diff options
| -rw-r--r-- | lisp/ChangeLog | 10 | ||||
| -rw-r--r-- | lisp/mail/mailabbrev.el | 271 |
2 files changed, 127 insertions, 154 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 4761b65d99d..9c6d71201ec 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,3 +1,13 @@ | |||
| 1 | 2007-10-31 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 2 | |||
| 3 | * mail/mailabbrev.el (mail-abbrevs-mode): Use define-minor-mode. | ||
| 4 | (mail-abbrevs-setup): Use abbrev-expand-functions. | ||
| 5 | (build-mail-abbrevs): Use with-temp-buffer. | ||
| 6 | (define-mail-abbrev): Simplify. | ||
| 7 | (mail-abbrev-expand-wrapper): Rename sendmail-pre-abbrev-expand-hook. | ||
| 8 | Change it for use on abbrev-expand-functions. | ||
| 9 | (mail-abbrev-complete-alias): Use with-syntax-table. | ||
| 10 | |||
| 1 | 2007-10-31 Michael Albinus <michael.albinus@gmx.de> | 11 | 2007-10-31 Michael Albinus <michael.albinus@gmx.de> |
| 2 | 12 | ||
| 3 | * net/tramp.el (tramp-handle-shell-command): Call `start-file-process' | 13 | * net/tramp.el (tramp-handle-shell-command): Call `start-file-process' |
diff --git a/lisp/mail/mailabbrev.el b/lisp/mail/mailabbrev.el index b75e10096dd..0b2c0177234 100644 --- a/lisp/mail/mailabbrev.el +++ b/lisp/mail/mailabbrev.el | |||
| @@ -133,19 +133,16 @@ | |||
| 133 | "Expand mail aliases as abbrevs, in certain mail headers." | 133 | "Expand mail aliases as abbrevs, in certain mail headers." |
| 134 | :group 'abbrev-mode) | 134 | :group 'abbrev-mode) |
| 135 | 135 | ||
| 136 | (defcustom mail-abbrevs-mode nil | 136 | ;;;###autoload |
| 137 | "*Non-nil means expand mail aliases as abbrevs, in certain message headers." | 137 | (define-minor-mode mail-abbrevs-mode |
| 138 | :type 'boolean | 138 | "Non-nil means expand mail aliases as abbrevs, in certain message headers." |
| 139 | :global t | ||
| 139 | :group 'mail-abbrev | 140 | :group 'mail-abbrev |
| 140 | :require 'mailabbrev | 141 | :version "20.3" |
| 141 | :set (lambda (symbol value) | 142 | (if mail-abbrevs-mode (mail-abbrevs-enable) (mail-abbrevs-disable))) |
| 142 | (setq mail-abbrevs-mode value) | ||
| 143 | (if value (mail-abbrevs-enable) (mail-abbrevs-disable))) | ||
| 144 | :initialize 'custom-initialize-default | ||
| 145 | :version "20.3") | ||
| 146 | 143 | ||
| 147 | (defcustom mail-abbrevs-only nil | 144 | (defcustom mail-abbrevs-only nil |
| 148 | "*Non-nil means only mail abbrevs should expand automatically. | 145 | "Non-nil means only mail abbrevs should expand automatically. |
| 149 | Other abbrevs expand only when you explicitly use `expand-abbrev'." | 146 | Other abbrevs expand only when you explicitly use `expand-abbrev'." |
| 150 | :type 'boolean | 147 | :type 'boolean |
| 151 | :group 'mail-abbrev) | 148 | :group 'mail-abbrev) |
| @@ -179,8 +176,7 @@ no aliases, which is represented by this being a table with no entries.)") | |||
| 179 | (nth 5 (file-attributes mail-personal-alias-file))) | 176 | (nth 5 (file-attributes mail-personal-alias-file))) |
| 180 | (build-mail-abbrevs))) | 177 | (build-mail-abbrevs))) |
| 181 | (mail-abbrevs-sync-aliases) | 178 | (mail-abbrevs-sync-aliases) |
| 182 | (add-hook 'pre-abbrev-expand-hook 'sendmail-pre-abbrev-expand-hook | 179 | (add-hook 'abbrev-expand-functions 'mail-abbrev-expand-wrapper nil t) |
| 183 | nil t) | ||
| 184 | (abbrev-mode 1)) | 180 | (abbrev-mode 1)) |
| 185 | 181 | ||
| 186 | (defun mail-abbrevs-enable () | 182 | (defun mail-abbrevs-enable () |
| @@ -201,64 +197,56 @@ By default this is the file specified by `mail-personal-alias-file'." | |||
| 201 | (setq mail-abbrevs nil) | 197 | (setq mail-abbrevs nil) |
| 202 | (define-abbrev-table 'mail-abbrevs '())) | 198 | (define-abbrev-table 'mail-abbrevs '())) |
| 203 | (message "Parsing %s..." file) | 199 | (message "Parsing %s..." file) |
| 204 | (let ((buffer nil) | 200 | (with-temp-buffer |
| 205 | (obuf (current-buffer))) | 201 | (buffer-disable-undo) |
| 206 | (unwind-protect | 202 | (cond ((get-file-buffer file) |
| 207 | (progn | 203 | (insert (with-current-buffer (get-file-buffer file) |
| 208 | (setq buffer (generate-new-buffer " mailrc")) | 204 | (buffer-substring (point-min) (point-max))))) |
| 209 | (buffer-disable-undo buffer) | 205 | ((not (file-exists-p file))) |
| 210 | (set-buffer buffer) | 206 | (t (insert-file-contents file))) |
| 211 | (cond ((get-file-buffer file) | 207 | ;; Don't lose if no final newline. |
| 212 | (insert (save-excursion | 208 | (goto-char (point-max)) |
| 213 | (set-buffer (get-file-buffer file)) | 209 | (or (eq (preceding-char) ?\n) (newline)) |
| 214 | (buffer-substring (point-min) (point-max))))) | 210 | (goto-char (point-min)) |
| 215 | ((not (file-exists-p file))) | 211 | ;; Delete comments from the file |
| 216 | (t (insert-file-contents file))) | 212 | (while (search-forward "# " nil t) |
| 217 | ;; Don't lose if no final newline. | 213 | (let ((p (- (point) 2))) |
| 218 | (goto-char (point-max)) | 214 | (end-of-line) |
| 219 | (or (eq (preceding-char) ?\n) (newline)) | 215 | (delete-region p (point)))) |
| 220 | (goto-char (point-min)) | 216 | (goto-char (point-min)) |
| 221 | ;; Delete comments from the file | 217 | ;; handle "\\\n" continuation lines |
| 222 | (while (search-forward "# " nil t) | 218 | (while (not (eobp)) |
| 223 | (let ((p (- (point) 2))) | 219 | (end-of-line) |
| 224 | (end-of-line) | 220 | (if (= (preceding-char) ?\\) |
| 225 | (delete-region p (point)))) | 221 | (progn (delete-char -1) (delete-char 1) (insert ?\ )) |
| 226 | (goto-char (point-min)) | 222 | (forward-char 1))) |
| 227 | ;; handle "\\\n" continuation lines | 223 | (goto-char (point-min)) |
| 228 | (while (not (eobp)) | 224 | (while (re-search-forward |
| 229 | (end-of-line) | 225 | "^\\(a\\(lias\\)?\\|g\\(roup\\)?\\|source\\)[ \t]+" nil t) |
| 230 | (if (= (preceding-char) ?\\) | 226 | (beginning-of-line) |
| 231 | (progn (delete-char -1) (delete-char 1) (insert ?\ )) | 227 | (if (looking-at "source[ \t]+\\([^ \t\n]+\\)") |
| 232 | (forward-char 1))) | 228 | (progn |
| 233 | (goto-char (point-min)) | 229 | (end-of-line) |
| 234 | (while (re-search-forward | 230 | (build-mail-abbrevs |
| 235 | "^\\(a\\(lias\\)?\\|g\\(roup\\)?\\|source\\)[ \t]+" nil t) | 231 | (substitute-in-file-name |
| 236 | (beginning-of-line) | 232 | (buffer-substring (match-beginning 1) (match-end 1))) |
| 237 | (if (looking-at "source[ \t]+\\([^ \t\n]+\\)") | 233 | t)) |
| 238 | (progn | 234 | (re-search-forward "[ \t]+\\([^ \t\n]+\\)") |
| 239 | (end-of-line) | 235 | (let* ((name (buffer-substring |
| 240 | (build-mail-abbrevs | 236 | (match-beginning 1) (match-end 1))) |
| 241 | (substitute-in-file-name | 237 | (start (progn (skip-chars-forward " \t") (point)))) |
| 242 | (buffer-substring (match-beginning 1) (match-end 1))) | 238 | (end-of-line) |
| 243 | t)) | 239 | ;; (message "** %s \"%s\"" name (buffer-substring start (point)))(sit-for 1) |
| 244 | (re-search-forward "[ \t]+\\([^ \t\n]+\\)") | 240 | (define-mail-abbrev |
| 245 | (let* ((name (buffer-substring | 241 | name |
| 246 | (match-beginning 1) (match-end 1))) | 242 | (buffer-substring start (point)) |
| 247 | (start (progn (skip-chars-forward " \t") (point)))) | 243 | t)))) |
| 248 | (end-of-line) | 244 | ;; Resolve forward references in .mailrc file. |
| 249 | ; (message "** %s \"%s\"" name (buffer-substring start (point)))(sit-for 1) | 245 | ;; This would happen automatically before the first abbrev was |
| 250 | (define-mail-abbrev | 246 | ;; expanded, but why not do it now. |
| 251 | name | 247 | (or recursivep (mail-resolve-all-aliases)) |
| 252 | (buffer-substring start (point)) | 248 | mail-abbrevs) |
| 253 | t)))) | 249 | (message "Parsing %s... done" file)) |
| 254 | ;; Resolve forward references in .mailrc file. | ||
| 255 | ;; This would happen automatically before the first abbrev was | ||
| 256 | ;; expanded, but why not do it now. | ||
| 257 | (or recursivep (mail-resolve-all-aliases)) | ||
| 258 | mail-abbrevs) | ||
| 259 | (if buffer (kill-buffer buffer)) | ||
| 260 | (set-buffer obuf))) | ||
| 261 | (message "Parsing %s... done" file)) | ||
| 262 | 250 | ||
| 263 | (defvar mail-alias-separator-string ", " | 251 | (defvar mail-alias-separator-string ", " |
| 264 | "*A string inserted between addresses in multi-address mail aliases. | 252 | "*A string inserted between addresses in multi-address mail aliases. |
| @@ -280,12 +268,7 @@ If DEFINITION contains multiple addresses, separate them with commas." | |||
| 280 | ;; true, and we do some evil space->comma hacking like /bin/mail does. | 268 | ;; true, and we do some evil space->comma hacking like /bin/mail does. |
| 281 | (interactive "sDefine mail alias: \nsDefine %s as mail alias for: ") | 269 | (interactive "sDefine mail alias: \nsDefine %s as mail alias for: ") |
| 282 | ;; Read the defaults first, if we have not done so. | 270 | ;; Read the defaults first, if we have not done so. |
| 283 | (if (vectorp mail-abbrevs) | 271 | (unless (vectorp mail-abbrevs) (build-mail-abbrevs)) |
| 284 | nil | ||
| 285 | (setq mail-abbrevs nil) | ||
| 286 | (define-abbrev-table 'mail-abbrevs '()) | ||
| 287 | (if (file-exists-p mail-personal-alias-file) | ||
| 288 | (build-mail-abbrevs))) | ||
| 289 | ;; strip garbage from front and end | 272 | ;; strip garbage from front and end |
| 290 | (if (string-match "\\`[ \t\n,]+" definition) | 273 | (if (string-match "\\`[ \t\n,]+" definition) |
| 291 | (setq definition (substring definition (match-end 0)))) | 274 | (setq definition (substring definition (match-end 0)))) |
| @@ -454,72 +437,58 @@ of a mail alias. The value is set up, buffer-local, when first needed.") | |||
| 454 | (rfc822-goto-eoh) | 437 | (rfc822-goto-eoh) |
| 455 | (point))))))) | 438 | (point))))))) |
| 456 | 439 | ||
| 457 | (defun sendmail-pre-abbrev-expand-hook () | 440 | (defun mail-abbrev-expand-wrapper (expand) |
| 458 | (and (and mail-abbrevs (not (eq mail-abbrevs t))) | 441 | (if (and mail-abbrevs (not (eq mail-abbrevs t))) |
| 459 | (if (mail-abbrev-in-expansion-header-p) | 442 | (if (mail-abbrev-in-expansion-header-p) |
| 460 | 443 | ||
| 461 | ;; We are in a To: (or CC:, or whatever) header, and | 444 | ;; We are in a To: (or CC:, or whatever) header, and |
| 462 | ;; should use word-abbrevs to expand mail aliases. | 445 | ;; should use word-abbrevs to expand mail aliases. |
| 463 | (let ((local-abbrev-table mail-abbrevs) | 446 | (let ((local-abbrev-table mail-abbrevs)) |
| 464 | (old-syntax-table (syntax-table))) | 447 | |
| 465 | 448 | ;; Before anything else, resolve aliases if they need it. | |
| 466 | ;; Before anything else, resolve aliases if they need it. | 449 | (and mail-abbrev-aliases-need-to-be-resolved |
| 467 | (and mail-abbrev-aliases-need-to-be-resolved | 450 | (mail-resolve-all-aliases)) |
| 468 | (mail-resolve-all-aliases)) | 451 | |
| 469 | 452 | ;; Now proceed with the abbrev section. | |
| 470 | ;; Now proceed with the abbrev section. | 453 | ;; - We already installed mail-abbrevs as the abbrev table. |
| 471 | ;; - We already installed mail-abbrevs as the abbrev table. | 454 | ;; - Then install the mail-abbrev-syntax-table, which |
| 472 | ;; - Then install the mail-abbrev-syntax-table, which | 455 | ;; temporarily marks all of the |
| 473 | ;; temporarily marks all of the | 456 | ;; non-alphanumeric-atom-characters (the "_" |
| 474 | ;; non-alphanumeric-atom-characters (the "_" | 457 | ;; syntax ones) as being normal word-syntax. We do this |
| 475 | ;; syntax ones) as being normal word-syntax. We do this | 458 | ;; because the C code for expand-abbrev only works on words, |
| 476 | ;; because the C code for expand-abbrev only works on words, | 459 | ;; and we want these characters to be considered words for |
| 477 | ;; and we want these characters to be considered words for | 460 | ;; the purpose of abbrev expansion. |
| 478 | ;; the purpose of abbrev expansion. | 461 | ;; - Then we call the expand function, to do |
| 479 | ;; - Then we call expand-abbrev again, recursively, to do | 462 | ;; the abbrev expansion with the above syntax table. |
| 480 | ;; the abbrev expansion with the above syntax table. | 463 | |
| 481 | ;; - Restore the previous syntax table. | 464 | (mail-abbrev-make-syntax-table) |
| 482 | ;; - Then we do a trick which tells the expand-abbrev frame | 465 | |
| 483 | ;; which invoked us to not continue (and thus not | 466 | ;; If the character just typed was non-alpha-symbol-syntax, |
| 484 | ;; expand twice.) This means that any abbrev expansion | 467 | ;; then don't expand the abbrev now (that is, don't expand |
| 485 | ;; will happen as a result of this function's call to | 468 | ;; when the user types -.) Check the character's syntax in |
| 486 | ;; expand-abbrev, and not as a result of the call to | 469 | ;; the usual syntax table. |
| 487 | ;; expand-abbrev which invoked *us*. | 470 | |
| 488 | 471 | (or (and (integerp last-command-char) | |
| 489 | (mail-abbrev-make-syntax-table) | 472 | ;; Some commands such as M-> may want to expand first. |
| 490 | 473 | (equal this-command 'self-insert-command) | |
| 491 | ;; If the character just typed was non-alpha-symbol-syntax, | 474 | (or (eq (char-syntax last-command-char) ?_) |
| 492 | ;; then don't expand the abbrev now (that is, don't expand | 475 | ;; Don't expand on @. |
| 493 | ;; when the user types -.) Check the character's syntax in | 476 | (memq last-command-char '(?@ ?. ?% ?! ?_ ?-)))) |
| 494 | ;; the usual syntax table. | 477 | ;; Use this table so that abbrevs can have hyphens in them. |
| 495 | 478 | (with-syntax-table mail-abbrev-syntax-table | |
| 496 | (or (and (integerp last-command-char) | 479 | (funcall expand)))) |
| 497 | ;; Some commands such as M-> may want to expand first. | 480 | |
| 498 | (equal this-command 'self-insert-command) | 481 | (if (or (not mail-abbrevs-only) |
| 499 | (or (eq (char-syntax last-command-char) ?_) | 482 | (eq this-command 'expand-abbrev)) |
| 500 | ;; Don't expand on @. | 483 | ;; We're not in a mail header where mail aliases should |
| 501 | (memq last-command-char '(?@ ?. ?% ?! ?_ ?-)))) | 484 | ;; be expanded, then use the normal mail-mode abbrev table |
| 502 | (let ((pre-abbrev-expand-hook nil)) ; That's us; don't loop. | 485 | ;; (if any) and the normal mail-mode syntax table. |
| 503 | ;; Use this table so that abbrevs can have hyphens in them. | 486 | (funcall expand) |
| 504 | (set-syntax-table mail-abbrev-syntax-table) | 487 | ;; This is not a mail abbrev, and we should not expand it. |
| 505 | (unwind-protect | 488 | ;; Don't expand anything. |
| 506 | (expand-abbrev) | 489 | nil)) |
| 507 | ;; Now set it back to what it was before. | 490 | ;; No mail-abbrevs at all, do the normal thing. |
| 508 | (set-syntax-table old-syntax-table)))) | 491 | (funcall expand))) |
| 509 | (setq abbrev-start-location (point-max) ; This is the trick. | ||
| 510 | abbrev-start-location-buffer (current-buffer))) | ||
| 511 | |||
| 512 | (if (or (not mail-abbrevs-only) | ||
| 513 | (eq this-command 'expand-abbrev)) | ||
| 514 | ;; We're not in a mail header where mail aliases should | ||
| 515 | ;; be expanded, then use the normal mail-mode abbrev table | ||
| 516 | ;; (if any) and the normal mail-mode syntax table. | ||
| 517 | nil | ||
| 518 | ;; This is not a mail abbrev, and we should not expand it. | ||
| 519 | ;; This kludge stops expand-abbrev from doing anything. | ||
| 520 | (setq abbrev-start-location (point-max) | ||
| 521 | abbrev-start-location-buffer (current-buffer)))) | ||
| 522 | )) | ||
| 523 | 492 | ||
| 524 | ;;; utilities | 493 | ;;; utilities |
| 525 | 494 | ||
| @@ -568,14 +537,11 @@ of a mail alias. The value is set up, buffer-local, when first needed.") | |||
| 568 | (interactive) | 537 | (interactive) |
| 569 | (mail-abbrev-make-syntax-table) | 538 | (mail-abbrev-make-syntax-table) |
| 570 | (let* ((end (point)) | 539 | (let* ((end (point)) |
| 571 | (syntax-table (syntax-table)) | 540 | (beg (with-syntax-table mail-abbrev-syntax-table |
| 572 | (beg (unwind-protect | 541 | (save-excursion |
| 573 | (save-excursion | 542 | (backward-word 1) |
| 574 | (set-syntax-table mail-abbrev-syntax-table) | 543 | (point)))) |
| 575 | (backward-word 1) | 544 | (alias (buffer-substring beg end)) |
| 576 | (point)) | ||
| 577 | (set-syntax-table syntax-table))) | ||
| 578 | (alias (buffer-substring beg end)) | ||
| 579 | (completion (try-completion alias mail-abbrevs))) | 545 | (completion (try-completion alias mail-abbrevs))) |
| 580 | (cond ((eq completion t) | 546 | (cond ((eq completion t) |
| 581 | (message "%s" alias)) ; confirm | 547 | (message "%s" alias)) ; confirm |
| @@ -638,8 +604,5 @@ Don't use this command in Lisp programs! | |||
| 638 | 604 | ||
| 639 | (provide 'mailabbrev) | 605 | (provide 'mailabbrev) |
| 640 | 606 | ||
| 641 | (if mail-abbrevs-mode | 607 | ;; arch-tag: 5aa2d901-73f8-4ad7-b73c-4802282ad2ff |
| 642 | (mail-abbrevs-enable)) | ||
| 643 | |||
| 644 | ;;; arch-tag: 5aa2d901-73f8-4ad7-b73c-4802282ad2ff | ||
| 645 | ;;; mailabbrev.el ends here | 608 | ;;; mailabbrev.el ends here |