[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] Changes to emacs/lisp/mh-e/mh-mime.el
From: |
Bill Wohler |
Subject: |
[Emacs-diffs] Changes to emacs/lisp/mh-e/mh-mime.el |
Date: |
Fri, 25 Apr 2003 01:52:09 -0400 |
Index: emacs/lisp/mh-e/mh-mime.el
diff -c emacs/lisp/mh-e/mh-mime.el:1.2 emacs/lisp/mh-e/mh-mime.el:1.3
*** emacs/lisp/mh-e/mh-mime.el:1.2 Mon Feb 3 15:55:30 2003
--- emacs/lisp/mh-e/mh-mime.el Fri Apr 25 01:52:00 2003
***************
*** 1,6 ****
;;; mh-mime.el --- MH-E support for composing MIME messages
! ;; Copyright (C) 1993, 1995, 2001, 2002 Free Software Foundation, Inc.
;; Author: Bill Wohler <address@hidden>
;; Maintainer: Bill Wohler <address@hidden>
--- 1,6 ----
;;; mh-mime.el --- MH-E support for composing MIME messages
! ;; Copyright (C) 1993, 1995, 2001, 02, 2003 Free Software Foundation, Inc.
;; Author: Bill Wohler <address@hidden>
;; Maintainer: Bill Wohler <address@hidden>
***************
*** 32,39 ****
;;; Change Log:
- ;; $Id: mh-mime.el,v 1.2 2003/02/03 20:55:30 wohler Exp $
-
;;; Code:
(require 'cl)
--- 32,37 ----
***************
*** 58,63 ****
--- 56,62 ----
(autoload 'mml-insert-empty-tag "mml")
(autoload 'mml-to-mime "mml")
(autoload 'mml-attach-file "mml")
+ (autoload 'rfc2047-decode-region "rfc2047")
;;;###mh-autoload
(defun mh-compose-insertion (&optional inline)
***************
*** 235,241 ****
The file specified by FILENAME is encoded as TYPE. An optional DESCRIPTION is
used as the Content-Description field, optional set of ATTRIBUTES and an
optional COMMENT can also be included."
- (setq mh-mhn-compose-insert-flag t)
(beginning-of-line)
(insert "#" type)
(and attributes
--- 234,239 ----
***************
*** 306,312 ****
EXTRA-PARAMS, and COMMENT.
See also \\[mh-edit-mhn]."
- (setq mh-mhn-compose-insert-flag t)
(beginning-of-line)
(insert "#@" type)
(and attributes
--- 304,309 ----
***************
*** 341,347 ****
(if mh-sent-from-msg
(format " [%d]" mh-sent-from-msg)
"")))))
- (setq mh-mhn-compose-insert-flag t)
(beginning-of-line)
(insert "#forw [")
(and description
--- 338,343 ----
***************
*** 368,374 ****
already inserted in the draft, fills in all the MIME components and header
fields.
! This step should be done last just before sending the message.
The `\\[mh-revert-mhn-edit]' command undoes this command. The arguments in the
list `mh-mhn-args' are passed to mhn if this function is passed an optional
--- 364,371 ----
already inserted in the draft, fills in all the MIME components and header
fields.
! This step is performed automatically when sending the message, but this
! function may be called manually before sending the draft as well.
The `\\[mh-revert-mhn-edit]' command undoes this command. The arguments in the
list `mh-mhn-args' are passed to mhn if this function is passed an optional
***************
*** 379,386 ****
from a file), \\[mh-mhn-compose-anon-ftp] (external reference to file via
anonymous ftp), \\[mh-mhn-compose-external-compressed-tar] \ \(reference to
compressed tar file via anonymous ftp), and \\[mh-mhn-compose-forw] (forward
! message). If these helper functions are used, `mh-edit-mhn' is run
! automatically when the draft is sent.
The value of `mh-edit-mhn-hook' is a list of functions to be called, with no
arguments, after performing the conversion.
--- 376,382 ----
from a file), \\[mh-mhn-compose-anon-ftp] (external reference to file via
anonymous ftp), \\[mh-mhn-compose-external-compressed-tar] \ \(reference to
compressed tar file via anonymous ftp), and \\[mh-mhn-compose-forw] (forward
! message).
The value of `mh-edit-mhn-hook' is a list of functions to be called, with no
arguments, after performing the conversion.
***************
*** 396,402 ****
(t
(mh-exec-cmd-error (format "mhdraft=%s" buffer-file-name)
"mhn" (if extra-args mh-mhn-args) buffer-file-name)))
- (setq mh-mhn-compose-insert-flag nil)
(revert-buffer t t)
(message "mhn editing...done")
(run-hooks 'mh-edit-mhn-hook))
--- 392,397 ----
***************
*** 429,446 ****
(insert-file-contents backup-file))
(after-find-file nil)))
;;; MIME composition functions
;;;###mh-autoload
(defun mh-mml-to-mime ()
! "Compose MIME message from mml directives."
(interactive)
(when mh-gnus-pgp-support-flag ;; This is only needed for PGP
(message-options-set-recipient))
! (mml-to-mime)
! (setq mh-mml-compose-insert-flag nil))
;;;###mh-autoload
(defun mh-mml-forward-message (description folder message)
--- 424,458 ----
(insert-file-contents backup-file))
(after-find-file nil)))
+ ;;;###mh-autoload
+ (defun mh-mhn-directive-present-p ()
+ "Check if the current buffer has text which might be a MHN directive."
+ (save-excursion
+ (block 'search-for-mhn-directive
+ (goto-char (point-min))
+ (while (re-search-forward "^#" nil t)
+ (let ((s (buffer-substring-no-properties (point)
(line-end-position))))
+ (cond ((equal s ""))
+ ((string-match "^forw[ \t\n]+" s)
+ (return-from 'search-for-mhn-directive t))
+ (t (let ((first-token (car (split-string s "[ \t;@]"))))
+ (when (string-match mh-media-type-regexp first-token)
+ (return-from 'search-for-mhn-directive t)))))))
+ nil)))
+
;;; MIME composition functions
;;;###mh-autoload
(defun mh-mml-to-mime ()
! "Compose MIME message from mml directives.
! This step is performed automatically when sending the message, but this
! function may be called manually before sending the draft as well."
(interactive)
(when mh-gnus-pgp-support-flag ;; This is only needed for PGP
(message-options-set-recipient))
! (mml-to-mime))
;;;###mh-autoload
(defun mh-mml-forward-message (description folder message)
***************
*** 460,467 ****
(mml-attach-file (format "%s%s/%d"
mh-user-path (substring folder 1) msg)
"message/rfc822"
! description))
! (setq mh-mml-compose-insert-flag t))
(t (error "The message number, %s is not a integer!" msg)))))
;;;###mh-autoload
--- 472,478 ----
(mml-attach-file (format "%s%s/%d"
mh-user-path (substring folder 1) msg)
"message/rfc822"
! description)))
(t (error "The message number, %s is not a integer!" msg)))))
;;;###mh-autoload
***************
*** 488,495 ****
nil t nil nil
"attachment"))))
(mml-insert-empty-tag 'part 'type type 'filename file
! 'disposition dispos 'description description)
! (setq mh-mml-compose-insert-flag t)))
;;;###mh-autoload
(defun mh-mml-secure-message-sign-pgpmime ()
--- 499,505 ----
nil t nil nil
"attachment"))))
(mml-insert-empty-tag 'part 'type type 'filename file
! 'disposition dispos 'description description)))
;;;###mh-autoload
(defun mh-mml-secure-message-sign-pgpmime ()
***************
*** 497,504 ****
(interactive)
(if (not mh-gnus-pgp-support-flag)
(error "Sorry. Your version of gnus does not support PGP/GPG")
! (mml-secure-message-sign-pgpmime)
! (setq mh-mml-compose-insert-flag t)))
;;;###mh-autoload
(defun mh-mml-secure-message-encrypt-pgpmime (&optional dontsign)
--- 507,513 ----
(interactive)
(if (not mh-gnus-pgp-support-flag)
(error "Sorry. Your version of gnus does not support PGP/GPG")
! (mml-secure-message-sign-pgpmime)))
;;;###mh-autoload
(defun mh-mml-secure-message-encrypt-pgpmime (&optional dontsign)
***************
*** 507,514 ****
(interactive "P")
(if (not mh-gnus-pgp-support-flag)
(error "Sorry. Your version of gnus does not support PGP/GPG")
! (mml-secure-message-encrypt-pgpmime dontsign)
! (setq mh-mml-compose-insert-flag t)))
--- 516,531 ----
(interactive "P")
(if (not mh-gnus-pgp-support-flag)
(error "Sorry. Your version of gnus does not support PGP/GPG")
! (mml-secure-message-encrypt-pgpmime dontsign)))
!
! ;;;###mh-autoload
! (defun mh-mml-directive-present-p ()
! "Check if the current buffer has text which may be an MML directive."
! (save-excursion
! (goto-char (point-min))
! (re-search-forward
! "\\(<#part\\(.\\|\n\\)*>[ \n\t]*<#/part>\\|^<#secure.+>$\\)"
! nil t)))
***************
*** 547,552 ****
--- 564,571 ----
(mh-defun-compat mm-handle-multipart-ctl-parameter (handle parameter)
(get-text-property 0 parameter (car handle)))
+ (mh-do-in-xemacs (defvar default-enable-multibyte-characters))
+
;; Copy of original function in mm-decode.el
(mh-defun-compat mm-readable-p (handle)
"Say whether the content of HANDLE is readable."
***************
*** 610,617 ****
"Free the decoded MIME parts."
(let ((mime-data (gethash (current-buffer) mh-globals-hash)))
;; This is for Emacs, what about XEmacs?
! (cond ((fboundp 'remove-images)
! (remove-images (point-min) (point-max))))
(when mime-data
(mm-destroy-parts (mh-mime-handles mime-data))
(remhash (current-buffer) mh-globals-hash))))
--- 629,635 ----
"Free the decoded MIME parts."
(let ((mime-data (gethash (current-buffer) mh-globals-hash)))
;; This is for Emacs, what about XEmacs?
! (mh-funcall-if-exists remove-images (point-min) (point-max))
(when mime-data
(mm-destroy-parts (mh-mime-handles mime-data))
(remhash (current-buffer) mh-globals-hash))))
***************
*** 662,667 ****
--- 680,686 ----
(when (and mh-graphical-smileys-flag
(fboundp 'smiley-region)
(boundp 'font-lock-maximum-size)
+ font-lock-maximum-size
(>= (/ font-lock-maximum-size 8) (buffer-size)))
(smiley-region (point-min) (point-max))))
***************
*** 669,676 ****
(defun mh-display-emphasis ()
"Function to display graphical emphasis."
(when (and mh-graphical-emphasis-flag
! (boundp 'font-lock-maximum-size)
! (>= (/ font-lock-maximum-size 8) (buffer-size)))
(flet ((article-goto-body ())) ; shadow this function to do nothing
(save-excursion
(goto-char (point-min))
--- 688,695 ----
(defun mh-display-emphasis ()
"Function to display graphical emphasis."
(when (and mh-graphical-emphasis-flag
! (if font-lock-maximum-size
! (>= (/ font-lock-maximum-size 8) (buffer-size))))
(flet ((article-goto-body ())) ; shadow this function to do nothing
(save-excursion
(goto-char (point-min))
***************
*** 685,691 ****
(unless (>= (string-to-number emacs-version) 21)
;; XEmacs doesn't care.
(set-keymap-parent map mh-show-mode-map))
! (define-key map [mouse-2] 'mh-push-button)
(dolist (c mh-mime-button-commands)
(define-key map (cadr c) (car c)))
map))
--- 704,713 ----
(unless (>= (string-to-number emacs-version) 21)
;; XEmacs doesn't care.
(set-keymap-parent map mh-show-mode-map))
! (mh-do-in-gnu-emacs
! (define-key map [mouse-2] 'mh-push-button))
! (mh-do-in-xemacs
! (define-key map '(button2) 'mh-push-button))
(dolist (c mh-mime-button-commands)
(define-key map (cadr c) (car c)))
map))
***************
*** 708,714 ****
(unless (>= (string-to-number emacs-version) 21)
(set-keymap-parent map mh-show-mode-map))
(define-key map "\r" 'mh-press-button)
! (define-key map [mouse-2] 'mh-push-button)
map))
(defvar mh-mime-save-parts-directory nil
--- 730,739 ----
(unless (>= (string-to-number emacs-version) 21)
(set-keymap-parent map mh-show-mode-map))
(define-key map "\r" 'mh-press-button)
! (mh-do-in-gnu-emacs
! (define-key map [mouse-2] 'mh-push-button))
! (mh-do-in-xemacs
! (define-key map '(button2) 'mh-push-button))
map))
(defvar mh-mime-save-parts-directory nil
***************
*** 755,776 ****
(if (equal nil mh-mime-save-parts-default-directory)
(setq mh-mime-save-parts-directory directory))
(save-excursion
! (set-buffer (get-buffer-create " *mh-store*"))
(cd directory)
(setq mh-mime-save-parts-directory directory)
! (erase-buffer)
! (apply 'call-process
! (expand-file-name command mh-progs) nil t nil
! (mh-list-to-string (list folder msg "-auto")))
! (if (> (buffer-size) 0)
! (save-window-excursion
! (switch-to-buffer-other-window " *mh-store*")
! (sit-for 3)))))))
;; Avoid errors if gnus-sum isn't loaded yet...
(defvar gnus-newsgroup-charset nil)
(defvar gnus-newsgroup-name nil)
;;;###mh-autoload
(defun mh-mime-display (&optional pre-dissected-handles)
"Display (and possibly decode) MIME handles.
--- 780,825 ----
(if (equal nil mh-mime-save-parts-default-directory)
(setq mh-mime-save-parts-directory directory))
(save-excursion
! (set-buffer (get-buffer-create mh-log-buffer))
(cd directory)
(setq mh-mime-save-parts-directory directory)
! (let ((initial-size (mh-truncate-log-buffer)))
! (apply 'call-process
! (expand-file-name command mh-progs) nil t nil
! (mh-list-to-string (list folder msg "-auto")))
! (if (> (buffer-size) initial-size)
! (save-window-excursion
! (switch-to-buffer-other-window mh-log-buffer)
! (sit-for 3))))))))
;; Avoid errors if gnus-sum isn't loaded yet...
(defvar gnus-newsgroup-charset nil)
(defvar gnus-newsgroup-name nil)
+ (defun mh-decode-message-body ()
+ "Decode message based on charset.
+ If message has been encoded for transfer take that into account."
+ (let* ((ct (ignore-errors (mail-header-parse-content-type
+ (message-fetch-field "Content-Type" t))))
+ (charset (mail-content-type-get ct 'charset))
+ (cte (message-fetch-field "Content-Transfer-Encoding")))
+ (when (stringp cte) (setq cte (mail-header-strip cte)))
+ (when (or (not ct) (equal (car ct) "text/plain"))
+ (save-restriction
+ (narrow-to-region (min (1+ (mh-mail-header-end)) (point-max))
+ (point-max))
+ (mm-decode-body charset
+ (and cte (intern (downcase
+ (gnus-strip-whitespace cte))))
+ (car ct))))))
+
+ ;;;###mh-autoload
+ (defun mh-decode-message-header ()
+ "Decode RFC2047 encoded message header fields."
+ (when mh-decode-mime-flag
+ (let ((buffer-read-only nil))
+ (rfc2047-decode-region (point-min) (mh-mail-header-end)))))
+
;;;###mh-autoload
(defun mh-mime-display (&optional pre-dissected-handles)
"Display (and possibly decode) MIME handles.
***************
*** 778,813 ****
present they are displayed otherwise the buffer is parsed and then
displayed."
(let ((handles ())
! (folder mh-show-folder-buffer))
(flet ((mm-handle-set-external-undisplayer
(handle function)
(mh-handle-set-external-undisplayer folder handle function)))
! ;; If needed dissect the current buffer
! (if pre-dissected-handles
! (setq handles pre-dissected-handles)
! (setq handles (or (mm-dissect-buffer nil) (mm-uu-dissect)))
! (setf (mh-mime-handles (mh-buffer-data))
! (mm-merge-handles handles (mh-mime-handles (mh-buffer-data))))
!
! ;; Use charset to decode body...
! (unless handles
! (let* ((ct (ignore-errors
! (mail-header-parse-content-type
! (message-fetch-field "Content-Type" t))))
! (charset (mail-content-type-get ct 'charset)))
! (when (stringp charset)
! (mm-decode-body charset)))))
!
! (when (and handles (or (not (stringp (car handles))) (cdr handles)))
! ;; Goto start of message body
! (goto-char (point-min))
! (or (search-forward "\n\n" nil t) (goto-char (point-max)))
! ;; Delete the body
! (delete-region (point) (point-max))
! ;; Display the MIME handles
! (mh-mime-display-part handles)))))
(defun mh-mime-display-part (handle)
"Decides the viewer to call based on the type of HANDLE."
--- 827,869 ----
present they are displayed otherwise the buffer is parsed and then
displayed."
(let ((handles ())
! (folder mh-show-folder-buffer)
! (raw-message-data (buffer-string)))
(flet ((mm-handle-set-external-undisplayer
(handle function)
(mh-handle-set-external-undisplayer folder handle function)))
! (goto-char (point-min))
! (unless (search-forward "\n\n" nil t)
! (goto-char (point-max))
! (insert "\n\n"))
!
! (condition-case err
! (progn
! ;; If needed dissect the current buffer
! (if pre-dissected-handles
! (setq handles pre-dissected-handles)
! (setq handles (or (mm-dissect-buffer nil) (mm-uu-dissect)))
! (setf (mh-mime-handles (mh-buffer-data))
! (mm-merge-handles handles
! (mh-mime-handles (mh-buffer-data))))
! (unless handles (mh-decode-message-body)))
!
! (when (and handles
! (or (not (stringp (car handles))) (cdr handles)))
! ;; Goto start of message body
! (goto-char (point-min))
! (or (search-forward "\n\n" nil t) (goto-char (point-max)))
! ;; Delete the body
! (delete-region (point) (point-max))
! ;; Display the MIME handles
! (mh-mime-display-part handles)))
! (error
! (message "Please report this error. The error message is:\n %s"
! (error-message-string err))
! (delete-region (point-min) (point-max))
! (insert raw-message-data))))))
(defun mh-mime-display-part (handle)
"Decides the viewer to call based on the type of HANDLE."
***************
*** 868,874 ****
(let* ((image (mm-get-image handle)))
(cond ((fboundp 'glyph-width)
;; XEmacs -- totally untested, copied from gnus
! (and (< (glyph-width image)
(or mh-max-inline-image-width
(window-pixel-width)))
(< (glyph-height image)
--- 924,931 ----
(let* ((image (mm-get-image handle)))
(cond ((fboundp 'glyph-width)
;; XEmacs -- totally untested, copied from gnus
! (and (mh-funcall-if-exists glyphp image)
! (< (glyph-width image)
(or mh-max-inline-image-width
(window-pixel-width)))
(< (glyph-height image)
***************
*** 876,883 ****
(window-pixel-height)))))
((fboundp 'image-size)
;; Emacs21 -- copied from gnus
! (let ((size (image-size image)))
! (and (< (cdr size)
(or mh-max-inline-image-height
(1- (window-height))))
(< (car size)
--- 933,941 ----
(window-pixel-height)))))
((fboundp 'image-size)
;; Emacs21 -- copied from gnus
! (let ((size (mh-funcall-if-exists image-size image)))
! (and size
! (< (cdr size)
(or mh-max-inline-image-height
(1- (window-height))))
(< (car size)
***************
*** 889,895 ****
(defun mh-inline-vcard-p (handle)
"Decide if HANDLE is a vcard that must be displayed inline."
(let ((type (mm-handle-type handle)))
! (and (consp type)
(equal (car type) "text/x-vcard")
(save-excursion
(save-restriction
--- 947,954 ----
(defun mh-inline-vcard-p (handle)
"Decide if HANDLE is a vcard that must be displayed inline."
(let ((type (mm-handle-type handle)))
! (and (or (featurep 'vcard) (fboundp 'vcard-pretty-print))
! (consp type)
(equal (car type) "text/x-vcard")
(save-excursion
(save-restriction
***************
*** 933,938 ****
--- 992,1001 ----
(mh-mm-display-part handle)))
(goto-char (point-max)))))
+ (mh-do-in-xemacs
+ (defvar dots)
+ (defvar type))
+
(defun mh-insert-mime-button (handle index displayed)
"Insert MIME button for HANDLE.
INDEX is the part number that will be DISPLAYED. It is also used by commands
***************
*** 999,1007 ****
(progn
;; Delete the button and displayed part (if any)
(let ((region (get-text-property point 'mh-region)))
! (when region
! (when (fboundp 'remove-images)
! (remove-images (car region) (cdr region))))
(mm-display-part handle)
(when region
(delete-region (car region) (cdr region))))
--- 1062,1070 ----
(progn
;; Delete the button and displayed part (if any)
(let ((region (get-text-property point 'mh-region)))
! (when (and region (fboundp 'remove-images))
! (mh-funcall-if-exists
! remove-images (car region) (cdr region)))
(mm-display-part handle)
(when region
(delete-region (car region) (cdr region))))
***************
*** 1067,1086 ****
displayed. This function is called when the mouse is used to click the MIME
button."
(interactive "e")
! (set-buffer (window-buffer (posn-window (event-start event))))
! (select-window (posn-window (event-start event)))
! (let* ((pos (posn-point (event-start event)))
! (folder mh-show-folder-buffer)
! (mm-inline-media-tests mh-mm-inline-media-tests)
! (data (get-text-property pos 'mh-data))
! (function (get-text-property pos 'mh-callback))
! (buffer-read-only nil))
! (flet ((mm-handle-set-external-undisplayer
! (handle function)
! (mh-handle-set-external-undisplayer folder handle function)))
! (goto-char pos)
! (unwind-protect (and function (funcall function data))
! (set-buffer-modified-p nil)))))
;;;###mh-autoload
(defun mh-mime-save-part ()
--- 1130,1162 ----
displayed. This function is called when the mouse is used to click the MIME
button."
(interactive "e")
! (save-excursion
! (let* ((event-window
! (or (mh-funcall-if-exists posn-window (event-start event));GNU
Emacs
! (mh-funcall-if-exists event-window event))) ;XEmacs
! (event-position
! (or (mh-funcall-if-exists posn-point (event-start event)) ;GNU
Emacs
! (mh-funcall-if-exists event-closest-point event))) ;XEmacs
! (original-window (selected-window))
! (original-position (progn
! (set-buffer (window-buffer event-window))
! (set-marker (make-marker) (point))))
! (folder mh-show-folder-buffer)
! (mm-inline-media-tests mh-mm-inline-media-tests)
! (data (get-text-property event-position 'mh-data))
! (function (get-text-property event-position 'mh-callback))
! (buffer-read-only nil))
! (unwind-protect
! (progn
! (select-window event-window)
! (flet ((mm-handle-set-external-undisplayer (handle func)
! (mh-handle-set-external-undisplayer folder handle func)))
! (goto-char event-position)
! (and function (funcall function data))))
! (set-buffer-modified-p nil)
! (goto-char original-position)
! (set-marker original-position nil)
! (select-window original-window)))))
;;;###mh-autoload
(defun mh-mime-save-part ()
***************
*** 1242,1247 ****
--- 1318,1324 ----
handles))))
(goto-char (point-min))
+ (mh-show-xface)
(cond (clean-message-header
(mh-clean-msg-header (point-min)
invisible-headers
***************
*** 1249,1255 ****
(goto-char (point-min)))
(t
(mh-start-of-uncleaned-message)))
! (mh-show-xface)
(mh-show-addr)
;; The other highlighting types don't need anything special
(when (eq mh-highlight-citation-p 'gnus)
--- 1326,1332 ----
(goto-char (point-min)))
(t
(mh-start-of-uncleaned-message)))
! (mh-decode-message-header)
(mh-show-addr)
;; The other highlighting types don't need anything special
(when (eq mh-highlight-citation-p 'gnus)