X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/ac3232837188f7e1c4ffe34b76edede0ccb54f5e..53aff12a2f57ca0830b425a6097d93bb8da637ca:/lisp/mail/mailalias.el diff --git a/lisp/mail/mailalias.el b/lisp/mail/mailalias.el index 0ccb1b4d93..fbf60bbe36 100644 --- a/lisp/mail/mailalias.el +++ b/lisp/mail/mailalias.el @@ -1,7 +1,8 @@ ;;; mailalias.el --- expand and complete mailing address aliases -;; Copyright (C) 1985, 1987, 1995, 1996, 1997, 2001, 2002, 2003, -;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. +;; Copyright (C) 1985, 1987, 1995, 1996, 1997, 2001, 2002, 2003, 2004, +;; 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: mail @@ -36,12 +37,12 @@ :group 'mail) (defcustom mail-passwd-files '("/etc/passwd") - "*List of files from which to determine valid user names." + "List of files from which to determine valid user names." :type '(repeat string) :group 'mailalias) (defcustom mail-passwd-command nil - "*Shell command to retrieve text to add to `/etc/passwd', or nil." + "Shell command to retrieve text to add to `/etc/passwd', or nil." :type '(choice string (const nil)) :group 'mailalias) @@ -66,7 +67,7 @@ When t this still needs to be initialized.") ("Followup-To:" . (mail-sentto-newsgroups)) ;;("Distribution:" ???) )) - "*Alist of header field and expression to return alist for completion. + "Alist of header field and expression to return alist for completion. The expression may reference the variable `pattern' which will hold the string being completed. If not on matching header, `mail-complete-function' gets called instead." @@ -76,7 +77,7 @@ If not on matching header, `mail-complete-function' gets called instead." ;;;###autoload (defcustom mail-complete-style 'angles - "*Specifies how \\[mail-complete] formats the full name when it completes. + "Specifies how \\[mail-complete] formats the full name when it completes. If `nil', they contain just the return address like: king@grassland.com If `parens', they look like: @@ -87,26 +88,26 @@ If `angles', they look like: :group 'mailalias) (defcustom mail-complete-function 'ispell-complete-word - "*Function to call when completing outside `mail-complete-alist'-header." + "Function to call when completing outside `mail-complete-alist'-header." :type '(choice function (const nil)) :group 'mailalias) (defcustom mail-directory-function nil - "*Function to get completions from directory service or nil for none. + "Function to get completions from directory service or nil for none. See `mail-directory-requery'." :type '(choice function (const nil)) :group 'mailalias) ;; This is for when the directory is huge, or changes frequently. (defcustom mail-directory-requery nil - "*When non-nil call `mail-directory-function' for each completion. + "When non-nil call `mail-directory-function' for each completion. In that case, one argument gets passed to the function, the partial string entered so far." :type 'boolean :group 'mailalias) (defcustom mail-directory-process nil - "*Shell command to get the list of names from a mail directory. + "Shell command to get the list of names from a mail directory. This value is used when the value of `mail-directory-function' is `mail-directory-process'. The value should be a list of the form (COMMAND ARG ...), where each of the list elements @@ -127,13 +128,13 @@ or like this: (put 'mail-directory-process 'risky-local-variable t) (defcustom mail-directory-stream nil - "*List of (HOST SERVICE) for stream connection to mail directory." + "List of (HOST SERVICE) for stream connection to mail directory." :type 'sexp :group 'mailalias) (put 'mail-directory-stream 'risky-local-variable t) (defcustom mail-directory-parser nil - "*How to interpret the output of `mail-directory-function'. + "How to interpret the output of `mail-directory-function'. Three types of values are possible: - nil means to gather each line as one name @@ -240,68 +241,66 @@ removed from alias expansions." (defun build-mail-aliases (&optional file) "Read mail aliases from personal aliases file and set `mail-aliases'. By default, this is the file specified by `mail-personal-alias-file'." + (interactive + (list + (read-file-name (format "Read mail alias file (default %s): " + mail-personal-alias-file) + nil mail-personal-alias-file t))) (setq file (expand-file-name (or file mail-personal-alias-file))) ;; In case mail-aliases is t, make sure define-mail-alias ;; does not recursively call build-mail-aliases. (setq mail-aliases nil) - (let ((buffer nil) - (obuf (current-buffer))) - (unwind-protect - (progn - (setq buffer (generate-new-buffer " mailrc")) - (set-buffer buffer) - (while file - (cond ((get-file-buffer file) - (insert (save-excursion - (set-buffer (get-file-buffer file)) - (buffer-substring-no-properties - (point-min) (point-max))))) - ((file-exists-p file) (insert-file-contents file)) - ((file-exists-p (setq file (concat "~/" file))) - (insert-file-contents file)) - (t (setq file nil))) - (goto-char (point-min)) - ;; Delete comments from the contents. - (while (search-forward "# " nil t) - (let ((p (- (point) 2))) - (end-of-line) - (delete-region p (point)))) - ;; Don't lose if no final newline. - (goto-char (point-max)) - (or (eq (preceding-char) ?\n) (newline)) - (goto-char (point-min)) - ;; handle "\\\n" continuation lines - (while (not (eobp)) - (end-of-line) - (if (= (preceding-char) ?\\) - (progn (delete-char -1) (delete-char 1) (insert ?\ )) - (forward-char 1))) - (goto-char (point-min)) - ;; handle `source' directives -- Eddy/1994/May/25 - (cond ((re-search-forward "^source[ \t]+" nil t) - (re-search-forward "\\S-+") - (setq file (buffer-substring-no-properties - (match-beginning 0) (match-end 0))) - (beginning-of-line) - (insert "# ") ; to ensure we don't re-process this file - (beginning-of-line)) - (t (setq file nil)))) - (goto-char (point-min)) - (while (re-search-forward - "^\\(a\\|alias\\|g\\|group\\)[ \t]+\\([^ \t\n]+\\)" nil t) - (let* ((name (match-string 2)) - (start (progn (skip-chars-forward " \t") (point))) - value) - (end-of-line) - (setq value (buffer-substring-no-properties start (point))) - (unless (equal value "") - (define-mail-alias name value t)))) - mail-aliases) - (if buffer (kill-buffer buffer)) - (set-buffer obuf)))) + (with-temp-buffer + (while file + (cond ((get-file-buffer file) + (insert (with-current-buffer (get-file-buffer file) + (buffer-substring-no-properties + (point-min) (point-max))))) + ((file-exists-p file) (insert-file-contents file)) + ((file-exists-p (setq file (expand-file-name file "~/"))) + (insert-file-contents file)) + (t (setq file nil))) + (goto-char (point-min)) + ;; Delete comments from the contents. + (while (search-forward "# " nil t) + (let ((p (- (point) 2))) + (end-of-line) + (delete-region p (point)))) + ;; Don't lose if no final newline. + (goto-char (point-max)) + (or (eq (preceding-char) ?\n) (newline)) + (goto-char (point-min)) + ;; handle "\\\n" continuation lines + (while (not (eobp)) + (end-of-line) + (if (= (preceding-char) ?\\) + (progn (delete-char -1) (delete-char 1) (insert ?\ )) + (forward-char 1))) + (goto-char (point-min)) + ;; handle `source' directives -- Eddy/1994/May/25 + (cond ((re-search-forward "^source[ \t]+" nil t) + (re-search-forward "\\S-+") + (setq file (buffer-substring-no-properties + (match-beginning 0) (match-end 0))) + (beginning-of-line) + (insert "# ") ; to ensure we don't re-process this file + (beginning-of-line)) + (t (setq file nil)))) + (goto-char (point-min)) + (while (re-search-forward + "^\\(a\\|alias\\|g\\|group\\)[ \t]+\\([^ \t\n]+\\)" nil t) + (let* ((name (match-string 2)) + (start (progn (skip-chars-forward " \t") (point))) + value) + (end-of-line) + (setq value (buffer-substring-no-properties start (point))) + (unless (equal value "") + (define-mail-alias name value t)))) + mail-aliases)) ;; Always autoloadable in case the user wants to define aliases ;; interactively or in .emacs. +;; define-mail-abbrev in mailabbrev.el duplicates much of this code. ;;;###autoload (defun define-mail-alias (name definition &optional from-mailrc-file) "Define NAME as a mail alias that translates to DEFINITION. @@ -327,44 +326,64 @@ if it is quoted with double-quotes." (setq definition (substring definition (match-end 0)))) (if (string-match "[ \t\n,]+\\'" definition) (setq definition (substring definition 0 (match-beginning 0)))) - (let ((result '()) - ;; If DEFINITION is null string, avoid looping even once. - (start (and (not (equal definition "")) 0)) - (L (length definition)) - convert-backslash - end tem) + + (let* ((L (length definition)) + (start (if (> L 0) 0)) + end this-entry result tem) (while start - (setq convert-backslash nil) - ;; If we're reading from the mailrc file, then addresses are delimited - ;; by spaces, and addresses with embedded spaces must be surrounded by - ;; double-quotes. Otherwise, addresses are separated by commas. - (if from-mailrc-file - (if (eq ?\" (aref definition start)) - ;; The following test on `found' compensates for a bug - ;; in match-end, which does not return nil when match - ;; failed. - (let ((found (string-match "[^\\]\\(\\([\\][\\]\\)*\\)\"[ \t,]*" - definition start))) - (setq start (1+ start) - end (and found (match-end 1)) - convert-backslash t)) - (setq end (string-match "[ \t,]+" definition start))) - (setq end (string-match "[ \t\n,]*,[ \t\n,]*" definition start))) - (let ((temp (substring definition start end)) - (pos 0)) - (setq start (and end - (/= (match-end 0) L) - (match-end 0))) - (if convert-backslash - (while (string-match "[\\]" temp pos) - (setq temp (replace-match "" t t temp)) - (if start - (setq start (1- start))) - (setq pos (match-end 0)))) - (setq result (cons temp result)))) + (cond + (from-mailrc-file + ;; If we're reading from the mailrc file, addresses are + ;; delimited by spaces, and addresses with embedded spaces are + ;; surrounded by non-escaped double-quotes. + (if (eq ?\" (aref definition start)) + (setq start (1+ start) + end (and (string-match + "[^\\]\\(\\([\\][\\]\\)*\\)\"[ \t,]*" + definition start) + (match-end 1))) + (setq end (string-match "[ \t,]+" definition start))) + ;; Extract the address and advance the loop past it. + (setq this-entry (substring definition start end) + start (and end (/= (match-end 0) L) (match-end 0))) + ;; If the full name contains a problem character, quote it. + (and (string-match "\\(.+?\\)[ \t]*\\(<.*>\\)" this-entry) + (string-match "[^- !#$%&'*+/0-9=?A-Za-z^_`{|}~]" + (match-string 1 this-entry)) + (setq this-entry (replace-regexp-in-string + "\\(.+?\\)[ \t]*\\(<.*>\\)" + "\"\\1\" \\2" + this-entry)))) + ;; When we are not reading from .mailrc, addresses are + ;; separated by commas. Try to accept a rfc822-like syntax. + ;; (Todo: extend rfc822.el to do the work for us.) + ((equal (string-match + "[ \t,]*\\(\"\\(?:[^\"]\\|[^\\]\\(?:[\\][\\]\\)*\"\\)*\"[ \t]*\ +<[-.!#$%&'*+/0-9=?A-Za-z^_`{|}~@]+>\\)[ \t,]*" + definition start) + start) + ;; If an entry has a valid [ "foo bar" ] + ;; form, use it literally . This also allows commas in the + ;; quoted string, e.g. [ "foo bar, jr" ] + (setq this-entry (match-string 1 definition) + start (and (/= (match-end 0) L) (match-end 0)))) + (t + ;; Otherwise, read the next address by looking for a comma. + (setq end (string-match "[ \t\n,]*,[ \t\n]*" definition start)) + (setq this-entry (substring definition start end)) + ;; Advance the loop past this address. + (setq start (and end (/= (match-end 0) L) (match-end 0))) + ;; If the full name contains a problem character, quote it. + (and (string-match "\\(.+?\\)[ \t]*\\(<.*>\\)" this-entry) + (string-match "[^- !#$%&'*+/0-9=?A-Za-z^_`{|}~]" + (match-string 1 this-entry)) + (setq this-entry (replace-regexp-in-string + "\\(.+?\\)[ \t]*\\(<.*>\\)" "\"\\1\" \\2" + this-entry))))) + (push this-entry result)) + (setq definition (mapconcat (function identity) - (nreverse result) - ", ")) + (nreverse result) ", ")) (setq tem (assoc name mail-aliases)) (if tem (rplacd tem definition) @@ -431,8 +450,7 @@ Consults `/etc/passwd' and a directory service if one is set up via `mail-directory-function'. PATTERN is the string we want to complete." (if (eq mail-local-names t) - (save-excursion - (set-buffer (generate-new-buffer " passwd")) + (with-current-buffer (generate-new-buffer " passwd") (let ((files mail-passwd-files)) (while files (insert-file-contents (car files) nil nil nil t) @@ -490,11 +508,10 @@ PATTERN is the string we want to complete." If PATTERN is nil, get all the defined user names. This function calls `mail-directory-function' to query the directory, then uses `mail-directory-parser' to parse the output it returns." - (save-excursion - (message "Querying directory...") - (set-buffer (generate-new-buffer " *mail-directory*")) + (message "Querying directory...") + (with-current-buffer (generate-new-buffer " *mail-directory*") (funcall mail-directory-function pattern) - (goto-char 1) + (goto-char (point-min)) (let (directory) (if (stringp mail-directory-parser) (while (re-search-forward mail-directory-parser nil t) @@ -551,5 +568,4 @@ See `mail-directory-stream'." (provide 'mailalias) -;; arch-tag: 1d6a0f87-eb34-4d45-8816-60c1b952cf46 ;;; mailalias.el ends here