Mercurial > emacs
annotate lisp/mail/mailabbrev.el @ 1717:aa7d6d57504b
* frame.h (struct frame): New fields `can_have_scrollbars' and
`has_vertical_scrollbars'.
(FRAME_CAN_HAVE_SCROLLBARS, FRAME_HAS_VERTICAL_SCROLLBARS): New
accessors, for both the MULTI_FRAME and non-MULTI_FRAME.
(VERTICAL_SCROLLBAR_WIDTH, WINDOW_VERTICAL_SCROLLBAR,
WINDOW_VERTICAL_SCROLLBAR_COLUMN,
WINDOW_VERTICAL_SCROLLBAR_HEIGHT): New macros.
* window.h (struct window): New field `vertical_scrollbar'.
* xterm.h (struct x_display): vertical_scrollbars,
judge_timestamp, vertical_scrollbar_extra: New fields.
(struct scrollbar): New struct.
(VERTICAL_SCROLLBAR_PIXEL_WIDTH, VERTICAL_SCROLLBAR_PIXEL_HEIGHT,
VERTICAL_SCROLLBAR_LEFT_BORDER, VERTICAL_SCROLLBAR_RIGHT_BORDER,
VERTICAL_SCROLLBAR_TOP_BORDER, VERTICAL_SCROLLBAR_BOTTOM_BORDER,
CHAR_TO_PIXEL_WIDTH, CHAR_TO_PIXEL_HEIGHT, PIXEL_TO_CHAR_WIDTH,
PIXEL_TO_CHAR_HEIGHT): New accessors and macros.
* frame.c (make_frame): Initialize the `can_have_scrollbars' and
`has_vertical_scrollbars' fields of the frame.
* term.c (term_init): Note that TERMCAP terminals don't support
scrollbars.
(mouse_position_hook): Document new args.
(set_vertical_scrollbar_hook, condemn_scrollbars_hook,
redeem_scrollbar_hook, judge_scrollbars_hook): New hooks.
* termhooks.h: Declare and document them.
(enum scrollbar_part): New type.
(struct input_event): Describe the new form of the scrollbar_click
event type. Change `part' from a Lisp_Object to an enum
scrollbar_part. Add a new field `scrollbar'.
* keyboard.c (kbd_buffer_get_event): Pass appropriate new
parameters to *mouse_position_hook, and make_lispy_movement.
* xfns.c (x_set_vertical_scrollbar): New function.
(x_figure_window_size): Use new macros to calculate frame size.
(Fx_create_frame): Note that X Windows frames do support scroll
bars. Default to "yes".
* xterm.c: #include <X11/cursorfont.h> and "window.h".
(x_vertical_scrollbar_cursor): New variable.
(x_term_init): Initialize it.
(last_mouse_bar, last_mouse_bar_frame, last_mouse_part,
last_mouse_scroll_range_start, last_mouse_scroll_range_end): New
variables.
(XTmouse_position): Use them to return scrollbar movement events.
Take new arguments, for that purpose.
(x_window_to_scrollbar, x_scrollbar_create,
x_scrollbar_set_handle, x_scrollbar_remove, x_scrollbar_move,
XTset_scrollbar, XTcondemn_scrollbars, XTredeem_scrollbar,
XTjudge_scrollbars, x_scrollbar_expose,
x_scrollbar_background_expose, x_scrollbar_handle_click,
x_scrollbar_handle_motion): New functions to implement scrollbars.
(x_term_init): Set the termhooks.h hooks to point to them.
(x_set_window_size): Use new macros to calculate frame size. Set
vertical_scrollbar_extra field.
(x_make_frame_visible): Use the frame accessor
FRAME_HAS_VERTICAL_SCROLLBARS to decide if we need to map the
frame's subwindows as well.
(XTread_socket): Use new size-calculation macros from xterm.h when
processing ConfigureNotify events.
(x_wm_set_size_hint): Use PIXEL_TO_CHAR_WIDTH and
PIXEL_TO_CHAR_HEIGHT macros.
* ymakefile (xdisp.o): This now depends on termhooks.h.
(xterm.o): This now depends on window.h.
| author | Jim Blandy <jimb@redhat.com> |
|---|---|
| date | Thu, 24 Dec 1992 06:17:18 +0000 |
| parents | c5fe2f36dda5 |
| children | f852ebc02465 |
| rev | line source |
|---|---|
| 1148 | 1 ;;; mailabbrev.el --- abbrev-expansion of mail aliases. |
| 2 | |
|
846
20674ae6bf52
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
811
diff
changeset
|
3 ;;; Copyright (C) 1985, 1986, 1987, 1992 Free Software Foundation, Inc. |
| 1148 | 4 |
| 5 ;; Author: Jamie Zawinski <jwz@lucid.com> | |
| 6 ;; Maintainer: Jamie Zawinski <jwz@lucid.com> | |
| 7 ;; Created: 19 Oct 90 | |
| 8 ;; Keywords: mail | |
| 9 | |
| 459 | 10 ;;; This file is part of GNU Emacs. |
| 11 | |
| 12 ;;; GNU Emacs is free software; you can redistribute it and/or modify | |
| 13 ;;; it under the terms of the GNU General Public License as published by | |
| 717 | 14 ;;; the Free Software Foundation; either version 2, or (at your option) |
| 459 | 15 ;;; any later version. |
| 16 | |
| 17 ;;; GNU Emacs is distributed in the hope that it will be useful, | |
| 18 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 19 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
| 20 ;;; GNU General Public License for more details. | |
| 21 | |
| 22 ;;; You should have received a copy of the GNU General Public License | |
| 23 ;;; along with GNU Emacs; see the file COPYING. If not, write to | |
| 24 ;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | |
| 25 | |
| 1148 | 26 ;;; Commentary: |
| 27 | |
| 459 | 28 ;;; This file ensures that, when the point is in a To:, CC:, BCC:, or From: |
| 29 ;;; field, word-abbrevs are defined for each of your mail aliases. These | |
| 30 ;;; aliases will be defined from your .mailrc file (or the file specified by | |
| 598 | 31 ;;; the MAILRC environment variable) if it exists. Your mail aliases will |
| 32 ;;; expand any time you type a word-delimiter at the end of an abbreviation. | |
| 459 | 33 ;;; |
| 34 ;;; What you see is what you get: no abbreviations will be expanded after you | |
| 35 ;;; have sent the mail, unlike the old system. This means you don't suffer | |
| 36 ;;; the annoyance of having the system do things behind your back -- if an | |
| 37 ;;; address you typed is going to be rewritten, you know it immediately, | |
| 38 ;;; instead of after the mail has been sent and it's too late to do anything | |
| 39 ;;; about it. You will never again be screwed because you forgot to delete an | |
| 40 ;;; old alias from your .mailrc when a new local user arrives and is given a | |
| 41 ;;; userid which conflicts with one of your aliases, for example. | |
| 42 ;;; | |
| 43 ;;; Your mail alias abbrevs will be in effect only when the point is in an | |
| 44 ;;; appropriate header field. When in the body of the message, or other | |
| 45 ;;; header fields, the mail aliases will not expand. Rather, the normal | |
| 46 ;;; mode-specific abbrev table (mail-mode-abbrev-table) will be used if | |
| 47 ;;; defined. So if you use mail-mode specific abbrevs, this code will not | |
| 48 ;;; adversely affect you. You can control which header fields the abbrevs | |
| 49 ;;; are used in by changing the variable mail-abbrev-mode-regexp. | |
| 50 ;;; | |
| 51 ;;; If auto-fill mode is on, abbrevs will wrap at commas instead of at word | |
| 52 ;;; boundaries; also, header continuation-lines will be properly indented. | |
| 53 ;;; | |
| 54 ;;; You can also insert a mail alias with mail-interactive-insert-alias | |
| 55 ;;; (bound to C-c C-a), which prompts you for an alias (with completion) | |
| 56 ;;; and inserts its expansion at point. | |
| 57 ;;; | |
| 58 ;;; This file fixes a bug in the old system which prohibited your .mailrc | |
| 59 ;;; file from having lines like | |
| 60 ;;; | |
| 61 ;;; alias someone "John Doe <doe@quux.com>" | |
| 62 ;;; | |
| 63 ;;; That is, if you want an address to have embedded spaces, simply surround it | |
| 64 ;;; with double-quotes. This is necessary because the format of the .mailrc | |
| 65 ;;; file bogusly uses spaces as address delimiters. The following line defines | |
| 66 ;;; an alias which expands to three addresses: | |
| 67 ;;; | |
| 68 ;;; alias foobar addr-1 addr-2 "address three <addr-3>" | |
| 69 ;;; | |
| 70 ;;; (This is bogus because mail-delivery programs want commas, not spaces, | |
| 71 ;;; but that's what the file format is, so we have to live with it.) | |
| 72 ;;; | |
| 73 ;;; If you like, you can call the function define-mail-alias to define your | |
|
1432
7446ab662993
Delete version 18 compatibility stuff.
Richard M. Stallman <rms@gnu.org>
parents:
1150
diff
changeset
|
74 ;;; mail aliases instead of using a .mailrc file. When you call it in this |
| 627 | 75 ;;; way, addresses are separated by commas. |
| 459 | 76 ;;; |
| 77 ;;; CAVEAT: This works on most Sun systems; I have been told that some versions | |
| 78 ;;; of /bin/mail do not understand double-quotes in the .mailrc file. So you | |
| 79 ;;; should make sure your version does before including verbose addresses like | |
| 80 ;;; this. One solution to this, if you are on a system whose /bin/mail doesn't | |
| 81 ;;; work that way, (and you still want to be able to /bin/mail to send mail in | |
| 82 ;;; addition to emacs) is to define minimal aliases (without full names) in | |
| 83 ;;; your .mailrc file, and use define-mail-alias to redefine them when sending | |
| 84 ;;; mail from emacs; this way, mail sent from /bin/mail will work, and mail | |
| 85 ;;; sent from emacs will be pretty. | |
| 86 ;;; | |
| 87 ;;; Aliases in the mailrc file may be nested. If you define aliases like | |
| 88 ;;; alias group1 fred ethel | |
| 89 ;;; alias group2 larry curly moe | |
| 90 ;;; alias everybody group1 group2 | |
| 91 ;;; Then when you type "everybody" on the To: line, it will be expanded to | |
| 92 ;;; fred, ethyl, larry, curly, moe | |
| 93 ;;; | |
| 94 ;;; Aliases may also contain forward references; the alias of "everybody" can | |
| 95 ;;; preceed the aliases of "group1" and "group2". | |
| 96 ;;; | |
| 97 ;;; This code also understands the "source" .mailrc command, for reading | |
| 98 ;;; aliases from some other file as well. | |
| 99 ;;; | |
| 598 | 100 ;;; Aliases may contain hyphens, as in "alias foo-bar foo@bar"; word-abbrevs |
| 101 ;;; normally cannot contain hyphens, but this code works around that for the | |
| 102 ;;; specific case of mail-alias word-abbrevs. | |
| 103 ;;; | |
| 459 | 104 ;;; To read in the contents of another .mailrc-type file from emacs, use the |
|
1432
7446ab662993
Delete version 18 compatibility stuff.
Richard M. Stallman <rms@gnu.org>
parents:
1150
diff
changeset
|
105 ;;; command Meta-X merge-mail-abbrevs. The rebuild-mail-abbrevs command is |
| 459 | 106 ;;; similar, but will delete existing aliases first. |
| 107 ;;; | |
| 598 | 108 ;;; If you would like your aliases to be expanded when you type M-> or ^N to |
| 109 ;;; move out of the mail-header into the message body (instead of having to | |
| 110 ;;; type SPC at the end of the abbrev before moving away) then you can do | |
| 111 ;;; | |
| 1433 | 112 ;;; (define-key mail-mode-map "\C-n" 'mail-abbrev-next-line) |
| 113 ;;; (define-key mail-mode-map "\M->" 'mail-abbrev-end-of-buffer) | |
| 598 | 114 ;;; |
| 627 | 115 ;;; If you want multiple addresses separated by a string other than ", " then |
| 116 ;;; you can set the variable mail-alias-separator-string to it. This has to | |
| 459 | 117 ;;; be a comma bracketed by whitespace if you want any kind of reasonable |
| 118 ;;; behaviour. | |
| 119 ;;; | |
| 120 ;;; Thanks to Harald Hanche-Olsen, Michael Ernst, David Loeffler, and | |
| 121 ;;; Noah Friedman for suggestions and bug reports. | |
|
1432
7446ab662993
Delete version 18 compatibility stuff.
Richard M. Stallman <rms@gnu.org>
parents:
1150
diff
changeset
|
122 |
|
7446ab662993
Delete version 18 compatibility stuff.
Richard M. Stallman <rms@gnu.org>
parents:
1150
diff
changeset
|
123 ;;; To use this file, add mail-abbrevs-setup as a hook |
|
7446ab662993
Delete version 18 compatibility stuff.
Richard M. Stallman <rms@gnu.org>
parents:
1150
diff
changeset
|
124 ;;; to the hook list `mail-setup-hook'. |
| 459 | 125 |
| 1148 | 126 ;;; Code: |
| 127 | |
| 459 | 128 (require 'sendmail) |
| 129 | |
| 130 (defvar mail-abbrev-mailrc-file nil | |
| 131 "Name of file with mail aliases. If nil, ~/.mailrc is used.") | |
| 132 | |
| 133 (defmacro mail-abbrev-mailrc-file () | |
| 134 '(or mail-abbrev-mailrc-file | |
| 135 (setq mail-abbrev-mailrc-file | |
| 136 (or (getenv "MAILRC") "~/.mailrc")))) | |
| 137 | |
| 138 ;; originally defined in sendmail.el - used to be an alist, now is a table. | |
|
1432
7446ab662993
Delete version 18 compatibility stuff.
Richard M. Stallman <rms@gnu.org>
parents:
1150
diff
changeset
|
139 (defvar mail-abbrevs nil |
| 598 | 140 "Word-abbrev table of mail address aliases. |
| 459 | 141 If this is nil, it means the aliases have not yet been initialized and |
| 142 should be read from the .mailrc file. (This is distinct from there being | |
| 143 no aliases, which is represented by this being a table with no entries.)") | |
| 144 | |
| 474 | 145 ;;;###autoload |
|
1432
7446ab662993
Delete version 18 compatibility stuff.
Richard M. Stallman <rms@gnu.org>
parents:
1150
diff
changeset
|
146 (defun mail-abbrevs-setup () |
|
7446ab662993
Delete version 18 compatibility stuff.
Richard M. Stallman <rms@gnu.org>
parents:
1150
diff
changeset
|
147 (if (and (not (vectorp mail-abbrevs)) |
| 459 | 148 (file-exists-p (mail-abbrev-mailrc-file))) |
|
1432
7446ab662993
Delete version 18 compatibility stuff.
Richard M. Stallman <rms@gnu.org>
parents:
1150
diff
changeset
|
149 (build-mail-abbrevs)) |
| 606 | 150 (make-local-variable 'pre-abbrev-expand-hook) |
| 151 (setq pre-abbrev-expand-hook | |
| 152 (cond ((and (listp pre-abbrev-expand-hook) | |
| 153 (not (eq 'lambda (car pre-abbrev-expand-hook)))) | |
| 154 (cons 'sendmail-pre-abbrev-expand-hook pre-abbrev-expand-hook)) | |
| 155 (t | |
| 156 (list 'sendmail-pre-abbrev-expand-hook pre-abbrev-expand-hook)))) | |
| 459 | 157 (abbrev-mode 1)) |
| 158 | |
| 598 | 159 ;;;###autoload |
|
1432
7446ab662993
Delete version 18 compatibility stuff.
Richard M. Stallman <rms@gnu.org>
parents:
1150
diff
changeset
|
160 (defun build-mail-abbrevs (&optional file recursivep) |
|
7446ab662993
Delete version 18 compatibility stuff.
Richard M. Stallman <rms@gnu.org>
parents:
1150
diff
changeset
|
161 "Read mail aliases from `~/.mailrc' file and set `mail-abbrevs'." |
| 459 | 162 (setq file (expand-file-name (or file (mail-abbrev-mailrc-file)))) |
|
1432
7446ab662993
Delete version 18 compatibility stuff.
Richard M. Stallman <rms@gnu.org>
parents:
1150
diff
changeset
|
163 (if (vectorp mail-abbrevs) |
| 459 | 164 nil |
|
1432
7446ab662993
Delete version 18 compatibility stuff.
Richard M. Stallman <rms@gnu.org>
parents:
1150
diff
changeset
|
165 (setq mail-abbrevs nil) |
|
7446ab662993
Delete version 18 compatibility stuff.
Richard M. Stallman <rms@gnu.org>
parents:
1150
diff
changeset
|
166 (define-abbrev-table 'mail-abbrevs '())) |
| 606 | 167 (message "Parsing %s..." file) |
| 459 | 168 (let ((buffer nil) |
| 169 (obuf (current-buffer))) | |
| 170 (unwind-protect | |
| 171 (progn | |
| 172 (setq buffer (generate-new-buffer "mailrc")) | |
| 598 | 173 (buffer-disable-undo buffer) |
| 459 | 174 (set-buffer buffer) |
| 175 (cond ((get-file-buffer file) | |
| 176 (insert (save-excursion | |
| 177 (set-buffer (get-file-buffer file)) | |
| 178 (buffer-substring (point-min) (point-max))))) | |
| 179 ((not (file-exists-p file))) | |
| 180 (t (insert-file-contents file))) | |
| 181 ;; Don't lose if no final newline. | |
| 182 (goto-char (point-max)) | |
| 183 (or (eq (preceding-char) ?\n) (newline)) | |
| 184 (goto-char (point-min)) | |
| 185 ;; Delete comments from the file | |
| 186 (while (search-forward "# " nil t) | |
| 187 (let ((p (- (point) 2))) | |
| 188 (end-of-line) | |
| 189 (delete-region p (point)))) | |
| 190 (goto-char (point-min)) | |
| 191 ;; handle "\\\n" continuation lines | |
| 192 (while (not (eobp)) | |
| 193 (end-of-line) | |
| 194 (if (= (preceding-char) ?\\) | |
| 195 (progn (delete-char -1) (delete-char 1) (insert ?\ )) | |
| 196 (forward-char 1))) | |
| 197 (goto-char (point-min)) | |
| 198 (while (re-search-forward | |
| 907 | 199 "^\\(a\\(lias\\)?\\|g\\(roup\\)?\\|source\\)[ \t]+" nil t) |
| 459 | 200 (beginning-of-line) |
| 201 (if (looking-at "source[ \t]+\\([^ \t\n]+\\)") | |
| 202 (progn | |
| 203 (end-of-line) | |
|
1432
7446ab662993
Delete version 18 compatibility stuff.
Richard M. Stallman <rms@gnu.org>
parents:
1150
diff
changeset
|
204 (build-mail-abbrevs |
| 459 | 205 (buffer-substring (match-beginning 1) (match-end 1)) t)) |
| 206 (re-search-forward "[ \t]+\\([^ \t\n]+\\)") | |
| 207 (let* ((name (buffer-substring | |
| 208 (match-beginning 1) (match-end 1))) | |
| 209 (start (progn (skip-chars-forward " \t") (point)))) | |
| 210 (end-of-line) | |
| 211 ; (message "** %s \"%s\"" name (buffer-substring start (point)))(sit-for 1) | |
| 212 (define-mail-alias | |
| 213 name | |
| 214 (buffer-substring start (point)) | |
| 215 t)))) | |
| 216 ;; Resolve forward references in .mailrc file. | |
| 217 ;; This would happen automatically before the first abbrev was | |
| 218 ;; expanded, but why not do it now. | |
| 219 (or recursivep (mail-resolve-all-aliases)) | |
|
1432
7446ab662993
Delete version 18 compatibility stuff.
Richard M. Stallman <rms@gnu.org>
parents:
1150
diff
changeset
|
220 mail-abbrevs) |
| 459 | 221 (if buffer (kill-buffer buffer)) |
| 222 (set-buffer obuf))) | |
| 606 | 223 (message "Parsing %s... done" file)) |
| 459 | 224 |
| 627 | 225 (defvar mail-alias-separator-string ", " |
| 459 | 226 "*A string inserted between addresses in multi-address mail aliases. |
| 227 This has to contain a comma, so \", \" is a reasonable value. You might | |
| 228 also want something like \",\\n \" to get each address on its own line.") | |
| 229 | |
| 230 ;; define-mail-alias sets this flag, which causes mail-resolve-all-aliases | |
| 231 ;; to be called before expanding abbrevs if it's necessary. | |
| 232 (defvar mail-abbrev-aliases-need-to-be-resolved t) | |
| 233 | |
|
1432
7446ab662993
Delete version 18 compatibility stuff.
Richard M. Stallman <rms@gnu.org>
parents:
1150
diff
changeset
|
234 ;; originally defined in mailalias.el ; build-mail-abbrevs calls this with |
| 459 | 235 ;; stuff parsed from the .mailrc file. |
| 236 ;; | |
| 474 | 237 ;;;###autoload |
| 459 | 238 (defun define-mail-alias (name definition &optional from-mailrc-file) |
| 239 "Define NAME as a mail-alias that translates to DEFINITION. | |
| 627 | 240 If DEFINITION contains multiple addresses, separate them with commas." |
|
1432
7446ab662993
Delete version 18 compatibility stuff.
Richard M. Stallman <rms@gnu.org>
parents:
1150
diff
changeset
|
241 ;; When this is called from build-mail-abbrevs, the third argument is |
| 459 | 242 ;; true, and we do some evil space->comma hacking like /bin/mail does. |
| 243 (interactive "sDefine mail alias: \nsDefine %s as mail alias for: ") | |
| 244 ;; Read the defaults first, if we have not done so. | |
|
1432
7446ab662993
Delete version 18 compatibility stuff.
Richard M. Stallman <rms@gnu.org>
parents:
1150
diff
changeset
|
245 (if (vectorp mail-abbrevs) |
| 459 | 246 nil |
|
1432
7446ab662993
Delete version 18 compatibility stuff.
Richard M. Stallman <rms@gnu.org>
parents:
1150
diff
changeset
|
247 (setq mail-abbrevs nil) |
|
7446ab662993
Delete version 18 compatibility stuff.
Richard M. Stallman <rms@gnu.org>
parents:
1150
diff
changeset
|
248 (define-abbrev-table 'mail-abbrevs '()) |
| 459 | 249 (if (file-exists-p (mail-abbrev-mailrc-file)) |
|
1432
7446ab662993
Delete version 18 compatibility stuff.
Richard M. Stallman <rms@gnu.org>
parents:
1150
diff
changeset
|
250 (build-mail-abbrevs))) |
| 459 | 251 ;; strip garbage from front and end |
| 252 (if (string-match "\\`[ \t\n,]+" definition) | |
| 253 (setq definition (substring definition (match-end 0)))) | |
| 254 (if (string-match "[ \t\n,]+\\'" definition) | |
| 255 (setq definition (substring definition 0 (match-beginning 0)))) | |
| 256 (let ((result '()) | |
| 257 (start 0) | |
| 258 (L (length definition)) | |
| 259 end) | |
| 260 (while start | |
| 261 ;; If we're reading from the mailrc file, then addresses are delimited | |
| 262 ;; by spaces, and addresses with embedded spaces must be surrounded by | |
| 627 | 263 ;; double-quotes. Otherwise, addresses are separated by commas. |
| 459 | 264 (if from-mailrc-file |
| 265 (if (eq ?\" (aref definition start)) | |
| 266 (setq start (1+ start) | |
| 267 end (string-match "\"[ \t,]*" definition start)) | |
| 268 (setq end (string-match "[ \t,]+" definition start))) | |
| 269 (setq end (string-match "[ \t\n,]*,[ \t\n,]*" definition start))) | |
| 270 (setq result (cons (substring definition start end) result)) | |
| 271 (setq start (and end | |
| 272 (/= (match-end 0) L) | |
| 273 (match-end 0)))) | |
| 274 (setq definition (mapconcat (function identity) | |
| 275 (nreverse result) | |
| 627 | 276 mail-alias-separator-string))) |
| 459 | 277 (setq mail-abbrev-aliases-need-to-be-resolved t) |
| 278 (setq name (downcase name)) | |
|
1432
7446ab662993
Delete version 18 compatibility stuff.
Richard M. Stallman <rms@gnu.org>
parents:
1150
diff
changeset
|
279 ;; use an abbrev table instead of an alist for mail-abbrevs. |
| 459 | 280 (let ((abbrevs-changed abbrevs-changed)) ; protect this from being changed. |
|
1432
7446ab662993
Delete version 18 compatibility stuff.
Richard M. Stallman <rms@gnu.org>
parents:
1150
diff
changeset
|
281 (define-abbrev mail-abbrevs name definition 'mail-abbrev-expand-hook))) |
| 459 | 282 |
| 283 | |
| 284 (defun mail-resolve-all-aliases () | |
| 285 "Resolve all forward references in the mail aliases table." | |
| 286 (if mail-abbrev-aliases-need-to-be-resolved | |
| 287 (progn | |
| 288 ;; (message "Resolving mail aliases...") | |
|
1432
7446ab662993
Delete version 18 compatibility stuff.
Richard M. Stallman <rms@gnu.org>
parents:
1150
diff
changeset
|
289 (if (vectorp mail-abbrevs) |
|
7446ab662993
Delete version 18 compatibility stuff.
Richard M. Stallman <rms@gnu.org>
parents:
1150
diff
changeset
|
290 (mapatoms (function mail-resolve-all-aliases-1) mail-abbrevs)) |
| 459 | 291 (setq mail-abbrev-aliases-need-to-be-resolved nil) |
| 292 ;; (message "Resolving mail aliases... done.") | |
| 293 ))) | |
| 294 | |
| 717 | 295 (defun mail-resolve-all-aliases-1 (sym &optional so-far) |
| 296 (if (memq sym so-far) | |
| 297 (error "mail alias loop detected: %s" | |
| 298 (mapconcat 'symbol-name (cons sym so-far) " <- "))) | |
| 459 | 299 (let ((definition (and (boundp sym) (symbol-value sym)))) |
| 300 (if definition | |
| 301 (let ((result '()) | |
| 302 (start 0)) | |
| 303 (while start | |
| 304 (let ((end (string-match "[ \t\n]*,[, \t\n]*" definition start))) | |
| 305 (setq result (cons (substring definition start end) result) | |
| 306 start (and end (match-end 0))))) | |
| 307 (setq definition | |
| 308 (mapconcat (function (lambda (x) | |
| 309 (or (mail-resolve-all-aliases-1 | |
|
1432
7446ab662993
Delete version 18 compatibility stuff.
Richard M. Stallman <rms@gnu.org>
parents:
1150
diff
changeset
|
310 (intern-soft x mail-abbrevs) |
| 717 | 311 (cons sym so-far)) |
| 459 | 312 x))) |
| 313 (nreverse result) | |
| 627 | 314 mail-alias-separator-string)) |
| 459 | 315 (set sym definition)))) |
| 316 (symbol-value sym)) | |
| 317 | |
| 318 | |
| 627 | 319 (defun mail-abbrev-expand-hook () |
| 598 | 320 "For use as the fourth arg to define-abbrev. |
| 627 | 321 After expanding a mail-abbrev, if fill-mode is on and we're past the |
| 598 | 322 fill-column, break the line at the previous comma, and indent the next |
| 323 line." | |
| 608 | 324 (save-excursion |
| 325 (let ((p (point)) | |
| 326 bol comma fp) | |
| 327 (beginning-of-line) | |
| 328 (setq bol (point)) | |
| 329 (goto-char p) | |
| 606 | 330 (while (and auto-fill-function |
| 608 | 331 (>= (current-column) fill-column) |
| 332 (search-backward "," bol t)) | |
| 333 (setq comma (point)) | |
| 334 (forward-char 1) ; Now we are just past the comma. | |
| 335 (insert "\n") | |
| 336 (delete-horizontal-space) | |
| 627 | 337 (setq p (point)) |
| 608 | 338 (indent-relative) |
| 339 (setq fp (buffer-substring p (point))) | |
| 340 ;; Go to the end of the new line. | |
| 341 (end-of-line) | |
| 342 (if (> (current-column) fill-column) | |
| 343 ;; It's still too long; do normal auto-fill. | |
| 344 (let ((fill-prefix (or fp "\t"))) | |
| 345 (do-auto-fill))) | |
| 346 ;; Resume the search. | |
| 347 (goto-char comma) | |
| 348 )))) | |
| 598 | 349 |
| 350 ;;; Syntax tables and abbrev-expansion | |
| 459 | 351 |
| 598 | 352 (defvar mail-abbrev-mode-regexp "^\\(Resent-\\)?\\(To\\|From\\|CC\\|BCC\\):" |
|
1432
7446ab662993
Delete version 18 compatibility stuff.
Richard M. Stallman <rms@gnu.org>
parents:
1150
diff
changeset
|
353 "*Regexp to select mail-headers in which mail-abbrevs should be expanded. |
| 459 | 354 This string it will be handed to `looking-at' with the point at the beginning |
| 355 of the current line; if it matches, abbrev mode will be turned on, otherwise | |
| 356 it will be turned off. (You don't need to worry about continuation lines.) | |
| 357 This should be set to match those mail fields in which you want abbreviations | |
| 358 turned on.") | |
| 359 | |
| 360 (defvar mail-mode-syntax-table (copy-syntax-table text-mode-syntax-table) | |
| 598 | 361 "The syntax table which is used in send-mail mode message bodies.") |
| 459 | 362 |
| 363 (defvar mail-mode-header-syntax-table | |
| 364 (let ((tab (copy-syntax-table text-mode-syntax-table))) | |
| 627 | 365 ;; This makes the characters "@%!._-" be considered symbol-consituents |
| 459 | 366 ;; but not word-constituents, so forward-sexp will move you over an |
| 367 ;; entire address, but forward-word will only move you over a sequence | |
| 368 ;; of alphanumerics. (Clearly the right thing.) | |
| 369 (modify-syntax-entry ?@ "_" tab) | |
| 370 (modify-syntax-entry ?% "_" tab) | |
| 371 (modify-syntax-entry ?! "_" tab) | |
| 372 (modify-syntax-entry ?. "_" tab) | |
| 373 (modify-syntax-entry ?_ "_" tab) | |
| 374 (modify-syntax-entry ?- "_" tab) | |
| 375 (modify-syntax-entry ?< "(>" tab) | |
| 376 (modify-syntax-entry ?> ")<" tab) | |
| 377 tab) | |
| 598 | 378 "The syntax table used in send-mail mode when in a mail-address header. |
| 379 mail-mode-syntax-table is used when the cursor is in the message body or in | |
| 380 non-address headers.") | |
| 381 | |
| 382 (defvar mail-abbrev-syntax-table | |
| 383 (let* ((tab (copy-syntax-table mail-mode-header-syntax-table)) | |
| 384 (i (1- (length tab))) | |
| 385 (_ (aref (standard-syntax-table) ?_)) | |
| 386 (w (aref (standard-syntax-table) ?w))) | |
| 387 (while (>= i 0) | |
| 388 (if (= (aref tab i) _) (aset tab i w)) | |
| 389 (setq i (1- i))) | |
| 390 tab) | |
| 391 "The syntax-table used for abbrev-expansion purposes; this is not actually | |
| 392 made the current syntax table of the buffer, but simply controls the set of | |
| 393 characters which may be a part of the name of a mail-alias.") | |
| 394 | |
| 459 | 395 |
| 598 | 396 (defun mail-abbrev-in-expansion-header-p () |
| 397 "Whether point is in a mail-address header field." | |
| 398 (let ((case-fold-search t)) | |
| 399 (and ;; | |
| 400 ;; we are on an appropriate header line... | |
| 401 (save-excursion | |
| 402 (beginning-of-line) | |
| 403 ;; skip backwards over continuation lines. | |
| 404 (while (and (looking-at "^[ \t]") | |
| 405 (not (= (point) (point-min)))) | |
| 406 (forward-line -1)) | |
| 407 ;; are we at the front of an appropriate header line? | |
| 408 (looking-at mail-abbrev-mode-regexp)) | |
| 409 ;; | |
| 410 ;; ...and we are before the mail-header-separator | |
| 411 (< (point) | |
| 412 (save-excursion | |
| 413 (goto-char (point-min)) | |
| 414 (search-forward (concat "\n" mail-header-separator "\n") | |
| 415 nil 0) | |
| 416 (point)))))) | |
| 417 | |
| 418 (defvar mail-mode-abbrev-table) ; quiet the compiler | |
| 419 | |
| 627 | 420 (defun sendmail-pre-abbrev-expand-hook () |
|
1432
7446ab662993
Delete version 18 compatibility stuff.
Richard M. Stallman <rms@gnu.org>
parents:
1150
diff
changeset
|
421 (and (and mail-abbrevs (not (eq mail-abbrevs t))) |
| 1148 | 422 (if (mail-abbrev-in-expansion-header-p) |
| 423 (progn | |
| 424 ;; | |
| 425 ;; We are in a To: (or CC:, or whatever) header, and | |
| 426 ;; should use word-abbrevs to expand mail aliases. | |
| 427 | |
| 428 ;; Before anything else, resolve aliases if they need it. | |
| 429 (and mail-abbrev-aliases-need-to-be-resolved | |
| 430 (mail-resolve-all-aliases)) | |
| 431 | |
| 432 ;; Now proceed with the abbrev section. | |
|
1432
7446ab662993
Delete version 18 compatibility stuff.
Richard M. Stallman <rms@gnu.org>
parents:
1150
diff
changeset
|
433 ;; - First, install the mail-abbrevs as the word-abbrev table. |
| 1148 | 434 ;; - Then install the mail-abbrev-syntax-table, which |
| 435 ;; temporarily marks all of the | |
| 436 ;; non-alphanumeric-atom-characters (the "_" | |
| 437 ;; syntax ones) as being normal word-syntax. We do this | |
| 438 ;; because the C code for expand-abbrev only works on words, | |
| 439 ;; and we want these characters to be considered words for | |
| 440 ;; the purpose of abbrev expansion. | |
| 441 ;; - Then we call expand-abbrev again, recursively, to do | |
| 442 ;; the abbrev expansion with the above syntax table. | |
| 443 ;; - Then we do a trick which tells the expand-abbrev frame | |
| 444 ;; which invoked us to not continue (and thus not | |
| 445 ;; expand twice.) This means that any abbrev expansion | |
| 446 ;; will happen as a result of this function's call to | |
| 447 ;; expand-abbrev, and not as a result of the call to | |
| 448 ;; expand-abbrev which invoked *us*. | |
| 449 ;; - Then we set the syntax table to | |
| 450 ;; mail-mode-header-syntax-table, which doesn't have | |
| 451 ;; anything to do with abbrev expansion, but | |
| 452 ;; is just for the user's convenience (see its doc string.) | |
| 453 ;; | |
| 454 | |
|
1432
7446ab662993
Delete version 18 compatibility stuff.
Richard M. Stallman <rms@gnu.org>
parents:
1150
diff
changeset
|
455 (setq local-abbrev-table mail-abbrevs) |
| 1148 | 456 |
| 457 ;; If the character just typed was non-alpha-symbol-syntax, | |
| 458 ;; then don't expand the abbrev now (that is, don't expand | |
| 459 ;; when the user types -.) Check the character's syntax in | |
| 460 ;; the mail-mode-header-syntax-table. | |
| 461 | |
| 462 (set-syntax-table mail-mode-header-syntax-table) | |
| 463 (or (eq (char-syntax last-command-char) ?_) | |
| 464 (let ((pre-abbrev-expand-hook nil)) ; That's us; don't loop. | |
| 465 ;; Use this table so that abbrevs can have hyphens in them. | |
| 466 (set-syntax-table mail-abbrev-syntax-table) | |
| 467 (expand-abbrev) | |
| 468 ;; Now set it back to what it was before. | |
| 469 (set-syntax-table mail-mode-header-syntax-table))) | |
| 470 (setq abbrev-start-location (point) ; This is the trick. | |
| 471 abbrev-start-location-buffer (current-buffer))) | |
| 472 | |
| 473 ;; We're not in a mail header where mail aliases should | |
| 474 ;; be expanded, then use the normal mail-mode abbrev table | |
| 475 ;; (if any) and the normal mail-mode syntax table. | |
| 476 | |
| 477 (setq local-abbrev-table (and (boundp 'mail-mode-abbrev-table) | |
| 478 mail-mode-abbrev-table)) | |
| 479 (set-syntax-table mail-mode-syntax-table)) | |
| 480 )) | |
| 598 | 481 |
| 482 ;;; utilities | |
| 459 | 483 |
|
1432
7446ab662993
Delete version 18 compatibility stuff.
Richard M. Stallman <rms@gnu.org>
parents:
1150
diff
changeset
|
484 (defun merge-mail-abbrevs (file) |
| 459 | 485 "Merge mail aliases from the given file with existing ones." |
| 486 (interactive (list | |
| 487 (let ((insert-default-directory t) | |
| 488 (default-directory (expand-file-name "~/")) | |
| 489 (def (mail-abbrev-mailrc-file))) | |
| 490 (read-file-name | |
| 491 (format "Read additional aliases from file: (default %s) " | |
| 492 def) | |
| 493 default-directory | |
| 494 (expand-file-name def default-directory) | |
| 495 t)))) | |
|
1432
7446ab662993
Delete version 18 compatibility stuff.
Richard M. Stallman <rms@gnu.org>
parents:
1150
diff
changeset
|
496 (build-mail-abbrevs file)) |
| 459 | 497 |
|
1432
7446ab662993
Delete version 18 compatibility stuff.
Richard M. Stallman <rms@gnu.org>
parents:
1150
diff
changeset
|
498 (defun rebuild-mail-abbrevs (file) |
| 459 | 499 "Rebuild all the mail aliases from the given file." |
| 500 (interactive (list | |
| 501 (let ((insert-default-directory t) | |
| 502 (default-directory (expand-file-name "~/")) | |
| 503 (def (mail-abbrev-mailrc-file))) | |
| 504 (read-file-name | |
| 505 (format "Read mail aliases from file: (default %s) " def) | |
| 506 default-directory | |
| 507 (expand-file-name def default-directory) | |
| 508 t)))) | |
|
1432
7446ab662993
Delete version 18 compatibility stuff.
Richard M. Stallman <rms@gnu.org>
parents:
1150
diff
changeset
|
509 (setq mail-abbrevs nil) |
|
7446ab662993
Delete version 18 compatibility stuff.
Richard M. Stallman <rms@gnu.org>
parents:
1150
diff
changeset
|
510 (build-mail-abbrevs file)) |
| 584 | 511 |
| 598 | 512 (defun mail-interactive-insert-alias (&optional alias) |
| 513 "Prompt for and insert a mail alias." | |
| 907 | 514 (interactive (progn |
|
1432
7446ab662993
Delete version 18 compatibility stuff.
Richard M. Stallman <rms@gnu.org>
parents:
1150
diff
changeset
|
515 (if (not (vectorp mail-abbrevs)) (mail-abbrevs-setup)) |
|
7446ab662993
Delete version 18 compatibility stuff.
Richard M. Stallman <rms@gnu.org>
parents:
1150
diff
changeset
|
516 (list (completing-read "Expand alias: " mail-abbrevs nil t)))) |
|
7446ab662993
Delete version 18 compatibility stuff.
Richard M. Stallman <rms@gnu.org>
parents:
1150
diff
changeset
|
517 (if (not (vectorp mail-abbrevs)) (mail-abbrevs-setup)) |
|
7446ab662993
Delete version 18 compatibility stuff.
Richard M. Stallman <rms@gnu.org>
parents:
1150
diff
changeset
|
518 (insert (or (and alias (symbol-value (intern-soft alias mail-abbrevs))) ""))) |
| 598 | 519 |
|
1432
7446ab662993
Delete version 18 compatibility stuff.
Richard M. Stallman <rms@gnu.org>
parents:
1150
diff
changeset
|
520 (defun mail-abbrev-next-line (&optional arg) |
|
7446ab662993
Delete version 18 compatibility stuff.
Richard M. Stallman <rms@gnu.org>
parents:
1150
diff
changeset
|
521 "Expand any mail abbrev, then move cursor vertically down ARG lines. |
|
7446ab662993
Delete version 18 compatibility stuff.
Richard M. Stallman <rms@gnu.org>
parents:
1150
diff
changeset
|
522 If there is no character in the target line exactly under the current column, |
|
7446ab662993
Delete version 18 compatibility stuff.
Richard M. Stallman <rms@gnu.org>
parents:
1150
diff
changeset
|
523 the cursor is positioned after the character in that line which spans this |
|
7446ab662993
Delete version 18 compatibility stuff.
Richard M. Stallman <rms@gnu.org>
parents:
1150
diff
changeset
|
524 column, or at the end of the line if it is not long enough. |
|
7446ab662993
Delete version 18 compatibility stuff.
Richard M. Stallman <rms@gnu.org>
parents:
1150
diff
changeset
|
525 If there is no line in the buffer after this one, |
|
7446ab662993
Delete version 18 compatibility stuff.
Richard M. Stallman <rms@gnu.org>
parents:
1150
diff
changeset
|
526 a newline character is inserted to create a line |
|
7446ab662993
Delete version 18 compatibility stuff.
Richard M. Stallman <rms@gnu.org>
parents:
1150
diff
changeset
|
527 and the cursor moves to that line. |
|
7446ab662993
Delete version 18 compatibility stuff.
Richard M. Stallman <rms@gnu.org>
parents:
1150
diff
changeset
|
528 |
|
7446ab662993
Delete version 18 compatibility stuff.
Richard M. Stallman <rms@gnu.org>
parents:
1150
diff
changeset
|
529 The command \\[set-goal-column] can be used to create |
|
7446ab662993
Delete version 18 compatibility stuff.
Richard M. Stallman <rms@gnu.org>
parents:
1150
diff
changeset
|
530 a semipermanent goal column to which this command always moves. |
|
7446ab662993
Delete version 18 compatibility stuff.
Richard M. Stallman <rms@gnu.org>
parents:
1150
diff
changeset
|
531 Then it does not try to move vertically. This goal column is stored |
|
7446ab662993
Delete version 18 compatibility stuff.
Richard M. Stallman <rms@gnu.org>
parents:
1150
diff
changeset
|
532 in `goal-column', which is nil when there is none. |
|
7446ab662993
Delete version 18 compatibility stuff.
Richard M. Stallman <rms@gnu.org>
parents:
1150
diff
changeset
|
533 |
|
7446ab662993
Delete version 18 compatibility stuff.
Richard M. Stallman <rms@gnu.org>
parents:
1150
diff
changeset
|
534 If you are thinking of using this in a Lisp program, consider |
|
7446ab662993
Delete version 18 compatibility stuff.
Richard M. Stallman <rms@gnu.org>
parents:
1150
diff
changeset
|
535 using `forward-line' instead. It is usually easier to use |
|
7446ab662993
Delete version 18 compatibility stuff.
Richard M. Stallman <rms@gnu.org>
parents:
1150
diff
changeset
|
536 and more reliable (no dependence on goal column, etc.)." |
| 598 | 537 (interactive "p") |
| 717 | 538 (if (looking-at "[ \t]*\n") (expand-abbrev)) |
| 539 (setq this-command 'next-line) | |
| 598 | 540 (next-line arg)) |
| 541 | |
|
1432
7446ab662993
Delete version 18 compatibility stuff.
Richard M. Stallman <rms@gnu.org>
parents:
1150
diff
changeset
|
542 (defun mail-abbrev-end-of-buffer (&optional arg) |
|
7446ab662993
Delete version 18 compatibility stuff.
Richard M. Stallman <rms@gnu.org>
parents:
1150
diff
changeset
|
543 "Expand any mail abbrev, then move point to end of buffer. |
|
7446ab662993
Delete version 18 compatibility stuff.
Richard M. Stallman <rms@gnu.org>
parents:
1150
diff
changeset
|
544 Leave mark at previous position. |
|
7446ab662993
Delete version 18 compatibility stuff.
Richard M. Stallman <rms@gnu.org>
parents:
1150
diff
changeset
|
545 With arg N, put point N/10 of the way from the true end. |
|
7446ab662993
Delete version 18 compatibility stuff.
Richard M. Stallman <rms@gnu.org>
parents:
1150
diff
changeset
|
546 |
|
7446ab662993
Delete version 18 compatibility stuff.
Richard M. Stallman <rms@gnu.org>
parents:
1150
diff
changeset
|
547 Don't use this command in Lisp programs! |
|
7446ab662993
Delete version 18 compatibility stuff.
Richard M. Stallman <rms@gnu.org>
parents:
1150
diff
changeset
|
548 \(goto-char (point-max)) is faster and avoids clobbering the mark." |
| 598 | 549 (interactive "P") |
| 717 | 550 (if (looking-at "[ \t]*\n") (expand-abbrev)) |
| 551 (setq this-command 'end-of-buffer) | |
| 598 | 552 (end-of-buffer arg)) |
| 553 | |
| 554 (define-key mail-mode-map "\C-c\C-a" 'mail-interactive-insert-alias) | |
| 555 | |
|
1432
7446ab662993
Delete version 18 compatibility stuff.
Richard M. Stallman <rms@gnu.org>
parents:
1150
diff
changeset
|
556 ;;(define-key mail-mode-map "\C-n" 'mail-abbrev-next-line) |
|
7446ab662993
Delete version 18 compatibility stuff.
Richard M. Stallman <rms@gnu.org>
parents:
1150
diff
changeset
|
557 ;;(define-key mail-mode-map "\M->" 'mail-abbrev-end-of-buffer) |
| 598 | 558 |
| 459 | 559 (provide 'mail-abbrevs) |
