mh-utils.el 107 KB
Newer Older
Bill Wohler's avatar
Bill Wohler committed
1
;;; mh-utils.el --- MH-E code needed for both sending and reading
Richard M. Stallman's avatar
Richard M. Stallman committed
2

Bill Wohler's avatar
Bill Wohler committed
3
;; Copyright (C) 1993, 1995, 1997,
4
;; 2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
Bill Wohler's avatar
Bill Wohler committed
5 6 7 8 9

;; Author: Bill Wohler <wohler@newt.com>
;; Maintainer: Bill Wohler <wohler@newt.com>
;; Keywords: mail
;; See: mh-e.el
Richard M. Stallman's avatar
Richard M. Stallman committed
10

11
;; This file is part of GNU Emacs.
Richard M. Stallman's avatar
Richard M. Stallman committed
12

Karl Heuer's avatar
Karl Heuer committed
13
;; GNU Emacs is free software; you can redistribute it and/or modify
Richard M. Stallman's avatar
Richard M. Stallman committed
14 15 16 17
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

Karl Heuer's avatar
Karl Heuer committed
18
;; GNU Emacs is distributed in the hope that it will be useful,
Richard M. Stallman's avatar
Richard M. Stallman committed
19 20 21 22 23
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
Erik Naggum's avatar
Erik Naggum committed
24
;; along with GNU Emacs; see the file COPYING.  If not, write to the
Lute Kamstra's avatar
Lute Kamstra committed
25 26
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
Richard M. Stallman's avatar
Richard M. Stallman committed
27 28 29

;;; Commentary:

Bill Wohler's avatar
Bill Wohler committed
30
;; Internal support for MH-E package.
Richard M. Stallman's avatar
Richard M. Stallman committed
31

Bill Wohler's avatar
Bill Wohler committed
32 33
;;; Change Log:

Richard M. Stallman's avatar
Richard M. Stallman committed
34 35
;;; Code:

