[Mew-dist 2817] Re: Annotation on Mew

Kenji Gotsubo gotsubo at example.com
1997年 10月 30日 (木) 13:20:55 JST


五坪です。

From: Kenji Gotsubo <gotsubo at example.com>
Subject: [Mew-dist 2524] Annotation on Mew
Date: Thu, 16 Oct 1997 16:54:48 +0900

 > Mewを使いはじめたのですが、私はどれにリプライしたかをすぐに忘れて
 > しまう鳥頭だったのを忘れていました。そこで、replied markを付ける機
 > 能を作りました。

鳥頭は私だけだったようですが(^^;;、mew-1.92とim-76も出たことですの
で、これ用のpatchを作りました。replyのほかにもre-distributeと
forwardしたときもmarkが付くようにしました。

  ()()    「顕微鏡なめてみていい?」
  ( ¨>・ 富士通株式会社 ソフトウェア事業本部
 〜( )    五坪 賢次 <gotsubo at example.com>

-------------- next part --------------
Annotation like MH on Mew

	Mew上でMH的なAnnotation機能を用いるためのpatchです。
	このpatchは次のファイルから構成されています。

	 - mew-anno.el
	 - mew-192.diff
	 - im-76.diff
	 - scan.sbr

Annotation機能とは?

	Annotation機能とは、Messageに対して次を行ったとこと記録す
	る機能です。

	 - Reply
	 - Re-Distribute
	 - Forward

	この機能はすでにIMが持っており、それをMewのsummary buffer
	に表示するだけです。summaryのキャッシュを使っている場合は
	キャッシュの内容も変更します。Message-Idを頼りにMessageを
	探すのでMessage-Idが付いていることが必須となります。また、
	スペースの制約上、summary bufferにはReply、Reset、Forward
	のうち、一つしか表示しません。デフォルトの表示の優先順位は
	次のようになっています。

		Reply > Re-Distribute > Forward

	Forwardマークを付けるには、Subjectが"Forward:"で始まってお
	り、かつマルチパートである必要があります。
	Mewのsummary bufferでf(mew-summary-forward)をした場合は自
	動的に"Forward:"で始まるSubjectになりますが、
	F(mew-summary-multi-forward)した場合は、自分でSubjectを付
	ける時に、"Forward:"で始まるサブジェクトにする必要がありま
	す。
	Replyマークを付けるにはReferenceフィールドが必要ですが、
	Mewが自動的に付けてくれるので気にする必要はありません。

インストール

	mew-1.92にmew-anno.elを追加し、mew-192.diffをあて、
	im-76にim76.diffをあてます。そして、通常の手順でinstallし
	ます。

	たとえば、これらのpatchなどを置いたディレクトリを$ANNO、
	mew-1.92を展開したディレクトリを$MEW、im-76を展開したディ
	レクトリを$IMとすると、
	% cd $MEW
	% cp $ANNO/mew-anno.el .
	% patch -p1 < $ANNO/mew-192.diff
	% cd $IM
	% patch -p1 < $ANNO/im-76.diff
	とした後、MewとIMをインストールします。

セッティング

	IMの設定

	~/.im/Configに次のような行を追加します。

	Annotate=on
	Form=%5n %1x%m%d %-14A %S <<%b	# Added %1x between `%5n ' and `%m'
	ScanSbr=scan.sbr
	MsgDBFile=msgiddb

	そして、~/.im/にscan.sbrを置きます。
	% cp $ANNO/scan.sbr cd ~/.im

	今までMsgDBFileを定義していなかった人は、
	% imhist --add=+
	などを行い、MsgDBを作成する必要があります。

	Mewの設定

	~/.emacsに次の一行を記述します。
	(setq mew-annotation-use t)

	Formを変更しますので、mew-summary-cache-useをtにしている人
	は、キャッシュの内容を更新する必要があります。

カスタマイズ

	マークの種類と優先順位は変更することができます。
	変更する場合は、mew-anno.elでdefvarされている変数と
	scan.sbrの内容を同時に変更してください。

制約

	フォルダー名に`,'を含めないで下さい。
-------------- next part --------------
;;;			      mew-anno.el
;;;
;;;	      Copyright (C) 1997  Kenji Gotsubo
;;;
;;;		   This emacs lisp library conforms
;;;		GNU GENERAL PUBLIC LICENSE Version 2.
;;;
;;; Author:  Kenji Gotsubo <gotsubo at example.com>
;;; Created: Oct 14, 1997
;;; Revised: Oct 16, 1997
;;; Revised: Oct 22, 1997
;;; Revised: Oct 26, 1997
;;;

(defconst mew-anno-version "mew-anno.el version 0.4")

(require 'mew)

(defconst mew-imhist-buffer "*mew imhist*")
(defvar mew-note-repl ?- "Replied mark")
(defvar mew-note-dist ?R "Re-distributed mark") 
(defvar mew-note-fwd ?F "Forwarded mark")
(defvar mew-note-order (` ((?  . 0)			; weakest
			   ((, mew-note-fwd)  . 1)
			   ((, mew-note-dist)  . 2)
			   ((, mew-note-repl)  . 3))))	; strongest
