Commit | Line | Data |
---|---|---|
dda00b2c | 1 | ;;; mh-gnus.el --- make MH-E compatible with various versions of Gnus |
a66894d8 | 2 | |
acaf905b | 3 | ;; Copyright (C) 2003-2004, 2006-2012 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. |
55f56e6a | 40 | ;; TODO This is not in Gnus 5.11. |
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) |
55f56e6a BW |
49 | (append |
50 | (if (listp (car handles1)) | |
51 | handles1 | |
52 | (list handles1)) | |
53 | (if (listp (car handles2)) | |
54 | handles2 | |
55 | (list handles2)))) | |
a66894d8 | 56 | |
0c47b17c | 57 | ;; Copy of function from mm-decode.el. |
c90c4cf1 | 58 | (defun-mh mh-mm-set-handle-multipart-parameter |
06e7028b | 59 | mm-set-handle-multipart-parameter (handle parameter value) |
a66894d8 | 60 | ;; HANDLE could be a CTL. |
55f56e6a BW |
61 | (when handle |
62 | (put-text-property 0 (length (car handle)) parameter value | |
63 | (car handle)))) | |
a66894d8 | 64 | |
0c47b17c | 65 | ;; Copy of function from mm-view.el. |
c90c4cf1 | 66 | (defun-mh mh-mm-inline-text-vcard mm-inline-text-vcard (handle) |
55f56e6a | 67 | (let ((inhibit-read-only t)) |
f0d73c14 BW |
68 | (mm-insert-inline |
69 | handle | |
70 | (concat "\n-- \n" | |
55f56e6a BW |
71 | (ignore-errors |
72 | (if (fboundp 'vcard-pretty-print) | |
73 | (vcard-pretty-print (mm-get-part handle)) | |
74 | (vcard-format-string | |
75 | (vcard-parse-string (mm-get-part handle) | |
76 | 'vcard-standard-filter)))))))) | |
f0d73c14 BW |
77 | |
78 | ;; Function from mm-decode.el used in PGP messages. Just define it with older | |
0c47b17c | 79 | ;; Gnus to avoid compiler warning. |
c90c4cf1 | 80 | (defun-mh mh-mm-possibly-verify-or-decrypt |
06e7028b | 81 | mm-possibly-verify-or-decrypt (parts ctl) |
f0d73c14 BW |
82 | nil) |
83 | ||
549afb31 | 84 | ;; Copy of macro in mm-decode.el. |
c90c4cf1 | 85 | (defmacro-mh mh-mm-handle-multipart-ctl-parameter |
06e7028b | 86 | mm-handle-multipart-ctl-parameter (handle parameter) |
a66894d8 BW |
87 | `(get-text-property 0 ,parameter (car ,handle))) |
88 | ||
549afb31 | 89 | ;; Copy of function in mm-decode.el. |
c90c4cf1 | 90 | (defun-mh mh-mm-readable-p mm-readable-p (handle) |
a66894d8 BW |
91 | "Say whether the content of HANDLE is readable." |
92 | (and (< (with-current-buffer (mm-handle-buffer handle) | |
93 | (buffer-size)) 10000) | |
94 | (mm-with-unibyte-buffer | |
95 | (mm-insert-part handle) | |
96 | (and (eq (mm-body-7-or-8) '7bit) | |
06e7028b | 97 | (not (mh-mm-long-lines-p 76)))))) |
a66894d8 | 98 | |
549afb31 | 99 | ;; Copy of function in mm-bodies.el. |
c90c4cf1 | 100 | (defun-mh mh-mm-long-lines-p mm-long-lines-p (length) |
a66894d8 BW |
101 | "Say whether any of the lines in the buffer is longer than LENGTH." |
102 | (save-excursion | |
103 | (goto-char (point-min)) | |
104 | (end-of-line) | |
105 | (while (and (not (eobp)) | |
106 | (not (> (current-column) length))) | |
107 | (forward-line 1) | |
108 | (end-of-line)) | |
109 | (and (> (current-column) length) | |
110 | (current-column)))) | |
111 | ||
c90c4cf1 | 112 | (defun-mh mh-mm-keep-viewer-alive-p mm-keep-viewer-alive-p (handle) |
a66894d8 BW |
113 | ;; Released Gnus doesn't keep handles associated with externally displayed |
114 | ;; MIME parts. So this will always return nil. | |
115 | nil) | |
116 | ||
c90c4cf1 | 117 | (defun-mh mh-mm-destroy-parts mm-destroy-parts (list) |
0c47b17c | 118 | "Older versions of Emacs don't have this function." |
a66894d8 BW |
119 | nil) |
120 | ||
c90c4cf1 | 121 | (defun-mh mh-mm-uu-dissect-text-parts mm-uu-dissect-text-parts (handles) |
dda00b2c BW |
122 | "Emacs 21 and XEmacs don't have this function." |
123 | nil) | |
124 | ||
549afb31 | 125 | ;; Copy of function in mml.el. |
c90c4cf1 | 126 | (defun-mh mh-mml-minibuffer-read-disposition |
55f56e6a BW |
127 | mml-minibuffer-read-disposition (type &optional default filename) |
128 | (unless default | |
129 | (setq default (mml-content-disposition type filename))) | |
0c47b17c | 130 | (let ((disposition (completing-read |
55f56e6a BW |
131 | (format "Disposition (default %s): " default) |
132 | '(("attachment") ("inline") ("")) | |
133 | nil t nil nil default))) | |
0c47b17c | 134 | (if (not (equal disposition "")) |
55f56e6a | 135 | disposition |
0c47b17c BW |
136 | default))) |
137 | ||
55f56e6a BW |
138 | ;; This is mm-save-part from Gnus 5.11 since that function in Emacs |
139 | ;; 21.2 is buggy (the args to read-file-name are incorrect) and the | |
140 | ;; version in Emacs 22 is not consistent with C-x C-w in that you | |
141 | ;; can't just specify a directory and have the right thing happen. | |
142 | (defun mh-mm-save-part (handle &optional prompt) | |
143 | "Write HANDLE to a file. | |
144 | PROMPT overrides the default one used to ask user for a file name." | |
145 | (let ((filename (or (mail-content-type-get | |
146 | (mm-handle-disposition handle) 'filename) | |
147 | (mail-content-type-get | |
148 | (mm-handle-type handle) 'name))) | |
149 | file) | |
a66894d8 | 150 | (when filename |
55f56e6a BW |
151 | (setq filename (gnus-map-function mm-file-name-rewrite-functions |
152 | (file-name-nondirectory filename)))) | |
153 | (setq file | |
154 | (read-file-name (or prompt "Save MIME part to: ") | |
155 | (or mm-default-directory default-directory) | |
156 | nil nil (or filename ""))) | |
a66894d8 BW |
157 | (setq mm-default-directory (file-name-directory file)) |
158 | (and (or (not (file-exists-p file)) | |
55f56e6a BW |
159 | (yes-or-no-p (format "File %s already exists; overwrite? " |
160 | file))) | |
161 | (progn | |
162 | (mm-save-part-to-file handle file) | |
163 | file)))) | |
a66894d8 | 164 | |
f0d73c14 | 165 | (defun mh-mm-text-html-renderer () |
0c47b17c | 166 | "Find the renderer Gnus is using to display text/html MIME parts." |
f0d73c14 BW |
167 | (or (and (boundp 'mm-inline-text-html-renderer) mm-inline-text-html-renderer) |
168 | (and (boundp 'mm-text-html-renderer) mm-text-html-renderer))) | |
169 | ||
a66894d8 | 170 | (provide 'mh-gnus) |
f0d73c14 | 171 | |
cee9f5c6 BW |
172 | ;; Local Variables: |
173 | ;; no-byte-compile: t | |
174 | ;; no-update-autoloads: t | |
175 | ;; indent-tabs-mode: nil | |
176 | ;; sentence-end-double-space: nil | |
177 | ;; End: | |
23b8b180 | 178 | |
a66894d8 | 179 | ;;; mh-gnus.el ends here |