aboutsummaryrefslogtreecommitdiffstats
path: root/lisp/mail
diff options
context:
space:
mode:
authorBill Wohler2003-01-26 02:38:37 +0000
committerBill Wohler2003-01-26 02:38:37 +0000
commit942da20cebcb20d3ac2b495de0be6865a40a4e67 (patch)
tree2da4379ec14867bf6272cdf2aafbf0732e79187e /lisp/mail
parent290682efe61f5704a60a41ff2a196207e6223652 (diff)
downloademacs-942da20cebcb20d3ac2b495de0be6865a40a4e67.tar.gz
emacs-942da20cebcb20d3ac2b495de0be6865a40a4e67.zip
* mh-e: Created directory. ChangeLog will appear in a week when we
release version 7.2. * lisp/mail/mh-alias.el, lisp/mail/mh-comp.el, lisp/mail/mh-customize.el, lisp/mail/mh-e.el, lisp/mail/mh-funcs.el, lisp/mail/mh-identity.el, lisp/mail/mh-index.el, lisp/mail/mh-loaddefs.el, lisp/mail/mh-mime.el, lisp/mail/mh-pick.el, lisp/mail/mh-seq.el, lisp/mail/mh-speed.el, lisp/mail/mh-utils.el, lisp/mail/mh-xemacs-compat.el: Moved to mh-e. Note that reply2.pbm and reply2.xpm, which were created by the MH-E package, were left in mail since they can probably be used by other mail packages. * makefile.w32-in (WINS): Added mh-e. * makefile.nt (WINS): Added mh-e.
Diffstat (limited to 'lisp/mail')
-rw-r--r--lisp/mail/mh-alias.el590
-rw-r--r--lisp/mail/mh-comp.el1525
-rw-r--r--lisp/mail/mh-customize.el1751
-rw-r--r--lisp/mail/mh-e.el2258
-rw-r--r--lisp/mail/mh-funcs.el436
-rw-r--r--lisp/mail/mh-identity.el219
-rw-r--r--lisp/mail/mh-index.el948
-rw-r--r--lisp/mail/mh-loaddefs.el880
-rw-r--r--lisp/mail/mh-mime.el1276
-rw-r--r--lisp/mail/mh-pick.el239
-rw-r--r--lisp/mail/mh-seq.el1277
-rw-r--r--lisp/mail/mh-speed.el573
-rw-r--r--lisp/mail/mh-utils.el1879
-rw-r--r--lisp/mail/mh-xemacs-compat.el62
14 files changed, 0 insertions, 13913 deletions
diff --git a/lisp/mail/mh-alias.el b/lisp/mail/mh-alias.el
deleted file mode 100644
index b9f144fae02..00000000000
--- a/lisp/mail/mh-alias.el
+++ /dev/null
@@ -1,590 +0,0 @@
1;;; mh-alias.el --- MH-E mail alias completion and expansion
2;;
3;; Copyright (C) 1994, 1995, 1996, 1997, 2001, 2002 Free Software Foundation, Inc.
4
5;; Author: Peter S. Galbraith <psg@debian.org>
6;; Maintainer: Bill Wohler <wohler@newt.com>
7;; Keywords: mail
8;; See: mh-e.el
9
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
14;; the Free Software Foundation; either version 2, or (at your option)
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 the
24;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
25;; Boston, MA 02111-1307, USA.
26
27;;; Commentary:
28
29;; [To be deleted when documented in MH-E manual.]
30;;
31;; This module provides mail alias completion when entering addresses.
32;;
33;; Use the TAB key to complete aliases (and optionally local usernames) when
34;; initially composing a message in the To: and Cc: minibuffer prompts. You
35;; may enter multiple addressees separated with a comma (but do *not* add any
36;; space after the comma).
37;;
38;; In the header of a message draft, use "M-TAB (mh-letter-complete)" to
39;; complete aliases. This is useful when you want to add an addressee as an
40;; afterthought when creating a message, or when adding an additional
41;; addressee to a reply.
42;;
43;; By default, completion is case-insensitive. This can be changed by
44;; customizing the variable `mh-alias-completion-ignore-case-flag'. This is
45;; useful, for example, to differentiate between people aliases in lowercase
46;; such as:
47;;
48;; p.galbraith: Peter Galbraith <GalbraithP@dfo-mpo.gc.ca>
49;;
50;; and lists in uppercase such as:
51;;
52;; MH-E: MH-E mailing list <mh-e-devel@lists.sourceforge.net>
53;;
54;; Note that this variable affects minibuffer completion only. If you have an
55;; alias for P.Galbraith and type in p.galbraith at the prompt, it will still
56;; be expanded in the letter buffer because MH is case-insensitive.
57;;
58;; When you press ", (mh-alias-minibuffer-confirm-address)" after an alias in
59;; the minibuffer, the expansion for the previous mail alias appears briefly.
60;; To inhibit this, customize the variable `mh-alias-flash-on-comma'.
61;;
62;; The addresses and aliases entered in the minibuffer are added to the
63;; message draft. To expand the aliases before they are added to the draft,
64;; customize the variable `mh-alias-expand-aliases-flag'.
65;;
66;; Completion is also performed on usernames extracted from the /etc/passwd
67;; file. This can be a handy tool on a machine where you and co-workers
68;; exchange messages, but should probably be disabled on a system with
69;; thousands of users you don't know. This is done by customizing the
70;; variable `mh-alias-local-users'. This variable also takes a string which
71;; is executed to generate the password file. For example, you'd use "ypcat
72;; passwd" for NIS.
73;;
74;; Aliases are loaded the first time you send mail and get the "To:" prompt
75;; and whenever a source of aliases changes. Sources of system aliases are
76;; defined in the customization variable `mh-alias-system-aliases' and
77;; include:
78;;
79;; /etc/nmh/MailAliases
80;; /usr/lib/mh/MailAliases
81;; /etc/passwd
82;;
83;; Sources of personal aliases are read from the files listed in your MH
84;; profile component Aliasfile. Multiple files are separated by white space
85;; and are relative to your mail directory.
86;;
87;; Alias Insertions
88;; ~~~~~~~~~~~~~~~~
89;; There are commands to insert new aliases into your alias file(s) (defined
90;; by the `Aliasfile' component in the .mh_profile file or by the variable
91;; `mh-alias-insert-file'). In particular, there is a tool-bar icon to grab
92;; an alias from the From line of the current message.
93
94;;; Code:
95
96(require 'mh-e)
97(load "cmr" t t) ; Non-fatal dependency for
98 ; completing-read-multiple.
99(eval-when-compile (defvar mail-abbrev-syntax-table))
100
101;;; Autoloads
102(autoload 'mail-abbrev-complete-alias "mailabbrev")
103(autoload 'multi-prompt "multi-prompt")
104
105(defvar mh-alias-alist nil
106 "Alist of MH aliases.")
107(defvar mh-alias-blind-alist nil
108 "Alist of MH aliases that are blind lists.")
109(defvar mh-alias-passwd-alist nil
110 "Alist of aliases extracted from passwd file and their expansions.")
111(defvar mh-alias-tstamp nil
112 "Time aliases were last loaded.")
113(defvar mh-alias-read-address-map nil)
114(if mh-alias-read-address-map
115 ()
116 (setq mh-alias-read-address-map
117 (copy-keymap minibuffer-local-completion-map))
118 (if mh-alias-flash-on-comma
119 (define-key mh-alias-read-address-map
120 "," 'mh-alias-minibuffer-confirm-address))
121 (define-key mh-alias-read-address-map " " 'self-insert-command))
122
123
124;;; Alias Loading
125
126(defun mh-alias-tstamp (arg)
127 "Check whether alias files have been modified.
128Return t if any file listed in the MH profile component Aliasfile has been
129modified since the timestamp.
130If ARG is non-nil, set timestamp with the current time."
131 (if arg
132 (let ((time (current-time)))
133 (setq mh-alias-tstamp (list (nth 0 time) (nth 1 time))))
134 (let ((stamp))
135 (car (memq t (mapcar
136 (function
137 (lambda (file)
138 (when (and file (file-exists-p file))
139 (setq stamp (nth 5 (file-attributes file)))
140 (or (> (car stamp) (car mh-alias-tstamp))
141 (and (= (car stamp) (car mh-alias-tstamp))
142 (> (cadr stamp) (cadr mh-alias-tstamp)))))))
143 (mh-alias-filenames t)))))))
144
145(defun mh-alias-filenames (arg)
146 "Return list of filenames that contain aliases.
147The filenames come from the MH profile component Aliasfile and are expanded.
148If ARG is non-nil, filenames listed in `mh-alias-system-aliases' are appended."
149 (or mh-progs (mh-find-path))
150 (save-excursion
151 (let* ((filename (mh-profile-component "Aliasfile"))
152 (filelist (and filename (split-string filename "[ \t]+")))
153 (userlist
154 (mapcar
155 (function
156 (lambda (file)
157 (if (and mh-user-path file
158 (file-exists-p (expand-file-name file mh-user-path)))
159 (expand-file-name file mh-user-path))))
160 filelist)))
161 (if arg
162 (if (stringp mh-alias-system-aliases)
163 (append userlist (list mh-alias-system-aliases))
164 (append userlist mh-alias-system-aliases))
165 userlist))))
166
167(defun mh-alias-local-users ()
168 "Return an alist of local users from /etc/passwd."
169 (let (passwd-alist)
170 (save-excursion
171 (set-buffer (get-buffer-create mh-temp-buffer))
172 (erase-buffer)
173 (cond
174 ((eq mh-alias-local-users t)
175 (if (file-readable-p "/etc/passwd")
176 (insert-file-contents "/etc/passwd")))
177 ((stringp mh-alias-local-users)
178 (insert mh-alias-local-users "\n")
179 (shell-command-on-region (point-min)(point-max) mh-alias-local-users t)
180 (goto-char (point-min))))
181 (while (< (point) (point-max))
182 (cond
183 ((looking-at "\\([^:]*\\):[^:]*:\\([^:]*\\):[^:]*:\\([^:,]*\\)[:,]")
184 (when (> (string-to-int (match-string 2)) 200)
185 (let* ((username (match-string 1))
186 (gecos-name (match-string 3))
187 (realname
188 (if (string-match "&" gecos-name)
189 (concat
190 (substring gecos-name 0 (match-beginning 0))
191 (capitalize username)
192 (substring gecos-name (match-end 0)))
193 gecos-name)))
194 (setq passwd-alist
195 (cons (list username
196 (if (string-equal "" realname)
197 (concat "<" username ">")
198 (concat realname " <" username ">")))
199 passwd-alist))))))
200 (forward-line 1)))
201 passwd-alist))
202
203;;;###mh-autoload
204(defun mh-alias-reload ()
205 "Load MH aliases into `mh-alias-alist'."
206 (interactive)
207 (save-excursion
208 (message "Loading MH aliases...")
209 (mh-alias-tstamp t)
210 (mh-exec-cmd-quiet t "ali" "-nolist" "-nouser")
211 (setq mh-alias-alist nil)
212 (setq mh-alias-blind-alist nil)
213 (while (< (point) (point-max))
214 (cond
215 ((looking-at "^[ \t]")) ;Continuation line
216 ((looking-at "\\(.+\\): .+: .*$") ; A new -blind- MH alias
217 (when (not (assoc-ignore-case (match-string 1) mh-alias-blind-alist))
218 (setq mh-alias-blind-alist
219 (cons (list (match-string 1)) mh-alias-blind-alist))
220 (setq mh-alias-alist (cons (list (match-string 1)) mh-alias-alist))))
221 ((looking-at "\\(.+\\): .*$") ; A new MH alias
222 (when (not (assoc-ignore-case (match-string 1) mh-alias-alist))
223 (setq mh-alias-alist
224 (cons (list (match-string 1)) mh-alias-alist)))))
225 (forward-line 1)))
226 (when mh-alias-local-users
227 (setq mh-alias-passwd-alist (mh-alias-local-users))
228 ;; Update aliases with local users, but leave existing aliases alone.
229 (let ((local-users mh-alias-passwd-alist)
230 user)
231 (while local-users
232 (setq user (car local-users))
233 (if (not (assoc-ignore-case (car user) mh-alias-alist))
234 (setq mh-alias-alist (append mh-alias-alist (list user))))
235 (setq local-users (cdr local-users)))))
236 (message "Loading MH aliases...done"))
237
238(defun mh-alias-reload-maybe ()
239 "Load new MH aliases."
240 (if (or (not mh-alias-alist) ; Doesn't exist, so create it.
241 (mh-alias-tstamp nil)) ; Out of date, so recreate it.
242 (mh-alias-reload)))
243
244
245;;; Alias Expansion
246
247(defun mh-alias-ali (alias &optional user)
248 "Return ali expansion for ALIAS.
249ALIAS must be a string for a single alias.
250If USER is t, then assume ALIAS is an address and call ali -user.
251ali returns the string unchanged if not defined. The same is done here."
252 (save-excursion
253 (let ((user-arg (if user "-user" "-nouser")))
254 (mh-exec-cmd-quiet t "ali" user-arg "-nolist" alias))
255 (goto-char (point-max))
256 (if (looking-at "^$") (delete-backward-char 1))
257 (buffer-substring (point-min)(point-max))))
258
259(defun mh-alias-expand (alias)
260 "Return expansion for ALIAS.
261Blind aliases or users from /etc/passwd are not expanded."
262 (cond
263 ((assoc-ignore-case alias mh-alias-blind-alist)
264 alias) ; Don't expand a blind alias
265 ((assoc-ignore-case alias mh-alias-passwd-alist)
266 (cadr (assoc-ignore-case alias mh-alias-passwd-alist)))
267 (t
268 (mh-alias-ali alias))))
269
270;;;###mh-autoload
271(defun mh-read-address (prompt)
272 "Read an address from the minibuffer with PROMPT."
273 (mh-alias-reload-maybe)
274 (if (not mh-alias-alist) ; If still no aliases, just prompt
275 (read-string prompt)
276 (let* ((minibuffer-local-completion-map mh-alias-read-address-map)
277 (completion-ignore-case mh-alias-completion-ignore-case-flag)
278 (the-answer
279 (or (cond
280 ((fboundp 'completing-read-multiple)
281 (completing-read-multiple prompt mh-alias-alist nil nil))
282 ((featurep 'multi-prompt)
283 (multi-prompt "," nil prompt mh-alias-alist nil nil))
284 (t
285 (split-string
286 (completing-read "To: " mh-alias-alist nil nil)
287 ","))))))
288 (if (not mh-alias-expand-aliases-flag)
289 (mapconcat 'identity the-answer ", ")
290 ;; Loop over all elements, checking if in passwd aliast or blind first
291 (mapconcat 'mh-alias-expand the-answer ",\n ")))))
292
293;;;###mh-autoload
294(defun mh-alias-minibuffer-confirm-address ()
295 "Display the alias expansion if `mh-alias-flash-on-comma' is non-nil."
296 (interactive)
297 (if (not mh-alias-flash-on-comma)
298 ()
299 (save-excursion
300 (let* ((case-fold-search t)
301 (the-name (buffer-substring
302 (progn (skip-chars-backward " \t")(point))
303 ;; This moves over to previous comma, if any
304 (progn (or (and (not (= 0 (skip-chars-backward "^,")))
305 ;; the skips over leading whitespace
306 (skip-chars-forward " "))
307 ;; no comma, then to beginning of word
308 (skip-chars-backward "^ \t"))
309 ;; In Emacs21, the beginning of the prompt
310 ;; line is accessible, which wasn't the case
311 ;; in emacs20. Skip over it.
312 (if (looking-at "^[^ \t]+:")
313 (skip-chars-forward "^ \t"))
314 (skip-chars-forward " ")
315 (point)))))
316 (if (assoc-ignore-case the-name mh-alias-alist)
317 (message "%s -> %s" the-name (mh-alias-expand the-name))
318 ;; Check if if was a single word likely to be an alias
319 (if (and (equal mh-alias-flash-on-comma 1)
320 (not (string-match " " the-name)))
321 (message "No alias for %s" the-name))))))
322 (self-insert-command 1))
323
324;;;###mh-autoload
325(defun mh-alias-letter-expand-alias ()
326 "Expand mail alias before point."
327 (mh-alias-reload-maybe)
328 (let ((mail-abbrevs mh-alias-alist))
329 (mail-abbrev-complete-alias))
330 (when mh-alias-expand-aliases-flag
331 (let* ((end (point))
332 (syntax-table (syntax-table))
333 (beg (unwind-protect
334 (save-excursion
335 (set-syntax-table mail-abbrev-syntax-table)
336 (backward-word 1)
337 (point))
338 (set-syntax-table syntax-table)))
339 (alias (buffer-substring beg end))
340 (expansion (mh-alias-expand alias)))
341 (delete-region beg end)
342 (insert expansion))))
343
344;;; Adding addresses to alias file.
345
346(defun mh-alias-suggest-alias (string)
347 "Suggest an alias for STRING."
348 (cond
349 ((string-match "^\\sw+$" string)
350 ;; One word -> downcase it.
351 (downcase string))
352 ((string-match "^\\(\\sw+\\)\\s-+\\(\\sw+\\)$" string)
353 ;; Two words -> first.last
354 (downcase
355 (format "%s.%s" (match-string 1 string) (match-string 2 string))))
356 ((string-match "^\\([-a-zA-Z0-9._]+\\)@[-a-zA-z0-9_]+\\.+[a-zA-Z0-9]+$"
357 string)
358 ;; email only -> downcase username
359 (downcase (match-string 1 string)))
360 ((string-match "^\"\\(.*\\)\".*" string)
361 ;; "Some name" <somename@foo.bar> -> recurse -> "Some name"
362 (mh-alias-suggest-alias (match-string 1 string)))
363 ((string-match "^\\(.*\\) +<.*>$" string)
364 ;; Some name <somename@foo.bar> -> recurse -> Some name
365 (mh-alias-suggest-alias (match-string 1 string)))
366 ((string-match (concat mh-address-mail-regexp " +(\\(.*\\))$") string)
367 ;; somename@foo.bar (Some name) -> recurse -> Some name
368 (mh-alias-suggest-alias (match-string 1 string)))
369 ((string-match "^\\(Dr\\|Prof\\)\\.? +\\(.*\\)" string)
370 ;; Strip out title
371 (mh-alias-suggest-alias (match-string 2 string)))
372 ((string-match "^\\(.*\\), +\\(Jr\\.?\\|II+\\)$" string)
373 ;; Strip out tails with comma
374 (mh-alias-suggest-alias (match-string 1 string)))
375 ((string-match "^\\(.*\\) +\\(Jr\\.?\\|II+\\)$" string)
376 ;; Strip out tails
377 (mh-alias-suggest-alias (match-string 1 string)))
378 ((string-match "^\\(\\sw+\\) +[A-Z]\\.? +\\(.*\\)$" string)
379 ;; Strip out initials
380 (mh-alias-suggest-alias
381 (format "%s %s" (match-string 1 string) (match-string 2 string))))
382 ((string-match "^\\([^,]+\\), +\\(.*\\)$" string)
383 ;; Reverse order of comma-separated fields
384 (mh-alias-suggest-alias
385 (format "%s %s" (match-string 2 string) (match-string 1 string))))
386 (t
387 ;; Output string, with spaces replaced by dots.
388 (downcase (replace-regexp-in-string
389 "\\.\\.+" "."
390 (replace-regexp-in-string " +" "." string))))))
391
392(defun mh-alias-which-file-has-alias (alias file-list)
393 "Return the name of writable file which defines ALIAS from list FILE-LIST."
394 (save-excursion
395 (set-buffer (get-buffer-create mh-temp-buffer))
396 (let ((the-list file-list)
397 (found))
398 (while the-list
399 (erase-buffer)
400 (when (file-writable-p (car file-list))
401 (insert-file-contents (car file-list))
402 (if (re-search-forward (concat "^" (regexp-quote alias) ":"))
403 (setq found (car file-list)
404 the-list nil)
405 (setq the-list (cdr the-list)))))
406 found)))
407
408(defun mh-alias-insert-file (&optional alias)
409 "Return the alias file to write a new entry for ALIAS in.
410Use variable `mh-alias-insert-file' if non-nil, else use AliasFile component
411value.
412If ALIAS is specified and it already exists, try to return the file that
413contains it."
414 (cond
415 ((and mh-alias-insert-file (listp mh-alias-insert-file))
416 (if (not (elt mh-alias-insert-file 1)) ; Only one entry, use it
417 (car mh-alias-insert-file)
418 (if (or (not alias)
419 (string-equal alias (mh-alias-ali alias))) ;alias doesn't exist
420 (completing-read "Alias file [press Tab]: "
421 (mapcar 'list mh-alias-insert-file) nil t)
422 (or (mh-alias-which-file-has-alias alias mh-alias-insert-file)
423 (completing-read "Alias file [press Tab]: "
424 (mapcar 'list mh-alias-insert-file) nil t)))))
425 ((and mh-alias-insert-file (stringp mh-alias-insert-file))
426 mh-alias-insert-file)
427 (t
428 ;; writable ones returned from (mh-alias-filenames):
429 (let ((autolist (delq nil (mapcar (lambda (file)
430 (if (and (file-writable-p file)
431 (not (string-equal
432 file "/etc/passwd")))
433 file))
434 (mh-alias-filenames t)))))
435 (cond
436 ((not autolist)
437 (error "No writable alias file.
438Set `mh-alias-insert-file' or set AliasFile in your .mh_profile file"))
439 ((not (elt autolist 1)) ; Only one entry, use it
440 (car autolist))
441 ((or (not alias)
442 (string-equal alias (mh-alias-ali alias))) ;alias doesn't exist
443 (completing-read "Alias file [press Tab]: "
444 (mapcar 'list autolist) nil t))
445 (t
446 (or (mh-alias-which-file-has-alias alias autolist)
447 (completing-read "Alias file [press Tab]: "
448 (mapcar 'list autolist) nil t))))))))
449
450(defun mh-alias-address-to-alias (address)
451 "Return the ADDRESS alias if defined, or nil."
452 (let* ((aliases (mh-alias-ali address t)))
453 (if (string-equal aliases address)
454 nil ; ali returned same string -> no.
455 ;; For the comma-separated aliases reyurned by ali, check that one of
456 ;; them doesn't expand into a list. e.g. we do have an individual
457 ;; alias for that adress.
458 (car (delq nil (mapcar
459 (function
460 (lambda (alias)
461 (let ((recurse (mh-alias-ali alias nil)))
462 (if (string-match ".*,.*" recurse)
463 nil
464 alias))))
465 (split-string aliases ", +")))))))
466
467;;;###mh-autoload
468(defun mh-alias-from-has-no-alias-p ()
469 "Return t is From has no current alias set."
470 (mh-alias-reload-maybe)
471 (save-excursion
472 (if (not (mh-folder-line-matches-show-buffer-p))
473 nil ;No corresponding show buffer
474 (if (eq major-mode 'mh-folder-mode)
475 (set-buffer mh-show-buffer))
476 (not (mh-alias-address-to-alias (mh-extract-from-header-value))))))
477
478(defun mh-alias-add-alias-to-file (alias address &optional file)
479 "Add ALIAS for ADDRESS in alias FILE without alias check or prompts.
480Prompt for alias file if not provided and there is more than one candidate.
481If ALIAS matches exactly, prompt to [i]nsert before old value or [a]ppend
482after it."
483 (if (not file)
484 (setq file (mh-alias-insert-file alias)))
485 (save-excursion
486 (set-buffer (find-file-noselect file))
487 (goto-char (point-min))
488 (let ((alias-search (concat alias ":"))
489 (letter)
490 (here (point))
491 (case-fold-search t))
492 (cond
493 ;; Search for exact match (if we had the same alias before)
494 ((re-search-forward
495 (concat "^" (regexp-quote alias-search) " *\\(.*\\)") nil t)
496 (let ((answer (read-string
497 (format "Exists for %s; [i]nsert, [a]ppend: "
498 (match-string 1))))
499 (case-fold-search t))
500 (cond ((string-match "^i" answer))
501 ((string-match "^a" answer)
502 (forward-line 1))
503 (t
504 error "Quitting."))))
505 ;; No, so sort-in at the right place
506 ;; search for "^alias", then "^alia", etc.
507 ((eq mh-alias-insertion-location 'sorted)
508 (setq letter (substring alias-search -1)
509 alias-search (substring alias-search 0 -1))
510 (while (and (not (equal alias-search ""))
511 (not (re-search-forward
512 (concat "^" (regexp-quote alias-search)) nil t)))
513 (setq letter (substring alias-search -1)
514 alias-search (substring alias-search 0 -1)))
515 ;; Next, move forward to sort alphabetically for following letters
516 (beginning-of-line)
517 (while (re-search-forward
518 (concat "^" (regexp-quote alias-search) "[a-" letter "]")
519 nil t)
520 (forward-line 1)))
521 ((eq mh-alias-insertion-location 'bottom)
522 (goto-char (point-max)))
523 ((eq mh-alias-insertion-location 'top)
524 (goto-char (point-min)))))
525 (beginning-of-line)
526 (insert (format "%s: %s\n" alias address))
527 (save-buffer)))
528
529;;;###mh-autoload
530(defun mh-alias-add-alias (alias address)
531 "*Add ALIAS for ADDRESS in personal alias file.
532Prompts for confirmation if the address already has an alias.
533If the alias is already is use, `mh-alias-add-alias-to-file' will prompt."
534 (interactive "P\nP")
535 (mh-alias-reload-maybe)
536 (setq alias (completing-read "Alias: " mh-alias-alist nil nil alias))
537 (setq address (read-string "Address: " address))
538 (let ((address-alias (mh-alias-address-to-alias address))
539 (alias-address (mh-alias-expand alias)))
540 (if (string-equal alias-address alias)
541 (setq alias-address nil))
542 (cond
543 ((and (equal alias address-alias)
544 (equal address alias-address))
545 (message "Already defined as: %s" alias-address))
546 (address-alias
547 (if (y-or-n-p (format "Address has alias %s; set new one? "
548 address-alias))
549 (mh-alias-add-alias-to-file alias address)))
550 (t
551 (mh-alias-add-alias-to-file alias address)))))
552
553;;;###mh-autoload
554(defun mh-alias-grab-from-field ()
555 "*Add ALIAS for ADDRESS in personal alias file.
556Prompts for confirmation if the alias is already in use or if the address
557already has an alias."
558 (interactive)
559 (mh-alias-reload-maybe)
560 (save-excursion
561 (cond
562 ((mh-folder-line-matches-show-buffer-p)
563 (set-buffer mh-show-buffer))
564 ((and (eq major-mode 'mh-folder-mode)
565 (mh-get-msg-num nil))
566 (set-buffer (get-buffer-create mh-temp-buffer))
567 (insert-file-contents (mh-msg-filename (mh-get-msg-num t))))
568 ((eq major-mode 'mh-folder-mode)
569 (error "Cursor not pointing to a message")))
570 (let* ((address (mh-extract-from-header-value))
571 (alias (mh-alias-suggest-alias address)))
572 (mh-alias-add-alias alias address))))
573
574;;;###mh-autoload
575(defun mh-alias-add-address-under-point ()
576 "Insert an alias for email address under point."
577 (interactive)
578 (let ((address (mh-goto-address-find-address-at-point)))
579 (if address
580 (mh-alias-add-alias nil address)
581 (message "No email address found under point."))))
582
583(provide 'mh-alias)
584
585;;; Local Variables:
586;;; indent-tabs-mode: nil
587;;; sentence-end-double-space: nil
588;;; End:
589
590;;; mh-alias.el ends here
diff --git a/lisp/mail/mh-comp.el b/lisp/mail/mh-comp.el
deleted file mode 100644
index c1e28a97011..00000000000
--- a/lisp/mail/mh-comp.el
+++ /dev/null
@@ -1,1525 +0,0 @@
1;;; mh-comp.el --- MH-E functions for composing messages
2
3;; Copyright (C) 1993,1995,1997,2000,2001,2002 Free Software Foundation, Inc.
4
5;; Author: Bill Wohler <wohler@newt.com>
6;; Maintainer: Bill Wohler <wohler@newt.com>
7;; Keywords: mail
8;; See: mh-e.el
9
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
14;; the Free Software Foundation; either version 2, or (at your option)
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 the
24;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
25;; Boston, MA 02111-1307, USA.
26
27;;; Commentary:
28
29;; Internal support for MH-E package.
30
31;;; Change Log:
32
33;; $Id: mh-comp.el,v 1.164 2003/01/07 21:16:25 satyaki Exp $
34
35;;; Code:
36
37(require 'mh-e)
38(require 'gnus-util)
39(require 'easymenu)
40(require 'cl)
41
42;; Shush the byte-compiler
43(defvar adaptive-fill-first-line-regexp)
44(defvar font-lock-defaults)
45(defvar mark-active)
46(defvar sendmail-coding-system)
47(defvar mh-identity-list)
48(defvar mh-identity-default)
49(defvar mh-identity-menu)
50
51;;; Autoloads
52(autoload 'Info-goto-node "info")
53(autoload 'mail-mode-fill-paragraph "sendmail")
54(autoload 'mm-handle-displayed-p "mm-decode")
55
56(autoload 'sc-cite-original "sc"
57 "Workhorse citing function which performs the initial citation.
58This is callable from the various mail and news readers' reply
59function according to the agreed upon standard. See `\\[sc-describe]'
60for more details. `sc-cite-original' does not do any yanking of the
61original message but it does require a few things:
62
63 1) The reply buffer is the current buffer.
64
65 2) The original message has been yanked and inserted into the
66 reply buffer.
67
68 3) Verbose mail headers from the original message have been
69 inserted into the reply buffer directly before the text of the
70 original message.
71
72 4) Point is at the beginning of the verbose headers.
73
74 5) Mark is at the end of the body of text to be cited.
75
76For Emacs 19's, the region need not be active (and typically isn't
77when this function is called. Also, the hook `sc-pre-hook' is run
78before, and `sc-post-hook' is run after the guts of this function.")
79
80;;; Site customization (see also mh-utils.el):
81
82(defvar mh-send-prog "send"
83 "Name of the MH send program.
84Some sites need to change this because of a name conflict.")
85
86(defvar mh-redist-full-contents nil
87 "Non-nil if the `dist' command needs whole letter for redistribution.
88This is the case only when `send' is compiled with the BERK option.
89If MH will not allow you to redist a previously redist'd msg, set to nil.")
90
91(defvar mh-redist-background nil
92 "If non-nil redist will be done in background like send.
93This allows transaction log to be visible if -watch, -verbose or -snoop are
94used.")
95
96(defvar mh-note-repl "-"
97 "String whose first character is used to notate replied to messages.")
98
99(defvar mh-note-forw "F"
100 "String whose first character is used to notate forwarded messages.")
101
102(defvar mh-note-dist "R"
103 "String whose first character is used to notate redistributed messages.")
104
105(defvar mh-yank-hooks nil
106 "Obsolete hook for modifying a citation just inserted in the mail buffer.
107Each hook function can find the citation between point and mark.
108And each hook function should leave point and mark around the citation
109text as modified.
110
111This is a normal hook, misnamed for historical reasons.
112It is semi-obsolete and is only used if `mail-citation-hook' is nil.")
113
114(defvar mail-citation-hook nil
115 "*Hook for modifying a citation just inserted in the mail buffer.
116Each hook function can find the citation between point and mark.
117And each hook function should leave point and mark around the citation
118text as modified.
119
120If this hook is entirely empty (nil), the text of the message is inserted
121with `mh-ins-buf-prefix' prefixed to each line.
122
123See also the variable `mh-yank-from-start-of-msg', which controls how
124much of the message passed to the hook.
125
126This hook was historically provided to set up supercite. You may now leave
127this nil and set up supercite by setting the variable
128`mh-yank-from-start-of-msg' to 'supercite or, for more automatic insertion,
129to 'autosupercite.")
130
131(defvar mh-comp-formfile "components"
132 "Name of file to be used as a skeleton for composing messages.
133Default is \"components\". If not an absolute file name, the file
134is searched for first in the user's MH directory, then in the
135system MH lib directory.")
136
137(defvar mh-repl-formfile "replcomps"
138 "Name of file to be used as a skeleton for replying to messages.
139Default is \"replcomps\". If not an absolute file name, the file
140is searched for first in the user's MH directory, then in the
141system MH lib directory.")
142
143(defvar mh-repl-group-formfile "replgroupcomps"
144 "Name of file to be used as a skeleton for replying to messages.
145This file is used to form replies to the sender and all recipients of a
146message. Only used if `mh-nmh-flag' is non-nil. Default is \"replgroupcomps\".
147If not an absolute file name, the file is searched for first in the user's MH
148directory, then in the system MH lib directory.")
149
150(defvar mh-rejected-letter-start
151 (format "^%s$"
152 (regexp-opt
153 '("Content-Type: message/rfc822" ;MIME MDN
154 " ----- Unsent message follows -----" ;from sendmail V5
155 " --------Unsent Message below:" ; from sendmail at BU
156 " ----- Original message follows -----" ;from sendmail V8
157 "------- Unsent Draft" ;from MH itself
158 "---------- Original Message ----------" ;from zmailer
159 " --- The unsent message follows ---" ;from AIX mail system
160 " Your message follows:" ;from MMDF-II
161 "Content-Description: Returned Content" ;1993 KJ sendmail
162 ))))
163
164(defvar mh-new-draft-cleaned-headers
165 "^Date:\\|^Received:\\|^Message-Id:\\|^From:\\|^Sender:\\|^Errors-To:\\|^Delivery-Date:\\|^Return-Path:"
166 "Regexp of header lines to remove before offering a message as a new draft.
167Used by the \\<mh-folder-mode-map>`\\[mh-edit-again]' and `\\[mh-extract-rejected-mail]' commands.")
168
169(defvar mh-to-field-choices '(("t" . "To:") ("s" . "Subject:") ("c" . "Cc:")
170 ("b" . "Bcc:") ("f" . "Fcc:") ("r" . "From:")
171 ("d" . "Dcc:"))
172 "Alist of (final-character . field-name) choices for `mh-to-field'.")
173
174(defvar mh-letter-mode-map (copy-keymap text-mode-map)
175 "Keymap for composing mail.")
176
177(defvar mh-letter-mode-syntax-table nil
178 "Syntax table used by MH-E while in MH-Letter mode.")
179
180(if mh-letter-mode-syntax-table
181 ()
182 (setq mh-letter-mode-syntax-table
183 (make-syntax-table text-mode-syntax-table))
184 (modify-syntax-entry ?% "." mh-letter-mode-syntax-table))
185
186(defvar mh-sent-from-folder nil
187 "Folder of msg assoc with this letter.")
188
189(defvar mh-sent-from-msg nil
190 "Number of msg assoc with this letter.")
191
192(defvar mh-send-args nil
193 "Extra args to pass to \"send\" command.")
194
195(defvar mh-annotate-char nil
196 "Character to use to annotate `mh-sent-from-msg'.")
197
198(defvar mh-annotate-field nil
199 "Field name for message annotation.")
200
201;;;###autoload
202(defun mh-smail ()
203 "Compose and send mail with the MH mail system.
204This function is an entry point to MH-E, the Emacs front end
205to the MH mail system.
206
207See documentation of `\\[mh-send]' for more details on composing mail."
208 (interactive)
209 (mh-find-path)
210 (call-interactively 'mh-send))
211
212(defvar mh-error-if-no-draft nil) ;raise error over using old draft
213
214;;;###autoload
215(defun mh-smail-batch (&optional to subject other-headers &rest ignored)
216 "Set up a mail composition draft with the MH mail system.
217This function is an entry point to MH-E, the Emacs front end
218to the MH mail system. This function does not prompt the user
219for any header fields, and thus is suitable for use by programs
220that want to create a mail buffer.
221Users should use `\\[mh-smail]' to compose mail.
222Optional arguments for setting certain fields include TO, SUBJECT, and
223OTHER-HEADERS. Additional arguments are IGNORED."
224 (mh-find-path)
225 (let ((mh-error-if-no-draft t))
226 (mh-send (or to "") "" (or subject ""))))
227
228;; XEmacs needs this:
229;;;###autoload
230(defun mh-user-agent-compose (&optional to subject other-headers continue
231 switch-function yank-action
232 send-actions)
233 "Set up mail composition draft with the MH mail system.
234This is `mail-user-agent' entry point to MH-E.
235
236The optional arguments TO and SUBJECT specify recipients and the
237initial Subject field, respectively.
238
239OTHER-HEADERS is an alist specifying additional
240header fields. Elements look like (HEADER . VALUE) where both
241HEADER and VALUE are strings.
242
243CONTINUE, SWITCH-FUNCTION, YANK-ACTION and SEND-ACTIONS are ignored."
244 (mh-find-path)
245 (let ((mh-error-if-no-draft t))
246 (mh-send to "" subject)
247 (while other-headers
248 (mh-insert-fields (concat (car (car other-headers)) ":")
249 (cdr (car other-headers)))
250 (setq other-headers (cdr other-headers)))))
251
252;;;###mh-autoload
253(defun mh-edit-again (msg)
254 "Clean up a draft or a message MSG previously sent and make it resendable.
255Default is the current message.
256The variable `mh-new-draft-cleaned-headers' specifies the headers to remove.
257See also documentation for `\\[mh-send]' function."
258 (interactive (list (mh-get-msg-num t)))
259 (let* ((from-folder mh-current-folder)
260 (config (current-window-configuration))
261 (draft
262 (cond ((and mh-draft-folder (equal from-folder mh-draft-folder))
263 (pop-to-buffer (find-file-noselect (mh-msg-filename msg)) t)
264 (rename-buffer (format "draft-%d" msg))
265 ;; Make buffer writable...
266 (setq buffer-read-only nil)
267 ;; If buffer was being used to display the message reinsert
268 ;; from file...
269 (when (eq major-mode 'mh-show-mode)
270 (erase-buffer)
271 (insert-file-contents buffer-file-name))
272 (buffer-name))
273 (t
274 (mh-read-draft "clean-up" (mh-msg-filename msg) nil)))))
275 (mh-clean-msg-header (point-min) mh-new-draft-cleaned-headers nil)
276 (mh-insert-header-separator)
277 (goto-char (point-min))
278 (save-buffer)
279 (mh-compose-and-send-mail draft "" from-folder nil nil nil nil nil nil
280 config)
281 (mh-letter-mode-message)))
282
283;;;###mh-autoload
284(defun mh-extract-rejected-mail (msg)
285 "Extract message MSG returned by the mail system and make it resendable.
286Default is the current message. The variable `mh-new-draft-cleaned-headers'
287gives the headers to clean out of the original message.
288See also documentation for `\\[mh-send]' function."
289 (interactive (list (mh-get-msg-num t)))
290 (let ((from-folder mh-current-folder)
291 (config (current-window-configuration))
292 (draft (mh-read-draft "extraction" (mh-msg-filename msg) nil)))
293 (goto-char (point-min))
294 (cond ((re-search-forward mh-rejected-letter-start nil t)
295 (skip-chars-forward " \t\n")
296 (delete-region (point-min) (point))
297 (mh-clean-msg-header (point-min) mh-new-draft-cleaned-headers nil))
298 (t
299 (message "Does not appear to be a rejected letter.")))
300 (mh-insert-header-separator)
301 (goto-char (point-min))
302 (save-buffer)
303 (mh-compose-and-send-mail draft "" from-folder msg
304 (mh-get-header-field "To:")
305 (mh-get-header-field "From:")
306 (mh-get-header-field "Cc:")
307 nil nil config)
308 (mh-letter-mode-message)))
309
310;;;###mh-autoload
311(defun mh-forward (to cc &optional msg-or-seq)
312 "Forward one or more messages to the recipients TO and CC.
313
314Use the optional MSG-OR-SEQ to specify a message or sequence to forward.
315
316Default is the displayed message. If optional prefix argument is given then
317prompt for the message sequence. If variable `transient-mark-mode' is non-nil
318and the mark is active, then the selected region is forwarded.
319See also documentation for `\\[mh-send]' function."
320 (interactive (list (mh-read-address "To: ")
321 (mh-read-address "Cc: ")
322 (cond
323 ((mh-mark-active-p t)
324 (mh-region-to-msg-list (region-beginning) (region-end)))
325 (current-prefix-arg
326 (mh-read-seq-default "Forward" t))
327 (t
328 (mh-get-msg-num t)))))
329 (let* ((folder mh-current-folder)
330 (msgs (cond ((numberp msg-or-seq) (list msg-or-seq))
331 ((listp msg-or-seq) msg-or-seq)
332 (t (mh-seq-to-msgs msg-or-seq))))
333 (config (current-window-configuration))
334 (fwd-msg-file (mh-msg-filename (car msgs) folder))
335 ;; forw always leaves file in "draft" since it doesn't have -draft
336 (draft-name (expand-file-name "draft" mh-user-path))
337 (draft (cond ((or (not (file-exists-p draft-name))
338 (y-or-n-p "The file 'draft' exists. Discard it? "))
339 (mh-exec-cmd "forw" "-build" (if mh-nmh-flag "-mime")
340 mh-current-folder msgs)
341 (prog1
342 (mh-read-draft "" draft-name t)
343 (mh-insert-fields "To:" to "Cc:" cc)
344 (save-buffer)))
345 (t
346 (mh-read-draft "" draft-name nil)))))
347 (let (orig-from
348 orig-subject)
349 (save-excursion
350 (set-buffer (get-buffer-create mh-temp-buffer))
351 (erase-buffer)
352 (insert-file-contents fwd-msg-file)
353 (setq orig-from (mh-get-header-field "From:"))
354 (setq orig-subject (mh-get-header-field "Subject:")))
355 (let ((forw-subject
356 (mh-forwarded-letter-subject orig-from orig-subject))
357 (compose))
358 (mh-insert-fields "Subject:" forw-subject)
359 (goto-char (point-min))
360 ;; If using MML, translate mhn
361 (if (equal mh-compose-insertion 'gnus)
362 (save-excursion
363 (setq compose t)
364 (re-search-forward (format "^\\(%s\\)?$"
365 mh-mail-header-separator))
366 (while
367 (re-search-forward
368 "^#forw \\[\\([^]]+\\)\\] \\(+\\S-+\\) \\(.*\\)$"
369 (point-max) t)
370 (let ((description (if (equal (match-string 1)
371 "forwarded messages")
372 "forwarded message %d"
373 (match-string 1)))
374 (msgs (split-string (match-string 3)))
375 (i 0))
376 (beginning-of-line)
377 (delete-region (point) (progn (forward-line 1) (point)))
378 (dolist (msg msgs)
379 (setq i (1+ i))
380 (mh-mml-forward-message (format description i)
381 folder msg))))))
382 ;; Postition just before forwarded message
383 (if (re-search-forward "^------- Forwarded Message" nil t)
384 (forward-line -1)
385 (re-search-forward (format "^\\(%s\\)?$" mh-mail-header-separator))
386 (forward-line 1))
387 (delete-other-windows)
388 (mh-add-msgs-to-seq msgs 'forwarded t)
389 (mh-compose-and-send-mail draft "" folder msg-or-seq
390 to forw-subject cc
391 mh-note-forw "Forwarded:"
392 config)
393 (if compose
394 (setq mh-mml-compose-insert-flag t))
395 (mh-letter-mode-message)))))
396
397(defun mh-forwarded-letter-subject (from subject)
398 "Return a Subject suitable for a forwarded message.
399Original message has headers FROM and SUBJECT."
400 (let ((addr-start (string-match "<" from))
401 (comment (string-match "(" from)))
402 (cond ((and addr-start (> addr-start 0))
403 ;; Full Name <luser@host>
404 (setq from (substring from 0 (1- addr-start))))
405 (comment
406 ;; luser@host (Full Name)
407 (setq from (substring from (1+ comment) (1- (length from)))))))
408 (format mh-forward-subject-format from subject))
409
410;;;###autoload
411(defun mh-smail-other-window ()
412 "Compose and send mail in other window with the MH mail system.
413This function is an entry point to MH-E, the Emacs front end
414to the MH mail system.
415
416See documentation of `\\[mh-send]' for more details on composing mail."
417 (interactive)
418 (mh-find-path)
419 (call-interactively 'mh-send-other-window))
420
421;;;###mh-autoload
422(defun mh-redistribute (to cc &optional msg)
423 "Redistribute displayed message to recipients TO and CC.
424Use optional argument MSG to redistribute another message.
425Depending on how your copy of MH was compiled, you may need to change the
426setting of the variable `mh-redist-full-contents'. See its documentation."
427 (interactive (list (mh-read-address "Redist-To: ")
428 (mh-read-address "Redist-Cc: ")
429 (mh-get-msg-num t)))
430 (or msg
431 (setq msg (mh-get-msg-num t)))
432 (save-window-excursion
433 (let ((folder mh-current-folder)
434 (draft (mh-read-draft "redistribution"
435 (if mh-redist-full-contents
436 (mh-msg-filename msg)
437 nil)
438 nil)))
439 (mh-goto-header-end 0)
440 (insert "Resent-To: " to "\n")
441 (if (not (equal cc "")) (insert "Resent-cc: " cc "\n"))
442 (mh-clean-msg-header (point-min)
443 "^Message-Id:\\|^Received:\\|^Return-Path:\\|^Sender:\\|^Date:\\|^From:"
444 nil)
445 (save-buffer)
446 (message "Redistributing...")
447 (if (not mh-redist-background)
448 (if mh-redist-full-contents
449 (call-process "/bin/sh" nil 0 nil "-c"
450 (format "mhdist=1 mhaltmsg=%s %s -push %s"
451 buffer-file-name
452 (expand-file-name mh-send-prog mh-progs)
453 buffer-file-name))
454 (call-process "/bin/sh" nil 0 nil "-c"
455 (format
456 "mhdist=1 mhaltmsg=%s mhannotate=1 %s -push %s"
457 (mh-msg-filename msg folder)
458 (expand-file-name mh-send-prog mh-progs)
459 buffer-file-name))))
460 (mh-annotate-msg msg folder mh-note-dist
461 "-component" "Resent:"
462 "-text" (format "\"%s %s\"" to cc))
463 (if mh-redist-background
464 (mh-exec-cmd-daemon "/bin/sh" "-c"
465 (format "mhdist=1 mhaltmsg=%s %s %s %s"
466 (if mh-redist-full-contents
467 buffer-file-name
468 (mh-msg-filename msg folder))
469 (if mh-redist-full-contents
470 ""
471 "mhannotate=1")
472 (mh-expand-file-name "send" mh-progs)
473 buffer-file-name)))
474 (kill-buffer draft)
475 (message "Redistributing...done"))))
476
477(defun mh-show-buffer-message-number (&optional buffer)
478 "Message number of displayed message in corresponding show buffer.
479Return nil if show buffer not displayed.
480If in `mh-letter-mode', don't display the message number being replied to,
481but rather the message number of the show buffer associated with our
482originating folder buffer.
483Optional argument BUFFER can be used to specify the buffer."
484 (save-excursion
485 (if buffer
486 (set-buffer buffer))
487 (cond ((eq major-mode 'mh-show-mode)
488 (let ((number-start (mh-search-from-end ?/ buffer-file-name)))
489 (car (read-from-string (substring buffer-file-name
490 (1+ number-start))))))
491 ((and (eq major-mode 'mh-folder-mode)
492 mh-show-buffer
493 (get-buffer mh-show-buffer))
494 (mh-show-buffer-message-number mh-show-buffer))
495 ((and (eq major-mode 'mh-letter-mode)
496 mh-sent-from-folder
497 (get-buffer mh-sent-from-folder))
498 (mh-show-buffer-message-number mh-sent-from-folder))
499 (t
500 nil))))
501
502;;;###mh-autoload
503(defun mh-reply (message &optional reply-to includep)
504 "Reply to MESSAGE (default: current message).
505If the optional argument REPLY-TO is not given, prompts for type of addresses
506to reply to:
507 from sender only,
508 to sender and primary recipients,
509 cc/all sender and all recipients.
510If optional prefix argument INCLUDEP provided, then include the message
511in the reply using filter `mhl.reply' in your MH directory.
512If the file named by `mh-repl-formfile' exists, it is used as a skeleton
513for the reply. See also documentation for `\\[mh-send]' function."
514 (interactive (list
515 (mh-get-msg-num t)
516 (let ((minibuffer-help-form
517 "from => Sender only\nto => Sender and primary recipients\ncc or all => Sender and all recipients"))
518 (or mh-reply-default-reply-to
519 (completing-read "Reply to whom? (from, to, all) [from]: "
520 '(("from") ("to") ("cc") ("all"))
521 nil
522 t)))
523 current-prefix-arg))
524 (let* ((folder mh-current-folder)
525 (show-buffer mh-show-buffer)
526 (config (current-window-configuration))
527 (group-reply (or (equal reply-to "cc") (equal reply-to "all")))
528 (form-file (cond ((and mh-nmh-flag group-reply
529 (stringp mh-repl-group-formfile))
530 mh-repl-group-formfile)
531 ((stringp mh-repl-formfile) mh-repl-formfile)
532 (t nil))))
533 (message "Composing a reply...")
534 (mh-exec-cmd "repl" "-build" "-noquery" "-nodraftfolder"
535 (if form-file
536 (list "-form" form-file))
537 mh-current-folder message
538 (cond ((or (equal reply-to "from") (equal reply-to ""))
539 '("-nocc" "all"))
540 ((equal reply-to "to")
541 '("-cc" "to"))
542 (group-reply (if mh-nmh-flag
543 '("-group" "-nocc" "me")
544 '("-cc" "all" "-nocc" "me"))))
545 (cond ((or (eq mh-yank-from-start-of-msg 'autosupercite)
546 (eq mh-yank-from-start-of-msg 'autoattrib))
547 '("-noformat"))
548 (includep '("-filter" "mhl.reply"))
549 (t '())))
550 (let ((draft (mh-read-draft "reply"
551 (expand-file-name "reply" mh-user-path)
552 t)))
553 (delete-other-windows)
554 (save-buffer)
555
556 (let ((to (mh-get-header-field "To:"))
557 (subject (mh-get-header-field "Subject:"))
558 (cc (mh-get-header-field "Cc:")))
559 (goto-char (point-min))
560 (mh-goto-header-end 1)
561 (or includep
562 (not mh-reply-show-message-flag)
563 (mh-in-show-buffer (show-buffer)
564 (mh-display-msg message folder)))
565 (mh-add-msgs-to-seq message 'answered t)
566 (message "Composing a reply...done")
567 (mh-compose-and-send-mail draft "" folder message to subject cc
568 mh-note-repl "Replied:" config))
569 (when (and (or (eq 'autosupercite mh-yank-from-start-of-msg)
570 (eq 'autoattrib mh-yank-from-start-of-msg))
571 (eq (mh-show-buffer-message-number) mh-sent-from-msg))
572 (undo-boundary)
573 (mh-yank-cur-msg))
574 (mh-letter-mode-message))))
575
576;;;###mh-autoload
577(defun mh-send (to cc subject)
578 "Compose and send a letter.
579
580Do not call this function from outside MH-E; use \\[mh-smail] instead.
581
582The file named by `mh-comp-formfile' will be used as the form.
583The letter is composed in `mh-letter-mode'; see its documentation for more
584details.
585If `mh-compose-letter-function' is defined, it is called on the draft and
586passed three arguments: TO, CC, and SUBJECT."
587 (interactive (list
588 (mh-read-address "To: ")
589 (mh-read-address "Cc: ")
590 (read-string "Subject: ")))
591 (let ((config (current-window-configuration)))
592 (delete-other-windows)
593 (mh-send-sub to cc subject config)))
594
595;;;###mh-autoload
596(defun mh-send-other-window (to cc subject)
597 "Compose and send a letter in another window.
598
599Do not call this function from outside MH-E; use \\[mh-smail-other-window]
600instead.
601
602The file named by `mh-comp-formfile' will be used as the form.
603The letter is composed in `mh-letter-mode'; see its documentation for more
604details.
605If `mh-compose-letter-function' is defined, it is called on the draft and
606passed three arguments: TO, CC, and SUBJECT."
607 (interactive (list
608 (mh-read-address "To: ")
609 (mh-read-address "Cc: ")
610 (read-string "Subject: ")))
611 (let ((pop-up-windows t))
612 (mh-send-sub to cc subject (current-window-configuration))))
613
614(defun mh-send-sub (to cc subject config)
615 "Do the real work of composing and sending a letter.
616Expects the TO, CC, and SUBJECT fields as arguments.
617CONFIG is the window configuration before sending mail."
618 (let ((folder mh-current-folder)
619 (msg-num (mh-get-msg-num nil)))
620 (message "Composing a message...")
621 (let ((draft (mh-read-draft
622 "message"
623 (let (components)
624 (cond
625 ((file-exists-p
626 (setq components
627 (expand-file-name mh-comp-formfile mh-user-path)))
628 components)
629 ((file-exists-p
630 (setq components
631 (expand-file-name mh-comp-formfile mh-lib)))
632 components)
633 ((file-exists-p
634 (setq components
635 (expand-file-name mh-comp-formfile
636 ;; What is this mh-etc ?? -sm
637 ;; This is dead code, so
638 ;; remove it.
639 ;(and (boundp 'mh-etc) mh-etc)
640 )))
641 components)
642 (t
643 (error (format "Can't find components file \"%s\""
644 components)))))
645 nil)))
646 (mh-insert-fields "To:" to "Subject:" subject "Cc:" cc)
647 (goto-char (point-max))
648 (mh-compose-and-send-mail draft "" folder msg-num
649 to subject cc
650 nil nil config)
651 (mh-letter-mode-message))))
652
653(defun mh-read-draft (use initial-contents delete-contents-file)
654 "Read draft file into a draft buffer and make that buffer the current one.
655USE is a message used for prompting about the intended use of the message.
656INITIAL-CONTENTS is filename that is read into an empty buffer, or nil
657if buffer should not be modified. Delete the initial-contents file if
658DELETE-CONTENTS-FILE flag is set.
659Returns the draft folder's name.
660If the draft folder facility is enabled in ~/.mh_profile, a new buffer is
661used each time and saved in the draft folder. The draft file can then be
662reused."
663 (cond (mh-draft-folder
664 (let ((orig-default-dir default-directory)
665 (draft-file-name (mh-new-draft-name)))
666 (pop-to-buffer (generate-new-buffer
667 (format "draft-%s"
668 (file-name-nondirectory draft-file-name))))
669 (condition-case ()
670 (insert-file-contents draft-file-name t)
671 (file-error))
672 (setq default-directory orig-default-dir)))
673 (t
674 (let ((draft-name (expand-file-name "draft" mh-user-path)))
675 (pop-to-buffer "draft") ; Create if necessary
676 (if (buffer-modified-p)
677 (if (y-or-n-p "Draft has been modified; kill anyway? ")
678 (set-buffer-modified-p nil)
679 (error "Draft preserved")))
680 (setq buffer-file-name draft-name)
681 (clear-visited-file-modtime)
682 (unlock-buffer)
683 (cond ((and (file-exists-p draft-name)
684 (not (equal draft-name initial-contents)))
685 (insert-file-contents draft-name)
686 (delete-file draft-name))))))
687 (cond ((and initial-contents
688 (or (zerop (buffer-size))
689 (if (y-or-n-p
690 (format "A draft exists. Use for %s? " use))
691 (if mh-error-if-no-draft
692 (error "A prior draft exists"))
693 t)))
694 (erase-buffer)
695 (insert-file-contents initial-contents)
696 (if delete-contents-file (delete-file initial-contents))))
697 (auto-save-mode 1)
698 (if mh-draft-folder
699 (save-buffer)) ; Do not reuse draft name
700 (buffer-name))
701
702(defun mh-new-draft-name ()
703 "Return the pathname of folder for draft messages."
704 (save-excursion
705 (mh-exec-cmd-quiet t "mhpath" mh-draft-folder "new")
706 (buffer-substring (point-min) (1- (point-max)))))
707
708(defun mh-annotate-msg (msg buffer note &rest args)
709 "Mark MSG in BUFFER with character NOTE and annotate message with ARGS."
710 (apply 'mh-exec-cmd "anno" buffer msg args)
711 (save-excursion
712 (cond ((get-buffer buffer) ; Buffer may be deleted
713 (set-buffer buffer)
714 (if (numberp msg)
715 (mh-notate msg note (1+ mh-cmd-note))
716 (mh-notate-seq msg note (1+ mh-cmd-note)))))))
717
718(defun mh-insert-fields (&rest name-values)
719 "Insert the NAME-VALUES pairs in the current buffer.
720If the field exists, append the value to it.
721Do not insert any pairs whose value is the empty string."
722 (let ((case-fold-search t))
723 (while name-values
724 (let ((field-name (car name-values))
725 (value (car (cdr name-values))))
726 (cond ((equal value "")
727 nil)
728 ((mh-position-on-field field-name)
729 (insert " " (or value "")))
730 (t
731 (insert field-name " " value "\n")))
732 (setq name-values (cdr (cdr name-values)))))))
733
734(defun mh-position-on-field (field &optional ignored)
735 "Move to the end of the FIELD in the header.
736Move to end of entire header if FIELD not found.
737Returns non-nil iff FIELD was found.
738The optional second arg is for pre-version 4 compatibility and is IGNORED."
739 (cond ((mh-goto-header-field field)
740 (mh-header-field-end)
741 t)
742 ((mh-goto-header-end 0)
743 nil)))
744
745(defun mh-get-header-field (field)
746 "Find and return the body of FIELD in the mail header.
747Returns the empty string if the field is not in the header of the
748current buffer."
749 (if (mh-goto-header-field field)
750 (progn
751 (skip-chars-forward " \t") ;strip leading white space in body
752 (let ((start (point)))
753 (mh-header-field-end)
754 (buffer-substring-no-properties start (point))))
755 ""))
756
757(fset 'mh-get-field 'mh-get-header-field) ;MH-E 4 compatibility
758
759(defun mh-goto-header-field (field)
760 "Move to FIELD in the message header.
761Move to the end of the FIELD name, which should end in a colon.
762Returns t if found, nil if not."
763 (goto-char (point-min))
764 (let ((case-fold-search t)
765 (headers-end (save-excursion
766 (mh-goto-header-end 0)
767 (point))))
768 (re-search-forward (format "^%s" field) headers-end t)))
769
770(defun mh-goto-header-end (arg)
771 "Move the cursor ARG lines after the header."
772 (if (re-search-forward "^-*$" nil nil)
773 (forward-line arg)))
774
775(defun mh-extract-from-header-value ()
776 "Extract From: string from header."
777 (save-excursion
778 (if (not (mh-goto-header-field "From:"))
779 (error "No From header line found")
780 (skip-chars-forward " \t")
781 (buffer-substring-no-properties
782 (point) (progn (mh-header-field-end)(point))))))
783
784
785
786;;; Mode for composing and sending a draft message.
787
788(put 'mh-letter-mode 'mode-class 'special)
789
790;;; Menu extracted from mh-menubar.el V1.1 (31 July 2001)
791(eval-when-compile (defvar mh-letter-menu nil))
792(cond
793 ((fboundp 'easy-menu-define)
794 (easy-menu-define
795 mh-letter-menu mh-letter-mode-map "Menu for MH-E letter mode."
796 '("Letter"
797 ["Send This Draft" mh-send-letter t]
798 ["Split Current Line" mh-open-line t]
799 ["Check Recipient" mh-check-whom t]
800 ["Yank Current Message" mh-yank-cur-msg t]
801 ["Insert a Message..." mh-insert-letter t]
802 ["Insert Signature" mh-insert-signature t]
803 ["GPG Sign message"
804 mh-mml-secure-message-sign-pgpmime mh-gnus-pgp-support-flag]
805 ["GPG Encrypt message"
806 mh-mml-secure-message-encrypt-pgpmime mh-gnus-pgp-support-flag]
807 ["Compose Insertion (MIME)..." mh-compose-insertion t]
808 ;; ["Compose Compressed tar (MIME)..."
809 ;;mh-mhn-compose-external-compressed-tar t]
810 ;; ["Compose Anon FTP (MIME)..." mh-mhn-compose-anon-ftp t]
811 ["Compose Forward (MIME)..." mh-compose-forward t]
812 ;; The next two will have to be merged. But I also need to make sure the
813 ;; user can't mix directives of both types.
814 ["Pull in All Compositions (mhn)"
815 mh-edit-mhn mh-mhn-compose-insert-flag]
816 ["Pull in All Compositions (gnus)"
817 mh-mml-to-mime mh-mml-compose-insert-flag]
818 ["Revert to Non-MIME Edit (mhn)"
819 mh-revert-mhn-edit (equal mh-compose-insertion 'mhn)]
820 ["Kill This Draft" mh-fully-kill-draft t]))))
821
822;;; Help Messages
823;;; Group messages logically, more or less.
824(defvar mh-letter-mode-help-messages
825 '((nil
826 "Send letter: \\[mh-send-letter]"
827 "\t\tOpen line: \\[mh-open-line]\n"
828 "Kill letter: \\[mh-fully-kill-draft]"
829 "\t\tInsert:\n"
830 "Check recipients: \\[mh-check-whom]"
831 "\t\t Current message: \\[mh-yank-cur-msg]\n"
832 "Encrypt message: \\[mh-mml-secure-message-encrypt-pgpmime]"
833 "\t\t Attachment: \\[mh-compose-insertion]\n"
834 "Sign message: \\[mh-mml-secure-message-sign-pgpmime]"
835 "\t\t Message to forward: \\[mh-compose-forward]\n"
836 " "
837 "\t\t Signature: \\[mh-insert-signature]"))
838 "Key binding cheat sheet.
839
840This is an associative array which is used to show the most common commands.
841The key is a prefix char. The value is one or more strings which are
842concatenated together and displayed in the minibuffer if ? is pressed after
843the prefix character. The special key nil is used to display the
844non-prefixed commands.
845
846The substitutions described in `substitute-command-keys' are performed as
847well.")
848
849;;;###mh-autoload
850(defun mh-fill-paragraph-function (arg)
851 "Fill paragraph at or after point.
852Prefix ARG means justify as well. This function enables `fill-paragraph' to
853work better in MH-Letter mode."
854 (interactive "P")
855 (let ((fill-paragraph-function) (fill-prefix))
856 (if (mh-in-header-p)
857 (mail-mode-fill-paragraph arg)
858 (fill-paragraph arg))))
859
860;;;###autoload
861(define-derived-mode mh-letter-mode text-mode "MH-Letter"
862 "Mode for composing letters in MH-E.\\<mh-letter-mode-map>
863
864When you have finished composing, type \\[mh-send-letter] to send the message
865using the MH mail handling system.
866
867There are two types of MIME directives used by MH-E: Gnus and MH. The option
868`mh-compose-insertion' controls what type of directives are inserted by MH-E
869commands. These directives can be converted to MIME body parts by running
870\\[mh-edit-mhn] for mhn directives or \\[mh-mml-to-mime] for Gnus directives.
871This step is mandatory if these directives are added manually. If the
872directives are inserted with MH-E commands such as \\[mh-compose-insertion],
873the directives are expanded automatically when the letter is sent.
874
875Options that control this mode can be changed with
876\\[customize-group]; specify the \"mh-compose\" group.
877
878When a message is composed, the hooks `text-mode-hook' and
879`mh-letter-mode-hook' are run.
880
881\\{mh-letter-mode-map}"
882
883 (or mh-user-path (mh-find-path))
884 (make-local-variable 'mh-send-args)
885 (make-local-variable 'mh-annotate-char)
886 (make-local-variable 'mh-annotate-field)
887 (make-local-variable 'mh-previous-window-config)
888 (make-local-variable 'mh-sent-from-folder)
889 (make-local-variable 'mh-sent-from-msg)
890 (make-local-variable 'mail-header-separator)
891 (setq mail-header-separator mh-mail-header-separator) ;override sendmail.el
892 (make-local-variable 'mh-help-messages)
893 (setq mh-help-messages mh-letter-mode-help-messages)
894
895 ;; From sendmail.el for proper paragraph fill
896 ;; sendmail.el also sets a normal-auto-fill-function (not done here)
897 (make-local-variable 'paragraph-separate)
898 (make-local-variable 'paragraph-start)
899 (make-local-variable 'fill-paragraph-function)
900 (setq fill-paragraph-function 'mh-fill-paragraph-function)
901 (make-local-variable 'adaptive-fill-regexp)
902 (setq adaptive-fill-regexp
903 (concat adaptive-fill-regexp
904 "\\|[ \t]*[-[:alnum:]]*>+[ \t]*"))
905 (make-local-variable 'adaptive-fill-first-line-regexp)
906 (setq adaptive-fill-first-line-regexp
907 (concat adaptive-fill-first-line-regexp
908 "\\|[ \t]*[-[:alnum:]]*>+[ \t]*"))
909 ;; `-- ' precedes the signature. `-----' appears at the start of the
910 ;; lines that delimit forwarded messages.
911 ;; Lines containing just >= 3 dashes, perhaps after whitespace,
912 ;; are also sometimes used and should be separators.
913 (setq paragraph-start (concat (regexp-quote mail-header-separator)
914 "\\|\t*\\([-|#;>* ]\\|(?[0-9]+[.)]\\)+$"
915 "\\|[ \t]*[[:alnum:]]*>+[ \t]*$\\|[ \t]*$\\|"
916 "-- $\\|---+$\\|"
917 page-delimiter))
918 (setq paragraph-separate paragraph-start)
919 ;; --- End of code from sendmail.el ---
920
921 (if (and (boundp 'tool-bar-mode) tool-bar-mode)
922 (set (make-local-variable 'tool-bar-map) mh-letter-tool-bar-map))
923 (make-local-variable 'font-lock-defaults)
924 (cond
925 ((or (equal mh-highlight-citation-p 'font-lock)
926 (equal mh-highlight-citation-p 'gnus))
927 ;; Let's use font-lock even if gnus is used in show-mode. The reason
928 ;; is that gnus uses static text properties which are not appropriate
929 ;; for a buffer that will be edited. So the choice here is either fontify
930 ;; the citations and header...
931 (setq font-lock-defaults '(mh-show-font-lock-keywords-with-cite t)))
932 (t
933 ;; ...or the header only
934 (setq font-lock-defaults '(mh-show-font-lock-keywords t))))
935 (easy-menu-add mh-letter-menu)
936 ;; See if a "forw: -mime" message containing a MIME composition.
937 ;; Mode clears local vars, so can't do this in mh-forward.
938 (save-excursion
939 (goto-char (point-min))
940 (when (and (re-search-forward
941 (format "^\\(%s\\)?$" mail-header-separator) nil t)
942 (= 0 (forward-line 1))
943 (looking-at "^#forw"))
944 (require 'mh-mime) ;Need mh-mhn-compose-insert-flag local var
945 (setq mh-mhn-compose-insert-flag t)))
946 (setq fill-column mh-letter-fill-column)
947 ;; If text-mode-hook turned on auto-fill, tune it for messages
948 (when auto-fill-function
949 (make-local-variable 'auto-fill-function)
950 (setq auto-fill-function 'mh-auto-fill-for-letter)))
951
952(defun mh-auto-fill-for-letter ()
953 "Perform auto-fill for message.
954Header is treated specially by inserting a tab before continuation lines."
955 (if (mh-in-header-p)
956 (let ((fill-prefix "\t"))
957 (do-auto-fill))
958 (do-auto-fill)))
959
960(defun mh-insert-header-separator ()
961 "Insert `mh-mail-header-separator', if absent."
962 (save-excursion
963 (goto-char (point-min))
964 (rfc822-goto-eoh)
965 (if (looking-at "$")
966 (insert mh-mail-header-separator))))
967
968;;;###mh-autoload
969(defun mh-to-field ()
970 "Move point to the end of a specified header field.
971The field is indicated by the previous keystroke (the last keystroke
972of the command) according to the list in the variable `mh-to-field-choices'.
973Create the field if it does not exist. Set the mark to point before moving."
974 (interactive)
975 (expand-abbrev)
976 (let ((target (cdr (or (assoc (char-to-string (logior last-input-char ?`))
977 mh-to-field-choices)
978 ;; also look for a char for version 4 compat
979 (assoc (logior last-input-char ?`)
980 mh-to-field-choices))))
981 (case-fold-search t))
982 (push-mark)
983 (cond ((mh-position-on-field target)
984 (let ((eol (point)))
985 (skip-chars-backward " \t")
986 (delete-region (point) eol))
987 (if (and (not (eq (logior last-input-char ?`) ?s))
988 (save-excursion
989 (backward-char 1)
990 (not (looking-at "[:,]"))))
991 (insert ", ")
992 (insert " ")))
993 (t
994 (if (mh-position-on-field "To:")
995 (forward-line 1))
996 (insert (format "%s \n" target))
997 (backward-char 1)))))
998
999;;;###mh-autoload
1000(defun mh-to-fcc (&optional folder)
1001 "Insert an Fcc: FOLDER field in the current message.
1002Prompt for the field name with a completion list of the current folders."
1003 (interactive)
1004 (or folder
1005 (setq folder (mh-prompt-for-folder
1006 "Fcc"
1007 (or (and mh-default-folder-for-message-function
1008 (save-excursion
1009 (goto-char (point-min))
1010 (funcall
1011 mh-default-folder-for-message-function)))
1012 "")
1013 t)))
1014 (let ((last-input-char ?\C-f))
1015 (expand-abbrev)
1016 (save-excursion
1017 (mh-to-field)
1018 (insert (if (mh-folder-name-p folder)
1019 (substring folder 1)
1020 folder)))))
1021
1022;;;###mh-autoload
1023(defun mh-insert-signature ()
1024 "Insert the file named by `mh-signature-file-name' at point.
1025The value of `mh-letter-insert-signature-hook' is a list of functions to be
1026called, with no arguments, before the signature is actually inserted."
1027 (interactive)
1028 (let ((mh-signature-file-name mh-signature-file-name))
1029 (run-hooks 'mh-letter-insert-signature-hook)
1030 (if mh-signature-file-name
1031 (insert-file-contents mh-signature-file-name)))
1032 (force-mode-line-update))
1033
1034;;;###mh-autoload
1035(defun mh-check-whom ()
1036 "Verify recipients of the current letter, showing expansion of any aliases."
1037 (interactive)
1038 (let ((file-name buffer-file-name))
1039 (save-buffer)
1040 (message "Checking recipients...")
1041 (mh-in-show-buffer ("*Recipients*")
1042 (bury-buffer (current-buffer))
1043 (erase-buffer)
1044 (mh-exec-cmd-output "whom" t file-name))
1045 (message "Checking recipients...done")))
1046
1047
1048
1049;;; Routines to compose and send a letter.
1050
1051(defun mh-insert-x-face ()
1052 "Append X-Face field to header.
1053If the field already exists, this function does nothing."
1054 (when (and (file-exists-p mh-x-face-file)
1055 (file-readable-p mh-x-face-file))
1056 (save-excursion
1057 (when (null (mh-position-on-field "X-Face"))
1058 (insert "X-Face: ")
1059 (goto-char (+ (point) (cadr (insert-file-contents mh-x-face-file))))
1060 (if (not (looking-at "^"))
1061 (insert "\n"))))))
1062
1063(defun mh-insert-x-mailer ()
1064 "Append an X-Mailer field to the header.
1065The versions of MH-E, Emacs, and MH are shown."
1066
1067 ;; Lazily initialize mh-x-mailer-string.
1068 (when (null mh-x-mailer-string)
1069 (save-window-excursion
1070 (mh-version)
1071 (set-buffer mh-temp-buffer)
1072 (if mh-nmh-flag
1073 (search-forward-regexp "^nmh-\\(\\S +\\)")
1074 (search-forward-regexp "^MH \\(\\S +\\)" nil t))
1075 (let ((x-mailer-mh (buffer-substring (match-beginning 1) (match-end 1))))
1076 (setq mh-x-mailer-string
1077 (format "MH-E %s; %s %s; %s %d.%d"
1078 mh-version (if mh-nmh-flag "nmh" "MH") x-mailer-mh
1079 (if mh-xemacs-flag
1080 "XEmacs"
1081 "Emacs")
1082 emacs-major-version emacs-minor-version)))
1083 (kill-buffer mh-temp-buffer)))
1084 ;; Insert X-Mailer, but only if it doesn't already exist.
1085 (save-excursion
1086 (when (null (mh-goto-header-field "X-Mailer"))
1087 (mh-insert-fields "X-Mailer:" mh-x-mailer-string))))
1088
1089(defun mh-regexp-in-field-p (regexp &rest fields)
1090 "Non-nil means REGEXP was found in FIELDS."
1091 (save-excursion
1092 (let ((search-result nil)
1093 (field))
1094 (while fields
1095 (setq field (car fields))
1096 (if (and (mh-goto-header-field field)
1097 (re-search-forward
1098 regexp (save-excursion (mh-header-field-end)(point)) t))
1099 (setq fields nil
1100 search-result t)
1101 (setq fields (cdr fields))))
1102 search-result)))
1103
1104(defun mh-insert-mail-followup-to ()
1105 "Insert Mail-Followup-To: if To or Cc match `mh-insert-mail-followup-to-list'."
1106 (save-excursion
1107 (if (and (or (mh-goto-header-field "To:")(mh-goto-header-field "cc:"))
1108 (not (mh-goto-header-field "Mail-Followup-To: ")))
1109 (let ((list mh-insert-mail-followup-to-list))
1110 (while list
1111 (let ((regexp (nth 0 (car list)))
1112 (entry (nth 1 (car list))))
1113 (when (mh-regexp-in-field-p regexp "To:" "cc:")
1114 (if (mh-goto-header-field "Mail-Followup-To: ")
1115 (insert entry ", ")
1116 (mh-goto-header-end 0)
1117 (insert "Mail-Followup-To: " entry "\n")))
1118 (setq list (cdr list))))))))
1119
1120(defun mh-compose-and-send-mail (draft send-args
1121 sent-from-folder sent-from-msg
1122 to subject cc
1123 annotate-char annotate-field
1124 config)
1125 "Edit and compose a draft message in buffer DRAFT and send or save it.
1126SEND-ARGS is the argument passed to the send command.
1127SENT-FROM-FOLDER is buffer containing scan listing of current folder, or
1128nil if none exists.
1129SENT-FROM-MSG is the message number or sequence name or nil.
1130The TO, SUBJECT, and CC fields are passed to the
1131`mh-compose-letter-function'.
1132If ANNOTATE-CHAR is non-null, it is used to notate the scan listing of the
1133message. In that case, the ANNOTATE-FIELD is used to build a string
1134for `mh-annotate-msg'.
1135CONFIG is the window configuration to restore after sending the letter."
1136 (pop-to-buffer draft)
1137 (if mh-insert-mail-followup-to-flag (mh-insert-mail-followup-to))
1138 (mh-letter-mode)
1139
1140 ;; mh-identity support
1141 (if (and (boundp 'mh-identity-default)
1142 mh-identity-default)
1143 (mh-insert-identity mh-identity-default))
1144 (when (and (boundp 'mh-identity-list)
1145 mh-identity-list)
1146 (mh-identity-make-menu)
1147 (easy-menu-add mh-identity-menu))
1148
1149 (setq mh-sent-from-folder sent-from-folder)
1150 (setq mh-sent-from-msg sent-from-msg)
1151 (setq mh-send-args send-args)
1152 (setq mh-annotate-char annotate-char)
1153 (setq mh-annotate-field annotate-field)
1154 (setq mh-previous-window-config config)
1155 (setq mode-line-buffer-identification (list "{%b}"))
1156 (if (and (boundp 'mh-compose-letter-function)
1157 mh-compose-letter-function)
1158 ;; run-hooks will not pass arguments.
1159 (let ((value mh-compose-letter-function))
1160 (if (and (listp value) (not (eq (car value) 'lambda)))
1161 (while value
1162 (funcall (car value) to subject cc)
1163 (setq value (cdr value)))
1164 (funcall mh-compose-letter-function to subject cc)))))
1165
1166(defun mh-letter-mode-message ()
1167 "Display a help message for users of `mh-letter-mode'.
1168This should be the last function called when composing the draft."
1169 (message "%s" (substitute-command-keys
1170 (concat "Type \\[mh-send-letter] to send message, "
1171 "\\[mh-help] for help."))))
1172
1173;;;###mh-autoload
1174(defun mh-send-letter (&optional arg)
1175 "Send the draft letter in the current buffer.
1176If optional prefix argument ARG is provided, monitor delivery.
1177The value of `mh-before-send-letter-hook' is a list of functions to be called,
1178with no arguments, before doing anything.
1179Run `\\[mh-edit-mhn]' if variable `mh-mhn-compose-insert-flag' is set.
1180Run `\\[mh-mml-to-mime]' if variable `mh-mml-compose-insert-flag' is set.
1181Insert X-Mailer field if variable `mh-insert-x-mailer-flag' is set.
1182Insert X-Face field if the file specified by `mh-x-face-file' exists."
1183 (interactive "P")
1184 (run-hooks 'mh-before-send-letter-hook)
1185 (cond
1186 ((and (boundp 'mh-mhn-compose-insert-flag)
1187 mh-mhn-compose-insert-flag)
1188 (mh-edit-mhn))
1189 ((and (boundp 'mh-mml-compose-insert-flag)
1190 mh-mml-compose-insert-flag)
1191 (mh-mml-to-mime)))
1192 (if mh-insert-x-mailer-flag (mh-insert-x-mailer))
1193 (mh-insert-x-face)
1194 (save-buffer)
1195 (message "Sending...")
1196 (let ((draft-buffer (current-buffer))
1197 (file-name buffer-file-name)
1198 (config mh-previous-window-config)
1199 (coding-system-for-write
1200 (if (and (local-variable-p 'buffer-file-coding-system
1201 (current-buffer)) ;XEmacs needs two args
1202 ;; We're not sure why, but buffer-file-coding-system
1203 ;; tends to get set to undecided-unix.
1204 (not (memq buffer-file-coding-system
1205 '(undecided undecided-unix undecided-dos))))
1206 buffer-file-coding-system
1207 (or (and (boundp 'sendmail-coding-system) sendmail-coding-system)
1208 (and (boundp 'default-buffer-file-coding-system )
1209 default-buffer-file-coding-system)
1210 'iso-latin-1))))
1211 ;; The default BCC encapsulation will make a MIME message unreadable.
1212 ;; With nmh use the -mime arg to prevent this.
1213 (if (and mh-nmh-flag
1214 (mh-goto-header-field "Bcc:")
1215 (mh-goto-header-field "Content-Type:"))
1216 (setq mh-send-args (format "-mime %s" mh-send-args)))
1217 (cond (arg
1218 (pop-to-buffer "MH mail delivery")
1219 (erase-buffer)
1220 (mh-exec-cmd-output mh-send-prog t "-watch" "-nopush"
1221 "-nodraftfolder" mh-send-args file-name)
1222 (goto-char (point-max)) ; show the interesting part
1223 (recenter -1)
1224 (set-buffer draft-buffer)) ; for annotation below
1225 (t
1226 (mh-exec-cmd-daemon mh-send-prog "-nodraftfolder" "-noverbose"
1227 mh-send-args file-name)))
1228 (if mh-annotate-char
1229 (mh-annotate-msg mh-sent-from-msg
1230 mh-sent-from-folder
1231 mh-annotate-char
1232 "-component" mh-annotate-field
1233 "-text" (format "\"%s %s\""
1234 (mh-get-header-field "To:")
1235 (mh-get-header-field "Cc:"))))
1236
1237 (cond ((or (not arg)
1238 (y-or-n-p "Kill draft buffer? "))
1239 (kill-buffer draft-buffer)
1240 (if config
1241 (set-window-configuration config))))
1242 (if arg
1243 (message "Sending...done")
1244 (message "Sending...backgrounded"))))
1245
1246;;;###mh-autoload
1247(defun mh-insert-letter (folder message verbatim)
1248 "Insert a message into the current letter.
1249Removes the header fields according to the variable `mh-invisible-headers'.
1250Prefixes each non-blank line with `mh-ins-buf-prefix', unless
1251`mh-yank-from-start-of-msg' is set for supercite in which case supercite is
1252used to format the message.
1253Prompts for FOLDER and MESSAGE. If prefix argument VERBATIM provided, do
1254not indent and do not delete headers. Leaves the mark before the letter
1255and point after it."
1256 (interactive
1257 (list (mh-prompt-for-folder "Message from" mh-sent-from-folder nil)
1258 (read-input (format "Message number%s: "
1259 (if (numberp mh-sent-from-msg)
1260 (format " [%d]" mh-sent-from-msg)
1261 "")))
1262 current-prefix-arg))
1263 (save-restriction
1264 (narrow-to-region (point) (point))
1265 (let ((start (point-min)))
1266 (if (equal message "") (setq message (int-to-string mh-sent-from-msg)))
1267 (insert-file-contents
1268 (expand-file-name message (mh-expand-file-name folder)))
1269 (when (not verbatim)
1270 (mh-clean-msg-header start mh-invisible-headers mh-visible-headers)
1271 (goto-char (point-max)) ;Needed for sc-cite-original
1272 (push-mark) ;Needed for sc-cite-original
1273 (goto-char (point-min)) ;Needed for sc-cite-original
1274 (mh-insert-prefix-string mh-ins-buf-prefix)))))
1275
1276(defun mh-extract-from-attribution ()
1277 "Extract phrase or comment from From header field."
1278 (save-excursion
1279 (if (not (mh-goto-header-field "From: "))
1280 nil
1281 (skip-chars-forward " ")
1282 (cond
1283 ((looking-at "\"\\([^\"\n]+\\)\" \\(<.+>\\)")
1284 (format "%s %s %s" (match-string 1)(match-string 2)
1285 mh-extract-from-attribution-verb))
1286 ((looking-at "\\([^<\n]+<.+>\\)$")
1287 (format "%s %s" (match-string 1) mh-extract-from-attribution-verb))
1288 ((looking-at "\\([^ ]+@[^ ]+\\) +(\\(.+\\))$")
1289 (format "%s <%s> %s" (match-string 2)(match-string 1)
1290 mh-extract-from-attribution-verb))
1291 ((looking-at " *\\(.+\\)$")
1292 (format "%s %s" (match-string 1) mh-extract-from-attribution-verb))))))
1293
1294;;;###mh-autoload
1295(defun mh-yank-cur-msg ()
1296 "Insert the current message into the draft buffer.
1297Prefix each non-blank line in the message with the string in
1298`mh-ins-buf-prefix'. If a region is set in the message's buffer, then
1299only the region will be inserted. Otherwise, the entire message will
1300be inserted if `mh-yank-from-start-of-msg' is non-nil. If this variable
1301is nil, the portion of the message following the point will be yanked.
1302If `mh-delete-yanked-msg-window-flag' is non-nil, any window displaying the
1303yanked message will be deleted."
1304 (interactive)
1305 (if (and mh-sent-from-folder
1306 (save-excursion (set-buffer mh-sent-from-folder) mh-show-buffer)
1307 (save-excursion (set-buffer mh-sent-from-folder)
1308 (get-buffer mh-show-buffer))
1309 mh-sent-from-msg)
1310 (let ((to-point (point))
1311 (to-buffer (current-buffer)))
1312 (set-buffer mh-sent-from-folder)
1313 (if mh-delete-yanked-msg-window-flag
1314 (delete-windows-on mh-show-buffer))
1315 (set-buffer mh-show-buffer) ; Find displayed message
1316 (let* ((from-attr (mh-extract-from-attribution))
1317 (yank-region (mh-mark-active-p nil))
1318 (mh-ins-str
1319 (cond ((and yank-region
1320 (or (eq 'supercite mh-yank-from-start-of-msg)
1321 (eq 'autosupercite mh-yank-from-start-of-msg)
1322 (eq t mh-yank-from-start-of-msg)))
1323 ;; supercite needs the full header
1324 (concat
1325 (buffer-substring (point-min) (mail-header-end))
1326 "\n"
1327 (buffer-substring (region-beginning) (region-end))))
1328 (yank-region
1329 (buffer-substring (region-beginning) (region-end)))
1330 ((or (eq 'body mh-yank-from-start-of-msg)
1331 (eq 'attribution
1332 mh-yank-from-start-of-msg)
1333 (eq 'autoattrib
1334 mh-yank-from-start-of-msg))
1335 (buffer-substring
1336 (save-excursion
1337 (goto-char (point-min))
1338 (mh-goto-header-end 1)
1339 (point))
1340 (point-max)))
1341 ((or (eq 'supercite mh-yank-from-start-of-msg)
1342 (eq 'autosupercite mh-yank-from-start-of-msg)
1343 (eq t mh-yank-from-start-of-msg))
1344 (buffer-substring (point-min) (point-max)))
1345 (t
1346 (buffer-substring (point) (point-max))))))
1347 (set-buffer to-buffer)
1348 (save-restriction
1349 (narrow-to-region to-point to-point)
1350 (insert (mh-filter-out-non-text mh-ins-str))
1351 (goto-char (point-max)) ;Needed for sc-cite-original
1352 (push-mark) ;Needed for sc-cite-original
1353 (goto-char (point-min)) ;Needed for sc-cite-original
1354 (mh-insert-prefix-string mh-ins-buf-prefix)
1355 (if (or (eq 'attribution mh-yank-from-start-of-msg)
1356 (eq 'autoattrib mh-yank-from-start-of-msg))
1357 (insert from-attr "\n\n"))
1358 ;; If the user has selected a region, he has already "edited" the
1359 ;; text, so leave the cursor at the end of the yanked text. In
1360 ;; either case, leave a mark at the opposite end of the included
1361 ;; text to make it easy to jump or delete to the other end of the
1362 ;; text.
1363 (push-mark)
1364 (goto-char (point-max))
1365 (if (null yank-region)
1366 (mh-exchange-point-and-mark-preserving-active-mark)))))
1367 (error "There is no current message")))
1368
1369(defun mh-filter-out-non-text (string)
1370 "Return STRING but without adornments such as MIME buttons and smileys."
1371 (with-temp-buffer
1372 ;; Insert the string to filter
1373 (insert string)
1374 (goto-char (point-min))
1375
1376 ;; Remove the MIME buttons
1377 (let ((can-move-forward t)
1378 (in-button nil))
1379 (while can-move-forward
1380 (cond ((and (not (get-text-property (point) 'mh-data))
1381 in-button)
1382 (delete-region (1- (point)) (point))
1383 (setq in-button nil))
1384 ((get-text-property (point) 'mh-data)
1385 (delete-region (point)
1386 (save-excursion (forward-line) (point)))
1387 (setq in-button t))
1388 (t (setq can-move-forward (= (forward-line) 0))))))
1389
1390 ;; Return the contents without properties... This gets rid of emphasis
1391 ;; and smileys
1392 (buffer-substring-no-properties (point-min) (point-max))))
1393
1394(defun mh-insert-prefix-string (mh-ins-string)
1395 "Insert prefix string before each line in buffer.
1396The inserted letter is cited using `sc-cite-original' if
1397`mh-yank-from-start-of-msg' is one of 'supercite or 'autosupercite. Otherwise,
1398simply insert MH-INS-STRING before each line."
1399 (goto-char (point-min))
1400 (cond ((or (eq mh-yank-from-start-of-msg 'supercite)
1401 (eq mh-yank-from-start-of-msg 'autosupercite))
1402 (sc-cite-original))
1403 (mail-citation-hook
1404 (run-hooks 'mail-citation-hook))
1405 (mh-yank-hooks ;old hook name
1406 (run-hooks 'mh-yank-hooks))
1407 (t
1408 (or (bolp) (forward-line 1))
1409 (while (< (point) (point-max))
1410 (insert mh-ins-string)
1411 (forward-line 1))
1412 (goto-char (point-min))))) ;leave point like sc-cite-original
1413
1414;;;###mh-autoload
1415(defun mh-fully-kill-draft ()
1416 "Kill the draft message file and the draft message buffer.
1417Use \\[kill-buffer] if you don't want to delete the draft message file."
1418 (interactive)
1419 (if (y-or-n-p "Kill draft message? ")
1420 (let ((config mh-previous-window-config))
1421 (if (file-exists-p buffer-file-name)
1422 (delete-file buffer-file-name))
1423 (set-buffer-modified-p nil)
1424 (kill-buffer (buffer-name))
1425 (message "")
1426 (if config
1427 (set-window-configuration config)))
1428 (error "Message not killed")))
1429
1430(defun mh-current-fill-prefix ()
1431 "Return the `fill-prefix' on the current line as a string."
1432 (save-excursion
1433 (beginning-of-line)
1434 ;; This assumes that the major-mode sets up adaptive-fill-regexp
1435 ;; correctly such as mh-letter-mode or sendmail.el's mail-mode. But
1436 ;; perhaps I should use the variable and simply inserts its value here,
1437 ;; and set it locally in a let scope. --psg
1438 (if (re-search-forward adaptive-fill-regexp nil t)
1439 (match-string 0)
1440 "")))
1441
1442;;;###mh-autoload
1443(defun mh-open-line ()
1444 "Insert a newline and leave point after it.
1445In addition, insert newline and quoting characters before text after point.
1446This is useful in breaking up paragraphs in replies."
1447 (interactive)
1448 (let ((column (current-column))
1449 (prefix (mh-current-fill-prefix)))
1450 (if (> (length prefix) column)
1451 (message "Sorry, point seems to be within the line prefix")
1452 (newline 2)
1453 (insert prefix)
1454 (while (> column (current-column))
1455 (insert " "))
1456 (forward-line -1))))
1457
1458;;;###mh-autoload
1459(defun mh-letter-complete (arg)
1460 "Perform completion on header field or word preceding point.
1461Alias completion is done within the mail header on selected fields and
1462by the function designated by `mh-letter-complete-function' elsewhere,
1463passing the prefix ARG if any."
1464 (interactive "P")
1465 (let ((case-fold-search t))
1466 (if (and (mh-in-header-p)
1467 (save-excursion
1468 (mh-header-field-beginning)
1469 (looking-at "^.*\\(to\\|cc\\|from\\):")))
1470 (mh-alias-letter-expand-alias)
1471 (funcall mh-letter-complete-function arg))))
1472
1473;;; Build the letter-mode keymap:
1474;;; If this changes, modify mh-letter-mode-help-messages accordingly, above.
1475(gnus-define-keys mh-letter-mode-map
1476 "\C-c?" mh-help
1477 "\C-c\C-c" mh-send-letter
1478 "\C-c\C-d" mh-insert-identity
1479 "\C-c\C-e" mh-edit-mhn
1480 "\C-c\C-f\C-b" mh-to-field
1481 "\C-c\C-f\C-c" mh-to-field
1482 "\C-c\C-f\C-d" mh-to-field
1483 "\C-c\C-f\C-f" mh-to-fcc
1484 "\C-c\C-f\C-r" mh-to-field
1485 "\C-c\C-f\C-s" mh-to-field
1486 "\C-c\C-f\C-t" mh-to-field
1487 "\C-c\C-fb" mh-to-field
1488 "\C-c\C-fc" mh-to-field
1489 "\C-c\C-fd" mh-to-field
1490 "\C-c\C-ff" mh-to-fcc
1491 "\C-c\C-fr" mh-to-field
1492 "\C-c\C-fs" mh-to-field
1493 "\C-c\C-ft" mh-to-field
1494 "\C-c\C-i" mh-insert-letter
1495 "\C-c\C-m\C-e" mh-mml-secure-message-encrypt-pgpmime
1496 "\C-c\C-m\C-f" mh-compose-forward
1497 "\C-c\C-m\C-i" mh-compose-insertion
1498 "\C-c\C-m\C-m" mh-mml-to-mime
1499 "\C-c\C-m\C-s" mh-mml-secure-message-sign-pgpmime
1500 "\C-c\C-m\C-u" mh-revert-mhn-edit
1501 "\C-c\C-me" mh-mml-secure-message-encrypt-pgpmime
1502 "\C-c\C-mf" mh-compose-forward
1503 "\C-c\C-mi" mh-compose-insertion
1504 "\C-c\C-mm" mh-mml-to-mime
1505 "\C-c\C-ms" mh-mml-secure-message-sign-pgpmime
1506 "\C-c\C-mu" mh-revert-mhn-edit
1507 "\C-c\C-o" mh-open-line
1508 "\C-c\C-q" mh-fully-kill-draft
1509 "\C-c\C-\\" mh-fully-kill-draft ;if no C-q
1510 "\C-c\C-s" mh-insert-signature
1511 "\C-c\C-^" mh-insert-signature ;if no C-s
1512 "\C-c\C-w" mh-check-whom
1513 "\C-c\C-y" mh-yank-cur-msg
1514 "\M-\t" mh-letter-complete)
1515
1516;; "C-c /" prefix is used in mh-letter-mode by pgp.el and mailcrypt.el.
1517
1518(provide 'mh-comp)
1519
1520;;; Local Variables:
1521;;; indent-tabs-mode: nil
1522;;; sentence-end-double-space: nil
1523;;; End:
1524
1525;;; mh-comp.el ends here
diff --git a/lisp/mail/mh-customize.el b/lisp/mail/mh-customize.el
deleted file mode 100644
index 92b2b60f505..00000000000
--- a/lisp/mail/mh-customize.el
+++ /dev/null
@@ -1,1751 +0,0 @@
1;;; mh-customize.el --- MH-E customization
2
3;; Copyright (C) 2002 Free Software Foundation, Inc.
4
5;; Author: Bill Wohler <wohler@newt.com>
6;; Maintainer: Bill Wohler <wohler@newt.com>
7;; Keywords: mail
8;; See: mh-e.el
9
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
14;; the Free Software Foundation; either version 2, or (at your option)
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 the
24;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
25;; Boston, MA 02111-1307, USA.
26
27;;; Commentary:
28
29;; All of the defgroups, defcustoms, and deffaces in MH-E are found here. This
30;; makes it possible to customize modules that aren't loaded yet. It also
31;; makes it easier to organize the customization groups.
32
33;; This file contains the following sections:
34;;
35;; 1. MH-E Customization Groups
36;;
37;; These are the customization group definitions. These are organized in a
38;; logical order. High-level, windows and toolbar, folder, message,
39;; composing and hooks.
40;;
41;; 2. MH-E Customization
42;;
43;; Here are the actual customization variables. There is a sub-section for
44;; each group in the MH-E Customization Groups section. Within each
45;; section, variables are sorted alphabetically. The manual section
46;; dictates which group a variable should be placed. New variables should
47;; be placed in the section where they would most likely be defined.
48;;
49;; All hooks should be placed in the 'mh-hook group; in addition, add the
50;; group in which the hook is defined in the manual (or, if it is new,
51;; where it would be defined). These two actions insures that the hooks
52;; appear last in each group.
53;;
54;; 3. Faces
55
56;;; Change Log:
57
58;; $Id: mh-customize.el,v 1.18 2003/01/08 00:45:37 wohler Exp $
59
60;;; Code:
61
62;;;###mh-autoload
63(defun mh-customize ()
64 "Customize MH-E variables."
65 (interactive)
66 (customize-group 'mh))
67
68;;; MH-E Customization Groups
69
70(defgroup mh nil
71 "GNU Emacs interface to the MH mail system."
72 :link '(custom-manual "(mh-e)Top")
73 :group 'mail)
74
75(defgroup mh-toolbar nil
76 "Toolbar configuration."
77 :prefix "mh-"
78 :group 'mh)
79
80(defgroup mh-speed nil
81 "Speedbar and folder configuration."
82 :prefix "mh-"
83 :link '(custom-manual "(mh-e)Customizing Moving Mail")
84 :group 'mh)
85
86(defgroup mh-folder nil
87 "Options for controlling scan listing."
88 :prefix "mh-"
89 :link '(custom-manual "(mh-e)Customizing Moving Mail")
90 :group 'mh)
91
92(defgroup mh-show nil
93 "Message display."
94 :prefix "mh-"
95 :link '(custom-manual "(mh-e)Customizing Reading")
96 :group 'mh)
97
98(defgroup mh-letter nil
99 "Composing messages."
100 :prefix "mh-"
101 :link '(custom-manual "(mh-e)Customizing Sending")
102 :group 'mh)
103
104(defgroup mh-alias nil
105 "Alias handling."
106 :link '(custom-manual "(mh-e)Customizing mh-e")
107 :prefix "mh-alias-"
108 :group 'mh)
109
110(defgroup mh-index nil
111 "Indexed searching."
112 :link '(custom-manual "(mh-e)Customizing mh-e")
113 :prefix "mh-"
114 :group 'mh)
115
116(defgroup mh-identity nil
117 "Multiple personalities."
118 :link '(custom-manual "(mh-e)Customizing mh-e")
119 :prefix "mh-"
120 :group 'mh)
121
122(defgroup mh-faces nil
123 "Faces used in MH-E."
124 :link '(custom-manual "(mh-e)Customizing mh-e")
125 :prefix "mh-"
126 :group 'faces
127 :group 'mh)
128
129(defgroup mh-hooks nil
130 "MH-E hooks."
131 :link '(custom-manual "(mh-e)Customizing mh-e")
132 :prefix "mh-"
133 :group 'mh)
134
135;;; Faces
136
137(defgroup mh-speed-faces nil
138 "Faces used in speedbar."
139 :link '(custom-manual "(mh-e)Customizing mh-e")
140 :prefix "mh-"
141 :group 'mh-faces
142 :group 'mh-speed)
143
144(defgroup mh-folder-faces nil
145 "Faces used in scan listing."
146 :link '(custom-manual "(mh-e)Customizing mh-e")
147 :prefix "mh-"
148 :group 'mh-faces
149 :group 'mh-folder)
150
151(defgroup mh-show-faces nil
152 "Faces used in message display."
153 :link '(custom-manual "(mh-e)Customizing mh-e")
154 :prefix "mh-"
155 :group 'mh-faces
156 :group 'mh-show)
157
158(defgroup mh-index-faces nil
159 "Faces used in indexed searches."
160 :link '(custom-manual "(mh-e)Customizing mh-e")
161 :prefix "mh-"
162 :group 'mh-faces
163 :group 'mh-index)
164
165
166
167;;; MH-E Customization (:group mh)
168
169;;; Toolbar configuration (:group 'mh-toolbar)
170
171(defconst mh-tool-bar-item-inc "Incorporate new mail in Inbox")
172(defconst mh-tool-bar-item-save-mime "Save MIME parts")
173(defconst mh-tool-bar-item-prev-msg "Previous message")
174(defconst mh-tool-bar-item-page-msg "Page this message")
175(defconst mh-tool-bar-item-next-msg "Next message")
176(defconst mh-tool-bar-item-delete "Mark for deletion")
177(defconst mh-tool-bar-item-refile "Refile this message")
178(defconst mh-tool-bar-item-undo "Undo this mark")
179(defconst mh-tool-bar-item-perform "Perform moves and deletes")
180(defconst mh-tool-bar-item-toggle-show "Toggle showing message")
181(defconst mh-tool-bar-item-reply-from "Reply to \"from\"")
182(defconst mh-tool-bar-item-reply-to "Reply to \"to\"")
183(defconst mh-tool-bar-item-reply-all "Reply to \"all\"")
184(defconst mh-tool-bar-item-reply "Reply to this message")
185(defconst mh-tool-bar-item-alias "Grab From alias")
186(defconst mh-tool-bar-item-compose "Compose new message")
187(defconst mh-tool-bar-item-rescan "Rescan this folder")
188(defconst mh-tool-bar-item-repack "Repack this folder")
189(defconst mh-tool-bar-item-search "Search")
190(defconst mh-tool-bar-item-visit "Visit other folder")
191(defconst mh-tool-bar-item-prefs "MH-E preferences")
192(defconst mh-tool-bar-item-help "Help")
193(defconst mh-tool-bar-item-widen "Widen from this sequence")
194
195(defconst mh-tool-bar-item-send "Send this letter")
196(defconst mh-tool-bar-item-attach "Insert attachment")
197(defconst mh-tool-bar-item-spell "Check spelling")
198(defconst mh-tool-bar-item-save "Save current buffer to its file")
199(defconst mh-tool-bar-item-undo-op "Undo last operation")
200(defconst mh-tool-bar-item-kill
201 "Cut (kill) text in region between mark and current position")
202(defconst mh-tool-bar-item-copy
203 "Copy text in region between mark and current position")
204(defconst mh-tool-bar-item-paste
205 "Paste (yank) text cut or copied earlier")
206(defconst mh-tool-bar-item-kill-draft "Kill this draft")
207(defconst mh-tool-bar-item-comp-prefs "MH-E composition preferences")
208
209(defcustom mh-tool-bar-reply-3-buttons-flag nil
210 "*Non-nil means use three buttons for reply commands in tool-bar.
211If you have room on your tool-bar because you are using a large font, you
212may set this variable to expand the single reply button into three buttons
213that won't lead to minibuffer prompt about who to reply to."
214 :type 'boolean
215 :group 'mh-toolbar)
216
217(defcustom mh-tool-bar-search-function 'mh-search-folder
218 "*Function called by the tool-bar search button.
219See `mh-search-folder' and `mh-index-search' for details."
220 :type '(choice (const mh-search-folder)
221 (const mh-index-search)
222 (function :tag "Other function"))
223 :group 'mh-toolbar)
224
225(eval-when-compile (defvar tool-bar-map))
226(defvar mh-show-tool-bar-map nil)
227(defun mh-tool-bar-show-set ()
228 "Construct toolbar for `mh-show-mode'."
229 (when (fboundp 'tool-bar-add-item)
230 (setq
231 mh-show-tool-bar-map
232 (let ((tool-bar-map (make-sparse-keymap)))
233 (if (member mh-tool-bar-item-inc mh-tool-bar-folder-buttons)
234 (tool-bar-add-item "mail" 'mh-inc-folder 'mh-showtoolbar-inc-folder
235 :help mh-tool-bar-item-inc))
236 (if (member mh-tool-bar-item-save-mime mh-tool-bar-folder-buttons)
237 (tool-bar-add-item "attach" 'mh-mime-save-parts
238 'mh-showtoolbar-mime-save-parts
239 :help mh-tool-bar-item-save-mime))
240 (if (member mh-tool-bar-item-prev-msg mh-tool-bar-folder-buttons)
241 (tool-bar-add-item "left_arrow" 'mh-show-previous-undeleted-msg
242 'mh-showtoolbar-prev
243 :help mh-tool-bar-item-prev-msg))
244 (if (member mh-tool-bar-item-page-msg mh-tool-bar-folder-buttons)
245 (tool-bar-add-item "page-down" 'mh-show-page-msg 'mh-showtoolbar-page
246 :help mh-tool-bar-item-page-msg))
247 (if (member mh-tool-bar-item-next-msg mh-tool-bar-folder-buttons)
248 (tool-bar-add-item "right_arrow" 'mh-show-next-undeleted-msg
249 'mh-showtoolbar-next
250 :help mh-tool-bar-item-next-msg))
251 (if (member mh-tool-bar-item-delete mh-tool-bar-folder-buttons)
252 (tool-bar-add-item "close" 'mh-show-delete-msg
253 'mh-showtoolbar-delete
254 :help mh-tool-bar-item-delete))
255 (if (member mh-tool-bar-item-refile mh-tool-bar-folder-buttons)
256 (tool-bar-add-item "refile" 'mh-show-refile-msg
257 'mh-showtoolbar-refile
258 :help mh-tool-bar-item-refile))
259 (if (member mh-tool-bar-item-undo mh-tool-bar-folder-buttons)
260 (tool-bar-add-item "undo" 'mh-show-undo 'mh-showtoolbar-undo
261 :help mh-tool-bar-item-undo))
262 (if (member mh-tool-bar-item-perform mh-tool-bar-folder-buttons)
263 (tool-bar-add-item "execute" 'mh-show-execute-commands
264 'mh-showtoolbar-exec
265 :help mh-tool-bar-item-perform))
266 (if (member mh-tool-bar-item-toggle-show mh-tool-bar-folder-buttons)
267 (tool-bar-add-item "show" 'mh-show-toggle-showing
268 'mh-showtoolbar-toggle-show
269 :help mh-tool-bar-item-toggle-show))
270 (if (member mh-tool-bar-item-reply-from mh-tool-bar-folder-buttons)
271 (tool-bar-add-item "reply-from"
272 (lambda (&optional arg)
273 (interactive "P")
274 (set-buffer mh-show-folder-buffer)
275 (mh-reply (mh-get-msg-num nil) "from" arg))
276 'mh-showtoolbar-reply-from
277 :help mh-tool-bar-item-reply-from))
278 (if (member mh-tool-bar-item-reply-to mh-tool-bar-folder-buttons)
279 (tool-bar-add-item "reply-to"
280 (lambda (&optional arg)
281 (interactive "P")
282 (set-buffer mh-show-folder-buffer)
283 (mh-reply (mh-get-msg-num nil) "to" arg))
284 'mh-showtoolbar-reply-to
285 :help mh-tool-bar-item-reply-to))
286 (if (member mh-tool-bar-item-reply-all mh-tool-bar-folder-buttons)
287 (tool-bar-add-item "reply-all"
288 (lambda (&optional arg)
289 (interactive "P")
290 (set-buffer mh-show-folder-buffer)
291 (mh-reply (mh-get-msg-num nil) "all" arg))
292 'mh-showtoolbar-reply-all
293 :help mh-tool-bar-item-reply-all))
294 (if (member mh-tool-bar-item-reply mh-tool-bar-folder-buttons)
295 (tool-bar-add-item "mail/reply2" 'mh-show-reply
296 'mh-showtoolbar-reply
297 :help mh-tool-bar-item-reply))
298 (if (member mh-tool-bar-item-alias mh-tool-bar-folder-buttons)
299 (tool-bar-add-item "alias" 'mh-alias-grab-from-field
300 'mh-showtoolbar-alias
301 :help mh-tool-bar-item-alias
302 :enable '(mh-alias-from-has-no-alias-p)))
303 (if (member mh-tool-bar-item-compose mh-tool-bar-folder-buttons)
304 (tool-bar-add-item "mail_compose" 'mh-send 'mh-showtoolbar-compose
305 :help mh-tool-bar-item-compose))
306 (if (member mh-tool-bar-item-rescan mh-tool-bar-folder-buttons)
307 (tool-bar-add-item "rescan" 'mh-show-rescan-folder
308 'mh-showtoolbar-rescan
309 :help mh-tool-bar-item-rescan))
310 (if (member mh-tool-bar-item-repack mh-tool-bar-folder-buttons)
311 (tool-bar-add-item "repack" 'mh-show-pack-folder
312 'mh-showtoolbar-pack
313 :help mh-tool-bar-item-repack))
314 (if (member mh-tool-bar-item-search mh-tool-bar-folder-buttons)
315 (tool-bar-add-item "search"
316 (lambda (&optional arg)
317 (interactive "P")
318 (call-interactively
319 mh-tool-bar-search-function))
320 'mh-showtoolbar-search
321 :help mh-tool-bar-item-search))
322 (if (member mh-tool-bar-item-visit mh-tool-bar-folder-buttons)
323 (tool-bar-add-item "fld_open" 'mh-visit-folder
324 'mh-showtoolbar-visit
325 :help mh-tool-bar-item-visit))
326 (if (member mh-tool-bar-item-prefs mh-tool-bar-folder-buttons)
327 (tool-bar-add-item "preferences" (lambda ()
328 (interactive)
329 (customize-group "mh"))
330 'mh-showtoolbar-customize
331 :help mh-tool-bar-item-prefs))
332 (if (member mh-tool-bar-item-help mh-tool-bar-folder-buttons)
333 (tool-bar-add-item "help" (lambda ()
334 (interactive)
335 (Info-goto-node "(mh-e)Top"))
336 'mh-showtoolbar-help
337 :help mh-tool-bar-item-help))
338 tool-bar-map))))
339
340(defvar mh-letter-tool-bar-map nil)
341;;;###mh-autoload
342(defun mh-tool-bar-letter-set ()
343 "Construct toolbar for `mh-letter-mode'."
344 (when (fboundp 'tool-bar-add-item)
345 (setq
346 mh-letter-tool-bar-map
347 (let ((tool-bar-map (make-sparse-keymap)))
348 (if (member mh-tool-bar-item-send mh-tool-bar-letter-buttons)
349 (tool-bar-add-item "mail_send" 'mh-send-letter
350 'mh-lettertoolbar-send
351 :help mh-tool-bar-item-send))
352 (if (member mh-tool-bar-item-attach mh-tool-bar-letter-buttons)
353 (tool-bar-add-item "attach" 'mh-compose-insertion
354 'mh-lettertoolbar-compose
355 :help mh-tool-bar-item-attach))
356 (if (member mh-tool-bar-item-spell mh-tool-bar-letter-buttons)
357 (tool-bar-add-item "spell" 'ispell-message 'mh-lettertoolbar-ispell
358 :help mh-tool-bar-item-spell))
359 (if (member mh-tool-bar-item-save mh-tool-bar-letter-buttons)
360 (tool-bar-add-item-from-menu 'save-buffer "save"))
361 (if (member mh-tool-bar-item-undo-op mh-tool-bar-letter-buttons)
362 (tool-bar-add-item-from-menu 'undo "undo"))
363 (if (member mh-tool-bar-item-kill mh-tool-bar-letter-buttons)
364 (tool-bar-add-item-from-menu 'kill-region "cut"))
365 (if (member mh-tool-bar-item-copy mh-tool-bar-letter-buttons)
366 (tool-bar-add-item-from-menu 'menu-bar-kill-ring-save "copy"))
367 (if (member mh-tool-bar-item-paste mh-tool-bar-letter-buttons)
368 (tool-bar-add-item-from-menu 'yank "paste"))
369 (if (member mh-tool-bar-item-kill-draft mh-tool-bar-letter-buttons)
370 (tool-bar-add-item "close" 'mh-fully-kill-draft
371 'mh-lettertoolbar-kill
372 :help mh-tool-bar-item-kill-draft))
373 (if (member mh-tool-bar-item-comp-prefs mh-tool-bar-letter-buttons)
374 (tool-bar-add-item "preferences" (lambda ()
375 (interactive)
376 (customize-group "mh-compose"))
377 'mh-lettertoolbar-customize
378 :help mh-tool-bar-item-comp-prefs))
379 (if (member mh-tool-bar-item-help mh-tool-bar-letter-buttons)
380 (tool-bar-add-item "help" (lambda ()
381 (interactive)
382 (Info-goto-node "(mh-e)Draft Editing"))
383 'mh-lettertoolbar-help
384 :help mh-tool-bar-item-help))
385 tool-bar-map))))
386
387(defvar mh-folder-tool-bar-map nil)
388(defvar mh-folder-seq-tool-bar-map nil
389 "Tool-bar to use when narrowed to a sequence in MH-Folder buffers.")
390;;;###mh-autoload
391(defun mh-tool-bar-folder-set ()
392 "Construct toolbar for `mh-folder-mode'."
393 (when (fboundp 'tool-bar-add-item)
394 (setq
395 mh-folder-tool-bar-map
396 (let ((tool-bar-map (make-sparse-keymap)))
397 (if (member mh-tool-bar-item-inc mh-tool-bar-folder-buttons)
398 (tool-bar-add-item "mail" 'mh-inc-folder
399 'mh-foldertoolbar-inc-folder
400 :help mh-tool-bar-item-inc))
401 (if (member mh-tool-bar-item-save-mime mh-tool-bar-folder-buttons)
402 (tool-bar-add-item "attach" 'mh-mime-save-parts
403 'mh-foldertoolbar-mime-save-parts
404 :help mh-tool-bar-item-save-mime))
405 (if (member mh-tool-bar-item-prev-msg mh-tool-bar-folder-buttons)
406 (tool-bar-add-item "left_arrow" 'mh-previous-undeleted-msg
407 'mh-foldertoolbar-prev
408 :help mh-tool-bar-item-prev-msg))
409 (if (member mh-tool-bar-item-page-msg mh-tool-bar-folder-buttons)
410 (tool-bar-add-item "page-down" 'mh-page-msg 'mh-foldertoolbar-page
411 :help mh-tool-bar-item-page-msg))
412 (if (member mh-tool-bar-item-next-msg mh-tool-bar-folder-buttons)
413 (tool-bar-add-item "right_arrow" 'mh-next-undeleted-msg
414 'mh-foldertoolbar-next
415 :help mh-tool-bar-item-next-msg))
416 (if (member mh-tool-bar-item-delete mh-tool-bar-folder-buttons)
417 (tool-bar-add-item "close" 'mh-delete-msg 'mh-foldertoolbar-delete
418 :help mh-tool-bar-item-delete))
419 (if (member mh-tool-bar-item-refile mh-tool-bar-folder-buttons)
420 (tool-bar-add-item "refile" 'mh-refile-msg 'mh-foldertoolbar-refile
421 :help mh-tool-bar-item-refile))
422 (if (member mh-tool-bar-item-undo mh-tool-bar-folder-buttons)
423 (tool-bar-add-item "undo" 'mh-undo 'mh-foldertoolbar-undo
424 :help mh-tool-bar-item-undo))
425 (if (member mh-tool-bar-item-perform mh-tool-bar-folder-buttons)
426 (tool-bar-add-item "execute" 'mh-execute-commands
427 'mh-foldertoolbar-exec
428 :help mh-tool-bar-item-perform))
429 (if (member mh-tool-bar-item-toggle-show mh-tool-bar-folder-buttons)
430 (tool-bar-add-item "show" 'mh-toggle-showing
431 'mh-foldertoolbar-toggle-show
432 :help mh-tool-bar-item-toggle-show))
433 (if (member mh-tool-bar-item-reply-from mh-tool-bar-folder-buttons)
434 (tool-bar-add-item "reply-from"
435 (lambda (&optional arg)
436 (interactive "P")
437 (mh-reply (mh-get-msg-num nil) "from" arg))
438 'mh-foldertoolbar-reply-from
439 :help mh-tool-bar-item-reply-from))
440 (if (member mh-tool-bar-item-reply-to mh-tool-bar-folder-buttons)
441 (tool-bar-add-item "reply-to"
442 (lambda (&optional arg)
443 (interactive "P")
444 (mh-reply (mh-get-msg-num nil) "to" arg))
445 'mh-foldertoolbar-reply-to
446 :help mh-tool-bar-item-reply-to))
447 (if (member mh-tool-bar-item-reply-all mh-tool-bar-folder-buttons)
448 (tool-bar-add-item "reply-all"
449 (lambda (&optional arg)
450 (interactive "P")
451 (mh-reply (mh-get-msg-num nil) "all" arg))
452 'mh-foldertoolbar-reply-all
453 :help mh-tool-bar-item-reply-all))
454 (if (member mh-tool-bar-item-reply mh-tool-bar-folder-buttons)
455 (tool-bar-add-item "mail/reply2" 'mh-reply
456 'mh-foldertoolbar-reply
457 :help mh-tool-bar-item-reply))
458 (if (member mh-tool-bar-item-alias mh-tool-bar-folder-buttons)
459 (tool-bar-add-item "alias" 'mh-alias-grab-from-field
460 'mh-foldertoolbar-alias
461 :help mh-tool-bar-item-alias
462 :enable '(mh-alias-from-has-no-alias-p)))
463 (if (member mh-tool-bar-item-compose mh-tool-bar-folder-buttons)
464 (tool-bar-add-item "mail_compose" 'mh-send 'mh-foldertoolbar-compose
465 :help mh-tool-bar-item-compose))
466 (if (member mh-tool-bar-item-rescan mh-tool-bar-folder-buttons)
467 (tool-bar-add-item "rescan" 'mh-rescan-folder
468 'mh-foldertoolbar-rescan
469 :help mh-tool-bar-item-rescan))
470 (if (member mh-tool-bar-item-repack mh-tool-bar-folder-buttons)
471 (tool-bar-add-item "repack" 'mh-pack-folder 'mh-foldertoolbar-pack
472 :help mh-tool-bar-item-repack))
473 (if (member mh-tool-bar-item-search mh-tool-bar-folder-buttons)
474 (tool-bar-add-item "search"
475 (lambda (&optional arg)
476 (interactive "P")
477 (call-interactively
478 mh-tool-bar-search-function))
479 'mh-foldertoolbar-search
480 :help mh-tool-bar-item-search))
481 (if (member mh-tool-bar-item-visit mh-tool-bar-folder-buttons)
482 (tool-bar-add-item "fld_open" 'mh-visit-folder
483 'mh-foldertoolbar-visit
484 :help mh-tool-bar-item-visit))
485 (if (member mh-tool-bar-item-prefs mh-tool-bar-folder-buttons)
486 (tool-bar-add-item "preferences" (lambda ()
487 (interactive)
488 (customize-group "mh"))
489 'mh-foldertoolbar-customize
490 :help mh-tool-bar-item-prefs))
491 (if (member mh-tool-bar-item-help mh-tool-bar-folder-buttons)
492 (tool-bar-add-item "help" (lambda ()
493 (interactive)
494 (Info-goto-node "(mh-e)Top"))
495 'mh-foldertoolbar-help
496 :help mh-tool-bar-item-help))
497 tool-bar-map))
498
499 (setq mh-folder-seq-tool-bar-map
500 (let ((tool-bar-map (copy-keymap mh-folder-tool-bar-map)))
501 (if (member mh-tool-bar-item-widen mh-tool-bar-folder-buttons)
502 (tool-bar-add-item "widen" 'mh-widen 'mh-foldertoolbar-widen
503 :help mh-tool-bar-item-widen))
504 tool-bar-map))))
505
506(defun mh-tool-bar-folder-buttons-set (symbol value)
507 "Update the `mh-tool-bar-folder-buttons' variable, and rebuild the tool-bar.
508Sets the default for SYMBOL (e.g. `mh-tool-bar-folder-buttons') to VALUE (as
509set in customization). This is called after 'customize is used to alter
510`mh-tool-bar-folder-buttons'."
511 (set-default symbol value)
512 (mh-tool-bar-show-set)
513 (mh-tool-bar-folder-set))
514
515(custom-declare-variable
516 'mh-tool-bar-folder-buttons
517 '(append
518 (list mh-tool-bar-item-inc
519 mh-tool-bar-item-save-mime
520 mh-tool-bar-item-prev-msg
521 mh-tool-bar-item-page-msg
522 mh-tool-bar-item-next-msg
523 mh-tool-bar-item-delete
524 mh-tool-bar-item-refile
525 mh-tool-bar-item-undo
526 mh-tool-bar-item-perform
527;;; mh-tool-bar-item-toggle-show
528 )
529 (if mh-tool-bar-reply-3-buttons-flag
530 (list mh-tool-bar-item-reply-from
531 mh-tool-bar-item-reply-to
532 mh-tool-bar-item-reply-all)
533 (list mh-tool-bar-item-reply))
534 (list mh-tool-bar-item-alias
535 mh-tool-bar-item-compose
536 mh-tool-bar-item-rescan
537;;; mh-tool-bar-item-repack
538 mh-tool-bar-item-search
539 mh-tool-bar-item-visit
540 mh-tool-bar-item-prefs
541 mh-tool-bar-item-help
542 mh-tool-bar-item-widen))
543 "Buttons to include in MH-E folder/show toolbar."
544 :group 'mh-toolbar
545 :set 'mh-tool-bar-folder-buttons-set
546 :type `(set (const ,mh-tool-bar-item-inc)
547 (const ,mh-tool-bar-item-save-mime)
548 (const ,mh-tool-bar-item-prev-msg)
549 (const ,mh-tool-bar-item-page-msg)
550 (const ,mh-tool-bar-item-next-msg)
551 (const ,mh-tool-bar-item-delete)
552 (const ,mh-tool-bar-item-refile)
553 (const ,mh-tool-bar-item-undo)
554 (const ,mh-tool-bar-item-perform)
555 (const ,mh-tool-bar-item-toggle-show)
556 (const ,mh-tool-bar-item-reply-from)
557 (const ,mh-tool-bar-item-reply-to)
558 (const ,mh-tool-bar-item-reply-all)
559 (const ,mh-tool-bar-item-reply)
560 (const ,mh-tool-bar-item-alias)
561 (const ,mh-tool-bar-item-compose)
562 (const ,mh-tool-bar-item-rescan)
563 (const ,mh-tool-bar-item-repack)
564 (const ,mh-tool-bar-item-search)
565 (const ,mh-tool-bar-item-visit)
566 (const ,mh-tool-bar-item-prefs)
567 (const ,mh-tool-bar-item-help)
568 (const ,mh-tool-bar-item-widen)))
569
570(defun mh-tool-bar-letter-buttons-set (symbol value)
571 "Update the `mh-tool-bar-letter-buttons' variable, and rebuild the tool-bar.
572Sets the default for SYMBOL (e.g. `mh-tool-bar-letter-buttons') to VALUE (as
573set in customization). This is called after 'customize is used to alter
574`mh-tool-bar-letter-buttons'."
575 (set-default symbol value)
576 (mh-tool-bar-letter-set))
577
578(custom-declare-variable
579 'mh-tool-bar-letter-buttons
580 '(list mh-tool-bar-item-send
581 mh-tool-bar-item-attach
582 mh-tool-bar-item-spell
583 mh-tool-bar-item-save
584 mh-tool-bar-item-undo-op
585 mh-tool-bar-item-kill
586 mh-tool-bar-item-copy
587 mh-tool-bar-item-paste
588 mh-tool-bar-item-kill-draft
589 mh-tool-bar-item-comp-prefs
590 mh-tool-bar-item-help)
591 "Buttons to include in MH-E letter toolbar."
592 :group 'mh-toolbar
593 :set 'mh-tool-bar-letter-buttons-set
594 :type `(set (const ,mh-tool-bar-item-send)
595 (const ,mh-tool-bar-item-attach)
596 (const ,mh-tool-bar-item-spell)
597 (const ,mh-tool-bar-item-save)
598 (const ,mh-tool-bar-item-undo-op)
599 (const ,mh-tool-bar-item-kill)
600 (const ,mh-tool-bar-item-copy)
601 (const ,mh-tool-bar-item-paste)
602 (const ,mh-tool-bar-item-kill-draft)
603 (const ,mh-tool-bar-item-comp-prefs)
604 (const ,mh-tool-bar-item-help)))
605
606
607
608;;; Speedbar and folder configuration (:group 'mh-speed)
609
610(defcustom mh-large-folder 200
611 "The number of messages that indicates a large folder.
612If a folder is deemed to be large, that is the number of messages in it exceed
613this value, then confirmation is needed when it is visited. Even when
614`mh-show-threads-flag' is non-nil, the folder is not automatically threaded, if
615it is large. If set to nil all folders are treated as if they are small."
616 :type '(choice (const :tag "No limit") integer)
617 :group 'mh-speed)
618
619(defcustom mh-speed-flists-interval 60
620 "Time between calls to flists in seconds.
621If 0, flists is not called repeatedly."
622 :type 'integer
623 :group 'mh-speed)
624
625(defcustom mh-speed-run-flists-flag t
626 "Non-nil means flists is used.
627If non-nil, flists is executed every `mh-speed-flists-interval' seconds to
628update the display of the number of unseen and total messages in each folder.
629If resources are limited, this can be set to nil and the speedbar display can
630be updated manually with the \\[mh-speed-flists] command."
631 :type 'boolean
632 :group 'mh-speed)
633
634;;; Options for controlling scan listing (:group 'mh-folder)
635
636(defcustom mh-adaptive-cmd-note-flag t
637 "*Non-nil means that the message number width is determined dynamically.
638This is done once when a folder is first opened by running scan on the last
639message of the folder. The message number for the last message is extracted
640and its width calculated. This width is used when calling `mh-set-cmd-note'.
641
642If you prefer fixed-width message numbers, set this variable to nil and call
643`mh-set-cmd-note' with the width specified by the scan format in
644`mh-scan-format-file'. For example, the default width is 4, so you would use
645\"(mh-set-cmd-note 4)\" if `mh-scan-format-file' were nil."
646 :type 'boolean
647 :group 'mh-folder)
648
649(defcustom mh-auto-folder-collect-flag t
650 "*Non-nil means to collect all folder names at startup in the background.
651Otherwise, the internal list of folder names is built as folders are
652referenced."
653 :type 'boolean
654 :group 'mh-folder)
655
656(defcustom mh-inc-prog "inc"
657 "*Program to run to incorporate new mail into a folder.
658Normally \"inc\". This file is searched for relative to
659the `mh-progs' directory unless it is an absolute pathname."
660 :type 'string
661 :group 'mh-folder)
662
663(defcustom mh-lpr-command-format "lpr -J '%s'"
664 "*Format for Unix command that prints a message.
665The string should be a Unix command line, with the string '%s' where
666the job's name (folder and message number) should appear. The formatted
667message text is piped to this command when you type \\<mh-folder-mode-map>`\\[mh-print-msg]'."
668 :type 'string
669 :group 'mh-folder)
670
671(defcustom mh-mime-save-parts-default-directory t
672 "Default directory to use for `mh-mime-save-parts'.
673If nil, prompt and set for next time the command is used during same session.
674If t, prompt always"
675 :type '(choice (const :tag "Prompt the first time" nil)
676 (const :tag "Prompt always" t)
677 directory)
678 :group 'mh-folder)
679
680(defcustom mh-recenter-summary-flag nil
681 "*Non-nil means to recenter the summary window.
682Recenter the summary window when the show window is toggled off if non-nil."
683 :type 'boolean
684 :group 'mh-folder)
685
686(defcustom mh-print-background-flag nil
687 "*Non-nil means messages should be printed in the background.
688WARNING: do not delete the messages until printing is finished;
689otherwise, your output may be truncated."
690 :type 'boolean
691 :group 'mh-folder)
692
693(defcustom mh-recursive-folders-flag nil
694 "*Non-nil means that commands which operate on folders do so recursively."
695 :type 'boolean
696 :group 'mh-folder)
697
698(defcustom mh-scan-format-file t
699 "Specifies the format file to pass to the scan program.
700If t, the format string will be taken from the either `mh-scan-format-mh'
701or `mh-scan-format-nmh' depending on whether MH or nmh is in use.
702If nil, the default scan output will be used.
703
704If you customize the scan format, you may need to modify a few variables
705containing regexps that MH-E uses to identify specific portions of the output.
706Use `M-x apropos RET mh-scan.*regexp' to obtain a list of these variables. You
707may also have to call `mh-set-cmd-note' with the width of your message
708numbers. See also `mh-adaptive-cmd-note-flag'."
709 :type '(choice (const :tag "Use MH-E scan format" t)
710 (const :tag "Use default scan format" nil)
711 (file :tag "Specify a scan format file"))
712 :group 'mh-folder)
713
714(defcustom mh-scan-prog "scan"
715 "*Program to run to generate one-line-per-message listing of a folder.
716Normally \"scan\" or a file name linked to scan. This file is searched
717for relative to the `mh-progs' directory unless it is an absolute pathname."
718 :type 'string
719 :group 'mh-folder)
720(make-variable-buffer-local 'mh-scan-prog)
721
722(defcustom mh-show-threads-flag nil
723 "Non-nil means new folders start in threaded mode.
724Threading large number of messages can be time consuming. So if the flag is
725non-nil then threading will be done only if the number of messages being
726threaded is less than `mh-large-folder'."
727 :type 'boolean
728 :group 'mh-folder)
729
730(defcustom mh-store-default-directory nil
731 "*Last directory used by \\[mh-store-msg]; default for next store.
732A directory name string, or nil to use current directory."
733 :type '(choice (const :tag "Current" nil)
734 directory)
735 :group 'mh-folder)
736
737(defcustom mh-update-sequences-after-mh-show-flag t
738 "*Non-nil means `mh-update-sequence' is called from `mh-show-mode'.
739If set, `mh-update-sequence' is run every time a message is shown, telling
740MH or nmh that this is your current message. It's useful, for example, to
741display MIME content using \"M-! mhshow RET\""
742 :type 'boolean
743 :group 'mh-folder)
744
745;;; Message display (:group 'mh-show)
746
747(defcustom mh-bury-show-buffer-flag t
748 "*Non-nil means that the displayed show buffer for a folder is buried."
749 :type 'boolean
750 :group 'mh-show)
751
752(defcustom mh-clean-message-header-flag t
753 "*Non-nil means clean headers of messages that are displayed or inserted.
754The variables `mh-invisible-headers' and `mh-visible-headers' control
755what is removed."
756 :type 'boolean
757 :group 'mh-show)
758
759(defcustom mh-decode-mime-flag (not (not (locate-library "mm-decode")))
760 "*Non-nil means that Gnus is used to show MIME attachments with Gnus."
761 :type 'boolean
762 :group 'mh-show)
763
764(defcustom mh-decode-quoted-printable-flag
765 (not (null (and (fboundp 'executable-find)(executable-find "mimedecode"))))
766 "Non-nil means decode quoted-printable MIME part with `mimedecode'.
767
768Quoted-printable message parts are translated to 8-bit characters by the
769`mimedecode' command. However, unless there is only one quoted-printable body
770part, Gnus will have already decoded the quoted-printable parts.
771
772This variable is initialized t if `mimedecode' is available.
773
774The source code for `mimedecode' can be obtained from
775http://www.freesoft.org/CIE/FAQ/mimedeco.c."
776 :type 'boolean
777 :group 'mh-show)
778
779(defcustom mh-display-buttons-for-inline-parts-flag nil
780 "*Non-nil means display buttons for all inline MIME parts.
781If non-nil, buttons are displayed for all MIME parts. Inline parts start off
782in displayed state but they can be hidden by clicking the button. If nil no
783buttons are shown for inline parts."
784 :type 'boolean
785 :group 'mh-show)
786
787(defcustom mh-do-not-confirm-flag nil
788 "*Non-nil means do not prompt for confirmation.
789Commands such as `mh-pack-folder' prompt to confirm whether to process
790outstanding moves and deletes or not before continuing. A non-nil setting will
791perform the action--which is usually desired but cannot be retracted--without
792question."
793 :type 'boolean
794 :group 'mh-show)
795
796(defcustom mh-graphical-smileys-flag t
797 "*Non-nil means graphical smileys are displayed.
798Non-nil means that small graphics will be used in the show buffer instead of
799patterns like :-), ;-) etc. The setting only has effect if
800`mh-decode-mime-flag' is non-nil."
801 :type 'boolean
802 :group 'mh-show)
803
804(defcustom mh-graphical-emphasis-flag t
805 "*Non-nil means graphical emphasis is displayed.
806Non-nil means that _underline_ will be underlined, *bold* will appear in bold,
807/italic/ will appear in italic etc. See `gnus-emphasis-alist' for the whole
808list. The setting only has effect if `mh-decode-mime-flag' is non-nil."
809 :type 'boolean
810 :group 'mh-show)
811
812(defcustom mh-highlight-citation-p 'gnus
813 "How to highlight citations in show buffers.
814The gnus method uses a different color for each indentation."
815 :type '(choice (const :tag "Use gnus" gnus)
816 (const :tag "Use font-lock" font-lock)
817 (const :tag "Don't fontify" nil))
818 :group 'mh-show)
819
820(defcustom mh-max-inline-image-height nil
821 "*Maximum inline image height if Content-Disposition is not present.
822If nil, image will be displayed if its height is smaller than the height of
823the window."
824 :type '(choice (const nil) integer)
825 :group 'mh-show)
826
827(defcustom mh-max-inline-image-width nil
828 "*Maximum inline image width if Content-Disposition is not present.
829If nil, image will be displayed if its width is smaller than the width of the
830window."
831 :type '(choice (const nil) integer)
832 :group 'mh-show)
833
834(defcustom mh-show-maximum-size 0
835 "*Maximum size of message (in bytes) to display automatically.
836Provides an opportunity to skip over large messages which may be slow to load.
837Use a value of 0 to display all messages automatically regardless of size."
838 :type 'integer
839 :group 'mh-show)
840
841;; Use goto-addr if it was already loaded (which probably sets this
842;; variable to t), or if this variable is otherwise set to t.
843(defcustom mh-show-use-goto-addr-flag (and (boundp 'goto-address-highlight-p)
844 goto-address-highlight-p)
845 "*Non-nil means highlight URLs and email addresses.
846The `goto-addr' module is used."
847 :type 'boolean
848 :group 'mh-show)
849
850(defcustom mh-show-use-xface-flag
851 (and window-system
852 (not (null (cond
853 (mh-xemacs-flag
854 (locate-library "x-face"))
855 ((>= emacs-major-version 21)
856 (locate-library "x-face-e21"))
857 (t ;Emacs20
858 nil))))
859 (not (null (and (fboundp 'executable-find)
860 (executable-find
861 "uncompface")))))
862 "*Non-nil means display faces in `mh-show-mode' with external x-face package.
863It is available from ftp://ftp.jpl.org/pub/elisp/. Download it and put its
864files in the Emacs `load-path' and MH-E will invoke it automatically for you if
865this variable is non-nil.
866
867The `uncompface' binary is also required to be in the execute PATH. It can
868be obtained from: ftp://ftp.cs.indiana.edu/pub/faces/compface/compface.tar.Z"
869 :type 'boolean
870 :group 'mh-show)
871
872(defcustom mh-summary-height (or (and (fboundp 'frame-height)
873 (> (frame-height) 24)
874 (min 10 (/ (frame-height) 6)))
875 4)
876 "*Number of lines in MH-Folder window (including the mode line)."
877 :type 'integer
878 :group 'mh-show)
879
880(defcustom mh-visible-headers nil
881 "*Contains a regexp specifying the headers to keep when cleaning.
882Only used if `mh-clean-message-header-flag' is non-nil. Setting it overrides
883the variable `mh-invisible-headers'."
884 :type '(choice (const nil) regexp)
885 :group 'mh-show)
886
887(defcustom mhl-formfile nil
888 "*Name of format file to be used by mhl to show and print messages.
889A value of t means use the default format file.
890nil means don't use mhl to format messages when showing; mhl is still used,
891with the default format file, to format messages when printing them.
892The format used should specify a non-zero value for overflowoffset so
893the message continues to conform to RFC 822 and MH-E can parse the headers."
894 :type '(choice (const nil) (const t) string)
895 :group 'mh-show)
896(put 'mhl-formfile 'info-file "mh-e")
897
898(defvar mh-invisible-headers nil
899 "*Regexp matching lines in a message header that are not to be shown.
900If `mh-visible-headers' is non-nil, it is used instead to specify what
901to keep.")
902
903(defun mh-invisible-headers ()
904 "Make or remake the variable `mh-invisible-headers'.
905Done using `mh-invisible-header-fields' as input."
906 (setq mh-invisible-headers
907 (concat
908 "^"
909 (let ((max-specpdl-size 1000)) ;workaround for insufficient default
910 (regexp-opt
911 (append
912 (if (not mh-show-use-xface-flag)
913 '("X-Face: "))
914 mh-invisible-header-fields))))))
915
916(defun mh-invisible-header-fields-set (symbol value)
917 "Update `mh-invisible-header-fields'.
918The function is called with SYMBOL bound to `mh-invisible-header-fields' and
919VALUE is the the list of headers that are invisible. As a side effect, the
920variable `mh-invisible-fields' is set."
921 (set-default symbol value)
922 (mh-invisible-headers))
923
924;; Keep fields alphabetized. Mention source, if known.
925(defcustom mh-invisible-header-fields
926 '("Autoforwarded: "
927 "Bestservhost: "
928 "Content-" ; RFC 2045
929 "Delivered-To: " ; Egroups/yahoogroups mailing list manager
930 "Delivery-Date: " ; MH
931 "Delivery: "
932 "Encoding: "
933 "Errors-To: "
934 "Forwarded: " ; MH
935 "From " ; sendmail
936 "Importance: " ; MS Outlook
937 "In-Reply-To: " ; MH
938 "Lines: "
939 "List-" ; Mailman mailing list manager
940 "List-" ; Unknown mailing list managers
941 "List-Subscribe: " ; Unknown mailing list managers
942 "List-Unsubscribe: " ; Unknown mailing list managers
943 "Mail-from: " ; MH
944 "Mailing-List: " ; Egroups/yahoogroups mailing list manager
945 "Message-Id: " ; RFC 822
946 "Mime-Version" ; RFC 2045
947 "NNTP-" ; News
948 "Old-Return-Path: "
949 "Original-Encoded-Information-Types: " ; X400
950 "P1-Content-Type: " ; X400
951 "P1-Message-Id: " ; X400
952 "P1-Recipient: " ; X400
953 "Path: "
954 "Precedence: "
955 "Prev-Resent" ; MH
956 "Priority: "
957 "Received: " ; RFC 822
958 "References: "
959 "Remailed-" ; MH
960 "Replied: " ; MH
961 "Resent" ; MH
962 "Return-Path: " ; RFC 822
963 "Sensitivity: " ; MS Outlook
964 "Status: " ; sendmail
965 "Ua-Content-Id: " ; X400
966 "User-Agent: "
967 "Via: " ; MH
968 "X-Abuse-Info: "
969 "X-Accept-Language: "
970 "X-Accept-Language: " ; Netscape/Mozilla
971 "X-Ack: "
972 "X-Apparently-From: " ; MS Outlook
973 "X-Apparently-To: " ; Egroups/yahoogroups mailing list manager
974 "X-Authentication-Warning: " ; sendmail
975 "X-Beenthere: " ; Mailman mailing list manager
976 "X-Complaints-To: "
977 "X-Cron-Env: "
978 "X-Delivered"
979 "X-Envelope-Sender: "
980 "X-Envelope-To: "
981 "X-Folder: " ; Spam
982 "X-From-Line"
983 "X-Gnus-Mail-Source: " ; gnus
984 "X-Habeas-SWE-1: " ; Spam
985 "X-Habeas-SWE-2: " ; Spam
986 "X-Habeas-SWE-3: " ; Spam
987 "X-Habeas-SWE-4: " ; Spam
988 "X-Habeas-SWE-5: " ; Spam
989 "X-Habeas-SWE-6: " ; Spam
990 "X-Habeas-SWE-7: " ; Spam
991 "X-Habeas-SWE-8: " ; Spam
992 "X-Habeas-SWE-9: " ; Spam
993 "X-Info: " ; NTMail
994 "X-Juno-" ; Juno
995 "X-List-Host: " ; Unknown mailing list managers
996 "X-List-Subscribe: " ; Unknown mailing list managers
997 "X-List-Unsubscribe: " ; Unknown mailing list managers
998 "X-Listserver: " ; Unknown mailing list managers
999 "X-Loop: " ; Unknown mailing list managers
1000 "X-MIME-Autoconverted: " ; sendmail
1001 "X-MIMETrack: "
1002 "X-MS-TNEF-Correlator: " ; MS Outlook
1003 "X-Mailing-List: " ; Unknown mailing list managers
1004 "X-Mailman-Version: " ; Mailman mailing list manager
1005 "X-Message-Id"
1006 "X-MimeOLE: " ; MS Outlook
1007 "X-Mozilla-Status: " ; Netscape/Mozilla
1008 "X-Msmail-" ; MS Outlook
1009 "X-News: " ; News
1010 "X-No-Archive: "
1011 "X-Orcl-Content-Type: "
1012 "X-Original-Complaints-To: "
1013 "X-Original-Date: " ; SourceForge mailing list manager
1014 "X-Original-Trace: "
1015 "X-OriginalArrivalTime: " ; Hotmail
1016 "X-Originating-IP: " ; Hotmail
1017 "X-Priority: " ; MS Outlook
1018 "X-Qotd-" ; User added
1019 "X-Received-Date: "
1020 "X-Received: "
1021 "X-Request-"
1022 "X-SBClass: " ; Spam
1023 "X-SBNote: " ; Spam
1024 "X-SBPass: " ; Spam
1025 "X-SBRule: " ; Spam
1026 "X-Scanned-By"
1027 "X-Sender: "
1028 "X-Server-Date: "
1029 "X-Server-Uuid: "
1030 "X-Sieve: " ; Sieve filtering
1031 "X-Spam-Level: " ; Spam
1032 "X-Spam-Score: " ; Spam
1033 "X-Spam-Status: " ; Spam
1034 "X-SpamBouncer: " ; Spam
1035 "X-Trace: "
1036 "X-UIDL: "
1037 "X-UserInfo1: "
1038 "X-VSMLoop: " ; NTMail
1039 "X-Vms-To: "
1040 "X-Wss-Id: " ; Worldtalk gateways
1041 "X-eGroups-" ; Egroups/yahoogroups mailing list manager
1042 "X-pgp: "
1043 "X-submission-address: "
1044 "X400-" ; X400
1045 "Xref: ")
1046"*List of header fields that are not to be shown.
1047Regexps are not allowed. Unique fields should have a \": \" suffix;
1048otherwise, the element can be used to render an entire class of fields
1049that start with the same prefix invisible.
1050This variable is ignored if `mh-visible-headers' is set."
1051 :type '(repeat (string :tag "Header field"))
1052 :set 'mh-invisible-header-fields-set
1053 :group 'mh-show)
1054
1055;;; Composing messages (:group 'mh-letter)
1056
1057(defcustom mh-compose-insertion (if (locate-library "mml") 'gnus 'mhn)
1058 "Use either 'gnus or 'mhn to insert MIME message directives in messages."
1059 :type '(choice (const :tag "Use gnus" gnus)
1060 (const :tag "Use mhn" mhn))
1061 :group 'mh-letter)
1062
1063(defcustom mh-compose-letter-function nil
1064 "Invoked when setting up a letter draft.
1065It is passed three arguments: TO recipients, SUBJECT, and CC recipients."
1066 :type '(choice (const nil) function)
1067 :group 'mh-letter)
1068
1069(defcustom mh-delete-yanked-msg-window-flag nil
1070 "*Non-nil means delete any window displaying the message.
1071Controls window display when a message is yanked by \\<mh-letter-mode-map>\\[mh-yank-cur-msg].
1072If non-nil, yanking the current message into a draft letter deletes any
1073windows displaying the message."
1074 :type 'boolean
1075 :group 'mh-letter)
1076
1077(defcustom mh-extract-from-attribution-verb "wrote:"
1078 "*Verb to use for attribution when a message is yanked by \\<mh-letter-mode-map>\\[mh-yank-cur-msg]."
1079 :type '(choice (const "wrote:")
1080 (const "a écrit :")
1081 (string :tag "Custom string"))
1082 :group 'mh-letter)
1083
1084(defcustom mh-forward-subject-format "%s: %s"
1085 "*Format to generate the Subject: line contents for a forwarded message.
1086The two string arguments to the format are the sender of the original
1087message and the original subject line."
1088 :type 'string
1089 :group 'mh-letter)
1090
1091(defcustom mh-ins-buf-prefix "> "
1092 "*String to put before each non-blank line of a yanked or inserted message.
1093\\<mh-letter-mode-map>Used when the message is inserted into an outgoing letter
1094by \\[mh-insert-letter] or \\[mh-yank-cur-msg]."
1095 :type 'string
1096 :group 'mh-letter)
1097
1098(defcustom mh-insert-mail-followup-to-flag t
1099 "Non-nil means maybe append a Mail-Followup-To field to the header.
1100The insertion is done if the To: or Cc: fields matches an entry in
1101`mh-insert-mail-followup-to-list'."
1102 :type 'boolean
1103 :group 'mh-letter)
1104
1105(defcustom mh-insert-mail-followup-to-list nil
1106 "Alist of addresses for which a Mail-Followup-To field is inserted.
1107Each element has the form (REGEXP ADDRESS).
1108When the REGEXP appears in the To or cc fields of a message, the corresponding
1109ADDRESS is inserted in a Mail-Followup-To field.
1110
1111Here's a customization example:
1112
1113 regexp: mh-e-users@lists.s\\\\(ourceforge\\\\|f\\\\).net
1114 address: mh-e-users@lists.sourceforge.net
1115
1116This corresponds to:
1117
1118 (setq mh-insert-mail-followup-to-list
1119 '((\"mh-e-users@lists.s\\\\(ourceforge\\\\|f\\\\).net\"
1120 \"mh-e-users@lists.sourceforge.net\")))
1121
1122While it might be tempting to add a descriptive name to the mailing list
1123address, consider that this field will appear in other people's outgoing
1124mail in their To: field. It might be best to keep it simple."
1125 :type '(repeat (list (string :tag "regexp") (string :tag "address")))
1126 :group 'mh-letter)
1127
1128(defcustom mh-insert-x-mailer-flag t
1129 "*Non-nil means append an X-Mailer field to the header."
1130 :type 'boolean
1131 :group 'mh-letter)
1132
1133(defcustom mh-letter-fill-column 72
1134 "*Fill column to use in `mh-letter-mode'.
1135This is usually less than in other text modes because email messages get
1136quoted by some prefix (sometimes many times) when they are replied to,
1137and it's best to avoid quoted lines that span more than 80 columns."
1138 :type 'integer
1139 :group 'mh-letter)
1140
1141(defcustom mh-reply-default-reply-to nil
1142 "*Sets the person or persons to whom a reply will be sent.
1143If nil, prompt for recipient. If non-nil, then \\<mh-folder-mode-map>`\\[mh-reply]' will use this
1144value and it should be one of \"from\", \"to\", \"cc\", or \"all\".
1145The values \"cc\" and \"all\" do the same thing."
1146 :type '(choice (const :tag "Prompt" nil)
1147 (const "from") (const "to")
1148 (const "cc") (const "all"))
1149 :group 'mh-letter)
1150
1151(defcustom mh-reply-show-message-flag t
1152 "*Non-nil means the show buffer is displayed using \\<mh-letter-mode-map>\\[mh-reply].
1153
1154The setting of this variable determines whether the MH `show-buffer' is
1155displayed with the current message when using `mh-reply' without a prefix
1156argument. Set it to nil if you already include the message automatically
1157in your draft using
1158 repl: -filter repl.filter
1159in your ~/.mh_profile file."
1160 :type 'boolean
1161 :group 'mh-letter)
1162
1163(defcustom mh-signature-file-name "~/.signature"
1164 "*Name of file containing the user's signature.
1165Inserted into message by \\<mh-letter-mode-map>\\[mh-insert-signature]."
1166 :type 'file
1167 :group 'mh-letter)
1168
1169(defcustom mh-x-face-file "~/.face"
1170 "*File name containing the encoded X-Face string to insert in outgoing mail.
1171If nil, or the file does not exist, nothing is added to message headers."
1172 :type 'file
1173 :group 'mh-letter)
1174
1175(defvar mh-x-mailer-string nil
1176 "*String containing the contents of the X-Mailer header field.
1177If nil, this variable is initialized to show the version of MH-E, Emacs, and
1178MH the first time a message is composed.")
1179
1180(defcustom mh-yank-from-start-of-msg 'attribution
1181 "*Controls which part of a message is yanked by \\<mh-letter-mode-map>\\[mh-yank-cur-msg].
1182If t, include the entire message, with full headers. This is historically
1183here for use with supercite, but is now deprecated in favor of the setting
1184`supercite' below.
1185
1186If the symbol `body', then yank the message minus the header.
1187
1188If the symbol `supercite', include the entire message, with full headers.
1189This also causes the invocation of `sc-cite-original' without the setting
1190of `mail-citation-hook', now deprecated practice.
1191
1192If the symbol `autosupercite', do as for `supercite' automatically when
1193show buffer matches the message being replied-to. When this option is used,
1194the -noformat switch is passed to the repl program to override a -filter or
1195-format switch.
1196
1197If the symbol `attribution', then yank the message minus the header and add
1198a simple attribution line at the top.
1199
1200If the symbol `autoattrib', do as for `attribution' automatically when show
1201buffer matches the message being replied-to. You can make sure this is
1202always the case by setting `mh-reply-show-message-flag' to t (which is the
1203default) and optionally `mh-delete-yanked-msg-window-flag' to t as well such
1204that the show window is never displayed. When the `autoattrib' option is
1205used, the -noformat switch is passed to the repl program to override a
1206-filter or -format switch.
1207
1208If nil, yank only the portion of the message following the point.
1209
1210If the show buffer has a region, this variable is ignored unless its value is
1211one of `attribution' or `autoattrib' in which case the attribution is added
1212to the yanked region."
1213 :type '(choice (const :tag "Below point" nil)
1214 (const :tag "Without header" body)
1215 (const :tag "Invoke supercite" supercite)
1216 (const :tag "Invoke supercite, automatically" autosupercite)
1217 (const :tag "Without header, with attribution" attribution)
1218 (const :tag "Without header, with attribution, automatically"
1219 autoattrib)
1220 (const :tag "Entire message with headers" t))
1221 :group 'mh-letter)
1222
1223(defcustom mh-letter-complete-function 'ispell-complete-word
1224 "*Function to call when completing outside of fields specific to aliases."
1225 :type '(choice function (const nil))
1226 :group 'mh-letter)
1227
1228;;; Alias handling (:group 'mh-alias)
1229
1230(defcustom mh-alias-system-aliases
1231 '("/etc/nmh/MailAliases" "/usr/lib/mh/MailAliases" "/etc/passwd")
1232 "*A list of system files from which to cull aliases.
1233If these files are modified, they are automatically reread. This list need
1234include only system aliases and the passwd file, since personal alias files
1235listed in your \"AliasFile\" MH profile component are automatically included.
1236You can update the alias list manually using \\[mh-alias-reload]."
1237 :group 'mh-alias
1238 :type '(choice (file) (repeat file)))
1239
1240(defcustom mh-alias-expand-aliases-flag nil
1241 "*Non-nil means to expand aliases entered in the minibuffer.
1242In other words, aliases entered in the minibuffer will be expanded to the full
1243address in the message draft. By default, this expansion is not performed."
1244 :group 'mh-alias
1245 :type 'boolean)
1246
1247(defcustom mh-alias-completion-ignore-case-flag t
1248 "*Non-nil means don't consider case significant in MH alias completion.
1249This is the default in plain MH, so it is the default here as well. It
1250can be useful to set this to t if, for example, you use lowercase
1251aliases for people and uppercase for mailing lists."
1252 :group 'mh-alias
1253 :type 'boolean)
1254
1255(defcustom mh-alias-flash-on-comma t
1256 "*Specify whether to flash or warn on translation.
1257When a [comma] is pressed while entering aliases or addresses, setting this
1258variable to the following values has the listed effects:
1259t Flash alias translation but don't warn if there is no translation.
12601 Flash alias translation and warn if there is no translation.
1261nil Do not flash alias translation nor warn if there is no translation."
1262 :group 'mh-alias
1263 :type '(choice (const :tag "Flash but don't warn if no translation" t)
1264 (const :tag "Flash and warn if no translation" 1)
1265 (const :tag "Don't flash nor warn if no translation" nil)))
1266
1267(defcustom mh-alias-local-users t
1268 "*If t, local users are completed in MH-E To: and Cc: prompts.
1269
1270Users with a userid greater than some magic number (usually 200) are available
1271for completion.
1272
1273If you set this variable to a string, it will be executed to generate a
1274password file. A value of \"ypcat passwd\" is helpful if NIS is in use."
1275 :group 'mh-alias
1276 :type '(choice (boolean) (string)))
1277
1278(defcustom mh-alias-insert-file nil
1279 "*Filename to use to store new MH-E aliases.
1280This variable can also be a list of filenames, in which case MH-E will prompt
1281for one of them. If nil, the default, then MH-E will use the first file found
1282in the \"AliasFile\" component of the MH profile."
1283 :group 'mh-alias
1284 :type '(choice (const :tag "Use AliasFile MH profile component" nil)
1285 (file :tag "Alias file")
1286 (repeat :tag "List of alias files" file)))
1287
1288(defcustom mh-alias-insertion-location 'sorted
1289 "Specifies where new aliases are entered in alias files.
1290Options are sorted alphabetically, at the top of the file or at the bottom."
1291 :type '(choice (const :tag "Sorted alphabetically" sorted)
1292 (const :tag "At the top of file" top)
1293 (const :tag "At the bottom of file" bottom))
1294 :group 'mh-alias)
1295
1296;;; Indexed searching (:group 'mh-index)
1297
1298(defcustom mh-index-program nil
1299 "Indexing program that MH-E shall use.
1300The possible choices are swish++, swish-e, namazu, glimpse and grep. By
1301default this variable is nil which means that the programs are tried in order
1302and the first one found is used."
1303 :type '(choice (const :tag "auto-detect" nil)
1304 (const :tag "swish++" swish++)
1305 (const :tag "swish-e" swish)
1306 (const :tag "namazu" namazu)
1307 (const :tag "glimpse" glimpse)
1308 (const :tag "grep" grep))
1309 :group 'mh-index)
1310
1311;;; Multiple personalities (:group 'mh-identity)
1312
1313(defcustom mh-identity-list nil
1314 "*List holding MH-E identity.
1315Omit the colon and trailing space from the field names.
1316The keyword name \"none\" is reversed for internal use.
1317Use the keyname name \"signature\" to specify either a signature file or a
1318function to call to insert a signature at point.
1319
1320Providing an empty Value (\"\") will cause the field to be deleted.
1321
1322Example entries using the customize interface:
1323 Keyword name: work
1324 From
1325 Value: John Doe <john@work.com>
1326 Organization
1327 Value: Acme Inc.
1328 Keyword name: home
1329 From
1330 Value: John Doe <johndoe@home.net>
1331 Organization
1332 Value:
1333
1334This would produce the equivalent of:
1335 (setq mh-identity-list
1336 '((\"work\"
1337 ((\"From\" . \"John Doe <john@work.com>\")
1338 (\"Organization\" . \"Acme Inc.\")))
1339 (\"home\"
1340 ((\"From\" . \"John Doe <johndoe@home.net>\")
1341 (\"Organization\" . \"\")))))"
1342 :type '(repeat (list :tag ""
1343 (string :tag "Keyword name")
1344 (repeat :tag "At least one pair from below"
1345 (choice (cons :tag "From field"
1346 (const "From")
1347 (string :tag "Value"))
1348 (cons :tag "Organization field"
1349 (const "Organization")
1350 (string :tag "Value"))
1351 (cons :tag "Signature"
1352 (const "signature")
1353 (choice (file) (function)))
1354 (cons :tag "Other field & value pair"
1355 (string :tag "Field")
1356 (string :tag "Value"))))))
1357 :set 'mh-identity-list-set
1358 :group 'mh-identity)
1359
1360(defcustom mh-identity-default nil
1361 "Default identity to use when `mh-letter-mode' is called."
1362 ;; Dynamically render :type corresponding to `mh-identity-list' entries,
1363 ;; e.g.:
1364 ;; :type '(radio (const :tag "none" nil)
1365 ;; (const "home")
1366 ;; (const "work"))
1367 :type (append
1368 '(radio)
1369 (cons '(const :tag "none" nil)
1370 (mapcar (function (lambda (arg) `(const ,arg)))
1371 (mapcar 'car mh-identity-list))))
1372 :group 'mh-identity)
1373
1374;;; Hooks (:group 'mh-hooks + group where hook defined)
1375
1376;;; These are alphabetized. All hooks should be placed in the 'mh-hook group;
1377;;; in addition, add the group in which the hook is defined in the manual (or,
1378;;; if it is new, where it would be defined).
1379
1380(defcustom mh-before-quit-hook nil
1381 "Invoked by \\<mh-folder-mode-map>`\\[mh-quit]' before quitting MH-E.
1382See also `mh-quit-hook'."
1383 :type 'hook
1384 :group 'mh-hooks
1385 :group 'mh-folder)
1386
1387(defcustom mh-before-send-letter-hook nil
1388 "Invoked at the beginning of the \\<mh-letter-mode-map>\\[mh-send-letter] command."
1389 :type 'hook
1390 :group 'mh-hooks
1391 :group 'mh-letter)
1392
1393(defcustom mh-delete-msg-hook nil
1394 "Invoked after marking each message for deletion."
1395 :type 'hook
1396 :group 'mh-hooks
1397 :group 'mh-folder)
1398
1399(defcustom mh-edit-mhn-hook nil
1400 "Invoked on the formatted letter by \\<mh-letter-mode-map>\\[mh-edit-mhn]."
1401 :type 'hook
1402 :group 'mh-hooks
1403 :group 'mh-letter)
1404
1405(defcustom mh-find-path-hook nil
1406 "Invoked by `mh-find-path' after reading the user's MH profile."
1407 :type 'hook
1408 :group 'mh-hooks
1409 :group 'mh-folder)
1410
1411(defcustom mh-folder-list-change-hook nil
1412 "Invoked whenever the cached folder list `mh-folder-list' is changed."
1413 :type 'hook
1414 :group 'mh-hooks
1415 :group 'mh-folder)
1416
1417(defcustom mh-folder-mode-hook nil
1418 "Invoked in `mh-folder-mode' on a new folder."
1419 :type 'hook
1420 :group 'mh-hooks
1421 :group 'mh-folder)
1422
1423(defcustom mh-folder-updated-hook nil
1424 "Invoked when the folder actions (such as moves and deletes) are performed.
1425Variables that are useful in this hook include `mh-delete-list' and
1426`mh-refile-list' which can be used to see which changes are being made to
1427current folder, `mh-current-folder'."
1428 :type 'hook
1429 :group 'mh-hooks)
1430
1431(defcustom mh-inc-folder-hook nil
1432 "Invoked by \\<mh-folder-mode-map>`\\[mh-inc-folder]' after incorporating mail into a folder."
1433 :type 'hook
1434 :group 'mh-hooks
1435 :group 'mh-folder)
1436
1437(defcustom mh-index-show-hook nil
1438 "Invoked after the message has been displayed."
1439 :type 'hook
1440 :group 'mh-hooks
1441 :group 'mh-index)
1442
1443(defcustom mh-letter-insert-signature-hook nil
1444 "Invoked at the beginning of the \\<mh-letter-mode-map>\\[mh-insert-signature] command.
1445Can be used to determine which signature file to use based on message content.
1446On return, if `mh-signature-file-name' is non-nil that file will be inserted at
1447the current point in the buffer."
1448 :type 'hook
1449 :group 'mh-hooks
1450 :group 'mh-letter)
1451
1452(defcustom mh-letter-mode-hook nil
1453 "Invoked in `mh-letter-mode' on a new letter."
1454 :type 'hook
1455 :group 'mh-hooks
1456 :group 'mh-letter)
1457
1458(defcustom mh-pick-mode-hook nil
1459 "Invoked upon entry to `mh-pick-mode'."
1460 :type 'hook
1461 :group 'mh-hooks
1462 :group 'mh-folder)
1463
1464(defcustom mh-quit-hook nil
1465 "Invoked after \\<mh-folder-mode-map>`\\[mh-quit]' quits MH-E.
1466See also `mh-before-quit-hook'."
1467 :type 'hook
1468 :group 'mh-hooks
1469 :group 'mh-folder)
1470
1471(defcustom mh-refile-msg-hook nil
1472 "Invoked after marking each message for refiling."
1473 :type 'hook
1474 :group 'mh-hooks
1475 :group 'mh-folder)
1476
1477(defcustom mh-show-hook nil
1478 "Invoked after \\<mh-folder-mode-map>`\\[mh-show]' shows a message."
1479 :type 'hook
1480 :group 'mh-hooks
1481 :group 'mh-show)
1482
1483(defcustom mh-show-mode-hook nil
1484 "Invoked upon entry to `mh-show-mode'."
1485 :type 'hook
1486 :group 'mh-hooks
1487 :group 'mh-show)
1488
1489(defcustom mh-unseen-updated-hook nil
1490 "Invoked after the unseen sequence has been updated.
1491The variable `mh-seen-list' can be used to obtain the list of messages which
1492will be removed from the unseen sequence."
1493 :type 'hook
1494 :group 'mh-hooks
1495 :group 'mh-folder)
1496
1497
1498
1499;;; Faces
1500
1501;;; Faces used in speedbar (:group mh-speed-faces)
1502
1503(defface mh-speedbar-folder-face
1504 '((((class color) (background light))
1505 (:foreground "blue4"))
1506 (((class color) (background dark))
1507 (:foreground "light blue")))
1508 "Face used for folders in the speedbar buffer."
1509 :group 'mh-speed-faces)
1510
1511(defface mh-speedbar-selected-folder-face
1512 '((((class color) (background light))
1513 (:foreground "red" :underline t))
1514 (((class color) (background dark))
1515 (:foreground "red" :underline t))
1516 (t (:underline t)))
1517 "Face used for the current folder."
1518 :group 'mh-speed-faces)
1519
1520(defface mh-speedbar-folder-with-unseen-messages-face
1521 '((t (:inherit mh-speedbar-folder-face :bold t)))
1522 "Face used for folders in the speedbar buffer which have unread messages."
1523 :group 'mh-speed-faces)
1524
1525(defface mh-speedbar-selected-folder-with-unseen-messages-face
1526 '((t (:inherit mh-speedbar-selected-folder-face :bold t)))
1527 "Face used for the current folder when it has unread messages."
1528 :group 'mh-speed-faces)
1529
1530;;; Faces used in scan listing (:group mh-folder-faces)
1531
1532(defvar mh-folder-body-face 'mh-folder-body-face
1533 "Face for highlighting body text in MH-Folder buffers.")
1534(defface mh-folder-body-face
1535 '((((type tty) (class color)) (:foreground "green"))
1536 (((class grayscale) (background light)) (:foreground "DimGray" :italic t))
1537 (((class grayscale) (background dark)) (:foreground "LightGray" :italic t))
1538 (((class color) (background light)) (:foreground "RosyBrown"))
1539 (((class color) (background dark)) (:foreground "LightSalmon"))
1540 (t (:italic t)))
1541 "Face for highlighting body text in MH-Folder buffers."
1542 :group 'mh-folder-faces)
1543
1544(defvar mh-folder-cur-msg-face 'mh-folder-cur-msg-face
1545 "Face for the current message line in MH-Folder buffers.")
1546(defface mh-folder-cur-msg-face
1547 '((((type tty pc) (class color))
1548 (:background "LightGreen"))
1549 (((class color) (background light))
1550 (:background "LightGreen") ;Use this for solid background colour
1551 ;; (:underline t) ;Use this for underlining
1552 )
1553 (((class color) (background dark))
1554 (:background "DarkOliveGreen4"))
1555 (t (:underline t)))
1556 "Face for the current message line in MH-Folder buffers."
1557 :group 'mh-folder-faces)
1558
1559(defvar mh-folder-cur-msg-number-face 'mh-folder-cur-msg-number-face
1560 "Face for highlighting the current message in MH-Folder buffers.")
1561(defface mh-folder-cur-msg-number-face
1562 '((((type tty) (class color)) (:foreground "cyan" :weight bold))
1563 (((class grayscale) (background light)) (:foreground "LightGray" :bold t))
1564 (((class grayscale) (background dark)) (:foreground "DimGray" :bold t))
1565 (((class color) (background light)) (:foreground "Purple"))
1566 (((class color) (background dark)) (:foreground "Cyan"))
1567 (t (:bold t)))
1568 "Face for highlighting the current message in MH-Folder buffers."
1569 :group 'mh-folder-faces)
1570
1571(defvar mh-folder-date-face 'mh-folder-date-face
1572 "Face for highlighting the date in MH-Folder buffers.")
1573(defface mh-folder-date-face
1574 '((((class color) (background light))
1575 (:foreground "snow4"))
1576 (((class color) (background dark))
1577 (:foreground "snow3"))
1578 (t
1579 (:bold t)))
1580 "Face for highlighting the date in MH-Folder buffers."
1581 :group 'mh-folder-faces)
1582
1583(defvar mh-folder-followup-face 'mh-folder-followup-face
1584 "Face for highlighting Re: (followup) subject text in MH-Folder buffers.")
1585(defface mh-folder-followup-face
1586 '((((class color) (background light))
1587 (:foreground "blue3"))
1588 (((class color) (background dark))
1589 (:foreground "LightGoldenRod"))
1590 (t
1591 (:bold t)))
1592 "Face for highlighting Re: (followup) subject text in MH-Folder buffers."
1593 :group 'mh-folder-faces)
1594
1595(defvar mh-folder-msg-number-face 'mh-folder-msg-number-face
1596 "Face for highlighting the message number in MH-Folder buffers.")
1597(defface mh-folder-msg-number-face
1598 '((((class color) (background light))
1599 (:foreground "snow4"))
1600 (((class color) (background dark))
1601 (:foreground "snow3"))
1602 (t
1603 (:bold t)))
1604 "Face for highlighting the message number in MH-Folder buffers."
1605 :group 'mh-folder-faces)
1606
1607(defvar mh-folder-deleted-face 'mh-folder-deleted-face
1608 "Face for highlighting deleted messages in MH-Folder buffers.")
1609(copy-face 'mh-folder-msg-number-face 'mh-folder-deleted-face)
1610
1611(defvar mh-folder-refiled-face 'mh-folder-refiled-face
1612 "Face for highlighting refiled messages in MH-Folder buffers.")
1613(defface mh-folder-refiled-face
1614 '((((type tty) (class color)) (:foreground "yellow" :weight light))
1615 (((class grayscale) (background light))
1616 (:foreground "Gray90" :bold t :italic t))
1617 (((class grayscale) (background dark))
1618 (:foreground "DimGray" :bold t :italic t))
1619 (((class color) (background light)) (:foreground "DarkGoldenrod"))
1620 (((class color) (background dark)) (:foreground "LightGoldenrod"))
1621 (t (:bold t :italic t)))
1622 "Face for highlighting refiled messages in MH-Folder buffers."
1623 :group 'mh-folder-faces)
1624
1625(defvar mh-folder-subject-face 'mh-folder-subject-face
1626 "Face for highlighting subject text in MH-Folder buffers.")
1627(if (boundp 'facemenu-unlisted-faces)
1628 (add-to-list 'facemenu-unlisted-faces "^mh-folder"))
1629(defface mh-folder-subject-face
1630 '((((class color) (background light))
1631 (:foreground "blue4"))
1632 (((class color) (background dark))
1633 (:foreground "yellow"))
1634 (t
1635 (:bold t)))
1636 "Face for highlighting subject text in MH-Folder buffers."
1637 :group 'mh-folder-faces)
1638
1639(defvar mh-folder-address-face 'mh-folder-address-face
1640 "Face for highlighting the address in MH-Folder buffers.")
1641(copy-face 'mh-folder-subject-face 'mh-folder-address-face)
1642
1643(defvar mh-folder-scan-format-face 'mh-folder-scan-format-face
1644 "Face for highlighting `mh-scan-format-regexp' matches in MH-Folder buffers.")
1645(copy-face 'mh-folder-followup-face 'mh-folder-scan-format-face)
1646
1647(defvar mh-folder-to-face 'mh-folder-to-face
1648 "Face for highlighting the To: string in MH-Folder buffers.")
1649(defface mh-folder-to-face
1650 '((((type tty) (class color)) (:foreground "green"))
1651 (((class grayscale) (background light)) (:foreground "DimGray" :italic t))
1652 (((class grayscale) (background dark)) (:foreground "LightGray" :italic t))
1653 (((class color) (background light)) (:foreground "RosyBrown"))
1654 (((class color) (background dark)) (:foreground "LightSalmon"))
1655 (t (:italic t)))
1656 "Face for highlighting the To: string in MH-Folder buffers."
1657 :group 'mh-folder-faces)
1658
1659;;; Faces used in message display (:group mh-show-faces)
1660
1661(defvar mh-show-cc-face 'mh-show-cc-face
1662 "Face for highlighting cc header fields.")
1663(defface mh-show-cc-face
1664 '((((type tty) (class color)) (:foreground "yellow" :weight light))
1665 (((class grayscale) (background light))
1666 (:foreground "Gray90" :bold t :italic t))
1667 (((class grayscale) (background dark))
1668 (:foreground "DimGray" :bold t :italic t))
1669 (((class color) (background light)) (:foreground "DarkGoldenrod"))
1670 (((class color) (background dark)) (:foreground "LightGoldenrod"))
1671 (t (:bold t :italic t)))
1672 "Face for highlighting cc header fields."
1673 :group 'mh-show-faces)
1674
1675(defvar mh-show-date-face 'mh-show-date-face
1676 "Face for highlighting the Date header field.")
1677(defface mh-show-date-face
1678 '((((type tty) (class color)) (:foreground "green"))
1679 (((class grayscale) (background light)) (:foreground "Gray90" :bold t))
1680 (((class grayscale) (background dark)) (:foreground "DimGray" :bold t))
1681 (((class color) (background light)) (:foreground "ForestGreen"))
1682 (((class color) (background dark)) (:foreground "PaleGreen"))
1683 (t (:bold t :underline t)))
1684 "Face for highlighting the Date header field."
1685 :group 'mh-show-faces)
1686
1687(defvar mh-show-header-face 'mh-show-header-face
1688 "Face used to deemphasize unspecified header fields.")
1689(defface mh-show-header-face
1690 '((((type tty) (class color)) (:foreground "green"))
1691 (((class grayscale) (background light)) (:foreground "DimGray" :italic t))
1692 (((class grayscale) (background dark)) (:foreground "LightGray" :italic t))
1693 (((class color) (background light)) (:foreground "RosyBrown"))
1694 (((class color) (background dark)) (:foreground "LightSalmon"))
1695 (t (:italic t)))
1696 "Face used to deemphasize unspecified header fields."
1697 :group 'mh-show-faces)
1698
1699(defvar mh-show-to-face 'mh-show-to-face
1700 "Face for highlighting the To: header field.")
1701(if (boundp 'facemenu-unlisted-faces)
1702 (add-to-list 'facemenu-unlisted-faces "^mh-show"))
1703(defface mh-show-to-face
1704 '((((class grayscale) (background light))
1705 (:foreground "DimGray" :underline t))
1706 (((class grayscale) (background dark))
1707 (:foreground "LightGray" :underline t))
1708 (((class color) (background light)) (:foreground "SaddleBrown"))
1709 (((class color) (background dark)) (:foreground "burlywood"))
1710 (t (:underline t)))
1711 "Face for highlighting the To: header field."
1712 :group 'mh-show-faces)
1713
1714(defvar mh-show-from-face 'mh-show-from-face
1715 "Face for highlighting the From: header field.")
1716(defface mh-show-from-face
1717 '((((class color) (background light))
1718 (:foreground "red3"))
1719 (((class color) (background dark))
1720 (:foreground "cyan"))
1721 (t
1722 (:bold t)))
1723 "Face for highlighting the From: header field."
1724 :group 'mh-show-faces)
1725
1726(defvar mh-show-subject-face 'mh-show-subject-face
1727 "Face for highlighting the Subject header field.")
1728(copy-face 'mh-folder-subject-face 'mh-show-subject-face)
1729
1730;;; Faces used in indexed searches (:group mh-index-faces)
1731
1732(defvar mh-index-folder-face 'mh-index-folder-face
1733 "Face for highlighting folders in MH-Index buffers.")
1734(defface mh-index-folder-face
1735 '((((class color) (background light))
1736 (:foreground "dark green" :bold t))
1737 (((class color) (background dark))
1738 (:foreground "indian red" :bold t))
1739 (t
1740 (:bold t)))
1741 "Face for highlighting folders in MH-Index buffers."
1742 :group 'mh-index-faces)
1743
1744(provide 'mh-customize)
1745
1746;;; Local Variables:
1747;;; indent-tabs-mode: nil
1748;;; sentence-end-double-space: nil
1749;;; End:
1750
1751;;; mh-customize.el ends here
diff --git a/lisp/mail/mh-e.el b/lisp/mail/mh-e.el
deleted file mode 100644
index 9a5f8967f2a..00000000000
--- a/lisp/mail/mh-e.el
+++ /dev/null
@@ -1,2258 +0,0 @@
1;;; mh-e.el --- GNU Emacs interface to the MH mail system
2
3;; Copyright (C) 1985,86,87,88,90,92,93,94,95,97,2000,2001,2002 Free Software Foundation, Inc.
4
5;; Author: Bill Wohler <wohler@newt.com>
6;; Maintainer: Bill Wohler <wohler@newt.com>
7;; Version: 7.1
8;; Keywords: mail
9
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
14;; the Free Software Foundation; either version 2, or (at your option)
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 the
24;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
25;; Boston, MA 02111-1307, USA.
26
27;;; Commentary:
28
29;; How to Use:
30;; M-x mh-rmail to read mail. Type C-h m there for a list of commands.
31;; C-u M-x mh-rmail to visit any folder.
32;; M-x mh-smail to send mail. From within the mail reader, "m" works, too.
33
34;; Your .emacs might benefit from these bindings:
35;; (global-set-key "\C-cr" 'mh-rmail)
36;; (global-set-key "\C-xm" 'mh-smail)
37;; (global-set-key "\C-x4m" 'mh-smail-other-window)
38
39;; MH (Message Handler) is a powerful mail reader.
40
41;; The MH newsgroup is comp.mail.mh; the mailing list is mh-users@ics.uci.edu
42;; (send to mh-users-request to be added). See the monthly Frequently Asked
43;; Questions posting there for information on getting MH and MH-E:
44;; http://www.faqs.org/faqs/mail/mh-faq/part1/preamble.html
45
46;; N.B. MH must have been compiled with the MHE compiler flag or several
47;; features necessary for MH-E will be missing from MH commands, specifically
48;; the -build switch to repl and forw.
49
50;; MH-E is an Emacs interface to the MH mail system.
51
52;; MH-E is supported in GNU Emacs 20 and 21, with MH 6.8.4 and nmh 1.0.4.
53
54;; Mailing Lists:
55;; mh-e-users@lists.sourceforge.net
56;; mh-e-announce@lists.sourceforge.net
57;; mh-e-devel@lists.sourceforge.net
58;;
59;; Subscribe by sending a "subscribe" message to
60;; <list>-request@lists.sourceforge.net, or by using the web interface at
61;; https://sourceforge.net/mail/?group_id=13357
62
63;; Bug Reports:
64;; https://sourceforge.net/tracker/?group_id=13357&atid=113357
65;; Include the output of M-x mh-version in any bug report.
66
67;; Feature Requests:
68;; https://sourceforge.net/tracker/?atid=363357&group_id=13357&func=browse
69
70;; Support:
71;; https://sourceforge.net/tracker/?group_id=13357&atid=213357
72
73;;; Change Log:
74
75;; Original version for Gosling emacs by Brian Reid, Stanford, 1982.
76;; Modified by James Larus, BBN, July 1984 and UCB, 1984 & 1985.
77;; Rewritten for GNU Emacs, James Larus 1985. larus@ginger.berkeley.edu
78;; Modified by Stephen Gildea 1988. gildea@lcs.mit.edu
79;; Maintenance picked up by Bill Wohler <wohler@newt.com> and the
80;; SourceForge Crew <http://mh-e.sourceforge.net/>. 2001.
81
82;; $Id: mh-e.el,v 1.240 2003/01/08 00:46:25 wohler Exp $
83
84;;; Code:
85
86(require 'cl)
87
88(defvar recursive-load-depth-limit)
89(eval-when (compile load eval)
90 (if (and (boundp 'recursive-load-depth-limit)
91 (integerp recursive-load-depth-limit)
92 (> 50 recursive-load-depth-limit))
93 (setq recursive-load-depth-limit 50)))
94
95(require 'mh-utils)
96(require 'gnus-util)
97(require 'easymenu)
98(if mh-xemacs-flag
99 (require 'mh-xemacs-compat))
100
101;; Shush the byte-compiler
102(defvar font-lock-auto-fontify)
103(defvar font-lock-defaults)
104
105(defconst mh-version "7.1" "Version number of MH-E.")
106
107;;; Autoloads
108(autoload 'Info-goto-node "info")
109
110
111
112(defvar mh-note-deleted "D"
113 "String whose first character is used to notate deleted messages.")
114
115(defvar mh-note-refiled "^"
116 "String whose first character is used to notate refiled messages.")
117
118(defvar mh-note-cur "+"
119 "String whose first character is used to notate the current message.")
120
121(defvar mh-partial-folder-mode-line-annotation "select"
122 "Annotation when displaying part of a folder.
123The string is displayed after the folder's name. nil for no annotation.")
124
125;;; Parameterize MH-E to work with different scan formats. The defaults work
126;;; with the standard MH scan listings, in which the first 4 characters on
127;;; the line are the message number, followed by two places for notations.
128
129;; The following scan formats are passed to the scan program if the
130;; setting of `mh-scan-format-file' above is nil. They are identical
131;; except the later one makes use of the nmh `decode' function to
132;; decode RFC 2047 encodings. If you just want to change the width of
133;; the msg number, use the `mh-set-cmd-note' function.
134
135(defvar mh-scan-format-mh
136 (concat
137 "%4(msg)"
138 "%<(cur)+%| %>"
139 "%<{replied}-"
140 "%?(nonnull(comp{to}))%<(mymbox{to})t%>"
141 "%?(nonnull(comp{cc}))%<(mymbox{cc})c%>"
142 "%?(nonnull(comp{bcc}))%<(mymbox{bcc})b%>"
143 "%?(nonnull(comp{newsgroups}))n%>"
144 "%<(zero) %>"
145 "%02(mon{date})/%02(mday{date})%<{date} %|*%>"
146 "%<(mymbox{from})%<{to}To:%14(friendly{to})%>%>"
147 "%<(zero)%17(friendly{from})%> "
148 "%{subject}%<{body}<<%{body}%>")
149 "*Scan format string for MH, provided to the scan program via the -format arg.
150This format is identical to the default except that additional hints for
151fontification have been added to the fifth column (remember that in Emacs, the
152first column is 0).
153
154The values of the fifth column, in priority order, are: `-' if the
155message has been replied to, t if an address on the To: line matches
156one of the mailboxes of the current user, `c' if the Cc: line matches,
157`b' if the Bcc: line matches, and `n' if a non-empty Newsgroups: header
158is present.")
159
160(defvar mh-scan-format-nmh
161 (concat
162 "%4(msg)"
163 "%<(cur)+%| %>"
164 "%<{replied}-"
165 "%?(nonnull(comp{to}))%<(mymbox{to})t%>"
166 "%?(nonnull(comp{cc}))%<(mymbox{cc})c%>"
167 "%?(nonnull(comp{bcc}))%<(mymbox{bcc})b%>"
168 "%?(nonnull(comp{newsgroups}))n%>"
169 "%<(zero) %>"
170 "%02(mon{date})/%02(mday{date})%<{date} %|*%>"
171 "%<(mymbox{from})%<{to}To:%14(decode(friendly{to}))%>%>"
172 "%<(zero)%17(decode(friendly{from}))%> "
173 "%(decode{subject})%<{body}<<%{body}%>")
174 "*Scan format string for nmh.
175This string is passed to the scan program via the -format arg.
176This format is identical to the default except that additional hints for
177fontification have been added to the fifth column (remember that in Emacs, the
178first column is 0).
179
180The values of the fifth column, in priority order, are: `-' if the
181message has been replied to, t if an address on the To: line matches
182one of the mailboxes of the current user, `c' if the Cc: line matches,
183`b' if the Bcc: line matches, and `n' if a non-empty Newsgroups: header
184is present.")
185
186(defvar mh-scan-good-msg-regexp "^\\( *[0-9]+\\)[^D^0-9]"
187 "Regexp specifying the scan lines that are 'good' messages.
188The default `mh-folder-font-lock-keywords' expects this expression to contain
189at least one parenthesized expression which matches the message number.")
190
191(defvar mh-scan-deleted-msg-regexp "^\\( *[0-9]+\\)D"
192 "Regexp matching scan lines of deleted messages.
193The default `mh-folder-font-lock-keywords' expects this expression to contain
194at least one parenthesized expression which matches the message number.")
195
196(defvar mh-scan-refiled-msg-regexp "^\\( *[0-9]+\\)\\^"
197 "Regexp matching scan lines of refiled messages.
198The default `mh-folder-font-lock-keywords' expects this expression to contain
199at least one parenthesized expression which matches the message number.")
200
201(defvar mh-scan-valid-regexp "^ *[0-9]"
202 "Regexp matching scan lines for messages (not error messages).")
203
204(defvar mh-scan-cur-msg-number-regexp "^\\( *[0-9]+\\+\\).*"
205 "Regexp matching scan line for the current message.
206The default `mh-folder-font-lock-keywords' expects this expression to contain
207at least one parenthesized expression which matches the message number.
208Don't disable this regexp as it's needed by non fontifying functions.")
209
210(defvar mh-scan-cur-msg-regexp "^\\( *[0-9]+\\+DISABLED.*\\)"
211 "Regexp matching scan line for the current message.
212The default `mh-folder-font-lock-keywords' expects this expression to contain
213at least one parenthesized expression which matches the whole line.
214To enable this feature, remove the string DISABLED from the regexp.")
215
216(defvar mh-scan-date-regexp "\\([0-9][0-9]/[0-9][0-9]\\)"
217 "Regexp matching a valid date in scan lines.
218The default `mh-folder-font-lock-keywords' expects this expression to contain
219only one parenthesized expression which matches the date field
220\(see `mh-scan-format-regexp').")
221
222(defvar mh-scan-rcpt-regexp "\\(To:\\)\\(..............\\)"
223 "Regexp specifying the recipient in scan lines for messages we sent.
224The default `mh-folder-font-lock-keywords' expects this expression to contain
225two parenthesized expressions. The first is expected to match the To:
226that the default scan format file generates. The second is expected to match
227the recipient's name.")
228
229(defvar mh-scan-body-regexp "\\(<<\\([^\n]+\\)?\\)"
230 "Regexp matching the message body beginning displayed in scan lines.
231The default `mh-folder-font-lock-keywords' expects this expression to contain
232at least one parenthesized expression which matches the body text.")
233
234(defvar mh-scan-subject-regexp
235 ;;"^ *[0-9]+........[ ]*...................\\([Rr][Ee]:\\s-*\\)*\\([^<\n]*\\)"
236 "^ *[0-9]+........[ ]*...................\\([Rr][Ee]\\(\\[[0-9]+\\]\\)?:\\s-*\\)*\\([^<\n]*\\)"
237 "*Regexp matching the subject string in MH folder mode.
238The default `mh-folder-font-lock-keywords' expects this expression to contain
239at least tree parenthesized expressions. The first is expected to match the Re:
240string, if any. The second matches an optional bracketed number after Re,
241such as in Re[2]: and the third is expected to match the subject line itself.")
242
243(defvar mh-scan-format-regexp
244 (concat "\\([bct]\\)" mh-scan-date-regexp " *\\(..................\\)")
245 "Regexp matching the output of scan.
246The default value is based upon the default values of either
247`mh-scan-format-mh' or `mh-scan-format-nmh'.
248The default `mh-folder-font-lock-keywords' expects this expression to contain
249at least three parenthesized expressions. The first should match the
250fontification hint, the second is found in `mh-scan-date-regexp', and the
251third should match the user name.")
252
253
254
255(defvar mh-folder-font-lock-keywords
256 (list
257 ;; Folders when displaying index buffer
258 (list "^\\+.*"
259 '(0 mh-index-folder-face))
260 ;; Marked for deletion
261 (list (concat mh-scan-deleted-msg-regexp ".*")
262 '(0 mh-folder-deleted-face))
263 ;; Marked for refile
264 (list (concat mh-scan-refiled-msg-regexp ".*")
265 '(0 mh-folder-refiled-face))
266 ;;after subj
267 (list mh-scan-body-regexp '(1 mh-folder-body-face nil t))
268 '(mh-folder-font-lock-subject
269 (1 mh-folder-followup-face append t)
270 (2 mh-folder-subject-face append t))
271 ;;current msg
272 (list mh-scan-cur-msg-number-regexp
273 '(1 mh-folder-cur-msg-number-face))
274 (list mh-scan-good-msg-regexp
275 '(1 mh-folder-msg-number-face)) ;; Msg number
276 (list mh-scan-date-regexp '(1 mh-folder-date-face)) ;; Date
277 (list mh-scan-rcpt-regexp
278 '(1 mh-folder-to-face) ;; To:
279 '(2 mh-folder-address-face)) ;; address
280 ;; scan font-lock name
281 (list mh-scan-format-regexp
282 '(1 mh-folder-date-face)
283 '(3 mh-folder-scan-format-face))
284 ;; Current message line
285 (list mh-scan-cur-msg-regexp
286 '(1 mh-folder-cur-msg-face prepend t))
287 ;; Unseen messages in bold
288 '(mh-folder-font-lock-unseen (1 'bold append t)))
289 "Regexp keywords used to fontify the MH-Folder buffer.")
290
291(defvar mh-scan-cmd-note-width 1
292 "Number of columns consumed by the cmd-note field in `mh-scan-format'.
293This column will have one of the values: ` ', `D', `^', `+' and where
294` ' is the default value,
295`D' is the `mh-note-deleted' character,
296`^' is the `mh-note-refiled' character, and
297`+' is the `mh-note-cur' character.")
298
299(defvar mh-scan-destination-width 1
300 "Number of columns consumed by the destination field in `mh-scan-format'.
301This column will have one of ' ', '%', '-', 't', 'c', 'b', or `n' in it.
302A ' ' blank space is the default character.
303A '%' indicates that the message in in a named MH sequence.
304A '-' indicates that the message has been annotated with a replied field.
305A 't' indicates that the message contains mymbox in the To: field.
306A 'c' indicates that the message contains mymbox in the Cc: field.
307A 'b' indicates that the message contains mymbox in the Bcc: field.
308A 'n' indicates that the message contains a Newsgroups: field.")
309
310(defvar mh-scan-date-width 5
311 "Number of columns consumed by the date field in `mh-scan-format'.
312This column will typically be of the form mm/dd.")
313
314(defvar mh-scan-date-flag-width 1
315 "Number of columns consumed to flag (in)valid dates in `mh-scan-format'.
316This column will have ` ' for valid and `*' for invalid or missing dates.")
317
318(defvar mh-scan-from-mbox-width 17
319 "Number of columns consumed with the \"From:\" line in `mh-scan-format'.
320This column will have a friendly name or e-mail address of the
321originator, or a \"To: address\" for outgoing e-mail messages.")
322
323(defvar mh-scan-from-mbox-sep-width 2
324 "Number of columns consumed by whitespace after from-mbox in `mh-scan-format'.
325This column will only ever have spaces in it.")
326
327(defvar mh-scan-field-from-start-offset
328 (+ mh-scan-cmd-note-width
329 mh-scan-destination-width
330 mh-scan-date-width
331 mh-scan-date-flag-width)
332 "The offset from the `mh-cmd-note' to find the start of \"From:\" address.")
333
334(defvar mh-scan-field-from-end-offset
335 (+ mh-scan-field-from-start-offset mh-scan-from-mbox-width)
336 "The offset from the `mh-cmd-note' to find the end of \"From:\" address.")
337
338(defvar mh-scan-field-subject-start-offset
339 (+ mh-scan-cmd-note-width
340 mh-scan-destination-width
341 mh-scan-date-width
342 mh-scan-date-flag-width
343 mh-scan-from-mbox-width
344 mh-scan-from-mbox-sep-width)
345 "The offset from the `mh-cmd-note' to find the start of the subject.")
346
347(defun mh-folder-font-lock-subject (limit)
348 "Return MH-E scan subject strings to font-lock between point and LIMIT."
349 (if (not (re-search-forward mh-scan-subject-regexp limit t))
350 nil
351 (if (match-beginning 1)
352 (set-match-data (list (match-beginning 1) (match-end 3)
353 (match-beginning 1) (match-end 3) nil nil))
354 (set-match-data (list (match-beginning 3) (match-end 3)
355 nil nil (match-beginning 3) (match-end 3))))
356 t))
357
358
359
360;; Fontifify unseen mesages in bold.
361
362(defvar mh-folder-unseen-seq-name nil
363 "Name of unseen sequence.
364The default for this is provided by the function `mh-folder-unseen-seq-name'
365On nmh systems.")
366
367(defun mh-folder-unseen-seq-name ()
368 "Provide name of unseen sequence from mhparam."
369 (or mh-progs (mh-find-path))
370 (save-excursion
371 (let ((unseen-seq-name "unseen"))
372 (with-temp-buffer
373 (unwind-protect
374 (progn
375 (call-process (expand-file-name "mhparam" mh-progs)
376 nil '(t t) nil "-component" "Unseen-Sequence")
377 (goto-char (point-min))
378 (if (re-search-forward "Unseen-Sequence: \\(.*\\)$" nil t)
379 (setq unseen-seq-name (match-string 1))))))
380 unseen-seq-name)))
381
382(defun mh-folder-unseen-seq-list ()
383 "Return a list of unseen message numbers for current folder."
384 (if (not mh-folder-unseen-seq-name)
385 (setq mh-folder-unseen-seq-name (mh-folder-unseen-seq-name)))
386 (cond
387 ((not mh-folder-unseen-seq-name)
388 nil)
389 (t
390 (let ((folder mh-current-folder))
391 (save-excursion
392 (with-temp-buffer
393 (unwind-protect
394 (progn
395 (call-process (expand-file-name "mark" mh-progs)
396 nil '(t t) nil
397 folder "-seq" mh-folder-unseen-seq-name
398 "-list")
399 (goto-char (point-min))
400 (sort (mh-read-msg-list) '<)))))))))
401
402(defvar mh-folder-unseen-seq-cache nil
403 "Internal cache variable used for font-lock in MH-E.
404Should only be non-nil through font-lock stepping, and nil once font-lock
405is done highlighting.")
406(make-variable-buffer-local 'mh-folder-unseen-seq-cache)
407
408(defun mh-folder-font-lock-unseen (limit)
409 "Return unseen message lines to font-lock between point and LIMIT."
410 (if (not mh-folder-unseen-seq-cache)
411 (setq mh-folder-unseen-seq-cache (mh-folder-unseen-seq-list)))
412 (let ((cur-msg (mh-get-msg-num nil)))
413 (cond
414 ((not mh-folder-unseen-seq-cache)
415 nil)
416 ((not cur-msg) ;Presumably at end of buffer
417 (setq mh-folder-unseen-seq-cache nil)
418 nil)
419 ((member cur-msg mh-folder-unseen-seq-cache)
420 (let ((bpoint (progn (beginning-of-line)(point)))
421 (epoint (progn (forward-line 1)(point))))
422 (if (<= limit (point))
423 (setq mh-folder-unseen-seq-cache nil))
424 (set-match-data (list bpoint epoint bpoint epoint))
425 t))
426 (t
427 ;; move forward one line at a time, checking each message number.
428 (while (and
429 (= 0 (forward-line 1))
430 (> limit (point))
431 (not (member (mh-get-msg-num nil) mh-folder-unseen-seq-cache))))
432 ;; Examine how we must have exited the loop...
433 (let ((cur-msg (mh-get-msg-num nil)))
434 (cond
435 ((or (not cur-msg)
436 (<= limit (point))
437 (not (member cur-msg mh-folder-unseen-seq-cache)))
438 (setq mh-folder-unseen-seq-cache nil)
439 nil)
440 ((member cur-msg mh-folder-unseen-seq-cache)
441 (let ((bpoint (progn (beginning-of-line)(point)))
442 (epoint (progn (forward-line 1)(point))))
443 (if (<= limit (point))
444 (setq mh-folder-unseen-seq-cache nil))
445 (set-match-data (list bpoint epoint bpoint epoint))
446 t))))))))
447
448
449
450;;; Internal variables:
451
452(defvar mh-last-destination nil) ;Destination of last refile or write
453 ;command.
454(defvar mh-last-destination-folder nil) ;Destination of last refile command.
455(defvar mh-last-destination-write nil) ;Destination of last write command.
456
457(defvar mh-folder-mode-map (make-keymap)
458 "Keymap for MH folders.")
459
460(defvar mh-delete-list nil) ;List of msg numbers to delete.
461
462(defvar mh-refile-list nil) ;List of folder names in mh-seq-list.
463
464(defvar mh-next-direction 'forward) ;Direction to move to next message.
465
466(defvar mh-narrowed-to-seq nil) ;Sequence display is narrowed to or
467 ;nil if not narrowed.
468
469(defvar mh-view-ops ()) ;Stack of ops that change the folder
470 ;view (such as narrowing or threading).
471
472(defvar mh-index-data nil) ;Info about index search results
473(defvar mh-index-previous-search nil)
474(defvar mh-index-msg-checksum-map nil)
475(defvar mh-index-checksum-origin-map nil)
476
477(defvar mh-first-msg-num nil) ;Number of first msg in buffer.
478
479(defvar mh-last-msg-num nil) ;Number of last msg in buffer.
480
481(defvar mh-mode-line-annotation nil) ;Message range displayed in buffer.
482
483;;; Macros and generic functions:
484
485(defun mh-mapc (function list)
486 "Apply FUNCTION to each element of LIST for side effects only."
487 (while list
488 (funcall function (car list))
489 (setq list (cdr list))))
490
491(defun mh-scan-format ()
492 "Return \"-format\" argument for the scan program."
493 (if (equal mh-scan-format-file t)
494 (list "-format" (if mh-nmh-flag
495 (list (mh-update-scan-format
496 mh-scan-format-nmh mh-cmd-note))
497 (list (mh-update-scan-format
498 mh-scan-format-mh mh-cmd-note))))
499 (if (not (equal mh-scan-format-file nil))
500 (list "-format" mh-scan-format-file))))
501
502
503
504;;; Entry points:
505
506;;;###autoload
507(defun mh-rmail (&optional arg)
508 "Inc(orporate) new mail with MH.
509Scan an MH folder if ARG is non-nil. This function is an entry point to MH-E,
510the Emacs front end to the MH mail system."
511 (interactive "P")
512 (mh-find-path)
513 (if arg
514 (call-interactively 'mh-visit-folder)
515 (mh-inc-folder)))
516
517;;;###autoload
518(defun mh-nmail (&optional arg)
519 "Check for new mail in inbox folder.
520Scan an MH folder if ARG is non-nil. This function is an entry point to MH-E,
521the Emacs front end to the MH mail system."
522 (interactive "P")
523 (mh-find-path) ; init mh-inbox
524 (if arg
525 (call-interactively 'mh-visit-folder)
526 (mh-visit-folder mh-inbox)))
527
528
529
530;;; User executable MH-E commands:
531
532(defun mh-delete-msg (msg-or-seq)
533 "Mark the specified MSG-OR-SEQ for subsequent deletion and move to the next.
534
535Default is the displayed message. If optional prefix argument is given then
536prompt for the message sequence. If variable `transient-mark-mode' is non-nil
537and the mark is active, then the selected region is marked for deletion."
538 (interactive (list (cond
539 ((mh-mark-active-p t)
540 (mh-region-to-msg-list (region-beginning) (region-end)))
541 (current-prefix-arg
542 (mh-read-seq-default "Delete" t))
543 (t
544 (mh-get-msg-num t)))))
545 (mh-delete-msg-no-motion msg-or-seq)
546 (mh-next-msg))
547
548(defun mh-delete-msg-no-motion (msg-or-seq)
549 "Mark the specified MSG-OR-SEQ for subsequent deletion.
550Default is the displayed message. If optional prefix argument is provided,
551then prompt for the message sequence."
552 (interactive (list (if current-prefix-arg
553 (mh-read-seq-default "Delete" t)
554 (mh-get-msg-num t))))
555 (if (numberp msg-or-seq)
556 (mh-delete-a-msg msg-or-seq)
557 (mh-map-to-seq-msgs 'mh-delete-a-msg msg-or-seq)))
558
559(defun mh-execute-commands ()
560 "Process outstanding delete and refile requests."
561 (interactive)
562 (if mh-narrowed-to-seq (mh-widen))
563 (mh-process-commands mh-current-folder)
564 (mh-set-scan-mode)
565 (mh-goto-cur-msg) ; after mh-set-scan-mode for efficiency
566 (mh-make-folder-mode-line)
567 t) ; return t for write-file-functions
568
569(defun mh-first-msg ()
570 "Move to the first message."
571 (interactive)
572 (goto-char (point-min))
573 (while (and (not (eobp)) (not (looking-at mh-scan-valid-regexp)))
574 (forward-line 1)))
575
576(defun mh-header-display ()
577 "Show the current message with all its headers.
578Displays headers that might have been suppressed by setting the
579variables `mh-clean-message-header-flag' or `mhl-formfile', or by the fallback
580behavior of scrolling uninteresting headers off the top of the window.
581Type \"\\[mh-show]\" to show the message normally again."
582 (interactive)
583 (and (not mh-showing-with-headers)
584 (or mhl-formfile mh-clean-message-header-flag)
585 (mh-invalidate-show-buffer))
586 (let ((mh-decode-mime-flag nil)
587 (mhl-formfile nil)
588 (mh-clean-message-header-flag nil))
589 (mh-show-msg nil)
590 (mh-in-show-buffer (mh-show-buffer)
591 (goto-char (point-min))
592 (mh-recenter 0))
593 (setq mh-showing-with-headers t)))
594
595(defun mh-inc-folder (&optional maildrop-name)
596 "Inc(orporate)s new mail into the Inbox folder.
597Optional argument MAILDROP-NAME specifies an alternate maildrop from the
598default. If the prefix argument is given, incorporates mail into the current
599folder, otherwise uses the folder named by `mh-inbox'.
600The value of `mh-inc-folder-hook' is a list of functions to be called, with no
601arguments, after incorporating new mail.
602Do not call this function from outside MH-E; use \\[mh-rmail] instead."
603 (interactive (list (if current-prefix-arg
604 (expand-file-name
605 (read-file-name "inc mail from file: "
606 mh-user-path)))))
607 (let ((threading-needed-flag nil))
608 (let ((config (current-window-configuration)))
609 (if (not maildrop-name)
610 (cond ((not (get-buffer mh-inbox))
611 (mh-make-folder mh-inbox)
612 (setq threading-needed-flag mh-show-threads-flag)
613 (setq mh-previous-window-config config))
614 ((not (eq (current-buffer) (get-buffer mh-inbox)))
615 (switch-to-buffer mh-inbox)
616 (setq mh-previous-window-config config)))))
617 (mh-get-new-mail maildrop-name)
618 (when (and threading-needed-flag
619 (save-excursion
620 (goto-char (point-min))
621 (or (null mh-large-folder)
622 (not (equal (forward-line mh-large-folder) 0))
623 (and (message "Not threading since the number of messages exceeds `mh-large-folder'")
624 nil))))
625 (mh-toggle-threads))
626 (if mh-showing-mode (mh-show))
627 (run-hooks 'mh-inc-folder-hook)))
628
629(defun mh-last-msg ()
630 "Move to the last message."
631 (interactive)
632 (goto-char (point-max))
633 (while (and (not (bobp)) (not (looking-at mh-scan-valid-regexp)))
634 (forward-line -1))
635 (mh-recenter nil))
636
637(defun mh-next-undeleted-msg (&optional arg)
638 "Move to the next undeleted message ARG in window."
639 (interactive "p")
640 (setq mh-next-direction 'forward)
641 (forward-line 1)
642 (cond ((re-search-forward mh-scan-good-msg-regexp nil t arg)
643 (beginning-of-line)
644 (mh-maybe-show))
645 (t (forward-line -1)
646 (message "No more undeleted messages"))))
647
648(defun mh-refile-msg (msg-or-seq folder)
649 "Refile MSG-OR-SEQ (default: displayed message) into FOLDER.
650If optional prefix argument provided, then prompt for message sequence.
651If variable `transient-mark-mode' is non-nil and the mark is active, then the
652selected region is marked for refiling."
653 (interactive
654 (list (cond
655 ((mh-mark-active-p t)
656 (mh-region-to-msg-list (region-beginning) (region-end)))
657 (current-prefix-arg
658 (mh-read-seq-default "Refile" t))
659 (t
660 (mh-get-msg-num t)))
661 (intern
662 (mh-prompt-for-folder
663 "Destination"
664 (or (and mh-default-folder-for-message-function
665 (let ((refile-file (mh-msg-filename (mh-get-msg-num t))))
666 (save-excursion
667 (set-buffer (get-buffer-create mh-temp-buffer))
668 (erase-buffer)
669 (insert-file-contents refile-file)
670 (let ((buffer-file-name refile-file))
671 (funcall mh-default-folder-for-message-function)))))
672 (and (eq 'refile (car mh-last-destination-folder))
673 (symbol-name (cdr mh-last-destination-folder)))
674 "")
675 t))))
676 (setq mh-last-destination (cons 'refile folder)
677 mh-last-destination-folder mh-last-destination)
678 (if (numberp msg-or-seq)
679 (mh-refile-a-msg msg-or-seq folder)
680 (mh-map-to-seq-msgs 'mh-refile-a-msg msg-or-seq folder))
681 (mh-next-msg))
682
683(defun mh-refile-or-write-again (message)
684 "Re-execute the last refile or write command on the given MESSAGE.
685Default is the displayed message. Use the same folder or file as the previous
686refile or write command."
687 (interactive (list (mh-get-msg-num t)))
688 (if (null mh-last-destination)
689 (error "No previous refile or write"))
690 (cond ((eq (car mh-last-destination) 'refile)
691 (mh-refile-a-msg message (cdr mh-last-destination))
692 (message "Destination folder: %s" (cdr mh-last-destination)))
693 (t
694 (apply 'mh-write-msg-to-file message (cdr mh-last-destination))
695 (message "Destination: %s" (cdr mh-last-destination))))
696 (mh-next-msg))
697
698(defun mh-quit ()
699 "Quit the current MH-E folder.
700Restore the previous window configuration, if one exists.
701The value of `mh-before-quit-hook' is a list of functions to be called, with
702no arguments, immediately upon entry to this function.
703The value of `mh-quit-hook' is a list of functions to be called, with no
704arguments, upon exit of this function."
705 (interactive)
706 (run-hooks 'mh-before-quit-hook)
707 (let ((show-buffer (get-buffer mh-show-buffer)))
708 (when show-buffer
709 (kill-buffer show-buffer)))
710 (mh-update-sequences)
711 (mh-destroy-postponed-handles)
712 (bury-buffer (current-buffer))
713 (if (get-buffer mh-temp-buffer)
714 (kill-buffer mh-temp-buffer))
715 (if (get-buffer mh-temp-folders-buffer)
716 (kill-buffer mh-temp-folders-buffer))
717 (if (get-buffer mh-temp-sequences-buffer)
718 (kill-buffer mh-temp-sequences-buffer))
719 (if mh-previous-window-config
720 (set-window-configuration mh-previous-window-config))
721 (run-hooks 'mh-quit-hook))
722
723(defun mh-page-msg (&optional arg)
724 "Page the displayed message forwards.
725Scrolls ARG lines or a full screen if no argument is supplied. Show buffer
726first if not displayed. Show the next undeleted message if looking at the
727bottom of the current message."
728 (interactive "P")
729 (if mh-showing-mode
730 (if mh-page-to-next-msg-flag
731 (if (equal mh-next-direction 'backward)
732 (mh-previous-undeleted-msg)
733 (mh-next-undeleted-msg))
734 (if (mh-in-show-buffer (mh-show-buffer)
735 (pos-visible-in-window-p (point-max)))
736 (progn
737 (message (format
738 "End of message (Type %s to read %s undeleted message)"
739 (single-key-description last-input-event)
740 (if (equal mh-next-direction 'backward)
741 "previous"
742 "next")))
743 (setq mh-page-to-next-msg-flag t))
744 (scroll-other-window arg)))
745 (mh-show)))
746
747(defun mh-previous-page (&optional arg)
748 "Page the displayed message backwards.
749Scrolls ARG lines or a full screen if no argument is supplied."
750 (interactive "P")
751 (mh-in-show-buffer (mh-show-buffer)
752 (scroll-down arg)))
753
754(defun mh-previous-undeleted-msg (&optional arg)
755 "Move to the previous undeleted message ARG in window."
756 (interactive "p")
757 (setq mh-next-direction 'backward)
758 (beginning-of-line)
759 (cond ((re-search-backward mh-scan-good-msg-regexp nil t arg)
760 (mh-maybe-show))
761 (t (message "No previous undeleted message"))))
762
763(defun mh-previous-unread-msg (&optional count)
764 "Move to previous unread message.
765With optional argument COUNT, COUNT-1 unread messages before current message
766are skipped."
767 (interactive "p")
768 (unless (> count 0)
769 (error "The function mh-previous-unread-msg expects positive argument"))
770 (setq count (1- count))
771 (let ((unread-sequence (cdr (assoc mh-unseen-seq mh-seq-list)))
772 (cur-msg (mh-get-msg-num nil)))
773 (cond ((and (not cur-msg) (not (bobp))
774 ;; If we are at the end of the buffer back up one line and go
775 ;; to unread message after that.
776 (progn
777 (forward-line -1)
778 (setq cur-msg (mh-get-msg-num nil)))
779 nil))
780 ((or (null unread-sequence) (not cur-msg))
781 ;; No unread message or there aren't any messages in buffer...
782 (message "No more unread messages"))
783 ((progn
784 ;; Skip count messages...
785 (while (and unread-sequence (>= (car unread-sequence) cur-msg))
786 (setq unread-sequence (cdr unread-sequence)))
787 (while (> count 0)
788 (setq unread-sequence (cdr unread-sequence))
789 (setq count (1- count)))
790 (not (car unread-sequence)))
791 (message "No more unread messages"))
792 (t (mh-goto-msg (car unread-sequence))))))
793
794(defun mh-goto-next-button (backward-flag &optional criterion)
795 "Search for next button satisfying criterion.
796If BACKWARD-FLAG is non-nil search backward in the buffer for a mime button. If
797CRITERION is a function or a symbol which has a function binding then that
798function must return non-nil at the button we stop."
799 (unless (or (and (symbolp criterion) (fboundp criterion))
800 (functionp criterion))
801 (setq criterion (lambda (x) t)))
802 ;; Move to the next button in the buffer satisfying criterion
803 (goto-char (or (save-excursion
804 (beginning-of-line)
805 ;; Find point before current button
806 (let ((point-before-current-button
807 (save-excursion
808 (while (get-text-property (point) 'mh-data)
809 (unless (= (forward-line
810 (if backward-flag 1 -1))
811 0)
812 (if backward-flag
813 (goto-char (point-min))
814 (goto-char (point-max)))))
815 (point))))
816 ;; Skip over current button
817 (while (and (get-text-property (point) 'mh-data)
818 (not (if backward-flag (bobp) (eobp))))
819 (forward-line (if backward-flag -1 1)))
820 ;; Stop at next MIME button if any exists.
821 (block loop
822 (while (/= (progn
823 (unless (= (forward-line
824 (if backward-flag -1 1))
825 0)
826 (if backward-flag
827 (goto-char (point-max))
828 (goto-char (point-min)))
829 (beginning-of-line))
830 (point))
831 point-before-current-button)
832 (when (and (get-text-property (point) 'mh-data)
833 (funcall criterion (point)))
834 (return-from loop (point))))
835 nil)))
836 (point))))
837
838(defun mh-next-button (&optional backward-flag)
839 "Go to the next MIME button.
840Advance point to the next MIME button in the show buffer. If the end
841of buffer is reached then the search wraps over to the start of the
842buffer. With prefix argument, BACKWARD-FLAG the point will move to the
843previous MIME button."
844 (interactive (list current-prefix-arg))
845 (unless mh-showing-mode
846 (mh-show))
847 (mh-in-show-buffer (mh-show-buffer)
848 (mh-goto-next-button backward-flag)))
849
850(defun mh-prev-button ()
851 "Go to the prev MIME button.
852Move point to the previous MIME button in the show buffer. If the beginning
853of the buffer is reached then the search wraps over to the end of the
854buffer."
855 (interactive)
856 (mh-next-button t))
857
858(defun mh-folder-mime-action (part-index action include-security-flag)
859 "Go to PART-INDEX and carry out ACTION.
860If PART-INDEX is nil then go to the next part in the buffer. The search for
861the next buffer wraps around if end of buffer is reached. If argument
862INCLUDE-SECURITY-FLAG is non-nil then include security info buttons when
863searching for a suitable parts."
864 (unless mh-showing-mode
865 (mh-show))
866 (mh-in-show-buffer (mh-show-buffer)
867 (let ((criterion
868 (cond (part-index
869 (lambda (p)
870 (let ((part (get-text-property p 'mh-part)))
871 (and (integerp part) (= part part-index)))))
872 (t (lambda (p)
873 (if include-security-flag
874 (get-text-property p 'mh-data)
875 (integerp (get-text-property p 'mh-part)))))))
876 (point (point)))
877 (cond ((and (get-text-property point 'mh-part)
878 (or (null part-index)
879 (= (get-text-property point 'mh-part) part-index)))
880 (funcall action))
881 ((and (get-text-property point 'mh-data)
882 include-security-flag
883 (null part-index))
884 (funcall action))
885 (t
886 (mh-goto-next-button nil criterion)
887 (if (= (point) point)
888 (message "No matching MIME part found")
889 (funcall action)))))))
890
891(defun mh-folder-toggle-mime-part (part-index)
892 "Toggle display of button.
893If point in show buffer is at a button then that part is toggled.
894If not at a button and PART-INDEX is non-nil point is moved to that part.
895With nil PART-INDEX find the first button after point (search wraps around if
896end of buffer is reached) and toggle it."
897 (interactive "P")
898 (when (consp part-index) (setq part-index (car part-index)))
899 (mh-folder-mime-action part-index #'mh-press-button t))
900
901(defun mh-folder-inline-mime-part (part-index)
902 "Show the raw bytes of MIME part inline.
903If point in show buffer is at a mime part then that part is inlined.
904If not at a mime-part and PART-INDEX is non-nil point is moved to that part.
905With nil PART-INDEX find the first button after point (search wraps around if
906end of buffer is reached) and inline it."
907 (interactive "P")
908 (when (consp part-index) (setq part-index (car part-index)))
909 (mh-folder-mime-action part-index #'mh-mime-inline-part nil))
910
911(defun mh-folder-save-mime-part (part-index)
912 "Save MIME part.
913If point in show buffer is at a mime part then that part is saved.
914If not at a mime-part and PART-INDEX is non-nil point is moved to that part.
915With nil PART-INDEX find the first button after point (search wraps around if
916end of buffer is reached) and save it."
917 (interactive "P")
918 (when (consp part-index) (setq part-index (car part-index)))
919 (mh-folder-mime-action part-index #'mh-mime-save-part nil))
920
921(defun mh-reset-threads-and-narrowing ()
922 "Reset all variables pertaining to threads and narrowing.
923Also removes all content from the folder buffer."
924 (setq mh-view-ops ())
925 (setq mh-narrowed-to-seq nil)
926 (let ((buffer-read-only nil)) (erase-buffer)))
927
928(defun mh-rescan-folder (&optional range dont-exec-pending)
929 "Rescan a folder after optionally processing the outstanding commands.
930If optional prefix argument RANGE is provided, prompt for the range of
931messages to display. Otherwise show the entire folder.
932If optional argument DONT-EXEC-PENDING is non-nil then pending deletes and
933refiles aren't carried out."
934 (interactive (list (if current-prefix-arg
935 (mh-read-msg-range mh-current-folder t)
936 nil)))
937 (setq mh-next-direction 'forward)
938 (let ((threaded-flag (memq 'unthread mh-view-ops)))
939 (mh-reset-threads-and-narrowing)
940 (mh-scan-folder mh-current-folder (or range "all") dont-exec-pending)
941 (cond (threaded-flag (mh-toggle-threads))
942 (mh-index-data (mh-index-insert-folder-headers)))))
943
944(defun mh-write-msg-to-file (msg file no-headers)
945 "Append MSG to the end of a FILE.
946If prefix argument NO-HEADERS is provided, write only the message body.
947Otherwise send the entire message including the headers."
948 (interactive
949 (list (mh-get-msg-num t)
950 (let ((default-dir (if (eq 'write (car mh-last-destination-write))
951 (file-name-directory
952 (car (cdr mh-last-destination-write)))
953 default-directory)))
954 (read-file-name (format "Save message%s in file: "
955 (if current-prefix-arg " body" ""))
956 default-dir
957 (if (eq 'write (car mh-last-destination-write))
958 (car (cdr mh-last-destination-write))
959 (expand-file-name "mail.out" default-dir))))
960 current-prefix-arg))
961 (let ((msg-file-to-output (mh-msg-filename msg))
962 (output-file (mh-expand-file-name file)))
963 (setq mh-last-destination (list 'write file (if no-headers 'no-headers))
964 mh-last-destination-write mh-last-destination)
965 (save-excursion
966 (set-buffer (get-buffer-create mh-temp-buffer))
967 (erase-buffer)
968 (insert-file-contents msg-file-to-output)
969 (goto-char (point-min))
970 (if no-headers (search-forward "\n\n"))
971 (append-to-file (point) (point-max) output-file))))
972
973(defun mh-toggle-showing ()
974 "Toggle the scanning mode/showing mode of displaying messages."
975 (interactive)
976 (if mh-showing-mode
977 (mh-set-scan-mode)
978 (mh-show)))
979
980(defun mh-undo (msg-or-seq)
981 "Undo the pending deletion or refile of the specified MSG-OR-SEQ.
982Default is the displayed message.
983If optional prefix argument is provided, then prompt for the message sequence.
984If variable `transient-mark-mode' is non-nil and the mark is active, then the
985selected region is unmarked."
986 (interactive (list (cond
987 ((mh-mark-active-p t)
988 (mh-region-to-msg-list (region-beginning) (region-end)))
989 (current-prefix-arg
990 (mh-read-seq-default "Undo" t))
991 (t
992 (mh-get-msg-num t)))))
993 (cond ((numberp msg-or-seq)
994 (let ((original-position (point)))
995 (beginning-of-line)
996 (while (not (or (looking-at mh-scan-deleted-msg-regexp)
997 (looking-at mh-scan-refiled-msg-regexp)
998 (and (eq mh-next-direction 'forward) (bobp))
999 (and (eq mh-next-direction 'backward)
1000 (save-excursion (forward-line) (eobp)))))
1001 (forward-line (if (eq mh-next-direction 'forward) -1 1)))
1002 (if (or (looking-at mh-scan-deleted-msg-regexp)
1003 (looking-at mh-scan-refiled-msg-regexp))
1004 (progn
1005 (mh-undo-msg (mh-get-msg-num t))
1006 (mh-maybe-show))
1007 (goto-char original-position)
1008 (error "Nothing to undo"))))
1009 (t
1010 (mh-map-to-seq-msgs 'mh-undo-msg msg-or-seq)))
1011 (if (not (mh-outstanding-commands-p))
1012 (mh-set-folder-modified-p nil)))
1013
1014;;;###mh-autoload
1015(defun mh-folder-line-matches-show-buffer-p ()
1016 "Return t if the message under point in folder-mode is in the show buffer.
1017Return nil in any other circumstance (no message under point, no show buffer,
1018the message in the show buffer doesn't match."
1019 (and (eq major-mode 'mh-folder-mode)
1020 (mh-get-msg-num nil)
1021 mh-show-buffer
1022 (get-buffer mh-show-buffer)
1023 (buffer-file-name (get-buffer mh-show-buffer))
1024 (string-match ".*/\\([0-9]+\\)$"
1025 (buffer-file-name (get-buffer mh-show-buffer)))
1026 (string-equal
1027 (match-string 1 (buffer-file-name (get-buffer mh-show-buffer)))
1028 (int-to-string (mh-get-msg-num nil)))))
1029
1030(eval-when-compile (require 'gnus))
1031
1032(defmacro mh-macro-expansion-time-gnus-version ()
1033 "Return Gnus version available at macro expansion time.
1034The macro evaluates the Gnus version at macro expansion time. If MH-E was
1035compiled then macro expansion happens at compile time."
1036 gnus-version)
1037
1038(defun mh-run-time-gnus-version ()
1039 "Return Gnus version available at run time."
1040 (require 'gnus)
1041 gnus-version)
1042
1043;;;###autoload
1044(defun mh-version ()
1045 "Display version information about MH-E and the MH mail handling system."
1046 (interactive)
1047 (mh-find-progs)
1048 (set-buffer (get-buffer-create mh-temp-buffer))
1049 (erase-buffer)
1050 ;; MH-E version.
1051 (insert "MH-E " mh-version "\n\n")
1052 ;; MH-E compilation details.
1053 (insert "MH-E compilation details:\n")
1054 (let* ((compiled-mhe (byte-code-function-p (symbol-function 'mh-version)))
1055 (gnus-compiled-version (if compiled-mhe
1056 (mh-macro-expansion-time-gnus-version)
1057 "N/A")))
1058 (insert " Byte compiled:\t\t" (if compiled-mhe "yes" "no") "\n"
1059 " Gnus (compile-time):\t" gnus-compiled-version "\n"
1060 " Gnus (run-time):\t" (mh-run-time-gnus-version) "\n\n"))
1061 ;; Emacs version.
1062 (insert (emacs-version) "\n\n")
1063 ;; MH version.
1064 (let ((help-start (point)))
1065 (condition-case err-data
1066 (mh-exec-cmd-output "inc" nil (if mh-nmh-flag "-version" "-help"))
1067 (file-error (insert (mapconcat 'concat (cdr err-data) ": ") "\n")))
1068 (goto-char help-start)
1069 (if mh-nmh-flag
1070 (search-forward "inc -- " nil t)
1071 (search-forward "version: " nil t))
1072 (delete-region help-start (point)))
1073 (goto-char (point-max))
1074 (insert " mh-progs:\t" mh-progs "\n"
1075 " mh-lib:\t" mh-lib "\n"
1076 " mh-lib-progs:\t" mh-lib-progs "\n\n")
1077 ;; Linux version.
1078 (condition-case ()
1079 (call-process "uname" nil t nil "-a")
1080 (file-error))
1081 (goto-char (point-min))
1082 (display-buffer mh-temp-buffer))
1083
1084(defun mh-parse-flist-output-line (line)
1085 "Parse LINE to generate folder name, unseen messages and total messages."
1086 (with-temp-buffer
1087 (insert line)
1088 (goto-char (point-max))
1089 (let (folder unseen total p)
1090 (when (search-backward " out of " (point-min) t)
1091 (setq total (read-from-string
1092 (buffer-substring-no-properties
1093 (match-end 0) (line-end-position))))
1094 (when (search-backward " in sequence " (point-min) t)
1095 (setq p (point))
1096 (when (search-backward " has " (point-min) t)
1097 (setq unseen (read-from-string (buffer-substring-no-properties
1098 (match-end 0) p)))
1099 (while (or (eq (char-after) ?+) (eq (char-after) ? ))
1100 (backward-char))
1101 (setq folder (buffer-substring-no-properties
1102 (point-min) (1+ (point))))
1103 (values (format "+%s" folder) (car unseen) (car total))))))))
1104
1105(defun mh-folder-size (folder)
1106 "Find size of FOLDER."
1107 (with-temp-buffer
1108 (call-process (expand-file-name "flist" mh-progs) nil t nil
1109 "-norecurse" folder)
1110 (goto-char (point-min))
1111 (multiple-value-bind (folder1 unseen total)
1112 (mh-parse-flist-output-line
1113 (buffer-substring (point) (line-end-position)))
1114 (unless (equal folder folder1)
1115 (error "Call to flist failed on folder %s" folder))
1116 (values total unseen))))
1117
1118(defun mh-visit-folder (folder &optional range index-data)
1119 "Visit FOLDER and display RANGE of messages.
1120Do not call this function from outside MH-E; see \\[mh-rmail] instead.
1121
1122If RANGE is nil (the default if it is omitted when called non-interactively),
1123then all messages in FOLDER are displayed.
1124
1125If an index buffer is being created then INDEX-DATA is used to initialize the
1126index buffer specific data structures."
1127 (interactive (let ((folder-name (mh-prompt-for-folder "Visit" mh-inbox t)))
1128 (list folder-name (mh-read-msg-range folder-name))))
1129 (let ((config (current-window-configuration))
1130 (threaded-view-flag mh-show-threads-flag))
1131 (save-excursion
1132 (when (get-buffer folder)
1133 (set-buffer folder)
1134 (setq threaded-view-flag (memq 'unthread mh-view-ops))
1135 (mh-reset-threads-and-narrowing)))
1136 (when index-data
1137 (mh-make-folder folder)
1138 (setq mh-index-data (car index-data)
1139 mh-index-msg-checksum-map (make-hash-table :test #'equal)
1140 mh-index-checksum-origin-map (make-hash-table :test #'equal))
1141 (mh-index-update-maps folder (cadr index-data)))
1142 (mh-scan-folder folder (or range "all"))
1143 (cond ((and threaded-view-flag
1144 (save-excursion
1145 (goto-char (point-min))
1146 (or (null mh-large-folder)
1147 (not (equal (forward-line mh-large-folder) 0))
1148 (and (message "Not threading since the number of messages exceeds `mh-large-folder'")
1149 nil))))
1150 (mh-toggle-threads))
1151 (mh-index-data
1152 (mh-index-insert-folder-headers)))
1153 (unless mh-showing-mode (delete-other-windows))
1154 (setq mh-previous-window-config config))
1155 nil)
1156
1157;;;###mh-autoload
1158(defun mh-update-sequences ()
1159 "Update MH's Unseen-Sequence and current folder and message.
1160Flush MH-E's state out to MH. The message at the cursor becomes current."
1161 (interactive)
1162 ;; mh-update-sequences is the opposite of mh-read-folder-sequences,
1163 ;; which updates MH-E's state from MH.
1164 (let ((folder-set (mh-update-unseen))
1165 (new-cur (mh-get-msg-num nil)))
1166 (if new-cur
1167 (let ((seq-entry (mh-find-seq 'cur)))
1168 (mh-remove-cur-notation)
1169 (setcdr seq-entry
1170 (list new-cur)) ;delete-seq-locally, add-msgs-to-seq
1171 (mh-define-sequence 'cur (list new-cur))
1172 (beginning-of-line)
1173 (if (looking-at mh-scan-good-msg-regexp)
1174 (mh-notate nil mh-note-cur mh-cmd-note)))
1175 (or folder-set
1176 (save-excursion
1177 ;; psg - mh-current-folder is nil if mh-summary-height < 4 !
1178 ;; So I added this sanity check.
1179 (if (stringp mh-current-folder)
1180 (mh-exec-cmd-quiet t "folder" mh-current-folder "-fast")
1181 (mh-exec-cmd-quiet t "folder" "-fast")))))))
1182
1183
1184
1185;;; Support routines.
1186
1187(defun mh-delete-a-msg (msg)
1188 "Delete the MSG.
1189The value of `mh-delete-msg-hook' is a list of functions to be called, with no
1190arguments, after the message has been deleted."
1191 (save-excursion
1192 (mh-goto-msg msg nil t)
1193 (if (looking-at mh-scan-refiled-msg-regexp)
1194 (error "Message %d is refiled. Undo refile before deleting" msg))
1195 (if (looking-at mh-scan-deleted-msg-regexp)
1196 nil
1197 (mh-set-folder-modified-p t)
1198 (setq mh-delete-list (cons msg mh-delete-list))
1199 (mh-notate msg mh-note-deleted mh-cmd-note)
1200 (run-hooks 'mh-delete-msg-hook))))
1201
1202(defun mh-refile-a-msg (msg folder)
1203 "Refile MSG in FOLDER.
1204Folder is a symbol, not a string.
1205The value of `mh-refile-msg-hook' is a list of functions to be called, with no
1206arguments, after the message has been refiled."
1207 (save-excursion
1208 (mh-goto-msg msg nil t)
1209 (cond ((looking-at mh-scan-deleted-msg-regexp)
1210 (error "Message %d is deleted. Undo delete before moving" msg))
1211 ((looking-at mh-scan-refiled-msg-regexp)
1212 (if (y-or-n-p
1213 (format "Message %d already refiled. Copy to %s as well? "
1214 msg folder))
1215 (mh-exec-cmd "refile" (mh-get-msg-num t) "-link"
1216 "-src" mh-current-folder
1217 (symbol-name folder))
1218 (message "Message not copied.")))
1219 (t
1220 (mh-set-folder-modified-p t)
1221 (cond ((null (assoc folder mh-refile-list))
1222 (push (list folder msg) mh-refile-list))
1223 ((not (member msg (cdr (assoc folder mh-refile-list))))
1224 (push msg (cdr (assoc folder mh-refile-list)))))
1225 (mh-notate msg mh-note-refiled mh-cmd-note)
1226 (run-hooks 'mh-refile-msg-hook)))))
1227
1228(defun mh-next-msg ()
1229 "Move backward or forward to the next undeleted message in the buffer."
1230 (if (eq mh-next-direction 'forward)
1231 (mh-next-undeleted-msg 1)
1232 (mh-previous-undeleted-msg 1)))
1233
1234(defun mh-next-unread-msg (&optional count)
1235 "Move to next unread message.
1236With optional argument COUNT, COUNT-1 unread messages are skipped."
1237 (interactive "p")
1238 (unless (> count 0)
1239 (error "The function mh-next-unread-msg expects positive argument"))
1240 (setq count (1- count))
1241 (let ((unread-sequence (reverse (cdr (assoc mh-unseen-seq mh-seq-list))))
1242 (cur-msg (mh-get-msg-num nil)))
1243 (cond ((and (not cur-msg) (not (bobp))
1244 ;; If we are at the end of the buffer back up one line and go
1245 ;; to unread message after that.
1246 (progn
1247 (forward-line -1)
1248 (setq cur-msg (mh-get-msg-num nil)))
1249 nil))
1250 ((or (null unread-sequence) (not cur-msg))
1251 ;; No unread message or there aren't any messages in buffer...
1252 (message "No more unread messages"))
1253 ((progn
1254 ;; Skip messages
1255 (while (and unread-sequence (>= cur-msg (car unread-sequence)))
1256 (setq unread-sequence (cdr unread-sequence)))
1257 (while (> count 0)
1258 (setq unread-sequence (cdr unread-sequence))
1259 (setq count (1- count)))
1260 (not (car unread-sequence)))
1261 (message "No more unread messages"))
1262 (t (mh-goto-msg (car unread-sequence))))))
1263
1264(defun mh-set-scan-mode ()
1265 "Display the scan listing buffer, but do not show a message."
1266 (if (get-buffer mh-show-buffer)
1267 (delete-windows-on mh-show-buffer))
1268 (mh-showing-mode 0)
1269 (force-mode-line-update)
1270 (if mh-recenter-summary-flag
1271 (mh-recenter nil)))
1272
1273(defun mh-undo-msg (msg)
1274 "Undo the deletion or refile of one MSG."
1275 (cond ((memq msg mh-delete-list)
1276 (setq mh-delete-list (delq msg mh-delete-list)))
1277 (t
1278 (dolist (folder-msg-list mh-refile-list)
1279 (setf (cdr folder-msg-list) (remove msg (cdr folder-msg-list))))
1280 (setq mh-refile-list (loop for x in mh-refile-list
1281 unless (null (cdr x)) collect x))))
1282 (mh-notate msg ? mh-cmd-note))
1283
1284
1285
1286;;; The folder data abstraction.
1287
1288(defun mh-make-folder (name)
1289 "Create a new mail folder called NAME.
1290Make it the current folder."
1291 (switch-to-buffer name)
1292 (setq buffer-read-only nil)
1293 (erase-buffer)
1294 (if mh-adaptive-cmd-note-flag
1295 (mh-set-cmd-note (mh-message-number-width name)))
1296 (setq buffer-read-only t)
1297 (mh-folder-mode)
1298 (mh-set-folder-modified-p nil)
1299 (setq buffer-file-name mh-folder-filename)
1300 (mh-make-folder-mode-line))
1301
1302;;; Ensure new buffers won't get this mode if default-major-mode is nil.
1303(put 'mh-folder-mode 'mode-class 'special)
1304
1305
1306
1307;;; Menu extracted from mh-menubar.el V1.1 (31 July 2001)
1308;;; Menus for folder mode: folder, message, sequence (in that order)
1309;;; folder-mode "Sequence" menu
1310(easy-menu-define
1311 mh-folder-sequence-menu mh-folder-mode-map "Menu for MH-E folder-sequence."
1312 '("Sequence"
1313 ["Add Message to Sequence..." mh-put-msg-in-seq (mh-get-msg-num nil)]
1314 ["List Sequences for Message" mh-msg-is-in-seq (mh-get-msg-num nil)]
1315 ["Delete Message from Sequence..." mh-delete-msg-from-seq
1316 (mh-get-msg-num nil)]
1317 ["List Sequences in Folder..." mh-list-sequences t]
1318 ["Delete Sequence..." mh-delete-seq t]
1319 ["Narrow to Sequence..." mh-narrow-to-seq t]
1320 ["Widen from Sequence" mh-widen mh-narrowed-to-seq]
1321 "--"
1322 ["Narrow to Subject Sequence" mh-narrow-to-subject t]
1323 ["Delete Rest of Same Subject" mh-delete-subject t]
1324 "--"
1325 ["Push State Out to MH" mh-update-sequences t]))
1326
1327;;; folder-mode "Message" menu
1328(easy-menu-define
1329 mh-folder-message-menu mh-folder-mode-map "Menu for MH-E folder-message."
1330 '("Message"
1331 ["Show Message" mh-show (mh-get-msg-num nil)]
1332 ["Show Message with Header" mh-header-display (mh-get-msg-num nil)]
1333 ["Next Message" mh-next-undeleted-msg t]
1334 ["Previous Message" mh-previous-undeleted-msg t]
1335 ["Go to First Message" mh-first-msg t]
1336 ["Go to Last Message" mh-last-msg t]
1337 ["Go to Message by Number..." mh-goto-msg t]
1338 ["Modify Message" mh-modify]
1339 ["Delete Message" mh-delete-msg (mh-get-msg-num nil)]
1340 ["Refile Message" mh-refile-msg (mh-get-msg-num nil)]
1341 ["Undo Delete/Refile" mh-undo t]
1342 ["Process Delete/Refile" mh-execute-commands
1343 (or mh-refile-list mh-delete-list)]
1344 "--"
1345 ["Compose a New Message" mh-send t]
1346 ["Reply to Message..." mh-reply (mh-get-msg-num nil)]
1347 ["Forward Message..." mh-forward (mh-get-msg-num nil)]
1348 ["Redistribute Message..." mh-redistribute (mh-get-msg-num nil)]
1349 ["Edit Message Again" mh-edit-again (mh-get-msg-num nil)]
1350 ["Re-edit a Bounced Message" mh-extract-rejected-mail t]
1351 "--"
1352 ["Copy Message to Folder..." mh-copy-msg (mh-get-msg-num nil)]
1353 ["Print Message" mh-print-msg (mh-get-msg-num nil)]
1354 ["Write Message to File..." mh-write-msg-to-file
1355 (mh-get-msg-num nil)]
1356 ["Pipe Message to Command..." mh-pipe-msg (mh-get-msg-num nil)]
1357 ["Unpack Uuencoded Message..." mh-store-msg (mh-get-msg-num nil)]
1358 ["Burst Digest Message" mh-burst-digest (mh-get-msg-num nil)]))
1359
1360;;; folder-mode "Folder" menu
1361(easy-menu-define
1362 mh-folder-folder-menu mh-folder-mode-map "Menu for MH-E folder."
1363 '("Folder"
1364 ["Incorporate New Mail" mh-inc-folder t]
1365 ["Toggle Show/Folder" mh-toggle-showing t]
1366 ["Execute Delete/Refile" mh-execute-commands
1367 (or mh-refile-list mh-delete-list)]
1368 ["Rescan Folder" mh-rescan-folder t]
1369 ["Thread Folder" mh-toggle-threads
1370 (not (memq 'unthread mh-view-ops))]
1371 ["Pack Folder" mh-pack-folder t]
1372 ["Sort Folder" mh-sort-folder t]
1373 "--"
1374 ["List Folders" mh-list-folders t]
1375 ["Visit a Folder..." mh-visit-folder t]
1376 ["Search a Folder..." mh-search-folder t]
1377 ["Indexed Search..." mh-index-search t]
1378 "--"
1379 ["Quit MH-E" mh-quit t]))
1380
1381
1382
1383(defmacro mh-remove-xemacs-horizontal-scrollbar ()
1384 "Get rid of the horizontal scrollbar that XEmacs insists on putting in."
1385 (when mh-xemacs-flag
1386 `(if (and (featurep 'scrollbar)
1387 (fboundp 'set-specifier))
1388 (set-specifier horizontal-scrollbar-visible-p nil
1389 (cons (current-buffer) nil)))))
1390
1391(defmacro mh-write-file-functions-compat ()
1392 "Return `write-file-functions' if it exists.
1393Otherwise return `local-write-file-hooks'. This macro exists purely for
1394compatibility. The former symbol is used in Emacs 21.4 onward while the latter
1395is used in previous versions and XEmacs."
1396 (if (boundp 'write-file-functions)
1397 ''write-file-functions ;Emacs 21.4
1398 ''local-write-file-hooks)) ;<Emacs 21.4, XEmacs
1399
1400(define-derived-mode mh-folder-mode fundamental-mode "MH-Folder"
1401 "Major MH-E mode for \"editing\" an MH folder scan listing.\\<mh-folder-mode-map>
1402
1403You can show the message the cursor is pointing to, and step through the
1404messages. Messages can be marked for deletion or refiling into another
1405folder; these commands are executed all at once with a separate command.
1406
1407A prefix argument (\\[universal-argument]) to delete, refile, list, or undo
1408applies the action to a message sequence. If `transient-mark-mode',
1409is non-nil, the action is applied to the region.
1410
1411Options that control this mode can be changed with \\[customize-group];
1412specify the \"mh\" group. In particular, please see the `mh-scan-format-file'
1413option if you wish to modify scan's format.
1414
1415When a folder is visited, the hook `mh-folder-mode-hook' is run.
1416
1417\\{mh-folder-mode-map}"
1418
1419 (make-local-variable 'font-lock-defaults)
1420 (setq font-lock-defaults '(mh-folder-font-lock-keywords t))
1421 (mh-make-local-vars
1422 'mh-current-folder (buffer-name) ; Name of folder, a string
1423 'mh-show-buffer (format "show-%s" (buffer-name)) ; Buffer that displays msgs
1424 'mh-folder-filename ; e.g. "/usr/foobar/Mail/inbox/"
1425 (file-name-as-directory (mh-expand-file-name (buffer-name)))
1426 'mh-showing-mode nil ; Show message also?
1427 'mh-delete-list nil ; List of msgs nums to delete
1428 'mh-refile-list nil ; List of folder names in mh-seq-list
1429 'mh-seq-list nil ; Alist of (seq . msgs) nums
1430 'mh-seen-list nil ; List of displayed messages
1431 'mh-next-direction 'forward ; Direction to move to next message
1432 'mh-narrowed-to-seq nil ; Sequence display is narrowed to
1433 'mh-view-ops () ; Stack that keeps track of the order
1434 ; in which narrowing/threading has been
1435 ; carried out.
1436 'mh-index-data nil ; If the folder was created by a call
1437 ; to mh-index-search this contains info
1438 ; about the search results.
1439 'mh-index-previous-search nil ; Previous folder and search-regexp
1440 'mh-index-msg-checksum-map nil ; msg -> checksum map
1441 'mh-index-checksum-origin-map nil ; checksum -> ( orig-folder, orig-msg )
1442 'mh-first-msg-num nil ; Number of first msg in buffer
1443 'mh-last-msg-num nil ; Number of last msg in buffer
1444 'mh-msg-count nil ; Number of msgs in buffer
1445 'mh-mode-line-annotation nil ; Indicates message range
1446 'mh-previous-window-config nil) ; Previous window configuration
1447 (mh-remove-xemacs-horizontal-scrollbar)
1448 (setq truncate-lines t)
1449 (auto-save-mode -1)
1450 (setq buffer-offer-save t)
1451 (add-hook (mh-write-file-functions-compat) 'mh-execute-commands nil t)
1452 (make-local-variable 'revert-buffer-function)
1453 (make-local-variable 'hl-line-mode) ; avoid pollution
1454 (if (fboundp 'hl-line-mode)
1455 (hl-line-mode 1))
1456 (setq revert-buffer-function 'mh-undo-folder)
1457 (or (assq 'mh-showing-mode minor-mode-alist)
1458 (setq minor-mode-alist
1459 (cons '(mh-showing-mode " Show") minor-mode-alist)))
1460 (easy-menu-add mh-folder-sequence-menu)
1461 (easy-menu-add mh-folder-message-menu)
1462 (easy-menu-add mh-folder-folder-menu)
1463 (if (and (boundp 'tool-bar-mode) tool-bar-mode)
1464 (set (make-local-variable 'tool-bar-map) mh-folder-tool-bar-map))
1465 (if (and mh-xemacs-flag
1466 font-lock-auto-fontify)
1467 (turn-on-font-lock))) ; Force font-lock in XEmacs.
1468
1469(defun mh-make-local-vars (&rest pairs)
1470 "Initialize local variables according to the variable-value PAIRS."
1471
1472 (while pairs
1473 (set (make-local-variable (car pairs)) (car (cdr pairs)))
1474 (setq pairs (cdr (cdr pairs)))))
1475
1476(defun mh-scan-folder (folder range &optional dont-exec-pending)
1477 "Scan the FOLDER over the RANGE.
1478If the optional argument DONT-EXEC-PENDING is non-nil then pending deletes and
1479refiles aren't carried out.
1480Return in the folder's buffer."
1481 (cond ((null (get-buffer folder))
1482 (mh-make-folder folder))
1483 (t
1484 (or dont-exec-pending (mh-process-or-undo-commands folder))
1485 (switch-to-buffer folder)))
1486 (mh-regenerate-headers range)
1487 (if (zerop (buffer-size))
1488 (if (equal range "all")
1489 (message "Folder %s is empty" folder)
1490 (message "No messages in %s, range %s" folder range))
1491 (mh-goto-cur-msg))
1492 (save-excursion
1493 (when dont-exec-pending
1494 ;; Re-annotate messages to be refiled...
1495 (dolist (folder-msg-list mh-refile-list)
1496 (dolist (msg (cdr folder-msg-list))
1497 (mh-notate msg mh-note-refiled mh-cmd-note)))
1498 ;; Re-annotate messages to be deleted...
1499 (dolist (msg mh-delete-list)
1500 (mh-notate msg mh-note-deleted mh-cmd-note)))))
1501
1502(defun mh-set-cmd-note (width)
1503 "Set `mh-cmd-note' to WIDTH characters (minimum of 2).
1504
1505If `mh-scan-format-file' specifies nil or a filename, then this function
1506will NOT update `mh-cmd-note'."
1507 ;; Add one to the width to always have whitespace in column zero.
1508 (setq width (max (1+ width) 2))
1509 (if (and (equal mh-scan-format-file t)
1510 (not (eq mh-cmd-note width)))
1511 (setq mh-cmd-note width))
1512 mh-cmd-note)
1513
1514(defun mh-regenerate-headers (range &optional update)
1515 "Scan folder over range RANGE.
1516If UPDATE, append the scan lines, otherwise replace."
1517 (let ((folder mh-current-folder)
1518 (range (if (and range (atom range)) (list range) range))
1519 scan-start)
1520 (message "Scanning %s..." folder)
1521 (with-mh-folder-updating (nil)
1522 (if update
1523 (goto-char (point-max))
1524 (delete-region (point-min) (point-max))
1525 (if mh-adaptive-cmd-note-flag
1526 (mh-set-cmd-note (mh-message-number-width folder))))
1527 (setq scan-start (point))
1528 (apply #'mh-exec-cmd-output
1529 mh-scan-prog nil
1530 (mh-scan-format)
1531 "-noclear" "-noheader"
1532 "-width" (window-width)
1533 folder range)
1534 (goto-char scan-start)
1535 (cond ((looking-at "scan: no messages in")
1536 (keep-lines mh-scan-valid-regexp)) ; Flush random scan lines
1537 ((looking-at "scan: bad message list ")
1538 (keep-lines mh-scan-valid-regexp))
1539 ((looking-at "scan: ")) ; Keep error messages
1540 (t
1541 (keep-lines mh-scan-valid-regexp))) ; Flush random scan lines
1542 (setq mh-seq-list (mh-read-folder-sequences folder nil))
1543 (mh-notate-user-sequences)
1544 (or update
1545 (setq mh-mode-line-annotation
1546 (if (equal range '("all"))
1547 nil
1548 mh-partial-folder-mode-line-annotation)))
1549 (mh-make-folder-mode-line))
1550 (message "Scanning %s...done" folder)))
1551
1552(defun mh-generate-new-cmd-note (folder)
1553 "Fix the `mh-cmd-note' value for this FOLDER.
1554
1555After doing an `mh-get-new-mail' operation in this FOLDER, at least
1556one line that looks like a truncated message number was found.
1557
1558Remove the text added by the last `mh-inc' command. It should be the
1559messages cur-last. Call `mh-set-cmd-note' with the widest message number
1560in FOLDER.
1561
1562Reformat the message number width on each line in the buffer and trim
1563the line length to fit in the window.
1564
1565Rescan the FOLDER in the range cur-last in order to display the
1566messages that were removed earlier. They should all fit in the scan
1567line now with no message truncation."
1568 (save-excursion
1569 (let ((maxcol (1- (window-width)))
1570 (old-cmd-note mh-cmd-note)
1571 mh-cmd-note-fmt
1572 msgnum)
1573 ;; Nuke all of the lines just added by the last inc
1574 (delete-char (- (point-max) (point)))
1575 ;; Update the current buffer to reflect the new mh-cmd-note
1576 ;; value needed to display messages.
1577 (mh-set-cmd-note (mh-message-number-width folder))
1578 (setq mh-cmd-note-fmt (concat "%" (format "%d" mh-cmd-note) "d"))
1579 ;; Cleanup the messages that are in the buffer right now
1580 (goto-char (point-min))
1581 (cond ((memq 'unthread mh-view-ops)
1582 (mh-thread-add-spaces (- mh-cmd-note old-cmd-note)))
1583 (t (while (re-search-forward mh-scan-msg-number-regexp nil 0 1)
1584 ;; reformat the number to fix in mh-cmd-note columns
1585 (setq msgnum (string-to-number
1586 (buffer-substring
1587 (match-beginning 1) (match-end 1))))
1588 (replace-match (format mh-cmd-note-fmt msgnum))
1589 ;; trim the line to fix in the window
1590 (end-of-line)
1591 (let ((eol (point)))
1592 (move-to-column maxcol)
1593 (if (<= (point) eol)
1594 (delete-char (- eol (point))))))))
1595 ;; now re-read the lost messages
1596 (goto-char (point-max))
1597 (prog1 (point)
1598 (mh-regenerate-headers "cur-last" t)))))
1599
1600(defun mh-get-new-mail (maildrop-name)
1601 "Read new mail from MAILDROP-NAME into the current buffer.
1602Return in the current buffer."
1603 (let ((point-before-inc (point))
1604 (folder mh-current-folder)
1605 (new-mail-flag nil))
1606 (with-mh-folder-updating (t)
1607 (if maildrop-name
1608 (message "inc %s -file %s..." folder maildrop-name)
1609 (message "inc %s..." folder))
1610 (setq mh-next-direction 'forward)
1611 (goto-char (point-max))
1612 (let ((start-of-inc (point)))
1613 (mh-remove-cur-notation)
1614 (if maildrop-name
1615 ;; I think MH 5 used "-ms-file" instead of "-file",
1616 ;; which would make inc'ing from maildrops fail.
1617 (mh-exec-cmd-output mh-inc-prog nil folder
1618 (mh-scan-format)
1619 "-file" (expand-file-name maildrop-name)
1620 "-width" (window-width)
1621 "-truncate")
1622 (mh-exec-cmd-output mh-inc-prog nil
1623 (mh-scan-format)
1624 "-width" (window-width)))
1625 (if maildrop-name
1626 (message "inc %s -file %s...done" folder maildrop-name)
1627 (message "inc %s...done" folder))
1628 (goto-char start-of-inc)
1629 (cond ((save-excursion
1630 (re-search-forward "^inc: no mail" nil t))
1631 (message "No new mail%s%s" (if maildrop-name " in " "")
1632 (if maildrop-name maildrop-name "")))
1633 ((and (when mh-narrowed-to-seq
1634 (let ((saved-text (buffer-substring-no-properties
1635 start-of-inc (point-max))))
1636 (delete-region start-of-inc (point-max))
1637 (unwind-protect (mh-widen)
1638 (goto-char (point-max))
1639 (setq start-of-inc (point))
1640 (insert saved-text)
1641 (goto-char start-of-inc))))
1642 nil))
1643 ((re-search-forward "^inc:" nil t) ; Error messages
1644 (error "Error incorporating mail"))
1645 ((and
1646 (equal mh-scan-format-file t)
1647 mh-adaptive-cmd-note-flag
1648 ;; Have we reached an edge condition?
1649 (save-excursion
1650 (re-search-forward mh-scan-msg-overflow-regexp nil 0 1))
1651 (setq start-of-inc (mh-generate-new-cmd-note folder))
1652 nil))
1653 (t
1654 (setq new-mail-flag t)))
1655 (keep-lines mh-scan-valid-regexp) ; Flush random scan lines
1656 (setq mh-seq-list (mh-read-folder-sequences folder t))
1657 (when (equal (point-max) start-of-inc)
1658 (mh-notate-seq 'cur mh-note-cur mh-cmd-note))
1659 (mh-notate-user-sequences)
1660 (if new-mail-flag
1661 (progn
1662 (mh-make-folder-mode-line)
1663 (when (memq 'unthread mh-view-ops)
1664 (mh-thread-inc folder start-of-inc))
1665 (mh-goto-cur-msg))
1666 (goto-char point-before-inc))))))
1667
1668(defun mh-make-folder-mode-line (&optional ignored)
1669 "Set the fields of the mode line for a folder buffer.
1670The optional argument is now obsolete and IGNORED. It used to be used to pass
1671in what is now stored in the buffer-local variable `mh-mode-line-annotation'."
1672 (save-excursion
1673 (save-window-excursion
1674 (mh-first-msg)
1675 (let ((new-first-msg-num (mh-get-msg-num nil)))
1676 (when (or (not (memq 'unthread mh-view-ops))
1677 (null mh-first-msg-num)
1678 (null new-first-msg-num)
1679 (< new-first-msg-num mh-first-msg-num))
1680 (setq mh-first-msg-num new-first-msg-num)))
1681 (mh-last-msg)
1682 (let ((new-last-msg-num (mh-get-msg-num nil)))
1683 (when (or (not (memq 'unthread mh-view-ops))
1684 (null mh-last-msg-num)
1685 (null new-last-msg-num)
1686 (> new-last-msg-num mh-last-msg-num))
1687 (setq mh-last-msg-num new-last-msg-num)))
1688 (setq mh-msg-count (if mh-first-msg-num
1689 (count-lines (point-min) (point-max))
1690 0))
1691 (setq mode-line-buffer-identification
1692 (list (format "{%%b%s} %s msg%s"
1693 (if mh-mode-line-annotation
1694 (format "/%s" mh-mode-line-annotation)
1695 "")
1696 (if (zerop mh-msg-count)
1697 "no"
1698 (format "%d" mh-msg-count))
1699 (if (zerop mh-msg-count)
1700 "s"
1701 (cond ((> mh-msg-count 1)
1702 (format "s (%d-%d)" mh-first-msg-num
1703 mh-last-msg-num))
1704 (mh-first-msg-num
1705 (format " (%d)" mh-first-msg-num))
1706 ("")))))))))
1707
1708(defun mh-unmark-all-headers (remove-all-flags)
1709 "Remove all '+' flags from the folder listing.
1710With non-nil argument REMOVE-ALL-FLAGS, remove all 'D', '^' and '%' flags too.
1711Optimized for speed (i.e., no regular expressions)."
1712 (save-excursion
1713 (let ((case-fold-search nil)
1714 (last-line (1- (point-max)))
1715 char)
1716 (mh-first-msg)
1717 (while (<= (point) last-line)
1718 (forward-char mh-cmd-note)
1719 (setq char (following-char))
1720 (if (or (and remove-all-flags
1721 (or (= char (aref mh-note-deleted 0))
1722 (= char (aref mh-note-refiled 0))))
1723 (= char (aref mh-note-cur 0)))
1724 (progn
1725 (delete-char 1)
1726 (insert " ")))
1727 (if remove-all-flags
1728 (progn
1729 (forward-char 1)
1730 (if (= (following-char) (aref mh-note-seq 0))
1731 (progn
1732 (delete-char 1)
1733 (insert " ")))))
1734 (forward-line)))))
1735
1736(defun mh-remove-cur-notation ()
1737 "Remove old cur notation."
1738 (let ((cur-msg (car (mh-seq-to-msgs 'cur))))
1739 (save-excursion
1740 (and cur-msg
1741 (mh-goto-msg cur-msg t t)
1742 (looking-at mh-scan-cur-msg-number-regexp)
1743 (mh-notate nil ? mh-cmd-note)))))
1744
1745(defun mh-remove-all-notation ()
1746 "Remove all notations on all scan lines that MH-E introduces."
1747 (save-excursion
1748 (goto-char (point-min))
1749 (while (not (eobp))
1750 (unless (or (equal (char-after) ?+) (eolp))
1751 (mh-notate nil ? mh-cmd-note)
1752 (when (eq (char-after (+ (point) mh-cmd-note 1)) (elt mh-note-seq 0))
1753 (mh-notate nil ? (1+ mh-cmd-note))))
1754 (forward-line))))
1755
1756;;;###mh-autoload
1757(defun mh-goto-cur-msg (&optional minimal-changes-flag)
1758 "Position the cursor at the current message.
1759When optional argument MINIMAL-CHANGES-FLAG is non-nil, the function doesn't
1760recenter the folder buffer."
1761 (let ((cur-msg (car (mh-seq-to-msgs 'cur))))
1762 (cond ((and cur-msg
1763 (mh-goto-msg cur-msg t t))
1764 (unless minimal-changes-flag
1765 (mh-notate nil mh-note-cur mh-cmd-note)
1766 (mh-recenter 0)
1767 (mh-maybe-show cur-msg)))
1768 (t
1769 (message "No current message")))))
1770
1771(defun mh-process-or-undo-commands (folder)
1772 "If FOLDER has outstanding commands, then either process or discard them.
1773Called by functions like `mh-sort-folder', so also invalidate show buffer."
1774 (set-buffer folder)
1775 (if (mh-outstanding-commands-p)
1776 (if (or mh-do-not-confirm-flag
1777 (y-or-n-p
1778 "Process outstanding deletes and refiles (or lose them)? "))
1779 (mh-process-commands folder)
1780 (mh-undo-folder)))
1781 (mh-update-unseen)
1782 (mh-invalidate-show-buffer))
1783
1784(defun mh-process-commands (folder)
1785 "Process outstanding commands for FOLDER.
1786The value of `mh-folder-updated-hook' is a list of functions to be called,
1787with no arguments, before the commands are processed."
1788 (message "Processing deletes and refiles for %s..." folder)
1789 (set-buffer folder)
1790 (with-mh-folder-updating (nil)
1791 ;; Run the hook while the lists are still valid
1792 (run-hooks 'mh-folder-updated-hook)
1793
1794 ;; Update the unseen sequence if it exists
1795 (mh-update-unseen)
1796
1797 (let ((redraw-needed-flag mh-index-data))
1798 ;; Remove invalid scan lines if we are in an index folder and then remove
1799 ;; the real messages
1800 (when mh-index-data
1801 (mh-index-delete-folder-headers)
1802 (mh-index-execute-commands))
1803
1804 ;; Then refile messages
1805 (mh-mapc #'(lambda (folder-msg-list)
1806 (let ((dest-folder (symbol-name (car folder-msg-list)))
1807 (msgs (cdr folder-msg-list)))
1808 (setq redraw-needed-flag t)
1809 (apply #'mh-exec-cmd
1810 "refile" "-src" folder dest-folder
1811 (mh-coalesce-msg-list msgs))
1812 (mh-delete-scan-msgs msgs)))
1813 mh-refile-list)
1814 (setq mh-refile-list ())
1815
1816 ;; Now delete messages
1817 (cond (mh-delete-list
1818 (setq redraw-needed-flag t)
1819 (apply 'mh-exec-cmd "rmm" folder
1820 (mh-coalesce-msg-list mh-delete-list))
1821 (mh-delete-scan-msgs mh-delete-list)
1822 (setq mh-delete-list nil)))
1823
1824 ;; Don't need to remove sequences since delete and refile do so.
1825 ;; Mark cur message
1826 (if (> (buffer-size) 0)
1827 (mh-define-sequence 'cur (list (or (mh-get-msg-num nil) "last"))))
1828
1829 ;; Redraw folder buffer if needed
1830 (when (and redraw-needed-flag)
1831 (cond ((memq 'unthread mh-view-ops) (mh-thread-inc folder (point-max)))
1832 (mh-index-data (mh-index-insert-folder-headers)))))
1833
1834 (and (buffer-file-name (get-buffer mh-show-buffer))
1835 (not (file-exists-p (buffer-file-name (get-buffer mh-show-buffer))))
1836 ;; If "inc" were to put a new msg in this file,
1837 ;; we would not notice, so mark it invalid now.
1838 (mh-invalidate-show-buffer))
1839
1840 (setq mh-seq-list (mh-read-folder-sequences mh-current-folder nil))
1841 (mh-unmark-all-headers t)
1842 (mh-notate-user-sequences)
1843 (message "Processing deletes and refiles for %s...done" folder)))
1844
1845(defun mh-update-unseen ()
1846 "Synchronize the unseen sequence with MH.
1847Return non-nil iff the MH folder was set.
1848The value of `mh-unseen-updated-hook' is a list of functions to be called,
1849with no arguments, after the unseen sequence is updated."
1850 (if mh-seen-list
1851 (let* ((unseen-seq (mh-find-seq mh-unseen-seq))
1852 (unseen-msgs (mh-seq-msgs unseen-seq)))
1853 (if unseen-msgs
1854 (progn
1855 (mh-undefine-sequence mh-unseen-seq mh-seen-list)
1856 (run-hooks 'mh-unseen-updated-hook)
1857 (while mh-seen-list
1858 (setq unseen-msgs (delq (car mh-seen-list) unseen-msgs))
1859 (setq mh-seen-list (cdr mh-seen-list)))
1860 (setcdr unseen-seq unseen-msgs)
1861 t) ;since we set the folder
1862 (setq mh-seen-list nil)))))
1863
1864(defun mh-delete-scan-msgs (msgs)
1865 "Delete the scan listing lines for MSGS."
1866 (save-excursion
1867 (while msgs
1868 (when (mh-goto-msg (car msgs) t t)
1869 (when (memq 'unthread mh-view-ops)
1870 (mh-thread-forget-message (car msgs)))
1871 (mh-delete-line 1))
1872 (setq msgs (cdr msgs)))))
1873
1874(defun mh-outstanding-commands-p ()
1875 "Return non-nil if there are outstanding deletes or refiles."
1876 (or mh-delete-list mh-refile-list))
1877
1878(defun mh-coalesce-msg-list (messages)
1879 "Give a list of MESSAGES, return a list of message number ranges.
1880Sort of the opposite of `mh-read-msg-list', which expands ranges.
1881Message lists passed to MH programs go through this so
1882command line arguments won't exceed system limits."
1883 (let ((msgs (sort (copy-sequence messages) 'mh-greaterp))
1884 (range-high nil)
1885 (prev -1)
1886 (ranges nil))
1887 (while prev
1888 (if range-high
1889 (if (or (not (numberp prev))
1890 (not (equal (car msgs) (1- prev))))
1891 (progn ;non-sequential, flush old range
1892 (if (eq prev range-high)
1893 (setq ranges (cons range-high ranges))
1894 (setq ranges (cons (format "%s-%s" prev range-high) ranges)))
1895 (setq range-high nil))))
1896 (or range-high
1897 (setq range-high (car msgs))) ;start new or first range
1898 (setq prev (car msgs))
1899 (setq msgs (cdr msgs)))
1900 ranges))
1901
1902(defun mh-greaterp (msg1 msg2)
1903 "Return the greater of two message indicators MSG1 and MSG2.
1904Strings are \"smaller\" than numbers.
1905Legal values are things like \"cur\", \"last\", 1, and 1820."
1906 (if (numberp msg1)
1907 (if (numberp msg2)
1908 (> msg1 msg2)
1909 t)
1910 (if (numberp msg2)
1911 nil
1912 (string-lessp msg2 msg1))))
1913
1914(defun mh-lessp (msg1 msg2)
1915 "Return the lesser of two message indicators MSG1 and MSG2.
1916Strings are \"smaller\" than numbers.
1917Legal values are things like \"cur\", \"last\", 1, and 1820."
1918 (not (mh-greaterp msg1 msg2)))
1919
1920
1921
1922;;; Basic sequence handling
1923
1924(defun mh-delete-seq-locally (seq)
1925 "Remove MH-E's record of SEQ."
1926 (let ((entry (mh-find-seq seq)))
1927 (setq mh-seq-list (delq entry mh-seq-list))))
1928
1929(defun mh-read-folder-sequences (folder save-refiles)
1930 "Read and return the predefined sequences for a FOLDER.
1931If SAVE-REFILES is non-nil, then keep the sequences
1932that note messages to be refiled."
1933 (let ((seqs ()))
1934 (cond (save-refiles
1935 (mh-mapc (function (lambda (seq) ; Save the refiling sequences
1936 (if (mh-folder-name-p (mh-seq-name seq))
1937 (setq seqs (cons seq seqs)))))
1938 mh-seq-list)))
1939 (save-excursion
1940 (if (eq 0 (mh-exec-cmd-quiet nil "mark" folder "-list"))
1941 (progn
1942 ;; look for name in line of form "cur: 4" or "myseq (private): 23"
1943 (while (re-search-forward "^[^: ]+" nil t)
1944 (setq seqs (cons (mh-make-seq (intern (buffer-substring
1945 (match-beginning 0)
1946 (match-end 0)))
1947 (mh-read-msg-list))
1948 seqs)))
1949 (delete-region (point-min) (point))))) ; avoid race with
1950 ; mh-process-daemon
1951 seqs))
1952
1953(defun mh-read-msg-list ()
1954 "Return a list of message numbers from point to the end of the line.
1955Expands ranges into set of individual numbers."
1956 (let ((msgs ())
1957 (end-of-line (save-excursion (end-of-line) (point)))
1958 num)
1959 (while (re-search-forward "[0-9]+" end-of-line t)
1960 (setq num (string-to-int (buffer-substring (match-beginning 0)
1961 (match-end 0))))
1962 (cond ((looking-at "-") ; Message range
1963 (forward-char 1)
1964 (re-search-forward "[0-9]+" end-of-line t)
1965 (let ((num2 (string-to-int (buffer-substring (match-beginning 0)
1966 (match-end 0)))))
1967 (if (< num2 num)
1968 (error "Bad message range: %d-%d" num num2))
1969 (while (<= num num2)
1970 (setq msgs (cons num msgs))
1971 (setq num (1+ num)))))
1972 ((not (zerop num)) ;"pick" outputs "0" to mean no match
1973 (setq msgs (cons num msgs)))))
1974 msgs))
1975
1976(defun mh-notate-user-sequences ()
1977 "Mark the scan listing of all messages in user-defined sequences."
1978 (let ((seqs mh-seq-list)
1979 name)
1980 (while seqs
1981 (setq name (mh-seq-name (car seqs)))
1982 (if (not (mh-internal-seq name))
1983 (mh-notate-seq name mh-note-seq (1+ mh-cmd-note)))
1984 (setq seqs (cdr seqs)))))
1985
1986(defun mh-internal-seq (name)
1987 "Return non-nil if NAME is the name of an internal MH-E sequence."
1988 (or (memq name '(answered cur deleted forwarded printed))
1989 (eq name mh-unseen-seq)
1990 (eq name mh-previous-seq)
1991 (mh-folder-name-p name)))
1992
1993(defun mh-delete-msg-from-seq (message sequence &optional internal-flag)
1994 "Delete MESSAGE from SEQUENCE.
1995MESSAGE defaults to displayed message. From Lisp, optional third arg
1996INTERNAL-FLAG non-nil means do not inform MH of the change."
1997 (interactive (list (mh-get-msg-num t)
1998 (mh-read-seq-default "Delete from" t)
1999 nil))
2000 (let ((entry (mh-find-seq sequence)))
2001 (cond (entry
2002 (mh-notate-if-in-one-seq message ? (1+ mh-cmd-note) sequence)
2003 (if (not internal-flag)
2004 (mh-undefine-sequence sequence (list message)))
2005 (setcdr entry (delq message (mh-seq-msgs entry)))))))
2006
2007(defun mh-undefine-sequence (seq msgs)
2008 "Remove from the SEQ the list of MSGS."
2009 (mh-exec-cmd "mark" mh-current-folder "-delete"
2010 "-sequence" (symbol-name seq)
2011 (mh-coalesce-msg-list msgs)))
2012
2013(defun mh-define-sequence (seq msgs)
2014 "Define the SEQ to contain the list of MSGS.
2015Do not mark pseudo-sequences or empty sequences.
2016Signals an error if SEQ is an illegal name."
2017 (if (and msgs
2018 (not (mh-folder-name-p seq)))
2019 (save-excursion
2020 (mh-exec-cmd-error nil "mark" mh-current-folder "-add" "-zero"
2021 "-sequence" (symbol-name seq)
2022 (mh-coalesce-msg-list msgs)))))
2023
2024(defun mh-map-over-seqs (function seq-list)
2025 "Apply FUNCTION to each sequence in SEQ-LIST.
2026The sequence name and the list of messages are passed as arguments."
2027 (while seq-list
2028 (funcall function
2029 (mh-seq-name (car seq-list))
2030 (mh-seq-msgs (car seq-list)))
2031 (setq seq-list (cdr seq-list))))
2032
2033(defun mh-notate-if-in-one-seq (msg character offset seq)
2034 "Notate MSG.
2035The CHARACTER is placed at the given OFFSET from the beginning of the listing.
2036The notation is performed if the MSG is only in SEQ."
2037 (let ((in-seqs (mh-seq-containing-msg msg nil)))
2038 (if (and (eq seq (car in-seqs)) (null (cdr in-seqs)))
2039 (mh-notate msg character offset))))
2040
2041(defun mh-seq-containing-msg (msg &optional include-internal-flag)
2042 "Return a list of the sequences containing MSG.
2043If INCLUDE-INTERNAL-FLAG non-nil, include MH-E internal sequences in list."
2044 (let ((l mh-seq-list)
2045 (seqs ()))
2046 (while l
2047 (and (memq msg (mh-seq-msgs (car l)))
2048 (or include-internal-flag
2049 (not (mh-internal-seq (mh-seq-name (car l)))))
2050 (setq seqs (cons (mh-seq-name (car l)) seqs)))
2051 (setq l (cdr l)))
2052 seqs))
2053
2054
2055
2056;;; User prompting commands.
2057
2058(defun mh-read-msg-range (folder &optional always-prompt-flag)
2059 "Prompt for message range from FOLDER.
2060If optional second argument ALWAYS-PROMPT-FLAG is non-nil then always ask for
2061range."
2062 (multiple-value-bind (total unseen) (mh-folder-size folder)
2063 (cond
2064 ((and (not always-prompt-flag) (numberp unseen) (> unseen 0))
2065 (list (symbol-name mh-unseen-seq)))
2066 ((or (null mh-large-folder) (not (numberp total)))
2067 (list "all"))
2068 ((and (numberp total) (or always-prompt-flag (> total mh-large-folder)))
2069 (let* ((prompt
2070 (format "Range or number of messages to read (default: %s): "
2071 total))
2072 (in (read-string prompt nil nil (number-to-string total))))
2073 (cond ((string-match "^[ \f\t\n\r\v]*[0-9]+[ \f\t\n\r\v]*$" in)
2074 (list (format "last:%s" (car (read-from-string in)))))
2075 ((equal in "") (list "all"))
2076 (t (split-string in)))))
2077 (t (list "all")))))
2078
2079
2080
2081;;; Build the folder-mode keymap:
2082
2083(suppress-keymap mh-folder-mode-map)
2084
2085;; Use defalias to make sure the documented primary key bindings
2086;; appear in menu lists.
2087(defalias 'mh-alt-show 'mh-show)
2088(defalias 'mh-alt-refile-msg 'mh-refile-msg)
2089(defalias 'mh-alt-send 'mh-send)
2090(defalias 'mh-alt-visit-folder 'mh-visit-folder)
2091
2092;; Save the `b' binding for a future `back'. Maybe?
2093(gnus-define-keys mh-folder-mode-map
2094 " " mh-page-msg
2095 "!" mh-refile-or-write-again
2096 "," mh-header-display
2097 "." mh-alt-show
2098 ">" mh-write-msg-to-file
2099 "?" mh-help
2100 "E" mh-extract-rejected-mail
2101 "M" mh-modify
2102 "\177" mh-previous-page
2103 "\C-d" mh-delete-msg-no-motion
2104 "\t" mh-index-next-folder
2105 [backtab] mh-index-previous-folder
2106 "\M-\t" mh-index-previous-folder
2107 "\e<" mh-first-msg
2108 "\e>" mh-last-msg
2109 "\ed" mh-redistribute
2110 "\r" mh-show
2111 "^" mh-alt-refile-msg
2112 "c" mh-copy-msg
2113 "d" mh-delete-msg
2114 "e" mh-edit-again
2115 "f" mh-forward
2116 "g" mh-goto-msg
2117 "i" mh-inc-folder
2118 "k" mh-delete-subject-or-thread
2119 "l" mh-print-msg
2120 "m" mh-alt-send
2121 "n" mh-next-undeleted-msg
2122 "\M-n" mh-next-unread-msg
2123 "o" mh-refile-msg
2124 "p" mh-previous-undeleted-msg
2125 "\M-p" mh-previous-unread-msg
2126 "q" mh-quit
2127 "r" mh-reply
2128 "s" mh-send
2129 "t" mh-toggle-showing
2130 "u" mh-undo
2131 "v" mh-index-visit-folder
2132 "x" mh-execute-commands
2133 "|" mh-pipe-msg)
2134
2135(gnus-define-keys (mh-folder-map "F" mh-folder-mode-map)
2136 "?" mh-prefix-help
2137 "S" mh-sort-folder
2138 "f" mh-alt-visit-folder
2139 "i" mh-index-search
2140 "k" mh-kill-folder
2141 "l" mh-list-folders
2142 "o" mh-alt-visit-folder
2143 "p" mh-pack-folder
2144 "r" mh-rescan-folder
2145 "s" mh-search-folder
2146 "u" mh-undo-folder
2147 "v" mh-visit-folder)
2148
2149(gnus-define-keys (mh-sequence-map "S" mh-folder-mode-map)
2150 "?" mh-prefix-help
2151 "d" mh-delete-msg-from-seq
2152 "k" mh-delete-seq
2153 "l" mh-list-sequences
2154 "n" mh-narrow-to-seq
2155 "p" mh-put-msg-in-seq
2156 "s" mh-msg-is-in-seq
2157 "w" mh-widen)
2158
2159(gnus-define-keys (mh-thread-map "T" mh-folder-mode-map)
2160 "?" mh-prefix-help
2161 "u" mh-thread-ancestor
2162 "p" mh-thread-previous-sibling
2163 "n" mh-thread-next-sibling
2164 "t" mh-toggle-threads
2165 "d" mh-thread-delete
2166 "o" mh-thread-refile)
2167
2168(gnus-define-keys (mh-limit-map "/" mh-folder-mode-map)
2169 "?" mh-prefix-help
2170 "s" mh-narrow-to-subject
2171 "w" mh-widen)
2172
2173(gnus-define-keys (mh-extract-map "X" mh-folder-mode-map)
2174 "?" mh-prefix-help
2175 "s" mh-store-msg ;shar
2176 "u" mh-store-msg) ;uuencode
2177
2178(gnus-define-keys (mh-digest-map "D" mh-folder-mode-map)
2179 " " mh-page-digest
2180 "?" mh-prefix-help
2181 "\177" mh-page-digest-backwards
2182 "b" mh-burst-digest)
2183
2184(gnus-define-keys (mh-mime-map "K" mh-folder-mode-map)
2185 "?" mh-prefix-help
2186 "a" mh-mime-save-parts
2187 "i" mh-folder-inline-mime-part
2188 "o" mh-folder-save-mime-part
2189 "v" mh-folder-toggle-mime-part
2190 "\t" mh-next-button
2191 [backtab] mh-prev-button
2192 "\M-\t" mh-prev-button)
2193
2194(cond
2195 (mh-xemacs-flag
2196 (define-key mh-folder-mode-map [button2] 'mh-show-mouse))
2197 (t
2198 (define-key mh-folder-mode-map [mouse-2] 'mh-show-mouse)))
2199
2200;; "C-c /" prefix is used in mh-folder-mode by pgp.el and mailcrypt
2201
2202
2203
2204;;; Help Messages
2205
2206;;; If you add a new prefix, add appropriate text to the nil key.
2207;;;
2208;;; In general, messages are grouped logically. Taking the main commands for
2209;;; example, the first line is "ways to view messages," the second line is
2210;;; "things you can do with messages", and the third is "composing" messages.
2211;;;
2212;;; When adding a new prefix, ensure that the help message contains "what" the
2213;;; prefix is for. For example, if the word "folder" were not present in the
2214;;; `F' entry, it would not be clear what these commands operated upon.
2215(defvar mh-help-messages
2216 '((nil "[i]nc, [.]show, [,]show all, [n]ext, [p]revious,\n"
2217 "[d]elete, [o]refile, e[x]ecute,\n"
2218 "[s]end, [r]eply.\n"
2219 "Prefix characters:\n [F]older, [S]equence, MIME [K]eys, "
2220 "[T]hread, / Limit, e[X]tract, [D]igest.")
2221
2222 (?F "[l]ist, [v]isit folder;\n"
2223 "[t]hread; [s]earch; [i]ndexed search;\n"
2224 "[p]ack; [S]ort; [r]escan; [k]ill")
2225 (?S "[p]ut message in sequence, [n]arrow, [w]iden,\n"
2226 "[s]equences, [l]ist,\n"
2227 "[d]elete message from sequence, [k]ill sequence")
2228 (?T "[t]oggle, [d]elete, [o]refile thread")
2229 (?/ "Limit to [s]ubject; [w]iden")
2230 (?X "un[s]har, [u]udecode message")
2231 (?D "[b]urst digest")
2232 (?K "[v]iew, [i]nline, [o]utput/save MIME part; save [a]ll parts; \n"
2233 "[TAB] next; [SHIFT-TAB] previous"))
2234 "Key binding cheat sheet.
2235
2236This is an associative array which is used to show the most common commands.
2237The key is a prefix char. The value is one or more strings which are
2238concatenated together and displayed in the minibuffer if ? is pressed after
2239the prefix character. The special key nil is used to display the
2240non-prefixed commands.
2241
2242The substitutions described in `substitute-command-keys' are performed as
2243well.")
2244
2245
2246
2247(dolist (mess '("^Cursor not pointing to message$"
2248 "^There is no other window$"))
2249 (add-to-list 'debug-ignored-errors mess))
2250
2251(provide 'mh-e)
2252
2253;;; Local Variables:
2254;;; indent-tabs-mode: nil
2255;;; sentence-end-double-space: nil
2256;;; End:
2257
2258;;; mh-e.el ends here
diff --git a/lisp/mail/mh-funcs.el b/lisp/mail/mh-funcs.el
deleted file mode 100644
index b14039170f1..00000000000
--- a/lisp/mail/mh-funcs.el
+++ /dev/null
@@ -1,436 +0,0 @@
1;;; mh-funcs.el --- MH-E functions not everyone will use right away
2
3;; Copyright (C) 1993, 1995, 2001, 2002 Free Software Foundation, Inc.
4
5;; Author: Bill Wohler <wohler@newt.com>
6;; Maintainer: Bill Wohler <wohler@newt.com>
7;; Keywords: mail
8;; See: mh-e.el
9
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
14;; the Free Software Foundation; either version 2, or (at your option)
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 the
24;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
25;; Boston, MA 02111-1307, USA.
26
27;;; Commentary:
28
29;; Internal support for MH-E package.
30;; Putting these functions in a separate file lets MH-E start up faster,
31;; since less Lisp code needs to be loaded all at once.
32
33;;; Change Log:
34
35;; $Id: mh-funcs.el,v 1.36 2002/12/23 05:52:07 satyaki Exp $
36
37;;; Code:
38
39(require 'mh-e)
40
41;;; Customization
42
43(defvar mh-sortm-args nil
44 "Extra arguments to have \\[mh-sort-folder] pass to the \"sortm\" command.
45The arguments are passed to sortm if \\[mh-sort-folder] is given a
46prefix argument. Normally default arguments to sortm are specified in the
47MH profile.
48For example, '(\"-nolimit\" \"-textfield\" \"subject\") is a useful setting.")
49
50(defvar mh-note-copied "C"
51 "String whose first character is used to notate copied messages.")
52
53(defvar mh-note-printed "P"
54 "String whose first character is used to notate printed messages.")
55
56;;; Functions
57
58;;;###mh-autoload
59(defun mh-burst-digest ()
60 "Burst apart the current message, which should be a digest.
61The message is replaced by its table of contents and the messages from the
62digest are inserted into the folder after that message."
63 (interactive)
64 (let ((digest (mh-get-msg-num t)))
65 (mh-process-or-undo-commands mh-current-folder)
66 (mh-set-folder-modified-p t) ; lock folder while bursting
67 (message "Bursting digest...")
68 (mh-exec-cmd "burst" mh-current-folder digest "-inplace")
69 (with-mh-folder-updating (t)
70 (beginning-of-line)
71 (delete-region (point) (point-max)))
72 (mh-regenerate-headers (format "%d-last" digest) t)
73 (mh-goto-cur-msg)
74 (message "Bursting digest...done")))
75
76;;;###mh-autoload
77(defun mh-copy-msg (msg-or-seq folder)
78 "Copy the specified MSG-OR-SEQ to another FOLDER without deleting them.
79Default is the displayed message. If optional prefix argument is provided,
80then prompt for the message sequence."
81 (interactive (list (cond
82 ((mh-mark-active-p t)
83 (mh-region-to-msg-list (region-beginning) (region-end)))
84 (current-prefix-arg
85 (mh-read-seq-default "Copy" t))
86 (t
87 (mh-get-msg-num t)))
88 (mh-prompt-for-folder "Copy to" "" t)))
89 (mh-exec-cmd "refile"
90 (cond ((numberp msg-or-seq) msg-or-seq)
91 ((listp msg-or-seq) msg-or-seq)
92 (t (mh-coalesce-msg-list (mh-seq-to-msgs msg-or-seq))))
93 "-link" "-src" mh-current-folder folder)
94 (if (numberp msg-or-seq)
95 (mh-notate msg-or-seq mh-note-copied mh-cmd-note)
96 (mh-notate-seq msg-or-seq mh-note-copied mh-cmd-note)))
97
98;;;###mh-autoload
99(defun mh-kill-folder ()
100 "Remove the current folder and all included messages.
101Removes all of the messages (files) within the specified current folder,
102and then removes the folder (directory) itself.
103The value of `mh-folder-list-change-hook' is a list of functions to be called,
104with no arguments, after the folders has been removed."
105 (interactive)
106 (if (yes-or-no-p (format "Remove folder %s (and all included messages)?"
107 mh-current-folder))
108 (let ((folder mh-current-folder))
109 (if (null mh-folder-list)
110 (mh-set-folder-list))
111 (mh-set-folder-modified-p t) ; lock folder to kill it
112 (mh-exec-cmd-daemon "rmf" folder)
113 (setq mh-folder-list
114 (delq (assoc folder mh-folder-list) mh-folder-list))
115 (when (boundp 'mh-speed-folder-map)
116 (mh-speed-invalidate-map folder))
117 (run-hooks 'mh-folder-list-change-hook)
118 (message "Folder %s removed" folder)
119 (mh-set-folder-modified-p nil) ; so kill-buffer doesn't complain
120 (if (get-buffer mh-show-buffer)
121 (kill-buffer mh-show-buffer))
122 (if (get-buffer folder)
123 (kill-buffer folder)))
124 (message "Folder not removed")))
125
126;; Avoid compiler warning...
127(defvar view-exit-action)
128
129;;;###mh-autoload
130(defun mh-list-folders ()
131 "List mail folders."
132 (interactive)
133 (let ((temp-buffer mh-temp-folders-buffer))
134 (with-output-to-temp-buffer temp-buffer
135 (save-excursion
136 (set-buffer temp-buffer)
137 (erase-buffer)
138 (message "Listing folders...")
139 (mh-exec-cmd-output "folders" t (if mh-recursive-folders-flag
140 "-recurse"
141 "-norecurse"))
142 (goto-char (point-min))
143 (view-mode 1)
144 (setq view-exit-action 'kill-buffer)
145 (message "Listing folders...done")))))
146
147;;;###mh-autoload
148(defun mh-pack-folder (range)
149 "Renumber the messages of a folder to be 1..n.
150First, offer to execute any outstanding commands for the current folder. If
151optional prefix argument provided, prompt for the RANGE of messages to display
152after packing. Otherwise, show the entire folder."
153 (interactive (list (if current-prefix-arg
154 (mh-read-msg-range mh-current-folder t)
155 '("all"))))
156 (let ((threaded-flag (memq 'unthread mh-view-ops)))
157 (mh-pack-folder-1 range)
158 (mh-goto-cur-msg)
159 (when mh-index-data
160 (mh-index-update-maps mh-current-folder))
161 (cond (threaded-flag (mh-toggle-threads))
162 (mh-index-data (mh-index-insert-folder-headers))))
163 (message "Packing folder...done"))
164
165(defun mh-pack-folder-1 (range)
166 "Close and pack the current folder.
167Display the given RANGE of messages after packing. If RANGE is nil, show the
168entire folder."
169 (mh-process-or-undo-commands mh-current-folder)
170 (message "Packing folder...")
171 (mh-set-folder-modified-p t) ; lock folder while packing
172 (save-excursion
173 (mh-exec-cmd-quiet t "folder" mh-current-folder "-pack"
174 "-norecurse" "-fast"))
175 (mh-reset-threads-and-narrowing)
176 (mh-regenerate-headers range))
177
178;;;###mh-autoload
179(defun mh-pipe-msg (command include-headers)
180 "Pipe the current message through the given shell COMMAND.
181If INCLUDE-HEADERS (prefix argument) is provided, send the entire message.
182Otherwise just send the message's body without the headers."
183 (interactive
184 (list (read-string "Shell command on message: ") current-prefix-arg))
185 (let ((msg-file-to-pipe (mh-msg-filename (mh-get-msg-num t)))
186 (message-directory default-directory))
187 (save-excursion
188 (set-buffer (get-buffer-create mh-temp-buffer))
189 (erase-buffer)
190 (insert-file-contents msg-file-to-pipe)
191 (goto-char (point-min))
192 (if (not include-headers) (search-forward "\n\n"))
193 (let ((default-directory message-directory))
194 (shell-command-on-region (point) (point-max) command nil)))))
195
196;;;###mh-autoload
197(defun mh-page-digest ()
198 "Advance displayed message to next digested message."
199 (interactive)
200 (mh-in-show-buffer (mh-show-buffer)
201 ;; Go to top of screen (in case user moved point).
202 (move-to-window-line 0)
203 (let ((case-fold-search nil))
204 ;; Search for blank line and then for From:
205 (or (and (search-forward "\n\n" nil t)
206 (re-search-forward "^From:" nil t))
207 (error "No more messages in digest")))
208 ;; Go back to previous blank line, then forward to the first non-blank.
209 (search-backward "\n\n" nil t)
210 (forward-line 2)
211 (mh-recenter 0)))
212
213;;;###mh-autoload
214(defun mh-page-digest-backwards ()
215 "Back up displayed message to previous digested message."
216 (interactive)
217 (mh-in-show-buffer (mh-show-buffer)
218 ;; Go to top of screen (in case user moved point).
219 (move-to-window-line 0)
220 (let ((case-fold-search nil))
221 (beginning-of-line)
222 (or (and (search-backward "\n\n" nil t)
223 (re-search-backward "^From:" nil t))
224 (error "No previous message in digest")))
225 ;; Go back to previous blank line, then forward to the first non-blank.
226 (if (search-backward "\n\n" nil t)
227 (forward-line 2))
228 (mh-recenter 0)))
229
230;;;###mh-autoload
231(defun mh-print-msg (msg-or-seq)
232 "Print MSG-OR-SEQ (default: displayed message) on printer.
233If optional prefix argument provided, then prompt for the message sequence.
234The variable `mh-lpr-command-format' is used to generate the print command.
235The messages are formatted by mhl. See the variable `mhl-formfile'."
236 (interactive (list (if current-prefix-arg
237 (reverse (mh-seq-to-msgs
238 (mh-read-seq-default "Print" t)))
239 (mh-get-msg-num t))))
240 (if (numberp msg-or-seq)
241 (message "Printing message...")
242 (message "Printing sequence..."))
243 (let ((print-command
244 (if (numberp msg-or-seq)
245 (format "%s -nobell -clear %s %s | %s"
246 (expand-file-name "mhl" mh-lib-progs)
247 (mh-msg-filename msg-or-seq)
248 (if (stringp mhl-formfile)
249 (format "-form %s" mhl-formfile)
250 "")
251 (format mh-lpr-command-format
252 (if (numberp msg-or-seq)
253 (format "%s/%d" mh-current-folder
254 msg-or-seq)
255 (format "Sequence from %s" mh-current-folder))))
256 (format "(scan -clear %s ; %s -nobell -clear %s %s) | %s"
257 (mapconcat (function (lambda (msg) msg)) msg-or-seq " ")
258 (expand-file-name "mhl" mh-lib-progs)
259 (if (stringp mhl-formfile)
260 (format "-form %s" mhl-formfile)
261 "")
262 (mh-msg-filenames msg-or-seq)
263 (format mh-lpr-command-format
264 (if (numberp msg-or-seq)
265 (format "%s/%d" mh-current-folder
266 msg-or-seq)
267 (format "Sequence from %s"
268 mh-current-folder)))))))
269 (if mh-print-background-flag
270 (mh-exec-cmd-daemon shell-file-name "-c" print-command)
271 (call-process shell-file-name nil nil nil "-c" print-command))
272 (if (numberp msg-or-seq)
273 (mh-notate msg-or-seq mh-note-printed mh-cmd-note)
274 (mh-notate-seq msg-or-seq mh-note-printed mh-cmd-note))
275 (mh-add-msgs-to-seq msg-or-seq 'printed t)
276 (if (numberp msg-or-seq)
277 (message "Printing message...done")
278 (message "Printing sequence...done"))))
279
280(defun mh-msg-filenames (msgs &optional folder)
281 "Return a list of file names for MSGS in FOLDER (default current folder)."
282 (mapconcat (function (lambda (msg) (mh-msg-filename msg folder))) msgs " "))
283
284;;;###mh-autoload
285(defun mh-sort-folder (&optional extra-args)
286 "Sort the messages in the current folder by date.
287Calls the MH program sortm to do the work.
288The arguments in the list `mh-sortm-args' are passed to sortm if the optional
289argument EXTRA-ARGS is given."
290 (interactive "P")
291 (mh-process-or-undo-commands mh-current-folder)
292 (setq mh-next-direction 'forward)
293 (mh-set-folder-modified-p t) ; lock folder while sorting
294 (message "Sorting folder...")
295 (let ((threaded-flag (memq 'unthread mh-view-ops)))
296 (mh-exec-cmd "sortm" mh-current-folder (if extra-args mh-sortm-args))
297 (when mh-index-data
298 (mh-index-update-maps mh-current-folder))
299 (message "Sorting folder...done")
300 (mh-reset-threads-and-narrowing)
301 (mh-scan-folder mh-current-folder "all")
302 (cond (threaded-flag (mh-toggle-threads))
303 (mh-index-data (mh-index-insert-folder-headers)))))
304
305;;;###mh-autoload
306(defun mh-undo-folder (&rest ignore)
307 "Undo all pending deletes and refiles in current folder.
308Argument IGNORE is deprecated."
309 (interactive)
310 (cond ((or mh-do-not-confirm-flag
311 (yes-or-no-p "Undo all commands in folder? "))
312 (setq mh-delete-list nil
313 mh-refile-list nil
314 mh-seq-list nil
315 mh-next-direction 'forward)
316 (with-mh-folder-updating (nil)
317 (mh-unmark-all-headers t)))
318 (t
319 (message "Commands not undone.")
320 (sit-for 2))))
321
322;;;###mh-autoload
323(defun mh-store-msg (directory)
324 "Store the file(s) contained in the current message into DIRECTORY.
325The message can contain a shar file or uuencoded file.
326Default directory is the last directory used, or initially the value of
327`mh-store-default-directory' or the current directory."
328 (interactive (list (let ((udir (or mh-store-default-directory
329 default-directory)))
330 (read-file-name "Store message in directory: "
331 udir udir nil))))
332 (let ((msg-file-to-store (mh-msg-filename (mh-get-msg-num t))))
333 (save-excursion
334 (set-buffer (get-buffer-create mh-temp-buffer))
335 (erase-buffer)
336 (insert-file-contents msg-file-to-store)
337 (mh-store-buffer directory))))
338
339;;;###mh-autoload
340(defun mh-store-buffer (directory)
341 "Store the file(s) contained in the current buffer into DIRECTORY.
342The buffer can contain a shar file or uuencoded file.
343Default directory is the last directory used, or initially the value of
344`mh-store-default-directory' or the current directory."
345 (interactive (list (let ((udir (or mh-store-default-directory
346 default-directory)))
347 (read-file-name "Store buffer in directory: "
348 udir udir nil))))
349 (let ((store-directory (expand-file-name directory))
350 (sh-start (save-excursion
351 (goto-char (point-min))
352 (if (re-search-forward
353 "^#![ \t]*/bin/sh\\|^#\\|^: " nil t)
354 (progn
355 ;; The "cut here" pattern was removed from above
356 ;; because it seemed to hurt more than help.
357 ;; But keep this to make it easier to put it back.
358 (if (looking-at "^[^a-z0-9\"]*cut here\\b")
359 (forward-line 1))
360 (beginning-of-line)
361 (if (looking-at "^[#:]....+\n\\( ?\n\\)?end$")
362 nil ;most likely end of a uuencode
363 (point))))))
364 (log-buffer (get-buffer-create "*Store Output*"))
365 (command "sh")
366 (uudecode-filename "(unknown filename)"))
367 (if (not sh-start)
368 (save-excursion
369 (goto-char (point-min))
370 (if (re-search-forward "^begin [0-7]+ " nil t)
371 (setq uudecode-filename
372 (buffer-substring (point)
373 (progn (end-of-line) (point)))))))
374 (save-excursion
375 (set-buffer log-buffer)
376 (erase-buffer)
377 (if (not (file-directory-p store-directory))
378 (progn
379 (insert "mkdir " directory "\n")
380 (call-process "mkdir" nil log-buffer t store-directory)))
381 (insert "cd " directory "\n")
382 (setq mh-store-default-directory directory)
383 (if (not sh-start)
384 (progn
385 (setq command "uudecode")
386 (insert uudecode-filename " being uudecoded...\n"))))
387 (set-window-start (display-buffer log-buffer) 0) ;watch progress
388 (let (value)
389 (let ((default-directory (file-name-as-directory store-directory)))
390 (setq value (call-process-region sh-start (point-max) command
391 nil log-buffer t)))
392 (set-buffer log-buffer)
393 (mh-handle-process-error command value))
394 (insert "\n(mh-store finished)\n")))
395
396
397
398;;; Help Functions
399
400(defun mh-ephem-message (string)
401 "Display STRING in the minibuffer momentarily."
402 (message "%s" string)
403 (sit-for 5)
404 (message ""))
405
406;;;###mh-autoload
407(defun mh-help ()
408 "Display cheat sheet for the MH-Folder commands in minibuffer."
409 (interactive)
410 (mh-ephem-message
411 (substitute-command-keys
412 (mapconcat 'identity (cdr (assoc nil mh-help-messages)) ""))))
413
414;;;###mh-autoload
415(defun mh-prefix-help ()
416 "Display cheat sheet for the commands of the current prefix in minibuffer."
417 (interactive)
418 ;; We got here because the user pressed a `?', but he pressed a prefix key
419 ;; before that. Since the the key vector starts at index 0, the index of the
420 ;; last keystroke is length-1 and thus the second to last keystroke is at
421 ;; length-2. We use that information to obtain a suitable prefix character
422 ;; from the recent keys.
423 (let* ((keys (recent-keys))
424 (prefix-char (elt keys (- (length keys) 2))))
425 (mh-ephem-message
426 (substitute-command-keys
427 (mapconcat 'identity (cdr (assoc prefix-char mh-help-messages)) "")))))
428
429(provide 'mh-funcs)
430
431;;; Local Variables:
432;;; indent-tabs-mode: nil
433;;; sentence-end-double-space: nil
434;;; End:
435
436;;; mh-funcs.el ends here
diff --git a/lisp/mail/mh-identity.el b/lisp/mail/mh-identity.el
deleted file mode 100644
index 1347225a2ed..00000000000
--- a/lisp/mail/mh-identity.el
+++ /dev/null
@@ -1,219 +0,0 @@
1;;; mh-identity.el --- Multiple Identify support for MH-E.
2
3;; Copyright (C) 2002 Free Software Foundation, Inc.
4
5;; Author: Peter S. Galbraith <psg@debian.org>
6;; Maintainer: Bill Wohler <wohler@newt.com>
7;; Keywords: mail
8;; See: mh-e.el
9
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
14;; the Free Software Foundation; either version 2, or (at your option)
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 the
24;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
25;; Boston, MA 02111-1307, USA.
26
27;;; Commentary:
28
29;; Multiple identity support for MH-E.
30;;
31;; Used to easily set different fields such as From and Organization, as
32;; well as different signature files.
33;;
34;; Customize the variable `mh-identity-list' and an Identity menu will
35;; appear in mh-letter-mode. The command 'mh-insert-identity can be used
36;; from the command line.
37
38;;; Change Log:
39
40;; $Id: mh-identity.el,v 1.17 2002/12/03 15:54:27 psg Exp $
41
42;;; Code:
43
44
45(require 'cl)
46
47(eval-when (compile load eval)
48 (defvar mh-comp-loaded nil)
49 (unless mh-comp-loaded
50 (setq mh-comp-loaded t)
51 (require 'mh-comp))) ;Since we do this on sending
52
53(autoload 'mml-insert-tag "mml")
54
55;;;###mh-autoload
56(defun mh-identity-make-menu ()
57 "Build (or rebuild) the Identity menu (e.g. after the list is modified)."
58 (when (and mh-identity-list (boundp 'mh-letter-mode-map))
59 (easy-menu-define mh-identity-menu mh-letter-mode-map
60 "mh-e identity menu"
61 (append
62 '("Identity")
63 ;; Dynamically render :type corresponding to `mh-identity-list'
64 ;; e.g.:
65 ;; ["home" (mh-insert-identity "home")
66 ;; :style radio :active (not (equal mh-identity-local "home"))
67 ;; :selected (equal mh-identity-local "home")]
68 (mapcar (function
69 (lambda (arg)
70 `[,arg (mh-insert-identity ,arg) :style radio
71 :active (not (equal mh-identity-local ,arg))
72 :selected (equal mh-identity-local ,arg)]))
73 (mapcar 'car mh-identity-list))
74 '("--"
75 ["none" (mh-insert-identity "none") mh-identity-local]
76 ["Set Default for Session"
77 (setq mh-identity-default mh-identity-local) t]
78 ["Save as Default"
79 (customize-save-variable
80 'mh-identity-default mh-identity-local) t]
81 )))))
82
83;;;###mh-autoload
84(defun mh-identity-list-set (symbol value)
85 "Update the `mh-identity-list' variable, and rebuild the menu.
86Sets the default for SYMBOL (e.g. `mh-identity-list') to VALUE (as set in
87customization). This is called after 'customize is used to alter
88`mh-identity-list'."
89 (set-default symbol value)
90 (mh-identity-make-menu))
91
92(defvar mh-identity-local nil
93 "Buffer-local variable holding the identity currently in use.")
94(make-variable-buffer-local 'mh-identity-local)
95
96(defun mh-header-field-delete (field value-only)
97 "Delete FIELD in the mail header, or only its value if VALUE-ONLY is t.
98Return t if anything is deleted."
99 (when (mh-goto-header-field field)
100 (if (not value-only)
101 (beginning-of-line)
102 (forward-char))
103 (delete-region (point)
104 (progn (mh-header-field-end)
105 (if (not value-only) (forward-char 1))
106 (point)))
107 t))
108
109(defvar mh-identity-signature-start nil
110 "Marker for the beginning of a signature inserted by `mh-insert-identity'.")
111(defvar mh-identity-signature-end nil
112 "Marker for the end of a signature inserted by `mh-insert-identity'.")
113
114;;;###mh-autoload
115(defun mh-insert-identity (identity)
116 "Insert proper fields for given IDENTITY.
117Edit the `mh-identity-list' variable to define identity."
118 (interactive
119 (list (completing-read
120 "Identity: "
121 (if mh-identity-local
122 (cons '("none")
123 (mapcar 'list (mapcar 'car mh-identity-list)))
124 (mapcar 'list (mapcar 'car mh-identity-list)))
125 nil t)))
126 (save-excursion
127 ;;First remove old settings, if any.
128 (when mh-identity-local
129 (let ((pers-list (cadr (assoc mh-identity-local mh-identity-list))))
130 (while pers-list
131 (let ((field (concat (caar pers-list) ":")))
132 (cond
133 ((string-equal "signature:" field)
134 (when (and (boundp 'mh-identity-signature-start)
135 (markerp mh-identity-signature-start))
136 (goto-char mh-identity-signature-start)
137 (forward-char -1)
138 (delete-region (point) mh-identity-signature-end)))
139 ((mh-header-field-delete field nil))))
140 (setq pers-list (cdr pers-list)))))
141 ;; Then insert the replacement
142 (when (not (equal "none" identity))
143 (let ((pers-list (cadr (assoc identity mh-identity-list))))
144 (while pers-list
145 (let ((field (concat (caar pers-list) ":"))
146 (value (cdar pers-list)))
147 (cond
148 ;; No value, remove field
149 ((or (not value)
150 (string= value ""))
151 (mh-header-field-delete field nil))
152 ;; Existing field, replace
153 ((mh-header-field-delete field t)
154 (insert value))
155 ;; Handle "signature" special case. Insert file or call function.
156 ((and (string-equal "signature:" field)
157 (or (and (stringp value)
158 (file-readable-p value))
159 (fboundp value)))
160 (goto-char (point-max))
161 (if (not (looking-at "^$"))
162 (insert "\n"))
163 (insert "\n")
164 (save-restriction
165 (narrow-to-region (point) (point))
166 (set (make-local-variable 'mh-identity-signature-start)
167 (make-marker))
168 (set-marker mh-identity-signature-start (point))
169 (cond
170 ;; If MIME composition done, insert signature at the end as
171 ;; an inline MIME part.
172 ((and (boundp 'mh-mhn-compose-insert-flag)
173 mh-mhn-compose-insert-flag)
174 (insert "#\n" "Content-Description: Signature\n"))
175 ((and (boundp 'mh-mml-compose-insert-flag)
176 mh-mml-compose-insert-flag)
177 (mml-insert-tag 'part 'type "text/plain"
178 'disposition "inline"
179 'description "Signature")))
180 (if (stringp value)
181 (insert-file-contents value)
182 (funcall value))
183 (goto-char (point-min))
184 (when (not (re-search-forward "^--" nil t))
185 (if (and (boundp 'mh-mhn-compose-insert-flag)
186 mh-mhn-compose-insert-flag)
187 (forward-line 2))
188 (if (and (boundp 'mh-mml-compose-insert-flag)
189 mh-mml-compose-insert-flag)
190 (forward-line 1))
191 (insert "-- \n"))
192 (set (make-local-variable 'mh-identity-signature-end)
193 (make-marker))
194 (set-marker mh-identity-signature-end (point-max))))
195 ;; Handle "From" field differently, adding it at the beginning.
196 ((string-equal "From:" field)
197 (goto-char (point-min))
198 (insert "From: " value "\n"))
199 ;; Skip empty signature (Can't remove what we don't know)
200 ((string-equal "signature:" field))
201 ;; Other field, add at end
202 (t ;Otherwise, add the end.
203 (goto-char (point-min))
204 (mh-goto-header-end 0)
205 (mh-insert-fields field value))))
206 (setq pers-list (cdr pers-list))))))
207 ;; Remember what is in use in this buffer
208 (if (equal "none" identity)
209 (setq mh-identity-local nil)
210 (setq mh-identity-local identity)))
211
212(provide 'mh-identity)
213
214;;; Local Variables:
215;;; indent-tabs-mode: nil
216;;; sentence-end-double-space: nil
217;;; End:
218
219;;; mh-identity.el ends here
diff --git a/lisp/mail/mh-index.el b/lisp/mail/mh-index.el
deleted file mode 100644
index a04a11b651f..00000000000
--- a/lisp/mail/mh-index.el
+++ /dev/null
@@ -1,948 +0,0 @@
1;;; mh-index -- MH-E interface to indexing programs
2
3;; Copyright (C) 2002 Free Software Foundation, Inc.
4
5;; Author: Satyaki Das <satyaki@theforce.stanford.edu>
6;; Maintainer: Bill Wohler <wohler@newt.com>
7;; Keywords: mail
8;; See: mh-e.el
9
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
14;; the Free Software Foundation; either version 2, or (at your option)
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 the
24;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
25;; Boston, MA 02111-1307, USA.
26
27;;; Commentary:
28
29;;; (1) The following search engines are supported:
30;;; swish++
31;;; swish-e
32;;; namazu
33;;; glimpse
34;;; grep
35;;;
36;;; (2) To use this package, you first have to build an index. Please read
37;;; the documentation for `mh-index-search' to get started. That
38;;; documentation will direct you to the specific instructions for your
39;;; particular indexer.
40
41;;; Change Log:
42
43;; $Id: mh-index.el,v 1.73 2003/01/07 21:15:49 satyaki Exp $
44
45;;; Code:
46
47(require 'cl)
48(require 'mh-e)
49(require 'mh-mime)
50
51(autoload 'gnus-local-map-property "gnus-util")
52(autoload 'gnus-eval-format "gnus-spec")
53(autoload 'widget-convert-button "wid-edit")
54(autoload 'executable-find "executable")
55
56;; Support different indexing programs
57(defvar mh-indexer-choices
58 '((swish++
59 mh-swish++-binary mh-swish++-execute-search mh-swish++-next-result)
60 (swish
61 mh-swish-binary mh-swish-execute-search mh-swish-next-result)
62 (namazu
63 mh-namazu-binary mh-namazu-execute-search mh-namazu-next-result)
64 (glimpse
65 mh-glimpse-binary mh-glimpse-execute-search mh-glimpse-next-result)
66 (grep
67 mh-grep-binary mh-grep-execute-search mh-grep-next-result))
68 "List of possible indexer choices.")
69(defvar mh-indexer nil
70 "Chosen index program.")
71(defvar mh-index-execute-search-function nil
72 "Function which executes the search program.")
73(defvar mh-index-next-result-function nil
74 "Function to parse the next line of output.")
75
76;; FIXME: This should be a defcustom...
77(defvar mh-index-folder "+mhe-index"
78 "Folder that contains the folders resulting from the index searches.")
79
80;; Temporary buffers for search results
81(defvar mh-index-temp-buffer " *mh-index-temp*")
82(defvar mh-checksum-buffer " *mh-checksum-buffer*")
83
84
85
86;;; A few different checksum programs are supported. The supported programs
87;;; are:
88;;; 1. md5sum
89;;; 2. md5
90;;; 3. openssl
91;;;
92;;; To add support for your favorite checksum program add a clause to the cond
93;;; statement in mh-checksum-choose. This should set the variable
94;;; mh-checksum-cmd to the command line needed to run the checsum program and
95;;; should set mh-checksum-parser to a function which returns a cons cell
96;;; containing the message number and checksum string.
97
98(defvar mh-checksum-cmd)
99(defvar mh-checksum-parser)
100
101(defun mh-checksum-choose ()
102 "Check if a program to create a checksum is present."
103 (unless (boundp 'mh-checksum-cmd)
104 (let ((exec-path (append '("/sbin" "/usr/sbin") exec-path)))
105 (cond ((executable-find "md5sum")
106 (setq mh-checksum-cmd (list (executable-find "md5sum")))
107 (setq mh-checksum-parser #'mh-md5sum-parser))
108 ((executable-find "openssl")
109 (setq mh-checksum-cmd (list (executable-find "openssl") "md5"))
110 (setq mh-checksum-parser #'mh-openssl-parser))
111 ((executable-find "md5")
112 (setq mh-checksum-cmd (list (executable-find "md5")))
113 (setq mh-checksum-parser #'mh-md5-parser))
114 (t (error "No suitable checksum program"))))))
115
116(defun mh-md5sum-parser ()
117 "Parse md5sum output."
118 (let ((begin (line-beginning-position))
119 (end (line-end-position))
120 first-space last-slash)
121 (setq first-space (search-forward " " end t))
122 (goto-char end)
123 (setq last-slash (search-backward "/" begin t))
124 (cond ((and first-space last-slash)
125 (cons (car (read-from-string (buffer-substring-no-properties
126 (1+ last-slash) end)))
127 (buffer-substring-no-properties begin (1- first-space))))
128 (t (cons nil nil)))))
129
130(defun mh-openssl-parser ()
131 "Parse openssl output."
132 (let ((begin (line-beginning-position))
133 (end (line-end-position))
134 last-space last-slash)
135 (goto-char end)
136 (setq last-space (search-backward " " begin t))
137 (setq last-slash (search-backward "/" begin t))
138 (cond ((and last-slash last-space)
139 (cons (car (read-from-string (buffer-substring-no-properties
140 (1+ last-slash) (1- last-space))))
141 (buffer-substring-no-properties (1+ last-space) end))))))
142
143(defalias 'mh-md5-parser 'mh-openssl-parser)
144
145
146
147;;; Make sure that we don't produce too long a command line.
148
149(defvar mh-index-max-cmdline-args 500
150 "Maximum number of command line args.")
151
152(defun mh-index-execute (cmd &rest args)
153 "Partial imitation of xargs.
154The current buffer contains a list of strings, one on each line. The function
155will execute CMD with ARGS and pass the first `mh-index-max-cmdline-args'
156strings to it. This is repeated till all the strings have been used."
157 (goto-char (point-min))
158 (let ((out (get-buffer-create " *mh-xargs-output*")))
159 (save-excursion
160 (set-buffer out)
161 (erase-buffer))
162 (while (not (eobp))
163 (let ((arg-list (reverse args))
164 (count 0))
165 (while (and (not (eobp)) (< count mh-index-max-cmdline-args))
166 (push (buffer-substring-no-properties (point) (line-end-position))
167 arg-list)
168 (incf count)
169 (forward-line))
170 (apply #'call-process cmd nil (list out nil) nil (nreverse arg-list))))
171 (erase-buffer)
172 (insert-buffer-substring out)))
173
174
175
176(defun mh-index-update-single-msg (msg checksum origin-map)
177 "Update various maps for one message.
178MSG is a index folder message, CHECKSUM its MD5 hash and ORIGIN-MAP, if
179non-nil, a hashtable containing which maps each message in the index folder to
180the folder and message that it was copied from. The function updates the hash
181tables `mh-index-msg-checksum-map' and `mh-index-checksum-origin-map'.
182
183This function should only be called in the appropriate index folder buffer."
184 (cond ((and origin-map (gethash checksum mh-index-checksum-origin-map))
185 (let* ((intermediate (gethash msg origin-map))
186 (ofolder (car intermediate))
187 (omsg (cdr intermediate)))
188 ;; This is most probably a duplicate. So eliminate it.
189 (call-process "rm" nil nil nil
190 (format "%s%s/%s" mh-user-path
191 (substring mh-current-folder 1) msg))
192 (remhash omsg (gethash ofolder mh-index-data))))
193 (t
194 (setf (gethash msg mh-index-msg-checksum-map) checksum)
195 (when origin-map
196 (setf (gethash checksum mh-index-checksum-origin-map)
197 (gethash msg origin-map))))))
198
199;;;###mh-autoload
200(defun mh-index-update-maps (folder &optional origin-map)
201 "Annotate all as yet unannotated messages in FOLDER with their MD5 hash.
202As a side effect msg -> checksum map is updated. Optional argument ORIGIN-MAP
203is a hashtable which maps each message in the index folder to the original
204folder and message from whence it was copied. If present the
205checksum -> (origin-folder, origin-index) map is updated too."
206 (clrhash mh-index-msg-checksum-map)
207 (save-excursion
208 ;; Clear temp buffer
209 (set-buffer (get-buffer-create mh-checksum-buffer))
210 (erase-buffer)
211 ;; Run scan to check if any messages needs MD5 annotations at all
212 (with-temp-buffer
213 (mh-exec-cmd-output mh-scan-prog nil "-width" "80"
214 "-format" "%(msg)\n%{x-mhe-checksum}\n"
215 folder "all")
216 (goto-char (point-min))
217 (let (msg checksum)
218 (while (not (eobp))
219 (setq msg (buffer-substring-no-properties
220 (point) (line-end-position)))
221 (forward-line)
222 (save-excursion
223 (cond ((eolp)
224 ;; need to compute checksum
225 (set-buffer mh-checksum-buffer)
226 (insert mh-user-path (substring folder 1) "/" msg "\n"))
227 (t
228 ;; update maps
229 (setq checksum (buffer-substring-no-properties
230 (point) (line-end-position)))
231 (let ((msg (car (read-from-string msg))))
232 (set-buffer folder)
233 (mh-index-update-single-msg msg checksum origin-map)))))
234 (forward-line))))
235 ;; Run checksum program if needed
236 (unless (and (eobp) (bobp))
237 (apply #'mh-index-execute mh-checksum-cmd)
238 (goto-char (point-min))
239 (while (not (eobp))
240 (let* ((intermediate (funcall mh-checksum-parser))
241 (msg (car intermediate))
242 (checksum (cdr intermediate)))
243 (when msg
244 ;; annotate
245 (mh-exec-cmd "anno" folder msg "-component" "X-MHE-Checksum"
246 "-nodate" "-text" checksum "-inplace")
247 ;; update maps
248 (save-excursion
249 (set-buffer folder)
250 (mh-index-update-single-msg msg checksum origin-map)))
251 (forward-line))))))
252
253(defun mh-index-generate-pretty-name (string)
254 "Given STRING generate a name which is suitable for use as a folder name.
255White space from the beginning and end are removed. All spaces in the name are
256replaced with underscores and all / are replaced with $. If STRING is longer
257than 20 it is truncated too."
258 (with-temp-buffer
259 (insert string)
260 (goto-char (point-min))
261 (while (and (not (eobp)) (memq (char-after) '(? ?\t ?\n ?\r)))
262 (delete-char 1))
263 (goto-char (point-max))
264 (while (and (not (bobp)) (memq (char-before) '(? ?\t ?\n ?\r)))
265 (delete-backward-char 1))
266 (subst-char-in-region (point-min) (point-max) ? ?_ t)
267 (subst-char-in-region (point-min) (point-max) ?\t ?_ t)
268 (subst-char-in-region (point-min) (point-max) ?\n ?_ t)
269 (subst-char-in-region (point-min) (point-max) ?\r ?_ t)
270 (subst-char-in-region (point-min) (point-max) ?/ ?$ t)
271 (truncate-string-to-width (buffer-substring (point-min) (point-max)) 20)))
272
273;;;###mh-autoload
274(defun mh-index-search (redo-search-flag folder search-regexp)
275 "Perform an indexed search in an MH mail folder.
276
277If REDO-SEARCH-FLAG is non-nil and the current folder buffer was generated by a
278index search, then the search is repeated. Otherwise, FOLDER is searched with
279SEARCH-REGEXP and the results are presented in an MH-E folder. If FOLDER is
280\"+\" then mail in all folders are searched.
281
282Four indexing programs are supported; if none of these are present, then grep
283is used. This function picks the first program that is available on your
284system. If you would prefer to use a different program, set the customization
285variable `mh-index-program' accordingly.
286
287The documentation for the following functions describes how to generate the
288index for each program:
289
290 - `mh-swish++-execute-search'
291 - `mh-swish-execute-search'
292 - `mh-namazu-execute-search'
293 - `mh-glimpse-execute-search'
294
295This and related functions use an X-MHE-Checksum header to cache the MD5
296checksum of a message. This means that already present X-MHE-Checksum headers
297in the incoming email could result in messages not being found. The following
298procmail recipe should avoid this:
299
300 :0 wf
301 | formail -R \"X-MHE-Checksum\" \"Old-X-MHE-Checksum\"
302
303This has the effect of renaming already present X-MHE-Checksum headers."
304 (interactive
305 (list current-prefix-arg
306 (progn
307 (unless mh-find-path-run (mh-find-path))
308 (or (and current-prefix-arg (car mh-index-previous-search))
309 (mh-prompt-for-folder "Search" "+" nil "all")))
310 (progn
311 ;; Yes, we do want to call mh-index-choose every time in case the
312 ;; user has switched the indexer manually.
313 (unless (mh-index-choose) (error "No indexing program found"))
314 (or (and current-prefix-arg (cadr mh-index-previous-search))
315 (read-string (format "%s regexp: "
316 (upcase-initials
317 (symbol-name mh-indexer))))))))
318 (mh-checksum-choose)
319 (let ((result-count 0)
320 (old-window-config mh-previous-window-config)
321 (previous-search mh-index-previous-search)
322 (index-folder (format "%s/%s" mh-index-folder
323 (mh-index-generate-pretty-name search-regexp))))
324 ;; Create a new folder for the search results or recreate the old one...
325 (if (and redo-search-flag mh-index-previous-search)
326 (let ((buffer-name (buffer-name (current-buffer))))
327 (mh-process-or-undo-commands buffer-name)
328 (save-excursion (mh-exec-cmd-quiet nil "rmf" buffer-name))
329 (mh-exec-cmd-quiet nil "folder" "-create" "-fast" buffer-name)
330 (setq index-folder buffer-name))
331 (setq index-folder (mh-index-new-folder index-folder)))
332
333 (let ((folder-path (format "%s%s" mh-user-path (substring folder 1)))
334 (folder-results-map (make-hash-table :test #'equal))
335 (origin-map (make-hash-table :test #'equal)))
336 ;; Run search program...
337 (message "Executing %s... " mh-indexer)
338 (funcall mh-index-execute-search-function folder-path search-regexp)
339
340 ;; Parse indexer output
341 (message "Processing %s output... " mh-indexer)
342 (goto-char (point-min))
343 (loop for next-result = (funcall mh-index-next-result-function)
344 when (null next-result) return nil
345 do (unless (eq next-result 'error)
346 (unless (gethash (car next-result) folder-results-map)
347 (setf (gethash (car next-result) folder-results-map)
348 (make-hash-table :test #'equal)))
349 (setf (gethash (cadr next-result)
350 (gethash (car next-result) folder-results-map))
351 t)))
352
353 ;; Copy the search results over
354 (maphash #'(lambda (folder msgs)
355 (let ((msgs (sort (loop for msg being the hash-keys of msgs
356 collect msg)
357 #'<)))
358 (mh-exec-cmd "refile" msgs "-src" folder
359 "-link" index-folder)
360 (loop for msg in msgs
361 do (incf result-count)
362 (setf (gethash result-count origin-map)
363 (cons folder msg)))))
364 folder-results-map)
365
366 ;; Generate scan lines for the hits.
367 (let ((mh-show-threads-flag nil))
368 (mh-visit-folder index-folder () (list folder-results-map origin-map)))
369
370 (goto-char (point-min))
371 (forward-line)
372 (mh-update-sequences)
373 (mh-recenter nil)
374
375 ;; Maintain history
376 (when (and redo-search-flag previous-search)
377 (setq mh-previous-window-config old-window-config))
378 (setq mh-index-previous-search (list folder search-regexp))
379
380 (message "%s found %s matches in %s folders"
381 (upcase-initials (symbol-name mh-indexer))
382 (loop for msg-hash being hash-values of mh-index-data
383 sum (hash-table-count msg-hash))
384 (loop for msg-hash being hash-values of mh-index-data
385 count (> (hash-table-count msg-hash) 0))))))
386
387;;;###mh-autoload
388(defun mh-index-next-folder (&optional backward-flag)
389 "Jump to the next folder marker.
390The function is only applicable to folders displaying index search results.
391With non-nil optional argument BACKWARD-FLAG, jump to the previous group of
392results."
393 (interactive "P")
394 (if (or (null mh-index-data)
395 (memq 'unthread mh-view-ops))
396 (message "Only applicable in an unthreaded MH-E index search buffer")
397 (let ((point (point)))
398 (forward-line (if backward-flag -1 1))
399 (cond ((if backward-flag
400 (re-search-backward "^+" (point-min) t)
401 (re-search-forward "^+" (point-max) t))
402 (beginning-of-line))
403 ((and (if backward-flag
404 (goto-char (point-max))
405 (goto-char (point-min)))
406 nil))
407 ((if backward-flag
408 (re-search-backward "^+" (point-min) t)
409 (re-search-forward "^+" (point-max) t))
410 (beginning-of-line))
411 (t (goto-char point))))))
412
413;;;###mh-autoload
414(defun mh-index-previous-folder ()
415 "Jump to the previous folder marker."
416 (interactive)
417 (mh-index-next-folder t))
418
419(defun mh-folder-exists-p (folder)
420 "Check if FOLDER exists."
421 (and (mh-folder-name-p folder)
422 (save-excursion
423 (with-temp-buffer
424 (mh-exec-cmd-output "folder" nil "-fast" "-nocreate" folder)
425 (goto-char (point-min))
426 (not (eobp))))))
427
428(defun mh-msg-exists-p (msg folder)
429 "Check if MSG exists in FOLDER."
430 (file-exists-p (format "%s%s/%s" mh-user-path (substring folder 1) msg)))
431
432(defun mh-index-new-folder (name)
433 "Create and return an MH folder name based on NAME.
434If the folder NAME already exists then check if NAME<2> exists. If it doesn't
435then it is created and returned. Otherwise try NAME<3>. This is repeated till
436we find a new folder name."
437 (unless (mh-folder-name-p name)
438 (error "The argument should be a valid MH folder name"))
439 (let ((chosen-name name))
440 (block unique-name
441 (unless (mh-folder-exists-p name)
442 (return-from unique-name))
443 (loop for index from 2
444 do (let ((new-name (format "%s<%s>" name index)))
445 (unless (mh-folder-exists-p new-name)
446 (setq chosen-name new-name)
447 (return-from unique-name)))))
448 (mh-exec-cmd-quiet nil "folder" "-create" "-fast" chosen-name)
449 (when (boundp 'mh-speed-folder-map)
450 (mh-speed-add-folder chosen-name))
451 (push (list chosen-name) mh-folder-list)
452 chosen-name))
453
454;;;###mh-autoload
455(defun mh-index-insert-folder-headers ()
456 "Annotate the search results with original folder names."
457 (let ((cur-msg (mh-get-msg-num nil))
458 (old-buffer-modified-flag (buffer-modified-p))
459 (buffer-read-only nil)
460 current-folder last-folder)
461 (goto-char (point-min))
462 (while (not (eobp))
463 (setq current-folder (car (gethash (gethash (mh-get-msg-num nil)
464 mh-index-msg-checksum-map)
465 mh-index-checksum-origin-map)))
466 (when (and current-folder (not (eq current-folder last-folder)))
467 (insert (if last-folder "\n" "") current-folder "\n")
468 (setq last-folder current-folder))
469 (forward-line))
470 (when cur-msg (mh-goto-msg cur-msg t))
471 (set-buffer-modified-p old-buffer-modified-flag)))
472
473;;;###mh-autoload
474(defun mh-index-delete-folder-headers ()
475 "Delete the folder headers."
476 (let ((cur-msg (mh-get-msg-num nil))
477 (old-buffer-modified-flag (buffer-modified-p))
478 (buffer-read-only nil))
479 (goto-char (point-min))
480 (while (not (eobp))
481 (if (or (char-equal (char-after) ?+) (char-equal (char-after) 10))
482 (delete-region (point) (progn (forward-line) (point)))
483 (forward-line)))
484 (when cur-msg (mh-goto-msg cur-msg t t))
485 (set-buffer-modified-p old-buffer-modified-flag)))
486
487;;;###mh-autoload
488(defun mh-index-visit-folder ()
489 "Visit original folder from where the message at point was found."
490 (interactive)
491 (unless mh-index-data
492 (error "Not in an index folder"))
493 (let (folder msg)
494 (save-excursion
495 (cond ((and (bolp) (eolp))
496 (ignore-errors (forward-line -1))
497 (setq msg (mh-get-msg-num t)))
498 ((equal (char-after (line-beginning-position)) ?+)
499 (setq folder (buffer-substring-no-properties
500 (line-beginning-position) (line-end-position))))
501 (t (setq msg (mh-get-msg-num t)))))
502 (when (not folder)
503 (setq folder (car (gethash (gethash msg mh-index-msg-checksum-map)
504 mh-index-checksum-origin-map))))
505 (mh-visit-folder
506 folder (loop for x being the hash-keys of (gethash folder mh-index-data)
507 when (mh-msg-exists-p x folder) collect x))))
508
509(defun mh-index-match-checksum (msg folder checksum)
510 "Check if MSG in FOLDER has X-MHE-Checksum header value of CHECKSUM."
511 (with-temp-buffer
512 (mh-exec-cmd-output mh-scan-prog nil "-width" "80"
513 "-format" "%{x-mhe-checksum}\n" folder msg)
514 (goto-char (point-min))
515 (string-equal (buffer-substring-no-properties (point) (line-end-position))
516 checksum)))
517
518;;;###mh-autoload
519(defun mh-index-execute-commands ()
520 "Delete/refile the actual messages.
521The copies in the searched folder are then deleted/refiled to get the desired
522result. Before deleting the messages we make sure that the message being
523deleted is identical to the one that the user has marked in the index buffer."
524 (let ((message-table (make-hash-table :test #'equal)))
525 (dolist (msg-list (cons mh-delete-list (mapcar #'cdr mh-refile-list)))
526 (dolist (msg msg-list)
527 (let* ((checksum (gethash msg mh-index-msg-checksum-map))
528 (pair (gethash checksum mh-index-checksum-origin-map)))
529 (when (and checksum (car pair) (cdr pair)
530 (mh-index-match-checksum (cdr pair) (car pair) checksum))
531 (push (cdr pair) (gethash (car pair) message-table))
532 (remhash (cdr pair) (gethash (car pair) mh-index-data))))))
533 (maphash (lambda (folder msgs)
534 (apply #'mh-exec-cmd "rmm" folder (mh-coalesce-msg-list msgs)))
535 message-table)))
536
537
538
539;; Glimpse interface
540
541(defvar mh-glimpse-binary (executable-find "glimpse"))
542(defvar mh-glimpse-directory ".glimpse")
543
544;;;###mh-autoload
545(defun mh-glimpse-execute-search (folder-path search-regexp)
546 "Execute glimpse and read the results.
547
548In the examples below, replace /home/user/Mail with the path to your MH
549directory.
550
551First create the directory /home/user/Mail/.glimpse. Then create the file
552/home/user/Mail/.glimpse/.glimpse_exclude with the following contents:
553
554 */.*
555 */#*
556 */,*
557 */*~
558 ^/home/user/Mail/.glimpse
559 ^/home/user/Mail/mhe-index
560
561If there are any directories you would like to ignore, append lines like the
562following to .glimpse_exclude:
563
564 ^/home/user/Mail/scripts
565
566You do not want to index the folders that hold the results of your searches
567since they tend to be ephemeral and the original messages are indexed anyway.
568The configuration file above assumes that the results are found in sub-folders
569of `mh-index-folder' which is +mhe-index by default.
570
571Use the following command line to generate the glimpse index. Run this
572daily from cron:
573
574 glimpseindex -H /home/user/Mail/.glimpse /home/user/Mail
575
576FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search."
577 (set-buffer (get-buffer-create mh-index-temp-buffer))
578 (erase-buffer)
579 (call-process mh-glimpse-binary nil '(t nil) nil
580 ;(format "-%s" fuzz)
581 "-i" "-y"
582 "-H" (format "%s%s" mh-user-path mh-glimpse-directory)
583 "-F" (format "^%s" folder-path)
584 search-regexp)
585 (goto-char (point-min)))
586
587(defun mh-glimpse-next-result ()
588 "Read the next result.
589Parse it and return the message folder, message index and the match. If no
590other matches left then return nil. If the current record is invalid return
591'error."
592 (prog1
593 (block nil
594 (when (eobp)
595 (return nil))
596 (let ((eol-pos (line-end-position))
597 (bol-pos (line-beginning-position))
598 folder-start msg-end)
599 (goto-char bol-pos)
600 (unless (search-forward mh-user-path eol-pos t)
601 (return 'error))
602 (setq folder-start (point))
603 (unless (search-forward ": " eol-pos t)
604 (return 'error))
605 (let ((match (buffer-substring-no-properties (point) eol-pos)))
606 (forward-char -2)
607 (setq msg-end (point))
608 (unless (search-backward "/" folder-start t)
609 (return 'error))
610 (list (format "+%s" (buffer-substring-no-properties
611 folder-start (point)))
612 (let ((val (ignore-errors (read-from-string
613 (buffer-substring-no-properties
614 (1+ (point)) msg-end)))))
615 (if (and (consp val) (integerp (car val)))
616 (car val)
617 (return 'error)))
618 match))))
619 (forward-line)))
620
621
622
623;; Grep interface
624
625(defvar mh-grep-binary (executable-find "grep"))
626
627(defun mh-grep-execute-search (folder-path search-regexp)
628 "Execute grep and read the results.
629FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search."
630 (set-buffer (get-buffer-create mh-index-temp-buffer))
631 (erase-buffer)
632 (call-process mh-grep-binary nil '(t nil) nil
633 "-i" "-r" search-regexp folder-path)
634 (goto-char (point-min)))
635
636(defun mh-grep-next-result ()
637 "Read the next result.
638Parse it and return the message folder, message index and the match. If no
639other matches left then return nil. If the current record is invalid return
640'error."
641 (prog1
642 (block nil
643 (when (eobp)
644 (return nil))
645 (let ((eol-pos (line-end-position))
646 (bol-pos (line-beginning-position))
647 folder-start msg-end)
648 (goto-char bol-pos)
649 (unless (search-forward mh-user-path eol-pos t)
650 (return 'error))
651 (setq folder-start (point))
652 (unless (search-forward ":" eol-pos t)
653 (return 'error))
654 (let ((match (buffer-substring-no-properties (point) eol-pos)))
655 (forward-char -1)
656 (setq msg-end (point))
657 (unless (search-backward "/" folder-start t)
658 (return 'error))
659 (list (format "+%s" (buffer-substring-no-properties
660 folder-start (point)))
661 (let ((val (ignore-errors (read-from-string
662 (buffer-substring-no-properties
663 (1+ (point)) msg-end)))))
664 (if (and (consp val) (integerp (car val)))
665 (car val)
666 (return 'error)))
667 match))))
668 (forward-line)))
669
670
671
672;; Swish interface
673
674(defvar mh-swish-binary (executable-find "swish-e"))
675(defvar mh-swish-directory ".swish")
676(defvar mh-swish-folder nil)
677
678;;;###mh-autoload
679(defun mh-swish-execute-search (folder-path search-regexp)
680 "Execute swish-e and read the results.
681
682In the examples below, replace /home/user/Mail with the path to your MH
683directory.
684
685First create the directory /home/user/Mail/.swish. Then create the file
686/home/user/Mail/.swish/config with the following contents:
687
688 IndexDir /home/user/Mail
689 IndexFile /home/user/Mail/.swish/index
690 IndexName \"Mail Index\"
691 IndexDescription \"Mail Index\"
692 IndexPointer \"http://nowhere\"
693 IndexAdmin \"nobody\"
694 #MetaNames automatic
695 IndexReport 3
696 FollowSymLinks no
697 UseStemming no
698 IgnoreTotalWordCountWhenRanking yes
699 WordCharacters abcdefghijklmnopqrstuvwxyz0123456789-
700 BeginCharacters abcdefghijklmnopqrstuvwxyz
701 EndCharacters abcdefghijklmnopqrstuvwxyz0123456789
702 IgnoreLimit 50 1000
703 IndexComments 0
704 FileRules pathname contains /home/user/Mail/.swish
705 FileRules pathname contains /home/user/Mail/mhe-index
706 FileRules filename is index
707 FileRules filename is \..*
708 FileRules filename is #.*
709 FileRules filename is ,.*
710 FileRules filename is .*~
711
712If there are any directories you would like to ignore, append lines like the
713following to config:
714
715 FileRules pathname contains /home/user/Mail/scripts
716
717You do not want to index the folders that hold the results of your searches
718since they tend to be ephemeral and the original messages are indexed anyway.
719The configuration file above assumes that the results are found in sub-folders
720of `mh-index-folder' which is +mhe-index by default.
721
722Use the following command line to generate the swish index. Run this
723daily from cron:
724
725 swish-e -c /home/user/Mail/.swish/config
726
727FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search."
728 (set-buffer (get-buffer-create mh-index-temp-buffer))
729 (erase-buffer)
730 (unless mh-swish-binary
731 (error "Set mh-swish-binary appropriately"))
732 (call-process mh-swish-binary nil '(t nil) nil
733 "-w" search-regexp
734 "-f" (format "%s%s/index" mh-user-path mh-swish-directory))
735 (goto-char (point-min))
736 (setq mh-swish-folder
737 (let ((last-char (substring folder-path (1- (length folder-path)))))
738 (if (equal last-char "/")
739 folder-path
740 (format "%s/" folder-path)))))
741
742(defun mh-swish-next-result ()
743 "Get the next result from swish output."
744 (prog1
745 (block nil
746 (when (or (eobp) (equal (char-after (point)) ?.))
747 (return nil))
748 (when (equal (char-after (point)) ?#)
749 (return 'error))
750 (let* ((start (search-forward " " (line-end-position) t))
751 (end (search-forward " " (line-end-position) t)))
752 (unless (and start end)
753 (return 'error))
754 (setq end (1- end))
755 (unless (file-exists-p (buffer-substring-no-properties start end))
756 (return 'error))
757 (unless (search-backward "/" start t)
758 (return 'error))
759 (list (let* ((s (buffer-substring-no-properties start (1+ (point)))))
760 (unless (string-match mh-swish-folder s)
761 (return 'error))
762 (if (string-match mh-user-path s)
763 (format "+%s"
764 (substring s (match-end 0) (1- (length s))))
765 (return 'error)))
766 (let* ((s (buffer-substring-no-properties (1+ (point)) end))
767 (val (ignore-errors (read-from-string s))))
768 (if (and (consp val) (numberp (car val)))
769 (car val)
770 (return 'error)))
771 nil)))
772 (forward-line)))
773
774
775
776;; Swish++ interface
777
778(defvar mh-swish++-binary (or (executable-find "search++")
779 (executable-find "search")))
780(defvar mh-swish++-directory ".swish++")
781
782;;;###mh-autoload
783(defun mh-swish++-execute-search (folder-path search-regexp)
784 "Execute swish++ and read the results.
785
786In the examples below, replace /home/user/Mail with the path to your MH
787directory.
788
789First create the directory /home/user/Mail/.swish++. Then create the file
790/home/user/Mail/.swish++/swish++.conf with the following contents:
791
792 IncludeMeta Bcc Cc Comments Content-Description From Keywords
793 IncludeMeta Newsgroups Resent-To Subject To
794 IncludeMeta Message-Id References In-Reply-To
795 IncludeFile Mail *
796 IndexFile /home/user/Mail/.swish++/swish++.index
797
798Use the following command line to generate the swish index. Run this
799daily from cron:
800
801 find /home/user/Mail -path /home/user/Mail/mhe-index -prune \\
802 -o -path /home/user/Mail/.swish++ -prune \\
803 -o -name \"[0-9]*\" -print \\
804 | index -c /home/user/Mail/.swish++/swish++.conf /home/user/Mail
805
806You do not want to index the folders that hold the results of your searches
807since they tend to be ephemeral and the original messages are indexed anyway.
808The command above assumes that the results are found in sub-folders of
809`mh-index-folder' which is +mhe-index by default.
810
811On some systems (Debian GNU/Linux, for example), use index++ instead of index.
812
813FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search."
814 (set-buffer (get-buffer-create mh-index-temp-buffer))
815 (erase-buffer)
816 (unless mh-swish++-binary
817 (error "Set mh-swish++-binary appropriately"))
818 (call-process mh-swish++-binary nil '(t nil) nil
819 "-m" "10000"
820 (format "-i%s%s/swish++.index"
821 mh-user-path mh-swish++-directory)
822 search-regexp)
823 (goto-char (point-min))
824 (setq mh-swish-folder
825 (let ((last-char (substring folder-path (1- (length folder-path)))))
826 (if (equal last-char "/")
827 folder-path
828 (format "%s/" folder-path)))))
829
830(defalias 'mh-swish++-next-result 'mh-swish-next-result)
831
832
833
834;; Namazu interface
835
836(defvar mh-namazu-binary (executable-find "namazu"))
837(defvar mh-namazu-directory ".namazu")
838(defvar mh-namazu-folder nil)
839
840;;;###mh-autoload
841(defun mh-namazu-execute-search (folder-path search-regexp)
842 "Execute namazu and read the results.
843
844In the examples below, replace /home/user/Mail with the path to your MH
845directory.
846
847First create the directory /home/user/Mail/.namazu. Then create the file
848/home/user/Mail/.namazu/mknmzrc with the following contents:
849
850 package conf; # Don't remove this line!
851 $ADDRESS = 'user@localhost';
852 $ALLOW_FILE = \"[0-9]*\";
853 $EXCLUDE_PATH = \"^/home/user/Mail/(mhe-index|spam)\";
854
855In the above example configuration, none of the mail files contained in the
856directories /home/user/Mail/mhe-index and /home/user/Mail/spam are indexed.
857
858You do not want to index the folders that hold the results of your searches
859since they tend to be ephemeral and the original messages are indexed anyway.
860The configuration file above assumes that the results are found in sub-folders
861of `mh-index-folder' which is +mhe-index by default.
862
863Use the following command line to generate the namazu index. Run this
864daily from cron:
865
866 mknmz -f /home/user/Mail/.namazu/mknmzrc -O /home/user/Mail/.namazu \\
867 /home/user/Mail
868
869FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search."
870 (let ((namazu-index-directory
871 (format "%s%s" mh-user-path mh-namazu-directory)))
872 (unless (file-exists-p namazu-index-directory)
873 (error "Namazu directory %s not present" namazu-index-directory))
874 (unless (executable-find mh-namazu-binary)
875 (error "Set mh-namazu-binary appropriately"))
876 (set-buffer (get-buffer-create mh-index-temp-buffer))
877 (erase-buffer)
878 (call-process mh-namazu-binary nil '(t nil) nil
879 "-alR" search-regexp namazu-index-directory)
880 (goto-char (point-min))
881 (setq mh-namazu-folder
882 (let ((last (substring folder-path (1- (length folder-path)))))
883 (if (equal last "/")
884 folder-path
885 (format "%s/" folder-path))))))
886
887(defun mh-namazu-next-result ()
888 "Get the next result from namazu output."
889 (prog1
890 (block nil
891 (when (eobp) (return nil))
892 (let ((file-name (buffer-substring-no-properties
893 (point) (line-end-position))))
894 (unless (equal (string-match mh-namazu-folder file-name) 0)
895 (return 'error))
896 (unless (file-exists-p file-name)
897 (return 'error))
898 (string-match mh-user-path file-name)
899 (let* ((folder/msg (substring file-name (match-end 0)))
900 (mark (mh-search-from-end ?/ folder/msg)))
901 (unless mark (return 'error))
902 (list (format "+%s" (substring folder/msg 0 mark))
903 (let ((n (ignore-errors (read-from-string
904 (substring folder/msg (1+ mark))))))
905 (if (and (consp n) (numberp (car n)))
906 (car n)
907 (return 'error)))
908 nil))))
909 (forward-line)))
910
911
912
913(defun mh-index-choose ()
914 "Choose an indexing function.
915The side-effects of this function are that the variables `mh-indexer',
916`mh-index-execute-search-function', and `mh-index-next-result-function' are
917set according to the first indexer in `mh-indexer-choices' present on the
918system."
919 (block nil
920 ;; The following favors the user's preference; otherwise, the last
921 ;; automatically chosen indexer is used for efficiency rather than going
922 ;; through the list.
923 (let ((program-alist (cond (mh-index-program
924 (list
925 (assoc mh-index-program mh-indexer-choices)))
926 (mh-indexer
927 (list (assoc mh-indexer mh-indexer-choices)))
928 (t mh-indexer-choices))))
929 (while program-alist
930 (let* ((current (pop program-alist))
931 (executable (symbol-value (cadr current))))
932 (when executable
933 (setq mh-indexer (car current))
934 (setq mh-index-execute-search-function (caddr current))
935 (setq mh-index-next-result-function (cadddr current))
936 (return mh-indexer))))
937 nil)))
938
939
940
941(provide 'mh-index)
942
943;;; Local Variables:
944;;; indent-tabs-mode: nil
945;;; sentence-end-double-space: nil
946;;; End:
947
948;;; mh-index ends here
diff --git a/lisp/mail/mh-loaddefs.el b/lisp/mail/mh-loaddefs.el
deleted file mode 100644
index 20cfb8571bd..00000000000
--- a/lisp/mail/mh-loaddefs.el
+++ /dev/null
@@ -1,880 +0,0 @@
1;;; mh-loaddefs.el --- automatically extracted autoloads
2;;
3;;; Commentary:
4;;; Code:
5
6;;;### (autoloads (mh-letter-complete mh-open-line mh-fully-kill-draft
7;;;;;; mh-yank-cur-msg mh-insert-letter mh-send-letter mh-check-whom
8;;;;;; mh-insert-signature mh-to-fcc mh-to-field mh-fill-paragraph-function
9;;;;;; mh-send-other-window mh-send mh-reply mh-redistribute mh-forward
10;;;;;; mh-extract-rejected-mail mh-edit-again) "mh-comp" "mh-comp.el"
11;;;;;; (15899 19356))
12;;; Generated autoloads from mh-comp.el
13
14(autoload (quote mh-edit-again) "mh-comp" "\
15Clean up a draft or a message MSG previously sent and make it resendable.
16Default is the current message.
17The variable `mh-new-draft-cleaned-headers' specifies the headers to remove.
18See also documentation for `\\[mh-send]' function." t nil)
19
20(autoload (quote mh-extract-rejected-mail) "mh-comp" "\
21Extract message MSG returned by the mail system and make it resendable.
22Default is the current message. The variable `mh-new-draft-cleaned-headers'
23gives the headers to clean out of the original message.
24See also documentation for `\\[mh-send]' function." t nil)
25
26(autoload (quote mh-forward) "mh-comp" "\
27Forward one or more messages to the recipients TO and CC.
28
29Use the optional MSG-OR-SEQ to specify a message or sequence to forward.
30
31Default is the displayed message. If optional prefix argument is given then
32prompt for the message sequence. If variable `transient-mark-mode' is non-nil
33and the mark is active, then the selected region is forwarded.
34See also documentation for `\\[mh-send]' function." t nil)
35
36(autoload (quote mh-redistribute) "mh-comp" "\
37Redistribute displayed message to recipients TO and CC.
38Use optional argument MSG to redistribute another message.
39Depending on how your copy of MH was compiled, you may need to change the
40setting of the variable `mh-redist-full-contents'. See its documentation." t nil)
41
42(autoload (quote mh-reply) "mh-comp" "\
43Reply to MESSAGE (default: current message).
44If the optional argument REPLY-TO is not given, prompts for type of addresses
45to reply to:
46 from sender only,
47 to sender and primary recipients,
48 cc/all sender and all recipients.
49If optional prefix argument INCLUDEP provided, then include the message
50in the reply using filter `mhl.reply' in your MH directory.
51If the file named by `mh-repl-formfile' exists, it is used as a skeleton
52for the reply. See also documentation for `\\[mh-send]' function." t nil)
53
54(autoload (quote mh-send) "mh-comp" "\
55Compose and send a letter.
56
57Do not call this function from outside MH-E; use \\[mh-smail] instead.
58
59The file named by `mh-comp-formfile' will be used as the form.
60The letter is composed in `mh-letter-mode'; see its documentation for more
61details.
62If `mh-compose-letter-function' is defined, it is called on the draft and
63passed three arguments: TO, CC, and SUBJECT." t nil)
64
65(autoload (quote mh-send-other-window) "mh-comp" "\
66Compose and send a letter in another window.
67
68Do not call this function from outside MH-E; use \\[mh-smail-other-window]
69instead.
70
71The file named by `mh-comp-formfile' will be used as the form.
72The letter is composed in `mh-letter-mode'; see its documentation for more
73details.
74If `mh-compose-letter-function' is defined, it is called on the draft and
75passed three arguments: TO, CC, and SUBJECT." t nil)
76
77(autoload (quote mh-fill-paragraph-function) "mh-comp" "\
78Fill paragraph at or after point.
79Prefix ARG means justify as well. This function enables `fill-paragraph' to
80work better in MH-Letter mode." t nil)
81
82(autoload (quote mh-to-field) "mh-comp" "\
83Move point to the end of a specified header field.
84The field is indicated by the previous keystroke (the last keystroke
85of the command) according to the list in the variable `mh-to-field-choices'.
86Create the field if it does not exist. Set the mark to point before moving." t nil)
87
88(autoload (quote mh-to-fcc) "mh-comp" "\
89Insert an Fcc: FOLDER field in the current message.
90Prompt for the field name with a completion list of the current folders." t nil)
91
92(autoload (quote mh-insert-signature) "mh-comp" "\
93Insert the file named by `mh-signature-file-name' at point.
94The value of `mh-letter-insert-signature-hook' is a list of functions to be
95called, with no arguments, before the signature is actually inserted." t nil)
96
97(autoload (quote mh-check-whom) "mh-comp" "\
98Verify recipients of the current letter, showing expansion of any aliases." t nil)
99
100(autoload (quote mh-send-letter) "mh-comp" "\
101Send the draft letter in the current buffer.
102If optional prefix argument ARG is provided, monitor delivery.
103The value of `mh-before-send-letter-hook' is a list of functions to be called,
104with no arguments, before doing anything.
105Run `\\[mh-edit-mhn]' if variable `mh-mhn-compose-insert-flag' is set.
106Run `\\[mh-mml-to-mime]' if variable `mh-mml-compose-insert-flag' is set.
107Insert X-Mailer field if variable `mh-insert-x-mailer-flag' is set.
108Insert X-Face field if the file specified by `mh-x-face-file' exists." t nil)
109
110(autoload (quote mh-insert-letter) "mh-comp" "\
111Insert a message into the current letter.
112Removes the header fields according to the variable `mh-invisible-headers'.
113Prefixes each non-blank line with `mh-ins-buf-prefix', unless
114`mh-yank-from-start-of-msg' is set for supercite in which case supercite is
115used to format the message.
116Prompts for FOLDER and MESSAGE. If prefix argument VERBATIM provided, do
117not indent and do not delete headers. Leaves the mark before the letter
118and point after it." t nil)
119
120(autoload (quote mh-yank-cur-msg) "mh-comp" "\
121Insert the current message into the draft buffer.
122Prefix each non-blank line in the message with the string in
123`mh-ins-buf-prefix'. If a region is set in the message's buffer, then
124only the region will be inserted. Otherwise, the entire message will
125be inserted if `mh-yank-from-start-of-msg' is non-nil. If this variable
126is nil, the portion of the message following the point will be yanked.
127If `mh-delete-yanked-msg-window-flag' is non-nil, any window displaying the
128yanked message will be deleted." t nil)
129
130(autoload (quote mh-fully-kill-draft) "mh-comp" "\
131Kill the draft message file and the draft message buffer.
132Use \\[kill-buffer] if you don't want to delete the draft message file." t nil)
133
134(autoload (quote mh-open-line) "mh-comp" "\
135Insert a newline and leave point after it.
136In addition, insert newline and quoting characters before text after point.
137This is useful in breaking up paragraphs in replies." t nil)
138
139(autoload (quote mh-letter-complete) "mh-comp" "\
140Perform completion on header field or word preceding point.
141Alias completion is done within the mail header on selected fields and
142by the function designated by `mh-letter-complete-function' elsewhere,
143passing the prefix ARG if any." t nil)
144
145;;;***
146
147;;;### (autoloads (mh-tool-bar-folder-set mh-tool-bar-letter-set
148;;;;;; mh-customize) "mh-customize" "mh-customize.el" (15899 29873))
149;;; Generated autoloads from mh-customize.el
150
151(autoload (quote mh-customize) "mh-customize" "\
152Customize MH-E variables." t nil)
153
154(autoload (quote mh-tool-bar-letter-set) "mh-customize" "\
155Construct toolbar for `mh-letter-mode'." nil nil)
156
157(autoload (quote mh-tool-bar-folder-set) "mh-customize" "\
158Construct toolbar for `mh-folder-mode'." nil nil)
159
160;;;***
161
162;;;### (autoloads (mh-goto-cur-msg mh-update-sequences mh-folder-line-matches-show-buffer-p)
163;;;;;; "mh-e" "mh-e.el" (15899 29921))
164;;; Generated autoloads from mh-e.el
165
166(autoload (quote mh-folder-line-matches-show-buffer-p) "mh-e" "\
167Return t if the message under point in folder-mode is in the show buffer.
168Return nil in any other circumstance (no message under point, no show buffer,
169the message in the show buffer doesn't match." nil nil)
170
171(autoload (quote mh-update-sequences) "mh-e" "\
172Update MH's Unseen-Sequence and current folder and message.
173Flush MH-E's state out to MH. The message at the cursor becomes current." t nil)
174
175(autoload (quote mh-goto-cur-msg) "mh-e" "\
176Position the cursor at the current message.
177When optional argument MINIMAL-CHANGES-FLAG is non-nil, the function doesn't
178recenter the folder buffer." nil nil)
179
180;;;***
181
182;;;### (autoloads (mh-prefix-help mh-help mh-store-buffer mh-store-msg
183;;;;;; mh-undo-folder mh-sort-folder mh-print-msg mh-page-digest-backwards
184;;;;;; mh-page-digest mh-pipe-msg mh-pack-folder mh-list-folders
185;;;;;; mh-kill-folder mh-copy-msg mh-burst-digest) "mh-funcs" "mh-funcs.el"
186;;;;;; (15886 19303))
187;;; Generated autoloads from mh-funcs.el
188
189(autoload (quote mh-burst-digest) "mh-funcs" "\
190Burst apart the current message, which should be a digest.
191The message is replaced by its table of contents and the messages from the
192digest are inserted into the folder after that message." t nil)
193
194(autoload (quote mh-copy-msg) "mh-funcs" "\
195Copy the specified MSG-OR-SEQ to another FOLDER without deleting them.
196Default is the displayed message. If optional prefix argument is provided,
197then prompt for the message sequence." t nil)
198
199(autoload (quote mh-kill-folder) "mh-funcs" "\
200Remove the current folder and all included messages.
201Removes all of the messages (files) within the specified current folder,
202and then removes the folder (directory) itself.
203The value of `mh-folder-list-change-hook' is a list of functions to be called,
204with no arguments, after the folders has been removed." t nil)
205
206(autoload (quote mh-list-folders) "mh-funcs" "\
207List mail folders." t nil)
208
209(autoload (quote mh-pack-folder) "mh-funcs" "\
210Renumber the messages of a folder to be 1..n.
211First, offer to execute any outstanding commands for the current folder. If
212optional prefix argument provided, prompt for the RANGE of messages to display
213after packing. Otherwise, show the entire folder." t nil)
214
215(autoload (quote mh-pipe-msg) "mh-funcs" "\
216Pipe the current message through the given shell COMMAND.
217If INCLUDE-HEADERS (prefix argument) is provided, send the entire message.
218Otherwise just send the message's body without the headers." t nil)
219
220(autoload (quote mh-page-digest) "mh-funcs" "\
221Advance displayed message to next digested message." t nil)
222
223(autoload (quote mh-page-digest-backwards) "mh-funcs" "\
224Back up displayed message to previous digested message." t nil)
225
226(autoload (quote mh-print-msg) "mh-funcs" "\
227Print MSG-OR-SEQ (default: displayed message) on printer.
228If optional prefix argument provided, then prompt for the message sequence.
229The variable `mh-lpr-command-format' is used to generate the print command.
230The messages are formatted by mhl. See the variable `mhl-formfile'." t nil)
231
232(autoload (quote mh-sort-folder) "mh-funcs" "\
233Sort the messages in the current folder by date.
234Calls the MH program sortm to do the work.
235The arguments in the list `mh-sortm-args' are passed to sortm if the optional
236argument EXTRA-ARGS is given." t nil)
237
238(autoload (quote mh-undo-folder) "mh-funcs" "\
239Undo all pending deletes and refiles in current folder.
240Argument IGNORE is deprecated." t nil)
241
242(autoload (quote mh-store-msg) "mh-funcs" "\
243Store the file(s) contained in the current message into DIRECTORY.
244The message can contain a shar file or uuencoded file.
245Default directory is the last directory used, or initially the value of
246`mh-store-default-directory' or the current directory." t nil)
247
248(autoload (quote mh-store-buffer) "mh-funcs" "\
249Store the file(s) contained in the current buffer into DIRECTORY.
250The buffer can contain a shar file or uuencoded file.
251Default directory is the last directory used, or initially the value of
252`mh-store-default-directory' or the current directory." t nil)
253
254(autoload (quote mh-help) "mh-funcs" "\
255Display cheat sheet for the MH-Folder commands in minibuffer." t nil)
256
257(autoload (quote mh-prefix-help) "mh-funcs" "\
258Display cheat sheet for the commands of the current prefix in minibuffer." t nil)
259
260;;;***
261
262;;;### (autoloads (mh-insert-identity mh-identity-list-set mh-identity-make-menu)
263;;;;;; "mh-identity" "mh-identity.el" (15852 60439))
264;;; Generated autoloads from mh-identity.el
265
266(autoload (quote mh-identity-make-menu) "mh-identity" "\
267Build (or rebuild) the Identity menu (e.g. after the list is modified)." nil nil)
268
269(autoload (quote mh-identity-list-set) "mh-identity" "\
270Update the `mh-identity-list' variable, and rebuild the menu.
271Sets the default for SYMBOL (e.g. `mh-identity-list') to VALUE (as set in
272customization). This is called after 'customize is used to alter
273`mh-identity-list'." nil nil)
274
275(autoload (quote mh-insert-identity) "mh-identity" "\
276Insert proper fields for given IDENTITY.
277Edit the `mh-identity-list' variable to define identity." t nil)
278
279;;;***
280
281;;;### (autoloads (mh-namazu-execute-search mh-swish++-execute-search
282;;;;;; mh-swish-execute-search mh-glimpse-execute-search mh-index-execute-commands
283;;;;;; mh-index-visit-folder mh-index-delete-folder-headers mh-index-insert-folder-headers
284;;;;;; mh-index-previous-folder mh-index-next-folder mh-index-search
285;;;;;; mh-index-update-maps) "mh-index" "mh-index.el" (15899 19358))
286;;; Generated autoloads from mh-index.el
287
288(autoload (quote mh-index-update-maps) "mh-index" "\
289Annotate all as yet unannotated messages in FOLDER with their MD5 hash.
290As a side effect msg -> checksum map is updated. Optional argument ORIGIN-MAP
291is a hashtable which maps each message in the index folder to the original
292folder and message from whence it was copied. If present the
293checksum -> (origin-folder, origin-index) map is updated too." nil nil)
294
295(autoload (quote mh-index-search) "mh-index" "\
296Perform an indexed search in an MH mail folder.
297
298If REDO-SEARCH-FLAG is non-nil and the current folder buffer was generated by a
299index search, then the search is repeated. Otherwise, FOLDER is searched with
300SEARCH-REGEXP and the results are presented in an MH-E folder. If FOLDER is
301\"+\" then mail in all folders are searched.
302
303Four indexing programs are supported; if none of these are present, then grep
304is used. This function picks the first program that is available on your
305system. If you would prefer to use a different program, set the customization
306variable `mh-index-program' accordingly.
307
308The documentation for the following functions describes how to generate the
309index for each program:
310
311 - `mh-swish++-execute-search'
312 - `mh-swish-execute-search'
313 - `mh-namazu-execute-search'
314 - `mh-glimpse-execute-search'
315
316This and related functions use an X-MHE-Checksum header to cache the MD5
317checksum of a message. This means that already present X-MHE-Checksum headers
318in the incoming email could result in messages not being found. The following
319procmail recipe should avoid this:
320
321 :0 wf
322 | formail -R \"X-MHE-Checksum\" \"Old-X-MHE-Checksum\"
323
324This has the effect of renaming already present X-MHE-Checksum headers." t nil)
325
326(autoload (quote mh-index-next-folder) "mh-index" "\
327Jump to the next folder marker.
328The function is only applicable to folders displaying index search results.
329With non-nil optional argument BACKWARD-FLAG, jump to the previous group of
330results." t nil)
331
332(autoload (quote mh-index-previous-folder) "mh-index" "\
333Jump to the previous folder marker." t nil)
334
335(autoload (quote mh-index-insert-folder-headers) "mh-index" "\
336Annotate the search results with original folder names." nil nil)
337
338(autoload (quote mh-index-delete-folder-headers) "mh-index" "\
339Delete the folder headers." nil nil)
340
341(autoload (quote mh-index-visit-folder) "mh-index" "\
342Visit original folder from where the message at point was found." t nil)
343
344(autoload (quote mh-index-execute-commands) "mh-index" "\
345Delete/refile the actual messages.
346The copies in the searched folder are then deleted/refiled to get the desired
347result. Before deleting the messages we make sure that the message being
348deleted is identical to the one that the user has marked in the index buffer." nil nil)
349
350(autoload (quote mh-glimpse-execute-search) "mh-index" "\
351Execute glimpse and read the results.
352
353In the examples below, replace /home/user/Mail with the path to your MH
354directory.
355
356First create the directory /home/user/Mail/.glimpse. Then create the file
357/home/user/Mail/.glimpse/.glimpse_exclude with the following contents:
358
359 */.*
360 */#*
361 */,*
362 */*~
363 ^/home/user/Mail/.glimpse
364 ^/home/user/Mail/mhe-index
365
366If there are any directories you would like to ignore, append lines like the
367following to .glimpse_exclude:
368
369 ^/home/user/Mail/scripts
370
371You do not want to index the folders that hold the results of your searches
372since they tend to be ephemeral and the original messages are indexed anyway.
373The configuration file above assumes that the results are found in sub-folders
374of `mh-index-folder' which is +mhe-index by default.
375
376Use the following command line to generate the glimpse index. Run this
377daily from cron:
378
379 glimpseindex -H /home/user/Mail/.glimpse /home/user/Mail
380
381FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search." nil nil)
382
383(autoload (quote mh-swish-execute-search) "mh-index" "\
384Execute swish-e and read the results.
385
386In the examples below, replace /home/user/Mail with the path to your MH
387directory.
388
389First create the directory /home/user/Mail/.swish. Then create the file
390/home/user/Mail/.swish/config with the following contents:
391
392 IndexDir /home/user/Mail
393 IndexFile /home/user/Mail/.swish/index
394 IndexName \"Mail Index\"
395 IndexDescription \"Mail Index\"
396 IndexPointer \"http://nowhere\"
397 IndexAdmin \"nobody\"
398 #MetaNames automatic
399 IndexReport 3
400 FollowSymLinks no
401 UseStemming no
402 IgnoreTotalWordCountWhenRanking yes
403 WordCharacters abcdefghijklmnopqrstuvwxyz0123456789-
404 BeginCharacters abcdefghijklmnopqrstuvwxyz
405 EndCharacters abcdefghijklmnopqrstuvwxyz0123456789
406 IgnoreLimit 50 1000
407 IndexComments 0
408 FileRules pathname contains /home/user/Mail/.swish
409 FileRules pathname contains /home/user/Mail/mhe-index
410 FileRules filename is index
411 FileRules filename is ..*
412 FileRules filename is #.*
413 FileRules filename is ,.*
414 FileRules filename is .*~
415
416If there are any directories you would like to ignore, append lines like the
417following to config:
418
419 FileRules pathname contains /home/user/Mail/scripts
420
421You do not want to index the folders that hold the results of your searches
422since they tend to be ephemeral and the original messages are indexed anyway.
423The configuration file above assumes that the results are found in sub-folders
424of `mh-index-folder' which is +mhe-index by default.
425
426Use the following command line to generate the swish index. Run this
427daily from cron:
428
429 swish-e -c /home/user/Mail/.swish/config
430
431FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search." nil nil)
432
433(autoload (quote mh-swish++-execute-search) "mh-index" "\
434Execute swish++ and read the results.
435
436In the examples below, replace /home/user/Mail with the path to your MH
437directory.
438
439First create the directory /home/user/Mail/.swish++. Then create the file
440/home/user/Mail/.swish++/swish++.conf with the following contents:
441
442 IncludeMeta Bcc Cc Comments Content-Description From Keywords
443 IncludeMeta Newsgroups Resent-To Subject To
444 IncludeMeta Message-Id References In-Reply-To
445 IncludeFile Mail *
446 IndexFile /home/user/Mail/.swish++/swish++.index
447
448Use the following command line to generate the swish index. Run this
449daily from cron:
450
451 find /home/user/Mail -path /home/user/Mail/mhe-index -prune \\
452 -o -path /home/user/Mail/.swish++ -prune \\
453 -o -name \"[0-9]*\" -print \\
454 | index -c /home/user/Mail/.swish++/swish++.conf /home/user/Mail
455
456You do not want to index the folders that hold the results of your searches
457since they tend to be ephemeral and the original messages are indexed anyway.
458The command above assumes that the results are found in sub-folders of
459`mh-index-folder' which is +mhe-index by default.
460
461On some systems (Debian GNU/Linux, for example), use index++ instead of index.
462
463FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search." nil nil)
464
465(autoload (quote mh-namazu-execute-search) "mh-index" "\
466Execute namazu and read the results.
467
468In the examples below, replace /home/user/Mail with the path to your MH
469directory.
470
471First create the directory /home/user/Mail/.namazu. Then create the file
472/home/user/Mail/.namazu/mknmzrc with the following contents:
473
474 package conf; # Don't remove this line!
475 $ADDRESS = 'user@localhost';
476 $ALLOW_FILE = \"[0-9]*\";
477 $EXCLUDE_PATH = \"^/home/user/Mail/(mhe-index|spam)\";
478
479In the above example configuration, none of the mail files contained in the
480directories /home/user/Mail/mhe-index and /home/user/Mail/spam are indexed.
481
482You do not want to index the folders that hold the results of your searches
483since they tend to be ephemeral and the original messages are indexed anyway.
484The configuration file above assumes that the results are found in sub-folders
485of `mh-index-folder' which is +mhe-index by default.
486
487Use the following command line to generate the namazu index. Run this
488daily from cron:
489
490 mknmz -f /home/user/Mail/.namazu/mknmzrc -O /home/user/Mail/.namazu \\
491 /home/user/Mail
492
493FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search." nil nil)
494
495;;;***
496
497;;;### (autoloads (mh-mime-inline-part mh-mime-save-part mh-push-button
498;;;;;; mh-press-button mh-mime-display mh-mime-save-parts mh-display-emphasis
499;;;;;; mh-display-smileys mh-add-missing-mime-version-header mh-destroy-postponed-handles
500;;;;;; mh-mime-cleanup mh-mml-secure-message-encrypt-pgpmime mh-mml-secure-message-sign-pgpmime
501;;;;;; mh-mml-attach-file mh-mml-forward-message mh-mml-to-mime
502;;;;;; mh-revert-mhn-edit mh-edit-mhn mh-mhn-compose-forw mh-mhn-compose-external-compressed-tar
503;;;;;; mh-mhn-compose-anon-ftp mh-mhn-compose-insertion mh-compose-forward
504;;;;;; mh-compose-insertion) "mh-mime" "mh-mime.el" (15858 6046))
505;;; Generated autoloads from mh-mime.el
506
507(autoload (quote mh-compose-insertion) "mh-mime" "\
508Add a directive to insert a MIME part from a file, using mhn or gnus.
509If the variable `mh-compose-insertion' is set to 'mhn, then that will be used.
510If it is set to 'gnus, then that will be used instead.
511Optional argument INLINE means make it an inline attachment." t nil)
512
513(autoload (quote mh-compose-forward) "mh-mime" "\
514Add a MIME directive to forward a message, using mhn or gnus.
515If the variable `mh-compose-insertion' is set to 'mhn, then that will be used.
516If it is set to 'gnus, then that will be used instead.
517Optional argument DESCRIPTION is a description of the attachment.
518Optional argument FOLDER is the folder from which the forwarded message should
519come.
520Optional argument MESSAGE is the message to forward.
521If any of the optional arguments are absent, they are prompted for." t nil)
522
523(autoload (quote mh-mhn-compose-insertion) "mh-mime" "\
524Add a directive to insert a MIME message part from a file.
525This is the typical way to insert non-text parts in a message.
526
527Arguments are FILENAME, which tells where to find the file, TYPE, the MIME
528content type, DESCRIPTION, a line of text for the Content-Description field.
529ATTRIBUTES is a comma separated list of name=value pairs that is appended to
530the Content-Type field of the attachment.
531
532See also \\[mh-edit-mhn]." t nil)
533
534(autoload (quote mh-mhn-compose-anon-ftp) "mh-mime" "\
535Add a directive for a MIME anonymous ftp external body part.
536This directive tells MH to include a reference to a message/external-body part
537retrievable by anonymous FTP.
538
539Arguments are HOST and FILENAME, which tell where to find the file, TYPE, the
540MIME content type, and DESCRIPTION, a line of text for the Content-description
541header.
542
543See also \\[mh-edit-mhn]." t nil)
544
545(autoload (quote mh-mhn-compose-external-compressed-tar) "mh-mime" "\
546Add a directive to include a MIME reference to a compressed tar file.
547The file should be available via anonymous ftp. This directive tells MH to
548include a reference to a message/external-body part.
549
550Arguments are HOST and FILENAME, which tell where to find the file, and
551DESCRIPTION, a line of text for the Content-description header.
552
553See also \\[mh-edit-mhn]." t nil)
554
555(autoload (quote mh-mhn-compose-forw) "mh-mime" "\
556Add a forw directive to this message, to forward a message with MIME.
557This directive tells MH to include the named messages in this one.
558
559Arguments are DESCRIPTION, a line of text for the Content-description header,
560and FOLDER and MESSAGES, which name the message(s) to be forwarded.
561
562See also \\[mh-edit-mhn]." t nil)
563
564(autoload (quote mh-edit-mhn) "mh-mime" "\
565Format the current draft for MIME, expanding any mhn directives.
566
567Process the current draft with the mhn program, which, using directives
568already inserted in the draft, fills in all the MIME components and header
569fields.
570
571This step should be done last just before sending the message.
572
573The `\\[mh-revert-mhn-edit]' command undoes this command. The arguments in the
574list `mh-mhn-args' are passed to mhn if this function is passed an optional
575prefix argument EXTRA-ARGS.
576
577For assistance with creating mhn directives to insert various types of
578components in a message, see \\[mh-mhn-compose-insertion] (generic insertion
579from a file), \\[mh-mhn-compose-anon-ftp] (external reference to file via
580anonymous ftp), \\[mh-mhn-compose-external-compressed-tar] (reference to
581compressed tar file via anonymous ftp), and \\[mh-mhn-compose-forw] (forward
582message). If these helper functions are used, `mh-edit-mhn' is run
583automatically when the draft is sent.
584
585The value of `mh-edit-mhn-hook' is a list of functions to be called, with no
586arguments, after performing the conversion.
587
588The mhn program is part of MH version 6.8 or later." t nil)
589
590(autoload (quote mh-revert-mhn-edit) "mh-mime" "\
591Undo the effect of \\[mh-edit-mhn] by reverting to the backup file.
592Optional non-nil argument NOCONFIRM means don't ask for confirmation." t nil)
593
594(autoload (quote mh-mml-to-mime) "mh-mime" "\
595Compose MIME message from mml directives." t nil)
596
597(autoload (quote mh-mml-forward-message) "mh-mime" "\
598Forward a message as attachment.
599The function will prompt the user for a DESCRIPTION, a FOLDER and MESSAGE
600number." nil nil)
601
602(autoload (quote mh-mml-attach-file) "mh-mime" "\
603Attach a file to the outgoing MIME message.
604The file is not inserted or encoded until you send the message with
605`\\[mh-send-letter]'.
606Message disposition is \"inline\" or \"attachment\" and is prompted for if
607DISPOSITION is nil.
608
609This is basically `mml-attach-file' from gnus, modified such that a prefix
610argument yields an `inline' disposition and Content-Type is determined
611automatically." nil nil)
612
613(autoload (quote mh-mml-secure-message-sign-pgpmime) "mh-mime" "\
614Add directive to encrypt/sign the entire message." t nil)
615
616(autoload (quote mh-mml-secure-message-encrypt-pgpmime) "mh-mime" "\
617Add directive to encrypt and sign the entire message.
618If called with a prefix argument DONTSIGN, only encrypt (do NOT sign)." t nil)
619
620(autoload (quote mh-mime-cleanup) "mh-mime" "\
621Free the decoded MIME parts." nil nil)
622
623(autoload (quote mh-destroy-postponed-handles) "mh-mime" "\
624Free MIME data for externally displayed mime parts." nil nil)
625
626(autoload (quote mh-add-missing-mime-version-header) "mh-mime" "\
627Some mail programs don't put a MIME-Version header.
628I have seen this only in spam, so maybe we shouldn't fix this ;-)" nil nil)
629
630(autoload (quote mh-display-smileys) "mh-mime" "\
631Function to display smileys." nil nil)
632
633(autoload (quote mh-display-emphasis) "mh-mime" "\
634Function to display graphical emphasis." nil nil)
635
636(autoload (quote mh-mime-save-parts) "mh-mime" "\
637Store the MIME parts of the current message.
638If ARG, prompt for directory, else use that specified by the variable
639`mh-mime-save-parts-default-directory'. These directories may be superseded by
640mh_profile directives, since this function calls on mhstore or mhn to do the
641actual storing." t nil)
642
643(autoload (quote mh-mime-display) "mh-mime" "\
644Display (and possibly decode) MIME handles.
645Optional argument, PRE-DISSECTED-HANDLES is a list of MIME handles. If
646present they are displayed otherwise the buffer is parsed and then
647displayed." nil nil)
648
649(autoload (quote mh-press-button) "mh-mime" "\
650Press MIME button.
651If the MIME part is visible then it is removed. Otherwise the part is
652displayed." t nil)
653
654(autoload (quote mh-push-button) "mh-mime" "\
655Click MIME button for EVENT.
656If the MIME part is visible then it is removed. Otherwise the part is
657displayed. This function is called when the mouse is used to click the MIME
658button." t nil)
659
660(autoload (quote mh-mime-save-part) "mh-mime" "\
661Save MIME part at point." t nil)
662
663(autoload (quote mh-mime-inline-part) "mh-mime" "\
664Toggle display of the raw MIME part." t nil)
665
666;;;***
667
668;;;### (autoloads (mh-do-pick-search mh-search-folder) "mh-pick"
669;;;;;; "mh-pick.el" (15854 20166))
670;;; Generated autoloads from mh-pick.el
671
672(autoload (quote mh-search-folder) "mh-pick" "\
673Search FOLDER for messages matching a pattern.
674This function uses the MH command `pick' to do the work.
675Add the messages found to the sequence named `search'." t nil)
676
677(autoload (quote mh-do-pick-search) "mh-pick" "\
678Find messages that match the qualifications in the current pattern buffer.
679Messages are searched for in the folder named in `mh-searching-folder'.
680Add the messages found to the sequence named `search'." t nil)
681
682;;;***
683
684;;;### (autoloads (mh-thread-refile mh-thread-delete mh-thread-ancestor
685;;;;;; mh-thread-previous-sibling mh-thread-next-sibling mh-thread-forget-message
686;;;;;; mh-toggle-threads mh-thread-add-spaces mh-thread-inc mh-delete-subject-or-thread
687;;;;;; mh-delete-subject mh-narrow-to-subject mh-region-to-msg-list
688;;;;;; mh-add-to-sequence mh-notate-seq mh-map-to-seq-msgs mh-rename-seq
689;;;;;; mh-widen mh-put-msg-in-seq mh-narrow-to-seq mh-msg-is-in-seq
690;;;;;; mh-list-sequences mh-delete-seq) "mh-seq" "mh-seq.el" (15899
691;;;;;; 19358))
692;;; Generated autoloads from mh-seq.el
693
694(autoload (quote mh-delete-seq) "mh-seq" "\
695Delete the SEQUENCE." t nil)
696
697(autoload (quote mh-list-sequences) "mh-seq" "\
698List the sequences defined in the folder being visited." t nil)
699
700(autoload (quote mh-msg-is-in-seq) "mh-seq" "\
701Display the sequences that contain MESSAGE (default: current message)." t nil)
702
703(autoload (quote mh-narrow-to-seq) "mh-seq" "\
704Restrict display of this folder to just messages in SEQUENCE.
705Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command." t nil)
706
707(autoload (quote mh-put-msg-in-seq) "mh-seq" "\
708Add MSG-OR-SEQ (default: displayed message) to SEQUENCE.
709If optional prefix argument provided, then prompt for the message sequence.
710If variable `transient-mark-mode' is non-nil and the mark is active, then
711the selected region is added to the sequence." t nil)
712
713(autoload (quote mh-widen) "mh-seq" "\
714Remove restrictions from current folder, thereby showing all messages." t nil)
715
716(autoload (quote mh-rename-seq) "mh-seq" "\
717Rename SEQUENCE to have NEW-NAME." t nil)
718
719(autoload (quote mh-map-to-seq-msgs) "mh-seq" "\
720Invoke the FUNC at each message in the SEQ.
721SEQ can either be a list of messages or a MH sequence. The remaining ARGS are
722passed as arguments to FUNC." nil nil)
723
724(autoload (quote mh-notate-seq) "mh-seq" "\
725Mark the scan listing.
726All messages in SEQ are marked with NOTATION at OFFSET from the beginning of
727the line." nil nil)
728
729(autoload (quote mh-add-to-sequence) "mh-seq" "\
730The sequence SEQ is augmented with the messages in MSGS." nil nil)
731
732(autoload (quote mh-region-to-msg-list) "mh-seq" "\
733Return a list of messages within the region between BEGIN and END." nil nil)
734
735(autoload (quote mh-narrow-to-subject) "mh-seq" "\
736Narrow to a sequence containing all following messages with same subject." t nil)
737
738(autoload (quote mh-delete-subject) "mh-seq" "\
739Mark all following messages with same subject to be deleted.
740This puts the messages in a sequence named subject. You can undo the last
741deletion marks using `mh-undo' with a prefix argument and then specifying the
742subject sequence." t nil)
743
744(autoload (quote mh-delete-subject-or-thread) "mh-seq" "\
745Mark messages for deletion intelligently.
746If the folder is threaded then `mh-thread-delete' is used to mark the current
747message and all its descendants for deletion. Otherwise `mh-delete-subject' is
748used to mark the current message and all messages following it with the same
749subject for deletion." t nil)
750
751(autoload (quote mh-thread-inc) "mh-seq" "\
752Update thread tree for FOLDER.
753All messages after START-POINT are added to the thread tree." nil nil)
754
755(autoload (quote mh-thread-add-spaces) "mh-seq" "\
756Add COUNT spaces to each scan line in `mh-thread-scan-line-map'." nil nil)
757
758(autoload (quote mh-toggle-threads) "mh-seq" "\
759Toggle threaded view of folder.
760The conversion of normal view to threaded view is exact, that is the same
761messages are displayed in the folder buffer before and after threading. However
762the conversion from threaded view to normal view is inexact. So more messages
763than were originally present may be shown as a result." t nil)
764
765(autoload (quote mh-thread-forget-message) "mh-seq" "\
766Forget the message INDEX from the threading tables." nil nil)
767
768(autoload (quote mh-thread-next-sibling) "mh-seq" "\
769Jump to next sibling.
770With non-nil optional argument PREVIOUS-FLAG jump to the previous sibling." t nil)
771
772(autoload (quote mh-thread-previous-sibling) "mh-seq" "\
773Jump to previous sibling." t nil)
774
775(autoload (quote mh-thread-ancestor) "mh-seq" "\
776Jump to the ancestor of current message.
777If optional argument THREAD-ROOT-FLAG is non-nil then jump to the root of the
778thread tree the message belongs to." t nil)
779
780(autoload (quote mh-thread-delete) "mh-seq" "\
781Mark current message and all its children for subsequent deletion." t nil)
782
783(autoload (quote mh-thread-refile) "mh-seq" "\
784Mark current message and all its children for refiling to FOLDER." t nil)
785
786;;;***
787
788;;;### (autoloads (mh-speed-add-folder mh-speed-invalidate-map mh-speed-flists
789;;;;;; mh-speed-view mh-speed-toggle mh-folder-speedbar-buttons)
790;;;;;; "mh-speed" "mh-speed.el" (15899 19358))
791;;; Generated autoloads from mh-speed.el
792
793(autoload (quote mh-folder-speedbar-buttons) "mh-speed" "\
794Interface function to create MH-E speedbar buffer.
795BUFFER is the MH-E buffer for which the speedbar buffer is to be created." nil nil)
796
797(defalias (quote mh-show-speedbar-buttons) (quote mh-folder-speedbar-buttons))
798
799(defalias (quote mh-letter-speedbar-buttons) (quote mh-folder-speedbar-buttons))
800
801(autoload (quote mh-speed-toggle) "mh-speed" "\
802Toggle the display of child folders.
803The otional ARGS are ignored and there for compatibilty with speedbar." t nil)
804
805(autoload (quote mh-speed-view) "mh-speed" "\
806View folder on current line.
807Optional ARGS are ignored." t nil)
808
809(autoload (quote mh-speed-flists) "mh-speed" "\
810Execute flists -recurse and update message counts.
811If FORCE is non-nil the timer is reset." t nil)
812
813(autoload (quote mh-speed-invalidate-map) "mh-speed" "\
814Remove FOLDER from various optimization caches." t nil)
815
816(autoload (quote mh-speed-add-folder) "mh-speed" "\
817Add FOLDER since it is being created.
818The function invalidates the latest ancestor that is present." nil nil)
819
820;;;***
821
822;;;### (autoloads (mh-get-msg-num mh-goto-address-find-address-at-point)
823;;;;;; "mh-utils" "mh-utils.el" (15899 28827))
824;;; Generated autoloads from mh-utils.el
825
826(autoload (quote mh-goto-address-find-address-at-point) "mh-utils" "\
827Find e-mail address around or before point.
828Then search backwards to beginning of line for the start of an e-mail
829address. If no e-mail address found, return nil." nil nil)
830
831(autoload (quote mh-get-msg-num) "mh-utils" "\
832Return the message number of the displayed message.
833If the argument ERROR-IF-NO-MESSAGE is non-nil, then complain if the cursor is
834not pointing to a message." nil nil)
835
836;;;***
837
838;;;### (autoloads (mh-alias-add-address-under-point mh-alias-grab-from-field
839;;;;;; mh-alias-add-alias mh-alias-from-has-no-alias-p mh-alias-letter-expand-alias
840;;;;;; mh-alias-minibuffer-confirm-address mh-read-address mh-alias-reload)
841;;;;;; "mh-alias" "mh-alias.el" (15899 29102))
842;;; Generated autoloads from mh-alias.el
843
844(autoload (quote mh-alias-reload) "mh-alias" "\
845Load MH aliases into `mh-alias-alist'." t nil)
846
847(autoload (quote mh-read-address) "mh-alias" "\
848Read an address from the minibuffer with PROMPT." nil nil)
849
850(autoload (quote mh-alias-minibuffer-confirm-address) "mh-alias" "\
851Display the alias expansion if `mh-alias-flash-on-comma' is non-nil." t nil)
852
853(autoload (quote mh-alias-letter-expand-alias) "mh-alias" "\
854Expand mail alias before point." nil nil)
855
856(autoload (quote mh-alias-from-has-no-alias-p) "mh-alias" "\
857Return t is From has no current alias set." nil nil)
858
859(autoload (quote mh-alias-add-alias) "mh-alias" "\
860*Add ALIAS for ADDRESS in personal alias file.
861Prompts for confirmation if the address already has an alias.
862If the alias is already is use, `mh-alias-add-alias-to-file' will prompt." t nil)
863
864(autoload (quote mh-alias-grab-from-field) "mh-alias" "\
865*Add ALIAS for ADDRESS in personal alias file.
866Prompts for confirmation if the alias is already in use or if the address
867already has an alias." t nil)
868
869(autoload (quote mh-alias-add-address-under-point) "mh-alias" "\
870Insert an alias for email address under point." t nil)
871
872;;;***
873
874(provide 'mh-loaddefs)
875;;; Local Variables:
876;;; version-control: never
877;;; no-byte-compile: t
878;;; no-update-autoloads: t
879;;; End:
880;;; mh-loaddefs.el ends here
diff --git a/lisp/mail/mh-mime.el b/lisp/mail/mh-mime.el
deleted file mode 100644
index 594b63eee9b..00000000000
--- a/lisp/mail/mh-mime.el
+++ /dev/null
@@ -1,1276 +0,0 @@
1;;; mh-mime.el --- MH-E support for composing MIME messages
2
3;; Copyright (C) 1993, 1995, 2001, 2002 Free Software Foundation, Inc.
4
5;; Author: Bill Wohler <wohler@newt.com>
6;; Maintainer: Bill Wohler <wohler@newt.com>
7;; Keywords: mail
8;; See: mh-e.el
9
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
14;; the Free Software Foundation; either version 2, or (at your option)
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 the
24;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
25;; Boston, MA 02111-1307, USA.
26
27;;; Commentary:
28
29;; Internal support for MH-E package.
30;; Support for generating an mhn composition file.
31;; MIME is supported only by MH 6.8 or later.
32
33;;; Change Log:
34
35;; $Id: mh-mime.el,v 1.98 2002/12/06 03:33:47 satyaki Exp $
36
37;;; Code:
38
39(require 'cl)
40(require 'mh-comp)
41(require 'mh-utils)
42(load "mm-decode" t t) ; Non-fatal dependency
43(load "mm-uu" t t) ; Non-fatal dependency
44(load "mailcap" t t) ; Non-fatal dependency
45(load "smiley" t t) ; Non-fatal dependency
46(require 'gnus-util)
47
48(autoload 'gnus-article-goto-header "gnus-art")
49(autoload 'article-emphasize "gnus-art")
50(autoload 'gnus-get-buffer-create "gnus")
51(autoload 'gnus-eval-format "gnus-spec")
52(autoload 'widget-convert-button "wid-edit")
53(autoload 'message-options-set-recipient "message")
54(autoload 'mml-secure-message-sign-pgpmime "mml-sec")
55(autoload 'mml-secure-message-encrypt-pgpmime "mml-sec")
56(autoload 'mml-minibuffer-read-file "mml")
57(autoload 'mml-minibuffer-read-description "mml")
58(autoload 'mml-insert-empty-tag "mml")
59(autoload 'mml-to-mime "mml")
60(autoload 'mml-attach-file "mml")
61
62;;;###mh-autoload
63(defun mh-compose-insertion (&optional inline)
64 "Add a directive to insert a MIME part from a file, using mhn or gnus.
65If the variable `mh-compose-insertion' is set to 'mhn, then that will be used.
66If it is set to 'gnus, then that will be used instead.
67Optional argument INLINE means make it an inline attachment."
68 (interactive "P")
69 (if (equal mh-compose-insertion 'gnus)
70 (if inline
71 (mh-mml-attach-file "inline")
72 (mh-mml-attach-file))
73 (call-interactively 'mh-mhn-compose-insertion)))
74
75;;;###mh-autoload
76(defun mh-compose-forward (&optional description folder message)
77 "Add a MIME directive to forward a message, using mhn or gnus.
78If the variable `mh-compose-insertion' is set to 'mhn, then that will be used.
79If it is set to 'gnus, then that will be used instead.
80Optional argument DESCRIPTION is a description of the attachment.
81Optional argument FOLDER is the folder from which the forwarded message should
82come.
83Optional argument MESSAGE is the message to forward.
84If any of the optional arguments are absent, they are prompted for."
85 (interactive (list
86 (read-string "Forw Content-description: ")
87 (mh-prompt-for-folder "Message from" mh-sent-from-folder nil)
88 (read-string (format "Messages%s: "
89 (if mh-sent-from-msg
90 (format " [%d]" mh-sent-from-msg)
91 "")))))
92 (if (equal mh-compose-insertion 'gnus)
93 (mh-mml-forward-message description folder message)
94 (mh-mhn-compose-forw description folder message)))
95
96;; To do:
97;; paragraph code should not fill # lines if MIME enabled.
98;; implement mh-auto-edit-mhn (if non-nil, \\[mh-send-letter]
99;; invokes mh-edit-mhn automatically before sending.)
100;; actually, instead of mh-auto-edit-mhn,
101;; should read automhnproc from profile
102;; MIME option to mh-forward
103;; command to move to content-description insertion point
104
105(defvar mh-mhn-args nil
106 "Extra arguments to have \\[mh-edit-mhn] pass to the \"mhn\" command.
107The arguments are passed to mhn if \\[mh-edit-mhn] is given a
108prefix argument. Normally default arguments to mhn are specified in the
109MH profile.")
110
111(defvar mh-media-type-regexp
112 (concat (regexp-opt '("text" "image" "audio" "video" "application"
113 "multipart" "message") t)
114 "/[-.+a-zA-Z0-9]+")
115 "Regexp matching valid media types used in MIME attachment compositions.")
116
117;; Just defvar the variable to avoid compiler warning... This doesn't bind
118;; the variable, so things should work exactly as before.
119(defvar mh-have-file-command)
120
121(defun mh-have-file-command ()
122 "Return t if 'file' command is on the system.
123'file -i' is used to get MIME type of composition insertion."
124 (when (not (boundp 'mh-have-file-command))
125 (load "executable" t t) ; executable-find not autoloaded in emacs20
126 (setq mh-have-file-command
127 (and (fboundp 'executable-find)
128 (executable-find "file") ; file command exists
129 ; and accepts -i and -b args.
130 (zerop (call-process "file" nil nil nil "-i" "-b"
131 (expand-file-name "inc" mh-progs))))))
132 mh-have-file-command)
133
134(defvar mh-file-mime-type-substitutions
135 '(("application/msword" "\.xls" "application/ms-excel")
136 ("application/msword" "\.ppt" "application/ms-powerpoint"))
137 "Substitutions to make for Content-Type returned from file command.
138The first element is the Content-Type returned by the file command.
139The second element is a regexp matching the file name, usually the extension.
140The third element is the Content-Type to replace with.")
141
142(defun mh-file-mime-type-substitute (content-type filename)
143 "Return possibly changed CONTENT-TYPE on the FILENAME.
144Substitutions are made from the `mh-file-mime-type-substitutions' variable."
145 (let ((subst mh-file-mime-type-substitutions)
146 (type) (match) (answer content-type)
147 (case-fold-search t))
148 (while subst
149 (setq type (car (car subst))
150 match (elt (car subst) 1))
151 (if (and (string-equal content-type type)
152 (string-match match filename))
153 (setq answer (elt (car subst) 2)
154 subst nil)
155 (setq subst (cdr subst))))
156 answer))
157
158(defun mh-file-mime-type (filename)
159 "Return MIME type of FILENAME from file command.
160Returns nil if file command not on system."
161 (cond
162 ((not (mh-have-file-command))
163 nil) ;No file command, exit now.
164 ((not (and (file-exists-p filename)(file-readable-p filename)))
165 nil)
166 (t
167 (save-excursion
168 (let ((tmp-buffer (get-buffer-create mh-temp-buffer)))
169 (set-buffer tmp-buffer)
170 (unwind-protect
171 (progn
172 (call-process "file" nil '(t nil) nil "-b" "-i"
173 (expand-file-name filename))
174 (goto-char (point-min))
175 (if (not (re-search-forward mh-media-type-regexp nil t))
176 nil
177 (mh-file-mime-type-substitute (match-string 0) filename)))
178 (kill-buffer tmp-buffer)))))))
179
180;;; This is needed for Emacs20 which doesn't have mailcap-mime-types.
181(defvar mh-mime-content-types
182 '(("application/mac-binhex40") ("application/msword")
183 ("application/octet-stream") ("application/pdf") ("application/pgp-keys")
184 ("application/pgp-signature") ("application/pkcs7-signature")
185 ("application/postscript") ("application/rtf")
186 ("application/vnd.ms-excel") ("application/vnd.ms-powerpoint")
187 ("application/vnd.ms-project") ("application/vnd.ms-tnef")
188 ("application/wordperfect5.1") ("application/wordperfect6.0")
189 ("application/zip")
190
191 ("audio/basic") ("audio/mpeg")
192
193 ("image/gif") ("image/jpeg") ("image/png")
194
195 ("message/delivery-status")
196 ("message/external-body") ("message/partial") ("message/rfc822")
197
198 ("text/enriched") ("text/html") ("text/plain") ("text/rfc822-headers")
199 ("text/richtext") ("text/xml")
200
201 ("video/mpeg") ("video/quicktime"))
202 "Legal MIME content types.
203See documentation for \\[mh-edit-mhn].")
204
205;;;###mh-autoload
206(defun mh-mhn-compose-insertion (filename type description attributes)
207 "Add a directive to insert a MIME message part from a file.
208This is the typical way to insert non-text parts in a message.
209
210Arguments are FILENAME, which tells where to find the file, TYPE, the MIME
211content type, DESCRIPTION, a line of text for the Content-Description field.
212ATTRIBUTES is a comma separated list of name=value pairs that is appended to
213the Content-Type field of the attachment.
214
215See also \\[mh-edit-mhn]."
216 (interactive (let ((filename (read-file-name "Insert contents of: ")))
217 (list
218 filename
219 (or (mh-file-mime-type filename)
220 (completing-read "Content-Type: "
221 (if (fboundp 'mailcap-mime-types)
222 (mapcar 'list (mailcap-mime-types))
223 mh-mime-content-types)))
224 (read-string "Content-Description: ")
225 (read-string "Content-Attributes: "
226 (concat "name=\""
227 (file-name-nondirectory filename)
228 "\"")))))
229 (mh-mhn-compose-type filename type description attributes ))
230
231(defun mh-mhn-compose-type (filename type
232 &optional description attributes comment)
233 "Insert a mhn directive to insert a file.
234
235The file specified by FILENAME is encoded as TYPE. An optional DESCRIPTION is
236used as the Content-Description field, optional set of ATTRIBUTES and an
237optional COMMENT can also be included."
238 (setq mh-mhn-compose-insert-flag t)
239 (beginning-of-line)
240 (insert "#" type)
241 (and attributes
242 (insert "; " attributes))
243 (and comment
244 (insert " (" comment ")"))
245 (insert " [")
246 (and description
247 (insert description))
248 (insert "] " (expand-file-name filename))
249 (insert "\n"))
250
251
252;;;###mh-autoload
253(defun mh-mhn-compose-anon-ftp (host filename type description)
254 "Add a directive for a MIME anonymous ftp external body part.
255This directive tells MH to include a reference to a message/external-body part
256retrievable by anonymous FTP.
257
258Arguments are HOST and FILENAME, which tell where to find the file, TYPE, the
259MIME content type, and DESCRIPTION, a line of text for the Content-description
260header.
261
262See also \\[mh-edit-mhn]."
263 (interactive (list
264 (read-string "Remote host: ")
265 (read-string "Remote filename: ")
266 (completing-read "External Content-Type: "
267 (if (fboundp 'mailcap-mime-types)
268 (mapcar 'list (mailcap-mime-types))
269 mh-mime-content-types))
270 (read-string "External Content-Description: ")))
271 (mh-mhn-compose-external-type "anon-ftp" host filename
272 type description))
273
274;;;###mh-autoload
275(defun mh-mhn-compose-external-compressed-tar (host filename description)
276 "Add a directive to include a MIME reference to a compressed tar file.
277The file should be available via anonymous ftp. This directive tells MH to
278include a reference to a message/external-body part.
279
280Arguments are HOST and FILENAME, which tell where to find the file, and
281DESCRIPTION, a line of text for the Content-description header.
282
283See also \\[mh-edit-mhn]."
284 (interactive (list
285 (read-string "Remote host: ")
286 (read-string "Remote filename: ")
287 (read-string "Tar file Content-description: ")))
288 (mh-mhn-compose-external-type "anon-ftp" host filename
289 "application/octet-stream"
290 description
291 "type=tar; conversions=x-compress"
292 "mode=image"))
293
294
295(defun mh-mhn-compose-external-type (access-type host filename type
296 &optional description
297 attributes extra-params
298 comment)
299 "Add a directive to include a MIME reference to a remote file.
300The file should be available via anonymous ftp. This directive tells MH to
301include a reference to a message/external-body part.
302
303Arguments are ACCESS-TYPE, HOST and FILENAME, which tell where to find the
304file and TYPE which is the MIME Content-Type. Optional arguments include
305DESCRIPTION, a line of text for the Content-description header, ATTRIBUTES,
306EXTRA-PARAMS, and COMMENT.
307
308See also \\[mh-edit-mhn]."
309 (setq mh-mhn-compose-insert-flag t)
310 (beginning-of-line)
311 (insert "#@" type)
312 (and attributes
313 (insert "; " attributes))
314 (and comment
315 (insert " (" comment ") "))
316 (insert " [")
317 (and description
318 (insert description))
319 (insert "] ")
320 (insert "access-type=" access-type "; ")
321 (insert "site=" host)
322 (insert "; name=" (file-name-nondirectory filename))
323 (insert "; directory=\"" (file-name-directory filename) "\"")
324 (and extra-params
325 (insert "; " extra-params))
326 (insert "\n"))
327
328;;;###mh-autoload
329(defun mh-mhn-compose-forw (&optional description folder messages)
330 "Add a forw directive to this message, to forward a message with MIME.
331This directive tells MH to include the named messages in this one.
332
333Arguments are DESCRIPTION, a line of text for the Content-description header,
334and FOLDER and MESSAGES, which name the message(s) to be forwarded.
335
336See also \\[mh-edit-mhn]."
337 (interactive (list
338 (read-string "Forw Content-description: ")
339 (mh-prompt-for-folder "Message from" mh-sent-from-folder nil)
340 (read-string (format "Messages%s: "
341 (if mh-sent-from-msg
342 (format " [%d]" mh-sent-from-msg)
343 "")))))
344 (setq mh-mhn-compose-insert-flag t)
345 (beginning-of-line)
346 (insert "#forw [")
347 (and description
348 (not (string= description ""))
349 (insert description))
350 (insert "]")
351 (and folder
352 (not (string= folder ""))
353 (insert " " folder))
354 (if (and messages
355 (not (string= messages "")))
356 (let ((start (point)))
357 (insert " " messages)
358 (subst-char-in-region start (point) ?, ? ))
359 (if mh-sent-from-msg
360 (insert " " (int-to-string mh-sent-from-msg))))
361 (insert "\n"))
362
363;;;###mh-autoload
364(defun mh-edit-mhn (&optional extra-args)
365 "Format the current draft for MIME, expanding any mhn directives.
366
367Process the current draft with the mhn program, which, using directives
368already inserted in the draft, fills in all the MIME components and header
369fields.
370
371This step should be done last just before sending the message.
372
373The `\\[mh-revert-mhn-edit]' command undoes this command. The arguments in the
374list `mh-mhn-args' are passed to mhn if this function is passed an optional
375prefix argument EXTRA-ARGS.
376
377For assistance with creating mhn directives to insert various types of
378components in a message, see \\[mh-mhn-compose-insertion] (generic insertion
379from a file), \\[mh-mhn-compose-anon-ftp] (external reference to file via
380anonymous ftp), \\[mh-mhn-compose-external-compressed-tar] \ \(reference to
381compressed tar file via anonymous ftp), and \\[mh-mhn-compose-forw] (forward
382message). If these helper functions are used, `mh-edit-mhn' is run
383automatically when the draft is sent.
384
385The value of `mh-edit-mhn-hook' is a list of functions to be called, with no
386arguments, after performing the conversion.
387
388The mhn program is part of MH version 6.8 or later."
389 (interactive "*P")
390 (save-buffer)
391 (message "mhn editing...")
392 (cond
393 (mh-nmh-flag
394 (mh-exec-cmd-error nil
395 "mhbuild" (if extra-args mh-mhn-args) buffer-file-name))
396 (t
397 (mh-exec-cmd-error (format "mhdraft=%s" buffer-file-name)
398 "mhn" (if extra-args mh-mhn-args) buffer-file-name)))
399 (setq mh-mhn-compose-insert-flag nil)
400 (revert-buffer t t)
401 (message "mhn editing...done")
402 (run-hooks 'mh-edit-mhn-hook))
403
404;;;###mh-autoload
405(defun mh-revert-mhn-edit (noconfirm)
406 "Undo the effect of \\[mh-edit-mhn] by reverting to the backup file.
407Optional non-nil argument NOCONFIRM means don't ask for confirmation."
408 (interactive "*P")
409 (if (null buffer-file-name)
410 (error "Buffer does not seem to be associated with any file"))
411 (let ((backup-strings '("," "#"))
412 backup-file)
413 (while (and backup-strings
414 (not (file-exists-p
415 (setq backup-file
416 (concat (file-name-directory buffer-file-name)
417 (car backup-strings)
418 (file-name-nondirectory buffer-file-name)
419 ".orig")))))
420 (setq backup-strings (cdr backup-strings)))
421 (or backup-strings
422 (error "Backup file for %s no longer exists!" buffer-file-name))
423 (or noconfirm
424 (yes-or-no-p (format "Revert buffer from file %s? "
425 backup-file))
426 (error "Revert not confirmed"))
427 (let ((buffer-read-only nil))
428 (erase-buffer)
429 (insert-file-contents backup-file))
430 (after-find-file nil)))
431
432
433
434;;; MIME composition functions
435
436;;;###mh-autoload
437(defun mh-mml-to-mime ()
438 "Compose MIME message from mml directives."
439 (interactive)
440 (when mh-gnus-pgp-support-flag ;; This is only needed for PGP
441 (message-options-set-recipient))
442 (mml-to-mime)
443 (setq mh-mml-compose-insert-flag nil))
444
445;;;###mh-autoload
446(defun mh-mml-forward-message (description folder message)
447 "Forward a message as attachment.
448The function will prompt the user for a DESCRIPTION, a FOLDER and MESSAGE
449number."
450 (let ((msg (if (equal message "")
451 mh-sent-from-msg
452 (car (read-from-string message)))))
453 (cond ((integerp msg)
454 (if (string= "" description)
455 ;; Rationale: mml-attach-file constructs a malformed composition
456 ;; if the description string is empty. This fixes SF #625168.
457 (mml-attach-file (format "%s%s/%d"
458 mh-user-path (substring folder 1) msg)
459 "message/rfc822")
460 (mml-attach-file (format "%s%s/%d"
461 mh-user-path (substring folder 1) msg)
462 "message/rfc822"
463 description))
464 (setq mh-mml-compose-insert-flag t))
465 (t (error "The message number, %s is not a integer!" msg)))))
466
467;;;###mh-autoload
468(defun mh-mml-attach-file (&optional disposition)
469 "Attach a file to the outgoing MIME message.
470The file is not inserted or encoded until you send the message with
471`\\[mh-send-letter]'.
472Message disposition is \"inline\" or \"attachment\" and is prompted for if
473DISPOSITION is nil.
474
475This is basically `mml-attach-file' from gnus, modified such that a prefix
476argument yields an `inline' disposition and Content-Type is determined
477automatically."
478 (let* ((file (mml-minibuffer-read-file "Attach file: "))
479 (type (or (mh-file-mime-type file)
480 (completing-read "Content-Type: "
481 (if (fboundp 'mailcap-mime-types)
482 (mapcar 'list (mailcap-mime-types))
483 mh-mime-content-types))))
484 (description (mml-minibuffer-read-description))
485 (dispos (or disposition
486 (completing-read "Disposition: [attachment] "
487 '(("attachment")("inline"))
488 nil t nil nil
489 "attachment"))))
490 (mml-insert-empty-tag 'part 'type type 'filename file
491 'disposition dispos 'description description)
492 (setq mh-mml-compose-insert-flag t)))
493
494;;;###mh-autoload
495(defun mh-mml-secure-message-sign-pgpmime ()
496 "Add directive to encrypt/sign the entire message."
497 (interactive)
498 (if (not mh-gnus-pgp-support-flag)
499 (error "Sorry. Your version of gnus does not support PGP/GPG")
500 (mml-secure-message-sign-pgpmime)
501 (setq mh-mml-compose-insert-flag t)))
502
503;;;###mh-autoload
504(defun mh-mml-secure-message-encrypt-pgpmime (&optional dontsign)
505 "Add directive to encrypt and sign the entire message.
506If called with a prefix argument DONTSIGN, only encrypt (do NOT sign)."
507 (interactive "P")
508 (if (not mh-gnus-pgp-support-flag)
509 (error "Sorry. Your version of gnus does not support PGP/GPG")
510 (mml-secure-message-encrypt-pgpmime dontsign)
511 (setq mh-mml-compose-insert-flag t)))
512
513
514
515;;; MIME decoding
516
517(defmacro mh-defun-compat (function arg-list &rest body)
518 "This is a macro to define functions which are not defined.
519It is used for Gnus utility functions which were added recently. If FUNCTION
520is not defined then it is defined to have argument list, ARG-LIST and body,
521BODY."
522 (let ((defined-p (fboundp function)))
523 (unless defined-p
524 `(defun ,function ,arg-list ,@body))))
525(put 'mh-defun-compat 'lisp-indent-function 'defun)
526
527;; Copy of original function from gnus-util.el
528(mh-defun-compat gnus-local-map-property (map)
529 "Return a list suitable for a text property list specifying keymap MAP."
530 (cond (mh-xemacs-flag (list 'keymap map))
531 ((>= emacs-major-version 21) (list 'keymap map))
532 (t (list 'local-map map))))
533
534;; Copy of original function from mm-decode.el
535(mh-defun-compat mm-merge-handles (handles1 handles2)
536 (append (if (listp (car handles1)) handles1 (list handles1))
537 (if (listp (car handles2)) handles2 (list handles2))))
538
539;; Copy of function from mm-decode.el
540(mh-defun-compat mm-set-handle-multipart-parameter (handle parameter value)
541 ;; HANDLE could be a CTL.
542 (if handle
543 (put-text-property 0 (length (car handle)) parameter value
544 (car handle))))
545
546;; Copy of original macro is in mm-decode.el
547(mh-defun-compat mm-handle-multipart-ctl-parameter (handle parameter)
548 (get-text-property 0 parameter (car handle)))
549
550;; Copy of original function in mm-decode.el
551(mh-defun-compat mm-readable-p (handle)
552 "Say whether the content of HANDLE is readable."
553 (and (< (with-current-buffer (mm-handle-buffer handle)
554 (buffer-size)) 10000)
555 (mm-with-unibyte-buffer
556 (mm-insert-part handle)
557 (and (eq (mm-body-7-or-8) '7bit)
558 (not (mm-long-lines-p 76))))))
559
560;; Copy of original function in mm-bodies.el
561(mh-defun-compat mm-long-lines-p (length)
562 "Say whether any of the lines in the buffer is longer than LINES."
563 (save-excursion
564 (goto-char (point-min))
565 (end-of-line)
566 (while (and (not (eobp))
567 (not (> (current-column) length)))
568 (forward-line 1)
569 (end-of-line))
570 (and (> (current-column) length)
571 (current-column))))
572
573(mh-defun-compat mm-keep-viewer-alive-p (handle)
574 ;; Released Gnus doesn't keep handles associated with externally displayed
575 ;; MIME parts. So this will always return nil.
576 nil)
577
578(mh-defun-compat mm-destroy-parts (list)
579 "Older emacs don't have this function."
580 nil)
581
582;;; This is mm-save-part from gnus 5.10 since that function in emacs21.2 is
583;;; buggy (the args to read-file-name are incorrect). When all supported
584;;; versions of Emacs come with at least Gnus 5.10, we can delete this
585;;; function and rename calls to mh-mm-save-part to mm-save-part.
586(defun mh-mm-save-part (handle)
587 "Write HANDLE to a file."
588 (let ((name (mail-content-type-get (mm-handle-type handle) 'name))
589 (filename (mail-content-type-get
590 (mm-handle-disposition handle) 'filename))
591 file)
592 (when filename
593 (setq filename (file-name-nondirectory filename)))
594 (setq file (read-file-name "Save MIME part to: "
595 (or mm-default-directory
596 default-directory)
597 nil nil (or filename name "")))
598 (setq mm-default-directory (file-name-directory file))
599 (and (or (not (file-exists-p file))
600 (yes-or-no-p (format "File %s already exists; overwrite? "
601 file)))
602 (mm-save-part-to-file handle file))))
603
604
605
606;;; MIME cleanup
607
608;;;###mh-autoload
609(defun mh-mime-cleanup ()
610 "Free the decoded MIME parts."
611 (let ((mime-data (gethash (current-buffer) mh-globals-hash)))
612 ;; This is for Emacs, what about XEmacs?
613 (cond ((fboundp 'remove-images)
614 (remove-images (point-min) (point-max))))
615 (when mime-data
616 (mm-destroy-parts (mh-mime-handles mime-data))
617 (remhash (current-buffer) mh-globals-hash))))
618
619;;;###mh-autoload
620(defun mh-destroy-postponed-handles ()
621 "Free MIME data for externally displayed mime parts."
622 (let ((mime-data (mh-buffer-data)))
623 (when mime-data
624 (mm-destroy-parts (mh-mime-handles mime-data)))
625 (remhash (current-buffer) mh-globals-hash)))
626
627(defun mh-handle-set-external-undisplayer (folder handle function)
628 "Replacement for `mm-handle-set-external-undisplayer'.
629This is only called in recent versions of Gnus. The MIME handles are stored
630in data structures corresponding to MH-E folder buffer FOLDER instead of in
631Gnus (as in the original). The MIME part, HANDLE is associated with the
632undisplayer FUNCTION."
633 (if (mm-keep-viewer-alive-p handle)
634 (let ((new-handle (copy-sequence handle)))
635 (mm-handle-set-undisplayer new-handle function)
636 (mm-handle-set-undisplayer handle nil)
637 (save-excursion
638 (set-buffer folder)
639 (push new-handle (mh-mime-handles (mh-buffer-data)))))
640 (mm-handle-set-undisplayer handle function)))
641
642
643
644;;; MIME transformations
645(eval-when-compile (require 'font-lock))
646
647;;;###mh-autoload
648(defun mh-add-missing-mime-version-header ()
649 "Some mail programs don't put a MIME-Version header.
650I have seen this only in spam, so maybe we shouldn't fix this ;-)"
651 (save-excursion
652 (goto-char (point-min))
653 (when (and (message-fetch-field "content-type")
654 (not (message-fetch-field "mime-version")))
655 (when (search-forward "\n\n" nil t)
656 (forward-line -1)
657 (insert "MIME-Version: 1.0\n")))))
658
659;;;###mh-autoload
660(defun mh-display-smileys ()
661 "Function to display smileys."
662 (when (and mh-graphical-smileys-flag
663 (fboundp 'smiley-region)
664 (boundp 'font-lock-maximum-size)
665 (>= (/ font-lock-maximum-size 8) (buffer-size)))
666 (smiley-region (point-min) (point-max))))
667
668;;;###mh-autoload
669(defun mh-display-emphasis ()
670 "Function to display graphical emphasis."
671 (when (and mh-graphical-emphasis-flag
672 (boundp 'font-lock-maximum-size)
673 (>= (/ font-lock-maximum-size 8) (buffer-size)))
674 (flet ((article-goto-body ())) ; shadow this function to do nothing
675 (save-excursion
676 (goto-char (point-min))
677 (article-emphasize)))))
678
679;; Copied from gnus-art.el (should be checked for other cool things that can
680;; be added to the buttons)
681(defvar mh-mime-button-commands
682 '((mh-press-button "\r" "Toggle Display")))
683(defvar mh-mime-button-map
684 (let ((map (make-sparse-keymap)))
685 (unless (>= (string-to-number emacs-version) 21)
686 ;; XEmacs doesn't care.
687 (set-keymap-parent map mh-show-mode-map))
688 (define-key map [mouse-2] 'mh-push-button)
689 (dolist (c mh-mime-button-commands)
690 (define-key map (cadr c) (car c)))
691 map))
692(defvar mh-mime-button-line-format-alist
693 '((?T long-type ?s)
694 (?d description ?s)
695 (?p index ?s)
696 (?e dots ?s)))
697(defvar mh-mime-button-line-format "%{%([%p. %d%T]%)%}%e\n")
698(defvar mh-mime-security-button-pressed nil)
699(defvar mh-mime-security-button-line-format "%{%([[%t:%i]%D]%)%}\n")
700(defvar mh-mime-security-button-end-line-format "%{%([[End of %t]%D]%)%}\n")
701(defvar mh-mime-security-button-line-format-alist
702 '((?t type ?s)
703 (?i info ?s)
704 (?d details ?s)
705 (?D pressed-details ?s)))
706(defvar mh-mime-security-button-map
707 (let ((map (make-sparse-keymap)))
708 (unless (>= (string-to-number emacs-version) 21)
709 (set-keymap-parent map mh-show-mode-map))
710 (define-key map "\r" 'mh-press-button)
711 (define-key map [mouse-2] 'mh-push-button)
712 map))
713
714(defvar mh-mime-save-parts-directory nil
715 "Default to use for `mh-mime-save-parts-default-directory'.
716Set from last use.")
717
718;;;###mh-autoload
719(defun mh-mime-save-parts (arg)
720 "Store the MIME parts of the current message.
721If ARG, prompt for directory, else use that specified by the variable
722`mh-mime-save-parts-default-directory'. These directories may be superseded by
723mh_profile directives, since this function calls on mhstore or mhn to do the
724actual storing."
725 (interactive "P")
726 (let ((msg (if (eq major-mode 'mh-show-mode)
727 (mh-show-buffer-message-number)
728 (mh-get-msg-num t)))
729 (folder (if (eq major-mode 'mh-show-mode)
730 mh-show-folder-buffer
731 mh-current-folder))
732 (command (if mh-nmh-flag "mhstore" "mhn"))
733 (directory
734 (cond
735 ((and (or arg
736 (equal nil mh-mime-save-parts-default-directory)
737 (equal t mh-mime-save-parts-default-directory))
738 (not mh-mime-save-parts-directory))
739 (read-file-name "Store in what directory? " nil nil t nil))
740 ((and (or arg
741 (equal t mh-mime-save-parts-default-directory))
742 mh-mime-save-parts-directory)
743 (read-file-name (format
744 "Store in what directory? [%s] "
745 mh-mime-save-parts-directory)
746 "" mh-mime-save-parts-directory t ""))
747 ((stringp mh-mime-save-parts-default-directory)
748 mh-mime-save-parts-default-directory)
749 (t
750 mh-mime-save-parts-directory))))
751 (if (and (equal directory "") mh-mime-save-parts-directory)
752 (setq directory mh-mime-save-parts-directory))
753 (if (not (file-directory-p directory))
754 (message "No directory specified.")
755 (if (equal nil mh-mime-save-parts-default-directory)
756 (setq mh-mime-save-parts-directory directory))
757 (save-excursion
758 (set-buffer (get-buffer-create " *mh-store*"))
759 (cd directory)
760 (setq mh-mime-save-parts-directory directory)
761 (erase-buffer)
762 (apply 'call-process
763 (expand-file-name command mh-progs) nil t nil
764 (mh-list-to-string (list folder msg "-auto")))
765 (if (> (buffer-size) 0)
766 (save-window-excursion
767 (switch-to-buffer-other-window " *mh-store*")
768 (sit-for 3)))))))
769
770;; Avoid errors if gnus-sum isn't loaded yet...
771(defvar gnus-newsgroup-charset nil)
772(defvar gnus-newsgroup-name nil)
773
774;;;###mh-autoload
775(defun mh-mime-display (&optional pre-dissected-handles)
776 "Display (and possibly decode) MIME handles.
777Optional argument, PRE-DISSECTED-HANDLES is a list of MIME handles. If
778present they are displayed otherwise the buffer is parsed and then
779displayed."
780 (let ((handles ())
781 (folder mh-show-folder-buffer))
782 (flet ((mm-handle-set-external-undisplayer
783 (handle function)
784 (mh-handle-set-external-undisplayer folder handle function)))
785 ;; If needed dissect the current buffer
786 (if pre-dissected-handles
787 (setq handles pre-dissected-handles)
788 (setq handles (or (mm-dissect-buffer nil) (mm-uu-dissect)))
789 (setf (mh-mime-handles (mh-buffer-data))
790 (mm-merge-handles handles (mh-mime-handles (mh-buffer-data)))))
791
792 (when (and handles (or (not (stringp (car handles))) (cdr handles)))
793 ;; Goto start of message body
794 (goto-char (point-min))
795 (or (search-forward "\n\n" nil t) (goto-char (point-max)))
796
797 ;; Delete the body
798 (delete-region (point) (point-max))
799
800 ;; Display the MIME handles
801 (mh-mime-display-part handles)))))
802
803(defun mh-mime-display-part (handle)
804 "Decides the viewer to call based on the type of HANDLE."
805 (cond ((null handle) nil)
806 ((not (stringp (car handle)))
807 (mh-mime-display-single handle))
808 ((equal (car handle) "multipart/alternative")
809 (mh-mime-display-alternative (cdr handle)))
810 ((and mh-gnus-pgp-support-flag
811 (or (equal (car handle) "multipart/signed")
812 (equal (car handle) "multipart/encrypted")))
813 (mh-mime-display-security handle))
814 (t (mh-mime-display-mixed (cdr handle)))))
815
816(defun mh-mime-display-alternative (handles)
817 "Choose among the alternatives, HANDLES the part that will be displayed.
818If no part is preferred then all the parts are displayed."
819 (let ((preferred (mm-preferred-alternative handles)))
820 (cond ((and preferred (stringp (car preferred)))
821 (mh-mime-display-part preferred))
822 (preferred
823 (save-restriction
824 (narrow-to-region (point) (if (eobp) (point) (1+ (point))))
825 (mh-mime-display-single preferred)
826 (goto-char (point-max))))
827 (t (mh-mime-display-mixed handles)))))
828
829(defun mh-mime-display-mixed (handles)
830 "Display the list of MIME parts, HANDLES recursively."
831 (mapcar #'mh-mime-display-part handles))
832
833(defun mh-mime-part-index (handle)
834 "Generate the button number for MIME part, HANDLE.
835Notice that a hash table is used to display the same number when buttons need
836to be displayed multiple times (for instance when nested messages are
837opened)."
838 (or (gethash handle (mh-mime-part-index-hash (mh-buffer-data)))
839 (setf (gethash handle (mh-mime-part-index-hash (mh-buffer-data)))
840 (incf (mh-mime-parts-count (mh-buffer-data))))))
841
842;;; Avoid compiler warnings for XEmacs functions...
843(eval-when (compile)
844 (loop for function in '(glyph-width window-pixel-width
845 glyph-height window-pixel-height)
846 do (or (fboundp function) (defalias function 'ignore))))
847
848(defun mh-small-image-p (handle)
849 "Decide whether HANDLE is a \"small\" image that can be displayed inline.
850This is only useful if a Content-Disposition header is not present."
851 (let ((media-test (caddr (assoc (car (mm-handle-type handle))
852 mh-mm-inline-media-tests)))
853 (mm-inline-large-images t))
854 (and media-test
855 (equal (mm-handle-media-supertype handle) "image")
856 (funcall media-test handle) ; Since mm-inline-large-images is T,
857 ; this only tells us if the image is
858 ; something that emacs can display
859 (let* ((image (mm-get-image handle)))
860 (cond ((fboundp 'glyph-width)
861 ;; XEmacs -- totally untested, copied from gnus
862 (and (< (glyph-width image)
863 (or mh-max-inline-image-width
864 (window-pixel-width)))
865 (< (glyph-height image)
866 (or mh-max-inline-image-height
867 (window-pixel-height)))))
868 ((fboundp 'image-size)
869 ;; Emacs21 -- copied from gnus
870 (let ((size (image-size image)))
871 (and (< (cdr size)
872 (or mh-max-inline-image-height
873 (1- (window-height))))
874 (< (car size)
875 (or mh-max-inline-image-width (window-width))))))
876 (t
877 ;; Can't show image inline
878 nil))))))
879
880(defun mh-inline-vcard-p (handle)
881 "Decide if HANDLE is a vcard that must be displayed inline."
882 (let ((type (mm-handle-type handle)))
883 (and (consp type)
884 (equal (car type) "text/x-vcard")
885 (save-excursion
886 (save-restriction
887 (widen)
888 (goto-char (point-min))
889 (not (re-search-forward "^-- $" nil t)))))))
890
891(defun mh-mime-display-single (handle)
892 "Display a leaf node, HANDLE in the MIME tree."
893 (let* ((type (mm-handle-media-type handle))
894 (small-image-flag (mh-small-image-p handle))
895 (attachmentp (equal (car (mm-handle-disposition handle))
896 "attachment"))
897 (inlinep (and (equal (car (mm-handle-disposition handle)) "inline")
898 (mm-inlinable-p handle)
899 (mm-inlined-p handle)))
900 (displayp (or inlinep ; show if inline OR
901 (mh-inline-vcard-p handle); inline vcard OR
902 (and (not attachmentp) ; if not an attachment
903 (or small-image-flag ; and small image
904 ; and user wants inline
905 (and (not (equal
906 (mm-handle-media-supertype handle)
907 "image"))
908 (mm-inlinable-p handle)
909 (mm-inlined-p handle)))))))
910 (save-restriction
911 (narrow-to-region (point) (if (eobp) (point) (1+ (point))))
912 (cond ((and mh-gnus-pgp-support-flag
913 (equal type "application/pgp-signature"))
914 nil) ; skip signatures as they are already handled...
915 ((not displayp)
916 (insert "\n")
917 (mh-insert-mime-button handle (mh-mime-part-index handle) nil))
918 ((and displayp (not mh-display-buttons-for-inline-parts-flag))
919 (or (mm-display-part handle) (mm-display-part handle)))
920 ((and displayp mh-display-buttons-for-inline-parts-flag)
921 (insert "\n")
922 (mh-insert-mime-button handle (mh-mime-part-index handle) nil)
923 (forward-line -1)
924 (mh-mm-display-part handle)))
925 (goto-char (point-max)))))
926
927(defun mh-insert-mime-button (handle index displayed)
928 "Insert MIME button for HANDLE.
929INDEX is the part number that will be DISPLAYED. It is also used by commands
930like \"K v\" which operate on individual MIME parts."
931 ;; The button could be displayed by a previous decode. In that case
932 ;; undisplay it if we need a hidden button.
933 (when (and (mm-handle-displayed-p handle) (not displayed))
934 (mm-display-part handle))
935 (let ((name (or (mail-content-type-get (mm-handle-type handle) 'name)
936 (mail-content-type-get (mm-handle-disposition handle)
937 'filename)
938 (mail-content-type-get (mm-handle-type handle) 'url)
939 ""))
940 (type (mm-handle-media-type handle))
941 (description (mail-decode-encoded-word-string
942 (or (mm-handle-description handle) "")))
943 (dots (if (or displayed (mm-handle-displayed-p handle)) " " "..."))
944 long-type begin end)
945 (if (string-match ".*/" name) (setq name (substring name (match-end 0))))
946 (setq long-type (concat type (and (not (equal name ""))
947 (concat "; " name))))
948 (unless (equal description "")
949 (setq long-type (concat " --- " long-type)))
950 (unless (bolp) (insert "\n"))
951 (setq begin (point))
952 (gnus-eval-format
953 mh-mime-button-line-format mh-mime-button-line-format-alist
954 `(,@(gnus-local-map-property mh-mime-button-map)
955 mh-callback mh-mm-display-part
956 mh-part ,index
957 mh-data ,handle))
958 (setq end (point))
959 (widget-convert-button
960 'link begin end
961 :mime-handle handle
962 :action 'mh-widget-press-button
963 :button-keymap mh-mime-button-map
964 :help-echo
965 "Mouse-2 click or press RET (in show buffer) to toggle display")))
966
967;; There is a bug in Gnus inline image display due to which an extra line
968;; gets inserted every time it is viewed. To work around that problem we are
969;; using an extra property 'mh-region to remember the region that is added
970;; when the button is clicked. The region is then deleted to make sure that
971;; no extra lines get inserted.
972(defun mh-mm-display-part (handle)
973 "Toggle display of button for MIME part, HANDLE."
974 (beginning-of-line)
975 (let ((id (get-text-property (point) 'mh-part))
976 (point (point))
977 (window (selected-window))
978 (mail-parse-charset 'nil)
979 (mail-parse-ignored-charsets nil)
980 region buffer-read-only)
981 (save-excursion
982 (unwind-protect
983 (let ((win (get-buffer-window (current-buffer) t)))
984 (when win
985 (select-window win))
986 (goto-char point)
987
988 (if (mm-handle-displayed-p handle)
989 ;; This will remove the part.
990 (progn
991 ;; Delete the button and displayed part (if any)
992 (let ((region (get-text-property point 'mh-region)))
993 (when region
994 (when (fboundp 'remove-images)
995 (remove-images (car region) (cdr region))))
996 (mm-display-part handle)
997 (when region
998 (delete-region (car region) (cdr region))))
999 ;; Delete button (if it still remains). This happens for
1000 ;; externally displayed parts where the previous step does
1001 ;; nothing.
1002 (unless (eolp)
1003 (delete-region (point) (progn (forward-line) (point)))))
1004 (save-restriction
1005 (delete-region (point) (progn (forward-line 1) (point)))
1006 (narrow-to-region (point) (point))
1007 ;; Maybe we need another unwind-protect here.
1008 (when (equal (mm-handle-media-supertype handle) "image")
1009 (insert "\n"))
1010 (when (and (not (eq (ignore-errors (mm-display-part handle))
1011 'inline))
1012 (equal (mm-handle-media-supertype handle)
1013 "image"))
1014 (goto-char (point-min))
1015 (delete-char 1))
1016 (when (equal (mm-handle-media-supertype handle) "text")
1017 (when (eq mh-highlight-citation-p 'gnus)
1018 (mh-gnus-article-highlight-citation))
1019 (mh-display-smileys)
1020 (mh-display-emphasis))
1021 (setq region (cons (progn (goto-char (point-min))
1022 (point-marker))
1023 (progn (goto-char (point-max))
1024 (point-marker)))))))
1025 (when (window-live-p window)
1026 (select-window window))
1027 (goto-char point)
1028 (beginning-of-line)
1029 (mh-insert-mime-button handle id (mm-handle-displayed-p handle))
1030 (goto-char point)
1031 (when region
1032 (add-text-properties (line-beginning-position) (line-end-position)
1033 `(mh-region ,region)))))))
1034
1035;;;###mh-autoload
1036(defun mh-press-button ()
1037 "Press MIME button.
1038If the MIME part is visible then it is removed. Otherwise the part is
1039displayed."
1040 (interactive)
1041 (let ((mm-inline-media-tests mh-mm-inline-media-tests)
1042 (data (get-text-property (point) 'mh-data))
1043 (function (get-text-property (point) 'mh-callback))
1044 (buffer-read-only nil)
1045 (folder mh-show-folder-buffer))
1046 (flet ((mm-handle-set-external-undisplayer
1047 (handle function)
1048 (mh-handle-set-external-undisplayer folder handle function)))
1049 (when (and function (eolp))
1050 (backward-char))
1051 (unwind-protect (and function (funcall function data))
1052 (set-buffer-modified-p nil)))))
1053
1054;;;###mh-autoload
1055(defun mh-push-button (event)
1056 "Click MIME button for EVENT.
1057If the MIME part is visible then it is removed. Otherwise the part is
1058displayed. This function is called when the mouse is used to click the MIME
1059button."
1060 (interactive "e")
1061 (set-buffer (window-buffer (posn-window (event-start event))))
1062 (select-window (posn-window (event-start event)))
1063 (let* ((pos (posn-point (event-start event)))
1064 (folder mh-show-folder-buffer)
1065 (mm-inline-media-tests mh-mm-inline-media-tests)
1066 (data (get-text-property pos 'mh-data))
1067 (function (get-text-property pos 'mh-callback))
1068 (buffer-read-only nil))
1069 (flet ((mm-handle-set-external-undisplayer
1070 (handle function)
1071 (mh-handle-set-external-undisplayer folder handle function)))
1072 (goto-char pos)
1073 (unwind-protect (and function (funcall function data))
1074 (set-buffer-modified-p nil)))))
1075
1076;;;###mh-autoload
1077(defun mh-mime-save-part ()
1078 "Save MIME part at point."
1079 (interactive)
1080 (let ((data (get-text-property (point) 'mh-data)))
1081 (when data
1082 (let ((mm-default-directory mh-mime-save-parts-directory))
1083 (mh-mm-save-part data)
1084 (setq mh-mime-save-parts-directory mm-default-directory)))))
1085
1086;;;###mh-autoload
1087(defun mh-mime-inline-part ()
1088 "Toggle display of the raw MIME part."
1089 (interactive)
1090 (let* ((buffer-read-only nil)
1091 (data (get-text-property (point) 'mh-data))
1092 (inserted-flag (get-text-property (point) 'mh-mime-inserted))
1093 (displayed-flag (mm-handle-displayed-p data))
1094 (point (point))
1095 start end)
1096 (cond ((and data (not inserted-flag) (not displayed-flag))
1097 (let ((contents (mm-get-part data)))
1098 (add-text-properties (line-beginning-position) (line-end-position)
1099 '(mh-mime-inserted t))
1100 (setq start (point-marker))
1101 (forward-line 1)
1102 (mm-insert-inline data contents)
1103 (setq end (point-marker))
1104 (add-text-properties
1105 start (progn (goto-char start) (line-end-position))
1106 `(mh-region (,start . ,end)))))
1107 ((and data (or inserted-flag displayed-flag))
1108 (mh-press-button)
1109 (message "MIME part already inserted")))
1110 (goto-char point)
1111 (set-buffer-modified-p nil)))
1112
1113(defun mh-widget-press-button (widget el)
1114 "Callback for widget, WIDGET.
1115Parameter EL is unused."
1116 (goto-char (widget-get widget :from))
1117 (mh-press-button))
1118
1119(defun mh-mime-display-security (handle)
1120 "Display PGP encrypted/signed message, HANDLE."
1121 (insert "\n")
1122 (save-restriction
1123 (narrow-to-region (point) (point))
1124 (mh-insert-mime-security-button handle)
1125 (mh-mime-display-mixed (cdr handle))
1126 (insert "\n")
1127 (let ((mh-mime-security-button-line-format
1128 mh-mime-security-button-end-line-format))
1129 (mh-insert-mime-security-button handle))
1130 (mm-set-handle-multipart-parameter
1131 handle 'mh-region
1132 (cons (set-marker (make-marker) (point-min))
1133 (set-marker (make-marker) (point-max))))))
1134
1135;;; I rewrote the security part because Gnus doesn't seem to ever minimize
1136;;; the button. That is once the mime-security button is pressed there seems
1137;;; to be no way of getting rid of the inserted text.
1138(defun mh-mime-security-show-details (handle)
1139 "Toggle display of detailed security info for HANDLE."
1140 (let ((details (mm-handle-multipart-ctl-parameter handle 'gnus-details)))
1141 (when details
1142 (let ((mh-mime-security-button-pressed
1143 (not (get-text-property (point) 'mh-button-pressed)))
1144 (mh-mime-security-button-line-format
1145 (get-text-property (point) 'mh-line-format)))
1146 (forward-char -1)
1147 (while (eq (get-text-property (point) 'mh-line-format)
1148 mh-mime-security-button-line-format)
1149 (forward-char -1))
1150 (forward-char)
1151 (save-restriction
1152 (narrow-to-region (point) (point))
1153 (mh-insert-mime-security-button handle))
1154 (delete-region
1155 (point)
1156 (or (text-property-not-all
1157 (point) (point-max)
1158 'mh-line-format mh-mime-security-button-line-format)
1159 (point-max)))
1160 (forward-line -1)))))
1161
1162(defun mh-mime-security-press-button (handle)
1163 "Callback from security button for part HANDLE."
1164 (when (mm-handle-multipart-ctl-parameter handle 'gnus-info)
1165 (mh-mime-security-show-details handle)))
1166
1167;; These variables should already be initialized in mm-decode.el if we have a
1168;; recent enough Gnus. The defvars are here to avoid compiler warnings.
1169(defvar mm-verify-function-alist nil)
1170(defvar mm-decrypt-function-alist nil)
1171
1172(defvar pressed-details)
1173
1174(defun mh-insert-mime-security-button (handle)
1175 "Display buttons for PGP message, HANDLE."
1176 (let* ((protocol (mm-handle-multipart-ctl-parameter handle 'protocol))
1177 (crypto-type (or (nth 2 (assoc protocol mm-verify-function-alist))
1178 (nth 2 (assoc protocol mm-decrypt-function-alist))
1179 "Unknown"))
1180 (type (concat crypto-type
1181 (if (equal (car handle) "multipart/signed")
1182 " Signed" " Encrypted")
1183 " Part"))
1184 (info (or (mm-handle-multipart-ctl-parameter handle 'gnus-info)
1185 "Undecided"))
1186 (details (mm-handle-multipart-ctl-parameter handle 'gnus-details))
1187 pressed-details begin end)
1188 (setq details (if details (concat "\n" details) ""))
1189 (setq pressed-details (if mh-mime-security-button-pressed details ""))
1190 (unless (bolp) (insert "\n"))
1191 (setq begin (point))
1192 (gnus-eval-format
1193 mh-mime-security-button-line-format
1194 mh-mime-security-button-line-format-alist
1195 `(,@(gnus-local-map-property mh-mime-security-button-map)
1196 mh-button-pressed ,mh-mime-security-button-pressed
1197 mh-callback mh-mime-security-press-button
1198 mh-line-format ,mh-mime-security-button-line-format
1199 mh-data ,handle))
1200 (setq end (point))
1201 (widget-convert-button 'link begin end
1202 :mime-handle handle
1203 :action 'mh-widget-press-button
1204 :button-keymap mh-mime-security-button-map
1205 :help-echo "Mouse-2 click or press RET (in show buffer) to see security details.")
1206 (when (equal info "Failed")
1207 (let* ((type (if (equal (car handle) "multipart/signed")
1208 "verification" "decryption"))
1209 (warning (if (equal type "decryption")
1210 "(passphrase may be incorrect)" "")))
1211 (message "%s %s failed %s" crypto-type type warning)))))
1212
1213(defun mh-mm-inline-message (handle)
1214 "Display message, HANDLE.
1215The function decodes the message and displays it. It avoids decoding the same
1216message multiple times."
1217 (let ((b (point))
1218 (charset (mail-content-type-get (mm-handle-type handle) 'charset))
1219 (clean-message-header mh-clean-message-header-flag)
1220 (invisible-headers mh-invisible-headers)
1221 (visible-headers mh-visible-headers))
1222 (when (and charset (stringp charset))
1223 (setq charset (intern (downcase charset)))
1224 (when (eq charset 'us-ascii)
1225 (setq charset nil)))
1226 (save-excursion
1227 (save-restriction
1228 (narrow-to-region b b)
1229 (mm-insert-part handle)
1230 (mh-mime-display
1231 (or (gethash handle (mh-mime-handles-cache (mh-buffer-data)))
1232 (setf (gethash handle (mh-mime-handles-cache (mh-buffer-data)))
1233 (let ((handles (or (mm-dissect-buffer nil)
1234 (mm-uu-dissect))))
1235 (setf (mh-mime-handles (mh-buffer-data))
1236 (mm-merge-handles
1237 handles (mh-mime-handles (mh-buffer-data))))
1238 handles))))
1239
1240 (goto-char (point-min))
1241 (cond (clean-message-header
1242 (mh-clean-msg-header (point-min)
1243 invisible-headers
1244 visible-headers)
1245 (goto-char (point-min)))
1246 (t
1247 (mh-start-of-uncleaned-message)))
1248 (mh-show-xface)
1249 (mh-show-addr)
1250 ;; The other highlighting types don't need anything special
1251 (when (eq mh-highlight-citation-p 'gnus)
1252 (mh-gnus-article-highlight-citation))
1253 (goto-char (point-min))
1254 (insert "\n------- Forwarded Message\n\n")
1255 (mh-display-smileys)
1256 (mh-display-emphasis)
1257 (mm-handle-set-undisplayer
1258 handle
1259 `(lambda ()
1260 (let (buffer-read-only)
1261 (if (fboundp 'remove-specifier)
1262 ;; This is only valid on XEmacs.
1263 (mapcar (lambda (prop)
1264 (remove-specifier
1265 (face-property 'default prop) (current-buffer)))
1266 '(background background-pixmap foreground)))
1267 (delete-region ,(point-min-marker) ,(point-max-marker)))))))))
1268
1269(provide 'mh-mime)
1270
1271;;; Local Variables:
1272;;; indent-tabs-mode: nil
1273;;; sentence-end-double-space: nil
1274;;; End:
1275
1276;;; mh-mime.el ends here
diff --git a/lisp/mail/mh-pick.el b/lisp/mail/mh-pick.el
deleted file mode 100644
index a2a50f80565..00000000000
--- a/lisp/mail/mh-pick.el
+++ /dev/null
@@ -1,239 +0,0 @@
1;;; mh-pick.el --- make a search pattern and search for a message in MH-E
2
3;; Copyright (C) 1993, 1995, 2001 Free Software Foundation, Inc.
4
5;; Author: Bill Wohler <wohler@newt.com>
6;; Maintainer: Bill Wohler <wohler@newt.com>
7;; Keywords: mail
8;; See: mh-e.el
9
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
14;; the Free Software Foundation; either version 2, or (at your option)
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 the
24;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
25;; Boston, MA 02111-1307, USA.
26
27;;; Commentary:
28
29;; Internal support for MH-E package.
30
31;;; Change Log:
32
33;; $Id: mh-pick.el,v 1.25 2002/12/04 18:51:50 wohler Exp $
34
35;;; Code:
36
37(require 'mh-e)
38(require 'easymenu)
39(require 'gnus-util)
40
41;;; Internal variables:
42
43(defvar mh-pick-mode-map (make-sparse-keymap)
44 "Keymap for searching folder.")
45
46(defvar mh-searching-folder nil) ;Folder this pick is searching.
47
48;;;###mh-autoload
49(defun mh-search-folder (folder)
50 "Search FOLDER for messages matching a pattern.
51This function uses the MH command `pick' to do the work.
52Add the messages found to the sequence named `search'."
53 (interactive (list (mh-prompt-for-folder "Search"
54 mh-current-folder
55 t)))
56 (switch-to-buffer-other-window "pick-pattern")
57 (if (or (zerop (buffer-size))
58 (not (y-or-n-p "Reuse pattern? ")))
59 (mh-make-pick-template)
60 (message ""))
61 (setq mh-searching-folder folder)
62 (message "%s" (substitute-command-keys
63 (concat "Type \\[mh-do-pick-search] to search messages, "
64 "\\[mh-help] for help."))))
65
66(defun mh-make-pick-template ()
67 "Initialize the current buffer with a template for a pick pattern."
68 (erase-buffer)
69 (insert "From: \n"
70 "To: \n"
71 "Cc: \n"
72 "Date: \n"
73 "Subject: \n"
74 "---------\n")
75 (mh-pick-mode)
76 (goto-char (point-min))
77 (end-of-line))
78
79;;; Menu extracted from mh-menubar.el V1.1 (31 July 2001)
80(easy-menu-define
81 mh-pick-menu mh-pick-mode-map "Menu for MH-E pick-mode"
82 '("Pick"
83 ["Execute the Search" mh-do-pick-search t]))
84
85
86;;; Help Messages
87;;; Group messages logically, more or less.
88(defvar mh-pick-mode-help-messages
89 '((nil
90 "Search messages: \\[mh-do-pick-search]\n"
91 "Move to a field by typing C-c C-f C-<field>\n"
92 "where <field> is the first letter of the desired field."))
93 "Key binding cheat sheet.
94
95This is an associative array which is used to show the most common commands.
96The key is a prefix char. The value is one or more strings which are
97concatenated together and displayed in the minibuffer if ? is pressed after
98the prefix character. The special key nil is used to display the
99non-prefixed commands.
100
101The substitutions described in `substitute-command-keys' are performed as
102well.")
103
104(put 'mh-pick-mode 'mode-class 'special)
105
106(define-derived-mode mh-pick-mode fundamental-mode "MH-Pick"
107 "Mode for creating search templates in MH-E.\\<mh-pick-mode-map>
108
109After each field name, enter the pattern to search for. If a field's
110value does not matter for the search, leave it empty. To search the
111entire message, supply the pattern in the \"body\" of the template.
112Each non-empty field must be matched for a message to be selected.
113To effect a logical \"or\", use \\[mh-search-folder] multiple times.
114When you have finished, type \\[mh-do-pick-search] to do the search.
115
116The value of `mh-pick-mode-hook' is a list of functions to be called,
117with no arguments, upon entry to this mode.
118
119\\{mh-pick-mode-map}"
120
121 (make-local-variable 'mh-searching-folder)
122 (easy-menu-add mh-pick-menu)
123 (make-local-variable 'mh-help-messages)
124 (setq mh-help-messages mh-pick-mode-help-messages)
125 (run-hooks 'mh-pick-mode-hook))
126
127;;;###mh-autoload
128(defun mh-do-pick-search ()
129 "Find messages that match the qualifications in the current pattern buffer.
130Messages are searched for in the folder named in `mh-searching-folder'.
131Add the messages found to the sequence named `search'."
132 (interactive)
133 (let ((pattern-buffer (buffer-name))
134 (searching-buffer mh-searching-folder)
135 range
136 msgs
137 (pattern nil)
138 (new-buffer nil))
139 (save-excursion
140 (cond ((get-buffer searching-buffer)
141 (set-buffer searching-buffer)
142 (setq range (list (format "%d-%d"
143 mh-first-msg-num mh-last-msg-num))))
144 (t
145 (mh-make-folder searching-buffer)
146 (setq range '("all"))
147 (setq new-buffer t))))
148 (message "Searching...")
149 (goto-char (point-min))
150 (while (and range
151 (setq pattern (mh-next-pick-field pattern-buffer)))
152 (setq msgs (mh-seq-from-command searching-buffer
153 'search
154 (mh-list-to-string
155 (list "pick" pattern searching-buffer
156 "-list"
157 (mh-coalesce-msg-list range)))))
158 (setq range msgs)) ;restrict the pick range for next pass
159 (message "Searching...done")
160 (if new-buffer
161 (mh-scan-folder searching-buffer msgs)
162 (switch-to-buffer searching-buffer))
163 (mh-add-msgs-to-seq msgs 'search)
164 (delete-other-windows)))
165
166(defun mh-seq-from-command (folder seq command)
167 "In FOLDER, make a sequence named SEQ by executing COMMAND.
168COMMAND is a list. The first element is a program name
169and the subsequent elements are its arguments, all strings."
170 (let ((msg)
171 (msgs ())
172 (case-fold-search t))
173 (save-excursion
174 (save-window-excursion
175 (if (eq 0 (apply 'mh-exec-cmd-quiet nil command))
176 ;; "pick" outputs one number per line
177 (while (setq msg (car (mh-read-msg-list)))
178 (setq msgs (cons msg msgs))
179 (forward-line 1))))
180 (set-buffer folder)
181 (setq msgs (nreverse msgs)) ;put in ascending order
182 msgs)))
183
184(defun mh-next-pick-field (buffer)
185 "Return the next piece of a pick argument extracted from BUFFER.
186Return a list like (\"--fieldname\" \"pattern\") or (\"-search\" \"bodypat\")
187or nil if no pieces remain."
188 (set-buffer buffer)
189 (let ((case-fold-search t))
190 (cond ((eobp)
191 nil)
192 ((re-search-forward "^\\([a-z][^: \t\n]*\\):[ \t]*\\([a-z0-9].*\\)$"
193 nil t)
194 (let* ((component
195 (format "--%s"
196 (downcase (buffer-substring (match-beginning 1)
197 (match-end 1)))))
198 (pat (buffer-substring (match-beginning 2) (match-end 2))))
199 (forward-line 1)
200 (list component pat)))
201 ((re-search-forward "^-*$" nil t)
202 (forward-char 1)
203 (let ((body (buffer-substring (point) (point-max))))
204 (if (and (> (length body) 0) (not (equal body "\n")))
205 (list "-search" body)
206 nil)))
207 (t
208 nil))))
209
210
211
212;;; Build the pick-mode keymap:
213;;; If this changes, modify mh-pick-mode-help-messages accordingly, above.
214(gnus-define-keys mh-pick-mode-map
215 "\C-c?" mh-help
216 "\C-c\C-c" mh-do-pick-search
217 "\C-c\C-f\C-b" mh-to-field
218 "\C-c\C-f\C-c" mh-to-field
219 "\C-c\C-f\C-d" mh-to-field
220 "\C-c\C-f\C-f" mh-to-field
221 "\C-c\C-f\C-r" mh-to-field
222 "\C-c\C-f\C-s" mh-to-field
223 "\C-c\C-f\C-t" mh-to-field
224 "\C-c\C-fb" mh-to-field
225 "\C-c\C-fc" mh-to-field
226 "\C-c\C-fd" mh-to-field
227 "\C-c\C-ff" mh-to-field
228 "\C-c\C-fr" mh-to-field
229 "\C-c\C-fs" mh-to-field
230 "\C-c\C-ft" mh-to-field)
231
232(provide 'mh-pick)
233
234;;; Local Variables:
235;;; indent-tabs-mode: nil
236;;; sentence-end-double-space: nil
237;;; End:
238
239;;; mh-pick.el ends here
diff --git a/lisp/mail/mh-seq.el b/lisp/mail/mh-seq.el
deleted file mode 100644
index 1175e420281..00000000000
--- a/lisp/mail/mh-seq.el
+++ /dev/null
@@ -1,1277 +0,0 @@
1;;; mh-seq.el --- MH-E sequences support
2
3;; Copyright (C) 1993, 1995, 2001, 2002 Free Software Foundation, Inc.
4
5;; Author: Bill Wohler <wohler@newt.com>
6;; Maintainer: Bill Wohler <wohler@newt.com>
7;; Keywords: mail
8;; See: mh-e.el
9
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
14;; the Free Software Foundation; either version 2, or (at your option)
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 the
24;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
25;; Boston, MA 02111-1307, USA.
26
27;;; Commentary:
28;;
29;; This tries to implement the algorithm described at:
30;; http://www.jwz.org/doc/threading.html
31;; It is also a start to implementing the IMAP Threading extension RFC. The
32;; implementation lacks the reference and subject canonicalization of the
33;; RFC.
34;;
35;; In the presentation buffer, children messages are shown indented with
36;; either [ ] or < > around them. Square brackets ([ ]) denote that the
37;; algorithm can point out some headers which when taken together implies
38;; that the unindented message is an ancestor of the indented message. If
39;; no such proof exists then angles (< >) are used.
40;;
41;; Some issues and problems are as follows:
42;;
43;; (1) Scan truncates the fields at length 512. So longer references:
44;; headers get mutilated. The same kind of MH format string works when
45;; composing messages. Is there a way to avoid this? My scan command
46;; is as follows:
47;; scan +folder -width 10000 \
48;; -format "%(msg)\n%{message-id}\n%{references}\n%{subject}\n"
49;; I would really appreciate it if someone would help me with this.
50;;
51;; (2) Implement heuristics to recognize message-id's in In-Reply-To:
52;; header. Right now it just assumes that the last text between angles
53;; (< and >) is the message-id. There is the chance that this will
54;; incorrectly use an email address like a message-id.
55;;
56;; (3) Error checking of found message-id's should be done.
57;;
58;; (4) Since this breaks the assumption that message indices increase as
59;; one goes down the buffer, the binary search based mh-goto-msg
60;; doesn't work. I have a simpler replacement which may be less
61;; efficient.
62;;
63;; (5) Better canonicalizing for message-id and subject strings.
64;;
65
66;; Internal support for MH-E package.
67
68;;; Change Log:
69
70;; $Id: mh-seq.el,v 1.84 2003/01/07 21:15:33 satyaki Exp $
71
72;;; Code:
73
74(require 'cl)
75(require 'mh-e)
76
77;; Shush the byte-compiler
78(defvar tool-bar-mode)
79
80;;; Data structures (used in message threading)...
81(defstruct (mh-thread-message (:conc-name mh-message-)
82 (:constructor mh-thread-make-message))
83 (id nil)
84 (references ())
85 (subject "")
86 (subject-re-p nil))
87
88(defstruct (mh-thread-container (:conc-name mh-container-)
89 (:constructor mh-thread-make-container))
90 message parent children
91 (real-child-p t))
92
93
94;;; Internal variables:
95(defvar mh-last-seq-used nil
96 "Name of seq to which a msg was last added.")
97
98(defvar mh-non-seq-mode-line-annotation nil
99 "Saved value of `mh-mode-line-annotation' when narrowed to a seq.")
100
101;;; Maps and hashes...
102(defvar mh-thread-id-hash nil
103 "Hashtable used to canonicalize message-id strings.")
104(defvar mh-thread-subject-hash nil
105 "Hashtable used to canonicalize subject strings.")
106(defvar mh-thread-id-table nil
107 "Thread ID table maps from message-id's to message containers.")
108(defvar mh-thread-id-index-map nil
109 "Table to lookup message index number from message-id.")
110(defvar mh-thread-index-id-map nil
111 "Table to lookup message-id from message index.")
112(defvar mh-thread-scan-line-map nil
113 "Map of message index to various parts of the scan line.")
114(defvar mh-thread-old-scan-line-map nil
115 "Old map of message index to various parts of the scan line.
116This is the original map that is stored when the folder is narrowed.")
117(defvar mh-thread-subject-container-hash nil
118 "Hashtable used to group messages by subject.")
119(defvar mh-thread-duplicates nil
120 "Hashtable used to remember multiple messages with the same message-id.")
121(defvar mh-thread-history ()
122 "Variable to remember the transformations to the thread tree.
123When new messages are added, these transformations are rewound, then the
124links are added from the newly seen messages. Finally the transformations are
125redone to get the new thread tree. This makes incremental threading easier.")
126(defvar mh-thread-body-width nil
127 "Width of scan substring that contains subject and body of message.")
128
129(make-variable-buffer-local 'mh-thread-id-hash)
130(make-variable-buffer-local 'mh-thread-subject-hash)
131(make-variable-buffer-local 'mh-thread-id-table)
132(make-variable-buffer-local 'mh-thread-id-index-map)
133(make-variable-buffer-local 'mh-thread-index-id-map)
134(make-variable-buffer-local 'mh-thread-scan-line-map)
135(make-variable-buffer-local 'mh-thread-old-scan-line-map)
136(make-variable-buffer-local 'mh-thread-subject-container-hash)
137(make-variable-buffer-local 'mh-thread-duplicates)
138(make-variable-buffer-local 'mh-thread-history)
139
140;;;###mh-autoload
141(defun mh-delete-seq (sequence)
142 "Delete the SEQUENCE."
143 (interactive (list (mh-read-seq-default "Delete" t)))
144 (mh-map-to-seq-msgs 'mh-notate-if-in-one-seq sequence ? (1+ mh-cmd-note)
145 sequence)
146 (mh-undefine-sequence sequence '("all"))
147 (mh-delete-seq-locally sequence))
148
149;; Avoid compiler warnings
150(defvar view-exit-action)
151
152;;;###mh-autoload
153(defun mh-list-sequences ()
154 "List the sequences defined in the folder being visited."
155 (interactive)
156 (let ((folder mh-current-folder)
157 (temp-buffer mh-temp-sequences-buffer)
158 (seq-list mh-seq-list)
159 (max-len 0))
160 (with-output-to-temp-buffer temp-buffer
161 (save-excursion
162 (set-buffer temp-buffer)
163 (erase-buffer)
164 (message "Listing sequences ...")
165 (insert "Sequences in folder " folder ":\n")
166 (let ((seq-list seq-list))
167 (while seq-list
168 (setq max-len
169 (max (length (symbol-name (mh-seq-name (pop seq-list))))
170 max-len)))
171 (setq max-len (+ 2 max-len)))
172 (while seq-list
173 (let ((name (mh-seq-name (car seq-list)))
174 (sorted-seq-msgs
175 (mh-coalesce-msg-list
176 (sort (copy-sequence (mh-seq-msgs (car seq-list))) '<)))
177 name-spec)
178 (insert (setq name-spec (format (format "%%%ss:" max-len) name)))
179 (while sorted-seq-msgs
180 (let ((next-element (format " %s" (pop sorted-seq-msgs))))
181 (when (>= (+ (current-column) (length next-element))
182 (window-width))
183 (insert "\n")
184 (insert (format (format "%%%ss" (length name-spec)) "")))
185 (insert next-element)))
186 (insert "\n"))
187 (setq seq-list (cdr seq-list)))
188 (goto-char (point-min))
189 (view-mode 1)
190 (setq view-exit-action 'kill-buffer)
191 (message "Listing sequences...done")))))
192
193;;;###mh-autoload
194(defun mh-msg-is-in-seq (message)
195 "Display the sequences that contain MESSAGE (default: current message)."
196 (interactive (list (mh-get-msg-num t)))
197 (let* ((dest-folder (loop for seq in mh-refile-list
198 when (member message (cdr seq)) return (car seq)))
199 (deleted-flag (unless dest-folder (member message mh-delete-list))))
200 (message "Message %d%s is in sequences: %s"
201 message
202 (cond (dest-folder (format " (to be refiled to %s)" dest-folder))
203 (deleted-flag (format " (to be deleted)"))
204 (t ""))
205 (mapconcat 'concat
206 (mh-list-to-string (mh-seq-containing-msg message t))
207 " "))))
208
209;;;###mh-autoload
210(defun mh-narrow-to-seq (sequence)
211 "Restrict display of this folder to just messages in SEQUENCE.
212Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command."
213 (interactive (list (mh-read-seq "Narrow to" t)))
214 (with-mh-folder-updating (t)
215 (cond ((mh-seq-to-msgs sequence)
216 (mh-widen)
217 (mh-remove-all-notation)
218 (let ((eob (point-max))
219 (msg-at-cursor (mh-get-msg-num nil)))
220 (setq mh-thread-old-scan-line-map mh-thread-scan-line-map)
221 (setq mh-thread-scan-line-map (make-hash-table :test #'eql))
222 (mh-copy-seq-to-eob sequence)
223 (narrow-to-region eob (point-max))
224 (mh-notate-user-sequences)
225 (mh-notate-deleted-and-refiled)
226 (mh-notate-seq 'cur mh-note-cur mh-cmd-note)
227 (when msg-at-cursor (mh-goto-msg msg-at-cursor t t))
228 (make-variable-buffer-local 'mh-non-seq-mode-line-annotation)
229 (setq mh-non-seq-mode-line-annotation mh-mode-line-annotation)
230 (setq mh-mode-line-annotation (symbol-name sequence))
231 (mh-make-folder-mode-line)
232 (mh-recenter nil)
233 (if (and (boundp 'tool-bar-mode) tool-bar-mode)
234 (set (make-local-variable 'tool-bar-map)
235 mh-folder-seq-tool-bar-map))
236 (setq mh-narrowed-to-seq sequence)
237 (push 'widen mh-view-ops)))
238 (t
239 (error "No messages in sequence `%s'" (symbol-name sequence))))))
240
241;;;###mh-autoload
242(defun mh-put-msg-in-seq (msg-or-seq sequence)
243 "Add MSG-OR-SEQ (default: displayed message) to SEQUENCE.
244If optional prefix argument provided, then prompt for the message sequence.
245If variable `transient-mark-mode' is non-nil and the mark is active, then
246the selected region is added to the sequence."
247 (interactive (list (cond
248 ((mh-mark-active-p t)
249 (mh-region-to-msg-list (region-beginning) (region-end)))
250 (current-prefix-arg
251 (mh-read-seq-default "Add messages from" t))
252 (t
253 (mh-get-msg-num t)))
254 (mh-read-seq-default "Add to" nil)))
255 (if (not (mh-internal-seq sequence))
256 (setq mh-last-seq-used sequence))
257 (mh-add-msgs-to-seq (cond ((numberp msg-or-seq) (list msg-or-seq))
258 ((listp msg-or-seq) msg-or-seq)
259 (t (mh-seq-to-msgs msg-or-seq)))
260 sequence))
261
262(defun mh-valid-view-change-operation-p (op)
263 "Check if the view change operation can be performed.
264OP is one of 'widen and 'unthread."
265 (cond ((eq (car mh-view-ops) op)
266 (pop mh-view-ops))
267 (t nil)))
268
269;;;###mh-autoload
270(defun mh-widen ()
271 "Remove restrictions from current folder, thereby showing all messages."
272 (interactive)
273 (let ((msg (mh-get-msg-num nil)))
274 (when mh-narrowed-to-seq
275 (cond ((mh-valid-view-change-operation-p 'widen) nil)
276 ((memq 'widen mh-view-ops)
277 (while (not (eq (car mh-view-ops) 'widen))
278 (setq mh-view-ops (cdr mh-view-ops)))
279 (pop mh-view-ops))
280 (t (error "Widening is not applicable")))
281 (when (memq 'unthread mh-view-ops)
282 (setq mh-thread-scan-line-map mh-thread-old-scan-line-map))
283 (with-mh-folder-updating (t)
284 (delete-region (point-min) (point-max))
285 (widen)
286 (setq mh-mode-line-annotation mh-non-seq-mode-line-annotation)
287 (mh-make-folder-mode-line))
288 (if msg
289 (mh-goto-msg msg t t))
290 (mh-notate-deleted-and-refiled)
291 (mh-notate-user-sequences)
292 (mh-notate-seq 'cur mh-note-cur mh-cmd-note)
293 (mh-recenter nil)))
294 (if (and (boundp 'tool-bar-mode) tool-bar-mode)
295 (set (make-local-variable 'tool-bar-map) mh-folder-tool-bar-map))
296 (setq mh-narrowed-to-seq nil))
297
298;; FIXME? We may want to clear all notations and add one for current-message
299;; and process user sequences.
300(defun mh-notate-deleted-and-refiled ()
301 "Notate messages marked for deletion or refiling.
302Messages to be deleted are given by `mh-delete-list' while messages to be
303refiled are present in `mh-refile-list'."
304 (mh-mapc #'(lambda (msg) (mh-notate msg mh-note-deleted mh-cmd-note))
305 mh-delete-list)
306 (mh-mapc #'(lambda (dest-msg-list)
307 ;; foreach folder name, get the keyed sequence from mh-seq-list
308 (let ((msg-list (cdr dest-msg-list)))
309 (mh-mapc #'(lambda (msg)
310 (mh-notate msg mh-note-refiled mh-cmd-note))
311 msg-list)))
312 mh-refile-list))
313
314
315
316;;; Commands to manipulate sequences. Sequences are stored in an alist
317;;; of the form:
318;;; ((seq-name msgs ...) (seq-name msgs ...) ...)
319
320(defun mh-read-seq-default (prompt not-empty)
321 "Read and return sequence name with default narrowed or previous sequence.
322PROMPT is the prompt to use when reading. If NOT-EMPTY is non-nil then a
323non-empty sequence is read."
324 (mh-read-seq prompt not-empty
325 (or mh-narrowed-to-seq
326 mh-last-seq-used
327 (car (mh-seq-containing-msg (mh-get-msg-num nil) nil)))))
328
329(defun mh-read-seq (prompt not-empty &optional default)
330 "Read and return a sequence name.
331Prompt with PROMPT, raise an error if the sequence is empty and the NOT-EMPTY
332flag is non-nil, and supply an optional DEFAULT sequence. A reply of '%'
333defaults to the first sequence containing the current message."
334 (let* ((input (completing-read (format "%s %s %s" prompt "sequence:"
335 (if default
336 (format "[%s] " default)
337 ""))
338 (mh-seq-names mh-seq-list)))
339 (seq (cond ((equal input "%")
340 (car (mh-seq-containing-msg (mh-get-msg-num t) nil)))
341 ((equal input "") default)
342 (t (intern input))))
343 (msgs (mh-seq-to-msgs seq)))
344 (if (and (null msgs) not-empty)
345 (error "No messages in sequence `%s'" seq))
346 seq))
347
348(defun mh-seq-names (seq-list)
349 "Return an alist containing the names of the SEQ-LIST."
350 (mapcar (lambda (entry) (list (symbol-name (mh-seq-name entry))))
351 seq-list))
352
353;;;###mh-autoload
354(defun mh-rename-seq (sequence new-name)
355 "Rename SEQUENCE to have NEW-NAME."
356 (interactive (list (mh-read-seq "Old" t)
357 (intern (read-string "New sequence name: "))))
358 (let ((old-seq (mh-find-seq sequence)))
359 (or old-seq
360 (error "Sequence %s does not exist" sequence))
361 ;; create new sequence first, since it might raise an error.
362 (mh-define-sequence new-name (mh-seq-msgs old-seq))
363 (mh-undefine-sequence sequence (mh-seq-msgs old-seq))
364 (rplaca old-seq new-name)))
365
366;;;###mh-autoload
367(defun mh-map-to-seq-msgs (func seq &rest args)
368 "Invoke the FUNC at each message in the SEQ.
369SEQ can either be a list of messages or a MH sequence. The remaining ARGS are
370passed as arguments to FUNC."
371 (save-excursion
372 (let ((msgs (if (listp seq) seq (mh-seq-to-msgs seq))))
373 (while msgs
374 (if (mh-goto-msg (car msgs) t t)
375 (apply func (car msgs) args))
376 (setq msgs (cdr msgs))))))
377
378;;;###mh-autoload
379(defun mh-notate-seq (seq notation offset)
380 "Mark the scan listing.
381All messages in SEQ are marked with NOTATION at OFFSET from the beginning of
382the line."
383 (mh-map-to-seq-msgs 'mh-notate seq notation offset))
384
385;;;###mh-autoload
386(defun mh-add-to-sequence (seq msgs)
387 "The sequence SEQ is augmented with the messages in MSGS."
388 ;; Add to a SEQUENCE each message the list of MSGS.
389 (if (not (mh-folder-name-p seq))
390 (if msgs
391 (apply 'mh-exec-cmd "mark" mh-current-folder "-add"
392 "-sequence" (symbol-name seq)
393 (mh-coalesce-msg-list msgs)))))
394
395;; This has a tricky bug. mh-map-to-seq-msgs uses mh-goto-msg, which assumes
396;; that the folder buffer is sorted. However in this case that assumption
397;; doesn't hold. So we will do this the dumb way.
398;(defun mh-copy-seq-to-point (seq location)
399; ;; Copy the scan listing of the messages in SEQUENCE to after the point
400; ;; LOCATION in the current buffer.
401; (mh-map-to-seq-msgs 'mh-copy-line-to-point seq location))
402
403(defun mh-copy-seq-to-eob (seq)
404 "Copy SEQ to the end of the buffer."
405 ;; It is quite involved to write something which will work at any place in
406 ;; the buffer, so we will write something which works only at the end of
407 ;; the buffer. If we ever need to insert sequences in the middle of the
408 ;; buffer, this will need to be fixed.
409 (save-excursion
410 (let* ((msgs (mh-seq-to-msgs seq))
411 (coalesced-msgs (mh-coalesce-msg-list msgs)))
412 (goto-char (point-max))
413 (save-restriction
414 (narrow-to-region (point) (point))
415 (mh-regenerate-headers coalesced-msgs t)
416 (cond ((memq 'unthread mh-view-ops)
417 ;; Populate restricted scan-line map
418 (goto-char (point-min))
419 (while (not (eobp))
420 (let ((msg (mh-get-msg-num nil)))
421 (when (numberp msg)
422 (setf (gethash msg mh-thread-scan-line-map)
423 (mh-thread-parse-scan-line))))
424 (forward-line))
425 ;; Remove scan lines and read results from pre-computed tree
426 (delete-region (point-min) (point-max))
427 (let ((thread-tree (mh-thread-generate mh-current-folder ()))
428 (mh-thread-body-width
429 (- (window-width) mh-cmd-note
430 (1- mh-scan-field-subject-start-offset)))
431 (mh-thread-last-ancestor nil))
432 (mh-thread-generate-scan-lines thread-tree -2)))
433 (mh-index-data
434 (mh-index-insert-folder-headers)))))))
435
436(defun mh-copy-line-to-point (msg location)
437 "Copy current message line to a specific location.
438The argument MSG is not used. The message in the current line is copied to
439LOCATION."
440 ;; msg is not used?
441 ;; Copy the current line to the LOCATION in the current buffer.
442 (beginning-of-line)
443 (save-excursion
444 (let ((beginning-of-line (point))
445 end)
446 (forward-line 1)
447 (setq end (point))
448 (goto-char location)
449 (insert-buffer-substring (current-buffer) beginning-of-line end))))
450
451;;;###mh-autoload
452(defun mh-region-to-msg-list (begin end)
453 "Return a list of messages within the region between BEGIN and END."
454 (save-excursion
455 ;; If end is end of buffer back up one position
456 (setq end (if (equal end (point-max)) (1- end) end))
457 (goto-char begin)
458 (let ((result ()))
459 (while (<= (point) end)
460 (let ((index (mh-get-msg-num nil)))
461 (when (numberp index) (push index result)))
462 (forward-line 1))
463 result)))
464
465
466
467;;; Commands to handle new 'subject sequence.
468;;; Or "Poor man's threading" by psg.
469
470(defun mh-subject-to-sequence (all)
471 "Put all following messages with same subject in sequence 'subject.
472If arg ALL is t, move to beginning of folder buffer to collect all messages.
473If arg ALL is nil, collect only messages fron current one on forward.
474
475Return number of messages put in the sequence:
476
477 nil -> there was no subject line.
478 0 -> there were no later messages with the same subject (sequence not made)
479 >1 -> the total number of messages including current one."
480 (if (not (eq major-mode 'mh-folder-mode))
481 (error "Not in a folder buffer"))
482 (save-excursion
483 (beginning-of-line)
484 (if (or (not (looking-at mh-scan-subject-regexp))
485 (not (match-string 3))
486 (string-equal "" (match-string 3)))
487 (progn (message "No subject line.")
488 nil)
489 (let ((subject (match-string-no-properties 3))
490 (list))
491 (if (> (length subject) 41)
492 (setq subject (substring subject 0 41)))
493 (save-excursion
494 (if all
495 (goto-char (point-min)))
496 (while (re-search-forward mh-scan-subject-regexp nil t)
497 (let ((this-subject (match-string-no-properties 3)))
498 (if (> (length this-subject) 41)
499 (setq this-subject (substring this-subject 0 41)))
500 (if (string-equal this-subject subject)
501 (setq list (cons (mh-get-msg-num t) list))))))
502 (cond
503 (list
504 ;; If we created a new sequence, add the initial message to it too.
505 (if (not (member (mh-get-msg-num t) list))
506 (setq list (cons (mh-get-msg-num t) list)))
507 (if (member '("subject") (mh-seq-names mh-seq-list))
508 (mh-delete-seq 'subject))
509 ;; sort the result into a sequence
510 (let ((sorted-list (sort (copy-sequence list) 'mh-lessp)))
511 (while sorted-list
512 (mh-add-msgs-to-seq (car sorted-list) 'subject nil)
513 (setq sorted-list (cdr sorted-list)))
514 (safe-length list)))
515 (t
516 0))))))
517
518;;;###mh-autoload
519(defun mh-narrow-to-subject ()
520 "Narrow to a sequence containing all following messages with same subject."
521 (interactive)
522 (let ((num (mh-get-msg-num nil))
523 (count (mh-subject-to-sequence t)))
524 (cond
525 ((not count) ; No subject line, delete msg anyway
526 nil)
527 ((= 0 count) ; No other msgs, delete msg anyway.
528 (message "No other messages with same Subject following this one.")
529 nil)
530 (t ; We have a subject sequence.
531 (message "Found %d messages for subject sequence." count)
532 (mh-narrow-to-seq 'subject)
533 (if (numberp num)
534 (mh-goto-msg num t t))))))
535
536;;;###mh-autoload
537(defun mh-delete-subject ()
538 "Mark all following messages with same subject to be deleted.
539This puts the messages in a sequence named subject. You can undo the last
540deletion marks using `mh-undo' with a prefix argument and then specifying the
541subject sequence."
542 (interactive)
543 (let ((count (mh-subject-to-sequence nil)))
544 (cond
545 ((not count) ; No subject line, delete msg anyway
546 (mh-delete-msg (mh-get-msg-num t)))
547 ((= 0 count) ; No other msgs, delete msg anyway.
548 (message "No other messages with same Subject following this one.")
549 (mh-delete-msg (mh-get-msg-num t)))
550 (t ; We have a subject sequence.
551 (message "Marked %d messages for deletion" count)
552 (mh-delete-msg 'subject)))))
553
554;;;###mh-autoload
555(defun mh-delete-subject-or-thread ()
556 "Mark messages for deletion intelligently.
557If the folder is threaded then `mh-thread-delete' is used to mark the current
558message and all its descendants for deletion. Otherwise `mh-delete-subject' is
559used to mark the current message and all messages following it with the same
560subject for deletion."
561 (interactive)
562 (if (memq 'unthread mh-view-ops)
563 (mh-thread-delete)
564 (mh-delete-subject)))
565
566;;; Message threading:
567
568(defun mh-thread-initialize ()
569 "Make hash tables, otherwise clear them."
570 (cond
571 (mh-thread-id-hash
572 (clrhash mh-thread-id-hash)
573 (clrhash mh-thread-subject-hash)
574 (clrhash mh-thread-id-table)
575 (clrhash mh-thread-id-index-map)
576 (clrhash mh-thread-index-id-map)
577 (clrhash mh-thread-scan-line-map)
578 (clrhash mh-thread-subject-container-hash)
579 (clrhash mh-thread-duplicates)
580 (setq mh-thread-history ()))
581 (t (setq mh-thread-id-hash (make-hash-table :test #'equal))
582 (setq mh-thread-subject-hash (make-hash-table :test #'equal))
583 (setq mh-thread-id-table (make-hash-table :test #'eq))
584 (setq mh-thread-id-index-map (make-hash-table :test #'eq))
585 (setq mh-thread-index-id-map (make-hash-table :test #'eql))
586 (setq mh-thread-scan-line-map (make-hash-table :test #'eql))
587 (setq mh-thread-subject-container-hash (make-hash-table :test #'eq))
588 (setq mh-thread-duplicates (make-hash-table :test #'eq))
589 (setq mh-thread-history ()))))
590
591(defsubst mh-thread-id-container (id)
592 "Given ID, return the corresponding container in `mh-thread-id-table'.
593If no container exists then a suitable container is created and the id-table
594is updated."
595 (when (not id)
596 (error "1"))
597 (or (gethash id mh-thread-id-table)
598 (setf (gethash id mh-thread-id-table)
599 (let ((message (mh-thread-make-message :id id)))
600 (mh-thread-make-container :message message)))))
601
602(defsubst mh-thread-remove-parent-link (child)
603 "Remove parent link of CHILD if it exists."
604 (let* ((child-container (if (mh-thread-container-p child)
605 child (mh-thread-id-container child)))
606 (parent-container (mh-container-parent child-container)))
607 (when parent-container
608 (setf (mh-container-children parent-container)
609 (loop for elem in (mh-container-children parent-container)
610 unless (eq child-container elem) collect elem))
611 (setf (mh-container-parent child-container) nil))))
612
613(defsubst mh-thread-add-link (parent child &optional at-end-p)
614 "Add links so that PARENT becomes a parent of CHILD.
615Doesn't make any changes if CHILD is already an ancestor of PARENT. If
616optional argument AT-END-P is non-nil, the CHILD is added to the end of the
617children list of PARENT."
618 (let ((parent-container (cond ((null parent) nil)
619 ((mh-thread-container-p parent) parent)
620 (t (mh-thread-id-container parent))))
621 (child-container (if (mh-thread-container-p child)
622 child (mh-thread-id-container child))))
623 (when (and parent-container
624 (not (mh-thread-ancestor-p child-container parent-container))
625 (not (mh-thread-ancestor-p parent-container child-container)))
626 (mh-thread-remove-parent-link child-container)
627 (cond ((not at-end-p)
628 (push child-container (mh-container-children parent-container)))
629 ((null (mh-container-children parent-container))
630 (push child-container (mh-container-children parent-container)))
631 (t (let ((last-child (mh-container-children parent-container)))
632 (while (cdr last-child)
633 (setq last-child (cdr last-child)))
634 (setcdr last-child (cons child-container nil)))))
635 (setf (mh-container-parent child-container) parent-container))
636 (unless parent-container
637 (mh-thread-remove-parent-link child-container))))
638
639(defun mh-thread-ancestor-p (ancestor successor)
640 "Return t if ANCESTOR is really an ancestor of SUCCESSOR and nil otherwise.
641In the limit, the function returns t if ANCESTOR and SUCCESSOR are the same
642containers."
643 (block nil
644 (while successor
645 (when (eq ancestor successor) (return t))
646 (setq successor (mh-container-parent successor)))
647 nil))
648
649(defsubst mh-thread-get-message-container (message)
650 "Return container which has MESSAGE in it.
651If there is no container present then a new container is allocated."
652 (let* ((id (mh-message-id message))
653 (container (gethash id mh-thread-id-table)))
654 (cond (container (setf (mh-container-message container) message)
655 container)
656 (t (setf (gethash id mh-thread-id-table)
657 (mh-thread-make-container :message message))))))
658
659(defsubst mh-thread-get-message (id subject-re-p subject refs)
660 "Return appropriate message.
661Otherwise update message already present to have the proper ID, SUBJECT-RE-P,
662SUBJECT and REFS fields."
663 (let* ((container (gethash id mh-thread-id-table))
664 (message (if container (mh-container-message container) nil)))
665 (cond (message
666 (setf (mh-message-subject-re-p message) subject-re-p)
667 (setf (mh-message-subject message) subject)
668 (setf (mh-message-id message) id)
669 (setf (mh-message-references message) refs)
670 message)
671 (container
672 (setf (mh-container-message container)
673 (mh-thread-make-message :subject subject
674 :subject-re-p subject-re-p
675 :id id :references refs)))
676 (t (let ((message (mh-thread-make-message
677 :subject subject
678 :subject-re-p subject-re-p
679 :id id :references refs)))
680 (prog1 message
681 (mh-thread-get-message-container message)))))))
682
683(defsubst mh-thread-canonicalize-id (id)
684 "Produce canonical string representation for ID.
685This allows cheap string comparison with EQ."
686 (or (and (equal id "") (copy-sequence ""))
687 (gethash id mh-thread-id-hash)
688 (setf (gethash id mh-thread-id-hash) id)))
689
690(defsubst mh-thread-prune-subject (subject)
691 "Prune leading Re:'s, Fwd:'s etc. and trailing (fwd)'s from SUBJECT.
692If the result after pruning is not the empty string then it is canonicalized
693so that subjects can be tested for equality with eq. This is done so that all
694the messages without a subject are not put into a single thread."
695 (let ((case-fold-search t)
696 (subject-pruned-flag nil))
697 ;; Prune subject leader
698 (while (or (string-match "^[ \t]*\\(re\\|fwd?\\)\\(\\[[0-9]*\\]\\)?:[ \t]*"
699 subject)
700 (string-match "^[ \t]*\\[[^\\]][ \t]*" subject))
701 (setq subject-pruned-flag t)
702 (setq subject (substring subject (match-end 0))))
703 ;; Prune subject trailer
704 (while (or (string-match "(fwd)$" subject)
705 (string-match "[ \t]+$" subject))
706 (setq subject-pruned-flag t)
707 (setq subject (substring subject 0 (match-beginning 0))))
708 ;; Canonicalize subject only if it is non-empty
709 (cond ((equal subject "") (values subject subject-pruned-flag))
710 (t (values
711 (or (gethash subject mh-thread-subject-hash)
712 (setf (gethash subject mh-thread-subject-hash) subject))
713 subject-pruned-flag)))))
714
715(defun mh-thread-container-subject (container)
716 "Return the subject of CONTAINER.
717If CONTAINER is empty return the subject info of one of its children."
718 (cond ((and (mh-container-message container)
719 (mh-message-id (mh-container-message container)))
720 (mh-message-subject (mh-container-message container)))
721 (t (block nil
722 (dolist (kid (mh-container-children container))
723 (when (and (mh-container-message kid)
724 (mh-message-id (mh-container-message kid)))
725 (let ((kid-message (mh-container-message kid)))
726 (return (mh-message-subject kid-message)))))
727 (error "This can't happen!")))))
728
729(defun mh-thread-rewind-pruning ()
730 "Restore the thread tree to its state before pruning."
731 (while mh-thread-history
732 (let ((action (pop mh-thread-history)))
733 (cond ((eq (car action) 'DROP)
734 (mh-thread-remove-parent-link (cadr action))
735 (mh-thread-add-link (caddr action) (cadr action)))
736 ((eq (car action) 'PROMOTE)
737 (let ((node (cadr action))
738 (parent (caddr action))
739 (children (cdddr action)))
740 (dolist (child children)
741 (mh-thread-remove-parent-link child)
742 (mh-thread-add-link node child))
743 (mh-thread-add-link parent node)))
744 ((eq (car action) 'SUBJECT)
745 (let ((node (cadr action)))
746 (mh-thread-remove-parent-link node)
747 (setf (mh-container-real-child-p node) t)))))))
748
749(defun mh-thread-prune-containers (roots)
750 "Prune empty containers in the containers ROOTS."
751 (let ((dfs-ordered-nodes ())
752 (work-list roots))
753 (while work-list
754 (let ((node (pop work-list)))
755 (dolist (child (mh-container-children node))
756 (push child work-list))
757 (push node dfs-ordered-nodes)))
758 (while dfs-ordered-nodes
759 (let ((node (pop dfs-ordered-nodes)))
760 (cond ((gethash (mh-message-id (mh-container-message node))
761 mh-thread-id-index-map)
762 ;; Keep it
763 (setf (mh-container-children node)
764 (mh-thread-sort-containers (mh-container-children node))))
765 ((and (mh-container-children node)
766 (or (null (cdr (mh-container-children node)))
767 (mh-container-parent node)))
768 ;; Promote kids
769 (let ((children ()))
770 (dolist (kid (mh-container-children node))
771 (mh-thread-remove-parent-link kid)
772 (mh-thread-add-link (mh-container-parent node) kid)
773 (push kid children))
774 (push `(PROMOTE ,node ,(mh-container-parent node) ,@children)
775 mh-thread-history)
776 (mh-thread-remove-parent-link node)))
777 ((mh-container-children node)
778 ;; Promote the first orphan to parent and add the other kids as
779 ;; his children
780 (setf (mh-container-children node)
781 (mh-thread-sort-containers (mh-container-children node)))
782 (let ((new-parent (car (mh-container-children node)))
783 (other-kids (cdr (mh-container-children node))))
784 (mh-thread-remove-parent-link new-parent)
785 (dolist (kid other-kids)
786 (mh-thread-remove-parent-link kid)
787 (setf (mh-container-real-child-p kid) nil)
788 (mh-thread-add-link new-parent kid t))
789 (push `(PROMOTE ,node ,(mh-container-parent node)
790 ,new-parent ,@other-kids)
791 mh-thread-history)
792 (mh-thread-remove-parent-link node)))
793 (t
794 ;; Drop it
795 (push `(DROP ,node ,(mh-container-parent node))
796 mh-thread-history)
797 (mh-thread-remove-parent-link node)))))
798 (let ((results ()))
799 (maphash #'(lambda (k v)
800 (declare (ignore k))
801 (when (and (null (mh-container-parent v))
802 (gethash (mh-message-id (mh-container-message v))
803 mh-thread-id-index-map))
804 (push v results)))
805 mh-thread-id-table)
806 (mh-thread-sort-containers results))))
807
808(defun mh-thread-sort-containers (containers)
809 "Sort a list of message CONTAINERS to be in ascending order wrt index."
810 (sort containers
811 #'(lambda (x y)
812 (when (and (mh-container-message x) (mh-container-message y))
813 (let* ((id-x (mh-message-id (mh-container-message x)))
814 (id-y (mh-message-id (mh-container-message y)))
815 (index-x (gethash id-x mh-thread-id-index-map))
816 (index-y (gethash id-y mh-thread-id-index-map)))
817 (and (integerp index-x) (integerp index-y)
818 (< index-x index-y)))))))
819
820(defsubst mh-thread-group-by-subject (roots)
821 "Group the set of message containers, ROOTS based on subject.
822Bug: Check for and make sure that something without Re: is made the parent in
823preference to something that has it."
824 (clrhash mh-thread-subject-container-hash)
825 (let ((results ()))
826 (dolist (root roots)
827 (let* ((subject (mh-thread-container-subject root))
828 (parent (gethash subject mh-thread-subject-container-hash)))
829 (cond (parent (mh-thread-remove-parent-link root)
830 (mh-thread-add-link parent root t)
831 (setf (mh-container-real-child-p root) nil)
832 (push `(SUBJECT ,root) mh-thread-history))
833 (t
834 (setf (gethash subject mh-thread-subject-container-hash) root)
835 (push root results)))))
836 (nreverse results)))
837
838(defsubst mh-thread-process-in-reply-to (reply-to-header)
839 "Extract message id's from REPLY-TO-HEADER.
840Ideally this should have some regexp which will try to guess if a string
841between < and > is a message id and not an email address. For now it will
842take the last string inside angles."
843 (let ((end (mh-search-from-end ?> reply-to-header)))
844 (when (numberp end)
845 (let ((begin (mh-search-from-end ?< (substring reply-to-header 0 end))))
846 (when (numberp begin)
847 (list (substring reply-to-header begin (1+ end))))))))
848
849(defun mh-thread-set-tables (folder)
850 "Use the tables of FOLDER in current buffer."
851 (flet ((mh-get-table (symbol)
852 (save-excursion
853 (set-buffer folder)
854 (symbol-value symbol))))
855 (setq mh-thread-id-hash (mh-get-table 'mh-thread-id-hash))
856 (setq mh-thread-subject-hash (mh-get-table 'mh-thread-subject-hash))
857 (setq mh-thread-id-table (mh-get-table 'mh-thread-id-table))
858 (setq mh-thread-id-index-map (mh-get-table 'mh-thread-id-index-map))
859 (setq mh-thread-index-id-map (mh-get-table 'mh-thread-index-id-map))
860 (setq mh-thread-scan-line-map (mh-get-table 'mh-thread-scan-line-map))
861 (setq mh-thread-subject-container-hash
862 (mh-get-table 'mh-thread-subject-container-hash))
863 (setq mh-thread-duplicates (mh-get-table 'mh-thread-duplicates))
864 (setq mh-thread-history (mh-get-table 'mh-thread-history))))
865
866(defsubst mh-thread-update-id-index-maps (id index)
867 "Message with id, ID is the message in INDEX.
868The function also checks for duplicate messages (that is multiple messages
869with the same ID). These messages are put in the `mh-thread-duplicates' hash
870table."
871 (let ((old-index (gethash id mh-thread-id-index-map)))
872 (when old-index (push old-index (gethash id mh-thread-duplicates)))
873 (setf (gethash id mh-thread-id-index-map) index)
874 (setf (gethash index mh-thread-index-id-map) id)))
875
876
877
878;;; Generate Threads...
879
880(defun mh-thread-generate (folder msg-list)
881 "Scan FOLDER to get info for threading.
882Only information about messages in MSG-LIST are added to the tree."
883 (save-excursion
884 (set-buffer (get-buffer-create "*mh-thread*"))
885 (mh-thread-set-tables folder)
886 (erase-buffer)
887 (when msg-list
888 (apply
889 #'call-process (expand-file-name mh-scan-prog mh-progs) nil '(t nil) nil
890 "-width" "10000" "-format"
891 "%(msg)\n%{message-id}\n%{references}\n%{in-reply-to}\n%{subject}\n"
892 folder (mapcar #'(lambda (x) (format "%s" x)) msg-list)))
893 (goto-char (point-min))
894 (let ((roots ())
895 (case-fold-search t))
896 (block nil
897 (while (not (eobp))
898 (block process-message
899 (let* ((index-line
900 (prog1 (buffer-substring (point) (line-end-position))
901 (forward-line)))
902 (index (car (read-from-string index-line)))
903 (id (prog1 (buffer-substring (point) (line-end-position))
904 (forward-line)))
905 (refs (prog1 (buffer-substring (point) (line-end-position))
906 (forward-line)))
907 (in-reply-to (prog1 (buffer-substring (point)
908 (line-end-position))
909 (forward-line)))
910 (subject (prog1
911 (buffer-substring (point) (line-end-position))
912 (forward-line)))
913 (subject-re-p nil))
914 (unless (gethash index mh-thread-scan-line-map)
915 (return-from process-message))
916 (unless (integerp index) (return)) ;Error message here
917 (multiple-value-setq (subject subject-re-p)
918 (mh-thread-prune-subject subject))
919 (setq in-reply-to (mh-thread-process-in-reply-to in-reply-to))
920 (setq refs (append (split-string refs) in-reply-to))
921 (setq id (mh-thread-canonicalize-id id))
922 (mh-thread-update-id-index-maps id index)
923 (setq refs (mapcar #'mh-thread-canonicalize-id refs))
924 (mh-thread-get-message id subject-re-p subject refs)
925 (do ((ancestors refs (cdr ancestors)))
926 ((null (cdr ancestors))
927 (when (car ancestors)
928 (mh-thread-remove-parent-link id)
929 (mh-thread-add-link (car ancestors) id)))
930 (mh-thread-add-link (car ancestors) (cadr ancestors)))))))
931 (maphash #'(lambda (k v)
932 (declare (ignore k))
933 (when (null (mh-container-parent v))
934 (push v roots)))
935 mh-thread-id-table)
936 (setq roots (mh-thread-prune-containers roots))
937 (prog1 (setq roots (mh-thread-group-by-subject roots))
938 (let ((history mh-thread-history))
939 (set-buffer folder)
940 (setq mh-thread-history history))))))
941
942;;;###mh-autoload
943(defun mh-thread-inc (folder start-point)
944 "Update thread tree for FOLDER.
945All messages after START-POINT are added to the thread tree."
946 (mh-thread-rewind-pruning)
947 (goto-char start-point)
948 (let ((msg-list ()))
949 (while (not (eobp))
950 (let ((index (mh-get-msg-num nil)))
951 (when (numberp index)
952 (push index msg-list)
953 (setf (gethash index mh-thread-scan-line-map)
954 (mh-thread-parse-scan-line)))
955 (forward-line)))
956 (let ((thread-tree (mh-thread-generate folder msg-list))
957 (buffer-read-only nil)
958 (old-buffer-modified-flag (buffer-modified-p)))
959 (delete-region (point-min) (point-max))
960 (let ((mh-thread-body-width (- (window-width) mh-cmd-note
961 (1- mh-scan-field-subject-start-offset)))
962 (mh-thread-last-ancestor nil))
963 (mh-thread-generate-scan-lines thread-tree -2))
964 (mh-notate-user-sequences)
965 (mh-notate-deleted-and-refiled)
966 (mh-notate-seq 'cur mh-note-cur mh-cmd-note)
967 (set-buffer-modified-p old-buffer-modified-flag))))
968
969(defvar mh-thread-last-ancestor)
970
971(defun mh-thread-generate-scan-lines (tree level)
972 "Generate scan lines.
973TREE is the hierarchical tree of messages, SCAN-LINE-MAP maps message indices
974to the corresponding scan lines and LEVEL used to determine indentation of
975the message."
976 (cond ((null tree) nil)
977 ((mh-thread-container-p tree)
978 (let* ((message (mh-container-message tree))
979 (id (mh-message-id message))
980 (index (gethash id mh-thread-id-index-map))
981 (duplicates (gethash id mh-thread-duplicates))
982 (new-level (+ level 2))
983 (dupl-flag t)
984 (force-angle-flag nil)
985 (increment-level-flag nil))
986 (dolist (scan-line (mapcar (lambda (x)
987 (gethash x mh-thread-scan-line-map))
988 (reverse (cons index duplicates))))
989 (when scan-line
990 (when (and dupl-flag (equal level 0)
991 (mh-thread-ancestor-p mh-thread-last-ancestor tree))
992 (setq level (+ level 2)
993 new-level (+ new-level 2)
994 force-angle-flag t))
995 (when (equal level 0)
996 (setq mh-thread-last-ancestor tree)
997 (while (mh-container-parent mh-thread-last-ancestor)
998 (setq mh-thread-last-ancestor
999 (mh-container-parent mh-thread-last-ancestor))))
1000 (insert (car scan-line)
1001 (format (format "%%%ss"
1002 (if dupl-flag level new-level)) "")
1003 (if (and (mh-container-real-child-p tree) dupl-flag
1004 (not force-angle-flag))
1005 "[" "<")
1006 (cadr scan-line)
1007 (if (and (mh-container-real-child-p tree) dupl-flag
1008 (not force-angle-flag))
1009 "]" ">")
1010 (truncate-string-to-width
1011 (caddr scan-line) (- mh-thread-body-width
1012 (if dupl-flag level new-level)))
1013 "\n")
1014 (setq increment-level-flag t)
1015 (setq dupl-flag nil)))
1016 (unless increment-level-flag (setq new-level level))
1017 (dolist (child (mh-container-children tree))
1018 (mh-thread-generate-scan-lines child new-level))))
1019 (t (let ((nlevel (+ level 2)))
1020 (dolist (ch tree)
1021 (mh-thread-generate-scan-lines ch nlevel))))))
1022
1023;; Another and may be better approach would be to generate all the info from
1024;; the scan which generates the threading info. For now this will have to do.
1025(defun mh-thread-parse-scan-line (&optional string)
1026 "Parse a scan line.
1027If optional argument STRING is given then that is assumed to be the scan line.
1028Otherwise uses the line at point as the scan line to parse."
1029 (let* ((string (or string
1030 (buffer-substring-no-properties (line-beginning-position)
1031 (line-end-position))))
1032 (first-string (substring string 0 (+ mh-cmd-note 8))))
1033 (setf (elt first-string mh-cmd-note) ? )
1034 (when (equal (elt first-string (1+ mh-cmd-note)) (elt mh-note-seq 0))
1035 (setf (elt first-string (1+ mh-cmd-note)) ? ))
1036 (list first-string
1037 (substring string
1038 (+ mh-cmd-note mh-scan-field-from-start-offset)
1039 (+ mh-cmd-note mh-scan-field-from-end-offset -2))
1040 (substring string (+ mh-cmd-note mh-scan-field-from-end-offset))
1041 string)))
1042
1043;;;###mh-autoload
1044(defun mh-thread-add-spaces (count)
1045 "Add COUNT spaces to each scan line in `mh-thread-scan-line-map'."
1046 (let ((spaces (format (format "%%%ss" count) "")))
1047 (while (not (eobp))
1048 (let* ((msg-num (mh-get-msg-num nil))
1049 (old-line (nth 3 (gethash msg-num mh-thread-scan-line-map))))
1050 (when (numberp msg-num)
1051 (setf (gethash msg-num mh-thread-scan-line-map)
1052 (mh-thread-parse-scan-line (format "%s%s" spaces old-line)))))
1053 (forward-line 1))))
1054
1055(defun mh-thread-folder ()
1056 "Generate thread view of folder."
1057 (message "Threading %s..." (buffer-name))
1058 (mh-thread-initialize)
1059 (goto-char (point-min))
1060 (while (not (eobp))
1061 (let ((index (mh-get-msg-num nil)))
1062 (when (numberp index)
1063 (setf (gethash index mh-thread-scan-line-map)
1064 (mh-thread-parse-scan-line))))
1065 (forward-line))
1066 (let* ((range (format "%s-%s" mh-first-msg-num mh-last-msg-num))
1067 (thread-tree (mh-thread-generate (buffer-name) (list range))))
1068 (delete-region (point-min) (point-max))
1069 (let ((mh-thread-body-width (- (window-width) mh-cmd-note
1070 (1- mh-scan-field-subject-start-offset)))
1071 (mh-thread-last-ancestor nil))
1072 (mh-thread-generate-scan-lines thread-tree -2))
1073 (mh-notate-user-sequences)
1074 (mh-notate-deleted-and-refiled)
1075 (mh-notate-seq 'cur mh-note-cur mh-cmd-note)
1076 (message "Threading %s...done" (buffer-name))))
1077
1078;;;###mh-autoload
1079(defun mh-toggle-threads ()
1080 "Toggle threaded view of folder.
1081The conversion of normal view to threaded view is exact, that is the same
1082messages are displayed in the folder buffer before and after threading. However
1083the conversion from threaded view to normal view is inexact. So more messages
1084than were originally present may be shown as a result."
1085 (interactive)
1086 (let ((msg-at-point (mh-get-msg-num nil))
1087 (old-buffer-modified-flag (buffer-modified-p))
1088 (buffer-read-only nil))
1089 (cond ((and (memq 'unthread mh-view-ops) mh-narrowed-to-seq)
1090 (unless (mh-valid-view-change-operation-p 'unthread)
1091 (error "Can't unthread folder"))
1092 (mh-scan-folder mh-current-folder
1093 (format "%s" mh-narrowed-to-seq)
1094 t)
1095 (when mh-index-data
1096 (mh-index-insert-folder-headers)))
1097 ((memq 'unthread mh-view-ops)
1098 (unless (mh-valid-view-change-operation-p 'unthread)
1099 (error "Can't unthread folder"))
1100 (mh-scan-folder mh-current-folder
1101 (format "%s-%s" mh-first-msg-num mh-last-msg-num)
1102 t)
1103 (when mh-index-data
1104 (mh-index-insert-folder-headers)))
1105 (t (mh-thread-folder)
1106 (push 'unthread mh-view-ops)))
1107 (when msg-at-point (mh-goto-msg msg-at-point t t))
1108 (set-buffer-modified-p old-buffer-modified-flag)
1109 (mh-recenter nil)))
1110
1111;;;###mh-autoload
1112(defun mh-thread-forget-message (index)
1113 "Forget the message INDEX from the threading tables."
1114 (let* ((id (gethash index mh-thread-index-id-map))
1115 (id-index (gethash id mh-thread-id-index-map))
1116 (duplicates (gethash id mh-thread-duplicates)))
1117 (remhash index mh-thread-index-id-map)
1118 (cond ((and (eql index id-index) (null duplicates))
1119 (remhash id mh-thread-id-index-map))
1120 ((eql index id-index)
1121 (setf (gethash id mh-thread-id-index-map) (car duplicates))
1122 (setf (gethash (car duplicates) mh-thread-index-id-map) id)
1123 (setf (gethash id mh-thread-duplicates) (cdr duplicates)))
1124 (t
1125 (setf (gethash id mh-thread-duplicates)
1126 (remove index duplicates))))))
1127
1128
1129
1130;;; Operations on threads
1131
1132(defun mh-thread-current-indentation-level ()
1133 "Find the number of spaces by which current message is indented."
1134 (save-excursion
1135 (let ((address-start-offset (+ mh-cmd-note mh-scan-date-flag-width
1136 mh-scan-date-width 1))
1137 (level 0))
1138 (beginning-of-line)
1139 (forward-char address-start-offset)
1140 (while (char-equal (char-after) ? )
1141 (incf level)
1142 (forward-char))
1143 level)))
1144
1145;;;###mh-autoload
1146(defun mh-thread-next-sibling (&optional previous-flag)
1147 "Jump to next sibling.
1148With non-nil optional argument PREVIOUS-FLAG jump to the previous sibling."
1149 (interactive)
1150 (cond ((not (memq 'unthread mh-view-ops))
1151 (error "Folder isn't threaded"))
1152 ((eobp)
1153 (error "No message at point")))
1154 (beginning-of-line)
1155 (let ((point (point))
1156 (done nil)
1157 (my-level (mh-thread-current-indentation-level)))
1158 (while (and (not done)
1159 (equal (forward-line (if previous-flag -1 1)) 0)
1160 (not (eobp)))
1161 (let ((level (mh-thread-current-indentation-level)))
1162 (cond ((equal level my-level)
1163 (setq done 'success))
1164 ((< level my-level)
1165 (message "No %s sibling" (if previous-flag "previous" "next"))
1166 (setq done 'failure)))))
1167 (cond ((eq done 'success) (mh-maybe-show))
1168 ((eq done 'failure) (goto-char point))
1169 (t (message "No %s sibling" (if previous-flag "previous" "next"))
1170 (goto-char point)))))
1171
1172;;;###mh-autoload
1173(defun mh-thread-previous-sibling ()
1174 "Jump to previous sibling."
1175 (interactive)
1176 (mh-thread-next-sibling t))
1177
1178(defun mh-thread-immediate-ancestor ()
1179 "Jump to immediate ancestor in thread tree."
1180 (beginning-of-line)
1181 (let ((point (point))
1182 (ancestor-level (- (mh-thread-current-indentation-level) 2))
1183 (done nil))
1184 (if (< ancestor-level 0)
1185 nil
1186 (while (and (not done) (equal (forward-line -1) 0))
1187 (when (equal ancestor-level (mh-thread-current-indentation-level))
1188 (setq done t)))
1189 (unless done
1190 (goto-char point))
1191 done)))
1192
1193;;;###mh-autoload
1194(defun mh-thread-ancestor (&optional thread-root-flag)
1195 "Jump to the ancestor of current message.
1196If optional argument THREAD-ROOT-FLAG is non-nil then jump to the root of the
1197thread tree the message belongs to."
1198 (interactive "P")
1199 (beginning-of-line)
1200 (cond ((not (memq 'unthread mh-view-ops))
1201 (error "Folder isn't threaded"))
1202 ((eobp)
1203 (error "No message at point")))
1204 (let ((current-level (mh-thread-current-indentation-level)))
1205 (cond (thread-root-flag
1206 (while (mh-thread-immediate-ancestor))
1207 (mh-maybe-show))
1208 ((equal current-level 1)
1209 (message "Message has no ancestor"))
1210 (t (mh-thread-immediate-ancestor)
1211 (mh-maybe-show)))))
1212
1213(defun mh-thread-find-children ()
1214 "Return a region containing the current message and its children.
1215The result is returned as a list of two elements. The first is the point at the
1216start of the region and the second is the point at the end."
1217 (beginning-of-line)
1218 (if (eobp)
1219 nil
1220 (let ((address-start-offset (+ mh-cmd-note mh-scan-date-flag-width
1221 mh-scan-date-width 1))
1222 (level (mh-thread-current-indentation-level))
1223 spaces begin)
1224 (setq begin (point))
1225 (setq spaces (format (format "%%%ss" (1+ level)) ""))
1226 (forward-line)
1227 (block nil
1228 (while (not (eobp))
1229 (forward-char address-start-offset)
1230 (unless (equal (string-match spaces (buffer-substring-no-properties
1231 (point) (line-end-position)))
1232 0)
1233 (beginning-of-line)
1234 (backward-char)
1235 (return))
1236 (forward-line)))
1237 (list begin (point)))))
1238
1239;;;###mh-autoload
1240(defun mh-thread-delete ()
1241 "Mark current message and all its children for subsequent deletion."
1242 (interactive)
1243 (cond ((not (memq 'unthread mh-view-ops))
1244 (error "Folder isn't threaded"))
1245 ((eobp)
1246 (error "No message at point"))
1247 (t (mh-delete-msg
1248 (apply #'mh-region-to-msg-list (mh-thread-find-children))))))
1249
1250;; This doesn't handle mh-default-folder-for-message-function. We should
1251;; refactor that code so that we don't copy it.
1252;;;###mh-autoload
1253(defun mh-thread-refile (folder)
1254 "Mark current message and all its children for refiling to FOLDER."
1255 (interactive (list
1256 (intern (mh-prompt-for-folder
1257 "Destination"
1258 (cond ((eq 'refile (car mh-last-destination-folder))
1259 (symbol-name (cdr mh-last-destination-folder)))
1260 (t ""))
1261 t))))
1262 (cond ((not (memq 'unthread mh-view-ops))
1263 (error "Folder isn't threaded"))
1264 ((eobp)
1265 (error "No message at point"))
1266 (t (mh-refile-msg
1267 (apply #'mh-region-to-msg-list (mh-thread-find-children))
1268 folder))))
1269
1270(provide 'mh-seq)
1271
1272;;; Local Variables:
1273;;; indent-tabs-mode: nil
1274;;; sentence-end-double-space: nil
1275;;; End:
1276
1277;;; mh-seq.el ends here
diff --git a/lisp/mail/mh-speed.el b/lisp/mail/mh-speed.el
deleted file mode 100644
index beda52778e4..00000000000
--- a/lisp/mail/mh-speed.el
+++ /dev/null
@@ -1,573 +0,0 @@
1;;; mh-speed.el --- Speedbar interface for MH-E.
2
3;; Copyright (C) 2002 Free Software Foundation, Inc.
4
5;; Author: Satyaki Das <satyaki@theforce.stanford.edu>
6;; Maintainer: Bill Wohler <wohler@newt.com>
7;; Keywords: mail
8;; See: mh-e.el
9
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
14;; the Free Software Foundation; either version 2, or (at your option)
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 the
24;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
25;; Boston, MA 02111-1307, USA.
26
27;;; Commentary:
28;; Future versions should only use flists.
29
30;; Speedbar support for MH-E package.
31
32;;; Change Log:
33
34;; $Id: mh-speed.el,v 1.34 2003/01/07 21:15:20 satyaki Exp $
35
36;;; Code:
37
38;; Requires
39(require 'cl)
40(require 'mh-e)
41(require 'speedbar)
42
43;; Global variables
44(defvar mh-speed-refresh-flag nil)
45(defvar mh-speed-last-selected-folder nil)
46(defvar mh-speed-folder-map (make-hash-table :test #'equal))
47(defvar mh-speed-folders-cache (make-hash-table :test #'equal))
48(defvar mh-speed-flists-cache (make-hash-table :test #'equal))
49(defvar mh-speed-flists-process nil)
50(defvar mh-speed-flists-timer nil)
51(defvar mh-speed-partial-line "")
52
53;; Add our stealth update function
54(unless (member 'mh-speed-stealth-update
55 (cdr (assoc "files" speedbar-stealthy-function-list)))
56 ;; Is changing constant lists in elisp safe?
57 (setq speedbar-stealthy-function-list
58 (copy-tree speedbar-stealthy-function-list))
59 (push 'mh-speed-stealth-update
60 (cdr (assoc "files" speedbar-stealthy-function-list))))
61
62;; Functions called by speedbar to initialize display...
63;;;###mh-autoload
64(defun mh-folder-speedbar-buttons (buffer)
65 "Interface function to create MH-E speedbar buffer.
66BUFFER is the MH-E buffer for which the speedbar buffer is to be created."
67 (unless (get-text-property (point-min) 'mh-level)
68 (erase-buffer)
69 (clrhash mh-speed-folder-map)
70 (speedbar-make-tag-line 'bracket ?+ 'mh-speed-toggle nil " " 'ignore nil
71 'mh-speedbar-folder-face 0)
72 (forward-line -1)
73 (setf (gethash nil mh-speed-folder-map)
74 (set-marker (make-marker) (1+ (line-beginning-position))))
75 (add-text-properties
76 (line-beginning-position) (1+ (line-beginning-position))
77 `(mh-folder nil mh-expanded nil mh-children-p t mh-level 0))
78 (mh-speed-stealth-update t)
79 (when mh-speed-run-flists-flag
80 (mh-speed-flists nil))))
81
82;;;###mh-autoload
83(defalias 'mh-show-speedbar-buttons 'mh-folder-speedbar-buttons)
84;;;###mh-autoload
85(defalias 'mh-letter-speedbar-buttons 'mh-folder-speedbar-buttons)
86
87;; Keymaps for speedbar...
88(defvar mh-folder-speedbar-key-map (speedbar-make-specialized-keymap)
89 "Specialized speedbar keymap for MH-E buffers.")
90(gnus-define-keys mh-folder-speedbar-key-map
91 "+" mh-speed-expand-folder
92 "-" mh-speed-contract-folder
93 "\r" mh-speed-view
94 "f" mh-speed-flists
95 "i" mh-speed-invalidate-map)
96
97(defvar mh-show-speedbar-key-map mh-folder-speedbar-key-map)
98(defvar mh-letter-speedbar-key-map mh-folder-speedbar-key-map)
99
100;; Menus for speedbar...
101(defvar mh-folder-speedbar-menu-items
102 '(["Visit Folder" mh-speed-view
103 (save-excursion
104 (set-buffer speedbar-buffer)
105 (get-text-property (line-beginning-position) 'mh-folder))]
106 ["Expand nested folders" mh-speed-expand-folder
107 (and (get-text-property (line-beginning-position) 'mh-children-p)
108 (not (get-text-property (line-beginning-position) 'mh-expanded)))]
109 ["Contract nested folders" mh-speed-contract-folder
110 (and (get-text-property (line-beginning-position) 'mh-children-p)
111 (get-text-property (line-beginning-position) 'mh-expanded))]
112 ["Run Flists" mh-speed-flists t]
113 ["Invalidate cached folders" mh-speed-invalidate-map t])
114 "Extra menu items for speedbar.")
115
116(defvar mh-show-speedbar-menu-items mh-folder-speedbar-menu-items)
117(defvar mh-letter-speedbar-menu-items mh-folder-speedbar-menu-items)
118
119(defmacro mh-speed-select-attached-frame ()
120 "Compatibility macro to handle speedbar versions 0.11a and 0.14beta4."
121 (cond ((fboundp 'dframe-select-attached-frame)
122 '(dframe-select-attached-frame speedbar-frame))
123 ((boundp 'speedbar-attached-frame)
124 '(select-frame speedbar-attached-frame))
125 (t (error "Installed speedbar version not supported by MH-E"))))
126
127(defun mh-speed-update-current-folder (force)
128 "Update speedbar highlighting of the current folder.
129The function tries to be smart so that work done is minimized. The currently
130highlighted folder is cached and no highlighting happens unless it changes.
131Also highlighting is suspended while the speedbar frame is selected.
132Otherwise you get the disconcerting behavior of folders popping open on their
133own when you are trying to navigate around in the speedbar buffer.
134
135The update is always carried out if FORCE is non-nil."
136 (let* ((lastf (selected-frame))
137 (newcf (save-excursion
138 (mh-speed-select-attached-frame)
139 (prog1 (mh-speed-extract-folder-name (buffer-name))
140 (select-frame lastf))))
141 (lastb (current-buffer))
142 (case-fold-search t))
143 (when (or force
144 (and mh-speed-refresh-flag (not (eq lastf speedbar-frame)))
145 (and (stringp newcf)
146 (equal (substring newcf 0 1) "+")
147 (not (equal newcf mh-speed-last-selected-folder))))
148 (setq mh-speed-refresh-flag nil)
149 (select-frame speedbar-frame)
150 (set-buffer speedbar-buffer)
151
152 ;; Remove highlight from previous match...
153 (mh-speed-highlight mh-speed-last-selected-folder
154 'mh-speedbar-folder-face)
155
156 ;; If we found a match highlight it...
157 (when (mh-speed-goto-folder newcf)
158 (mh-speed-highlight newcf 'mh-speedbar-selected-folder-face))
159
160 (setq mh-speed-last-selected-folder newcf)
161 (speedbar-position-cursor-on-line)
162 (set-window-point (frame-first-window speedbar-frame) (point))
163 (set-buffer lastb)
164 (select-frame lastf))
165 (when (eq lastf speedbar-frame)
166 (setq mh-speed-refresh-flag t))))
167
168(defun mh-speed-normal-face (face)
169 "Return normal face for given FACE."
170 (cond ((eq face 'mh-speedbar-folder-with-unseen-messages-face)
171 'mh-speedbar-folder-face)
172 ((eq face 'mh-speedbar-selected-folder-with-unseen-messages-face)
173 'mh-speedbar-selected-folder-face)
174 (t face)))
175
176(defun mh-speed-bold-face (face)
177 "Return bold face for given FACE."
178 (cond ((eq face 'mh-speedbar-folder-face)
179 'mh-speedbar-folder-with-unseen-messages-face)
180 ((eq face 'mh-speedbar-selected-folder-face)
181 'mh-speedbar-selected-folder-with-unseen-messages-face)
182 (t face)))
183
184(defun mh-speed-highlight (folder face)
185 "Set FOLDER to FACE."
186 (save-excursion
187 (speedbar-with-writable
188 (goto-char (gethash folder mh-speed-folder-map (point)))
189 (beginning-of-line)
190 (if (re-search-forward "([1-9][0-9]*/[0-9]+)" (line-end-position) t)
191 (setq face (mh-speed-bold-face face))
192 (setq face (mh-speed-normal-face face)))
193 (beginning-of-line)
194 (when (re-search-forward "\\[.\\] " (line-end-position) t)
195 (put-text-property (point) (line-end-position) 'face face)))))
196
197(defun mh-speed-stealth-update (&optional force)
198 "Do stealth update.
199With non-nil FORCE, the update is always carried out."
200 (cond ((save-excursion (set-buffer speedbar-buffer)
201 (get-text-property (point-min) 'mh-level))
202 ;; Execute this hook and *don't* run anything else
203 (mh-speed-update-current-folder force)
204 nil)
205 ;; Otherwise on to your regular programming
206 (t t)))
207
208(defun mh-speed-goto-folder (folder)
209 "Move point to line containing FOLDER.
210The function will expand out parent folders of FOLDER if needed."
211 (let ((prefix folder)
212 (suffix-list ())
213 (last-slash t))
214 (while (and (not (gethash prefix mh-speed-folder-map)) last-slash)
215 (setq last-slash (mh-search-from-end ?/ prefix))
216 (when (integerp last-slash)
217 (push (substring prefix (1+ last-slash)) suffix-list)
218 (setq prefix (substring prefix 0 last-slash))))
219 (let ((prefix-position (gethash prefix mh-speed-folder-map)))
220 (if prefix-position
221 (goto-char prefix-position)
222 (goto-char (point-min))
223 (mh-speed-toggle)
224 (unless (get-text-property (point) 'mh-expanded)
225 (mh-speed-toggle))
226 (goto-char (gethash prefix mh-speed-folder-map))))
227 (while suffix-list
228 ;; We always need atleast one toggle. We need two if the directory list
229 ;; is stale since a folder was added.
230 (when (equal prefix (get-text-property (line-beginning-position)
231 'mh-folder))
232 (mh-speed-toggle)
233 (unless (get-text-property (point) 'mh-expanded)
234 (mh-speed-toggle)))
235 (setq prefix (format "%s/%s" prefix (pop suffix-list)))
236 (goto-char (gethash prefix mh-speed-folder-map (point))))
237 (beginning-of-line)
238 (equal folder (get-text-property (point) 'mh-folder))))
239
240(defun mh-speed-extract-folder-name (buffer)
241 "Given an MH-E BUFFER find the folder that should be highlighted.
242Do the right thing for the different kinds of buffers that MH-E uses."
243 (save-excursion
244 (set-buffer buffer)
245 (cond ((eq major-mode 'mh-folder-mode)
246 mh-current-folder)
247 ((eq major-mode 'mh-show-mode)
248 (set-buffer mh-show-folder-buffer)
249 mh-current-folder)
250 ((eq major-mode 'mh-letter-mode)
251 (when (string-match mh-user-path buffer-file-name)
252 (let* ((rel-path (substring buffer-file-name (match-end 0)))
253 (directory-end (mh-search-from-end ?/ rel-path)))
254 (when directory-end
255 (format "+%s" (substring rel-path 0 directory-end)))))))))
256
257(defun mh-speed-add-buttons (folder level)
258 "Add speedbar button for FOLDER which is at indented by LEVEL amount."
259 (let ((folder-list (mh-speed-folders folder)))
260 (mapc
261 (lambda (f)
262 (let* ((folder-name (format "%s%s%s" (or folder "+")
263 (if folder "/" "") (car f)))
264 (counts (gethash folder-name mh-speed-flists-cache)))
265 (speedbar-with-writable
266 (speedbar-make-tag-line
267 'bracket (if (cdr f) ?+ ? )
268 'mh-speed-toggle nil
269 (format "%s%s"
270 (car f)
271 (if counts
272 (format " (%s/%s)" (car counts) (cdr counts))
273 ""))
274 'mh-speed-view nil
275 (if (and counts (> (car counts) 0))
276 'mh-speedbar-folder-with-unseen-messages-face
277 'mh-speedbar-folder-face)
278 level)
279 (save-excursion
280 (forward-line -1)
281 (setf (gethash folder-name mh-speed-folder-map)
282 (set-marker (make-marker) (1+ (line-beginning-position))))
283 (add-text-properties
284 (line-beginning-position) (1+ (line-beginning-position))
285 `(mh-folder ,folder-name
286 mh-expanded nil
287 mh-children-p ,(not (not (cdr f)))
288 ,@(if counts `(mh-count
289 (,(car counts) . ,(cdr counts))) ())
290 mh-level ,level))))))
291 folder-list)))
292
293;;;###mh-autoload
294(defun mh-speed-toggle (&rest args)
295 "Toggle the display of child folders.
296The otional ARGS are ignored and there for compatibilty with speedbar."
297 (interactive)
298 (declare (ignore args))
299 (beginning-of-line)
300 (let ((parent (get-text-property (point) 'mh-folder))
301 (kids-p (get-text-property (point) 'mh-children-p))
302 (expanded (get-text-property (point) 'mh-expanded))
303 (level (get-text-property (point) 'mh-level))
304 (point (point))
305 start-region)
306 (speedbar-with-writable
307 (cond ((not kids-p) nil)
308 (expanded
309 (forward-line)
310 (setq start-region (point))
311 (while (and (get-text-property (point) 'mh-level)
312 (> (get-text-property (point) 'mh-level) level))
313 (remhash (get-text-property (point) 'mh-folder)
314 mh-speed-folder-map)
315 (forward-line))
316 (delete-region start-region (point))
317 (forward-line -1)
318 (speedbar-change-expand-button-char ?+)
319 (add-text-properties
320 (line-beginning-position) (1+ (line-beginning-position))
321 '(mh-expanded nil)))
322 (t
323 (forward-line)
324 (mh-speed-add-buttons parent (1+ level))
325 (goto-char point)
326 (speedbar-change-expand-button-char ?-)
327 (add-text-properties
328 (line-beginning-position) (1+ (line-beginning-position))
329 `(mh-expanded t)))))))
330
331(defalias 'mh-speed-expand-folder 'mh-speed-toggle)
332(defalias 'mh-speed-contract-folder 'mh-speed-toggle)
333
334;;;###mh-autoload
335(defun mh-speed-view (&rest args)
336 "View folder on current line.
337Optional ARGS are ignored."
338 (interactive)
339 (declare (ignore args))
340 (let* ((folder (get-text-property (line-beginning-position) 'mh-folder))
341 (range (and (stringp folder) (mh-read-msg-range folder))))
342 (when (stringp folder)
343 (speedbar-with-attached-buffer
344 (mh-visit-folder folder range)
345 (delete-other-windows)))))
346
347(defun mh-speed-folders (folder)
348 "Find the subfolders of FOLDER.
349The function avoids running folders unnecessarily by caching the results of
350the actual folders call."
351 (let ((match (gethash folder mh-speed-folders-cache 'no-result)))
352 (cond ((eq match 'no-result)
353 (setf (gethash folder mh-speed-folders-cache)
354 (mh-speed-folders-actual folder)))
355 (t match))))
356
357(defun mh-speed-folders-actual (folder)
358 "Execute the command folders to return the sub-folders of FOLDER.
359Filters out the folder names that start with \".\" so that directories that
360aren't usually mail folders are hidden."
361 (let* ((folder (cond ((and (stringp folder)
362 (equal (substring folder 0 1) "+"))
363 folder)
364 (t nil)))
365 (arg-list `(,(expand-file-name "folders" mh-progs)
366 nil (t nil) nil "-noheader" "-norecurse"
367 ,@(if (stringp folder) (list folder) ())))
368 (results ()))
369 (with-temp-buffer
370 (apply #'call-process arg-list)
371 (goto-char (point-min))
372 (while (not (and (eolp) (bolp)))
373 (goto-char (line-end-position))
374 (let ((has-pos (search-backward " has " (line-beginning-position) t)))
375 (when (integerp has-pos)
376 (while (or (equal (char-after has-pos) ? )
377 (equal (char-after has-pos) ?+))
378 (decf has-pos))
379 (incf has-pos)
380 (let ((name (buffer-substring (line-beginning-position) has-pos)))
381 (let ((first-char (substring name 0 1)))
382 (unless (or (string-equal first-char ".")
383 (string-equal first-char "#")
384 (string-equal first-char ","))
385 (push
386 (cons name
387 (search-forward "(others)" (line-end-position) t))
388 results)))))
389 (forward-line 1))))
390 (setq results (nreverse results))
391 (when (stringp folder)
392 (setq results (cdr results))
393 (let ((folder-name-len (length (format "%s/" (substring folder 1)))))
394 (setq results (mapcar (lambda (f)
395 (cons (substring (car f) folder-name-len)
396 (cdr f)))
397 results))))
398 results))
399
400;;;###mh-autoload
401(defun mh-speed-flists (force)
402 "Execute flists -recurse and update message counts.
403If FORCE is non-nil the timer is reset."
404 (interactive (list t))
405 (when force
406 (when (timerp mh-speed-flists-timer)
407 (cancel-timer mh-speed-flists-timer))
408 (setq mh-speed-flists-timer nil)
409 (when (and (processp mh-speed-flists-process)
410 (not (eq (process-status mh-speed-flists-process) 'exit)))
411 (kill-process mh-speed-flists-process)
412 (setq mh-speed-flists-process nil)))
413 (unless mh-speed-flists-timer
414 (setq mh-speed-flists-timer
415 (run-at-time
416 nil mh-speed-flists-interval
417 (lambda ()
418 (unless (and (processp mh-speed-flists-process)
419 (not (eq (process-status mh-speed-flists-process)
420 'exit)))
421 (setq mh-speed-flists-process
422 (start-process (expand-file-name "flists" mh-progs) nil
423 "flists" "-recurse"
424 "-sequence" (symbol-name mh-unseen-seq)))
425 (set-process-filter mh-speed-flists-process
426 'mh-speed-parse-flists-output)))))))
427
428;; Copied from mh-make-folder-list-filter...
429(defun mh-speed-parse-flists-output (process output)
430 "Parse the incremental results from flists.
431PROCESS is the flists process and OUTPUT is the results that must be handled
432next."
433 (let ((prevailing-match-data (match-data))
434 (position 0)
435 line-end line folder unseen total)
436 (unwind-protect
437 (while (setq line-end (string-match "\n" output position))
438 (setq line (format "%s%s"
439 mh-speed-partial-line
440 (substring output position line-end))
441 mh-speed-partial-line "")
442 (multiple-value-setq (folder unseen total)
443 (mh-parse-flist-output-line line))
444 (when (and folder unseen total)
445 (setf (gethash folder mh-speed-flists-cache) (cons unseen total))
446 (save-excursion
447 (when (buffer-live-p (get-buffer speedbar-buffer))
448 (set-buffer speedbar-buffer)
449 (speedbar-with-writable
450 (when (get-text-property (point-min) 'mh-level)
451 (let ((pos (gethash folder mh-speed-folder-map))
452 face)
453 (when pos
454 (goto-char pos)
455 (goto-char (line-beginning-position))
456 (cond
457 ((null (get-text-property (point) 'mh-count))
458 (goto-char (line-end-position))
459 (setq face (get-text-property (1- (point)) 'face))
460 (insert (format " (%s/%s)" unseen total))
461 (mh-speed-highlight 'unknown face)
462 (goto-char (line-beginning-position))
463 (add-text-properties (point) (1+ (point))
464 `(mh-count (,unseen . ,total))))
465 ((not (equal (get-text-property (point) 'mh-count)
466 (cons unseen total)))
467 (goto-char (line-end-position))
468 (setq face (get-text-property (1- (point)) 'face))
469 (re-search-backward " " (line-beginning-position) t)
470 (delete-region (point) (line-end-position))
471 (insert (format " (%s/%s)" unseen total))
472 (mh-speed-highlight 'unknown face)
473 (goto-char (line-beginning-position))
474 (add-text-properties
475 (point) (1+ (point))
476 `(mh-count (,unseen . ,total))))))))))))
477 (setq position (1+ line-end)))
478 (set-match-data prevailing-match-data))
479 (setq mh-speed-partial-line (substring output position))))
480
481;;;###mh-autoload
482(defun mh-speed-invalidate-map (folder)
483 "Remove FOLDER from various optimization caches."
484 (interactive (list ""))
485 (save-excursion
486 (set-buffer speedbar-buffer)
487 (let* ((speedbar-update-flag nil)
488 (last-slash (mh-search-from-end ?/ folder))
489 (parent (if last-slash (substring folder 0 last-slash) nil))
490 (parent-position (gethash parent mh-speed-folder-map))
491 (parent-change nil))
492 (remhash parent mh-speed-folders-cache)
493 (remhash folder mh-speed-folders-cache)
494 (when parent-position
495 (let ((parent-kids (mh-speed-folders parent)))
496 (cond ((null parent-kids)
497 (setq parent-change ?+))
498 ((and (null (cdr parent-kids))
499 (equal (if last-slash
500 (substring folder (1+ last-slash))
501 (substring folder 1))
502 (caar parent-kids)))
503 (setq parent-change ? ))))
504 (goto-char parent-position)
505 (when (equal (get-text-property (line-beginning-position) 'mh-folder)
506 parent)
507 (when (get-text-property (line-beginning-position) 'mh-expanded)
508 (mh-speed-toggle))
509 (when parent-change
510 (speedbar-with-writable
511 (mh-speedbar-change-expand-button-char parent-change)
512 (add-text-properties
513 (line-beginning-position) (1+ (line-beginning-position))
514 `(mh-children-p ,(equal parent-change ?+)))))
515 (mh-speed-highlight mh-speed-last-selected-folder
516 'mh-speedbar-folder-face)
517 (setq mh-speed-last-selected-folder nil)
518 (setq mh-speed-refresh-flag t)))
519 (when (equal folder "")
520 (clrhash mh-speed-folders-cache)))))
521
522;;;###mh-autoload
523(defun mh-speed-add-folder (folder)
524 "Add FOLDER since it is being created.
525The function invalidates the latest ancestor that is present."
526 (save-excursion
527 (set-buffer speedbar-buffer)
528 (let ((speedbar-update-flag nil)
529 (last-slash (mh-search-from-end ?/ folder))
530 (ancestor folder)
531 (ancestor-pos nil))
532 (block while-loop
533 (while last-slash
534 (setq ancestor (substring ancestor 0 last-slash))
535 (setq ancestor-pos (gethash ancestor mh-speed-folder-map))
536 (when ancestor-pos
537 (return-from while-loop))
538 (setq last-slash (mh-search-from-end ?/ ancestor))))
539 (unless ancestor-pos (setq ancestor nil))
540 (goto-char (or ancestor-pos (gethash nil mh-speed-folder-map)))
541 (speedbar-with-writable
542 (mh-speedbar-change-expand-button-char ?+)
543 (add-text-properties
544 (line-beginning-position) (1+ (line-beginning-position))
545 `(mh-children-p t)))
546 (when (get-text-property (line-beginning-position) 'mh-expanded)
547 (mh-speed-toggle))
548 (remhash ancestor mh-speed-folders-cache)
549 (setq mh-speed-refresh-flag t))))
550
551;; Make it slightly more general to allow for [ ] buttons to be changed to
552;; [+].
553(defun mh-speedbar-change-expand-button-char (char)
554 "Change the expansion button character to CHAR for the current line."
555 (save-excursion
556 (beginning-of-line)
557 (if (re-search-forward "\\[.\\]" (line-end-position) t)
558 (speedbar-with-writable
559 (backward-char 2)
560 (delete-char 1)
561 (insert-char char 1 t)
562 (put-text-property (point) (1- (point)) 'invisible nil)
563 ;; make sure we fix the image on the text here.
564 (speedbar-insert-image-button-maybe (- (point) 2) 3)))))
565
566(provide 'mh-speed)
567
568;;; Local Variables:
569;;; indent-tabs-mode: nil
570;;; sentence-end-double-space: nil
571;;; End:
572
573;;; mh-speed.el ends here
diff --git a/lisp/mail/mh-utils.el b/lisp/mail/mh-utils.el
deleted file mode 100644
index 320cdf7cbfd..00000000000
--- a/lisp/mail/mh-utils.el
+++ /dev/null
@@ -1,1879 +0,0 @@
1;;; mh-utils.el --- MH-E code needed for both sending and reading
2
3;; Copyright (C) 1993, 1995, 1997, 2000, 2001, 2002 Free Software Foundation, Inc.
4
5;; Author: Bill Wohler <wohler@newt.com>
6;; Maintainer: Bill Wohler <wohler@newt.com>
7;; Keywords: mail
8;; See: mh-e.el
9
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
14;; the Free Software Foundation; either version 2, or (at your option)
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 the
24;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
25;; Boston, MA 02111-1307, USA.
26
27;;; Commentary:
28
29;; Internal support for MH-E package.
30
31;;; Change Log:
32
33;; $Id: mh-utils.el,v 1.193 2003/01/08 00:27:31 satyaki Exp $
34
35;;; Code:
36
37;; Is this XEmacs-land? Located here since needed by mh-customize.el.
38(defvar mh-xemacs-flag (featurep 'xemacs)
39 "Non-nil means the current Emacs is XEmacs.")
40
41(require 'cl)
42(require 'gnus-util)
43(require 'font-lock)
44(require 'mh-loaddefs)
45(require 'mh-customize)
46
47(load "mm-decode" t t) ; Non-fatal dependency
48(load "mm-view" t t) ; Non-fatal dependency
49(load "executable" t t) ; Non-fatal dependency on
50 ; executable-find
51
52;; Shush the byte-compiler
53(defvar font-lock-auto-fontify)
54(defvar font-lock-defaults)
55(defvar mark-active)
56(defvar tool-bar-mode)
57
58;;; Autoloads
59(autoload 'gnus-article-highlight-citation "gnus-cite")
60(autoload 'mail-header-end "sendmail")
61(autoload 'Info-goto-node "info")
62(unless (fboundp 'make-hash-table)
63 (autoload 'make-hash-table "cl"))
64
65;;; Set for local environment:
66;;; mh-progs and mh-lib used to be set in paths.el, which tried to
67;;; figure out at build time which of several possible directories MH
68;;; was installed into. But if you installed MH after building Emacs,
69;;; this would almost certainly be wrong, so now we do it at run time.
70
71(defvar mh-progs nil
72 "Directory containing MH commands, such as inc, repl, and rmm.")
73
74(defvar mh-lib nil
75 "Directory containing the MH library.
76This directory contains, among other things, the components file.")
77
78(defvar mh-lib-progs nil
79 "Directory containing MH helper programs.
80This directory contains, among other things, the mhl program.")
81
82(defvar mh-nmh-flag nil
83 "Non-nil means nmh is installed on this system instead of MH.")
84
85;;;###autoload
86(put 'mh-progs 'risky-local-variable t)
87;;;###autoload
88(put 'mh-lib 'risky-local-variable t)
89;;;###autoload
90(put 'mh-lib-progs 'risky-local-variable t)
91;;;###autoload
92(put 'mh-nmh-flag 'risky-local-variable t)
93
94;;; CL Replacements
95(defun mh-search-from-end (char string)
96 "Return the position of last occurrence of CHAR in STRING.
97If CHAR is not present in STRING then return nil. The function is used in lieu
98of `search' in the CL package."
99 (loop for index from (1- (length string)) downto 0
100 when (equal (aref string index) char) return index
101 finally return nil))
102
103;;; Macro to generate correct code for different emacs variants
104
105(defmacro mh-mark-active-p (check-transient-mark-mode-flag)
106 "A macro that expands into appropriate code in XEmacs and nil in GNU Emacs.
107In GNU Emacs if CHECK-TRANSIENT-MARK-MODE-FLAG is non-nil then check if
108variable `transient-mark-mode' is active."
109 (cond (mh-xemacs-flag ;XEmacs
110 `(and (boundp 'zmacs-regions) zmacs-regions (region-active-p)))
111 ((not check-transient-mark-mode-flag) ;GNU Emacs
112 `(and (boundp 'mark-active) mark-active))
113 (t ;GNU Emacs
114 `(and (boundp 'transient-mark-mode) transient-mark-mode
115 (boundp 'mark-active) mark-active))))
116
117;;; Additional header fields that might someday be added:
118;;; "Sender: " "Reply-to: "
119
120(defvar mh-scan-msg-number-regexp "^ *\\([0-9]+\\)"
121 "Regexp to find the number of a message in a scan line.
122The message's number must be surrounded with \\( \\)")
123
124(defvar mh-scan-msg-overflow-regexp "^\\?[0-9]"
125 "Regexp to find a scan line in which the message number overflowed.
126The message's number is left truncated in this case.")
127
128(defvar mh-scan-msg-format-regexp "%\\([0-9]*\\)(msg)"
129 "Regexp to find message number width in an scan format.
130The message number width must be surrounded with \\( \\).")
131
132(defvar mh-scan-msg-format-string "%d"
133 "Format string for width of the message number in a scan format.
134Use `0%d' for zero-filled message numbers.")
135
136(defvar mh-scan-msg-search-regexp "^[^0-9]*%d[^0-9]"
137 "Format string containing a regexp matching the scan listing for a message.
138The desired message's number will be an argument to format.")
139
140(defvar mh-default-folder-for-message-function nil
141 "Function to select a default folder for refiling or Fcc.
142If set to a function, that function is called with no arguments by
143`\\[mh-refile-msg]' and `\\[mh-to-fcc]' to get a default when
144prompting the user for a folder. The function is called from within a
145`save-excursion', with point at the start of the message. It should
146return the folder to offer as the refile or Fcc folder, as a string
147with a leading `+' sign. It can also return an empty string to use no
148default, or nil to calculate the default the usual way.
149NOTE: This variable is not an ordinary hook;
150It may not be a list of functions.")
151
152(defvar mh-show-buffer-mode-line-buffer-id "{show-%s} %d"
153 "Format string to produce `mode-line-buffer-identification' for show buffers.
154First argument is folder name. Second is message number.")
155
156(defvar mh-cmd-note 4
157 "Column to insert notation.
158Use `mh-set-cmd-note' to modify it.
159This value may be dynamically updated if `mh-adaptive-cmd-note-flag' is
160non-nil and `mh-scan-format-file' is t.
161Note that the first column is column number 0.")
162(make-variable-buffer-local 'mh-cmd-note)
163
164(defvar mh-note-seq "%"
165 "String whose first character is used to notate messages in a sequence.")
166
167(defvar mh-mail-header-separator "--------"
168 "*Line used by MH to separate headers from text in messages being composed.
169This variable should not be used directly in programs. Programs should use
170`mail-header-separator' instead. `mail-header-separator' is initialized to
171`mh-mail-header-separator' in `mh-letter-mode'; in other contexts, you may
172have to perform this initialization yourself.
173
174Do not make this a regexp as it may be the argument to `insert' and it is
175passed through `regexp-quote' before being used by functions like
176`re-search-forward'.")
177
178;; Variables for MIME display
179
180;; Structure to keep track of MIME handles on a per buffer basis.
181(defstruct (mh-buffer-data (:conc-name mh-mime-)
182 (:constructor mh-make-buffer-data))
183 (handles ()) ; List of MIME handles
184 (handles-cache (make-hash-table)) ; Cache to avoid multiple decodes of
185 ; nested messages
186 (parts-count 0) ; The button number is generated from
187 ; this number
188 (part-index-hash (make-hash-table))) ; Avoid incrementing the part number
189 ; for nested messages
190;;; This has to be a macro, since we do: (setf (mh-buffer-data) ...)
191(defmacro mh-buffer-data ()
192 "Convenience macro to get the MIME data structures of the current buffer."
193 `(gethash (current-buffer) mh-globals-hash))
194
195(defvar mh-globals-hash (make-hash-table)
196 "Keeps track of MIME data on a per buffer basis.")
197
198(defvar mh-gnus-pgp-support-flag (not (not (locate-library "mml2015")))
199 "Non-nil means installed Gnus has PGP support.")
200
201(defvar mh-mm-inline-media-tests
202 `(("image/jpeg"
203 mm-inline-image
204 (lambda (handle)
205 (mm-valid-and-fit-image-p 'jpeg handle)))
206 ("image/png"
207 mm-inline-image
208 (lambda (handle)
209 (mm-valid-and-fit-image-p 'png handle)))
210 ("image/gif"
211 mm-inline-image
212 (lambda (handle)
213 (mm-valid-and-fit-image-p 'gif handle)))
214 ("image/tiff"
215 mm-inline-image
216 (lambda (handle)
217 (mm-valid-and-fit-image-p 'tiff handle)) )
218 ("image/xbm"
219 mm-inline-image
220 (lambda (handle)
221 (mm-valid-and-fit-image-p 'xbm handle)))
222 ("image/x-xbitmap"
223 mm-inline-image
224 (lambda (handle)
225 (mm-valid-and-fit-image-p 'xbm handle)))
226 ("image/xpm"
227 mm-inline-image
228 (lambda (handle)
229 (mm-valid-and-fit-image-p 'xpm handle)))
230 ("image/x-pixmap"
231 mm-inline-image
232 (lambda (handle)
233 (mm-valid-and-fit-image-p 'xpm handle)))
234 ("image/bmp"
235 mm-inline-image
236 (lambda (handle)
237 (mm-valid-and-fit-image-p 'bmp handle)))
238 ("image/x-portable-bitmap"
239 mm-inline-image
240 (lambda (handle)
241 (mm-valid-and-fit-image-p 'pbm handle)))
242 ("text/plain" mm-inline-text identity)
243 ("text/enriched" mm-inline-text identity)
244 ("text/richtext" mm-inline-text identity)
245 ("text/x-patch" mm-display-patch-inline
246 (lambda (handle)
247 (locate-library "diff-mode")))
248 ("application/emacs-lisp" mm-display-elisp-inline identity)
249 ("application/x-emacs-lisp" mm-display-elisp-inline identity)
250 ("text/html"
251 ,(if (fboundp 'mm-inline-text-html) 'mm-inline-text-html 'mm-inline-text)
252 (lambda (handle)
253 (or (and (boundp 'mm-inline-text-html-renderer)
254 mm-inline-text-html-renderer)
255 (and (boundp 'mm-text-html-renderer) mm-text-html-renderer))))
256 ("text/x-vcard"
257 mm-inline-text-vcard
258 (lambda (handle)
259 (or (featurep 'vcard)
260 (locate-library "vcard"))))
261 ("message/delivery-status" mm-inline-text identity)
262 ("message/rfc822" mh-mm-inline-message identity)
263 ;;("message/partial" mm-inline-partial identity)
264 ;;("message/external-body" mm-inline-external-body identity)
265 ("text/.*" mm-inline-text identity)
266 ("audio/wav" mm-inline-audio
267 (lambda (handle)
268 (and (or (featurep 'nas-sound) (featurep 'native-sound))
269 (device-sound-enabled-p))))
270 ("audio/au"
271 mm-inline-audio
272 (lambda (handle)
273 (and (or (featurep 'nas-sound) (featurep 'native-sound))
274 (device-sound-enabled-p))))
275 ("application/pgp-signature" ignore identity)
276 ("application/x-pkcs7-signature" ignore identity)
277 ("application/pkcs7-signature" ignore identity)
278 ("application/x-pkcs7-mime" ignore identity)
279 ("application/pkcs7-mime" ignore identity)
280 ("multipart/alternative" ignore identity)
281 ("multipart/mixed" ignore identity)
282 ("multipart/related" ignore identity)
283 ;; Disable audio and image
284 ("audio/.*" ignore ignore)
285 ("image/.*" ignore ignore)
286 ;; Default to displaying as text
287 (".*" mm-inline-text mm-readable-p))
288 "Alist of media types/tests saying whether types can be displayed inline.")
289
290;; Needed by mh-comp.el and mh-mime.el
291(defvar mh-mhn-compose-insert-flag nil
292 "Non-nil means MIME insertion was done.
293Triggers an automatic call to `mh-edit-mhn' in `mh-send-letter'.
294This variable is buffer-local.")
295(make-variable-buffer-local 'mh-mhn-compose-insert-flag)
296
297(defvar mh-mml-compose-insert-flag nil
298 "Non-nil means that a MIME insertion was done.
299This buffer-local variable is used to remember if a MIME insertion was done.
300Triggers an automatic call to `mh-mml-to-mime' in `mh-send-letter'.")
301(make-variable-buffer-local 'mh-mml-compose-insert-flag)
302
303;; Copy of `goto-address-mail-regexp'
304(defvar mh-address-mail-regexp
305 "[-a-zA-Z0-9._]+@[-a-zA-z0-9_]+\\.+[a-zA-Z0-9]+"
306 "A regular expression probably matching an e-mail address.")
307
308;; From goto-addr.el, which we don't want to force-load on users.
309;;;###mh-autoload
310(defun mh-goto-address-find-address-at-point ()
311 "Find e-mail address around or before point.
312Then search backwards to beginning of line for the start of an e-mail
313address. If no e-mail address found, return nil."
314 (re-search-backward "[^-_A-z0-9.@]" (line-beginning-position) 'lim)
315 (if (or (looking-at mh-address-mail-regexp) ; already at start
316 (and (re-search-forward mh-address-mail-regexp
317 (line-end-position) 'lim)
318 (goto-char (match-beginning 0))))
319 (match-string-no-properties 0)))
320
321(defun mh-in-header-p ()
322 "Return non-nil if the point is in the header of a draft message."
323 (< (point) (mail-header-end)))
324
325(defun mh-header-field-beginning ()
326 "Move to the beginning of the current header field.
327Handles RFC 822 continuation lines."
328 (beginning-of-line)
329 (while (looking-at "^[ \t]")
330 (forward-line -1)))
331
332(defun mh-header-field-end ()
333 "Move to the end of the current header field.
334Handles RFC 822 continuation lines."
335 (forward-line 1)
336 (while (looking-at "^[ \t]")
337 (forward-line 1))
338 (backward-char 1)) ;to end of previous line
339
340(defun mh-letter-header-font-lock (limit)
341 "Return the entire mail header to font-lock.
342Argument LIMIT limits search."
343 (if (= (point) limit)
344 nil
345 (let* ((mail-header-end (save-match-data (mail-header-end)))
346 (lesser-limit (if (< mail-header-end limit) mail-header-end limit)))
347 (when (mh-in-header-p)
348 (set-match-data (list 1 lesser-limit))
349 (goto-char lesser-limit)
350 t))))
351
352(defun mh-header-field-font-lock (field limit)
353 "Return the value of a header field FIELD to font-lock.
354Argument LIMIT limits search."
355 (if (= (point) limit)
356 nil
357 (let* ((mail-header-end (mail-header-end))
358 (lesser-limit (if (< mail-header-end limit) mail-header-end limit))
359 (case-fold-search t))
360 (when (and (< (point) mail-header-end) ;Only within header
361 (re-search-forward (format "^%s" field) lesser-limit t))
362 (let ((match-one-b (match-beginning 0))
363 (match-one-e (match-end 0)))
364 (mh-header-field-end)
365 (if (> (point) limit) ;Don't search for end beyond limit
366 (goto-char limit))
367 (set-match-data (list match-one-b match-one-e
368 (1+ match-one-e) (point)))
369 t)))))
370
371(defun mh-header-to-font-lock (limit)
372 "Return the value of a header field To to font-lock.
373Argument LIMIT limits search."
374 (mh-header-field-font-lock "To:" limit))
375
376(defun mh-header-cc-font-lock (limit)
377 "Return the value of a header field cc to font-lock.
378Argument LIMIT limits search."
379 (mh-header-field-font-lock "cc:" limit))
380
381(defun mh-header-subject-font-lock (limit)
382 "Return the value of a header field Subject to font-lock.
383Argument LIMIT limits search."
384 (mh-header-field-font-lock "Subject:" limit))
385
386(eval-and-compile
387 ;; Otherwise byte-compilation fails on `mh-show-font-lock-keywords-with-cite'
388 (defvar mh-show-font-lock-keywords
389 '(("^\\(From:\\|Sender:\\)\\(.*\\)" (1 'default) (2 mh-show-from-face))
390 (mh-header-to-font-lock (0 'default) (1 mh-show-to-face))
391 (mh-header-cc-font-lock (0 'default) (1 mh-show-cc-face))
392 ("^\\(Reply-To:\\|Return-Path:\\)\\(.*\\)$"
393 (1 'default) (2 mh-show-from-face))
394 (mh-header-subject-font-lock (0 'default) (1 mh-show-subject-face))
395 ("^\\(Apparently-To:\\|Newsgroups:\\)\\(.*\\)"
396 (1 'default) (2 mh-show-cc-face))
397 ("^\\(In-reply-to\\|Date\\):\\(.*\\)$"
398 (1 'default) (2 mh-show-date-face))
399 (mh-letter-header-font-lock (0 mh-show-header-face append t)))
400 "Additional expressions to highlight in MH-show mode."))
401
402(defvar mh-show-font-lock-keywords-with-cite
403 (eval-when-compile
404 (let* ((cite-chars "[>|}]")
405 (cite-prefix "A-Za-z")
406 (cite-suffix (concat cite-prefix "0-9_.@-`'\"")))
407 (append
408 mh-show-font-lock-keywords
409 (list
410 ;; Use MATCH-ANCHORED to effectively anchor the regexp left side.
411 `(,cite-chars
412 (,(concat "\\=[ \t]*"
413 "\\(\\([" cite-prefix "]+[" cite-suffix "]*\\)?"
414 "\\(" cite-chars "[ \t]*\\)\\)+"
415 "\\(.*\\)")
416 (beginning-of-line) (end-of-line)
417 (2 font-lock-constant-face nil t)
418 (4 font-lock-comment-face nil t)))))))
419 "Additional expressions to highlight in MH-show mode.")
420
421(defun mh-show-font-lock-fontify-region (beg end loudly)
422 "Limit font-lock in `mh-show-mode' to the header.
423Used when `mh-highlight-citation-p' is set to gnus, leaving the body to be
424dealt with by gnus highlighting. The region between BEG and END is
425given over to be fontified and LOUDLY controls if a user sees a
426message about the fontification operation."
427 (let ((header-end (mail-header-end)))
428 (cond
429 ((and (< beg header-end)(< end header-end))
430 (font-lock-default-fontify-region beg end loudly))
431 ((and (< beg header-end)(>= end header-end))
432 (font-lock-default-fontify-region beg header-end loudly))
433 (t
434 nil))))
435
436;; Needed to help shush the byte-compiler.
437(if mh-xemacs-flag
438 (progn
439 (eval-and-compile
440 (require 'gnus)
441 (require 'gnus-art)
442 (require 'gnus-cite))))
443
444(defun mh-gnus-article-highlight-citation ()
445 "Highlight cited text in current buffer using gnus."
446 (interactive)
447 ;; Requiring gnus-cite should have been sufficient. However for Emacs21.1,
448 ;; recursive-load-depth-limit is only 10, so an error occurs. Also it may be
449 ;; better to have an autoload at top-level (though that won't work because
450 ;; of recursive-load-depth-limit). That gets rid of a compiler warning as
451 ;; well.
452 (unless mh-xemacs-flag
453 (require 'gnus-art)
454 (require 'gnus-cite))
455 ;; Don't allow Gnus to create buttons while highlighting, maybe this is bad
456 ;; style?
457 (flet ((gnus-article-add-button (&rest args) nil))
458 (let* ((modified (buffer-modified-p))
459 (gnus-article-buffer (buffer-name))
460 (gnus-cite-face-list `(,@(cdr gnus-cite-face-list)
461 ,(car gnus-cite-face-list))))
462 (gnus-article-highlight-citation t)
463 (set-buffer-modified-p modified))))
464
465;;; Internal bookkeeping variables:
466
467;; The value of `mh-folder-list-change-hook' is called whenever
468;; mh-folder-list variable is set.
469;; List of folder names for completion.
470(defvar mh-folder-list nil)
471
472;; Cached value of the `Path:' component in the user's MH profile.
473;; User's mail folder directory.
474(defvar mh-user-path nil)
475
476;; An mh-draft-folder of nil means do not use a draft folder.
477;; Cached value of the `Draft-Folder:' component in the user's MH profile.
478;; Name of folder containing draft messages.
479(defvar mh-draft-folder nil)
480
481;; Cached value of the `Unseen-Sequence:' component in the user's MH profile.
482;; Name of the Unseen sequence.
483(defvar mh-unseen-seq nil)
484
485;; Cached value of the `Previous-Sequence:' component in the user's MH
486;; profile.
487;; Name of the Previous sequence.
488(defvar mh-previous-seq nil)
489
490;; Cached value of the `Inbox:' component in the user's MH profile,
491;; or "+inbox" if no such component.
492;; Name of the Inbox folder.
493(defvar mh-inbox nil)
494
495;; Name of MH-E scratch buffer.
496(defconst mh-temp-buffer " *mh-temp*")
497
498;; Name of the MH-E folder list buffer.
499(defconst mh-temp-folders-buffer "*Folders*")
500
501;; Name of the MH-E sequences list buffer.
502(defconst mh-temp-sequences-buffer "*Sequences*")
503
504;; Window configuration before MH-E command.
505(defvar mh-previous-window-config nil)
506
507;;Non-nil means next SPC or whatever goes to next undeleted message.
508(defvar mh-page-to-next-msg-flag nil)
509
510;;; Internal variables local to a folder.
511
512;; Name of current folder, a string.
513(defvar mh-current-folder nil)
514
515;; Buffer that displays message for this folder.
516(defvar mh-show-buffer nil)
517
518;; Full path of directory for this folder.
519(defvar mh-folder-filename nil)
520
521;;Number of msgs in buffer.
522(defvar mh-msg-count nil)
523
524;; If non-nil, show the message in a separate window.
525(defvar mh-showing-mode nil)
526
527(defvar mh-show-mode-map (make-sparse-keymap)
528 "Keymap used by the show buffer.")
529
530(defvar mh-show-folder-buffer nil
531 "Keeps track of folder whose message is being displayed.")
532
533;;; This holds a documentation string used by describe-mode.
534(defun mh-showing-mode (&optional arg)
535 "Change whether messages should be displayed.
536With arg, display messages iff ARG is positive."
537 (setq mh-showing-mode
538 (if (null arg)
539 (not mh-showing-mode)
540 (> (prefix-numeric-value arg) 0))))
541
542;; The sequences of this folder. An alist of (seq . msgs).
543(defvar mh-seq-list nil)
544
545;; List of displayed messages to be removed from the Unseen sequence.
546(defvar mh-seen-list nil)
547
548;; If non-nil, show buffer contains message with all headers.
549;; If nil, show buffer contains message processed normally.
550;; Showing message with headers or normally.
551(defvar mh-showing-with-headers nil)
552
553
554;;; MH-E macros
555
556(defmacro with-mh-folder-updating (save-modification-flag &rest body)
557 "Format is (with-mh-folder-updating (SAVE-MODIFICATION-FLAG) &body BODY).
558Execute BODY, which can modify the folder buffer without having to
559worry about file locking or the read-only flag, and return its result.
560If SAVE-MODIFICATION-FLAG is non-nil, the buffer's modification
561flag is unchanged, otherwise it is cleared."
562 (setq save-modification-flag (car save-modification-flag)) ; CL style
563 `(prog1
564 (let ((mh-folder-updating-mod-flag (buffer-modified-p))
565 (buffer-read-only nil)
566 (buffer-file-name nil)) ;don't let the buffer get locked
567 (prog1
568 (progn
569 ,@body)
570 (mh-set-folder-modified-p mh-folder-updating-mod-flag)))
571 ,@(if (not save-modification-flag)
572 '((mh-set-folder-modified-p nil)))))
573
574(put 'with-mh-folder-updating 'lisp-indent-hook 1)
575
576(defmacro mh-in-show-buffer (show-buffer &rest body)
577 "Format is (mh-in-show-buffer (SHOW-BUFFER) &body BODY).
578Display buffer SHOW-BUFFER in other window and execute BODY in it.
579Stronger than `save-excursion', weaker than `save-window-excursion'."
580 (setq show-buffer (car show-buffer)) ; CL style
581 `(let ((mh-in-show-buffer-saved-window (selected-window)))
582 (switch-to-buffer-other-window ,show-buffer)
583 (if mh-bury-show-buffer-flag (bury-buffer (current-buffer)))
584 (unwind-protect
585 (progn
586 ,@body)
587 (select-window mh-in-show-buffer-saved-window))))
588
589(put 'mh-in-show-buffer 'lisp-indent-hook 1)
590
591(defmacro mh-make-seq (name msgs)
592 "Create sequence NAME with the given MSGS."
593 (list 'cons name msgs))
594
595(defmacro mh-seq-name (sequence)
596 "Extract sequence name from the given SEQUENCE."
597 (list 'car sequence))
598
599(defmacro mh-seq-msgs (sequence)
600 "Extract messages from the given SEQUENCE."
601 (list 'cdr sequence))
602
603(defun mh-recenter (arg)
604 "Like recenter but with three improvements:
605- At the end of the buffer it tries to show fewer empty lines.
606- operates only if the current buffer is in the selected window.
607 (Commands like `save-some-buffers' can make this false.)
608- nil ARG means recenter as if prefix argument had been given."
609 (cond ((not (eq (get-buffer-window (current-buffer)) (selected-window)))
610 nil)
611 ((= (point-max) (save-excursion
612 (forward-line (- (/ (window-height) 2) 2))
613 (point)))
614 (let ((lines-from-end 2))
615 (save-excursion
616 (while (> (point-max) (progn (forward-line) (point)))
617 (incf lines-from-end)))
618 (recenter (- lines-from-end))))
619 ;; '(4) is the same as C-u prefix argument.
620 (t (recenter (or arg '(4))))))
621
622(defun mh-start-of-uncleaned-message ()
623 "Position uninteresting headers off the top of the window."
624 (let ((case-fold-search t))
625 (re-search-forward
626 "^To:\\|^Cc:\\|^From:\\|^Subject:\\|^Date:" nil t)
627 (beginning-of-line)
628 (mh-recenter 0)))
629
630(defun mh-invalidate-show-buffer ()
631 "Invalidate the show buffer so we must update it to use it."
632 (if (get-buffer mh-show-buffer)
633 (save-excursion
634 (set-buffer mh-show-buffer)
635 (mh-unvisit-file))))
636
637(defun mh-unvisit-file ()
638 "Separate current buffer from the message file it was visiting."
639 (or (not (buffer-modified-p))
640 (null buffer-file-name) ;we've been here before
641 (yes-or-no-p (format "Message %s modified; flush changes? "
642 (file-name-nondirectory buffer-file-name)))
643 (error "Flushing changes not confirmed"))
644 (clear-visited-file-modtime)
645 (unlock-buffer)
646 (setq buffer-file-name nil))
647
648;;;###mh-autoload
649(defun mh-get-msg-num (error-if-no-message)
650 "Return the message number of the displayed message.
651If the argument ERROR-IF-NO-MESSAGE is non-nil, then complain if the cursor is
652not pointing to a message."
653 (save-excursion
654 (beginning-of-line)
655 (cond ((looking-at mh-scan-msg-number-regexp)
656 (string-to-int (buffer-substring (match-beginning 1)
657 (match-end 1))))
658 (error-if-no-message
659 (error "Cursor not pointing to message"))
660 (t nil))))
661
662(defun mh-folder-name-p (name)
663 "Return non-nil if NAME is the name of a folder.
664A name (a string or symbol) can be a folder name if it begins with \"+\"."
665 (if (symbolp name)
666 (eq (aref (symbol-name name) 0) ?+)
667 (and (> (length name) 0)
668 (eq (aref name 0) ?+))))
669
670
671(defun mh-expand-file-name (filename &optional default)
672 "Expand FILENAME like `expand-file-name', but also handle MH folder names.
673Any filename that starts with '+' is treated as a folder name.
674See `expand-file-name' for description of DEFAULT."
675 (if (mh-folder-name-p filename)
676 (expand-file-name (substring filename 1) mh-user-path)
677 (expand-file-name filename default)))
678
679
680(defun mh-msg-filename (msg &optional folder)
681 "Return the file name of MSG in FOLDER (default current folder)."
682 (expand-file-name (int-to-string msg)
683 (if folder
684 (mh-expand-file-name folder)
685 mh-folder-filename)))
686
687;;; Infrastructure to generate show-buffer functions from folder functions
688;;; XEmacs does not have deactivate-mark? What is the equivalent of
689;;; transient-mark-mode for XEmacs? Should we be restoring the mark in the
690;;; folder buffer after the operation has been carried out.
691(defmacro mh-defun-show-buffer (function original-function
692 &optional dont-return)
693 "Define FUNCTION to run ORIGINAL-FUNCTION in folder buffer.
694If the buffer we start in is still visible and DONT-RETURN is nil then switch
695to it after that."
696 `(defun ,function ()
697 ,(format "Calls %s from the message's folder.\n%s\nSee `%s' for more info.\n"
698 original-function
699 (if dont-return ""
700 "When function completes, returns to the show buffer if it is
701still visible.\n")
702 original-function)
703 (interactive)
704 (when (buffer-live-p (get-buffer mh-show-folder-buffer))
705 (let ((config (current-window-configuration))
706 (folder-buffer mh-show-folder-buffer)
707 (normal-exit nil)
708 ,@(if dont-return () '((cur-buffer-name (buffer-name)))))
709 (pop-to-buffer mh-show-folder-buffer nil)
710 (unless (equal (buffer-name
711 (window-buffer (frame-first-window (selected-frame))))
712 folder-buffer)
713 (delete-other-windows))
714 (mh-goto-cur-msg t)
715 (and (fboundp 'deactivate-mark) (deactivate-mark))
716 (unwind-protect
717 (prog1 (call-interactively (function ,original-function))
718 (setq normal-exit t))
719 (and (fboundp 'deactivate-mark) (deactivate-mark))
720 (cond ((not normal-exit)
721 (set-window-configuration config))
722 ,(if dont-return
723 `(t (setq mh-previous-window-config config))
724 `((and (get-buffer cur-buffer-name)
725 (window-live-p (get-buffer-window
726 (get-buffer cur-buffer-name))))
727 (pop-to-buffer (get-buffer cur-buffer-name) nil)))))))))
728
729;;; Generate interactive functions for the show buffer from the corresponding
730;;; folder functions.
731(mh-defun-show-buffer mh-show-previous-undeleted-msg
732 mh-previous-undeleted-msg)
733(mh-defun-show-buffer mh-show-next-undeleted-msg
734 mh-next-undeleted-msg)
735(mh-defun-show-buffer mh-show-quit mh-quit)
736(mh-defun-show-buffer mh-show-delete-msg mh-delete-msg)
737(mh-defun-show-buffer mh-show-refile-msg mh-refile-msg)
738(mh-defun-show-buffer mh-show-undo mh-undo)
739(mh-defun-show-buffer mh-show-execute-commands mh-execute-commands)
740(mh-defun-show-buffer mh-show-reply mh-reply t)
741(mh-defun-show-buffer mh-show-redistribute mh-redistribute)
742(mh-defun-show-buffer mh-show-forward mh-forward t)
743(mh-defun-show-buffer mh-show-header-display mh-header-display)
744(mh-defun-show-buffer mh-show-refile-or-write-again
745 mh-refile-or-write-again)
746(mh-defun-show-buffer mh-show-show mh-show)
747(mh-defun-show-buffer mh-show-write-message-to-file
748 mh-write-msg-to-file)
749(mh-defun-show-buffer mh-show-extract-rejected-mail
750 mh-extract-rejected-mail t)
751(mh-defun-show-buffer mh-show-delete-msg-no-motion
752 mh-delete-msg-no-motion)
753(mh-defun-show-buffer mh-show-first-msg mh-first-msg)
754(mh-defun-show-buffer mh-show-last-msg mh-last-msg)
755(mh-defun-show-buffer mh-show-copy-msg mh-copy-msg)
756(mh-defun-show-buffer mh-show-edit-again mh-edit-again t)
757(mh-defun-show-buffer mh-show-goto-msg mh-goto-msg)
758(mh-defun-show-buffer mh-show-inc-folder mh-inc-folder)
759(mh-defun-show-buffer mh-show-delete-subject-or-thread
760 mh-delete-subject-or-thread)
761(mh-defun-show-buffer mh-show-delete-subject mh-delete-subject)
762(mh-defun-show-buffer mh-show-print-msg mh-print-msg)
763(mh-defun-show-buffer mh-show-send mh-send t)
764(mh-defun-show-buffer mh-show-toggle-showing mh-toggle-showing t)
765(mh-defun-show-buffer mh-show-pipe-msg mh-pipe-msg t)
766(mh-defun-show-buffer mh-show-sort-folder mh-sort-folder)
767(mh-defun-show-buffer mh-show-visit-folder mh-visit-folder t)
768(mh-defun-show-buffer mh-show-rescan-folder mh-rescan-folder)
769(mh-defun-show-buffer mh-show-pack-folder mh-pack-folder)
770(mh-defun-show-buffer mh-show-kill-folder mh-kill-folder t)
771(mh-defun-show-buffer mh-show-list-folders mh-list-folders t)
772(mh-defun-show-buffer mh-show-search-folder mh-search-folder t)
773(mh-defun-show-buffer mh-show-undo-folder mh-undo-folder)
774(mh-defun-show-buffer mh-show-delete-msg-from-seq
775 mh-delete-msg-from-seq)
776(mh-defun-show-buffer mh-show-delete-seq mh-delete-seq)
777(mh-defun-show-buffer mh-show-list-sequences mh-list-sequences)
778(mh-defun-show-buffer mh-show-narrow-to-seq mh-narrow-to-seq)
779(mh-defun-show-buffer mh-show-put-msg-in-seq mh-put-msg-in-seq)
780(mh-defun-show-buffer mh-show-msg-is-in-seq mh-msg-is-in-seq)
781(mh-defun-show-buffer mh-show-widen mh-widen)
782(mh-defun-show-buffer mh-show-narrow-to-subject
783 mh-narrow-to-subject)
784(mh-defun-show-buffer mh-show-store-msg mh-store-msg)
785(mh-defun-show-buffer mh-show-page-digest mh-page-digest)
786(mh-defun-show-buffer mh-show-page-digest-backwards
787 mh-page-digest-backwards)
788(mh-defun-show-buffer mh-show-burst-digest mh-burst-digest)
789(mh-defun-show-buffer mh-show-page-msg mh-page-msg)
790(mh-defun-show-buffer mh-show-previous-page mh-previous-page)
791(mh-defun-show-buffer mh-show-modify mh-modify t)
792(mh-defun-show-buffer mh-show-next-button mh-next-button)
793(mh-defun-show-buffer mh-show-prev-button mh-prev-button)
794(mh-defun-show-buffer mh-show-toggle-mime-part mh-folder-toggle-mime-part)
795(mh-defun-show-buffer mh-show-save-mime-part mh-folder-save-mime-part)
796(mh-defun-show-buffer mh-show-inline-mime-part mh-folder-inline-mime-part)
797(mh-defun-show-buffer mh-show-toggle-threads mh-toggle-threads)
798(mh-defun-show-buffer mh-show-thread-delete mh-thread-delete)
799(mh-defun-show-buffer mh-show-thread-refile mh-thread-refile)
800(mh-defun-show-buffer mh-show-update-sequences mh-update-sequences)
801(mh-defun-show-buffer mh-show-next-unread-msg mh-next-unread-msg)
802(mh-defun-show-buffer mh-show-previous-unread-msg mh-previous-unread-msg)
803(mh-defun-show-buffer mh-show-thread-ancestor mh-thread-ancestor)
804(mh-defun-show-buffer mh-show-thread-next-sibling mh-thread-next-sibling)
805(mh-defun-show-buffer mh-show-thread-previous-sibling
806 mh-thread-previous-sibling)
807(mh-defun-show-buffer mh-show-index-visit-folder mh-index-visit-folder t)
808
809;;; Populate mh-show-mode-map
810(gnus-define-keys mh-show-mode-map
811 " " mh-show-page-msg
812 "!" mh-show-refile-or-write-again
813 "," mh-show-header-display
814 "." mh-show-show
815 ">" mh-show-write-message-to-file
816 "?" mh-help
817 "E" mh-show-extract-rejected-mail
818 "M" mh-show-modify
819 "\177" mh-show-previous-page
820 "\C-d" mh-show-delete-msg-no-motion
821 "\t" mh-show-next-button
822 [backtab] mh-show-prev-button
823 "\M-\t" mh-show-prev-button
824 "\ed" mh-show-redistribute
825 "^" mh-show-refile-msg
826 "c" mh-show-copy-msg
827 "d" mh-show-delete-msg
828 "e" mh-show-edit-again
829 "f" mh-show-forward
830 "g" mh-show-goto-msg
831 "i" mh-show-inc-folder
832 "k" mh-show-delete-subject-or-thread
833 "l" mh-show-print-msg
834 "m" mh-show-send
835 "n" mh-show-next-undeleted-msg
836 "\M-n" mh-show-next-unread-msg
837 "o" mh-show-refile-msg
838 "p" mh-show-previous-undeleted-msg
839 "\M-p" mh-show-previous-unread-msg
840 "q" mh-show-quit
841 "r" mh-show-reply
842 "s" mh-show-send
843 "t" mh-show-toggle-showing
844 "u" mh-show-undo
845 "x" mh-show-execute-commands
846 "v" mh-show-index-visit-folder
847 "|" mh-show-pipe-msg)
848
849(gnus-define-keys (mh-show-folder-map "F" mh-show-mode-map)
850 "?" mh-prefix-help
851 "S" mh-show-sort-folder
852 "f" mh-show-visit-folder
853 "i" mh-index-search
854 "k" mh-show-kill-folder
855 "l" mh-show-list-folders
856 "o" mh-show-visit-folder
857 "r" mh-show-rescan-folder
858 "s" mh-show-search-folder
859 "t" mh-show-toggle-threads
860 "u" mh-show-undo-folder
861 "v" mh-show-visit-folder)
862
863(gnus-define-keys (mh-show-sequence-map "S" mh-show-mode-map)
864 "?" mh-prefix-help
865 "d" mh-show-delete-msg-from-seq
866 "k" mh-show-delete-seq
867 "l" mh-show-list-sequences
868 "n" mh-show-narrow-to-seq
869 "p" mh-show-put-msg-in-seq
870 "s" mh-show-msg-is-in-seq
871 "w" mh-show-widen)
872
873(gnus-define-keys (mh-show-thread-map "T" mh-show-mode-map)
874 "?" mh-prefix-help
875 "u" mh-show-thread-ancestor
876 "p" mh-show-thread-previous-sibling
877 "n" mh-show-thread-next-sibling
878 "t" mh-show-toggle-threads
879 "d" mh-show-thread-delete
880 "o" mh-show-thread-refile)
881
882(gnus-define-keys (mh-show-limit-map "/" mh-show-mode-map)
883 "?" mh-prefix-help
884 "s" mh-show-narrow-to-subject
885 "w" mh-show-widen)
886
887(gnus-define-keys (mh-show-extract-map "X" mh-show-mode-map)
888 "?" mh-prefix-help
889 "s" mh-show-store-msg
890 "u" mh-show-store-msg)
891
892;; Untested...
893(gnus-define-keys (mh-show-digest-map "D" mh-show-mode-map)
894 "?" mh-prefix-help
895 " " mh-show-page-digest
896 "\177" mh-show-page-digest-backwards
897 "b" mh-show-burst-digest)
898
899(gnus-define-keys (mh-show-mime-map "K" mh-show-mode-map)
900 "?" mh-prefix-help
901 "a" mh-mime-save-parts
902 "v" mh-show-toggle-mime-part
903 "o" mh-show-save-mime-part
904 "i" mh-show-inline-mime-part
905 "\t" mh-show-next-button
906 [backtab] mh-show-prev-button
907 "\M-\t" mh-show-prev-button)
908
909(easy-menu-define
910 mh-show-sequence-menu mh-show-mode-map "Menu for MH-E folder-sequence."
911 '("Sequence"
912 ["Add Message to Sequence..." mh-show-put-msg-in-seq t]
913 ["List Sequences for Message" mh-show-msg-is-in-seq t]
914 ["Delete Message from Sequence..." mh-show-delete-msg-from-seq t]
915 ["List Sequences in Folder..." mh-show-list-sequences t]
916 ["Delete Sequence..." mh-show-delete-seq t]
917 ["Narrow to Sequence..." mh-show-narrow-to-seq t]
918 ["Widen from Sequence" mh-show-widen t]
919 "--"
920 ["Narrow to Subject Sequence" mh-show-narrow-to-subject t]
921 ["Delete Rest of Same Subject" mh-show-delete-subject t]
922 "--"
923 ["Push State Out to MH" mh-show-update-sequences t]))
924
925(easy-menu-define
926 mh-show-message-menu mh-show-mode-map "Menu for MH-E folder-message."
927 '("Message"
928 ["Show Message" mh-show-show t]
929 ["Show Message with Header" mh-show-header-display t]
930 ["Next Message" mh-show-next-undeleted-msg t]
931 ["Previous Message" mh-show-previous-undeleted-msg t]
932 ["Go to First Message" mh-show-first-msg t]
933 ["Go to Last Message" mh-show-last-msg t]
934 ["Go to Message by Number..." mh-show-goto-msg t]
935 ["Modify Message" mh-show-modify t]
936 ["Delete Message" mh-show-delete-msg t]
937 ["Refile Message" mh-show-refile-msg t]
938 ["Undo Delete/Refile" mh-show-undo t]
939 ["Process Delete/Refile" mh-show-execute-commands t]
940 "--"
941 ["Compose a New Message" mh-send t]
942 ["Reply to Message..." mh-show-reply t]
943 ["Forward Message..." mh-show-forward t]
944 ["Redistribute Message..." mh-show-redistribute t]
945 ["Edit Message Again" mh-show-edit-again t]
946 ["Re-edit a Bounced Message" mh-show-extract-rejected-mail t]
947 "--"
948 ["Copy Message to Folder..." mh-show-copy-msg t]
949 ["Print Message" mh-show-print-msg t]
950 ["Write Message to File..." mh-show-write-msg-to-file t]
951 ["Pipe Message to Command..." mh-show-pipe-msg t]
952 ["Unpack Uuencoded Message..." mh-show-store-msg t]
953 ["Burst Digest Message" mh-show-burst-digest t]))
954
955(easy-menu-define
956 mh-show-folder-menu mh-show-mode-map "Menu for MH-E folder."
957 '("Folder"
958 ["Incorporate New Mail" mh-show-inc-folder t]
959 ["Toggle Show/Folder" mh-show-toggle-showing t]
960 ["Execute Delete/Refile" mh-show-execute-commands t]
961 ["Rescan Folder" mh-show-rescan-folder t]
962 ["Thread Folder" mh-show-toggle-threads t]
963 ["Pack Folder" mh-show-pack-folder t]
964 ["Sort Folder" mh-show-sort-folder t]
965 "--"
966 ["List Folders" mh-show-list-folders t]
967 ["Visit a Folder..." mh-show-visit-folder t]
968 ["Search a Folder..." mh-show-search-folder t]
969 ["Indexed Search..." mh-index-search t]
970 "--"
971 ["Quit MH-E" mh-quit t]))
972
973
974;;; Ensure new buffers won't get this mode if default-major-mode is nil.
975(put 'mh-show-mode 'mode-class 'special)
976
977(define-derived-mode mh-show-mode text-mode "MH-Show"
978 "Major mode for showing messages in MH-E.\\<mh-show-mode-map>
979The value of `mh-show-mode-hook' is a list of functions to
980be called, with no arguments, upon entry to this mode."
981 (set (make-local-variable 'mail-header-separator) mh-mail-header-separator)
982 (setq paragraph-start (default-value 'paragraph-start))
983 (mh-show-unquote-From)
984 (mh-show-xface)
985 (mh-show-addr)
986 (make-local-variable 'font-lock-defaults)
987 ;;(set (make-local-variable 'font-lock-support-mode) nil)
988 (cond
989 ((equal mh-highlight-citation-p 'font-lock)
990 (setq font-lock-defaults '(mh-show-font-lock-keywords-with-cite t)))
991 ((equal mh-highlight-citation-p 'gnus)
992 (setq font-lock-defaults '((mh-show-font-lock-keywords)
993 t nil nil nil
994 (font-lock-fontify-region-function
995 . mh-show-font-lock-fontify-region)))
996 (mh-gnus-article-highlight-citation))
997 (t
998 (setq font-lock-defaults '(mh-show-font-lock-keywords t))))
999 (if (and mh-xemacs-flag
1000 font-lock-auto-fontify)
1001 (turn-on-font-lock))
1002 (if (and (boundp 'tool-bar-mode) tool-bar-mode)
1003 (set (make-local-variable 'tool-bar-map) mh-show-tool-bar-map))
1004 (when mh-decode-mime-flag
1005 (add-hook 'kill-buffer-hook 'mh-mime-cleanup nil t))
1006 (easy-menu-add mh-show-sequence-menu)
1007 (easy-menu-add mh-show-message-menu)
1008 (easy-menu-add mh-show-folder-menu)
1009 (make-local-variable 'mh-show-folder-buffer)
1010 (buffer-disable-undo)
1011 (setq buffer-read-only t)
1012 (use-local-map mh-show-mode-map)
1013 (run-hooks 'mh-show-mode-hook))
1014
1015(defun mh-show-addr ()
1016 "Use `goto-address'."
1017 (when mh-show-use-goto-addr-flag
1018 (if (not (featurep 'goto-addr))
1019 (load "goto-addr" t t))
1020 (if (fboundp 'goto-address)
1021 (goto-address))))
1022
1023(defvar mh-show-xface-function
1024 (cond ((and mh-xemacs-flag (locate-library "x-face"))
1025 (load "x-face" t t)
1026 (if (fboundp 'x-face-xmas-wl-display-x-face)
1027 #'x-face-xmas-wl-display-x-face
1028 #'ignore))
1029 ((and (not mh-xemacs-flag) (>= emacs-major-version 21))
1030 (load "x-face-e21" t t)
1031 (if (fboundp 'x-face-decode-message-header)
1032 #'x-face-decode-message-header
1033 #'ignore))
1034 (t #'ignore))
1035 "Determine at run time what function should be called to display X-Face.")
1036
1037(defun mh-show-xface ()
1038 "Display X-Face."
1039 (when (and mh-show-use-xface-flag
1040 (or mh-decode-mime-flag mhl-formfile
1041 mh-clean-message-header-flag))
1042 (funcall mh-show-xface-function)))
1043
1044(defun mh-maybe-show (&optional msg)
1045 "Display message at cursor, but only if in show mode.
1046If optional arg MSG is non-nil, display that message instead."
1047 (if mh-showing-mode (mh-show msg)))
1048
1049(defun mh-show (&optional message)
1050 "Show message at cursor.
1051If optional argument MESSAGE is non-nil, display that message instead.
1052Force a two-window display with the folder window on top (size
1053`mh-summary-height') and the show buffer below it.
1054If the message is already visible, display the start of the message.
1055
1056Display of the message is controlled by setting the variables
1057`mh-clean-message-header-flag' and `mhl-formfile'. The default behavior is
1058to scroll uninteresting headers off the top of the window.
1059Type \"\\[mh-header-display]\" to see the message with all its headers."
1060 (interactive)
1061 (and mh-showing-with-headers
1062 (or mhl-formfile mh-clean-message-header-flag)
1063 (mh-invalidate-show-buffer))
1064 (mh-show-msg message))
1065
1066(defun mh-show-mouse (EVENT)
1067 "Move point to mouse EVENT and show message."
1068 (interactive "e")
1069 (mouse-set-point EVENT)
1070 (mh-show))
1071
1072(defun mh-show-msg (msg)
1073 "Show MSG.
1074The value of `mh-show-hook' is a list of functions to be called, with no
1075arguments, after the message has been displayed."
1076 (if (not msg)
1077 (setq msg (mh-get-msg-num t)))
1078 (mh-showing-mode t)
1079 (setq mh-page-to-next-msg-flag nil)
1080 (let ((folder mh-current-folder)
1081 (clean-message-header mh-clean-message-header-flag)
1082 (show-window (get-buffer-window mh-show-buffer)))
1083 (if (not (eq (next-window (minibuffer-window)) (selected-window)))
1084 (delete-other-windows)) ; force ourself to the top window
1085 (mh-in-show-buffer (mh-show-buffer)
1086 (if (and show-window
1087 (equal (mh-msg-filename msg folder) buffer-file-name))
1088 (progn ;just back up to start
1089 (goto-char (point-min))
1090 (if (not clean-message-header)
1091 (mh-start-of-uncleaned-message)))
1092 (mh-display-msg msg folder))))
1093 (if (not (= (1+ (window-height)) (frame-height))) ;not horizontally split
1094 (shrink-window (- (window-height) mh-summary-height)))
1095 (mh-recenter nil)
1096 (if (not (memq msg mh-seen-list))
1097 (setq mh-seen-list (cons msg mh-seen-list)))
1098 (when mh-update-sequences-after-mh-show-flag
1099 (mh-update-sequences))
1100 (run-hooks 'mh-show-hook))
1101
1102(defun mh-modify (&optional message)
1103 "Edit message at cursor.
1104If optional argument MESSAGE is non-nil, edit that message instead.
1105Force a two-window display with the folder window on top (size
1106`mh-summary-height') and the message editing buffer below it.
1107
1108The message is displayed in raw form."
1109 (interactive)
1110 (let* ((message (or message (mh-get-msg-num t)))
1111 (msg-filename (mh-msg-filename message))
1112 edit-buffer)
1113 (when (not (file-exists-p msg-filename))
1114 (error "Message %d does not exist" message))
1115
1116 ;; Invalidate the show buffer if it is showing the same message that is
1117 ;; to be edited.
1118 (when (and (buffer-live-p (get-buffer mh-show-buffer))
1119 (equal (save-excursion (set-buffer mh-show-buffer)
1120 buffer-file-name)
1121 msg-filename))
1122 (mh-invalidate-show-buffer))
1123
1124 ;; Edit message
1125 (find-file msg-filename)
1126 (setq edit-buffer (current-buffer))
1127
1128 ;; Set buffer properties
1129 (mh-letter-mode)
1130 (use-local-map text-mode-map)
1131
1132 ;; Just show the edit buffer...
1133 (delete-other-windows)
1134 (switch-to-buffer edit-buffer)))
1135
1136(defun mh-decode-quoted-printable ()
1137 "Run mimedecode on current buffer, replacing its contents."
1138 (let ((case-fold-search t))
1139 (goto-char (point-min))
1140 (when (and (re-search-forward
1141 "^content-transfer-encoding:[ \t]*quoted-printable"
1142 (if mh-decode-mime-flag (mail-header-end) nil) t)
1143 (search-forward "\n\n" nil t))
1144 (message "Converting quoted-printable characters...")
1145 (let ((modified (buffer-modified-p))
1146 (command "mimedecode"))
1147 (shell-command-on-region (point-min) (point-max) command t t)
1148 (if (fboundp 'deactivate-mark)
1149 (deactivate-mark))
1150 (set-buffer-modified-p modified))
1151 (message "Converting quoted-printable characters... done."))))
1152
1153(defun mh-show-unquote-From ()
1154 "Decode >From at beginning of lines for `mh-show-mode'."
1155 (save-excursion
1156 (let ((modified (buffer-modified-p))
1157 (case-fold-search nil))
1158 (goto-char (mail-header-end))
1159 (while (re-search-forward "^>From" nil t)
1160 (replace-match "From"))
1161 (set-buffer-modified-p modified))))
1162
1163(defun mh-msg-folder (folder-name)
1164 "Return the name of the buffer for FOLDER-NAME."
1165 folder-name)
1166
1167(defun mh-display-msg (msg-num folder-name)
1168 "Display MSG-NUM of FOLDER-NAME.
1169Sets the current buffer to the show buffer."
1170 (let ((folder (mh-msg-folder folder-name)))
1171 (set-buffer folder)
1172 ;; When Gnus uses external displayers it has to keep handles longer. So
1173 ;; we will delete these handles when mh-quit is called on the folder. It
1174 ;; would be nicer if there are weak pointers in emacs lisp, then we could
1175 ;; get the garbage collector to do this for us.
1176 (unless (mh-buffer-data)
1177 (setf (mh-buffer-data) (mh-make-buffer-data)))
1178 ;; Bind variables in folder buffer in case they are local
1179 (let ((formfile mhl-formfile)
1180 (clean-message-header mh-clean-message-header-flag)
1181 (invisible-headers mh-invisible-headers)
1182 (visible-headers mh-visible-headers)
1183 (msg-filename (mh-msg-filename msg-num folder-name))
1184 (show-buffer mh-show-buffer)
1185 (mm-inline-media-tests mh-mm-inline-media-tests))
1186 (if (not (file-exists-p msg-filename))
1187 (error "Message %d does not exist" msg-num))
1188 (if (and (> mh-show-maximum-size 0)
1189 (> (elt (file-attributes msg-filename) 7)
1190 mh-show-maximum-size)
1191 (not (y-or-n-p
1192 (format
1193 "Message %d (%d bytes) exceeds %d bytes. Display it? "
1194 msg-num (elt (file-attributes msg-filename) 7)
1195 mh-show-maximum-size))))
1196 (error "Message %d not displayed" msg-num))
1197 (set-buffer show-buffer)
1198 (cond ((not (equal msg-filename buffer-file-name))
1199 (mh-unvisit-file)
1200 (setq buffer-read-only nil)
1201 (erase-buffer)
1202 ;; Changing contents, so this hook needs to be reinitialized.
1203 ;; pgp.el uses this.
1204 (if (boundp 'write-contents-hooks) ;Emacs 19
1205 (kill-local-variable 'write-contents-hooks))
1206 (if formfile
1207 (mh-exec-lib-cmd-output "mhl" "-nobell" "-noclear"
1208 (if (stringp formfile)
1209 (list "-form" formfile))
1210 msg-filename)
1211 (insert-file-contents msg-filename))
1212 (if mh-decode-quoted-printable-flag
1213 (mh-decode-quoted-printable))
1214 ;; Cleanup old mime handles
1215 (mh-mime-cleanup)
1216 ;; Use mm to display buffer
1217 (when (and mh-decode-mime-flag (not formfile))
1218 (mh-add-missing-mime-version-header)
1219 (setf (mh-buffer-data) (mh-make-buffer-data))
1220 (mh-mime-display))
1221 ;; Header cleanup
1222 (goto-char (point-min))
1223 (cond (clean-message-header
1224 (mh-clean-msg-header (point-min)
1225 invisible-headers
1226 visible-headers)
1227 (goto-char (point-min)))
1228 (t
1229 (mh-start-of-uncleaned-message)))
1230 ;; the parts of visiting we want to do (no locking)
1231 (or (eq buffer-undo-list t) ;don't save undo info for prev msgs
1232 (setq buffer-undo-list nil))
1233 (set-buffer-auto-saved)
1234 ;; the parts of set-visited-file-name we want to do (no locking)
1235 (setq buffer-file-name msg-filename)
1236 (setq buffer-backed-up nil)
1237 (auto-save-mode 1)
1238 (set-mark nil)
1239 (mh-show-mode)
1240 (unwind-protect
1241 (when (and mh-decode-mime-flag (not formfile))
1242 (setq buffer-read-only nil)
1243 (mh-display-smileys)
1244 (mh-display-emphasis))
1245 (setq buffer-read-only t))
1246 (set-buffer-modified-p nil)
1247 (setq mh-show-folder-buffer folder)
1248 (setq mode-line-buffer-identification
1249 (list (format mh-show-buffer-mode-line-buffer-id
1250 folder-name msg-num)))
1251 (set-buffer folder)
1252 (setq mh-showing-with-headers nil))))))
1253
1254(defun mh-clean-msg-header (start invisible-headers visible-headers)
1255 "Flush extraneous lines in message header.
1256Header is cleaned from START to the end of the message header.
1257INVISIBLE-HEADERS contains a regular expression specifying lines to delete
1258from the header. VISIBLE-HEADERS contains a regular expression specifying the
1259lines to display. INVISIBLE-HEADERS is ignored if VISIBLE-HEADERS is non-nil."
1260 (let ((case-fold-search t)
1261 (after-change-functions nil)) ;Work around emacs-20 font-lock bug
1262 ;causing an endless loop.
1263 (save-restriction
1264 (goto-char start)
1265 (if (search-forward "\n\n" nil 'move)
1266 (backward-char 1))
1267 (narrow-to-region start (point))
1268 (goto-char (point-min))
1269 (if visible-headers
1270 (while (< (point) (point-max))
1271 (cond ((looking-at visible-headers)
1272 (forward-line 1)
1273 (while (looking-at "[ \t]") (forward-line 1)))
1274 (t
1275 (mh-delete-line 1)
1276 (while (looking-at "[ \t]")
1277 (mh-delete-line 1)))))
1278 (while (re-search-forward invisible-headers nil t)
1279 (beginning-of-line)
1280 (mh-delete-line 1)
1281 (while (looking-at "[ \t]")
1282 (mh-delete-line 1))))
1283 (unlock-buffer))))
1284
1285(defun mh-delete-line (lines)
1286 "Delete the next LINES lines."
1287 (delete-region (point) (progn (forward-line lines) (point))))
1288
1289(defun mh-notate (msg notation offset)
1290 "Mark MSG with the character NOTATION at position OFFSET.
1291Null MSG means the message at cursor."
1292 (save-excursion
1293 (if (or (null msg)
1294 (mh-goto-msg msg t t))
1295 (with-mh-folder-updating (t)
1296 (beginning-of-line)
1297 (forward-char offset)
1298 (delete-char 1)
1299 (insert notation)))))
1300
1301(defun mh-find-msg-get-num (step)
1302 "Return the message number of the message nearest the cursor.
1303Jumps over non-message lines, such as inc errors.
1304If we have to search, STEP tells whether to search forward or backward."
1305 (or (mh-get-msg-num nil)
1306 (let ((msg-num nil)
1307 (nreverses 0))
1308 (while (and (not msg-num)
1309 (< nreverses 2))
1310 (cond ((eobp)
1311 (setq step -1)
1312 (setq nreverses (1+ nreverses)))
1313 ((bobp)
1314 (setq step 1)
1315 (setq nreverses (1+ nreverses))))
1316 (forward-line step)
1317 (setq msg-num (mh-get-msg-num nil)))
1318 msg-num)))
1319
1320(defun mh-goto-msg (number &optional no-error-if-no-message dont-show)
1321 "Position the cursor at message NUMBER.
1322Optional non-nil second argument NO-ERROR-IF-NO-MESSAGE means return nil
1323instead of signaling an error if message does not exist; in this case, the
1324cursor is positioned near where the message would have been.
1325Non-nil third argument DONT-SHOW means not to show the message."
1326 (interactive "NGo to message: ")
1327 (setq number (prefix-numeric-value number))
1328 (let ((point (point))
1329 (return-value t))
1330 (goto-char (point-min))
1331 (unless (re-search-forward (format "^[ ]*%s[^0-9]+" number) nil t)
1332 (goto-char point)
1333 (unless no-error-if-no-message
1334 (error "No message %d" number))
1335 (setq return-value nil))
1336 (beginning-of-line)
1337 (or dont-show (not return-value) (mh-maybe-show number))
1338 return-value))
1339
1340(defun mh-msg-search-pat (n)
1341 "Return a search pattern for message N in the scan listing."
1342 (format mh-scan-msg-search-regexp n))
1343
1344(defun mh-get-profile-field (field)
1345 "Find and return the value of FIELD in the current buffer.
1346Returns nil if the field is not in the buffer."
1347 (let ((case-fold-search t))
1348 (goto-char (point-min))
1349 (cond ((not (re-search-forward (format "^%s" field) nil t)) nil)
1350 ((looking-at "[\t ]*$") nil)
1351 (t
1352 (re-search-forward "[\t ]*\\([^\t \n].*\\)$" nil t)
1353 (let ((start (match-beginning 1)))
1354 (end-of-line)
1355 (buffer-substring start (point)))))))
1356
1357(defvar mail-user-agent)
1358(defvar read-mail-command)
1359
1360(defvar mh-find-path-run nil
1361 "Non-nil if `mh-find-path' has been run already.")
1362
1363(defun mh-find-path ()
1364 "Set `mh-progs', `mh-lib', and `mh-lib-progs' variables.
1365Set `mh-user-path', `mh-draft-folder', `mh-unseen-seq', `mh-previous-seq',
1366`mh-inbox' from user's MH profile.
1367The value of `mh-find-path-hook' is a list of functions to be called, with no
1368arguments, after these variable have been set."
1369 (mh-find-progs)
1370 (unless mh-find-path-run
1371 (setq mh-find-path-run t)
1372 (setq read-mail-command 'mh-rmail)
1373 (setq mail-user-agent 'mh-e-user-agent))
1374 (save-excursion
1375 ;; Be sure profile is fully expanded before switching buffers
1376 (let ((profile (expand-file-name (or (getenv "MH") "~/.mh_profile"))))
1377 (set-buffer (get-buffer-create mh-temp-buffer))
1378 (setq buffer-offer-save nil) ;for people who set default to t
1379 (erase-buffer)
1380 (condition-case err
1381 (insert-file-contents profile)
1382 (file-error
1383 (mh-install profile err)))
1384 (setq mh-user-path (mh-get-profile-field "Path:"))
1385 (if (not mh-user-path)
1386 (setq mh-user-path "Mail"))
1387 (setq mh-user-path
1388 (file-name-as-directory
1389 (expand-file-name mh-user-path (expand-file-name "~"))))
1390 (setq mh-draft-folder (mh-get-profile-field "Draft-Folder:"))
1391 (if mh-draft-folder
1392 (progn
1393 (if (not (mh-folder-name-p mh-draft-folder))
1394 (setq mh-draft-folder (format "+%s" mh-draft-folder)))
1395 (if (not (file-exists-p (mh-expand-file-name mh-draft-folder)))
1396 (error "Draft folder \"%s\" not found. Create it and try again"
1397 (mh-expand-file-name mh-draft-folder)))))
1398 (setq mh-inbox (mh-get-profile-field "Inbox:"))
1399 (cond ((not mh-inbox)
1400 (setq mh-inbox "+inbox"))
1401 ((not (mh-folder-name-p mh-inbox))
1402 (setq mh-inbox (format "+%s" mh-inbox))))
1403 (setq mh-unseen-seq (mh-get-profile-field "Unseen-Sequence:"))
1404 (if mh-unseen-seq
1405 (setq mh-unseen-seq (intern mh-unseen-seq))
1406 (setq mh-unseen-seq 'unseen)) ;old MH default?
1407 (setq mh-previous-seq (mh-get-profile-field "Previous-Sequence:"))
1408 (if mh-previous-seq
1409 (setq mh-previous-seq (intern mh-previous-seq)))
1410 (run-hooks 'mh-find-path-hook)))
1411 (and mh-auto-folder-collect-flag
1412 (let ((mh-no-install t)) ;only get folders if MH installed
1413 (condition-case err
1414 (mh-make-folder-list-background)
1415 (file-error))))) ;so don't complain if not installed
1416
1417(defun mh-file-command-p (file)
1418 "Return t if file FILE is the name of a executable regular file."
1419 (and (file-regular-p file) (file-executable-p file)))
1420
1421(defun mh-find-progs ()
1422 "Find the directories for the installed MH/nmh binaries and config files.
1423Set the `mh-progs' and `mh-lib', and `mh-lib-progs' variables to the
1424directory names and set `mh-nmh-flag' if we detect nmh instead of MH."
1425 (unless (and mh-progs mh-lib mh-lib-progs)
1426 (let ((path (or (mh-path-search exec-path "mhparam")
1427 (mh-path-search '("/usr/local/nmh/bin" ; nmh default
1428 "/usr/local/bin/mh/"
1429 "/usr/local/mh/"
1430 "/usr/bin/mh/" ;Ultrix 4.2, Linux
1431 "/usr/new/mh/" ;Ultrix <4.2
1432 "/usr/contrib/mh/bin/" ;BSDI
1433 "/usr/pkg/bin/" ; NetBSD
1434 "/usr/local/bin/"
1435 )
1436 "mhparam"))))
1437 (if (not path)
1438 (error "Unable to find the `mhparam' command"))
1439 (save-excursion
1440 (let ((tmp-buffer (get-buffer-create mh-temp-buffer)))
1441 (set-buffer tmp-buffer)
1442 (unwind-protect
1443 (progn
1444 (call-process (expand-file-name "mhparam" path)
1445 nil '(t nil) nil "libdir" "etcdir")
1446 (goto-char (point-min))
1447 (if (search-forward-regexp "^libdir:\\s-\\(\\S-+\\)\\s-*$"
1448 nil t)
1449 (setq mh-lib-progs (match-string 1)
1450 mh-lib mh-lib-progs
1451 mh-progs path))
1452 (goto-char (point-min))
1453 (if (search-forward-regexp "^etcdir:\\s-\\(\\S-+\\)\\s-*$"
1454 nil t)
1455 (setq mh-lib (match-string 1)
1456 mh-nmh-flag t)))
1457 (kill-buffer tmp-buffer))))
1458 (unless (and mh-progs mh-lib mh-lib-progs)
1459 (error "Unable to determine paths from `mhparam' command")))))
1460
1461(defun mh-path-search (path file)
1462 "Search PATH, a list of directory names, for FILE.
1463Returns the element of PATH that contains FILE, or nil if not found."
1464 (while (and path
1465 (not (funcall 'mh-file-command-p
1466 (expand-file-name file (car path)))))
1467 (setq path (cdr path)))
1468 (car path))
1469
1470(defvar mh-no-install nil) ;do not run install-mh
1471
1472(defun mh-install (profile error-val)
1473 "Initialize the MH environment.
1474This is called if we fail to read the PROFILE file. ERROR-VAL is the error
1475that made this call necessary."
1476 (if (or (getenv "MH")
1477 (file-exists-p profile)
1478 mh-no-install)
1479 (signal (car error-val)
1480 (list (format "Cannot read MH profile \"%s\"" profile)
1481 (car (cdr (cdr error-val))))))
1482 ;; The "install-mh" command will output a short note which
1483 ;; mh-exec-cmd will display to the user.
1484 ;; The MH 5 version of install-mh might try prompt the user
1485 ;; for information, which would fail here.
1486 (mh-exec-cmd (expand-file-name "install-mh" mh-lib-progs) "-auto")
1487 ;; now try again to read the profile file
1488 (erase-buffer)
1489 (condition-case err
1490 (insert-file-contents profile)
1491 (file-error
1492 (signal (car err) ;re-signal with more specific msg
1493 (list (format "Cannot read MH profile \"%s\"" profile)
1494 (car (cdr (cdr err))))))))
1495
1496(defun mh-set-folder-modified-p (flag)
1497 "Mark current folder as modified or unmodified according to FLAG."
1498 (set-buffer-modified-p flag))
1499
1500(defun mh-find-seq (name)
1501 "Return sequence NAME."
1502 (assoc name mh-seq-list))
1503
1504(defun mh-seq-to-msgs (seq)
1505 "Return a list of the messages in SEQ."
1506 (mh-seq-msgs (mh-find-seq seq)))
1507
1508(defun mh-update-scan-format (fmt width)
1509 "Return a scan format with the (msg) width in the FMT replaced with WIDTH.
1510
1511The message number width portion of the format is discovered using
1512`mh-scan-msg-format-regexp'. Its replacement is controlled with
1513`mh-scan-msg-format-string'."
1514 (or (and
1515 (string-match mh-scan-msg-format-regexp fmt)
1516 (let ((begin (match-beginning 1))
1517 (end (match-end 1)))
1518 (concat (substring fmt 0 begin)
1519 (format mh-scan-msg-format-string width)
1520 (substring fmt end))))
1521 fmt))
1522
1523(defun mh-message-number-width (folder)
1524 "Return the widest message number in this FOLDER."
1525 (or mh-progs (mh-find-path))
1526 (let ((tmp-buffer (get-buffer-create mh-temp-buffer))
1527 (width 0))
1528 (save-excursion
1529 (set-buffer tmp-buffer)
1530 (erase-buffer)
1531 (apply 'call-process
1532 (expand-file-name "scan" mh-progs) nil '(t nil) nil
1533 (list folder "last" "-format" "%(msg)"))
1534 (goto-char (point-min))
1535 (if (re-search-forward mh-scan-msg-number-regexp nil 0 1)
1536 (setq width (length (buffer-substring
1537 (match-beginning 1) (match-end 1))))))
1538 width))
1539
1540(defun mh-add-msgs-to-seq (msgs seq &optional internal-flag)
1541 "Add MSGS to SEQ.
1542Remove duplicates and keep sequence sorted. If optional INTERNAL-FLAG is
1543non-nil, do not mark the message in the scan listing or inform MH of the
1544addition."
1545 (let ((entry (mh-find-seq seq)))
1546 (if (and msgs (atom msgs)) (setq msgs (list msgs)))
1547 (if (null entry)
1548 (setq mh-seq-list
1549 (cons (mh-make-seq seq (mh-canonicalize-sequence msgs))
1550 mh-seq-list))
1551 (if msgs (setcdr entry (mh-canonicalize-sequence
1552 (append msgs (mh-seq-msgs entry))))))
1553 (cond ((not internal-flag)
1554 (mh-add-to-sequence seq msgs)
1555 (mh-notate-seq seq mh-note-seq (1+ mh-cmd-note))))))
1556
1557(defun mh-canonicalize-sequence (msgs)
1558 "Sort MSGS in decreasing order and remove duplicates."
1559 (let* ((sorted-msgs (sort (copy-sequence msgs) '>))
1560 (head sorted-msgs))
1561 (while (cdr head)
1562 (if (= (car head) (cadr head))
1563 (setcdr head (cddr head))
1564 (setq head (cdr head))))
1565 sorted-msgs))
1566
1567(defvar mh-folder-hist nil)
1568(defvar mh-speed-folder-map)
1569
1570(defun mh-prompt-for-folder (prompt default can-create
1571 &optional default-string)
1572 "Prompt for a folder name with PROMPT.
1573Returns the folder's name as a string. DEFAULT is used if the folder exists
1574and the user types return. If the CAN-CREATE flag is t, then a folder is
1575created if it doesn't already exist. If optional argument DEFAULT-STRING is
1576non-nil, use it in the prompt instead of DEFAULT.
1577The value of `mh-folder-list-change-hook' is a list of functions to be called,
1578with no arguments, whenever the cached folder list `mh-folder-list' is
1579changed."
1580 (if (null default)
1581 (setq default ""))
1582 (let* ((default-string (cond (default-string (format " [%s]? "
1583 default-string))
1584 ((equal "" default) "? ")
1585 (t (format " [%s]? " default))))
1586 (prompt (format "%s folder%s" prompt default-string))
1587 read-name folder-name)
1588 (if (null mh-folder-list)
1589 (mh-set-folder-list))
1590 (while (and (setq read-name (completing-read prompt mh-folder-list nil nil
1591 "+" 'mh-folder-hist))
1592 (equal read-name "")
1593 (equal default "")))
1594 (cond ((or (equal read-name "") (equal read-name "+"))
1595 (setq read-name default))
1596 ((not (mh-folder-name-p read-name))
1597 (setq read-name (format "+%s" read-name))))
1598 (if (or (not read-name) (equal "" read-name))
1599 (error "No folder specified"))
1600 (setq folder-name read-name)
1601 (cond ((and (> (length folder-name) 0)
1602 (eq (aref folder-name (1- (length folder-name))) ?/))
1603 (setq folder-name (substring folder-name 0 -1))))
1604 (let ((new-file-flag
1605 (not (file-exists-p (mh-expand-file-name folder-name)))))
1606 (cond ((and new-file-flag
1607 (y-or-n-p
1608 (format "Folder %s does not exist. Create it? "
1609 folder-name)))
1610 (message "Creating %s" folder-name)
1611 (mh-exec-cmd-error nil "folder" folder-name)
1612 (when (boundp 'mh-speed-folder-map)
1613 (mh-speed-add-folder folder-name))
1614 (message "Creating %s...done" folder-name)
1615 (setq mh-folder-list (cons (list read-name) mh-folder-list))
1616 (run-hooks 'mh-folder-list-change-hook))
1617 (new-file-flag
1618 (error "Folder %s is not created" folder-name))
1619 ((not (file-directory-p (mh-expand-file-name folder-name)))
1620 (error "\"%s\" is not a directory"
1621 (mh-expand-file-name folder-name)))
1622 ((and (null (assoc read-name mh-folder-list))
1623 (null (assoc (concat read-name "/") mh-folder-list)))
1624 (setq mh-folder-list (cons (list read-name) mh-folder-list))
1625 (run-hooks 'mh-folder-list-change-hook))))
1626 folder-name))
1627
1628(defvar mh-make-folder-list-process nil) ;The background process collecting
1629 ;the folder list.
1630
1631(defvar mh-folder-list-temp nil) ;mh-folder-list as it is being built.
1632
1633(defvar mh-folder-list-partial-line "") ;Start of last incomplete line from
1634 ;folder process.
1635
1636(defun mh-set-folder-list ()
1637 "Set `mh-folder-list' correctly.
1638A useful function for the command line or for when you need to
1639sync by hand. Format is in a form suitable for completing read.
1640The value of `mh-folder-list-change-hook' is a list of functions to be called,
1641with no arguments, once the list of folders has been created."
1642 (message "Collecting folder names...")
1643 (if (not mh-make-folder-list-process)
1644 (mh-make-folder-list-background))
1645 (while (eq (process-status mh-make-folder-list-process) 'run)
1646 (accept-process-output mh-make-folder-list-process))
1647 (setq mh-folder-list mh-folder-list-temp)
1648 (run-hooks 'mh-folder-list-change-hook)
1649 (setq mh-folder-list-temp nil)
1650 (delete-process mh-make-folder-list-process)
1651 (setq mh-make-folder-list-process nil)
1652 (message "Collecting folder names...done"))
1653
1654(defun mh-make-folder-list-background ()
1655 "Start a background process to compute a list of the user's folders.
1656Call `mh-set-folder-list' to wait for the result."
1657 (cond
1658 ((not mh-make-folder-list-process)
1659 (unless mh-inbox
1660 (mh-find-path))
1661 (let ((process-connection-type nil))
1662 (setq mh-make-folder-list-process
1663 (start-process "folders" nil (expand-file-name "folders" mh-progs)
1664 "-fast"
1665 (if mh-recursive-folders-flag
1666 "-recurse"
1667 "-norecurse")))
1668 (set-process-filter mh-make-folder-list-process
1669 'mh-make-folder-list-filter)
1670 (process-kill-without-query mh-make-folder-list-process)))))
1671
1672(defun mh-make-folder-list-filter (process output)
1673 "Given the PROCESS \"folders -fast\", parse OUTPUT.
1674See also `set-process-filter'."
1675 (let ((position 0)
1676 line-end
1677 new-folder
1678 (prevailing-match-data (match-data)))
1679 (unwind-protect
1680 ;; make sure got complete line
1681 (while (setq line-end (string-match "\n" output position))
1682 (setq new-folder (format "+%s%s"
1683 mh-folder-list-partial-line
1684 (substring output position line-end)))
1685 (setq mh-folder-list-partial-line "")
1686 ;; is new folder a subfolder of previous?
1687 (if (and mh-folder-list-temp
1688 (string-match
1689 (regexp-quote
1690 (concat (car (car mh-folder-list-temp)) "/"))
1691 new-folder))
1692 ;; append slash to parent folder for better completion
1693 ;; (undone by mh-prompt-for-folder)
1694 (setq mh-folder-list-temp
1695 (cons
1696 (list new-folder)
1697 (cons
1698 (list (concat (car (car mh-folder-list-temp)) "/"))
1699 (cdr mh-folder-list-temp))))
1700 (setq mh-folder-list-temp
1701 (cons (list new-folder)
1702 mh-folder-list-temp)))
1703 (setq position (1+ line-end)))
1704 (set-match-data prevailing-match-data))
1705 (setq mh-folder-list-partial-line (substring output position))))
1706
1707;;; Issue commands to MH.
1708
1709(defun mh-exec-cmd (command &rest args)
1710 "Execute mh-command COMMAND with ARGS.
1711The side effects are what is desired.
1712Any output is assumed to be an error and is shown to the user.
1713The output is not read or parsed by MH-E."
1714 (save-excursion
1715 (set-buffer (get-buffer-create mh-temp-buffer))
1716 (erase-buffer)
1717 (apply 'call-process
1718 (expand-file-name command mh-progs) nil t nil
1719 (mh-list-to-string args))
1720 (if (> (buffer-size) 0)
1721 (save-window-excursion
1722 (switch-to-buffer-other-window mh-temp-buffer)
1723 (sit-for 5)))))
1724
1725(defun mh-exec-cmd-error (env command &rest args)
1726 "In environment ENV, execute mh-command COMMAND with ARGS.
1727ENV is nil or a string of space-separated \"var=value\" elements.
1728Signals an error if process does not complete successfully."
1729 (save-excursion
1730 (set-buffer (get-buffer-create mh-temp-buffer))
1731 (erase-buffer)
1732 (let ((status
1733 (if env
1734 ;; the shell hacks necessary here shows just how broken Unix is
1735 (apply 'call-process "/bin/sh" nil t nil "-c"
1736 (format "%s %s ${1+\"$@\"}"
1737 env
1738 (expand-file-name command mh-progs))
1739 command
1740 (mh-list-to-string args))
1741 (apply 'call-process
1742 (expand-file-name command mh-progs) nil t nil
1743 (mh-list-to-string args)))))
1744 (mh-handle-process-error command status))))
1745
1746(defun mh-exec-cmd-daemon (command &rest args)
1747 "Execute MH command COMMAND with ARGS in the background.
1748Any output from command is displayed in an asynchronous pop-up window."
1749 (save-excursion
1750 (set-buffer (get-buffer-create mh-temp-buffer))
1751 (erase-buffer))
1752 (let* ((process-connection-type nil)
1753 (process (apply 'start-process
1754 command nil
1755 (expand-file-name command mh-progs)
1756 (mh-list-to-string args))))
1757 (set-process-filter process 'mh-process-daemon)))
1758
1759(defun mh-process-daemon (process output)
1760 "PROCESS daemon that puts OUTPUT into a temporary buffer."
1761 (set-buffer (get-buffer-create mh-temp-buffer))
1762 (insert-before-markers output)
1763 (display-buffer mh-temp-buffer))
1764
1765(defun mh-exec-cmd-quiet (raise-error command &rest args)
1766 "Signal RAISE-ERROR if COMMAND with ARGS fails.
1767Execute MH command COMMAND with ARGS. ARGS is a list of strings.
1768Return at start of mh-temp buffer, where output can be parsed and used.
1769Returns value of `call-process', which is 0 for success, unless RAISE-ERROR is
1770non-nil, in which case an error is signaled if `call-process' returns non-0."
1771 (set-buffer (get-buffer-create mh-temp-buffer))
1772 (erase-buffer)
1773 (let ((value
1774 (apply 'call-process
1775 (expand-file-name command mh-progs) nil t nil
1776 args)))
1777 (goto-char (point-min))
1778 (if raise-error
1779 (mh-handle-process-error command value)
1780 value)))
1781
1782(defun mh-profile-component (component)
1783 "Return COMPONENT value from mhparam, or nil if unset."
1784 (save-excursion
1785 (mh-exec-cmd-quiet nil "mhparam" "-components" component)
1786 (mh-get-profile-field (concat component ":"))))
1787
1788(defun mh-exchange-point-and-mark-preserving-active-mark ()
1789 "Put the mark where point is now, and point where the mark is now.
1790This command works even when the mark is not active, and preserves whether the
1791mark is active or not."
1792 (interactive nil)
1793 (let ((is-active (and (boundp 'mark-active) mark-active)))
1794 (let ((omark (mark t)))
1795 (if (null omark)
1796 (error "No mark set in this buffer"))
1797 (set-mark (point))
1798 (goto-char omark)
1799 (if (boundp 'mark-active)
1800 (setq mark-active is-active))
1801 nil)))
1802
1803(defun mh-exec-cmd-output (command display &rest args)
1804 "Execute MH command COMMAND with DISPLAY flag and ARGS.
1805Put the output into buffer after point. Set mark after inserted text.
1806Output is expected to be shown to user, not parsed by MH-E."
1807 (push-mark (point) t)
1808 (apply 'call-process
1809 (expand-file-name command mh-progs) nil t display
1810 (mh-list-to-string args))
1811
1812 ;; The following is used instead of 'exchange-point-and-mark because the
1813 ;; latter activates the current region (between point and mark), which
1814 ;; turns on highlighting. So prior to this bug fix, doing "inc" would
1815 ;; highlight a region containing the new messages, which is undesirable.
1816 ;; The bug wasn't seen in emacs21 but still occurred in XEmacs21.4.
1817 (mh-exchange-point-and-mark-preserving-active-mark))
1818
1819(defun mh-exec-lib-cmd-output (command &rest args)
1820 "Execute MH library command COMMAND with ARGS.
1821Put the output into buffer after point. Set mark after inserted text."
1822 (apply 'mh-exec-cmd-output (expand-file-name command mh-lib-progs) nil args))
1823
1824(defun mh-handle-process-error (command status)
1825 "Raise error if COMMAND returned non-zero STATUS, otherwise return STATUS.
1826STATUS is return value from `call-process'.
1827Program output is in current buffer.
1828If output is too long to include in error message, display the buffer."
1829 (cond ((eq status 0) ;success
1830 status)
1831 ((stringp status) ;kill string
1832 (error "%s: %s" command status))
1833 (t ;exit code
1834 (cond
1835 ((= (buffer-size) 0) ;program produced no error message
1836 (error "%s: exit code %d" command status))
1837 (t
1838 ;; will error message fit on one line?
1839 (goto-line 2)
1840 (if (and (< (buffer-size) (frame-width))
1841 (eobp))
1842 (error "%s"
1843 (buffer-substring 1 (progn (goto-char 1)
1844 (end-of-line)
1845 (point))))
1846 (display-buffer (current-buffer))
1847 (error "%s failed with status %d. See error message in other window"
1848 command status)))))))
1849
1850(defun mh-list-to-string (l)
1851 "Flatten the list L and make every element of the new list into a string."
1852 (nreverse (mh-list-to-string-1 l)))
1853
1854(defun mh-list-to-string-1 (l)
1855 "Flatten the list L and make every element of the new list into a string."
1856 (let ((new-list nil))
1857 (while l
1858 (cond ((null (car l)))
1859 ((symbolp (car l))
1860 (setq new-list (cons (symbol-name (car l)) new-list)))
1861 ((numberp (car l))
1862 (setq new-list (cons (int-to-string (car l)) new-list)))
1863 ((equal (car l) ""))
1864 ((stringp (car l)) (setq new-list (cons (car l) new-list)))
1865 ((listp (car l))
1866 (setq new-list (nconc (mh-list-to-string-1 (car l))
1867 new-list)))
1868 (t (error "Bad element in mh-list-to-string: %s" (car l))))
1869 (setq l (cdr l)))
1870 new-list))
1871
1872(provide 'mh-utils)
1873
1874;;; Local Variables:
1875;;; indent-tabs-mode: nil
1876;;; sentence-end-double-space: nil
1877;;; End:
1878
1879;;; mh-utils.el ends here
diff --git a/lisp/mail/mh-xemacs-compat.el b/lisp/mail/mh-xemacs-compat.el
deleted file mode 100644
index 692d792a1bc..00000000000
--- a/lisp/mail/mh-xemacs-compat.el
+++ /dev/null
@@ -1,62 +0,0 @@
1;;; mh-xemacs-compat.el --- GNU Emacs Functions needed by XEmacs
2
3;; Copyright (C) 2001, 2002 Free Software Foundation, Inc.
4
5;; Author: FSF
6;; Maintainer: Bill Wohler <wohler@newt.com>
7;; Keywords: mail
8;; See: mh-e.el
9
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
14;; the Free Software Foundation; either version 2, or (at your option)
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 the
24;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
25;; Boston, MA 02111-1307, USA.
26
27;;; Commentary:
28
29;;; Change Log:
30
31;; $Id: mh-xemacs-compat.el,v 1.13 2002/11/30 01:21:42 wohler Exp $
32
33;;; Code:
34
35;;; Some requires:
36(require 'rfc822)
37
38;;; Simple compatibility:
39
40(unless (fboundp 'match-string-no-properties)
41 (defsubst match-string-no-properties (match)
42 (buffer-substring-no-properties
43 (match-beginning match) (match-end match))))
44
45(unless (fboundp 'line-beginning-position)
46 (defalias 'line-beginning-position 'point-at-bol))
47(unless (fboundp 'line-end-position)
48 (defalias 'line-end-position 'point-at-eol))
49
50(unless (fboundp 'timerp)
51 (defalias 'timerp 'itimerp))
52(unless (fboundp 'cancel-timer)
53 (defalias 'cancel-timer 'delete-itimer))
54
55(provide 'mh-xemacs-compat)
56
57;;; Local Variables:
58;;; indent-tabs-mode: nil
59;;; sentence-end-double-space: nil
60;;; End:
61
62;;; mh-xemacs-compat.el ends here
generated by cgit v1.2.1 (git 2.18.0) at 2026-03-27 12:18:37 +0000