Bill Wohler's avatar
Bill Wohler committed
36 37 38 39 40 41
(defvar recursive-load-depth-limit)
(eval-and-compile
  (if (and (boundp 'recursive-load-depth-limit)
           (integerp recursive-load-depth-limit)
           (> 50 recursive-load-depth-limit))
      (setq recursive-load-depth-limit 50)))
Bill Wohler's avatar
Bill Wohler committed
42

Bill Wohler's avatar
Bill Wohler committed
43
(eval-when-compile (require 'mh-acros))
Bill Wohler's avatar
Bill Wohler committed
44
(mh-require-cl)
Bill Wohler's avatar
Bill Wohler committed
45
(require 'gnus-util)
Bill Wohler's avatar
Bill Wohler committed
46
(require 'font-lock)
Bill Wohler's avatar
Bill Wohler committed
47 48
(require 'mouse)
(load "tool-bar" t t)
Bill Wohler's avatar
Bill Wohler committed
49 50
(require 'mh-loaddefs)
(require 'mh-customize)
Bill Wohler's avatar
Bill Wohler committed
51
(require 'mh-inc)
Bill Wohler's avatar
Bill Wohler committed
52 53 54

(load "mm-decode" t t)                  ; Non-fatal dependency
(load "mm-view" t t)                    ; Non-fatal dependency
Bill Wohler's avatar
Bill Wohler committed
55
(load "vcard" t t)                      ; Non-fatal dependency
Bill Wohler's avatar
Bill Wohler committed
56
(load "hl-line" t t)                    ; Non-fatal dependency
Bill Wohler's avatar
Bill Wohler committed
57 58
(load "executable" t t)                 ; Non-fatal dependency on
                                        ; executable-find
Bill Wohler's avatar
Bill Wohler committed
59 60 61 62 63 64

;; Shush the byte-compiler
(defvar font-lock-auto-fontify)
(defvar font-lock-defaults)
(defvar mark-active)

Bill Wohler's avatar
Bill Wohler committed
65
;;; Autoloads
Bill Wohler's avatar
Bill Wohler committed
66
(autoload 'gnus-article-highlight-citation "gnus-cite")
Bill Wohler's avatar
Bill Wohler committed
67 68
(autoload 'message-fetch-field "message")
(autoload 'message-tokenize-header "message")
Bill Wohler's avatar
Bill Wohler committed
69
(require 'sendmail)
Bill Wohler's avatar
Bill Wohler committed
70 71 72
(unless (fboundp 'make-hash-table)
  (autoload 'make-hash-table "cl"))

Bill Wohler's avatar
Bill Wohler committed
73 74 75 76 77 78 79 80 81
;;; CL Replacements
(defun mh-search-from-end (char string)
  "Return the position of last occurrence of CHAR in STRING.
If CHAR is not present in STRING then return nil. The function is used in lieu
of `search' in the CL package."
  (loop for index from (1- (length string)) downto 0
        when (equal (aref string index) char) return index
        finally return nil))

Bill Wohler's avatar
Bill Wohler committed
82 83 84
;;; Additional header fields that might someday be added:
;;; "Sender: " "Reply-to: "

Bill Wohler's avatar
Bill Wohler committed
85 86 87

;;; Scan Line Formats

Bill Wohler's avatar
Bill Wohler committed
88
(defvar mh-scan-msg-number-regexp "^ *\\([0-9]+\\)"
Bill Wohler's avatar
Bill Wohler committed
89 90 91
  "This regexp is used to extract the message number from a scan line.
Note that the message number must be placed in a parenthesized expression as
in the default of \"^ *\\\\([0-9]+\\\\)\".")
Richard M. Stallman's avatar
Richard M. Stallman committed
92

Bill Wohler's avatar
Bill Wohler committed
93
(defvar mh-scan-msg-overflow-regexp "^[?0-9][0-9]"
Bill Wohler's avatar
Bill Wohler committed
94
  "This regexp matches scan lines in which the message number overflowed.")
Bill Wohler's avatar
Bill Wohler committed
95 96

(defvar mh-scan-msg-format-regexp "%\\([0-9]*\\)(msg)"
Bill Wohler's avatar
Bill Wohler committed
97 98 99
  "This regexp is used to find the message number width in a scan format.
Note that the message number must be placed in a parenthesized expression as
in the default of \"%\\\\([0-9]*\\\\)(msg)\".")
Bill Wohler's avatar
Bill Wohler committed
100 101

(defvar mh-scan-msg-format-string "%d"
Bill Wohler's avatar
Bill Wohler committed
102
  "This is a format string for width of the message number in a scan format.
Bill Wohler's avatar
Bill Wohler committed
103 104
Use `0%d' for zero-filled message numbers.")

Bill Wohler's avatar
Bill Wohler committed
105
(defvar mh-scan-msg-search-regexp "^[^0-9]*%d[^0-9]"
Bill Wohler's avatar
Bill Wohler committed
106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121
  "This format string regexp matches the scan line for a particular message.
Use `%d' to represent the location of the message number within the
expression as in the default of \"^[^0-9]*%d[^0-9]\".")

(defvar mh-cmd-note 4
  "This is the number of characters to skip over before inserting notation.
This variable should be set with the function `mh-set-cmd-note'. This variable
may be updated dynamically if `mh-adaptive-cmd-note-flag' is non-nil and
`mh-scan-format-file' is t.")
(make-variable-buffer-local 'mh-cmd-note)

(defvar mh-note-seq ?%
  "Messages in a user-defined sequence are marked by this character.
Messages in the `search' sequence are marked by this character as well.")


Karl Heuer's avatar
Karl Heuer committed
122

Bill Wohler's avatar
Bill Wohler committed
123
(defvar mh-show-buffer-mode-line-buffer-id "    {show-%s} %d"
Karl Heuer's avatar
Karl Heuer committed
124 125
  "Format string to produce `mode-line-buffer-identification' for show buffers.
First argument is folder name.  Second is message number.")
Richard M. Stallman's avatar
Richard M. Stallman committed
126

Bill Wohler's avatar
Bill Wohler committed
127

Karl Heuer's avatar
Karl Heuer committed
128

Bill Wohler's avatar
Bill Wohler committed
129 130 131 132 133 134 135 136 137 138 139
(defvar mh-mail-header-separator "--------"
  "*Line used by MH to separate headers from text in messages being composed.
This variable should not be used directly in programs. Programs should use
`mail-header-separator' instead. `mail-header-separator' is initialized to
`mh-mail-header-separator' in `mh-letter-mode'; in other contexts, you may
have to perform this initialization yourself.

Do not make this a regexp as it may be the argument to `insert' and it is
passed through `regexp-quote' before being used by functions like
`re-search-forward'.")

Bill Wohler's avatar
Bill Wohler committed
140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157
(defvar mh-signature-separator-regexp "^-- $"
  "Regexp used to find signature separator.
See `mh-signature-separator'.")

(defvar mh-signature-separator "-- \n"
  "Text of a signature separator.
A signature separator is used to separate the body of a message from the
signature. This can be used by user agents such as MH-E to render the
signature differently or to suppress the inclusion of the signature in a
reply.
Use `mh-signature-separator-regexp' when searching for a separator.")

(defun mh-signature-separator-p ()
  "Return non-nil if buffer includes \"^-- $\"."
  (save-excursion
    (goto-char (point-min))
    (re-search-forward mh-signature-separator-regexp nil t)))

Bill Wohler's avatar
Bill Wohler committed
158
;; Variables for MIME display
Bill Wohler's avatar
Bill Wohler committed
159

Bill Wohler's avatar
Bill Wohler committed
160
;; Structure to keep track of MIME handles on a per buffer basis.
Bill Wohler's avatar
Bill Wohler committed
161 162
(mh-defstruct (mh-buffer-data (:conc-name mh-mime-)
                              (:constructor mh-make-buffer-data))
Bill Wohler's avatar
Bill Wohler committed
163 164 165 166 167 168 169 170 171 172 173
  (handles ())                          ; List of MIME handles
  (handles-cache (make-hash-table))     ; Cache to avoid multiple decodes of
                                        ; nested messages
  (parts-count 0)                       ; The button number is generated from
                                        ; this number
  (part-index-hash (make-hash-table)))  ; Avoid incrementing the part number
                                        ; for nested messages
;;; This has to be a macro, since we do: (setf (mh-buffer-data) ...)
(defmacro mh-buffer-data ()
  "Convenience macro to get the MIME data structures of the current buffer."
  `(gethash (current-buffer) mh-globals-hash))
Bill Wohler's avatar
Bill Wohler committed
174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242

(defvar mh-globals-hash (make-hash-table)
  "Keeps track of MIME data on a per buffer basis.")

(defvar mh-gnus-pgp-support-flag (not (not (locate-library "mml2015")))
  "Non-nil means installed Gnus has PGP support.")

(defvar mh-mm-inline-media-tests
  `(("image/jpeg"
     mm-inline-image
     (lambda (handle)
       (mm-valid-and-fit-image-p 'jpeg handle)))
    ("image/png"
     mm-inline-image
     (lambda (handle)
       (mm-valid-and-fit-image-p 'png handle)))
    ("image/gif"
     mm-inline-image
     (lambda (handle)
       (mm-valid-and-fit-image-p 'gif handle)))
    ("image/tiff"
     mm-inline-image
     (lambda (handle)
       (mm-valid-and-fit-image-p 'tiff handle)) )
    ("image/xbm"
     mm-inline-image
     (lambda (handle)
       (mm-valid-and-fit-image-p 'xbm handle)))
    ("image/x-xbitmap"
     mm-inline-image
     (lambda (handle)
       (mm-valid-and-fit-image-p 'xbm handle)))
    ("image/xpm"
     mm-inline-image
     (lambda (handle)
       (mm-valid-and-fit-image-p 'xpm handle)))
    ("image/x-pixmap"
     mm-inline-image
     (lambda (handle)
       (mm-valid-and-fit-image-p 'xpm handle)))
    ("image/bmp"
     mm-inline-image
     (lambda (handle)
       (mm-valid-and-fit-image-p 'bmp handle)))
    ("image/x-portable-bitmap"
     mm-inline-image
     (lambda (handle)
       (mm-valid-and-fit-image-p 'pbm handle)))
    ("text/plain" mm-inline-text identity)
    ("text/enriched" mm-inline-text identity)
    ("text/richtext" mm-inline-text identity)
    ("text/x-patch" mm-display-patch-inline
     (lambda (handle)
       (locate-library "diff-mode")))
    ("application/emacs-lisp" mm-display-elisp-inline identity)
    ("application/x-emacs-lisp" mm-display-elisp-inline identity)
    ("text/html"
     ,(if (fboundp 'mm-inline-text-html) 'mm-inline-text-html 'mm-inline-text)
     (lambda (handle)
       (or (and (boundp 'mm-inline-text-html-renderer)
                mm-inline-text-html-renderer)
           (and (boundp 'mm-text-html-renderer) mm-text-html-renderer))))
    ("text/x-vcard"
     mm-inline-text-vcard
     (lambda (handle)
       (or (featurep 'vcard)
           (locate-library "vcard"))))
    ("message/delivery-status" mm-inline-text identity)
    ("message/rfc822" mh-mm-inline-message identity)
Bill Wohler's avatar
Bill Wohler committed
243 244
    ;;("message/partial" mm-inline-partial identity)
    ;;("message/external-body" mm-inline-external-body identity)
Bill Wohler's avatar
Bill Wohler committed
245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269
    ("text/.*" mm-inline-text identity)
    ("audio/wav" mm-inline-audio
     (lambda (handle)
       (and (or (featurep 'nas-sound) (featurep 'native-sound))
            (device-sound-enabled-p))))
    ("audio/au"
     mm-inline-audio
     (lambda (handle)
       (and (or (featurep 'nas-sound) (featurep 'native-sound))
            (device-sound-enabled-p))))
    ("application/pgp-signature" ignore identity)
    ("application/x-pkcs7-signature" ignore identity)
    ("application/pkcs7-signature" ignore identity)
    ("application/x-pkcs7-mime" ignore identity)
    ("application/pkcs7-mime" ignore identity)
    ("multipart/alternative" ignore identity)
    ("multipart/mixed" ignore identity)
    ("multipart/related" ignore identity)
    ;; Disable audio and image
    ("audio/.*" ignore ignore)
    ("image/.*" ignore ignore)
    ;; Default to displaying as text
    (".*" mm-inline-text mm-readable-p))
  "Alist of media types/tests saying whether types can be displayed inline.")

Bill Wohler's avatar
Bill Wohler committed
270 271
;; Copy of `goto-address-mail-regexp'
(defvar mh-address-mail-regexp
Bill Wohler's avatar
Bill Wohler committed
272
  "[-a-zA-Z0-9._]+@\\([-a-zA-z0-9_]+\\.\\)+[a-zA-Z0-9]+"
Bill Wohler's avatar
Bill Wohler committed
273 274 275
  "A regular expression probably matching an e-mail address.")

;; From goto-addr.el, which we don't want to force-load on users.
Bill Wohler's avatar
Bill Wohler committed
276

Bill Wohler's avatar
Bill Wohler committed
277 278 279 280 281 282 283 284 285 286 287
(defun mh-goto-address-find-address-at-point ()
  "Find e-mail address around or before point.
Then search backwards to beginning of line for the start of an e-mail
address.  If no e-mail address found, return nil."
  (re-search-backward "[^-_A-z0-9.@]" (line-beginning-position) 'lim)
  (if (or (looking-at mh-address-mail-regexp)	; already at start
	  (and (re-search-forward mh-address-mail-regexp
				  (line-end-position) 'lim)
	       (goto-char (match-beginning 0))))
      (match-string-no-properties 0)))

Bill Wohler's avatar
Bill Wohler committed
288 289 290 291 292
(defun mh-mail-header-end ()
  "Substitute for `mail-header-end' that doesn't widen the buffer.
In MH-E we frequently need to find the end of headers in nested messages, where
the buffer has been narrowed. This function works in this situation."
  (save-excursion
Bill Wohler's avatar
Bill Wohler committed
293 294 295 296 297 298 299 300 301 302 303 304
    ;; XXX: The following replaces a call to rfc822-goto-eoh. Occasionally,
    ;; mail headers that MH-E has to read contains lines of the form:
    ;;    From xxx@yyy Mon May 10 11:48:07 2004
    ;; In this situation, rfc822-goto-eoh doesn't go to the end of the
    ;; header. The replacement allows From_ lines in the mail header.
    (goto-char (point-min))
    (loop for p = (re-search-forward
                   "^\\([:\n]\\|[^: \t\n]+[ \t\n]\\)" nil 'move)
          do (cond ((null p) (return))
                   (t (goto-char (match-beginning 0))
                      (unless (looking-at "From ") (return))
                      (goto-char p))))
Bill Wohler's avatar
Bill Wohler committed
305 306
    (point)))

Bill Wohler's avatar
Bill Wohler committed
307
(defun mh-in-header-p ()
Bill Wohler's avatar
Bill Wohler committed
308
  "Return non-nil if the point is in the header of a draft message."
Bill Wohler's avatar
Bill Wohler committed
309
  (< (point) (mh-mail-header-end)))
Bill Wohler's avatar
Bill Wohler committed
310

Bill Wohler's avatar
Bill Wohler committed
311 312 313 314 315 316 317
(defun mh-header-field-beginning ()
  "Move to the beginning of the current header field.
Handles RFC 822 continuation lines."
  (beginning-of-line)
  (while (looking-at "^[ \t]")
    (forward-line -1)))

Bill Wohler's avatar
Bill Wohler committed
318
(defun mh-header-field-end ()
Bill Wohler's avatar
Bill Wohler committed
319 320
  "Move to the end of the current header field.
Handles RFC 822 continuation lines."
Bill Wohler's avatar
Bill Wohler committed
321 322 323
  (forward-line 1)
  (while (looking-at "^[ \t]")
    (forward-line 1))
Bill Wohler's avatar
Bill Wohler committed
324
  (backward-char 1))                    ;to end of previous line
Bill Wohler's avatar
Bill Wohler committed
325 326 327 328 329 330

(defun mh-letter-header-font-lock (limit)
  "Return the entire mail header to font-lock.
Argument LIMIT limits search."
  (if (= (point) limit)
      nil
Bill Wohler's avatar
Bill Wohler committed
331
    (let* ((mail-header-end (save-match-data (mh-mail-header-end)))
Bill Wohler's avatar
Bill Wohler committed
332 333 334 335 336 337 338 339 340 341 342
           (lesser-limit (if (< mail-header-end limit) mail-header-end limit)))
      (when (mh-in-header-p)
        (set-match-data (list 1 lesser-limit))
        (goto-char lesser-limit)
        t))))

(defun mh-header-field-font-lock (field limit)
  "Return the value of a header field FIELD to font-lock.
Argument LIMIT limits search."
  (if (= (point) limit)
      nil
Bill Wohler's avatar
Bill Wohler committed
343
    (let* ((mail-header-end (mh-mail-header-end))
Bill Wohler's avatar
Bill Wohler committed
344 345
           (lesser-limit (if (< mail-header-end limit) mail-header-end limit))
           (case-fold-search t))
Bill Wohler's avatar
Bill Wohler committed
346
      (when (and (< (point) mail-header-end) ;Only within header
Bill Wohler's avatar
Bill Wohler committed
347 348 349 350
                 (re-search-forward (format "^%s" field) lesser-limit t))
        (let ((match-one-b (match-beginning 0))
              (match-one-e (match-end 0)))
          (mh-header-field-end)
Bill Wohler's avatar
Bill Wohler committed
351
          (if (> (point) limit)         ;Don't search for end beyond limit
Bill Wohler's avatar
Bill Wohler committed
352 353 354 355 356 357
              (goto-char limit))
          (set-match-data (list match-one-b match-one-e
                                (1+ match-one-e) (point)))
          t)))))

(defun mh-header-to-font-lock (limit)
Bill Wohler's avatar
Bill Wohler committed
358 359
  "Return the value of a header field To to font-lock.
Argument LIMIT limits search."
Bill Wohler's avatar
Bill Wohler committed
360 361 362
  (mh-header-field-font-lock "To:" limit))

(defun mh-header-cc-font-lock (limit)
Bill Wohler's avatar
Bill Wohler committed
363 364
  "Return the value of a header field cc to font-lock.
Argument LIMIT limits search."
Bill Wohler's avatar
Bill Wohler committed
365 366 367
  (mh-header-field-font-lock "cc:" limit))

(defun mh-header-subject-font-lock (limit)
Bill Wohler's avatar
Bill Wohler committed
368 369
  "Return the value of a header field Subject to font-lock.
Argument LIMIT limits search."
Bill Wohler's avatar
Bill Wohler committed
370 371
  (mh-header-field-font-lock "Subject:" limit))

Bill Wohler's avatar
Bill Wohler committed
372 373 374 375 376 377 378
(eval-and-compile
  ;; Otherwise byte-compilation fails on `mh-show-font-lock-keywords-with-cite'
  (defvar mh-show-font-lock-keywords
    '(("^\\(From:\\|Sender:\\)\\(.*\\)"  (1 'default) (2 mh-show-from-face))
      (mh-header-to-font-lock            (0 'default) (1 mh-show-to-face))
      (mh-header-cc-font-lock            (0 'default) (1 mh-show-cc-face))
      ("^\\(Reply-To:\\|Return-Path:\\)\\(.*\\)$"
Bill Wohler's avatar
Bill Wohler committed
379
       (1 'default) (2 mh-show-from-face))
Bill Wohler's avatar
Bill Wohler committed
380 381
      (mh-header-subject-font-lock       (0 'default) (1 mh-show-subject-face))
      ("^\\(Apparently-To:\\|Newsgroups:\\)\\(.*\\)"
Bill Wohler's avatar
Bill Wohler committed
382
       (1 'default) (2 mh-show-cc-face))
Bill Wohler's avatar
Bill Wohler committed
383
      ("^\\(In-reply-to\\|Date\\):\\(.*\\)$"
Bill Wohler's avatar
Bill Wohler committed
384
       (1 'default) (2 mh-show-date-face))
Bill Wohler's avatar
Bill Wohler committed
385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406
      (mh-letter-header-font-lock        (0 mh-show-header-face append t)))
    "Additional expressions to highlight in MH-show mode."))

(defvar mh-show-font-lock-keywords-with-cite
  (eval-when-compile
    (let* ((cite-chars "[>|}]")
           (cite-prefix "A-Za-z")
           (cite-suffix (concat cite-prefix "0-9_.@-`'\"")))
      (append
       mh-show-font-lock-keywords
       (list
        ;; Use MATCH-ANCHORED to effectively anchor the regexp left side.
        `(,cite-chars
          (,(concat "\\=[ \t]*"
                    "\\(\\([" cite-prefix "]+[" cite-suffix "]*\\)?"
                    "\\(" cite-chars "[ \t]*\\)\\)+"
                    "\\(.*\\)")
           (beginning-of-line) (end-of-line)
           (2 font-lock-constant-face nil t)
           (4 font-lock-comment-face nil t)))))))
  "Additional expressions to highlight in MH-show mode.")

Bill Wohler's avatar
Bill Wohler committed
407 408
(defvar mh-letter-font-lock-keywords
  `(,@mh-show-font-lock-keywords-with-cite
409
    (mh-font-lock-field-data (1 'mh-letter-header-field prepend t))))
Bill Wohler's avatar
Bill Wohler committed
410

Bill Wohler's avatar
Bill Wohler committed
411 412 413 414 415 416
(defun mh-show-font-lock-fontify-region (beg end loudly)
  "Limit font-lock in `mh-show-mode' to the header.
Used when `mh-highlight-citation-p' is set to gnus, leaving the body to be
dealt with by gnus highlighting. The region between BEG and END is
given over to be fontified and LOUDLY controls if a user sees a
message about the fontification operation."
Bill Wohler's avatar
Bill Wohler committed
417
  (let ((header-end (mh-mail-header-end)))
Bill Wohler's avatar
Bill Wohler committed
418 419 420 421 422 423 424 425 426 427 428 429
    (cond
     ((and (< beg header-end)(< end header-end))
      (font-lock-default-fontify-region beg end loudly))
     ((and (< beg header-end)(>= end header-end))
      (font-lock-default-fontify-region beg header-end loudly))
     (t
      nil))))

;; Needed to help shush the byte-compiler.
(if mh-xemacs-flag
    (progn
      (eval-and-compile
Bill Wohler's avatar
Bill Wohler committed
430 431 432
        (require 'gnus)
        (require 'gnus-art)
        (require 'gnus-cite))))
Bill Wohler's avatar
Bill Wohler committed
433 434 435 436

(defun mh-gnus-article-highlight-citation ()
  "Highlight cited text in current buffer using gnus."
  (interactive)
Bill Wohler's avatar
Bill Wohler committed
437 438 439 440 441 442 443 444 445 446 447 448
  ;; Requiring gnus-cite should have been sufficient. However for Emacs21.1,
  ;; recursive-load-depth-limit is only 10, so an error occurs. Also it may be
  ;; better to have an autoload at top-level (though that won't work because
  ;; of recursive-load-depth-limit). That gets rid of a compiler warning as
  ;; well.
  (unless mh-xemacs-flag
    (require 'gnus-art)
    (require 'gnus-cite))
  ;; Don't allow Gnus to create buttons while highlighting, maybe this is bad
  ;; style?
  (flet ((gnus-article-add-button (&rest args) nil))
    (let* ((modified (buffer-modified-p))
Bill Wohler's avatar
Bill Wohler committed
449 450 451
           (gnus-article-buffer (buffer-name))
           (gnus-cite-face-list `(,@(cdr gnus-cite-face-list)
                                    ,(car gnus-cite-face-list))))
Bill Wohler's avatar
Bill Wohler committed
452 453
      (gnus-article-highlight-citation t)
      (set-buffer-modified-p modified))))
Bill Wohler's avatar
Bill Wohler committed
454

Karl Heuer's avatar
Karl Heuer committed
455 456 457
;;; Internal bookkeeping variables:

;; Cached value of the `Path:' component in the user's MH profile.
Bill Wohler's avatar
Bill Wohler committed
458 459
;; User's mail folder directory.
(defvar mh-user-path nil)
Richard M. Stallman's avatar
Richard M. Stallman committed
460

Bill Wohler's avatar
Bill Wohler committed
461
;; An mh-draft-folder of nil means do not use a draft folder.
Karl Heuer's avatar
Karl Heuer committed
462
;; Cached value of the `Draft-Folder:' component in the user's MH profile.
Bill Wohler's avatar
Bill Wohler committed
463 464
;; Name of folder containing draft messages.
(defvar mh-draft-folder nil)
Richard M. Stallman's avatar
Richard M. Stallman committed
465

Karl Heuer's avatar
Karl Heuer committed
466
;; Cached value of the `Unseen-Sequence:' component in the user's MH profile.
Bill Wohler's avatar
Bill Wohler committed
467 468
;; Name of the Unseen sequence.
(defvar mh-unseen-seq nil)
Richard M. Stallman's avatar
Richard M. Stallman committed
469

Bill Wohler's avatar
Bill Wohler committed
470 471 472 473
;; Cached value of the `Previous-Sequence:' component in the user's MH
;; profile.
;; Name of the Previous sequence.
(defvar mh-previous-seq nil)
Richard M. Stallman's avatar
Richard M. Stallman committed
474

Karl Heuer's avatar
Karl Heuer committed
475 476
;; Cached value of the `Inbox:' component in the user's MH profile,
;; or "+inbox" if no such component.
Bill Wohler's avatar
Bill Wohler committed
477 478
;; Name of the Inbox folder.
(defvar mh-inbox nil)
Richard M. Stallman's avatar
Richard M. Stallman committed
479

Bill Wohler's avatar
Bill Wohler committed
480 481 482 483
;; The names of ephemeral buffers have a " *mh-" prefix (so that they are
;; hidden and can be programmatically removed in mh-quit), and the variable
;; names have the form mh-temp-.*-buffer.
(defconst mh-temp-buffer " *mh-temp*")  ;scratch
Bill Wohler's avatar
Bill Wohler committed
484
(defconst mh-temp-fetch-buffer " *mh-fetch*")  ;wget/curl/fetch output
Bill Wohler's avatar
Bill Wohler committed
485 486 487 488 489

;; The names of MH-E buffers that are not ephemeral and can be used by the
;; user (and deleted by the user when no longer needed) have a "*MH-E " prefix
;; (so they can be programmatically removed in mh-quit), and the variable
;; names have the form mh-.*-buffer.
Bill Wohler's avatar
Bill Wohler committed
490
(defconst mh-aliases-buffer "*MH-E Aliases*") ;alias lookups
Bill Wohler's avatar
Bill Wohler committed
491
(defconst mh-folders-buffer "*MH-E Folders*") ;folder list
Bill Wohler's avatar
Bill Wohler committed
492
(defconst mh-help-buffer "*MH-E Help*") ;quick help
Bill Wohler's avatar
Bill Wohler committed
493 494
(defconst mh-info-buffer "*MH-E Info*") ;version information buffer
(defconst mh-log-buffer "*MH-E Log*") ;output of MH commands and so on
Bill Wohler's avatar
Bill Wohler committed
495
(defconst mh-mail-delivery-buffer "*MH-E Mail Delivery*") ;mail delivery log
Bill Wohler's avatar
Bill Wohler committed
496 497
(defconst mh-recipients-buffer "*MH-E Recipients*") ;killed when draft sent
(defconst mh-sequences-buffer "*MH-E Sequences*") ;sequences list
Bill Wohler's avatar
Bill Wohler committed
498 499 500

;; Number of lines to keep in mh-log-buffer.
(defvar mh-log-buffer-lines 100)
Bill Wohler's avatar
Bill Wohler committed
501

Bill Wohler's avatar
Bill Wohler committed
502
;; Window configuration before MH-E command.
Bill Wohler's avatar
Bill Wohler committed
503 504 505
(defvar mh-previous-window-config nil)

;;Non-nil means next SPC or whatever goes to next undeleted message.
Bill Wohler's avatar
Bill Wohler committed
506
(defvar mh-page-to-next-msg-flag nil)
Richard M. Stallman's avatar
Richard M. Stallman committed
507

Karl Heuer's avatar
Karl Heuer committed
508
;;; Internal variables local to a folder.
Richard M. Stallman's avatar
Richard M. Stallman committed
509

Bill Wohler's avatar
Bill Wohler committed
510 511
;; Name of current folder, a string.
(defvar mh-current-folder nil)
Richard M. Stallman's avatar
Richard M. Stallman committed
512

Bill Wohler's avatar
Bill Wohler committed
513 514
;; Buffer that displays message for this folder.
(defvar mh-show-buffer nil)
Richard M. Stallman's avatar
Richard M. Stallman committed
515

Bill Wohler's avatar
Bill Wohler committed
516 517
;; Full path of directory for this folder.
(defvar mh-folder-filename nil)
518

Bill Wohler's avatar
Bill Wohler committed
519 520
;;Number of msgs in buffer.
(defvar mh-msg-count nil)
Richard M. Stallman's avatar
Richard M. Stallman committed
521

Bill Wohler's avatar
Bill Wohler committed
522 523
;; If non-nil, show the message in a separate window.
(defvar mh-showing-mode nil)
Richard M. Stallman's avatar
Richard M. Stallman committed
524

Bill Wohler's avatar
Bill Wohler committed
525 526 527 528 529 530
(defvar mh-show-mode-map (make-sparse-keymap)
  "Keymap used by the show buffer.")

(defvar mh-show-folder-buffer nil
  "Keeps track of folder whose message is being displayed.")

Bill Wohler's avatar
Bill Wohler committed
531 532 533 534
(defvar mh-logo-cache nil)

(defun mh-logo-display ()
  "Modify mode line to display MH-E logo."
Bill Wohler's avatar
Bill Wohler committed
535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551
  (mh-do-in-gnu-emacs
   (add-text-properties
    0 2
    `(display ,(or mh-logo-cache
                   (setq mh-logo-cache
                         (mh-funcall-if-exists
                          find-image '((:type xpm :ascent center
                                              :file "mh-logo.xpm"))))))
    (car mode-line-buffer-identification)))
  (mh-do-in-xemacs
   (setq modeline-buffer-identification
         (list
          (if mh-modeline-glyph
              (cons modeline-buffer-id-left-extent mh-modeline-glyph)
            (cons modeline-buffer-id-left-extent "XEmacs%N:"))
          (cons modeline-buffer-id-right-extent " %17b")))))

Karl Heuer's avatar
Karl Heuer committed
552
;;; This holds a documentation string used by describe-mode.
Bill Wohler's avatar
Bill Wohler committed
553 554 555 556
(defun mh-showing-mode (&optional arg)
  "Change whether messages should be displayed.
With arg, display messages iff ARG is positive."
  (setq mh-showing-mode
Bill Wohler's avatar
Bill Wohler committed
557 558 559
        (if (null arg)
            (not mh-showing-mode)
          (> (prefix-numeric-value arg) 0))))
Karl Heuer's avatar
Karl Heuer committed
560

Bill Wohler's avatar
Bill Wohler committed
561 562
;; The sequences of this folder.  An alist of (seq . msgs).
(defvar mh-seq-list nil)
Karl Heuer's avatar
Karl Heuer committed
563

Bill Wohler's avatar
Bill Wohler committed
564 565
;; List of displayed messages to be removed from the Unseen sequence.
(defvar mh-seen-list nil)
Karl Heuer's avatar
Karl Heuer committed
566 567 568

;; If non-nil, show buffer contains message with all headers.
;; If nil, show buffer contains message processed normally.
Bill Wohler's avatar
Bill Wohler committed
569 570
;; Showing message with headers or normally.
(defvar mh-showing-with-headers nil)
Richard M. Stallman's avatar
Richard M. Stallman committed
571

Bill Wohler's avatar
Bill Wohler committed
572
;;; MH-E macros
573

Bill Wohler's avatar
Bill Wohler committed
574 575 576 577 578 579 580
(defmacro with-mh-folder-updating (save-modification-flag &rest body)
  "Format is (with-mh-folder-updating (SAVE-MODIFICATION-FLAG) &body BODY).
Execute BODY, which can modify the folder buffer without having to
worry about file locking or the read-only flag, and return its result.
If SAVE-MODIFICATION-FLAG is non-nil, the buffer's modification
flag is unchanged, otherwise it is cleared."
  (setq save-modification-flag (car save-modification-flag)) ; CL style
Gerd Moellmann's avatar
Gerd Moellmann committed
581 582
  `(prog1
       (let ((mh-folder-updating-mod-flag (buffer-modified-p))
Bill Wohler's avatar
Bill Wohler committed
583 584 585 586 587 588
             (buffer-read-only nil)
             (buffer-file-name nil))    ;don't let the buffer get locked
         (prog1
             (progn
               ,@body)
           (mh-set-folder-modified-p mh-folder-updating-mod-flag)))
Bill Wohler's avatar
Bill Wohler committed
589
     ,@(if (not save-modification-flag)
Bill Wohler's avatar
Bill Wohler committed
590
           '((mh-set-folder-modified-p nil)))))
591

Bill Wohler's avatar
Bill Wohler committed
592
(put 'with-mh-folder-updating 'lisp-indent-hook 'defun)
593 594

(defmacro mh-in-show-buffer (show-buffer &rest body)
Bill Wohler's avatar
Bill Wohler committed
595 596 597
  "Format is (mh-in-show-buffer (SHOW-BUFFER) &body BODY).
Display buffer SHOW-BUFFER in other window and execute BODY in it.
Stronger than `save-excursion', weaker than `save-window-excursion'."
Bill Wohler's avatar
Bill Wohler committed
598
  (setq show-buffer (car show-buffer))  ; CL style
Gerd Moellmann's avatar
Gerd Moellmann committed
599 600
  `(let ((mh-in-show-buffer-saved-window (selected-window)))
     (switch-to-buffer-other-window ,show-buffer)
Bill Wohler's avatar
Bill Wohler committed
601
     (if mh-bury-show-buffer-flag (bury-buffer (current-buffer)))
Gerd Moellmann's avatar
Gerd Moellmann committed
602
     (unwind-protect
Bill Wohler's avatar
Bill Wohler committed
603
         (progn
Gerd Moellmann's avatar
Gerd Moellmann committed
604 605
           ,@body)
       (select-window mh-in-show-buffer-saved-window))))
606

Bill Wohler's avatar
Bill Wohler committed
607
(put 'mh-in-show-buffer 'lisp-indent-hook 'defun)
608

Bill Wohler's avatar
Bill Wohler committed
609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641
(defmacro mh-do-at-event-location (event &rest body)
  "Switch to the location of EVENT and execute BODY.
After BODY has been executed return to original window. The modification flag
of the buffer in the event window is preserved."
  (let ((event-window (make-symbol "event-window"))
        (event-position (make-symbol "event-position"))
        (original-window (make-symbol "original-window"))
        (original-position (make-symbol "original-position"))
        (modified-flag (make-symbol "modified-flag")))
    `(save-excursion
       (let* ((,event-window
               (or (mh-funcall-if-exists posn-window (event-start ,event))
                   (mh-funcall-if-exists event-window ,event)))
              (,event-position
               (or (mh-funcall-if-exists posn-point (event-start ,event))
                   (mh-funcall-if-exists event-closest-point ,event)))
              (,original-window (selected-window))
              (,original-position (progn
                                   (set-buffer (window-buffer ,event-window))
                                   (set-marker (make-marker) (point))))
              (,modified-flag (buffer-modified-p))
              (buffer-read-only nil))
         (unwind-protect (progn
                           (select-window ,event-window)
                           (goto-char ,event-position)
                           ,@body)
           (set-buffer-modified-p ,modified-flag)
           (goto-char ,original-position)
           (set-marker ,original-position nil)
           (select-window ,original-window))))))

(put 'mh-do-at-event-location 'lisp-indent-hook 'defun)

Bill Wohler's avatar
Bill Wohler committed
642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684
(defmacro mh-make-seq (name msgs)
  "Create sequence NAME with the given MSGS."
  (list 'cons name msgs))

(defmacro mh-seq-name (sequence)
  "Extract sequence name from the given SEQUENCE."
  (list 'car sequence))

(defmacro mh-seq-msgs (sequence)
  "Extract messages from the given SEQUENCE."
  (list 'cdr sequence))

(defun mh-recenter (arg)
  "Like recenter but with three improvements:
- At the end of the buffer it tries to show fewer empty lines.
- operates only if the current buffer is in the selected window.
  (Commands like `save-some-buffers' can make this false.)
- nil ARG means recenter as if prefix argument had been given."
  (cond ((not (eq (get-buffer-window (current-buffer)) (selected-window)))
         nil)
        ((= (point-max) (save-excursion
                          (forward-line (- (/ (window-height) 2) 2))
                          (point)))
         (let ((lines-from-end 2))
           (save-excursion
             (while (> (point-max) (progn (forward-line) (point)))
               (incf lines-from-end)))
           (recenter (- lines-from-end))))
        ;; '(4) is the same as C-u prefix argument.
        (t (recenter (or arg '(4))))))

(defun mh-start-of-uncleaned-message ()
  "Position uninteresting headers off the top of the window."
  (let ((case-fold-search t))
    (re-search-forward
     "^To:\\|^Cc:\\|^From:\\|^Subject:\\|^Date:" nil t)
    (beginning-of-line)
    (mh-recenter 0)))

(defun mh-invalidate-show-buffer ()
  "Invalidate the show buffer so we must update it to use it."
  (if (get-buffer mh-show-buffer)
      (save-excursion
Bill Wohler's avatar
Bill Wohler committed
685 686
        (set-buffer mh-show-buffer)
        (mh-unvisit-file))))
Bill Wohler's avatar
Bill Wohler committed
687 688 689 690

(defun mh-unvisit-file ()
  "Separate current buffer from the message file it was visiting."
  (or (not (buffer-modified-p))
Bill Wohler's avatar
Bill Wohler committed
691
      (null buffer-file-name)           ;we've been here before
Bill Wohler's avatar
Bill Wohler committed
692
      (yes-or-no-p (format "Message %s modified; flush changes? "
Bill Wohler's avatar
Bill Wohler committed
693
                           (file-name-nondirectory buffer-file-name)))
Bill Wohler's avatar
Bill Wohler committed
694 695 696 697
      (error "Flushing changes not confirmed"))
  (clear-visited-file-modtime)
  (unlock-buffer)
  (setq buffer-file-name nil))
698

Bill Wohler's avatar
Bill Wohler committed
699

Bill Wohler's avatar
Bill Wohler committed
700 701 702 703 704 705 706
(defun mh-get-msg-num (error-if-no-message)
  "Return the message number of the displayed message.
If the argument ERROR-IF-NO-MESSAGE is non-nil, then complain if the cursor is
not pointing to a message."
  (save-excursion
    (beginning-of-line)
    (cond ((looking-at mh-scan-msg-number-regexp)
Bill Wohler's avatar
Bill Wohler committed
707 708
           (string-to-number (buffer-substring (match-beginning 1)
                                               (match-end 1))))
Bill Wohler's avatar
Bill Wohler committed
709 710 711
          (error-if-no-message
           (error "Cursor not pointing to message"))
          (t nil))))
Bill Wohler's avatar
Bill Wohler committed
712 713 714 715 716 717 718

(defun mh-folder-name-p (name)
  "Return non-nil if NAME is the name of a folder.
A name (a string or symbol) can be a folder name if it begins with \"+\"."
  (if (symbolp name)
      (eq (aref (symbol-name name) 0) ?+)
    (and (> (length name) 0)
Bill Wohler's avatar
Bill Wohler committed
719
         (eq (aref name 0) ?+))))
Bill Wohler's avatar
Bill Wohler committed
720 721 722 723 724 725


(defun mh-expand-file-name (filename &optional default)
  "Expand FILENAME like `expand-file-name', but also handle MH folder names.
Any filename that starts with '+' is treated as a folder name.
See `expand-file-name' for description of DEFAULT."
Bill Wohler's avatar
Bill Wohler committed
726 727 728
  (if (mh-folder-name-p filename)
      (expand-file-name (substring filename 1) mh-user-path)
    (expand-file-name filename default)))
Karl Heuer's avatar
Karl Heuer committed
729

730

Bill Wohler's avatar
Bill Wohler committed
731 732 733
(defun mh-msg-filename (msg &optional folder)
  "Return the file name of MSG in FOLDER (default current folder)."
  (expand-file-name (int-to-string msg)
Bill Wohler's avatar
Bill Wohler committed
734 735 736
                    (if folder
                        (mh-expand-file-name folder)
                      mh-folder-filename)))
737

Bill Wohler's avatar
Bill Wohler committed
738 739 740 741 742
;;; Infrastructure to generate show-buffer functions from folder functions
;;; XEmacs does not have deactivate-mark? What is the equivalent of
;;; transient-mark-mode for XEmacs? Should we be restoring the mark in the
;;; folder buffer after the operation has been carried out.
(defmacro mh-defun-show-buffer (function original-function
Bill Wohler's avatar
Bill Wohler committed
743
                                         &optional dont-return)
Bill Wohler's avatar
Bill Wohler committed
744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765
  "Define FUNCTION to run ORIGINAL-FUNCTION in folder buffer.
If the buffer we start in is still visible and DONT-RETURN is nil then switch
to it after that."
  `(defun ,function ()
     ,(format "Calls %s from the message's folder.\n%s\nSee `%s' for more info.\n"
              original-function
              (if dont-return ""
                "When function completes, returns to the show buffer if it is
still visible.\n")
              original-function)
     (interactive)
     (when (buffer-live-p (get-buffer mh-show-folder-buffer))
       (let ((config (current-window-configuration))
             (folder-buffer mh-show-folder-buffer)
             (normal-exit nil)
             ,@(if dont-return () '((cur-buffer-name (buffer-name)))))
         (pop-to-buffer mh-show-folder-buffer nil)
         (unless (equal (buffer-name
                         (window-buffer (frame-first-window (selected-frame))))
                        folder-buffer)
           (delete-other-windows))
         (mh-goto-cur-msg t)
Bill Wohler's avatar
Bill Wohler committed
766
         (mh-funcall-if-exists deactivate-mark)
Bill Wohler's avatar
Bill Wohler committed
767 768 769
         (unwind-protect
             (prog1 (call-interactively (function ,original-function))
               (setq normal-exit t))
Bill Wohler's avatar
Bill Wohler committed
770
           (mh-funcall-if-exists deactivate-mark)
Bill Wohler's avatar
Bill Wohler committed
771 772
           (when (eq major-mode 'mh-folder-mode)
             (mh-funcall-if-exists hl-line-highlight))
Bill Wohler's avatar
Bill Wohler committed
773 774 775 776 777 778 779 780 781 782 783 784
           (cond ((not normal-exit)
                  (set-window-configuration config))
                 ,(if dont-return
                      `(t (setq mh-previous-window-config config))
                    `((and (get-buffer cur-buffer-name)
                           (window-live-p (get-buffer-window
                                           (get-buffer cur-buffer-name))))
                      (pop-to-buffer (get-buffer cur-buffer-name) nil)))))))))

;;; Generate interactive functions for the show buffer from the corresponding
;;; folder functions.
(mh-defun-show-buffer mh-show-previous-undeleted-msg
Bill Wohler's avatar
Bill Wohler committed
785
                      mh-previous-undeleted-msg)
Bill Wohler's avatar
Bill Wohler committed
786
(mh-defun-show-buffer mh-show-next-undeleted-msg
Bill Wohler's avatar
Bill Wohler committed
787
                      mh-next-undeleted-msg)
Bill Wohler's avatar
Bill Wohler committed
788 789 790 791 792 793 794 795 796 797
(mh-defun-show-buffer mh-show-quit mh-quit)
(mh-defun-show-buffer mh-show-delete-msg mh-delete-msg)
(mh-defun-show-buffer mh-show-refile-msg mh-refile-msg)
(mh-defun-show-buffer mh-show-undo mh-undo)
(mh-defun-show-buffer mh-show-execute-commands mh-execute-commands)
(mh-defun-show-buffer mh-show-reply mh-reply t)
(mh-defun-show-buffer mh-show-redistribute mh-redistribute)
(mh-defun-show-buffer mh-show-forward mh-forward t)
(mh-defun-show-buffer mh-show-header-display mh-header-display)
(mh-defun-show-buffer mh-show-refile-or-write-again
Bill Wohler's avatar
Bill Wohler committed
798
                      mh-refile-or-write-again)
Bill Wohler's avatar
Bill Wohler committed
799 800
(mh-defun-show-buffer mh-show-show mh-show)
(mh-defun-show-buffer mh-show-write-message-to-file
Bill Wohler's avatar
Bill Wohler committed
801
                      mh-write-msg-to-file)
Bill Wohler's avatar
Bill Wohler committed
802
(mh-defun-show-buffer mh-show-extract-rejected-mail
Bill Wohler's avatar
Bill Wohler committed
803
                      mh-extract-rejected-mail t)
Bill Wohler's avatar
Bill Wohler committed
804
(mh-defun-show-buffer mh-show-delete-msg-no-motion
Bill Wohler's avatar
Bill Wohler committed
805
                      mh-delete-msg-no-motion)
Bill Wohler's avatar
Bill Wohler committed
806 807 808 809 810 811
(mh-defun-show-buffer mh-show-first-msg mh-first-msg)
(mh-defun-show-buffer mh-show-last-msg mh-last-msg)
(mh-defun-show-buffer mh-show-copy-msg mh-copy-msg)
(mh-defun-show-buffer mh-show-edit-again mh-edit-again t)
(mh-defun-show-buffer mh-show-goto-msg mh-goto-msg)
(mh-defun-show-buffer mh-show-inc-folder mh-inc-folder)
Bill Wohler's avatar
Bill Wohler committed
812 813 814
(mh-defun-show-buffer mh-show-delete-subject-or-thread
                      mh-delete-subject-or-thread)
(mh-defun-show-buffer mh-show-delete-subject mh-delete-subject)
Bill Wohler's avatar
Bill Wohler committed
815 816 817 818 819 820 821 822 823 824 825 826 827
(mh-defun-show-buffer mh-show-print-msg mh-print-msg)
(mh-defun-show-buffer mh-show-send mh-send t)
(mh-defun-show-buffer mh-show-toggle-showing mh-toggle-showing t)
(mh-defun-show-buffer mh-show-pipe-msg mh-pipe-msg t)
(mh-defun-show-buffer mh-show-sort-folder mh-sort-folder)
(mh-defun-show-buffer mh-show-visit-folder mh-visit-folder t)
(mh-defun-show-buffer mh-show-rescan-folder mh-rescan-folder)
(mh-defun-show-buffer mh-show-pack-folder mh-pack-folder)
(mh-defun-show-buffer mh-show-kill-folder mh-kill-folder t)
(mh-defun-show-buffer mh-show-list-folders mh-list-folders t)
(mh-defun-show-buffer mh-show-search-folder mh-search-folder t)
(mh-defun-show-buffer mh-show-undo-folder mh-undo-folder)
(mh-defun-show-buffer mh-show-delete-msg-from-seq
Bill Wohler's avatar
Bill Wohler committed
828
                      mh-delete-msg-from-seq)
Bill Wohler's avatar
Bill Wohler committed
829 830 831 832 833 834
(mh-defun-show-buffer mh-show-delete-seq mh-delete-seq)
(mh-defun-show-buffer mh-show-list-sequences mh-list-sequences)
(mh-defun-show-buffer mh-show-narrow-to-seq mh-narrow-to-seq)
(mh-defun-show-buffer mh-show-put-msg-in-seq mh-put-msg-in-seq)
(mh-defun-show-buffer mh-show-msg-is-in-seq mh-msg-is-in-seq)
(mh-defun-show-buffer mh-show-widen mh-widen)
Bill Wohler's avatar
Bill Wohler committed
835 836 837 838 839
(mh-defun-show-buffer mh-show-narrow-to-subject mh-narrow-to-subject)
(mh-defun-show-buffer mh-show-narrow-to-from mh-narrow-to-from)
(mh-defun-show-buffer mh-show-narrow-to-cc mh-narrow-to-cc)
(mh-defun-show-buffer mh-show-narrow-to-range mh-narrow-to-range)
(mh-defun-show-buffer mh-show-narrow-to-to mh-narrow-to-to)
Bill Wohler's avatar
Bill Wohler committed
840 841 842
(mh-defun-show-buffer mh-show-store-msg mh-store-msg)
(mh-defun-show-buffer mh-show-page-digest mh-page-digest)
(mh-defun-show-buffer mh-show-page-digest-backwards
Bill Wohler's avatar
Bill Wohler committed
843
                      mh-page-digest-backwards)
Bill Wohler's avatar
Bill Wohler committed
844 845 846 847 848 849 850 851 852 853
(mh-defun-show-buffer mh-show-burst-digest mh-burst-digest)
(mh-defun-show-buffer mh-show-page-msg mh-page-msg)
(mh-defun-show-buffer mh-show-previous-page mh-previous-page)
(mh-defun-show-buffer mh-show-modify mh-modify t)
(mh-defun-show-buffer mh-show-next-button mh-next-button)
(mh-defun-show-buffer mh-show-prev-button mh-prev-button)
(mh-defun-show-buffer mh-show-toggle-mime-part mh-folder-toggle-mime-part)
(mh-defun-show-buffer mh-show-save-mime-part mh-folder-save-mime-part)
(mh-defun-show-buffer mh-show-inline-mime-part mh-folder-inline-mime-part)
(mh-defun-show-buffer mh-show-toggle-threads mh-toggle-threads)
Bill Wohler's avatar
Bill Wohler committed
854 855
(mh-defun-show-buffer mh-show-thread-delete mh-thread-delete)
(mh-defun-show-buffer mh-show-thread-refile mh-thread-refile)
Bill Wohler's avatar
Bill Wohler committed
856
(mh-defun-show-buffer mh-show-update-sequences mh-update-sequences)
Bill Wohler's avatar
Bill Wohler committed
857 858 859 860 861 862 863
(mh-defun-show-buffer mh-show-next-unread-msg mh-next-unread-msg)
(mh-defun-show-buffer mh-show-previous-unread-msg mh-previous-unread-msg)
(mh-defun-show-buffer mh-show-thread-ancestor mh-thread-ancestor)
(mh-defun-show-buffer mh-show-thread-next-sibling mh-thread-next-sibling)
(mh-defun-show-buffer mh-show-thread-previous-sibling
                      mh-thread-previous-sibling)
(mh-defun-show-buffer mh-show-index-visit-folder mh-index-visit-folder t)
Bill Wohler's avatar
Bill Wohler committed
864 865 866 867 868
(mh-defun-show-buffer mh-show-toggle-tick mh-toggle-tick)
(mh-defun-show-buffer mh-show-narrow-to-tick mh-narrow-to-tick)
(mh-defun-show-buffer mh-show-junk-blacklist mh-junk-blacklist)
(mh-defun-show-buffer mh-show-junk-whitelist mh-junk-whitelist)
(mh-defun-show-buffer mh-show-index-new-messages mh-index-new-messages)
Bill Wohler's avatar
Bill Wohler committed
869 870 871
(mh-defun-show-buffer mh-show-index-ticked-messages mh-index-ticked-messages)
(mh-defun-show-buffer mh-show-index-sequenced-messages
                      mh-index-sequenced-messages)
Bill Wohler's avatar
Bill Wohler committed
872 873 874 875 876 877 878 879 880 881
(mh-defun-show-buffer mh-show-catchup mh-catchup)
(mh-defun-show-buffer mh-show-ps-print-toggle-mime mh-ps-print-toggle-mime)
(mh-defun-show-buffer mh-show-ps-print-toggle-color mh-ps-print-toggle-color)
(mh-defun-show-buffer mh-show-ps-print-toggle-faces mh-ps-print-toggle-faces)
(mh-defun-show-buffer mh-show-ps-print-msg-file mh-ps-print-msg-file)
(mh-defun-show-buffer mh-show-ps-print-msg mh-ps-print-msg)
(mh-defun-show-buffer mh-show-ps-print-msg-show mh-ps-print-msg-show)
(mh-defun-show-buffer mh-show-toggle-mime-buttons mh-toggle-mime-buttons)
(mh-defun-show-buffer mh-show-display-with-external-viewer
                      mh-display-with-external-viewer)
Bill Wohler's avatar
Bill Wohler committed
882 883 884 885 886

;;; Populate mh-show-mode-map
(gnus-define-keys mh-show-mode-map
  " "    mh-show-page-msg
  "!"    mh-show-refile-or-write-again
Bill Wohler's avatar
Bill Wohler committed
887
  "'"    mh-show-toggle-tick
Bill Wohler's avatar
Bill Wohler committed
888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906
  ","    mh-show-header-display
  "."    mh-show-show
  ">"    mh-show-write-message-to-file
  "?"    mh-help
  "E"    mh-show-extract-rejected-mail
  "M"    mh-show-modify
  "\177" mh-show-previous-page
  "\C-d" mh-show-delete-msg-no-motion
  "\t"   mh-show-next-button
  [backtab] mh-show-prev-button
  "\M-\t" mh-show-prev-button
  "\ed"  mh-show-redistribute
  "^"    mh-show-refile-msg
  "c"    mh-show-copy-msg
  "d"    mh-show-delete-msg
  "e"    mh-show-edit-again
  "f"    mh-show-forward
  "g"    mh-show-goto-msg
  "i"    mh-show-inc-folder
Bill Wohler's avatar
Bill Wohler committed
907
  "k"    mh-show-delete-subject-or-thread
Bill Wohler's avatar
Bill Wohler committed
908 909
  "m"    mh-show-send
  "n"    mh-show-next-undeleted-msg
Bill Wohler's avatar
Bill Wohler committed
910
  "\M-n" mh-show-next-unread-msg
Bill Wohler's avatar
Bill Wohler committed
911 912
  "o"    mh-show-refile-msg
  "p"    mh-show-previous-undeleted-msg
Bill Wohler's avatar
Bill Wohler committed
913
  "\M-p" mh-show-previous-unread-msg
Bill Wohler's avatar
Bill Wohler committed
914 915 916 917 918 919
  "q"    mh-show-quit
  "r"    mh-show-reply
  "s"    mh-show-send
  "t"    mh-show-toggle-showing
  "u"    mh-show-undo
  "x"    mh-show-execute-commands
Bill Wohler's avatar
Bill Wohler committed
920
  "v"    mh-show-index-visit-folder
Bill Wohler's avatar
Bill Wohler committed
921 922 923 924
  "|"    mh-show-pipe-msg)

(gnus-define-keys (mh-show-folder-map "F" mh-show-mode-map)
  "?"    mh-prefix-help
Bill Wohler's avatar
Bill Wohler committed
925
  "'"    mh-index-ticked-messages
Bill Wohler's avatar
Bill Wohler committed
926
  "S"    mh-show-sort-folder
Bill Wohler's avatar
Bill Wohler committed
927
  "c"    mh-show-catchup
Bill Wohler's avatar
Bill Wohler committed
928 929 930 931
  "f"    mh-show-visit-folder
  "i"    mh-index-search
  "k"    mh-show-kill-folder
  "l"    mh-show-list-folders
Bill Wohler's avatar
Bill Wohler committed
932
  "n"    mh-index-new-messages
Bill Wohler's avatar
Bill Wohler committed
933
  "o"    mh-show-visit-folder
Bill Wohler's avatar
Bill Wohler committed
934
  "q"    mh-show-index-sequenced-messages
Bill Wohler's avatar
Bill Wohler committed
935 936 937 938 939 940 941
  "r"    mh-show-rescan-folder
  "s"    mh-show-search-folder
  "t"    mh-show-toggle-threads
  "u"    mh-show-undo-folder
  "v"    mh-show-visit-folder)

(gnus-define-keys (mh-show-sequence-map "S" mh-show-mode-map)
Bill Wohler's avatar
Bill Wohler committed
942
  "'"    mh-show-narrow-to-tick
Bill Wohler's avatar
Bill Wohler committed
943 944 945 946 947 948 949 950 951
  "?"    mh-prefix-help
  "d"    mh-show-delete-msg-from-seq
  "k"    mh-show-delete-seq
  "l"    mh-show-list-sequences
  "n"    mh-show-narrow-to-seq
  "p"    mh-show-put-msg-in-seq
  "s"    mh-show-msg-is-in-seq
  "w"    mh-show-widen)

Bill Wohler's avatar
Bill Wohler committed
952 953 954 955 956 957 958
(define-key mh-show-mode-map "I" mh-inc-spool-map)

(gnus-define-keys (mh-show-junk-map "J" mh-show-mode-map)
  "?"    mh-prefix-help
  "b"    mh-show-junk-blacklist
  "w"    mh-show-junk-whitelist)

Bill Wohler's avatar
Bill Wohler committed
959 960 961 962 963 964 965 966 967 968 969
(gnus-define-keys (mh-show-ps-print-map "P" mh-show-mode-map)
  "?"	mh-prefix-help
  "A"	mh-show-ps-print-toggle-mime
  "C"	mh-show-ps-print-toggle-color
  "F"	mh-show-ps-print-toggle-faces
  "M"	mh-show-ps-print-toggle-mime
  "f"	mh-show-ps-print-msg-file
  "l"   mh-show-print-msg
  "p"	mh-show-ps-print-msg
  "s"	mh-show-ps-print-msg-show)

Bill Wohler's avatar
Bill Wohler committed
970 971
(gnus-define-keys (mh-show-thread-map "T" mh-show-mode-map)
  "?"    mh-prefix-help
Bill Wohler's avatar
Bill Wohler committed
972 973 974 975 976 977
  "u"    mh-show-thread-ancestor
  "p"    mh-show-thread-previous-sibling
  "n"    mh-show-thread-next-sibling
  "t"    mh-show-toggle-threads
  "d"    mh-show-thread-delete
  "o"    mh-show-thread-refile)
Bill Wohler's avatar
Bill Wohler committed
978 979

(gnus-define-keys (mh-show-limit-map "/" mh-show-mode-map)
Bill Wohler's avatar
Bill Wohler committed
980
  "'"    mh-show-narrow-to-tick
Bill Wohler's avatar
Bill Wohler committed
981
  "?"    mh-prefix-help
Bill Wohler's avatar
Bill Wohler committed
982 983 984
  "c"    mh-show-narrow-to-cc
  "f"    mh-show-narrow-to-from
  "r"    mh-show-narrow-to-range
Bill Wohler's avatar
Bill Wohler committed
985
  "s"    mh-show-narrow-to-subject
Bill Wohler's avatar
Bill Wohler committed
986
  "t"    mh-show-narrow-to-to
Bill Wohler's avatar
Bill Wohler committed
987 988 989 990 991 992 993 994 995 996
  "w"    mh-show-widen)

(gnus-define-keys (mh-show-extract-map "X" mh-show-mode-map)
  "?"    mh-prefix-help
  "s"    mh-show-store-msg
  "u"    mh-show-store-msg)

;; Untested...
(gnus-define-keys (mh-show-digest-map "D" mh-show-mode-map)
  "?"    mh-prefix-help
Bill Wohler's avatar
Bill Wohler committed
997
  " "    mh-show-page-digest
Bill Wohler's avatar
Bill Wohler committed
998
  "\177" mh-show-page-digest-backwards
Bill Wohler's avatar
Bill Wohler committed
999
  "b"    mh-show-burst-digest)
Bill Wohler's avatar
Bill Wohler committed
1000 1001 1002

(gnus-define-keys (mh-show-mime-map "K" mh-show-mode-map)
  "?"           mh-prefix-help
Bill Wohler's avatar
Bill Wohler committed
1003
  "a"           mh-mime-save-parts
Bill Wohler's avatar
Bill Wohler committed
1004
  "e"           mh-show-display-with-external-viewer
Bill Wohler's avatar
Bill Wohler committed
1005 1006 1007
  "v"           mh-show-toggle-mime-part
  "o"           mh-show-save-mime-part
  "i"           mh-show-inline-mime-part
Bill Wohler's avatar
Bill Wohler committed
1008
  "t"           mh-show-toggle-mime-buttons
Bill Wohler's avatar
Bill Wohler committed
1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024
  "\t"          mh-show-next-button
  [backtab]     mh-show-prev-button
  "\M-\t"       mh-show-prev-button)

(easy-menu-define
  mh-show-sequence-menu mh-show-mode-map "Menu for MH-E folder-sequence."
  '("Sequence"
    ["Add Message to Sequence..."       mh-show-put-msg-in-seq t]
    ["List Sequences for Message"       mh-show-msg-is-in-seq t]
    ["Delete Message from Sequence..."  mh-show-delete-msg-from-seq t]
    ["List Sequences in Folder..."      mh-show-list-sequences t]
    ["Delete Sequence..."               mh-show-delete-seq t]
    ["Narrow to Sequence..."            mh-show-narrow-to-seq t]
    ["Widen from Sequence"              mh-show-widen t]
    "--"
    ["Narrow to Subject Sequence"       mh-show-narrow-to-subject t]
Bill Wohler's avatar
Bill Wohler committed
1025 1026 1027 1028
    ["Narrow to Tick Sequence"          mh-show-narrow-to-tick
     (save-excursion
       (set-buffer mh-show-folder-buffer)
       (and mh-tick-seq (mh-seq-msgs (mh-find-seq mh-tick-seq))))]
Bill Wohler's avatar
Bill Wohler committed
1029
    ["Delete Rest of Same Subject"      mh-show-delete-subject t]
Bill Wohler's avatar
Bill Wohler committed
1030
    ["Toggle Tick Mark"                 mh-show-toggle-tick t]
Bill Wohler's avatar
Bill Wohler committed
1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076
    "--"
    ["Push State Out to MH"             mh-show-update-sequences t]))

(easy-menu-define
  mh-show-message-menu mh-show-mode-map "Menu for MH-E folder-message."
  '("Message"
    ["Show Message"                     mh-show-show t]
    ["Show Message with Header"         mh-show-header-display t]
    ["Next Message"                     mh-show-next-undeleted-msg t]
    ["Previous Message"                 mh-show-previous-undeleted-msg t]
    ["Go to First Message"              mh-show-first-msg t]
    ["Go to Last Message"               mh-show-last-msg t]
    ["Go to Message by Number..."       mh-show-goto-msg t]
    ["Modify Message"                   mh-show-modify t]
    ["Delete Message"                   mh-show-delete-msg t]
    ["Refile Message"                   mh-show-refile-msg t]
    ["Undo Delete/Refile"               mh-show-undo t]
    ["Process Delete/Refile"            mh-show-execute-commands t]
    "--"
    ["Compose a New Message"            mh-send t]
    ["Reply to Message..."              mh-show-reply t]
    ["Forward Message..."               mh-show-forward t]
    ["Redistribute Message..."          mh-show-redistribute t]
    ["Edit Message Again"               mh-show-edit-again t]
    ["Re-edit a Bounced Message"        mh-show-extract-rejected-mail t]
    "--"
    ["Copy Message to Folder..."        mh-show-copy-msg t]
    ["Print Message"                    mh-show-print-msg t]
    ["Write Message to File..."         mh-show-write-msg-to-file t]
    ["Pipe Message to Command..."       mh-show-pipe-msg t]
    ["Unpack Uuencoded Message..."      mh-show-store-msg t]
    ["Burst Digest Message"             mh-show-burst-digest t]))

(easy-menu-define
  mh-show-folder-menu mh-show-mode-map  "Menu for MH-E folder."
  '("Folder"
    ["Incorporate New Mail"             mh-show-inc-folder t]
    ["Toggle Show/Folder"               mh-show-toggle-showing t]
    ["Execute Delete/Refile"            mh-show-execute-commands t]
    ["Rescan Folder"                    mh-show-rescan-folder t]
    ["Thread Folder"                    mh-show-toggle-threads t]
    ["Pack Folder"                      mh-show-pack-folder t]
    ["Sort Folder"                      mh-show-sort-folder t]
    "--"
    ["List Folders"                     mh-show-list-folders t]
    ["Visit a Folder..."                mh-show-visit-folder t]
Bill Wohler's avatar
Bill Wohler committed
1077
    ["View New Messages"                mh-show-index-new-messages t]
Bill Wohler's avatar
Bill Wohler committed
1078 1079 1080 1081 1082
    ["Search a Folder..."               mh-show-search-folder t]
    ["Indexed Search..."                mh-index-search t]
    "--"
    ["Quit MH-E"                        mh-quit t]))

1083

Richard M. Stallman's avatar
Richard M. Stallman committed
1084 1085 1086
;;; Ensure new buffers won't get this mode if default-major-mode is nil.
(put 'mh-show-mode 'mode-class 'special)

Bill Wohler's avatar
Bill Wohler committed
1087 1088 1089 1090
;; Avoid compiler warnings in XEmacs and Emacs 20
(eval-when-compile
  (defvar tool-bar-mode)
  (defvar tool-bar-map))
Bill Wohler's avatar
Bill Wohler committed
1091

Bill Wohler's avatar
Bill Wohler committed
1092
(define-derived-mode mh-show-mode text-mode "MH-Show"
Bill Wohler's avatar
Bill Wohler committed
1093 1094
  "Major mode for showing messages in MH-E.\\<mh-show-mode-map>
The value of `mh-show-mode-hook' is a list of functions to
Bill Wohler's avatar
Bill Wohler committed
1095 1096 1097 1098
be called, with no arguments, upon entry to this mode.
See also `mh-folder-mode'.

\\{mh-show-mode-map}"
Bill Wohler's avatar
Bill Wohler committed
1099
  (set (make-local-variable 'mail-header-separator) mh-mail-header-separator)
Bill Wohler's avatar
Bill Wohler committed
1100
  (setq paragraph-start (default-value 'paragraph-start))
Bill Wohler's avatar
Bill Wohler committed
1101
  (mh-show-unquote-From)
Bill Wohler's avatar
Bill Wohler committed
1102 1103
  (mh-show-xface)
  (mh-show-addr)
Bill Wohler's avatar
Bill Wohler committed
1104 1105
  (setq buffer-invisibility-spec '((vanish . t) t))
  (set (make-local-variable 'line-move-ignore-invisible) t)
Bill Wohler's avatar
Bill Wohler committed
1106
  (make-local-variable 'font-lock-defaults)
Bill Wohler's avatar
Bill Wohler committed
1107
  ;;(set (make-local-variable 'font-lock-support-mode) nil)
Bill Wohler's avatar
Bill Wohler committed
1108 1109 1110 1111
  (cond
   ((equal mh-highlight-citation-p 'font-lock)
    (setq font-lock-defaults '(mh-show-font-lock-keywords-with-cite t)))
   ((equal mh-highlight-citation-p 'gnus)
Bill Wohler's avatar
Bill Wohler committed
1112 1113 1114 1115
    (setq font-lock-defaults '((mh-show-font-lock-keywords)
                               t nil nil nil
                               (font-lock-fontify-region-function
                                . mh-show-font-lock-fontify-region)))
Bill Wohler's avatar
Bill Wohler committed
1116 1117
    (mh-gnus-article-highlight-citation))
   (t
Bill Wohler's avatar
Bill Wohler committed
1118 1119
    (setq font-lock-defaults '(mh-show-font-lock-keywords t))))
  (if (and mh-xemacs-flag
Bill Wohler's avatar
Bill Wohler committed
1120
           font-lock-auto-fontify)
Bill Wohler's avatar
Bill Wohler committed
1121
      (turn-on-font-lock))
Bill Wohler's avatar
Bill Wohler committed
1122
  (set (make-local-variable 'tool-bar-map) mh-show-tool-bar-map)
Bill Wohler's avatar
Bill Wohler committed
1123
  (mh-funcall-if-exists mh-toolbar-init :show)
Bill Wohler's avatar
Bill Wohler committed
1124
  (when mh-decode-mime-flag
Bill Wohler's avatar
Bill Wohler committed
1125
    (mh-make-local