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