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