1 ;;; mh-gnus.el --- make MH-E compatible with various versions of Gnus
3 ;; Copyright (C) 2003, 2004, 2006, 2007, 2008 Free Software Foundation, Inc.
5 ;; Author: Satyaki Das <satyaki@theforce.stanford.edu>
6 ;; Maintainer: Bill Wohler <wohler@newt.com>
10 ;; This file is part of GNU Emacs.
12 ;; GNU Emacs is free software; you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation; either version 3, or (at your option)
17 ;; GNU Emacs is distributed in the hope that it will be useful,
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;; GNU General Public License for more details.
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs; see the file COPYING. If not, write to the
24 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
25 ;; Boston, MA 02110-1301, USA.
35 (mh-require 'gnus-util nil t
)
36 (mh-require 'mm-bodies nil t
)
37 (mh-require 'mm-decode nil t
)
38 (mh-require 'mm-view nil t
)
39 (mh-require 'mml nil t
)
41 ;; Copy of function from gnus-util.el.
42 (defun-mh mh-gnus-local-map-property gnus-local-map-property
(map)
43 "Return a list suitable for a text property list specifying keymap MAP."
44 (cond ((featurep 'xemacs
) (list 'keymap map
))
45 ((>= emacs-major-version
21) (list 'keymap map
))
46 (t (list 'local-map map
))))
48 ;; Copy of function from mm-decode.el.
49 (defun-mh mh-mm-merge-handles mm-merge-handles
(handles1 handles2
)
50 (append (if (listp (car handles1
)) handles1
(list handles1
))
51 (if (listp (car handles2
)) handles2
(list handles2
))))
53 ;; Copy of function from mm-decode.el.
54 (defun-mh mh-mm-set-handle-multipart-parameter
55 mm-set-handle-multipart-parameter
(handle parameter value
)
56 ;; HANDLE could be a CTL.
58 (put-text-property 0 (length (car handle
)) parameter value
61 ;; Copy of function from mm-view.el.
62 (defun-mh mh-mm-inline-text-vcard mm-inline-text-vcard
(handle)
63 (let (buffer-read-only)
68 (if (fboundp 'vcard-pretty-print
)
69 (vcard-pretty-print (mm-get-part handle
))
71 (vcard-parse-string (mm-get-part handle
)
72 'vcard-standard-filter
))))))))
74 ;; Function from mm-decode.el used in PGP messages. Just define it with older
75 ;; Gnus to avoid compiler warning.
76 (defun-mh mh-mm-possibly-verify-or-decrypt
77 mm-possibly-verify-or-decrypt
(parts ctl
)
80 ;; Copy of macro in mm-decode.el.
81 (defmacro-mh mh-mm-handle-multipart-ctl-parameter
82 mm-handle-multipart-ctl-parameter
(handle parameter
)
83 `(get-text-property 0 ,parameter
(car ,handle
)))
85 ;; Copy of function in mm-decode.el.
86 (defun-mh mh-mm-readable-p mm-readable-p
(handle)
87 "Say whether the content of HANDLE is readable."
88 (and (< (with-current-buffer (mm-handle-buffer handle
)
90 (mm-with-unibyte-buffer
91 (mm-insert-part handle
)
92 (and (eq (mm-body-7-or-8) '7bit
)
93 (not (mh-mm-long-lines-p 76))))))
95 ;; Copy of function in mm-bodies.el.
96 (defun-mh mh-mm-long-lines-p mm-long-lines-p
(length)
97 "Say whether any of the lines in the buffer is longer than LENGTH."
99 (goto-char (point-min))
101 (while (and (not (eobp))
102 (not (> (current-column) length
)))
105 (and (> (current-column) length
)
108 (defun-mh mh-mm-keep-viewer-alive-p mm-keep-viewer-alive-p
(handle)
109 ;; Released Gnus doesn't keep handles associated with externally displayed
110 ;; MIME parts. So this will always return nil.
113 (defun-mh mh-mm-destroy-parts mm-destroy-parts
(list)
114 "Older versions of Emacs don't have this function."
117 (defun-mh mh-mm-uu-dissect-text-parts mm-uu-dissect-text-parts
(handles)
118 "Emacs 21 and XEmacs don't have this function."
121 ;; Copy of function in mml.el.
122 (defun-mh mh-mml-minibuffer-read-disposition
123 mml-minibuffer-read-disposition
(type &optional default
)
124 (unless default
(setq default
125 (if (and (string-match "\\`text/" type
)
126 (not (string-match "\\`text/rtf\\'" type
)))
129 (let ((disposition (completing-read
130 (format "Disposition (default %s): " default
)
131 '(("attachment") ("inline") (""))
132 nil t nil nil default
)))
133 (if (not (equal disposition
""))
137 ;; This is mm-save-part from Gnus 5.10 since that function in emacs21.2 is
138 ;; buggy (the args to read-file-name are incorrect). When all supported
139 ;; versions of Emacs come with at least Gnus 5.10, we can delete this
140 ;; function and rename calls to mh-mm-save-part to mm-save-part.
141 (defun mh-mm-save-part (handle)
142 "Write HANDLE to a file."
143 (let ((name (mail-content-type-get (mm-handle-type handle
) 'name
))
144 (filename (mail-content-type-get
145 (mm-handle-disposition handle
) 'filename
))
148 (setq filename
(file-name-nondirectory filename
)))
149 (setq file
(read-file-name "Save MIME part to: "
150 (or mm-default-directory
152 nil nil
(or filename name
"")))
153 (setq mm-default-directory
(file-name-directory file
))
154 (and (or (not (file-exists-p file
))
155 (yes-or-no-p (format "File %s already exists; overwrite? "
157 (mm-save-part-to-file handle file
))))
159 (defun mh-mm-text-html-renderer ()
160 "Find the renderer Gnus is using to display text/html MIME parts."
161 (or (and (boundp 'mm-inline-text-html-renderer
) mm-inline-text-html-renderer
)
162 (and (boundp 'mm-text-html-renderer
) mm-text-html-renderer
)))
167 ;; no-byte-compile: t
168 ;; no-update-autoloads: t
169 ;; indent-tabs-mode: nil
170 ;; sentence-end-double-space: nil
173 ;; arch-tag: 1e3638af-cad3-4c69-8427-bc8eb6e5e4fa
174 ;;; mh-gnus.el ends here