summaryrefslogtreecommitdiff
path: root/lisp/mh-e/mh-gnus.el
diff options
context:
space:
mode:
authorBill Wohler <wohler@newt.com>2004-07-13 03:06:25 +0000
committerBill Wohler <wohler@newt.com>2004-07-13 03:06:25 +0000
commita66894d8b489dfdfafc2058cd181fefbb894fbf0 (patch)
tree39c692b4da2f58c1f9830381b0befa1ec3d56b87 /lisp/mh-e/mh-gnus.el
parent0117451de7e30adf240f369f26b7667dbf3788bf (diff)
downloademacs-a66894d8b489dfdfafc2058cd181fefbb894fbf0.tar.gz
Upgraded to MH-E version 7.4.4.
See etc/MH-E-NEWS and lisp/mh-e/ChangeLog for details.
Diffstat (limited to 'lisp/mh-e/mh-gnus.el')
-rw-r--r--lisp/mh-e/mh-gnus.el142
1 files changed, 142 insertions, 0 deletions
diff --git a/lisp/mh-e/mh-gnus.el b/lisp/mh-e/mh-gnus.el
new file mode 100644
index 00000000000..82748335408
--- /dev/null
+++ b/lisp/mh-e/mh-gnus.el
@@ -0,0 +1,142 @@
+;;; mh-gnus.el --- Make MH-E compatible with installed version of Gnus.
+
+;; Copyright (C) 2003 Free Software Foundation, Inc.
+
+;; Author: Satyaki Das <satyaki@theforce.stanford.edu>
+;; Maintainer: Bill Wohler <wohler@newt.com>
+;; Keywords: mail
+;; See: mh-e.el
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Change Log:
+
+;;; Code:
+
+(load "mm-decode" t t) ; Non-fatal dependency
+(load "mm-uu" t t) ; Non-fatal dependency
+(load "mailcap" t t) ; Non-fatal dependency
+(load "smiley" t t) ; Non-fatal dependency
+
+(defmacro mh-defun-compat (function arg-list &rest body)
+ "This is a macro to define functions which are not defined.
+It is used for Gnus utility functions which were added recently. If FUNCTION
+is not defined then it is defined to have argument list, ARG-LIST and body,
+BODY."
+ (let ((defined-p (fboundp function)))
+ (unless defined-p
+ `(defun ,function ,arg-list ,@body))))
+(put 'mh-defun-compat 'lisp-indent-function 'defun)
+
+(defmacro mh-defmacro-compat (function arg-list &rest body)
+ "This is a macro to define functions which are not defined.
+It is used for Gnus utility functions which were added recently. If FUNCTION
+is not defined then it is defined to have argument list, ARG-LIST and body,
+BODY."
+ (let ((defined-p (fboundp function)))
+ (unless defined-p
+ `(defmacro ,function ,arg-list ,@body))))
+(put 'mh-defmacro-compat 'lisp-indent-function 'defun)
+
+;; Copy of original function from gnus-util.el
+(mh-defun-compat gnus-local-map-property (map)
+ "Return a list suitable for a text property list specifying keymap MAP."
+ (cond (mh-xemacs-flag (list 'keymap map))
+ ((>= emacs-major-version 21) (list 'keymap map))
+ (t (list 'local-map map))))
+
+;; Copy of original function from mm-decode.el
+(mh-defun-compat mm-merge-handles (handles1 handles2)
+ (append (if (listp (car handles1)) handles1 (list handles1))
+ (if (listp (car handles2)) handles2 (list handles2))))
+
+;; Copy of function from mm-decode.el
+(mh-defun-compat mm-set-handle-multipart-parameter (handle parameter value)
+ ;; HANDLE could be a CTL.
+ (if handle
+ (put-text-property 0 (length (car handle)) parameter value
+ (car handle))))
+
+;; Copy of original macro is in mm-decode.el
+(mh-defmacro-compat mm-handle-multipart-ctl-parameter (handle parameter)
+ `(get-text-property 0 ,parameter (car ,handle)))
+
+(mh-do-in-xemacs (defvar default-enable-multibyte-characters))
+
+;; Copy of original function in mm-decode.el
+(mh-defun-compat mm-readable-p (handle)
+ "Say whether the content of HANDLE is readable."
+ (and (< (with-current-buffer (mm-handle-buffer handle)
+ (buffer-size)) 10000)
+ (mm-with-unibyte-buffer
+ (mm-insert-part handle)
+ (and (eq (mm-body-7-or-8) '7bit)
+ (not (mm-long-lines-p 76))))))
+
+;; Copy of original function in mm-bodies.el
+(mh-defun-compat mm-long-lines-p (length)
+ "Say whether any of the lines in the buffer is longer than LENGTH."
+ (save-excursion
+ (goto-char (point-min))
+ (end-of-line)
+ (while (and (not (eobp))
+ (not (> (current-column) length)))
+ (forward-line 1)
+ (end-of-line))
+ (and (> (current-column) length)
+ (current-column))))
+
+(mh-defun-compat mm-keep-viewer-alive-p (handle)
+ ;; Released Gnus doesn't keep handles associated with externally displayed
+ ;; MIME parts. So this will always return nil.
+ nil)
+
+(mh-defun-compat mm-destroy-parts (list)
+ "Older emacs don't have this function."
+ nil)
+
+;;; This is mm-save-part from gnus 5.10 since that function in emacs21.2 is
+;;; buggy (the args to read-file-name are incorrect). When all supported
+;;; versions of Emacs come with at least Gnus 5.10, we can delete this
+;;; function and rename calls to mh-mm-save-part to mm-save-part.
+(defun mh-mm-save-part (handle)
+ "Write HANDLE to a file."
+ (let ((name (mail-content-type-get (mm-handle-type handle) 'name))
+ (filename (mail-content-type-get
+ (mm-handle-disposition handle) 'filename))
+ file)
+ (when filename
+ (setq filename (file-name-nondirectory filename)))
+ (setq file (read-file-name "Save MIME part to: "
+ (or mm-default-directory
+ default-directory)
+ nil nil (or filename name "")))
+ (setq mm-default-directory (file-name-directory file))
+ (and (or (not (file-exists-p file))
+ (yes-or-no-p (format "File %s already exists; overwrite? "
+ file)))
+ (mm-save-part-to-file handle file))))
+
+(provide 'mh-gnus)
+;;; Local Variables:
+;;; no-byte-compile: t
+;;; no-update-autoloads: t
+;;; End:
+;;; mh-gnus.el ends here