Commit | Line | Data |
---|---|---|
c3d9274a BW |
1 | ;;; mh-alias.el --- MH-E mail alias completion and expansion |
2 | ;; | |
e495eaec BW |
3 | ;; Copyright (C) 1994, 1995, 1996, 1997, |
4 | ;; 2001, 2002, 2003, 2004 Free Software Foundation, Inc. | |
a1506d29 | 5 | |
c3d9274a BW |
6 | ;; Author: Peter S. Galbraith <psg@debian.org> |
7 | ;; Maintainer: Bill Wohler <wohler@newt.com> | |
8 | ;; Keywords: mail | |
9 | ;; See: mh-e.el | |
10 | ||
11 | ;; This file is part of GNU Emacs. | |
12 | ||
13 | ;; GNU Emacs is free software; you can redistribute it and/or modify | |
14 | ;; it under the terms of the GNU General Public License as published by | |
15 | ;; the Free Software Foundation; either version 2, or (at your option) | |
16 | ;; any later version. | |
17 | ||
18 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
19 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
20 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
21 | ;; GNU General Public License for more details. | |
22 | ||
23 | ;; You should have received a copy of the GNU General Public License | |
24 | ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
3a35cf56 LK |
25 | ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
26 | ;; Boston, MA 02110-1301, USA. | |
c3d9274a BW |
27 | |
28 | ;;; Commentary: | |
29 | ||
3d7ca223 BW |
30 | ;;; Change Log: |
31 | ||
c3d9274a BW |
32 | ;;; Code: |
33 | ||
f0d73c14 BW |
34 | (eval-when-compile (require 'mh-acros)) |
35 | (mh-require-cl) | |
c3d9274a BW |
36 | (require 'mh-e) |
37 | (load "cmr" t t) ; Non-fatal dependency for | |
38 | ; completing-read-multiple. | |
39 | (eval-when-compile (defvar mail-abbrev-syntax-table)) | |
40 | ||
41 | ;;; Autoloads | |
924df208 BW |
42 | (eval-when (compile load eval) |
43 | (ignore-errors | |
44 | (require 'mailabbrev) | |
45 | (require 'multi-prompt))) | |
c3d9274a | 46 | |
924df208 | 47 | (defvar mh-alias-alist 'not-read |
c3d9274a BW |
48 | "Alist of MH aliases.") |
49 | (defvar mh-alias-blind-alist nil | |
50 | "Alist of MH aliases that are blind lists.") | |
51 | (defvar mh-alias-passwd-alist nil | |
52 | "Alist of aliases extracted from passwd file and their expansions.") | |
53 | (defvar mh-alias-tstamp nil | |
54 | "Time aliases were last loaded.") | |
55 | (defvar mh-alias-read-address-map nil) | |
f0d73c14 | 56 | (unless mh-alias-read-address-map |
c3d9274a BW |
57 | (setq mh-alias-read-address-map |
58 | (copy-keymap minibuffer-local-completion-map)) | |
f0d73c14 BW |
59 | (define-key mh-alias-read-address-map |
60 | "," 'mh-alias-minibuffer-confirm-address) | |
c3d9274a BW |
61 | (define-key mh-alias-read-address-map " " 'self-insert-command)) |
62 | ||
f0d73c14 BW |
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 | ||
c3d9274a BW |
73 | \f |
74 | ;;; Alias Loading | |
75 | ||
a66894d8 BW |
76 | (defmacro mh-assoc-ignore-case (key alist) |
77 | "Search for string KEY in ALIST. | |
78 | This is a wrapper around `assoc-string' or `assoc-ignore-case'. Avoid | |
79 | `assoc-ignore-case' which is now an obsolete function." | |
80 | (cond ((fboundp 'assoc-string) `(assoc-string ,key ,alist t)) | |
81 | ((fboundp 'assoc-ignore-case) `(assoc-ignore-case ,key ,alist)) | |
82 | (t (error "The macro mh-assoc-ignore-case not implemented properly")))) | |
83 | ||
c3d9274a BW |
84 | (defun mh-alias-tstamp (arg) |
85 | "Check whether alias files have been modified. | |
f0d73c14 | 86 | Return t if any file listed in the Aliasfile MH profile component has been |
c3d9274a BW |
87 | modified since the timestamp. |
88 | If ARG is non-nil, set timestamp with the current time." | |
89 | (if arg | |
90 | (let ((time (current-time))) | |
91 | (setq mh-alias-tstamp (list (nth 0 time) (nth 1 time)))) | |
92 | (let ((stamp)) | |
93 | (car (memq t (mapcar | |
94 | (function | |
95 | (lambda (file) | |
96 | (when (and file (file-exists-p file)) | |
97 | (setq stamp (nth 5 (file-attributes file))) | |
98 | (or (> (car stamp) (car mh-alias-tstamp)) | |
99 | (and (= (car stamp) (car mh-alias-tstamp)) | |
100 | (> (cadr stamp) (cadr mh-alias-tstamp))))))) | |
101 | (mh-alias-filenames t))))))) | |
102 | ||
103 | (defun mh-alias-filenames (arg) | |
104 | "Return list of filenames that contain aliases. | |
f0d73c14 | 105 | The filenames come from the Aliasfile profile component and are expanded. |
c3d9274a BW |
106 | If ARG is non-nil, filenames listed in `mh-alias-system-aliases' are appended." |
107 | (or mh-progs (mh-find-path)) | |
108 | (save-excursion | |
109 | (let* ((filename (mh-profile-component "Aliasfile")) | |
110 | (filelist (and filename (split-string filename "[ \t]+"))) | |
111 | (userlist | |
112 | (mapcar | |
113 | (function | |
114 | (lambda (file) | |
115 | (if (and mh-user-path file | |
116 | (file-exists-p (expand-file-name file mh-user-path))) | |
117 | (expand-file-name file mh-user-path)))) | |
118 | filelist))) | |
119 | (if arg | |
120 | (if (stringp mh-alias-system-aliases) | |
121 | (append userlist (list mh-alias-system-aliases)) | |
122 | (append userlist mh-alias-system-aliases)) | |
123 | userlist)))) | |
124 | ||
a66894d8 BW |
125 | (defun mh-alias-gecos-name (gecos-name username comma-separator) |
126 | "Return a usable address string from a GECOS-NAME and USERNAME. | |
127 | Use only part of the GECOS-NAME up to the first comma if COMMA-SEPARATOR is | |
128 | non-nil." | |
129 | (let ((res gecos-name)) | |
130 | ;; Keep only string until first comma if COMMA-SEPARATOR is t. | |
131 | (if (and comma-separator | |
132 | (string-match "^\\([^,]+\\)," res)) | |
133 | (setq res (match-string 1 res))) | |
134 | ;; Replace "&" with capitalized username | |
135 | (if (string-match "&" res) | |
136 | (setq res (mh-replace-in-string "&" (capitalize username) res))) | |
137 | ;; Remove " character | |
138 | (if (string-match "\"" res) | |
139 | (setq res (mh-replace-in-string "\"" "" res))) | |
140 | ;; If empty string, use username instead | |
141 | (if (string-equal "" res) | |
142 | (setq res username)) | |
143 | ;; Surround by quotes if doesn't consist of simple characters | |
144 | (if (not (string-match "^[ a-zA-Z0-9-]+$" res)) | |
145 | (setq res (concat "\"" res "\""))) | |
146 | res)) | |
147 | ||
c3d9274a | 148 | (defun mh-alias-local-users () |
f0d73c14 BW |
149 | "Return an alist of local users from /etc/passwd. |
150 | Exclude all aliases already in `mh-alias-alist' from `ali'" | |
c3d9274a BW |
151 | (let (passwd-alist) |
152 | (save-excursion | |
153 | (set-buffer (get-buffer-create mh-temp-buffer)) | |
154 | (erase-buffer) | |
155 | (cond | |
156 | ((eq mh-alias-local-users t) | |
157 | (if (file-readable-p "/etc/passwd") | |
158 | (insert-file-contents "/etc/passwd"))) | |
159 | ((stringp mh-alias-local-users) | |
160 | (insert mh-alias-local-users "\n") | |
924df208 | 161 | (shell-command-on-region (point-min) (point-max) mh-alias-local-users t) |
c3d9274a BW |
162 | (goto-char (point-min)))) |
163 | (while (< (point) (point-max)) | |
164 | (cond | |
a66894d8 | 165 | ((looking-at "\\([^:]*\\):[^:]*:\\([^:]*\\):[^:]*:\\([^:]*\\):") |
e495eaec | 166 | (when (> (string-to-number (match-string 2)) 200) |
c3d9274a BW |
167 | (let* ((username (match-string 1)) |
168 | (gecos-name (match-string 3)) | |
a66894d8 BW |
169 | (realname (mh-alias-gecos-name |
170 | gecos-name username | |
f0d73c14 BW |
171 | mh-alias-passwd-gecos-comma-separator-flag)) |
172 | (alias-name (if mh-alias-local-users-prefix | |
e495eaec BW |
173 | (concat mh-alias-local-users-prefix |
174 | (mh-alias-suggest-alias realname t)) | |
175 | username)) | |
f0d73c14 BW |
176 | (alias-translation |
177 | (if (string-equal username realname) | |
178 | (concat "<" username ">") | |
179 | (concat realname " <" username ">")))) | |
180 | (when (not (mh-assoc-ignore-case alias-name mh-alias-alist)) | |
181 | (setq passwd-alist (cons (list alias-name alias-translation) | |
182 | passwd-alist))))))) | |
c3d9274a BW |
183 | (forward-line 1))) |
184 | passwd-alist)) | |
185 | ||
186 | ;;;###mh-autoload | |
187 | (defun mh-alias-reload () | |
f0d73c14 BW |
188 | "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." | |
c3d9274a BW |
198 | (interactive) |
199 | (save-excursion | |
200 | (message "Loading MH aliases...") | |
201 | (mh-alias-tstamp t) | |
202 | (mh-exec-cmd-quiet t "ali" "-nolist" "-nouser") | |
203 | (setq mh-alias-alist nil) | |
204 | (setq mh-alias-blind-alist nil) | |
205 | (while (< (point) (point-max)) | |
206 | (cond | |
207 | ((looking-at "^[ \t]")) ;Continuation line | |
208 | ((looking-at "\\(.+\\): .+: .*$") ; A new -blind- MH alias | |
a66894d8 | 209 | (when (not (mh-assoc-ignore-case (match-string 1) mh-alias-blind-alist)) |
c3d9274a BW |
210 | (setq mh-alias-blind-alist |
211 | (cons (list (match-string 1)) mh-alias-blind-alist)) | |
212 | (setq mh-alias-alist (cons (list (match-string 1)) mh-alias-alist)))) | |
213 | ((looking-at "\\(.+\\): .*$") ; A new MH alias | |
a66894d8 | 214 | (when (not (mh-assoc-ignore-case (match-string 1) mh-alias-alist)) |
c3d9274a BW |
215 | (setq mh-alias-alist |
216 | (cons (list (match-string 1)) mh-alias-alist))))) | |
217 | (forward-line 1))) | |
218 | (when mh-alias-local-users | |
219 | (setq mh-alias-passwd-alist (mh-alias-local-users)) | |
220 | ;; Update aliases with local users, but leave existing aliases alone. | |
221 | (let ((local-users mh-alias-passwd-alist) | |
222 | user) | |
223 | (while local-users | |
224 | (setq user (car local-users)) | |
a66894d8 | 225 | (if (not (mh-assoc-ignore-case (car user) mh-alias-alist)) |
c3d9274a BW |
226 | (setq mh-alias-alist (append mh-alias-alist (list user)))) |
227 | (setq local-users (cdr local-users))))) | |
f0d73c14 | 228 | (run-hooks 'mh-alias-reloaded-hook) |
c3d9274a BW |
229 | (message "Loading MH aliases...done")) |
230 | ||
a66894d8 | 231 | ;;;###mh-autoload |
c3d9274a BW |
232 | (defun mh-alias-reload-maybe () |
233 | "Load new MH aliases." | |
f0d73c14 BW |
234 | (if (or (eq mh-alias-alist 'not-read) ; Doesn't exist? |
235 | (mh-alias-tstamp nil)) ; Out of date? | |
c3d9274a BW |
236 | (mh-alias-reload))) |
237 | ||
238 | \f | |
239 | ;;; Alias Expansion | |
240 | ||
241 | (defun mh-alias-ali (alias &optional user) | |
242 | "Return ali expansion for ALIAS. | |
243 | ALIAS must be a string for a single alias. | |
244 | If USER is t, then assume ALIAS is an address and call ali -user. | |
245 | ali returns the string unchanged if not defined. The same is done here." | |
924df208 BW |
246 | (condition-case err |
247 | (save-excursion | |
248 | (let ((user-arg (if user "-user" "-nouser"))) | |
249 | (mh-exec-cmd-quiet t "ali" user-arg "-nolist" alias)) | |
250 | (goto-char (point-max)) | |
251 | (if (looking-at "^$") (delete-backward-char 1)) | |
252 | (buffer-substring (point-min)(point-max))) | |
253 | (error (progn | |
254 | (message (error-message-string err)) | |
255 | alias)))) | |
c3d9274a BW |
256 | |
257 | (defun mh-alias-expand (alias) | |
258 | "Return expansion for ALIAS. | |
259 | Blind aliases or users from /etc/passwd are not expanded." | |
260 | (cond | |
a66894d8 | 261 | ((mh-assoc-ignore-case alias mh-alias-blind-alist) |
c3d9274a | 262 | alias) ; Don't expand a blind alias |
a66894d8 BW |
263 | ((mh-assoc-ignore-case alias mh-alias-passwd-alist) |
264 | (cadr (mh-assoc-ignore-case alias mh-alias-passwd-alist))) | |
c3d9274a BW |
265 | (t |
266 | (mh-alias-ali alias)))) | |
267 | ||
268 | ;;;###mh-autoload | |
269 | (defun mh-read-address (prompt) | |
270 | "Read an address from the minibuffer with PROMPT." | |
271 | (mh-alias-reload-maybe) | |
272 | (if (not mh-alias-alist) ; If still no aliases, just prompt | |
273 | (read-string prompt) | |
274 | (let* ((minibuffer-local-completion-map mh-alias-read-address-map) | |
275 | (completion-ignore-case mh-alias-completion-ignore-case-flag) | |
276 | (the-answer | |
924df208 BW |
277 | (cond ((fboundp 'completing-read-multiple) |
278 | (mh-funcall-if-exists | |
279 | completing-read-multiple prompt mh-alias-alist nil nil)) | |
280 | ((featurep 'multi-prompt) | |
281 | (mh-funcall-if-exists | |
282 | multi-prompt "," nil prompt mh-alias-alist nil nil)) | |
283 | (t (split-string | |
284 | (completing-read prompt mh-alias-alist nil nil) ","))))) | |
c3d9274a BW |
285 | (if (not mh-alias-expand-aliases-flag) |
286 | (mapconcat 'identity the-answer ", ") | |
287 | ;; Loop over all elements, checking if in passwd aliast or blind first | |
288 | (mapconcat 'mh-alias-expand the-answer ",\n "))))) | |
289 | ||
290 | ;;;###mh-autoload | |
291 | (defun mh-alias-minibuffer-confirm-address () | |
292 | "Display the alias expansion if `mh-alias-flash-on-comma' is non-nil." | |
293 | (interactive) | |
a66894d8 | 294 | (when mh-alias-flash-on-comma |
c3d9274a BW |
295 | (save-excursion |
296 | (let* ((case-fold-search t) | |
a66894d8 BW |
297 | (beg (mh-beginning-of-word)) |
298 | (the-name (buffer-substring-no-properties beg (point)))) | |
299 | (if (mh-assoc-ignore-case the-name mh-alias-alist) | |
c3d9274a BW |
300 | (message "%s -> %s" the-name (mh-alias-expand the-name)) |
301 | ;; Check if if was a single word likely to be an alias | |
302 | (if (and (equal mh-alias-flash-on-comma 1) | |
303 | (not (string-match " " the-name))) | |
304 | (message "No alias for %s" the-name)))))) | |
305 | (self-insert-command 1)) | |
306 | ||
924df208 BW |
307 | (mh-do-in-xemacs (defvar mail-abbrevs)) |
308 | ||
c3d9274a BW |
309 | ;;;###mh-autoload |
310 | (defun mh-alias-letter-expand-alias () | |
311 | "Expand mail alias before point." | |
312 | (mh-alias-reload-maybe) | |
a66894d8 BW |
313 | (let* ((end (point)) |
314 | (begin (mh-beginning-of-word)) | |
315 | (input (buffer-substring-no-properties begin end))) | |
316 | (mh-complete-word input mh-alias-alist begin end) | |
317 | (when mh-alias-expand-aliases-flag | |
318 | (let* ((end (point)) | |
319 | (expansion (mh-alias-expand (buffer-substring begin end)))) | |
320 | (delete-region begin end) | |
321 | (insert expansion))))) | |
c3d9274a BW |
322 | \f |
323 | ;;; Adding addresses to alias file. | |
324 | ||
a66894d8 BW |
325 | (defun mh-alias-suggest-alias (string &optional no-comma-swap) |
326 | "Suggest an alias for STRING. | |
327 | Don't reverse the order of strings separated by a comma if NO-COMMA-SWAP is | |
328 | non-nil." | |
c3d9274a | 329 | (cond |
924df208 BW |
330 | ((string-match "^<\\(.*\\)>$" string) |
331 | ;; <somename@foo.bar> -> recurse, stripping brackets. | |
a66894d8 | 332 | (mh-alias-suggest-alias (match-string 1 string) no-comma-swap)) |
c3d9274a BW |
333 | ((string-match "^\\sw+$" string) |
334 | ;; One word -> downcase it. | |
335 | (downcase string)) | |
336 | ((string-match "^\\(\\sw+\\)\\s-+\\(\\sw+\\)$" string) | |
337 | ;; Two words -> first.last | |
338 | (downcase | |
339 | (format "%s.%s" (match-string 1 string) (match-string 2 string)))) | |
340 | ((string-match "^\\([-a-zA-Z0-9._]+\\)@[-a-zA-z0-9_]+\\.+[a-zA-Z0-9]+$" | |
341 | string) | |
342 | ;; email only -> downcase username | |
343 | (downcase (match-string 1 string))) | |
344 | ((string-match "^\"\\(.*\\)\".*" string) | |
345 | ;; "Some name" <somename@foo.bar> -> recurse -> "Some name" | |
a66894d8 | 346 | (mh-alias-suggest-alias (match-string 1 string) no-comma-swap)) |
c3d9274a BW |
347 | ((string-match "^\\(.*\\) +<.*>$" string) |
348 | ;; Some name <somename@foo.bar> -> recurse -> Some name | |
a66894d8 | 349 | (mh-alias-suggest-alias (match-string 1 string) no-comma-swap)) |
c3d9274a BW |
350 | ((string-match (concat mh-address-mail-regexp " +(\\(.*\\))$") string) |
351 | ;; somename@foo.bar (Some name) -> recurse -> Some name | |
a66894d8 | 352 | (mh-alias-suggest-alias (match-string 1 string) no-comma-swap)) |
c3d9274a BW |
353 | ((string-match "^\\(Dr\\|Prof\\)\\.? +\\(.*\\)" string) |
354 | ;; Strip out title | |
a66894d8 | 355 | (mh-alias-suggest-alias (match-string 2 string) no-comma-swap)) |
c3d9274a BW |
356 | ((string-match "^\\(.*\\), +\\(Jr\\.?\\|II+\\)$" string) |
357 | ;; Strip out tails with comma | |
a66894d8 | 358 | (mh-alias-suggest-alias (match-string 1 string) no-comma-swap)) |
c3d9274a BW |
359 | ((string-match "^\\(.*\\) +\\(Jr\\.?\\|II+\\)$" string) |
360 | ;; Strip out tails | |
a66894d8 | 361 | (mh-alias-suggest-alias (match-string 1 string) no-comma-swap)) |
c3d9274a BW |
362 | ((string-match "^\\(\\sw+\\) +[A-Z]\\.? +\\(.*\\)$" string) |
363 | ;; Strip out initials | |
364 | (mh-alias-suggest-alias | |
a66894d8 BW |
365 | (format "%s %s" (match-string 1 string) (match-string 2 string)) |
366 | no-comma-swap)) | |
367 | ((and (not no-comma-swap) | |
368 | (string-match "^\\([^,]+\\), +\\(.*\\)$" string)) | |
369 | ;; Reverse order of comma-separated fields to handle: | |
370 | ;; From: "Galbraith, Peter" <psg@debian.org> | |
371 | ;; but don't this for a name string extracted from the passwd file | |
372 | ;; with mh-alias-passwd-gecos-comma-separator-flag set to nil. | |
c3d9274a | 373 | (mh-alias-suggest-alias |
a66894d8 BW |
374 | (format "%s %s" (match-string 2 string) (match-string 1 string)) |
375 | no-comma-swap)) | |
c3d9274a BW |
376 | (t |
377 | ;; Output string, with spaces replaced by dots. | |
924df208 BW |
378 | (mh-alias-canonicalize-suggestion string)))) |
379 | ||
380 | (defun mh-alias-canonicalize-suggestion (string) | |
a66894d8 BW |
381 | "Process STRING to replace spaces by periods. |
382 | First all spaces and commas are replaced by periods. Then every run of | |
383 | consecutive periods are replaced with a single period. Finally the string | |
384 | is converted to lower case." | |
924df208 BW |
385 | (with-temp-buffer |
386 | (insert string) | |
387 | ;; Replace spaces with periods | |
388 | (goto-char (point-min)) | |
a66894d8 BW |
389 | (while (re-search-forward " +" nil t) |
390 | (replace-match "." nil nil)) | |
391 | ;; Replace commas with periods | |
392 | (goto-char (point-min)) | |
393 | (while (re-search-forward ",+" nil t) | |
394 | (replace-match "." nil nil)) | |
924df208 BW |
395 | ;; Replace consecutive periods with a single period |
396 | (goto-char (point-min)) | |
a66894d8 BW |
397 | (while (re-search-forward "\\.\\.+" nil t) |
398 | (replace-match "." nil nil)) | |
924df208 BW |
399 | ;; Convert to lower case |
400 | (downcase-region (point-min) (point-max)) | |
401 | ;; Whew! all done... | |
402 | (buffer-string))) | |
c3d9274a BW |
403 | |
404 | (defun mh-alias-which-file-has-alias (alias file-list) | |
405 | "Return the name of writable file which defines ALIAS from list FILE-LIST." | |
406 | (save-excursion | |
407 | (set-buffer (get-buffer-create mh-temp-buffer)) | |
408 | (let ((the-list file-list) | |
409 | (found)) | |
410 | (while the-list | |
411 | (erase-buffer) | |
412 | (when (file-writable-p (car file-list)) | |
413 | (insert-file-contents (car file-list)) | |
924df208 | 414 | (if (re-search-forward (concat "^" (regexp-quote alias) ":") nil t) |
c3d9274a BW |
415 | (setq found (car file-list) |
416 | the-list nil) | |
417 | (setq the-list (cdr the-list))))) | |
418 | found))) | |
419 | ||
420 | (defun mh-alias-insert-file (&optional alias) | |
f0d73c14 BW |
421 | "Return filename which should be used to add ALIAS. |
422 | The value of the option `mh-alias-insert-file' is used if non-nil\; otherwise | |
423 | the value of the `Aliasfile:' profile component is used. | |
424 | If the alias already exists, try to return the name of the file that contains | |
425 | it." | |
c3d9274a BW |
426 | (cond |
427 | ((and mh-alias-insert-file (listp mh-alias-insert-file)) | |
428 | (if (not (elt mh-alias-insert-file 1)) ; Only one entry, use it | |
429 | (car mh-alias-insert-file) | |
430 | (if (or (not alias) | |
431 | (string-equal alias (mh-alias-ali alias))) ;alias doesn't exist | |
f0d73c14 | 432 | (completing-read "Alias file: " |
c3d9274a BW |
433 | (mapcar 'list mh-alias-insert-file) nil t) |
434 | (or (mh-alias-which-file-has-alias alias mh-alias-insert-file) | |
f0d73c14 | 435 | (completing-read "Alias file: " |
c3d9274a BW |
436 | (mapcar 'list mh-alias-insert-file) nil t))))) |
437 | ((and mh-alias-insert-file (stringp mh-alias-insert-file)) | |
438 | mh-alias-insert-file) | |
439 | (t | |
440 | ;; writable ones returned from (mh-alias-filenames): | |
441 | (let ((autolist (delq nil (mapcar (lambda (file) | |
442 | (if (and (file-writable-p file) | |
443 | (not (string-equal | |
444 | file "/etc/passwd"))) | |
445 | file)) | |
446 | (mh-alias-filenames t))))) | |
447 | (cond | |
448 | ((not autolist) | |
449 | (error "No writable alias file. | |
f0d73c14 | 450 | Set `mh-alias-insert-file' or the Aliasfile profile component")) |
c3d9274a BW |
451 | ((not (elt autolist 1)) ; Only one entry, use it |
452 | (car autolist)) | |
453 | ((or (not alias) | |
454 | (string-equal alias (mh-alias-ali alias))) ;alias doesn't exist | |
f0d73c14 | 455 | (completing-read "Alias file: " (mapcar 'list autolist) nil t)) |
c3d9274a BW |
456 | (t |
457 | (or (mh-alias-which-file-has-alias alias autolist) | |
f0d73c14 | 458 | (completing-read "Alias file: " |
c3d9274a BW |
459 | (mapcar 'list autolist) nil t)))))))) |
460 | ||
3d7ca223 | 461 | ;;;###mh-autoload |
c3d9274a BW |
462 | (defun mh-alias-address-to-alias (address) |
463 | "Return the ADDRESS alias if defined, or nil." | |
464 | (let* ((aliases (mh-alias-ali address t))) | |
465 | (if (string-equal aliases address) | |
466 | nil ; ali returned same string -> no. | |
3d7ca223 BW |
467 | ;; Double-check that we have an individual alias. This means that the |
468 | ;; alias doesn't expand into a list (of which this address is part). | |
c3d9274a BW |
469 | (car (delq nil (mapcar |
470 | (function | |
471 | (lambda (alias) | |
472 | (let ((recurse (mh-alias-ali alias nil))) | |
473 | (if (string-match ".*,.*" recurse) | |
474 | nil | |
475 | alias)))) | |
476 | (split-string aliases ", +"))))))) | |
477 | ||
478 | ;;;###mh-autoload | |
f0d73c14 BW |
479 | (defun mh-alias-for-from-p () |
480 | "Return t if sender's address has a corresponding alias." | |
c3d9274a BW |
481 | (mh-alias-reload-maybe) |
482 | (save-excursion | |
483 | (if (not (mh-folder-line-matches-show-buffer-p)) | |
484 | nil ;No corresponding show buffer | |
485 | (if (eq major-mode 'mh-folder-mode) | |
486 | (set-buffer mh-show-buffer)) | |
924df208 BW |
487 | (let ((from-header (mh-extract-from-header-value))) |
488 | (and from-header | |
f0d73c14 | 489 | (mh-alias-address-to-alias from-header)))))) |
c3d9274a BW |
490 | |
491 | (defun mh-alias-add-alias-to-file (alias address &optional file) | |
492 | "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. | |
f0d73c14 BW |
494 | |
495 | 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." | |
c3d9274a BW |
499 | (if (not file) |
500 | (setq file (mh-alias-insert-file alias))) | |
501 | (save-excursion | |
502 | (set-buffer (find-file-noselect file)) | |
503 | (goto-char (point-min)) | |
504 | (let ((alias-search (concat alias ":")) | |
505 | (letter) | |
c3d9274a BW |
506 | (case-fold-search t)) |
507 | (cond | |
508 | ;; Search for exact match (if we had the same alias before) | |
509 | ((re-search-forward | |
510 | (concat "^" (regexp-quote alias-search) " *\\(.*\\)") nil t) | |
511 | (let ((answer (read-string | |
f0d73c14 BW |
512 | (format (concat "Alias %s exists; insert new address " |
513 | "[b]efore or [a]fter: ") | |
c3d9274a BW |
514 | (match-string 1)))) |
515 | (case-fold-search t)) | |
f0d73c14 | 516 | (cond ((string-match "^b" answer)) |
c3d9274a BW |
517 | ((string-match "^a" answer) |
518 | (forward-line 1)) | |
519 | (t | |
f0d73c14 | 520 | (error "Unrecognized response"))))) |
c3d9274a BW |
521 | ;; No, so sort-in at the right place |
522 | ;; search for "^alias", then "^alia", etc. | |
523 | ((eq mh-alias-insertion-location 'sorted) | |
524 | (setq letter (substring alias-search -1) | |
525 | alias-search (substring alias-search 0 -1)) | |
526 | (while (and (not (equal alias-search "")) | |
527 | (not (re-search-forward | |
528 | (concat "^" (regexp-quote alias-search)) nil t))) | |
529 | (setq letter (substring alias-search -1) | |
530 | alias-search (substring alias-search 0 -1))) | |
531 | ;; Next, move forward to sort alphabetically for following letters | |
532 | (beginning-of-line) | |
533 | (while (re-search-forward | |
534 | (concat "^" (regexp-quote alias-search) "[a-" letter "]") | |
535 | nil t) | |
536 | (forward-line 1))) | |
537 | ((eq mh-alias-insertion-location 'bottom) | |
538 | (goto-char (point-max))) | |
539 | ((eq mh-alias-insertion-location 'top) | |
540 | (goto-char (point-min))))) | |
541 | (beginning-of-line) | |
542 | (insert (format "%s: %s\n" alias address)) | |
543 | (save-buffer))) | |
544 | ||
545 | ;;;###mh-autoload | |
546 | (defun mh-alias-add-alias (alias address) | |
547 | "*Add ALIAS for ADDRESS in personal alias file. | |
f0d73c14 BW |
548 | This function prompts you for an alias and address. If the alias exists |
549 | 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." | |
c3d9274a BW |
553 | (interactive "P\nP") |
554 | (mh-alias-reload-maybe) | |
555 | (setq alias (completing-read "Alias: " mh-alias-alist nil nil alias)) | |
924df208 BW |
556 | (if (and address (string-match "^<\\(.*\\)>$" address)) |
557 | (setq address (match-string 1 address))) | |
c3d9274a | 558 | (setq address (read-string "Address: " address)) |
924df208 BW |
559 | (if (string-match "^<\\(.*\\)>$" address) |
560 | (setq address (match-string 1 address))) | |
c3d9274a BW |
561 | (let ((address-alias (mh-alias-address-to-alias address)) |
562 | (alias-address (mh-alias-expand alias))) | |
563 | (if (string-equal alias-address alias) | |
564 | (setq alias-address nil)) | |
565 | (cond | |
566 | ((and (equal alias address-alias) | |
567 | (equal address alias-address)) | |
568 | (message "Already defined as: %s" alias-address)) | |
569 | (address-alias | |
570 | (if (y-or-n-p (format "Address has alias %s; set new one? " | |
571 | address-alias)) | |
572 | (mh-alias-add-alias-to-file alias address))) | |
573 | (t | |
574 | (mh-alias-add-alias-to-file alias address))))) | |
575 | ||
576 | ;;;###mh-autoload | |
577 | (defun mh-alias-grab-from-field () | |
f0d73c14 | 578 | "*Add alias for the sender of the current message." |
c3d9274a BW |
579 | (interactive) |
580 | (mh-alias-reload-maybe) | |
581 | (save-excursion | |
582 | (cond | |
583 | ((mh-folder-line-matches-show-buffer-p) | |
584 | (set-buffer mh-show-buffer)) | |
585 | ((and (eq major-mode 'mh-folder-mode) | |
586 | (mh-get-msg-num nil)) | |
587 | (set-buffer (get-buffer-create mh-temp-buffer)) | |
588 | (insert-file-contents (mh-msg-filename (mh-get-msg-num t)))) | |
589 | ((eq major-mode 'mh-folder-mode) | |
590 | (error "Cursor not pointing to a message"))) | |
924df208 BW |
591 | (let* ((address (or (mh-extract-from-header-value) |
592 | (error "Message has no From: header"))) | |
c3d9274a BW |
593 | (alias (mh-alias-suggest-alias address))) |
594 | (mh-alias-add-alias alias address)))) | |
595 | ||
596 | ;;;###mh-autoload | |
597 | (defun mh-alias-add-address-under-point () | |
f0d73c14 | 598 | "Insert an alias for address under point." |
c3d9274a BW |
599 | (interactive) |
600 | (let ((address (mh-goto-address-find-address-at-point))) | |
601 | (if address | |
602 | (mh-alias-add-alias nil address) | |
f0d73c14 | 603 | (message "No email address found under point")))) |
c3d9274a | 604 | |
a66894d8 BW |
605 | ;;;###mh-autoload |
606 | (defun mh-alias-apropos (regexp) | |
f0d73c14 | 607 | "Show all aliases or addresses that match REGEXP." |
a66894d8 BW |
608 | (interactive "sAlias regexp: ") |
609 | (if mh-alias-local-users | |
610 | (mh-alias-reload-maybe)) | |
f0d73c14 BW |
611 | (let ((matches "") |
612 | (group-matches "") | |
613 | (passwd-matches)) | |
a66894d8 BW |
614 | (save-excursion |
615 | (message "Reading MH aliases...") | |
616 | (mh-exec-cmd-quiet t "ali" "-nolist" "-nouser") | |
f0d73c14 | 617 | (message "Parsing MH aliases...") |
a66894d8 BW |
618 | (while (re-search-forward regexp nil t) |
619 | (beginning-of-line) | |
620 | (cond | |
621 | ((looking-at "^[ \t]") ;Continuation line | |
622 | (setq group-matches | |
623 | (concat group-matches | |
624 | (buffer-substring | |
625 | (save-excursion | |
626 | (or (re-search-backward "^[^ \t]" nil t) | |
627 | (point))) | |
628 | (progn | |
629 | (if (re-search-forward "^[^ \t]" nil t) | |
630 | (forward-char -1)) | |
631 | (point)))))) | |
632 | (t | |
633 | (setq matches | |
634 | (concat matches | |
635 | (buffer-substring (point)(progn (end-of-line)(point))) | |
636 | "\n"))))) | |
f0d73c14 | 637 | (message "Parsing MH aliases...done") |
a66894d8 | 638 | (when mh-alias-local-users |
f0d73c14 | 639 | (message "Making passwd aliases...") |
a66894d8 BW |
640 | (setq passwd-matches |
641 | (mapconcat | |
642 | '(lambda (elem) | |
643 | (if (or (string-match regexp (car elem)) | |
644 | (string-match regexp (cadr elem))) | |
645 | (format "%s: %s\n" (car elem) (cadr elem)))) | |
646 | mh-alias-passwd-alist "")) | |
f0d73c14 | 647 | (message "Making passwd aliases...done"))) |
a66894d8 BW |
648 | (if (and (string-equal "" matches) |
649 | (string-equal "" group-matches) | |
650 | (string-equal "" passwd-matches)) | |
651 | (message "No matches") | |
f0d73c14 | 652 | (with-output-to-temp-buffer mh-aliases-buffer |
a66894d8 BW |
653 | (if (not (string-equal "" matches)) |
654 | (princ matches)) | |
655 | (when (not (string-equal group-matches "")) | |
656 | (princ "\nGroup Aliases:\n\n") | |
657 | (princ group-matches)) | |
658 | (when (not (string-equal passwd-matches "")) | |
659 | (princ "\nLocal User Aliases:\n\n") | |
660 | (princ passwd-matches)))))) | |
661 | ||
c3d9274a BW |
662 | (provide 'mh-alias) |
663 | ||
664 | ;;; Local Variables: | |
665 | ;;; indent-tabs-mode: nil | |
666 | ;;; sentence-end-double-space: nil | |
667 | ;;; End: | |
668 | ||
ab5796a9 | 669 | ;;; arch-tag: 49879e46-5aa3-4569-bece-e5a58731d690 |
c3d9274a | 670 | ;;; mh-alias.el ends here |