aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorRichard M. Stallman1994-03-15 06:16:30 +0000
committerRichard M. Stallman1994-03-15 06:16:30 +0000
commitc26cf6c836766a260786923712d151ec3b4cc0ae (patch)
treece574485dba85cb0bd325b39f3cd11d338d2cb99
parent103ffad56800483993986d4b2119c750cf1f8763 (diff)
downloademacs-c26cf6c836766a260786923712d151ec3b4cc0ae.tar.gz
emacs-c26cf6c836766a260786923712d151ec3b4cc0ae.zip
entered into RCS
-rw-r--r--lisp/mail/mh-comp.el934
-rw-r--r--lisp/mail/mh-e.el1334
-rw-r--r--lisp/mail/mh-funcs.el311
-rw-r--r--lisp/mail/mh-mime.el209
-rw-r--r--lisp/mail/mh-pick.el177
-rw-r--r--lisp/mail/mh-seq.el222
-rw-r--r--lisp/mail/mh-utils.el816
7 files changed, 4003 insertions, 0 deletions
diff --git a/lisp/mail/mh-comp.el b/lisp/mail/mh-comp.el
new file mode 100644
index 00000000000..0ed7774dc09
--- /dev/null
+++ b/lisp/mail/mh-comp.el
@@ -0,0 +1,934 @@
1;;; mh-comp --- mh-e functions for composing messages
2;; Time-stamp: <94/03/08 10:05:20 gildea>
3
4;; Copyright 1993 Free Software Foundation, Inc.
5
6;; This file is part of mh-e.
7
8;; mh-e is free software; you can redistribute it and/or modify
9;; it under the terms of the GNU General Public License as published by
10;; the Free Software Foundation; either version 2, or (at your option)
11;; any later version.
12
13;; mh-e is distributed in the hope that it will be useful,
14;; but WITHOUT ANY WARRANTY; without even the implied warranty of
15;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16;; GNU General Public License for more details.
17
18;; You should have received a copy of the GNU General Public License
19;; along with mh-e; see the file COPYING. If not, write to
20;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
21
22;;; Commentary:
23
24;; Internal support for mh-e package.
25
26;;; Code:
27
28(provide 'mh-comp)
29(require 'mh-utils)
30
31(defvar mh-note-repl "-"
32 "String whose first character is used to notate replied to messages.")
33
34(defvar mh-note-forw "F"
35 "String whose first character is used to notate forwarded messages.")
36
37(defvar mh-note-dist "R"
38 "String whose first character is used to notate redistributed messages.")
39
40(defvar mh-send-prog "send"
41 "Name of the MH send program.
42Some sites need to change this because of a name conflict.")
43
44(defvar mh-yank-hooks nil
45 "Obsolete hook for modifying a citation just inserted in the mail buffer.
46Each hook function can find the citation between point and mark.
47And each hook function should leave point and mark around the citation
48text as modified.
49
50This is a normal hook, misnamed for historical reasons.
51It is semi-obsolete and is only used if mail-citation-hook is nil.")
52
53(defvar mail-citation-hook nil
54 "*Hook for modifying a citation just inserted in the mail buffer.
55Each hook function can find the citation between point and mark.
56And each hook function should leave point and mark around the citation
57text as modified.
58
59If this hook is entirely empty (nil), the text of the message is inserted
60with mh-ins-buf-prefix prefixed to each line.
61
62See also the variable mh-yank-from-start-of-msg, which controls how
63much of the message passed to the hook.")
64
65;;; Copied from sendmail.el for Hyperbole
66(defvar mail-header-separator "--------"
67 "*Line used by MH to separate headers from text in messages being composed.")
68
69;;; Personal preferences:
70
71(defvar mh-delete-yanked-msg-window nil
72 "*Controls window display when a message is yanked by \\<mh-letter-mode-map>\\[mh-yank-cur-msg].
73If non-nil, yanking the current message into a draft letter deletes any
74windows displaying the message.")
75
76(defvar mh-yank-from-start-of-msg t
77 "*Controls which part of a message is yanked by \\<mh-letter-mode-map>\\[mh-yank-cur-msg].
78If non-nil, include the entire message. If the symbol `body', then yank the
79message minus the header. If nil, yank only the portion of the message
80following the point. If the show buffer has a region, this variable is
81ignored.")
82
83(defvar mh-reply-default-reply-to nil
84 "*Sets the person or persons to whom a reply will be sent.
85If nil, prompt for recipient. If non-nil, then \\<mh-folder-mode-map>`\\[mh-reply]' will use this
86value and it should be one of \"from\", \"to\", or \"cc\".")
87
88(defvar mh-signature-file-name "~/.signature"
89 "*Name of file containing the user's signature.
90Inserted into message by \\<mh-letter-mode-map>\\[mh-insert-signature].")
91
92(defvar mh-forward-subject-format "%s: %s"
93 "*Format to generate the Subject: line contents for a forwarded message.
94The two string arguments to the format are the sender of the original
95message and the original subject line.")
96
97(defvar mh-comp-formfile "components"
98 "Name of file to be used as a skeleton for composing messages.
99Default is \"components\". If not a complete path name, the file
100is searched for first in the user's MH directory, then in the
101system MH lib directory.")
102
103;;; Hooks:
104
105(defvar mh-letter-mode-hook nil
106 "Invoked in `mh-letter-mode' on a new letter.")
107
108(defvar mh-compose-letter-function nil
109 "Invoked in `mh-compose-and-send-mail' on a draft letter.
110It is passed three arguments: TO recipients, SUBJECT, and CC recipients.")
111
112(defvar mh-before-send-letter-hook nil
113 "Invoked at the beginning of the \\<mh-letter-mode-map>\\[mh-send-letter] command.")
114
115
116(defvar mh-rejected-letter-start
117 (concat "^ ----- Unsent message follows -----$" ;from mail system
118 "\\|^------- Unsent Draft$" ;from MH itself
119 "\\|^---------- Original Message ----------$" ;from zmailer
120 "\\|^ --- The unsent message follows ---$" ;from AIX mail system
121 "\\|^ Your message follows:$") ;from MMDF-II
122 "Regexp specifying the beginning of the wrapper around a returned letter.
123This wrapper is generated by the mail system when rejecting a letter.")
124
125(defvar mh-new-draft-cleaned-headers
126 "^Date:\\|^Received:\\|^Message-Id:\\|^From:\\|^Sender:\\|^Delivery-Date:\\|^Return-Path:"
127 "Regexp of header lines to remove before offering a message as a new draft.
128Used by the \\<mh-folder-mode-map>`\\[mh-edit-again]' and `\\[mh-extract-rejected-mail]' commands.")
129
130(defvar mh-to-field-choices '((?t . "To:") (?s . "Subject:") (?c . "Cc:")
131 (?b . "Bcc:") (?f . "Fcc:"))
132 "Alist of (final-character . field-name) choices for mh-to-field.")
133
134(defvar mh-letter-mode-map (copy-keymap text-mode-map)
135 "Keymap for composing mail.")
136
137(defvar mh-letter-mode-syntax-table nil
138 "Syntax table used by mh-e while in MH-Letter mode.")
139
140(if mh-letter-mode-syntax-table
141 ()
142 (setq mh-letter-mode-syntax-table
143 (make-syntax-table text-mode-syntax-table))
144 (modify-syntax-entry ?% "." mh-letter-mode-syntax-table))
145
146
147;;;###autoload
148(defun mh-smail ()
149 "Compose and send mail with the MH mail system.
150This function is an entry point to mh-e, the Emacs front end
151to the MH mail system."
152 (interactive)
153 (mh-find-path)
154 (call-interactively 'mh-send))
155
156
157(defun mh-edit-again (msg)
158 "Clean-up a draft or a message previously sent and make it resendable.
159The variable mh-new-draft-cleaned-headers specifies the headers to remove.
160See also documentation for `\\[mh-send]' function."
161 (interactive (list (mh-get-msg-num t)))
162 (let* ((from-folder mh-current-folder)
163 (config (current-window-configuration))
164 (draft
165 (cond ((and mh-draft-folder (equal from-folder mh-draft-folder))
166 (pop-to-buffer (find-file-noselect (mh-msg-filename msg)) t)
167 (rename-buffer (format "draft-%d" msg))
168 (buffer-name))
169 (t
170 (mh-read-draft "clean-up" (mh-msg-filename msg) nil)))))
171 (mh-clean-msg-header (point-min) mh-new-draft-cleaned-headers nil)
172 (goto-char (point-min))
173 (set-buffer-modified-p nil)
174 (mh-compose-and-send-mail draft "" from-folder nil nil nil nil nil nil
175 config)))
176
177
178(defun mh-extract-rejected-mail (msg)
179 "Extract a letter returned by the mail system and make it resendable.
180Default is the displayed message. The variable mh-new-draft-cleaned-headers
181gives the headers to clean out of the original message.
182See also documentation for `\\[mh-send]' function."
183 (interactive (list (mh-get-msg-num t)))
184 (let ((from-folder mh-current-folder)
185 (config (current-window-configuration))
186 (draft (mh-read-draft "extraction" (mh-msg-filename msg) nil)))
187 (goto-char (point-min))
188 (cond ((re-search-forward mh-rejected-letter-start nil t)
189 (skip-chars-forward " \t\n")
190 (delete-region (point-min) (point))
191 (mh-clean-msg-header (point-min) mh-new-draft-cleaned-headers nil))
192 (t
193 (message "Does not appear to be a rejected letter.")))
194 (goto-char (point-min))
195 (set-buffer-modified-p nil)
196 (mh-compose-and-send-mail draft "" from-folder msg (mh-get-field "To:")
197 (mh-get-field "From:") (mh-get-field "Cc:")
198 nil nil config)))
199
200
201(defun mh-forward (to cc &optional msg-or-seq)
202 "Forward a message or message sequence. Defaults to displayed message.
203If optional prefix argument provided, then prompt for the message sequence.
204See also documentation for `\\[mh-send]' function."
205 (interactive (list (mh-read-address "To: ")
206 (mh-read-address "Cc: ")
207 (if current-prefix-arg
208 (mh-read-seq-default "Forward" t)
209 (mh-get-msg-num t))))
210 (or msg-or-seq
211 (setq msg-or-seq (mh-get-msg-num t)))
212 (let* ((folder mh-current-folder)
213 (config (current-window-configuration))
214 ;; forw always leaves file in "draft" since it doesn't have -draft
215 (draft-name (expand-file-name "draft" mh-user-path))
216 (draft (cond ((or (not (file-exists-p draft-name))
217 (y-or-n-p "The file 'draft' exists. Discard it? "))
218 (mh-exec-cmd "forw"
219 "-build" mh-current-folder msg-or-seq)
220 (prog1
221 (mh-read-draft "" draft-name t)
222 (mh-insert-fields "To:" to "Cc:" cc)
223 (set-buffer-modified-p nil)))
224 (t
225 (mh-read-draft "" draft-name nil)))))
226 (goto-char (point-min))
227 (re-search-forward "^------- Forwarded Message")
228 (forward-line -1)
229 (narrow-to-region (point) (point-max))
230 (let ((orig-from (save-excursion (mh-get-field "From:")))
231 (orig-subject (save-excursion (mh-get-field "Subject:"))))
232 (widen)
233 (let ((forw-subject
234 (mh-forwarded-letter-subject orig-from orig-subject)))
235 (save-excursion (mh-insert-fields "Subject:" forw-subject))
236 (delete-other-windows)
237 (if (numberp msg-or-seq)
238 (mh-add-msgs-to-seq msg-or-seq 'forwarded t)
239 (mh-add-msgs-to-seq (mh-seq-to-msgs msg-or-seq) 'forwarded t))
240 (mh-compose-and-send-mail draft "" folder msg-or-seq
241 to forw-subject cc
242 mh-note-forw "Forwarded:"
243 config)))))
244
245(defun mh-forwarded-letter-subject (from subject)
246 ;; Return a Subject suitable for a forwarded message.
247 ;; Original message has headers FROM and SUBJECT.
248 (let ((addr-start (string-match "<" from))
249 (comment (string-match "(" from)))
250 (cond ((and addr-start (> addr-start 0))
251 ;; Full Name <luser@host>
252 (setq from (substring from 0 (1- addr-start))))
253 (comment
254 ;; luser@host (Full Name)
255 (setq from (substring from (1+ comment) (1- (length from)))))))
256 (format mh-forward-subject-format from subject))
257
258
259;;;###autoload
260(defun mh-smail-other-window ()
261 "Compose and send mail in other window with the MH mail system.
262This function is an entry point to mh-e, the Emacs front end
263to the MH mail system."
264 (interactive)
265 (mh-find-path)
266 (call-interactively 'mh-send-other-window))
267
268
269(defun mh-redistribute (to cc &optional msg)
270 "Redistribute a letter.
271Depending on how your copy of MH was compiled, you may need to change the
272setting of the variable mh-redist-full-contents. See its documentation."
273 (interactive (list (mh-read-address "Redist-To: ")
274 (mh-read-address "Redist-Cc: ")
275 (mh-get-msg-num t)))
276 (or msg
277 (setq msg (mh-get-msg-num t)))
278 (save-window-excursion
279 (let ((folder mh-current-folder)
280 (draft (mh-read-draft "redistribution"
281 (if mh-redist-full-contents
282 (mh-msg-filename msg)
283 nil)
284 nil)))
285 (mh-goto-header-end 0)
286 (insert "Resent-To: " to "\n")
287 (if (not (equal cc "")) (insert "Resent-cc: " cc "\n"))
288 (mh-clean-msg-header (point-min)
289 "^Message-Id:\\|^Received:\\|^Return-Path:\\|^Sender:\\|^Date:\\|^From:"
290 nil)
291 (save-buffer)
292 (message "Redistributing...")
293 (if mh-redist-full-contents
294 (call-process "/bin/sh" nil 0 nil "-c"
295 (format "mhdist=1 mhaltmsg=%s %s -push %s"
296 (buffer-file-name)
297 (expand-file-name mh-send-prog mh-progs)
298 (buffer-file-name)))
299 (call-process "/bin/sh" nil 0 nil "-c"
300 (format "mhdist=1 mhaltmsg=%s mhannotate=1 %s -push %s"
301 (mh-msg-filename msg folder)
302 (expand-file-name mh-send-prog mh-progs)
303 (buffer-file-name))))
304 (mh-annotate-msg msg folder mh-note-dist
305 "-component" "Resent:"
306 "-text" (format "\"%s %s\"" to cc))
307 (kill-buffer draft)
308 (message "Redistributing...done"))))
309
310
311(defun mh-reply (msg &optional includep)
312 "Reply to a MESSAGE (default: displayed message).
313If optional prefix argument INCLUDEP provided, then include the message
314in the reply using filter mhl.reply in your MH directory.
315Prompts for type of addresses to reply to:
316 from sender only,
317 to sender and primary recipients,
318 cc/all sender and all recipients.
319See also documentation for `\\[mh-send]' function."
320 (interactive (list (mh-get-msg-num t) current-prefix-arg))
321 (let ((minibuffer-help-form
322 "from => Sender only\nto => Sender and primary recipients\ncc or all => Sender and all recipients"))
323 (let ((reply-to (or mh-reply-default-reply-to
324 (completing-read "Reply to whom: "
325 '(("from") ("to") ("cc") ("all"))
326 nil
327 t)))
328 (folder mh-current-folder)
329 (show-buffer mh-show-buffer)
330 (config (current-window-configuration)))
331 (message "Composing a reply...")
332 (mh-exec-cmd "repl" "-build" "-noquery" "-nodraftfolder"
333 mh-current-folder msg
334 (cond ((or (equal reply-to "from") (equal reply-to ""))
335 '("-nocc" "all"))
336 ((equal reply-to "to")
337 '("-cc" "to"))
338 ((or (equal reply-to "cc") (equal reply-to "all"))
339 '("-cc" "all" "-nocc" "me")))
340 (if includep
341 '("-filter" "mhl.reply")))
342 (let ((draft (mh-read-draft "reply"
343 (expand-file-name "reply" mh-user-path)
344 t)))
345 (delete-other-windows)
346 (set-buffer-modified-p nil)
347
348 (let ((to (mh-get-field "To:"))
349 (subject (mh-get-field "Subject:"))
350 (cc (mh-get-field "Cc:")))
351 (goto-char (point-min))
352 (mh-goto-header-end 1)
353 (or includep
354 (mh-in-show-buffer (show-buffer)
355 (mh-display-msg msg folder)))
356 (mh-add-msgs-to-seq msg 'answered t)
357 (message "Composing a reply...done")
358 (mh-compose-and-send-mail draft "" folder msg to subject cc
359 mh-note-repl "Replied:" config))))))
360
361
362(defun mh-send (to cc subject)
363 "Compose and send a letter.
364The file named by `mh-comp-formfile' will be used as the form.
365The letter is composed in mh-letter-mode; see its documentation for more
366details. If `mh-compose-letter-function' is defined, it is called on the
367draft and passed three arguments: to, subject, and cc.
368Do not call this function from outside mh-e; use \\[mh-smail] instead."
369 (interactive (list
370 (mh-read-address "To: ")
371 (mh-read-address "Cc: ")
372 (read-string "Subject: ")))
373 (let ((config (current-window-configuration)))
374 (delete-other-windows)
375 (mh-send-sub to cc subject config)))
376
377
378(defun mh-send-other-window (to cc subject)
379 "Compose and send a letter in another window.
380Do not call this function from outside mh-e;
381use \\[mh-smail-other-window] instead.
382See also documentation for `\\[mh-send]' function."
383 (interactive (list
384 (mh-read-address "To: ")
385 (mh-read-address "Cc: ")
386 (read-string "Subject: ")))
387 (let ((pop-up-windows t))
388 (mh-send-sub to cc subject (current-window-configuration))))
389
390
391(defun mh-send-sub (to cc subject config)
392 "Do the real work of composing and sending a letter.
393Expects the TO, CC, and SUBJECT fields as arguments.
394CONFIG is the window configuration before sending mail."
395 (let ((folder mh-current-folder)
396 (msg-num (mh-get-msg-num nil)))
397 (message "Composing a message...")
398 (let ((draft (mh-read-draft
399 "message"
400 (let (components)
401 (cond
402 ((file-exists-p
403 (setq components
404 (expand-file-name mh-comp-formfile mh-user-path)))
405 components)
406 ((file-exists-p
407 (setq components
408 (expand-file-name mh-comp-formfile mh-lib)))
409 components)
410 (t
411 (error (format "Can't find components file \"%s\""
412 components)))))
413 nil)))
414 (mh-insert-fields "To:" to "Subject:" subject "Cc:" cc)
415 (goto-char (point-max))
416 (message "Composing a message...done")
417 (mh-compose-and-send-mail draft "" folder msg-num
418 to subject cc
419 nil nil config))))
420
421
422(defun mh-read-draft (use initial-contents delete-contents-file)
423 ;; Read draft file into a draft buffer and make that buffer the current one.
424 ;; USE is a message used for prompting about the intended use of the message.
425 ;; INITIAL-CONTENTS is filename that is read into an empty buffer, or NIL
426 ;; if buffer should not be modified. Delete the initial-contents file if
427 ;; DELETE-CONTENTS-FILE flag is set.
428 ;; Returns the draft folder's name.
429 ;; If the draft folder facility is enabled in ~/.mh_profile, a new buffer is
430 ;; used each time and saved in the draft folder. The draft file can then be
431 ;; reused.
432 (cond (mh-draft-folder
433 (let ((orig-default-dir default-directory)
434 (draft-file-name (mh-new-draft-name)))
435 (pop-to-buffer (generate-new-buffer
436 (format "draft-%s"
437 (file-name-nondirectory draft-file-name))))
438 (condition-case ()
439 (insert-file-contents draft-file-name t)
440 (file-error))
441 (setq default-directory orig-default-dir)))
442 (t
443 (let ((draft-name (expand-file-name "draft" mh-user-path)))
444 (pop-to-buffer "draft") ; Create if necessary
445 (if (buffer-modified-p)
446 (if (y-or-n-p "Draft has been modified; kill anyway? ")
447 (set-buffer-modified-p nil)
448 (error "Draft preserved")))
449 (setq buffer-file-name draft-name)
450 (clear-visited-file-modtime)
451 (unlock-buffer)
452 (cond ((and (file-exists-p draft-name)
453 (not (equal draft-name initial-contents)))
454 (insert-file-contents draft-name)
455 (delete-file draft-name))))))
456 (cond ((and initial-contents
457 (or (zerop (buffer-size))
458 (not (y-or-n-p
459 (format "A draft exists. Use for %s? " use)))))
460 (erase-buffer)
461 (insert-file-contents initial-contents)
462 (if delete-contents-file (delete-file initial-contents))))
463 (auto-save-mode 1)
464 (if mh-draft-folder
465 (save-buffer)) ; Do not reuse draft name
466 (buffer-name))
467
468
469(defun mh-new-draft-name ()
470 ;; Returns the pathname of folder for draft messages.
471 (save-excursion
472 (mh-exec-cmd-quiet t "mhpath" mh-draft-folder "new")
473 (buffer-substring (point-min) (1- (point-max)))))
474
475
476(defun mh-annotate-msg (msg buffer note &rest args)
477 ;; Mark the MESSAGE in BUFFER listing with the character NOTE and annotate
478 ;; the saved message with ARGS.
479 (apply 'mh-exec-cmd "anno" buffer msg args)
480 (save-excursion
481 (cond ((get-buffer buffer) ; Buffer may be deleted
482 (set-buffer buffer)
483 (if (symbolp msg)
484 (mh-notate-seq msg note (1+ mh-cmd-note))
485 (mh-notate msg note (1+ mh-cmd-note)))))))
486
487
488(defun mh-insert-fields (&rest name-values)
489 ;; Insert the NAME-VALUE pairs in the current buffer.
490 ;; If field NAME exists, append VALUE to it.
491 ;; Do not insert any pairs whose value is the empty string.
492 (let ((case-fold-search t))
493 (while name-values
494 (let ((field-name (car name-values))
495 (value (car (cdr name-values))))
496 (cond ((equal value "")
497 nil)
498 ((mh-position-on-field field-name)
499 (insert " " value))
500 (t
501 (insert field-name " " value "\n")))
502 (setq name-values (cdr (cdr name-values)))))))
503
504
505(defun mh-position-on-field (field &optional ignore)
506 ;; Move to the end of the FIELD in the header.
507 ;; Move to end of entire header if FIELD not found.
508 ;; Returns non-nil iff FIELD was found.
509 ;; The optional second arg is for pre-version 4 compatibility.
510 (let ((case-fold-search t))
511 (goto-char (point-min))
512 (mh-goto-header-end 0)
513 (if (re-search-backward (format "^%s" field) nil t)
514 (progn
515 (forward-line 1)
516 (while (looking-at "^[ \t]")
517 (forward-line 1))
518 (backward-char 1) ;to end of previous line
519 t)
520 nil)))
521
522
523(defun mh-goto-header-end (arg)
524 ;; Find the end of the message header in the current buffer and position
525 ;; the cursor at the ARG'th newline after the header.
526 (if (re-search-forward "^$\\|^-+$" nil nil)
527 (forward-line arg)))
528
529
530(defun mh-read-address (prompt)
531 ;; Read a To: or Cc: address, prompting in the minibuffer with PROMPT.
532 ;; May someday do completion on aliases.
533 (read-string prompt))
534
535
536
537;;; Mode for composing and sending a draft message.
538
539(defvar mh-sent-from-folder nil
540 "Folder of msg associated with this letter.")
541
542(defvar mh-sent-from-msg nil
543 "Number of msg associated with this letter.")
544
545(defvar mh-send-args nil
546 "Extra arguments to pass to \"send\" command.")
547
548(defvar mh-annotate-char nil
549 "Character to use to annotate mh-sent-from-msg.")
550
551(defvar mh-annotate-field nil
552 "Field name for message annotation.")
553
554(put 'mh-letter-mode 'mode-class 'special)
555
556;;;###autoload
557(defun mh-letter-mode ()
558 "Mode for composing letters in mh-e.\\<mh-letter-mode-map>
559When you have finished composing, type \\[mh-send-letter] to send the letter.
560
561\\{mh-letter-mode-map}
562
563Variables controlling this mode (defaults in parentheses):
564
565 mh-delete-yanked-msg-window (nil)
566 If non-nil, \\[mh-yank-cur-msg] will delete any windows displaying
567 the yanked message.
568
569 mh-yank-from-start-of-msg (t)
570 If non-nil, \\[mh-yank-cur-msg] will include the entire message.
571 If `body', just yank the body (no header).
572 If nil, only the portion of the message following the point will be yanked.
573 If there is a region, this variable is ignored.
574
575 mh-signature-file-name (\"~/.signature\")
576 File to be inserted into message by \\[mh-insert-signature].
577
578Upon invoking mh-letter-mode, text-mode-hook and mh-letter-mode-hook are
579invoked with no args, if those values are non-nil."
580
581 (interactive)
582 (or mh-user-path (mh-find-path))
583 (kill-all-local-variables)
584 (make-local-variable 'paragraph-start)
585 (setq paragraph-start (concat "^[ \t]*[-_][-_][-_]+$\\|" paragraph-start))
586 (make-local-variable 'paragraph-separate)
587 (setq paragraph-separate
588 (concat "^[ \t]*[-_][-_][-_]+$\\|" paragraph-separate))
589 (make-local-variable 'mh-send-args)
590 (make-local-variable 'mh-annotate-char)
591 (make-local-variable 'mh-annotate-field)
592 (make-local-variable 'mh-previous-window-config)
593 (make-local-variable 'mh-sent-from-folder)
594 (make-local-variable 'mh-sent-from-msg)
595 (make-local-variable 'mail-header-separator)
596 (setq mail-header-separator "--------") ;for Hyperbole
597 (use-local-map mh-letter-mode-map)
598 (setq major-mode 'mh-letter-mode)
599 (mh-set-mode-name "MH-Letter")
600 (set-syntax-table mh-letter-mode-syntax-table)
601 (run-hooks 'text-mode-hook)
602 ;; if text-mode-hook turned on auto-fill, tune it for messages
603 (cond ((and (boundp 'auto-fill-hook) auto-fill-hook) ;emacs 18
604 (make-local-variable 'auto-fill-hook)
605 (setq auto-fill-hook 'mh-auto-fill-for-letter)))
606 (cond ((and (boundp 'auto-fill-function) auto-fill-function) ;emacs 19
607 (make-local-variable 'auto-fill-function)
608 (setq auto-fill-function 'mh-auto-fill-for-letter)))
609 (run-hooks 'mh-letter-mode-hook))
610
611
612(defun mh-auto-fill-for-letter ()
613 ;; Auto-fill in letters treats the header specially by inserting a tab
614 ;; before continuation line.
615 (do-auto-fill)
616 (if (mh-in-header-p)
617 (save-excursion
618 (beginning-of-line nil)
619 (insert-char ?\t 1))))
620
621
622(defun mh-in-header-p ()
623 ;; Return non-nil if the point is in the header of a draft message.
624 (save-excursion
625 (let ((cur-point (point)))
626 (goto-char (point-min))
627 (re-search-forward "^-*$" nil t)
628 (< cur-point (point)))))
629
630
631(defun mh-to-field ()
632 "Move point to the end of a specified header field.
633The field is indicated by the previous keystroke (the last keystroke
634of the command) according to the list in mh-to-field-choices.
635Create the field if it does not exist. Set the mark to point before moving."
636 (interactive)
637 (expand-abbrev)
638 (let ((target (cdr (assoc (logior last-input-char ?`) mh-to-field-choices)))
639 (case-fold-search t))
640 (push-mark)
641 (cond ((mh-position-on-field target)
642 (let ((eol (point)))
643 (skip-chars-backward " \t")
644 (delete-region (point) eol))
645 (if (and (not (eq (logior last-input-char ?`) ?s))
646 (save-excursion
647 (backward-char 1)
648 (not (looking-at "[:,]"))))
649 (insert ", ")
650 (insert " ")))
651 (t
652 (if (mh-position-on-field "To:")
653 (forward-line 1))
654 (insert (format "%s \n" target))
655 (backward-char 1)))))
656
657
658(defun mh-to-fcc (&optional folder)
659 "Insert an Fcc: FOLDER field in the current message.
660Prompt for the field name with a completion list of the current folders."
661 (interactive)
662 (or folder
663 (setq folder (mh-prompt-for-folder
664 "Fcc"
665 (or (and mh-msg-folder-hook
666 (save-excursion
667 (goto-char (point-min))
668 (funcall mh-msg-folder-hook)))
669 "")
670 t)))
671 (let ((last-input-char ?\C-f))
672 (expand-abbrev)
673 (save-excursion
674 (mh-to-field)
675 (insert (if (mh-folder-name-p folder)
676 (substring folder 1)
677 folder)))))
678
679
680(defun mh-insert-signature ()
681 "Insert the file named by mh-signature-file-name at the current point."
682 (interactive)
683 (insert-file-contents mh-signature-file-name)
684 (set-buffer-modified-p (buffer-modified-p))) ; force mode line update
685
686
687(defun mh-check-whom ()
688 "Verify recipients of the current letter."
689 (interactive)
690 (let ((file-name (buffer-file-name)))
691 (save-buffer)
692 (message "Checking recipients...")
693 (mh-in-show-buffer ("*Recipients*")
694 (bury-buffer (current-buffer))
695 (erase-buffer)
696 (mh-exec-cmd-output "whom" t file-name))
697 (message "Checking recipients...done")))
698
699
700
701;;; Routines to compose and send a letter.
702
703(defun mh-compose-and-send-mail (draft send-args
704 sent-from-folder sent-from-msg
705 to subject cc
706 annotate-char annotate-field
707 config)
708 ;; Edit and compose a draft message in buffer DRAFT and send or save it.
709 ;; SENT-FROM-FOLDER is buffer containing scan listing of current folder, or
710 ;; nil if none exists.
711 ;; SENT-FROM-MSG is the message number or sequence name or nil.
712 ;; SEND-ARGS is an optional argument passed to the send command.
713 ;; The TO, SUBJECT, and CC fields are passed to the
714 ;; mh-compose-letter-function.
715 ;; If ANNOTATE-CHAR is non-null, it is used to notate the scan listing of the
716 ;; message. In that case, the ANNOTATE-FIELD is used to build a string
717 ;; for mh-annotate-msg.
718 ;; CONFIG is the window configuration to restore after sending the letter.
719 (pop-to-buffer draft)
720 (mh-letter-mode)
721 (setq mh-sent-from-folder sent-from-folder)
722 (setq mh-sent-from-msg sent-from-msg)
723 (setq mh-send-args send-args)
724 (setq mh-annotate-char annotate-char)
725 (setq mh-annotate-field annotate-field)
726 (setq mh-previous-window-config config)
727 (setq mode-line-buffer-identification (list "{%b}"))
728 (if (and (boundp 'mh-compose-letter-function)
729 (symbol-value 'mh-compose-letter-function))
730 ;; run-hooks will not pass arguments.
731 (let ((value (symbol-value 'mh-compose-letter-function)))
732 (if (and (listp value) (not (eq (car value) 'lambda)))
733 (while value
734 (funcall (car value) to subject cc)
735 (setq value (cdr value)))
736 (funcall mh-compose-letter-function to subject cc)))))
737
738
739(defun mh-send-letter (&optional arg)
740 "Send the draft letter in the current buffer.
741If optional prefix argument is provided, monitor delivery.
742Run mh-before-send-letter-hook before doing anything."
743 (interactive "P")
744 (run-hooks 'mh-before-send-letter-hook)
745 (set-buffer-modified-p t) ; Make sure buffer is written
746 (save-buffer)
747 (message "Sending...")
748 (let ((draft-buffer (current-buffer))
749 (file-name (buffer-file-name))
750 (config mh-previous-window-config))
751 (cond (arg
752 (pop-to-buffer "MH mail delivery")
753 (erase-buffer)
754 (mh-exec-cmd-output mh-send-prog t "-watch" "-nopush"
755 "-nodraftfolder" mh-send-args file-name)
756 (goto-char (point-max)) ; show the interesting part
757 (recenter -1)
758 (set-buffer draft-buffer)) ; for annotation below
759 (t
760 (mh-exec-cmd-daemon mh-send-prog "-nodraftfolder" "-noverbose"
761 mh-send-args file-name)))
762 (if mh-annotate-char
763 (mh-annotate-msg mh-sent-from-msg
764 mh-sent-from-folder
765 mh-annotate-char
766 "-component" mh-annotate-field
767 "-text" (format "\"%s %s\""
768 (mh-get-field "To:")
769 (mh-get-field "Cc:"))))
770
771 (cond ((or (not arg)
772 (y-or-n-p "Kill draft buffer? "))
773 (kill-buffer draft-buffer)
774 (if config
775 (set-window-configuration config))))
776 (if arg
777 (message "Sending...done")
778 (message "Sending...backgrounded"))))
779
780
781(defun mh-insert-letter (msg folder verbatum)
782 "Insert a MESSAGE from any FOLDER into the current letter.
783Removes the message's headers using mh-invisible-headers.
784Prefixes each non-blank line with mh-ins-buf-prefix (default \"> \").
785If prefix argument VERBATUM provided, do not indent and do not delete
786headers. Leaves the mark before the letter and point after it."
787 (interactive
788 (list (read-input (format "Message number%s: "
789 (if mh-sent-from-msg
790 (format " [%d]" mh-sent-from-msg)
791 "")))
792 (mh-prompt-for-folder "Message from" mh-sent-from-folder nil)
793 current-prefix-arg))
794 (save-restriction
795 (narrow-to-region (point) (point))
796 (let ((start (point-min)))
797 (if (equal msg "") (setq msg (int-to-string mh-sent-from-msg)))
798 (mh-exec-lib-cmd-output "mhl" "-nobell" "-noclear"
799 (expand-file-name msg
800 (mh-expand-file-name folder)))
801 (cond ((not verbatum)
802 (mh-clean-msg-header start mh-invisible-headers mh-visible-headers)
803 (set-mark start) ; since mh-clean-msg-header moves it
804 (mh-insert-prefix-string mh-ins-buf-prefix))))))
805
806
807(defun mh-yank-cur-msg ()
808 "Insert the current message into the draft buffer.
809Prefix each non-blank line in the message with the string in
810`mh-ins-buf-prefix'. If a region is set in the message's buffer, then
811only the region will be inserted. Otherwise, the entire message will
812be inserted if `mh-yank-from-start-of-msg' is non-nil. If this variable
813is nil, the portion of the message following the point will be yanked.
814If `mh-delete-yanked-msg-window' is non-nil, any window displaying the
815yanked message will be deleted."
816 (interactive)
817 (if (and mh-sent-from-folder mh-sent-from-msg)
818 (let ((to-point (point))
819 (to-buffer (current-buffer)))
820 (set-buffer mh-sent-from-folder)
821 (if mh-delete-yanked-msg-window
822 (delete-windows-on mh-show-buffer))
823 (set-buffer mh-show-buffer) ; Find displayed message
824 (let ((mh-ins-str (cond ((if (boundp 'mark-active)
825 mark-active ;Emacs 19
826 (mark)) ;Emacs 18
827 (buffer-substring (region-beginning)
828 (region-end)))
829 ((eq 'body mh-yank-from-start-of-msg)
830 (buffer-substring
831 (save-excursion
832 (goto-char (point-min))
833 (mh-goto-header-end 1)
834 (point))
835 (point-max)))
836 (mh-yank-from-start-of-msg
837 (buffer-substring (point-min) (point-max)))
838 (t
839 (buffer-substring (point) (point-max))))))
840 (set-buffer to-buffer)
841 (narrow-to-region to-point to-point)
842 (push-mark)
843 (insert mh-ins-str)
844 (mh-insert-prefix-string mh-ins-buf-prefix)
845 (insert "\n")
846 (widen)))
847 (error "There is no current message")))
848
849
850(defun mh-insert-prefix-string (mh-ins-string)
851 ;; Run MAIL-CITATION-HOOK to insert a prefix string before each line
852 ;; in the buffer. Generality for supercite users.
853 (save-excursion
854 (set-mark (point-max))
855 (goto-char (point-min))
856 (cond (mail-citation-hook
857 (run-hooks 'mail-citation-hook))
858 (mh-yank-hooks ;old hook name
859 (run-hooks 'mh-yank-hooks))
860 (t
861 (or (bolp) (forward-line 1))
862 (while (< (point) (mark))
863 (insert mh-ins-string)
864 (forward-line 1))))))
865
866
867(defun mh-fully-kill-draft ()
868 "Kill the draft message file and the draft message buffer.
869Use \\[kill-buffer] if you don't want to delete the draft message file."
870 (interactive)
871 (if (y-or-n-p "Kill draft message? ")
872 (let ((config mh-previous-window-config))
873 (if (file-exists-p (buffer-file-name))
874 (delete-file (buffer-file-name)))
875 (set-buffer-modified-p nil)
876 (kill-buffer (buffer-name))
877 (message "")
878 (if config
879 (set-window-configuration config)))
880 (error "Message not killed")))
881
882;;; Build the letter-mode keymap:
883
884(define-key mh-letter-mode-map "\C-c\C-f\C-b" 'mh-to-field)
885(define-key mh-letter-mode-map "\C-c\C-f\C-c" 'mh-to-field)
886(define-key mh-letter-mode-map "\C-c\C-f\C-f" 'mh-to-fcc)
887(define-key mh-letter-mode-map "\C-c\C-f\C-s" 'mh-to-field)
888(define-key mh-letter-mode-map "\C-c\C-f\C-t" 'mh-to-field)
889(define-key mh-letter-mode-map "\C-c\C-fb" 'mh-to-field)
890(define-key mh-letter-mode-map "\C-c\C-fc" 'mh-to-field)
891(define-key mh-letter-mode-map "\C-c\C-ff" 'mh-to-fcc)
892(define-key mh-letter-mode-map "\C-c\C-fs" 'mh-to-field)
893(define-key mh-letter-mode-map "\C-c\C-ft" 'mh-to-field)
894(define-key mh-letter-mode-map "\C-c\C-q" 'mh-fully-kill-draft)
895(define-key mh-letter-mode-map "\C-c\C-w" 'mh-check-whom)
896(define-key mh-letter-mode-map "\C-c\C-i" 'mh-insert-letter)
897(define-key mh-letter-mode-map "\C-c\C-y" 'mh-yank-cur-msg)
898(define-key mh-letter-mode-map "\C-c\C-s" 'mh-insert-signature)
899(define-key mh-letter-mode-map "\C-c\C-c" 'mh-send-letter)
900(define-key mh-letter-mode-map "\C-c\C-m\C-f" 'mh-mhn-compose-forw)
901(define-key mh-letter-mode-map "\C-c\C-m\C-e" 'mh-mhn-compose-anon-ftp)
902(define-key mh-letter-mode-map "\C-c\C-m\C-t" 'mh-mhn-compose-external-compressed-tar)
903(define-key mh-letter-mode-map "\C-c\C-m\C-i" 'mh-mhn-compose-insertion)
904(define-key mh-letter-mode-map "\C-c\C-e" 'mh-edit-mhn)
905(define-key mh-letter-mode-map "\C-c\C-m\C-u" 'mh-revert-mhn-edit)
906
907
908;;; autoloads from mh-mime
909
910(autoload 'mh-mhn-compose-insertion "mh-mime"
911 "Add a directive to insert a message part from a file." t)
912(autoload 'mh-mhn-compose-anon-ftp "mh-mime"
913 "Add a directive for an anonymous ftp external body part." t)
914(autoload 'mh-mhn-compose-external-compressed-tar "mh-mime"
915 "Add a directive to include a reference to a compressed tar file." t)
916(autoload 'mh-mhn-compose-forw "mh-mime"
917 "Add a forw directive to this message." t)
918(autoload 'mh-edit-mhn "mh-mime"
919 "Filter the current draft through the mhn program for MIME formatting.
920Using directives already inserted in the draft, fills in
921all the MIME components and header fields.
922This step should be done last just before sending the message.
923The mhn program is part of MH version 6.8 or later.
924The `\\[mh-revert-mhn-edit]' command undoes this command.
925For assistance with creating MIME directives to insert
926various types of components in a message, see
927\\[mh-mhn-compose-insertion] (generic insertion from a file),
928\\[mh-mhn-compose-anon-ftp] (external reference to file via anonymous ftp),
929\\[mh-mhn-compose-external-compressed-tar] \
930\(reference to compressed tar file via anonymous ftp), and
931\\[mh-mhn-compose-forw] (forward message)." t)
932
933(autoload 'mh-revert-mhn-edit "mh-mime"
934 "Undoes the effect of \\[mh-edit-mhn] by reverting to the backup file." t)
diff --git a/lisp/mail/mh-e.el b/lisp/mail/mh-e.el
new file mode 100644
index 00000000000..460bfc53c92
--- /dev/null
+++ b/lisp/mail/mh-e.el
@@ -0,0 +1,1334 @@
1;;; mh-e.el --- GNU Emacs interface to the MH mail system
2
3;;; Copyright 1985,86,87,88,90,92,93 Free Software Foundation
4
5(defconst mh-e-time-stamp "Time-stamp: <94/03/14 18:34:22 gildea>")
6(defconst mh-e-version "4.0"
7 "Version numbers of this version of mh-e.")
8
9;; Maintainer: Stephen Gildea <gildea@lcs.mit.edu>
10;; Version: 4.0
11;; Keywords: mail
12
13;; mh-e is free software; you can redistribute it and/or modify
14;; it under the terms of the GNU General Public License as published by
15;; the Free Software Foundation; either version 2, or (at your option)
16;; any later version.
17
18;; mh-e is distributed in the hope that it will be useful,
19;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21;; GNU General Public License for more details.
22
23;; You should have received a copy of the GNU General Public License
24;; along with mh-e; see the file COPYING. If not, write to
25;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, 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;;; Your .emacs might benefit from these bindings:
34;;; (global-set-key "\C-cr" 'mh-rmail)
35;;; (global-set-key "\C-xm" 'mh-smail)
36;;; (global-set-key "\C-x4m" 'mh-smail-other-window)
37
38;;; MH (Message Handler) is a powerful mail reader. The MH newsgroup
39;;; is comp.mail.mh; the mailing list is mh-users@ics.uci.edu (send to
40;;; mh-users-request to be added). See the monthly Frequently Asked
41;;; Questions posting there for information on getting MH.
42
43;;; mh-e works with Emacs 18 or 19, and MH 5 or 6.
44
45;;; NB. MH must have been compiled with the MHE compiler flag or several
46;;; features necessary mh-e will be missing from MH commands, specifically
47;;; the -build switch to repl and forw.
48
49;;; Change Log:
50
51;;; Original version for Gosling emacs by Brian Reid, Stanford, 1982.
52;;; Modified by James Larus, BBN, July 1984 and UCB, 1984 & 1985.
53;;; Rewritten for GNU Emacs, James Larus 1985. larus@ginger.berkeley.edu
54;;; Modified by Stephen Gildea 1988. gildea@lcs.mit.edu
55(defconst mh-e-RCS-id "$Header: mh-e.el,v 3.14 94/03/14 18:34:49 gildea Exp $")
56
57;;; Code:
58
59(provide 'mh-e)
60(require 'mh-utils)
61
62
63;;; Site customization:
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,
77the mhl program and the components file.")
78
79(defvar mh-redist-full-contents nil
80 "Non-nil if the `dist' command needs whole letter for redistribution.
81This is the case when `send' is compiled with the BERK option.
82If MH will not allow you to redist a previously redist'd msg, set to nil.")
83
84;;; Hooks:
85
86(defvar mh-folder-mode-hook nil
87 "Invoked in `mh-folder mode' on a new folder.")
88
89(defvar mh-inc-folder-hook nil
90 "Invoked by \\<mh-folder-mode-map>`\\[mh-inc-folder]' after incorporating mail into a folder.")
91
92(defvar mh-show-hook nil
93 "Invoked after \\<mh-folder-mode-map>`\\[mh-show]' shows a message.")
94
95(defvar mh-show-mode-hook nil
96 "Invoked in mh-show mode in each message.")
97
98(defvar mh-delete-msg-hook nil
99 "Invoked after marking each message for deletion.")
100
101(defvar mh-refile-msg-hook nil
102 "Invoked after marking each message for refiling.")
103
104(defvar mh-before-quit-hook nil
105 "Invoked by \\<mh-folder-mode-map>`\\[mh-quit]' before quitting mh-e. See also mh-quit-hook.")
106
107(defvar mh-quit-hook nil
108 "Invoked after \\<mh-folder-mode-map>`\\[mh-quit]' quits mh-e. See also mh-before-quit-hook.")
109
110
111
112;;; Personal preferences:
113
114(defvar mh-lpr-command-format "lpr -p -J '%s'"
115 "*Format for Unix command that prints a message.
116The string should be a Unix command line, with the string '%s' where
117the job's name (folder and message number) should appear. The formatted
118message text is piped to this command when you type \\<mh-folder-mode-map>`\\[mh-print-msg]'.")
119
120(defvar mh-scan-prog "scan"
121 "*Program to run to generate one-line-per-message listing of a folder.
122Normally \"scan\" or a file name linked to scan. This file is searched
123for relative to the mh-progs directory unless it is an absolute pathname.
124Automatically becomes buffer-local when set in any fashion.")
125(make-variable-buffer-local 'mh-scan-prog)
126
127(defvar mh-inc-prog "inc"
128 "*Program to run to incorporate new mail into a folder.
129Normally \"inc\". This file is searched for relative to
130the mh-progs directory unless it is an absolute pathname.")
131
132(defvar mh-print-background nil
133 "*Print messages in the background if non-nil.
134WARNING: do not delete the messages until printing is finished;
135otherwise, your output may be truncated.")
136
137(defvar mh-recenter-summary-p nil
138 "*Recenter summary window when the show window is toggled off if non-nil.")
139
140(defvar mh-ins-buf-prefix "> "
141 "*String to put before each non-blank line of a yanked or inserted message.
142\\<mh-letter-mode-map>Used when the message is inserted into an outgoing letter
143by \\[mh-insert-letter] or \\[mh-yank-cur-msg].")
144
145(defvar mh-do-not-confirm nil
146 "*Non-nil means do not prompt for confirmation before some mh-e commands.
147Affects non-recoverable commands such as mh-kill-folder and mh-undo-folder.")
148
149(defvar mh-store-default-directory nil
150 "*Last directory used by \\[mh-store-msg]; default for next store.
151A directory name string, or nil to use current directory.")
152
153;;; Parameterize mh-e to work with different scan formats. The defaults work
154;;; with the standard MH scan listings, in which the first 4 characters on
155;;; the line are the message number, followed by two places for notations.
156
157(defvar mh-good-msg-regexp "^....[^D^]"
158 "Regexp specifiying the scan lines that are 'good' messages.")
159
160(defvar mh-deleted-msg-regexp "^....D"
161 "Regexp matching scan lines of deleted messages.")
162
163(defvar mh-refiled-msg-regexp "^....\\^"
164 "Regexp matching scan lines of refiled messages.")
165
166(defvar mh-valid-scan-line "^ *[0-9]"
167 "Regexp matching scan lines for messages (not error messages).")
168
169(defvar mh-flagged-scan-msg-regexp "^....\\D\\|^....\\^\\|^....\\+\\|^.....%"
170 "Regexp matching flagged scan lines.
171Matches lines marked as deleted, refiled, in a sequence, or the cur message.")
172
173(defvar mh-cur-scan-msg-regexp "^....\\+"
174 "Regexp matching scan line for the cur message.")
175
176(defvar mh-show-buffer-mode-line-buffer-id "{show-%s} %d"
177 "Format string to produce `mode-line-buffer-identification' for show buffers.
178First argument is folder name. Second is message number.")
179
180(defvar mh-partial-folder-mode-line-annotation "select"
181 "Annotation when displaying part of a folder.
182The string is displayed after the folder's name. NIL for no annotation.")
183
184
185;;; Internal variables:
186
187(defvar mh-last-destination nil
188 "Destination of last refile or write command.")
189
190(defvar mh-folder-mode-map (make-keymap)
191 "Keymap for MH folders.")
192
193(defvar mh-next-seq-num nil
194 "Index of free sequence id.")
195
196(defvar mh-delete-list nil
197 "List of msg numbers to delete.")
198
199(defvar mh-refile-list nil
200 "List of folder names in mh-seq-list.")
201
202(defvar mh-next-direction 'forward
203 "Direction to move to next message.")
204
205(defvar mh-narrowed-to-seq nil
206 "Sequence display is narrowed to.")
207
208(defvar mh-first-msg-num nil
209 "Number of first msg in buffer.")
210
211(defvar mh-last-msg-num nil
212 "Number of last msg in buffer.")
213
214
215;;; Macros and generic functions:
216
217(defun mh-mapc (func list)
218 (while list
219 (funcall func (car list))
220 (setq list (cdr list))))
221
222
223
224;;; Entry points:
225
226;;;###autoload
227(defun mh-rmail (&optional arg)
228 "Inc(orporate) new mail with MH, or, with arg, scan an MH mail folder.
229This function is an entry point to mh-e, the Emacs front end
230to the MH mail system."
231 (interactive "P")
232 (mh-find-path)
233 (if arg
234 (call-interactively 'mh-visit-folder)
235 (mh-inc-folder)))
236
237
238;;; mh-smail and mh-smail-other-window have been moved to the new file
239;;; mh-comp.el, but Emacs 18 still looks for them here, so provide a
240;;; definition here, too, for a while.
241
242(defun mh-smail ()
243 "Compose and send mail with the MH mail system.
244This function is an entry point to mh-e, the Emacs front end
245to the MH mail system."
246 (interactive)
247 (mh-find-path)
248 (require 'mh-comp)
249 (call-interactively 'mh-send))
250
251
252(defun mh-smail-other-window ()
253 "Compose and send mail in other window with the MH mail system.
254This function is an entry point to mh-e, the Emacs front end
255to the MH mail system."
256 (interactive)
257 (mh-find-path)
258 (require 'mh-comp)
259 (call-interactively 'mh-send-other-window))
260
261
262
263;;; User executable mh-e commands:
264
265
266(defun mh-delete-msg (msg-or-seq)
267 "Mark the specified MESSAGE(s) for subsequent deletion and move to the next.
268Default is the displayed message. If optional prefix argument is
269given then prompt for the message sequence."
270 (interactive (list (if current-prefix-arg
271 (mh-read-seq-default "Delete" t)
272 (mh-get-msg-num t))))
273 (mh-delete-msg-no-motion msg-or-seq)
274 (mh-next-msg))
275
276
277(defun mh-delete-msg-no-motion (msg-or-seq)
278 "Mark the specified MESSAGE(s) for subsequent deletion.
279Default is the displayed message. If optional prefix argument is
280provided, then prompt for the message sequence."
281 (interactive (list (if current-prefix-arg
282 (mh-read-seq-default "Delete" t)
283 (mh-get-msg-num t))))
284 (if (numberp msg-or-seq)
285 (mh-delete-a-msg msg-or-seq)
286 (mh-map-to-seq-msgs 'mh-delete-a-msg msg-or-seq)))
287
288
289(defun mh-execute-commands ()
290 "Process outstanding delete and refile requests."
291 (interactive)
292 (if mh-narrowed-to-seq (mh-widen))
293 (mh-process-commands mh-current-folder)
294 (mh-set-scan-mode)
295 (mh-goto-cur-msg) ; after mh-set-scan-mode for efficiency
296 (mh-make-folder-mode-line)
297 t) ; return t for write-file-hooks
298
299
300(defun mh-first-msg ()
301 "Move to the first message."
302 (interactive)
303 (goto-char (point-min)))
304
305
306(defun mh-header-display ()
307 "Show the current message with all its headers.
308Displays headers that might have been suppressed by mh-clean-message-header,
309mhl-formfile, or the fallback behavior of scrolling uninteresting headers
310off the top of the window. Type \"\\[mh-show]\" to show the message
311normally again."
312 (interactive)
313 (and (not mh-showing-with-headers)
314 (or mhl-formfile mh-clean-message-header)
315 (mh-invalidate-show-buffer))
316 (let ((mhl-formfile nil)
317 (mh-clean-message-header nil))
318 (mh-show-msg nil)
319 (mh-in-show-buffer (mh-show-buffer)
320 (goto-char (point-min))
321 (mh-recenter 0))
322 (setq mh-showing-with-headers t)))
323
324
325(defun mh-inc-folder (&optional maildrop-name)
326 "Inc(orporate)s new mail into +inbox.
327Optional prefix argument specifies an alternate maildrop from the default.
328If this is given, incorporates mail into the current folder, rather
329than +inbox. Runs `mh-inc-folder-hook' after incorporating new mail.
330Do not call this function from outside mh-e; use \\[mh-rmail] instead."
331 (interactive (list (if current-prefix-arg
332 (expand-file-name
333 (read-file-name "inc mail from file: "
334 mh-user-path)))))
335 (let ((config (current-window-configuration)))
336 (if (not maildrop-name)
337 (cond ((not (get-buffer "+inbox"))
338 (mh-make-folder "+inbox")
339 (setq mh-previous-window-config config))
340 ((not (eq (current-buffer) (get-buffer "+inbox")))
341 (switch-to-buffer "+inbox")
342 (setq mh-previous-window-config config)))))
343 (mh-get-new-mail maildrop-name)
344 (run-hooks 'mh-inc-folder-hook))
345
346
347(defun mh-last-msg ()
348 "Move to the last message."
349 (interactive)
350 (goto-char (point-max))
351 (while (and (not (bobp)) (looking-at "^$"))
352 (forward-line -1)))
353
354
355(defun mh-next-undeleted-msg (&optional arg)
356 "Move to next undeleted message in window."
357 (interactive "P")
358 (forward-line (prefix-numeric-value arg))
359 (setq mh-next-direction 'forward)
360 (cond ((re-search-forward mh-good-msg-regexp nil 0 arg)
361 (beginning-of-line)
362 (mh-maybe-show))
363 (t
364 (forward-line -1)
365 (if (get-buffer mh-show-buffer)
366 (delete-windows-on mh-show-buffer)))))
367
368
369(defun mh-refile-msg (msg-or-seq dest)
370 "Refile MESSAGE(s) (default: displayed message) in FOLDER.
371If optional prefix argument provided, then prompt for message sequence."
372 (interactive
373 (list (if current-prefix-arg
374 (mh-read-seq-default "Refile" t)
375 (mh-get-msg-num t))
376 (intern
377 (mh-prompt-for-folder
378 "Destination"
379 (or (and mh-msg-folder-hook
380 (let ((file-name (mh-msg-filename (mh-get-msg-num t))))
381 (save-excursion
382 (set-buffer (get-buffer-create " *mh-temp*"))
383 (erase-buffer)
384 (insert-file-contents file-name)
385 (let ((buffer-file-name file-name))
386 (funcall mh-msg-folder-hook)))))
387 (and (eq 'refile (car mh-last-destination))
388 (symbol-name (cdr mh-last-destination)))
389 "")
390 t))))
391 (setq mh-last-destination (cons 'refile dest))
392 (if (numberp msg-or-seq)
393 (mh-refile-a-msg msg-or-seq dest)
394 (mh-map-to-seq-msgs 'mh-refile-a-msg msg-or-seq dest))
395 (mh-next-msg))
396
397
398(defun mh-refile-or-write-again (msg)
399 "Re-execute the last refile or write command on the given MESSAGE.
400Default is the displayed message. Use the same folder or file as the
401previous refile or write command."
402 (interactive (list (mh-get-msg-num t)))
403 (if (null mh-last-destination)
404 (error "No previous refile or write"))
405 (cond ((eq (car mh-last-destination) 'refile)
406 (mh-refile-a-msg msg (cdr mh-last-destination))
407 (message "Destination folder: %s" (cdr mh-last-destination)))
408 (t
409 (apply 'mh-write-msg-to-file msg (cdr mh-last-destination))
410 (message "Destination: %s" (cdr mh-last-destination))))
411 (mh-next-msg))
412
413
414(defun mh-quit ()
415 "Quit mh-e.
416Start by running mh-before-quit-hook. Restore the previous window
417configuration, if one exists. Finish by running mh-quit-hook."
418 (interactive)
419 (run-hooks 'mh-before-quit-hook)
420 (mh-update-unseen)
421 (mh-invalidate-show-buffer)
422 (bury-buffer (current-buffer))
423 (if (get-buffer mh-show-buffer)
424 (bury-buffer mh-show-buffer))
425 (if mh-previous-window-config
426 (set-window-configuration mh-previous-window-config))
427 (run-hooks 'mh-quit-hook))
428
429(defun mh-page-msg (&optional arg)
430 "Page the displayed message forwards.
431Scrolls ARG lines or a full screen if no argument is supplied."
432 (interactive "P")
433 (scroll-other-window arg))
434
435
436(defun mh-previous-page (&optional arg)
437 "Page the displayed message backwards.
438Scrolls ARG lines or a full screen if no argument is supplied."
439 (interactive "P")
440 (mh-in-show-buffer (mh-show-buffer)
441 (scroll-down arg)))
442
443
444(defun mh-previous-undeleted-msg (&optional arg)
445 "Move to previous undeleted message in window."
446 (interactive "p")
447 (setq mh-next-direction 'backward)
448 (beginning-of-line)
449 (cond ((re-search-backward mh-good-msg-regexp nil 0 arg)
450 (mh-maybe-show))
451 (t
452 (if (get-buffer mh-show-buffer)
453 (delete-windows-on mh-show-buffer)))))
454
455
456(defun mh-rescan-folder (&optional range)
457 "Rescan a folder after optionally processing the outstanding commands.
458If optional prefix argument is provided, prompt for the range of
459messages to display. Otherwise show the entire folder."
460 (interactive (list (if current-prefix-arg
461 (mh-read-msg-range "Range to scan [all]? ")
462 nil)))
463 (setq mh-next-direction 'forward)
464 (mh-scan-folder mh-current-folder (or range "all")))
465
466
467(defun mh-write-msg-to-file (msg file no-headers)
468 "Append MESSAGE to the end of a FILE.
469If NO-HEADERS (prefix argument) is provided, write only the message body.
470Otherwise send the entire message including the headers."
471 (interactive
472 (list (mh-get-msg-num t)
473 (let ((default-dir (if (eq 'write (car mh-last-destination))
474 (file-name-directory (car (cdr mh-last-destination)))
475 default-directory)))
476 (read-file-name "Save message in file: " default-dir
477 (expand-file-name "mail.out" default-dir)))
478 current-prefix-arg))
479 (let ((file-name (mh-msg-filename msg))
480 (output-file (mh-expand-file-name file)))
481 (setq mh-last-destination (list 'write file no-headers))
482 (save-excursion
483 (set-buffer (get-buffer-create " *mh-temp*"))
484 (erase-buffer)
485 (insert-file-contents file-name)
486 (goto-char (point-min))
487 (if no-headers (search-forward "\n\n"))
488 (append-to-file (point) (point-max) output-file))))
489
490
491(defun mh-toggle-showing ()
492 "Toggle the scanning mode/showing mode of displaying messages."
493 (interactive)
494 (if mh-showing
495 (mh-set-scan-mode)
496 (mh-show)))
497
498
499(defun mh-undo (msg-or-seq)
500 "Undo the deletion or refile of the specified MESSAGE(s).
501Default is the displayed message. If optional prefix argument is
502provided, then prompt for the message sequence."
503 (interactive (list (if current-prefix-arg
504 (mh-read-seq-default "Undo" t)
505 (mh-get-msg-num t))))
506 (cond ((numberp msg-or-seq)
507 (let ((original-position (point)))
508 (beginning-of-line)
509 (while (not (or (looking-at mh-deleted-msg-regexp)
510 (looking-at mh-refiled-msg-regexp)
511 (and (eq mh-next-direction 'forward) (bobp))
512 (and (eq mh-next-direction 'backward)
513 (save-excursion (forward-line) (eobp)))))
514 (forward-line (if (eq mh-next-direction 'forward) -1 1)))
515 (if (or (looking-at mh-deleted-msg-regexp)
516 (looking-at mh-refiled-msg-regexp))
517 (progn
518 (mh-undo-msg (mh-get-msg-num t))
519 (mh-maybe-show))
520 (goto-char original-position)
521 (error "Nothing to undo"))))
522 (t
523 (mh-mapc (function mh-undo-msg) (mh-seq-to-msgs msg-or-seq))))
524 ;; update the mh-refile-list so mh-outstanding-commands-p will work
525 (mh-mapc (function
526 (lambda (elt)
527 (if (not (mh-seq-to-msgs elt))
528 (setq mh-refile-list (delq elt mh-refile-list)))))
529 mh-refile-list)
530 (if (not (mh-outstanding-commands-p))
531 (mh-set-folder-modified-p nil)))
532
533
534(defun mh-version ()
535 "Display version information about mh-e and MH."
536 (interactive)
537 (mh-find-progs)
538 (set-buffer (get-buffer-create " *mh-temp*"))
539 (erase-buffer)
540 (insert " mh-e info:\n\nversion: " mh-e-version "\n" mh-e-time-stamp
541 "\nEmacs: " emacs-version " on " (symbol-name system-type) " ")
542 (condition-case ()
543 (call-process "uname" nil t nil "-a")
544 (file-error))
545 (insert "\n\n MH info:\n\n" (expand-file-name "inc" mh-progs) ":\n")
546 (let ((help-start (point)))
547 (condition-case err-data
548 (mh-exec-cmd-output "inc" nil "-help")
549 (file-error (insert (mapconcat 'concat (cdr err-data) ": "))))
550 (goto-char help-start)
551 (search-forward "version: " nil t)
552 (beginning-of-line)
553 (delete-region help-start (point))
554 (goto-char (point-min)))
555 (display-buffer " *mh-temp*"))
556
557
558(defun mh-visit-folder (folder &optional range)
559 "Visits FOLDER and displays RANGE of messages.
560Assumes mh-e has already been initialized.
561Do not call this function from outside mh-e; see \\[mh-rmail] instead."
562 (interactive (list (mh-prompt-for-folder "Visit" "+inbox" t)
563 (mh-read-msg-range "Range [all]? ")))
564 (let ((config (current-window-configuration)))
565 (mh-scan-folder folder (or range "all"))
566 (setq mh-previous-window-config config))
567 nil)
568
569
570(defun mh-compat-quit ()
571 "\"b\" reserved for future use as mh-burst-digest; will assume you want \"\\[mh-quit]\" ..."
572 ;; This is a temporary compatibility function
573 (interactive)
574 (message "%s" (documentation this-command))
575 (sit-for 1)
576 (call-interactively 'mh-quit))
577
578
579
580;;; Support routines.
581
582(defun mh-delete-a-msg (msg)
583 ;; Delete the MESSAGE.
584 (save-excursion
585 (mh-goto-msg msg nil t)
586 (if (looking-at mh-refiled-msg-regexp)
587 (error "Message %d is refiled. Undo refile before deleting." msg))
588 (if (looking-at mh-deleted-msg-regexp)
589 nil
590 (mh-set-folder-modified-p t)
591 (setq mh-delete-list (cons msg mh-delete-list))
592 (mh-add-msgs-to-seq msg 'deleted t)
593 (mh-notate msg ?D mh-cmd-note)
594 (run-hooks 'mh-delete-msg-hook))))
595
596(defun mh-refile-a-msg (msg destination)
597 ;; Refile MESSAGE in FOLDER. FOLDER is a symbol, not a string.
598 (save-excursion
599 (mh-goto-msg msg nil t)
600 (cond ((looking-at mh-deleted-msg-regexp)
601 (error "Message %d is deleted. Undo delete before moving." msg))
602 ((looking-at mh-refiled-msg-regexp)
603 (if (y-or-n-p
604 (format "Message %d already refiled. Copy to %s as well? "
605 msg destination))
606 (mh-exec-cmd "refile" (mh-get-msg-num t) "-link"
607 "-src" mh-current-folder
608 (symbol-name destination))
609 (message "Message not copied.")))
610 (t
611 (mh-set-folder-modified-p t)
612 (if (not (memq destination mh-refile-list))
613 (setq mh-refile-list (cons destination mh-refile-list)))
614 (if (not (memq msg (mh-seq-to-msgs destination)))
615 (mh-add-msgs-to-seq msg destination t))
616 (mh-notate msg ?^ mh-cmd-note)
617 (run-hooks 'mh-refile-msg-hook)))))
618
619
620(defun mh-next-msg ()
621 ;; Move backward or forward to the next undeleted message in the buffer.
622 (if (eq mh-next-direction 'forward)
623 (mh-next-undeleted-msg 1)
624 (mh-previous-undeleted-msg 1)))
625
626
627(defun mh-set-scan-mode ()
628 ;; Display the scan listing buffer, but do not show a message.
629 (if (get-buffer mh-show-buffer)
630 (delete-windows-on mh-show-buffer))
631 (setq mh-showing nil)
632 (set-buffer-modified-p (buffer-modified-p)) ;force mode line update
633 (if mh-recenter-summary-p
634 (mh-recenter nil)))
635
636
637(defun mh-undo-msg (msg)
638 ;; Undo the deletion or refile of one MESSAGE.
639 (cond ((memq msg mh-delete-list)
640 (setq mh-delete-list (delq msg mh-delete-list))
641 (mh-delete-msg-from-seq msg 'deleted t))
642 (t
643 (mh-mapc (function (lambda (dest)
644 (mh-delete-msg-from-seq msg dest t)))
645 mh-refile-list)))
646 (mh-notate msg ? mh-cmd-note))
647
648
649
650
651;;; The folder data abstraction.
652
653(defun mh-make-folder (name)
654 ;; Create and initialize a new mail folder called NAME and make it the
655 ;; current folder.
656 (switch-to-buffer name)
657 (setq buffer-read-only nil)
658 (erase-buffer)
659 (setq buffer-read-only t)
660 (mh-folder-mode)
661 (mh-set-folder-modified-p nil)
662 (setq buffer-file-name mh-folder-filename))
663
664
665;;; Ensure new buffers won't get this mode if default-major-mode is nil.
666(put 'mh-folder-mode 'mode-class 'special)
667
668(defun mh-folder-mode ()
669 "Major mh-e mode for \"editing\" an MH folder scan listing.\\<mh-folder-mode-map>
670You can show the message the cursor is pointing to, and step through the
671messages. Messages can be marked for deletion or refiling into another
672folder; these commands are executed all at once with a separate command.
673
674A prefix argument (\\[universal-argument]) to delete, refile, list, or undo
675applies the action to a message sequence.
676
677Here is a list of the standard keys for mh-e commands, grouped by function.
678This list is purposefully not customized; mh-e has a long history, and many
679alternate key bindings as a result. This list is to encourage users to use
680standard keys so the other keys can perhaps someday be put to new uses.
681
682t toggle show or scan-only mode
683. show message, or back to top if already showing
684
685SPC page forward
686DEL page back
687
688n next message
689p previous message
690j jump to message by number
691
692d mark for deletion
693o, ^ mark for output (refile) to another folder
694? show folder of pending refile
695u undo delete or refile marking
696
697x execute marked deletes and refiles
698i incorporate new mail
699
700m mail a new message
701r reply to a message
702f forward a message
703
704q quit mh-e
705
706M-f visit new folder
707M-r rescan this folder
708
709Here are all the commands with their current binding, listed in key order:
710\\{mh-folder-mode-map}
711
712Variables controlling mh-e operation are (defaults in parentheses):
713
714 mh-recursive-folders (nil)
715 Non-nil means commands which operate on folders do so recursively.
716
717 mh-bury-show-buffer (t)
718 Non-nil means that the buffer used to display message is buried.
719 It will never be offered as the default other buffer.
720
721 mh-clean-message-header (nil)
722 Non-nil means remove header lines matching the regular expression
723 specified in mh-invisible-headers from messages.
724
725 mh-visible-headers (nil)
726 If non-nil, it contains a regexp specifying the headers that are shown in
727 a message if mh-clean-message-header is non-nil. Setting this variable
728 overrides mh-invisible-headers.
729
730 mh-do-not-confirm (nil)
731 Non-nil means do not prompt for confirmation before executing some
732 non-recoverable commands such as mh-kill-folder and mh-undo-folder.
733
734 mhl-formfile (nil)
735 Name of format file to be used by mhl to show messages.
736 A value of T means use the default format file.
737 Nil means don't use mhl to format messages.
738
739 mh-lpr-command-format (\"lpr -p -J '%s'\")
740 Format for command used to print a message on a system printer.
741
742 mh-scan-prog (\"scan\")
743 Program to run to generate one-line-per-message listing of a folder.
744 Normally \"scan\" or a file name linked to scan. This file is searched
745 for relative to the mh-progs directory unless it is an absolute pathname.
746 Automatically becomes buffer-local when set in any fashion.
747
748 mh-print-background (nil)
749 Print messages in the background if non-nil.
750 WARNING: do not delete the messages until printing is finished;
751 otherwise, your output may be truncated.
752
753 mh-recenter-summary-p (nil)
754 If non-nil, then the scan listing is recentered when the window displaying
755 a messages is toggled off.
756
757 mh-summary-height (4)
758 Number of lines in the summary window including the mode line.
759
760 mh-ins-buf-prefix (\"> \")
761 String to insert before each non-blank line of a message as it is
762 inserted in a draft letter.
763
764The value of mh-folder-mode-hook is called when a new folder is set up."
765
766 (kill-all-local-variables)
767 (use-local-map mh-folder-mode-map)
768 (setq major-mode 'mh-folder-mode)
769 (mh-set-mode-name "MH-Folder")
770 (make-local-vars
771 'mh-current-folder (buffer-name) ; Name of folder, a string
772 'mh-show-buffer (format "show-%s" (buffer-name)) ; Buffer that displays msgs
773 'mh-folder-filename ; e.g. "/usr/foobar/Mail/inbox/"
774 (file-name-as-directory (mh-expand-file-name (buffer-name)))
775 'mh-showing nil ; Show message also?
776 'mh-next-seq-num 0 ; Index of free sequence id
777 'mh-delete-list nil ; List of msgs nums to delete
778 'mh-refile-list nil ; List of folder names in mh-seq-list
779 'mh-seq-list nil ; Alist of (seq . msgs) nums
780 'mh-seen-list nil ; List of displayed messages
781 'mh-next-direction 'forward ; Direction to move to next message
782 'mh-narrowed-to-seq nil ; Sequence display is narrowed to
783 'mh-first-msg-num nil ; Number of first msg in buffer
784 'mh-last-msg-num nil ; Number of last msg in buffer
785 'mh-previous-window-config nil) ; Previous window configuration
786 (setq truncate-lines t)
787 (auto-save-mode -1)
788 (setq buffer-offer-save t)
789 (make-local-variable 'write-file-hooks)
790 (setq write-file-hooks '(mh-execute-commands))
791 (make-local-variable 'revert-buffer-function)
792 (setq revert-buffer-function 'mh-undo-folder)
793 (or (assq 'mh-showing minor-mode-alist)
794 (setq minor-mode-alist
795 (cons '(mh-showing " Show") minor-mode-alist)))
796 (run-hooks 'mh-folder-mode-hook))
797
798
799(defun make-local-vars (&rest pairs)
800 ;; Take VARIABLE-VALUE pairs and makes local variables initialized to the
801 ;; value.
802 (while pairs
803 (make-variable-buffer-local (car pairs))
804 (set (car pairs) (car (cdr pairs)))
805 (setq pairs (cdr (cdr pairs)))))
806
807
808(defun mh-scan-folder (folder range)
809 ;; Scan the FOLDER over the RANGE. Return in the folder's buffer.
810 (cond ((null (get-buffer folder))
811 (mh-make-folder folder))
812 (t
813 (mh-process-or-undo-commands folder)
814 (switch-to-buffer folder)))
815 (mh-regenerate-headers range)
816 (cond ((zerop (buffer-size))
817 (if (equal range "all")
818 (message "Folder %s is empty" folder)
819 (message "No messages in %s, range %s" folder range))
820 (sit-for 5)))
821 (mh-goto-cur-msg))
822
823
824(defun mh-regenerate-headers (range)
825 ;; Replace buffer with scan of its contents over range RANGE.
826 (let ((folder mh-current-folder))
827 (message "Scanning %s..." folder)
828 (with-mh-folder-updating (nil)
829 (erase-buffer)
830 (mh-exec-cmd-output mh-scan-prog nil
831 "-noclear" "-noheader"
832 "-width" (window-width)
833 folder range)
834 (goto-char (point-min))
835 (cond ((looking-at "scan: no messages in")
836 (keep-lines mh-valid-scan-line)) ; Flush random scan lines
837 ((looking-at "scan: ")) ; Keep error messages
838 (t
839 (keep-lines mh-valid-scan-line))) ; Flush random scan lines
840 (mh-delete-seq-locally 'cur) ; To pick up new one
841 (setq mh-seq-list (mh-read-folder-sequences folder nil))
842 (mh-notate-user-sequences)
843 (mh-make-folder-mode-line (if (equal range "all")
844 nil
845 mh-partial-folder-mode-line-annotation)))
846 (message "Scanning %s...done" folder)))
847
848
849(defun mh-get-new-mail (maildrop-name)
850 ;; Read new mail from a maildrop into the current buffer.
851 ;; Return in the current buffer.
852 (let ((point-before-inc (point))
853 (folder mh-current-folder)
854 (new-mail-p nil))
855 (with-mh-folder-updating (t)
856 (message (if maildrop-name
857 (format "inc %s -file %s..." folder maildrop-name)
858 (format "inc %s..." folder)))
859 (setq mh-next-direction 'forward)
860 (goto-char (point-max))
861 (let ((start-of-inc (point)))
862 (if maildrop-name
863 (mh-exec-cmd-output mh-inc-prog nil folder
864 "-file" (expand-file-name maildrop-name)
865 "-width" (window-width)
866 "-truncate")
867 (mh-exec-cmd-output "inc" nil
868 "-width" (window-width)))
869 (message
870 (if maildrop-name
871 (format "inc %s -file %s...done" folder maildrop-name)
872 (format "inc %s...done" folder)))
873 (goto-char start-of-inc)
874 (cond ((looking-at "inc: no mail")
875 (message "No new mail%s%s" (if maildrop-name " in " "")
876 (if maildrop-name maildrop-name "")))
877 ((re-search-forward "^inc:" nil t) ; Error messages
878 (error "inc error"))
879 (t
880 ;; remove old cur notation (cf mh-goto-cur-msg code)
881 (let ((cur-msg (car (mh-seq-to-msgs 'cur))))
882 (save-excursion
883 (and cur-msg
884 (mh-goto-msg cur-msg t nil)
885 (looking-at mh-cur-scan-msg-regexp)
886 (mh-notate nil ? mh-cmd-note))))
887 (setq new-mail-p t)))
888 (keep-lines mh-valid-scan-line) ; Flush random scan lines
889 (mh-delete-seq-locally 'cur) ; To pick up new one
890 (setq mh-seq-list (mh-read-folder-sequences folder t))
891 (mh-notate-user-sequences)
892 (if new-mail-p
893 (progn
894 (mh-goto-cur-msg)
895 (mh-make-folder-mode-line))
896 (goto-char point-before-inc))))))
897
898
899(defun mh-make-folder-mode-line (&optional annotation)
900 ;; Set the fields of the mode line for a folder buffer.
901 ;; The optional ANNOTATION string is displayed after the folder's name.
902 (save-excursion
903 (mh-first-msg)
904 (setq mh-first-msg-num (mh-get-msg-num nil))
905 (mh-last-msg)
906 (setq mh-last-msg-num (mh-get-msg-num nil))
907 (let ((lines (count-lines (point-min) (point-max))))
908 (setq mode-line-buffer-identification
909 (list (format "{%%b%s} %d msg%s"
910 (if annotation (format "/%s" annotation) "")
911 lines
912 (if (zerop lines)
913 "s"
914 (if (> lines 1)
915 (format "s (%d-%d)" mh-first-msg-num
916 mh-last-msg-num)
917 (format " (%d)" mh-first-msg-num)))))))))
918
919
920(defun mh-unmark-all-headers (remove-all-flags)
921 ;; Remove all '+' flags from the headers, and if called with a non-nil
922 ;; argument, remove all 'D', '^' and '%' flags too.
923 ;; Optimized for speed (i.e., no regular expressions).
924 (save-excursion
925 (let ((case-fold-search nil)
926 (last-line (- (point-max) mh-cmd-note))
927 char)
928 (mh-first-msg)
929 (while (<= (point) last-line)
930 (forward-char mh-cmd-note)
931 (setq char (following-char))
932 (if (or (and remove-all-flags
933 (or (eql char ?D)
934 (eql char ?^)
935 (eql char ?%)))
936 (eql char ?+))
937 (progn
938 (delete-char 1)
939 (insert " ")))
940 (forward-line)))))
941
942
943(defun mh-goto-cur-msg ()
944 ;; Position the cursor at the current message.
945 (let ((cur-msg (car (mh-seq-to-msgs 'cur))))
946 (cond ((and cur-msg
947 (mh-goto-msg cur-msg t nil))
948 (mh-notate nil ?+ mh-cmd-note)
949 (mh-recenter 0)
950 (mh-maybe-show cur-msg))
951 (t
952 (mh-last-msg)
953 (message "No current message")))))
954
955
956(defun mh-process-or-undo-commands (folder)
957 ;; If FOLDER has outstanding commands, then either process or discard them.
958 ;; Called by functions like mh-sort-folder, so also invalidate show buffer.
959 (set-buffer folder)
960 (if (mh-outstanding-commands-p)
961 (if (or mh-do-not-confirm
962 (y-or-n-p
963 "Process outstanding deletes and refiles (or lose them)? "))
964 (mh-process-commands folder)
965 (mh-undo-folder)))
966 (mh-update-unseen)
967 (mh-invalidate-show-buffer))
968
969
970(defun mh-process-commands (folder)
971 ;; Process outstanding commands for the folder FOLDER.
972 (message "Processing deletes and refiles for %s..." folder)
973 (set-buffer folder)
974 (with-mh-folder-updating (nil)
975 ;; Update the unseen sequence if it exists
976 (mh-update-unseen)
977
978 ;; Then refile messages
979 (mh-mapc
980 (function
981 (lambda (dest)
982 (let ((msgs (mh-seq-to-msgs dest)))
983 (cond (msgs
984 (apply 'mh-exec-cmd "refile"
985 "-src" folder (symbol-name dest) msgs)
986 (mh-delete-scan-msgs msgs))))))
987 mh-refile-list)
988 (setq mh-refile-list nil)
989
990 ;; Now delete messages
991 (cond (mh-delete-list
992 (apply 'mh-exec-cmd "rmm" folder mh-delete-list)
993 (mh-delete-scan-msgs mh-delete-list)
994 (setq mh-delete-list nil)))
995
996 ;; Don't need to remove sequences since delete and refile do so.
997
998 ;; Mark cur message
999 (if (> (buffer-size) 0)
1000 (mh-define-sequence 'cur (or (mh-get-msg-num nil) "last")))
1001
1002 (and (buffer-file-name (get-buffer mh-show-buffer))
1003 (not (file-exists-p (buffer-file-name (get-buffer mh-show-buffer))))
1004 ;; If "inc" were to put a new msg in this file,
1005 ;; we would not notice, so mark it invalid now.
1006 (mh-invalidate-show-buffer))
1007
1008 (setq mh-seq-list (mh-read-folder-sequences mh-current-folder nil))
1009 (mh-unmark-all-headers t)
1010 (mh-notate-user-sequences)
1011 (message "Processing deletes and refiles for %s...done" folder)))
1012
1013
1014(defun mh-update-unseen ()
1015 ;; Push updates to the Unseen sequence out to MH.
1016 (if mh-seen-list
1017 (progn
1018 (if (mh-seq-to-msgs mh-unseen-seq)
1019 (mh-undefine-sequence mh-unseen-seq mh-seen-list))
1020 (setq mh-seen-list nil))))
1021
1022
1023(defun mh-delete-scan-msgs (msgs)
1024 ;; Delete the scan listing lines for each of the msgs in the LIST.
1025 ;; Optimized for speed (i.e., no regular expressions).
1026 (setq msgs (sort msgs (function <))) ;okay to clobber msgs
1027 (save-excursion
1028 (mh-first-msg)
1029 (while (and msgs (< (point) (point-max)))
1030 (cond ((equal (mh-get-msg-num nil) (car msgs))
1031 (delete-region (point) (save-excursion (forward-line) (point)))
1032 (setq msgs (cdr msgs)))
1033 (t
1034 (forward-line))))))
1035
1036
1037(defun mh-outstanding-commands-p ()
1038 ;; Returns non-nil if there are outstanding deletes or refiles.
1039 (or mh-delete-list mh-refile-list))
1040
1041
1042
1043;;; Basic sequence handling
1044
1045(defun mh-delete-seq-locally (seq)
1046 ;; Remove mh-e's record of SEQUENCE.
1047 (let ((entry (mh-find-seq seq)))
1048 (setq mh-seq-list (delq entry mh-seq-list))))
1049
1050(defun mh-read-folder-sequences (folder save-refiles)
1051 ;; Read and return the predefined sequences for a FOLDER.
1052 ;; If SAVE-REFILES is non-nil, then keep the sequences
1053 ;; that note messages to be refiled.
1054 (let ((seqs ()))
1055 (cond (save-refiles
1056 (mh-mapc (function (lambda (seq) ; Save the refiling sequences
1057 (if (mh-folder-name-p (mh-seq-name seq))
1058 (setq seqs (cons seq seqs)))))
1059 mh-seq-list)))
1060 (save-excursion
1061 (if (eq 0 (mh-exec-cmd-quiet nil "mark" folder "-list"))
1062 (progn
1063 ;; look for name in line of form "cur: 4" or "myseq (private): 23"
1064 (while (re-search-forward "^[^: ]+" nil t)
1065 (setq seqs (cons (mh-make-seq (intern (buffer-substring
1066 (match-beginning 0)
1067 (match-end 0)))
1068 (mh-read-msg-list))
1069 seqs)))
1070 (delete-region (point-min) (point))))) ; avoid race with mh-process-daemon
1071 seqs))
1072
1073(defun mh-read-msg-list ()
1074 ;; Return a list of message numbers from the current point to the end of
1075 ;; the line.
1076 (let ((msgs ())
1077 (end-of-line (save-excursion (end-of-line) (point)))
1078 num)
1079 (while (re-search-forward "[0-9]+" end-of-line t)
1080 (setq num (string-to-int (buffer-substring (match-beginning 0)
1081 (match-end 0))))
1082 (cond ((looking-at "-") ; Message range
1083 (forward-char 1)
1084 (re-search-forward "[0-9]+" end-of-line t)
1085 (let ((num2 (string-to-int (buffer-substring (match-beginning 0)
1086 (match-end 0)))))
1087 (if (< num2 num)
1088 (error "Bad message range: %d-%d" num num2))
1089 (while (<= num num2)
1090 (setq msgs (cons num msgs))
1091 (setq num (1+ num)))))
1092 ((not (zerop num)) (setq msgs (cons num msgs)))))
1093 msgs))
1094
1095(defun mh-notate-user-sequences ()
1096 ;; Mark the scan listing of all messages in user-defined sequences.
1097 (let ((seqs mh-seq-list)
1098 name)
1099 (while seqs
1100 (setq name (mh-seq-name (car seqs)))
1101 (if (not (mh-internal-seq name))
1102 (mh-notate-seq name ?% (1+ mh-cmd-note)))
1103 (setq seqs (cdr seqs)))))
1104
1105
1106(defun mh-internal-seq (name)
1107 ;; Return non-NIL if NAME is the name of an internal mh-e sequence.
1108 (or (memq name '(answered cur deleted forwarded printed))
1109 (eq name mh-unseen-seq)
1110 (eq name mh-previous-seq)
1111 (mh-folder-name-p name)))
1112
1113
1114(defun mh-delete-msg-from-seq (msg seq &optional internal-flag)
1115 "Delete MESSAGE from SEQUENCE. MESSAGE defaults to displayed message.
1116 From Lisp, optional third arg INTERNAL non-nil means do not
1117 inform MH of the change."
1118 (interactive (list (mh-get-msg-num t)
1119 (mh-read-seq-default "Delete from" t)
1120 nil))
1121 (let ((entry (mh-find-seq seq)))
1122 (cond (entry
1123 (mh-notate-if-in-one-seq msg ? (1+ mh-cmd-note) (mh-seq-name entry))
1124 (if (not internal-flag)
1125 (mh-undefine-sequence seq msg))
1126 (setcdr entry (delq msg (mh-seq-msgs entry)))))))
1127
1128
1129(defun mh-undefine-sequence (seq msgs)
1130 ;; Remove from the SEQUENCE the MSGS, which may be a list or single msg.
1131 (mh-exec-cmd "mark" mh-current-folder "-delete"
1132 "-sequence" (symbol-name seq)
1133 msgs))
1134
1135
1136(defun mh-define-sequence (seq msgs)
1137 ;; Define the SEQUENCE to contain the list of MSGS.
1138 ;; Do not mark pseudo-sequences or empty sequences.
1139 ;; Signals an error if SEQUENCE is an illegal name.
1140 (if (and msgs
1141 (not (mh-folder-name-p seq)))
1142 (save-excursion
1143 (mh-exec-cmd-error nil "mark" mh-current-folder "-add" "-zero"
1144 "-sequence" (symbol-name seq)
1145 msgs))))
1146
1147
1148(defun mh-define-sequences (seq-list)
1149 ;; Define the sequences in SEQ-LIST.
1150 (mh-map-over-seqs 'mh-define-sequence seq-list))
1151
1152
1153(defun mh-map-over-seqs (func seq-list)
1154 ;; Apply the FUNCTION to each element in the list of SEQUENCES,
1155 ;; passing the sequence name and the list of messages as arguments.
1156 (while seq-list
1157 (funcall func (mh-seq-name (car seq-list)) (mh-seq-msgs (car seq-list)))
1158 (setq seq-list (cdr seq-list))))
1159
1160
1161(defun mh-notate-if-in-one-seq (msg notation offset seq)
1162 ;; If the MESSAGE is in only the SEQUENCE, then mark the scan listing of the
1163 ;; message with the CHARACTER at the given OFFSET from the beginning of the
1164 ;; listing line.
1165 (let ((in-seqs (mh-seq-containing-msg msg)))
1166 (if (and (eq seq (car in-seqs)) (null (cdr in-seqs)))
1167 (mh-notate msg notation offset))))
1168
1169
1170(defun mh-seq-containing-msg (msg)
1171 ;; Return a list of the sequences containing MESSAGE.
1172 (let ((l mh-seq-list)
1173 (seqs ()))
1174 (while l
1175 (if (memq msg (mh-seq-msgs (car l)))
1176 (setq seqs (cons (mh-seq-name (car l)) seqs)))
1177 (setq l (cdr l)))
1178 seqs))
1179
1180
1181
1182
1183;;; User prompting commands.
1184
1185
1186(defun mh-read-msg-range (prompt)
1187 ;; Read a list of blank-separated items.
1188 (let* ((buf (read-string prompt))
1189 (buf-size (length buf))
1190 (start 0)
1191 (input ()))
1192 (while (< start buf-size)
1193 (let ((next (read-from-string buf start buf-size)))
1194 (setq input (cons (car next) input))
1195 (setq start (cdr next))))
1196 (nreverse input)))
1197
1198
1199
1200;;; Build the folder-mode keymap:
1201
1202(suppress-keymap mh-folder-mode-map)
1203(define-key mh-folder-mode-map "q" 'mh-quit)
1204(define-key mh-folder-mode-map "b" 'mh-compat-quit)
1205(define-key mh-folder-mode-map "?" 'mh-msg-is-in-seq)
1206(define-key mh-folder-mode-map "%" 'mh-put-msg-in-seq)
1207(define-key mh-folder-mode-map "|" 'mh-pipe-msg)
1208(define-key mh-folder-mode-map "\ea" 'mh-edit-again)
1209(define-key mh-folder-mode-map "\e%" 'mh-delete-msg-from-seq)
1210(define-key mh-folder-mode-map "\e#" 'mh-delete-seq)
1211(define-key mh-folder-mode-map "\C-xn" 'mh-narrow-to-seq)
1212(define-key mh-folder-mode-map "\C-xw" 'mh-widen)
1213(define-key mh-folder-mode-map "\eb" 'mh-burst-digest)
1214(define-key mh-folder-mode-map "\eu" 'mh-undo-folder)
1215(define-key mh-folder-mode-map "\e " 'mh-page-digest)
1216(define-key mh-folder-mode-map "\e\177" 'mh-page-digest-backwards)
1217(define-key mh-folder-mode-map "\ed" 'mh-redistribute)
1218(define-key mh-folder-mode-map "\ee" 'mh-extract-rejected-mail)
1219(define-key mh-folder-mode-map "\ef" 'mh-visit-folder)
1220(define-key mh-folder-mode-map "\ek" 'mh-kill-folder)
1221(define-key mh-folder-mode-map "\el" 'mh-list-folders)
1222(define-key mh-folder-mode-map "\en" 'mh-store-msg)
1223(define-key mh-folder-mode-map "\ep" 'mh-pack-folder)
1224(define-key mh-folder-mode-map "\eq" 'mh-list-sequences)
1225(define-key mh-folder-mode-map "\es" 'mh-search-folder)
1226(define-key mh-folder-mode-map "\er" 'mh-rescan-folder)
1227(define-key mh-folder-mode-map "l" 'mh-print-msg)
1228(define-key mh-folder-mode-map "t" 'mh-toggle-showing)
1229(define-key mh-folder-mode-map "c" 'mh-copy-msg)
1230(define-key mh-folder-mode-map "i" 'mh-inc-folder)
1231(define-key mh-folder-mode-map "x" 'mh-execute-commands)
1232(define-key mh-folder-mode-map "e" 'mh-execute-commands)
1233(define-key mh-folder-mode-map "f" 'mh-forward)
1234(define-key mh-folder-mode-map "m" 'mh-send)
1235(define-key mh-folder-mode-map "s" 'mh-send)
1236(define-key mh-folder-mode-map "r" 'mh-reply)
1237(define-key mh-folder-mode-map "a" 'mh-reply)
1238(define-key mh-folder-mode-map "j" 'mh-goto-msg)
1239(define-key mh-folder-mode-map "g" 'mh-goto-msg)
1240(define-key mh-folder-mode-map "\e>" 'mh-last-msg)
1241(define-key mh-folder-mode-map "\177" 'mh-previous-page)
1242(define-key mh-folder-mode-map " " 'mh-page-msg)
1243(define-key mh-folder-mode-map "." 'mh-show)
1244(define-key mh-folder-mode-map "," 'mh-header-display)
1245(define-key mh-folder-mode-map "u" 'mh-undo)
1246(define-key mh-folder-mode-map "d" 'mh-delete-msg)
1247(define-key mh-folder-mode-map "\C-d" 'mh-delete-msg-no-motion)
1248(define-key mh-folder-mode-map "p" 'mh-previous-undeleted-msg)
1249(define-key mh-folder-mode-map "n" 'mh-next-undeleted-msg)
1250(define-key mh-folder-mode-map "o" 'mh-refile-msg)
1251(define-key mh-folder-mode-map "^" 'mh-refile-msg)
1252(define-key mh-folder-mode-map "\C-o" 'mh-write-msg-to-file)
1253(define-key mh-folder-mode-map ">" 'mh-write-msg-to-file)
1254(define-key mh-folder-mode-map "!" 'mh-refile-or-write-again)
1255
1256
1257
1258;;;autoload the other mh-e parts
1259
1260;;; mh-comp
1261
1262(autoload 'mh-smail "mh-comp"
1263 "Compose and send mail with the MH mail system." t)
1264(autoload 'mh-smail-other-window "mh-comp"
1265 "Compose and send mail in other window with the MH mail system." t)
1266(autoload 'mh-edit-again "mh-comp"
1267 "Clean-up a draft or a message previously sent and make it resendable." t)
1268(autoload 'mh-extract-rejected-mail "mh-comp"
1269 "Extract a letter returned by the mail system and make it resendable." t)
1270(autoload 'mh-forward "mh-comp"
1271 "Forward MESSAGE(s) (default: displayed message)." t)
1272(autoload 'mh-redistribute "mh-comp"
1273 "Redistribute a letter." t)
1274(autoload 'mh-reply "mh-comp"
1275 "Reply to a MESSAGE (default: displayed message)." t)
1276(autoload 'mh-send "mh-comp"
1277 "Compose and send a letter." t)
1278(autoload 'mh-send-other-window "mh-comp"
1279 "Compose and send a letter in another window." t)
1280(autoload 'mh-letter-mode "mh-comp"
1281 "Mode for composing letters in mh-e." t)
1282
1283
1284;;; mh-funcs
1285
1286(autoload 'mh-burst-digest "mh-funcs"
1287 "Burst apart the current message, which should be a digest." t)
1288(autoload 'mh-copy-msg "mh-funcs"
1289 "Copy specified MESSAGE(s) to another FOLDER without deleting them." t)
1290(autoload 'mh-kill-folder "mh-funcs"
1291 "Remove the current folder." t)
1292(autoload 'mh-list-folders "mh-funcs"
1293 "List mail folders." t)
1294(autoload 'mh-pack-folder "mh-funcs"
1295 "Renumber the messages of a folder to be 1..n." t)
1296(autoload 'mh-pipe-msg "mh-funcs"
1297 "Pipe the current message through the given shell COMMAND." t)
1298(autoload 'mh-page-digest "mh-funcs"
1299 "Advance displayed message to next digested message." t)
1300(autoload 'mh-page-digest-backwards "mh-funcs"
1301 "Back up displayed message to previous digested message." t)
1302(autoload 'mh-print-msg "mh-funcs"
1303 "Print MESSAGE(s) (default: displayed message) on a line printer." t)
1304(autoload 'mh-sort-folder "mh-funcs"
1305 "Sort the messages in the current folder by date." t)
1306(autoload 'mh-undo-folder "mh-funcs"
1307 "Undo all commands in current folder." t)
1308(autoload 'mh-store-msg "mh-funcs"
1309 "Store the file(s) contained in the current message." t)
1310
1311
1312;;; mh-pick
1313
1314(autoload 'mh-search-folder "mh-pick"
1315 "Search FOLDER for messages matching a pattern." t)
1316
1317;;; mh-seq
1318
1319(autoload 'mh-put-msg-in-seq "mh-seq"
1320 "Add MESSAGE(s) (default: displayed message) to SEQUENCE." t)
1321(autoload 'mh-delete-seq "mh-seq"
1322 "Delete the SEQUENCE." t)
1323(autoload 'mh-list-sequences "mh-seq"
1324 "List the sequences defined in FOLDER." t)
1325(autoload 'mh-msg-is-in-seq "mh-seq"
1326 "Display the sequences that contain MESSAGE (default: displayed message)." t)
1327(autoload 'mh-narrow-to-seq "mh-seq"
1328 "Restrict display of this folder to just messages in a sequence." t)
1329(autoload 'mh-widen "mh-seq"
1330 "Remove restrictions from current folder, thereby showing all messages." t)
1331(autoload 'mh-rename-seq "mh-seq"
1332 "Rename a SEQUENCE to have a new NAME." t)
1333
1334;;; mh-e.el ends here
diff --git a/lisp/mail/mh-funcs.el b/lisp/mail/mh-funcs.el
new file mode 100644
index 00000000000..1a43161a8f3
--- /dev/null
+++ b/lisp/mail/mh-funcs.el
@@ -0,0 +1,311 @@
1;;; mh-funcs --- mh-e functions not everyone will use right away
2;; Time-stamp: <94/03/08 16:00:54 gildea>
3
4;; Copyright 1993 Free Software Foundation, Inc.
5
6;; This file is part of mh-e.
7
8;; mh-e is free software; you can redistribute it and/or modify
9;; it under the terms of the GNU General Public License as published by
10;; the Free Software Foundation; either version 2, or (at your option)
11;; any later version.
12
13;; mh-e is distributed in the hope that it will be useful,
14;; but WITHOUT ANY WARRANTY; without even the implied warranty of
15;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16;; GNU General Public License for more details.
17
18;; You should have received a copy of the GNU General Public License
19;; along with mh-e; see the file COPYING. If not, write to
20;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
21
22;;; Commentary:
23
24;;; Internal support for mh-e package.
25;;; Putting these functions in a separate file lets mh-e start up faster,
26;;; since less Lisp code needs to be loaded all at once.
27
28;;; Code:
29
30(provide 'mh-funcs)
31(require 'mh-e)
32
33(defvar mh-sortm-args nil
34 "Extra arguments to have \\[mh-sort-folder] pass to the \"sortm\" command.
35For example, '(\"-nolimit\" \"-textfield\" \"subject\") is a useful setting.")
36
37(defun mh-burst-digest ()
38 "Burst apart the current message, which should be a digest.
39The message is replaced by its table of contents and the letters from the
40digest are inserted into the folder after that message."
41 (interactive)
42 (let ((digest (mh-get-msg-num t)))
43 (mh-process-or-undo-commands mh-current-folder)
44 (mh-set-folder-modified-p t) ; lock folder while bursting
45 (message "Bursting digest...")
46 (mh-exec-cmd "burst" mh-current-folder digest "-inplace")
47 (mh-scan-folder mh-current-folder (format "%d-last" mh-first-msg-num))
48 (message "Bursting digest...done")))
49
50
51(defun mh-copy-msg (dest msg-or-seq)
52 "Copy to another FOLDER the specified MESSAGE(s) without deleting them.
53Default is the displayed message. If optional prefix argument is
54provided, then prompt for the message sequence."
55 (interactive (list (mh-prompt-for-folder "Copy to" "" t)
56 (if current-prefix-arg
57 (mh-read-seq-default "Copy" t)
58 (mh-get-msg-num t))))
59 (mh-exec-cmd "refile" msg-or-seq "-link" "-src" mh-current-folder dest)
60 (if (numberp msg-or-seq)
61 (mh-notate msg-or-seq ?C mh-cmd-note)
62 (mh-notate-seq msg-or-seq ?C mh-cmd-note)))
63
64(defun mh-kill-folder ()
65 "Remove the current folder."
66 (interactive)
67 (if (or mh-do-not-confirm
68 (yes-or-no-p (format "Remove folder %s? " mh-current-folder)))
69 (let ((folder mh-current-folder))
70 (if (null mh-folder-list)
71 (mh-set-folder-list))
72 (mh-set-folder-modified-p t) ; lock folder to kill it
73 (mh-exec-cmd-daemon "rmf" folder)
74 (setq mh-folder-list
75 (delq (assoc folder mh-folder-list) mh-folder-list))
76 (message "Folder %s removed" folder)
77 (mh-set-folder-modified-p nil) ; so kill-buffer doesn't complain
78 (if (get-buffer mh-show-buffer)
79 (kill-buffer mh-show-buffer))
80 (kill-buffer folder))
81 (message "Folder not removed")))
82
83
84(defun mh-list-folders ()
85 "List mail folders."
86 (interactive)
87 (with-output-to-temp-buffer " *mh-temp*"
88 (save-excursion
89 (switch-to-buffer " *mh-temp*")
90 (erase-buffer)
91 (message "Listing folders...")
92 (mh-exec-cmd-output "folders" t (if mh-recursive-folders
93 "-recurse"
94 "-norecurse"))
95 (goto-char (point-min))
96 (message "Listing folders...done"))))
97
98
99(defun mh-pack-folder (range)
100 "Renumber the messages of a folder to be 1..n.
101First, offer to execute any outstanding commands for the current folder.
102If optional prefix argument provided, prompt for the range of messages
103to display after packing. Otherwise, show the entire folder."
104 (interactive (list (if current-prefix-arg
105 (mh-read-msg-range
106 "Range to scan after packing [all]? ")
107 "all")))
108 (mh-pack-folder-1 range)
109 (mh-goto-cur-msg)
110 (message "Packing folder...done"))
111
112
113(defun mh-pack-folder-1 (range)
114 ;; Close and pack the current folder.
115 (mh-process-or-undo-commands mh-current-folder)
116 (message "Packing folder...")
117 (mh-set-folder-modified-p t) ; lock folder while packing
118 (save-excursion
119 (mh-exec-cmd-quiet t "folder" mh-current-folder "-pack"))
120 (mh-regenerate-headers range))
121
122
123(defun mh-pipe-msg (command include-headers)
124 "Pipe the current message through the given shell COMMAND.
125If INCLUDE-HEADERS (prefix argument) is provided, send the entire message.
126Otherwise just send the message's body without the headers."
127 (interactive
128 (list (read-string "Shell command on message: ") current-prefix-arg))
129 (let ((file-name (mh-msg-filename (mh-get-msg-num t))))
130 (save-excursion
131 (set-buffer (get-buffer-create " *mh-temp*"))
132 (erase-buffer)
133 (insert-file-contents file-name)
134 (goto-char (point-min))
135 (if (not include-headers) (search-forward "\n\n"))
136 (shell-command-on-region (point) (point-max) command nil))))
137
138
139(defun mh-page-digest ()
140 "Advance displayed message to next digested message."
141 (interactive)
142 (mh-in-show-buffer (mh-show-buffer)
143 ;; Go to top of screen (in case user moved point).
144 (move-to-window-line 0)
145 (let ((case-fold-search nil))
146 ;; Search for blank line and then for From:
147 (or (and (search-forward "\n\n" nil t)
148 (search-forward "From:" nil t))
149 (error "No more messages in digest")))
150 ;; Go back to previous blank line, then forward to the first non-blank.
151 (search-backward "\n\n" nil t)
152 (forward-line 2)
153 (mh-recenter 0)))
154
155
156(defun mh-page-digest-backwards ()
157 "Back up displayed message to previous digested message."
158 (interactive)
159 (mh-in-show-buffer (mh-show-buffer)
160 ;; Go to top of screen (in case user moved point).
161 (move-to-window-line 0)
162 (let ((case-fold-search nil))
163 (beginning-of-line)
164 (or (and (search-backward "\n\n" nil t)
165 (search-backward "From:" nil t))
166 (error "No previous message in digest")))
167 ;; Go back to previous blank line, then forward to the first non-blank.
168 (if (search-backward "\n\n" nil t)
169 (forward-line 2))
170 (mh-recenter 0)))
171
172
173(defun mh-print-msg (msg-or-seq)
174 "Print MESSAGE(s) (default: displayed message) on printer.
175If optional prefix argument provided, then prompt for the message sequence.
176The variable mh-lpr-command-format is used to generate the print command.
177The messages are formatted by mhl. See the variable mhl-formfile."
178 (interactive (list (if current-prefix-arg
179 (reverse (mh-seq-to-msgs
180 (mh-read-seq-default "Print" t)))
181 (mh-get-msg-num t))))
182 (if (numberp msg-or-seq)
183 (message "Printing message...")
184 (message "Printing sequence..."))
185 (let ((print-command
186 (if (numberp msg-or-seq)
187 (format "%s -nobell -clear %s %s | %s"
188 (expand-file-name "mhl" mh-lib)
189 (mh-msg-filename msg-or-seq)
190 (if (stringp mhl-formfile)
191 (format "-form %s" mhl-formfile)
192 "")
193 (format mh-lpr-command-format
194 (if (numberp msg-or-seq)
195 (format "%s/%d" mh-current-folder
196 msg-or-seq)
197 (format "Sequence from %s" mh-current-folder))))
198 (format "(scan -clear %s ; %s -nobell -clear %s %s) | %s"
199 (mapconcat (function (lambda (msg) msg)) msg-or-seq " ")
200 (expand-file-name "mhl" mh-lib)
201 (if (stringp mhl-formfile)
202 (format "-form %s" mhl-formfile)
203 "")
204 (mh-msg-filenames msg-or-seq)
205 (format mh-lpr-command-format
206 (if (numberp msg-or-seq)
207 (format "%s/%d" mh-current-folder
208 msg-or-seq)
209 (format "Sequence from %s"
210 mh-current-folder)))))))
211 (if mh-print-background
212 (mh-exec-cmd-daemon shell-file-name "-c" print-command)
213 (call-process shell-file-name nil nil nil "-c" print-command))
214 (if (numberp msg-or-seq)
215 (mh-notate msg-or-seq ?P mh-cmd-note)
216 (mh-notate-seq msg-or-seq ?P mh-cmd-note))
217 (mh-add-msgs-to-seq msg-or-seq 'printed t)
218 (if (numberp msg-or-seq)
219 (message "Printing message...done")
220 (message "Printing sequence...done"))))
221
222
223(defun mh-msg-filenames (msgs &optional folder)
224 ;; Return a list of file names for MSGS in FOLDER (default current folder).
225 (mapconcat (function (lambda (msg) (mh-msg-filename msg folder))) msgs " "))
226
227
228(defun mh-sort-folder (&optional no-args)
229 "Sort the messages in the current folder by date.
230Calls the MH program sortm to do the work.
231The arguments in the list mh-sortm-args are passed to sortm
232unless this function is passed an argument."
233 (interactive "P")
234 (mh-process-or-undo-commands mh-current-folder)
235 (setq mh-next-direction 'forward)
236 (mh-set-folder-modified-p t) ; lock folder while sorting
237 (message "Sorting folder...")
238 (mh-exec-cmd "sortm" mh-current-folder (if (not no-args) mh-sortm-args))
239 (message "Sorting folder...done")
240 (mh-scan-folder mh-current-folder "all"))
241
242
243(defun mh-undo-folder (&rest ignore)
244 "Undo all commands in current folder."
245 (interactive)
246 (cond ((or mh-do-not-confirm
247 (yes-or-no-p "Undo all commands in folder? "))
248 (setq mh-delete-list nil
249 mh-refile-list nil
250 mh-seq-list nil
251 mh-next-direction 'forward)
252 (with-mh-folder-updating (nil)
253 (mh-unmark-all-headers t)))
254 (t
255 (message "Commands not undone.")
256 (sit-for 2))))
257
258
259(defun mh-store-msg (dir)
260 "Store the file(s) contained in the current message into DIRECTORY.
261The message can contain a shar file or uuencoded file.
262Default directory is the last directory used, or initially the value of
263mh-store-default-directory or the current directory."
264 (interactive (list (let ((udir (or mh-store-default-directory default-directory)))
265 (read-file-name "Store message in directory: "
266 udir udir nil))))
267 (let ((file-name (mh-msg-filename (mh-get-msg-num t))))
268 (save-excursion
269 (set-buffer (get-buffer-create " *mh-temp*"))
270 (erase-buffer)
271 (insert-file-contents file-name)
272 (mh-store-buffer dir))))
273
274(defun mh-store-buffer (dir)
275 "Store the file(s) contained in the current buffer into DIRECTORY.
276The buffer can contain a shar file or uuencoded file.
277Default directory is the last directory used, or initially the value of
278`mh-store-default-directory' or the current directory."
279 (interactive (list (let ((udir (or mh-store-default-directory default-directory)))
280 (read-file-name "Store buffer in directory: "
281 udir udir nil))))
282 (let ((store-directory (expand-file-name dir))
283 (start (save-excursion
284 (goto-char (point-min))
285 (if (or (re-search-forward "^#![ \t]*/bin/sh" nil t)
286 (and (re-search-forward "^[^a-z0-9\"]*cut here\\b" nil t)
287 (forward-line 1))
288 (re-search-forward "^#" nil t)
289 (re-search-forward "^: " nil t))
290 (progn (beginning-of-line) (point)))))
291 (log-buffer (get-buffer-create "*Store Output*"))
292 (command "sh"))
293 (save-excursion
294 (set-buffer log-buffer)
295 (erase-buffer)
296 (if (not (file-directory-p store-directory))
297 (progn
298 (insert "mkdir " dir "\n")
299 (call-process "mkdir" nil log-buffer t store-directory)))
300 (insert "cd " dir "\n")
301 (if (not start)
302 (progn
303 (setq command "uudecode")
304 (insert "uudecoding...\n"))))
305 (set-window-start (display-buffer log-buffer) 0) ;watch progress
306 (let ((default-directory (file-name-as-directory store-directory)))
307 (call-process-region start (point-max) command nil log-buffer t))
308 (setq mh-store-default-directory dir)
309 (set-buffer log-buffer)
310 (insert "\n(mh-store finished)\n")))
311
diff --git a/lisp/mail/mh-mime.el b/lisp/mail/mh-mime.el
new file mode 100644
index 00000000000..bb49c5c6513
--- /dev/null
+++ b/lisp/mail/mh-mime.el
@@ -0,0 +1,209 @@
1;;; mh-mime --- mh-e support for composing MIME messages
2;; Time-stamp: <94/03/08 08:41:27 gildea>
3
4;; Copyright 1993 Free Software Foundation, Inc.
5
6;; This file is part of mh-e.
7
8;; mh-e is free software; you can redistribute it and/or modify
9;; it under the terms of the GNU General Public License as published by
10;; the Free Software Foundation; either version 2, or (at your option)
11;; any later version.
12
13;; mh-e is distributed in the hope that it will be useful,
14;; but WITHOUT ANY WARRANTY; without even the implied warranty of
15;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16;; GNU General Public License for more details.
17
18;; You should have received a copy of the GNU General Public License
19;; along with mh-e; see the file COPYING. If not, write to
20;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
21
22;;; Commentary:
23
24;;; Internal support for mh-e package.
25;;; Support for generating an mhn composition file.
26;;; MIME is supported only by MH 6.8 or later.
27
28;;; Code:
29
30(provide 'mh-mime)
31(require 'mh-comp)
32
33
34;; To do:
35;; paragraph code should not fill # lines if MIME enabled.
36;; implement mh-auto-edit-mhn (if non-nil, \\[mh-send-letter]
37;; invokes mh-edit-mhn automatically before sending.)
38;; actually, instead of mh-auto-edit-mhn,
39;; should read automhnproc from profile
40;; MIME option to mh-forward
41;; command to move to content-description insertion point
42
43(defvar mh-mime-content-types
44 '(("text/plain") ("text/richtext")
45 ("multipart/mixed") ("multipart/alternative") ("multipart/digest")
46 ("multipart/parallel")
47 ("message/rfc822") ("message/partial") ("message/external-body")
48 ("application/octet-stream") ("application/postscript")
49 ("image/jpeg") ("image/gif")
50 ("audio/basic")
51 ("video/mpeg"))
52 "Legal MIME content types.")
53
54(defun mh-mhn-compose-insertion (pathname type description)
55 "Add a directive to insert a message part from a file.
56This is the typical way to insert non-text parts in a message.
57See also \\[mh-edit-mhn]."
58 (interactive (list
59 (read-file-name "Insert contents of: ")
60 (completing-read "Content-type: "
61 mh-mime-content-types nil nil nil)
62 (read-string "Content-description: ")))
63 (mh-mhn-compose-type pathname type description))
64
65(defun mh-mhn-compose-type (pathname type
66 &optional description attributes comment)
67 (beginning-of-line)
68 (insert "#" type)
69 (and attributes
70 (insert "; " attributes))
71 (and comment
72 (insert " (" comment ")"))
73 (insert " [")
74 (and description
75 (insert description))
76 (insert "] " (expand-file-name pathname))
77 (insert "\n"))
78
79
80(defun mh-mhn-compose-anon-ftp (host pathname type description)
81 "Add a directive for an anonymous ftp external body part.
82This directive tells MH to include a reference to a message/external-body part
83retrievable by anonymous FTP. See also \\[mh-edit-mhn]."
84 (interactive (list
85 (read-string "Remote host: ")
86 (read-string "Remote pathname: ")
87 (completing-read "External Content-type: "
88 mh-mime-content-types nil nil nil)
89 (read-string "External Content-description: ")))
90 (mh-mhn-compose-external-type "anon-ftp" host pathname
91 type description))
92
93(defun mh-mhn-compose-external-compressed-tar (host pathname description)
94 "Add a directive to include a reference to a compressed tar file.
95The file should be available via anonymous ftp.
96This directive tells MH to include a reference to a message/external-body part.
97See also \\[mh-edit-mhn]."
98 (interactive (list
99 (read-string "Remote host: ")
100 (read-string "Remote pathname: ")
101 (read-string "Tar file Content-description: ")))
102 (mh-mhn-compose-external-type "anon-ftp" host pathname
103 "application/octet-stream"
104 description
105 "type=tar; conversions=x-compress"
106 "mode=image"))
107
108
109(defun mh-mhn-compose-external-type (access-type host pathname type
110 &optional description
111 attributes extra-params comment)
112 (beginning-of-line)
113 (insert "#@" type)
114 (and attributes
115 (insert "; " attributes))
116 (and comment
117 (insert " (" comment ") "))
118 (insert " [")
119 (and description
120 (insert description))
121 (insert "] ")
122 (insert "access-type=" access-type "; ")
123 (insert "site=" host)
124 (insert "; name=" (file-name-nondirectory pathname))
125 (insert "; directory=\"" (file-name-directory pathname) "\"")
126 (and extra-params
127 (insert "; " extra-params))
128 (insert "\n"))
129
130(defun mh-mhn-compose-forw (&optional description msgs folder)
131 "Add a forw directive to this message.
132This directive tells MH to include the named messages in this one.
133Arguments are DESCRIPTION, a line of text for the Content-description header,
134MESSAGES and FOLDER, which name the message(s) to be forwarded.
135See also \\[mh-edit-mhn]."
136 (interactive (list
137 (read-string "Forw Content-description: ")
138 (read-string (format "Messages%s: "
139 (if mh-sent-from-msg
140 (format " [%d]" mh-sent-from-msg)
141 "")))
142 (mh-prompt-for-folder "Message from" mh-sent-from-folder nil)))
143 (beginning-of-line)
144 (insert "#forw [")
145 (and description
146 (not (string= description ""))
147 (insert description))
148 (insert "]")
149 (and folder
150 (not (string= folder ""))
151 (insert " " folder))
152 (if (and msgs
153 (not (string= msgs "")))
154 (let ((start (point)))
155 (insert " " msgs)
156 (subst-char-in-region start (point) ?, ? ))
157 (if mh-sent-from-msg
158 (insert " " (int-to-string mh-sent-from-msg))))
159 (insert "\n"))
160
161(defun mh-edit-mhn ()
162 "Filter the current draft through the mhn program for MIME formatting.
163Using directives already inserted in the draft, fills in
164all the MIME components and header fields.
165This step should be done last just before sending the message.
166The mhn program is part of MH version 6.8 or later.
167The `\\[mh-revert-mhn-edit]' command undoes this command.
168For assistance with creating MIME directives to insert
169various types of components in a message, see
170\\[mh-mhn-compose-insertion] (generic insertion from a file),
171\\[mh-mhn-compose-anon-ftp] (external reference to file via anonymous ftp),
172\\[mh-mhn-compose-external-compressed-tar] \
173\(reference to compressed tar file via anonymous ftp), and
174\\[mh-mhn-compose-forw] (forward message)."
175 (interactive "*")
176 (save-buffer)
177 (message "mhn editing...")
178 (mh-exec-cmd-error (format "mhdraft=%s" (buffer-file-name))
179 "mhn" (buffer-file-name))
180 (revert-buffer t t)
181 (message "mhn editing...done"))
182
183
184(defun mh-revert-mhn-edit (noconfirm)
185 "Undoes the effect of \\[mh-edit-mhn] by reverting to the backup file.
186Argument (optional) non-nil means don't ask for confirmation."
187 (interactive "*P")
188 (if (null buffer-file-name)
189 (error "Buffer does not seem to be associated with any file"))
190 (let ((backup-strings '("," "#"))
191 backup-file)
192 (while (and backup-strings
193 (not (file-exists-p
194 (setq backup-file
195 (concat (file-name-directory buffer-file-name)
196 (car backup-strings)
197 (file-name-nondirectory buffer-file-name)
198 ".orig")))))
199 (setq backup-strings (cdr backup-strings)))
200 (or backup-strings
201 (error "mhn backup file for %s no longer exists!" buffer-file-name))
202 (or noconfirm
203 (yes-or-no-p (format "Revert buffer from file %s? "
204 backup-file))
205 (error "mhn edit revert not confirmed."))
206 (let ((buffer-read-only nil))
207 (erase-buffer)
208 (insert-file-contents backup-file))
209 (after-find-file nil)))
diff --git a/lisp/mail/mh-pick.el b/lisp/mail/mh-pick.el
new file mode 100644
index 00000000000..b74379c2baa
--- /dev/null
+++ b/lisp/mail/mh-pick.el
@@ -0,0 +1,177 @@
1;;; mh-pick --- make a search pattern and search for a message in mh-e
2;; Time-stamp: <93/08/22 22:56:53 gildea>
3
4;; Copyright 1993 Free Software Foundation, Inc.
5
6;; This file is part of mh-e.
7
8;; mh-e is free software; you can redistribute it and/or modify
9;; it under the terms of the GNU General Public License as published by
10;; the Free Software Foundation; either version 2, or (at your option)
11;; any later version.
12
13;; mh-e is distributed in the hope that it will be useful,
14;; but WITHOUT ANY WARRANTY; without even the implied warranty of
15;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16;; GNU General Public License for more details.
17
18;; You should have received a copy of the GNU General Public License
19;; along with mh-e; see the file COPYING. If not, write to
20;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
21
22;;; Commentary:
23
24;; Internal support for mh-e package.
25
26;;; Code:
27
28(provide 'mh-pick)
29(require 'mh-e)
30
31(defvar mh-pick-mode-map (make-sparse-keymap)
32 "Keymap for searching folder.")
33
34(defvar mh-pick-mode-hook nil
35 "Invoked in `mh-pick-mode' on a new pattern.")
36
37(defvar mh-searching-folder nil
38 "Folder this pick is searching.")
39
40(defun mh-search-folder (folder)
41 "Search FOLDER for messages matching a pattern."
42 (interactive (list (mh-prompt-for-folder "Search"
43 mh-current-folder
44 t)))
45 (switch-to-buffer-other-window "pick-pattern")
46 (if (or (zerop (buffer-size))
47 (not (y-or-n-p "Reuse pattern? ")))
48 (mh-make-pick-template)
49 (message ""))
50 (setq mh-searching-folder folder))
51
52(defun mh-make-pick-template ()
53 ;; Initialize the current buffer with a template for a pick pattern.
54 (erase-buffer)
55 (insert "From: \n"
56 "To: \n"
57 "Cc: \n"
58 "Date: \n"
59 "Subject: \n"
60 "---------\n")
61 (mh-pick-mode)
62 (goto-char (point-min))
63 (end-of-line))
64
65(put 'mh-pick-mode 'mode-class 'special)
66
67(defun mh-pick-mode ()
68 "Mode for creating search templates in mh-e.\\<mh-pick-mode-map>
69After each field name, enter the pattern to search for. To search
70the entire message, supply the pattern in the \"body\" of the template.
71When you have finished, type \\[mh-do-pick-search] to do the search.
72\\{mh-pick-mode-map}
73Turning on mh-pick-mode calls the value of the variable mh-pick-mode-hook
74if that value is non-nil."
75 (interactive)
76 (kill-all-local-variables)
77 (make-local-variable 'mh-searching-folder)
78 (use-local-map mh-pick-mode-map)
79 (setq major-mode 'mh-pick-mode)
80 (mh-set-mode-name "MH-Pick")
81 (run-hooks 'mh-pick-mode-hook))
82
83
84(defun mh-do-pick-search ()
85 "Find messages that match the qualifications in the current pattern buffer.
86Messages are searched for in the folder named in mh-searching-folder.
87Add messages found to the sequence named `search'."
88 (interactive)
89 (let ((pattern-buffer (buffer-name))
90 (searching-buffer mh-searching-folder)
91 range msgs
92 (pattern nil)
93 (new-buffer nil))
94 (save-excursion
95 (cond ((get-buffer searching-buffer)
96 (set-buffer searching-buffer)
97 (setq range (format "%d-%d" mh-first-msg-num mh-last-msg-num)))
98 (t
99 (mh-make-folder searching-buffer)
100 (setq range "all")
101 (setq new-buffer t))))
102 (message "Searching...")
103 (goto-char (point-min))
104 (while (setq pattern (mh-next-pick-field pattern-buffer))
105 (setq msgs (mh-seq-from-command searching-buffer
106 'search
107 (nconc (cons "pick" pattern)
108 (list searching-buffer
109 range
110 "-sequence" "search"
111 "-list"))))
112 (setq range "search"))
113 (message "Searching...done")
114 (if new-buffer
115 (mh-scan-folder searching-buffer msgs)
116 (switch-to-buffer searching-buffer))
117 (delete-other-windows)
118 (mh-notate-seq 'search ?% (1+ mh-cmd-note))))
119
120
121(defun mh-seq-from-command (folder seq seq-command)
122 ;; In FOLDER, make a sequence named SEQ by executing COMMAND.
123 ;; COMMAND is a list. The first element is a program name
124 ;; and the subsequent elements are its arguments, all strings.
125 (let ((msg)
126 (msgs ())
127 (case-fold-search t))
128 (save-excursion
129 (save-window-excursion
130 (if (eq 0 (apply 'mh-exec-cmd-quiet nil seq-command))
131 (while (setq msg (car (mh-read-msg-list)))
132 (setq msgs (cons msg msgs))
133 (forward-line 1))))
134 (set-buffer folder)
135 (setq msgs (nreverse msgs)) ; Put in ascending order
136 (setq mh-seq-list (cons (mh-make-seq seq msgs) mh-seq-list))
137 msgs)))
138
139
140(defun mh-next-pick-field (buffer)
141 ;; Return the next piece of a pick argument that can be extracted from the
142 ;; BUFFER. Returns nil if no pieces remain.
143 (set-buffer buffer)
144 (let ((case-fold-search t))
145 (cond ((eobp)
146 nil)
147 ((re-search-forward "^\\([a-z][^: \t\n]*\\):[ \t]*\\([a-z0-9].*\\)$" nil t)
148 (let* ((component
149 (format "--%s"
150 (downcase (buffer-substring (match-beginning 1)
151 (match-end 1)))))
152 (pat (buffer-substring (match-beginning 2) (match-end 2))))
153 (forward-line 1)
154 (list component pat)))
155 ((re-search-forward "^-*$" nil t)
156 (forward-char 1)
157 (let ((body (buffer-substring (point) (point-max))))
158 (if (and (> (length body) 0) (not (equal body "\n")))
159 (list "-search" body)
160 nil)))
161 (t
162 nil))))
163
164;;; Build the pick-mode keymap:
165
166(define-key mh-pick-mode-map "\C-c\C-c" 'mh-do-pick-search)
167(define-key mh-pick-mode-map "\C-c\C-f\C-b" 'mh-to-field)
168(define-key mh-pick-mode-map "\C-c\C-f\C-c" 'mh-to-field)
169(define-key mh-pick-mode-map "\C-c\C-f\C-f" 'mh-to-field)
170(define-key mh-pick-mode-map "\C-c\C-f\C-s" 'mh-to-field)
171(define-key mh-pick-mode-map "\C-c\C-f\C-t" 'mh-to-field)
172(define-key mh-pick-mode-map "\C-c\C-fb" 'mh-to-field)
173(define-key mh-pick-mode-map "\C-c\C-fc" 'mh-to-field)
174(define-key mh-pick-mode-map "\C-c\C-ff" 'mh-to-field)
175(define-key mh-pick-mode-map "\C-c\C-fs" 'mh-to-field)
176(define-key mh-pick-mode-map "\C-c\C-ft" 'mh-to-field)
177(define-key mh-pick-mode-map "\C-c\C-w" 'mh-check-whom)
diff --git a/lisp/mail/mh-seq.el b/lisp/mail/mh-seq.el
new file mode 100644
index 00000000000..e51e1c30398
--- /dev/null
+++ b/lisp/mail/mh-seq.el
@@ -0,0 +1,222 @@
1;;; mh-seq --- mh-e sequences support
2;; Time-stamp: <93/12/02 09:36:09 gildea>
3
4;; Copyright 1993 Free Software Foundation, Inc.
5
6;; This file is part of mh-e.
7
8;; mh-e is free software; you can redistribute it and/or modify
9;; it under the terms of the GNU General Public License as published by
10;; the Free Software Foundation; either version 2, or (at your option)
11;; any later version.
12
13;; mh-e is distributed in the hope that it will be useful,
14;; but WITHOUT ANY WARRANTY; without even the implied warranty of
15;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16;; GNU General Public License for more details.
17
18;; You should have received a copy of the GNU General Public License
19;; along with mh-e; see the file COPYING. If not, write to
20;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
21
22;;; Commentary:
23
24;; Internal support for mh-e package.
25
26;;; Code:
27
28(provide 'mh-seq)
29(require 'mh-e)
30
31(defvar mh-last-seq-used nil
32 "Name of the sequence to which a message was last added.")
33
34
35(defun mh-delete-seq (seq)
36 "Delete the SEQUENCE."
37 (interactive (list (mh-read-seq-default "Delete" t)))
38 (mh-map-to-seq-msgs 'mh-notate-if-in-one-seq seq ? (1+ mh-cmd-note) seq)
39 (mh-undefine-sequence seq "all")
40 (mh-delete-seq-locally seq))
41
42
43(defun mh-list-sequences (folder)
44 "List the sequences defined in FOLDER."
45 (interactive (list (mh-prompt-for-folder "List sequences in"
46 mh-current-folder t)))
47 (let ((temp-buffer " *mh-temp*")
48 (seq-list mh-seq-list))
49 (with-output-to-temp-buffer temp-buffer
50 (save-excursion
51 (set-buffer temp-buffer)
52 (erase-buffer)
53 (message "Listing sequences ...")
54 (insert "Sequences in folder " folder ":\n")
55 (while seq-list
56 (let ((name (mh-seq-name (car seq-list)))
57 (sorted-seq-msgs
58 (sort (copy-sequence (mh-seq-msgs (car seq-list))) '<))
59 (last-col (- (window-width) 4))
60 name-spec)
61 (insert (setq name-spec (format "%20s:" name)))
62 (while sorted-seq-msgs
63 (if (> (current-column) last-col)
64 (progn
65 (insert "\n")
66 (move-to-column (length name-spec))))
67 (insert (format " %s" (car sorted-seq-msgs)))
68 (setq sorted-seq-msgs (cdr sorted-seq-msgs)))
69 (insert "\n"))
70 (setq seq-list (cdr seq-list)))
71 (goto-char (point-min))
72 (message "Listing sequences...done")))))
73
74
75(defun mh-msg-is-in-seq (msg)
76 "Display the sequences that contain MESSAGE (default: displayed message)."
77 (interactive (list (mh-get-msg-num t)))
78 (message "Message %d is in sequences: %s"
79 msg
80 (mapconcat 'concat
81 (mh-list-to-string (mh-seq-containing-msg msg))
82 " ")))
83
84
85(defun mh-narrow-to-seq (seq)
86 "Restrict display of this folder to just messages in a sequence.
87Reads which sequence.\\<mh-folder-mode-map> Use \\[mh-widen] to undo this command."
88 (interactive (list (mh-read-seq "Narrow to" t)))
89 (let ((eob (point-max)))
90 (with-mh-folder-updating (t)
91 (cond ((mh-seq-to-msgs seq)
92 (mh-copy-seq-to-point seq eob)
93 (narrow-to-region eob (point-max))
94 (mh-make-folder-mode-line (symbol-name seq))
95 (mh-recenter nil)
96 (setq mh-narrowed-to-seq seq))
97 (t
98 (error "No messages in sequence `%s'" (symbol-name seq)))))))
99
100
101(defun mh-put-msg-in-seq (msg-or-seq to)
102 "Add MESSAGE(s) (default: displayed message) to SEQUENCE.
103If optional prefix argument provided, then prompt for the message sequence."
104 (interactive (list (if current-prefix-arg
105 (mh-read-seq-default "Add messages from" t)
106 (mh-get-msg-num t))
107 (mh-read-seq-default "Add to" nil)))
108 (setq mh-last-seq-used to)
109 (mh-add-msgs-to-seq (if (numberp msg-or-seq)
110 msg-or-seq
111 (mh-seq-to-msgs msg-or-seq))
112 to))
113
114
115(defun mh-widen ()
116 "Remove restrictions from current folder, thereby showing all messages."
117 (interactive)
118 (if mh-narrowed-to-seq
119 (with-mh-folder-updating (t)
120 (delete-region (point-min) (point-max))
121 (widen)
122 (mh-make-folder-mode-line)))
123 (setq mh-narrowed-to-seq nil))
124
125
126
127;;; Commands to manipulate sequences. Sequences are stored in an alist
128;;; of the form:
129;;; ((seq-name msgs ...) (seq-name msgs ...) ...)
130
131
132(defun mh-read-seq-default (prompt not-empty)
133 ;; Read and return sequence name with default narrowed or previous sequence.
134 (mh-read-seq prompt not-empty (or mh-narrowed-to-seq mh-last-seq-used)))
135
136
137(defun mh-read-seq (prompt not-empty &optional default)
138 ;; Read and return a sequence name. Prompt with PROMPT, raise an error
139 ;; if the sequence is empty and the NOT-EMPTY flag is non-nil, and supply
140 ;; an optional DEFAULT sequence.
141 ;; A reply of '%' defaults to the first sequence containing the current
142 ;; message.
143 (let* ((input (completing-read (format "%s %s %s" prompt "sequence:"
144 (if default
145 (format "[%s] " default)
146 ""))
147 (mh-seq-names mh-seq-list)))
148 (seq (cond ((equal input "%") (mh-msg-to-seq (mh-get-msg-num t)))
149 ((equal input "") default)
150 (t (intern input))))
151 (msgs (mh-seq-to-msgs seq)))
152 (if (and (null msgs) not-empty)
153 (error (format "No messages in sequence `%s'" seq)))
154 seq))
155
156
157(defun mh-msg-to-seq (msg)
158 ;; Given a MESSAGE number, return the first sequence in which it occurs.
159 (car (mh-seq-containing-msg msg)))
160
161
162(defun mh-seq-names (seq-list)
163 ;; Return an alist containing the names of the SEQUENCES.
164 (mapcar (function (lambda (entry) (list (symbol-name (mh-seq-name entry)))))
165 seq-list))
166
167
168(defun mh-rename-seq (seq new-name)
169 "Rename a SEQUENCE to have a new NAME."
170 (interactive (list (mh-read-seq "Old" t)
171 (intern (read-string "New sequence name: "))))
172 (let ((old-seq (mh-find-seq seq)))
173 (or old-seq
174 (error "Sequence %s does not exist" seq))
175 ;; create new seq first, since it might raise an error.
176 (mh-define-sequence new-name (mh-seq-msgs old-seq))
177 (mh-undefine-sequence seq (mh-seq-msgs old-seq))
178 (rplaca old-seq new-name)))
179
180
181(defun mh-map-to-seq-msgs (func seq &rest args)
182 ;; Invoke the FUNCTION at each message in the SEQUENCE, passing the
183 ;; remaining ARGS as arguments.
184 (save-excursion
185 (let ((msgs (mh-seq-to-msgs seq)))
186 (while msgs
187 (if (mh-goto-msg (car msgs) t t)
188 (apply func (car msgs) args))
189 (setq msgs (cdr msgs))))))
190
191
192(defun mh-notate-seq (seq notation offset)
193 ;; Mark the scan listing of all messages in the SEQUENCE with the CHARACTER
194 ;; at the given OFFSET from the beginning of the listing line.
195 (mh-map-to-seq-msgs 'mh-notate seq notation offset))
196
197
198(defun mh-add-to-sequence (seq msgs)
199 ;; Add to a SEQUENCE each message the list of MSGS.
200 (if (not (mh-folder-name-p seq))
201 (if msgs
202 (apply 'mh-exec-cmd "mark" mh-current-folder "-add"
203 "-sequence" (symbol-name seq)
204 msgs))))
205
206
207(defun mh-copy-seq-to-point (seq location)
208 ;; Copy the scan listing of the messages in SEQUENCE to after the point
209 ;; LOCATION in the current buffer.
210 (mh-map-to-seq-msgs 'mh-copy-line-to-point seq location))
211
212
213(defun mh-copy-line-to-point (msg location)
214 ;; Copy the current line to the LOCATION in the current buffer.
215 (beginning-of-line)
216 (let ((beginning-of-line (point)))
217 (forward-line 1)
218 (copy-region-as-kill beginning-of-line (point))
219 (goto-char location)
220 (yank)
221 (goto-char beginning-of-line)))
222
diff --git a/lisp/mail/mh-utils.el b/lisp/mail/mh-utils.el
new file mode 100644
index 00000000000..0b37dadaa39
--- /dev/null
+++ b/lisp/mail/mh-utils.el
@@ -0,0 +1,816 @@
1;;; mh-utils.el --- mh-e code needed for both sending and reading
2;; Time-stamp: <93/12/26 18:50:51 gildea>
3
4;; Copyright 1993 Free Software Foundation, Inc.
5
6;; This file is part of mh-e.
7
8;; mh-e is free software; you can redistribute it and/or modify
9;; it under the terms of the GNU General Public License as published by
10;; the Free Software Foundation; either version 2, or (at your option)
11;; any later version.
12
13;; mh-e is distributed in the hope that it will be useful,
14;; but WITHOUT ANY WARRANTY; without even the implied warranty of
15;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16;; GNU General Public License for more details.
17
18;; You should have received a copy of the GNU General Public License
19;; along with mh-e; see the file COPYING. If not, write to
20;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
21
22;;; Commentary:
23
24;; Internal support for mh-e package.
25
26;;; Code:
27
28;;; mh-e macros
29
30(defmacro with-mh-folder-updating (save-modification-flag-p &rest body)
31 ;; Format is (with-mh-folder-updating (SAVE-MODIFICATION-FLAG-P) &body BODY).
32 ;; Execute BODY, which can modify the folder buffer without having to
33 ;; worry about file locking or the read-only flag, and return its result.
34 ;; If SAVE-MODIFICATION-FLAG-P is non-nil, the buffer's modification
35 ;; flag is unchanged, otherwise it is cleared.
36 (setq save-modification-flag-p (car save-modification-flag-p)) ; CL style
37 (` (let (, (if save-modification-flag-p '((mh-folder-updating-mod-flag (buffer-modified-p)))))
38 (prog1
39 (let ((buffer-read-only nil)
40 (buffer-file-name nil)) ; don't let the buffer get locked
41 (,@ body))
42 (, (if save-modification-flag-p
43 '(mh-set-folder-modified-p mh-folder-updating-mod-flag)
44 '(mh-set-folder-modified-p nil)))))))
45
46(put 'with-mh-folder-updating 'lisp-indent-hook 1)
47
48(defmacro mh-in-show-buffer (show-buffer &rest body)
49 ;; Format is (mh-in-show-buffer (show-buffer) &body BODY).
50 ;; Display buffer SHOW-BUFFER in other window and execute BODY in it.
51 ;; Stronger than save-excursion, weaker than save-window-excursion.
52 (setq show-buffer (car show-buffer)) ; CL style
53 (` (let ((mh-in-show-buffer-saved-window (selected-window)))
54 (switch-to-buffer-other-window (, show-buffer))
55 (if mh-bury-show-buffer (bury-buffer (current-buffer)))
56 (unwind-protect
57 (progn
58 (,@ body))
59 (select-window mh-in-show-buffer-saved-window)))))
60
61(put 'mh-in-show-buffer 'lisp-indent-hook 1)
62
63(defmacro mh-seq-name (pair) (list 'car pair))
64
65(defmacro mh-seq-msgs (pair) (list 'cdr pair))
66
67
68(defvar mh-auto-folder-collect t
69 "*Whether to start collecting MH folder names immediately in the background.
70Non-nil means start a background process collecting the names of all
71folders as soon as mh-e is loaded.")
72
73(defvar mh-recursive-folders nil
74 "*If non-nil, then commands which operate on folders do so recursively.")
75
76(defvar mh-clean-message-header nil
77 "*Non-nil means clean headers of messages that are displayed or inserted.
78The variables `mh-visible-headers' and `mh-invisible-headers' control what
79is removed.")
80
81(defvar mh-visible-headers nil
82 "*If non-nil, contains a regexp specifying the headers to keep when cleaning.
83Only used if `mh-clean-message-header' is non-nil. Setting this variable
84overrides `mh-invisible-headers'.")
85
86(defvar mh-invisible-headers
87 "^Received: \\|^Message-Id: \\|^Remailed-\\|^Via: \\|^Mail-from: \\|^Return-Path: \\|^In-Reply-To: \\|^Resent-"
88 "Regexp matching lines in a message header that are not to be shown.
89If `mh-visible-headers' is non-nil, it is used instead to specify what
90to keep.")
91
92(defvar mh-bury-show-buffer t
93 "*Non-nil means that the displayed show buffer for a folder is buried.")
94
95(defvar mh-summary-height 4
96 "*Number of lines in MH-Folder window (including the mode line).")
97
98(defvar mh-msg-number-regexp "^ *\\([0-9]+\\)"
99 "Regexp to find the number of a message in a scan line.
100The message's number must be surrounded with \\( \\)")
101
102(defvar mh-msg-search-regexp "^[^0-9]*%d[^0-9]"
103 "Format string containing a regexp matching the scan listing for a message.
104The desired message's number will be an argument to format.")
105
106(defvar mhl-formfile nil
107 "*Name of format file to be used by mhl to show and print messages.
108A value of T means use the default format file.
109Nil means don't use mhl to format messages when showing; mhl is still used,
110with the default format file, to format messages when printing them.
111The format used should specify a non-zero value for overflowoffset so
112the message continues to conform to RFC 822 and mh-e can parse the headers.")
113
114(defvar mh-msg-folder-hook nil
115 "Select a default folder for refiling or Fcc.
116Called by `\\[mh-refile-msg]' and `\\[mh-to-fcc]' to get a default
117when prompting the user for a folder. Called from within a save-excursion,
118with point at the start of the message. Should return the folder to offer
119as the refile or Fcc folder, as a string with a leading `+' sign.")
120
121
122(defvar mh-cmd-note 4
123 "Offset to insert notation.")
124
125(defvar mh-folder-list nil
126 "List of folder names for completion.")
127
128(defvar mh-user-path nil
129 "User's mail folder directory.")
130
131(defvar mh-draft-folder nil
132 "Name of folder containing draft messages.
133NIL means do not use draft folder.")
134
135(defvar mh-previous-window-config nil
136 "Window configuration before mh-e command.")
137
138(defvar mh-current-folder nil
139 "Name of current folder, a string.")
140
141(defvar mh-folder-filename nil
142 "Full path of directory for this folder.")
143
144(defvar mh-show-buffer nil
145 "Buffer that displays mesage for this folder.")
146
147(defvar mh-unseen-seq nil
148 "Name of the Unseen sequence.")
149
150(defvar mh-previous-seq nil
151 "Name of the Previous sequence.")
152
153(defvar mh-seen-list nil
154 "List of displayed messages.")
155
156(defvar mh-seq-list nil
157 "Alist of (seq . msgs) numbers.")
158
159(defvar mh-showing nil
160 "If non-nil, show the message in a separate window.")
161
162(defvar mh-showing-with-headers nil
163 "If non-nil, show buffer contains message with all headers.
164If nil, show buffer contains message processed normally.")
165
166
167;;; Ensure new buffers won't get this mode if default-major-mode is nil.
168(put 'mh-show-mode 'mode-class 'special)
169
170(defun mh-show-mode ()
171 "Major mode for showing messages in mh-e.
172The value of mh-show-mode-hook is called when a new message is displayed."
173 (kill-all-local-variables)
174 (setq major-mode 'mh-show-mode)
175 (mh-set-mode-name "MH-Show")
176 (run-hooks 'mh-show-mode-hook))
177
178
179(defun mh-maybe-show (&optional msg)
180 ;; If in showing mode, then display the message pointed to by the cursor.
181 (if mh-showing (mh-show msg)))
182
183(defun mh-show (&optional msg)
184 "Show MESSAGE (default: displayed message).
185Forces a two-window display with the folder window on top (size
186mh-summary-height) and the show buffer below it.
187If the message is already visible, display the start of the message."
188 (interactive)
189 (and mh-showing-with-headers
190 (or mhl-formfile mh-clean-message-header)
191 (mh-invalidate-show-buffer))
192 (mh-show-msg msg))
193
194
195(defun mh-show-msg (msg)
196 (if (not msg)
197 (setq msg (mh-get-msg-num t)))
198 (setq mh-showing t)
199 (let ((folder mh-current-folder)
200 (clean-message-header mh-clean-message-header)
201 (show-window (get-buffer-window mh-show-buffer)))
202 (if (not (eql (next-window (minibuffer-window)) (selected-window)))
203 (delete-other-windows)) ; force ourself to the top window
204 (mh-in-show-buffer (mh-show-buffer)
205 (if (and show-window
206 (equal (mh-msg-filename msg folder) buffer-file-name))
207 (progn ;just back up to start
208 (goto-char (point-min))
209 (if (not clean-message-header)
210 (mh-start-of-uncleaned-message)))
211 (mh-display-msg msg folder))))
212 (if (not (= (1+ (window-height)) (screen-height))) ;not horizontally split
213 (shrink-window (- (window-height) mh-summary-height)))
214 (mh-recenter nil)
215 (if (not (memq msg mh-seen-list)) (setq mh-seen-list (cons msg mh-seen-list)))
216 (run-hooks 'mh-show-hook))
217
218
219(defun mh-display-msg (msg-num folder)
220 ;; Display message NUMBER of FOLDER.
221 ;; Sets the current buffer to the show buffer.
222 (set-buffer folder)
223 ;; Bind variables in folder buffer in case they are local
224 (let ((formfile mhl-formfile)
225 (clean-message-header mh-clean-message-header)
226 (invisible-headers mh-invisible-headers)
227 (visible-headers mh-visible-headers)
228 (msg-filename (mh-msg-filename msg-num))
229 (show-buffer mh-show-buffer))
230 (if (not (file-exists-p msg-filename))
231 (error "Message %d does not exist" msg-num))
232 (set-buffer show-buffer)
233 (cond ((not (equal msg-filename buffer-file-name))
234 ;; Buffer does not yet contain message.
235 (clear-visited-file-modtime)
236 (unlock-buffer)
237 (setq buffer-file-name nil) ; no locking during setup
238 (erase-buffer)
239 (if formfile
240 (mh-exec-lib-cmd-output "mhl" "-nobell" "-noclear"
241 (if (stringp formfile)
242 (list "-form" formfile))
243 msg-filename)
244 (insert-file-contents msg-filename))
245 (goto-char (point-min))
246 (cond (clean-message-header
247 (mh-clean-msg-header (point-min)
248 invisible-headers
249 visible-headers)
250 (goto-char (point-min)))
251 (t
252 (mh-start-of-uncleaned-message)))
253 (set-buffer-modified-p nil)
254 (or (eq buffer-undo-list t) ;don't save undo info for prev msgs
255 (setq buffer-undo-list nil))
256 (setq buffer-file-name msg-filename)
257 (set-mark nil)
258 (mh-show-mode)
259 (setq mode-line-buffer-identification
260 (list (format mh-show-buffer-mode-line-buffer-id
261 folder msg-num)))
262 (set-buffer folder)
263 (setq mh-showing-with-headers nil)))))
264
265(defun mh-start-of-uncleaned-message ()
266 ;; position uninteresting headers off the top of the window
267 (let ((case-fold-search t))
268 (re-search-forward
269 "^To:\\|^From:\\|^Subject:\\|^Date:" nil t)
270 (beginning-of-line)
271 (mh-recenter 0)))
272
273
274(defun mh-invalidate-show-buffer ()
275 ;; Invalidate the show buffer so we must update it to use it.
276 (if (get-buffer mh-show-buffer)
277 (save-excursion
278 (set-buffer mh-show-buffer)
279 (setq buffer-file-name nil))))
280
281
282(defun mh-get-msg-num (error-if-no-message)
283 ;; Return the message number of the displayed message. If the argument
284 ;; ERROR-IF-NO-MESSAGE is non-nil, then complain if the cursor is not
285 ;; pointing to a message.
286 (save-excursion
287 (beginning-of-line)
288 (cond ((looking-at mh-msg-number-regexp)
289 (string-to-int (buffer-substring (match-beginning 1)
290 (match-end 1))))
291 (error-if-no-message
292 (error "Cursor not pointing to message"))
293 (t nil))))
294
295
296(defun mh-msg-filename (msg &optional folder)
297 ;; Return the file name of MESSAGE in FOLDER (default current folder).
298 (expand-file-name (int-to-string msg)
299 (if folder
300 (mh-expand-file-name folder)
301 mh-folder-filename)))
302
303
304(defun mh-clean-msg-header (start invisible-headers visible-headers)
305 ;; Flush extraneous lines in a message header, from the given POINT to the
306 ;; end of the message header. If VISIBLE-HEADERS is non-nil, it contains a
307 ;; regular expression specifying the lines to display, otherwise
308 ;; INVISIBLE-HEADERS contains a regular expression specifying lines to
309 ;; delete from the header.
310 (let ((case-fold-search t))
311 (save-restriction
312 (goto-char start)
313 (if (search-forward "\n\n" nil 'move)
314 (backward-char 1))
315 (narrow-to-region start (point))
316 (goto-char (point-min))
317 (if visible-headers
318 (while (< (point) (point-max))
319 (cond ((looking-at visible-headers)
320 (forward-line 1)
321 (while (looking-at "[ \t]") (forward-line 1)))
322 (t
323 (mh-delete-line 1)
324 (while (looking-at "[ \t]")
325 (mh-delete-line 1)))))
326 (while (re-search-forward invisible-headers nil t)
327 (beginning-of-line)
328 (mh-delete-line 1)
329 (while (looking-at "[ \t]")
330 (mh-delete-line 1))))
331 (unlock-buffer))))
332
333
334(defun mh-recenter (arg)
335 ;; Like recenter but with two improvements: nil arg means recenter,
336 ;; and only does anything if the current buffer is in the selected
337 ;; window. (Commands like save-some-buffers can make this false.)
338 (if (eql (get-buffer-window (current-buffer))
339 (selected-window))
340 (recenter (if arg arg '(t)))))
341
342
343(defun mh-delete-line (lines)
344 ;; Delete version of kill-line.
345 (delete-region (point) (save-excursion (forward-line lines) (point))))
346
347
348(defun mh-get-field (field)
349 ;; Find and return the value of field FIELD in the current buffer.
350 ;; Returns the empty string if the field is not in the message.
351 (let ((case-fold-search t))
352 (goto-char (point-min))
353 (cond ((not (re-search-forward (format "^%s" field) nil t)) "")
354 ((looking-at "[\t ]*$") "")
355 (t
356 (re-search-forward "[\t ]*\\([^\t \n].*\\)$" nil t)
357 (let ((start (match-beginning 1)))
358 (forward-line 1)
359 (while (looking-at "[ \t]")
360 (forward-line 1))
361 (buffer-substring start (1- (point))))))))
362
363
364(defun mh-notate (msg notation offset)
365 ;; Marks MESSAGE with the character NOTATION at position OFFSET.
366 ;; Null MESSAGE means the message that the cursor points to.
367 (save-excursion
368 (if (or (null msg)
369 (mh-goto-msg msg t t))
370 (with-mh-folder-updating (t)
371 (beginning-of-line)
372 (forward-char offset)
373 (delete-char 1)
374 (insert notation)))))
375
376
377(defun mh-goto-msg (number &optional no-error-if-no-message dont-show)
378 "Position the cursor at message NUMBER.
379Non-nil second argument means do not signal an error if message does not exist.
380Non-nil third argument means not to show the message.
381Return non-nil if cursor is at message."
382 (interactive "NJump to message: ")
383 (let ((cur-msg (mh-get-msg-num nil))
384 (starting-place (point))
385 (msg-pattern (mh-msg-search-pat number)))
386 (cond ((cond ((and cur-msg (= cur-msg number)) t)
387 ((and cur-msg
388 (< cur-msg number)
389 (re-search-forward msg-pattern nil t)) t)
390 ((and cur-msg
391 (> cur-msg number)
392 (re-search-backward msg-pattern nil t)) t)
393 (t ; Do thorough search of buffer
394 (goto-char (point-max))
395 (re-search-backward msg-pattern nil t)))
396 (beginning-of-line)
397 (if (not dont-show) (mh-maybe-show number))
398 t)
399 (t
400 (goto-char starting-place)
401 (if (not no-error-if-no-message)
402 (error "No message %d" number))
403 nil))))
404
405(defun mh-msg-search-pat (n)
406 ;; Return a search pattern for message N in the scan listing.
407 (format mh-msg-search-regexp n))
408
409
410(defun mh-find-path ()
411 ;; Set mh-progs and mh-lib.
412 ;; (This step is necessary if MH was installed after this Emacs was dumped.)
413 ;; Set mh-user-path, mh-draft-folder,
414 ;; mh-unseen-seq, and mh-previous-seq from profile file.
415 (mh-find-progs)
416 (save-excursion
417 ;; Be sure profile is fully expanded before switching buffers
418 (let ((profile (expand-file-name (or (getenv "MH") "~/.mh_profile"))))
419 (set-buffer (get-buffer-create " *mh-temp*"))
420 (setq buffer-offer-save nil) ;for people who set default to t
421 (erase-buffer)
422 (condition-case err
423 (insert-file-contents profile)
424 (file-error
425 (mh-install profile err)))
426 (setq mh-draft-folder (mh-get-field "Draft-Folder:"))
427 (cond ((equal mh-draft-folder "")
428 (setq mh-draft-folder nil))
429 ((not (mh-folder-name-p mh-draft-folder))
430 (setq mh-draft-folder (format "+%s" mh-draft-folder))))
431 (setq mh-user-path (mh-get-field "Path:"))
432 (if (equal mh-user-path "")
433 (setq mh-user-path "Mail"))
434 (setq mh-user-path
435 (file-name-as-directory
436 (expand-file-name mh-user-path (expand-file-name "~"))))
437 (if (and mh-draft-folder
438 (not (file-exists-p (mh-expand-file-name mh-draft-folder))))
439 (error "Draft folder \"%s\" not found. Create it and try again."
440 (mh-expand-file-name mh-draft-folder)))
441 (setq mh-unseen-seq (mh-get-field "Unseen-Sequence:"))
442 (if (equal mh-unseen-seq "")
443 (setq mh-unseen-seq 'unseen) ;old MH default?
444 (setq mh-unseen-seq (intern mh-unseen-seq)))
445 (setq mh-previous-seq (mh-get-field "Previous-Sequence:"))
446 (if (equal mh-previous-seq "")
447 (setq mh-previous-seq nil)
448 (setq mh-previous-seq (intern mh-previous-seq))))))
449
450(defun mh-find-progs ()
451 (or (file-exists-p (expand-file-name "inc" mh-progs))
452 (setq mh-progs
453 (or (mh-path-search exec-path "inc")
454 (mh-path-search '("/usr/bin/mh/" ;Ultrix 4.2
455 "/usr/new/mh/" ;Ultrix <4.2
456 "/usr/local/bin/mh/"
457 "/usr/local/mh/")
458 "inc")
459 "/usr/local/bin/")))
460 (or (file-exists-p (expand-file-name "mhl" mh-lib))
461 (setq mh-lib
462 (or (mh-path-search '("/usr/lib/mh/" ;Ultrix 4.2
463 "/usr/new/lib/mh/" ;Ultrix <4.2
464 "/usr/local/lib/mh/")
465 "mhl")
466 (mh-path-search exec-path "mhl") ;unlikely
467 "/usr/local/bin/mh/"))))
468
469(defun mh-path-search (path file)
470 ;; Search PATH, a list of directory names, for FILE.
471 ;; Returns the element of PATH that contains FILE, or nil if not found.
472 (while (and path
473 (not (file-exists-p (expand-file-name file (car path)))))
474 (setq path (cdr path)))
475 (car path))
476
477(defun mh-install (profile error-val)
478 ;; Called to do error recovery if we fail to read the profile file.
479 ;; If possible, initialize the MH environment.
480 (if (or (getenv "MH")
481 (file-exists-p profile))
482 (error "Cannot read MH profile \"%s\": %s"
483 profile (car (cdr (cdr error-val)))))
484 ;; The "install-mh" command will output a short note which
485 ;; mh-exec-cmd will display to the user.
486 (mh-exec-cmd (expand-file-name "install-mh" mh-lib) "-auto")
487 ;; now try again to read the profile file
488 (erase-buffer)
489 (condition-case err
490 (insert-file-contents profile)
491 (file-error
492 (error "Cannot read MH profile \"%s\": %s"
493 profile (car (cdr (cdr err)))))))
494
495
496(defun mh-set-folder-modified-p (flag)
497 "Mark current folder as modified or unmodified according to FLAG."
498 (set-buffer-modified-p flag))
499
500
501(defun mh-find-seq (name) (assoc name mh-seq-list))
502
503(defun mh-make-seq (name msgs) (cons name msgs))
504
505(defun mh-seq-to-msgs (seq)
506 "Return a list of the messages in SEQUENCE."
507 (mh-seq-msgs (mh-find-seq seq)))
508
509
510(defun mh-add-msgs-to-seq (msgs seq &optional internal-flag)
511 ;; Add MESSAGE(s) to the SEQUENCE. If optional FLAG is non-nil, do not mark
512 ;; the message in the scan listing or inform MH of the addition.
513 (let ((entry (mh-find-seq seq)))
514 (if (and msgs (atom msgs)) (setq msgs (list msgs)))
515 (if (null entry)
516 (setq mh-seq-list (cons (mh-make-seq seq msgs) mh-seq-list))
517 (if msgs (setcdr entry (append msgs (cdr entry)))))
518 (cond ((not internal-flag)
519 (mh-add-to-sequence seq msgs)
520 (mh-notate-seq seq ?% (1+ mh-cmd-note))))))
521
522(autoload 'mh-add-to-sequence "mh-seq")
523(autoload 'mh-notate-seq "mh-seq")
524(autoload 'mh-read-seq-default "mh-seq")
525(autoload 'mh-map-to-seq-msgs "mh-seq")
526
527
528(defun mh-set-mode-name (mode-name-string)
529 ;; Set the mode-name and ensure that the mode line is updated.
530 (setq mode-name mode-name-string)
531 ;; Force redisplay of all buffers' mode lines to be considered.
532 (save-excursion (set-buffer (other-buffer)))
533 (set-buffer-modified-p (buffer-modified-p)))
534
535
536(defun mh-prompt-for-folder (prompt default can-create)
537 ;; Prompt for a folder name with PROMPT. Returns the folder's name as a
538 ;; string. DEFAULT is used if the folder exists and the user types return.
539 ;; If the CAN-CREATE flag is t, then a non-existent folder is made.
540 (if (null default)
541 (setq default ""))
542 (let* ((prompt (format "%s folder%s" prompt
543 (if (equal "" default)
544 "? "
545 (format " [%s]? " default))))
546 read-name folder-name)
547 (if (null mh-folder-list)
548 (mh-set-folder-list))
549 (while (and (setq read-name (completing-read prompt mh-folder-list
550 nil nil "+"))
551 (equal read-name "")
552 (equal default "")))
553 (cond ((or (equal read-name "") (equal read-name "+"))
554 (setq read-name default))
555 ((not (mh-folder-name-p read-name))
556 (setq read-name (format "+%s" read-name))))
557 (setq folder-name read-name)
558 (cond ((and (> (length folder-name) 0)
559 (eql (aref folder-name (1- (length folder-name))) ?/))
560 (setq folder-name (substring folder-name 0 -1))))
561 (let ((new-file-p (not (file-exists-p (mh-expand-file-name folder-name)))))
562 (cond ((and new-file-p
563 (y-or-n-p
564 (format "Folder %s does not exist. Create it? " folder-name)))
565 (message "Creating %s" folder-name)
566 (call-process "mkdir" nil nil nil (mh-expand-file-name folder-name))
567 (message "Creating %s...done" folder-name)
568 (setq mh-folder-list (cons (list read-name) mh-folder-list)))
569 (new-file-p
570 (error "Folder %s is not created" folder-name))
571 ((and (null (assoc read-name mh-folder-list))
572 (null (assoc (concat read-name "/") mh-folder-list)))
573 (setq mh-folder-list (cons (list read-name) mh-folder-list)))))
574 folder-name))
575
576
577(defvar mh-make-folder-list-process nil
578 "The background process collecting the folder list.")
579
580(defvar mh-folder-list-temp nil
581 "mh-folder-list as it is being built.")
582
583(defvar mh-folder-list-partial-line ""
584 "Start of last incomplete line from folder process.")
585
586(defun mh-set-folder-list ()
587 "Sets mh-folder-list correctly.
588A useful function for the command line or for when you need to sync by hand.
589Format is in a form suitable for completing read."
590 (message "Collecting folder names...")
591 (if (not mh-make-folder-list-process)
592 (mh-make-folder-list-background))
593 (while (eq (process-status mh-make-folder-list-process) 'run)
594 (accept-process-output mh-make-folder-list-process))
595 (setq mh-folder-list mh-folder-list-temp)
596 (setq mh-folder-list-temp nil)
597 (delete-process mh-make-folder-list-process)
598 (setq mh-make-folder-list-process nil)
599 (message "Collecting folder names...done"))
600
601(defun mh-make-folder-list-background ()
602 "Start a background process to compute a list of the user's folders.
603Call mh-set-folder-list to wait for the result."
604 (cond
605 ((not mh-make-folder-list-process)
606 (mh-find-progs)
607 (let ((process-connection-type nil))
608 (setq mh-make-folder-list-process
609 (start-process "folders" nil (expand-file-name "folders" mh-progs)
610 "-fast"
611 (if mh-recursive-folders
612 "-recurse"
613 "-norecurse")))
614 (set-process-filter mh-make-folder-list-process
615 'mh-make-folder-list-filter)
616 (process-kill-without-query mh-make-folder-list-process)))))
617
618(defun mh-make-folder-list-filter (process output)
619 ;; parse output from "folders -fast"
620 (let ((position 0)
621 (line-end t)
622 new-folder)
623 (while line-end
624 (setq line-end (string-match "\n" output position))
625 (cond
626 (line-end ;make sure got complete line
627 (setq new-folder (format "+%s%s"
628 mh-folder-list-partial-line
629 (substring output position line-end)))
630 (setq mh-folder-list-partial-line "")
631 ;; is new folder a subfolder of previous?
632 (if (and mh-folder-list-temp
633 (string-match (regexp-quote
634 (concat (car (car mh-folder-list-temp)) "/"))
635 new-folder))
636 ;; append slash to parent folder for better completion
637 ;; (undone by mh-prompt-for-folder)
638 (setq mh-folder-list-temp
639 (cons (list new-folder)
640 (cons
641 (list (concat (car (car mh-folder-list-temp)) "/"))
642 (cdr mh-folder-list-temp))))
643 (setq mh-folder-list-temp
644 (cons (list new-folder)
645 mh-folder-list-temp)))
646 (setq position (1+ line-end)))))
647 (setq mh-folder-list-partial-line (substring output position))))
648
649
650(defun mh-folder-name-p (name)
651 ;; Return non-NIL if NAME is possibly the name of a folder.
652 ;; A name (a string or symbol) can be a folder name if it begins with "+".
653 (if (symbolp name)
654 (eql (aref (symbol-name name) 0) ?+)
655 (and (> (length name) 0)
656 (eql (aref name 0) ?+))))
657
658
659;;; Issue commands to MH.
660
661
662(defun mh-exec-cmd (command &rest args)
663 ;; Execute mh-command COMMAND with ARGS.
664 ;; Any output is assumed to be an error and is shown to the user.
665 (save-excursion
666 (set-buffer (get-buffer-create " *mh-temp*"))
667 (erase-buffer)
668 (apply 'call-process
669 (expand-file-name command mh-progs) nil t nil
670 (mh-list-to-string args))
671 (if (> (buffer-size) 0)
672 (save-window-excursion
673 (switch-to-buffer-other-window " *mh-temp*")
674 (sit-for 5)))))
675
676
677(defun mh-exec-cmd-error (env command &rest args)
678 ;; In environment ENV, execute mh-command COMMAND with args ARGS.
679 ;; ENV is nil or a string of space-separated "var=value" elements.
680 ;; Signals an error if process does not complete successfully.
681 (save-excursion
682 (set-buffer (get-buffer-create " *mh-temp*"))
683 (erase-buffer)
684 (let ((status
685 (if env
686 ;; the shell hacks necessary here shows just how broken Unix is
687 (apply 'call-process "/bin/sh" nil t nil "-c"
688 (format "%s %s ${1+\"$@\"}"
689 env
690 (expand-file-name command mh-progs))
691 command
692 (mh-list-to-string args))
693 (apply 'call-process
694 (expand-file-name command mh-progs) nil t nil
695 (mh-list-to-string args)))))
696 (mh-handle-process-error command status))))
697
698
699(defun mh-exec-cmd-daemon (command &rest args)
700 ;; Execute MH command COMMAND with ARGS. Any output from command is
701 ;; displayed in an asynchronous pop-up window.
702 (save-excursion
703 (set-buffer (get-buffer-create " *mh-temp*"))
704 (erase-buffer))
705 (let* ((process-connection-type nil)
706 (process (apply 'start-process
707 command nil
708 (expand-file-name command mh-progs)
709 (mh-list-to-string args))))
710 (set-process-filter process 'mh-process-daemon)))
711
712(defun mh-process-daemon (process output)
713 ;; Process daemon that puts output into a temporary buffer.
714 (set-buffer (get-buffer-create " *mh-temp*"))
715 (insert-before-markers output)
716 (display-buffer " *mh-temp*"))
717
718
719(defun mh-exec-cmd-quiet (raise-error command &rest args)
720 ;; Args are RAISE-ERROR, COMMANDS, ARGS....
721 ;; Execute MH command COMMAND with ARGS. ARGS is a list of strings.
722 ;; Return at start of mh-temp buffer, where output can be parsed and used.
723 ;; Returns value of call-process, which is 0 for success,
724 ;; unless RAISE-ERROR is non-nil, in which case an error is signaled
725 ;; if call-process returns non-0.
726 (set-buffer (get-buffer-create " *mh-temp*"))
727 (erase-buffer)
728 (let ((value
729 (apply 'call-process
730 (expand-file-name command mh-progs) nil t nil
731 args)))
732 (goto-char (point-min))
733 (if raise-error
734 (mh-handle-process-error command value)
735 value)))
736
737
738(defun mh-exec-cmd-output (command display &rest args)
739 ;; Execute MH command COMMAND with DISPLAY flag and ARGS.
740 ;; Put the output into buffer after point. Set mark after inserted text.
741 (push-mark (point) t)
742 (apply 'call-process
743 (expand-file-name command mh-progs) nil t display
744 (mh-list-to-string args))
745 (exchange-point-and-mark))
746
747
748(defun mh-exec-lib-cmd-output (command &rest args)
749 ;; Execute MH library command COMMAND with ARGS.
750 ;; Put the output into buffer after point. Set mark after inserted text.
751 (apply 'mh-exec-cmd-output (expand-file-name command mh-lib) nil args))
752
753
754(defun mh-handle-process-error (command status)
755 ;; Raise error if COMMAND returned non-0 STATUS, otherwise return STATUS.
756 ;; STATUS is return value from call-process.
757 ;; Program output is in current buffer.
758 ;; If output is too long ot include in error message, display the bufffer.
759 (cond ((eql status 0) ;success
760 status)
761 ((stringp status) ;kill string
762 (error (format "%s: %s" command status)))
763 (t ;exit code
764 (cond
765 ((= (buffer-size) 0) ;program produced no error message
766 (error (format "%s: exit code %d" command status)))
767 (t
768 ;; will error message fit on one line?
769 (goto-line 2)
770 (if (and (< (buffer-size) (screen-width))
771 (eobp))
772 (error (buffer-substring 1 (progn (goto-char 1)
773 (end-of-line)
774 (point))))
775 (display-buffer (current-buffer))
776 (error (format
777 "%s failed with status %d. See error message in other window."
778 command status))))))))
779
780
781(defun mh-expand-file-name (filename &optional default)
782 "Just like `expand-file-name', but also handles MH folder names.
783Assumes that any filename that starts with '+' is a folder name."
784 (if (mh-folder-name-p filename)
785 (expand-file-name (substring filename 1) mh-user-path)
786 (expand-file-name filename default)))
787
788
789(defun mh-list-to-string (l)
790 ;; Flattens the list L and makes every element of the new list into a string.
791 (nreverse (mh-list-to-string-1 l)))
792
793(defun mh-list-to-string-1 (l)
794 (let ((new-list nil))
795 (while l
796 (cond ((null (car l)))
797 ((symbolp (car l))
798 (setq new-list (cons (symbol-name (car l)) new-list)))
799 ((numberp (car l))
800 (setq new-list (cons (int-to-string (car l)) new-list)))
801 ((equal (car l) ""))
802 ((stringp (car l)) (setq new-list (cons (car l) new-list)))
803 ((listp (car l))
804 (setq new-list (nconc (mh-list-to-string-1 (car l))
805 new-list)))
806 (t (error "Bad element in mh-list-to-string: %s" (car l))))
807 (setq l (cdr l)))
808 new-list))
809
810(provide 'mh-utils)
811
812(and (not noninteractive)
813 mh-auto-folder-collect
814 (mh-make-folder-list-background))
815
816;;; mh-utils.el ends here