From 3658c893ebec185f0c6bb2678a9ae6f49a44f54d Mon Sep 17 00:00:00 2001 From: teranisi Date: Fri, 11 Aug 2000 01:43:41 +0000 Subject: [PATCH] 2000-08-10 Yuuichi Teranishi * wl-vars.el (wl-draft-remove-group-list-contents): New user option. * wl-draft.el (wl-draft-deduce-address-list): New function. (wl-draft-parse-mailbox-list): Ditto. (wl-draft-send-mail-with-smtp): Use `wl-draft-deduce-address-list' instead of `smtp-deduce-address-list'. (wl-draft-on-field-p): Follow group list. * wl-address.el (wl-address-concat-token): New function. (wl-address-string-without-group-list-contents): Ditto. (wl-complete-field-body): Fixed problem of completion by japanese petname. (wl-address-make-completion-list): Rewrite. 2000-08-11 Taro Kawagishi * wl-address.el (wl-address-make-completion-list): Completion by petname. (wl-complete-field-body): Likewise. --- wl/ChangeLog | 22 +++++++++++++ wl/wl-address.el | 88 ++++++++++++++++++++++++++++++++++++++++--------- wl/wl-draft.el | 96 +++++++++++++++++++++++++++++++++++++++++++++++++----- wl/wl-vars.el | 5 +++ 4 files changed, 186 insertions(+), 25 deletions(-) diff --git a/wl/ChangeLog b/wl/ChangeLog index 43aac79..014dc5c 100644 --- a/wl/ChangeLog +++ b/wl/ChangeLog @@ -1,3 +1,25 @@ +2000-08-10 Yuuichi Teranishi + + * wl-vars.el (wl-draft-remove-group-list-contents): New user option. + + * wl-draft.el (wl-draft-deduce-address-list): New function. + (wl-draft-parse-mailbox-list): Ditto. + (wl-draft-send-mail-with-smtp): Use `wl-draft-deduce-address-list' + instead of `smtp-deduce-address-list'. + (wl-draft-on-field-p): Follow group list. + + * wl-address.el (wl-address-concat-token): New function. + (wl-address-string-without-group-list-contents): Ditto. + (wl-complete-field-body): Fixed problem of completion + by japanese petname. + (wl-address-make-completion-list): Rewrite. + +2000-08-11 Taro Kawagishi + + * wl-address.el (wl-address-make-completion-list): Completion by + petname. + (wl-complete-field-body): Likewise. + 2000-08-08 Yuuichi Teranishi * wl-draft.el (wl-draft-reply): Fixed problem when to or cc diff --git a/wl/wl-address.el b/wl/wl-address.el index 2146f35..88fff82 100644 --- a/wl/wl-address.el +++ b/wl/wl-address.el @@ -276,6 +276,27 @@ Matched address lists are append to CL." (completing-read "To: " cl) (read-string "To: ")))) +(defun wl-address-make-completion-list (address-list) + (let (addr-tuple cl) + (while address-list + (setq addr-tuple (car address-list)) + (setq cl + (cons + (cons (nth 0 addr-tuple) + (concat (nth 2 addr-tuple) " <"(nth 0 addr-tuple)">")) + cl)) + ;; nickname completion. + (unless (or (equal (nth 1 addr-tuple) (nth 0 addr-tuple)) + ;; already exists + (assoc (nth 1 addr-tuple) cl)) + (setq cl + (cons + (cons (nth 1 addr-tuple) + (concat (nth 2 addr-tuple) " <"(nth 0 addr-tuple)">")) + cl))) + (setq address-list (cdr address-list))) + cl)) + (defun wl-complete-field-body-or-tab () (interactive) (let ((case-fold-search t) @@ -383,26 +404,22 @@ Matched address lists are append to CL." (if (setq comp-win (get-buffer-window comp-buf)) (delete-window comp-win))))))) -(defun wl-complete-field-body (completion-list &optional epand-char skip-chars use-ldap) +(defun wl-complete-field-body (completion-list + &optional epand-char skip-chars use-ldap) (interactive) (let* ((end (point)) (start (save-excursion -; (skip-chars-backward "_a-zA-Z0-9+@%.!\\-") - (skip-chars-backward (or skip-chars - "_a-zA-Z0-9+@%.!\\-/")) + (skip-chars-backward (or skip-chars "^:,>\n")) + (skip-chars-forward " \t") (point))) (completion) - (pattern (elmo-string (buffer-substring start end))) + (pattern (buffer-substring start end)) (len (length pattern)) - (completion-ignore-case t) (cl completion-list)) (when use-ldap - (setq cl (wl-address-ldap-search pattern cl))) + (setq cl (wl-address-ldap-search pattern cl))) (if (null cl) - (if use-ldap - (progn - (message "Can't find completion for \"%s\"" pattern) - (ding))) + nil (setq completion (try-completion pattern cl)) (cond ((eq completion t) (if use-ldap (setq wl-address-ldap-search-hash nil)) @@ -518,11 +535,6 @@ Matched address lists are append to CL." (or (elmo-get-hash-val addr wl-address-petname-hash) str))) -(defsubst wl-address-make-completion-list (address-list) - (mapcar '(lambda (entity) - (cons (nth 0 entity) - (concat (nth 2 entity) " <"(nth 0 entity)">"))) address-list)) - (defsubst wl-address-user-mail-address-p (address) "Judge whether ADDRESS is user's or not." (member (downcase (wl-address-header-extract-address address)) @@ -551,6 +563,49 @@ e.g. \"Mr. bar \" (wl-match-string 1 str)) (t ""))) +(defmacro wl-address-concat-token (string token) + (` (cond + ((eq 'quoted-string (car (, token))) + (concat (, string) "\"" (cdr (, token)) "\"")) + ((eq 'comment (car (, token))) + (concat (, string) "(" (cdr (, token)) ")")) + (t + (concat (, string) (cdr (, token))))))) + +(defun wl-address-string-without-group-list-contents (sequence) + "Return address string from lexical analyzed list SEQUENCE. +Group list contents is not included." + (let (address-string route-addr-end token seq) + (while sequence + (setq token (car sequence)) + (cond + ;; group = phrase ":" [#mailbox] ";" + ((and (eq 'specials (car token)) + (string= (cdr token) ":")) + (setq address-string (concat address-string (cdr token))) ; ':' + (setq seq (cdr sequence)) + (setq token (car seq)) + (while (not (and (eq 'specials (car token)) + (string= (cdr token) ";"))) + (setq token (car seq)) + (setq seq (cdr seq))) + (setq address-string (concat address-string (cdr token))) ; ';' + (setq sequence seq)) + ;; route-addr = "<" [route] addr-spec ">" + ;; route = 1#("@" domain) ":" ; path-relative + ((and (eq 'specials (car token)) + (string= (cdr token) "<")) + (setq seq (std11-parse-route-addr sequence)) + (setq route-addr-end (car (cdr seq))) + (while (not (eq (car sequence) route-addr-end)) + (setq address-string (wl-address-concat-token address-string + (car sequence))) + (setq sequence (cdr sequence)))) + (t + (setq address-string (wl-address-concat-token address-string token)) + (setq sequence (cdr sequence))))) + address-string)) + (defun wl-address-petname-delete (the-email) "Delete petname in wl-address-file." (let* ( (tmp-buf (get-buffer-create " *wl-petname-tmp*")) @@ -619,3 +674,4 @@ If already registerd, change it." (provide 'wl-address) ;;; wl-address.el ends here + diff --git a/wl/wl-draft.el b/wl/wl-draft.el index 7580d86..481b87b 100644 --- a/wl/wl-draft.el +++ b/wl/wl-draft.el @@ -813,6 +813,73 @@ to find out how to use this." ;; should never happen (t (error "qmail-inject reported unknown failure")))))) +(defun wl-draft-parse-mailbox-list (field &optional remove-group-list) + "Get mailbox list of FIELD from current buffer. +The buffer is expected to be narrowed to just the headers of the message. +If optional argument REMOVE-GROUP-LIST is non-nil, remove group list content +from current buffer." + (save-excursion + (let ((case-fold-search t) + (inhibit-read-only t) + addresses address + mailbox-list beg seq has-group-list) + (goto-char (point-min)) + (while (re-search-forward (concat "^" (regexp-quote field) "[\t ]*:") + nil t) + (setq beg (point)) + (re-search-forward "^[^ \t]" nil 'move) + (beginning-of-line) + (skip-chars-backward "\n") + (setq seq (std11-lexical-analyze + (buffer-substring-no-properties beg (point)))) + (setq addresses (std11-parse-addresses seq)) + (while addresses + (cond ((eq (car (car addresses)) 'group) + (setq has-group-list t) + (setq mailbox-list + (nconc mailbox-list + (mapcar + 'std11-address-string + (nth 2 (car addresses)))))) + ((eq (car (car addresses)) 'mailbox) + (setq address (nth 1 (car addresses))) + (setq mailbox-list + (nconc mailbox-list + (list + (std11-addr-to-string + (if (eq (car address) 'phrase-route-addr) + (nth 2 address) + (cdr address)))))))) + (setq addresses (cdr addresses))) + (when (and remove-group-list has-group-list) + (delete-region beg (point)) + (insert " " (wl-address-string-without-group-list-contents seq)))) + mailbox-list))) + +(defun wl-draft-deduce-address-list (buffer header-start header-end) + "Get address list suitable for smtp RCPT TO:
. +Group list content is removed if `wl-draft-remove-group-list-contents' is +non-nil." + (let ((fields '("to" "cc" "bcc")) + (resent-fields '("resent-to" "resent-cc" "resent-bcc")) + (case-fold-search t) + addrs recipients) + (save-excursion + (save-restriction + (narrow-to-region header-start header-end) + (goto-char (point-min)) + (save-excursion + (if (re-search-forward "^resent-to[\t ]*:" nil t) + (setq fields resent-fields))) + (while fields + (setq recipients + (nconc recipients + (wl-draft-parse-mailbox-list + (car fields) + wl-draft-remove-group-list-contents))) + (setq fields (cdr fields))) + recipients)))) + ;; ;; from Semi-gnus ;; @@ -832,21 +899,30 @@ to find out how to use this." (concat "^" (regexp-quote mail-header-separator) "$\\|^$") nil t) (point-marker))) - (recipients (smtp-deduce-address-list (current-buffer) - (point-min) delimline)) - (smtp-server (or wl-smtp-posting-server - (if (functionp smtp-server) - (funcall smtp-server sender - recipients) - (or smtp-server "localhost")))) + (smtp-server + (or wl-smtp-posting-server + (if (functionp smtp-server) + (funcall + smtp-server + sender + ;; no harm.. + (let (wl-draft-remove-group-list-contents) + (wl-draft-deduce-address-list + (current-buffer) (point-min) delimline))) + (or smtp-server "localhost")))) (smtp-service (or wl-smtp-posting-port smtp-service)) (smtp-local-domain (or smtp-local-domain wl-local-domain)) - (id (std11-field-body "message-id"))) + (id (std11-field-body "message-id")) + recipients) (if (not (elmo-plugged-p smtp-server smtp-service)) (wl-draft-set-sent-message 'mail 'unplugged (cons smtp-server smtp-service)) (unwind-protect (save-excursion + ;; Instead of `smtp-deduce-address-list'. + (setq recipients (wl-draft-deduce-address-list + (current-buffer) (point-min) delimline)) + (unless recipients (error "No recipients")) ;; Insert an extra newline if we need it to work around ;; Sun's bug that swallows newlines. (goto-char (1+ delimline)) @@ -1184,7 +1260,9 @@ If optional argument is non-nil, current draft buffer is killed" t (save-excursion (forward-line -1) - (if (looking-at ".*,[ \t]?$") nil t))) + (if (or (looking-at ".*,[ \t]?$") + (looking-at "^[^ \t]+:[ \t]+.*:$")); group list name + nil t))) (let ((pos (point))) (save-excursion (beginning-of-line) diff --git a/wl/wl-vars.el b/wl/wl-vars.el index 6f76a5a..390054b 100644 --- a/wl/wl-vars.el +++ b/wl/wl-vars.el @@ -568,6 +568,11 @@ Default is for 'reply-to-all'." :type 'boolean :group 'wl-draft) +(defcustom wl-draft-remove-group-list-contents t + "*If non-nil, remove group list contents in `wl-draft-send-mail-with-smtp'" + :type 'boolean + :group 'wl-draft) + ;;;; (defcustom wl-init-file "~/.wl" "*User customization setting file." -- 1.7.10.4