mirror of
git://git.sv.gnu.org/emacs.git
synced 2026-01-30 12:21:25 -08:00
(mh-mm-merge-handles)
(mh-mm-set-handle-multipart-parameter, mh-mm-inline-text-vcard) (mh-mml-minibuffer-read-disposition, mh-mm-save-part): Update with code from Gnus 5.11 (closes SF #2235022).
This commit is contained in:
parent
170bc4f7d8
commit
55f56e6aed
2 changed files with 55 additions and 40 deletions
|
|
@ -1,3 +1,10 @@
|
|||
2009-01-27 Bill Wohler <wohler@newt.com>
|
||||
|
||||
* mh-gnus.el (mh-mm-merge-handles)
|
||||
(mh-mm-set-handle-multipart-parameter, mh-mm-inline-text-vcard)
|
||||
(mh-mml-minibuffer-read-disposition, mh-mm-save-part): Update with
|
||||
code from Gnus 5.11 (closes SF #2235022).
|
||||
|
||||
2009-01-26 Stephen Gildea <gildea@stop.mail-abuse.org>
|
||||
|
||||
* mh-e.el (mh-pack-folder-hook): New variable.
|
||||
|
|
|
|||
|
|
@ -38,6 +38,7 @@
|
|||
(mh-require 'mml nil t)
|
||||
|
||||
;; Copy of function from gnus-util.el.
|
||||
;; TODO This is not in Gnus 5.11.
|
||||
(defun-mh mh-gnus-local-map-property gnus-local-map-property (map)
|
||||
"Return a list suitable for a text property list specifying keymap MAP."
|
||||
(cond ((featurep 'xemacs) (list 'keymap map))
|
||||
|
|
@ -46,29 +47,34 @@
|
|||
|
||||
;; Copy of function from mm-decode.el.
|
||||
(defun-mh mh-mm-merge-handles mm-merge-handles (handles1 handles2)
|
||||
(append (if (listp (car handles1)) handles1 (list handles1))
|
||||
(if (listp (car handles2)) handles2 (list handles2))))
|
||||
(append
|
||||
(if (listp (car handles1))
|
||||
handles1
|
||||
(list handles1))
|
||||
(if (listp (car handles2))
|
||||
handles2
|
||||
(list handles2))))
|
||||
|
||||
;; Copy of function from mm-decode.el.
|
||||
(defun-mh mh-mm-set-handle-multipart-parameter
|
||||
mm-set-handle-multipart-parameter (handle parameter value)
|
||||
;; HANDLE could be a CTL.
|
||||
(if handle
|
||||
(put-text-property 0 (length (car handle)) parameter value
|
||||
(car handle))))
|
||||
(when handle
|
||||
(put-text-property 0 (length (car handle)) parameter value
|
||||
(car handle))))
|
||||
|
||||
;; Copy of function from mm-view.el.
|
||||
(defun-mh mh-mm-inline-text-vcard mm-inline-text-vcard (handle)
|
||||
(let (buffer-read-only)
|
||||
(let ((inhibit-read-only t))
|
||||
(mm-insert-inline
|
||||
handle
|
||||
(concat "\n-- \n"
|
||||
(ignore-errors
|
||||
(if (fboundp 'vcard-pretty-print)
|
||||
(vcard-pretty-print (mm-get-part handle))
|
||||
(vcard-format-string
|
||||
(vcard-parse-string (mm-get-part handle)
|
||||
'vcard-standard-filter))))))))
|
||||
(ignore-errors
|
||||
(if (fboundp 'vcard-pretty-print)
|
||||
(vcard-pretty-print (mm-get-part handle))
|
||||
(vcard-format-string
|
||||
(vcard-parse-string (mm-get-part handle)
|
||||
'vcard-standard-filter))))))))
|
||||
|
||||
;; Function from mm-decode.el used in PGP messages. Just define it with older
|
||||
;; Gnus to avoid compiler warning.
|
||||
|
|
@ -119,41 +125,43 @@
|
|||
|
||||
;; Copy of function in mml.el.
|
||||
(defun-mh mh-mml-minibuffer-read-disposition
|
||||
mml-minibuffer-read-disposition (type &optional default)
|
||||
(unless default (setq default
|
||||
(if (and (string-match "\\`text/" type)
|
||||
(not (string-match "\\`text/rtf\\'" type)))
|
||||
"inline"
|
||||
"attachment")))
|
||||
mml-minibuffer-read-disposition (type &optional default filename)
|
||||
(unless default
|
||||
(setq default (mml-content-disposition type filename)))
|
||||
(let ((disposition (completing-read
|
||||
(format "Disposition (default %s): " default)
|
||||
'(("attachment") ("inline") (""))
|
||||
nil t nil nil default)))
|
||||
(format "Disposition (default %s): " default)
|
||||
'(("attachment") ("inline") (""))
|
||||
nil t nil nil default)))
|
||||
(if (not (equal disposition ""))
|
||||
disposition
|
||||
disposition
|
||||
default)))
|
||||
|
||||
;; This is mm-save-part from Gnus 5.10 since that function in emacs21.2 is
|
||||
;; buggy (the args to read-file-name are incorrect). When all supported
|
||||
;; versions of Emacs come with at least Gnus 5.10, we can delete this
|
||||
;; function and rename calls to mh-mm-save-part to mm-save-part.
|
||||
(defun mh-mm-save-part (handle)
|
||||
"Write HANDLE to a file."
|
||||
(let ((name (mail-content-type-get (mm-handle-type handle) 'name))
|
||||
(filename (mail-content-type-get
|
||||
(mm-handle-disposition handle) 'filename))
|
||||
file)
|
||||
;; This is mm-save-part from Gnus 5.11 since that function in Emacs
|
||||
;; 21.2 is buggy (the args to read-file-name are incorrect) and the
|
||||
;; version in Emacs 22 is not consistent with C-x C-w in that you
|
||||
;; can't just specify a directory and have the right thing happen.
|
||||
(defun mh-mm-save-part (handle &optional prompt)
|
||||
"Write HANDLE to a file.
|
||||
PROMPT overrides the default one used to ask user for a file name."
|
||||
(let ((filename (or (mail-content-type-get
|
||||
(mm-handle-disposition handle) 'filename)
|
||||
(mail-content-type-get
|
||||
(mm-handle-type handle) 'name)))
|
||||
file)
|
||||
(when filename
|
||||
(setq filename (file-name-nondirectory filename)))
|
||||
(setq file (read-file-name "Save MIME part to: "
|
||||
(or mm-default-directory
|
||||
default-directory)
|
||||
nil nil (or filename name "")))
|
||||
(setq filename (gnus-map-function mm-file-name-rewrite-functions
|
||||
(file-name-nondirectory filename))))
|
||||
(setq file
|
||||
(read-file-name (or prompt "Save MIME part to: ")
|
||||
(or mm-default-directory default-directory)
|
||||
nil nil (or filename "")))
|
||||
(setq mm-default-directory (file-name-directory file))
|
||||
(and (or (not (file-exists-p file))
|
||||
(yes-or-no-p (format "File %s already exists; overwrite? "
|
||||
file)))
|
||||
(mm-save-part-to-file handle file))))
|
||||
(yes-or-no-p (format "File %s already exists; overwrite? "
|
||||
file)))
|
||||
(progn
|
||||
(mm-save-part-to-file handle file)
|
||||
file))))
|
||||
|
||||
(defun mh-mm-text-html-renderer ()
|
||||
"Find the renderer Gnus is using to display text/html MIME parts."
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue