* 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 <taro.kawagishi@nokia.com>
* wl-address.el (wl-address-make-completion-list): Completion by
petname.
(wl-complete-field-body): Likewise.
+2000-08-10 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * 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 <taro.kawagishi@nokia.com>
+
+ * wl-address.el (wl-address-make-completion-list): Completion by
+ petname.
+ (wl-complete-field-body): Likewise.
+
2000-08-08 Yuuichi Teranishi <teranisi@gohome.org>
* wl-draft.el (wl-draft-reply): Fixed problem when to or cc
(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)
(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))
(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))
(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*"))
(provide 'wl-address)
;;; wl-address.el ends here
+
;; 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:<address>.
+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
;;
(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))
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)
: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."
projects / elisp / wanderlust.git / commitdiff