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, 95, 96, 1997, |
;; Copyright (C) 1994, 95, 96, 1997, |
4 |
;; 2001, 02, 2003 Free Software Foundation, Inc. |
;; 2001, 02, 03, 2004 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> |
128 |
|
|
129 |
;;; Alias Loading |
;;; Alias Loading |
130 |
|
|
131 |
|
(defmacro mh-assoc-ignore-case (key alist) |
132 |
|
"Search for string KEY in ALIST. |
133 |
|
This is a wrapper around `assoc-string' or `assoc-ignore-case'. Avoid |
134 |
|
`assoc-ignore-case' which is now an obsolete function." |
135 |
|
(cond ((fboundp 'assoc-string) `(assoc-string ,key ,alist t)) |
136 |
|
((fboundp 'assoc-ignore-case) `(assoc-ignore-case ,key ,alist)) |
137 |
|
(t (error "The macro mh-assoc-ignore-case not implemented properly")))) |
138 |
|
|
139 |
(defun mh-alias-tstamp (arg) |
(defun mh-alias-tstamp (arg) |
140 |
"Check whether alias files have been modified. |
"Check whether alias files have been modified. |
141 |
Return t if any file listed in the MH profile component Aliasfile has been |
Return t if any file listed in the MH profile component Aliasfile has been |
177 |
(append userlist mh-alias-system-aliases)) |
(append userlist mh-alias-system-aliases)) |
178 |
userlist)))) |
userlist)))) |
179 |
|
|
180 |
|
(defun mh-alias-gecos-name (gecos-name username comma-separator) |
181 |
|
"Return a usable address string from a GECOS-NAME and USERNAME. |
182 |
|
Use only part of the GECOS-NAME up to the first comma if COMMA-SEPARATOR is |
183 |
|
non-nil." |
184 |
|
(let ((res gecos-name)) |
185 |
|
;; Keep only string until first comma if COMMA-SEPARATOR is t. |
186 |
|
(if (and comma-separator |
187 |
|
(string-match "^\\([^,]+\\)," res)) |
188 |
|
(setq res (match-string 1 res))) |
189 |
|
;; Replace "&" with capitalized username |
190 |
|
(if (string-match "&" res) |
191 |
|
(setq res (mh-replace-in-string "&" (capitalize username) res))) |
192 |
|
;; Remove " character |
193 |
|
(if (string-match "\"" res) |
194 |
|
(setq res (mh-replace-in-string "\"" "" res))) |
195 |
|
;; If empty string, use username instead |
196 |
|
(if (string-equal "" res) |
197 |
|
(setq res username)) |
198 |
|
;; Surround by quotes if doesn't consist of simple characters |
199 |
|
(if (not (string-match "^[ a-zA-Z0-9-]+$" res)) |
200 |
|
(setq res (concat "\"" res "\""))) |
201 |
|
res)) |
202 |
|
|
203 |
(defun mh-alias-local-users () |
(defun mh-alias-local-users () |
204 |
"Return an alist of local users from /etc/passwd." |
"Return an alist of local users from /etc/passwd." |
205 |
(let (passwd-alist) |
(let (passwd-alist) |
216 |
(goto-char (point-min)))) |
(goto-char (point-min)))) |
217 |
(while (< (point) (point-max)) |
(while (< (point) (point-max)) |
218 |
(cond |
(cond |
219 |
((looking-at "\\([^:]*\\):[^:]*:\\([^:]*\\):[^:]*:\\([^:,]*\\)[:,]") |
((looking-at "\\([^:]*\\):[^:]*:\\([^:]*\\):[^:]*:\\([^:]*\\):") |
220 |
(when (> (string-to-int (match-string 2)) 200) |
(when (> (string-to-int (match-string 2)) 200) |
221 |
(let* ((username (match-string 1)) |
(let* ((username (match-string 1)) |
222 |
(gecos-name (match-string 3)) |
(gecos-name (match-string 3)) |
223 |
(realname |
(realname (mh-alias-gecos-name |
224 |
(if (string-match "&" gecos-name) |
gecos-name username |
225 |
(concat |
mh-alias-passwd-gecos-comma-separator-flag))) |
|
(substring gecos-name 0 (match-beginning 0)) |
|
|
(capitalize username) |
|
|
(substring gecos-name (match-end 0))) |
|
|
gecos-name))) |
|
226 |
(setq passwd-alist |
(setq passwd-alist |
227 |
(cons (list username |
(cons |
228 |
(if (string-equal "" realname) |
(list (if mh-alias-local-users-prefix |
229 |
(concat "<" username ">") |
(concat mh-alias-local-users-prefix |
230 |
(concat realname " <" username ">"))) |
(mh-alias-suggest-alias realname t)) |
231 |
passwd-alist)))))) |
username) |
232 |
|
(if (string-equal username realname) |
233 |
|
(concat "<" username ">") |
234 |
|
(concat realname " <" username ">"))) |
235 |
|
passwd-alist)))))) |
236 |
(forward-line 1))) |
(forward-line 1))) |
237 |
passwd-alist)) |
passwd-alist)) |
238 |
|
|
250 |
(cond |
(cond |
251 |
((looking-at "^[ \t]")) ;Continuation line |
((looking-at "^[ \t]")) ;Continuation line |
252 |
((looking-at "\\(.+\\): .+: .*$") ; A new -blind- MH alias |
((looking-at "\\(.+\\): .+: .*$") ; A new -blind- MH alias |
253 |
(when (not (assoc-ignore-case (match-string 1) mh-alias-blind-alist)) |
(when (not (mh-assoc-ignore-case (match-string 1) mh-alias-blind-alist)) |
254 |
(setq mh-alias-blind-alist |
(setq mh-alias-blind-alist |
255 |
(cons (list (match-string 1)) mh-alias-blind-alist)) |
(cons (list (match-string 1)) mh-alias-blind-alist)) |
256 |
(setq mh-alias-alist (cons (list (match-string 1)) mh-alias-alist)))) |
(setq mh-alias-alist (cons (list (match-string 1)) mh-alias-alist)))) |
257 |
((looking-at "\\(.+\\): .*$") ; A new MH alias |
((looking-at "\\(.+\\): .*$") ; A new MH alias |
258 |
(when (not (assoc-ignore-case (match-string 1) mh-alias-alist)) |
(when (not (mh-assoc-ignore-case (match-string 1) mh-alias-alist)) |
259 |
(setq mh-alias-alist |
(setq mh-alias-alist |
260 |
(cons (list (match-string 1)) mh-alias-alist))))) |
(cons (list (match-string 1)) mh-alias-alist))))) |
261 |
(forward-line 1))) |
(forward-line 1))) |
266 |
user) |
user) |
267 |
(while local-users |
(while local-users |
268 |
(setq user (car local-users)) |
(setq user (car local-users)) |
269 |
(if (not (assoc-ignore-case (car user) mh-alias-alist)) |
(if (not (mh-assoc-ignore-case (car user) mh-alias-alist)) |
270 |
(setq mh-alias-alist (append mh-alias-alist (list user)))) |
(setq mh-alias-alist (append mh-alias-alist (list user)))) |
271 |
(setq local-users (cdr local-users))))) |
(setq local-users (cdr local-users))))) |
272 |
(message "Loading MH aliases...done")) |
(message "Loading MH aliases...done")) |
273 |
|
|
274 |
|
;;;###mh-autoload |
275 |
(defun mh-alias-reload-maybe () |
(defun mh-alias-reload-maybe () |
276 |
"Load new MH aliases." |
"Load new MH aliases." |
277 |
(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, so create it. |
301 |
"Return expansion for ALIAS. |
"Return expansion for ALIAS. |
302 |
Blind aliases or users from /etc/passwd are not expanded." |
Blind aliases or users from /etc/passwd are not expanded." |
303 |
(cond |
(cond |
304 |
((assoc-ignore-case alias mh-alias-blind-alist) |
((mh-assoc-ignore-case alias mh-alias-blind-alist) |
305 |
alias) ; Don't expand a blind alias |
alias) ; Don't expand a blind alias |
306 |
((assoc-ignore-case alias mh-alias-passwd-alist) |
((mh-assoc-ignore-case alias mh-alias-passwd-alist) |
307 |
(cadr (assoc-ignore-case alias mh-alias-passwd-alist))) |
(cadr (mh-assoc-ignore-case alias mh-alias-passwd-alist))) |
308 |
(t |
(t |
309 |
(mh-alias-ali alias)))) |
(mh-alias-ali alias)))) |
310 |
|
|
334 |
(defun mh-alias-minibuffer-confirm-address () |
(defun mh-alias-minibuffer-confirm-address () |
335 |
"Display the alias expansion if `mh-alias-flash-on-comma' is non-nil." |
"Display the alias expansion if `mh-alias-flash-on-comma' is non-nil." |
336 |
(interactive) |
(interactive) |
337 |
(if (not mh-alias-flash-on-comma) |
(when mh-alias-flash-on-comma |
|
() |
|
338 |
(save-excursion |
(save-excursion |
339 |
(let* ((case-fold-search t) |
(let* ((case-fold-search t) |
340 |
(the-name (buffer-substring |
(beg (mh-beginning-of-word)) |
341 |
(progn (skip-chars-backward " \t")(point)) |
(the-name (buffer-substring-no-properties beg (point)))) |
342 |
;; This moves over to previous comma, if any |
(if (mh-assoc-ignore-case the-name mh-alias-alist) |
|
(progn (or (and (not (= 0 (skip-chars-backward "^,"))) |
|
|
;; the skips over leading whitespace |
|
|
(skip-chars-forward " ")) |
|
|
;; no comma, then to beginning of word |
|
|
(skip-chars-backward "^ \t")) |
|
|
;; In Emacs21, the beginning of the prompt |
|
|
;; line is accessible, which wasn't the case |
|
|
;; in emacs20. Skip over it. |
|
|
(if (looking-at "^[^ \t]+:") |
|
|
(skip-chars-forward "^ \t")) |
|
|
(skip-chars-forward " ") |
|
|
(point))))) |
|
|
(if (assoc-ignore-case the-name mh-alias-alist) |
|
343 |
(message "%s -> %s" the-name (mh-alias-expand the-name)) |
(message "%s -> %s" the-name (mh-alias-expand the-name)) |
344 |
;; Check if if was a single word likely to be an alias |
;; Check if if was a single word likely to be an alias |
345 |
(if (and (equal mh-alias-flash-on-comma 1) |
(if (and (equal mh-alias-flash-on-comma 1) |
353 |
(defun mh-alias-letter-expand-alias () |
(defun mh-alias-letter-expand-alias () |
354 |
"Expand mail alias before point." |
"Expand mail alias before point." |
355 |
(mh-alias-reload-maybe) |
(mh-alias-reload-maybe) |
356 |
(let ((mail-abbrevs mh-alias-alist)) |
(let* ((end (point)) |
357 |
(mh-funcall-if-exists mail-abbrev-complete-alias)) |
(begin (mh-beginning-of-word)) |
358 |
(when mh-alias-expand-aliases-flag |
(input (buffer-substring-no-properties begin end))) |
359 |
(let* ((end (point)) |
(mh-complete-word input mh-alias-alist begin end) |
360 |
(syntax-table (syntax-table)) |
(when mh-alias-expand-aliases-flag |
361 |
(beg (unwind-protect |
(let* ((end (point)) |
362 |
(save-excursion |
(expansion (mh-alias-expand (buffer-substring begin end)))) |
363 |
(set-syntax-table mail-abbrev-syntax-table) |
(delete-region begin end) |
364 |
(backward-word 1) |
(insert expansion))))) |
|
(point)) |
|
|
(set-syntax-table syntax-table))) |
|
|
(alias (buffer-substring beg end)) |
|
|
(expansion (mh-alias-expand alias))) |
|
|
(delete-region beg end) |
|
|
(insert expansion)))) |
|
365 |
|
|
366 |
;;; Adding addresses to alias file. |
;;; Adding addresses to alias file. |
367 |
|
|
368 |
(defun mh-alias-suggest-alias (string) |
(defun mh-alias-suggest-alias (string &optional no-comma-swap) |
369 |
"Suggest an alias for STRING." |
"Suggest an alias for STRING. |
370 |
|
Don't reverse the order of strings separated by a comma if NO-COMMA-SWAP is |
371 |
|
non-nil." |
372 |
(cond |
(cond |
373 |
((string-match "^<\\(.*\\)>$" string) |
((string-match "^<\\(.*\\)>$" string) |
374 |
;; <somename@foo.bar> -> recurse, stripping brackets. |
;; <somename@foo.bar> -> recurse, stripping brackets. |
375 |
(mh-alias-suggest-alias (match-string 1 string))) |
(mh-alias-suggest-alias (match-string 1 string) no-comma-swap)) |
376 |
((string-match "^\\sw+$" string) |
((string-match "^\\sw+$" string) |
377 |
;; One word -> downcase it. |
;; One word -> downcase it. |
378 |
(downcase string)) |
(downcase string)) |
386 |
(downcase (match-string 1 string))) |
(downcase (match-string 1 string))) |
387 |
((string-match "^\"\\(.*\\)\".*" string) |
((string-match "^\"\\(.*\\)\".*" string) |
388 |
;; "Some name" <somename@foo.bar> -> recurse -> "Some name" |
;; "Some name" <somename@foo.bar> -> recurse -> "Some name" |
389 |
(mh-alias-suggest-alias (match-string 1 string))) |
(mh-alias-suggest-alias (match-string 1 string) no-comma-swap)) |
390 |
((string-match "^\\(.*\\) +<.*>$" string) |
((string-match "^\\(.*\\) +<.*>$" string) |
391 |
;; Some name <somename@foo.bar> -> recurse -> Some name |
;; Some name <somename@foo.bar> -> recurse -> Some name |
392 |
(mh-alias-suggest-alias (match-string 1 string))) |
(mh-alias-suggest-alias (match-string 1 string) no-comma-swap)) |
393 |
((string-match (concat mh-address-mail-regexp " +(\\(.*\\))$") string) |
((string-match (concat mh-address-mail-regexp " +(\\(.*\\))$") string) |
394 |
;; somename@foo.bar (Some name) -> recurse -> Some name |
;; somename@foo.bar (Some name) -> recurse -> Some name |
395 |
(mh-alias-suggest-alias (match-string 1 string))) |
(mh-alias-suggest-alias (match-string 1 string) no-comma-swap)) |
396 |
((string-match "^\\(Dr\\|Prof\\)\\.? +\\(.*\\)" string) |
((string-match "^\\(Dr\\|Prof\\)\\.? +\\(.*\\)" string) |
397 |
;; Strip out title |
;; Strip out title |
398 |
(mh-alias-suggest-alias (match-string 2 string))) |
(mh-alias-suggest-alias (match-string 2 string) no-comma-swap)) |
399 |
((string-match "^\\(.*\\), +\\(Jr\\.?\\|II+\\)$" string) |
((string-match "^\\(.*\\), +\\(Jr\\.?\\|II+\\)$" string) |
400 |
;; Strip out tails with comma |
;; Strip out tails with comma |
401 |
(mh-alias-suggest-alias (match-string 1 string))) |
(mh-alias-suggest-alias (match-string 1 string) no-comma-swap)) |
402 |
((string-match "^\\(.*\\) +\\(Jr\\.?\\|II+\\)$" string) |
((string-match "^\\(.*\\) +\\(Jr\\.?\\|II+\\)$" string) |
403 |
;; Strip out tails |
;; Strip out tails |
404 |
(mh-alias-suggest-alias (match-string 1 string))) |
(mh-alias-suggest-alias (match-string 1 string) no-comma-swap)) |
405 |
((string-match "^\\(\\sw+\\) +[A-Z]\\.? +\\(.*\\)$" string) |
((string-match "^\\(\\sw+\\) +[A-Z]\\.? +\\(.*\\)$" string) |
406 |
;; Strip out initials |
;; Strip out initials |
407 |
(mh-alias-suggest-alias |
(mh-alias-suggest-alias |
408 |
(format "%s %s" (match-string 1 string) (match-string 2 string)))) |
(format "%s %s" (match-string 1 string) (match-string 2 string)) |
409 |
((string-match "^\\([^,]+\\), +\\(.*\\)$" string) |
no-comma-swap)) |
410 |
;; Reverse order of comma-separated fields |
((and (not no-comma-swap) |
411 |
|
(string-match "^\\([^,]+\\), +\\(.*\\)$" string)) |
412 |
|
;; Reverse order of comma-separated fields to handle: |
413 |
|
;; From: "Galbraith, Peter" <psg@debian.org> |
414 |
|
;; but don't this for a name string extracted from the passwd file |
415 |
|
;; with mh-alias-passwd-gecos-comma-separator-flag set to nil. |
416 |
(mh-alias-suggest-alias |
(mh-alias-suggest-alias |
417 |
(format "%s %s" (match-string 2 string) (match-string 1 string)))) |
(format "%s %s" (match-string 2 string) (match-string 1 string)) |
418 |
|
no-comma-swap)) |
419 |
(t |
(t |
420 |
;; Output string, with spaces replaced by dots. |
;; Output string, with spaces replaced by dots. |
421 |
(mh-alias-canonicalize-suggestion string)))) |
(mh-alias-canonicalize-suggestion string)))) |
422 |
|
|
423 |
(defun mh-alias-canonicalize-suggestion (string) |
(defun mh-alias-canonicalize-suggestion (string) |
424 |
"Process STRING to replace spacess by periods. |
"Process STRING to replace spaces by periods. |
425 |
First all spaces are replaced by periods. Then every run of consecutive periods |
First all spaces and commas are replaced by periods. Then every run of |
426 |
are replaced with a single period. Finally the string is converted to lower |
consecutive periods are replaced with a single period. Finally the string |
427 |
case." |
is converted to lower case." |
428 |
(with-temp-buffer |
(with-temp-buffer |
429 |
(insert string) |
(insert string) |
430 |
;; Replace spaces with periods |
;; Replace spaces with periods |
431 |
(goto-char (point-min)) |
(goto-char (point-min)) |
432 |
(replace-regexp " +" ".") |
(while (re-search-forward " +" nil t) |
433 |
|
(replace-match "." nil nil)) |
434 |
|
;; Replace commas with periods |
435 |
|
(goto-char (point-min)) |
436 |
|
(while (re-search-forward ",+" nil t) |
437 |
|
(replace-match "." nil nil)) |
438 |
;; Replace consecutive periods with a single period |
;; Replace consecutive periods with a single period |
439 |
(goto-char (point-min)) |
(goto-char (point-min)) |
440 |
(replace-regexp "\\.\\.+" ".") |
(while (re-search-forward "\\.\\.+" nil t) |
441 |
|
(replace-match "." nil nil)) |
442 |
;; Convert to lower case |
;; Convert to lower case |
443 |
(downcase-region (point-min) (point-max)) |
(downcase-region (point-min) (point-max)) |
444 |
;; Whew! all done... |
;; Whew! all done... |
643 |
(mh-alias-add-alias nil address) |
(mh-alias-add-alias nil address) |
644 |
(message "No email address found under point.")))) |
(message "No email address found under point.")))) |
645 |
|
|
646 |
|
;;;###mh-autoload |
647 |
|
(defun mh-alias-apropos (regexp) |
648 |
|
"Show all aliases that match REGEXP either in name or content." |
649 |
|
(interactive "sAlias regexp: ") |
650 |
|
(if mh-alias-local-users |
651 |
|
(mh-alias-reload-maybe)) |
652 |
|
(let ((matches "")(group-matches "")(passwd-matches)) |
653 |
|
(save-excursion |
654 |
|
(message "Reading MH aliases...") |
655 |
|
(mh-exec-cmd-quiet t "ali" "-nolist" "-nouser") |
656 |
|
(message "Reading MH aliases...done. Parsing...") |
657 |
|
(while (re-search-forward regexp nil t) |
658 |
|
(beginning-of-line) |
659 |
|
(cond |
660 |
|
((looking-at "^[ \t]") ;Continuation line |
661 |
|
(setq group-matches |
662 |
|
(concat group-matches |
663 |
|
(buffer-substring |
664 |
|
(save-excursion |
665 |
|
(or (re-search-backward "^[^ \t]" nil t) |
666 |
|
(point))) |
667 |
|
(progn |
668 |
|
(if (re-search-forward "^[^ \t]" nil t) |
669 |
|
(forward-char -1)) |
670 |
|
(point)))))) |
671 |
|
(t |
672 |
|
(setq matches |
673 |
|
(concat matches |
674 |
|
(buffer-substring (point)(progn (end-of-line)(point))) |
675 |
|
"\n"))))) |
676 |
|
(message "Reading MH aliases...done. Parsing...done.") |
677 |
|
(when mh-alias-local-users |
678 |
|
(message |
679 |
|
"Reading MH aliases...done. Parsing...done. Passwd aliases...") |
680 |
|
(setq passwd-matches |
681 |
|
(mapconcat |
682 |
|
'(lambda (elem) |
683 |
|
(if (or (string-match regexp (car elem)) |
684 |
|
(string-match regexp (cadr elem))) |
685 |
|
(format "%s: %s\n" (car elem) (cadr elem)))) |
686 |
|
mh-alias-passwd-alist "")) |
687 |
|
(message |
688 |
|
"Reading MH aliases...done. Parsing...done. Passwd aliases...done."))) |
689 |
|
(if (and (string-equal "" matches) |
690 |
|
(string-equal "" group-matches) |
691 |
|
(string-equal "" passwd-matches)) |
692 |
|
(message "No matches") |
693 |
|
(with-output-to-temp-buffer "*Help*" |
694 |
|
(if (not (string-equal "" matches)) |
695 |
|
(princ matches)) |
696 |
|
(when (not (string-equal group-matches "")) |
697 |
|
(princ "\nGroup Aliases:\n\n") |
698 |
|
(princ group-matches)) |
699 |
|
(when (not (string-equal passwd-matches "")) |
700 |
|
(princ "\nLocal User Aliases:\n\n") |
701 |
|
(princ passwd-matches)))))) |
702 |
|
|
703 |
(provide 'mh-alias) |
(provide 'mh-alias) |
704 |
|
|
705 |
;;; Local Variables: |
;;; Local Variables: |