Mercurial > hg > xemacs-beta
comparison lisp/modes/mail-abbrevs.el @ 0:376386a54a3c r19-14
Import from CVS: tag r19-14
| author | cvs |
|---|---|
| date | Mon, 13 Aug 2007 08:45:50 +0200 |
| parents | |
| children | b82b59fe008d |
comparison
equal
deleted
inserted
replaced
| -1:000000000000 | 0:376386a54a3c |
|---|---|
| 1 ;;; Abbrev-expansion of mail aliases. | |
| 2 ;;; Copyright (C) 1985-1994 Free Software Foundation, Inc. | |
| 3 ;;; Created: 19 oct 90, Jamie Zawinski <jwz@lucid.com> | |
| 4 ;;; Modified: 5 apr 92, Roland McGrath <roland@gnu.ai.mit.edu> | |
| 5 ;;; Last change 4-may-94. jwz | |
| 6 | |
| 7 ;; This file is part of XEmacs. | |
| 8 | |
| 9 ;; XEmacs is free software; you can redistribute it and/or modify it | |
| 10 ;; under the terms of the GNU General Public License as published by | |
| 11 ;; the Free Software Foundation; either version 2, or (at your option) | |
| 12 ;; any later version. | |
| 13 | |
| 14 ;; XEmacs is distributed in the hope that it will be useful, but | |
| 15 ;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
| 17 ;; General Public License for more details. | |
| 18 | |
| 19 ;; You should have received a copy of the GNU General Public License | |
| 20 ;; along with XEmacs; see the file COPYING. If not, write to the Free | |
| 21 ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | |
| 22 | |
| 23 ;;; This file ensures that, when the point is in a To:, CC:, BCC:, or From: | |
| 24 ;;; field, word-abbrevs are defined for each of your mail aliases. These | |
| 25 ;;; aliases will be defined from your .mailrc file (or the file specified by | |
| 26 ;;; the MAILRC environment variable) if it exists. Your mail aliases will | |
| 27 ;;; expand any time you type a word-delimiter at the end of an abbreviation. | |
| 28 ;;; | |
| 29 ;;; What you see is what you get: no abbreviations will be expanded after you | |
| 30 ;;; have sent the mail, unlike the old system. This means you don't suffer | |
| 31 ;;; the annoyance of having the system do things behind your back -- if an | |
| 32 ;;; address you typed is going to be rewritten, you know it immediately, | |
| 33 ;;; instead of after the mail has been sent and it's too late to do anything | |
| 34 ;;; about it. You will never again be screwed because you forgot to delete an | |
| 35 ;;; old alias from your .mailrc when a new local user arrives and is given a | |
| 36 ;;; userid which conflicts with one of your aliases, for example. | |
| 37 ;;; | |
| 38 ;;; Your mail alias abbrevs will be in effect only when the point is in an | |
| 39 ;;; appropriate header field. When in the body of the message, or other | |
| 40 ;;; header fields, the mail aliases will not expand. Rather, the normal | |
| 41 ;;; mode-specific abbrev table (mail-mode-abbrev-table) will be used if | |
| 42 ;;; defined. So if you use mail-mode specific abbrevs, this code will not | |
| 43 ;;; adversely affect you. You can control which header fields the abbrevs | |
| 44 ;;; are used in by changing the variable mail-abbrev-mode-regexp. | |
| 45 ;;; | |
| 46 ;;; If auto-fill mode is on, abbrevs will wrap at commas instead of at word | |
| 47 ;;; boundaries; also, header continuation-lines will be properly indented. | |
| 48 ;;; | |
| 49 ;;; You can also insert a mail alias with mail-interactive-insert-alias | |
| 50 ;;; (bound to C-c C-a), which prompts you for an alias (with completion) | |
| 51 ;;; and inserts its expansion at point. | |
| 52 ;;; | |
| 53 ;;; This file fixes a bug in the old system which prohibited your .mailrc | |
| 54 ;;; file from having lines like | |
| 55 ;;; | |
| 56 ;;; alias someone "John Doe <doe@quux.com>" | |
| 57 ;;; | |
| 58 ;;; That is, if you want an address to have embedded spaces, simply surround it | |
| 59 ;;; with quotes. This is necessary because the format of the .mailrc file | |
| 60 ;;; bogusly uses spaces as address delimiters. The following line defines an | |
| 61 ;;; alias which expands to three addresses: | |
| 62 ;;; | |
| 63 ;;; alias foobar addr-1 addr-2 "address three <addr-3>" | |
| 64 ;;; | |
| 65 ;;; (This is bogus because mail-delivery programs want commas, not spaces, | |
| 66 ;;; but that's what the file format is, so we have to live with it.) | |
| 67 ;;; | |
| 68 ;;; If you like, you can call the function define-mail-alias to define your | |
| 69 ;;; mail-aliases instead of using a .mailrc file. When you call it in this | |
| 70 ;;; way, addresses are separated by commas. | |
| 71 ;;; | |
| 72 ;;; CAVEAT: This works on most Sun systems; I have been told that some versions | |
| 73 ;;; of /bin/mail do not understand double-quotes in the .mailrc file. So you | |
| 74 ;;; should make sure your version does before including verbose addresses like | |
| 75 ;;; this. One solution to this, if you are on a system whose /bin/mail doesn't | |
| 76 ;;; work that way, (and you still want to be able to /bin/mail to send mail in | |
| 77 ;;; addition to emacs) is to define minimal aliases (without full names) in | |
| 78 ;;; your .mailrc file, and use define-mail-alias to redefine them when sending | |
| 79 ;;; mail from emacs; this way, mail sent from /bin/mail will work, and mail | |
| 80 ;;; sent from emacs will be pretty. | |
| 81 ;;; | |
| 82 ;;; Aliases in the mailrc file may be nested. If you define aliases like | |
| 83 ;;; alias group1 fred ethel | |
| 84 ;;; alias group2 larry curly moe | |
| 85 ;;; alias everybody group1 group2 | |
| 86 ;;; Then when you type "everybody" on the To: line, it will be expanded to | |
| 87 ;;; fred, ethyl, larry, curly, moe | |
| 88 ;;; | |
| 89 ;;; Aliases may also contain forward references; the alias of "everybody" can | |
| 90 ;;; preceed the aliases of "group1" and "group2". | |
| 91 ;;; | |
| 92 ;;; This code also understands the "source" .mailrc command, for reading | |
| 93 ;;; aliases from some other file as well. | |
| 94 ;;; | |
| 95 ;;; Aliases may contain hyphens, as in "alias foo-bar foo@bar"; word-abbrevs | |
| 96 ;;; normally cannot contain hyphens, but this code works around that for the | |
| 97 ;;; specific case of mail-alias word-abbrevs. | |
| 98 ;;; | |
| 99 ;;; To read in the contents of another .mailrc-type file from emacs, use the | |
| 100 ;;; command Meta-X merge-mail-aliases. The rebuild-mail-aliases command is | |
| 101 ;;; similar, but will delete existing aliases first. | |
| 102 ;;; | |
| 103 ;;; If you want multiple addresses separated by a string other than ", " then | |
| 104 ;;; you can set the variable mail-alias-separator-string to it. This has to | |
| 105 ;;; be a comma bracketed by whitespace if you want any kind of reasonable | |
| 106 ;;; behaviour. | |
| 107 ;;; | |
| 108 ;;; Some versions of /bin/mail append the contents of multiple definitions of | |
| 109 ;;; the same alias together, so that | |
| 110 ;;; alias group one two three | |
| 111 ;;; alias group four five | |
| 112 ;;; would define "group" as "one two three four five" instead of "four five". | |
| 113 ;;; This code does *not* support that syntax, because it's a horrible syntax | |
| 114 ;;; and isn't worth the effort or added code complexity. (So there.) | |
| 115 ;;; | |
| 116 ;;; Thanks to Harald Hanche-Olsen, Michael Ernst, David Loeffler, Noah | |
| 117 ;;; Friedman, and Michelangelo Grigni for suggestions and bug reports. | |
| 118 ;;; | |
| 119 ;;; INSTALLATION | |
| 120 ;;; | |
| 121 ;;; If you are using Emacs 18, you shouldn't have to do anything at all to | |
| 122 ;;; install this code other than load this file. You might want to do this | |
| 123 ;;; to have this code loaded only when needed: | |
| 124 ;;; | |
| 125 ;;; (setq mail-setup-hook '(lambda () (require 'mail-abbrevs))) | |
| 126 ;;; | |
| 127 ;;; Simply loading this file will redefine and overload the required | |
| 128 ;;; functions. | |
| 129 ;;; | |
| 130 ;;; If you want to install this code more permanently (instead of loading | |
| 131 ;;; it as a patch) you need to do the following: | |
| 132 ;;; | |
| 133 ;;; - Remove the entire file mailalias.el; | |
| 134 ;;; - Remove the definition of mail-aliases from sendmail.el; | |
| 135 ;;; - Add a call to mail-aliases-setup to the front of the function | |
| 136 ;;; mail-setup in the file sendmail.el; | |
| 137 ;;; - Remove the call to expand-mail-aliases from the function | |
| 138 ;;; sendmail-send-it in the file sendmail.el; | |
| 139 ;;; - Remove the autoload of expand-mail-aliases from the file sendmail.el; | |
| 140 ;;; - Remove the autoload of build-mail-aliases from the file sendmail.el; | |
| 141 ;;; - Add an autoload of define-mail-alias to loaddefs.el. | |
| 142 | |
| 143 (require 'sendmail) | |
| 144 | |
| 145 ;;;###autoload | |
| 146 (defvar mail-abbrev-mailrc-file nil | |
| 147 "Name of file with mail aliases. If nil, ~/.mailrc is used.") | |
| 148 | |
| 149 (defmacro mail-abbrev-mailrc-file () | |
| 150 '(or mail-abbrev-mailrc-file | |
| 151 (setq mail-abbrev-mailrc-file | |
| 152 (or (getenv "MAILRC") "~/.mailrc")))) | |
| 153 | |
| 154 ;; originally defined in sendmail.el - used to be an alist, now is a table. | |
| 155 ;;;###autoload | |
| 156 (defvar mail-aliases nil | |
| 157 "Word-abbrev table of mail address aliases. | |
| 158 If this is nil, it means the aliases have not yet been initialized and | |
| 159 should be read from the .mailrc file. (This is distinct from there being | |
| 160 no aliases, which is represented by this being a table with no entries.)") | |
| 161 | |
| 162 ;;;###autoload | |
| 163 (defun mail-aliases-setup () | |
| 164 (if (and (not (vectorp mail-aliases)) | |
| 165 (file-exists-p (mail-abbrev-mailrc-file))) | |
| 166 (build-mail-aliases)) | |
| 167 (make-local-variable 'pre-abbrev-expand-hook) | |
| 168 (setq pre-abbrev-expand-hook | |
| 169 (cond ((and (listp pre-abbrev-expand-hook) | |
| 170 (not (eq 'lambda (car pre-abbrev-expand-hook)))) | |
| 171 (cons 'sendmail-pre-abbrev-expand-hook pre-abbrev-expand-hook)) | |
| 172 (t | |
| 173 (list 'sendmail-pre-abbrev-expand-hook pre-abbrev-expand-hook)))) | |
| 174 (abbrev-mode 1)) | |
| 175 | |
| 176 ;;; Originally defined in mailalias.el. Changed to call define-mail-alias | |
| 177 ;;; with an additional argument. | |
| 178 ;;;###autoload | |
| 179 (defun build-mail-aliases (&optional file recursivep) | |
| 180 "Read mail aliases from .mailrc and set mail-aliases." | |
| 181 (setq file (expand-file-name (or file (mail-abbrev-mailrc-file)))) | |
| 182 (or (vectorp mail-aliases) | |
| 183 (setq mail-aliases (make-abbrev-table))) | |
| 184 (message "Parsing %s..." file) | |
| 185 (let ((buffer nil) | |
| 186 (obuf (current-buffer))) | |
| 187 (unwind-protect | |
| 188 (progn | |
| 189 (setq buffer (generate-new-buffer "mailrc")) | |
| 190 (buffer-disable-undo buffer) | |
| 191 (set-buffer buffer) | |
| 192 (cond ((get-file-buffer file) | |
| 193 (insert (save-excursion | |
| 194 (set-buffer (get-file-buffer file)) | |
| 195 (buffer-substring (point-min) (point-max))))) | |
| 196 ((not (file-exists-p file))) | |
| 197 (t (insert-file-contents file))) | |
| 198 ;; Don't lose if no final newline. | |
| 199 (goto-char (point-max)) | |
| 200 (or (eq (preceding-char) ?\n) (newline)) | |
| 201 (goto-char (point-min)) | |
| 202 ;; Delete comments from the file | |
| 203 (while (search-forward "# " nil t) | |
| 204 (let ((p (- (point) 2))) | |
| 205 (end-of-line) | |
| 206 (delete-region p (point)))) | |
| 207 (goto-char (point-min)) | |
| 208 ;; handle "\\\n" continuation lines | |
| 209 (while (not (eobp)) | |
| 210 (end-of-line) | |
| 211 (if (= (preceding-char) ?\\) | |
| 212 (progn (delete-char -1) (delete-char 1) (insert ?\ )) | |
| 213 (forward-char 1))) | |
| 214 (goto-char (point-min)) | |
| 215 (while (re-search-forward | |
| 216 "^\\(a\\(lias\\)?\\|g\\(roup\\)?\\|source\\)[ \t]+" nil t) | |
| 217 (beginning-of-line) | |
| 218 (if (looking-at "source[ \t]+\\([^ \t\n]+\\)") | |
| 219 (progn | |
| 220 (end-of-line) | |
| 221 (build-mail-aliases | |
| 222 (substitute-in-file-name | |
| 223 (buffer-substring (match-beginning 1) (match-end 1))) | |
| 224 t)) | |
| 225 (re-search-forward "[ \t]+\\([^ \t\n]+\\)") | |
| 226 (let* ((name (buffer-substring | |
| 227 (match-beginning 1) (match-end 1))) | |
| 228 (start (progn (skip-chars-forward " \t") (point)))) | |
| 229 (end-of-line) | |
| 230 ; (message "** %s \"%s\"" name (buffer-substring start (point)))(sit-for 1) | |
| 231 (define-mail-alias | |
| 232 name | |
| 233 (buffer-substring start (point)) | |
| 234 t)))) | |
| 235 ;; Resolve forward references in .mailrc file. | |
| 236 ;; This would happen automatically before the first abbrev was | |
| 237 ;; expanded, but why not do it now. | |
| 238 (or recursivep (mail-resolve-all-aliases)) | |
| 239 ) | |
| 240 (if buffer (kill-buffer buffer)) | |
| 241 (set-buffer obuf))) | |
| 242 (message "Parsing %s... done" file)) | |
| 243 | |
| 244 (defvar mail-alias-separator-string ", " | |
| 245 "*A string inserted between addresses in multi-address mail aliases. | |
| 246 This has to contain a comma, so \", \" is a reasonable value. You might | |
| 247 also want something like \",\\n \" to get each address on its own line.") | |
| 248 | |
| 249 ;; define-mail-alias sets this flag, which causes mail-resolve-all-aliases | |
| 250 ;; to be called before expanding abbrevs if it's necessary. | |
| 251 (defvar mail-abbrev-aliases-need-to-be-resolved t) | |
| 252 | |
| 253 ;; originally defined in mailalias.el ; build-mail-aliases calls this with | |
| 254 ;; stuff parsed from the .mailrc file. | |
| 255 ;; | |
| 256 ;;;###autoload | |
| 257 (defun define-mail-alias (name definition &optional from-mailrc-file) | |
| 258 "Define NAME as a mail-alias that translates to DEFINITION. | |
| 259 If DEFINITION contains multiple addresses, separate them with commas." | |
| 260 ;; When this is called from build-mail-aliases, the third argument is | |
| 261 ;; true, and we do some evil space->comma hacking like /bin/mail does. | |
| 262 (interactive "sDefine mail alias: \nsDefine %s as mail alias for: ") | |
| 263 ;; Read the defaults first, if we have not done so. | |
| 264 (if (vectorp mail-aliases) | |
| 265 nil | |
| 266 (setq mail-aliases (make-abbrev-table)) | |
| 267 (if (file-exists-p (mail-abbrev-mailrc-file)) | |
| 268 (build-mail-aliases))) | |
| 269 ;; strip garbage from front and end | |
| 270 (if (string-match "\\`[ \t\n,]+" definition) | |
| 271 (setq definition (substring definition (match-end 0)))) | |
| 272 (if (string-match "[ \t\n,]+\\'" definition) | |
| 273 (setq definition (substring definition 0 (match-beginning 0)))) | |
| 274 (let ((result '()) | |
| 275 (start 0) | |
| 276 (L (length definition)) | |
| 277 end) | |
| 278 (while start | |
| 279 ;; If we're reading from the mailrc file, then addresses are delimited | |
| 280 ;; by spaces, and addresses with embedded spaces must be surrounded by | |
| 281 ;; single or double-quotes. Otherwise, addresses are separated by | |
| 282 ;; commas. | |
| 283 (if from-mailrc-file | |
| 284 (cond ((eq ?\" (aref definition start)) | |
| 285 (setq start (1+ start) | |
| 286 end (string-match "\"[ \t,]*" definition start))) | |
| 287 ((eq ?\' (aref definition start)) | |
| 288 (setq start (1+ start) | |
| 289 end (string-match "\'[ \t,]*" definition start))) | |
| 290 (t | |
| 291 (setq end (string-match "[ \t,]+" definition start)))) | |
| 292 (setq end (string-match "[ \t\n,]*,[ \t\n,]*" definition start))) | |
| 293 (setq result (cons (substring definition start end) result)) | |
| 294 (setq start (and end | |
| 295 (/= (match-end 0) L) | |
| 296 (match-end 0)))) | |
| 297 (setq definition (mapconcat (function identity) | |
| 298 (nreverse result) | |
| 299 mail-alias-separator-string))) | |
| 300 (setq mail-abbrev-aliases-need-to-be-resolved t) | |
| 301 (setq name (downcase name)) | |
| 302 ;; use an abbrev table instead of an alist for mail-aliases. | |
| 303 (let ((abbrevs-changed abbrevs-changed)) ; protect this from being changed. | |
| 304 (define-abbrev mail-aliases name definition 'mail-abbrev-expand-hook))) | |
| 305 | |
| 306 | |
| 307 (defun mail-resolve-all-aliases () | |
| 308 "Resolve all forward references in the mail aliases table." | |
| 309 (if mail-abbrev-aliases-need-to-be-resolved | |
| 310 (progn | |
| 311 ;; (message "Resolving mail aliases...") | |
| 312 (if (vectorp mail-aliases) | |
| 313 (mapatoms (function mail-resolve-all-aliases-1) mail-aliases)) | |
| 314 (setq mail-abbrev-aliases-need-to-be-resolved nil) | |
| 315 ;; (message "Resolving mail aliases... done.") | |
| 316 ))) | |
| 317 | |
| 318 (defun mail-resolve-all-aliases-1 (sym &optional so-far) | |
| 319 (if (memq sym so-far) | |
| 320 (error "mail alias loop detected: %s" | |
| 321 (mapconcat 'symbol-name (cons sym so-far) " <- "))) | |
| 322 (let ((definition (and (boundp sym) (symbol-value sym)))) | |
| 323 (if definition | |
| 324 (let ((result '()) | |
| 325 (start 0)) | |
| 326 (while start | |
| 327 (let ((end (string-match "[ \t\n]*,[, \t\n]*" definition start))) | |
| 328 (setq result (cons (substring definition start end) result) | |
| 329 start (and end (match-end 0))))) | |
| 330 (setq definition | |
| 331 (mapconcat (function (lambda (x) | |
| 332 (or (mail-resolve-all-aliases-1 | |
| 333 (intern-soft (downcase x) mail-aliases) | |
| 334 (cons sym so-far)) | |
| 335 x))) | |
| 336 (nreverse result) | |
| 337 mail-alias-separator-string)) | |
| 338 (set sym definition)))) | |
| 339 (symbol-value sym)) | |
| 340 | |
| 341 | |
| 342 (defun mail-abbrev-expand-hook () | |
| 343 "For use as the fourth arg to define-abbrev. | |
| 344 After expanding a mail-abbrev, if fill-mode is on and we're past the | |
| 345 fill-column, break the line at the previous comma, and indent the next | |
| 346 line." | |
| 347 (save-excursion | |
| 348 (let ((p (point)) | |
| 349 bol comma fp) | |
| 350 (beginning-of-line) | |
| 351 (setq bol (point)) | |
| 352 (goto-char p) | |
| 353 (while (and auto-fill-function | |
| 354 (>= (current-column) fill-column) | |
| 355 (search-backward "," bol t)) | |
| 356 (setq comma (point)) | |
| 357 (forward-char 1) ; Now we are just past the comma. | |
| 358 (insert "\n") | |
| 359 (delete-horizontal-space) | |
| 360 (setq p (point)) | |
| 361 (indent-relative) | |
| 362 (setq fp (buffer-substring p (point))) | |
| 363 ;; Go to the end of the new line. | |
| 364 (end-of-line) | |
| 365 (if (> (current-column) fill-column) | |
| 366 ;; It's still too long; do normal auto-fill. | |
| 367 (let ((fill-prefix (or fp "\t"))) | |
| 368 (do-auto-fill))) | |
| 369 ;; Resume the search. | |
| 370 (goto-char comma) | |
| 371 )))) | |
| 372 | |
| 373 ;;; Syntax tables and abbrev-expansion | |
| 374 | |
| 375 (defvar mail-abbrev-mode-regexp | |
| 376 "^\\(Resent-\\)?\\(To\\|From\\|CC\\|BCC\\|Reply-to\\):" | |
| 377 "*Regexp to select mail-headers in which mail aliases should be expanded. | |
| 378 This string it will be handed to `looking-at' with the point at the beginning | |
| 379 of the current line; if it matches, abbrev mode will be turned on, otherwise | |
| 380 it will be turned off. (You don't need to worry about continuation lines.) | |
| 381 This should be set to match those mail fields in which you want abbreviations | |
| 382 turned on.") | |
| 383 | |
| 384 (defvar mail-mode-syntax-table (copy-syntax-table text-mode-syntax-table) | |
| 385 "The syntax table which is used in send-mail mode message bodies.") | |
| 386 | |
| 387 (defvar mail-mode-header-syntax-table | |
| 388 (let ((tab (copy-syntax-table text-mode-syntax-table))) | |
| 389 ;; This makes the characters "@%!._-" be considered symbol-consituents | |
| 390 ;; but not word-constituents, so forward-sexp will move you over an | |
| 391 ;; entire address, but forward-word will only move you over a sequence | |
| 392 ;; of alphanumerics. (Clearly the right thing.) | |
| 393 (modify-syntax-entry ?@ "_" tab) | |
| 394 (modify-syntax-entry ?% "_" tab) | |
| 395 (modify-syntax-entry ?! "_" tab) | |
| 396 (modify-syntax-entry ?. "_" tab) | |
| 397 (modify-syntax-entry ?_ "_" tab) | |
| 398 (modify-syntax-entry ?- "_" tab) | |
| 399 (modify-syntax-entry ?< "(>" tab) | |
| 400 (modify-syntax-entry ?> ")<" tab) | |
| 401 tab) | |
| 402 "The syntax table used in send-mail mode when in a mail-address header. | |
| 403 mail-mode-syntax-table is used when the cursor is in the message body or in | |
| 404 non-address headers.") | |
| 405 | |
| 406 (defvar mail-abbrev-syntax-table | |
| 407 (let* ((tab (copy-syntax-table mail-mode-header-syntax-table)) | |
| 408 (i (1- (length tab))) | |
| 409 (_ (aref (standard-syntax-table) ?_)) | |
| 410 (w (aref (standard-syntax-table) ?w))) | |
| 411 (while (>= i 0) | |
| 412 (if (= (aref tab i) _) (aset tab i w)) | |
| 413 (setq i (1- i))) | |
| 414 tab) | |
| 415 "The syntax-table used for abbrev-expansion purposes; this is not actually | |
| 416 made the current syntax table of the buffer, but simply controls the set of | |
| 417 characters which may be a part of the name of a mail-alias.") | |
| 418 | |
| 419 | |
| 420 (defun mail-abbrev-in-expansion-header-p () | |
| 421 "Whether point is in a mail-address header field." | |
| 422 (let ((case-fold-search t)) | |
| 423 (and ;; | |
| 424 ;; we are on an appropriate header line... | |
| 425 (save-excursion | |
| 426 (beginning-of-line) | |
| 427 ;; skip backwards over continuation lines. | |
| 428 (while (and (looking-at "^[ \t]") | |
| 429 (not (= (point) (point-min)))) | |
| 430 (forward-line -1)) | |
| 431 ;; are we at the front of an appropriate header line? | |
| 432 (looking-at mail-abbrev-mode-regexp)) | |
| 433 ;; | |
| 434 ;; ...and we are before the mail-header-separator | |
| 435 (< (point) | |
| 436 (save-excursion | |
| 437 (goto-char (point-min)) | |
| 438 (search-forward (concat "\n" mail-header-separator "\n") | |
| 439 nil 0) | |
| 440 (point)))))) | |
| 441 | |
| 442 (defvar mail-mode-abbrev-table) ; quiet the compiler | |
| 443 | |
| 444 (defun sendmail-pre-abbrev-expand-hook () | |
| 445 (if mail-abbrev-aliases-need-to-be-resolved | |
| 446 (mail-resolve-all-aliases)) | |
| 447 (if (and mail-aliases (not (eq mail-aliases t))) | |
| 448 (if (not (mail-abbrev-in-expansion-header-p)) | |
| 449 ;; | |
| 450 ;; If we're not in a mail header in which mail aliases should | |
| 451 ;; be expanded, then use the normal mail-mode abbrev table (if any) | |
| 452 ;; and the normal mail-mode syntax table. | |
| 453 ;; | |
| 454 (progn | |
| 455 (setq local-abbrev-table (and (boundp 'mail-mode-abbrev-table) | |
| 456 mail-mode-abbrev-table)) | |
| 457 (set-syntax-table mail-mode-syntax-table)) | |
| 458 ;; | |
| 459 ;; Otherwise, we are in a To: (or CC:, or whatever) header, and | |
| 460 ;; should use word-abbrevs to expand mail aliases. | |
| 461 ;; - First, install the mail-aliases as the word-abbrev table. | |
| 462 ;; - Then install the mail-abbrev-syntax-table, which temporarily | |
| 463 ;; marks all of the non-alphanumeric-atom-characters (the "_" | |
| 464 ;; syntax ones) as being normal word-syntax. We do this because | |
| 465 ;; the C code for expand-abbrev only works on words, and we want | |
| 466 ;; these characters to be considered words for the purpose of | |
| 467 ;; abbrev expansion. | |
| 468 ;; - Then we call expand-abbrev again, recursively, to do the abbrev | |
| 469 ;; expansion with the above syntax table. | |
| 470 ;; - Then we do a trick which tells the expand-abbrev frame which | |
| 471 ;; invoked us to not continue (and thus not expand twice.) | |
| 472 ;; This means that any abbrev expansion will happen as a result | |
| 473 ;; of this function's call to expand-abbrev, and not as a result | |
| 474 ;; of the call to expand-abbrev which invoked *us*. | |
| 475 ;; - Then we set the syntax table to mail-mode-header-syntax-table, | |
| 476 ;; which doesn't have anything to do with abbrev expansion, but | |
| 477 ;; is just for the user's convenience (see its doc string.) | |
| 478 ;; | |
| 479 (setq local-abbrev-table mail-aliases) | |
| 480 ;; If the character just typed was non-alpha-symbol-syntax, then don't | |
| 481 ;; expand the abbrev now (that is, don't expand when the user types -.) | |
| 482 ;; Check the character's syntax in the mail-mode-header-syntax-table. | |
| 483 (set-syntax-table mail-mode-header-syntax-table) | |
| 484 (or (and last-command-char | |
| 485 (eq (char-syntax last-command-char) ?_)) | |
| 486 (let ((pre-abbrev-expand-hook nil)) ; That's us; don't loop. | |
| 487 ;; Use this table so that abbrevs can have hyphens in them. | |
| 488 (set-syntax-table mail-abbrev-syntax-table) | |
| 489 (expand-abbrev) | |
| 490 ;; Now set it back to what it was before. | |
| 491 (set-syntax-table mail-mode-header-syntax-table))) | |
| 492 (setq abbrev-start-location (point) ; This is the trick. | |
| 493 abbrev-start-location-buffer (current-buffer)) | |
| 494 ))) | |
| 495 | |
| 496 | |
| 497 ;;; Reading addresses from the minibuffer; by David Hughes <djh@Harston.CV.COM> | |
| 498 | |
| 499 (defun mail-abbrev-minibuffer-setup-hook () | |
| 500 ;; Use as the value of minibuffer-setup-hook when reading addresses | |
| 501 ;; from the minibuffer, as in: | |
| 502 ;; (let ((minibuffer-setup-hook 'mail-abbrev-minibuffer-setup-hook)) | |
| 503 ;; (read-string "Who: ")) | |
| 504 (if (and (not (vectorp mail-aliases)) | |
| 505 (file-exists-p (mail-abbrev-mailrc-file))) | |
| 506 (build-mail-aliases)) | |
| 507 (make-local-variable 'pre-abbrev-expand-hook) | |
| 508 (setq pre-abbrev-expand-hook | |
| 509 (function | |
| 510 (lambda () | |
| 511 (setq local-abbrev-table mail-aliases) | |
| 512 (set-syntax-table mail-mode-header-syntax-table) | |
| 513 (or (and last-command-char | |
| 514 (eq (char-syntax last-command-char) ?_)) | |
| 515 (let ((pre-abbrev-expand-hook nil)) ; That's us; don't loop. | |
| 516 ;; Use this table so that abbrevs can have hyphens in them. | |
| 517 (set-syntax-table mail-abbrev-syntax-table) | |
| 518 (expand-abbrev) | |
| 519 ;; Now set it back to what it was before. | |
| 520 (set-syntax-table mail-mode-header-syntax-table))) | |
| 521 (setq abbrev-start-location (point) ; This is the trick. | |
| 522 abbrev-start-location-buffer (current-buffer))))) | |
| 523 (abbrev-mode 1)) | |
| 524 | |
| 525 | |
| 526 ;;; utilities | |
| 527 | |
| 528 (defun merge-mail-aliases (file) | |
| 529 "Merge mail aliases from the given file with existing ones." | |
| 530 (interactive (list | |
| 531 (let ((insert-default-directory t) | |
| 532 (default-directory (expand-file-name "~/")) | |
| 533 (def (mail-abbrev-mailrc-file))) | |
| 534 (read-file-name | |
| 535 (format "Read additional aliases from file: (default %s) " | |
| 536 def) | |
| 537 default-directory | |
| 538 (expand-file-name def default-directory) | |
| 539 t)))) | |
| 540 (build-mail-aliases file)) | |
| 541 | |
| 542 (defun rebuild-mail-aliases (file) | |
| 543 "Rebuild all the mail aliases from the given file." | |
| 544 (interactive (list | |
| 545 (let ((insert-default-directory t) | |
| 546 (default-directory (expand-file-name "~/")) | |
| 547 (def (mail-abbrev-mailrc-file))) | |
| 548 (read-file-name | |
| 549 (format "Read mail aliases from file: (default %s) " def) | |
| 550 default-directory | |
| 551 (expand-file-name def default-directory) | |
| 552 t)))) | |
| 553 (setq mail-aliases nil) | |
| 554 (build-mail-aliases file)) | |
| 555 | |
| 556 (defun mail-interactive-insert-alias (&optional alias) | |
| 557 "Prompt for and insert a mail alias." | |
| 558 (interactive (progn | |
| 559 (if (not (vectorp mail-aliases)) (mail-aliases-setup)) | |
| 560 (list (completing-read "Expand alias: " mail-aliases nil t)))) | |
| 561 (if (not (vectorp mail-aliases)) (mail-aliases-setup)) | |
| 562 (insert (or (and alias (symbol-value (intern-soft alias mail-aliases))) ""))) | |
| 563 | |
| 564 ;; call-interactively is so that zmacs-regions gets hacked correctly | |
| 565 ;; without making the interactive specs incompatible with v18. | |
| 566 | |
| 567 (defun abbrev-hacking-next-line () | |
| 568 "Just like `next-line' (\\<global-map>\\[next-line]) but expands abbrevs \ | |
| 569 when at end of line." | |
| 570 (interactive) | |
| 571 (if (and (looking-at "[ \t]*\n") | |
| 572 (= (char-syntax (preceding-char)) ?w)) | |
| 573 (expand-abbrev)) | |
| 574 (setq this-command 'next-line) | |
| 575 (call-interactively 'next-line)) | |
| 576 | |
| 577 (defun abbrev-hacking-end-of-buffer () | |
| 578 "Just like `end-of-buffer' (\\<global-map>\\[end-of-buffer]) but expands \ | |
| 579 abbrevs when at end of buffer." | |
| 580 (interactive) | |
| 581 (if (and (looking-at "[ \t]*\n") | |
| 582 (= (char-syntax (preceding-char)) ?w)) | |
| 583 (expand-abbrev)) | |
| 584 (setq this-command 'end-of-buffer) | |
| 585 (call-interactively 'end-of-buffer)) | |
| 586 | |
| 587 (define-key mail-mode-map "\C-c\C-a" 'mail-interactive-insert-alias) | |
| 588 | |
| 589 ;(define-key mail-mode-map "\C-n" 'abbrev-hacking-next-line) | |
| 590 ;(define-key mail-mode-map "\M->" 'abbrev-hacking-end-of-buffer) | |
| 591 (let ((subst '((next-line . abbrev-hacking-next-line) | |
| 592 (fkey-next-line . abbrev-hacking-next-line) | |
| 593 (end-of-buffer . abbrev-hacking-end-of-buffer) | |
| 594 (fkey-end-of-buffer . abbrev-hacking-end-of-buffer) | |
| 595 ))) | |
| 596 (while subst | |
| 597 (let ((keys | |
| 598 (delq nil | |
| 599 (nconc (where-is-internal (car (car subst)) mail-mode-map) | |
| 600 (where-is-internal (car (car subst))))))) | |
| 601 (while keys | |
| 602 (define-key mail-mode-map (car keys) (cdr (car subst))) | |
| 603 (setq keys (cdr keys)))) | |
| 604 (setq subst (cdr subst)))) | |
| 605 | |
| 606 (provide 'mail-abbrevs) | |
| 607 | |
| 608 | |
| 609 ;;; V18 compatibility | |
| 610 ;;; | |
| 611 ;;; All of the Emacs18 stuff is isolated down here so that it will be | |
| 612 ;;; easy to delete once v18 finally bites the dust. | |
| 613 ;;; | |
| 614 ;;; These defuns and defvars aren't inside the cond in deference to | |
| 615 ;;; the intense brokenness of the v18 byte-compiler. | |
| 616 ;;; | |
| 617 ;;; All the code on this page is gross and hidious and awful and might | |
| 618 ;;; not even work all that well. Comfort yourself with knowing that the | |
| 619 ;;; v19 code above works wonderfully. | |
| 620 | |
| 621 (defun sendmail-v18-self-insert-command (arg) | |
| 622 "Just like self-insert-command, but runs sendmail-pre-abbrev-expand-hook." | |
| 623 (interactive "p") | |
| 624 (if (not (and last-command-char | |
| 625 (eq (char-syntax last-command-char) ?w))) | |
| 626 (progn | |
| 627 (sendmail-pre-abbrev-expand-hook) | |
| 628 ;; Unhack expand-abbrev, so it will work right next time around. | |
| 629 (setq abbrev-start-location nil))) | |
| 630 ;; this is gross and wasteful. | |
| 631 (let ((abbrev-mode (if (mail-abbrev-in-expansion-header-p) | |
| 632 nil | |
| 633 abbrev-mode))) | |
| 634 (self-insert-command arg))) | |
| 635 | |
| 636 (defun abbrev-hacking-next-line-v18 (arg) | |
| 637 (if (looking-at "[ \t]*\n") (sendmail-pre-abbrev-expand-hook)) | |
| 638 (setq this-command 'next-line) | |
| 639 (next-line arg)) | |
| 640 | |
| 641 (defun abbrev-hacking-end-of-buffer-v18 (arg) | |
| 642 (if (looking-at "[ \t]*\n") (sendmail-pre-abbrev-expand-hook)) | |
| 643 (setq this-command 'end-of-buffer) | |
| 644 (end-of-buffer arg)) | |
| 645 | |
| 646 (defvar mail-abbrevs-v18-map-munged nil) | |
| 647 | |
| 648 (defun mail-abbrevs-v18-munge-map () | |
| 649 ;; For every key that is bound to self-insert-command in global-map, | |
| 650 ;; bind that key to sendmail-self-insert-command in mail-mode-map. | |
| 651 ;; We used to do this by making the mail-mode-map be a non-sparse map, | |
| 652 ;; but that made the esc-map be shared in such a way that making a | |
| 653 ;; local meta binding in the mail-mode-map made a *global* binding | |
| 654 ;; instead. Yucko. | |
| 655 (let ((global-map (current-global-map)) | |
| 656 new-bindings | |
| 657 (i 0)) | |
| 658 (while (< i 128) | |
| 659 (if (eq 'self-insert-command (or (cdr (assq i mail-mode-map)) | |
| 660 (aref global-map i))) | |
| 661 (setq new-bindings | |
| 662 (cons (cons i 'sendmail-v18-self-insert-command) | |
| 663 new-bindings))) | |
| 664 (setq i (1+ i))) | |
| 665 (setq mail-mode-map | |
| 666 (nconc (copy-keymap mail-mode-map) (nreverse new-bindings)))) | |
| 667 (setq mail-abbrevs-v18-map-munged t)) | |
| 668 | |
| 669 (defun mail-aliases-setup-v18 () | |
| 670 "Put this on `mail-setup-hook' to use mail-abbrevs." | |
| 671 (if (not (eq major-mode 'mail-mode)) | |
| 672 nil | |
| 673 (or (and mail-mode-map (eq (current-local-map) mail-mode-map)) | |
| 674 (error "shut 'er down clancy, she's suckin' mud")) | |
| 675 (if (and (not (vectorp mail-aliases)) | |
| 676 (file-exists-p (mail-abbrev-mailrc-file))) | |
| 677 (build-mail-aliases)) | |
| 678 (or mail-abbrevs-v18-map-munged (mail-abbrevs-v18-munge-map)) | |
| 679 (use-local-map mail-mode-map) | |
| 680 (abbrev-mode 1))) | |
| 681 | |
| 682 | |
| 683 (cond ((or (string-match "^18\\." emacs-version) | |
| 684 (and (boundp 'epoch::version) epoch::version)) | |
| 685 ;; | |
| 686 ;; v19 (and this code) uses a new name for this function. | |
| 687 (or (fboundp 'buffer-disable-undo) | |
| 688 (fset 'buffer-disable-undo 'buffer-flush-undo)) | |
| 689 ;; | |
| 690 ;; v19 (and this code) uses a new name for auto-fill-hook (-function). | |
| 691 ;; Encapsulate the function that uses it to bind the new name. | |
| 692 (or (fboundp 'mail-abbrev-expand-hook-v19) | |
| 693 (fset 'mail-abbrev-expand-hook-v19 | |
| 694 (symbol-function 'mail-abbrev-expand-hook))) | |
| 695 (fset 'mail-abbrev-expand-hook | |
| 696 (function (lambda () | |
| 697 (let ((auto-fill-function auto-fill-hook)) | |
| 698 (mail-abbrev-expand-hook-v19))))) | |
| 699 ;; | |
| 700 ;; Turn off the broken v18 code (that is still called from sendmail.el) | |
| 701 (fset 'expand-mail-aliases | |
| 702 (function (lambda (&rest args) | |
| 703 "Obsoleted by mail-abbrevs. Does nothing." | |
| 704 nil))) | |
| 705 ;; | |
| 706 ;; Redefine the abbrev-hacking functions. Yuck. | |
| 707 (fset 'abbrev-hacking-next-line | |
| 708 (function (lambda (p) (interactive "p") | |
| 709 (abbrev-hacking-next-line-v18 p)))) | |
| 710 (fset 'abbrev-hacking-end-of-buffer | |
| 711 (function (lambda (p) (interactive "P") | |
| 712 (abbrev-hacking-end-of-buffer-v18 p)))) | |
| 713 ;; | |
| 714 ;; Encapsulate mail-setup to do the necessary buffer initializations. | |
| 715 (or (fboundp 'mail-setup-v18) | |
| 716 (fset 'mail-setup-v18 (symbol-function 'mail-setup))) | |
| 717 (fset 'mail-setup | |
| 718 (function (lambda (&rest args) | |
| 719 (mail-aliases-setup-v18) | |
| 720 (apply 'mail-setup-v18 args)))) | |
| 721 | |
| 722 ;; | |
| 723 ;; Encapsulate VM's version of mail-setup as well, if vm-mail is | |
| 724 ;; defined as a function or as an autoload. | |
| 725 (cond ((and (fboundp 'vm-mail) | |
| 726 (if (eq 'autoload (car-safe (symbol-function 'vm-mail))) | |
| 727 (load (nth 1 (symbol-function 'vm-mail)) t) | |
| 728 t)) | |
| 729 (or (fboundp 'vm-mail-internal-v18) | |
| 730 (fset 'vm-mail-internal-v18 | |
| 731 (symbol-function 'vm-mail-internal))) | |
| 732 (fset 'vm-mail-internal | |
| 733 (function (lambda (&rest args) | |
| 734 (apply 'vm-mail-internal-v18 args) | |
| 735 (mail-aliases-setup-v18)))))) | |
| 736 | |
| 737 ;; If we're being loaded from mail-setup-hook or mail-mode-hook | |
| 738 ;; as run from inside mail-setup or vm-mail-internal, then install | |
| 739 ;; right now. | |
| 740 (if (eq major-mode 'mail-mode) | |
| 741 (mail-aliases-setup-v18)) | |
| 742 ) | |
| 743 | |
| 744 (t ; v19 | |
| 745 (fmakunbound 'expand-mail-aliases))) |