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> |
94 |
|
|
95 |
;;; Change Log: |
;;; Change Log: |
96 |
|
|
|
;; $Id$ |
|
|
|
|
97 |
;;; Code: |
;;; Code: |
98 |
|
|
99 |
(require 'mh-e) |
(require 'mh-e) |
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.") |
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 |
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 |
|
|
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. |
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 |
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)) |
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)) |
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." |
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))))) |
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. |
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) |
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) |
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 |
|
|