33 |
|
|
34 |
;;; Code: |
;;; Code: |
35 |
|
|
36 |
;; Is this XEmacs-land? Located here since needed by mh-customize.el. |
(defvar recursive-load-depth-limit) |
37 |
(defvar mh-xemacs-flag (featurep 'xemacs) |
(eval-and-compile |
38 |
"Non-nil means the current Emacs is XEmacs.") |
(if (and (boundp 'recursive-load-depth-limit) |
39 |
|
(integerp recursive-load-depth-limit) |
40 |
;; The Emacs coding conventions require that the cl package not be required at |
(> 50 recursive-load-depth-limit)) |
41 |
;; runtime. However, the cl package in versions of Emacs prior to 21.4 left cl |
(setq recursive-load-depth-limit 50))) |
|
;; routines in their macro expansions. Use mh-require-cl to provide the cl |
|
|
;; routines in the best way possible. |
|
|
(eval-when-compile (require 'cl)) |
|
|
(defmacro mh-require-cl () |
|
|
(if (eq (car (macroexpand '(setf (gethash foo bar) baz))) 'cl-puthash) |
|
|
`(require 'cl) |
|
|
`(eval-when-compile (require 'cl)))) |
|
42 |
|
|
43 |
|
(eval-when-compile (require 'mh-acros)) |
44 |
(mh-require-cl) |
(mh-require-cl) |
45 |
(require 'gnus-util) |
(require 'gnus-util) |
46 |
(require 'font-lock) |
(require 'font-lock) |
52 |
|
|
53 |
(load "mm-decode" t t) ; Non-fatal dependency |
(load "mm-decode" t t) ; Non-fatal dependency |
54 |
(load "mm-view" t t) ; Non-fatal dependency |
(load "mm-view" t t) ; Non-fatal dependency |
55 |
|
(load "vcard" t t) ; Non-fatal dependency |
56 |
(load "hl-line" t t) ; Non-fatal dependency |
(load "hl-line" t t) ; Non-fatal dependency |
57 |
(load "executable" t t) ; Non-fatal dependency on |
(load "executable" t t) ; Non-fatal dependency on |
58 |
; executable-find |
; executable-find |
64 |
|
|
65 |
;;; Autoloads |
;;; Autoloads |
66 |
(autoload 'gnus-article-highlight-citation "gnus-cite") |
(autoload 'gnus-article-highlight-citation "gnus-cite") |
67 |
|
(autoload 'message-fetch-field "message") |
68 |
|
(autoload 'message-tokenize-header "message") |
69 |
(require 'sendmail) |
(require 'sendmail) |
|
(autoload 'Info-goto-node "info") |
|
70 |
(unless (fboundp 'make-hash-table) |
(unless (fboundp 'make-hash-table) |
71 |
(autoload 'make-hash-table "cl")) |
(autoload 'make-hash-table "cl")) |
72 |
|
|
|
;;; Set for local environment: |
|
|
;;; mh-progs and mh-lib used to be set in paths.el, which tried to |
|
|
;;; figure out at build time which of several possible directories MH |
|
|
;;; was installed into. But if you installed MH after building Emacs, |
|
|
;;; this would almost certainly be wrong, so now we do it at run time. |
|
|
|
|
|
(defvar mh-progs nil |
|
|
"Directory containing MH commands, such as inc, repl, and rmm.") |
|
|
|
|
|
(defvar mh-lib nil |
|
|
"Directory containing the MH library. |
|
|
This directory contains, among other things, the components file.") |
|
|
|
|
|
(defvar mh-lib-progs nil |
|
|
"Directory containing MH helper programs. |
|
|
This directory contains, among other things, the mhl program.") |
|
|
|
|
|
(defvar mh-nmh-flag nil |
|
|
"Non-nil means nmh is installed on this system instead of MH.") |
|
|
|
|
|
(defvar mh-flists-present-flag nil |
|
|
"Non-nil means that we have `flists'.") |
|
|
|
|
|
;;;###autoload |
|
|
(put 'mh-progs 'risky-local-variable t) |
|
|
;;;###autoload |
|
|
(put 'mh-lib 'risky-local-variable t) |
|
|
;;;###autoload |
|
|
(put 'mh-lib-progs 'risky-local-variable t) |
|
|
;;;###autoload |
|
|
(put 'mh-nmh-flag 'risky-local-variable t) |
|
|
|
|
73 |
;;; CL Replacements |
;;; CL Replacements |
74 |
(defun mh-search-from-end (char string) |
(defun mh-search-from-end (char string) |
75 |
"Return the position of last occurrence of CHAR in STRING. |
"Return the position of last occurrence of CHAR in STRING. |
79 |
when (equal (aref string index) char) return index |
when (equal (aref string index) char) return index |
80 |
finally return nil)) |
finally return nil)) |
81 |
|
|
|
;;; Macros to generate correct code for different emacs variants |
|
|
|
|
|
(defmacro mh-do-in-gnu-emacs (&rest body) |
|
|
"Execute BODY if in GNU Emacs." |
|
|
(unless mh-xemacs-flag `(progn ,@body))) |
|
|
(put 'mh-do-in-gnu-emacs 'lisp-indent-hook 'defun) |
|
|
|
|
|
(defmacro mh-do-in-xemacs (&rest body) |
|
|
"Execute BODY if in GNU Emacs." |
|
|
(when mh-xemacs-flag `(progn ,@body))) |
|
|
(put 'mh-do-in-xemacs 'lisp-indent-hook 'defun) |
|
|
|
|
|
(defmacro mh-funcall-if-exists (function &rest args) |
|
|
"Call FUNCTION with ARGS as parameters if it exists." |
|
|
(if (fboundp function) |
|
|
`(funcall ',function ,@args))) |
|
|
|
|
|
(defmacro mh-make-local-hook (hook) |
|
|
"Make HOOK local if needed. |
|
|
XEmacs and versions of GNU Emacs before 21.1 require `make-local-hook' to be |
|
|
called." |
|
|
(when (and (fboundp 'make-local-hook) |
|
|
(not (get 'make-local-hook 'byte-obsolete-info))) |
|
|
`(make-local-hook ,hook))) |
|
|
|
|
|
(defmacro mh-mark-active-p (check-transient-mark-mode-flag) |
|
|
"A macro that expands into appropriate code in XEmacs and nil in GNU Emacs. |
|
|
In GNU Emacs if CHECK-TRANSIENT-MARK-MODE-FLAG is non-nil then check if |
|
|
variable `transient-mark-mode' is active." |
|
|
(cond (mh-xemacs-flag ;XEmacs |
|
|
`(and (boundp 'zmacs-regions) zmacs-regions (region-active-p))) |
|
|
((not check-transient-mark-mode-flag) ;GNU Emacs |
|
|
`(and (boundp 'mark-active) mark-active)) |
|
|
(t ;GNU Emacs |
|
|
`(and (boundp 'transient-mark-mode) transient-mark-mode |
|
|
(boundp 'mark-active) mark-active)))) |
|
|
|
|
82 |
;;; Additional header fields that might someday be added: |
;;; Additional header fields that might someday be added: |
83 |
;;; "Sender: " "Reply-to: " |
;;; "Sender: " "Reply-to: " |
84 |
|
|
85 |
|
|
86 |
|
;;; Scan Line Formats |
87 |
|
|
88 |
(defvar mh-scan-msg-number-regexp "^ *\\([0-9]+\\)" |
(defvar mh-scan-msg-number-regexp "^ *\\([0-9]+\\)" |
89 |
"Regexp to find the number of a message in a scan line. |
"This regexp is used to extract the message number from a scan line. |
90 |
The message's number must be surrounded with \\( \\)") |
Note that the message number must be placed in a parenthesized expression as |
91 |
|
in the default of \"^ *\\\\([0-9]+\\\\)\".") |
92 |
|
|
93 |
(defvar mh-scan-msg-overflow-regexp "^[?0-9][0-9]" |
(defvar mh-scan-msg-overflow-regexp "^[?0-9][0-9]" |
94 |
"Regexp to find a scan line in which the message number overflowed. |
"This regexp matches scan lines in which the message number overflowed.") |
|
The message's number is left truncated in this case.") |
|
95 |
|
|
96 |
(defvar mh-scan-msg-format-regexp "%\\([0-9]*\\)(msg)" |
(defvar mh-scan-msg-format-regexp "%\\([0-9]*\\)(msg)" |
97 |
"Regexp to find message number width in an scan format. |
"This regexp is used to find the message number width in a scan format. |
98 |
The message number width must be surrounded with \\( \\).") |
Note that the message number must be placed in a parenthesized expression as |
99 |
|
in the default of \"%\\\\([0-9]*\\\\)(msg)\".") |
100 |
|
|
101 |
(defvar mh-scan-msg-format-string "%d" |
(defvar mh-scan-msg-format-string "%d" |
102 |
"Format string for width of the message number in a scan format. |
"This is a format string for width of the message number in a scan format. |
103 |
Use `0%d' for zero-filled message numbers.") |
Use `0%d' for zero-filled message numbers.") |
104 |
|
|
105 |
(defvar mh-scan-msg-search-regexp "^[^0-9]*%d[^0-9]" |
(defvar mh-scan-msg-search-regexp "^[^0-9]*%d[^0-9]" |
106 |
"Format string containing a regexp matching the scan listing for a message. |
"This format string regexp matches the scan line for a particular message. |
107 |
The desired message's number will be an argument to format.") |
Use `%d' to represent the location of the message number within the |
108 |
|
expression as in the default of \"^[^0-9]*%d[^0-9]\".") |
109 |
|
|
110 |
|
(defvar mh-cmd-note 4 |
111 |
|
"This is the number of characters to skip over before inserting notation. |
112 |
|
This variable should be set with the function `mh-set-cmd-note'. This variable |
113 |
|
may be updated dynamically if `mh-adaptive-cmd-note-flag' is non-nil and |
114 |
|
`mh-scan-format-file' is t.") |
115 |
|
(make-variable-buffer-local 'mh-cmd-note) |
116 |
|
|
117 |
(defvar mh-default-folder-for-message-function nil |
(defvar mh-note-seq ?% |
118 |
"Function to select a default folder for refiling or Fcc. |
"Messages in a user-defined sequence are marked by this character. |
119 |
If set to a function, that function is called with no arguments by |
Messages in the `search' sequence are marked by this character as well.") |
120 |
`\\[mh-refile-msg]' and `\\[mh-to-fcc]' to get a default when |
|
121 |
prompting the user for a folder. The function is called from within a |
|
|
`save-excursion', with point at the start of the message. It should |
|
|
return the folder to offer as the refile or Fcc folder, as a string |
|
|
with a leading `+' sign. It can also return an empty string to use no |
|
|
default, or nil to calculate the default the usual way. |
|
|
NOTE: This variable is not an ordinary hook; |
|
|
It may not be a list of functions.") |
|
122 |
|
|
123 |
(defvar mh-show-buffer-mode-line-buffer-id " {show-%s} %d" |
(defvar mh-show-buffer-mode-line-buffer-id " {show-%s} %d" |
124 |
"Format string to produce `mode-line-buffer-identification' for show buffers. |
"Format string to produce `mode-line-buffer-identification' for show buffers. |
125 |
First argument is folder name. Second is message number.") |
First argument is folder name. Second is message number.") |
126 |
|
|
127 |
(defvar mh-cmd-note 4 |
|
|
"Column to insert notation. |
|
|
Use `mh-set-cmd-note' to modify it. |
|
|
This value may be dynamically updated if `mh-adaptive-cmd-note-flag' is |
|
|
non-nil and `mh-scan-format-file' is t. |
|
|
Note that the first column is column number 0.") |
|
|
(make-variable-buffer-local 'mh-cmd-note) |
|
|
|
|
|
(defvar mh-note-seq "%" |
|
|
"String whose first character is used to notate messages in a sequence.") |
|
128 |
|
|
129 |
(defvar mh-mail-header-separator "--------" |
(defvar mh-mail-header-separator "--------" |
130 |
"*Line used by MH to separate headers from text in messages being composed. |
"*Line used by MH to separate headers from text in messages being composed. |
137 |
passed through `regexp-quote' before being used by functions like |
passed through `regexp-quote' before being used by functions like |
138 |
`re-search-forward'.") |
`re-search-forward'.") |
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 |
|
|
158 |
;; Variables for MIME display |
;; Variables for MIME display |
159 |
|
|
160 |
;; Structure to keep track of MIME handles on a per buffer basis. |
;; Structure to keep track of MIME handles on a per buffer basis. |
161 |
(defstruct (mh-buffer-data (:conc-name mh-mime-) |
(mh-defstruct (mh-buffer-data (:conc-name mh-mime-) |
162 |
(:constructor mh-make-buffer-data)) |
(:constructor mh-make-buffer-data)) |
163 |
(handles ()) ; List of MIME handles |
(handles ()) ; List of MIME handles |
164 |
(handles-cache (make-hash-table)) ; Cache to avoid multiple decodes of |
(handles-cache (make-hash-table)) ; Cache to avoid multiple decodes of |
165 |
; nested messages |
; nested messages |
273 |
"A regular expression probably matching an e-mail address.") |
"A regular expression probably matching an e-mail address.") |
274 |
|
|
275 |
;; From goto-addr.el, which we don't want to force-load on users. |
;; From goto-addr.el, which we don't want to force-load on users. |
276 |
;;;###mh-autoload |
|
277 |
(defun mh-goto-address-find-address-at-point () |
(defun mh-goto-address-find-address-at-point () |
278 |
"Find e-mail address around or before point. |
"Find e-mail address around or before point. |
279 |
Then search backwards to beginning of line for the start of an e-mail |
Then search backwards to beginning of line for the start of an e-mail |
290 |
In MH-E we frequently need to find the end of headers in nested messages, where |
In MH-E we frequently need to find the end of headers in nested messages, where |
291 |
the buffer has been narrowed. This function works in this situation." |
the buffer has been narrowed. This function works in this situation." |
292 |
(save-excursion |
(save-excursion |
293 |
(rfc822-goto-eoh) |
;; 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)))) |
305 |
(point))) |
(point))) |
306 |
|
|
307 |
(defun mh-in-header-p () |
(defun mh-in-header-p () |
481 |
;; hidden and can be programmatically removed in mh-quit), and the variable |
;; hidden and can be programmatically removed in mh-quit), and the variable |
482 |
;; names have the form mh-temp-.*-buffer. |
;; names have the form mh-temp-.*-buffer. |
483 |
(defconst mh-temp-buffer " *mh-temp*") ;scratch |
(defconst mh-temp-buffer " *mh-temp*") ;scratch |
484 |
|
(defconst mh-temp-fetch-buffer " *mh-fetch*") ;wget/curl/fetch output |
485 |
|
|
486 |
;; The names of MH-E buffers that are not ephemeral and can be used by the |
;; The names of MH-E buffers that are not ephemeral and can be used by the |
487 |
;; user (and deleted by the user when no longer needed) have a "*MH-E " prefix |
;; user (and deleted by the user when no longer needed) have a "*MH-E " prefix |
488 |
;; (so they can be programmatically removed in mh-quit), and the variable |
;; (so they can be programmatically removed in mh-quit), and the variable |
489 |
;; names have the form mh-.*-buffer. |
;; names have the form mh-.*-buffer. |
490 |
|
(defconst mh-aliases-buffer "*MH-E Aliases*") ;alias lookups |
491 |
(defconst mh-folders-buffer "*MH-E Folders*") ;folder list |
(defconst mh-folders-buffer "*MH-E Folders*") ;folder list |
492 |
|
(defconst mh-help-buffer "*MH-E Help*") ;quick help |
493 |
(defconst mh-info-buffer "*MH-E Info*") ;version information buffer |
(defconst mh-info-buffer "*MH-E Info*") ;version information buffer |
494 |
(defconst mh-log-buffer "*MH-E Log*") ;output of MH commands and so on |
(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 |
496 |
(defconst mh-recipients-buffer "*MH-E Recipients*") ;killed when draft sent |
(defconst mh-recipients-buffer "*MH-E Recipients*") ;killed when draft sent |
497 |
(defconst mh-sequences-buffer "*MH-E Sequences*") ;sequences list |
(defconst mh-sequences-buffer "*MH-E Sequences*") ;sequences list |
|
(defconst mh-mail-delivery-buffer "*MH-E Mail Delivery*") ;mail delivery log |
|
498 |
|
|
499 |
;; Number of lines to keep in mh-log-buffer. |
;; Number of lines to keep in mh-log-buffer. |
500 |
(defvar mh-log-buffer-lines 100) |
(defvar mh-log-buffer-lines 100) |
549 |
(cons modeline-buffer-id-left-extent "XEmacs%N:")) |
(cons modeline-buffer-id-left-extent "XEmacs%N:")) |
550 |
(cons modeline-buffer-id-right-extent " %17b"))))) |
(cons modeline-buffer-id-right-extent " %17b"))))) |
551 |
|
|
|
|
|
552 |
;;; This holds a documentation string used by describe-mode. |
;;; This holds a documentation string used by describe-mode. |
553 |
(defun mh-showing-mode (&optional arg) |
(defun mh-showing-mode (&optional arg) |
554 |
"Change whether messages should be displayed. |
"Change whether messages should be displayed. |
569 |
;; Showing message with headers or normally. |
;; Showing message with headers or normally. |
570 |
(defvar mh-showing-with-headers nil) |
(defvar mh-showing-with-headers nil) |
571 |
|
|
|
|
|
572 |
;;; MH-E macros |
;;; MH-E macros |
573 |
|
|
574 |
(defmacro with-mh-folder-updating (save-modification-flag &rest body) |
(defmacro with-mh-folder-updating (save-modification-flag &rest body) |
696 |
(unlock-buffer) |
(unlock-buffer) |
697 |
(setq buffer-file-name nil)) |
(setq buffer-file-name nil)) |
698 |
|
|
699 |
;;;###mh-autoload |
|
700 |
(defun mh-get-msg-num (error-if-no-message) |
(defun mh-get-msg-num (error-if-no-message) |
701 |
"Return the message number of the displayed message. |
"Return the message number of the displayed message. |
702 |
If the argument ERROR-IF-NO-MESSAGE is non-nil, then complain if the cursor is |
If the argument ERROR-IF-NO-MESSAGE is non-nil, then complain if the cursor is |
869 |
(mh-defun-show-buffer mh-show-index-ticked-messages mh-index-ticked-messages) |
(mh-defun-show-buffer mh-show-index-ticked-messages mh-index-ticked-messages) |
870 |
(mh-defun-show-buffer mh-show-index-sequenced-messages |
(mh-defun-show-buffer mh-show-index-sequenced-messages |
871 |
mh-index-sequenced-messages) |
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) |
882 |
|
|
883 |
;;; Populate mh-show-mode-map |
;;; Populate mh-show-mode-map |
884 |
(gnus-define-keys mh-show-mode-map |
(gnus-define-keys mh-show-mode-map |
905 |
"g" mh-show-goto-msg |
"g" mh-show-goto-msg |
906 |
"i" mh-show-inc-folder |
"i" mh-show-inc-folder |
907 |
"k" mh-show-delete-subject-or-thread |
"k" mh-show-delete-subject-or-thread |
|
"l" mh-show-print-msg |
|
908 |
"m" mh-show-send |
"m" mh-show-send |
909 |
"n" mh-show-next-undeleted-msg |
"n" mh-show-next-undeleted-msg |
910 |
"\M-n" mh-show-next-unread-msg |
"\M-n" mh-show-next-unread-msg |
924 |
"?" mh-prefix-help |
"?" mh-prefix-help |
925 |
"'" mh-index-ticked-messages |
"'" mh-index-ticked-messages |
926 |
"S" mh-show-sort-folder |
"S" mh-show-sort-folder |
927 |
|
"c" mh-show-catchup |
928 |
"f" mh-show-visit-folder |
"f" mh-show-visit-folder |
929 |
"i" mh-index-search |
"i" mh-index-search |
930 |
"k" mh-show-kill-folder |
"k" mh-show-kill-folder |
956 |
"b" mh-show-junk-blacklist |
"b" mh-show-junk-blacklist |
957 |
"w" mh-show-junk-whitelist) |
"w" mh-show-junk-whitelist) |
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 |
|
|
970 |
(gnus-define-keys (mh-show-thread-map "T" mh-show-mode-map) |
(gnus-define-keys (mh-show-thread-map "T" mh-show-mode-map) |
971 |
"?" mh-prefix-help |
"?" mh-prefix-help |
972 |
"u" mh-show-thread-ancestor |
"u" mh-show-thread-ancestor |
1001 |
(gnus-define-keys (mh-show-mime-map "K" mh-show-mode-map) |
(gnus-define-keys (mh-show-mime-map "K" mh-show-mode-map) |
1002 |
"?" mh-prefix-help |
"?" mh-prefix-help |
1003 |
"a" mh-mime-save-parts |
"a" mh-mime-save-parts |
1004 |
|
"e" mh-show-display-with-external-viewer |
1005 |
"v" mh-show-toggle-mime-part |
"v" mh-show-toggle-mime-part |
1006 |
"o" mh-show-save-mime-part |
"o" mh-show-save-mime-part |
1007 |
"i" mh-show-inline-mime-part |
"i" mh-show-inline-mime-part |
1008 |
|
"t" mh-show-toggle-mime-buttons |
1009 |
"\t" mh-show-next-button |
"\t" mh-show-next-button |
1010 |
[backtab] mh-show-prev-button |
[backtab] mh-show-prev-button |
1011 |
"\M-\t" mh-show-prev-button) |
"\M-\t" mh-show-prev-button) |
1092 |
(define-derived-mode mh-show-mode text-mode "MH-Show" |
(define-derived-mode mh-show-mode text-mode "MH-Show" |
1093 |
"Major mode for showing messages in MH-E.\\<mh-show-mode-map> |
"Major mode for showing messages in MH-E.\\<mh-show-mode-map> |
1094 |
The value of `mh-show-mode-hook' is a list of functions to |
The value of `mh-show-mode-hook' is a list of functions to |
1095 |
be called, with no arguments, upon entry to this mode." |
be called, with no arguments, upon entry to this mode. |
1096 |
|
See also `mh-folder-mode'. |
1097 |
|
|
1098 |
|
\\{mh-show-mode-map}" |
1099 |
(set (make-local-variable 'mail-header-separator) mh-mail-header-separator) |
(set (make-local-variable 'mail-header-separator) mh-mail-header-separator) |
1100 |
(setq paragraph-start (default-value 'paragraph-start)) |
(setq paragraph-start (default-value 'paragraph-start)) |
1101 |
(mh-show-unquote-From) |
(mh-show-unquote-From) |
1190 |
(mh-do-in-xemacs (defvar default-enable-multibyte-characters)) |
(mh-do-in-xemacs (defvar default-enable-multibyte-characters)) |
1191 |
|
|
1192 |
(defun mh-face-display-function () |
(defun mh-face-display-function () |
1193 |
"Display a Face or X-Face header field. |
"Display a Face, X-Face, or X-Image-URL header field. |
1194 |
Display Face if both are present." |
If more than one of these are present, then the first one found in this order |
1195 |
|
is used." |
1196 |
(save-restriction |
(save-restriction |
1197 |
(goto-char (point-min)) |
(goto-char (point-min)) |
1198 |
(re-search-forward "\n\n" (point-max) t) |
(re-search-forward "\n\n" (point-max) t) |
1207 |
type 'png)) |
type 'png)) |
1208 |
(x-face (setq raw (mh-uncompface x-face) |
(x-face (setq raw (mh-uncompface x-face) |
1209 |
type 'pbm)) |
type 'pbm)) |
1210 |
(url (setq type 'url))) |
(url (setq type 'url)) |
1211 |
|
(t (multiple-value-setq (type raw) (mh-picon-get-image)))) |
1212 |
(when type |
(when type |
1213 |
(goto-char (point-min)) |
(goto-char (point-min)) |
1214 |
(when (re-search-forward "^from:" (point-max) t) |
(when (re-search-forward "^from:" (point-max) t) |
1243 |
((and (eq type 'pbm) |
((and (eq type 'pbm) |
1244 |
(fboundp 'x-face-xmas-wl-display-x-face) |
(fboundp 'x-face-xmas-wl-display-x-face) |
1245 |
(fboundp 'executable-find) (executable-find "uncompface")) |
(fboundp 'executable-find) (executable-find "uncompface")) |
1246 |
(mh-funcall-if-exists x-face-xmas-wl-display-x-face))) |
(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)))))) |
1253 |
(when raw (insert " ")))))))) |
(when raw (insert " ")))))))) |
1254 |
|
|
|
|
|
1255 |
(defun mh-show-xface () |
(defun mh-show-xface () |
1256 |
"Display X-Face." |
"Display X-Face." |
1257 |
(when (and window-system mh-show-use-xface-flag |
(when (and window-system mh-show-use-xface-flag |
1261 |
|
|
1262 |
|
|
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 |
|
|
1383 |
;; X-Image-URL display |
;; X-Image-URL display |
1384 |
|
|
1385 |
(defvar mh-x-image-cache-directory nil |
(defvar mh-x-image-cache-directory nil |
1386 |
"Directory where X-Image-URL images are cached.") |
"Directory where X-Image-URL images are cached.") |
1387 |
|
(defvar mh-x-image-scaling-function |
1388 |
(defvar mh-convert-executable (executable-find "convert")) |
(cond ((executable-find "convert") |
1389 |
(defvar mh-wget-executable (executable-find "wget")) |
'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"))))) |
1402 |
(defvar mh-x-image-temp-file nil) |
(defvar mh-x-image-temp-file nil) |
1403 |
(defvar mh-x-image-url nil) |
(defvar mh-x-image-url nil) |
1404 |
(defvar mh-x-image-marker nil) |
(defvar mh-x-image-marker nil) |
1405 |
(defvar mh-x-image-url-cache-file nil) |
(defvar mh-x-image-url-cache-file nil) |
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 |
|
|
1420 |
(defun mh-x-image-url-cache-canonicalize (url) |
(defun mh-x-image-url-cache-canonicalize (url) |
1421 |
"Canonicalize URL. |
"Canonicalize URL. |
1422 |
Replace the ?/ character with a ?! character." |
Replace the ?/ character with a ?! character and append .png." |
1423 |
(with-temp-buffer |
(format "%s/%s.png" mh-x-image-cache-directory |
1424 |
(insert url) |
(with-temp-buffer |
1425 |
(goto-char (point-min)) |
(insert url) |
1426 |
(while (search-forward "/" nil t) (replace-match "!")) |
(mh-replace-string "/" "!") |
1427 |
(format "%s/%s.png" mh-x-image-cache-directory (buffer-string)))) |
(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))) |
1443 |
|
|
1444 |
(defun mh-x-image-url-fetch-image (url cache-file marker sentinel) |
(defun mh-x-image-url-fetch-image (url cache-file marker sentinel) |
1445 |
"Fetch and display the image specified by URL. |
"Fetch and display the image specified by URL. |
1446 |
After the image is fetched, it is stored in CACHE-FILE. It will be displayed |
After the image is fetched, it is stored in CACHE-FILE. It will be displayed |
1447 |
in a buffer and position specified by MARKER. The actual display is carried |
in a buffer and position specified by MARKER. The actual display is carried |
1448 |
out by the SENTINEL function." |
out by the SENTINEL function." |
1449 |
(if (and mh-wget-executable |
(if mh-wget-executable |
1450 |
mh-fetch-x-image-url |
(let ((buffer (get-buffer-create (generate-new-buffer-name |
1451 |
(or (eq mh-fetch-x-image-url t) |
mh-temp-fetch-buffer))) |
1452 |
(y-or-n-p (format "Fetch %s? " url)))) |
(filename (or (mh-funcall-if-exists make-temp-file "mhe-fetch") |
1453 |
(let ((buffer (get-buffer-create (generate-new-buffer-name " *mh-url*"))) |
(expand-file-name (make-temp-name "~/mhe-fetch"))))) |
|
(filename (make-temp-name "/tmp/mhe-wget"))) |
|
1454 |
(save-excursion |
(save-excursion |
1455 |
(set-buffer buffer) |
(set-buffer buffer) |
1456 |
(set (make-local-variable 'mh-x-image-url-cache-file) cache-file) |
(set (make-local-variable 'mh-x-image-url-cache-file) cache-file) |
1457 |
(set (make-local-variable 'mh-x-image-marker) marker) |
(set (make-local-variable 'mh-x-image-marker) marker) |
1458 |
(set (make-local-variable 'mh-x-image-temp-file) filename)) |
(set (make-local-variable 'mh-x-image-temp-file) filename)) |
1459 |
(set-process-sentinel |
(set-process-sentinel |
1460 |
(start-process "*wget*" buffer mh-wget-executable "-O" filename url) |
(start-process "*mh-x-image-url-fetch*" buffer |
1461 |
|
mh-wget-executable mh-wget-option filename url) |
1462 |
sentinel)) |
sentinel)) |
1463 |
;; Make sure we don't ask about this image again |
;; Temporary failure |
1464 |
(when (and mh-wget-executable (eq mh-fetch-x-image-url 'ask)) |
(mh-x-image-set-download-state cache-file 'try-again))) |
|
(make-symbolic-link mh-x-image-cache-directory cache-file t)))) |
|
1465 |
|
|
1466 |
(defun mh-x-image-display (image marker) |
(defun mh-x-image-display (image marker) |
1467 |
"Display IMAGE at MARKER." |
"Display IMAGE at MARKER." |
1471 |
(default-enable-multibyte-characters nil) |
(default-enable-multibyte-characters nil) |
1472 |
(buffer-modified-flag (buffer-modified-p))) |
(buffer-modified-flag (buffer-modified-p))) |
1473 |
(unwind-protect |
(unwind-protect |
1474 |
(when (and (file-readable-p image) (not (file-symlink-p image))) |
(when (and (file-readable-p image) (not (file-symlink-p image)) |
1475 |
|
(eq marker mh-x-image-marker)) |
1476 |
(goto-char marker) |
(goto-char marker) |
1477 |
(mh-do-in-gnu-emacs |
(mh-do-in-gnu-emacs |
1478 |
(mh-funcall-if-exists insert-image (create-image image 'png))) |
(mh-funcall-if-exists insert-image (create-image image 'png))) |
1496 |
(setq marker mh-x-image-marker |
(setq marker mh-x-image-marker |
1497 |
cache-filename mh-x-image-url-cache-file |
cache-filename mh-x-image-url-cache-file |
1498 |
temp-file mh-x-image-temp-file)) |
temp-file mh-x-image-temp-file)) |
1499 |
(when mh-convert-executable |
(cond |
1500 |
(call-process mh-convert-executable nil nil nil "-resize" "96x48" |
;; Check if we have `convert' |
1501 |
temp-file cache-filename)) |
((eq mh-x-image-scaling-function 'ignore) |
1502 |
(if (file-exists-p cache-filename) |
(message "The `convert' program is needed to display X-Image-URL") |
1503 |
(mh-x-image-display cache-filename marker) |
(mh-x-image-set-download-state cache-filename 'try-again)) |
1504 |
(make-symbolic-link mh-x-image-cache-directory cache-filename t)) |
;; 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))) |
1512 |
(ignore-errors |
(ignore-errors |
1513 |
(set-marker marker nil) |
(set-marker marker nil) |
1514 |
(delete-process process) |
(delete-process process) |
1515 |
(kill-buffer wget-buffer) |
(kill-buffer wget-buffer) |
1516 |
(delete-file temp-file))))) |
(delete-file temp-file))))) |
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 |
|
|
1526 |
(defun mh-x-image-url-display (url) |
(defun mh-x-image-url-display (url) |
1527 |
"Display image from location URL. |
"Display image from location URL. |
1528 |
If the URL isn't present in the cache then it is fetched with wget." |
If the URL isn't present in the cache then it is fetched with wget." |
1529 |
(let ((cache-filename (mh-x-image-url-cache-canonicalize url)) |
(let* ((cache-filename (mh-x-image-url-cache-canonicalize url)) |
1530 |
(marker (set-marker (make-marker) (point)))) |
(state (mh-x-image-get-download-state cache-filename)) |
1531 |
(cond ((file-exists-p cache-filename) |
(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) |
1535 |
(mh-x-image-display cache-filename marker)) |
(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)) |
1539 |
((not mh-fetch-x-image-url) |
((not mh-fetch-x-image-url) |
1540 |
(set-marker marker nil)) |
(set-marker marker nil)) |
1541 |
((and (not (file-exists-p mh-x-image-cache-directory)) |
((eq state 'try-again) |
1542 |
(call-process "mkdir" nil nil nil mh-x-image-cache-directory) |
(mh-x-image-set-download-state cache-filename nil) |
1543 |
nil)) |
(mh-x-image-url-fetch-image url cache-filename marker |
1544 |
((and (file-exists-p mh-x-image-cache-directory) |
'mh-x-image-scale-and-display)) |
1545 |
(file-directory-p mh-x-image-cache-directory)) |
((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) |
1549 |
(mh-x-image-url-fetch-image url cache-filename marker |
(mh-x-image-url-fetch-image url cache-filename marker |
1550 |
'mh-x-image-scale-and-display))))) |
'mh-x-image-scale-and-display))))) |
1551 |
|
|
1556 |
If optional arg MSG is non-nil, display that message instead." |
If optional arg MSG is non-nil, display that message instead." |
1557 |
(if mh-showing-mode (mh-show msg))) |
(if mh-showing-mode (mh-show msg))) |
1558 |
|
|
1559 |
(defun mh-show (&optional message) |
(defun mh-show (&optional message redisplay-flag) |
1560 |
"Show message at cursor. |
"Show message at cursor. |
1561 |
If optional argument MESSAGE is non-nil, display that message instead. |
If optional argument MESSAGE is non-nil, display that message instead. |
1562 |
Force a two-window display with the folder window on top (size given by the |
Force a two-window display with the folder window on top (size given by the |
1563 |
variable `mh-summary-height') and the show buffer below it. |
variable `mh-summary-height') and the show buffer below it. |
1564 |
If the message is already visible, display the start of the message. |
If the message is already visible, display the start of the message. |
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 |
|
|
1570 |
Display of the message is controlled by setting the variables |
Display of the message is controlled by setting the variables |
1571 |
`mh-clean-message-header-flag' and `mhl-formfile'. The default behavior is |
`mh-clean-message-header-flag' and `mhl-formfile'. The default behavior is |
1572 |
to scroll uninteresting headers off the top of the window. |
to scroll uninteresting headers off the top of the window. |
1573 |
Type \"\\[mh-header-display]\" to see the message with all its headers." |
Type \"\\[mh-header-display]\" to see the message with all its headers." |
1574 |
(interactive) |
(interactive (list nil t)) |
1575 |
(and mh-showing-with-headers |
(when (or redisplay-flag |
1576 |
(or mhl-formfile mh-clean-message-header-flag) |
(and mh-showing-with-headers |
1577 |
(mh-invalidate-show-buffer)) |
(or mhl-formfile mh-clean-message-header-flag))) |
1578 |
|
(mh-invalidate-show-buffer)) |
1579 |
(mh-show-msg message)) |
(mh-show-msg message)) |
1580 |
|
|
1581 |
(defun mh-show-mouse (EVENT) |
(defun mh-show-mouse (event) |
1582 |
"Move point to mouse EVENT and show message." |
"Move point to mouse EVENT and show message." |
1583 |
(interactive "e") |
(interactive "e") |
1584 |
(mouse-set-point EVENT) |
(mouse-set-point event) |
1585 |
(mh-show)) |
(mh-show)) |
1586 |
|
|
1587 |
(defun mh-summary-height () |
(defun mh-summary-height () |
1603 |
(let ((folder mh-current-folder) |
(let ((folder mh-current-folder) |
1604 |
(folders (list mh-current-folder)) |
(folders (list mh-current-folder)) |
1605 |
(clean-message-header mh-clean-message-header-flag) |
(clean-message-header mh-clean-message-header-flag) |
1606 |
(show-window (get-buffer-window mh-show-buffer))) |
(show-window (get-buffer-window mh-show-buffer)) |
1607 |
|
(display-mime-buttons-flag mh-display-buttons-for-inline-parts-flag)) |
1608 |
(if (not (eq (next-window (minibuffer-window)) (selected-window))) |
(if (not (eq (next-window (minibuffer-window)) (selected-window))) |
1609 |
(delete-other-windows)) ; force ourself to the top window |
(delete-other-windows)) ; force ourself to the top window |
1610 |
(mh-in-show-buffer (mh-show-buffer) |
(mh-in-show-buffer (mh-show-buffer) |
1611 |
|
(setq mh-display-buttons-for-inline-parts-flag display-mime-buttons-flag) |
1612 |
(if (and show-window |
(if (and show-window |
1613 |
(equal (mh-msg-filename msg folder) buffer-file-name)) |
(equal (mh-msg-filename msg folder) buffer-file-name)) |
1614 |
(progn ;just back up to start |
(progn ;just back up to start |
1620 |
(shrink-window (- (window-height) (or mh-summary-height |
(shrink-window (- (window-height) (or mh-summary-height |
1621 |
(mh-summary-height))))) |
(mh-summary-height))))) |
1622 |
(mh-recenter nil) |
(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) |
1626 |
(if (not (memq msg mh-seen-list)) |
(if (not (memq msg mh-seen-list)) |
1627 |
(setq mh-seen-list (cons msg mh-seen-list))) |
(setq mh-seen-list (cons msg mh-seen-list))) |
1628 |
(when mh-update-sequences-after-mh-show-flag |
(when mh-update-sequences-after-mh-show-flag |
1698 |
;; Bind variables in folder buffer in case they are local |
;; Bind variables in folder buffer in case they are local |
1699 |
(let ((formfile mhl-formfile) |
(let ((formfile mhl-formfile) |
1700 |
(clean-message-header mh-clean-message-header-flag) |
(clean-message-header mh-clean-message-header-flag) |
1701 |
(invisible-headers mh-invisible-headers) |
(invisible-headers mh-invisible-header-fields-compiled) |
1702 |
(visible-headers mh-visible-headers) |
(visible-headers nil) |
1703 |
(msg-filename (mh-msg-filename msg-num folder-name)) |
(msg-filename (mh-msg-filename msg-num folder-name)) |
1704 |
(show-buffer mh-show-buffer) |
(show-buffer mh-show-buffer) |
1705 |
(mm-inline-media-tests mh-mm-inline-media-tests)) |
(mm-inline-media-tests mh-mm-inline-media-tests)) |
1776 |
Header is cleaned from START to the end of the message header. |
Header is cleaned from START to the end of the message header. |
1777 |
INVISIBLE-HEADERS contains a regular expression specifying lines to delete |
INVISIBLE-HEADERS contains a regular expression specifying lines to delete |
1778 |
from the header. VISIBLE-HEADERS contains a regular expression specifying the |
from the header. VISIBLE-HEADERS contains a regular expression specifying the |
1779 |
lines to display. INVISIBLE-HEADERS is ignored if VISIBLE-HEADERS is non-nil." |
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." |
1783 |
(let ((case-fold-search t) |
(let ((case-fold-search t) |
1784 |
(buffer-read-only nil) |
(buffer-read-only nil) |
1785 |
(after-change-functions nil)) ;Work around emacs-20 font-lock bug |
(after-change-functions nil)) ;Work around emacs-20 font-lock bug |
1822 |
(with-mh-folder-updating (t) |
(with-mh-folder-updating (t) |
1823 |
(beginning-of-line) |
(beginning-of-line) |
1824 |
(forward-char offset) |
(forward-char offset) |
1825 |
(let* ((change-stack-flag (and (stringp notation) |
(let* ((change-stack-flag (and (equal offset (1+ mh-cmd-note)) |
|
(equal offset (1+ mh-cmd-note)) |
|
1826 |
(not (eq notation mh-note-seq)))) |
(not (eq notation mh-note-seq)))) |
1827 |
(msg (and change-stack-flag (or msg (mh-get-msg-num nil)))) |
(msg (and change-stack-flag (or msg (mh-get-msg-num nil)))) |
1828 |
(stack (and msg (gethash msg mh-sequence-notation-history))) |
(stack (and msg (gethash msg mh-sequence-notation-history))) |
1834 |
;; at the bottom of the stack. If the sequence is deleted, |
;; at the bottom of the stack. If the sequence is deleted, |
1835 |
;; the correct notation will be shown. |
;; the correct notation will be shown. |
1836 |
(setf (gethash msg mh-sequence-notation-history) |
(setf (gethash msg mh-sequence-notation-history) |
1837 |
(reverse (cons (aref notation 0) (cdr (reverse stack))))) |
(reverse (cons notation (cdr (reverse stack))))) |
1838 |
;; Since we don't have any sequence notations in the way, just |
;; Since we don't have any sequence notations in the way, just |
1839 |
;; notate the scan line. |
;; notate the scan line. |
1840 |
(delete-char 1) |
(delete-char 1) |
1842 |
(when change-stack-flag |
(when change-stack-flag |
1843 |
(mh-thread-update-scan-line-map msg notation offset))))))) |
(mh-thread-update-scan-line-map msg notation offset))))))) |
1844 |
|
|
|
(defun mh-find-msg-get-num (step) |
|
|
"Return the message number of the message nearest the cursor. |
|
|
Jumps over non-message lines, such as inc errors. |
|
|
If we have to search, STEP tells whether to search forward or backward." |
|
|
(or (mh-get-msg-num nil) |
|
|
(let ((msg-num nil) |
|
|
(nreverses 0)) |
|
|
(while (and (not msg-num) |
|
|
(< nreverses 2)) |
|
|
(cond ((eobp) |
|
|
(setq step -1) |
|
|
(setq nreverses (1+ nreverses))) |
|
|
((bobp) |
|
|
(setq step 1) |
|
|
(setq nreverses (1+ nreverses)))) |
|
|
(forward-line step) |
|
|
(setq msg-num (mh-get-msg-num nil))) |
|
|
msg-num))) |
|
|
|
|
1845 |
(defun mh-goto-msg (number &optional no-error-if-no-message dont-show) |
(defun mh-goto-msg (number &optional no-error-if-no-message dont-show) |
1846 |
"Position the cursor at message NUMBER. |
"Position the cursor at message NUMBER. |
1847 |
Optional non-nil second argument NO-ERROR-IF-NO-MESSAGE means return nil |
Optional non-nil second argument NO-ERROR-IF-NO-MESSAGE means return nil |
1862 |
(or dont-show (not return-value) (mh-maybe-show number)) |
(or dont-show (not return-value) (mh-maybe-show number)) |
1863 |
return-value)) |
return-value)) |
1864 |
|
|
|
(defun mh-msg-search-pat (n) |
|
|
"Return a search pattern for message N in the scan listing." |
|
|
(format mh-scan-msg-search-regexp n)) |
|
|
|
|
1865 |
(defun mh-get-profile-field (field) |
(defun mh-get-profile-field (field) |
1866 |
"Find and return the value of FIELD in the current buffer. |
"Find and return the value of FIELD in the current buffer. |
1867 |
Returns nil if the field is not in the buffer." |
Returns nil if the field is not in the buffer." |
1875 |
(end-of-line) |
(end-of-line) |
1876 |
(buffer-substring start (point))))))) |
(buffer-substring start (point))))))) |
1877 |
|
|
|
(defvar mail-user-agent) |
|
|
(defvar read-mail-command) |
|
|
|
|
1878 |
(defvar mh-find-path-run nil |
(defvar mh-find-path-run nil |
1879 |
"Non-nil if `mh-find-path' has been run already.") |
"Non-nil if `mh-find-path' has been run already.") |
1880 |
|
|
1881 |
(defun mh-find-path () |
(defun mh-find-path () |
1882 |
"Set `mh-progs', `mh-lib', and `mh-lib-progs' variables. |
"Set variables from user's MH profile. |
1883 |
Set `mh-user-path', `mh-draft-folder', `mh-unseen-seq', `mh-previous-seq', |
Set `mh-user-path', `mh-draft-folder', `mh-unseen-seq', `mh-previous-seq', |
1884 |
`mh-inbox' from user's MH profile. |
`mh-inbox' from user's MH profile. |
1885 |
The value of `mh-find-path-hook' is a list of functions to be called, with no |
The value of `mh-find-path-hook' is a list of functions to be called, with no |
1886 |
arguments, after these variable have been set." |
arguments, after these variable have been set." |
1887 |
(mh-find-progs) |
(mh-variants) |
1888 |
(unless mh-find-path-run |
(unless mh-find-path-run |
1889 |
(setq mh-find-path-run t) |
(setq mh-find-path-run t) |
1890 |
(setq read-mail-command 'mh-rmail) |
(save-excursion |
1891 |
(setq mail-user-agent 'mh-e-user-agent)) |
;; Be sure profile is fully expanded before switching buffers |
1892 |
(save-excursion |
(let ((profile (expand-file-name (or (getenv "MH") "~/.mh_profile")))) |
1893 |
;; Be sure profile is fully expanded before switching buffers |
(set-buffer (get-buffer-create mh-temp-buffer)) |
1894 |
(let ((profile (expand-file-name (or (getenv "MH") "~/.mh_profile")))) |
(setq buffer-offer-save nil) ;for people who set default to t |
1895 |
(set-buffer (get-buffer-create mh-temp-buffer)) |
(erase-buffer) |
1896 |
(setq buffer-offer-save nil) ;for people who set default to t |
(condition-case err |
1897 |
(erase-buffer) |
(insert-file-contents profile) |
1898 |
(condition-case err |
(file-error |
1899 |
(insert-file-contents profile) |
(mh-install profile err))) |
1900 |
(file-error |
(setq mh-user-path (mh-get-profile-field "Path:")) |
1901 |
(mh-install profile err))) |
(if (not mh-user-path) |
1902 |
(setq mh-user-path (mh-get-profile-field "Path:")) |
(setq mh-user-path "Mail")) |
1903 |
(if (not mh-user-path) |
(setq mh-user-path |
1904 |
(setq mh-user-path "Mail")) |
(file-name-as-directory |
1905 |
(setq mh-user-path |
(expand-file-name mh-user-path (expand-file-name "~")))) |
1906 |
(file-name-as-directory |
(unless mh-x-image-cache-directory |
1907 |
(expand-file-name mh-user-path (expand-file-name "~")))) |
(setq mh-x-image-cache-directory |
1908 |
(unless mh-x-image-cache-directory |
(expand-file-name ".mhe-x-image-cache" mh-user-path))) |
1909 |
(setq mh-x-image-cache-directory |
(setq mh-draft-folder (mh-get-profile-field "Draft-Folder:")) |
1910 |
(expand-file-name ".mhe-x-image-cache" mh-user-path))) |
(if mh-draft-folder |
1911 |
(setq mh-draft-folder (mh-get-profile-field "Draft-Folder:")) |
(progn |
1912 |
(if mh-draft-folder |
(if (not (mh-folder-name-p mh-draft-folder)) |
1913 |
(progn |
(setq mh-draft-folder (format "+%s" mh-draft-folder))) |
1914 |
(if (not (mh-folder-name-p mh-draft-folder)) |
(if (not (file-exists-p (mh-expand-file-name mh-draft-folder))) |
1915 |
(setq mh-draft-folder (format "+%s" mh-draft-folder))) |
(error |
1916 |
(if (not (file-exists-p (mh-expand-file-name mh-draft-folder))) |
"Draft folder \"%s\" not found. Create it and try again" |
1917 |
(error "Draft folder \"%s\" not found. Create it and try again" |
(mh-expand-file-name mh-draft-folder))))) |
1918 |
(mh-expand-file-name mh-draft-folder))))) |
(setq mh-inbox (mh-get-profile-field "Inbox:")) |
1919 |
(setq mh-inbox (mh-get-profile-field "Inbox:")) |
(cond ((not mh-inbox) |
1920 |
(cond ((not mh-inbox) |
(setq mh-inbox "+inbox")) |
1921 |
(setq mh-inbox "+inbox")) |
((not (mh-folder-name-p mh-inbox)) |
1922 |
((not (mh-folder-name-p mh-inbox)) |
(setq mh-inbox (format "+%s" mh-inbox)))) |
1923 |
(setq mh-inbox (format "+%s" mh-inbox)))) |
(setq mh-unseen-seq (mh-get-profile-field "Unseen-Sequence:")) |
1924 |
(setq mh-unseen-seq (mh-get-profile-field "Unseen-Sequence:")) |
(if mh-unseen-seq |
1925 |
(if mh-unseen-seq |
(setq mh-unseen-seq (intern mh-unseen-seq)) |
1926 |
(setq mh-unseen-seq (intern mh-unseen-seq)) |
(setq mh-unseen-seq 'unseen)) ;old MH default? |
1927 |
(setq mh-unseen-seq 'unseen)) ;old MH default? |
(setq mh-previous-seq (mh-get-profile-field "Previous-Sequence:")) |
1928 |
(setq mh-previous-seq (mh-get-profile-field "Previous-Sequence:")) |
(if mh-previous-seq |
1929 |
(if mh-previous-seq |
(setq mh-previous-seq (intern mh-previous-seq))) |
1930 |
(setq mh-previous-seq (intern mh-previous-seq))) |
(run-hooks 'mh-find-path-hook) |
1931 |
(run-hooks 'mh-find-path-hook) |
(mh-collect-folder-names))))) |
|
(mh-collect-folder-names)))) |
|
1932 |
|
|
1933 |
(defun mh-file-command-p (file) |
(defun mh-file-command-p (file) |
1934 |
"Return t if file FILE is the name of a executable regular file." |
"Return t if file FILE is the name of a executable regular file." |
1935 |
(and (file-regular-p file) (file-executable-p file))) |
(and (file-regular-p file) (file-executable-p file))) |
1936 |
|
|
|
(defun mh-find-progs () |
|
|
"Find the directories for the installed MH/nmh binaries and config files. |
|
|
Set the `mh-progs' and `mh-lib', and `mh-lib-progs' variables to the |
|
|
directory names and set `mh-nmh-flag' if we detect nmh instead of MH." |
|
|
(unless (and mh-progs mh-lib mh-lib-progs) |
|
|
(let ((path (or (mh-path-search exec-path "mhparam") |
|
|
(mh-path-search '("/usr/local/nmh/bin" ; nmh default |
|
|
"/usr/local/bin/mh/" |
|
|
"/usr/local/mh/" |
|
|
"/usr/bin/mh/" ;Ultrix 4.2, Linux |
|
|
"/usr/new/mh/" ;Ultrix <4.2 |
|
|
"/usr/contrib/mh/bin/" ;BSDI |
|
|
"/usr/pkg/bin/" ; NetBSD |
|
|
"/usr/local/bin/" |
|
|
) |
|
|
"mhparam")))) |
|
|
(if (not path) |
|
|
(error "Unable to find the `mhparam' command")) |
|
|
(save-excursion |
|
|
(let ((tmp-buffer (get-buffer-create mh-temp-buffer))) |
|
|
(set-buffer tmp-buffer) |
|
|
(unwind-protect |
|
|
(progn |
|
|
(call-process (expand-file-name "mhparam" path) |
|
|
nil '(t nil) nil "libdir" "etcdir") |
|
|
(goto-char (point-min)) |
|
|
(if (search-forward-regexp "^libdir:\\s-\\(\\S-+\\)\\s-*$" |
|
|
nil t) |
|
|
(setq mh-lib-progs (match-string 1) |
|
|
mh-lib mh-lib-progs |
|
|
mh-progs path)) |
|
|
(goto-char (point-min)) |
|
|
(if (search-forward-regexp "^etcdir:\\s-\\(\\S-+\\)\\s-*$" |
|
|
nil t) |
|
|
(setq mh-lib (match-string 1) |
|
|
mh-nmh-flag t))) |
|
|
(kill-buffer tmp-buffer)))) |
|
|
(unless (and mh-progs mh-lib mh-lib-progs) |
|
|
(error "Unable to determine paths from `mhparam' command")) |
|
|
(setq mh-flists-present-flag |
|
|
(file-exists-p (expand-file-name "flists" mh-progs)))))) |
|
|
|
|
|
(defun mh-path-search (path file) |
|
|
"Search PATH, a list of directory names, for FILE. |
|
|
Returns the element of PATH that contains FILE, or nil if not found." |
|
|
(while (and path |
|
|
(not (funcall 'mh-file-command-p |
|
|
(expand-file-name file (car path))))) |
|
|
(setq path (cdr path))) |
|
|
(car path)) |
|
|
|
|
1937 |
(defvar mh-no-install nil) ;do not run install-mh |
(defvar mh-no-install nil) ;do not run install-mh |
1938 |
|
|
1939 |
(defun mh-install (profile error-val) |
(defun mh-install (profile error-val) |
2015 |
(let ((entry (mh-find-seq seq)) |
(let ((entry (mh-find-seq seq)) |
2016 |
(internal-seq-flag (mh-internal-seq seq))) |
(internal-seq-flag (mh-internal-seq seq))) |
2017 |
(if (and msgs (atom msgs)) (setq msgs (list msgs))) |
(if (and msgs (atom msgs)) (setq msgs (list msgs))) |
|
(unless internal-flag |
|
|
(mh-add-to-sequence seq msgs) |
|
|
(when (not dont-annotate-flag) |
|
|
(mh-iterate-on-range msg msgs |
|
|
(unless (memq msg (cdr entry)) |
|
|
(mh-add-sequence-notation msg internal-seq-flag))))) |
|
2018 |
(if (null entry) |
(if (null entry) |
2019 |
(setq mh-seq-list |
(setq mh-seq-list |
2020 |
(cons (mh-make-seq seq (mh-canonicalize-sequence msgs)) |
(cons (mh-make-seq seq (mh-canonicalize-sequence msgs)) |
2021 |
mh-seq-list)) |
mh-seq-list)) |
2022 |
(if msgs (setcdr entry (mh-canonicalize-sequence |
(if msgs (setcdr entry (mh-canonicalize-sequence |
2023 |
(append msgs (mh-seq-msgs entry)))))))) |
(append msgs (mh-seq-msgs entry)))))) |
2024 |
|
(unless internal-flag |
2025 |
|
(mh-add-to-sequence seq msgs) |
2026 |
|
(when (not dont-annotate-flag) |
2027 |
|
(mh-iterate-on-range msg msgs |
2028 |
|
(unless (memq msg (cdr entry)) |
2029 |
|
(mh-add-sequence-notation msg internal-seq-flag))))))) |
2030 |
|
|
2031 |
(defun mh-canonicalize-sequence (msgs) |
(defun mh-canonicalize-sequence (msgs) |
2032 |
"Sort MSGS in decreasing order and remove duplicates." |
"Sort MSGS in decreasing order and remove duplicates." |
2180 |
(goto-char (point-min)) |
(goto-char (point-min)) |
2181 |
(while (not (and (eolp) (bolp))) |
(while (not (and (eolp) (bolp))) |
2182 |
(goto-char (line-end-position)) |
(goto-char (line-end-position)) |
2183 |
(let ((has-pos (search-backward " has " (line-beginning-position) t))) |
(let ((start-pos (line-beginning-position)) |
2184 |
|
(has-pos (search-backward " has " (line-beginning-position) t))) |
2185 |
(when (integerp has-pos) |
(when (integerp has-pos) |
2186 |
(while (equal (char-after has-pos) ? ) |
(while (equal (char-after has-pos) ? ) |
2187 |
(decf has-pos)) |
(decf has-pos)) |
2188 |
(incf has-pos) |
(incf has-pos) |
2189 |
(let* ((name (buffer-substring (line-beginning-position) has-pos)) |
(while (equal (char-after start-pos) ? ) |
2190 |
|
(incf start-pos)) |
2191 |
|
(let* ((name (buffer-substring start-pos has-pos)) |
2192 |
(first-char (aref name 0)) |
(first-char (aref name 0)) |
2193 |
(last-char (aref name (1- (length name))))) |
(last-char (aref name (1- (length name))))) |
2194 |
(unless (member first-char '(?. ?# ?,)) |
(unless (member first-char '(?. ?# ?,)) |
2296 |
If ALLOW-ROOT-FOLDER-FLAG is non-nil then \"+\" is allowed to be a folder name |
If ALLOW-ROOT-FOLDER-FLAG is non-nil then \"+\" is allowed to be a folder name |
2297 |
corresponding to `mh-user-path'." |
corresponding to `mh-user-path'." |
2298 |
(mh-normalize-folder-name |
(mh-normalize-folder-name |
2299 |
(let ((minibuffer-local-completion-map mh-folder-completion-map) |
(let ((minibuffer-completing-file-name t) |
2300 |
|
(completion-root-regexp "^[+/]") |
2301 |
|
(minibuffer-local-completion-map mh-folder-completion-map) |
2302 |
(mh-allow-root-folder-flag allow-root-folder-flag)) |
(mh-allow-root-folder-flag allow-root-folder-flag)) |
2303 |
(completing-read prompt 'mh-folder-completion-function nil nil nil |
(completing-read prompt 'mh-folder-completion-function nil nil nil |
2304 |
'mh-folder-hist default)) |
'mh-folder-hist default)) |
2315 |
when used in searching." |
when used in searching." |
2316 |
(if (null default) |
(if (null default) |
2317 |
(setq default "")) |
(setq default "")) |
2318 |
(let* ((default-string (cond (default-string (format " [%s]? " |
(let* ((default-string (cond (default-string (format "[%s] " default-string)) |
2319 |
default-string)) |
((equal "" default) "") |
2320 |
((equal "" default) "? ") |
(t (format "[%s] " default)))) |
2321 |
(t (format " [%s]? " default)))) |
(prompt (format "%s folder: %s" prompt default-string)) |
|
(prompt (format "%s folder%s" prompt default-string)) |
|
2322 |
(mh-current-folder-name mh-current-folder) |
(mh-current-folder-name mh-current-folder) |
2323 |
read-name folder-name) |
read-name folder-name) |
2324 |
(while (and (setq read-name (mh-folder-completing-read |
(while (and (setq read-name (mh-folder-completing-read |
2560 |
(setq l (cdr l))) |
(setq l (cdr l))) |
2561 |
new-list)) |
new-list)) |
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 |
|
|
2570 |
(defun mh-replace-in-string (regexp newtext string) |
(defun mh-replace-in-string (regexp newtext string) |
2571 |
"Replace REGEXP with NEWTEXT everywhere in STRING and return result. |
"Replace REGEXP with NEWTEXT everywhere in STRING and return result. |
2572 |
NEWTEXT is taken literally---no \\DIGIT escapes will be recognized. |
NEWTEXT is taken literally---no \\DIGIT escapes will be recognized. |