(defvar mew-prog-imhist "imhist")

(defun mew-annotation (mark mid)
  (save-excursion
    (let ((buf (mew-annotation-buffer-create))
	  mew-imhist-buffer-process)
      (erase-buffer)
      (setq mew-imhist-buffer-process
	    (start-process "imhist" buf
			   mew-prog-imhist
			   (format "--lookup=%s" (cond ((listp mid)
							(mew-join " " mid))
						       (t mid)))))
      (set-process-sentinel mew-imhist-buffer-process
			    (cond ((eq mark mew-note-repl)
				   'mew-imhist-repl-sentinel)
				  ((eq mark mew-note-dist)
				   'mew-imhist-dist-sentinel)
				  ((eq mark mew-note-fwd)
				   'mew-imhist-fwd-sentinel)
				  (t
				   nil))))))

(defun mew-imhist-repl-sentinel (process event)
  (mapcar (function (lambda (a) (mew-annotate-mark-as mew-note-repl a)))
	  (mew-get-consulting-message process)))

(defun mew-imhist-dist-sentinel (process event)
  (mapcar (function (lambda (a) (mew-annotate-mark-as mew-note-dist a)))
	  (mew-get-consulting-message process)))

(defun mew-imhist-fwd-sentinel (process event)
  (mapcar (function (lambda (a) (mew-annotate-mark-as mew-note-fwd a)))
	  (mew-get-consulting-message process)))

(defun mew-get-consulting-message (process)
  (save-excursion
    (let ((pbuf (process-buffer process))
	  list)
      (set-buffer pbuf)
      (unwind-protect
	  (progn
	    (goto-char (point-min))
	    (if (null (re-search-forward (format "^%s: " mew-prog-imhist)
					 nil t))
		(progn
		  (goto-char (point-min))
		  (while (re-search-forward "\\([-+=][^,\n]*\\)/\\([1-9]+[0-9]*\\)"
					    nil t)
		    (setq list
			  (cons (cons (buffer-substring (match-beginning 1)
							(match-end 1))
				      (buffer-substring (match-beginning 2)
							(match-end 2)))
				list))))))
	(kill-buffer pbuf))
      list)))

(defun mew-annotate-mark-as (mark msg)
  "Annotate mark this message"
  (if msg
      (save-excursion
	(let ((folder (car msg))
	      (current (point)))
	  (cond ((get-buffer folder)
		 (set-buffer folder)
		 (if (eq (mew-summary-jump-message (cdr msg)) t)
		     (progn
		       (beginning-of-line)
		       (re-search-forward (concat mew-summary-message-regex
						  "."))
		       (let ((buffer-read-only nil)
			     (cmark (string-to-char
				     (buffer-substring (point)
						       (1+ (point))))))
			 (if (mew-anno-mark< mark cmark)
			     (message "Already marked as %s"
				      (char-to-string cmark))
			   (delete-char 1)
			   (insert (char-to-string mark))
			   (if mew-summary-cache-use
			       (progn
				 (if (eq major-mode 'mew-summary-mode)
				     (mew-decode-syntax-delete))
				 (mew-summary-folder-cache-save))))
			 (goto-char current)))))
		(t
		 (let ((buf (get-buffer-create folder))
		       (cache (mew-expand-folder folder
						 mew-summary-cache-file)))
		   (set-buffer buf)
		   (unwind-protect
		       (if (and mew-summary-cache-use (file-exists-p cache))
			   (progn
			     (mew-frwlet mew-cs-scan mew-cs-noconv
					 (insert-file-contents cache))
			     (mew-annotate-mark-as mark msg)))
		     (kill-buffer buf)))))))))

(defun mew-anno-mark< (m1 m2)
  (< (cdr (assoc m1 mew-note-order)) (cdr (assoc m2 mew-note-order))))

  
(defun mew-forward-consultring-message ()
  (save-excursion
    (if (string-match "^Forward: .*$"
		      (or (mew-header-get-value "Subject:") ""))
	(let* ((content-type (mew-header-get-value "Content-Type:"))
	       (boundary (and content-type
			      (string-match "\\(boundary=\\)\"\\(.*\\)\"$"
					    content-type)
			      (substring content-type (match-beginning 2)
					 (match-end 2))))
	       (page-delimiter boundary)
	       midlist)
	  (if (null boundary)
	      nil
	    (goto-char (point-min))
	    (re-search-forward "^$")
	    (while (progn (forward-page) (eolp))
	      (unwind-protect
		  (progn
		    (narrow-to-page)
		    (let ((content-type
			   (mew-header-get-value "Content-Type:")))
		      (if (string-equal content-type "Message/Rfc822")
			  (progn
			    (narrow-to-region (1+ (re-search-forward "^$"))
					      (point-max))
			    (setq midlist
				  (cons (mew-header-get-value "Message-Id:")
					midlist))))))
		(widen))))
	  midlist))))

;(defun mew-concat-list (list)
;  (cond ((stringp list)
;	 list)
;	((null (cdr list))
;	 (car list))
;	(t
;	 (concat (car list) " " (mew-concat-list (cdr list))))))
  
(defun mew-annotation-buffer-create ()
  (let ((count 0))
    (while (get-buffer (format "%s%d" mew-imhist-buffer count))
      (setq count (1+ count)))
    (set-buffer (get-buffer-create (format "%s%d" mew-imhist-buffer count)))))

(provide 'mew-anno)
;; END
-------------- next part --------------
diff -c -r mew-1.92.OLD/Makefile mew-1.92/Makefile
*** mew-1.92.OLD/Makefile	Sat Oct 25 14:36:05 1997
--- mew-1.92/Makefile	Mon Oct 27 09:21:42 1997
***************
*** 43,49 ****
  	mew-mime.elc     mew-minibuf.elc mew-pgp.elc     \
  	mew-pick.elc     mew-refile.elc  mew-scan.elc    \
  	mew-sort.elc     mew-summary.elc mew-syntax.elc  \
! 	mew-virtual.elc  mew-highlight.elc
  
  SRCS =  mew-attach.el   mew-bq.el      mew-cache.el   \
  	mew-complete.el mew-decode.el  mew-demo.el    \
--- 43,49 ----
  	mew-mime.elc     mew-minibuf.elc mew-pgp.elc     \
  	mew-pick.elc     mew-refile.elc  mew-scan.elc    \
  	mew-sort.elc     mew-summary.elc mew-syntax.elc  \
! 	mew-virtual.elc  mew-highlight.elc mew-anno.elc
  
  SRCS =  mew-attach.el   mew-bq.el      mew-cache.el   \
  	mew-complete.el mew-decode.el  mew-demo.el    \
***************
*** 53,59 ****
  	mew-mime.el     mew-minibuf.el mew-pgp.el     \
  	mew-pick.el     mew-refile.el  mew-scan.el    \
  	mew-sort.el     mew-summary.el mew-syntax.el  \
! 	mew-virtual.el                                \
  	mew-mule0.el    mew-mule2.el   mew-mule3.el   \
  	mew-highlight.el			      \
  	mew-temacs.el   mew-xemacs.el  mew.el
--- 53,59 ----
  	mew-mime.el     mew-minibuf.el mew-pgp.el     \
  	mew-pick.el     mew-refile.el  mew-scan.el    \
  	mew-sort.el     mew-summary.el mew-syntax.el  \
! 	mew-virtual.el  mew-anno.el                   \
  	mew-mule0.el    mew-mule2.el   mew-mule3.el   \
  	mew-highlight.el			      \
  	mew-temacs.el   mew-xemacs.el  mew.el
diff -c -r mew-1.92.OLD/mew-draft.el mew-1.92/mew-draft.el
*** mew-1.92.OLD/mew-draft.el	Sat Oct 25 14:21:23 1997
--- mew-1.92/mew-draft.el	Mon Oct 27 09:20:53 1997
***************
*** 602,607 ****
--- 602,611 ----
    (let* ((mimefolder (mew-draft-to-mime (buffer-name)))
  	 (mimedir (mew-expand-folder mimefolder))
  	 (msg (file-name-nondirectory (buffer-file-name)))
+ 	 (replmid (and mew-annotation-use
+ 		       (mew-header-get-value "References:")))
+ 	 (fwdmid (and mew-annotation-use
+ 		      (mew-forward-consultring-message)))
  	 (process-connection-type mew-connection-type1)
  	 (delete nil))
      (set-buffer-modified-p t)		; Make sure buffer is written
***************
*** 618,623 ****
--- 622,636 ----
  	    (set-window-configuration (mew-current-get 'window))
  	    (mew-current-set 'window nil))))
      (set-buffer (generate-new-buffer mew-buffer-watch))
+     ;; for annotation
+     (make-local-variable 'mew-consulting-message)
+     (setq mew-consulting-message
+ 	  (cond (replmid
+ 		 (cons mew-note-repl replmid))
+ 		(fwdmid
+ 		 (cons mew-note-fwd fwdmid))
+ 		(t
+ 		 nil)))
      ;; watch buffer
      (setq mew-watch-buffer-process
  	  (start-process "Send" (current-buffer)
***************
*** 655,660 ****
--- 668,677 ----
      (goto-char (point-min))
      (if (null (re-search-forward (format "^%s: ERROR:" mew-prog-imput) nil t))
  	(progn
+ 	  ;; for annotation
+ 	  (if mew-consulting-message
+ 	      (mew-annotation (car mew-consulting-message)
+ 			      (cdr mew-consulting-message)))
  	  (set-buffer cbuf)  ;; to avoid cursor-in-echo-area bug
  	  (kill-buffer kbuf) ;; set-buffer before kill-buffer
  	  )
diff -c -r mew-1.92.OLD/mew-summary.el mew-1.92/mew-summary.el
*** mew-1.92.OLD/mew-summary.el	Sat Oct 25 14:27:44 1997
--- mew-1.92/mew-summary.el	Mon Oct 27 09:20:53 1997
***************
*** 1756,1762 ****
       (t 
        (goto-char (point-min))
        (if (re-search-forward (format "^[ ]*%s[^0-9]+" msg) nil t) ;; xxx regex?
! 	  (beginning-of-line)
  	(goto-char here))))
      ))
  
--- 1756,1764 ----
       (t 
        (goto-char (point-min))
        (if (re-search-forward (format "^[ ]*%s[^0-9]+" msg) nil t) ;; xxx regex?
! 	  (progn
! 	    (beginning-of-line)
! 	    t)
  	(goto-char here))))
      ))
  
***************
*** 1817,1833 ****
        (if (not (or to cc))
  	  (message "Not re-distributed since both to and cc wasn't specified.")
  	(save-excursion
! 	  (set-buffer (find-file-noselect hdrfile))
! 	  (and to (mew-header-insert-here "Resent-To:" to))
! 	  (and cc (mew-header-insert-here "Resent-Cc:" cc))
! 	  (save-buffer) 
! 	  (message "Redistributing ... ")
! 	  (call-process mew-prog-imput nil nil nil 
! 			"--dist=1"
! 			(format "--distmsg=%s" srcfile)
! 			(format "--message=%s" hdrfile))
! 	  (message "Redistributing ... done")
! 	  (kill-buffer (current-buffer))
  	  ))
        ))
    )
--- 1819,1849 ----
        (if (not (or to cc))
  	  (message "Not re-distributed since both to and cc wasn't specified.")
  	(save-excursion
! 	  (let ((hdrbuf (find-file-noselect hdrfile)))
! 	    (set-buffer hdrbuf)
! 	    (unwind-protect
! 		(progn
! 		  (and to (mew-header-insert-here "Resent-To:" to))
! 		  (and cc (mew-header-insert-here "Resent-Cc:" cc))
! 		  (save-buffer) 
! 		  (message "Redistributing ... ")
! 		  (call-process mew-prog-imput nil nil nil 
! 				"--dist=1"
! 				(format "--distmsg=%s" srcfile)
! 				(format "--message=%s" hdrfile))
! 		  ;; for annotation
! 		  (if mew-annotation-use
! 		      (save-excursion
! 			(let ((srcbuf (find-file-noselect srcfile)))
! 			  (set-buffer srcbuf)
! 			  (unwind-protect
! 			      (mew-annotation mew-note-dist
! 					      (mew-header-get-value
! 					       "Message-Id:"))
! 			    (kill-buffer srcbuf)))))
! 
! 		  (message "Redistributing ... done"))
! 	      (kill-buffer hdrbuf)))
  	  ))
        ))
    )
diff -c -r mew-1.92.OLD/mew.el mew-1.92/mew.el
*** mew-1.92.OLD/mew.el	Sat Oct 25 14:28:56 1997
--- mew-1.92/mew.el	Mon Oct 27 09:20:53 1997
***************
*** 118,123 ****
--- 118,126 ----
  (defvar mew-break-pages t)
  (defvar mew-page-delimiter "^\^L")
  
+ (defvar mew-annotation-use nil
+   "*If non-nil, annotate mail")
+ 
  (defvar mew-bold-url-size 3000
    "*Use bold font at url maximize size.
  If nil, all contents are parsed.")
***************
*** 979,984 ****
--- 982,988 ----
  (require 'mew-fib)
  (require 'mew-sort)
  (require 'mew-highlight)
+ (require 'mew-anno)
  
  ;;;
  ;;; End of Mew
-------------- next part --------------
diff -c -r im-76.OLD/imhist.in im-76/imhist.in
*** im-76.OLD/imhist.in	Fri Oct 10 09:46:47 1997
--- im-76/imhist.in	Thu Oct 30 10:50:39 1997
***************
*** 76,91 ****
  }
  if ($opt_lookup ne '') {
      exit $EXIT_ERROR if (open_history(1) < 0);
! #   unless ($opt_lookup =~ /^<.*>$/) {
! #	im_warn("Message-ID should be surrounded by <>.\n");
! #	exit $EXIT_ERROR;
! #   }
!     my $msg = lookup_history($opt_lookup, LookUpMsg);
!     if ($msg eq '') {
! 	im_info("no entry found for $opt_lookup\n");
! 	exit $EXIT_ERROR;
!     } else {
! 	print $msg . "\n";
      }
      close_history();
  } elsif ($opt_remove ne '') {
--- 76,94 ----
  }
  if ($opt_lookup ne '') {
      exit $EXIT_ERROR if (open_history(1) < 0);
!     my $mid;
!     foreach $mid (split(/> +|> *$/, $opt_lookup)) {	# XXX
! #	unless ($opt_lookup =~ /^<.*>$/) {
! #	    im_warn("Message-ID should be surrounded by <>.\n");
! #	    exit $EXIT_ERROR;
! #	}
! 	my $msg = lookup_history($mid . ">", LookUpMsg);
! 	if ($msg eq '') {
! 	    im_info("no entry found for $mid>\n");
! 	    exit $EXIT_ERROR;
! 	} else {
! 	    print $msg . "\n";
! 	}
      }
      close_history();
  } elsif ($opt_remove ne '') {
diff -c -r im-76.OLD/imput.in im-76/imput.in
*** im-76.OLD/imput.in	Fri Oct 24 18:53:58 1997
--- im-76/imput.in	Fri Oct 24 22:19:12 1997
***************
*** 981,987 ****
  	if ($Dist_flag) {
  	    $ref = &header_value(\@Header, 'Message-Id');
  	    &annotate('Resent', $ref) if ($ref ne '');
! 	} elsif (&header_value(\@Header, 'Subject') =~ /Forward:/) { # XXX
  	    my $rfc822;
  	    foreach (@Body) {
  		if (/^--/) {
--- 981,987 ----
  	if ($Dist_flag) {
  	    $ref = &header_value(\@Header, 'Message-Id');
  	    &annotate('Resent', $ref) if ($ref ne '');
! 	} elsif (&header_value(\@Header, 'Subject') =~ /^Forward:/) { # XXX
  	    my $rfc822;
  	    foreach (@Body) {
  		if (/^--/) {
-------------- next part --------------
$symbol_table{'x'} = 'anno:';
#$NEEDSAFE_HASH{'anno:} = 1;	# if the field contains JIS characters

sub scan_sub {
	local ($href) = shift;

	if (${$href}{'replied'} ne '') {
		${$href}{'anno:'} = '-';
	} elsif (${$href}{'resent'} ne '') {
		${$href}{'anno:'} = 'R';
	} elsif (${$href}{'forwarded'} ne '') {
		${$href}{'anno:'} = 'F';
	} else {
		${$href}{'anno:'} = ' ';
	}
}
1;


Mew-dist メーリングリストの案内