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