[Mew-dist 1283] Pick with completion

UMEMURA Akihiro akihiro at example.com
1997年 7月 23日 (水) 01:07:07 JST


mew-1.86 の pick pattern の入力時に補完ができるように
してみました。TAB key で補完されます。

また、以前のバージョンで存在した pick macro を復活させました。
使い方は、.emacs などで

(add-hook 'mew-init-hook
          (lambda ()	
             (mew-pick-define-macro "tocc=#" "to=#|cc=#")
             (mew-pick-define-macro "mew" "tocc=mew-dist")))

といった感じです。
(インタラクティブに M-x mew-pick-define-macro も可。)

試したのは、このメールの X-Mailer に書いてあるバージョンの
Emacs だけなので、他のものでうまく動かなかったらごめんなさい。
*****************************************************************
  NTT基礎研究所情報科学研究部  0462-40-3663 (厚木市森の里若宮)
           梅村晃広               akihiro at example.com
-------------- next part --------------
--- mew-pick.el.org	Tue Jul 22 13:07:05 1997
+++ mew-pick.el	Wed Jul 23 00:33:55 1997
@@ -21,7 +21,7 @@
 	(range nil))
     (if (null (file-directory-p (mew-expand-folder folder)))
 	(message "No such folder %s" folder)
-      (setq pattern (read-string "pick pattern: "))
+      (setq pattern (mew-read-pick-pattern))
       (message "Picking messages in %s ..." folder)
       (setq range (mew-summary-pick folder pattern))
       (message "Picking messages in %s ... done" folder)
@@ -45,7 +45,7 @@
 	  (first nil)
 	  (last nil)
 	  (range nil))
-      (setq pattern (read-string "pick pattern: "))
+      (setq pattern (mew-read-pick-pattern))
       (message "Picking messages in %s ..." folder)
       (goto-char (point-min))
       (setq first (mew-summary-message-number))
@@ -67,6 +67,175 @@
 	)
       )))
 
