| 1 | ;;; mh-gnus.el --- make MH-E compatible with various versions of Gnus |
| 2 | |
| 3 | ;; Copyright (C) 2003-2004, 2006-2014 Free Software Foundation, Inc. |
| 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 | |
| 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 of the License, or |
| 15 | ;; (at your option) any later version. |
| 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 |
| 23 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
| 24 | |
| 25 | ;;; Commentary: |
| 26 | |
| 27 | ;;; Change Log: |
| 28 | |
| 29 | ;;; Code: |
| 30 | |
| 31 | (require 'mh-e) |
| 32 | |
| 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) |
| 38 | |
| 39 | ;; Copy of function from gnus-util.el. |
| 40 | ;; TODO This is not in Gnus 5.11. |
| 41 | (defun-mh mh-gnus-local-map-property gnus-local-map-property (map) |
| 42 | "Return a list suitable for a text property list specifying keymap MAP." |
| 43 | (cond ((featurep 'xemacs) (list 'keymap map)) |
| 44 | ((>= emacs-major-version 21) (list 'keymap map)) |
| 45 | (t (list 'local-map map)))) |
| 46 | |
| 47 | ;; Copy of function from mm-decode.el. |
| 48 | (defun-mh mh-mm-merge-handles mm-merge-handles (handles1 handles2) |
| 49 | (append |
| 50 | (if (listp (car handles1)) |
| 51 | handles1 |
| 52 | (list handles1)) |
| 53 | (if (listp (car handles2)) |
| 54 | handles2 |
| 55 | (list handles2)))) |
| 56 | |
| 57 | ;; Copy of function from mm-decode.el. |
| 58 | (defun-mh mh-mm-set-handle-multipart-parameter |
| 59 | mm-set-handle-multipart-parameter (handle parameter value) |
| 60 | ;; HANDLE could be a CTL. |
| 61 | (when handle |
| 62 | (put-text-property 0 (length (car handle)) parameter value |
| 63 | (car handle)))) |
| 64 | |
| 65 | ;; Copy of function from mm-view.el. |
| 66 | (defun-mh mh-mm-inline-text-vcard mm-inline-text-vcard (handle) |
| 67 | (let ((inhibit-read-only t)) |
| 68 | (mm-insert-inline |
| 69 | handle |
| 70 | (concat "\n-- \n" |
| 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)))))))) |
| 77 | |
| 78 | ;; Function from mm-decode.el used in PGP messages. Just define it with older |
| 79 | ;; Gnus to avoid compiler warning. |
| 80 | (defun-mh mh-mm-possibly-verify-or-decrypt |
| 81 | mm-possibly-verify-or-decrypt (parts ctl) |
| 82 | nil) |
| 83 | |
| 84 | ;; Copy of macro in mm-decode.el. |
| 85 | (defmacro-mh mh-mm-handle-multipart-ctl-parameter |
| 86 | mm-handle-multipart-ctl-parameter (handle parameter) |
| 87 | `(get-text-property 0 ,parameter (car ,handle))) |
| 88 | |
| 89 | ;; Copy of function in mm-decode.el. |
| 90 | (defun-mh mh-mm-readable-p mm-readable-p (handle) |
| 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) |
| 97 | (not (mh-mm-long-lines-p 76)))))) |
| 98 | |
| 99 | ;; Copy of function in mm-bodies.el. |
| 100 | (defun-mh mh-mm-long-lines-p mm-long-lines-p (length) |
| 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 | |
| 112 | (defun-mh mh-mm-keep-viewer-alive-p mm-keep-viewer-alive-p (handle) |
| 113 | ;; Released Gnus doesn't keep handles associated with externally displayed |
| 114 | ;; MIME parts. So this will always return nil. |
| 115 | nil) |
| 116 | |
| 117 | (defun-mh mh-mm-destroy-parts mm-destroy-parts (list) |
| 118 | "Older versions of Emacs don't have this function." |
| 119 | nil) |
| 120 | |
| 121 | (defun-mh mh-mm-uu-dissect-text-parts mm-uu-dissect-text-parts (handles) |
| 122 | "Emacs 21 and XEmacs don't have this function." |
| 123 | nil) |
| 124 | |
| 125 | ;; Copy of function in mml.el. |
| 126 | (defun-mh mh-mml-minibuffer-read-disposition |
| 127 | mml-minibuffer-read-disposition (type &optional default filename) |
| 128 | (unless default |
| 129 | (setq default (mml-content-disposition type filename))) |
| 130 | (let ((disposition (completing-read |
| 131 | (format "Disposition (default %s): " default) |
| 132 | '(("attachment") ("inline") ("")) |
| 133 | nil t nil nil default))) |
| 134 | (if (not (equal disposition "")) |
| 135 | disposition |
| 136 | default))) |
| 137 | |
| 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) |
| 150 | (when filename |
| 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 ""))) |
| 157 | (setq mm-default-directory (file-name-directory file)) |
| 158 | (and (or (not (file-exists-p file)) |
| 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)))) |
| 164 | |
| 165 | (defun mh-mm-text-html-renderer () |
| 166 | "Find the renderer Gnus is using to display text/html MIME parts." |
| 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 | |
| 170 | (provide 'mh-gnus) |
| 171 | |
| 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: |
| 178 | |
| 179 | ;;; mh-gnus.el ends here |