/[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 by lektu, Tue Feb 4 13:15:32 2003 UTC revision 1.4 by wohler, Fri Apr 25 05:52:00 2003 UTC
# Line 1  Line 1 
1  ;;; mh-alias.el --- MH-E mail alias completion and expansion  ;;; mh-alias.el --- MH-E mail alias completion and expansion
2  ;;  ;;
3  ;; Copyright (C) 1994, 1995, 1996, 1997, 2001, 2002 Free Software Foundation, Inc.  ;; Copyright (C) 1994, 95, 96, 1997,
4    ;;  2001, 02, 2003 Free Software Foundation, Inc.
5    
6  ;; Author: Peter S. Galbraith <psg@debian.org>  ;; Author: Peter S. Galbraith <psg@debian.org>
7  ;; Maintainer: Bill Wohler <wohler@newt.com>  ;; Maintainer: Bill Wohler <wohler@newt.com>
# Line 93  Line 94 
94    
95  ;;; Change Log:  ;;; Change Log:
96    
 ;; $Id$  
   
97  ;;; Code:  ;;; Code:
98    
99  (require 'mh-e)  (require 'mh-e)
# Line 103  Line 102 
102  (eval-when-compile (defvar mail-abbrev-syntax-table))  (eval-when-compile (defvar mail-abbrev-syntax-table))
103    
104  ;;; Autoloads  ;;; Autoloads
105  (autoload 'mail-abbrev-complete-alias "mailabbrev")  (eval-when (compile load eval)
106  (autoload 'multi-prompt "multi-prompt")    (ignore-errors
107        (require 'mailabbrev)
108        (require 'multi-prompt)))
109    
110  (defvar mh-alias-alist nil  (defvar mh-alias-alist 'not-read
111    "Alist of MH aliases.")    "Alist of MH aliases.")
112  (defvar mh-alias-blind-alist nil  (defvar mh-alias-blind-alist nil
113    "Alist of MH aliases that are blind lists.")    "Alist of MH aliases that are blind lists.")
# Line 180  If ARG is non-nil, filenames listed in ` Line 181  If ARG is non-nil, filenames listed in `
181              (insert-file-contents "/etc/passwd")))              (insert-file-contents "/etc/passwd")))
182         ((stringp mh-alias-local-users)         ((stringp mh-alias-local-users)
183          (insert mh-alias-local-users "\n")          (insert mh-alias-local-users "\n")
184          (shell-command-on-region (point-min)(point-max) mh-alias-local-users t)          (shell-command-on-region (point-min) (point-max) mh-alias-local-users t)
185          (goto-char (point-min))))          (goto-char (point-min))))
186        (while  (< (point) (point-max))        (while  (< (point) (point-max))
187          (cond          (cond
# Line 241  If ARG is non-nil, filenames listed in ` Line 242  If ARG is non-nil, filenames listed in `
242    
243  (defun mh-alias-reload-maybe ()  (defun mh-alias-reload-maybe ()
244    "Load new MH aliases."    "Load new MH aliases."
245    (if (or (not mh-alias-alist)          ; Doesn't exist, so create it.    (if (or (eq mh-alias-alist 'not-read) ; Doesn't exist, so create it.
246            (mh-alias-tstamp nil))        ; Out of date, so recreate it.            (mh-alias-tstamp nil))        ; Out of date, so recreate it.
247        (mh-alias-reload)))        (mh-alias-reload)))
248    
# Line 253  If ARG is non-nil, filenames listed in ` Line 254  If ARG is non-nil, filenames listed in `
254  ALIAS must be a string for a single alias.  ALIAS must be a string for a single alias.
255  If USER is t, then assume ALIAS is an address and call ali -user.  If USER is t, then assume ALIAS is an address and call ali -user.
256  ali returns the string unchanged if not defined.  The same is done here."  ali returns the string unchanged if not defined.  The same is done here."
257    (save-excursion    (condition-case err
258      (let ((user-arg (if user "-user" "-nouser")))        (save-excursion
259        (mh-exec-cmd-quiet t "ali" user-arg "-nolist" alias))          (let ((user-arg (if user "-user" "-nouser")))
260      (goto-char (point-max))            (mh-exec-cmd-quiet t "ali" user-arg "-nolist" alias))
261      (if (looking-at "^$") (delete-backward-char 1))          (goto-char (point-max))
262      (buffer-substring (point-min)(point-max))))          (if (looking-at "^$") (delete-backward-char 1))
263            (buffer-substring (point-min)(point-max)))
264        (error (progn
265                 (message (error-message-string err))
266                 alias))))
267    
268  (defun mh-alias-expand (alias)  (defun mh-alias-expand (alias)
269    "Return expansion for ALIAS.    "Return expansion for ALIAS.
# Line 280  Blind aliases or users from /etc/passwd Line 285  Blind aliases or users from /etc/passwd
285      (let* ((minibuffer-local-completion-map mh-alias-read-address-map)      (let* ((minibuffer-local-completion-map mh-alias-read-address-map)
286             (completion-ignore-case mh-alias-completion-ignore-case-flag)             (completion-ignore-case mh-alias-completion-ignore-case-flag)
287             (the-answer             (the-answer
288              (or (cond              (cond ((fboundp 'completing-read-multiple)
289                   ((fboundp 'completing-read-multiple)                     (mh-funcall-if-exists
290                    (completing-read-multiple prompt mh-alias-alist nil nil))                      completing-read-multiple prompt mh-alias-alist nil nil))
291                   ((featurep 'multi-prompt)                    ((featurep 'multi-prompt)
292                    (multi-prompt "," nil prompt mh-alias-alist nil nil))                     (mh-funcall-if-exists
293                   (t                      multi-prompt "," nil prompt mh-alias-alist nil nil))
294                    (split-string                    (t (split-string
295                     (completing-read prompt mh-alias-alist nil nil)                        (completing-read prompt mh-alias-alist nil nil) ",")))))
                    ","))))))  
296        (if (not mh-alias-expand-aliases-flag)        (if (not mh-alias-expand-aliases-flag)
297            (mapconcat 'identity the-answer ", ")            (mapconcat 'identity the-answer ", ")
298          ;; Loop over all elements, checking if in passwd aliast or blind first          ;; Loop over all elements, checking if in passwd aliast or blind first
# Line 325  Blind aliases or users from /etc/passwd Line 329  Blind aliases or users from /etc/passwd
329                (message "No alias for %s" the-name))))))                (message "No alias for %s" the-name))))))
330    (self-insert-command 1))    (self-insert-command 1))
331    
332    (mh-do-in-xemacs (defvar mail-abbrevs))
333    
334  ;;;###mh-autoload  ;;;###mh-autoload
335  (defun mh-alias-letter-expand-alias ()  (defun mh-alias-letter-expand-alias ()
336    "Expand mail alias before point."    "Expand mail alias before point."
337    (mh-alias-reload-maybe)    (mh-alias-reload-maybe)
338    (let ((mail-abbrevs mh-alias-alist))    (let ((mail-abbrevs mh-alias-alist))
339      (mail-abbrev-complete-alias))      (mh-funcall-if-exists mail-abbrev-complete-alias))
340    (when mh-alias-expand-aliases-flag    (when mh-alias-expand-aliases-flag
341      (let* ((end (point))      (let* ((end (point))
342             (syntax-table (syntax-table))             (syntax-table (syntax-table))
# Line 350  Blind aliases or users from /etc/passwd Line 356  Blind aliases or users from /etc/passwd
356  (defun mh-alias-suggest-alias (string)  (defun mh-alias-suggest-alias (string)
357    "Suggest an alias for STRING."    "Suggest an alias for STRING."
358    (cond    (cond
359       ((string-match "^<\\(.*\\)>$" string)
360        ;; <somename@foo.bar>  -> recurse, stripping brackets.
361        (mh-alias-suggest-alias (match-string 1 string)))
362     ((string-match "^\\sw+$" string)     ((string-match "^\\sw+$" string)
363      ;; One word -> downcase it.      ;; One word -> downcase it.
364      (downcase string))      (downcase string))
# Line 389  Blind aliases or users from /etc/passwd Line 398  Blind aliases or users from /etc/passwd
398       (format "%s %s" (match-string 2 string) (match-string 1 string))))       (format "%s %s" (match-string 2 string) (match-string 1 string))))
399     (t     (t
400      ;; Output string, with spaces replaced by dots.      ;; Output string, with spaces replaced by dots.
401      (downcase (replace-regexp-in-string      (mh-alias-canonicalize-suggestion string))))
402                 "\\.\\.+" "."  
403                 (replace-regexp-in-string " +" "." string))))))  (defun mh-alias-canonicalize-suggestion (string)
404      "Process STRING to replace spacess by periods.
405    First all spaces are replaced by periods. Then every run of consecutive periods
406    are replaced with a single period. Finally the string is converted to lower
407    case."
408      (with-temp-buffer
409        (insert string)
410        ;; Replace spaces with periods
411        (goto-char (point-min))
412        (replace-regexp " +" ".")
413        ;; Replace consecutive periods with a single period
414        (goto-char (point-min))
415        (replace-regexp "\\.\\.+" ".")
416        ;; Convert to lower case
417        (downcase-region (point-min) (point-max))
418        ;; Whew! all done...
419        (buffer-string)))
420    
421  (defun mh-alias-which-file-has-alias (alias file-list)  (defun mh-alias-which-file-has-alias (alias file-list)
422    "Return the name of writable file which defines ALIAS from list FILE-LIST."    "Return the name of writable file which defines ALIAS from list FILE-LIST."
# Line 403  Blind aliases or users from /etc/passwd Line 428  Blind aliases or users from /etc/passwd
428          (erase-buffer)          (erase-buffer)
429          (when (file-writable-p (car file-list))          (when (file-writable-p (car file-list))
430            (insert-file-contents (car file-list))            (insert-file-contents (car file-list))
431            (if (re-search-forward (concat "^" (regexp-quote alias) ":"))            (if (re-search-forward (concat "^" (regexp-quote alias) ":") nil t)
432                (setq found (car file-list)                (setq found (car file-list)
433                      the-list nil)                      the-list nil)
434              (setq the-list (cdr the-list)))))              (setq the-list (cdr the-list)))))
# Line 470  Set `mh-alias-insert-file' or set AliasF Line 495  Set `mh-alias-insert-file' or set AliasF
495    
496  ;;;###mh-autoload  ;;;###mh-autoload
497  (defun mh-alias-from-has-no-alias-p ()  (defun mh-alias-from-has-no-alias-p ()
498    "Return t is From has no current alias set."    "Return t is From has no current alias set.
499    In the exceptional situation where there isn't a From header in the message the
500    function returns nil."
501    (mh-alias-reload-maybe)    (mh-alias-reload-maybe)
502    (save-excursion    (save-excursion
503      (if (not (mh-folder-line-matches-show-buffer-p))      (if (not (mh-folder-line-matches-show-buffer-p))
504          nil                             ;No corresponding show buffer          nil                             ;No corresponding show buffer
505        (if (eq major-mode 'mh-folder-mode)        (if (eq major-mode 'mh-folder-mode)
506            (set-buffer mh-show-buffer))            (set-buffer mh-show-buffer))
507        (not (mh-alias-address-to-alias (mh-extract-from-header-value))))))        (let ((from-header (mh-extract-from-header-value)))
508            (and from-header
509                 (not (mh-alias-address-to-alias from-header)))))))
510    
511  (defun mh-alias-add-alias-to-file (alias address &optional file)  (defun mh-alias-add-alias-to-file (alias address &optional file)
512    "Add ALIAS for ADDRESS in alias FILE without alias check or prompts.    "Add ALIAS for ADDRESS in alias FILE without alias check or prompts.
# Line 491  after it." Line 520  after it."
520      (goto-char (point-min))      (goto-char (point-min))
521      (let ((alias-search (concat alias ":"))      (let ((alias-search (concat alias ":"))
522            (letter)            (letter)
           (here (point))  
523            (case-fold-search t))            (case-fold-search t))
524        (cond        (cond
525         ;; Search for exact match (if we had the same alias before)         ;; Search for exact match (if we had the same alias before)
# Line 538  If the alias is already is use, `mh-alia Line 566  If the alias is already is use, `mh-alia
566    (interactive "P\nP")    (interactive "P\nP")
567    (mh-alias-reload-maybe)    (mh-alias-reload-maybe)
568    (setq alias (completing-read "Alias: " mh-alias-alist nil nil alias))    (setq alias (completing-read "Alias: " mh-alias-alist nil nil alias))
569      (if (and address (string-match "^<\\(.*\\)>$" address))
570          (setq address (match-string 1 address)))
571    (setq address (read-string "Address: " address))    (setq address (read-string "Address: " address))
572      (if (string-match "^<\\(.*\\)>$" address)
573          (setq address (match-string 1 address)))
574    (let ((address-alias (mh-alias-address-to-alias address))    (let ((address-alias (mh-alias-address-to-alias address))
575          (alias-address (mh-alias-expand alias)))          (alias-address (mh-alias-expand alias)))
576      (if (string-equal alias-address alias)      (if (string-equal alias-address alias)
# Line 571  already has an alias." Line 603  already has an alias."
603        (insert-file-contents (mh-msg-filename (mh-get-msg-num t))))        (insert-file-contents (mh-msg-filename (mh-get-msg-num t))))
604       ((eq major-mode 'mh-folder-mode)       ((eq major-mode 'mh-folder-mode)
605        (error "Cursor not pointing to a message")))        (error "Cursor not pointing to a message")))
606      (let* ((address (mh-extract-from-header-value))      (let* ((address (or (mh-extract-from-header-value)
607                            (error "Message has no From: header")))
608             (alias (mh-alias-suggest-alias address)))             (alias (mh-alias-suggest-alias address)))
609        (mh-alias-add-alias alias address))))        (mh-alias-add-alias alias address))))
610    

Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4

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