[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 メーリングリストの案内