Mercurial > emacs

comparison lisp/mh-e/mh-utils.el @ 56673:e9a6cbc8ca5e

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Upgraded to MH-E version 7.4.80. See etc/MH-E-NEWS and lisp/mh-e/ChangeLog for details.
author Bill Wohler <wohler@newt.com>
date Sun, 15 Aug 2004 22:00:06 +0000
parents d36b00b98db0
children 4f4f410e6fe8 d8411455de48
comparison
equal deleted inserted replaced
56672:83ab2b01744a 56673:e9a6cbc8ca5e
31 31
32 ;;; Change Log: 32 ;;; Change Log:
33 33
34 ;;; Code: 34 ;;; Code:
35 35
36 ;; Is this XEmacs-land? Located here since needed by mh-customize.el. 36 (defvar recursive-load-depth-limit)
37 (defvar mh-xemacs-flag (featurep 'xemacs) 37 (eval-and-compile
38 "Non-nil means the current Emacs is XEmacs.") 38 (if (and (boundp 'recursive-load-depth-limit)
39 39 (integerp recursive-load-depth-limit)
40 ;; The Emacs coding conventions require that the cl package not be required at 40 (> 50 recursive-load-depth-limit))
41 ;; runtime. However, the cl package in versions of Emacs prior to 21.4 left cl 41 (setq recursive-load-depth-limit 50)))
42 ;; routines in their macro expansions. Use mh-require-cl to provide the cl 42
43 ;; routines in the best way possible. 43 (eval-when-compile (require 'mh-acros))
44 (eval-when-compile (require 'cl))
45 (defmacro mh-require-cl ()
46 (if (eq (car (macroexpand '(setf (gethash foo bar) baz))) 'cl-puthash)
47 `(require 'cl)
48 `(eval-when-compile (require 'cl))))
49
50 (mh-require-cl) 44 (mh-require-cl)
51 (require 'gnus-util) 45 (require 'gnus-util)
52 (require 'font-lock) 46 (require 'font-lock)
53 (require 'mouse) 47 (require 'mouse)
54 (load "tool-bar" t t) 48 (load "tool-bar" t t)
56 (require 'mh-customize) 50 (require 'mh-customize)
57 (require 'mh-inc) 51 (require 'mh-inc)
58 52
59 (load "mm-decode" t t) ; Non-fatal dependency 53 (load "mm-decode" t t) ; Non-fatal dependency
60 (load "mm-view" t t) ; Non-fatal dependency 54 (load "mm-view" t t) ; Non-fatal dependency
55 (load "vcard" t t) ; Non-fatal dependency
61 (load "hl-line" t t) ; Non-fatal dependency 56 (load "hl-line" t t) ; Non-fatal dependency
62 (load "executable" t t) ; Non-fatal dependency on 57 (load "executable" t t) ; Non-fatal dependency on
63 ; executable-find 58 ; executable-find
64 59
65 ;; Shush the byte-compiler 60 ;; Shush the byte-compiler
67 (defvar font-lock-defaults) 62 (defvar font-lock-defaults)
68 (defvar mark-active) 63 (defvar mark-active)
69 64
70 ;;; Autoloads 65 ;;; Autoloads
71 (autoload 'gnus-article-highlight-citation "gnus-cite") 66 (autoload 'gnus-article-highlight-citation "gnus-cite")
67 (autoload 'message-fetch-field "message")
68 (autoload 'message-tokenize-header "message")
72 (require 'sendmail) 69 (require 'sendmail)
73 (autoload 'Info-goto-node "info")
74 (unless (fboundp 'make-hash-table) 70 (unless (fboundp 'make-hash-table)
75 (autoload 'make-hash-table "cl")) 71 (autoload 'make-hash-table "cl"))
76
77 ;;; Set for local environment:
78 ;;; mh-progs and mh-lib used to be set in paths.el, which tried to
79 ;;; figure out at build time which of several possible directories MH
80 ;;; was installed into. But if you installed MH after building Emacs,
81 ;;; this would almost certainly be wrong, so now we do it at run time.
82
83 (defvar mh-progs nil
84 "Directory containing MH commands, such as inc, repl, and rmm.")
85
86 (defvar mh-lib nil
87 "Directory containing the MH library.
88 This directory contains, among other things, the components file.")
89
90 (defvar mh-lib-progs nil
91 "Directory containing MH helper programs.
92 This directory contains, among other things, the mhl program.")
93
94 (defvar mh-nmh-flag nil
95 "Non-nil means nmh is installed on this system instead of MH.")
96
97 (defvar mh-flists-present-flag nil
98 "Non-nil means that we have `flists'.")
99
100 ;;;###autoload
101 (put 'mh-progs 'risky-local-variable t)
102 ;;;###autoload
103 (put 'mh-lib 'risky-local-variable t)
104 ;;;###autoload
105 (put 'mh-lib-progs 'risky-local-variable t)
106 ;;;###autoload
107 (put 'mh-nmh-flag 'risky-local-variable t)
108 72
109 ;;; CL Replacements 73 ;;; CL Replacements
110 (defun mh-search-from-end (char string) 74 (defun mh-search-from-end (char string)
111 "Return the position of last occurrence of CHAR in STRING. 75 "Return the position of last occurrence of CHAR in STRING.
112 If CHAR is not present in STRING then return nil. The function is used in lieu 76 If CHAR is not present in STRING then return nil. The function is used in lieu
113 of `search' in the CL package." 77 of `search' in the CL package."
114 (loop for index from (1- (length string)) downto 0 78 (loop for index from (1- (length string)) downto 0
115 when (equal (aref string index) char) return index 79 when (equal (aref string index) char) return index
116 finally return nil)) 80 finally return nil))
117 81
118 ;;; Macros to generate correct code for different emacs variants
119
120 (defmacro mh-do-in-gnu-emacs (&rest body)
121 "Execute BODY if in GNU Emacs."
122 (unless mh-xemacs-flag `(progn ,@body)))
123 (put 'mh-do-in-gnu-emacs 'lisp-indent-hook 'defun)
124
125 (defmacro mh-do-in-xemacs (&rest body)
126 "Execute BODY if in GNU Emacs."
127 (when mh-xemacs-flag `(progn ,@body)))
128 (put 'mh-do-in-xemacs 'lisp-indent-hook 'defun)
129
130 (defmacro mh-funcall-if-exists (function &rest args)
131 "Call FUNCTION with ARGS as parameters if it exists."
132 (if (fboundp function)
133 `(funcall ',function ,@args)))
134
135 (defmacro mh-make-local-hook (hook)
136 "Make HOOK local if needed.
137 XEmacs and versions of GNU Emacs before 21.1 require `make-local-hook' to be
138 called."
139 (when (and (fboundp 'make-local-hook)
140 (not (get 'make-local-hook 'byte-obsolete-info)))
141 `(make-local-hook ,hook)))
142
143 (defmacro mh-mark-active-p (check-transient-mark-mode-flag)
144 "A macro that expands into appropriate code in XEmacs and nil in GNU Emacs.
145 In GNU Emacs if CHECK-TRANSIENT-MARK-MODE-FLAG is non-nil then check if
146 variable `transient-mark-mode' is active."
147 (cond (mh-xemacs-flag ;XEmacs
148 `(and (boundp 'zmacs-regions) zmacs-regions (region-active-p)))
149 ((not check-transient-mark-mode-flag) ;GNU Emacs
150 `(and (boundp 'mark-active) mark-active))
151 (t ;GNU Emacs
152 `(and (boundp 'transient-mark-mode) transient-mark-mode
153 (boundp 'mark-active) mark-active))))
154
155 ;;; Additional header fields that might someday be added: 82 ;;; Additional header fields that might someday be added:
156 ;;; "Sender: " "Reply-to: " 83 ;;; "Sender: " "Reply-to: "
157 84
85
86 ;;; Scan Line Formats
87
158 (defvar mh-scan-msg-number-regexp "^ *\\([0-9]+\\)" 88 (defvar mh-scan-msg-number-regexp "^ *\\([0-9]+\\)"
159 "Regexp to find the number of a message in a scan line. 89 "This regexp is used to extract the message number from a scan line.
160 The message's number must be surrounded with \\( \\)") 90 Note that the message number must be placed in a parenthesized expression as
91 in the default of \"^ *\\\\([0-9]+\\\\)\".")
161 92
162 (defvar mh-scan-msg-overflow-regexp "^[?0-9][0-9]" 93 (defvar mh-scan-msg-overflow-regexp "^[?0-9][0-9]"
163 "Regexp to find a scan line in which the message number overflowed. 94 "This regexp matches scan lines in which the message number overflowed.")
164 The message's number is left truncated in this case.")
165 95
166 (defvar mh-scan-msg-format-regexp "%\\([0-9]*\\)(msg)" 96 (defvar mh-scan-msg-format-regexp "%\\([0-9]*\\)(msg)"
167 "Regexp to find message number width in an scan format. 97 "This regexp is used to find the message number width in a scan format.
168 The message number width must be surrounded with \\( \\).") 98 Note that the message number must be placed in a parenthesized expression as
99 in the default of \"%\\\\([0-9]*\\\\)(msg)\".")
169 100
170 (defvar mh-scan-msg-format-string "%d" 101 (defvar mh-scan-msg-format-string "%d"
171 "Format string for width of the message number in a scan format. 102 "This is a format string for width of the message number in a scan format.
172 Use `0%d' for zero-filled message numbers.") 103 Use `0%d' for zero-filled message numbers.")
173 104
174 (defvar mh-scan-msg-search-regexp "^[^0-9]*%d[^0-9]" 105 (defvar mh-scan-msg-search-regexp "^[^0-9]*%d[^0-9]"
175 "Format string containing a regexp matching the scan listing for a message. 106 "This format string regexp matches the scan line for a particular message.
176 The desired message's number will be an argument to format.") 107 Use `%d' to represent the location of the message number within the
177 108 expression as in the default of \"^[^0-9]*%d[^0-9]\".")
178 (defvar mh-default-folder-for-message-function nil 109
179 "Function to select a default folder for refiling or Fcc. 110 (defvar mh-cmd-note 4
180 If set to a function, that function is called with no arguments by 111 "This is the number of characters to skip over before inserting notation.
181 `\\[mh-refile-msg]' and `\\[mh-to-fcc]' to get a default when 112 This variable should be set with the function `mh-set-cmd-note'. This variable
182 prompting the user for a folder. The function is called from within a 113 may be updated dynamically if `mh-adaptive-cmd-note-flag' is non-nil and
183 `save-excursion', with point at the start of the message. It should 114 `mh-scan-format-file' is t.")
184 return the folder to offer as the refile or Fcc folder, as a string 115 (make-variable-buffer-local 'mh-cmd-note)
185 with a leading `+' sign. It can also return an empty string to use no 116
186 default, or nil to calculate the default the usual way. 117 (defvar mh-note-seq ?%
187 NOTE: This variable is not an ordinary hook; 118 "Messages in a user-defined sequence are marked by this character.
188 It may not be a list of functions.") 119 Messages in the `search' sequence are marked by this character as well.")
120
121
189 122
190 (defvar mh-show-buffer-mode-line-buffer-id " {show-%s} %d" 123 (defvar mh-show-buffer-mode-line-buffer-id " {show-%s} %d"
191 "Format string to produce `mode-line-buffer-identification' for show buffers. 124 "Format string to produce `mode-line-buffer-identification' for show buffers.
192 First argument is folder name. Second is message number.") 125 First argument is folder name. Second is message number.")
193 126
194 (defvar mh-cmd-note 4 127
195 "Column to insert notation.
196 Use `mh-set-cmd-note' to modify it.
197 This value may be dynamically updated if `mh-adaptive-cmd-note-flag' is
198 non-nil and `mh-scan-format-file' is t.
199 Note that the first column is column number 0.")
200 (make-variable-buffer-local 'mh-cmd-note)
201
202 (defvar mh-note-seq "%"
203 "String whose first character is used to notate messages in a sequence.")
204 128
205 (defvar mh-mail-header-separator "--------" 129 (defvar mh-mail-header-separator "--------"
206 "*Line used by MH to separate headers from text in messages being composed. 130 "*Line used by MH to separate headers from text in messages being composed.
207 This variable should not be used directly in programs. Programs should use 131 This variable should not be used directly in programs. Programs should use
208 `mail-header-separator' instead. `mail-header-separator' is initialized to 132 `mail-header-separator' instead. `mail-header-separator' is initialized to
211 135
212 Do not make this a regexp as it may be the argument to `insert' and it is 136 Do not make this a regexp as it may be the argument to `insert' and it is
213 passed through `regexp-quote' before being used by functions like 137 passed through `regexp-quote' before being used by functions like
214 `re-search-forward'.") 138 `re-search-forward'.")
215 139
140 (defvar mh-signature-separator-regexp "^-- $"
141 "Regexp used to find signature separator.
142 See `mh-signature-separator'.")
143
144 (defvar mh-signature-separator "-- \n"
145 "Text of a signature separator.
146 A signature separator is used to separate the body of a message from the
147 signature. This can be used by user agents such as MH-E to render the
148 signature differently or to suppress the inclusion of the signature in a
149 reply.
150 Use `mh-signature-separator-regexp' when searching for a separator.")
151
152 (defun mh-signature-separator-p ()
153 "Return non-nil if buffer includes \"^-- $\"."
154 (save-excursion
155 (goto-char (point-min))
156 (re-search-forward mh-signature-separator-regexp nil t)))
157
216 ;; Variables for MIME display 158 ;; Variables for MIME display
217 159
218 ;; Structure to keep track of MIME handles on a per buffer basis. 160 ;; Structure to keep track of MIME handles on a per buffer basis.
219 (defstruct (mh-buffer-data (:conc-name mh-mime-) 161 (mh-defstruct (mh-buffer-data (:conc-name mh-mime-)
220 (:constructor mh-make-buffer-data)) 162 (:constructor mh-make-buffer-data))
221 (handles ()) ; List of MIME handles 163 (handles ()) ; List of MIME handles
222 (handles-cache (make-hash-table)) ; Cache to avoid multiple decodes of 164 (handles-cache (make-hash-table)) ; Cache to avoid multiple decodes of
223 ; nested messages 165 ; nested messages
224 (parts-count 0) ; The button number is generated from 166 (parts-count 0) ; The button number is generated from
225 ; this number 167 ; this number
329 (defvar mh-address-mail-regexp 271 (defvar mh-address-mail-regexp
330 "[-a-zA-Z0-9._]+@\\([-a-zA-z0-9_]+\\.\\)+[a-zA-Z0-9]+" 272 "[-a-zA-Z0-9._]+@\\([-a-zA-z0-9_]+\\.\\)+[a-zA-Z0-9]+"
331 "A regular expression probably matching an e-mail address.") 273 "A regular expression probably matching an e-mail address.")
332 274
333 ;; From goto-addr.el, which we don't want to force-load on users. 275 ;; From goto-addr.el, which we don't want to force-load on users.
334 ;;;###mh-autoload 276
335 (defun mh-goto-address-find-address-at-point () 277 (defun mh-goto-address-find-address-at-point ()
336 "Find e-mail address around or before point. 278 "Find e-mail address around or before point.
337 Then search backwards to beginning of line for the start of an e-mail 279 Then search backwards to beginning of line for the start of an e-mail
338 address. If no e-mail address found, return nil." 280 address. If no e-mail address found, return nil."
339 (re-search-backward "[^-_A-z0-9.@]" (line-beginning-position) 'lim) 281 (re-search-backward "[^-_A-z0-9.@]" (line-beginning-position) 'lim)
346 (defun mh-mail-header-end () 288 (defun mh-mail-header-end ()
347 "Substitute for `mail-header-end' that doesn't widen the buffer. 289 "Substitute for `mail-header-end' that doesn't widen the buffer.
348 In MH-E we frequently need to find the end of headers in nested messages, where 290 In MH-E we frequently need to find the end of headers in nested messages, where
349 the buffer has been narrowed. This function works in this situation." 291 the buffer has been narrowed. This function works in this situation."
350 (save-excursion 292 (save-excursion
351 (rfc822-goto-eoh) 293 ;; XXX: The following replaces a call to rfc822-goto-eoh. Occasionally,
294 ;; mail headers that MH-E has to read contains lines of the form:
295 ;; From xxx@yyy Mon May 10 11:48:07 2004
296 ;; In this situation, rfc822-goto-eoh doesn't go to the end of the
297 ;; header. The replacement allows From_ lines in the mail header.
298 (goto-char (point-min))
299 (loop for p = (re-search-forward
300 "^\\([:\n]\\|[^: \t\n]+[ \t\n]\\)" nil 'move)
301 do (cond ((null p) (return))
302 (t (goto-char (match-beginning 0))
303 (unless (looking-at "From ") (return))
304 (goto-char p))))
352 (point))) 305 (point)))
353 306
354 (defun mh-in-header-p () 307 (defun mh-in-header-p ()
355 "Return non-nil if the point is in the header of a draft message." 308 "Return non-nil if the point is in the header of a draft message."
356 (< (point) (mh-mail-header-end))) 309 (< (point) (mh-mail-header-end)))
526 479
527 ;; The names of ephemeral buffers have a " *mh-" prefix (so that they are 480 ;; The names of ephemeral buffers have a " *mh-" prefix (so that they are
528 ;; hidden and can be programmatically removed in mh-quit), and the variable 481 ;; hidden and can be programmatically removed in mh-quit), and the variable
529 ;; names have the form mh-temp-.*-buffer. 482 ;; names have the form mh-temp-.*-buffer.
530 (defconst mh-temp-buffer " *mh-temp*") ;scratch 483 (defconst mh-temp-buffer " *mh-temp*") ;scratch
484 (defconst mh-temp-fetch-buffer " *mh-fetch*") ;wget/curl/fetch output
531 485
532 ;; The names of MH-E buffers that are not ephemeral and can be used by the 486 ;; The names of MH-E buffers that are not ephemeral and can be used by the
533 ;; user (and deleted by the user when no longer needed) have a "*MH-E " prefix 487 ;; user (and deleted by the user when no longer needed) have a "*MH-E " prefix
534 ;; (so they can be programmatically removed in mh-quit), and the variable 488 ;; (so they can be programmatically removed in mh-quit), and the variable
535 ;; names have the form mh-.*-buffer. 489 ;; names have the form mh-.*-buffer.
490 (defconst mh-aliases-buffer "*MH-E Aliases*") ;alias lookups
536 (defconst mh-folders-buffer "*MH-E Folders*") ;folder list 491 (defconst mh-folders-buffer "*MH-E Folders*") ;folder list
492 (defconst mh-help-buffer "*MH-E Help*") ;quick help
537 (defconst mh-info-buffer "*MH-E Info*") ;version information buffer 493 (defconst mh-info-buffer "*MH-E Info*") ;version information buffer
538 (defconst mh-log-buffer "*MH-E Log*") ;output of MH commands and so on 494 (defconst mh-log-buffer "*MH-E Log*") ;output of MH commands and so on
495 (defconst mh-mail-delivery-buffer "*MH-E Mail Delivery*") ;mail delivery log
539 (defconst mh-recipients-buffer "*MH-E Recipients*") ;killed when draft sent 496 (defconst mh-recipients-buffer "*MH-E Recipients*") ;killed when draft sent
540 (defconst mh-sequences-buffer "*MH-E Sequences*") ;sequences list 497 (defconst mh-sequences-buffer "*MH-E Sequences*") ;sequences list
541 (defconst mh-mail-delivery-buffer "*MH-E Mail Delivery*") ;mail delivery log
542 498
543 ;; Number of lines to keep in mh-log-buffer. 499 ;; Number of lines to keep in mh-log-buffer.
544 (defvar mh-log-buffer-lines 100) 500 (defvar mh-log-buffer-lines 100)
545 501
546 ;; Window configuration before MH-E command. 502 ;; Window configuration before MH-E command.
591 (if mh-modeline-glyph 547 (if mh-modeline-glyph
592 (cons modeline-buffer-id-left-extent mh-modeline-glyph) 548 (cons modeline-buffer-id-left-extent mh-modeline-glyph)
593 (cons modeline-buffer-id-left-extent "XEmacs%N:")) 549 (cons modeline-buffer-id-left-extent "XEmacs%N:"))
594 (cons modeline-buffer-id-right-extent " %17b"))))) 550 (cons modeline-buffer-id-right-extent " %17b")))))
595 551
596
597 ;;; This holds a documentation string used by describe-mode. 552 ;;; This holds a documentation string used by describe-mode.
598 (defun mh-showing-mode (&optional arg) 553 (defun mh-showing-mode (&optional arg)
599 "Change whether messages should be displayed. 554 "Change whether messages should be displayed.
600 With arg, display messages iff ARG is positive." 555 With arg, display messages iff ARG is positive."
601 (setq mh-showing-mode 556 (setq mh-showing-mode
611 566
612 ;; If non-nil, show buffer contains message with all headers. 567 ;; If non-nil, show buffer contains message with all headers.
613 ;; If nil, show buffer contains message processed normally. 568 ;; If nil, show buffer contains message processed normally.
614 ;; Showing message with headers or normally. 569 ;; Showing message with headers or normally.
615 (defvar mh-showing-with-headers nil) 570 (defvar mh-showing-with-headers nil)
616
617 571
618 ;;; MH-E macros 572 ;;; MH-E macros
619 573
620 (defmacro with-mh-folder-updating (save-modification-flag &rest body) 574 (defmacro with-mh-folder-updating (save-modification-flag &rest body)
621 "Format is (with-mh-folder-updating (SAVE-MODIFICATION-FLAG) &body BODY). 575 "Format is (with-mh-folder-updating (SAVE-MODIFICATION-FLAG) &body BODY).
740 (error "Flushing changes not confirmed")) 694 (error "Flushing changes not confirmed"))
741 (clear-visited-file-modtime) 695 (clear-visited-file-modtime)
742 (unlock-buffer) 696 (unlock-buffer)
743 (setq buffer-file-name nil)) 697 (setq buffer-file-name nil))
744 698
745 ;;;###mh-autoload 699
746 (defun mh-get-msg-num (error-if-no-message) 700 (defun mh-get-msg-num (error-if-no-message)
747 "Return the message number of the displayed message. 701 "Return the message number of the displayed message.
748 If the argument ERROR-IF-NO-MESSAGE is non-nil, then complain if the cursor is 702 If the argument ERROR-IF-NO-MESSAGE is non-nil, then complain if the cursor is
749 not pointing to a message." 703 not pointing to a message."
750 (save-excursion 704 (save-excursion
913 (mh-defun-show-buffer mh-show-junk-whitelist mh-junk-whitelist) 867 (mh-defun-show-buffer mh-show-junk-whitelist mh-junk-whitelist)
914 (mh-defun-show-buffer mh-show-index-new-messages mh-index-new-messages) 868 (mh-defun-show-buffer mh-show-index-new-messages mh-index-new-messages)
915 (mh-defun-show-buffer mh-show-index-ticked-messages mh-index-ticked-messages) 869 (mh-defun-show-buffer mh-show-index-ticked-messages mh-index-ticked-messages)
916 (mh-defun-show-buffer mh-show-index-sequenced-messages 870 (mh-defun-show-buffer mh-show-index-sequenced-messages
917 mh-index-sequenced-messages) 871 mh-index-sequenced-messages)
872 (mh-defun-show-buffer mh-show-catchup mh-catchup)
873 (mh-defun-show-buffer mh-show-ps-print-toggle-mime mh-ps-print-toggle-mime)
874 (mh-defun-show-buffer mh-show-ps-print-toggle-color mh-ps-print-toggle-color)
875 (mh-defun-show-buffer mh-show-ps-print-toggle-faces mh-ps-print-toggle-faces)
876 (mh-defun-show-buffer mh-show-ps-print-msg-file mh-ps-print-msg-file)
877 (mh-defun-show-buffer mh-show-ps-print-msg mh-ps-print-msg)
878 (mh-defun-show-buffer mh-show-ps-print-msg-show mh-ps-print-msg-show)
879 (mh-defun-show-buffer mh-show-toggle-mime-buttons mh-toggle-mime-buttons)
880 (mh-defun-show-buffer mh-show-display-with-external-viewer
881 mh-display-with-external-viewer)
918 882
919 ;;; Populate mh-show-mode-map 883 ;;; Populate mh-show-mode-map
920 (gnus-define-keys mh-show-mode-map 884 (gnus-define-keys mh-show-mode-map
921 " " mh-show-page-msg 885 " " mh-show-page-msg
922 "!" mh-show-refile-or-write-again 886 "!" mh-show-refile-or-write-again
939 "e" mh-show-edit-again 903 "e" mh-show-edit-again
940 "f" mh-show-forward 904 "f" mh-show-forward
941 "g" mh-show-goto-msg 905 "g" mh-show-goto-msg
942 "i" mh-show-inc-folder 906 "i" mh-show-inc-folder
943 "k" mh-show-delete-subject-or-thread 907 "k" mh-show-delete-subject-or-thread
944 "l" mh-show-print-msg
945 "m" mh-show-send 908 "m" mh-show-send
946 "n" mh-show-next-undeleted-msg 909 "n" mh-show-next-undeleted-msg
947 "\M-n" mh-show-next-unread-msg 910 "\M-n" mh-show-next-unread-msg
948 "o" mh-show-refile-msg 911 "o" mh-show-refile-msg
949 "p" mh-show-previous-undeleted-msg 912 "p" mh-show-previous-undeleted-msg
959 922
960 (gnus-define-keys (mh-show-folder-map "F" mh-show-mode-map) 923 (gnus-define-keys (mh-show-folder-map "F" mh-show-mode-map)
961 "?" mh-prefix-help 924 "?" mh-prefix-help
962 "'" mh-index-ticked-messages 925 "'" mh-index-ticked-messages
963 "S" mh-show-sort-folder 926 "S" mh-show-sort-folder
927 "c" mh-show-catchup
964 "f" mh-show-visit-folder 928 "f" mh-show-visit-folder
965 "i" mh-index-search 929 "i" mh-index-search
966 "k" mh-show-kill-folder 930 "k" mh-show-kill-folder
967 "l" mh-show-list-folders 931 "l" mh-show-list-folders
968 "n" mh-index-new-messages 932 "n" mh-index-new-messages
990 (gnus-define-keys (mh-show-junk-map "J" mh-show-mode-map) 954 (gnus-define-keys (mh-show-junk-map "J" mh-show-mode-map)
991 "?" mh-prefix-help 955 "?" mh-prefix-help
992 "b" mh-show-junk-blacklist 956 "b" mh-show-junk-blacklist
993 "w" mh-show-junk-whitelist) 957 "w" mh-show-junk-whitelist)
994 958
959 (gnus-define-keys (mh-show-ps-print-map "P" mh-show-mode-map)
960 "?" mh-prefix-help
961 "A" mh-show-ps-print-toggle-mime
962 "C" mh-show-ps-print-toggle-color
963 "F" mh-show-ps-print-toggle-faces
964 "M" mh-show-ps-print-toggle-mime
965 "f" mh-show-ps-print-msg-file
966 "l" mh-show-print-msg
967 "p" mh-show-ps-print-msg
968 "s" mh-show-ps-print-msg-show)
969
995 (gnus-define-keys (mh-show-thread-map "T" mh-show-mode-map) 970 (gnus-define-keys (mh-show-thread-map "T" mh-show-mode-map)
996 "?" mh-prefix-help 971 "?" mh-prefix-help
997 "u" mh-show-thread-ancestor 972 "u" mh-show-thread-ancestor
998 "p" mh-show-thread-previous-sibling 973 "p" mh-show-thread-previous-sibling
999 "n" mh-show-thread-next-sibling 974 "n" mh-show-thread-next-sibling
1024 "b" mh-show-burst-digest) 999 "b" mh-show-burst-digest)
1025 1000
1026 (gnus-define-keys (mh-show-mime-map "K" mh-show-mode-map) 1001 (gnus-define-keys (mh-show-mime-map "K" mh-show-mode-map)
1027 "?" mh-prefix-help 1002 "?" mh-prefix-help
1028 "a" mh-mime-save-parts 1003 "a" mh-mime-save-parts
1004 "e" mh-show-display-with-external-viewer
1029 "v" mh-show-toggle-mime-part 1005 "v" mh-show-toggle-mime-part
1030 "o" mh-show-save-mime-part 1006 "o" mh-show-save-mime-part
1031 "i" mh-show-inline-mime-part 1007 "i" mh-show-inline-mime-part
1008 "t" mh-show-toggle-mime-buttons
1032 "\t" mh-show-next-button 1009 "\t" mh-show-next-button
1033 [backtab] mh-show-prev-button 1010 [backtab] mh-show-prev-button
1034 "\M-\t" mh-show-prev-button) 1011 "\M-\t" mh-show-prev-button)
1035 1012
1036 (easy-menu-define 1013 (easy-menu-define
1113 (defvar tool-bar-map)) 1090 (defvar tool-bar-map))
1114 1091
1115 (define-derived-mode mh-show-mode text-mode "MH-Show" 1092 (define-derived-mode mh-show-mode text-mode "MH-Show"
1116 "Major mode for showing messages in MH-E.\\<mh-show-mode-map> 1093 "Major mode for showing messages in MH-E.\\<mh-show-mode-map>
1117 The value of `mh-show-mode-hook' is a list of functions to 1094 The value of `mh-show-mode-hook' is a list of functions to
1118 be called, with no arguments, upon entry to this mode." 1095 be called, with no arguments, upon entry to this mode.
1096 See also `mh-folder-mode'.
1097
1098 \\{mh-show-mode-map}"
1119 (set (make-local-variable 'mail-header-separator) mh-mail-header-separator) 1099 (set (make-local-variable 'mail-header-separator) mh-mail-header-separator)
1120 (setq paragraph-start (default-value 'paragraph-start)) 1100 (setq paragraph-start (default-value 'paragraph-start))
1121 (mh-show-unquote-From) 1101 (mh-show-unquote-From)
1122 (mh-show-xface) 1102 (mh-show-xface)
1123 (mh-show-addr) 1103 (mh-show-addr)
1208 (insert "P4\n48 48\n"))) 1188 (insert "P4\n48 48\n")))
1209 1189
1210 (mh-do-in-xemacs (defvar default-enable-multibyte-characters)) 1190 (mh-do-in-xemacs (defvar default-enable-multibyte-characters))
1211 1191
1212 (defun mh-face-display-function () 1192 (defun mh-face-display-function ()
1213 "Display a Face or X-Face header field. 1193 "Display a Face, X-Face, or X-Image-URL header field.
1214 Display Face if both are present." 1194 If more than one of these are present, then the first one found in this order
1195 is used."
1215 (save-restriction 1196 (save-restriction
1216 (goto-char (point-min)) 1197 (goto-char (point-min))
1217 (re-search-forward "\n\n" (point-max) t) 1198 (re-search-forward "\n\n" (point-max) t)
1218 (narrow-to-region (point-min) (point)) 1199 (narrow-to-region (point-min) (point))
1219 (let* ((case-fold-search t) 1200 (let* ((case-fold-search t)
1224 raw type) 1205 raw type)
1225 (cond (face (setq raw (mh-face-to-png face) 1206 (cond (face (setq raw (mh-face-to-png face)
1226 type 'png)) 1207 type 'png))
1227 (x-face (setq raw (mh-uncompface x-face) 1208 (x-face (setq raw (mh-uncompface x-face)
1228 type 'pbm)) 1209 type 'pbm))
1229 (url (setq type 'url))) 1210 (url (setq type 'url))
1211 (t (multiple-value-setq (type raw) (mh-picon-get-image))))
1230 (when type 1212 (when type
1231 (goto-char (point-min)) 1213 (goto-char (point-min))
1232 (when (re-search-forward "^from:" (point-max) t) 1214 (when (re-search-forward "^from:" (point-max) t)
1233 ;; GNU Emacs 1215 ;; GNU Emacs
1234 (mh-do-in-gnu-emacs 1216 (mh-do-in-gnu-emacs
1259 'mh-show-xface-face)) 1241 'mh-show-xface-face))
1260 ;; Otherwise try external support with x-face... 1242 ;; Otherwise try external support with x-face...
1261 ((and (eq type 'pbm) 1243 ((and (eq type 'pbm)
1262 (fboundp 'x-face-xmas-wl-display-x-face) 1244 (fboundp 'x-face-xmas-wl-display-x-face)
1263 (fboundp 'executable-find) (executable-find "uncompface")) 1245 (fboundp 'executable-find) (executable-find "uncompface"))
1264 (mh-funcall-if-exists x-face-xmas-wl-display-x-face))) 1246 (mh-funcall-if-exists x-face-xmas-wl-display-x-face))
1247 ;; Picon display
1248 ((and raw (member type '(xpm xbm gif)))
1249 (when (featurep type)
1250 (set-extent-begin-glyph
1251 (make-extent (point) (point))
1252 (make-glyph (vector type ':data raw))))))
1265 (when raw (insert " ")))))))) 1253 (when raw (insert " "))))))))
1266
1267 1254
1268 (defun mh-show-xface () 1255 (defun mh-show-xface ()
1269 "Display X-Face." 1256 "Display X-Face."
1270 (when (and window-system mh-show-use-xface-flag 1257 (when (and window-system mh-show-use-xface-flag
1271 (or mh-decode-mime-flag mhl-formfile 1258 (or mh-decode-mime-flag mhl-formfile
1272 mh-clean-message-header-flag)) 1259 mh-clean-message-header-flag))
1273 (funcall mh-show-xface-function))) 1260 (funcall mh-show-xface-function)))
1274 1261
1275 1262
1276 1263
1264 ;; Picon display
1265
1266 ;;; XXX: This should be customizable. As a side-effect of setting this
1267 ;;; variable, arrange to reset mh-picon-existing-directory-list to 'unset.
1268 (defvar mh-picon-directory-list
1269 '("~/.picons" "~/.picons/users" "~/.picons/usenix" "~/.picons/news"
1270 "~/.picons/domains" "~/.picons/misc"
1271 "/usr/share/picons/" "/usr/share/picons/users" "/usr/share/picons/usenix"
1272 "/usr/share/picons/news" "/usr/share/picons/domains"
1273 "/usr/share/picons/misc")
1274 "List of directories where picons reside.
1275 The directories are searched for in the order they appear in the list.")
1276
1277 (defvar mh-picon-existing-directory-list 'unset
1278 "List of directories to search in.")
1279
1280 (defvar mh-picon-cache (make-hash-table :test #'equal))
1281
1282 (defvar mh-picon-image-types
1283 (loop for type in '(xpm xbm gif)
1284 when (or (mh-do-in-gnu-emacs
1285 (ignore-errors
1286 (mh-funcall-if-exists image-type-available-p type)))
1287 (mh-do-in-xemacs (featurep type)))
1288 collect type))
1289
1290 (defun mh-picon-set-directory-list ()
1291 "Update `mh-picon-existing-directory-list' if needed."
1292 (when (eq mh-picon-existing-directory-list 'unset)
1293 (setq mh-picon-existing-directory-list
1294 (loop for x in mh-picon-directory-list
1295 when (file-directory-p x) collect x))))
1296
1297 (defun* mh-picon-get-image ()
1298 "Find the best possible match and return contents."
1299 (mh-picon-set-directory-list)
1300 (save-restriction
1301 (let* ((from-field (ignore-errors (car (message-tokenize-header
1302 (mh-get-header-field "from:")))))
1303 (from (car (ignore-errors
1304 (mh-funcall-if-exists ietf-drums-parse-address
1305 from-field))))
1306 (host (and from
1307 (string-match "\\([^+]*\\)\\(+.*\\)?@\\(.*\\)" from)
1308 (downcase (match-string 3 from))))
1309 (user (and host (downcase (match-string 1 from))))
1310 (canonical-address (format "%s@%s" user host))
1311 (cached-value (gethash canonical-address mh-picon-cache))
1312 (host-list (and host (delete "" (split-string host "\\."))))
1313 (match nil))
1314 (cond (cached-value (return-from mh-picon-get-image cached-value))
1315 ((not host-list) (return-from mh-picon-get-image nil)))
1316 (setq match
1317 (block 'loop
1318 ;; u@h search
1319 (loop for dir in mh-picon-existing-directory-list
1320 do (loop for type in mh-picon-image-types
1321 ;; [path]user@host
1322 for file1 = (format "%s/%s.%s"
1323 dir canonical-address type)
1324 when (file-exists-p file1)
1325 do (return-from 'loop file1)
1326 ;; [path]user
1327 for file2 = (format "%s/%s.%s" dir user type)
1328 when (file-exists-p file2)
1329 do (return-from 'loop file2)
1330 ;; [path]host
1331 for file3 = (format "%s/%s.%s" dir host type)
1332 when (file-exists-p file3)
1333 do (return-from 'loop file3)))
1334 ;; facedb search
1335 ;; Search order for user@foo.net:
1336 ;; [path]net/foo/user
1337 ;; [path]net/foo/user/face
1338 ;; [path]net/user
1339 ;; [path]net/user/face
1340 ;; [path]net/foo/unknown
1341 ;; [path]net/foo/unknown/face
1342 ;; [path]net/unknown
1343 ;; [path]net/unknown/face
1344 (loop for u in (list user "unknown")
1345 do (loop for dir in mh-picon-existing-directory-list
1346 do (loop for x on host-list by #'cdr
1347 for y = (mh-picon-generate-path x u dir)
1348 do (loop for type in mh-picon-image-types
1349 for z1 = (format "%s.%s" y type)
1350 when (file-exists-p z1)
1351 do (return-from 'loop z1)
1352 for z2 = (format "%s/face.%s"
1353 y type)
1354 when (file-exists-p z2)
1355 do (return-from 'loop z2)))))))
1356 (setf (gethash canonical-address mh-picon-cache)
1357 (mh-picon-file-contents match)))))
1358
1359 (defun mh-picon-file-contents (file)
1360 "Return details about FILE.
1361 A list of consisting of a symbol for the type of the file and the file
1362 contents as a string is returned. If FILE is nil, then both elements of the
1363 list are nil."
1364 (if (stringp file)
1365 (with-temp-buffer
1366 (let ((type (and (string-match ".*\\.\\(...\\)$" file)
1367 (intern (match-string 1 file)))))
1368 (insert-file-contents-literally file)
1369 (values type (buffer-string))))
1370 (values nil nil)))
1371
1372 (defun mh-picon-generate-path (host-list user directory)
1373 "Generate the image file path.
1374 HOST-LIST is the parsed host address of the email address, USER the username
1375 and DIRECTORY is the directory relative to which the path is generated."
1376 (loop with acc = ""
1377 for elem in host-list
1378 do (setq acc (format "%s/%s" elem acc))
1379 finally return (format "%s/%s%s" directory acc user)))
1380
1381
1382
1277 ;; X-Image-URL display 1383 ;; X-Image-URL display
1278 1384
1279 (defvar mh-x-image-cache-directory nil 1385 (defvar mh-x-image-cache-directory nil
1280 "Directory where X-Image-URL images are cached.") 1386 "Directory where X-Image-URL images are cached.")
1281 1387 (defvar mh-x-image-scaling-function
1282 (defvar mh-convert-executable (executable-find "convert")) 1388 (cond ((executable-find "convert")
1283 (defvar mh-wget-executable (executable-find "wget")) 1389 'mh-x-image-scale-with-convert)
1390 ((and (executable-find "anytopnm") (executable-find "pnmscale")
1391 (executable-find "pnmtopng"))
1392 'mh-x-image-scale-with-pnm)
1393 (t 'ignore))
1394 "Function to use to scale image to proper size.")
1395 (defvar mh-wget-executable nil)
1396 (defvar mh-wget-choice
1397 (or (and (setq mh-wget-executable (executable-find "wget")) 'wget)
1398 (and (setq mh-wget-executable (executable-find "fetch")) 'fetch)
1399 (and (setq mh-wget-executable (executable-find "curl")) 'curl)))
1400 (defvar mh-wget-option
1401 (cdr (assoc mh-wget-choice '((curl . "-o") (fetch . "-o") (wget . "-O")))))
1284 (defvar mh-x-image-temp-file nil) 1402 (defvar mh-x-image-temp-file nil)
1285 (defvar mh-x-image-url nil) 1403 (defvar mh-x-image-url nil)
1286 (defvar mh-x-image-marker nil) 1404 (defvar mh-x-image-marker nil)
1287 (defvar mh-x-image-url-cache-file nil) 1405 (defvar mh-x-image-url-cache-file nil)
1288 1406
1407 ;; Functions to scale image to proper size
1408 (defun mh-x-image-scale-with-pnm (input output)
1409 "Scale image in INPUT file and write to OUTPUT file using pnm tools."
1410 (let ((res (shell-command-to-string
1411 (format "anytopnm < %s | pnmscale -xysize 96 48 | pnmtopng > %s"
1412 input output))))
1413 (unless (equal res "")
1414 (delete-file output))))
1415
1416 (defun mh-x-image-scale-with-convert (input output)
1417 "Scale image in INPUT file and write to OUTPUT file using ImageMagick."
1418 (call-process "convert" nil nil nil "-geometry" "96x48" input output))
1419
1289 (defun mh-x-image-url-cache-canonicalize (url) 1420 (defun mh-x-image-url-cache-canonicalize (url)
1290 "Canonicalize URL. 1421 "Canonicalize URL.
1291 Replace the ?/ character with a ?! character." 1422 Replace the ?/ character with a ?! character and append .png."
1292 (with-temp-buffer 1423 (format "%s/%s.png" mh-x-image-cache-directory
1293 (insert url) 1424 (with-temp-buffer
1294 (goto-char (point-min)) 1425 (insert url)
1295 (while (search-forward "/" nil t) (replace-match "!")) 1426 (mh-replace-string "/" "!")
1296 (format "%s/%s.png" mh-x-image-cache-directory (buffer-string)))) 1427 (buffer-string))))
1428
1429 (defun mh-x-image-set-download-state (file data)
1430 "Setup a symbolic link from FILE to DATA."
1431 (if data
1432 (make-symbolic-link (symbol-name data) file t)
1433 (delete-file file)))
1434
1435 (defun mh-x-image-get-download-state (file)
1436 "Check the state of FILE by following any symbolic links."
1437 (unless (file-exists-p mh-x-image-cache-directory)
1438 (call-process "mkdir" nil nil nil mh-x-image-cache-directory))
1439 (cond ((file-symlink-p file)
1440 (intern (file-name-nondirectory (file-chase-links file))))
1441 ((not (file-exists-p file)) nil)
1442 (t 'ok)))
1297 1443
1298 (defun mh-x-image-url-fetch-image (url cache-file marker sentinel) 1444 (defun mh-x-image-url-fetch-image (url cache-file marker sentinel)
1299 "Fetch and display the image specified by URL. 1445 "Fetch and display the image specified by URL.
1300 After the image is fetched, it is stored in CACHE-FILE. It will be displayed 1446 After the image is fetched, it is stored in CACHE-FILE. It will be displayed
1301 in a buffer and position specified by MARKER. The actual display is carried 1447 in a buffer and position specified by MARKER. The actual display is carried
1302 out by the SENTINEL function." 1448 out by the SENTINEL function."
1303 (if (and mh-wget-executable 1449 (if mh-wget-executable
1304 mh-fetch-x-image-url 1450 (let ((buffer (get-buffer-create (generate-new-buffer-name
1305 (or (eq mh-fetch-x-image-url t) 1451 mh-temp-fetch-buffer)))
1306 (y-or-n-p (format "Fetch %s? " url)))) 1452 (filename (or (mh-funcall-if-exists make-temp-file "mhe-fetch")
1307 (let ((buffer (get-buffer-create (generate-new-buffer-name " *mh-url*"))) 1453 (expand-file-name (make-temp-name "~/mhe-fetch")))))
1308 (filename (make-temp-name "/tmp/mhe-wget")))
1309 (save-excursion 1454 (save-excursion
1310 (set-buffer buffer) 1455 (set-buffer buffer)
1311 (set (make-local-variable 'mh-x-image-url-cache-file) cache-file) 1456 (set (make-local-variable 'mh-x-image-url-cache-file) cache-file)
1312 (set (make-local-variable 'mh-x-image-marker) marker) 1457 (set (make-local-variable 'mh-x-image-marker) marker)
1313 (set (make-local-variable 'mh-x-image-temp-file) filename)) 1458 (set (make-local-variable 'mh-x-image-temp-file) filename))
1314 (set-process-sentinel 1459 (set-process-sentinel
1315 (start-process "*wget*" buffer mh-wget-executable "-O" filename url) 1460 (start-process "*mh-x-image-url-fetch*" buffer
1461 mh-wget-executable mh-wget-option filename url)
1316 sentinel)) 1462 sentinel))
1317 ;; Make sure we don't ask about this image again 1463 ;; Temporary failure
1318 (when (and mh-wget-executable (eq mh-fetch-x-image-url 'ask)) 1464 (mh-x-image-set-download-state cache-file 'try-again)))
1319 (make-symbolic-link mh-x-image-cache-directory cache-file t))))
1320 1465
1321 (defun mh-x-image-display (image marker) 1466 (defun mh-x-image-display (image marker)
1322 "Display IMAGE at MARKER." 1467 "Display IMAGE at MARKER."
1323 (save-excursion 1468 (save-excursion
1324 (set-buffer (marker-buffer marker)) 1469 (set-buffer (marker-buffer marker))
1325 (let ((buffer-read-only nil) 1470 (let ((buffer-read-only nil)
1326 (default-enable-multibyte-characters nil) 1471 (default-enable-multibyte-characters nil)
1327 (buffer-modified-flag (buffer-modified-p))) 1472 (buffer-modified-flag (buffer-modified-p)))
1328 (unwind-protect 1473 (unwind-protect
1329 (when (and (file-readable-p image) (not (file-symlink-p image))) 1474 (when (and (file-readable-p image) (not (file-symlink-p image))
1475 (eq marker mh-x-image-marker))
1330 (goto-char marker) 1476 (goto-char marker)
1331 (mh-do-in-gnu-emacs 1477 (mh-do-in-gnu-emacs
1332 (mh-funcall-if-exists insert-image (create-image image 'png))) 1478 (mh-funcall-if-exists insert-image (create-image image 'png)))
1333 (mh-do-in-xemacs 1479 (mh-do-in-xemacs
1334 (when (featurep 'png) 1480 (when (featurep 'png)
1348 (save-excursion 1494 (save-excursion
1349 (set-buffer (setq wget-buffer (process-buffer process))) 1495 (set-buffer (setq wget-buffer (process-buffer process)))
1350 (setq marker mh-x-image-marker 1496 (setq marker mh-x-image-marker
1351 cache-filename mh-x-image-url-cache-file 1497 cache-filename mh-x-image-url-cache-file
1352 temp-file mh-x-image-temp-file)) 1498 temp-file mh-x-image-temp-file))
1353 (when mh-convert-executable 1499 (cond
1354 (call-process mh-convert-executable nil nil nil "-resize" "96x48" 1500 ;; Check if we have `convert'
1355 temp-file cache-filename)) 1501 ((eq mh-x-image-scaling-function 'ignore)
1356 (if (file-exists-p cache-filename) 1502 (message "The `convert' program is needed to display X-Image-URL")
1357 (mh-x-image-display cache-filename marker) 1503 (mh-x-image-set-download-state cache-filename 'try-again))
1358 (make-symbolic-link mh-x-image-cache-directory cache-filename t)) 1504 ;; Scale fetched image
1505 ((and (funcall mh-x-image-scaling-function temp-file cache-filename)
1506 nil))
1507 ;; Attempt to display image if we have it
1508 ((file-exists-p cache-filename)
1509 (mh-x-image-display cache-filename marker))
1510 ;; We didn't find the image. Should we try to display it the next time?
1511 (t (mh-x-image-set-download-state cache-filename 'try-again)))
1359 (ignore-errors 1512 (ignore-errors
1360 (set-marker marker nil) 1513 (set-marker marker nil)
1361 (delete-process process) 1514 (delete-process process)
1362 (kill-buffer wget-buffer) 1515 (kill-buffer wget-buffer)
1363 (delete-file temp-file))))) 1516 (delete-file temp-file)))))
1364 1517
1518 (defun mh-x-image-url-sane-p (url)
1519 "Check if URL is something sensible."
1520 (let ((len (length url)))
1521 (cond ((< len 5) nil)
1522 ((not (equal (substring url 0 5) "http:")) nil)
1523 ((> len 100) nil)
1524 (t t))))
1525
1365 (defun mh-x-image-url-display (url) 1526 (defun mh-x-image-url-display (url)
1366 "Display image from location URL. 1527 "Display image from location URL.
1367 If the URL isn't present in the cache then it is fetched with wget." 1528 If the URL isn't present in the cache then it is fetched with wget."
1368 (let ((cache-filename (mh-x-image-url-cache-canonicalize url)) 1529 (let* ((cache-filename (mh-x-image-url-cache-canonicalize url))
1369 (marker (set-marker (make-marker) (point)))) 1530 (state (mh-x-image-get-download-state cache-filename))
1370 (cond ((file-exists-p cache-filename) 1531 (marker (set-marker (make-marker) (point))))
1532 (set (make-local-variable 'mh-x-image-marker) marker)
1533 (cond ((not (mh-x-image-url-sane-p url)))
1534 ((eq state 'ok)
1371 (mh-x-image-display cache-filename marker)) 1535 (mh-x-image-display cache-filename marker))
1536 ((or (not mh-wget-executable)
1537 (eq mh-x-image-scaling-function 'ignore)))
1538 ((eq state 'never))
1372 ((not mh-fetch-x-image-url) 1539 ((not mh-fetch-x-image-url)
1373 (set-marker marker nil)) 1540 (set-marker marker nil))
1374 ((and (not (file-exists-p mh-x-image-cache-directory)) 1541 ((eq state 'try-again)
1375 (call-process "mkdir" nil nil nil mh-x-image-cache-directory) 1542 (mh-x-image-set-download-state cache-filename nil)
1376 nil)) 1543 (mh-x-image-url-fetch-image url cache-filename marker
1377 ((and (file-exists-p mh-x-image-cache-directory) 1544 'mh-x-image-scale-and-display))
1378 (file-directory-p mh-x-image-cache-directory)) 1545 ((and (eq mh-fetch-x-image-url 'ask)
1546 (not (y-or-n-p (format "Fetch %s? " url))))
1547 (mh-x-image-set-download-state cache-filename 'never))
1548 ((eq state nil)
1379 (mh-x-image-url-fetch-image url cache-filename marker 1549 (mh-x-image-url-fetch-image url cache-filename marker
1380 'mh-x-image-scale-and-display))))) 1550 'mh-x-image-scale-and-display)))))
1381 1551
1382 1552
1383 1553
1384 (defun mh-maybe-show (&optional msg) 1554 (defun mh-maybe-show (&optional msg)
1385 "Display message at cursor, but only if in show mode. 1555 "Display message at cursor, but only if in show mode.
1386 If optional arg MSG is non-nil, display that message instead." 1556 If optional arg MSG is non-nil, display that message instead."
1387 (if mh-showing-mode (mh-show msg))) 1557 (if mh-showing-mode (mh-show msg)))
1388 1558
1389 (defun mh-show (&optional message) 1559 (defun mh-show (&optional message redisplay-flag)
1390 "Show message at cursor. 1560 "Show message at cursor.
1391 If optional argument MESSAGE is non-nil, display that message instead. 1561 If optional argument MESSAGE is non-nil, display that message instead.
1392 Force a two-window display with the folder window on top (size given by the 1562 Force a two-window display with the folder window on top (size given by the
1393 variable `mh-summary-height') and the show buffer below it. 1563 variable `mh-summary-height') and the show buffer below it.
1394 If the message is already visible, display the start of the message. 1564 If the message is already visible, display the start of the message.
1395 1565
1566 If REDISPLAY-FLAG is non-nil, the default when called interactively, the
1567 message is redisplayed even if the show buffer was already displaying the
1568 correct message.
1569
1396 Display of the message is controlled by setting the variables 1570 Display of the message is controlled by setting the variables
1397 `mh-clean-message-header-flag' and `mhl-formfile'. The default behavior is 1571 `mh-clean-message-header-flag' and `mhl-formfile'. The default behavior is
1398 to scroll uninteresting headers off the top of the window. 1572 to scroll uninteresting headers off the top of the window.
1399 Type \"\\[mh-header-display]\" to see the message with all its headers." 1573 Type \"\\[mh-header-display]\" to see the message with all its headers."
1400 (interactive) 1574 (interactive (list nil t))
1401 (and mh-showing-with-headers 1575 (when (or redisplay-flag
1402 (or mhl-formfile mh-clean-message-header-flag) 1576 (and mh-showing-with-headers
1403 (mh-invalidate-show-buffer)) 1577 (or mhl-formfile mh-clean-message-header-flag)))
1578 (mh-invalidate-show-buffer))
1404 (mh-show-msg message)) 1579 (mh-show-msg message))
1405 1580
1406 (defun mh-show-mouse (EVENT) 1581 (defun mh-show-mouse (event)
1407 "Move point to mouse EVENT and show message." 1582 "Move point to mouse EVENT and show message."
1408 (interactive "e") 1583 (interactive "e")
1409 (mouse-set-point EVENT) 1584 (mouse-set-point event)
1410 (mh-show)) 1585 (mh-show))
1411 1586
1412 (defun mh-summary-height () 1587 (defun mh-summary-height ()
1413 "Return ideal value for the variable `mh-summary-height'. 1588 "Return ideal value for the variable `mh-summary-height'.
1414 The current frame height is taken into consideration." 1589 The current frame height is taken into consideration."
1426 (mh-showing-mode t) 1601 (mh-showing-mode t)
1427 (setq mh-page-to-next-msg-flag nil) 1602 (setq mh-page-to-next-msg-flag nil)
1428 (let ((folder mh-current-folder) 1603 (let ((folder mh-current-folder)
1429 (folders (list mh-current-folder)) 1604 (folders (list mh-current-folder))
1430 (clean-message-header mh-clean-message-header-flag) 1605 (clean-message-header mh-clean-message-header-flag)
1431 (show-window (get-buffer-window mh-show-buffer))) 1606 (show-window (get-buffer-window mh-show-buffer))
1607 (display-mime-buttons-flag mh-display-buttons-for-inline-parts-flag))
1432 (if (not (eq (next-window (minibuffer-window)) (selected-window))) 1608 (if (not (eq (next-window (minibuffer-window)) (selected-window)))
1433 (delete-other-windows)) ; force ourself to the top window 1609 (delete-other-windows)) ; force ourself to the top window
1434 (mh-in-show-buffer (mh-show-buffer) 1610 (mh-in-show-buffer (mh-show-buffer)
1611 (setq mh-display-buttons-for-inline-parts-flag display-mime-buttons-flag)
1435 (if (and show-window 1612 (if (and show-window
1436 (equal (mh-msg-filename msg folder) buffer-file-name)) 1613 (equal (mh-msg-filename msg folder) buffer-file-name))
1437 (progn ;just back up to start 1614 (progn ;just back up to start
1438 (goto-char (point-min)) 1615 (goto-char (point-min))
1439 (if (not clean-message-header) 1616 (if (not clean-message-header)
1441 (mh-display-msg msg folder))) 1618 (mh-display-msg msg folder)))
1442 (if (not (= (1+ (window-height)) (frame-height))) ;not horizontally split 1619 (if (not (= (1+ (window-height)) (frame-height))) ;not horizontally split
1443 (shrink-window (- (window-height) (or mh-summary-height 1620 (shrink-window (- (window-height) (or mh-summary-height
1444 (mh-summary-height))))) 1621 (mh-summary-height)))))
1445 (mh-recenter nil) 1622 (mh-recenter nil)
1623 ;; The following line is a nop which forces update of the scan line so
1624 ;; that font-lock will update it (if needed)...
1625 (mh-notate nil nil mh-cmd-note)
1446 (if (not (memq msg mh-seen-list)) 1626 (if (not (memq msg mh-seen-list))
1447 (setq mh-seen-list (cons msg mh-seen-list))) 1627 (setq mh-seen-list (cons msg mh-seen-list)))
1448 (when mh-update-sequences-after-mh-show-flag 1628 (when mh-update-sequences-after-mh-show-flag
1449 (mh-update-sequences) 1629 (mh-update-sequences)
1450 (when mh-index-data 1630 (when mh-index-data
1516 (unless (mh-buffer-data) 1696 (unless (mh-buffer-data)
1517 (setf (mh-buffer-data) (mh-make-buffer-data))) 1697 (setf (mh-buffer-data) (mh-make-buffer-data)))
1518 ;; Bind variables in folder buffer in case they are local 1698 ;; Bind variables in folder buffer in case they are local
1519 (let ((formfile mhl-formfile) 1699 (let ((formfile mhl-formfile)
1520 (clean-message-header mh-clean-message-header-flag) 1700 (clean-message-header mh-clean-message-header-flag)
1521 (invisible-headers mh-invisible-headers) 1701 (invisible-headers mh-invisible-header-fields-compiled)
1522 (visible-headers mh-visible-headers) 1702 (visible-headers nil)
1523 (msg-filename (mh-msg-filename msg-num folder-name)) 1703 (msg-filename (mh-msg-filename msg-num folder-name))
1524 (show-buffer mh-show-buffer) 1704 (show-buffer mh-show-buffer)
1525 (mm-inline-media-tests mh-mm-inline-media-tests)) 1705 (mm-inline-media-tests mh-mm-inline-media-tests))
1526 (if (not (file-exists-p msg-filename)) 1706 (if (not (file-exists-p msg-filename))
1527 (error "Message %d does not exist" msg-num)) 1707 (error "Message %d does not exist" msg-num))
1594 (defun mh-clean-msg-header (start invisible-headers visible-headers) 1774 (defun mh-clean-msg-header (start invisible-headers visible-headers)
1595 "Flush extraneous lines in message header. 1775 "Flush extraneous lines in message header.
1596 Header is cleaned from START to the end of the message header. 1776 Header is cleaned from START to the end of the message header.
1597 INVISIBLE-HEADERS contains a regular expression specifying lines to delete 1777 INVISIBLE-HEADERS contains a regular expression specifying lines to delete
1598 from the header. VISIBLE-HEADERS contains a regular expression specifying the 1778 from the header. VISIBLE-HEADERS contains a regular expression specifying the
1599 lines to display. INVISIBLE-HEADERS is ignored if VISIBLE-HEADERS is non-nil." 1779 lines to display. INVISIBLE-HEADERS is ignored if VISIBLE-HEADERS is non-nil.
1780
1781 Note that MH-E no longer supports the `mh-visible-headers' variable, so
1782 this function could be trimmed of this feature too."
1600 (let ((case-fold-search t) 1783 (let ((case-fold-search t)
1601 (buffer-read-only nil) 1784 (buffer-read-only nil)
1602 (after-change-functions nil)) ;Work around emacs-20 font-lock bug 1785 (after-change-functions nil)) ;Work around emacs-20 font-lock bug
1603 ;causing an endless loop. 1786 ;causing an endless loop.
1604 (save-restriction 1787 (save-restriction
1637 (if (or (null msg) 1820 (if (or (null msg)
1638 (mh-goto-msg msg t t)) 1821 (mh-goto-msg msg t t))
1639 (with-mh-folder-updating (t) 1822 (with-mh-folder-updating (t)
1640 (beginning-of-line) 1823 (beginning-of-line)
1641 (forward-char offset) 1824 (forward-char offset)
1642 (let* ((change-stack-flag (and (stringp notation) 1825 (let* ((change-stack-flag (and (equal offset (1+ mh-cmd-note))
1643 (equal offset (1+ mh-cmd-note))
1644 (not (eq notation mh-note-seq)))) 1826 (not (eq notation mh-note-seq))))
1645 (msg (and change-stack-flag (or msg (mh-get-msg-num nil)))) 1827 (msg (and change-stack-flag (or msg (mh-get-msg-num nil))))
1646 (stack (and msg (gethash msg mh-sequence-notation-history))) 1828 (stack (and msg (gethash msg mh-sequence-notation-history)))
1647 (notation (or notation (char-after)))) 1829 (notation (or notation (char-after))))
1648 (if stack 1830 (if stack
1650 ;; notate the message, since the notation would be replaced 1832 ;; notate the message, since the notation would be replaced
1651 ;; by a sequence notation. So we will just put the notation 1833 ;; by a sequence notation. So we will just put the notation
1652 ;; at the bottom of the stack. If the sequence is deleted, 1834 ;; at the bottom of the stack. If the sequence is deleted,
1653 ;; the correct notation will be shown. 1835 ;; the correct notation will be shown.
1654 (setf (gethash msg mh-sequence-notation-history) 1836 (setf (gethash msg mh-sequence-notation-history)
1655 (reverse (cons (aref notation 0) (cdr (reverse stack))))) 1837 (reverse (cons notation (cdr (reverse stack)))))
1656 ;; Since we don't have any sequence notations in the way, just 1838 ;; Since we don't have any sequence notations in the way, just
1657 ;; notate the scan line. 1839 ;; notate the scan line.
1658 (delete-char 1) 1840 (delete-char 1)
1659 (insert notation)) 1841 (insert notation))
1660 (when change-stack-flag 1842 (when change-stack-flag
1661 (mh-thread-update-scan-line-map msg notation offset))))))) 1843 (mh-thread-update-scan-line-map msg notation offset)))))))
1662
1663 (defun mh-find-msg-get-num (step)
1664 "Return the message number of the message nearest the cursor.
1665 Jumps over non-message lines, such as inc errors.
1666 If we have to search, STEP tells whether to search forward or backward."
1667 (or (mh-get-msg-num nil)
1668 (let ((msg-num nil)
1669 (nreverses 0))
1670 (while (and (not msg-num)
1671 (< nreverses 2))
1672 (cond ((eobp)
1673 (setq step -1)
1674 (setq nreverses (1+ nreverses)))
1675 ((bobp)
1676 (setq step 1)
1677 (setq nreverses (1+ nreverses))))
1678 (forward-line step)
1679 (setq msg-num (mh-get-msg-num nil)))
1680 msg-num)))
1681 1844
1682 (defun mh-goto-msg (number &optional no-error-if-no-message dont-show) 1845 (defun mh-goto-msg (number &optional no-error-if-no-message dont-show)
1683 "Position the cursor at message NUMBER. 1846 "Position the cursor at message NUMBER.
1684 Optional non-nil second argument NO-ERROR-IF-NO-MESSAGE means return nil 1847 Optional non-nil second argument NO-ERROR-IF-NO-MESSAGE means return nil
1685 instead of signaling an error if message does not exist; in this case, the 1848 instead of signaling an error if message does not exist; in this case, the
1697 (setq return-value nil)) 1860 (setq return-value nil))
1698 (beginning-of-line) 1861 (beginning-of-line)
1699 (or dont-show (not return-value) (mh-maybe-show number)) 1862 (or dont-show (not return-value) (mh-maybe-show number))
1700 return-value)) 1863 return-value))
1701 1864
1702 (defun mh-msg-search-pat (n)
1703 "Return a search pattern for message N in the scan listing."
1704 (format mh-scan-msg-search-regexp n))
1705
1706 (defun mh-get-profile-field (field) 1865 (defun mh-get-profile-field (field)
1707 "Find and return the value of FIELD in the current buffer. 1866 "Find and return the value of FIELD in the current buffer.
1708 Returns nil if the field is not in the buffer." 1867 Returns nil if the field is not in the buffer."
1709 (let ((case-fold-search t)) 1868 (let ((case-fold-search t))
1710 (goto-char (point-min)) 1869 (goto-char (point-min))
1714 (re-search-forward "[\t ]*\\([^\t \n].*\\)$" nil t) 1873 (re-search-forward "[\t ]*\\([^\t \n].*\\)$" nil t)
1715 (let ((start (match-beginning 1))) 1874 (let ((start (match-beginning 1)))
1716 (end-of-line) 1875 (end-of-line)
1717 (buffer-substring start (point))))))) 1876 (buffer-substring start (point)))))))
1718 1877
1719 (defvar mail-user-agent)
1720 (defvar read-mail-command)
1721
1722 (defvar mh-find-path-run nil 1878 (defvar mh-find-path-run nil
1723 "Non-nil if `mh-find-path' has been run already.") 1879 "Non-nil if `mh-find-path' has been run already.")
1724 1880
1725 (defun mh-find-path () 1881 (defun mh-find-path ()
1726 "Set `mh-progs', `mh-lib', and `mh-lib-progs' variables. 1882 "Set variables from user's MH profile.
1727 Set `mh-user-path', `mh-draft-folder', `mh-unseen-seq', `mh-previous-seq', 1883 Set `mh-user-path', `mh-draft-folder', `mh-unseen-seq', `mh-previous-seq',
1728 `mh-inbox' from user's MH profile. 1884 `mh-inbox' from user's MH profile.
1729 The value of `mh-find-path-hook' is a list of functions to be called, with no 1885 The value of `mh-find-path-hook' is a list of functions to be called, with no
1730 arguments, after these variable have been set." 1886 arguments, after these variable have been set."
1731 (mh-find-progs) 1887 (mh-variants)
1732 (unless mh-find-path-run 1888 (unless mh-find-path-run
1733 (setq mh-find-path-run t) 1889 (setq mh-find-path-run t)
1734 (setq read-mail-command 'mh-rmail) 1890 (save-excursion
1735 (setq mail-user-agent 'mh-e-user-agent)) 1891 ;; Be sure profile is fully expanded before switching buffers
1736 (save-excursion 1892 (let ((profile (expand-file-name (or (getenv "MH") "~/.mh_profile"))))
1737 ;; Be sure profile is fully expanded before switching buffers 1893 (set-buffer (get-buffer-create mh-temp-buffer))
1738 (let ((profile (expand-file-name (or (getenv "MH") "~/.mh_profile")))) 1894 (setq buffer-offer-save nil) ;for people who set default to t
1739 (set-buffer (get-buffer-create mh-temp-buffer)) 1895 (erase-buffer)
1740 (setq buffer-offer-save nil) ;for people who set default to t 1896 (condition-case err
1741 (erase-buffer) 1897 (insert-file-contents profile)
1742 (condition-case err 1898 (file-error
1743 (insert-file-contents profile) 1899 (mh-install profile err)))
1744 (file-error 1900 (setq mh-user-path (mh-get-profile-field "Path:"))
1745 (mh-install profile err))) 1901 (if (not mh-user-path)
1746 (setq mh-user-path (mh-get-profile-field "Path:")) 1902 (setq mh-user-path "Mail"))
1747 (if (not mh-user-path) 1903 (setq mh-user-path
1748 (setq mh-user-path "Mail")) 1904 (file-name-as-directory
1749 (setq mh-user-path 1905 (expand-file-name mh-user-path (expand-file-name "~"))))
1750 (file-name-as-directory 1906 (unless mh-x-image-cache-directory
1751 (expand-file-name mh-user-path (expand-file-name "~")))) 1907 (setq mh-x-image-cache-directory
1752 (unless mh-x-image-cache-directory 1908 (expand-file-name ".mhe-x-image-cache" mh-user-path)))
1753 (setq mh-x-image-cache-directory 1909 (setq mh-draft-folder (mh-get-profile-field "Draft-Folder:"))
1754 (expand-file-name ".mhe-x-image-cache" mh-user-path))) 1910 (if mh-draft-folder
1755 (setq mh-draft-folder (mh-get-profile-field "Draft-Folder:")) 1911 (progn
1756 (if mh-draft-folder 1912 (if (not (mh-folder-name-p mh-draft-folder))
1757 (progn 1913 (setq mh-draft-folder (format "+%s" mh-draft-folder)))
1758 (if (not (mh-folder-name-p mh-draft-folder)) 1914 (if (not (file-exists-p (mh-expand-file-name mh-draft-folder)))
1759 (setq mh-draft-folder (format "+%s" mh-draft-folder))) 1915 (error
1760 (if (not (file-exists-p (mh-expand-file-name mh-draft-folder))) 1916 "Draft folder \"%s\" not found. Create it and try again"
1761 (error "Draft folder \"%s\" not found. Create it and try again" 1917 (mh-expand-file-name mh-draft-folder)))))
1762 (mh-expand-file-name mh-draft-folder))))) 1918 (setq mh-inbox (mh-get-profile-field "Inbox:"))
1763 (setq mh-inbox (mh-get-profile-field "Inbox:")) 1919 (cond ((not mh-inbox)
1764 (cond ((not mh-inbox) 1920 (setq mh-inbox "+inbox"))
1765 (setq mh-inbox "+inbox")) 1921 ((not (mh-folder-name-p mh-inbox))
1766 ((not (mh-folder-name-p mh-inbox)) 1922 (setq mh-inbox (format "+%s" mh-inbox))))
1767 (setq mh-inbox (format "+%s" mh-inbox)))) 1923 (setq mh-unseen-seq (mh-get-profile-field "Unseen-Sequence:"))
1768 (setq mh-unseen-seq (mh-get-profile-field "Unseen-Sequence:")) 1924 (if mh-unseen-seq
1769 (if mh-unseen-seq 1925 (setq mh-unseen-seq (intern mh-unseen-seq))
1770 (setq mh-unseen-seq (intern mh-unseen-seq)) 1926 (setq mh-unseen-seq 'unseen)) ;old MH default?
1771 (setq mh-unseen-seq 'unseen)) ;old MH default? 1927 (setq mh-previous-seq (mh-get-profile-field "Previous-Sequence:"))
1772 (setq mh-previous-seq (mh-get-profile-field "Previous-Sequence:")) 1928 (if mh-previous-seq
1773 (if mh-previous-seq 1929 (setq mh-previous-seq (intern mh-previous-seq)))
1774 (setq mh-previous-seq (intern mh-previous-seq))) 1930 (run-hooks 'mh-find-path-hook)
1775 (run-hooks 'mh-find-path-hook) 1931 (mh-collect-folder-names)))))
1776 (mh-collect-folder-names))))
1777 1932
1778 (defun mh-file-command-p (file) 1933 (defun mh-file-command-p (file)
1779 "Return t if file FILE is the name of a executable regular file." 1934 "Return t if file FILE is the name of a executable regular file."
1780 (and (file-regular-p file) (file-executable-p file))) 1935 (and (file-regular-p file) (file-executable-p file)))
1781
1782 (defun mh-find-progs ()
1783 "Find the directories for the installed MH/nmh binaries and config files.
1784 Set the `mh-progs' and `mh-lib', and `mh-lib-progs' variables to the
1785 directory names and set `mh-nmh-flag' if we detect nmh instead of MH."
1786 (unless (and mh-progs mh-lib mh-lib-progs)
1787 (let ((path (or (mh-path-search exec-path "mhparam")
1788 (mh-path-search '("/usr/local/nmh/bin" ; nmh default
1789 "/usr/local/bin/mh/"
1790 "/usr/local/mh/"
1791 "/usr/bin/mh/" ;Ultrix 4.2, Linux
1792 "/usr/new/mh/" ;Ultrix <4.2
1793 "/usr/contrib/mh/bin/" ;BSDI
1794 "/usr/pkg/bin/" ; NetBSD
1795 "/usr/local/bin/"
1796 )
1797 "mhparam"))))
1798 (if (not path)
1799 (error "Unable to find the `mhparam' command"))
1800 (save-excursion
1801 (let ((tmp-buffer (get-buffer-create mh-temp-buffer)))
1802 (set-buffer tmp-buffer)
1803 (unwind-protect
1804 (progn
1805 (call-process (expand-file-name "mhparam" path)
1806 nil '(t nil) nil "libdir" "etcdir")
1807 (goto-char (point-min))
1808 (if (search-forward-regexp "^libdir:\\s-\\(\\S-+\\)\\s-*$"
1809 nil t)
1810 (setq mh-lib-progs (match-string 1)
1811 mh-lib mh-lib-progs
1812 mh-progs path))
1813 (goto-char (point-min))
1814 (if (search-forward-regexp "^etcdir:\\s-\\(\\S-+\\)\\s-*$"
1815 nil t)
1816 (setq mh-lib (match-string 1)
1817 mh-nmh-flag t)))
1818 (kill-buffer tmp-buffer))))
1819 (unless (and mh-progs mh-lib mh-lib-progs)
1820 (error "Unable to determine paths from `mhparam' command"))
1821 (setq mh-flists-present-flag
1822 (file-exists-p (expand-file-name "flists" mh-progs))))))
1823
1824 (defun mh-path-search (path file)
1825 "Search PATH, a list of directory names, for FILE.
1826 Returns the element of PATH that contains FILE, or nil if not found."
1827 (while (and path
1828 (not (funcall 'mh-file-command-p
1829 (expand-file-name file (car path)))))
1830 (setq path (cdr path)))
1831 (car path))
1832 1936
1833 (defvar mh-no-install nil) ;do not run install-mh 1937 (defvar mh-no-install nil) ;do not run install-mh
1834 1938
1835 (defun mh-install (profile error-val) 1939 (defun mh-install (profile error-val)
1836 "Initialize the MH environment. 1940 "Initialize the MH environment.
1909 If DONT-ANNOTATE-FLAG is non-nil then the annotations in the folder buffer are 2013 If DONT-ANNOTATE-FLAG is non-nil then the annotations in the folder buffer are
1910 not updated." 2014 not updated."
1911 (let ((entry (mh-find-seq seq)) 2015 (let ((entry (mh-find-seq seq))
1912 (internal-seq-flag (mh-internal-seq seq))) 2016 (internal-seq-flag (mh-internal-seq seq)))
1913 (if (and msgs (atom msgs)) (setq msgs (list msgs))) 2017 (if (and msgs (atom msgs)) (setq msgs (list msgs)))
2018 (if (null entry)
2019 (setq mh-seq-list
2020 (cons (mh-make-seq seq (mh-canonicalize-sequence msgs))
2021 mh-seq-list))
2022 (if msgs (setcdr entry (mh-canonicalize-sequence
2023 (append msgs (mh-seq-msgs entry))))))
1914 (unless internal-flag 2024 (unless internal-flag
1915 (mh-add-to-sequence seq msgs) 2025 (mh-add-to-sequence seq msgs)
1916 (when (not dont-annotate-flag) 2026 (when (not dont-annotate-flag)
1917 (mh-iterate-on-range msg msgs 2027 (mh-iterate-on-range msg msgs
1918 (unless (memq msg (cdr entry)) 2028 (unless (memq msg (cdr entry))
1919 (mh-add-sequence-notation msg internal-seq-flag))))) 2029 (mh-add-sequence-notation msg internal-seq-flag)))))))
1920 (if (null entry)
1921 (setq mh-seq-list
1922 (cons (mh-make-seq seq (mh-canonicalize-sequence msgs))
1923 mh-seq-list))
1924 (if msgs (setcdr entry (mh-canonicalize-sequence
1925 (append msgs (mh-seq-msgs entry))))))))
1926 2030
1927 (defun mh-canonicalize-sequence (msgs) 2031 (defun mh-canonicalize-sequence (msgs)
1928 "Sort MSGS in decreasing order and remove duplicates." 2032 "Sort MSGS in decreasing order and remove duplicates."
1929 (let* ((sorted-msgs (sort (copy-sequence msgs) '>)) 2033 (let* ((sorted-msgs (sort (copy-sequence msgs) '>))
1930 (head sorted-msgs)) 2034 (head sorted-msgs))
2074 (with-temp-buffer 2178 (with-temp-buffer
2075 (apply #'call-process arg-list) 2179 (apply #'call-process arg-list)
2076 (goto-char (point-min)) 2180 (goto-char (point-min))
2077 (while (not (and (eolp) (bolp))) 2181 (while (not (and (eolp) (bolp)))
2078 (goto-char (line-end-position)) 2182 (goto-char (line-end-position))
2079 (let ((has-pos (search-backward " has " (line-beginning-position) t))) 2183 (let ((start-pos (line-beginning-position))
2184 (has-pos (search-backward " has " (line-beginning-position) t)))
2080 (when (integerp has-pos) 2185 (when (integerp has-pos)
2081 (while (equal (char-after has-pos) ? ) 2186 (while (equal (char-after has-pos) ? )
2082 (decf has-pos)) 2187 (decf has-pos))
2083 (incf has-pos) 2188 (incf has-pos)
2084 (let* ((name (buffer-substring (line-beginning-position) has-pos)) 2189 (while (equal (char-after start-pos) ? )
2190 (incf start-pos))
2191 (let* ((name (buffer-substring start-pos has-pos))
2085 (first-char (aref name 0)) 2192 (first-char (aref name 0))
2086 (last-char (aref name (1- (length name))))) 2193 (last-char (aref name (1- (length name)))))
2087 (unless (member first-char '(?. ?# ?,)) 2194 (unless (member first-char '(?. ?# ?,))
2088 (when (and (equal last-char ?+) (equal name current-folder)) 2195 (when (and (equal last-char ?+) (equal name current-folder))
2089 (setq name (substring name 0 (1- (length name))))) 2196 (setq name (substring name 0 (1- (length name)))))
2187 (defun mh-folder-completing-read (prompt default allow-root-folder-flag) 2294 (defun mh-folder-completing-read (prompt default allow-root-folder-flag)
2188 "Read folder name with PROMPT and default result DEFAULT. 2295 "Read folder name with PROMPT and default result DEFAULT.
2189 If ALLOW-ROOT-FOLDER-FLAG is non-nil then \"+\" is allowed to be a folder name 2296 If ALLOW-ROOT-FOLDER-FLAG is non-nil then \"+\" is allowed to be a folder name
2190 corresponding to `mh-user-path'." 2297 corresponding to `mh-user-path'."
2191 (mh-normalize-folder-name 2298 (mh-normalize-folder-name
2192 (let ((minibuffer-local-completion-map mh-folder-completion-map) 2299 (let ((minibuffer-completing-file-name t)
2300 (completion-root-regexp "^[+/]")
2301 (minibuffer-local-completion-map mh-folder-completion-map)
2193 (mh-allow-root-folder-flag allow-root-folder-flag)) 2302 (mh-allow-root-folder-flag allow-root-folder-flag))
2194 (completing-read prompt 'mh-folder-completion-function nil nil nil 2303 (completing-read prompt 'mh-folder-completion-function nil nil nil
2195 'mh-folder-hist default)) 2304 'mh-folder-hist default))
2196 t)) 2305 t))
2197 2306
2204 non-nil, use it in the prompt instead of DEFAULT. If ALLOW-ROOT-FOLDER-FLAG is 2313 non-nil, use it in the prompt instead of DEFAULT. If ALLOW-ROOT-FOLDER-FLAG is
2205 non-nil then the function will accept the folder +, which means all folders 2314 non-nil then the function will accept the folder +, which means all folders
2206 when used in searching." 2315 when used in searching."
2207 (if (null default) 2316 (if (null default)
2208 (setq default "")) 2317 (setq default ""))
2209 (let* ((default-string (cond (default-string (format " [%s]? " 2318 (let* ((default-string (cond (default-string (format "[%s] " default-string))
2210 default-string)) 2319 ((equal "" default) "")
2211 ((equal "" default) "? ") 2320 (t (format "[%s] " default))))
2212 (t (format " [%s]? " default)))) 2321 (prompt (format "%s folder: %s" prompt default-string))
2213 (prompt (format "%s folder%s" prompt default-string))
2214 (mh-current-folder-name mh-current-folder) 2322 (mh-current-folder-name mh-current-folder)
2215 read-name folder-name) 2323 read-name folder-name)
2216 (while (and (setq read-name (mh-folder-completing-read 2324 (while (and (setq read-name (mh-folder-completing-read
2217 prompt default allow-root-folder-flag)) 2325 prompt default allow-root-folder-flag))
2218 (equal read-name "") 2326 (equal read-name "")
2450 new-list))) 2558 new-list)))
2451 (t (error "Bad element in mh-list-to-string: %s" (car l)))) 2559 (t (error "Bad element in mh-list-to-string: %s" (car l))))
2452 (setq l (cdr l))) 2560 (setq l (cdr l)))
2453 new-list)) 2561 new-list))
2454 2562
2563 (defun mh-replace-string (old new)
2564 "Replace all occurrences of OLD with NEW in the current buffer."
2565 (goto-char (point-min))
2566 (let ((case-fold-search t))
2567 (while (search-forward old nil t)
2568 (replace-match new t t))))
2569
2455 (defun mh-replace-in-string (regexp newtext string) 2570 (defun mh-replace-in-string (regexp newtext string)
2456 "Replace REGEXP with NEWTEXT everywhere in STRING and return result. 2571 "Replace REGEXP with NEWTEXT everywhere in STRING and return result.
2457 NEWTEXT is taken literally---no \\DIGIT escapes will be recognized. 2572 NEWTEXT is taken literally---no \\DIGIT escapes will be recognized.
2458 2573
2459 The function body was copied from `dired-replace-in-string' in dired.el. 2574 The function body was copied from `dired-replace-in-string' in dired.el.