comparison lisp/mail/mailabbrev.el @ 717:950a63133bc4

*** empty log message ***

716:f11e7af7c0d9

;;; ??? We must get papers for this or delete it.
;;; mailabbrev.el --- abbrev-expansion of mail aliases.

;;; Copyright (C) 1985, 1986, 1987, 1992 Free Software Foundation, Inc.
;;; Created: 19 oct 90, Jamie Zawinski <[e-mail]>
;;; Modified: 5 apr 92, Roland McGrath <[e-mail]>
;;; Last change 22-apr-92. jwz

;;; This file is part of GNU Emacs.

;;; 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
;;; the Free Software Foundation; either version 1, or (at your option)
;;; any later version.

;;; GNU Emacs is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the

	    (mapatoms (function mail-resolve-all-aliases-1) mail-aliases))
	(setq mail-abbrev-aliases-need-to-be-resolved nil)
;;	(message "Resolving mail aliases... done.")
	)))

(defun mail-resolve-all-aliases-1 (sym)
  (let ((definition (and (boundp sym) (symbol-value sym))))
    (if definition
	(let ((result '())
	      (start 0))
	  (while start

	      (setq result (cons (substring definition start end) result)
		    start (and end (match-end 0)))))
	  (setq definition
		(mapconcat (function (lambda (x)
			     (or (mail-resolve-all-aliases-1
				   (intern-soft x mail-aliases))
				 x)))
			   (nreverse result)
			   mail-alias-separator-string))
	  (set sym definition))))
  (symbol-value sym))

	;;      abbrev expansion.
	;;   -  Then we call expand-abbrev again, recursively, to do the abbrev
	;;      expansion with the above syntax table.
	;;   -  Then we do a trick which tells the expand-abbrev frame which
	;;      invoked us to not continue (and thus not expand twice.)
	;;   -  Then we set the syntax table to mail-mode-header-syntax-table,
	;;      which doesn't have anything to do with abbrev expansion, but
	;;      is just for the user's convenience (see its doc string.)
	;;
	(setq local-abbrev-table mail-aliases)
	;; 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 -.)
	(or (= (char-syntax last-command-char) ?_)
	    (let ((pre-abbrev-expand-hook nil)) ; that's us; don't loop
	      (set-syntax-table mail-abbrev-syntax-table)
	      (expand-abbrev)))
	(setq abbrev-start-location (point)  ; this is the trick
	      abbrev-start-location-buffer (current-buffer))
	;; and do this just because.
	(set-syntax-table mail-mode-header-syntax-table)
	)))

;;; utilities

(defun merge-mail-aliases (file)

(defun abbrev-hacking-next-line (&optional arg)
  "Just like `next-line' (\\[next-line]) but expands abbrevs when at \
end of line."
  (interactive "p")
  (if (looking-at "[ \t]*\n") (sendmail-pre-abbrev-expand-hook))
  (next-line arg))

(defun abbrev-hacking-end-of-buffer (&optional arg)
  "Just like `end-of-buffer' (\\[end-of-buffer]) but expands abbrevs when at \
end of line."
  (interactive "P")
  (if (looking-at "[ \t]*\n") (sendmail-pre-abbrev-expand-hook))
  (end-of-buffer arg))

(define-key mail-mode-map "\C-c\C-a" 'mail-interactive-insert-alias)

;;(define-key mail-mode-map "\C-n" 'abbrev-hacking-next-line)

;;; All of the Emacs18 stuff is isolated down here so that it will be
;;; easy to delete once v18 finally bites the dust.
;;;
;;; These defuns and defvars aren't inside the cond in deference to
;;; the intense brokenness of the v18 byte-compiler.

(defun sendmail-v18-self-insert-command (arg)
  "Just like self-insert-command, but runs sendmail-pre-abbrev-expand-hook."
  (interactive "p")
  (if (not (= (char-syntax last-command-char) ?w))
      (progn
	(sendmail-pre-abbrev-expand-hook)
        ;; Unhack expand-abbrev, so it will work right next time around.
	(setq abbrev-start-location nil)))
  (let ((abbrev-mode nil))
    (self-insert-command arg)))

(defvar mail-abbrevs-v18-map-munged nil)

(defun mail-abbrevs-v18-munge-map ()
  ;; For every key that is bound to self-insert-command in global-map,

  ;; We used to do this by making the mail-mode-map be a non-sparse map,
  ;; but that made the esc-map be shared in such a way that making a
  ;; local meta binding in the mail-mode-map made a *global* binding
  ;; instead.  Yucko.
  (let ((global-map (current-global-map))
	(i 0))
    (while (< i 128)
      (if (eq 'self-insert-command (or (cdr (assq i mail-mode-map))
				       (aref global-map i)))
	  (define-key mail-mode-map (char-to-string i)
	    'sendmail-v18-self-insert-command))
      (setq i (1+ i))))
  (setq mail-abbrevs-v18-map-munged t))

(defun mail-aliases-setup-v18 ()
  "Put this on `mail-setup-hook' to use mail-abbrevs."
  (if (and (not (vectorp mail-aliases))
	   (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)
	   (and (boundp 'epoch::version) epoch::version))
       ;;

       (fset 'expand-mail-aliases
	     (function (lambda (&rest args)
			 "Obsoleted by mail-abbrevs.  Does nothing."
			 nil)))
       ;;
       ;; Encapsulate mail-setup to do the necessary buffer initializations.
       (or (fboundp 'mail-setup-v18)
	   (fset 'mail-setup-v18 (symbol-function 'mail-setup)))
       (fset 'mail-setup
	     (function (lambda (&rest args)
			 (mail-aliases-setup-v18)
			 (apply 'mail-setup-v18 args))))
       )

      (t ; v19
       (fmakunbound 'expand-mail-aliases)))

;;; mailabbrev.el ends here

717:950a63133bc4

;;; ??? We must get papers for this or delete it.
;;; Abbrev-expansion of mail aliases.
;;; Copyright (C) 1985, 1986, 1987, 1992 Free Software Foundation, Inc.
;;; Created: 19 oct 90, Jamie Zawinski <[e-mail]>
;;; Modified: 5 apr 92, Roland McGrath <[e-mail]>
;;; Last change 13-jun-92. jwz

;;; This file is part of GNU Emacs.

;;; 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
;;; the Free Software Foundation; either version 2, or (at your option)
;;; any later version.

;;; GNU Emacs is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the

	    (mapatoms (function mail-resolve-all-aliases-1) mail-aliases))
	(setq mail-abbrev-aliases-need-to-be-resolved nil)
;;	(message "Resolving mail aliases... done.")
	)))

(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))))
    (if definition
	(let ((result '())
	      (start 0))
	  (while start

	      (setq result (cons (substring definition start end) result)
		    start (and end (match-end 0)))))
	  (setq definition
		(mapconcat (function (lambda (x)
			     (or (mail-resolve-all-aliases-1
				   (intern-soft x mail-aliases)
				   (cons sym so-far))
				 x)))
			   (nreverse result)
			   mail-alias-separator-string))
	  (set sym definition))))
  (symbol-value sym))

	;;      abbrev expansion.
	;;   -  Then we call expand-abbrev again, recursively, to do the abbrev
	;;      expansion with the above syntax table.
	;;   -  Then we do a trick which tells the expand-abbrev frame which
	;;      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,
	;;      which doesn't have anything to do with abbrev expansion, but
	;;      is just for the user's convenience (see its doc string.)
	;;
	(setq local-abbrev-table mail-aliases)
	;; 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 -.)
	;; Check the character's syntax in the mail-mode-header-syntax-table.
	(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)
	      (expand-abbrev)
	      ;; 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))
	)))

