1;;; mh-gnus.el --- make MH-E compatible with various versions of Gnus 2 3;; Copyright (C) 2003, 2004, 2006, 2007 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 2, or (at your option) 15;; 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; 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. 26 27;;; Commentary: 28 29;;; Change Log: 30 31;;; Code: 32 33(require 'mh-e) 34 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) 40 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 (mh-xemacs-flag (list 'keymap map)) 45 ((>= emacs-major-version 21) (list 'keymap map)) 46 (t (list 'local-map map)))) 47 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)))) 52 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. 57 (if handle 58 (put-text-property 0 (length (car handle)) parameter value 59 (car handle)))) 60 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) 64 (mm-insert-inline 65 handle 66 (concat "\n-- \n" 67 (ignore-errors 68 (if (fboundp 'vcard-pretty-print) 69 (vcard-pretty-print (mm-get-part handle)) 70 (vcard-format-string 71 (vcard-parse-string (mm-get-part handle) 72 'vcard-standard-filter)))))))) 73 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) 78 nil) 79 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))) 84 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) 89 (buffer-size)) 10000) 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)))))) 94 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." 98 (save-excursion 99 (goto-char (point-min)) 100 (end-of-line) 101 (while (and (not (eobp)) 102 (not (> (current-column) length))) 103 (forward-line 1) 104 (end-of-line)) 105 (and (> (current-column) length) 106 (current-column)))) 107 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. 111 nil) 112 113(defun-mh mh-mm-destroy-parts mm-destroy-parts (list) 114 "Older versions of Emacs don't have this function." 115 nil) 116 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." 119 nil) 120 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))) 127 "inline" 128 "attachment"))) 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 "")) 134 disposition 135 default))) 136 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)) 146 file) 147 (when filename 148 (setq filename (file-name-nondirectory filename))) 149 (setq file (read-file-name "Save MIME part to: " 150 (or mm-default-directory 151 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? " 156 file))) 157 (mm-save-part-to-file handle file)))) 158 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))) 163 164(provide 'mh-gnus) 165 166;; Local Variables: 167;; no-byte-compile: t 168;; no-update-autoloads: t 169;; indent-tabs-mode: nil 170;; sentence-end-double-space: nil 171;; End: 172 173;; arch-tag: 1e3638af-cad3-4c69-8427-bc8eb6e5e4fa 174;;; mh-gnus.el ends here 175