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