Commit d7c1ec4b authored by Roland McGrath's avatar Roland McGrath

*** empty log message ***

parent 343fbb30
;;; ??? We must get papers for this or delete it. ;;; ??? We must get papers for this or delete it.
;;; mailabbrev.el --- abbrev-expansion of mail aliases. ;;; Abbrev-expansion of mail aliases.
;;; Copyright (C) 1985, 1986, 1987, 1992 Free Software Foundation, Inc. ;;; Copyright (C) 1985, 1986, 1987, 1992 Free Software Foundation, Inc.
;;; Created: 19 oct 90, Jamie Zawinski <jwz@lucid.com> ;;; Created: 19 oct 90, Jamie Zawinski <jwz@lucid.com>
;;; Modified: 5 apr 92, Roland McGrath <roland@gnu.ai.mit.edu> ;;; Modified: 5 apr 92, Roland McGrath <roland@gnu.ai.mit.edu>
;;; Last change 22-apr-92. jwz ;;; Last change 13-jun-92. jwz
;;; This file is part of GNU Emacs. ;;; This file is part of GNU Emacs.
;;; GNU Emacs is free software; you can redistribute it and/or modify ;;; GNU Emacs is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by ;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 1, or (at your option) ;;; the Free Software Foundation; either version 2, or (at your option)
;;; any later version. ;;; any later version.
;;; GNU Emacs is distributed in the hope that it will be useful, ;;; GNU Emacs is distributed in the hope that it will be useful,
...@@ -310,7 +309,10 @@ If DEFINITION contains multiple addresses, separate them with commas." ...@@ -310,7 +309,10 @@ If DEFINITION contains multiple addresses, separate them with commas."
;; (message "Resolving mail aliases... done.") ;; (message "Resolving mail aliases... done.")
))) )))
(defun mail-resolve-all-aliases-1 (sym) (defun mail-resolve-all-aliases-1 (sym &optional so-far)
(if (memq sym so-far)
(error "mail alias loop detected: %s"
(mapconcat 'symbol-name (cons sym so-far) " <- ")))
(let ((definition (and (boundp sym) (symbol-value sym)))) (let ((definition (and (boundp sym) (symbol-value sym))))
(if definition (if definition
(let ((result '()) (let ((result '())
...@@ -322,7 +324,8 @@ If DEFINITION contains multiple addresses, separate them with commas." ...@@ -322,7 +324,8 @@ If DEFINITION contains multiple addresses, separate them with commas."
(setq definition (setq definition
(mapconcat (function (lambda (x) (mapconcat (function (lambda (x)
(or (mail-resolve-all-aliases-1 (or (mail-resolve-all-aliases-1
(intern-soft x mail-aliases)) (intern-soft x mail-aliases)
(cons sym so-far))
x))) x)))
(nreverse result) (nreverse result)
mail-alias-separator-string)) mail-alias-separator-string))
...@@ -459,6 +462,9 @@ characters which may be a part of the name of a mail-alias.") ...@@ -459,6 +462,9 @@ characters which may be a part of the name of a mail-alias.")
;; expansion with the above syntax table. ;; expansion with the above syntax table.
;; - Then we do a trick which tells the expand-abbrev frame which ;; - Then we do a trick which tells the expand-abbrev frame which
;; invoked us to not continue (and thus not expand twice.) ;; invoked us to not continue (and thus not expand twice.)
;; This means that any abbrev expansion will happen as a result
;; of this function's call to expand-abbrev, and not as a result
;; of the call to expand-abbrev which invoked *us*.
;; - Then we set the syntax table to mail-mode-header-syntax-table, ;; - Then we set the syntax table to mail-mode-header-syntax-table,
;; which doesn't have anything to do with abbrev expansion, but ;; which doesn't have anything to do with abbrev expansion, but
;; is just for the user's convenience (see its doc string.) ;; is just for the user's convenience (see its doc string.)
...@@ -466,14 +472,17 @@ characters which may be a part of the name of a mail-alias.") ...@@ -466,14 +472,17 @@ characters which may be a part of the name of a mail-alias.")
(setq local-abbrev-table mail-aliases) (setq local-abbrev-table mail-aliases)
;; If the character just typed was non-alpha-symbol-syntax, then don't ;; If the character just typed was non-alpha-symbol-syntax, then don't
;; expand the abbrev now (that is, don't expand when the user types -.) ;; expand the abbrev now (that is, don't expand when the user types -.)
(or (= (char-syntax last-command-char) ?_) ;; Check the character's syntax in the mail-mode-header-syntax-table.
(let ((pre-abbrev-expand-hook nil)) ; that's us; don't loop (set-syntax-table mail-mode-header-syntax-table)
(or (eq (char-syntax last-command-char) ?_)
(let ((pre-abbrev-expand-hook nil)) ; That's us; don't loop.
;; Use this table so that abbrevs can have hyphens in them.
(set-syntax-table mail-abbrev-syntax-table) (set-syntax-table mail-abbrev-syntax-table)
(expand-abbrev))) (expand-abbrev)
(setq abbrev-start-location (point) ; this is the trick ;; Now set it back to what it was before.
(set-syntax-table mail-mode-header-syntax-table)))
(setq abbrev-start-location (point) ; This is the trick.
abbrev-start-location-buffer (current-buffer)) abbrev-start-location-buffer (current-buffer))
;; and do this just because.
(set-syntax-table mail-mode-header-syntax-table)
))) )))
;;; utilities ;;; utilities
...@@ -515,14 +524,16 @@ characters which may be a part of the name of a mail-alias.") ...@@ -515,14 +524,16 @@ characters which may be a part of the name of a mail-alias.")
"Just like `next-line' (\\[next-line]) but expands abbrevs when at \ "Just like `next-line' (\\[next-line]) but expands abbrevs when at \
end of line." end of line."
(interactive "p") (interactive "p")
(if (looking-at "[ \t]*\n") (sendmail-pre-abbrev-expand-hook)) (if (looking-at "[ \t]*\n") (expand-abbrev))
(setq this-command 'next-line)
(next-line arg)) (next-line arg))
(defun abbrev-hacking-end-of-buffer (&optional arg) (defun abbrev-hacking-end-of-buffer (&optional arg)
"Just like `end-of-buffer' (\\[end-of-buffer]) but expands abbrevs when at \ "Just like `end-of-buffer' (\\[end-of-buffer]) but expands abbrevs when at \
end of line." end of line."
(interactive "P") (interactive "P")
(if (looking-at "[ \t]*\n") (sendmail-pre-abbrev-expand-hook)) (if (looking-at "[ \t]*\n") (expand-abbrev))
(setq this-command 'end-of-buffer)
(end-of-buffer arg)) (end-of-buffer arg))
(define-key mail-mode-map "\C-c\C-a" 'mail-interactive-insert-alias) (define-key mail-mode-map "\C-c\C-a" 'mail-interactive-insert-alias)
...@@ -540,18 +551,35 @@ end of line." ...@@ -540,18 +551,35 @@ end of line."
;;; ;;;
;;; These defuns and defvars aren't inside the cond in deference to ;;; These defuns and defvars aren't inside the cond in deference to
;;; the intense brokenness of the v18 byte-compiler. ;;; the intense brokenness of the v18 byte-compiler.
;;;
;;; All the code on this page is gross and hidious and awful and might
;;; not even work all that well. Comfort yourself with knowing that the
;;; v19 code above works wonderfully.
(defun sendmail-v18-self-insert-command (arg) (defun sendmail-v18-self-insert-command (arg)
"Just like self-insert-command, but runs sendmail-pre-abbrev-expand-hook." "Just like self-insert-command, but runs sendmail-pre-abbrev-expand-hook."
(interactive "p") (interactive "p")
(if (not (= (char-syntax last-command-char) ?w)) (if (not (eq (char-syntax last-command-char) ?w))
(progn (progn
(sendmail-pre-abbrev-expand-hook) (sendmail-pre-abbrev-expand-hook)
;; Unhack expand-abbrev, so it will work right next time around. ;; Unhack expand-abbrev, so it will work right next time around.
(setq abbrev-start-location nil))) (setq abbrev-start-location nil)))
(let ((abbrev-mode nil)) ;; this is gross and wasteful.
(let ((abbrev-mode (if (mail-abbrev-in-expansion-header-p)
nil
abbrev-mode)))
(self-insert-command arg))) (self-insert-command arg)))
(defun abbrev-hacking-next-line-v18 (arg)
(if (looking-at "[ \t]*\n") (sendmail-pre-abbrev-expand-hook))
(setq this-command 'next-line)
(next-line arg))
(defun abbrev-hacking-end-of-buffer-v18 (arg)
(if (looking-at "[ \t]*\n") (sendmail-pre-abbrev-expand-hook))
(setq this-command 'end-of-buffer)
(end-of-buffer arg))
(defvar mail-abbrevs-v18-map-munged nil) (defvar mail-abbrevs-v18-map-munged nil)
(defun mail-abbrevs-v18-munge-map () (defun mail-abbrevs-v18-munge-map ()
...@@ -562,23 +590,31 @@ end of line." ...@@ -562,23 +590,31 @@ end of line."
;; local meta binding in the mail-mode-map made a *global* binding ;; local meta binding in the mail-mode-map made a *global* binding
;; instead. Yucko. ;; instead. Yucko.
(let ((global-map (current-global-map)) (let ((global-map (current-global-map))
new-bindings
(i 0)) (i 0))
(while (< i 128) (while (< i 128)
(if (eq 'self-insert-command (or (cdr (assq i mail-mode-map)) (if (eq 'self-insert-command (or (cdr (assq i mail-mode-map))
(aref global-map i))) (aref global-map i)))
(define-key mail-mode-map (char-to-string i) (setq new-bindings
'sendmail-v18-self-insert-command)) (cons (cons i 'sendmail-v18-self-insert-command)
(setq i (1+ i)))) new-bindings)))
(setq i (1+ i)))
(setq mail-mode-map
(nconc (copy-keymap mail-mode-map) (nreverse new-bindings))))
(setq mail-abbrevs-v18-map-munged t)) (setq mail-abbrevs-v18-map-munged t))
(defun mail-aliases-setup-v18 () (defun mail-aliases-setup-v18 ()
"Put this on `mail-setup-hook' to use mail-abbrevs." "Put this on `mail-setup-hook' to use mail-abbrevs."
(if (and (not (vectorp mail-aliases)) (if (not (eq major-mode 'mail-mode))
(file-exists-p (mail-abbrev-mailrc-file))) nil
(build-mail-aliases)) (or (and mail-mode-map (eq (current-local-map) mail-mode-map))
(or mail-abbrevs-v18-map-munged (mail-abbrevs-v18-munge-map)) (error "shut 'er down clancy, she's suckin' mud"))
(use-local-map mail-mode-map) (if (and (not (vectorp mail-aliases))
(abbrev-mode 1)) (file-exists-p (mail-abbrev-mailrc-file)))
(build-mail-aliases))
(or mail-abbrevs-v18-map-munged (mail-abbrevs-v18-munge-map))
(use-local-map mail-mode-map)
(abbrev-mode 1)))
(cond ((or (string-match "^18\\." emacs-version) (cond ((or (string-match "^18\\." emacs-version)
...@@ -604,6 +640,14 @@ end of line." ...@@ -604,6 +640,14 @@ end of line."
"Obsoleted by mail-abbrevs. Does nothing." "Obsoleted by mail-abbrevs. Does nothing."
nil))) nil)))
;; ;;
;; Redefine the abbrev-hacking functions. Yuck.
(fset 'abbrev-hacking-next-line
(function (lambda (p) (interactive "p")
(abbrev-hacking-next-line-v18 p))))
(fset 'abbrev-hacking-end-of-buffer
(function (lambda (p) (interactive "P")
(abbrev-hacking-end-of-buffer-v18 p))))
;;
;; Encapsulate mail-setup to do the necessary buffer initializations. ;; Encapsulate mail-setup to do the necessary buffer initializations.
(or (fboundp 'mail-setup-v18) (or (fboundp 'mail-setup-v18)
(fset 'mail-setup-v18 (symbol-function 'mail-setup))) (fset 'mail-setup-v18 (symbol-function 'mail-setup)))
...@@ -611,9 +655,28 @@ end of line." ...@@ -611,9 +655,28 @@ end of line."
(function (lambda (&rest args) (function (lambda (&rest args)
(mail-aliases-setup-v18) (mail-aliases-setup-v18)
(apply 'mail-setup-v18 args)))) (apply 'mail-setup-v18 args))))
;;
;; Encapsulate VM's version of mail-setup as well, if vm-mail is
;; defined as a function or as an autoload.
(cond ((and (fboundp 'vm-mail)
(if (eq 'autoload (car-safe (symbol-function 'vm-mail)))
(load (nth 1 (symbol-function 'vm-mail)) t)
t))
(or (fboundp 'vm-mail-internal-v18)
(fset 'vm-mail-internal-v18
(symbol-function 'vm-mail-internal)))
(fset 'vm-mail-internal
(function (lambda (&rest args)
(mail-aliases-setup-v18)
(apply 'vm-mail-internal-v18 args))))))
;; If we're being loaded from mail-setup-hook or mail-mode-hook
;; as run from inside mail-setup or vm-mail-internal, then install
;; right now.
(if (eq major-mode 'mail-mode)
(mail-aliases-setup-v18))
) )
(t ; v19 (t ; v19
(fmakunbound 'expand-mail-aliases))) (fmakunbound 'expand-mail-aliases)))
;;; mailabbrev.el ends here
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment