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