diff options
| author | Richard M. Stallman | 1997-04-05 21:57:48 +0000 |
|---|---|---|
| committer | Richard M. Stallman | 1997-04-05 21:57:48 +0000 |
| commit | e694581dc0592c4dccd9c3b4aaf11b1fed50a264 (patch) | |
| tree | 68627b8d18d703985954ece6115f6634812882ee | |
| parent | 0afdd8d04101a4540a1f4ccca9afc049ebabcf20 (diff) | |
| download | emacs-e694581dc0592c4dccd9c3b4aaf11b1fed50a264.tar.gz emacs-e694581dc0592c4dccd9c3b4aaf11b1fed50a264.zip | |
(mail-complete-style): New variable.
(mail-complete): Use that.
(mail-get-names): Store full names in cdrs of mail-names elts.
(mail-names): Doc fix.
(mail-directory): Minor cleanup.
| -rw-r--r-- | lisp/mail/mailalias.el | 73 |
1 files changed, 50 insertions, 23 deletions
diff --git a/lisp/mail/mailalias.el b/lisp/mail/mailalias.el index 3b67a1f9e0e..e653c0e97bb 100644 --- a/lisp/mail/mailalias.el +++ b/lisp/mail/mailalias.el | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | ;;; mailalias.el --- expand and complete mailing address aliases | 1 | ;;; mailalias.el --- expand and complete mailing address aliases |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1985, 1987, 1995, 1996 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 1985, 1987, 1995, 1996, 1997 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Maintainer: FSF | 5 | ;; Maintainer: FSF |
| 6 | ;; Keywords: mail | 6 | ;; Keywords: mail |
| @@ -34,8 +34,9 @@ | |||
| 34 | 34 | ||
| 35 | (defvar mail-names t | 35 | (defvar mail-names t |
| 36 | "Alist of local users, aliases and directory entries as available. | 36 | "Alist of local users, aliases and directory entries as available. |
| 37 | When t this still needs to be initialized. | 37 | Elements have the form (MAILNAME) or (MAILNAME . FULLNAME). |
| 38 | This is the basis for `mail-complete'.") | 38 | If the value means t, it means the real value should be calculated |
| 39 | for the next use. this is used in `mail-complete'.") | ||
| 39 | 40 | ||
| 40 | (defvar mail-local-names t | 41 | (defvar mail-local-names t |
| 41 | "Alist of local users. | 42 | "Alist of local users. |
| @@ -67,6 +68,16 @@ When t this still needs to be initialized.") | |||
| 67 | Expression may reference variable `pattern' which is the string being completed. | 68 | Expression may reference variable `pattern' which is the string being completed. |
| 68 | If not on matching header, `mail-complete-function' gets called instead.") | 69 | If not on matching header, `mail-complete-function' gets called instead.") |
| 69 | 70 | ||
| 71 | ;;;###autoload | ||
| 72 | (defvar mail-complete-style 'angles | ||
| 73 | "*Specifies how \\[mail-complete] formats the full name when it completes. | ||
| 74 | If `nil', they contain just the return address like: | ||
| 75 | king@grassland.com | ||
| 76 | If `parens', they look like: | ||
| 77 | king@grassland.com (Elvis Parsley) | ||
| 78 | If `angles', they look like: | ||
| 79 | Elvis Parsley <king@grassland.com>") | ||
| 80 | |||
| 70 | (defvar mail-complete-function 'ispell-complete-word | 81 | (defvar mail-complete-function 'ispell-complete-word |
| 71 | "Function to call when completing outside `mail-complete-alist'-header.") | 82 | "Function to call when completing outside `mail-complete-alist'-header.") |
| 72 | 83 | ||
| @@ -328,7 +339,15 @@ current header, calls `mail-complete-function' and passes prefix arg if any." | |||
| 328 | (ding)) | 339 | (ding)) |
| 329 | ((not (string= pattern completion)) | 340 | ((not (string= pattern completion)) |
| 330 | (delete-region beg end) | 341 | (delete-region beg end) |
| 331 | (insert completion)) | 342 | (let ((alist-elt (assoc completion mail-names))) |
| 343 | (if (cdr alist-elt) | ||
| 344 | (cond ((eq mail-complete-style 'parens) | ||
| 345 | (insert completion " (" (cdr alist-elt) ")")) | ||
| 346 | ((eq mail-complete-style 'angles) | ||
| 347 | (insert (cdr alist-elt) " <" completion ">")) | ||
| 348 | (t | ||
| 349 | (insert completion))) | ||
| 350 | (insert completion)))) | ||
| 332 | (t | 351 | (t |
| 333 | (message "Making completion list...") | 352 | (message "Making completion list...") |
| 334 | (with-output-to-temp-buffer "*Completions*" | 353 | (with-output-to-temp-buffer "*Completions*" |
| @@ -338,9 +357,10 @@ current header, calls `mail-complete-function' and passes prefix arg if any." | |||
| 338 | (funcall mail-complete-function arg)))) | 357 | (funcall mail-complete-function arg)))) |
| 339 | 358 | ||
| 340 | (defun mail-get-names (pattern) | 359 | (defun mail-get-names (pattern) |
| 341 | "Fetch local users and global mail adresses for completion. | 360 | "Fetch local users and global mail addresses for completion. |
| 342 | Consults `/etc/passwd' and a directory service if one is set up via | 361 | Consults `/etc/passwd' and a directory service if one is set up via |
| 343 | `mail-directory-function'." | 362 | `mail-directory-function'. |
| 363 | PATTERN is the string we want to complete." | ||
| 344 | (if (eq mail-local-names t) | 364 | (if (eq mail-local-names t) |
| 345 | (save-excursion | 365 | (save-excursion |
| 346 | (set-buffer (generate-new-buffer " passwd")) | 366 | (set-buffer (generate-new-buffer " passwd")) |
| @@ -351,6 +371,7 @@ Consults `/etc/passwd' and a directory service if one is set up via | |||
| 351 | (if mail-passwd-command | 371 | (if mail-passwd-command |
| 352 | (call-process shell-file-name nil t nil | 372 | (call-process shell-file-name nil t nil |
| 353 | shell-command-switch mail-passwd-command)) | 373 | shell-command-switch mail-passwd-command)) |
| 374 | (beginning-of-buffer) | ||
| 354 | (setq mail-local-names nil) | 375 | (setq mail-local-names nil) |
| 355 | (while (not (eobp)) | 376 | (while (not (eobp)) |
| 356 | ;;Recognize lines like | 377 | ;;Recognize lines like |
| @@ -359,30 +380,37 @@ Consults `/etc/passwd' and a directory service if one is set up via | |||
| 359 | ;; +ethanb | 380 | ;; +ethanb |
| 360 | ;;while skipping | 381 | ;;while skipping |
| 361 | ;; +@SOFTWARE | 382 | ;; +@SOFTWARE |
| 362 | (if (looking-at "\\+?\\([^:@\n+]+\\)") | 383 | ;; The second \(...\) matches the user id. |
| 363 | (add-to-list 'mail-local-names (list (match-string 1)))) | 384 | (if (looking-at "\\+?\\([^:@\n+]+\\):[^:\n]*:\\([^\n:]*\\):") |
| 385 | (add-to-list 'mail-local-names | ||
| 386 | (cons (match-string 1) | ||
| 387 | (user-full-name | ||
| 388 | (string-to-int (match-string 2)))))) | ||
| 364 | (beginning-of-line 2)) | 389 | (beginning-of-line 2)) |
| 365 | (kill-buffer (current-buffer)))) | 390 | (kill-buffer (current-buffer)))) |
| 366 | (if (or (eq mail-names t) | 391 | (if (or (eq mail-names t) |
| 367 | (eq mail-directory-names t)) | 392 | (eq mail-directory-names t)) |
| 368 | (let (directory) | 393 | (let (directory) |
| 369 | (and mail-directory-function | 394 | (and mail-directory-function |
| 370 | (eq mail-directory-names t) | 395 | (eq mail-directory-names t) |
| 371 | (setq directory | 396 | (setq directory |
| 372 | (mail-directory (if mail-directory-requery pattern)))) | 397 | (mail-directory (if mail-directory-requery pattern)))) |
| 398 | (or mail-directory-requery | ||
| 399 | (setq mail-directory-names directory)) | ||
| 373 | (if (or directory | 400 | (if (or directory |
| 374 | (eq mail-names t)) | 401 | (eq mail-names t)) |
| 375 | (setq mail-names | 402 | (setq mail-names |
| 376 | (sort (append (if (consp mail-aliases) mail-aliases) | 403 | (sort (append (if (consp mail-aliases) |
| 404 | (mapcar | ||
| 405 | (function (lambda (a) (list (car a)))) | ||
| 406 | mail-aliases)) | ||
| 377 | (if (consp mail-local-names) | 407 | (if (consp mail-local-names) |
| 378 | mail-local-names) | 408 | mail-local-names) |
| 379 | directory) | 409 | (or directory mail-directory-names)) |
| 380 | (lambda (a b) | 410 | (lambda (a b) |
| 381 | ;; should cache downcased strings | 411 | ;; should cache downcased strings |
| 382 | (string< (downcase (car a)) | 412 | (string< (downcase (car a)) |
| 383 | (downcase (car b))))))) | 413 | (downcase (car b))))))))) |
| 384 | (or mail-directory-requery | ||
| 385 | (setq mail-directory-names directory)))) | ||
| 386 | mail-names) | 414 | mail-names) |
| 387 | 415 | ||
| 388 | 416 | ||
| @@ -398,19 +426,18 @@ Calls `mail-directory-function' and applies `mail-directory-parser' to output." | |||
| 398 | (if (stringp mail-directory-parser) | 426 | (if (stringp mail-directory-parser) |
| 399 | (while (re-search-forward mail-directory-parser nil t) | 427 | (while (re-search-forward mail-directory-parser nil t) |
| 400 | (setq directory | 428 | (setq directory |
| 401 | `((,(match-string 1)) | 429 | (cons (match-string 1) directory))) |
| 402 | ,@directory))) | ||
| 403 | (if mail-directory-parser | 430 | (if mail-directory-parser |
| 404 | (setq directory (funcall mail-directory-parser)) | 431 | (setq directory (funcall mail-directory-parser)) |
| 405 | (while (not (eobp)) | 432 | (while (not (eobp)) |
| 406 | (setq directory | 433 | (setq directory |
| 407 | `((,(buffer-substring (point) | 434 | (cons (buffer-substring (point) |
| 408 | (progn | 435 | (progn |
| 409 | (forward-line) | 436 | (forward-line) |
| 410 | (if (bolp) | 437 | (if (bolp) |
| 411 | (1- (point)) | 438 | (1- (point)) |
| 412 | (point))))) | 439 | (point)))) |
| 413 | ,@directory))))) | 440 | directory))))) |
| 414 | (kill-buffer (current-buffer)) | 441 | (kill-buffer (current-buffer)) |
| 415 | (message "Querying directory...done") | 442 | (message "Querying directory...done") |
| 416 | directory))) | 443 | directory))) |