--- /dev/null
+;;;
+;;; gnus-mime.el --- MIME extensions for Gnus
+;;;
+;;; Copyright (C) 1996 Free Software Foundation, Inc.
+;;;
+;;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;;; Created: 1996/8/6
+;;; Version: $Revision: 0.2 $
+;;; Keywords: news, MIME, multimedia, multilingual, encoded-word
+;;;
+;;; This file is not part of GNU Emacs yet.
+;;;
+;;; This program 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.
+;;;
+;;; This program 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 This program. If not, write to the Free Software
+;;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;;;
+;;; Code:
+
+(defun call-after-loaded (module func &optional hook-name)
+ "If MODULE is provided, then FUNC is called.
+Otherwise func is set to MODULE-load-hook.
+If optional argument HOOK-NAME is specified,
+it is used as hook to set. [gnus-mime.el]"
+ (if (featurep module)
+ (funcall func)
+ (progn
+ (if (null hook-name)
+ (setq hook-name
+ (intern (concat (symbol-name module) "-load-hook")))
+ )
+ (add-hook hook-name func)
+ )))
+
+(defun get-version-string (id)
+ "Return a version-string from RCS ID. [gnus-mime.el]"
+ (and (string-match ",v \\([0-9][0-9.][0-9.]+\\)" id)
+ (substring id (match-beginning 1)(match-end 1))
+ ))
+
+
+;;; @ version
+;;;
+
+(defconst gnus-mime-RCS-ID
+ "$Id: gnus-mime.el,v 0.2 1996/08/06 12:05:37 morioka Exp $")
+
+(defconst gnus-mime-version
+ (get-version-string gnus-mime-RCS-ID))
+
+
+;;; @ variables
+;;;
+
+(defvar gnus-show-mime t
+ "*If non-nil, do mime processing of articles.
+The articles will simply be fed to the function given by
+`gnus-show-mime-method'.")
+
+(defvar gnus-show-mime-method 'gnus-article-preview-mime-message
+ "*Function to process a MIME message.
+The function is called from the article buffer.")
+
+(defvar gnus-decode-encoded-word-method 'gnus-article-decode-encoded-word
+ "*Function to decode a MIME encoded-words.
+The function is called from the article buffer.")
+
+(defvar gnus-parse-headers-hook
+ '(gnus-set-summary-default-charset gnus-decode-rfc1522)
+ "*A hook called before parsing the headers.")
+
+
+;;; @ load
+;;;
+
+(require 'gnus)
+(autoload 'gnus-decode-rfc1522 "gnus-art-mime")
+(autoload 'gnus-article-preview-mime-message "gnus-art-mime")
+(autoload 'gnus-article-decode-encoded-word "gnus-art-mime")
+(autoload 'gnus-set-summary-default-charset "gnus-sum-mime")
+(require 'gnus-charset)
+
+
+;;; @ for tm-view
+;;;
+
+(defun gnus-content-header-filter ()
+ (goto-char (point-min))
+ (mime-preview/cut-header)
+ (decode-mime-charset-region (point-min)(point-max) default-mime-charset)
+ (mime/decode-message-header)
+ )
+
+(set-alist 'mime-viewer/content-header-filter-alist
+ 'gnus-original-article-mode
+ (function gnus-content-header-filter))
+
+
+(set-alist 'mime-viewer/code-converter-alist
+ 'gnus-original-article-mode
+ (function mime-charset/decode-buffer))
+
+
+(defun mime-viewer/quitting-method-for-gnus ()
+ (if (not gnus-show-mime)
+ (mime-viewer/kill-buffer))
+ (delete-other-windows)
+ (gnus-article-show-summary)
+ (if (or (not gnus-show-mime)
+ (null gnus-have-all-headers))
+ (gnus-summary-select-article nil t)
+ ))
+
+(set-alist 'mime-viewer/quitting-method-alist
+ 'gnus-original-article-mode
+ (function mime-viewer/quitting-method-for-gnus))
+(set-alist 'mime-viewer/show-summary-method
+ 'gnus-original-article-mode
+ (function mime-viewer/quitting-method-for-gnus))
+
+
+;;; @ for tm-partial
+;;;
+
+(defun gnus-mime-partial-preview-function ()
+ (gnus-summary-preview-mime-message (gnus-summary-article-number))
+ )
+
+(call-after-loaded
+ 'tm-partial
+ (function
+ (lambda ()
+ (set-atype 'mime/content-decoding-condition
+ '((type . "message/partial")
+ (method . mime-article/grab-message/partials)
+ (major-mode . gnus-original-article-mode)
+ (summary-buffer-exp . gnus-summary-buffer)
+ ))
+ (set-alist 'tm-partial/preview-article-method-alist
+ 'gnus-original-article-mode
+ 'gnus-mime-partial-preview-function)
+ )))
+
+
+;;; @ for tm-edit
+;;;
+
+;; suggested by OKABE Yasuo <okabe@kudpc.kyoto-u.ac.jp>
+;; 1995/11/08 (c.f. [tm ML:1067])
+(defun tm-gnus/insert-article (&optional message)
+ (interactive)
+ (let ((message-cite-function 'mime-editor/inserted-message-filter)
+ (message-reply-buffer gnus-original-article-buffer)
+ )
+ (message-yank-original nil)
+ ))
+
+;;; modified by Steven L. Baur <steve@miranova.com>
+;;; 1995/12/6 (c.f. [tm-en:209])
+(defun mime-editor/attach-to-news-reply-menu ()
+ "Arrange to attach MIME editor's popup menu to VM's"
+ (if (boundp 'news-reply-menu)
+ (progn
+ (setq news-reply-menu (append news-reply-menu
+ '("---")
+ mime-editor/popup-menu-for-xemacs))
+ (remove-hook 'news-setup-hook
+ 'mime-editor/attach-to-news-reply-menu)
+ )))
+
+(call-after-loaded
+ 'tm-edit
+ (function
+ (lambda ()
+ (set-alist 'mime-editor/message-inserter-alist
+ 'message-mode (function tm-gnus/insert-article))
+ (if (string-match "XEmacs\\|Lucid" emacs-version)
+ (add-hook 'news-setup-hook 'mime-editor/attach-to-news-reply-menu)
+ )
+
+ (set-alist 'mime-editor/split-message-sender-alist
+ 'message-mode
+ (lambda ()
+ (interactive)
+ (let (message-send-hook
+ message-sent-message-via)
+ (message-send)
+ )))
+ )))
+
+
+;;; @ end
+;;;
+
+(provide 'gnus-mime)
+
+(or (featurep 'gnus-load)
+ (progn
+ ;; for Gnus 5.0 .. 5.3
+ (provide 'gnus-sum)
+ (provide 'gnus-art)
+
+ (or (boundp 'gnus-original-article-buffer)
+ (progn
+ ;; for Gnus 5.0.* and 5.1
+ (defvar gnus-original-article-buffer " *Original Article*")
+
+ (defun gnus-article-setup-original-article-buffer ()
+ (save-excursion
+ (set-buffer (get-buffer-create gnus-original-article-buffer))
+ (erase-buffer)
+ (insert-buffer gnus-article-buffer)
+ (setq major-mode 'gnus-original-article-mode)
+ ))
+
+ (add-hook 'gnus-article-prepare-hook
+ 'gnus-article-setup-original-article-buffer)
+
+ (setq gnus-strict-mime nil)
+ ))
+ ))
+
+(run-hooks 'gnus-mime-load-hook)
+
+;;; gnus-mime.el ends here
projects / elisp / tm.git / blobdiff