/[emacs]/emacs/lisp/mh-e/mh-mime.el
ViewVC logotype

Diff of /emacs/lisp/mh-e/mh-mime.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.2 by wohler, Mon Feb 3 20:55:30 2003 UTC revision 1.3 by wohler, Fri Apr 25 05:52:00 2003 UTC
# Line 1  Line 1 
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>
# Line 32  Line 32 
32    
33  ;;; Change Log:  ;;; Change Log:
34    
 ;; $Id$  
   
35  ;;; Code:  ;;; Code:
36    
37  (require 'cl)  (require 'cl)
# Line 58  Line 56 
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)
# Line 235  See also \\[mh-edit-mhn]." Line 234  See also \\[mh-edit-mhn]."
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
# Line 306  DESCRIPTION, a line of text for the Cont Line 304  DESCRIPTION, a line of text for the Cont
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
# Line 341  See also \\[mh-edit-mhn]." Line 338  See also \\[mh-edit-mhn]."
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
# Line 368  Process the current draft with the mhn p Line 364  Process the current draft with the mhn p
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
# Line 379  components in a message, see \\[mh-mhn-c Line 376  components in a message, see \\[mh-mhn-c
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.
# Line 396  The mhn program is part of MH version 6. Line 392  The mhn program is part of MH version 6.
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))
# Line 429  Optional non-nil argument NOCONFIRM mean Line 424  Optional non-nil argument NOCONFIRM mean
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)
# Line 460  number." Line 472  number."
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
# Line 488  automatically." Line 499  automatically."
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 ()
# Line 497  automatically." Line 507  automatically."
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)
# Line 507  If called with a prefix argument DONTSIG Line 516  If called with a prefix argument DONTSIG
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    
# Line 547  BODY." Line 564  BODY."
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."
# Line 610  BODY." Line 629  BODY."
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))))
# Line 662  I have seen this only in spam, so maybe Line 680  I have seen this only in spam, so maybe
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    
# Line 669  I have seen this only in spam, so maybe Line 688  I have seen this only in spam, so maybe
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))
# Line 685  I have seen this only in spam, so maybe Line 704  I have seen this only in spam, so maybe
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))
# Line 708  I have seen this only in spam, so maybe Line 730  I have seen this only in spam, so maybe
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
# Line 755  actual storing." Line 780  actual storing."
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.
# Line 778  Optional argument, PRE-DISSECTED-HANDLES Line 827  Optional argument, PRE-DISSECTED-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."
# Line 868  This is only useful if a Content-Disposi Line 924  This is only useful if a Content-Disposi
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)
# Line 876  This is only useful if a Content-Disposi Line 933  This is only useful if a Content-Disposi
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)
# Line 889  This is only useful if a Content-Disposi Line 947  This is only useful if a Content-Disposi
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
# Line 933  This is only useful if a Content-Disposi Line 992  This is only useful if a Content-Disposi
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
# Line 999  like \"K v\" which operate on individual Line 1062  like \"K v\" which operate on individual
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))))
# Line 1067  If the MIME part is visible then it is r Line 1130  If the MIME part is visible then it is r
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 ()
# Line 1242  message multiple times." Line 1318  message multiple times."
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
# Line 1249  message multiple times." Line 1326  message multiple times."
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)

Legend:
Removed from v.1.2  
changed lines
  Added in v.1.3

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26