;;; utilities

(defun merge-mail-aliases (file)

(defun abbrev-hacking-next-line (&optional arg)
  "Just like `next-line' (\\[next-line]) but expands abbrevs when at \
end of line."
  (interactive "p")
  (if (looking-at "[ \t]*\n") (expand-abbrev))
  (setq this-command 'next-line)
  (next-line arg))

(defun abbrev-hacking-end-of-buffer (&optional arg)
  "Just like `end-of-buffer' (\\[end-of-buffer]) but expands abbrevs when at \
end of line."
  (interactive "P")
  (if (looking-at "[ \t]*\n") (expand-abbrev))
  (setq this-command 'end-of-buffer)
  (end-of-buffer arg))

(define-key mail-mode-map "\C-c\C-a" 'mail-interactive-insert-alias)

;;(define-key mail-mode-map "\C-n" 'abbrev-hacking-next-line)

;;; All of the Emacs18 stuff is isolated down here so that it will be
;;; easy to delete once v18 finally bites the dust.
;;;
;;; These defuns and defvars aren't inside the cond in deference to
;;; 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)
  "Just like self-insert-command, but runs sendmail-pre-abbrev-expand-hook."
  (interactive "p")
  (if (not (eq (char-syntax last-command-char) ?w))
      (progn
	(sendmail-pre-abbrev-expand-hook)
        ;; Unhack expand-abbrev, so it will work right next time around.
	(setq abbrev-start-location nil)))
  ;; this is gross and wasteful.
  (let ((abbrev-mode (if (mail-abbrev-in-expansion-header-p)
			 nil
		       abbrev-mode)))
    (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)

(defun mail-abbrevs-v18-munge-map ()
  ;; For every key that is bound to self-insert-command in global-map,

  ;; We used to do this by making the mail-mode-map be a non-sparse map,
  ;; but that made the esc-map be shared in such a way that making a
  ;; local meta binding in the mail-mode-map made a *global* binding
  ;; instead.  Yucko.
  (let ((global-map (current-global-map))
	new-bindings
	(i 0))
    (while (< i 128)
      (if (eq 'self-insert-command (or (cdr (assq i mail-mode-map))
				       (aref global-map i)))
	  (setq new-bindings
		(cons (cons i 'sendmail-v18-self-insert-command)
		      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))

(defun mail-aliases-setup-v18 ()
  "Put this on `mail-setup-hook' to use mail-abbrevs."
  (if (not (eq major-mode 'mail-mode))
      nil
    (or (and mail-mode-map (eq (current-local-map) mail-mode-map))
	(error "shut 'er down clancy, she's suckin' mud"))
    (if (and (not (vectorp mail-aliases))
	     (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)
	   (and (boundp 'epoch::version) epoch::version))
       ;;

       (fset 'expand-mail-aliases
	     (function (lambda (&rest args)
			 "Obsoleted by mail-abbrevs.  Does nothing."
			 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.
       (or (fboundp 'mail-setup-v18)
	   (fset 'mail-setup-v18 (symbol-function 'mail-setup)))
       (fset 'mail-setup
	     (function (lambda (&rest args)
			 (mail-aliases-setup-v18)
			 (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
       (fmakunbound 'expand-mail-aliases)))