1;;; mh-show.el --- MH-Show mode
2
3;; Copyright (C) 1993, 1995, 1997,
4;;  2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
5
6;; Author: Bill Wohler <wohler@newt.com>
7;; Maintainer: Bill Wohler <wohler@newt.com>
8;; Keywords: mail
9;; See: mh-e.el
10
11;; This file is part of GNU Emacs.
12
13;; GNU Emacs 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;; GNU Emacs 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 GNU Emacs; see the file COPYING.  If not, write to the
25;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
26;; Boston, MA 02110-1301, USA.
27
28;;; Commentary:
29
30;; Mode for showing messages.
31
32;;; Change Log:
33
34;;; Code:
35
36(require 'mh-e)
37(require 'mh-scan)
38
39;; Dynamically-created function not found in mh-loaddefs.el.
40(autoload 'mh-tool-bar-init "mh-tool-bar")
41
42(require 'font-lock)
43(require 'gnus-cite)
44(require 'gnus-util)
45(require 'goto-addr)
46
47(autoload 'mh-make-buffer-data "mh-mime") ;can't be automatically generated
48
49
50
51;;; MH-Folder Commands
52
53(defvar mh-showing-with-headers nil
54  "If non-nil, MH-Show buffer contains message with all header fields.
55If nil, MH-Show buffer contains message processed normally.")
56
57;;;###mh-autoload
58(defun mh-show (&optional message redisplay-flag)
59  "Display message\\<mh-folder-mode-map>.
60
61If the message under the cursor is already displayed, this command
62scrolls to the beginning of the message. MH-E normally hides a lot of
63the superfluous header fields that mailers add to a message, but if
64you wish to see all of them, use the command \\[mh-header-display].
65
66Two hooks can be used to control how messages are displayed. The
67first hook, `mh-show-mode-hook', is called early on in the
68process of the message display. It is usually used to perform
69some action on the message's content. The second hook,
70`mh-show-hook', is the last thing called after messages are
71displayed. It's used to affect the behavior of MH-E in general or
72when `mh-show-mode-hook' is too early.
73
74From a program, optional argument MESSAGE can be used to display an
75alternative message. The optional argument REDISPLAY-FLAG forces the
76redisplay of the message even if the show buffer was already
77displaying the correct message.
78
79See the \"mh-show\" customization group for a litany of options that
80control what displayed messages look like."
81  (interactive (list nil t))
82  (when (or redisplay-flag
83            (and mh-showing-with-headers
84                 (or mh-mhl-format-file mh-clean-message-header-flag)))
85    (mh-invalidate-show-buffer))
86  (mh-show-msg message))
87
88;;;###mh-autoload
89(defun mh-header-display ()
90  "Display message with all header fields\\<mh-folder-mode-map>.
91
92Use the command \\[mh-show] to show the message normally again."
93  (interactive)
94  (and (not mh-showing-with-headers)
95       (or mh-mhl-format-file mh-clean-message-header-flag)
96       (mh-invalidate-show-buffer))
97  (let ((mh-decode-mime-flag nil)
98        (mh-mhl-format-file nil)
99        (mh-clean-message-header-flag nil))
100    (mh-show-msg nil)
101    (mh-in-show-buffer (mh-show-buffer)
102      (goto-char (point-min))
103      (mh-recenter 0))
104    (setq mh-showing-with-headers t)))
105
106
107
108;;; Support Routines for MH-Folder Commands
109
110;;;###mh-autoload
111(defun mh-maybe-show (&optional msg)
112  "Display message at cursor, but only if in show mode.
113If optional arg MSG is non-nil, display that message instead."
114  (if mh-showing-mode (mh-show msg)))
115
116(defun mh-show-msg (msg)
117  "Show MSG.
118
119The hook `mh-show-hook' is called after the message has been
120displayed."
121  (if (not msg)
122      (setq msg (mh-get-msg-num t)))
123  (mh-showing-mode t)
124  (setq mh-page-to-next-msg-flag nil)
125  (let ((folder mh-current-folder)
126        (folders (list mh-current-folder))
127        (clean-message-header mh-clean-message-header-flag)
128        (show-window (get-buffer-window mh-show-buffer))
129        (display-mime-buttons-flag mh-display-buttons-for-inline-parts-flag))
130    (if (not (eq (next-window (minibuffer-window)) (selected-window)))
131        (delete-other-windows))         ; force ourself to the top window
132    (mh-in-show-buffer (mh-show-buffer)
133      (setq mh-display-buttons-for-inline-parts-flag display-mime-buttons-flag)
134      (if (and show-window
135               (equal (mh-msg-filename msg folder) buffer-file-name))
136          (progn                        ;just back up to start
137            (goto-char (point-min))
138            (if (not clean-message-header)
139                (mh-start-of-uncleaned-message)))
140        (mh-display-msg msg folder)))
141    (if (not (= (1+ (window-height)) (frame-height))) ;not horizontally split
142        (shrink-window (- (window-height) (or mh-summary-height
143                                              (mh-summary-height)))))
144    (mh-recenter nil)
145    ;; The following line is a nop which forces update of the scan line so
146    ;; that font-lock will update it (if needed)...
147    (mh-notate nil nil mh-cmd-note)
148    (if (not (memq msg mh-seen-list))
149        (setq mh-seen-list (cons msg mh-seen-list)))
150    (when mh-update-sequences-after-mh-show-flag
151      (mh-update-sequences)
152      (when mh-index-data
153        (setq folders
154              (append (mh-index-delete-from-sequence mh-unseen-seq (list msg))
155                      folders)))
156      (when (mh-speed-flists-active-p)
157        (apply #'mh-speed-flists t folders)))
158    (run-hooks 'mh-show-hook)))
159
160;;;###mh-autoload
161(defun mh-showing-mode (&optional arg)
162  "Change whether messages should be displayed.
163
164With ARG, display messages iff ARG is positive."
165  (setq mh-showing-mode
166        (if (null arg)
167            (not mh-showing-mode)
168          (> (prefix-numeric-value arg) 0))))
169
170;;;###mh-autoload
171(defun mh-start-of-uncleaned-message ()
172  "Position uninteresting headers off the top of the window."
173  (let ((case-fold-search t))
174    (re-search-forward
175     "^To:\\|^Cc:\\|^From:\\|^Subject:\\|^Date:" nil t)
176    (beginning-of-line)
177    (mh-recenter 0)))
178
179(defvar mh-show-buffer-mode-line-buffer-id "    {show-%s} %d"
180  "Format string to produce `mode-line-buffer-identification' for show buffers.
181
182First argument is folder name. Second is message number.")
183
184;;;###mh-autoload
185(defun mh-display-msg (msg-num folder-name)
186  "Display MSG-NUM of FOLDER-NAME.
187Sets the current buffer to the show buffer."
188  (let ((folder (mh-msg-folder folder-name)))
189    (set-buffer folder)
190    ;; When Gnus uses external displayers it has to keep handles longer. So
191    ;; we will delete these handles when mh-quit is called on the folder. It
192    ;; would be nicer if there are weak pointers in emacs lisp, then we could
193    ;; get the garbage collector to do this for us.
194    (unless (mh-buffer-data)
195      (setf (mh-buffer-data) (mh-make-buffer-data)))
196    ;; Bind variables in folder buffer in case they are local
197    (let ((formfile mh-mhl-format-file)
198          (clean-message-header mh-clean-message-header-flag)
199          (invisible-headers mh-invisible-header-fields-compiled)
200          (visible-headers nil)
201          (msg-filename (mh-msg-filename msg-num folder-name))
202          (show-buffer mh-show-buffer)
203          (mm-inline-media-tests mh-mm-inline-media-tests))
204      (if (not (file-exists-p msg-filename))
205          (error "Message %d does not exist" msg-num))
206      (if (and (> mh-show-maximum-size 0)
207               (> (elt (file-attributes msg-filename) 7)
208                  mh-show-maximum-size)
209               (not (y-or-n-p
210                     (format
211                      "Message %d (%d bytes) exceeds %d bytes. Display it? "
212                      msg-num (elt (file-attributes msg-filename) 7)
213                      mh-show-maximum-size))))
214          (error "Message %d not displayed" msg-num))
215      (set-buffer show-buffer)
216      (cond ((not (equal msg-filename buffer-file-name))
217             (mh-unvisit-file)
218             (setq buffer-read-only nil)
219             ;; Cleanup old mime handles
220             (mh-mime-cleanup)
221             (erase-buffer)
222             ;; Changing contents, so this hook needs to be reinitialized.
223             ;; pgp.el uses this.
224             (if (boundp 'write-contents-hooks) ;Emacs 19
225                 (kill-local-variable 'write-contents-hooks))
226             (if formfile
227                 (mh-exec-lib-cmd-output "mhl" "-nobell" "-noclear"
228                                         (if (stringp formfile)
229                                             (list "-form" formfile))
230                                         msg-filename)
231               (insert-file-contents-literally msg-filename))
232             ;; Use mm to display buffer
233             (when (and mh-decode-mime-flag (not formfile))
234               (mh-add-missing-mime-version-header)
235               (setf (mh-buffer-data) (mh-make-buffer-data))
236               (mh-mime-display))
237             (mh-show-mode)
238             ;; Header cleanup
239             (goto-char (point-min))
240             (cond (clean-message-header
241                    (mh-clean-msg-header (point-min)
242                                         invisible-headers
243                                         visible-headers)
244                    (goto-char (point-min)))
245                   (t
246                    (mh-start-of-uncleaned-message)))
247             (mh-decode-message-header)
248             ;; the parts of visiting we want to do (no locking)
249             (or (eq buffer-undo-list t) ;don't save undo info for prev msgs
250                 (setq buffer-undo-list nil))
251             (set-buffer-auto-saved)
252             ;; the parts of set-visited-file-name we want to do (no locking)
253             (setq buffer-file-name msg-filename)
254             (setq buffer-backed-up nil)
255             (auto-save-mode 1)
256             (set-mark nil)
257             (unwind-protect
258                 (when (and mh-decode-mime-flag (not formfile))
259                   (setq buffer-read-only nil)
260                   (mh-display-smileys)
261                   (mh-display-emphasis))
262               (setq buffer-read-only t))
263             (set-buffer-modified-p nil)
264             (setq mh-show-folder-buffer folder)
265             (setq mode-line-buffer-identification
266                   (list (format mh-show-buffer-mode-line-buffer-id
267                                 folder-name msg-num)))
268             (mh-logo-display)
269             (set-buffer folder)
270             (setq mh-showing-with-headers nil))))))
271
272(defun mh-msg-folder (folder-name)
273  "Return the name of the buffer for FOLDER-NAME."
274  folder-name)
275
276;;;###mh-autoload
277(defun mh-clean-msg-header (start invisible-headers visible-headers)
278  "Flush extraneous lines in message header.
279
280Header is cleaned from START to the end of the message header.
281INVISIBLE-HEADERS contains a regular expression specifying lines
282to delete from the header. VISIBLE-HEADERS contains a regular
283expression specifying the lines to display. INVISIBLE-HEADERS is
284ignored if VISIBLE-HEADERS is non-nil."
285  ;; XXX Note that MH-E no longer supports the `mh-visible-headers'
286  ;; variable, so this function could be trimmed of this feature too."
287  (let ((case-fold-search t)
288        (buffer-read-only nil))
289    (save-restriction
290      (goto-char start)
291      (if (search-forward "\n\n" nil 'move)
292          (backward-char 1))
293      (narrow-to-region start (point))
294      (goto-char (point-min))
295      (if visible-headers
296          (while (< (point) (point-max))
297            (cond ((looking-at visible-headers)
298                   (forward-line 1)
299                   (while (looking-at "[ \t]") (forward-line 1)))
300                  (t
301                   (mh-delete-line 1)
302                   (while (looking-at "[ \t]")
303                     (mh-delete-line 1)))))
304        (while (re-search-forward invisible-headers nil t)
305          (beginning-of-line)
306          (mh-delete-line 1)
307          (while (looking-at "[ \t]")
308            (mh-delete-line 1)))))
309    (let ((mh-compose-skipped-header-fields ()))
310      (mh-letter-hide-all-skipped-fields))
311    (unlock-buffer)))
312
313;;;###mh-autoload
314(defun mh-invalidate-show-buffer ()
315  "Invalidate the show buffer so we must update it to use it."
316  (if (get-buffer mh-show-buffer)
317      (save-excursion
318        (set-buffer mh-show-buffer)
319        (mh-unvisit-file))))
320
321(defun mh-unvisit-file ()
322  "Separate current buffer from the message file it was visiting."
323  (or (not (buffer-modified-p))
324      (null buffer-file-name)           ;we've been here before
325      (yes-or-no-p (format "Message %s modified; flush changes? "
326                           (file-name-nondirectory buffer-file-name)))
327      (error "Flushing changes not confirmed"))
328  (clear-visited-file-modtime)
329  (unlock-buffer)
330  (setq buffer-file-name nil))
331
332(defun mh-summary-height ()
333  "Return ideal value for the variable `mh-summary-height'.
334The current frame height is taken into consideration."
335  (or (and (fboundp 'frame-height)
336           (> (frame-height) 24)
337           (min 10 (/ (frame-height) 6)))
338      4))
339
340
341
342;; Infrastructure to generate show-buffer functions from folder functions
343;; XEmacs does not have deactivate-mark? What is the equivalent of
344;; transient-mark-mode for XEmacs? Should we be restoring the mark in the
345;; folder buffer after the operation has been carried out.
346(defmacro mh-defun-show-buffer (function original-function
347                                         &optional dont-return)
348  "Define FUNCTION to run ORIGINAL-FUNCTION in folder buffer.
349If the buffer we start in is still visible and DONT-RETURN is nil
350then switch to it after that."
351  `(defun ,function ()
352     ,(format "Calls %s from the message's folder.\n%s\nSee \"%s\" for more info.\n"
353              original-function
354              (if dont-return ""
355                "When function completes, returns to the show buffer if it is
356still visible.\n")
357              original-function)
358     (interactive)
359     (when (buffer-live-p (get-buffer mh-show-folder-buffer))
360       (let ((config (current-window-configuration))
361             (folder-buffer mh-show-folder-buffer)
362             (normal-exit nil)
363             ,@(if dont-return () '((cur-buffer-name (buffer-name)))))
364         (pop-to-buffer mh-show-folder-buffer nil)
365         (unless (equal (buffer-name
366                         (window-buffer (frame-first-window (selected-frame))))
367                        folder-buffer)
368           (delete-other-windows))
369         (mh-goto-cur-msg t)
370         (mh-funcall-if-exists deactivate-mark)
371         (unwind-protect
372             (prog1 (call-interactively (function ,original-function))
373               (setq normal-exit t))
374           (mh-funcall-if-exists deactivate-mark)
375           (when (eq major-mode 'mh-folder-mode)
376             (mh-funcall-if-exists hl-line-highlight))
377           (cond ((not normal-exit)
378                  (set-window-configuration config))
379                 ,(if dont-return
380                      `(t (setq mh-previous-window-config config))
381                    `((and (get-buffer cur-buffer-name)
382                           (window-live-p (get-buffer-window
383                                           (get-buffer cur-buffer-name))))
384                      (pop-to-buffer (get-buffer cur-buffer-name) nil)))))))))
385
386;; Generate interactive functions for the show buffer from the corresponding
387;; folder functions.
388(mh-defun-show-buffer mh-show-previous-undeleted-msg
389                      mh-previous-undeleted-msg)
390(mh-defun-show-buffer mh-show-next-undeleted-msg
391                      mh-next-undeleted-msg)
392(mh-defun-show-buffer mh-show-quit mh-quit)
393(mh-defun-show-buffer mh-show-delete-msg mh-delete-msg)
394(mh-defun-show-buffer mh-show-refile-msg mh-refile-msg)
395(mh-defun-show-buffer mh-show-undo mh-undo)
396(mh-defun-show-buffer mh-show-execute-commands mh-execute-commands)
397(mh-defun-show-buffer mh-show-reply mh-reply t)
398(mh-defun-show-buffer mh-show-redistribute mh-redistribute)
399(mh-defun-show-buffer mh-show-forward mh-forward t)
400(mh-defun-show-buffer mh-show-header-display mh-header-display)
401(mh-defun-show-buffer mh-show-refile-or-write-again
402                      mh-refile-or-write-again)
403(mh-defun-show-buffer mh-show-show mh-show)
404(mh-defun-show-buffer mh-show-write-message-to-file
405                      mh-write-msg-to-file)
406(mh-defun-show-buffer mh-show-extract-rejected-mail
407                      mh-extract-rejected-mail t)
408(mh-defun-show-buffer mh-show-delete-msg-no-motion
409                      mh-delete-msg-no-motion)
410(mh-defun-show-buffer mh-show-first-msg mh-first-msg)
411(mh-defun-show-buffer mh-show-last-msg mh-last-msg)
412(mh-defun-show-buffer mh-show-copy-msg mh-copy-msg)
413(mh-defun-show-buffer mh-show-edit-again mh-edit-again t)
414(mh-defun-show-buffer mh-show-goto-msg mh-goto-msg)
415(mh-defun-show-buffer mh-show-inc-folder mh-inc-folder)
416(mh-defun-show-buffer mh-show-delete-subject-or-thread
417                      mh-delete-subject-or-thread)
418(mh-defun-show-buffer mh-show-delete-subject mh-delete-subject)
419(mh-defun-show-buffer mh-show-print-msg mh-print-msg)
420(mh-defun-show-buffer mh-show-send mh-send t)
421(mh-defun-show-buffer mh-show-toggle-showing mh-toggle-showing t)
422(mh-defun-show-buffer mh-show-pipe-msg mh-pipe-msg t)
423(mh-defun-show-buffer mh-show-sort-folder mh-sort-folder)
424(mh-defun-show-buffer mh-show-visit-folder mh-visit-folder t)
425(mh-defun-show-buffer mh-show-rescan-folder mh-rescan-folder)
426(mh-defun-show-buffer mh-show-pack-folder mh-pack-folder)
427(mh-defun-show-buffer mh-show-kill-folder mh-kill-folder t)
428(mh-defun-show-buffer mh-show-list-folders mh-list-folders t)
429(mh-defun-show-buffer mh-show-undo-folder mh-undo-folder)
430(mh-defun-show-buffer mh-show-delete-msg-from-seq
431                      mh-delete-msg-from-seq)
432(mh-defun-show-buffer mh-show-delete-seq mh-delete-seq)
433(mh-defun-show-buffer mh-show-list-sequences mh-list-sequences)
434(mh-defun-show-buffer mh-show-narrow-to-seq mh-narrow-to-seq)
435(mh-defun-show-buffer mh-show-put-msg-in-seq mh-put-msg-in-seq)
436(mh-defun-show-buffer mh-show-msg-is-in-seq mh-msg-is-in-seq)
437(mh-defun-show-buffer mh-show-widen mh-widen)
438(mh-defun-show-buffer mh-show-narrow-to-subject mh-narrow-to-subject)
439(mh-defun-show-buffer mh-show-narrow-to-from mh-narrow-to-from)
440(mh-defun-show-buffer mh-show-narrow-to-cc mh-narrow-to-cc)
441(mh-defun-show-buffer mh-show-narrow-to-range mh-narrow-to-range)
442(mh-defun-show-buffer mh-show-narrow-to-to mh-narrow-to-to)
443(mh-defun-show-buffer mh-show-store-msg mh-store-msg)
444(mh-defun-show-buffer mh-show-page-digest mh-page-digest)
445(mh-defun-show-buffer mh-show-page-digest-backwards
446                      mh-page-digest-backwards)
447(mh-defun-show-buffer mh-show-burst-digest mh-burst-digest)
448(mh-defun-show-buffer mh-show-page-msg mh-page-msg)
449(mh-defun-show-buffer mh-show-previous-page mh-previous-page)
450(mh-defun-show-buffer mh-show-modify mh-modify t)
451(mh-defun-show-buffer mh-show-next-button mh-next-button)
452(mh-defun-show-buffer mh-show-prev-button mh-prev-button)
453(mh-defun-show-buffer mh-show-toggle-mime-part mh-folder-toggle-mime-part)
454(mh-defun-show-buffer mh-show-save-mime-part mh-folder-save-mime-part)
455(mh-defun-show-buffer mh-show-inline-mime-part mh-folder-inline-mime-part)
456(mh-defun-show-buffer mh-show-toggle-threads mh-toggle-threads)
457(mh-defun-show-buffer mh-show-thread-delete mh-thread-delete)
458(mh-defun-show-buffer mh-show-thread-refile mh-thread-refile)
459(mh-defun-show-buffer mh-show-update-sequences mh-update-sequences)
460(mh-defun-show-buffer mh-show-next-unread-msg mh-next-unread-msg)
461(mh-defun-show-buffer mh-show-previous-unread-msg mh-previous-unread-msg)
462(mh-defun-show-buffer mh-show-thread-ancestor mh-thread-ancestor)
463(mh-defun-show-buffer mh-show-thread-next-sibling mh-thread-next-sibling)
464(mh-defun-show-buffer mh-show-thread-previous-sibling
465                      mh-thread-previous-sibling)
466(mh-defun-show-buffer mh-show-index-visit-folder mh-index-visit-folder t)
467(mh-defun-show-buffer mh-show-toggle-tick mh-toggle-tick)
468(mh-defun-show-buffer mh-show-narrow-to-tick mh-narrow-to-tick)
469(mh-defun-show-buffer mh-show-junk-blacklist mh-junk-blacklist)
470(mh-defun-show-buffer mh-show-junk-whitelist mh-junk-whitelist)
471(mh-defun-show-buffer mh-show-index-new-messages mh-index-new-messages)
472(mh-defun-show-buffer mh-show-index-ticked-messages mh-index-ticked-messages)
473(mh-defun-show-buffer mh-show-index-sequenced-messages
474                      mh-index-sequenced-messages)
475(mh-defun-show-buffer mh-show-catchup mh-catchup)
476(mh-defun-show-buffer mh-show-ps-print-toggle-color mh-ps-print-toggle-color)
477(mh-defun-show-buffer mh-show-ps-print-toggle-faces mh-ps-print-toggle-faces)
478(mh-defun-show-buffer mh-show-ps-print-msg-file mh-ps-print-msg-file)
479(mh-defun-show-buffer mh-show-ps-print-msg mh-ps-print-msg)
480(mh-defun-show-buffer mh-show-toggle-mime-buttons mh-toggle-mime-buttons)
481(mh-defun-show-buffer mh-show-display-with-external-viewer
482                      mh-display-with-external-viewer)
483
484
485
486;;; Sequence Menu
487
488(easy-menu-define
489  mh-show-sequence-menu mh-show-mode-map "Menu for MH-E folder-sequence."
490  '("Sequence"
491    ["Add Message to Sequence..."       mh-show-put-msg-in-seq t]
492    ["List Sequences for Message"       mh-show-msg-is-in-seq t]
493    ["Delete Message from Sequence..."  mh-show-delete-msg-from-seq t]
494    ["List Sequences in Folder..."      mh-show-list-sequences t]
495    ["Delete Sequence..."               mh-show-delete-seq t]
496    ["Narrow to Sequence..."            mh-show-narrow-to-seq t]
497    ["Widen from Sequence"              mh-show-widen t]
498    "--"
499    ["Narrow to Subject Sequence"       mh-show-narrow-to-subject t]
500    ["Narrow to Tick Sequence"          mh-show-narrow-to-tick
501     (save-excursion
502       (set-buffer mh-show-folder-buffer)
503       (and mh-tick-seq (mh-seq-msgs (mh-find-seq mh-tick-seq))))]
504    ["Delete Rest of Same Subject"      mh-show-delete-subject t]
505    ["Toggle Tick Mark"                 mh-show-toggle-tick t]
506    "--"
507    ["Push State Out to MH"             mh-show-update-sequences t]))
508
509;;; Message Menu
510
511(easy-menu-define
512  mh-show-message-menu mh-show-mode-map "Menu for MH-E folder-message."
513  '("Message"
514    ["Show Message"                     mh-show-show t]
515    ["Show Message with Header"         mh-show-header-display t]
516    ["Next Message"                     mh-show-next-undeleted-msg t]
517    ["Previous Message"                 mh-show-previous-undeleted-msg t]
518    ["Go to First Message"              mh-show-first-msg t]
519    ["Go to Last Message"               mh-show-last-msg t]
520    ["Go to Message by Number..."       mh-show-goto-msg t]
521    ["Modify Message"                   mh-show-modify t]
522    ["Delete Message"                   mh-show-delete-msg t]
523    ["Refile Message"                   mh-show-refile-msg t]
524    ["Undo Delete/Refile"               mh-show-undo t]
525    ["Process Delete/Refile"            mh-show-execute-commands t]
526    "--"
527    ["Compose a New Message"            mh-send t]
528    ["Reply to Message..."              mh-show-reply t]
529    ["Forward Message..."               mh-show-forward t]
530    ["Redistribute Message..."          mh-show-redistribute t]
531    ["Edit Message Again"               mh-show-edit-again t]
532    ["Re-edit a Bounced Message"        mh-show-extract-rejected-mail t]
533    "--"
534    ["Copy Message to Folder..."        mh-show-copy-msg t]
535    ["Print Message"                    mh-show-print-msg t]
536    ["Write Message to File..."         mh-show-write-msg-to-file t]
537    ["Pipe Message to Command..."       mh-show-pipe-msg t]
538    ["Unpack Uuencoded Message..."      mh-show-store-msg t]
539    ["Burst Digest Message"             mh-show-burst-digest t]))
540
541;;; Folder Menu
542
543(easy-menu-define
544  mh-show-folder-menu mh-show-mode-map  "Menu for MH-E folder."
545  '("Folder"
546    ["Incorporate New Mail"             mh-show-inc-folder t]
547    ["Toggle Show/Folder"               mh-show-toggle-showing t]
548    ["Execute Delete/Refile"            mh-show-execute-commands t]
549    ["Rescan Folder"                    mh-show-rescan-folder t]
550    ["Thread Folder"                    mh-show-toggle-threads t]
551    ["Pack Folder"                      mh-show-pack-folder t]
552    ["Sort Folder"                      mh-show-sort-folder t]
553    "--"
554    ["List Folders"                     mh-show-list-folders t]
555    ["Visit a Folder..."                mh-show-visit-folder t]
556    ["View New Messages"                mh-show-index-new-messages t]
557    ["Search..."                        mh-search t]
558    "--"
559    ["Quit MH-E"                        mh-quit t]))
560
561
562
563;;; MH-Show Keys
564
565(gnus-define-keys mh-show-mode-map
566  " "    mh-show-page-msg
567  "!"    mh-show-refile-or-write-again
568  "'"    mh-show-toggle-tick
569  ","    mh-show-header-display
570  "."    mh-show-show
571  ">"    mh-show-write-message-to-file
572  "?"    mh-help
573  "E"    mh-show-extract-rejected-mail
574  "M"    mh-show-modify
575  "\177" mh-show-previous-page
576  "\C-d" mh-show-delete-msg-no-motion
577  "\t"   mh-show-next-button
578  [backtab] mh-show-prev-button
579  "\M-\t" mh-show-prev-button
580  "\ed"  mh-show-redistribute
581  "^"    mh-show-refile-msg
582  "c"    mh-show-copy-msg
583  "d"    mh-show-delete-msg
584  "e"    mh-show-edit-again
585  "f"    mh-show-forward
586  "g"    mh-show-goto-msg
587  "i"    mh-show-inc-folder
588  "k"    mh-show-delete-subject-or-thread
589  "m"    mh-show-send
590  "n"    mh-show-next-undeleted-msg
591  "\M-n" mh-show-next-unread-msg
592  "o"    mh-show-refile-msg
593  "p"    mh-show-previous-undeleted-msg
594  "\M-p" mh-show-previous-unread-msg
595  "q"    mh-show-quit
596  "r"    mh-show-reply
597  "s"    mh-show-send
598  "t"    mh-show-toggle-showing
599  "u"    mh-show-undo
600  "x"    mh-show-execute-commands
601  "v"    mh-show-index-visit-folder
602  "|"    mh-show-pipe-msg)
603
604(gnus-define-keys (mh-show-folder-map "F" mh-show-mode-map)
605  "?"    mh-prefix-help
606  "'"    mh-index-ticked-messages
607  "S"    mh-show-sort-folder
608  "c"    mh-show-catchup
609  "f"    mh-show-visit-folder
610  "k"    mh-show-kill-folder
611  "l"    mh-show-list-folders
612  "n"    mh-index-new-messages
613  "o"    mh-show-visit-folder
614  "q"    mh-show-index-sequenced-messages
615  "r"    mh-show-rescan-folder
616  "s"    mh-search
617  "t"    mh-show-toggle-threads
618  "u"    mh-show-undo-folder
619  "v"    mh-show-visit-folder)
620
621(gnus-define-keys (mh-show-sequence-map "S" mh-show-mode-map)
622  "'"    mh-show-narrow-to-tick
623  "?"    mh-prefix-help
624  "d"    mh-show-delete-msg-from-seq
625  "k"    mh-show-delete-seq
626  "l"    mh-show-list-sequences
627  "n"    mh-show-narrow-to-seq
628  "p"    mh-show-put-msg-in-seq
629  "s"    mh-show-msg-is-in-seq
630  "w"    mh-show-widen)
631
632(define-key mh-show-mode-map "I" mh-inc-spool-map)
633
634(gnus-define-keys (mh-show-junk-map "J" mh-show-mode-map)
635  "?"    mh-prefix-help
636  "b"    mh-show-junk-blacklist
637  "w"    mh-show-junk-whitelist)
638
639(gnus-define-keys (mh-show-ps-print-map "P" mh-show-mode-map)
640  "?"   mh-prefix-help
641  "C"   mh-show-ps-print-toggle-color
642  "F"   mh-show-ps-print-toggle-faces
643  "f"   mh-show-ps-print-msg-file
644  "l"   mh-show-print-msg
645  "p"   mh-show-ps-print-msg)
646
647(gnus-define-keys (mh-show-thread-map "T" mh-show-mode-map)
648  "?"    mh-prefix-help
649  "u"    mh-show-thread-ancestor
650  "p"    mh-show-thread-previous-sibling
651  "n"    mh-show-thread-next-sibling
652  "t"    mh-show-toggle-threads
653  "d"    mh-show-thread-delete
654  "o"    mh-show-thread-refile)
655
656(gnus-define-keys (mh-show-limit-map "/" mh-show-mode-map)
657  "'"    mh-show-narrow-to-tick
658  "?"    mh-prefix-help
659  "c"    mh-show-narrow-to-cc
660  "g"    mh-show-narrow-to-range
661  "m"    mh-show-narrow-to-from
662  "s"    mh-show-narrow-to-subject
663  "t"    mh-show-narrow-to-to
664  "w"    mh-show-widen)
665
666(gnus-define-keys (mh-show-extract-map "X" mh-show-mode-map)
667  "?"    mh-prefix-help
668  "s"    mh-show-store-msg
669  "u"    mh-show-store-msg)
670
671(gnus-define-keys (mh-show-digest-map "D" mh-show-mode-map)
672  "?"    mh-prefix-help
673  " "    mh-show-page-digest
674  "\177" mh-show-page-digest-backwards
675  "b"    mh-show-burst-digest)
676
677(gnus-define-keys (mh-show-mime-map "K" mh-show-mode-map)
678  "?"           mh-prefix-help
679  "a"           mh-mime-save-parts
680  "e"           mh-show-display-with-external-viewer
681  "v"           mh-show-toggle-mime-part
682  "o"           mh-show-save-mime-part
683  "i"           mh-show-inline-mime-part
684  "t"           mh-show-toggle-mime-buttons
685  "\t"          mh-show-next-button
686  [backtab]     mh-show-prev-button
687  "\M-\t"       mh-show-prev-button)
688
689
690
691;;; MH-Show Font Lock
692
693(defun mh-header-field-font-lock (field limit)
694  "Return the value of a header field FIELD to font-lock.
695Argument LIMIT limits search."
696  (if (= (point) limit)
697      nil
698    (let* ((mail-header-end (mh-mail-header-end))
699           (lesser-limit (if (< mail-header-end limit) mail-header-end limit))
700           (case-fold-search t))
701      (when (and (< (point) mail-header-end) ;Only within header
702                 (re-search-forward (format "^%s" field) lesser-limit t))
703        (let ((match-one-b (match-beginning 0))
704              (match-one-e (match-end 0)))
705          (mh-header-field-end)
706          (if (> (point) limit)         ;Don't search for end beyond limit
707              (goto-char limit))
708          (set-match-data (list match-one-b match-one-e
709                                (1+ match-one-e) (point)))
710          t)))))
711
712(defun mh-header-to-font-lock (limit)
713  "Return the value of a header field To to font-lock.
714Argument LIMIT limits search."
715  (mh-header-field-font-lock "To:" limit))
716
717(defun mh-header-cc-font-lock (limit)
718  "Return the value of a header field cc to font-lock.
719Argument LIMIT limits search."
720  (mh-header-field-font-lock "cc:" limit))
721
722(defun mh-header-subject-font-lock (limit)
723  "Return the value of a header field Subject to font-lock.
724Argument LIMIT limits search."
725  (mh-header-field-font-lock "Subject:" limit))
726
727(defun mh-letter-header-font-lock (limit)
728  "Return the entire mail header to font-lock.
729Argument LIMIT limits search."
730  (if (= (point) limit)
731      nil
732    (let* ((mail-header-end (save-match-data (mh-mail-header-end)))
733           (lesser-limit (if (< mail-header-end limit) mail-header-end limit)))
734      (when (mh-in-header-p)
735        (set-match-data (list 1 lesser-limit))
736        (goto-char lesser-limit)
737        t))))
738
739(defun mh-show-font-lock-fontify-region (beg end loudly)
740  "Limit font-lock in `mh-show-mode' to the header.
741
742Used when the option `mh-highlight-citation-style' is set to
743\"Gnus\", leaving the body to be dealt with by Gnus highlighting.
744The region between BEG and END is given over to be fontified and
745LOUDLY controls if a user sees a message about the fontification
746operation."
747  (let ((header-end (mh-mail-header-end)))
748    (cond
749     ((and (< beg header-end)(< end header-end))
750      (font-lock-default-fontify-region beg end loudly))
751     ((and (< beg header-end)(>= end header-end))
752      (font-lock-default-fontify-region beg header-end loudly))
753     (t
754      nil))))
755
756(defvar mh-show-font-lock-keywords
757  '(("^\\(From:\\|Sender:\\)\\(.*\\)"
758     (1 'default)
759     (2 'mh-show-from))
760    (mh-header-to-font-lock
761     (0 'default)
762     (1 'mh-show-to))
763    (mh-header-cc-font-lock
764     (0 'default)
765     (1 'mh-show-cc))
766    ("^\\(Reply-To:\\|Return-Path:\\)\\(.*\\)$"
767     (1 'default)
768     (2 'mh-show-from))
769    (mh-header-subject-font-lock
770     (0 'default)
771     (1 'mh-show-subject))
772    ("^\\(Apparently-To:\\|Newsgroups:\\)\\(.*\\)"
773     (1 'default)
774     (2 'mh-show-cc))
775    ("^\\(In-reply-to\\|Date\\):\\(.*\\)$"
776     (1 'default)
777     (2 'mh-show-date))
778    (mh-letter-header-font-lock
779     (0 'mh-show-header append t)))
780  "Additional expressions to highlight in MH-Show buffers.")
781
782;;;###mh-autoload
783(defun mh-show-font-lock-keywords ()
784  "Return variable `mh-show-font-lock-keywords'."
785  mh-show-font-lock-keywords)
786
787(defvar mh-show-font-lock-keywords-with-cite
788  (let* ((cite-chars "[>|}]")
789         (cite-prefix "A-Za-z")
790         (cite-suffix (concat cite-prefix "0-9_.@-`'\"")))
791    (append
792     mh-show-font-lock-keywords
793     (list
794      ;; Use MATCH-ANCHORED to effectively anchor the regexp left side.
795      `(,cite-chars
796        (,(concat "\\=[ \t]*"
797                  "\\(\\([" cite-prefix "]+[" cite-suffix "]*\\)?"
798                  "\\(" cite-chars "[ \t]*\\)\\)+"
799                  "\\(.*\\)")
800         (beginning-of-line) (end-of-line)
801         (2 font-lock-constant-face nil t)
802         (4 font-lock-comment-face nil t))))))
803  "Additional expressions to highlight in MH-Show buffers.")
804
805;;;###mh-autoload
806(defun mh-show-font-lock-keywords-with-cite ()
807  "Return variable `mh-show-font-lock-keywords-with-cite'."
808  mh-show-font-lock-keywords-with-cite)
809
810
811
812;;; MH-Show Mode
813
814;; Ensure new buffers won't get this mode if default-major-mode is nil.
815(put 'mh-show-mode 'mode-class 'special)
816
817;; Shush compiler.
818(defvar font-lock-auto-fontify)
819
820;;;###mh-autoload
821(define-derived-mode mh-show-mode text-mode "MH-Show"
822  "Major mode for showing messages in MH-E.\\<mh-show-mode-map>
823
824Email addresses and URLs in the message are highlighted if the
825option `goto-address-highlight-p' is on, which it is by default.
826To view the web page for a highlighted URL or to send a message
827using a highlighted email address, use the middle mouse button or
828\\[goto-address-at-point]. See Info node `(mh-e)Sending Mail' to
829see how to configure Emacs to send the message using MH-E.
830
831The hook `mh-show-mode-hook' is called upon entry to this mode.
832
833See also `mh-folder-mode'.
834
835\\{mh-show-mode-map}"
836  (mh-do-in-gnu-emacs
837    (set (make-local-variable 'tool-bar-map) mh-show-tool-bar-map))
838  (mh-do-in-xemacs
839    (mh-tool-bar-init :show))
840  (set (make-local-variable 'mail-header-separator) mh-mail-header-separator)
841  (setq paragraph-start (default-value 'paragraph-start))
842  (mh-show-unquote-From)
843  (mh-show-xface)
844  (mh-show-addr)
845  (setq buffer-invisibility-spec '((vanish . t) t))
846  (set (make-local-variable 'line-move-ignore-invisible) t)
847  (make-local-variable 'font-lock-defaults)
848  ;;(set (make-local-variable 'font-lock-support-mode) nil)
849  (cond
850   ((equal mh-highlight-citation-style 'font-lock)
851    (setq font-lock-defaults '(mh-show-font-lock-keywords-with-cite t)))
852   ((equal mh-highlight-citation-style 'gnus)
853    (setq font-lock-defaults '((mh-show-font-lock-keywords)
854                               t nil nil nil
855                               (font-lock-fontify-region-function
856                                . mh-show-font-lock-fontify-region)))
857    (mh-gnus-article-highlight-citation))
858   (t
859    (setq font-lock-defaults '(mh-show-font-lock-keywords t))))
860  (if (and mh-xemacs-flag
861           font-lock-auto-fontify)
862      (turn-on-font-lock))
863  (when mh-decode-mime-flag
864    (mh-make-local-hook 'kill-buffer-hook)
865    (add-hook 'kill-buffer-hook 'mh-mime-cleanup nil t))
866  (easy-menu-add mh-show-sequence-menu)
867  (easy-menu-add mh-show-message-menu)
868  (easy-menu-add mh-show-folder-menu)
869  (make-local-variable 'mh-show-folder-buffer)
870  (buffer-disable-undo)
871  (setq buffer-read-only t)
872  (use-local-map mh-show-mode-map))
873
874
875
876;;; Support Routines
877
878(defun mh-show-unquote-From ()
879  "Decode >From at beginning of lines for `mh-show-mode'."
880  (save-excursion
881    (let ((modified (buffer-modified-p))
882          (case-fold-search nil)
883          (buffer-read-only nil))
884      (goto-char (mh-mail-header-end))
885      (while (re-search-forward "^>From" nil t)
886        (replace-match "From"))
887      (set-buffer-modified-p modified))))
888
889;;;###mh-autoload
890(defun mh-show-addr ()
891  "Use `goto-address'."
892  (goto-address))
893
894;;;###mh-autoload
895(defun mh-gnus-article-highlight-citation ()
896  "Highlight cited text in current buffer using Gnus."
897  (interactive)
898  ;; Don't allow Gnus to create buttons while highlighting, maybe this is bad
899  ;; style?
900  (flet ((gnus-article-add-button (&rest args) nil))
901    (let* ((modified (buffer-modified-p))
902           (gnus-article-buffer (buffer-name))
903           (gnus-cite-face-list `(,@(cdr gnus-cite-face-list)
904                                    ,(car gnus-cite-face-list))))
905      (gnus-article-highlight-citation t)
906      (set-buffer-modified-p modified))))
907
908(provide 'mh-show)
909
910;; Local Variables:
911;; indent-tabs-mode: nil
912;; sentence-end-double-space: nil
913;; End:
914
915;; arch-tag: 8607a80a-9b5c-43a7-a25d-d7e4a848c25b
916;;; mh-show.el ends here
917