From daca8ba5e3ceb52928a88379a5e7bd18a0a215a3 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 15 Apr 2011 10:50:04 -0300 Subject: [PATCH] Use completion-at-point for mailalias.el * lisp/mail/mailalias.el: Use lexical-binding. (pattern, mailalias-done): Declare dynamic. (mail-completion-at-point-function): New function, from mail-complete. (mail-complete): Use it. (mail-completion-expand): New function. (mail-get-names): Use it. (mail-directory, mail-directory-process, mail-directory-stream): Don't use `pattern' for lexically bound arg. * lisp/mail/sendmail.el (mail-mode-map): Use completion-at-point. (mail-mode): Setup mailalias completion here instead. --- lisp/ChangeLog | 23 ++++-- lisp/mail/mailalias.el | 163 +++++++++++++++++++++++------------------ lisp/mail/sendmail.el | 4 +- 3 files changed, 111 insertions(+), 79 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index e9f6e5995e6..9f3c8e6c498 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,16 @@ 2011-04-15 Stefan Monnier + * mail/sendmail.el (mail-mode-map): Use completion-at-point. + (mail-mode): Setup mailalias completion here instead. + * mail/mailalias.el: Use lexical-binding. + (pattern, mailalias-done): Declare dynamic. + (mail-completion-at-point-function): New function, from mail-complete. + (mail-complete): Use it. + (mail-completion-expand): New function. + (mail-get-names): Use it. + (mail-directory, mail-directory-process, mail-directory-stream): + Don't use `pattern' for lexically bound arg. + * emacs-lisp/lisp-mode.el (eval-defun-2): Use eval-sexp-add-defvars. * htmlfontify.el (hfy-etags-cmd): Remove inoperant eval-and-compile. @@ -89,8 +100,8 @@ * minibuffer.el (completion-show-inline-help): New var. (completion--do-completion, minibuffer-complete) - (minibuffer-force-complete, minibuffer-complete-word): Inhibit - minibuffer messages if completion-show-inline-help is nil. + (minibuffer-force-complete, minibuffer-complete-word): + Inhibit minibuffer messages if completion-show-inline-help is nil. * icomplete.el (icomplete-mode): Bind completion-show-inline-help to avoid interference from inline help (Bug#5849). @@ -106,7 +117,7 @@ not in Image mode. (image-transform-mode, image-transform-resize) (image-transform-set-rotation): Doc fix. - (image-transform-set-resize): Deleted. + (image-transform-set-resize): Delete. (image-transform-set-scale, image-transform-fit-to-height) (image-transform-fit-to-width): Handle image-toggle-display-image and image-transform-resize directly. @@ -196,7 +207,7 @@ (package-menu--generate): Use package--push. Renamed from package--generate-package-list. (package-menu-refresh, list-packages): Use it. - (package-menu--print-info): Renamed from package-print-package. + (package-menu--print-info): Rename from package-print-package. Return insertion data instead of inserting it directly. (package-menu-describe-package, package-menu-execute): Use tabulated-list-get-id. @@ -313,8 +324,8 @@ * dired-aux.el (dired-create-files): Add docstring (Bug#7970). * textmodes/flyspell.el (flyspell-word): Recognize default - dictionary case for flyspell-mark-duplications-exceptions. Use - regexp matching for languages. + dictionary case for flyspell-mark-duplications-exceptions. + Use regexp matching for languages. (flyspell-mark-duplications-exceptions): Add "that" and "had" for default dictionary (Bug#7926). diff --git a/lisp/mail/mailalias.el b/lisp/mail/mailalias.el index fb6ee674b35..fc8a07acd47 100644 --- a/lisp/mail/mailalias.el +++ b/lisp/mail/mailalias.el @@ -1,4 +1,4 @@ -;;; mailalias.el --- expand and complete mailing address aliases +;;; mailalias.el --- expand and complete mailing address aliases -*- lexical-binding: t -*- ;; Copyright (C) 1985, 1987, 1995-1997, 2001-2011 ;; Free Software Foundation, Inc. @@ -52,20 +52,20 @@ When t this still needs to be initialized.") (defvar mail-address-field-regexp "^\\(Resent-\\)?\\(To\\|From\\|CC\\|BCC\\|Reply-to\\):") +(defvar pattern) + (defcustom mail-complete-alist - ;; Don't use backquote here; we don't want backquote to get loaded - ;; just because of loading this file. ;; Don't refer to mail-address-field-regexp here; ;; that confuses some things such as cus-dep.el. - (cons '("^\\(Resent-\\)?\\(To\\|From\\|CC\\|BCC\\|Reply-to\\):" - . (mail-get-names pattern)) - '(("Newsgroups:" . (if (boundp 'gnus-active-hashtb) - gnus-active-hashtb - (if (boundp news-group-article-assoc) - news-group-article-assoc))) - ("Followup-To:" . (mail-sentto-newsgroups)) - ;;("Distribution:" ???) - )) + '(("^\\(Resent-\\)?\\(To\\|From\\|CC\\|BCC\\|Reply-to\\):" + . (mail-get-names pattern)) + ("Newsgroups:" . (if (boundp 'gnus-active-hashtb) + gnus-active-hashtb + (if (boundp news-group-article-assoc) + news-group-article-assoc))) + ("Followup-To:" . (mail-sentto-newsgroups)) + ;;("Distribution:" ???) + ) "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. @@ -90,6 +90,8 @@ If `angles', they look like: "Function to call when completing outside `mail-complete-alist'-header." :type '(choice function (const nil)) :group 'mailalias) +(make-obsolete-variable 'mail-complete-function + 'completion-at-point-functions "24.1") (defcustom mail-directory-function nil "Function to get completions from directory service or nil for none. @@ -390,11 +392,9 @@ if it is quoted with double-quotes." mail-names t)))) ;;;###autoload -(defun mail-complete (arg) - "Perform completion on header field or word preceding point. -Completable headers are according to `mail-complete-alist'. If none matches -current header, calls `mail-complete-function' and passes prefix arg if any." - (interactive "P") +(defun mail-completion-at-point-function () + "Compute completion data for mail aliases. +For use on `completion-at-point-functions'." ;; Read the defaults first, if we have not done so. (sendmail-sync-aliases) (if (eq mail-aliases t) @@ -402,52 +402,70 @@ current header, calls `mail-complete-function' and passes prefix arg if any." (setq mail-aliases nil) (if (file-exists-p mail-personal-alias-file) (build-mail-aliases)))) - (let ((list mail-complete-alist)) + (let ((list mail-complete-alist) + (list-exp nil)) (if (and (< 0 (mail-header-end)) (save-excursion - (if (re-search-backward "^[^\t]" nil t) + (if (re-search-backward "^[^\t ]" nil t) (while list (if (looking-at (car (car list))) - (setq arg (cdr (car list)) + (setq list-exp (cdr (car list)) list ()) (setq list (cdr list))))) - arg)) + list-exp)) (let* ((end (point)) (beg (save-excursion (skip-chars-backward "^ \t<,:") (point))) - (pattern (buffer-substring beg end)) - completion) - (setq list (eval arg) - completion (try-completion pattern list)) - (cond ((eq completion t)) - ((null completion) - (message "Can't find completion for \"%s\"" pattern) - (ding)) - ((not (string= pattern completion)) - (delete-region beg end) - (let ((alist-elt (assoc completion mail-names))) - (if (cdr alist-elt) - (cond ((eq mail-complete-style 'parens) - (insert completion " (" (cdr alist-elt) ")")) - ((eq mail-complete-style 'angles) - (insert (cdr alist-elt) " <" completion ">")) - (t - (insert completion))) - (insert completion)))) - (t - (message "Making completion list...") - (with-output-to-temp-buffer "*Completions*" - (display-completion-list - (all-completions pattern list))) - (message "Making completion list...%s" "done")))) - (funcall mail-complete-function arg)))) + (table (completion-table-dynamic + (lambda (prefix) + (let ((pattern prefix)) (eval list-exp)))))) + (list beg end table))))) -(defun mail-get-names (pattern) +;;;###autoload +(defun mail-complete (arg) + "Perform completion on header field or word preceding point. +Completable headers are according to `mail-complete-alist'. If none matches +current header, calls `mail-complete-function' and passes prefix ARG if any." + (interactive "P") + ;; Read the defaults first, if we have not done so. + (sendmail-sync-aliases) + (if (eq mail-aliases t) + (progn + (setq mail-aliases nil) + (if (file-exists-p mail-personal-alias-file) + (build-mail-aliases)))) + (let ((data (mail-completion-at-point-function))) + (if data + (apply #'completion-in-region data) + (funcall mail-complete-function arg)))) +(make-obsolete 'mail-complete 'mail-completion-at-point-function "24.1") + +(defun mail-completion-expand (table) + "Build new completion table that expands aliases. +Completes like TABLE except that if the completion is a valid alias, +it expands it to its full `mail-complete-style' form." + (lambda (string pred action) + (cond + ((eq action nil) + (let* ((comp (try-completion string table pred)) + (name (and (listp table) comp + (assoc (if (stringp comp) comp string) table)))) + (cond + ((null name) comp) + ((eq mail-complete-style 'parens) + (concat (car name) " (" (cdr name) ")")) + ((eq mail-complete-style 'angles) + (concat (cdr name) " <" (car name) ">")) + (t comp)))) + (t + (complete-with-action action table string pred))))) + +(defun mail-get-names (prefix) "Fetch local users and global mail addresses for completion. Consults `/etc/passwd' and a directory service if one is set up via `mail-directory-function'. -PATTERN is the string we want to complete." +PREFIX is the string we want to complete." (if (eq mail-local-names t) (with-current-buffer (generate-new-buffer " passwd") (let ((files mail-passwd-files)) @@ -480,7 +498,7 @@ PATTERN is the string we want to complete." (and mail-directory-function (eq mail-directory-names t) (setq directory - (mail-directory (if mail-directory-requery pattern)))) + (mail-directory (if mail-directory-requery prefix)))) (or mail-directory-requery (setq mail-directory-names directory)) (if (or directory @@ -496,58 +514,59 @@ PATTERN is the string we want to complete." (when (consp mail-directory-names) mail-directory-names))) (lambda (a b) - ;; should cache downcased strings + ;; Should cache downcased strings. (string< (downcase (car a)) (downcase (car b))))))))) - mail-names) + (mail-completion-expand mail-names)) -(defun mail-directory (pattern) - "Use mail-directory facility to get user names matching PATTERN. -If PATTERN is nil, get all the defined user names. +(defun mail-directory (prefix) + "Use mail-directory facility to get user names matching PREFIX. +If PREFIX 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." (message "Querying directory...") (with-current-buffer (generate-new-buffer " *mail-directory*") - (funcall mail-directory-function pattern) + (funcall mail-directory-function prefix) (goto-char (point-min)) (let (directory) (if (stringp mail-directory-parser) (while (re-search-forward mail-directory-parser nil t) - (setq directory - (cons (match-string 1) directory))) + (push (match-string 1) directory)) (if mail-directory-parser (setq directory (funcall mail-directory-parser)) (while (not (eobp)) - (setq directory - (cons (buffer-substring (point) - (progn - (forward-line) - (if (bolp) - (1- (point)) - (point)))) - directory))))) + (push (buffer-substring (point) + (progn + (forward-line) + (if (bolp) + (1- (point)) + (point)))) + directory)))) (kill-buffer (current-buffer)) (message "Querying directory...done") directory))) +(defvar mailalias-done) -(defun mail-directory-process (pattern) +(defun mail-directory-process (prefix) "Run a shell command to output names in directory. See `mail-directory-process'." (when (consp mail-directory-process) - (apply 'call-process (eval (car mail-directory-process)) nil t nil - (mapcar 'eval (cdr mail-directory-process))))) + (let ((pattern prefix)) ;Dynbind! + (apply 'call-process (eval (car mail-directory-process)) nil t nil + (mapcar 'eval (cdr mail-directory-process)))))) ;; This should handle a dialog. Currently expects port to spit out names. -(defun mail-directory-stream (pattern) +(defun mail-directory-stream (prefix) "Open a stream to retrieve names in directory. See `mail-directory-stream'." - (let (mailalias-done) + (let ((mailalias-done nil) + (pattern prefix)) ;Dynbind! (set-process-sentinel (apply 'open-network-stream "mailalias" (current-buffer) mail-directory-stream) - (lambda (x y) + (lambda (_x _y) (setq mailalias-done t))) (while (not mailalias-done) (sit-for .1)))) diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el index 0548f24b1dd..3b5ba2e029e 100644 --- a/lisp/mail/sendmail.el +++ b/lisp/mail/sendmail.el @@ -293,7 +293,7 @@ The default value matches citations like `foo-bar>' plus whitespace." (defvar mail-abbrevs-loaded nil) (defvar mail-mode-map (let ((map (make-sparse-keymap))) - (define-key map "\M-\t" 'mail-complete) + (define-key map "\M-\t" 'completion-at-point) (define-key map "\C-c?" 'describe-mode) (define-key map "\C-c\C-f\C-t" 'mail-to) (define-key map "\C-c\C-f\C-b" 'mail-bcc) @@ -688,6 +688,8 @@ Turning on Mail mode runs the normal hooks `text-mode-hook' and (setq adaptive-fill-first-line-regexp (concat "[ \t]*[-[:alnum:]]*>+[ \t]*\\|" adaptive-fill-first-line-regexp)) + (add-hook 'completion-at-point-functions #'mail-completion-at-point-function + nil 'local) ;; `-- ' precedes the signature. `-----' appears at the start of the ;; lines that delimit forwarded messages. ;; Lines containing just >= 3 dashes, perhaps after whitespace, -- 2.39.2