+(defvar mew-pick-field-alist
+  '(("head=")
+    ("body=")
+    ("all=")
+    ("To=") 
+    ("Cc=") 
+    ("Subject=") 
+    ("Dcc=") 
+    ("Fcc=") 
+    ("Bcc=") 
+    ("Reply-to=") 
+    ("Followup-to=") 
+    ("From=") 
+    ("Newsgroup=") 
+    ("Date=")
+    ))
+
+(defvar mew-pick-macro-alist nil)
+
+(defvar mew-pick-minibuffer-map nil)
+(if (not mew-pick-minibuffer-map)
+    (let ((map (copy-keymap minibuffer-local-map)))
+      (define-key map "\t" 'mew-pick-complete)
+      (setq mew-pick-minibuffer-map map)))
+
+(defun mew-read-pick-pattern ()
+  (mew-pick-macro-expand-string
+   (read-from-minibuffer "pick pattern: " nil mew-pick-minibuffer-map)))
+
+(defun mew-pick-complete ()
+  (interactive)
+  (let ((po (point)) 
+	(str nil)
+	(completion-ignore-case t)
+	(clist
+	 (append '(("(") ("!"))
+		 mew-pick-macro-alist
+		 mew-pick-field-alist))
+	(beg (point-min))
+	)
+    (if (re-search-backward " \\|(\\|&\\||\\|!" nil t)
+	(setq beg (match-end 0)))
+    (setq str (buffer-substring beg po))
+    (goto-char po)
+    (let ((all (all-completions str clist))
+	  (compl (try-completion str clist)))
+      (cond ((stringp compl)
+	     (delete-region beg po)
+	     (insert compl)
+	     (with-output-to-temp-buffer "*Completions*"
+	       (display-completion-list all)))
+	    (compl
+	     nil)
+	    (t
+	     nil)))))
+      
+(defun mew-pick-define-macro (str1 str2)
+  (interactive (list
+		(read-string "pick pattern: ")
+		(read-string "macro body: ")))
+  ;; macro-pattern is a string including no #, or
+  ;; a string in a form FIELD=#1 #2 #3...#n.
+  ;; #1 can be replaced by #.
+  (let ((args nil) (body nil))
+    (while (string-match "\\(#[0-9]*\\)[, ]*" str1)
+      (setq args (cons (intern (mew-match 1 str1)) args))
+      (setq str1 (concat (substring str1 0 
+				    (match-beginning 0))
+			 (substring str1 
+				    (match-end 0)))))
+    (while (string-match "#[0-9]*" str2)
+      (setq body 
+	    (cons (substring str2 0 (match-beginning 0)) body))
+      (setq body
+	    (cons (intern (mew-match 0 str2)) body))
+      (setq str2
+	    (substring str2 (match-end 0))))
+    (setq body (cons str2 body))
+    (let ((asc (assoc str1 mew-pick-macro-alist))
+	  (value (cons (nreverse args) (nreverse body))))
+      (if asc
+	  (setcdr asc value)
+	(setq mew-pick-macro-alist
+	  (cons (cons str1 value) mew-pick-macro-alist))))
+    ))
+    
+(defun mew-pick-macro-expand (name args)
+  (let ((asc (assoc name mew-pick-macro-alist)))
+    (if (not asc)
+	name
+      (let ((alist nil)
+	    (args2 (nth 1 asc))
+	    (body (nthcdr 2 asc))
+	    (body-copy nil))
+	(while (and args args2)
+	  (setq alist (cons (cons (car args2) (car args)) alist))
+	  (setq args (cdr args))
+	  (setq args2 (cdr args2))
+	  )
+	(while body
+	  (if (stringp (car body))
+	      (setq body-copy (cons (car body) body-copy))
+	    (let ((assq (assq (car body) alist)))
+	      (if assq
+		  (setq body-copy (cons (cdr assq) body-copy)))))
+	  (setq body (cdr body)))
+	(concat "("
+		(mew-pick-macro-expand-string
+		 (apply 'concat (nreverse body-copy)))
+		")")))))
+
+(defun mew-pick-macro-expand-string (str)
+  (if (string= str "") 
+      ""
+    (let ((first (string-to-char str))
+	  (eq-flag nil))
+      (if (memq first '(?\( ?\! ?\& ?\| ?= ? ?\)))
+	  (concat (char-to-string first)
+		  (mew-pick-macro-expand-string (substring str 1)))
+	(let ((key nil) (rest nil))
+	  (if (string-match "=\\| \\|)\\|&\\||" str)
+	      (if (string= (mew-match 0 str) "=")
+		  (progn
+		    (setq eq-flag t)
+		    (setq key (substring str 0 (match-end 0)))
+		    (setq rest (substring str (match-end 0))))
+		(setq key (substring str 0 (match-beginning 0)))
+		(setq rest (substring str (match-beginning 0))))
+	    (setq key str)
+	    (setq rest ""))
+	  (let ((asc (assoc key mew-pick-macro-alist)))
+	    (cond (asc
+		   (let ((args (nth 1 asc)) (vals nil))
+		     (while args
+		       (if (string-match ",\\| \\|)\\|&\\||" rest)
+			   (progn
+			     (setq vals
+				   (cons 
+				    (substring rest 0 
+					       (match-beginning 0))
+				    vals))
+			     (setq rest
+				   (substring rest
+					      (match-beginning
+					       0))))
+			 (setq vals
+			       (cons rest vals))
+			 (setq rest ""))
+		       (setq args (cdr args)))
+		     (concat
+		      (mew-pick-macro-expand key (nreverse vals))
+		      (mew-pick-macro-expand-string rest))))
+		  (eq-flag
+		   (let ((val ""))
+		     (if (string-match " \\|)\\|&\\||" rest)
+			 (progn
+			   (setq val (substring rest 0 (match-beginning 0)))
+			   (setq rest (substring rest (match-beginning
+						       0))))
+		       (setq val rest)
+		       (setq rest ""))
+		     (concat key val 
+			     (mew-pick-macro-expand-string rest))))
+		  (t
+		   (concat key 
+			   (mew-pick-macro-expand-string rest))
+		   ))))))))
+	
+;;;	 
 (defun mew-member-del (a list)
   (let ((pointer (cons nil list)))
     ;; xxx the following case necessary?


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