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