1 |
;;; mh-mime.el --- MH-E support for composing MIME messages |
;;; mh-mime.el --- MH-E support for composing MIME messages |
2 |
|
|
3 |
;; Copyright (C) 1993, 1995, 2001, 2002 Free Software Foundation, Inc. |
;; Copyright (C) 1993, 1995, 2001, 02, 2003 Free Software Foundation, Inc. |
4 |
|
|
5 |
;; Author: Bill Wohler <wohler@newt.com> |
;; Author: Bill Wohler <wohler@newt.com> |
6 |
;; Maintainer: Bill Wohler <wohler@newt.com> |
;; Maintainer: Bill Wohler <wohler@newt.com> |
32 |
|
|
33 |
;;; Change Log: |
;;; Change Log: |
34 |
|
|
|
;; $Id$ |
|
|
|
|
35 |
;;; Code: |
;;; Code: |
36 |
|
|
37 |
(require 'cl) |
(require 'cl) |
56 |
(autoload 'mml-insert-empty-tag "mml") |
(autoload 'mml-insert-empty-tag "mml") |
57 |
(autoload 'mml-to-mime "mml") |
(autoload 'mml-to-mime "mml") |
58 |
(autoload 'mml-attach-file "mml") |
(autoload 'mml-attach-file "mml") |
59 |
|
(autoload 'rfc2047-decode-region "rfc2047") |
60 |
|
|
61 |
;;;###mh-autoload |
;;;###mh-autoload |
62 |
(defun mh-compose-insertion (&optional inline) |
(defun mh-compose-insertion (&optional inline) |
234 |
The file specified by FILENAME is encoded as TYPE. An optional DESCRIPTION is |
The file specified by FILENAME is encoded as TYPE. An optional DESCRIPTION is |
235 |
used as the Content-Description field, optional set of ATTRIBUTES and an |
used as the Content-Description field, optional set of ATTRIBUTES and an |
236 |
optional COMMENT can also be included." |
optional COMMENT can also be included." |
|
(setq mh-mhn-compose-insert-flag t) |
|
237 |
(beginning-of-line) |
(beginning-of-line) |
238 |
(insert "#" type) |
(insert "#" type) |
239 |
(and attributes |
(and attributes |
304 |
EXTRA-PARAMS, and COMMENT. |
EXTRA-PARAMS, and COMMENT. |
305 |
|
|
306 |
See also \\[mh-edit-mhn]." |
See also \\[mh-edit-mhn]." |
|
(setq mh-mhn-compose-insert-flag t) |
|
307 |
(beginning-of-line) |
(beginning-of-line) |
308 |
(insert "#@" type) |
(insert "#@" type) |
309 |
(and attributes |
(and attributes |
338 |
(if mh-sent-from-msg |
(if mh-sent-from-msg |
339 |
(format " [%d]" mh-sent-from-msg) |
(format " [%d]" mh-sent-from-msg) |
340 |
""))))) |
""))))) |
|
(setq mh-mhn-compose-insert-flag t) |
|
341 |
(beginning-of-line) |
(beginning-of-line) |
342 |
(insert "#forw [") |
(insert "#forw [") |
343 |
(and description |
(and description |
364 |
already inserted in the draft, fills in all the MIME components and header |
already inserted in the draft, fills in all the MIME components and header |
365 |
fields. |
fields. |
366 |
|
|
367 |
This step should be done last just before sending the message. |
This step is performed automatically when sending the message, but this |
368 |
|
function may be called manually before sending the draft as well. |
369 |
|
|
370 |
The `\\[mh-revert-mhn-edit]' command undoes this command. The arguments in the |
The `\\[mh-revert-mhn-edit]' command undoes this command. The arguments in the |
371 |
list `mh-mhn-args' are passed to mhn if this function is passed an optional |
list `mh-mhn-args' are passed to mhn if this function is passed an optional |
376 |
from a file), \\[mh-mhn-compose-anon-ftp] (external reference to file via |
from a file), \\[mh-mhn-compose-anon-ftp] (external reference to file via |
377 |
anonymous ftp), \\[mh-mhn-compose-external-compressed-tar] \ \(reference to |
anonymous ftp), \\[mh-mhn-compose-external-compressed-tar] \ \(reference to |
378 |
compressed tar file via anonymous ftp), and \\[mh-mhn-compose-forw] (forward |
compressed tar file via anonymous ftp), and \\[mh-mhn-compose-forw] (forward |
379 |
message). If these helper functions are used, `mh-edit-mhn' is run |
message). |
|
automatically when the draft is sent. |
|
380 |
|
|
381 |
The value of `mh-edit-mhn-hook' is a list of functions to be called, with no |
The value of `mh-edit-mhn-hook' is a list of functions to be called, with no |
382 |
arguments, after performing the conversion. |
arguments, after performing the conversion. |
392 |
(t |
(t |
393 |
(mh-exec-cmd-error (format "mhdraft=%s" buffer-file-name) |
(mh-exec-cmd-error (format "mhdraft=%s" buffer-file-name) |
394 |
"mhn" (if extra-args mh-mhn-args) buffer-file-name))) |
"mhn" (if extra-args mh-mhn-args) buffer-file-name))) |
|
(setq mh-mhn-compose-insert-flag nil) |
|
395 |
(revert-buffer t t) |
(revert-buffer t t) |
396 |
(message "mhn editing...done") |
(message "mhn editing...done") |
397 |
(run-hooks 'mh-edit-mhn-hook)) |
(run-hooks 'mh-edit-mhn-hook)) |
424 |
(insert-file-contents backup-file)) |
(insert-file-contents backup-file)) |
425 |
(after-find-file nil))) |
(after-find-file nil))) |
426 |
|
|
427 |
|
;;;###mh-autoload |
428 |
|
(defun mh-mhn-directive-present-p () |
429 |
|
"Check if the current buffer has text which might be a MHN directive." |
430 |
|
(save-excursion |
431 |
|
(block 'search-for-mhn-directive |
432 |
|
(goto-char (point-min)) |
433 |
|
(while (re-search-forward "^#" nil t) |
434 |
|
(let ((s (buffer-substring-no-properties (point) (line-end-position)))) |
435 |
|
(cond ((equal s "")) |
436 |
|
((string-match "^forw[ \t\n]+" s) |
437 |
|
(return-from 'search-for-mhn-directive t)) |
438 |
|
(t (let ((first-token (car (split-string s "[ \t;@]")))) |
439 |
|
(when (string-match mh-media-type-regexp first-token) |
440 |
|
(return-from 'search-for-mhn-directive t))))))) |
441 |
|
nil))) |
442 |
|
|
443 |
|
|
444 |
|
|
445 |
;;; MIME composition functions |
;;; MIME composition functions |
446 |
|
|
447 |
;;;###mh-autoload |
;;;###mh-autoload |
448 |
(defun mh-mml-to-mime () |
(defun mh-mml-to-mime () |
449 |
"Compose MIME message from mml directives." |
"Compose MIME message from mml directives. |
450 |
|
This step is performed automatically when sending the message, but this |
451 |
|
function may be called manually before sending the draft as well." |
452 |
(interactive) |
(interactive) |
453 |
(when mh-gnus-pgp-support-flag ;; This is only needed for PGP |
(when mh-gnus-pgp-support-flag ;; This is only needed for PGP |
454 |
(message-options-set-recipient)) |
(message-options-set-recipient)) |
455 |
(mml-to-mime) |
(mml-to-mime)) |
|
(setq mh-mml-compose-insert-flag nil)) |
|
456 |
|
|
457 |
;;;###mh-autoload |
;;;###mh-autoload |
458 |
(defun mh-mml-forward-message (description folder message) |
(defun mh-mml-forward-message (description folder message) |
472 |
(mml-attach-file (format "%s%s/%d" |
(mml-attach-file (format "%s%s/%d" |
473 |
mh-user-path (substring folder 1) msg) |
mh-user-path (substring folder 1) msg) |
474 |
"message/rfc822" |
"message/rfc822" |
475 |
description)) |
description))) |
|
(setq mh-mml-compose-insert-flag t)) |
|
476 |
(t (error "The message number, %s is not a integer!" msg))))) |
(t (error "The message number, %s is not a integer!" msg))))) |
477 |
|
|
478 |
;;;###mh-autoload |
;;;###mh-autoload |
499 |
nil t nil nil |
nil t nil nil |
500 |
"attachment")))) |
"attachment")))) |
501 |
(mml-insert-empty-tag 'part 'type type 'filename file |
(mml-insert-empty-tag 'part 'type type 'filename file |
502 |
'disposition dispos 'description description) |
'disposition dispos 'description description))) |
|
(setq mh-mml-compose-insert-flag t))) |
|
503 |
|
|
504 |
;;;###mh-autoload |
;;;###mh-autoload |
505 |
(defun mh-mml-secure-message-sign-pgpmime () |
(defun mh-mml-secure-message-sign-pgpmime () |
507 |
(interactive) |
(interactive) |
508 |
(if (not mh-gnus-pgp-support-flag) |
(if (not mh-gnus-pgp-support-flag) |
509 |
(error "Sorry. Your version of gnus does not support PGP/GPG") |
(error "Sorry. Your version of gnus does not support PGP/GPG") |
510 |
(mml-secure-message-sign-pgpmime) |
(mml-secure-message-sign-pgpmime))) |
|
(setq mh-mml-compose-insert-flag t))) |
|
511 |
|
|
512 |
;;;###mh-autoload |
;;;###mh-autoload |
513 |
(defun mh-mml-secure-message-encrypt-pgpmime (&optional dontsign) |
(defun mh-mml-secure-message-encrypt-pgpmime (&optional dontsign) |
516 |
(interactive "P") |
(interactive "P") |
517 |
(if (not mh-gnus-pgp-support-flag) |
(if (not mh-gnus-pgp-support-flag) |
518 |
(error "Sorry. Your version of gnus does not support PGP/GPG") |
(error "Sorry. Your version of gnus does not support PGP/GPG") |
519 |
(mml-secure-message-encrypt-pgpmime dontsign) |
(mml-secure-message-encrypt-pgpmime dontsign))) |
520 |
(setq mh-mml-compose-insert-flag t))) |
|
521 |
|
;;;###mh-autoload |
522 |
|
(defun mh-mml-directive-present-p () |
523 |
|
"Check if the current buffer has text which may be an MML directive." |
524 |
|
(save-excursion |
525 |
|
(goto-char (point-min)) |
526 |
|
(re-search-forward |
527 |
|
"\\(<#part\\(.\\|\n\\)*>[ \n\t]*<#/part>\\|^<#secure.+>$\\)" |
528 |
|
nil t))) |
529 |
|
|
530 |
|
|
531 |
|
|
564 |
(mh-defun-compat mm-handle-multipart-ctl-parameter (handle parameter) |
(mh-defun-compat mm-handle-multipart-ctl-parameter (handle parameter) |
565 |
(get-text-property 0 parameter (car handle))) |
(get-text-property 0 parameter (car handle))) |
566 |
|
|
567 |
|
(mh-do-in-xemacs (defvar default-enable-multibyte-characters)) |
568 |
|
|
569 |
;; Copy of original function in mm-decode.el |
;; Copy of original function in mm-decode.el |
570 |
(mh-defun-compat mm-readable-p (handle) |
(mh-defun-compat mm-readable-p (handle) |
571 |
"Say whether the content of HANDLE is readable." |
"Say whether the content of HANDLE is readable." |
629 |
"Free the decoded MIME parts." |
"Free the decoded MIME parts." |
630 |
(let ((mime-data (gethash (current-buffer) mh-globals-hash))) |
(let ((mime-data (gethash (current-buffer) mh-globals-hash))) |
631 |
;; This is for Emacs, what about XEmacs? |
;; This is for Emacs, what about XEmacs? |
632 |
(cond ((fboundp 'remove-images) |
(mh-funcall-if-exists remove-images (point-min) (point-max)) |
|
(remove-images (point-min) (point-max)))) |
|
633 |
(when mime-data |
(when mime-data |
634 |
(mm-destroy-parts (mh-mime-handles mime-data)) |
(mm-destroy-parts (mh-mime-handles mime-data)) |
635 |
(remhash (current-buffer) mh-globals-hash)))) |
(remhash (current-buffer) mh-globals-hash)))) |
680 |
(when (and mh-graphical-smileys-flag |
(when (and mh-graphical-smileys-flag |
681 |
(fboundp 'smiley-region) |
(fboundp 'smiley-region) |
682 |
(boundp 'font-lock-maximum-size) |
(boundp 'font-lock-maximum-size) |
683 |
|
font-lock-maximum-size |
684 |
(>= (/ font-lock-maximum-size 8) (buffer-size))) |
(>= (/ font-lock-maximum-size 8) (buffer-size))) |
685 |
(smiley-region (point-min) (point-max)))) |
(smiley-region (point-min) (point-max)))) |
686 |
|
|
688 |
(defun mh-display-emphasis () |
(defun mh-display-emphasis () |
689 |
"Function to display graphical emphasis." |
"Function to display graphical emphasis." |
690 |
(when (and mh-graphical-emphasis-flag |
(when (and mh-graphical-emphasis-flag |
691 |
(boundp 'font-lock-maximum-size) |
(if font-lock-maximum-size |
692 |
(>= (/ font-lock-maximum-size 8) (buffer-size))) |
(>= (/ font-lock-maximum-size 8) (buffer-size)))) |
693 |
(flet ((article-goto-body ())) ; shadow this function to do nothing |
(flet ((article-goto-body ())) ; shadow this function to do nothing |
694 |
(save-excursion |
(save-excursion |
695 |
(goto-char (point-min)) |
(goto-char (point-min)) |
704 |
(unless (>= (string-to-number emacs-version) 21) |
(unless (>= (string-to-number emacs-version) 21) |
705 |
;; XEmacs doesn't care. |
;; XEmacs doesn't care. |
706 |
(set-keymap-parent map mh-show-mode-map)) |
(set-keymap-parent map mh-show-mode-map)) |
707 |
(define-key map [mouse-2] 'mh-push-button) |
(mh-do-in-gnu-emacs |
708 |
|
(define-key map [mouse-2] 'mh-push-button)) |
709 |
|
(mh-do-in-xemacs |
710 |
|
(define-key map '(button2) 'mh-push-button)) |
711 |
(dolist (c mh-mime-button-commands) |
(dolist (c mh-mime-button-commands) |
712 |
(define-key map (cadr c) (car c))) |
(define-key map (cadr c) (car c))) |
713 |
map)) |
map)) |
730 |
(unless (>= (string-to-number emacs-version) 21) |
(unless (>= (string-to-number emacs-version) 21) |
731 |
(set-keymap-parent map mh-show-mode-map)) |
(set-keymap-parent map mh-show-mode-map)) |
732 |
(define-key map "\r" 'mh-press-button) |
(define-key map "\r" 'mh-press-button) |
733 |
(define-key map [mouse-2] 'mh-push-button) |
(mh-do-in-gnu-emacs |
734 |
|
(define-key map [mouse-2] 'mh-push-button)) |
735 |
|
(mh-do-in-xemacs |
736 |
|
(define-key map '(button2) 'mh-push-button)) |
737 |
map)) |
map)) |
738 |
|
|
739 |
(defvar mh-mime-save-parts-directory nil |
(defvar mh-mime-save-parts-directory nil |
780 |
(if (equal nil mh-mime-save-parts-default-directory) |
(if (equal nil mh-mime-save-parts-default-directory) |
781 |
(setq mh-mime-save-parts-directory directory)) |
(setq mh-mime-save-parts-directory directory)) |
782 |
(save-excursion |
(save-excursion |
783 |
(set-buffer (get-buffer-create " *mh-store*")) |
(set-buffer (get-buffer-create mh-log-buffer)) |
784 |
(cd directory) |
(cd directory) |
785 |
(setq mh-mime-save-parts-directory directory) |
(setq mh-mime-save-parts-directory directory) |
786 |
(erase-buffer) |
(let ((initial-size (mh-truncate-log-buffer))) |
787 |
(apply 'call-process |
(apply 'call-process |
788 |
(expand-file-name command mh-progs) nil t nil |
(expand-file-name command mh-progs) nil t nil |
789 |
(mh-list-to-string (list folder msg "-auto"))) |
(mh-list-to-string (list folder msg "-auto"))) |
790 |
(if (> (buffer-size) 0) |
(if (> (buffer-size) initial-size) |
791 |
(save-window-excursion |
(save-window-excursion |
792 |
(switch-to-buffer-other-window " *mh-store*") |
(switch-to-buffer-other-window mh-log-buffer) |
793 |
(sit-for 3))))))) |
(sit-for 3)))))))) |
794 |
|
|
795 |
;; Avoid errors if gnus-sum isn't loaded yet... |
;; Avoid errors if gnus-sum isn't loaded yet... |
796 |
(defvar gnus-newsgroup-charset nil) |
(defvar gnus-newsgroup-charset nil) |
797 |
(defvar gnus-newsgroup-name nil) |
(defvar gnus-newsgroup-name nil) |
798 |
|
|
799 |
|
(defun mh-decode-message-body () |
800 |
|
"Decode message based on charset. |
801 |
|
If message has been encoded for transfer take that into account." |
802 |
|
(let* ((ct (ignore-errors (mail-header-parse-content-type |
803 |
|
(message-fetch-field "Content-Type" t)))) |
804 |
|
(charset (mail-content-type-get ct 'charset)) |
805 |
|
(cte (message-fetch-field "Content-Transfer-Encoding"))) |
806 |
|
(when (stringp cte) (setq cte (mail-header-strip cte))) |
807 |
|
(when (or (not ct) (equal (car ct) "text/plain")) |
808 |
|
(save-restriction |
809 |
|
(narrow-to-region (min (1+ (mh-mail-header-end)) (point-max)) |
810 |
|
(point-max)) |
811 |
|
(mm-decode-body charset |
812 |
|
(and cte (intern (downcase |
813 |
|
(gnus-strip-whitespace cte)))) |
814 |
|
(car ct)))))) |
815 |
|
|
816 |
|
;;;###mh-autoload |
817 |
|
(defun mh-decode-message-header () |
818 |
|
"Decode RFC2047 encoded message header fields." |
819 |
|
(when mh-decode-mime-flag |
820 |
|
(let ((buffer-read-only nil)) |
821 |
|
(rfc2047-decode-region (point-min) (mh-mail-header-end))))) |
822 |
|
|
823 |
;;;###mh-autoload |
;;;###mh-autoload |
824 |
(defun mh-mime-display (&optional pre-dissected-handles) |
(defun mh-mime-display (&optional pre-dissected-handles) |
825 |
"Display (and possibly decode) MIME handles. |
"Display (and possibly decode) MIME handles. |
827 |
present they are displayed otherwise the buffer is parsed and then |
present they are displayed otherwise the buffer is parsed and then |
828 |
displayed." |
displayed." |
829 |
(let ((handles ()) |
(let ((handles ()) |
830 |
(folder mh-show-folder-buffer)) |
(folder mh-show-folder-buffer) |
831 |
|
(raw-message-data (buffer-string))) |
832 |
(flet ((mm-handle-set-external-undisplayer |
(flet ((mm-handle-set-external-undisplayer |
833 |
(handle function) |
(handle function) |
834 |
(mh-handle-set-external-undisplayer folder handle function))) |
(mh-handle-set-external-undisplayer folder handle function))) |
835 |
;; If needed dissect the current buffer |
(goto-char (point-min)) |
836 |
(if pre-dissected-handles |
(unless (search-forward "\n\n" nil t) |
837 |
(setq handles pre-dissected-handles) |
(goto-char (point-max)) |
838 |
(setq handles (or (mm-dissect-buffer nil) (mm-uu-dissect))) |
(insert "\n\n")) |
839 |
(setf (mh-mime-handles (mh-buffer-data)) |
|
840 |
(mm-merge-handles handles (mh-mime-handles (mh-buffer-data)))) |
(condition-case err |
841 |
|
(progn |
842 |
;; Use charset to decode body... |
;; If needed dissect the current buffer |
843 |
(unless handles |
(if pre-dissected-handles |
844 |
(let* ((ct (ignore-errors |
(setq handles pre-dissected-handles) |
845 |
(mail-header-parse-content-type |
(setq handles (or (mm-dissect-buffer nil) (mm-uu-dissect))) |
846 |
(message-fetch-field "Content-Type" t)))) |
(setf (mh-mime-handles (mh-buffer-data)) |
847 |
(charset (mail-content-type-get ct 'charset))) |
(mm-merge-handles handles |
848 |
(when (stringp charset) |
(mh-mime-handles (mh-buffer-data)))) |
849 |
(mm-decode-body charset))))) |
(unless handles (mh-decode-message-body))) |
850 |
|
|
851 |
(when (and handles (or (not (stringp (car handles))) (cdr handles))) |
(when (and handles |
852 |
;; Goto start of message body |
(or (not (stringp (car handles))) (cdr handles))) |
853 |
(goto-char (point-min)) |
;; Goto start of message body |
854 |
(or (search-forward "\n\n" nil t) (goto-char (point-max))) |
(goto-char (point-min)) |
855 |
|
(or (search-forward "\n\n" nil t) (goto-char (point-max))) |
856 |
|
|
857 |
;; Delete the body |
;; Delete the body |
858 |
(delete-region (point) (point-max)) |
(delete-region (point) (point-max)) |
859 |
|
|
860 |
;; Display the MIME handles |
;; Display the MIME handles |
861 |
(mh-mime-display-part handles))))) |
(mh-mime-display-part handles))) |
862 |
|
(error |
863 |
|
(message "Please report this error. The error message is:\n %s" |
864 |
|
(error-message-string err)) |
865 |
|
(delete-region (point-min) (point-max)) |
866 |
|
(insert raw-message-data)))))) |
867 |
|
|
868 |
(defun mh-mime-display-part (handle) |
(defun mh-mime-display-part (handle) |
869 |
"Decides the viewer to call based on the type of HANDLE." |
"Decides the viewer to call based on the type of HANDLE." |
924 |
(let* ((image (mm-get-image handle))) |
(let* ((image (mm-get-image handle))) |
925 |
(cond ((fboundp 'glyph-width) |
(cond ((fboundp 'glyph-width) |
926 |
;; XEmacs -- totally untested, copied from gnus |
;; XEmacs -- totally untested, copied from gnus |
927 |
(and (< (glyph-width image) |
(and (mh-funcall-if-exists glyphp image) |
928 |
|
(< (glyph-width image) |
929 |
(or mh-max-inline-image-width |
(or mh-max-inline-image-width |
930 |
(window-pixel-width))) |
(window-pixel-width))) |
931 |
(< (glyph-height image) |
(< (glyph-height image) |
933 |
(window-pixel-height))))) |
(window-pixel-height))))) |
934 |
((fboundp 'image-size) |
((fboundp 'image-size) |
935 |
;; Emacs21 -- copied from gnus |
;; Emacs21 -- copied from gnus |
936 |
(let ((size (image-size image))) |
(let ((size (mh-funcall-if-exists image-size image))) |
937 |
(and (< (cdr size) |
(and size |
938 |
|
(< (cdr size) |
939 |
(or mh-max-inline-image-height |
(or mh-max-inline-image-height |
940 |
(1- (window-height)))) |
(1- (window-height)))) |
941 |
(< (car size) |
(< (car size) |
947 |
(defun mh-inline-vcard-p (handle) |
(defun mh-inline-vcard-p (handle) |
948 |
"Decide if HANDLE is a vcard that must be displayed inline." |
"Decide if HANDLE is a vcard that must be displayed inline." |
949 |
(let ((type (mm-handle-type handle))) |
(let ((type (mm-handle-type handle))) |
950 |
(and (consp type) |
(and (or (featurep 'vcard) (fboundp 'vcard-pretty-print)) |
951 |
|
(consp type) |
952 |
(equal (car type) "text/x-vcard") |
(equal (car type) "text/x-vcard") |
953 |
(save-excursion |
(save-excursion |
954 |
(save-restriction |
(save-restriction |
992 |
(mh-mm-display-part handle))) |
(mh-mm-display-part handle))) |
993 |
(goto-char (point-max))))) |
(goto-char (point-max))))) |
994 |
|
|
995 |
|
(mh-do-in-xemacs |
996 |
|
(defvar dots) |
997 |
|
(defvar type)) |
998 |
|
|
999 |
(defun mh-insert-mime-button (handle index displayed) |
(defun mh-insert-mime-button (handle index displayed) |
1000 |
"Insert MIME button for HANDLE. |
"Insert MIME button for HANDLE. |
1001 |
INDEX is the part number that will be DISPLAYED. It is also used by commands |
INDEX is the part number that will be DISPLAYED. It is also used by commands |
1062 |
(progn |
(progn |
1063 |
;; Delete the button and displayed part (if any) |
;; Delete the button and displayed part (if any) |
1064 |
(let ((region (get-text-property point 'mh-region))) |
(let ((region (get-text-property point 'mh-region))) |
1065 |
(when region |
(when (and region (fboundp 'remove-images)) |
1066 |
(when (fboundp 'remove-images) |
(mh-funcall-if-exists |
1067 |
(remove-images (car region) (cdr region)))) |
remove-images (car region) (cdr region))) |
1068 |
(mm-display-part handle) |
(mm-display-part handle) |
1069 |
(when region |
(when region |
1070 |
(delete-region (car region) (cdr region)))) |
(delete-region (car region) (cdr region)))) |
1130 |
displayed. This function is called when the mouse is used to click the MIME |
displayed. This function is called when the mouse is used to click the MIME |
1131 |
button." |
button." |
1132 |
(interactive "e") |
(interactive "e") |
1133 |
(set-buffer (window-buffer (posn-window (event-start event)))) |
(save-excursion |
1134 |
(select-window (posn-window (event-start event))) |
(let* ((event-window |
1135 |
(let* ((pos (posn-point (event-start event))) |
(or (mh-funcall-if-exists posn-window (event-start event));GNU Emacs |
1136 |
(folder mh-show-folder-buffer) |
(mh-funcall-if-exists event-window event))) ;XEmacs |
1137 |
(mm-inline-media-tests mh-mm-inline-media-tests) |
(event-position |
1138 |
(data (get-text-property pos 'mh-data)) |
(or (mh-funcall-if-exists posn-point (event-start event)) ;GNU Emacs |
1139 |
(function (get-text-property pos 'mh-callback)) |
(mh-funcall-if-exists event-closest-point event))) ;XEmacs |
1140 |
(buffer-read-only nil)) |
(original-window (selected-window)) |
1141 |
(flet ((mm-handle-set-external-undisplayer |
(original-position (progn |
1142 |
(handle function) |
(set-buffer (window-buffer event-window)) |
1143 |
(mh-handle-set-external-undisplayer folder handle function))) |
(set-marker (make-marker) (point)))) |
1144 |
(goto-char pos) |
(folder mh-show-folder-buffer) |
1145 |
(unwind-protect (and function (funcall function data)) |
(mm-inline-media-tests mh-mm-inline-media-tests) |
1146 |
(set-buffer-modified-p nil))))) |
(data (get-text-property event-position 'mh-data)) |
1147 |
|
(function (get-text-property event-position 'mh-callback)) |
1148 |
|
(buffer-read-only nil)) |
1149 |
|
(unwind-protect |
1150 |
|
(progn |
1151 |
|
(select-window event-window) |
1152 |
|
(flet ((mm-handle-set-external-undisplayer (handle func) |
1153 |
|
(mh-handle-set-external-undisplayer folder handle func))) |
1154 |
|
(goto-char event-position) |
1155 |
|
(and function (funcall function data)))) |
1156 |
|
(set-buffer-modified-p nil) |
1157 |
|
(goto-char original-position) |
1158 |
|
(set-marker original-position nil) |
1159 |
|
(select-window original-window))))) |
1160 |
|
|
1161 |
;;;###mh-autoload |
;;;###mh-autoload |
1162 |
(defun mh-mime-save-part () |
(defun mh-mime-save-part () |
1318 |
handles)))) |
handles)))) |
1319 |
|
|
1320 |
(goto-char (point-min)) |
(goto-char (point-min)) |
1321 |
|
(mh-show-xface) |
1322 |
(cond (clean-message-header |
(cond (clean-message-header |
1323 |
(mh-clean-msg-header (point-min) |
(mh-clean-msg-header (point-min) |
1324 |
invisible-headers |
invisible-headers |
1326 |
(goto-char (point-min))) |
(goto-char (point-min))) |
1327 |
(t |
(t |
1328 |
(mh-start-of-uncleaned-message))) |
(mh-start-of-uncleaned-message))) |
1329 |
(mh-show-xface) |
(mh-decode-message-header) |
1330 |
(mh-show-addr) |
(mh-show-addr) |
1331 |
;; The other highlighting types don't need anything special |
;; The other highlighting types don't need anything special |
1332 |
(when (eq mh-highlight-citation-p 'gnus) |
(when (eq mh-highlight-citation-p 'gnus) |