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