/[emacs]/emacs/lisp/mh-e/mh-alias.el
ViewVC logotype

Diff of /emacs/lisp/mh-e/mh-alias.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.3.4.3 by miles, Sat Jul 17 02:51:48 2004 UTC revision 1.3.4.4 by miles, Sat Sep 4 09:22:56 2004 UTC
# Line 27  Line 27 
27    
28  ;;; Commentary:  ;;; Commentary:
29    
 ;;  [To be deleted when documented in MH-E manual.]  
 ;;  
 ;;  This module provides mail alias completion when entering addresses.  
 ;;  
 ;;  Use the TAB key to complete aliases (and optionally local usernames) when  
 ;;  initially composing a message in the To: and Cc: minibuffer prompts. You  
 ;;  may enter multiple addressees separated with a comma (but do *not* add any  
 ;;  space after the comma).  
 ;;  
 ;;  In the header of a message draft, use "M-TAB (mh-letter-complete)" to  
 ;;  complete aliases. This is useful when you want to add an addressee as an  
 ;;  afterthought when creating a message, or when adding an additional  
 ;;  addressee to a reply.  
 ;;  
 ;;  By default, completion is case-insensitive. This can be changed by  
 ;;  customizing the variable `mh-alias-completion-ignore-case-flag'. This is  
 ;;  useful, for example, to differentiate between people aliases in lowercase  
 ;;  such as:  
 ;;  
 ;;    p.galbraith: Peter Galbraith <GalbraithP@dfo-mpo.gc.ca>  
 ;;  
 ;;  and lists in uppercase such as:  
 ;;  
 ;;    MH-E: MH-E mailing list <mh-e-devel@lists.sourceforge.net>  
 ;;  
 ;;  Note that this variable affects minibuffer completion only. If you have an  
 ;;  alias for P.Galbraith and type in p.galbraith at the prompt, it will still  
 ;;  be expanded in the letter buffer because MH is case-insensitive.  
 ;;  
 ;;  When you press ", (mh-alias-minibuffer-confirm-address)" after an alias in  
 ;;  the minibuffer, the expansion for the previous mail alias appears briefly.  
 ;;  To inhibit this, customize the variable `mh-alias-flash-on-comma'.  
 ;;  
 ;;  The addresses and aliases entered in the minibuffer are added to the  
 ;;  message draft. To expand the aliases before they are added to the draft,  
 ;;  customize the variable `mh-alias-expand-aliases-flag'.  
 ;;  
 ;;  Completion is also performed on usernames extracted from the /etc/passwd  
 ;;  file. This can be a handy tool on a machine where you and co-workers  
 ;;  exchange messages, but should probably be disabled on a system with  
 ;;  thousands of users you don't know. This is done by customizing the  
 ;;  variable `mh-alias-local-users'. This variable also takes a string which  
 ;;  is executed to generate the password file. For example, you'd use "ypcat  
 ;;  passwd" for NIS.  
 ;;  
 ;;  Aliases are loaded the first time you send mail and get the "To:" prompt  
 ;;  and whenever a source of aliases changes. Sources of system aliases are  
 ;;  defined in the customization variable `mh-alias-system-aliases' and  
 ;;  include:  
 ;;  
 ;;    /etc/nmh/MailAliases  
 ;;    /usr/lib/mh/MailAliases  
 ;;    /etc/passwd  
 ;;  
 ;;  Sources of personal aliases are read from the files listed in your MH  
 ;;  profile component Aliasfile. Multiple files are separated by white space  
 ;;  and are relative to your mail directory.  
 ;;  
 ;;  Alias Insertions  
 ;;  ~~~~~~~~~~~~~~~~  
 ;;  There are commands to insert new aliases into your alias file(s) (defined  
 ;;  by the `Aliasfile' component in the .mh_profile file or by the variable  
 ;;  `mh-alias-insert-file').  In particular, there is a tool-bar icon to grab  
 ;;  an alias from the From line of the current message.  
   
30  ;;; Change Log:  ;;; Change Log:
31    
32  ;;; Code:  ;;; Code:
33    
34    (eval-when-compile (require 'mh-acros))
35    (mh-require-cl)
36  (require 'mh-e)  (require 'mh-e)
37  (load "cmr" t t)                        ; Non-fatal dependency for  (load "cmr" t t)                        ; Non-fatal dependency for
38                                          ; completing-read-multiple.                                          ; completing-read-multiple.
# Line 116  Line 53 
53  (defvar mh-alias-tstamp nil  (defvar mh-alias-tstamp nil
54    "Time aliases were last loaded.")    "Time aliases were last loaded.")
55  (defvar mh-alias-read-address-map nil)  (defvar mh-alias-read-address-map nil)
56  (if mh-alias-read-address-map  (unless mh-alias-read-address-map
     ()  
57    (setq mh-alias-read-address-map    (setq mh-alias-read-address-map
58          (copy-keymap minibuffer-local-completion-map))          (copy-keymap minibuffer-local-completion-map))
59    (if mh-alias-flash-on-comma    (define-key mh-alias-read-address-map
60        (define-key mh-alias-read-address-map      "," 'mh-alias-minibuffer-confirm-address)
         "," 'mh-alias-minibuffer-confirm-address))  
61    (define-key mh-alias-read-address-map " " 'self-insert-command))    (define-key mh-alias-read-address-map " " 'self-insert-command))
62    
63    (defvar mh-alias-system-aliases
64      '("/etc/nmh/MailAliases" "/etc/mh/MailAliases"
65        "/usr/lib/mh/MailAliases" "/usr/share/mailutils/mh/MailAliases"
66        "/etc/passwd")
67      "*A list of system files which are a source of aliases.
68    If these files are modified, they are automatically reread. This list need
69    include only system aliases and the passwd file, since personal alias files
70    listed in your `Aliasfile:' MH profile component are automatically included.
71    You can update the alias list manually using \\[mh-alias-reload].")
72    
73    
74  ;;; Alias Loading  ;;; Alias Loading
75    
# Line 138  This is a wrapper around `assoc-string' Line 83  This is a wrapper around `assoc-string'
83    
84  (defun mh-alias-tstamp (arg)  (defun mh-alias-tstamp (arg)
85    "Check whether alias files have been modified.    "Check whether alias files have been modified.
86  Return t if any file listed in the MH profile component Aliasfile has been  Return t if any file listed in the Aliasfile MH profile component has been
87  modified since the timestamp.  modified since the timestamp.
88  If ARG is non-nil, set timestamp with the current time."  If ARG is non-nil, set timestamp with the current time."
89    (if arg    (if arg
# Line 157  If ARG is non-nil, set timestamp with th Line 102  If ARG is non-nil, set timestamp with th
102    
103  (defun mh-alias-filenames (arg)  (defun mh-alias-filenames (arg)
104    "Return list of filenames that contain aliases.    "Return list of filenames that contain aliases.
105  The filenames come from the MH profile component Aliasfile and are expanded.  The filenames come from the Aliasfile profile component and are expanded.
106  If ARG is non-nil, filenames listed in `mh-alias-system-aliases' are appended."  If ARG is non-nil, filenames listed in `mh-alias-system-aliases' are appended."
107    (or mh-progs (mh-find-path))    (or mh-progs (mh-find-path))
108    (save-excursion    (save-excursion
# Line 201  non-nil." Line 146  non-nil."
146      res))      res))
147    
148  (defun mh-alias-local-users ()  (defun mh-alias-local-users ()
149    "Return an alist of local users from /etc/passwd."    "Return an alist of local users from /etc/passwd.
150    Exclude all aliases already in `mh-alias-alist' from `ali'"
151    (let (passwd-alist)    (let (passwd-alist)
152      (save-excursion      (save-excursion
153        (set-buffer (get-buffer-create mh-temp-buffer))        (set-buffer (get-buffer-create mh-temp-buffer))
# Line 222  non-nil." Line 168  non-nil."
168                     (gecos-name (match-string 3))                     (gecos-name (match-string 3))
169                     (realname (mh-alias-gecos-name                     (realname (mh-alias-gecos-name
170                                gecos-name username                                gecos-name username
171                                mh-alias-passwd-gecos-comma-separator-flag)))                                mh-alias-passwd-gecos-comma-separator-flag))
172                (setq passwd-alist                     (alias-name (if mh-alias-local-users-prefix
173                      (cons                                    (concat mh-alias-local-users-prefix
174                       (list (if mh-alias-local-users-prefix                                            (mh-alias-suggest-alias realname t))
175                                 (concat mh-alias-local-users-prefix                                  username))
176                                         (mh-alias-suggest-alias realname t))                     (alias-translation
177                               username)                      (if (string-equal username realname)
178                             (if (string-equal username realname)                          (concat "<" username ">")
179                                 (concat "<" username ">")                        (concat realname " <" username ">"))))
180                               (concat realname " <" username ">")))                (when (not (mh-assoc-ignore-case alias-name mh-alias-alist))
181                       passwd-alist))))))                  (setq passwd-alist (cons (list alias-name alias-translation)
182                                             passwd-alist)))))))
183          (forward-line 1)))          (forward-line 1)))
184      passwd-alist))      passwd-alist))
185    
186  ;;;###mh-autoload  ;;;###mh-autoload
187  (defun mh-alias-reload ()  (defun mh-alias-reload ()
188    "Load MH aliases into `mh-alias-alist'."    "Reload MH aliases.
189    
190    Since aliases are updated frequently, MH-E will reload aliases automatically
191    whenever an alias lookup occurs if an alias source (a file listed in your
192    `Aliasfile:' profile component and your password file if variable
193    `mh-alias-local-users' is non-nil) has changed. However, you can reload your
194    aliases manually by calling this command directly.
195    
196    The value of `mh-alias-reloaded-hook' is a list of functions to be called,
197    with no arguments, after the aliases have been loaded."
198    (interactive)    (interactive)
199    (save-excursion    (save-excursion
200      (message "Loading MH aliases...")      (message "Loading MH aliases...")
# Line 269  non-nil." Line 225  non-nil."
225          (if (not (mh-assoc-ignore-case (car user) mh-alias-alist))          (if (not (mh-assoc-ignore-case (car user) mh-alias-alist))
226              (setq mh-alias-alist (append mh-alias-alist (list user))))              (setq mh-alias-alist (append mh-alias-alist (list user))))
227          (setq local-users (cdr local-users)))))          (setq local-users (cdr local-users)))))
228      (run-hooks 'mh-alias-reloaded-hook)
229    (message "Loading MH aliases...done"))    (message "Loading MH aliases...done"))
230    
231  ;;;###mh-autoload  ;;;###mh-autoload
232  (defun mh-alias-reload-maybe ()  (defun mh-alias-reload-maybe ()
233    "Load new MH aliases."    "Load new MH aliases."
234    (if (or (eq mh-alias-alist 'not-read) ; Doesn't exist, so create it.    (if (or (eq mh-alias-alist 'not-read) ; Doesn't exist?
235            (mh-alias-tstamp nil))        ; Out of date, so recreate it.            (mh-alias-tstamp nil))        ; Out of date?
236        (mh-alias-reload)))        (mh-alias-reload)))
237    
238    
# Line 461  is converted to lower case." Line 418  is converted to lower case."
418        found)))        found)))
419    
420  (defun mh-alias-insert-file (&optional alias)  (defun mh-alias-insert-file (&optional alias)
421    "Return the alias file to write a new entry for ALIAS in.    "Return filename which should be used to add ALIAS.
422  Use variable `mh-alias-insert-file' if non-nil, else use AliasFile component  The value of the option `mh-alias-insert-file' is used if non-nil\; otherwise
423  value.  the value of the `Aliasfile:' profile component is used.
424  If ALIAS is specified and it already exists, try to return the file that  If the alias already exists, try to return the name of the file that contains
425  contains it."  it."
426    (cond    (cond
427     ((and mh-alias-insert-file (listp mh-alias-insert-file))     ((and mh-alias-insert-file (listp mh-alias-insert-file))
428      (if (not (elt mh-alias-insert-file 1))        ; Only one entry, use it      (if (not (elt mh-alias-insert-file 1))        ; Only one entry, use it
429          (car mh-alias-insert-file)          (car mh-alias-insert-file)
430        (if (or (not alias)        (if (or (not alias)
431                (string-equal alias (mh-alias-ali alias))) ;alias doesn't exist                (string-equal alias (mh-alias-ali alias))) ;alias doesn't exist
432            (completing-read "Alias file [press Tab]: "            (completing-read "Alias file: "
433                             (mapcar 'list mh-alias-insert-file) nil t)                             (mapcar 'list mh-alias-insert-file) nil t)
434          (or (mh-alias-which-file-has-alias alias mh-alias-insert-file)          (or (mh-alias-which-file-has-alias alias mh-alias-insert-file)
435              (completing-read "Alias file [press Tab]: "              (completing-read "Alias file: "
436                               (mapcar 'list mh-alias-insert-file) nil t)))))                               (mapcar 'list mh-alias-insert-file) nil t)))))
437     ((and mh-alias-insert-file (stringp mh-alias-insert-file))     ((and mh-alias-insert-file (stringp mh-alias-insert-file))
438      mh-alias-insert-file)      mh-alias-insert-file)
# Line 490  contains it." Line 447  contains it."
447        (cond        (cond
448         ((not autolist)         ((not autolist)
449          (error "No writable alias file.          (error "No writable alias file.
450  Set `mh-alias-insert-file' or set AliasFile in your .mh_profile file"))  Set `mh-alias-insert-file' or the Aliasfile profile component"))
451         ((not (elt autolist 1))        ; Only one entry, use it         ((not (elt autolist 1))        ; Only one entry, use it
452          (car autolist))          (car autolist))
453         ((or (not alias)         ((or (not alias)
454              (string-equal alias (mh-alias-ali alias))) ;alias doesn't exist              (string-equal alias (mh-alias-ali alias))) ;alias doesn't exist
455          (completing-read "Alias file [press Tab]: "          (completing-read "Alias file: " (mapcar 'list autolist) nil t))
                          (mapcar 'list autolist) nil t))  
456         (t         (t
457          (or (mh-alias-which-file-has-alias alias autolist)          (or (mh-alias-which-file-has-alias alias autolist)
458              (completing-read "Alias file [press Tab]: "              (completing-read "Alias file: "
459                               (mapcar 'list autolist) nil t))))))))                               (mapcar 'list autolist) nil t))))))))
460    
461  ;;;###mh-autoload  ;;;###mh-autoload
# Line 520  Set `mh-alias-insert-file' or set AliasF Line 476  Set `mh-alias-insert-file' or set AliasF
476                        (split-string aliases ", +")))))))                        (split-string aliases ", +")))))))
477    
478  ;;;###mh-autoload  ;;;###mh-autoload
479  (defun mh-alias-from-has-no-alias-p ()  (defun mh-alias-for-from-p ()
480    "Return t is From has no current alias set.    "Return t if sender's address has a corresponding alias."
 In the exceptional situation where there isn't a From header in the message the  
 function returns nil."  
481    (mh-alias-reload-maybe)    (mh-alias-reload-maybe)
482    (save-excursion    (save-excursion
483      (if (not (mh-folder-line-matches-show-buffer-p))      (if (not (mh-folder-line-matches-show-buffer-p))
# Line 532  function returns nil." Line 486  function returns nil."
486            (set-buffer mh-show-buffer))            (set-buffer mh-show-buffer))
487        (let ((from-header (mh-extract-from-header-value)))        (let ((from-header (mh-extract-from-header-value)))
488          (and from-header          (and from-header
489               (not (mh-alias-address-to-alias from-header)))))))               (mh-alias-address-to-alias from-header))))))
490    
491  (defun mh-alias-add-alias-to-file (alias address &optional file)  (defun mh-alias-add-alias-to-file (alias address &optional file)
492    "Add ALIAS for ADDRESS in alias FILE without alias check or prompts.    "Add ALIAS for ADDRESS in alias FILE without alias check or prompts.
493  Prompt for alias file if not provided and there is more than one candidate.  Prompt for alias file if not provided and there is more than one candidate.
494  If ALIAS matches exactly, prompt to [i]nsert before old value or [a]ppend  
495  after it."  If the alias exists already, you will have the choice of inserting the new
496    alias before or after the old alias. In the former case, this alias will be
497    used when sending mail to this alias. In the latter case, the alias serves as
498    an additional folder name hint when filing messages."
499    (if (not file)    (if (not file)
500        (setq file (mh-alias-insert-file alias)))        (setq file (mh-alias-insert-file alias)))
501    (save-excursion    (save-excursion
# Line 552  after it." Line 509  after it."
509         ((re-search-forward         ((re-search-forward
510           (concat "^" (regexp-quote alias-search) " *\\(.*\\)") nil t)           (concat "^" (regexp-quote alias-search) " *\\(.*\\)") nil t)
511          (let ((answer (read-string          (let ((answer (read-string
512                         (format "Exists for %s; [i]nsert, [a]ppend: "                         (format (concat "Alias %s exists; insert new address "
513                                           "[b]efore or [a]fter: ")
514                                 (match-string 1))))                                 (match-string 1))))
515                (case-fold-search t))                (case-fold-search t))
516            (cond ((string-match "^i" answer))            (cond ((string-match "^b" answer))
517                  ((string-match "^a" answer)                  ((string-match "^a" answer)
518                   (forward-line 1))                   (forward-line 1))
519                  (t                  (t
520                   (error "Quitting")))))                   (error "Unrecognized response")))))
521         ;; No, so sort-in at the right place         ;; No, so sort-in at the right place
522         ;; search for "^alias", then "^alia", etc.         ;; search for "^alias", then "^alia", etc.
523         ((eq mh-alias-insertion-location 'sorted)         ((eq mh-alias-insertion-location 'sorted)
# Line 587  after it." Line 545  after it."
545  ;;;###mh-autoload  ;;;###mh-autoload
546  (defun mh-alias-add-alias (alias address)  (defun mh-alias-add-alias (alias address)
547    "*Add ALIAS for ADDRESS in personal alias file.    "*Add ALIAS for ADDRESS in personal alias file.
548  Prompts for confirmation if the address already has an alias.  This function prompts you for an alias and address. If the alias exists
549  If the alias is already is use, `mh-alias-add-alias-to-file' will prompt."  already, you will have the choice of inserting the new alias before or after
550    the old alias. In the former case, this alias will be used when sending mail
551    to this alias. In the latter case, the alias serves as an additional folder
552    name hint when filing messages."
553    (interactive "P\nP")    (interactive "P\nP")
554    (mh-alias-reload-maybe)    (mh-alias-reload-maybe)
555    (setq alias (completing-read "Alias: " mh-alias-alist nil nil alias))    (setq alias (completing-read "Alias: " mh-alias-alist nil nil alias))
# Line 614  If the alias is already is use, `mh-alia Line 575  If the alias is already is use, `mh-alia
575    
576  ;;;###mh-autoload  ;;;###mh-autoload
577  (defun mh-alias-grab-from-field ()  (defun mh-alias-grab-from-field ()
578    "*Add ALIAS for ADDRESS in personal alias file.    "*Add alias for the sender of the current message."
 Prompts for confirmation if the alias is already in use or if the address  
 already has an alias."  
579    (interactive)    (interactive)
580    (mh-alias-reload-maybe)    (mh-alias-reload-maybe)
581    (save-excursion    (save-excursion
# Line 636  already has an alias." Line 595  already has an alias."
595    
596  ;;;###mh-autoload  ;;;###mh-autoload
597  (defun mh-alias-add-address-under-point ()  (defun mh-alias-add-address-under-point ()
598    "Insert an alias for email address under point."    "Insert an alias for address under point."
599    (interactive)    (interactive)
600    (let ((address (mh-goto-address-find-address-at-point)))    (let ((address (mh-goto-address-find-address-at-point)))
601      (if address      (if address
602          (mh-alias-add-alias nil address)          (mh-alias-add-alias nil address)
603        (message "No email address found under point."))))        (message "No email address found under point"))))
604    
605  ;;;###mh-autoload  ;;;###mh-autoload
606  (defun mh-alias-apropos (regexp)  (defun mh-alias-apropos (regexp)
607    "Show all aliases that match REGEXP either in name or content."    "Show all aliases or addresses that match REGEXP."
608    (interactive "sAlias regexp: ")    (interactive "sAlias regexp: ")
609    (if mh-alias-local-users    (if mh-alias-local-users
610        (mh-alias-reload-maybe))        (mh-alias-reload-maybe))
611    (let ((matches "")(group-matches "")(passwd-matches))    (let ((matches "")
612            (group-matches "")
613            (passwd-matches))
614      (save-excursion      (save-excursion
615        (message "Reading MH aliases...")        (message "Reading MH aliases...")
616        (mh-exec-cmd-quiet t "ali" "-nolist" "-nouser")        (mh-exec-cmd-quiet t "ali" "-nolist" "-nouser")
617        (message "Reading MH aliases...done.  Parsing...")        (message "Parsing MH aliases...")
618        (while (re-search-forward regexp nil t)        (while (re-search-forward regexp nil t)
619          (beginning-of-line)          (beginning-of-line)
620          (cond          (cond
# Line 673  already has an alias." Line 634  already has an alias."
634                  (concat matches                  (concat matches
635                          (buffer-substring (point)(progn (end-of-line)(point)))                          (buffer-substring (point)(progn (end-of-line)(point)))
636                          "\n")))))                          "\n")))))
637        (message "Reading MH aliases...done.  Parsing...done.")        (message "Parsing MH aliases...done")
638        (when mh-alias-local-users        (when mh-alias-local-users
639          (message          (message "Making passwd aliases...")
          "Reading MH aliases...done.  Parsing...done.  Passwd aliases...")  
640          (setq passwd-matches          (setq passwd-matches
641                (mapconcat                (mapconcat
642                 '(lambda (elem)                 '(lambda (elem)
# Line 684  already has an alias." Line 644  already has an alias."
644                            (string-match regexp (cadr elem)))                            (string-match regexp (cadr elem)))
645                        (format "%s: %s\n" (car elem) (cadr elem))))                        (format "%s: %s\n" (car elem) (cadr elem))))
646                 mh-alias-passwd-alist ""))                 mh-alias-passwd-alist ""))
647          (message          (message "Making passwd aliases...done")))
          "Reading MH aliases...done.  Parsing...done.  Passwd aliases...done.")))  
648      (if (and (string-equal "" matches)      (if (and (string-equal "" matches)
649               (string-equal "" group-matches)               (string-equal "" group-matches)
650               (string-equal "" passwd-matches))               (string-equal "" passwd-matches))
651          (message "No matches")          (message "No matches")
652        (with-output-to-temp-buffer "*Help*"        (with-output-to-temp-buffer mh-aliases-buffer
653          (if (not (string-equal "" matches))          (if (not (string-equal "" matches))
654              (princ matches))              (princ matches))
655          (when (not (string-equal group-matches ""))          (when (not (string-equal group-matches ""))

Legend:
Removed from v.1.3.4.3  
changed lines
  Added in v.1.3.4.4

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26