Mercurial > emacs
annotate lisp/mh-e/mh-mime.el @ 107523:dda920d04029
* processes.texi (Network Processes): Document seqpacket type.
author | Chong Yidong <cyd@stupidchicken.com> |
---|---|
date | Sun, 21 Mar 2010 11:28:53 -0400 |
parents | 1d1d5d9bd884 |
children | 7be123ae7612 376148b31b5e |
rev | line source |
---|---|
68465 | 1 ;;; mh-mime.el --- MH-E MIME support |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
2 |
62847
aa8c2e12ee24
Upgraded to MH-E version 7.84.
Bill Wohler <wohler@newt.com>
parents:
62465
diff
changeset
|
3 ;; Copyright (C) 1993, 1995, |
106815 | 4 ;; 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 |
101477
dab5b24b1603
Follow Glenn's lead and update format of Copyright.
Bill Wohler <wohler@newt.com>
parents:
100908
diff
changeset
|
5 ;; Free Software Foundation, Inc. |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
6 |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
7 ;; Author: Bill Wohler <wohler@newt.com> |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
8 ;; Maintainer: Bill Wohler <wohler@newt.com> |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
9 ;; Keywords: mail |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
10 ;; See: mh-e.el |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
11 |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
12 ;; This file is part of GNU Emacs. |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
13 |
94663
90c9ebd43589
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
88078
diff
changeset
|
14 ;; GNU Emacs is free software: you can redistribute it and/or modify |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
15 ;; it under the terms of the GNU General Public License as published by |
94663
90c9ebd43589
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
88078
diff
changeset
|
16 ;; the Free Software Foundation, either version 3 of the License, or |
90c9ebd43589
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
88078
diff
changeset
|
17 ;; (at your option) any later version. |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
18 |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
19 ;; GNU Emacs is distributed in the hope that it will be useful, |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
22 ;; GNU General Public License for more details. |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
23 |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
24 ;; You should have received a copy of the GNU General Public License |
94663
90c9ebd43589
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
88078
diff
changeset
|
25 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
26 |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
27 ;;; Commentary: |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
28 |
68465 | 29 ;; Message composition of MIME message is done with either MH-style |
30 ;; directives for mhn or mhbuild (MH 6.8 or later) or MML (MIME Meta | |
31 ;; Language) tags. | |
32 | |
33 ;; TODO: | |
34 ;; Paragraph code should not fill # lines if MIME enabled. | |
35 ;; Implement mh-auto-mh-to-mime (if non-nil, \\[mh-send-letter] | |
36 ;; invokes mh-mh-to-mime automatically before sending.) | |
37 ;; Actually, instead of mh-auto-mh-to-mime, | |
38 ;; should read automhnproc from profile. | |
39 ;; MIME option to mh-forward command to move to content-description | |
40 ;; insertion point. | |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
41 |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
42 ;;; Change Log: |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
43 |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
44 ;;; Code: |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
45 |
68465 | 46 (require 'mh-e) |
47 (require 'mh-gnus) ;needed because mh-gnus.el not compiled | |
68096
57c4e7929f99
* mh-alias.el (mh-alias-gecos-name): Use replace-regexp-in-string
Bill Wohler <wohler@newt.com>
parents:
68083
diff
changeset
|
48 |
68465 | 49 (require 'font-lock) |
68096
57c4e7929f99
* mh-alias.el (mh-alias-gecos-name): Use replace-regexp-in-string
Bill Wohler <wohler@newt.com>
parents:
68083
diff
changeset
|
50 (require 'gnus-util) |
68465 | 51 (require 'mailcap) |
52 (require 'mm-decode) | |
53 (require 'mm-view) | |
54 (require 'mml) | |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
55 |
66354
cf99ce27df54
* mh-comp.el (mh-letter-menu): Rename
Bill Wohler <wohler@newt.com>
parents:
66087
diff
changeset
|
56 (autoload 'article-emphasize "gnus-art") |
cf99ce27df54
* mh-comp.el (mh-letter-menu): Rename
Bill Wohler <wohler@newt.com>
parents:
66087
diff
changeset
|
57 (autoload 'gnus-eval-format "gnus-spec") |
68465 | 58 (autoload 'mail-content-type-get "mail-parse") |
59 (autoload 'mail-decode-encoded-word-string "mail-parse") | |
60 (autoload 'mail-header-parse-content-type "mail-parse") | |
61 (autoload 'mail-header-strip "mail-parse") | |
86974
d1d8b9ce5e70
(mail-strip-quoted-names): Autoload it.
Glenn Morris <rgm@gnu.org>
parents:
82493
diff
changeset
|
62 (autoload 'mail-strip-quoted-names "mail-utils") |
82487
c51f2772210a
* mh-mime.el (message-options-set): Add missing autoloads from my
Jeffrey C Honig <jch@bsdi.com>
parents:
82476
diff
changeset
|
63 (autoload 'message-options-get "message") |
c51f2772210a
* mh-mime.el (message-options-set): Add missing autoloads from my
Jeffrey C Honig <jch@bsdi.com>
parents:
82476
diff
changeset
|
64 (autoload 'message-options-set "message") |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
65 (autoload 'message-options-set-recipient "message") |
68465 | 66 (autoload 'mm-decode-body "mm-bodies") |
66358
9f52d5da9ca6
Autoload mm-uu for mm-uu-dissect to avoid compiler warning in Emacs
Bill Wohler <wohler@newt.com>
parents:
66354
diff
changeset
|
67 (autoload 'mm-uu-dissect "mm-uu") |
56673
e9a6cbc8ca5e
Upgraded to MH-E version 7.4.80.
Bill Wohler <wohler@newt.com>
parents:
56406
diff
changeset
|
68 (autoload 'mml-unsecure-message "mml-sec") |
50702
7dd3d5eae9c7
Upgraded to MH-E version 7.3.
Bill Wohler <wohler@newt.com>
parents:
49578
diff
changeset
|
69 (autoload 'rfc2047-decode-region "rfc2047") |
66354
cf99ce27df54
* mh-comp.el (mh-letter-menu): Rename
Bill Wohler <wohler@newt.com>
parents:
66087
diff
changeset
|
70 (autoload 'widget-convert-button "wid-edit") |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
71 |
68465 | 72 |
73 | |
74 ;;; Variables | |
75 | |
76 ;; This has to be a macro, since we do: (setf (mh-buffer-data) ...) | |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
77 ;;;###mh-autoload |
68465 | 78 (defmacro mh-buffer-data () |
79 "Convenience macro to get the MIME data structures of the current buffer." | |
80 `(gethash (current-buffer) mh-globals-hash)) | |
81 | |
82 ;; Structure to keep track of MIME handles on a per buffer basis. | |
83 (mh-defstruct (mh-buffer-data (:conc-name mh-mime-) | |
84 (:constructor mh-make-buffer-data)) | |
85 (handles ()) ; List of MIME handles | |
86 (handles-cache (make-hash-table)) ; Cache to avoid multiple decodes of | |
87 ; nested messages | |
88 (parts-count 0) ; The button number is generated from | |
89 ; this number | |
90 (part-index-hash (make-hash-table))) ; Avoid incrementing the part number | |
91 ; for nested messages | |
92 | |
93 (defvar mh-mm-inline-media-tests | |
94 `(("image/jpeg" | |
95 mm-inline-image | |
96 (lambda (handle) | |
97 (mm-valid-and-fit-image-p 'jpeg handle))) | |
98 ("image/png" | |
99 mm-inline-image | |
100 (lambda (handle) | |
101 (mm-valid-and-fit-image-p 'png handle))) | |
102 ("image/gif" | |
103 mm-inline-image | |
104 (lambda (handle) | |
105 (mm-valid-and-fit-image-p 'gif handle))) | |
106 ("image/tiff" | |
107 mm-inline-image | |
108 (lambda (handle) | |
109 (mm-valid-and-fit-image-p 'tiff handle)) ) | |
110 ("image/xbm" | |
111 mm-inline-image | |
112 (lambda (handle) | |
113 (mm-valid-and-fit-image-p 'xbm handle))) | |
114 ("image/x-xbitmap" | |
115 mm-inline-image | |
116 (lambda (handle) | |
117 (mm-valid-and-fit-image-p 'xbm handle))) | |
118 ("image/xpm" | |
119 mm-inline-image | |
120 (lambda (handle) | |
121 (mm-valid-and-fit-image-p 'xpm handle))) | |
122 ("image/x-pixmap" | |
123 mm-inline-image | |
124 (lambda (handle) | |
125 (mm-valid-and-fit-image-p 'xpm handle))) | |
126 ("image/bmp" | |
127 mm-inline-image | |
128 (lambda (handle) | |
129 (mm-valid-and-fit-image-p 'bmp handle))) | |
130 ("image/x-portable-bitmap" | |
131 mm-inline-image | |
132 (lambda (handle) | |
133 (mm-valid-and-fit-image-p 'pbm handle))) | |
134 ("text/plain" mm-inline-text identity) | |
135 ("text/enriched" mm-inline-text identity) | |
136 ("text/richtext" mm-inline-text identity) | |
137 ("text/x-patch" mm-display-patch-inline | |
138 (lambda (handle) | |
139 (locate-library "diff-mode"))) | |
140 ("application/emacs-lisp" mm-display-elisp-inline identity) | |
141 ("application/x-emacs-lisp" mm-display-elisp-inline identity) | |
142 ("text/html" | |
143 ,(if (fboundp 'mm-inline-text-html) 'mm-inline-text-html 'mm-inline-text) | |
144 (lambda (handle) | |
145 (or (and (boundp 'mm-inline-text-html-renderer) | |
146 mm-inline-text-html-renderer) | |
147 (and (boundp 'mm-text-html-renderer) mm-text-html-renderer)))) | |
148 ("text/x-vcard" | |
68520
6a7173abcf59
* mh-acros.el (mh-defun-compat, mh-defmacro-compat): Add name argument
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
149 mh-mm-inline-text-vcard |
68465 | 150 (lambda (handle) |
151 (or (featurep 'vcard) | |
152 (locate-library "vcard")))) | |
153 ("message/delivery-status" mm-inline-text identity) | |
154 ("message/rfc822" mh-mm-inline-message identity) | |
155 ;;("message/partial" mm-inline-partial identity) | |
156 ;;("message/external-body" mm-inline-external-body identity) | |
157 ("text/.*" mm-inline-text identity) | |
158 ("audio/wav" mm-inline-audio | |
159 (lambda (handle) | |
160 (and (or (featurep 'nas-sound) (featurep 'native-sound)) | |
161 (device-sound-enabled-p)))) | |
162 ("audio/au" | |
163 mm-inline-audio | |
164 (lambda (handle) | |
165 (and (or (featurep 'nas-sound) (featurep 'native-sound)) | |
166 (device-sound-enabled-p)))) | |
167 ("application/pgp-signature" ignore identity) | |
168 ("application/x-pkcs7-signature" ignore identity) | |
169 ("application/pkcs7-signature" ignore identity) | |
170 ("application/x-pkcs7-mime" ignore identity) | |
171 ("application/pkcs7-mime" ignore identity) | |
172 ("multipart/alternative" ignore identity) | |
173 ("multipart/mixed" ignore identity) | |
174 ("multipart/related" ignore identity) | |
175 ;; Disable audio and image | |
176 ("audio/.*" ignore ignore) | |
177 ("image/.*" ignore ignore) | |
178 ;; Default to displaying as text | |
68520
6a7173abcf59
* mh-acros.el (mh-defun-compat, mh-defmacro-compat): Add name argument
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
179 (".*" mm-inline-text mh-mm-readable-p)) |
68465 | 180 "Alist of media types/tests saying whether types can be displayed inline.") |
181 | |
182 (defvar mh-mime-save-parts-directory nil | |
183 "Default to use for `mh-mime-save-parts-default-directory'. | |
184 Set from last use.") | |
185 | |
186 ;; Copied from gnus-art.el (should be checked for other cool things that can | |
187 ;; be added to the buttons) | |
188 (defvar mh-mime-button-commands | |
189 '((mh-press-button "\r" "Toggle Display"))) | |
190 (defvar mh-mime-button-map | |
191 (let ((map (make-sparse-keymap))) | |
192 (unless (>= (string-to-number emacs-version) 21) | |
193 ;; XEmacs doesn't care. | |
194 (set-keymap-parent map mh-show-mode-map)) | |
195 (mh-do-in-gnu-emacs | |
196 (define-key map [mouse-2] 'mh-push-button)) | |
197 (mh-do-in-xemacs | |
198 (define-key map '(button2) 'mh-push-button)) | |
199 (dolist (c mh-mime-button-commands) | |
200 (define-key map (cadr c) (car c))) | |
201 map)) | |
202 (defvar mh-mime-button-line-format-alist | |
203 '((?T long-type ?s) | |
204 (?d description ?s) | |
205 (?p index ?s) | |
206 (?e dots ?s))) | |
207 (defvar mh-mime-button-line-format "%{%([%p. %d%T]%)%}%e\n") | |
208 (defvar mh-mime-security-button-pressed nil) | |
209 (defvar mh-mime-security-button-line-format "%{%([[%t:%i]%D]%)%}\n") | |
210 (defvar mh-mime-security-button-end-line-format "%{%([[End of %t]%D]%)%}\n") | |
211 (defvar mh-mime-security-button-line-format-alist | |
212 '((?t type ?s) | |
213 (?i info ?s) | |
214 (?d details ?s) | |
215 (?D pressed-details ?s))) | |
216 (defvar mh-mime-security-button-map | |
217 (let ((map (make-sparse-keymap))) | |
218 (unless (>= (string-to-number emacs-version) 21) | |
219 (set-keymap-parent map mh-show-mode-map)) | |
220 (define-key map "\r" 'mh-press-button) | |
221 (mh-do-in-gnu-emacs | |
222 (define-key map [mouse-2] 'mh-push-button)) | |
223 (mh-do-in-xemacs | |
224 (define-key map '(button2) 'mh-push-button)) | |
225 map)) | |
226 | |
227 | |
228 | |
229 ;;; MH-Folder Commands | |
230 | |
231 ;; Alphabetical. | |
232 | |
233 ;;;###mh-autoload | |
234 (defun mh-display-with-external-viewer (part-index) | |
235 "View attachment externally. | |
236 | |
237 If Emacs does not know how to view an attachment, you could save | |
238 it into a file and then run some program to open it. It is | |
239 easier, however, to launch the program directly from MH-E with | |
240 this command. While you'll most likely use this to view | |
241 spreadsheets and documents, it is also useful to use your browser | |
242 to view HTML attachments with higher fidelity than what Emacs can | |
243 provide. | |
244 | |
245 This command displays the attachment associated with the button | |
246 under the cursor. If the cursor is not located over a button, | |
247 then the cursor first moves to the next button, wrapping to the | |
248 beginning of the message if necessary. You can provide a numeric | |
249 prefix argument PART-INDEX to view the attachment labeled with | |
250 that number. | |
251 | |
252 This command tries to provide a reasonable default for the viewer | |
253 by calling the Emacs function `mailcap-mime-info'. This function | |
254 usually reads the file \"/etc/mailcap\"." | |
255 (interactive "P") | |
256 (when (consp part-index) (setq part-index (car part-index))) | |
257 (mh-folder-mime-action | |
258 part-index | |
259 #'(lambda () | |
260 (let* ((part (get-text-property (point) 'mh-data)) | |
261 (type (mm-handle-media-type part)) | |
262 (methods (mapcar (lambda (x) (list (cdr (assoc 'viewer x)))) | |
263 (mailcap-mime-info type 'all))) | |
264 (def (caar methods)) | |
265 (prompt (format "Viewer%s: " (if def | |
266 (format " (default %s)" def) | |
267 ""))) | |
268 (method (completing-read prompt methods nil nil nil nil def)) | |
269 (folder mh-show-folder-buffer) | |
270 (buffer-read-only nil)) | |
271 (when (string-match "^[^% \t]+$" method) | |
272 (setq method (concat method " %s"))) | |
273 (flet ((mm-handle-set-external-undisplayer (handle function) | |
274 (mh-handle-set-external-undisplayer folder handle function))) | |
275 (unwind-protect (mm-display-external part method) | |
276 (set-buffer-modified-p nil))))) | |
277 nil)) | |
278 | |
279 ;;;###mh-autoload | |
280 (defun mh-folder-inline-mime-part (part-index) | |
281 "Show attachment verbatim. | |
282 | |
283 You can view the raw contents of an attachment with this command. | |
284 This command displays (or hides) the contents of the attachment | |
285 associated with the button under the cursor verbatim. If the | |
286 cursor is not located over a button, then the cursor first moves | |
287 to the next button, wrapping to the beginning of the message if | |
288 necessary. | |
289 | |
290 You can also provide a numeric prefix argument PART-INDEX to view | |
291 the attachment labeled with that number." | |
292 (interactive "P") | |
293 (when (consp part-index) (setq part-index (car part-index))) | |
294 (mh-folder-mime-action part-index #'mh-mime-inline-part nil)) | |
295 | |
296 (defun mh-mime-inline-part () | |
297 "Toggle display of the raw MIME part." | |
298 (interactive) | |
299 (let* ((buffer-read-only nil) | |
300 (data (get-text-property (point) 'mh-data)) | |
301 (inserted-flag (get-text-property (point) 'mh-mime-inserted)) | |
302 (displayed-flag (mm-handle-displayed-p data)) | |
303 (point (point)) | |
304 start end) | |
305 (cond ((and data (not inserted-flag) (not displayed-flag)) | |
306 (let ((contents (mm-get-part data))) | |
68529
7daec5f4a289
* mh-alias.el (mh-alias-gecos-name): Use mh-replace-regexp-in-string
Bill Wohler <wohler@newt.com>
parents:
68520
diff
changeset
|
307 (add-text-properties (mh-line-beginning-position) |
7daec5f4a289
* mh-alias.el (mh-alias-gecos-name): Use mh-replace-regexp-in-string
Bill Wohler <wohler@newt.com>
parents:
68520
diff
changeset
|
308 (mh-line-end-position) '(mh-mime-inserted t)) |
68465 | 309 (setq start (point-marker)) |
310 (forward-line 1) | |
311 (mm-insert-inline data contents) | |
312 (setq end (point-marker)) | |
313 (add-text-properties | |
68529
7daec5f4a289
* mh-alias.el (mh-alias-gecos-name): Use mh-replace-regexp-in-string
Bill Wohler <wohler@newt.com>
parents:
68520
diff
changeset
|
314 start (progn (goto-char start) (mh-line-end-position)) |
68465 | 315 `(mh-region (,start . ,end))))) |
316 ((and data (or inserted-flag displayed-flag)) | |
317 (mh-press-button) | |
318 (message "MIME part already inserted"))) | |
319 (goto-char point) | |
320 (set-buffer-modified-p nil))) | |
321 | |
322 ;;;###mh-autoload | |
323 (defun mh-folder-save-mime-part (part-index) | |
324 "Save (output) attachment. | |
325 | |
326 This command saves the attachment associated with the button under the | |
327 cursor. If the cursor is not located over a button, then the cursor | |
328 first moves to the next button, wrapping to the beginning of the | |
329 message if necessary. | |
330 | |
331 You can also provide a numeric prefix argument PART-INDEX to save the | |
332 attachment labeled with that number. | |
333 | |
334 This command prompts you for a filename and suggests a specific name | |
335 if it is available." | |
336 (interactive "P") | |
337 (when (consp part-index) (setq part-index (car part-index))) | |
338 (mh-folder-mime-action part-index #'mh-mime-save-part nil)) | |
66354
cf99ce27df54
* mh-comp.el (mh-letter-menu): Rename
Bill Wohler <wohler@newt.com>
parents:
66087
diff
changeset
|
339 |
68465 | 340 (defun mh-mime-save-part () |
341 "Save MIME part at point." | |
342 (interactive) | |
343 (let ((data (get-text-property (point) 'mh-data))) | |
344 (when data | |
345 (let ((mm-default-directory | |
346 (file-name-as-directory (or mh-mime-save-parts-directory | |
347 default-directory)))) | |
348 (mh-mm-save-part data) | |
349 (setq mh-mime-save-parts-directory mm-default-directory))))) | |
350 | |
351 ;;;###mh-autoload | |
352 (defun mh-folder-toggle-mime-part (part-index) | |
353 "View attachment. | |
354 | |
355 This command displays (or hides) the attachment associated with | |
356 the button under the cursor. If the cursor is not located over a | |
357 button, then the cursor first moves to the next button, wrapping | |
358 to the beginning of the message if necessary. This command has | |
359 the advantage over related commands of working from the MH-Folder | |
360 buffer. | |
361 | |
362 You can also provide a numeric prefix argument PART-INDEX to view | |
363 the attachment labeled with that number. If Emacs does not know | |
364 how to display the attachment, then Emacs offers to save the | |
365 attachment in a file." | |
366 (interactive "P") | |
367 (when (consp part-index) (setq part-index (car part-index))) | |
368 (mh-folder-mime-action part-index #'mh-press-button t)) | |
369 | |
370 ;;;###mh-autoload | |
371 (defun mh-mime-save-parts (prompt) | |
372 "Save attachments. | |
373 | |
374 You can save all of the attachments at once with this command. | |
375 The attachments are saved in the directory specified by the | |
376 option `mh-mime-save-parts-default-directory' unless you use a | |
377 prefix argument PROMPT in which case you are prompted for the | |
378 directory. These directories may be superseded by MH profile | |
379 components, since this function calls on \"mhstore\" (\"mhn\") to | |
380 do the work." | |
381 (interactive "P") | |
382 (let ((msg (if (eq major-mode 'mh-show-mode) | |
383 (mh-show-buffer-message-number) | |
384 (mh-get-msg-num t))) | |
385 (folder (if (eq major-mode 'mh-show-mode) | |
386 mh-show-folder-buffer | |
387 mh-current-folder)) | |
388 (command (if (mh-variant-p 'nmh) "mhstore" "mhn")) | |
389 (directory | |
390 (cond | |
391 ((and (or prompt | |
392 (equal nil mh-mime-save-parts-default-directory) | |
393 (equal t mh-mime-save-parts-default-directory)) | |
394 (not mh-mime-save-parts-directory)) | |
395 (read-file-name "Store in directory: " nil nil t nil)) | |
396 ((and (or prompt | |
397 (equal t mh-mime-save-parts-default-directory)) | |
398 mh-mime-save-parts-directory) | |
399 (read-file-name (format | |
400 "Store in directory (default %s): " | |
401 mh-mime-save-parts-directory) | |
402 "" mh-mime-save-parts-directory t "")) | |
403 ((stringp mh-mime-save-parts-default-directory) | |
404 mh-mime-save-parts-default-directory) | |
405 (t | |
406 mh-mime-save-parts-directory)))) | |
407 (if (and (equal directory "") mh-mime-save-parts-directory) | |
408 (setq directory mh-mime-save-parts-directory)) | |
409 (if (not (file-directory-p directory)) | |
410 (message "No directory specified") | |
411 (if (equal nil mh-mime-save-parts-default-directory) | |
412 (setq mh-mime-save-parts-directory directory)) | |
105867
00c0adbb54a9
* mh-thread.el (mh-thread-set-tables):
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
101477
diff
changeset
|
413 (with-current-buffer (get-buffer-create mh-log-buffer) |
68465 | 414 (cd directory) |
415 (setq mh-mime-save-parts-directory directory) | |
416 (let ((initial-size (mh-truncate-log-buffer))) | |
417 (apply 'call-process | |
418 (expand-file-name command mh-progs) nil t nil | |
71528
113cbc14f25c
(mh-mime-save-parts): Add -store option to mhn (closes SF #1513140).
Bill Wohler <wohler@newt.com>
parents:
70028
diff
changeset
|
419 (mh-list-to-string (list folder msg "-auto" |
113cbc14f25c
(mh-mime-save-parts): Add -store option to mhn (closes SF #1513140).
Bill Wohler <wohler@newt.com>
parents:
70028
diff
changeset
|
420 (if (not (mh-variant-p 'nmh)) |
113cbc14f25c
(mh-mime-save-parts): Add -store option to mhn (closes SF #1513140).
Bill Wohler <wohler@newt.com>
parents:
70028
diff
changeset
|
421 "-store")))) |
68465 | 422 (if (> (buffer-size) initial-size) |
423 (save-window-excursion | |
424 (switch-to-buffer-other-window mh-log-buffer) | |
425 (sit-for 3)))))))) | |
426 | |
427 ;;;###mh-autoload | |
428 (defun mh-toggle-mh-decode-mime-flag () | |
429 "Toggle the value of `mh-decode-mime-flag'." | |
430 (interactive) | |
431 (setq mh-decode-mime-flag (not mh-decode-mime-flag)) | |
432 (mh-show nil t) | |
433 (message "%s" (if mh-decode-mime-flag | |
434 "Processing attachments normally" | |
435 "Displaying raw message"))) | |
436 | |
437 ;;;###mh-autoload | |
438 (defun mh-toggle-mime-buttons () | |
439 "Toggle option `mh-display-buttons-for-inline-parts-flag'." | |
440 (interactive) | |
441 (setq mh-display-buttons-for-inline-parts-flag | |
442 (not mh-display-buttons-for-inline-parts-flag)) | |
443 (mh-show nil t)) | |
444 | |
445 | |
446 | |
447 ;;; MIME Display Routines | |
448 | |
449 (defun mh-mm-inline-message (handle) | |
450 "Display message, HANDLE. | |
451 The function decodes the message and displays it. It avoids | |
452 decoding the same message multiple times." | |
453 (let ((b (point)) | |
454 (clean-message-header mh-clean-message-header-flag) | |
455 (invisible-headers mh-invisible-header-fields-compiled) | |
456 (visible-headers nil)) | |
457 (save-excursion | |
458 (save-restriction | |
459 (narrow-to-region b b) | |
460 (mm-insert-part handle) | |
461 (mh-mime-display | |
462 (or (gethash handle (mh-mime-handles-cache (mh-buffer-data))) | |
463 (setf (gethash handle (mh-mime-handles-cache (mh-buffer-data))) | |
464 (let ((handles (mm-dissect-buffer nil))) | |
465 (if handles | |
68520
6a7173abcf59
* mh-acros.el (mh-defun-compat, mh-defmacro-compat): Add name argument
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
466 (mh-mm-uu-dissect-text-parts handles) |
68465 | 467 (setq handles (mm-uu-dissect))) |
468 (setf (mh-mime-handles (mh-buffer-data)) | |
68520
6a7173abcf59
* mh-acros.el (mh-defun-compat, mh-defmacro-compat): Add name argument
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
469 (mh-mm-merge-handles |
68465 | 470 handles (mh-mime-handles (mh-buffer-data)))) |
471 handles)))) | |
472 | |
473 (goto-char (point-min)) | |
474 (mh-show-xface) | |
475 (cond (clean-message-header | |
476 (mh-clean-msg-header (point-min) | |
477 invisible-headers | |
478 visible-headers) | |
479 (goto-char (point-min))) | |
480 (t | |
481 (mh-start-of-uncleaned-message))) | |
482 (mh-decode-message-header) | |
483 (mh-show-addr) | |
484 ;; The other highlighting types don't need anything special | |
485 (when (eq mh-highlight-citation-style 'gnus) | |
486 (mh-gnus-article-highlight-citation)) | |
487 (goto-char (point-min)) | |
488 (insert "\n------- Forwarded Message\n\n") | |
489 (mh-display-smileys) | |
490 (mh-display-emphasis) | |
491 (mm-handle-set-undisplayer | |
492 handle | |
493 `(lambda () | |
494 (let (buffer-read-only) | |
495 (if (fboundp 'remove-specifier) | |
496 ;; This is only valid on XEmacs. | |
497 (mapcar (lambda (prop) | |
498 (remove-specifier | |
499 (face-property 'default prop) (current-buffer))) | |
500 '(background background-pixmap foreground))) | |
501 (delete-region ,(point-min-marker) ,(point-max-marker))))))))) | |
502 | |
503 ;;;###mh-autoload | |
504 (defun mh-decode-message-header () | |
505 "Decode RFC2047 encoded message header fields." | |
506 (when mh-decode-mime-flag | |
507 (let ((buffer-read-only nil)) | |
508 (rfc2047-decode-region (point-min) (mh-mail-header-end))))) | |
509 | |
510 ;;;###mh-autoload | |
511 (defun mh-mime-display (&optional pre-dissected-handles) | |
512 "Display (and possibly decode) MIME handles. | |
513 Optional argument, PRE-DISSECTED-HANDLES is a list of MIME | |
514 handles. If present they are displayed otherwise the buffer is | |
515 parsed and then displayed." | |
516 (let ((handles ()) | |
517 (folder mh-show-folder-buffer) | |
518 (raw-message-data (buffer-string))) | |
519 (flet ((mm-handle-set-external-undisplayer | |
520 (handle function) | |
521 (mh-handle-set-external-undisplayer folder handle function))) | |
522 (goto-char (point-min)) | |
523 (unless (search-forward "\n\n" nil t) | |
524 (goto-char (point-max)) | |
525 (insert "\n\n")) | |
526 | |
527 (condition-case err | |
528 (progn | |
529 ;; If needed dissect the current buffer | |
530 (if pre-dissected-handles | |
531 (setq handles pre-dissected-handles) | |
532 (if (setq handles (mm-dissect-buffer nil)) | |
68520
6a7173abcf59
* mh-acros.el (mh-defun-compat, mh-defmacro-compat): Add name argument
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
533 (mh-mm-uu-dissect-text-parts handles) |
68465 | 534 (setq handles (mm-uu-dissect))) |
535 (setf (mh-mime-handles (mh-buffer-data)) | |
68520
6a7173abcf59
* mh-acros.el (mh-defun-compat, mh-defmacro-compat): Add name argument
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
536 (mh-mm-merge-handles handles |
6a7173abcf59
* mh-acros.el (mh-defun-compat, mh-defmacro-compat): Add name argument
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
537 (mh-mime-handles (mh-buffer-data)))) |
68465 | 538 (unless handles |
539 (mh-decode-message-body))) | |
540 | |
541 (cond ((and handles | |
542 (or (not (stringp (car handles))) | |
543 (cdr handles))) | |
544 ;; Go to start of message body | |
545 (goto-char (point-min)) | |
546 (or (search-forward "\n\n" nil t) | |
547 (goto-char (point-max))) | |
548 | |
549 ;; Delete the body | |
550 (delete-region (point) (point-max)) | |
551 | |
552 ;; Display the MIME handles | |
553 (mh-mime-display-part handles)) | |
554 (t | |
555 (mh-signature-highlight)))) | |
556 (error | |
557 (message "Could not display body: %s" (error-message-string err)) | |
558 (delete-region (point-min) (point-max)) | |
559 (insert raw-message-data)))))) | |
560 | |
561 (defun mh-decode-message-body () | |
562 "Decode message based on charset. | |
563 If message has been encoded for transfer take that into account." | |
564 (let (ct charset cte) | |
565 (goto-char (point-min)) | |
566 (re-search-forward "\n\n" nil t) | |
567 (save-restriction | |
568 (narrow-to-region (point-min) (point)) | |
569 (setq ct (ignore-errors (mail-header-parse-content-type | |
570 (message-fetch-field "Content-Type" t))) | |
571 charset (mail-content-type-get ct 'charset) | |
572 cte (message-fetch-field "Content-Transfer-Encoding"))) | |
573 (when (stringp cte) (setq cte (mail-header-strip cte))) | |
574 (when (or (not ct) (equal (car ct) "text/plain")) | |
575 (save-restriction | |
576 (narrow-to-region (min (1+ (mh-mail-header-end)) (point-max)) | |
577 (point-max)) | |
578 (mm-decode-body charset | |
579 (and cte (intern (downcase | |
580 (gnus-strip-whitespace cte)))) | |
581 (car ct)))))) | |
582 | |
583 (defun mh-mime-display-part (handle) | |
584 "Decides the viewer to call based on the type of HANDLE." | |
585 (cond ((null handle) | |
586 nil) | |
587 ((not (stringp (car handle))) | |
588 (mh-mime-display-single handle)) | |
589 ((equal (car handle) "multipart/alternative") | |
590 (mh-mime-display-alternative (cdr handle))) | |
591 ((and mh-pgp-support-flag | |
592 (or (equal (car handle) "multipart/signed") | |
593 (equal (car handle) "multipart/encrypted"))) | |
594 (mh-mime-display-security handle)) | |
595 (t | |
596 (mh-mime-display-mixed (cdr handle))))) | |
597 | |
598 (defun mh-mime-display-mixed (handles) | |
599 "Display the list of MIME parts, HANDLES recursively." | |
600 (mapcar #'mh-mime-display-part handles)) | |
601 | |
602 (defun mh-mime-display-alternative (handles) | |
603 "Choose among the alternatives, HANDLES the part that will be displayed. | |
604 If no part is preferred then all the parts are displayed." | |
605 (let* ((preferred (mm-preferred-alternative handles)) | |
606 (others (loop for x in handles unless (eq x preferred) collect x))) | |
607 (cond ((and preferred | |
608 (stringp (car preferred))) | |
609 (mh-mime-display-part preferred) | |
610 (mh-mime-maybe-display-alternatives others)) | |
611 (preferred | |
612 (save-restriction | |
613 (narrow-to-region (point) (if (eobp) (point) (1+ (point)))) | |
614 (mh-mime-display-single preferred) | |
615 (mh-mime-maybe-display-alternatives others) | |
616 (goto-char (point-max)))) | |
617 (t | |
618 (mh-mime-display-mixed handles))))) | |
67758
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67756
diff
changeset
|
619 |
68465 | 620 (defun mh-mime-maybe-display-alternatives (alternatives) |
621 "Show buttons for ALTERNATIVES. | |
622 If `mh-mime-display-alternatives-flag' is non-nil then display | |
623 buttons for alternative parts that are usually suppressed." | |
624 (when (and mh-display-buttons-for-alternatives-flag alternatives) | |
625 (insert "\n----------------------------------------------------\n") | |
626 (insert "Alternatives:\n") | |
627 (dolist (x alternatives) | |
628 (insert "\n") | |
629 (mh-insert-mime-button x (mh-mime-part-index x) nil)) | |
630 (insert "\n----------------------------------------------------\n"))) | |
631 | |
632 (defun mh-mime-display-security (handle) | |
633 "Display PGP encrypted/signed message, HANDLE." | |
634 (save-restriction | |
635 (narrow-to-region (point) (point)) | |
636 (insert "\n") | |
637 (mh-insert-mime-security-button handle) | |
638 (mh-mime-display-mixed (cdr handle)) | |
639 (insert "\n") | |
640 (let ((mh-mime-security-button-line-format | |
641 mh-mime-security-button-end-line-format)) | |
642 (mh-insert-mime-security-button handle)) | |
68520
6a7173abcf59
* mh-acros.el (mh-defun-compat, mh-defmacro-compat): Add name argument
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
643 (mh-mm-set-handle-multipart-parameter |
68465 | 644 handle 'mh-region (cons (point-min-marker) (point-max-marker))))) |
645 | |
646 (defun mh-mime-display-single (handle) | |
647 "Display a leaf node, HANDLE in the MIME tree." | |
648 (let* ((type (mm-handle-media-type handle)) | |
649 (small-image-flag (mh-small-image-p handle)) | |
650 (attachmentp (equal (car (mm-handle-disposition handle)) | |
651 "attachment")) | |
652 (inlinep (and (equal (car (mm-handle-disposition handle)) "inline") | |
653 (mm-inlinable-p handle) | |
654 (mm-inlined-p handle))) | |
655 (displayp (or inlinep ; show if inline OR | |
656 (mh-inline-vcard-p handle); inline vcard OR | |
657 (and (not attachmentp) ; if not an attachment | |
658 (or small-image-flag ; and small image | |
659 ; and user wants inline | |
660 (and (not (equal | |
661 (mm-handle-media-supertype handle) | |
662 "image")) | |
663 (mm-inlinable-p handle) | |
664 (mm-inlined-p handle))))))) | |
665 (save-restriction | |
666 (narrow-to-region (point) (if (eobp) (point) (1+ (point)))) | |
667 (cond ((and mh-pgp-support-flag | |
668 (equal type "application/pgp-signature")) | |
669 nil) ; skip signatures as they are already handled... | |
670 ((not displayp) | |
671 (insert "\n") | |
672 (mh-insert-mime-button handle (mh-mime-part-index handle) nil)) | |
673 ((and displayp | |
674 (not mh-display-buttons-for-inline-parts-flag)) | |
675 (or (mm-display-part handle) | |
676 (mm-display-part handle)) | |
677 (mh-signature-highlight handle)) | |
678 ((and displayp | |
679 mh-display-buttons-for-inline-parts-flag) | |
680 (insert "\n") | |
681 (mh-insert-mime-button handle (mh-mime-part-index handle) nil) | |
682 (forward-line -1) | |
683 (mh-mm-display-part handle))) | |
684 (goto-char (point-max))))) | |
685 | |
686 ;; There is a bug in Gnus inline image display due to which an extra line | |
687 ;; gets inserted every time it is viewed. To work around that problem we are | |
688 ;; using an extra property 'mh-region to remember the region that is added | |
689 ;; when the button is clicked. The region is then deleted to make sure that | |
690 ;; no extra lines get inserted. | |
691 (defun mh-mm-display-part (handle) | |
692 "Toggle display of button for MIME part, HANDLE." | |
693 (beginning-of-line) | |
694 (let ((id (get-text-property (point) 'mh-part)) | |
695 (point (point)) | |
696 (window (selected-window)) | |
697 (mail-parse-charset 'nil) | |
698 (mail-parse-ignored-charsets nil) | |
699 region buffer-read-only) | |
700 (save-excursion | |
701 (unwind-protect | |
702 (let ((win (get-buffer-window (current-buffer) t))) | |
703 (when win | |
704 (select-window win)) | |
705 (goto-char point) | |
706 | |
707 (if (mm-handle-displayed-p handle) | |
708 ;; This will remove the part. | |
709 (progn | |
710 ;; Delete the button and displayed part (if any) | |
711 (let ((region (get-text-property point 'mh-region))) | |
712 (when region | |
713 (mh-funcall-if-exists | |
714 remove-images (car region) (cdr region))) | |
715 (mm-display-part handle) | |
716 (when region | |
717 (delete-region (car region) (cdr region)))) | |
718 ;; Delete button (if it still remains). This happens for | |
719 ;; externally displayed parts where the previous step does | |
720 ;; nothing. | |
721 (unless (eolp) | |
722 (delete-region (point) (progn (forward-line) (point))))) | |
723 (save-restriction | |
724 (delete-region (point) (progn (forward-line 1) (point))) | |
725 (narrow-to-region (point) (point)) | |
726 ;; Maybe we need another unwind-protect here. | |
727 (when (equal (mm-handle-media-supertype handle) "image") | |
728 (insert "\n")) | |
729 (when (and (not (eq (ignore-errors (mm-display-part handle)) | |
730 'inline)) | |
731 (equal (mm-handle-media-supertype handle) | |
732 "image")) | |
733 (goto-char (point-min)) | |
734 (delete-char 1)) | |
735 (when (equal (mm-handle-media-supertype handle) "text") | |
736 (when (eq mh-highlight-citation-style 'gnus) | |
737 (mh-gnus-article-highlight-citation)) | |
738 (mh-display-smileys) | |
739 (mh-display-emphasis) | |
740 (mh-signature-highlight handle)) | |
741 (setq region (cons (progn (goto-char (point-min)) | |
742 (point-marker)) | |
743 (progn (goto-char (point-max)) | |
744 (point-marker))))))) | |
745 (when (window-live-p window) | |
746 (select-window window)) | |
747 (goto-char point) | |
748 (beginning-of-line) | |
749 (mh-insert-mime-button handle id (mm-handle-displayed-p handle)) | |
750 (goto-char point) | |
751 (when region | |
68529
7daec5f4a289
* mh-alias.el (mh-alias-gecos-name): Use mh-replace-regexp-in-string
Bill Wohler <wohler@newt.com>
parents:
68520
diff
changeset
|
752 (add-text-properties (mh-line-beginning-position) |
7daec5f4a289
* mh-alias.el (mh-alias-gecos-name): Use mh-replace-regexp-in-string
Bill Wohler <wohler@newt.com>
parents:
68520
diff
changeset
|
753 (mh-line-end-position) |
68465 | 754 `(mh-region ,region))))))) |
755 | |
756 (defun mh-mime-part-index (handle) | |
757 "Generate the button number for MIME part, HANDLE. | |
758 Notice that a hash table is used to display the same number when | |
759 buttons need to be displayed multiple times (for instance when | |
760 nested messages are opened)." | |
761 (or (gethash handle (mh-mime-part-index-hash (mh-buffer-data))) | |
762 (setf (gethash handle (mh-mime-part-index-hash (mh-buffer-data))) | |
763 (incf (mh-mime-parts-count (mh-buffer-data)))))) | |
764 | |
765 (defun mh-small-image-p (handle) | |
766 "Decide whether HANDLE is a \"small\" image that can be displayed inline. | |
767 This is only useful if a Content-Disposition header is not present." | |
768 (let ((media-test (caddr (assoc (car (mm-handle-type handle)) | |
769 mh-mm-inline-media-tests))) | |
770 (mm-inline-large-images t)) | |
771 (and media-test | |
772 (equal (mm-handle-media-supertype handle) "image") | |
773 (funcall media-test handle) ; Since mm-inline-large-images is T, | |
774 ; this only tells us if the image is | |
775 ; something that emacs can display | |
776 (let* ((image (mm-get-image handle))) | |
777 (or (mh-do-in-xemacs | |
778 (and (mh-funcall-if-exists glyphp image) | |
779 (< (glyph-width image) | |
780 (or mh-max-inline-image-width (window-pixel-width))) | |
781 (< (glyph-height image) | |
782 (or mh-max-inline-image-height | |
783 (window-pixel-height))))) | |
784 (mh-do-in-gnu-emacs | |
785 (let ((size (mh-funcall-if-exists image-size image))) | |
786 (and size | |
787 (< (cdr size) (or mh-max-inline-image-height | |
788 (1- (window-height)))) | |
789 (< (car size) (or mh-max-inline-image-width | |
790 (window-width))))))))))) | |
791 | |
792 (defun mh-inline-vcard-p (handle) | |
793 "Decide if HANDLE is a vcard that must be displayed inline." | |
794 (let ((type (mm-handle-type handle))) | |
795 (and (or (featurep 'vcard) (fboundp 'vcard-pretty-print)) | |
796 (consp type) | |
797 (equal (car type) "text/x-vcard") | |
798 (save-excursion | |
799 (save-restriction | |
800 (widen) | |
801 (goto-char (point-min)) | |
802 (not (mh-signature-separator-p))))))) | |
803 | |
804 (defun mh-signature-highlight (&optional handle) | |
805 "Highlight message signature in HANDLE. | |
806 The optional argument, HANDLE is a MIME handle if the function is | |
807 being used to highlight the signature in a MIME part." | |
808 (let ((regexp | |
809 (cond ((not handle) "^-- $") | |
810 ((not (and (equal (mm-handle-media-supertype handle) "text") | |
811 (equal (mm-handle-media-subtype handle) "html"))) | |
812 "^-- $") | |
813 ((eq (mh-mm-text-html-renderer) 'lynx) "^ --$") | |
814 (t "^--$")))) | |
815 (save-excursion | |
816 (goto-char (point-max)) | |
817 (when (re-search-backward regexp nil t) | |
818 (mh-do-in-gnu-emacs | |
819 (let ((ov (make-overlay (point) (point-max)))) | |
820 (overlay-put ov 'face 'mh-show-signature) | |
821 (overlay-put ov 'evaporate t))) | |
822 (mh-do-in-xemacs | |
823 (set-extent-property (make-extent (point) (point-max)) | |
824 'face 'mh-show-signature)))))) | |
825 | |
826 | |
827 | |
828 ;;; Button Display | |
829 | |
830 ;; Shush compiler. | |
70028
d81780942bb8
* mh-acros.el (struct, x, y): No need to wrap defvar with
Bill Wohler <wohler@newt.com>
parents:
70027
diff
changeset
|
831 (defvar dots) ; XEmacs |
d81780942bb8
* mh-acros.el (struct, x, y): No need to wrap defvar with
Bill Wohler <wohler@newt.com>
parents:
70027
diff
changeset
|
832 (defvar type) ; XEmacs |
d81780942bb8
* mh-acros.el (struct, x, y): No need to wrap defvar with
Bill Wohler <wohler@newt.com>
parents:
70027
diff
changeset
|
833 (defvar ov) ; XEmacs |
68465 | 834 |
835 (defun mh-insert-mime-button (handle index displayed) | |
836 "Insert MIME button for HANDLE. | |
837 INDEX is the part number that will be DISPLAYED. It is also used | |
838 by commands like \"K v\" which operate on individual MIME parts." | |
839 ;; The button could be displayed by a previous decode. In that case | |
840 ;; undisplay it if we need a hidden button. | |
841 (when (and (mm-handle-displayed-p handle) (not displayed)) | |
842 (mm-display-part handle)) | |
843 (let ((name (or (mail-content-type-get (mm-handle-type handle) 'name) | |
844 (mail-content-type-get (mm-handle-disposition handle) | |
845 'filename) | |
846 (mail-content-type-get (mm-handle-type handle) 'url) | |
847 "")) | |
848 (type (mm-handle-media-type handle)) | |
849 (description (mail-decode-encoded-word-string | |
850 (or (mm-handle-description handle) ""))) | |
851 (dots (if (or displayed (mm-handle-displayed-p handle)) " " "...")) | |
852 long-type begin end) | |
853 (if (string-match ".*/" name) (setq name (substring name (match-end 0)))) | |
854 (setq long-type (concat type (and (not (equal name "")) | |
855 (concat "; " name)))) | |
856 (unless (equal description "") | |
857 (setq long-type (concat " --- " long-type))) | |
858 (unless (bolp) (insert "\n")) | |
859 (setq begin (point)) | |
860 (gnus-eval-format | |
861 mh-mime-button-line-format mh-mime-button-line-format-alist | |
68520
6a7173abcf59
* mh-acros.el (mh-defun-compat, mh-defmacro-compat): Add name argument
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
862 `(,@(mh-gnus-local-map-property mh-mime-button-map) |
68465 | 863 mh-callback mh-mm-display-part |
864 mh-part ,index | |
865 mh-data ,handle)) | |
866 (setq end (point)) | |
867 (widget-convert-button | |
868 'link begin end | |
869 :mime-handle handle | |
870 :action 'mh-widget-press-button | |
871 :button-keymap mh-mime-button-map | |
872 :help-echo | |
873 "Mouse-2 click or press RET (in show buffer) to toggle display") | |
874 (dolist (ov (mh-funcall-if-exists overlays-in begin end)) | |
875 (mh-funcall-if-exists overlay-put ov 'evaporate t)))) | |
876 | |
877 ;; Shush compiler. | |
70028
d81780942bb8
* mh-acros.el (struct, x, y): No need to wrap defvar with
Bill Wohler <wohler@newt.com>
parents:
70027
diff
changeset
|
878 (defvar mm-verify-function-alist) ; < Emacs 22 |
d81780942bb8
* mh-acros.el (struct, x, y): No need to wrap defvar with
Bill Wohler <wohler@newt.com>
parents:
70027
diff
changeset
|
879 (defvar mm-decrypt-function-alist) ; < Emacs 22 |
d81780942bb8
* mh-acros.el (struct, x, y): No need to wrap defvar with
Bill Wohler <wohler@newt.com>
parents:
70027
diff
changeset
|
880 (defvar pressed-details) ; XEmacs |
68465 | 881 |
882 (defun mh-insert-mime-security-button (handle) | |
883 "Display buttons for PGP message, HANDLE." | |
68520
6a7173abcf59
* mh-acros.el (mh-defun-compat, mh-defmacro-compat): Add name argument
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
884 (let* ((protocol (mh-mm-handle-multipart-ctl-parameter handle 'protocol)) |
68465 | 885 (crypto-type (or (nth 2 (assoc protocol mm-verify-function-alist)) |
886 (nth 2 (assoc protocol mm-decrypt-function-alist)) | |
887 "Unknown")) | |
888 (type (concat crypto-type | |
889 (if (equal (car handle) "multipart/signed") | |
890 " Signed" " Encrypted") | |
891 " Part")) | |
68520
6a7173abcf59
* mh-acros.el (mh-defun-compat, mh-defmacro-compat): Add name argument
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
892 (info (or (mh-mm-handle-multipart-ctl-parameter handle 'gnus-info) |
68465 | 893 "Undecided")) |
68520
6a7173abcf59
* mh-acros.el (mh-defun-compat, mh-defmacro-compat): Add name argument
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
894 (details (mh-mm-handle-multipart-ctl-parameter handle 'gnus-details)) |
68465 | 895 pressed-details begin end face) |
896 (setq details (if details (concat "\n" details) "")) | |
897 (setq pressed-details (if mh-mime-security-button-pressed details "")) | |
898 (setq face (mh-mime-security-button-face info)) | |
899 (unless (bolp) (insert "\n")) | |
900 (setq begin (point)) | |
901 (gnus-eval-format | |
902 mh-mime-security-button-line-format | |
903 mh-mime-security-button-line-format-alist | |
68520
6a7173abcf59
* mh-acros.el (mh-defun-compat, mh-defmacro-compat): Add name argument
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
904 `(,@(mh-gnus-local-map-property mh-mime-security-button-map) |
68465 | 905 mh-button-pressed ,mh-mime-security-button-pressed |
906 mh-callback mh-mime-security-press-button | |
907 mh-line-format ,mh-mime-security-button-line-format | |
908 mh-data ,handle)) | |
909 (setq end (point)) | |
910 (widget-convert-button 'link begin end | |
911 :mime-handle handle | |
912 :action 'mh-widget-press-button | |
913 :button-keymap mh-mime-security-button-map | |
914 :button-face face | |
915 :help-echo "Mouse-2 click or press RET (in show buffer) to see security details.") | |
916 (dolist (ov (mh-funcall-if-exists overlays-in begin end)) | |
917 (mh-funcall-if-exists overlay-put ov 'evaporate t)) | |
918 (when (equal info "Failed") | |
919 (let* ((type (if (equal (car handle) "multipart/signed") | |
920 "verification" "decryption")) | |
921 (warning (if (equal type "decryption") | |
922 "(passphrase may be incorrect)" ""))) | |
923 (message "%s %s failed %s" crypto-type type warning))))) | |
924 | |
925 (defun mh-mime-security-button-face (info) | |
926 "Return the button face to use for encrypted/signed mail based on INFO." | |
927 (cond ((string-match "OK" info) ;Decrypted mail | |
928 'mh-show-pgg-good) | |
929 ((string-match "Failed" info) ;Decryption failed or signature invalid | |
930 'mh-show-pgg-bad) | |
931 ((string-match "Undecided" info);Unprocessed mail | |
932 'mh-show-pgg-unknown) | |
933 ((string-match "Untrusted" info);Key not trusted | |
934 'mh-show-pgg-unknown) | |
935 (t | |
936 'mh-show-pgg-good))) | |
937 | |
938 | |
939 | |
940 ;;; Button Handlers | |
941 | |
942 (defun mh-folder-mime-action (part-index action include-security-flag) | |
943 "Go to PART-INDEX and carry out ACTION. | |
944 | |
945 If PART-INDEX is nil then go to the next part in the buffer. The | |
946 search for the next buffer wraps around if end of buffer is reached. | |
947 If argument INCLUDE-SECURITY-FLAG is non-nil then include security | |
948 info buttons when searching for a suitable parts." | |
949 (unless mh-showing-mode | |
950 (mh-show)) | |
951 (mh-in-show-buffer (mh-show-buffer) | |
952 (let ((criterion | |
953 (cond (part-index | |
954 (lambda (p) | |
955 (let ((part (get-text-property p 'mh-part))) | |
956 (and (integerp part) (= part part-index))))) | |
957 (t (lambda (p) | |
958 (if include-security-flag | |
959 (get-text-property p 'mh-data) | |
960 (integerp (get-text-property p 'mh-part))))))) | |
961 (point (point))) | |
962 (cond ((and (get-text-property point 'mh-part) | |
963 (or (null part-index) | |
964 (= (get-text-property point 'mh-part) part-index))) | |
965 (funcall action)) | |
966 ((and (get-text-property point 'mh-data) | |
967 include-security-flag | |
968 (null part-index)) | |
969 (funcall action)) | |
970 (t | |
971 (mh-goto-next-button nil criterion) | |
972 (if (= (point) point) | |
973 (message "No matching MIME part found") | |
974 (funcall action))))))) | |
975 | |
976 ;;;###mh-autoload | |
977 (defun mh-goto-next-button (backward-flag &optional criterion) | |
978 "Search for next button satisfying criterion. | |
979 | |
980 If BACKWARD-FLAG is non-nil search backward in the buffer for a mime | |
981 button. | |
982 If CRITERION is a function or a symbol which has a function binding | |
983 then that function must return non-nil at the button we stop." | |
984 (unless (or (and (symbolp criterion) (fboundp criterion)) | |
985 (functionp criterion)) | |
986 (setq criterion (lambda (x) t))) | |
987 ;; Move to the next button in the buffer satisfying criterion | |
988 (goto-char (or (save-excursion | |
989 (beginning-of-line) | |
990 ;; Find point before current button | |
991 (let ((point-before-current-button | |
992 (save-excursion | |
993 (while (get-text-property (point) 'mh-data) | |
994 (unless (= (forward-line | |
995 (if backward-flag 1 -1)) | |
996 0) | |
997 (if backward-flag | |
998 (goto-char (point-min)) | |
999 (goto-char (point-max))))) | |
1000 (point)))) | |
1001 ;; Skip over current button | |
1002 (while (and (get-text-property (point) 'mh-data) | |
1003 (not (if backward-flag (bobp) (eobp)))) | |
1004 (forward-line (if backward-flag -1 1))) | |
1005 ;; Stop at next MIME button if any exists. | |
1006 (block loop | |
1007 (while (/= (progn | |
1008 (unless (= (forward-line | |
1009 (if backward-flag -1 1)) | |
1010 0) | |
1011 (if backward-flag | |
1012 (goto-char (point-max)) | |
1013 (goto-char (point-min))) | |
1014 (beginning-of-line)) | |
1015 (point)) | |
1016 point-before-current-button) | |
1017 (when (and (get-text-property (point) 'mh-data) | |
1018 (funcall criterion (point))) | |
1019 (return-from loop (point)))) | |
1020 nil))) | |
1021 (point)))) | |
1022 | |
1023 (defun mh-widget-press-button (widget el) | |
1024 "Callback for widget, WIDGET. | |
1025 Parameter EL is unused." | |
1026 (goto-char (widget-get widget :from)) | |
1027 (mh-press-button)) | |
1028 | |
1029 (defun mh-press-button () | |
1030 "View contents of button. | |
1031 | |
1032 This command is a toggle so if you use it again on the same | |
1033 attachment, the attachment is hidden." | |
1034 (interactive) | |
1035 (let ((mm-inline-media-tests mh-mm-inline-media-tests) | |
1036 (data (get-text-property (point) 'mh-data)) | |
1037 (function (get-text-property (point) 'mh-callback)) | |
1038 (buffer-read-only nil) | |
1039 (folder mh-show-folder-buffer)) | |
1040 (flet ((mm-handle-set-external-undisplayer | |
1041 (handle function) | |
1042 (mh-handle-set-external-undisplayer folder handle function))) | |
1043 (when (and function (eolp)) | |
1044 (backward-char)) | |
1045 (unwind-protect (and function (funcall function data)) | |
1046 (set-buffer-modified-p nil))))) | |
1047 | |
1048 (defun mh-push-button (event) | |
1049 "Click MIME button for EVENT. | |
1050 | |
1051 If the MIME part is visible then it is removed. Otherwise the | |
1052 part is displayed. This function is called when the mouse is used | |
1053 to click the MIME button." | |
1054 (interactive "e") | |
1055 (mh-do-at-event-location event | |
1056 (let ((folder mh-show-folder-buffer) | |
1057 (mm-inline-media-tests mh-mm-inline-media-tests) | |
1058 (data (get-text-property (point) 'mh-data)) | |
1059 (function (get-text-property (point) 'mh-callback))) | |
1060 (flet ((mm-handle-set-external-undisplayer (handle func) | |
1061 (mh-handle-set-external-undisplayer folder handle func))) | |
1062 (and function (funcall function data)))))) | |
1063 | |
1064 (defun mh-handle-set-external-undisplayer (folder handle function) | |
1065 "Replacement for `mm-handle-set-external-undisplayer'. | |
1066 | |
1067 This is only called in recent versions of Gnus. The MIME handles | |
1068 are stored in data structures corresponding to MH-E folder buffer | |
1069 FOLDER instead of in Gnus (as in the original). The MIME part, | |
1070 HANDLE is associated with the undisplayer FUNCTION." | |
68520
6a7173abcf59
* mh-acros.el (mh-defun-compat, mh-defmacro-compat): Add name argument
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
1071 (if (mh-mm-keep-viewer-alive-p handle) |
68465 | 1072 (let ((new-handle (copy-sequence handle))) |
1073 (mm-handle-set-undisplayer new-handle function) | |
1074 (mm-handle-set-undisplayer handle nil) | |
105867
00c0adbb54a9
* mh-thread.el (mh-thread-set-tables):
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
101477
diff
changeset
|
1075 (with-current-buffer folder |
68465 | 1076 (push new-handle (mh-mime-handles (mh-buffer-data))))) |
1077 (mm-handle-set-undisplayer handle function))) | |
1078 | |
1079 (defun mh-mime-security-press-button (handle) | |
1080 "Callback from security button for part HANDLE." | |
68520
6a7173abcf59
* mh-acros.el (mh-defun-compat, mh-defmacro-compat): Add name argument
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
1081 (if (mh-mm-handle-multipart-ctl-parameter handle 'gnus-info) |
68465 | 1082 (mh-mime-security-show-details handle) |
68520
6a7173abcf59
* mh-acros.el (mh-defun-compat, mh-defmacro-compat): Add name argument
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
1083 (let ((region (mh-mm-handle-multipart-ctl-parameter handle 'mh-region)) |
68465 | 1084 point) |
1085 (setq point (point)) | |
1086 (goto-char (car region)) | |
1087 (delete-region (car region) (cdr region)) | |
68520
6a7173abcf59
* mh-acros.el (mh-defun-compat, mh-defmacro-compat): Add name argument
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
1088 (with-current-buffer (mh-mm-handle-multipart-ctl-parameter handle 'buffer) |
68465 | 1089 (let* ((mm-verify-option 'known) |
1090 (mm-decrypt-option 'known) | |
68520
6a7173abcf59
* mh-acros.el (mh-defun-compat, mh-defmacro-compat): Add name argument
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
1091 (new (mh-mm-possibly-verify-or-decrypt (cdr handle) handle))) |
68465 | 1092 (unless (eq new (cdr handle)) |
68520
6a7173abcf59
* mh-acros.el (mh-defun-compat, mh-defmacro-compat): Add name argument
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
1093 (mh-mm-destroy-parts (cdr handle)) |
68465 | 1094 (setcdr handle new)))) |
1095 (mh-mime-display-security handle) | |
1096 (goto-char point)))) | |
1097 | |
1098 ;; I rewrote the security part because Gnus doesn't seem to ever minimize | |
1099 ;; the button. That is once the mime-security button is pressed there seems | |
1100 ;; to be no way of getting rid of the inserted text. | |
1101 (defun mh-mime-security-show-details (handle) | |
1102 "Toggle display of detailed security info for HANDLE." | |
68520
6a7173abcf59
* mh-acros.el (mh-defun-compat, mh-defmacro-compat): Add name argument
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
1103 (let ((details (mh-mm-handle-multipart-ctl-parameter handle 'gnus-details))) |
68465 | 1104 (when details |
1105 (let ((mh-mime-security-button-pressed | |
1106 (not (get-text-property (point) 'mh-button-pressed))) | |
1107 (mh-mime-security-button-line-format | |
1108 (get-text-property (point) 'mh-line-format))) | |
1109 (forward-char -1) | |
1110 (while (eq (get-text-property (point) 'mh-line-format) | |
1111 mh-mime-security-button-line-format) | |
1112 (forward-char -1)) | |
1113 (forward-char) | |
1114 (save-restriction | |
1115 (narrow-to-region (point) (point)) | |
1116 (mh-insert-mime-security-button handle)) | |
1117 (delete-region | |
1118 (point) | |
1119 (or (text-property-not-all | |
1120 (point) (point-max) | |
1121 'mh-line-format mh-mime-security-button-line-format) | |
1122 (point-max))) | |
1123 (forward-line -1))))) | |
1124 | |
1125 | |
1126 | |
1127 ;;; Miscellaneous Article Washing | |
1128 | |
1129 ;;;###mh-autoload | |
1130 (defun mh-add-missing-mime-version-header () | |
1131 "Some mail programs don't put a MIME-Version header. | |
1132 I have seen this only in spam, so maybe we shouldn't fix | |
1133 this ;-)" | |
1134 (save-excursion | |
1135 (goto-char (point-min)) | |
1136 (re-search-forward "\n\n" nil t) | |
1137 (save-restriction | |
1138 (narrow-to-region (point-min) (point)) | |
1139 (when (and (message-fetch-field "content-type") | |
1140 (not (message-fetch-field "mime-version"))) | |
1141 (goto-char (point-min)) | |
1142 (insert "MIME-Version: 1.0\n"))))) | |
1143 | |
1144 ;;;###mh-autoload | |
1145 (defun mh-display-smileys () | |
1146 "Display smileys." | |
1147 (when (and mh-graphical-smileys-flag (mh-small-show-buffer-p)) | |
1148 (mh-funcall-if-exists smiley-region (point-min) (point-max)))) | |
1149 | |
1150 ;;;###mh-autoload | |
1151 (defun mh-display-emphasis () | |
1152 "Display graphical emphasis." | |
1153 (when (and mh-graphical-emphasis-flag (mh-small-show-buffer-p)) | |
1154 (flet ((article-goto-body ())) ; shadow this function to do nothing | |
1155 (save-excursion | |
1156 (goto-char (point-min)) | |
1157 (article-emphasize))))) | |
1158 | |
1159 (defun mh-small-show-buffer-p () | |
1160 "Check if show buffer is small. | |
1161 This is used to decide if smileys and graphical emphasis should be | |
1162 displayed." | |
1163 (let ((max nil)) | |
1164 (when (and (boundp 'font-lock-maximum-size) font-lock-maximum-size) | |
1165 (cond ((numberp font-lock-maximum-size) | |
1166 (setq max font-lock-maximum-size)) | |
1167 ((listp font-lock-maximum-size) | |
1168 (setq max (cdr (or (assoc 'mh-show-mode font-lock-maximum-size) | |
1169 (assoc t font-lock-maximum-size))))))) | |
1170 (or (not (numberp max)) (>= (/ max 8) (buffer-size))))) | |
1171 | |
1172 | |
1173 | |
1174 ;;; MH-Letter Commands | |
1175 | |
1176 ;; MH-E commands are alphabetical; specific support routines follow command. | |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1177 |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1178 ;;;###mh-autoload |
68130
dfa5a760e24f
* mh-comp.el (mh-insert-letter): If you choose a different folder, the
Bill Wohler <wohler@newt.com>
parents:
68125
diff
changeset
|
1179 (defun mh-compose-forward (&optional description folder range) |
66354
cf99ce27df54
* mh-comp.el (mh-letter-menu): Rename
Bill Wohler <wohler@newt.com>
parents:
66087
diff
changeset
|
1180 "Add tag to forward a message. |
67758
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67756
diff
changeset
|
1181 |
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67756
diff
changeset
|
1182 You are prompted for a content DESCRIPTION, the name of the |
68130
dfa5a760e24f
* mh-comp.el (mh-insert-letter): If you choose a different folder, the
Bill Wohler <wohler@newt.com>
parents:
68125
diff
changeset
|
1183 FOLDER in which the messages to forward are located, and a RANGE |
dfa5a760e24f
* mh-comp.el (mh-insert-letter): If you choose a different folder, the
Bill Wohler <wohler@newt.com>
parents:
68125
diff
changeset
|
1184 of messages, which defaults to the current message in that |
dfa5a760e24f
* mh-comp.el (mh-insert-letter): If you choose a different folder, the
Bill Wohler <wohler@newt.com>
parents:
68125
diff
changeset
|
1185 folder. Check the documentation of `mh-interactive-range' to see |
dfa5a760e24f
* mh-comp.el (mh-insert-letter): If you choose a different folder, the
Bill Wohler <wohler@newt.com>
parents:
68125
diff
changeset
|
1186 how RANGE is read in interactive use. |
66354
cf99ce27df54
* mh-comp.el (mh-letter-menu): Rename
Bill Wohler <wohler@newt.com>
parents:
66087
diff
changeset
|
1187 |
cf99ce27df54
* mh-comp.el (mh-letter-menu): Rename
Bill Wohler <wohler@newt.com>
parents:
66087
diff
changeset
|
1188 The option `mh-compose-insertion' controls what type of tags are inserted." |
68130
dfa5a760e24f
* mh-comp.el (mh-insert-letter): If you choose a different folder, the
Bill Wohler <wohler@newt.com>
parents:
68125
diff
changeset
|
1189 (interactive |
dfa5a760e24f
* mh-comp.el (mh-insert-letter): If you choose a different folder, the
Bill Wohler <wohler@newt.com>
parents:
68125
diff
changeset
|
1190 (let* ((description |
dfa5a760e24f
* mh-comp.el (mh-insert-letter): If you choose a different folder, the
Bill Wohler <wohler@newt.com>
parents:
68125
diff
changeset
|
1191 (mml-minibuffer-read-description)) |
dfa5a760e24f
* mh-comp.el (mh-insert-letter): If you choose a different folder, the
Bill Wohler <wohler@newt.com>
parents:
68125
diff
changeset
|
1192 (folder |
dfa5a760e24f
* mh-comp.el (mh-insert-letter): If you choose a different folder, the
Bill Wohler <wohler@newt.com>
parents:
68125
diff
changeset
|
1193 (mh-prompt-for-folder "Message from" |
dfa5a760e24f
* mh-comp.el (mh-insert-letter): If you choose a different folder, the
Bill Wohler <wohler@newt.com>
parents:
68125
diff
changeset
|
1194 mh-sent-from-folder nil)) |
dfa5a760e24f
* mh-comp.el (mh-insert-letter): If you choose a different folder, the
Bill Wohler <wohler@newt.com>
parents:
68125
diff
changeset
|
1195 (default |
dfa5a760e24f
* mh-comp.el (mh-insert-letter): If you choose a different folder, the
Bill Wohler <wohler@newt.com>
parents:
68125
diff
changeset
|
1196 (if (and (equal folder mh-sent-from-folder) |
dfa5a760e24f
* mh-comp.el (mh-insert-letter): If you choose a different folder, the
Bill Wohler <wohler@newt.com>
parents:
68125
diff
changeset
|
1197 (numberp mh-sent-from-msg)) |
dfa5a760e24f
* mh-comp.el (mh-insert-letter): If you choose a different folder, the
Bill Wohler <wohler@newt.com>
parents:
68125
diff
changeset
|
1198 mh-sent-from-msg |
dfa5a760e24f
* mh-comp.el (mh-insert-letter): If you choose a different folder, the
Bill Wohler <wohler@newt.com>
parents:
68125
diff
changeset
|
1199 (nth 0 (mh-translate-range folder "cur")))) |
dfa5a760e24f
* mh-comp.el (mh-insert-letter): If you choose a different folder, the
Bill Wohler <wohler@newt.com>
parents:
68125
diff
changeset
|
1200 (range |
dfa5a760e24f
* mh-comp.el (mh-insert-letter): If you choose a different folder, the
Bill Wohler <wohler@newt.com>
parents:
68125
diff
changeset
|
1201 (mh-read-range "Forward" folder |
dfa5a760e24f
* mh-comp.el (mh-insert-letter): If you choose a different folder, the
Bill Wohler <wohler@newt.com>
parents:
68125
diff
changeset
|
1202 (or (and default |
dfa5a760e24f
* mh-comp.el (mh-insert-letter): If you choose a different folder, the
Bill Wohler <wohler@newt.com>
parents:
68125
diff
changeset
|
1203 (number-to-string default)) |
dfa5a760e24f
* mh-comp.el (mh-insert-letter): If you choose a different folder, the
Bill Wohler <wohler@newt.com>
parents:
68125
diff
changeset
|
1204 t) |
dfa5a760e24f
* mh-comp.el (mh-insert-letter): If you choose a different folder, the
Bill Wohler <wohler@newt.com>
parents:
68125
diff
changeset
|
1205 t t))) |
dfa5a760e24f
* mh-comp.el (mh-insert-letter): If you choose a different folder, the
Bill Wohler <wohler@newt.com>
parents:
68125
diff
changeset
|
1206 (list description folder range))) |
dfa5a760e24f
* mh-comp.el (mh-insert-letter): If you choose a different folder, the
Bill Wohler <wohler@newt.com>
parents:
68125
diff
changeset
|
1207 (let ((messages (mapconcat 'identity (mh-list-to-string range) " "))) |
dfa5a760e24f
* mh-comp.el (mh-insert-letter): If you choose a different folder, the
Bill Wohler <wohler@newt.com>
parents:
68125
diff
changeset
|
1208 (dolist (message (mh-translate-range folder messages)) |
66354
cf99ce27df54
* mh-comp.el (mh-letter-menu): Rename
Bill Wohler <wohler@newt.com>
parents:
66087
diff
changeset
|
1209 (if (equal mh-compose-insertion 'mml) |
68104
b10ff4551ab2
Use consistent verbiage with compiler defvars.
Bill Wohler <wohler@newt.com>
parents:
68096
diff
changeset
|
1210 (mh-mml-forward-message description folder (format "%s" message)) |
b10ff4551ab2
Use consistent verbiage with compiler defvars.
Bill Wohler <wohler@newt.com>
parents:
68096
diff
changeset
|
1211 (mh-mh-forward-message description folder (format "%s" message)))))) |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1212 |
68465 | 1213 ;;;###mh-autoload |
1214 (defun mh-mml-forward-message (description folder message) | |
1215 "Forward a message as attachment. | |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1216 |
68465 | 1217 The function will prompt the user for a DESCRIPTION, a FOLDER and |
1218 MESSAGE number." | |
1219 (let ((msg (if (and (equal message "") (numberp mh-sent-from-msg)) | |
1220 mh-sent-from-msg | |
1221 (string-to-number message)))) | |
1222 (cond ((integerp msg) | |
82476
c4d5c23a6b0a
(mh-mml-forward-message): Address SF 1378993 and
Jeffrey C Honig <jch@bsdi.com>
parents:
82473
diff
changeset
|
1223 (mml-attach-file (format "%s%s/%d" |
c4d5c23a6b0a
(mh-mml-forward-message): Address SF 1378993 and
Jeffrey C Honig <jch@bsdi.com>
parents:
82473
diff
changeset
|
1224 mh-user-path (substring folder 1) msg) |
c4d5c23a6b0a
(mh-mml-forward-message): Address SF 1378993 and
Jeffrey C Honig <jch@bsdi.com>
parents:
82473
diff
changeset
|
1225 "message/rfc822" |
c4d5c23a6b0a
(mh-mml-forward-message): Address SF 1378993 and
Jeffrey C Honig <jch@bsdi.com>
parents:
82473
diff
changeset
|
1226 (if (string= "" description) nil description) |
c4d5c23a6b0a
(mh-mml-forward-message): Address SF 1378993 and
Jeffrey C Honig <jch@bsdi.com>
parents:
82473
diff
changeset
|
1227 "inline")) |
68465 | 1228 (t (error "The message number, %s, is not a integer" msg))))) |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1229 |
68465 | 1230 (defun mh-mh-forward-message (&optional description folder messages) |
1231 "Add tag to forward a message. | |
1232 You are prompted for a content DESCRIPTION, the name of the | |
1233 FOLDER in which the messages to forward are located, and the | |
1234 MESSAGES' numbers. | |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1235 |
68465 | 1236 See also \\[mh-mh-to-mime]." |
1237 (interactive (list | |
1238 (mml-minibuffer-read-description) | |
1239 (mh-prompt-for-folder "Message from" mh-sent-from-folder nil) | |
1240 (read-string (concat "Messages" | |
1241 (if (numberp mh-sent-from-msg) | |
1242 (format " (default %d): " | |
1243 mh-sent-from-msg) | |
1244 ": "))))) | |
1245 (beginning-of-line) | |
1246 (insert "#forw [") | |
1247 (and description | |
1248 (not (string= description "")) | |
1249 (insert description)) | |
1250 (insert "]") | |
1251 (and folder | |
1252 (not (string= folder "")) | |
1253 (insert " " folder)) | |
1254 (if (and messages | |
1255 (not (string= messages ""))) | |
1256 (let ((start (point))) | |
1257 (insert " " messages) | |
1258 (subst-char-in-region start (point) ?, ? )) | |
1259 (if (numberp mh-sent-from-msg) | |
1260 (insert " " (int-to-string mh-sent-from-msg)))) | |
1261 (insert "\n")) | |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1262 |
56673
e9a6cbc8ca5e
Upgraded to MH-E version 7.4.80.
Bill Wohler <wohler@newt.com>
parents:
56406
diff
changeset
|
1263 ;;;###mh-autoload |
68465 | 1264 (defun mh-compose-insertion (&optional inline) |
1265 "Add tag to include a file such as an image or sound. | |
1266 | |
1267 You are prompted for the filename containing the object, the | |
1268 media type if it cannot be determined automatically, and a | |
1269 content description. If you're using MH-style directives, you | |
1270 will also be prompted for additional attributes. | |
1271 | |
1272 The option `mh-compose-insertion' controls what type of tags are | |
1273 inserted. Optional argument INLINE means make it an inline | |
1274 attachment." | |
1275 (interactive "P") | |
1276 (if (equal mh-compose-insertion 'mml) | |
1277 (if inline | |
1278 (mh-mml-attach-file "inline") | |
1279 (mh-mml-attach-file)) | |
1280 (call-interactively 'mh-mh-attach-file))) | |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1281 |
68465 | 1282 (defun mh-mml-attach-file (&optional disposition) |
1283 "Add a tag to insert a MIME message part from a file. | |
1284 | |
1285 You are prompted for the filename containing the object, the | |
1286 media type if it cannot be determined automatically, a content | |
1287 description and the DISPOSITION of the attachment. | |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1288 |
68465 | 1289 This is basically `mml-attach-file' from Gnus, modified such that a prefix |
1290 argument yields an \"inline\" disposition and Content-Type is determined | |
1291 automatically." | |
1292 (let* ((file (mml-minibuffer-read-file "Attach file: ")) | |
1293 (type (mh-minibuffer-read-type file)) | |
1294 (description (mml-minibuffer-read-description)) | |
1295 (dispos (or disposition | |
68520
6a7173abcf59
* mh-acros.el (mh-defun-compat, mh-defmacro-compat): Add name argument
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
1296 (mh-mml-minibuffer-read-disposition type)))) |
68465 | 1297 (mml-insert-empty-tag 'part 'type type 'filename file |
1298 'disposition dispos 'description description))) | |
56673
e9a6cbc8ca5e
Upgraded to MH-E version 7.4.80.
Bill Wohler <wohler@newt.com>
parents:
56406
diff
changeset
|
1299 |
66354
cf99ce27df54
* mh-comp.el (mh-letter-menu): Rename
Bill Wohler <wohler@newt.com>
parents:
66087
diff
changeset
|
1300 (defun mh-mh-attach-file (filename type description attributes) |
cf99ce27df54
* mh-comp.el (mh-letter-menu): Rename
Bill Wohler <wohler@newt.com>
parents:
66087
diff
changeset
|
1301 "Add a tag to insert a MIME message part from a file. |
67758
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67756
diff
changeset
|
1302 You are prompted for the FILENAME containing the object, the |
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67756
diff
changeset
|
1303 media TYPE if it cannot be determined automatically, and a |
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67756
diff
changeset
|
1304 content DESCRIPTION. In addition, you are also prompted for |
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67756
diff
changeset
|
1305 additional ATTRIBUTES. |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1306 |
66354
cf99ce27df54
* mh-comp.el (mh-letter-menu): Rename
Bill Wohler <wohler@newt.com>
parents:
66087
diff
changeset
|
1307 See also \\[mh-mh-to-mime]." |
cf99ce27df54
* mh-comp.el (mh-letter-menu): Rename
Bill Wohler <wohler@newt.com>
parents:
66087
diff
changeset
|
1308 (interactive (let ((filename (mml-minibuffer-read-file "Attach file: "))) |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1309 (list |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1310 filename |
66354
cf99ce27df54
* mh-comp.el (mh-letter-menu): Rename
Bill Wohler <wohler@newt.com>
parents:
66087
diff
changeset
|
1311 (mh-minibuffer-read-type filename) |
cf99ce27df54
* mh-comp.el (mh-letter-menu): Rename
Bill Wohler <wohler@newt.com>
parents:
66087
diff
changeset
|
1312 (mml-minibuffer-read-description) |
cf99ce27df54
* mh-comp.el (mh-letter-menu): Rename
Bill Wohler <wohler@newt.com>
parents:
66087
diff
changeset
|
1313 (read-string "Attributes: " |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1314 (concat "name=\"" |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1315 (file-name-nondirectory filename) |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1316 "\""))))) |
66354
cf99ce27df54
* mh-comp.el (mh-letter-menu): Rename
Bill Wohler <wohler@newt.com>
parents:
66087
diff
changeset
|
1317 (mh-mh-compose-type filename type description attributes)) |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1318 |
66354
cf99ce27df54
* mh-comp.el (mh-letter-menu): Rename
Bill Wohler <wohler@newt.com>
parents:
66087
diff
changeset
|
1319 (defun mh-mh-compose-type (filename type |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1320 &optional description attributes comment) |
66354
cf99ce27df54
* mh-comp.el (mh-letter-menu): Rename
Bill Wohler <wohler@newt.com>
parents:
66087
diff
changeset
|
1321 "Insert an MH-style directive to insert a file. |
67758
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67756
diff
changeset
|
1322 The file specified by FILENAME is encoded as TYPE. An optional |
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67756
diff
changeset
|
1323 DESCRIPTION is used as the Content-Description field, optional |
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67756
diff
changeset
|
1324 set of ATTRIBUTES and an optional COMMENT can also be included." |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1325 (beginning-of-line) |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1326 (insert "#" type) |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1327 (and attributes |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1328 (insert "; " attributes)) |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1329 (and comment |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1330 (insert " (" comment ")")) |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1331 (insert " [") |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1332 (and description |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1333 (insert description)) |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1334 (insert "] " (expand-file-name filename)) |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1335 (insert "\n")) |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1336 |
66354
cf99ce27df54
* mh-comp.el (mh-letter-menu): Rename
Bill Wohler <wohler@newt.com>
parents:
66087
diff
changeset
|
1337 ;;;###mh-autoload |
cf99ce27df54
* mh-comp.el (mh-letter-menu): Rename
Bill Wohler <wohler@newt.com>
parents:
66087
diff
changeset
|
1338 (defun mh-mh-compose-anon-ftp (host filename type description) |
cf99ce27df54
* mh-comp.el (mh-letter-menu): Rename
Bill Wohler <wohler@newt.com>
parents:
66087
diff
changeset
|
1339 "Add tag to include anonymous ftp reference to a file. |
67988
7882fc7df359
* mh-alias.el (mh-alias-grab-from-field): Remove leading * from
Bill Wohler <wohler@newt.com>
parents:
67984
diff
changeset
|
1340 |
7882fc7df359
* mh-alias.el (mh-alias-grab-from-field): Remove leading * from
Bill Wohler <wohler@newt.com>
parents:
67984
diff
changeset
|
1341 You can have your message initiate an \"ftp\" transfer when the |
7882fc7df359
* mh-alias.el (mh-alias-grab-from-field): Remove leading * from
Bill Wohler <wohler@newt.com>
parents:
67984
diff
changeset
|
1342 recipient reads the message. You are prompted for the remote HOST |
7882fc7df359
* mh-alias.el (mh-alias-grab-from-field): Remove leading * from
Bill Wohler <wohler@newt.com>
parents:
67984
diff
changeset
|
1343 and FILENAME, the media TYPE, and the content DESCRIPTION. |
66354
cf99ce27df54
* mh-comp.el (mh-letter-menu): Rename
Bill Wohler <wohler@newt.com>
parents:
66087
diff
changeset
|
1344 |
cf99ce27df54
* mh-comp.el (mh-letter-menu): Rename
Bill Wohler <wohler@newt.com>
parents:
66087
diff
changeset
|
1345 See also \\[mh-mh-to-mime]." |
cf99ce27df54
* mh-comp.el (mh-letter-menu): Rename
Bill Wohler <wohler@newt.com>
parents:
66087
diff
changeset
|
1346 (interactive (list |
cf99ce27df54
* mh-comp.el (mh-letter-menu): Rename
Bill Wohler <wohler@newt.com>
parents:
66087
diff
changeset
|
1347 (read-string "Remote host: ") |
cf99ce27df54
* mh-comp.el (mh-letter-menu): Rename
Bill Wohler <wohler@newt.com>
parents:
66087
diff
changeset
|
1348 (read-string "Remote filename: ") |
cf99ce27df54
* mh-comp.el (mh-letter-menu): Rename
Bill Wohler <wohler@newt.com>
parents:
66087
diff
changeset
|
1349 (mh-minibuffer-read-type "DUMMY-FILENAME") |
cf99ce27df54
* mh-comp.el (mh-letter-menu): Rename
Bill Wohler <wohler@newt.com>
parents:
66087
diff
changeset
|
1350 (mml-minibuffer-read-description))) |
cf99ce27df54
* mh-comp.el (mh-letter-menu): Rename
Bill Wohler <wohler@newt.com>
parents:
66087
diff
changeset
|
1351 (mh-mh-compose-external-type "anon-ftp" host filename |
cf99ce27df54
* mh-comp.el (mh-letter-menu): Rename
Bill Wohler <wohler@newt.com>
parents:
66087
diff
changeset
|
1352 type description)) |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1353 |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1354 ;;;###mh-autoload |
66354
cf99ce27df54
* mh-comp.el (mh-letter-menu): Rename
Bill Wohler <wohler@newt.com>
parents:
66087
diff
changeset
|
1355 (defun mh-mh-compose-external-compressed-tar (host filename description) |
cf99ce27df54
* mh-comp.el (mh-letter-menu): Rename
Bill Wohler <wohler@newt.com>
parents:
66087
diff
changeset
|
1356 "Add tag to include anonymous ftp reference to a compressed tar file. |
67988
7882fc7df359
* mh-alias.el (mh-alias-grab-from-field): Remove leading * from
Bill Wohler <wohler@newt.com>
parents:
67984
diff
changeset
|
1357 |
67758
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67756
diff
changeset
|
1358 In addition to retrieving the file via anonymous \"ftp\" as per |
67988
7882fc7df359
* mh-alias.el (mh-alias-grab-from-field): Remove leading * from
Bill Wohler <wohler@newt.com>
parents:
67984
diff
changeset
|
1359 the command \\[mh-mh-compose-anon-ftp], the file will also be |
67758
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67756
diff
changeset
|
1360 uncompressed and untarred. You are prompted for the remote HOST |
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67756
diff
changeset
|
1361 and FILENAME and the content DESCRIPTION. |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1362 |
66354
cf99ce27df54
* mh-comp.el (mh-letter-menu): Rename
Bill Wohler <wohler@newt.com>
parents:
66087
diff
changeset
|
1363 See also \\[mh-mh-to-mime]." |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1364 (interactive (list |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1365 (read-string "Remote host: ") |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1366 (read-string "Remote filename: ") |
66354
cf99ce27df54
* mh-comp.el (mh-letter-menu): Rename
Bill Wohler <wohler@newt.com>
parents:
66087
diff
changeset
|
1367 (mml-minibuffer-read-description))) |
cf99ce27df54
* mh-comp.el (mh-letter-menu): Rename
Bill Wohler <wohler@newt.com>
parents:
66087
diff
changeset
|
1368 (mh-mh-compose-external-type "anon-ftp" host filename |
cf99ce27df54
* mh-comp.el (mh-letter-menu): Rename
Bill Wohler <wohler@newt.com>
parents:
66087
diff
changeset
|
1369 "application/octet-stream" |
cf99ce27df54
* mh-comp.el (mh-letter-menu): Rename
Bill Wohler <wohler@newt.com>
parents:
66087
diff
changeset
|
1370 description |
cf99ce27df54
* mh-comp.el (mh-letter-menu): Rename
Bill Wohler <wohler@newt.com>
parents:
66087
diff
changeset
|
1371 "type=tar; conversions=x-compress" |
cf99ce27df54
* mh-comp.el (mh-letter-menu): Rename
Bill Wohler <wohler@newt.com>
parents:
66087
diff
changeset
|
1372 "mode=image")) |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1373 |
68465 | 1374 ;; RFC 2045 - Multipurpose Internet Mail Extensions (MIME) Part One: |
1375 ;; Format of Internet Message Bodies. | |
1376 ;; RFC 2046 - Multipurpose Internet Mail Extensions (MIME) Part Two: | |
1377 ;; Media Types. | |
1378 ;; RFC 2049 - Multipurpose Internet Mail Extensions (MIME) Part Five: | |
1379 ;; Conformance Criteria and Examples. | |
1380 ;; RFC 2017 - Definition of the URL MIME External-Body Access-Type | |
1381 ;; RFC 1738 - Uniform Resource Locators (URL) | |
1382 (defvar mh-access-types | |
1383 '(("anon-ftp") ; RFC2046 Anonymous File Transfer Protocol | |
1384 ("file") ; RFC1738 Host-specific file names | |
1385 ("ftp") ; RFC2046 File Transfer Protocol | |
1386 ("gopher") ; RFC1738 The Gopher Protocol | |
1387 ("http") ; RFC1738 Hypertext Transfer Protocol | |
1388 ("local-file") ; RFC2046 Local file access | |
1389 ("mail-server") ; RFC2046 mail-server Electronic mail address | |
1390 ("mailto") ; RFC1738 Electronic mail address | |
1391 ("news") ; RFC1738 Usenet news | |
1392 ("nntp") ; RFC1738 Usenet news using NNTP access | |
1393 ("propspero") ; RFC1738 Prospero Directory Service | |
1394 ("telnet") ; RFC1738 Telnet | |
1395 ("tftp") ; RFC2046 Trivial File Transfer Protocol | |
1396 ("url") ; RFC2017 URL scheme MIME access-type Protocol | |
1397 ("wais")) ; RFC1738 Wide Area Information Servers | |
1398 "Valid MIME access-type values.") | |
1399 | |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1400 ;;;###mh-autoload |
66354
cf99ce27df54
* mh-comp.el (mh-letter-menu): Rename
Bill Wohler <wohler@newt.com>
parents:
66087
diff
changeset
|
1401 (defun mh-mh-compose-external-type (access-type host filename type |
cf99ce27df54
* mh-comp.el (mh-letter-menu): Rename
Bill Wohler <wohler@newt.com>
parents:
66087
diff
changeset
|
1402 &optional description |
cf99ce27df54
* mh-comp.el (mh-letter-menu): Rename
Bill Wohler <wohler@newt.com>
parents:
66087
diff
changeset
|
1403 attributes parameters |
cf99ce27df54
* mh-comp.el (mh-letter-menu): Rename
Bill Wohler <wohler@newt.com>
parents:
66087
diff
changeset
|
1404 comment) |
cf99ce27df54
* mh-comp.el (mh-letter-menu): Rename
Bill Wohler <wohler@newt.com>
parents:
66087
diff
changeset
|
1405 "Add tag to refer to a remote file. |
67988
7882fc7df359
* mh-alias.el (mh-alias-grab-from-field): Remove leading * from
Bill Wohler <wohler@newt.com>
parents:
67984
diff
changeset
|
1406 |
67758
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67756
diff
changeset
|
1407 This command is a general utility for referencing external files. |
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67756
diff
changeset
|
1408 In fact, all of the other commands that insert directives to |
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67756
diff
changeset
|
1409 access external files call this command. You are prompted for the |
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67756
diff
changeset
|
1410 ACCESS-TYPE, remote HOST and FILENAME, and content TYPE. If you |
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67756
diff
changeset
|
1411 provide a prefix argument, you are also prompted for a content |
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67756
diff
changeset
|
1412 DESCRIPTION, ATTRIBUTES, PARAMETERS, and a COMMENT. |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1413 |
66354
cf99ce27df54
* mh-comp.el (mh-letter-menu): Rename
Bill Wohler <wohler@newt.com>
parents:
66087
diff
changeset
|
1414 See also \\[mh-mh-to-mime]." |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1415 (interactive (list |
66354
cf99ce27df54
* mh-comp.el (mh-letter-menu): Rename
Bill Wohler <wohler@newt.com>
parents:
66087
diff
changeset
|
1416 (completing-read "Access type: " mh-access-types) |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1417 (read-string "Remote host: ") |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1418 (read-string "Remote filename: ") |
66354
cf99ce27df54
* mh-comp.el (mh-letter-menu): Rename
Bill Wohler <wohler@newt.com>
parents:
66087
diff
changeset
|
1419 (mh-minibuffer-read-type "DUMMY-FILENAME") |
cf99ce27df54
* mh-comp.el (mh-letter-menu): Rename
Bill Wohler <wohler@newt.com>
parents:
66087
diff
changeset
|
1420 (if current-prefix-arg (mml-minibuffer-read-description)) |
56673
e9a6cbc8ca5e
Upgraded to MH-E version 7.4.80.
Bill Wohler <wohler@newt.com>
parents:
56406
diff
changeset
|
1421 (if current-prefix-arg (read-string "Attributes: ")) |
66354
cf99ce27df54
* mh-comp.el (mh-letter-menu): Rename
Bill Wohler <wohler@newt.com>
parents:
66087
diff
changeset
|
1422 (if current-prefix-arg (read-string "Parameters: ")) |
56673
e9a6cbc8ca5e
Upgraded to MH-E version 7.4.80.
Bill Wohler <wohler@newt.com>
parents:
56406
diff
changeset
|
1423 (if current-prefix-arg (read-string "Comment: ")))) |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1424 (beginning-of-line) |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1425 (insert "#@" type) |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1426 (and attributes |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1427 (insert "; " attributes)) |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1428 (and comment |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1429 (insert " (" comment ") ")) |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1430 (insert " [") |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1431 (and description |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1432 (insert description)) |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1433 (insert "] ") |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1434 (insert "access-type=" access-type "; ") |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1435 (insert "site=" host) |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1436 (insert "; name=" (file-name-nondirectory filename)) |
56673
e9a6cbc8ca5e
Upgraded to MH-E version 7.4.80.
Bill Wohler <wohler@newt.com>
parents:
56406
diff
changeset
|
1437 (let ((directory (file-name-directory filename))) |
e9a6cbc8ca5e
Upgraded to MH-E version 7.4.80.
Bill Wohler <wohler@newt.com>
parents:
56406
diff
changeset
|
1438 (and directory |
e9a6cbc8ca5e
Upgraded to MH-E version 7.4.80.
Bill Wohler <wohler@newt.com>
parents:
56406
diff
changeset
|
1439 (insert "; directory=\"" directory "\""))) |
66354
cf99ce27df54
* mh-comp.el (mh-letter-menu): Rename
Bill Wohler <wohler@newt.com>
parents:
66087
diff
changeset
|
1440 (and parameters |
cf99ce27df54
* mh-comp.el (mh-letter-menu): Rename
Bill Wohler <wohler@newt.com>
parents:
66087
diff
changeset
|
1441 (insert "; " parameters)) |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1442 (insert "\n")) |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1443 |
68465 | 1444 (defvar mh-mh-to-mime-args nil |
1445 "Extra arguments for \\[mh-mh-to-mime] to pass to the \"mhbuild\" command. | |
1446 The arguments are passed to \"mhbuild\" if \\[mh-mh-to-mime] is | |
1447 given a prefix argument. Normally default arguments to | |
1448 \"mhbuild\" are specified in the MH profile.") | |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1449 |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1450 ;;;###mh-autoload |
66354
cf99ce27df54
* mh-comp.el (mh-letter-menu): Rename
Bill Wohler <wohler@newt.com>
parents:
66087
diff
changeset
|
1451 (defun mh-mh-to-mime (&optional extra-args) |
cf99ce27df54
* mh-comp.el (mh-letter-menu): Rename
Bill Wohler <wohler@newt.com>
parents:
66087
diff
changeset
|
1452 "Compose MIME message from MH-style directives. |
67756
7ff92ad99326
* mh-alias.el (mh-alias-reload): Sync docstrings with manual.
Bill Wohler <wohler@newt.com>
parents:
67681
diff
changeset
|
1453 |
67758
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67756
diff
changeset
|
1454 Typically, you send a message with attachments just like any other |
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67756
diff
changeset
|
1455 message. However, you may take a sneak preview of the MIME encoding if |
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67756
diff
changeset
|
1456 you wish by running this command. |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1457 |
67988
7882fc7df359
* mh-alias.el (mh-alias-grab-from-field): Remove leading * from
Bill Wohler <wohler@newt.com>
parents:
67984
diff
changeset
|
1458 If you wish to pass additional arguments to \"mhbuild\" (\"mhn\") |
7882fc7df359
* mh-alias.el (mh-alias-grab-from-field): Remove leading * from
Bill Wohler <wohler@newt.com>
parents:
67984
diff
changeset
|
1459 to affect how it builds your message, use the option |
7882fc7df359
* mh-alias.el (mh-alias-grab-from-field): Remove leading * from
Bill Wohler <wohler@newt.com>
parents:
67984
diff
changeset
|
1460 `mh-mh-to-mime-args'. For example, you can build a consistency |
7882fc7df359
* mh-alias.el (mh-alias-grab-from-field): Remove leading * from
Bill Wohler <wohler@newt.com>
parents:
67984
diff
changeset
|
1461 check into the message by setting `mh-mh-to-mime-args' to |
7882fc7df359
* mh-alias.el (mh-alias-grab-from-field): Remove leading * from
Bill Wohler <wohler@newt.com>
parents:
67984
diff
changeset
|
1462 \"-check\". The recipient of your message can then run \"mhbuild |
7882fc7df359
* mh-alias.el (mh-alias-grab-from-field): Remove leading * from
Bill Wohler <wohler@newt.com>
parents:
67984
diff
changeset
|
1463 -check\" on the message--\"mhbuild\" (\"mhn\") will complain if |
7882fc7df359
* mh-alias.el (mh-alias-grab-from-field): Remove leading * from
Bill Wohler <wohler@newt.com>
parents:
67984
diff
changeset
|
1464 the message has been corrupted on the way. This command only |
7882fc7df359
* mh-alias.el (mh-alias-grab-from-field): Remove leading * from
Bill Wohler <wohler@newt.com>
parents:
67984
diff
changeset
|
1465 consults this option when given a prefix argument EXTRA-ARGS. |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1466 |
67756
7ff92ad99326
* mh-alias.el (mh-alias-reload): Sync docstrings with manual.
Bill Wohler <wohler@newt.com>
parents:
67681
diff
changeset
|
1467 The hook `mh-mh-to-mime-hook' is called after the message has been |
7ff92ad99326
* mh-alias.el (mh-alias-reload): Sync docstrings with manual.
Bill Wohler <wohler@newt.com>
parents:
67681
diff
changeset
|
1468 formatted. |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1469 |
67758
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67756
diff
changeset
|
1470 The effects of this command can be undone by running |
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67756
diff
changeset
|
1471 \\[mh-mh-to-mime-undo]." |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1472 (interactive "*P") |
66354
cf99ce27df54
* mh-comp.el (mh-letter-menu): Rename
Bill Wohler <wohler@newt.com>
parents:
66087
diff
changeset
|
1473 (mh-mh-quote-unescaped-sharp) |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1474 (save-buffer) |
66354
cf99ce27df54
* mh-comp.el (mh-letter-menu): Rename
Bill Wohler <wohler@newt.com>
parents:
66087
diff
changeset
|
1475 (message "Running %s..." (if (mh-variant-p 'nmh) "mhbuild" "mhn")) |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1476 (cond |
56673
e9a6cbc8ca5e
Upgraded to MH-E version 7.4.80.
Bill Wohler <wohler@newt.com>
parents:
56406
diff
changeset
|
1477 ((mh-variant-p 'nmh) |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1478 (mh-exec-cmd-error nil |
66354
cf99ce27df54
* mh-comp.el (mh-letter-menu): Rename
Bill Wohler <wohler@newt.com>
parents:
66087
diff
changeset
|
1479 "mhbuild" |
cf99ce27df54
* mh-comp.el (mh-letter-menu): Rename
Bill Wohler <wohler@newt.com>
parents:
66087
diff
changeset
|
1480 (if extra-args mh-mh-to-mime-args) |
cf99ce27df54
* mh-comp.el (mh-letter-menu): Rename
Bill Wohler <wohler@newt.com>
parents:
66087
diff
changeset
|
1481 buffer-file-name)) |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1482 (t |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1483 (mh-exec-cmd-error (format "mhdraft=%s" buffer-file-name) |
66354
cf99ce27df54
* mh-comp.el (mh-letter-menu): Rename
Bill Wohler <wohler@newt.com>
parents:
66087
diff
changeset
|
1484 "mhn" |
cf99ce27df54
* mh-comp.el (mh-letter-menu): Rename
Bill Wohler <wohler@newt.com>
parents:
66087
diff
changeset
|
1485 (if extra-args mh-mh-to-mime-args) |
cf99ce27df54
* mh-comp.el (mh-letter-menu): Rename
Bill Wohler <wohler@newt.com>
parents:
66087
diff
changeset
|
1486 buffer-file-name))) |
95100
c2fcfe84918f
(mh-mh-to-mime, mh-mh-to-mime-undo): Preserve modes when converting to
Bill Wohler <wohler@newt.com>
parents:
94663
diff
changeset
|
1487 (revert-buffer t t t) |
66354
cf99ce27df54
* mh-comp.el (mh-letter-menu): Rename
Bill Wohler <wohler@newt.com>
parents:
66087
diff
changeset
|
1488 (message "Running %s...done" (if (mh-variant-p 'nmh) "mhbuild" "mhn")) |
cf99ce27df54
* mh-comp.el (mh-letter-menu): Rename
Bill Wohler <wohler@newt.com>
parents:
66087
diff
changeset
|
1489 (run-hooks 'mh-mh-to-mime-hook)) |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1490 |
66354
cf99ce27df54
* mh-comp.el (mh-letter-menu): Rename
Bill Wohler <wohler@newt.com>
parents:
66087
diff
changeset
|
1491 (defun mh-mh-quote-unescaped-sharp () |
67760
9c3504ae6060
Follow MH-E Developers Guide conventions. Use `' quotes for Help
Bill Wohler <wohler@newt.com>
parents:
67759
diff
changeset
|
1492 "Quote \"#\" characters that haven't been quoted for \"mhbuild\". |
9c3504ae6060
Follow MH-E Developers Guide conventions. Use `' quotes for Help
Bill Wohler <wohler@newt.com>
parents:
67759
diff
changeset
|
1493 If the \"#\" character is present in the first column, but it isn't |
67758
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67756
diff
changeset
|
1494 part of a MH-style directive then \"mhbuild\" gives an error. |
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67756
diff
changeset
|
1495 This function will quote all such characters." |
56673
e9a6cbc8ca5e
Upgraded to MH-E version 7.4.80.
Bill Wohler <wohler@newt.com>
parents:
56406
diff
changeset
|
1496 (save-excursion |
e9a6cbc8ca5e
Upgraded to MH-E version 7.4.80.
Bill Wohler <wohler@newt.com>
parents:
56406
diff
changeset
|
1497 (goto-char (point-min)) |
e9a6cbc8ca5e
Upgraded to MH-E version 7.4.80.
Bill Wohler <wohler@newt.com>
parents:
56406
diff
changeset
|
1498 (while (re-search-forward "^#" nil t) |
e9a6cbc8ca5e
Upgraded to MH-E version 7.4.80.
Bill Wohler <wohler@newt.com>
parents:
56406
diff
changeset
|
1499 (beginning-of-line) |
68529
7daec5f4a289
* mh-alias.el (mh-alias-gecos-name): Use mh-replace-regexp-in-string
Bill Wohler <wohler@newt.com>
parents:
68520
diff
changeset
|
1500 (unless (mh-mh-directive-present-p (point) (mh-line-end-position)) |
56673
e9a6cbc8ca5e
Upgraded to MH-E version 7.4.80.
Bill Wohler <wohler@newt.com>
parents:
56406
diff
changeset
|
1501 (insert "#")) |
68529
7daec5f4a289
* mh-alias.el (mh-alias-gecos-name): Use mh-replace-regexp-in-string
Bill Wohler <wohler@newt.com>
parents:
68520
diff
changeset
|
1502 (goto-char (mh-line-end-position))))) |
56673
e9a6cbc8ca5e
Upgraded to MH-E version 7.4.80.
Bill Wohler <wohler@newt.com>
parents:
56406
diff
changeset
|
1503 |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1504 ;;;###mh-autoload |
66354
cf99ce27df54
* mh-comp.el (mh-letter-menu): Rename
Bill Wohler <wohler@newt.com>
parents:
66087
diff
changeset
|
1505 (defun mh-mh-to-mime-undo (noconfirm) |
cf99ce27df54
* mh-comp.el (mh-letter-menu): Rename
Bill Wohler <wohler@newt.com>
parents:
66087
diff
changeset
|
1506 "Undo effects of \\[mh-mh-to-mime]. |
67988
7882fc7df359
* mh-alias.el (mh-alias-grab-from-field): Remove leading * from
Bill Wohler <wohler@newt.com>
parents:
67984
diff
changeset
|
1507 |
7882fc7df359
* mh-alias.el (mh-alias-grab-from-field): Remove leading * from
Bill Wohler <wohler@newt.com>
parents:
67984
diff
changeset
|
1508 It does this by reverting to a backup file. You are prompted to |
7882fc7df359
* mh-alias.el (mh-alias-grab-from-field): Remove leading * from
Bill Wohler <wohler@newt.com>
parents:
67984
diff
changeset
|
1509 confirm this action, but you can avoid the confirmation by adding |
7882fc7df359
* mh-alias.el (mh-alias-grab-from-field): Remove leading * from
Bill Wohler <wohler@newt.com>
parents:
67984
diff
changeset
|
1510 a prefix argument NOCONFIRM." |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1511 (interactive "*P") |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1512 (if (null buffer-file-name) |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1513 (error "Buffer does not seem to be associated with any file")) |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1514 (let ((backup-strings '("," "#")) |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1515 backup-file) |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1516 (while (and backup-strings |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1517 (not (file-exists-p |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1518 (setq backup-file |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1519 (concat (file-name-directory buffer-file-name) |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1520 (car backup-strings) |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1521 (file-name-nondirectory buffer-file-name) |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1522 ".orig"))))) |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1523 (setq backup-strings (cdr backup-strings))) |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1524 (or backup-strings |
68013
bbc0e52abce5
* mh-alias.el (mh-alias-add-alias): Grand message and error string
Bill Wohler <wohler@newt.com>
parents:
68012
diff
changeset
|
1525 (error "Backup file for %s no longer exists" buffer-file-name)) |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1526 (or noconfirm |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1527 (yes-or-no-p (format "Revert buffer from file %s? " |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1528 backup-file)) |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1529 (error "Revert not confirmed")) |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1530 (let ((buffer-read-only nil)) |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1531 (erase-buffer) |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1532 (insert-file-contents backup-file)) |
95100
c2fcfe84918f
(mh-mh-to-mime, mh-mh-to-mime-undo): Preserve modes when converting to
Bill Wohler <wohler@newt.com>
parents:
94663
diff
changeset
|
1533 (after-find-file nil nil nil nil t))) |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1534 |
68465 | 1535 ;; Shush compiler. |
70027
0e0916499a15
* mh-funcs.el (view-exit-action): No need to wrap defvar with
Bill Wohler <wohler@newt.com>
parents:
69188
diff
changeset
|
1536 (defvar mh-identity-pgg-default-user-id) |
68465 | 1537 |
50702
7dd3d5eae9c7
Upgraded to MH-E version 7.3.
Bill Wohler <wohler@newt.com>
parents:
49578
diff
changeset
|
1538 ;;;###mh-autoload |
68465 | 1539 (defun mh-mml-secure-message-encrypt (method) |
1540 "Add tag to encrypt the message. | |
50702
7dd3d5eae9c7
Upgraded to MH-E version 7.3.
Bill Wohler <wohler@newt.com>
parents:
49578
diff
changeset
|
1541 |
68465 | 1542 A proper multipart message is created for you when you send the |
1543 message. Use the command \\[mh-mml-unsecure-message] to remove | |
1544 this tag. Use a prefix argument METHOD to be prompted for one of | |
1545 the possible security methods (see `mh-mml-method-default')." | |
1546 (interactive (list (mh-mml-query-cryptographic-method))) | |
1547 (mh-secure-message method "encrypt" mh-identity-pgg-default-user-id)) | |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1548 |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1549 ;;;###mh-autoload |
68465 | 1550 (defun mh-mml-secure-message-sign (method) |
1551 "Add tag to sign the message. | |
66354
cf99ce27df54
* mh-comp.el (mh-letter-menu): Rename
Bill Wohler <wohler@newt.com>
parents:
66087
diff
changeset
|
1552 |
68465 | 1553 A proper multipart message is created for you when you send the |
1554 message. Use the command \\[mh-mml-unsecure-message] to remove | |
1555 this tag. Use a prefix argument METHOD to be prompted for one of | |
1556 the possible security methods (see `mh-mml-method-default')." | |
1557 (interactive (list (mh-mml-query-cryptographic-method))) | |
1558 (mh-secure-message method "sign" mh-identity-pgg-default-user-id)) | |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1559 |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1560 ;;;###mh-autoload |
68465 | 1561 (defun mh-mml-secure-message-signencrypt (method) |
1562 "Add tag to encrypt and sign the message. | |
67758
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67756
diff
changeset
|
1563 |
68465 | 1564 A proper multipart message is created for you when you send the |
1565 message. Use the command \\[mh-mml-unsecure-message] to remove | |
1566 this tag. Use a prefix argument METHOD to be prompted for one of | |
1567 the possible security methods (see `mh-mml-method-default')." | |
1568 (interactive (list (mh-mml-query-cryptographic-method))) | |
1569 (mh-secure-message method "signencrypt" mh-identity-pgg-default-user-id)) | |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1570 |
56673
e9a6cbc8ca5e
Upgraded to MH-E version 7.4.80.
Bill Wohler <wohler@newt.com>
parents:
56406
diff
changeset
|
1571 (defvar mh-mml-cryptographic-method-history ()) |
e9a6cbc8ca5e
Upgraded to MH-E version 7.4.80.
Bill Wohler <wohler@newt.com>
parents:
56406
diff
changeset
|
1572 |
e9a6cbc8ca5e
Upgraded to MH-E version 7.4.80.
Bill Wohler <wohler@newt.com>
parents:
56406
diff
changeset
|
1573 (defun mh-mml-query-cryptographic-method () |
e9a6cbc8ca5e
Upgraded to MH-E version 7.4.80.
Bill Wohler <wohler@newt.com>
parents:
56406
diff
changeset
|
1574 "Read the cryptographic method to use." |
e9a6cbc8ca5e
Upgraded to MH-E version 7.4.80.
Bill Wohler <wohler@newt.com>
parents:
56406
diff
changeset
|
1575 (if current-prefix-arg |
e9a6cbc8ca5e
Upgraded to MH-E version 7.4.80.
Bill Wohler <wohler@newt.com>
parents:
56406
diff
changeset
|
1576 (let ((def (or (car mh-mml-cryptographic-method-history) |
e9a6cbc8ca5e
Upgraded to MH-E version 7.4.80.
Bill Wohler <wohler@newt.com>
parents:
56406
diff
changeset
|
1577 mh-mml-method-default))) |
66354
cf99ce27df54
* mh-comp.el (mh-letter-menu): Rename
Bill Wohler <wohler@newt.com>
parents:
66087
diff
changeset
|
1578 (completing-read (format "Method (default %s): " def) |
56673
e9a6cbc8ca5e
Upgraded to MH-E version 7.4.80.
Bill Wohler <wohler@newt.com>
parents:
56406
diff
changeset
|
1579 '(("pgp") ("pgpmime") ("smime")) |
e9a6cbc8ca5e
Upgraded to MH-E version 7.4.80.
Bill Wohler <wohler@newt.com>
parents:
56406
diff
changeset
|
1580 nil t nil 'mh-mml-cryptographic-method-history def)) |
e9a6cbc8ca5e
Upgraded to MH-E version 7.4.80.
Bill Wohler <wohler@newt.com>
parents:
56406
diff
changeset
|
1581 mh-mml-method-default)) |
e9a6cbc8ca5e
Upgraded to MH-E version 7.4.80.
Bill Wohler <wohler@newt.com>
parents:
56406
diff
changeset
|
1582 |
e9a6cbc8ca5e
Upgraded to MH-E version 7.4.80.
Bill Wohler <wohler@newt.com>
parents:
56406
diff
changeset
|
1583 (defun mh-secure-message (method mode &optional identity) |
66354
cf99ce27df54
* mh-comp.el (mh-letter-menu): Rename
Bill Wohler <wohler@newt.com>
parents:
66087
diff
changeset
|
1584 "Add tag to encrypt or sign message. |
67758
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67756
diff
changeset
|
1585 |
56673
e9a6cbc8ca5e
Upgraded to MH-E version 7.4.80.
Bill Wohler <wohler@newt.com>
parents:
56406
diff
changeset
|
1586 METHOD should be one of: \"pgpmime\", \"pgp\", \"smime\". |
e9a6cbc8ca5e
Upgraded to MH-E version 7.4.80.
Bill Wohler <wohler@newt.com>
parents:
56406
diff
changeset
|
1587 MODE should be one of: \"sign\", \"encrypt\", \"signencrypt\", \"none\". |
e9a6cbc8ca5e
Upgraded to MH-E version 7.4.80.
Bill Wohler <wohler@newt.com>
parents:
56406
diff
changeset
|
1588 IDENTITY is optionally the default-user-id to use." |
66354
cf99ce27df54
* mh-comp.el (mh-letter-menu): Rename
Bill Wohler <wohler@newt.com>
parents:
66087
diff
changeset
|
1589 (if (not mh-pgp-support-flag) |
cf99ce27df54
* mh-comp.el (mh-letter-menu): Rename
Bill Wohler <wohler@newt.com>
parents:
66087
diff
changeset
|
1590 (error "Your version of Gnus does not support PGP/GPG") |
56673
e9a6cbc8ca5e
Upgraded to MH-E version 7.4.80.
Bill Wohler <wohler@newt.com>
parents:
56406
diff
changeset
|
1591 ;; Check the arguments |
e9a6cbc8ca5e
Upgraded to MH-E version 7.4.80.
Bill Wohler <wohler@newt.com>
parents:
56406
diff
changeset
|
1592 (let ((valid-methods (list "pgpmime" "pgp" "smime")) |
e9a6cbc8ca5e
Upgraded to MH-E version 7.4.80.
Bill Wohler <wohler@newt.com>
parents:
56406
diff
changeset
|
1593 (valid-modes (list "sign" "encrypt" "signencrypt" "none"))) |
e9a6cbc8ca5e
Upgraded to MH-E version 7.4.80.
Bill Wohler <wohler@newt.com>
parents:
56406
diff
changeset
|
1594 (if (not (member method valid-methods)) |
68013
bbc0e52abce5
* mh-alias.el (mh-alias-add-alias): Grand message and error string
Bill Wohler <wohler@newt.com>
parents:
68012
diff
changeset
|
1595 (error "Method %s is invalid" method)) |
56673
e9a6cbc8ca5e
Upgraded to MH-E version 7.4.80.
Bill Wohler <wohler@newt.com>
parents:
56406
diff
changeset
|
1596 (if (not (member mode valid-modes)) |
68013
bbc0e52abce5
* mh-alias.el (mh-alias-add-alias): Grand message and error string
Bill Wohler <wohler@newt.com>
parents:
68012
diff
changeset
|
1597 (error "Mode %s is invalid" mode)) |
56673
e9a6cbc8ca5e
Upgraded to MH-E version 7.4.80.
Bill Wohler <wohler@newt.com>
parents:
56406
diff
changeset
|
1598 (mml-unsecure-message) |
e9a6cbc8ca5e
Upgraded to MH-E version 7.4.80.
Bill Wohler <wohler@newt.com>
parents:
56406
diff
changeset
|
1599 (if (not (string= mode "none")) |
e9a6cbc8ca5e
Upgraded to MH-E version 7.4.80.
Bill Wohler <wohler@newt.com>
parents:
56406
diff
changeset
|
1600 (save-excursion |
e9a6cbc8ca5e
Upgraded to MH-E version 7.4.80.
Bill Wohler <wohler@newt.com>
parents:
56406
diff
changeset
|
1601 (goto-char (point-min)) |
e9a6cbc8ca5e
Upgraded to MH-E version 7.4.80.
Bill Wohler <wohler@newt.com>
parents:
56406
diff
changeset
|
1602 (mh-goto-header-end 1) |
e9a6cbc8ca5e
Upgraded to MH-E version 7.4.80.
Bill Wohler <wohler@newt.com>
parents:
56406
diff
changeset
|
1603 (if mh-identity-pgg-default-user-id |
e9a6cbc8ca5e
Upgraded to MH-E version 7.4.80.
Bill Wohler <wohler@newt.com>
parents:
56406
diff
changeset
|
1604 (mml-insert-tag 'secure 'method method 'mode mode |
e9a6cbc8ca5e
Upgraded to MH-E version 7.4.80.
Bill Wohler <wohler@newt.com>
parents:
56406
diff
changeset
|
1605 'sender mh-identity-pgg-default-user-id) |
e9a6cbc8ca5e
Upgraded to MH-E version 7.4.80.
Bill Wohler <wohler@newt.com>
parents:
56406
diff
changeset
|
1606 (mml-insert-tag 'secure 'method method 'mode mode))))))) |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1607 |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1608 ;;;###mh-autoload |
68465 | 1609 (defun mh-mml-to-mime () |
1610 "Compose MIME message from MML tags. | |
1611 | |
1612 Typically, you send a message with attachments just like any | |
1613 other message. However, you may take a sneak preview of the MIME | |
1614 encoding if you wish by running this command. | |
1615 | |
1616 This action can be undone by running \\[undo]." | |
1617 (interactive) | |
1618 (require 'message) | |
82473
d318e41ee7db
(mh-mml-to-mime): GPG requires e-mail addresses, not
Jeffrey C Honig <jch@bsdi.com>
parents:
78231
diff
changeset
|
1619 (when mh-pgp-support-flag |
d318e41ee7db
(mh-mml-to-mime): GPG requires e-mail addresses, not
Jeffrey C Honig <jch@bsdi.com>
parents:
78231
diff
changeset
|
1620 ;; PGP requires actual e-mail addresses, not aliases. |
88078
3f6a9fe50cce
(mh-mml-to-mime): Don't look up sender if From absent. Fixes "Wrong
Bill Wohler <wohler@newt.com>
parents:
87649
diff
changeset
|
1621 ;; Parse the recipients and sender from the message. |
82473
d318e41ee7db
(mh-mml-to-mime): GPG requires e-mail addresses, not
Jeffrey C Honig <jch@bsdi.com>
parents:
78231
diff
changeset
|
1622 (message-options-set-recipient) |
88078
3f6a9fe50cce
(mh-mml-to-mime): Don't look up sender if From absent. Fixes "Wrong
Bill Wohler <wohler@newt.com>
parents:
87649
diff
changeset
|
1623 ;; Do an alias lookup on sender (if From field is present). |
3f6a9fe50cce
(mh-mml-to-mime): Don't look up sender if From absent. Fixes "Wrong
Bill Wohler <wohler@newt.com>
parents:
87649
diff
changeset
|
1624 (when (message-options-get 'message-sender) |
3f6a9fe50cce
(mh-mml-to-mime): Don't look up sender if From absent. Fixes "Wrong
Bill Wohler <wohler@newt.com>
parents:
87649
diff
changeset
|
1625 (message-options-set 'message-sender |
3f6a9fe50cce
(mh-mml-to-mime): Don't look up sender if From absent. Fixes "Wrong
Bill Wohler <wohler@newt.com>
parents:
87649
diff
changeset
|
1626 (mail-strip-quoted-names |
3f6a9fe50cce
(mh-mml-to-mime): Don't look up sender if From absent. Fixes "Wrong
Bill Wohler <wohler@newt.com>
parents:
87649
diff
changeset
|
1627 (mh-alias-expand |
3f6a9fe50cce
(mh-mml-to-mime): Don't look up sender if From absent. Fixes "Wrong
Bill Wohler <wohler@newt.com>
parents:
87649
diff
changeset
|
1628 (message-options-get 'message-sender))))) |
82473
d318e41ee7db
(mh-mml-to-mime): GPG requires e-mail addresses, not
Jeffrey C Honig <jch@bsdi.com>
parents:
78231
diff
changeset
|
1629 ;; Do an alias lookup on recipients |
d318e41ee7db
(mh-mml-to-mime): GPG requires e-mail addresses, not
Jeffrey C Honig <jch@bsdi.com>
parents:
78231
diff
changeset
|
1630 (message-options-set 'message-recipients |
d318e41ee7db
(mh-mml-to-mime): GPG requires e-mail addresses, not
Jeffrey C Honig <jch@bsdi.com>
parents:
78231
diff
changeset
|
1631 (mapconcat |
d318e41ee7db
(mh-mml-to-mime): GPG requires e-mail addresses, not
Jeffrey C Honig <jch@bsdi.com>
parents:
78231
diff
changeset
|
1632 '(lambda (ali) |
d318e41ee7db
(mh-mml-to-mime): GPG requires e-mail addresses, not
Jeffrey C Honig <jch@bsdi.com>
parents:
78231
diff
changeset
|
1633 (mail-strip-quoted-names (mh-alias-expand ali))) |
d318e41ee7db
(mh-mml-to-mime): GPG requires e-mail addresses, not
Jeffrey C Honig <jch@bsdi.com>
parents:
78231
diff
changeset
|
1634 (split-string (message-options-get 'message-recipients) "[, ]+") |
d318e41ee7db
(mh-mml-to-mime): GPG requires e-mail addresses, not
Jeffrey C Honig <jch@bsdi.com>
parents:
78231
diff
changeset
|
1635 ", "))) |
68465 | 1636 (let ((saved-text (buffer-string)) |
1637 (buffer (current-buffer)) | |
1638 (modified-flag (buffer-modified-p))) | |
1639 (condition-case err (mml-to-mime) | |
1640 (error | |
1641 (with-current-buffer buffer | |
1642 (delete-region (point-min) (point-max)) | |
1643 (insert saved-text) | |
1644 (set-buffer-modified-p modified-flag)) | |
1645 (error (error-message-string err)))))) | |
1646 | |
1647 ;;;###mh-autoload | |
67984
fb7a11feb83e
* mh-mime.el (mh-mml-unsecure-message): Remove unused argument.
Mark D. Baushke <mdb@gnu.org>
parents:
67969
diff
changeset
|
1648 (defun mh-mml-unsecure-message () |
fb7a11feb83e
* mh-mime.el (mh-mml-unsecure-message): Remove unused argument.
Mark D. Baushke <mdb@gnu.org>
parents:
67969
diff
changeset
|
1649 "Remove any secure message tags." |
fb7a11feb83e
* mh-mime.el (mh-mml-unsecure-message): Remove unused argument.
Mark D. Baushke <mdb@gnu.org>
parents:
67969
diff
changeset
|
1650 (interactive) |
66354
cf99ce27df54
* mh-comp.el (mh-letter-menu): Rename
Bill Wohler <wohler@newt.com>
parents:
66087
diff
changeset
|
1651 (if (not mh-pgp-support-flag) |
cf99ce27df54
* mh-comp.el (mh-letter-menu): Rename
Bill Wohler <wohler@newt.com>
parents:
66087
diff
changeset
|
1652 (error "Your version of Gnus does not support PGP/GPG") |
56673
e9a6cbc8ca5e
Upgraded to MH-E version 7.4.80.
Bill Wohler <wohler@newt.com>
parents:
56406
diff
changeset
|
1653 (mml-unsecure-message))) |
e9a6cbc8ca5e
Upgraded to MH-E version 7.4.80.
Bill Wohler <wohler@newt.com>
parents:
56406
diff
changeset
|
1654 |
68465 | 1655 |
67758
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67756
diff
changeset
|
1656 |
68465 | 1657 ;;; Support Routines for MH-Letter Commands |
50702
7dd3d5eae9c7
Upgraded to MH-E version 7.3.
Bill Wohler <wohler@newt.com>
parents:
49578
diff
changeset
|
1658 |
7dd3d5eae9c7
Upgraded to MH-E version 7.3.
Bill Wohler <wohler@newt.com>
parents:
49578
diff
changeset
|
1659 ;;;###mh-autoload |
66354
cf99ce27df54
* mh-comp.el (mh-letter-menu): Rename
Bill Wohler <wohler@newt.com>
parents:
66087
diff
changeset
|
1660 (defun mh-mml-tag-present-p () |
cf99ce27df54
* mh-comp.el (mh-letter-menu): Rename
Bill Wohler <wohler@newt.com>
parents:
66087
diff
changeset
|
1661 "Check if the current buffer has text which may be a MML tag." |
50702
7dd3d5eae9c7
Upgraded to MH-E version 7.3.
Bill Wohler <wohler@newt.com>
parents:
49578
diff
changeset
|
1662 (save-excursion |
7dd3d5eae9c7
Upgraded to MH-E version 7.3.
Bill Wohler <wohler@newt.com>
parents:
49578
diff
changeset
|
1663 (goto-char (point-min)) |
7dd3d5eae9c7
Upgraded to MH-E version 7.3.
Bill Wohler <wohler@newt.com>
parents:
49578
diff
changeset
|
1664 (re-search-forward |
68083
4aea781df851
(mh-mml-tag-present-p): Update regexp to handle <mml> tags inserted by
Bill Wohler <wohler@newt.com>
parents:
68013
diff
changeset
|
1665 (concat |
4aea781df851
(mh-mml-tag-present-p): Update regexp to handle <mml> tags inserted by
Bill Wohler <wohler@newt.com>
parents:
68013
diff
changeset
|
1666 "\\(<#\\(mml\\|part\\)\\(.\\|\n\\)*>[ \n\t]*<#/\\(mml\\|part\\)>\\|" |
4aea781df851
(mh-mml-tag-present-p): Update regexp to handle <mml> tags inserted by
Bill Wohler <wohler@newt.com>
parents:
68013
diff
changeset
|
1667 "^<#secure.+>$\\)") |
50702
7dd3d5eae9c7
Upgraded to MH-E version 7.3.
Bill Wohler <wohler@newt.com>
parents:
49578
diff
changeset
|
1668 nil t))) |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1669 |
68465 | 1670 (defvar mh-media-type-regexp |
1671 (concat (regexp-opt '("text" "image" "audio" "video" "application" | |
1672 "multipart" "message") t) | |
1673 "/[-.+a-zA-Z0-9]+") | |
1674 "Regexp matching valid media types used in MIME attachment compositions.") | |
1675 | |
1676 ;;;###mh-autoload | |
1677 (defun mh-mh-directive-present-p (&optional begin end) | |
1678 "Check if the text between BEGIN and END might be a MH-style directive. | |
1679 The optional argument BEGIN defaults to the beginning of the | |
77941
0bd276ce7806
(mh-mh-directive-present-p): Fix typos in docstrings.
Juanma Barranquero <lekktu@gmail.com>
parents:
75347
diff
changeset
|
1680 buffer, while END defaults to the end of the buffer." |
68465 | 1681 (unless begin (setq begin (point-min))) |
1682 (unless end (setq end (point-max))) | |
1683 (save-excursion | |
1684 (block 'search-for-mh-directive | |
1685 (goto-char begin) | |
1686 (while (re-search-forward "^#" end t) | |
68529
7daec5f4a289
* mh-alias.el (mh-alias-gecos-name): Use mh-replace-regexp-in-string
Bill Wohler <wohler@newt.com>
parents:
68520
diff
changeset
|
1687 (let ((s (buffer-substring-no-properties |
7daec5f4a289
* mh-alias.el (mh-alias-gecos-name): Use mh-replace-regexp-in-string
Bill Wohler <wohler@newt.com>
parents:
68520
diff
changeset
|
1688 (point) (mh-line-end-position)))) |
68465 | 1689 (cond ((equal s "")) |
1690 ((string-match "^forw[ \t\n]+" s) | |
1691 (return-from 'search-for-mh-directive t)) | |
1692 (t (let ((first-token (car (split-string s "[ \t;@]")))) | |
1693 (when (and first-token | |
1694 (string-match mh-media-type-regexp | |
1695 first-token)) | |
1696 (return-from 'search-for-mh-directive t))))))) | |
1697 nil))) | |
1698 | |
1699 (defun mh-minibuffer-read-type (filename &optional default) | |
1700 "Return the content type associated with the given FILENAME. | |
1701 If the \"file\" command exists and recognizes the given file, | |
1702 then its value is returned\; otherwise, the user is prompted for | |
69188
bbe4019f0045
(mh-minibuffer-read-type): Deleted comment in docstring about obsolete
Bill Wohler <wohler@newt.com>
parents:
68947
diff
changeset
|
1703 a type (see `mailcap-mime-types'). |
68465 | 1704 Optional argument DEFAULT is returned if a type isn't entered." |
1705 (mailcap-parse-mimetypes) | |
1706 (let* ((default (or default | |
1707 (mm-default-file-encoding filename) | |
1708 "application/octet-stream")) | |
1709 (probed-type (mh-file-mime-type filename)) | |
1710 (type (or (and (not (equal probed-type "application/octet-stream")) | |
1711 probed-type) | |
1712 (completing-read | |
1713 (format "Content type (default %s): " default) | |
1714 (mapcar 'list (mailcap-mime-types)))))) | |
1715 (if (not (equal type "")) | |
1716 type | |
1717 default))) | |
1718 | |
1719 ;;;###mh-autoload | |
1720 (defun mh-file-mime-type (filename) | |
1721 "Return MIME type of FILENAME from file command. | |
1722 Returns nil if file command not on system." | |
1723 (cond | |
1724 ((not (mh-have-file-command)) | |
1725 nil) ;no file command, exit now | |
1726 ((not (and (file-exists-p filename) | |
1727 (file-readable-p filename))) | |
1728 nil) ;no file or not readable, ditto | |
1729 (t | |
105867
00c0adbb54a9
* mh-thread.el (mh-thread-set-tables):
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
101477
diff
changeset
|
1730 (let ((tmp-buffer (get-buffer-create mh-temp-buffer))) |
00c0adbb54a9
* mh-thread.el (mh-thread-set-tables):
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
101477
diff
changeset
|
1731 (with-current-buffer tmp-buffer |
68465 | 1732 (unwind-protect |
1733 (progn | |
1734 (call-process "file" nil '(t nil) nil "-b" "-i" | |
1735 (expand-file-name filename)) | |
1736 (goto-char (point-min)) | |
1737 (if (not (re-search-forward mh-media-type-regexp nil t)) | |
1738 nil | |
1739 (mh-file-mime-type-substitute (match-string 0) filename))) | |
1740 (kill-buffer tmp-buffer))))))) | |
1741 | |
1742 (defvar mh-file-mime-type-substitutions | |
1743 '(("application/msword" "\.xls" "application/ms-excel") | |
1744 ("application/msword" "\.ppt" "application/ms-powerpoint") | |
68620
f58b821a2f40
* mh-mime.el (mh-file-mime-type-substitutions): Added entries to
Peter Galbraith <galbraith@mixing.qc.dfo.ca>
parents:
68529
diff
changeset
|
1745 ("text/plain" "\.vcf" "text/x-vcard") |
f58b821a2f40
* mh-mime.el (mh-file-mime-type-substitutions): Added entries to
Peter Galbraith <galbraith@mixing.qc.dfo.ca>
parents:
68529
diff
changeset
|
1746 ("text/rtf" "\.rtf" "application/rtf") |
f58b821a2f40
* mh-mime.el (mh-file-mime-type-substitutions): Added entries to
Peter Galbraith <galbraith@mixing.qc.dfo.ca>
parents:
68529
diff
changeset
|
1747 ("application/x-zip" "\.sxc" "application/vnd.sun.xml.calc") |
f58b821a2f40
* mh-mime.el (mh-file-mime-type-substitutions): Added entries to
Peter Galbraith <galbraith@mixing.qc.dfo.ca>
parents:
68529
diff
changeset
|
1748 ("application/x-zip" "\.sxd" "application/vnd.sun.xml.draw") |
f58b821a2f40
* mh-mime.el (mh-file-mime-type-substitutions): Added entries to
Peter Galbraith <galbraith@mixing.qc.dfo.ca>
parents:
68529
diff
changeset
|
1749 ("application/x-zip" "\.sxi" "application/vnd.sun.xml.impress") |
f58b821a2f40
* mh-mime.el (mh-file-mime-type-substitutions): Added entries to
Peter Galbraith <galbraith@mixing.qc.dfo.ca>
parents:
68529
diff
changeset
|
1750 ("application/x-zip" "\.sxw" "application/vnd.sun.xml.writer") |
f58b821a2f40
* mh-mime.el (mh-file-mime-type-substitutions): Added entries to
Peter Galbraith <galbraith@mixing.qc.dfo.ca>
parents:
68529
diff
changeset
|
1751 ("application/x-zip" "\.odg" "application/vnd.oasis.opendocument.graphics") |
f58b821a2f40
* mh-mime.el (mh-file-mime-type-substitutions): Added entries to
Peter Galbraith <galbraith@mixing.qc.dfo.ca>
parents:
68529
diff
changeset
|
1752 ("application/x-zip" "\.odi" "application/vnd.oasis.opendocument.image") |
68947
bbac579a3af5
(mh-file-mime-type-substitutions): Remove trailing whitespace
Bill Wohler <wohler@newt.com>
parents:
68620
diff
changeset
|
1753 ("application/x-zip" "\.odp" |
68620
f58b821a2f40
* mh-mime.el (mh-file-mime-type-substitutions): Added entries to
Peter Galbraith <galbraith@mixing.qc.dfo.ca>
parents:
68529
diff
changeset
|
1754 "application/vnd.oasis.opendocument.presentation") |
68947
bbac579a3af5
(mh-file-mime-type-substitutions): Remove trailing whitespace
Bill Wohler <wohler@newt.com>
parents:
68620
diff
changeset
|
1755 ("application/x-zip" "\.ods" |
68620
f58b821a2f40
* mh-mime.el (mh-file-mime-type-substitutions): Added entries to
Peter Galbraith <galbraith@mixing.qc.dfo.ca>
parents:
68529
diff
changeset
|
1756 "application/vnd.oasis.opendocument.spreadsheet") |
f58b821a2f40
* mh-mime.el (mh-file-mime-type-substitutions): Added entries to
Peter Galbraith <galbraith@mixing.qc.dfo.ca>
parents:
68529
diff
changeset
|
1757 ("application/x-zip" "\.odt" "application/vnd.oasis.opendocument.text")) |
68465 | 1758 "Substitutions to make for Content-Type returned from file command. |
1759 The first element is the Content-Type returned by the file command. | |
1760 The second element is a regexp matching the file name, usually the | |
1761 extension. | |
1762 The third element is the Content-Type to replace with.") | |
1763 | |
1764 (defun mh-file-mime-type-substitute (content-type filename) | |
1765 "Return possibly changed CONTENT-TYPE on the FILENAME. | |
1766 Substitutions are made from the `mh-file-mime-type-substitutions' | |
1767 variable." | |
1768 (let ((subst mh-file-mime-type-substitutions) | |
1769 (type) (match) (answer content-type) | |
1770 (case-fold-search t)) | |
1771 (while subst | |
1772 (setq type (car (car subst)) | |
1773 match (elt (car subst) 1)) | |
1774 (if (and (string-equal content-type type) | |
1775 (string-match match filename)) | |
1776 (setq answer (elt (car subst) 2) | |
1777 subst nil) | |
1778 (setq subst (cdr subst)))) | |
1779 answer)) | |
1780 | |
1781 (defvar mh-have-file-command 'undefined | |
1782 "Cached value of function `mh-have-file-command'. | |
1783 Do not reference this variable directly as it might not have been | |
1784 initialized. Always use the command `mh-have-file-command'.") | |
1785 | |
1786 ;;;###mh-autoload | |
1787 (defun mh-have-file-command () | |
1788 "Return t if 'file' command is on the system. | |
1789 'file -i' is used to get MIME type of composition insertion." | |
1790 (when (eq mh-have-file-command 'undefined) | |
1791 (setq mh-have-file-command | |
1792 (and (fboundp 'executable-find) | |
1793 (executable-find "file") ; file command exists | |
1794 ; and accepts -i and -b args. | |
1795 (zerop (call-process "file" nil nil nil "-i" "-b" | |
1796 (expand-file-name "inc" mh-progs)))))) | |
1797 mh-have-file-command) | |
1798 | |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1799 |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1800 |
68465 | 1801 ;;; MIME Cleanup |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1802 |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1803 ;;;###mh-autoload |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1804 (defun mh-mime-cleanup () |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1805 "Free the decoded MIME parts." |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1806 (let ((mime-data (gethash (current-buffer) mh-globals-hash))) |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1807 ;; This is for Emacs, what about XEmacs? |
50702
7dd3d5eae9c7
Upgraded to MH-E version 7.3.
Bill Wohler <wohler@newt.com>
parents:
49578
diff
changeset
|
1808 (mh-funcall-if-exists remove-images (point-min) (point-max)) |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1809 (when mime-data |
68520
6a7173abcf59
* mh-acros.el (mh-defun-compat, mh-defmacro-compat): Add name argument
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
1810 (mh-mm-destroy-parts (mh-mime-handles mime-data)) |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1811 (remhash (current-buffer) mh-globals-hash)))) |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1812 |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1813 ;;;###mh-autoload |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1814 (defun mh-destroy-postponed-handles () |
66354
cf99ce27df54
* mh-comp.el (mh-letter-menu): Rename
Bill Wohler <wohler@newt.com>
parents:
66087
diff
changeset
|
1815 "Free MIME data for externally displayed MIME parts." |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1816 (let ((mime-data (mh-buffer-data))) |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1817 (when mime-data |
68520
6a7173abcf59
* mh-acros.el (mh-defun-compat, mh-defmacro-compat): Add name argument
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
1818 (mh-mm-destroy-parts (mh-mime-handles mime-data))) |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1819 (remhash (current-buffer) mh-globals-hash))) |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1820 |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1821 (provide 'mh-mime) |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1822 |
67681 | 1823 ;; Local Variables: |
1824 ;; indent-tabs-mode: nil | |
1825 ;; sentence-end-double-space: nil | |
1826 ;; End: | |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1827 |
67681 | 1828 ;; arch-tag: 0dd36518-1b64-4a84-8f4e-59f422d3f002 |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
1829 ;;; mh-mime.el ends here |