gnus/gnus-mime.el

   1 ;;;
   2 ;;; gnus-mime.el --- MIME extensions for Gnus
   3 ;;;
   4 ;;; Copyright (C) 1996 Free Software Foundation, Inc.
   5 ;;;
   6 ;;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
   7 ;;; Created: 1996/8/6
   8 ;;; Version: $Revision: 0.2 $
   9 ;;; Keywords: news, MIME, multimedia, multilingual, encoded-word
  10 ;;;
  11 ;;; This file is not part of GNU Emacs yet.
  12 ;;;
  13 ;;; This program is free software; you can redistribute it and/or
  14 ;;; modify it under the terms of the GNU General Public License as
  15 ;;; published by the Free Software Foundation; either version 2, or
  16 ;;; (at your option) any later version.
  17 ;;;
  18 ;;; This program is distributed in the hope that it will be useful,
  19 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  21 ;;; General Public License for more details.
  22 ;;;
  23 ;;; You should have received a copy of the GNU General Public License
  24 ;;; along with This program.  If not, write to the Free Software
  25 ;;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  26 ;;;
  27 ;;; Code:
  28
  29 (defun call-after-loaded (module func &optional hook-name)
  30   "If MODULE is provided, then FUNC is called.
  31 Otherwise func is set to MODULE-load-hook.
  32 If optional argument HOOK-NAME is specified,
  33 it is used as hook to set. [gnus-mime.el]"
  34   (if (featurep module)
  35       (funcall func)
  36     (progn
  37       (if (null hook-name)
  38           (setq hook-name
  39                 (intern (concat (symbol-name module) "-load-hook")))
  40         )
  41       (add-hook hook-name func)
  42       )))
  43
  44 (defun get-version-string (id)
  45   "Return a version-string from RCS ID. [gnus-mime.el]"
  46   (and (string-match ",v \\([0-9][0-9.][0-9.]+\\)" id)
  47        (substring id (match-beginning 1)(match-end 1))
  48        ))
  49
  50
  51 ;;; @ version
  52 ;;;
  53
  54 (defconst gnus-mime-RCS-ID
  55   "$Id: gnus-mime.el,v 0.2 1996/08/06 12:05:37 morioka Exp $")
  56
  57 (defconst gnus-mime-version
  58   (get-version-string gnus-mime-RCS-ID))
  59
  60
  61 ;;; @ variables
  62 ;;;
  63
  64 (defvar gnus-show-mime t
  65   "*If non-nil, do mime processing of articles.
  66 The articles will simply be fed to the function given by
  67 `gnus-show-mime-method'.")
  68
  69 (defvar gnus-show-mime-method 'gnus-article-preview-mime-message
  70   "*Function to process a MIME message.
  71 The function is called from the article buffer.")
  72
  73 (defvar gnus-decode-encoded-word-method 'gnus-article-decode-encoded-word
  74   "*Function to decode a MIME encoded-words.
  75 The function is called from the article buffer.")
  76
  77 (defvar gnus-parse-headers-hook
  78   '(gnus-set-summary-default-charset gnus-decode-rfc1522)
  79   "*A hook called before parsing the headers.")
  80
  81
  82 ;;; @ load
  83 ;;;
  84
  85 (require 'gnus)
  86 (autoload 'gnus-decode-rfc1522               "gnus-art-mime")
  87 (autoload 'gnus-article-preview-mime-message "gnus-art-mime")
  88 (autoload 'gnus-article-decode-encoded-word  "gnus-art-mime")
  89 (autoload 'gnus-set-summary-default-charset  "gnus-sum-mime")
  90 (require 'gnus-charset)
  91
  92
  93 ;;; @ for tm-view
  94 ;;;
  95
  96 (defun gnus-content-header-filter ()
  97   (goto-char (point-min))
  98   (mime-preview/cut-header)
  99   (decode-mime-charset-region (point-min)(point-max) default-mime-charset)
 100   (mime/decode-message-header)
 101   )
 102
 103 (set-alist 'mime-viewer/content-header-filter-alist
 104            'gnus-original-article-mode
 105            (function gnus-content-header-filter))
 106
 107
 108 (set-alist 'mime-viewer/code-converter-alist
 109            'gnus-original-article-mode
 110            (function mime-charset/decode-buffer))
 111
 112
 113 (defun mime-viewer/quitting-method-for-gnus ()
 114   (if (not gnus-show-mime)
 115       (mime-viewer/kill-buffer))
 116   (delete-other-windows)
 117   (gnus-article-show-summary)
 118   (if (or (not gnus-show-mime)
 119           (null gnus-have-all-headers))
 120       (gnus-summary-select-article nil t)
 121     ))
 122
 123 (set-alist 'mime-viewer/quitting-method-alist
 124            'gnus-original-article-mode
 125            (function mime-viewer/quitting-method-for-gnus))
 126 (set-alist 'mime-viewer/show-summary-method
 127            'gnus-original-article-mode
 128            (function mime-viewer/quitting-method-for-gnus))
 129
 130
 131 ;;; @ for tm-partial
 132 ;;;
 133
 134 (defun gnus-mime-partial-preview-function ()
 135   (gnus-summary-preview-mime-message (gnus-summary-article-number))
 136   )
 137
 138 (call-after-loaded
 139  'tm-partial
 140  (function
 141   (lambda ()
 142     (set-atype 'mime/content-decoding-condition
 143                '((type . "message/partial")
 144                  (method . mime-article/grab-message/partials)
 145                  (major-mode . gnus-original-article-mode)
 146                  (summary-buffer-exp . gnus-summary-buffer)
 147                  ))
 148     (set-alist 'tm-partial/preview-article-method-alist
 149                'gnus-original-article-mode
 150                'gnus-mime-partial-preview-function)
 151     )))
 152
 153
 154 ;;; @ for tm-edit
 155 ;;;
 156
 157 ;; suggested by OKABE Yasuo <okabe@kudpc.kyoto-u.ac.jp>
 158 ;;      1995/11/08 (c.f. [tm ML:1067])
 159 (defun tm-gnus/insert-article (&optional message)
 160   (interactive)
 161   (let ((message-cite-function 'mime-editor/inserted-message-filter)
 162         (message-reply-buffer gnus-original-article-buffer)
 163         )
 164     (message-yank-original nil)
 165     ))
 166
 167 ;;; modified by Steven L. Baur <steve@miranova.com>
 168 ;;;     1995/12/6 (c.f. [tm-en:209])
 169 (defun mime-editor/attach-to-news-reply-menu ()
 170   "Arrange to attach MIME editor's popup menu to VM's"
 171   (if (boundp 'news-reply-menu)
 172       (progn
 173         (setq news-reply-menu (append news-reply-menu
 174                                       '("---")
 175                                       mime-editor/popup-menu-for-xemacs))
 176         (remove-hook 'news-setup-hook
 177                      'mime-editor/attach-to-news-reply-menu)
 178         )))
 179
 180 (call-after-loaded
 181  'tm-edit
 182  (function
 183   (lambda ()
 184     (set-alist 'mime-editor/message-inserter-alist
 185                'message-mode (function tm-gnus/insert-article))
 186     (if (string-match "XEmacs\\|Lucid" emacs-version)
 187         (add-hook 'news-setup-hook 'mime-editor/attach-to-news-reply-menu)
 188       )
 189
 190     (set-alist 'mime-editor/split-message-sender-alist
 191                'message-mode
 192                (lambda ()
 193                  (interactive)
 194                  (let (message-send-hook
 195                        message-sent-message-via)
 196                    (message-send)
 197                    )))
 198     )))
 199
 200
 201 ;;; @ end
 202 ;;;
 203
 204 (provide 'gnus-mime)
 205
 206 (or (featurep 'gnus-load)
 207     (progn
 208       ;; for Gnus 5.0 .. 5.3
 209       (provide 'gnus-sum)
 210       (provide 'gnus-art)
 211
 212       (or (boundp 'gnus-original-article-buffer)
 213           (progn
 214             ;; for Gnus 5.0.* and 5.1
 215             (defvar gnus-original-article-buffer " *Original Article*")
 216
 217             (defun gnus-article-setup-original-article-buffer ()
 218               (save-excursion
 219                 (set-buffer (get-buffer-create gnus-original-article-buffer))
 220                 (erase-buffer)
 221                 (insert-buffer gnus-article-buffer)
 222                 (setq major-mode 'gnus-original-article-mode)
 223                 ))
 224
 225             (add-hook 'gnus-article-prepare-hook
 226                       'gnus-article-setup-original-article-buffer)
 227
 228             (setq gnus-strict-mime nil)
 229             ))
 230       ))
 231
 232 (run-hooks 'gnus-mime-load-hook)
 233
 234 ;;; gnus-mime.el ends here