Commit | Line | Data |
---|---|---|
dda00b2c | 1 | ;;; mh-gnus.el --- make MH-E compatible with various versions of Gnus |
a66894d8 | 2 | |
dcf71371 BW |
3 | ;; Copyright (C) 2003, 2004, 2006, 2007, 2008, 2009 |
4 | ;; Free Software Foundation, Inc. | |
a66894d8 BW |
5 | |
6 | ;; Author: Satyaki Das <satyaki@theforce.stanford.edu> | |
7 | ;; Maintainer: Bill Wohler <wohler@newt.com> | |
8 | ;; Keywords: mail | |
9 | ;; See: mh-e.el | |
10 | ||
11 | ;; This file is part of GNU Emacs. | |
12 | ||
5e809f55 | 13 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
a66894d8 | 14 | ;; it under the terms of the GNU General Public License as published by |
5e809f55 GM |
15 | ;; the Free Software Foundation, either version 3 of the License, or |
16 | ;; (at your option) any later version. | |
a66894d8 BW |
17 | |
18 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
19 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
20 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
21 | ;; GNU General Public License for more details. | |
22 | ||
23 | ;; You should have received a copy of the GNU General Public License | |
5e809f55 | 24 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
a66894d8 BW |
25 | |
26 | ;;; Commentary: | |
27 | ||
28 | ;;; Change Log: | |
29 | ||
30 | ;;; Code: | |
31 | ||
dda00b2c | 32 | (require 'mh-e) |
549afb31 | 33 | |
d5dc8c56 BW |
34 | (mh-require 'gnus-util nil t) |
35 | (mh-require 'mm-bodies nil t) | |
36 | (mh-require 'mm-decode nil t) | |
37 | (mh-require 'mm-view nil t) | |
38 | (mh-require 'mml nil t) | |
a66894d8 | 39 | |
549afb31 | 40 | ;; Copy of function from gnus-util.el. |
c90c4cf1 | 41 | (defun-mh mh-gnus-local-map-property gnus-local-map-property (map) |
a66894d8 | 42 | "Return a list suitable for a text property list specifying keymap MAP." |
a3269bc4 | 43 | (cond ((featurep 'xemacs) (list 'keymap map)) |
a66894d8 BW |
44 | ((>= emacs-major-version 21) (list 'keymap map)) |
45 | (t (list 'local-map map)))) | |
46 | ||
549afb31 | 47 | ;; Copy of function from mm-decode.el. |
c90c4cf1 | 48 | (defun-mh mh-mm-merge-handles mm-merge-handles (handles1 handles2) |
a66894d8 BW |
49 | (append (if (listp (car handles1)) handles1 (list handles1)) |
50 | (if (listp (car handles2)) handles2 (list handles2)))) | |
51 | ||
0c47b17c | 52 | ;; Copy of function from mm-decode.el. |
c90c4cf1 | 53 | (defun-mh mh-mm-set-handle-multipart-parameter |
06e7028b | 54 | mm-set-handle-multipart-parameter (handle parameter value) |
a66894d8 BW |
55 | ;; HANDLE could be a CTL. |
56 | (if handle | |
57 | (put-text-property 0 (length (car handle)) parameter value | |
58 | (car handle)))) | |
59 | ||
0c47b17c | 60 | ;; Copy of function from mm-view.el. |
c90c4cf1 | 61 | (defun-mh mh-mm-inline-text-vcard mm-inline-text-vcard (handle) |
f0d73c14 BW |
62 | (let (buffer-read-only) |
63 | (mm-insert-inline | |
64 | handle | |
65 | (concat "\n-- \n" | |
dda00b2c BW |
66 | (ignore-errors |
67 | (if (fboundp 'vcard-pretty-print) | |
68 | (vcard-pretty-print (mm-get-part handle)) | |
69 | (vcard-format-string | |
70 | (vcard-parse-string (mm-get-part handle) | |
71 | 'vcard-standard-filter)))))))) | |
f0d73c14 BW |
72 | |
73 | ;; Function from mm-decode.el used in PGP messages. Just define it with older | |
0c47b17c | 74 | ;; Gnus to avoid compiler warning. |
c90c4cf1 | 75 | (defun-mh mh-mm-possibly-verify-or-decrypt |
06e7028b | 76 | mm-possibly-verify-or-decrypt (parts ctl) |
f0d73c14 BW |
77 | nil) |
78 | ||
549afb31 | 79 | ;; Copy of macro in mm-decode.el. |
c90c4cf1 | 80 | (defmacro-mh mh-mm-handle-multipart-ctl-parameter |
06e7028b | 81 | mm-handle-multipart-ctl-parameter (handle parameter) |
a66894d8 BW |
82 | `(get-text-property 0 ,parameter (car ,handle))) |
83 | ||
549afb31 | 84 | ;; Copy of function in mm-decode.el. |
c90c4cf1 | 85 | (defun-mh mh-mm-readable-p mm-readable-p (handle) |
a66894d8 BW |
86 | "Say whether the content of HANDLE is readable." |
87 | (and (< (with-current-buffer (mm-handle-buffer handle) | |
88 | (buffer-size)) 10000) | |
89 | (mm-with-unibyte-buffer | |
90 | (mm-insert-part handle) | |
91 | (and (eq (mm-body-7-or-8) '7bit) | |
06e7028b | 92 | (not (mh-mm-long-lines-p 76)))))) |
a66894d8 | 93 | |
549afb31 | 94 | ;; Copy of function in mm-bodies.el. |
c90c4cf1 | 95 | (defun-mh mh-mm-long-lines-p mm-long-lines-p (length) |
a66894d8 BW |
96 | "Say whether any of the lines in the buffer is longer than LENGTH." |
97 | (save-excursion | |
98 | (goto-char (point-min)) | |
99 | (end-of-line) | |
100 | (while (and (not (eobp)) | |
101 | (not (> (current-column) length))) | |
102 | (forward-line 1) | |
103 | (end-of-line)) | |
104 | (and (> (current-column) length) | |
105 | (current-column)))) | |
106 | ||
c90c4cf1 | 107 | (defun-mh mh-mm-keep-viewer-alive-p mm-keep-viewer-alive-p (handle) |
a66894d8 BW |
108 | ;; Released Gnus doesn't keep handles associated with externally displayed |
109 | ;; MIME parts. So this will always return nil. | |
110 | nil) | |
111 | ||
c90c4cf1 | 112 | (defun-mh mh-mm-destroy-parts mm-destroy-parts (list) |
0c47b17c | 113 | "Older versions of Emacs don't have this function." |
a66894d8 BW |
114 | nil) |
115 | ||
c90c4cf1 | 116 | (defun-mh mh-mm-uu-dissect-text-parts mm-uu-dissect-text-parts (handles) |
dda00b2c BW |
117 | "Emacs 21 and XEmacs don't have this function." |
118 | nil) | |
119 | ||
549afb31 | 120 | ;; Copy of function in mml.el. |
c90c4cf1 | 121 | (defun-mh mh-mml-minibuffer-read-disposition |
06e7028b | 122 | mml-minibuffer-read-disposition (type &optional default) |
0c47b17c BW |
123 | (unless default (setq default |
124 | (if (and (string-match "\\`text/" type) | |
125 | (not (string-match "\\`text/rtf\\'" type))) | |
126 | "inline" | |
127 | "attachment"))) | |
128 | (let ((disposition (completing-read | |
129 | (format "Disposition (default %s): " default) | |
130 | '(("attachment") ("inline") ("")) | |
131 | nil t nil nil default))) | |
132 | (if (not (equal disposition "")) | |
dda00b2c | 133 | disposition |
0c47b17c BW |
134 | default))) |
135 | ||
cee9f5c6 BW |
136 | ;; This is mm-save-part from Gnus 5.10 since that function in emacs21.2 is |
137 | ;; buggy (the args to read-file-name are incorrect). When all supported | |
138 | ;; versions of Emacs come with at least Gnus 5.10, we can delete this | |
139 | ;; function and rename calls to mh-mm-save-part to mm-save-part. | |
a66894d8 BW |
140 | (defun mh-mm-save-part (handle) |
141 | "Write HANDLE to a file." | |
142 | (let ((name (mail-content-type-get (mm-handle-type handle) 'name)) | |
143 | (filename (mail-content-type-get | |
144 | (mm-handle-disposition handle) 'filename)) | |
145 | file) | |
146 | (when filename | |
147 | (setq filename (file-name-nondirectory filename))) | |
148 | (setq file (read-file-name "Save MIME part to: " | |
149 | (or mm-default-directory | |
150 | default-directory) | |
151 | nil nil (or filename name ""))) | |
152 | (setq mm-default-directory (file-name-directory file)) | |
153 | (and (or (not (file-exists-p file)) | |
154 | (yes-or-no-p (format "File %s already exists; overwrite? " | |
155 | file))) | |
156 | (mm-save-part-to-file handle file)))) | |
157 | ||
f0d73c14 | 158 | (defun mh-mm-text-html-renderer () |
0c47b17c | 159 | "Find the renderer Gnus is using to display text/html MIME parts." |
f0d73c14 BW |
160 | (or (and (boundp 'mm-inline-text-html-renderer) mm-inline-text-html-renderer) |
161 | (and (boundp 'mm-text-html-renderer) mm-text-html-renderer))) | |
162 | ||
a66894d8 | 163 | (provide 'mh-gnus) |
f0d73c14 | 164 | |
cee9f5c6 BW |
165 | ;; Local Variables: |
166 | ;; no-byte-compile: t | |
167 | ;; no-update-autoloads: t | |
168 | ;; indent-tabs-mode: nil | |
169 | ;; sentence-end-double-space: nil | |
170 | ;; End: | |
23b8b180 MB |
171 | |
172 | ;; arch-tag: 1e3638af-cad3-4c69-8427-bc8eb6e5e4fa | |
a66894d8 | 173 | ;;; mh-gnus.el ends here |