X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/1bad168e59601c1c843a38b2962e77b29f497f11..39eb0cb563f5287270f3946804456dc766386638:/lisp/mh-e/mh-gnus.el diff --git a/lisp/mh-e/mh-gnus.el b/lisp/mh-e/mh-gnus.el index 3fe4e2fb46..50a5aed62a 100644 --- a/lisp/mh-e/mh-gnus.el +++ b/lisp/mh-e/mh-gnus.el @@ -1,6 +1,6 @@ ;;; mh-gnus.el --- make MH-E compatible with various versions of Gnus -;; Copyright (C) 2003, 2004, 2006, 2007, 2008 Free Software Foundation, Inc. +;; Copyright (C) 2003-2004, 2006-2013 Free Software Foundation, Inc. ;; Author: Satyaki Das ;; Maintainer: Bill Wohler @@ -9,10 +9,10 @@ ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of @@ -20,9 +20,7 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -39,6 +37,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)) @@ -47,29 +46,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. @@ -120,41 +124,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." @@ -170,5 +176,4 @@ ;; sentence-end-double-space: nil ;; End: -;; arch-tag: 1e3638af-cad3-4c69-8427-bc8eb6e5e4fa ;;; mh-gnus.el ends here