diff options
author | Bill Wohler <wohler@newt.com> | 2004-07-13 03:06:25 +0000 |
---|---|---|
committer | Bill Wohler <wohler@newt.com> | 2004-07-13 03:06:25 +0000 |
commit | a66894d8b489dfdfafc2058cd181fefbb894fbf0 (patch) | |
tree | 39c692b4da2f58c1f9830381b0befa1ec3d56b87 /lisp/mh-e/mh-gnus.el | |
parent | 0117451de7e30adf240f369f26b7667dbf3788bf (diff) | |
download | emacs-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.el | 142 |
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 |