2 ;;; tm-sgnus.el --- tm-gnus module for September GNUS
4 ;;; Copyright (C) 1995 Free Software Foundation, Inc.
5 ;;; Copyright (C) 1995 MORIOKA Tomohiko
7 ;;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
8 ;;; Keywords: news, MIME, multimedia, multilingual, encoded-word
10 ;;; This file is part of tm (Tools for MIME).
23 (defconst tm-gnus/RCS-ID
24 "$Id: tm-sgnus.el,v 7.15 1995/11/13 09:29:19 morioka Exp $")
26 (defconst tm-gnus/version
27 (concat (get-version-string tm-gnus/RCS-ID) " for September"))
33 (defvar tm-gnus/automatic-mime-preview t
34 "*If non-nil, show MIME processed article.
35 This variable is set to `gnus-show-mime'.")
37 (setq gnus-show-mime tm-gnus/automatic-mime-preview)
40 ;;; @ command functions
43 (defun tm-gnus/view-message (arg)
44 "MIME decode and play this message."
46 (let ((gnus-break-pages nil))
47 (gnus-summary-select-article t t)
49 (pop-to-buffer gnus-original-article-buffer t)
50 (let (buffer-read-only)
51 (if (text-property-any (point-min) (point-max) 'invisible t)
52 (remove-text-properties (point-min) (point-max)
53 gnus-hidden-properties)
55 (mime/viewer-mode nil nil nil gnus-original-article-buffer
59 (defun tm-gnus/summary-scroll-down ()
60 "Scroll down one line current article."
62 (gnus-summary-scroll-up -1)
65 (defun tm-gnus/summary-toggle-header (&optional arg)
67 (if (and gnus-show-mime
68 (or (not gnus-strict-mime)
70 (set-buffer gnus-article-buffer)
71 (gnus-fetch-field "Mime-Version")
73 (let ((mime-viewer/ignored-field-list
75 (set-buffer gnus-article-buffer)
78 (rfc822/get-field-body field)
80 mime-viewer/ignored-field-list))
81 mime-viewer/ignored-field-list)))
82 (gnus-summary-select-article t t)
84 (gnus-summary-toggle-header arg)
87 (define-key gnus-summary-mode-map "v" (function tm-gnus/view-message))
88 (define-key gnus-summary-mode-map
89 "\e\r" (function tm-gnus/summary-scroll-down))
90 (define-key gnus-summary-mode-map
91 "t" (function tm-gnus/summary-toggle-header))
97 (defun mime-viewer/quitting-method-for-sgnus ()
98 (mime-viewer/kill-buffer)
99 (delete-other-windows)
100 (gnus-article-show-summary)
101 (gnus-summary-display-article (gnus-summary-article-number))
107 (set-alist 'mime-viewer/quitting-method-alist
108 'gnus-original-article-mode
109 (function mime-viewer/quitting-method-for-sgnus))
119 (set-atype 'mime/content-decoding-condition
120 '((type . "message/partial")
121 (method . mime-article/grab-message/partials)
122 (major-mode . gnus-original-article-mode)
123 (summary-buffer-exp . gnus-summary-buffer)
125 (set-alist 'tm-partial/preview-article-method-alist
126 'gnus-original-article-mode
128 (tm-gnus/view-message (gnus-summary-article-number))
136 (cond ((not (boundp 'nnheader-encoded-words-decoding))
137 (defun tm-gnus/decode-summary-from-and-subjects ()
138 (mapcar (lambda (header)
139 (let ((from (mail-header-from header))
140 (subj (mail-header-subject header))
142 (mail-header-set-from
145 (mime-eword/decode-string from)
147 (mail-header-set-subject
150 (mime-eword/decode-string subj)
153 gnus-newsgroup-headers)
155 (add-hook 'gnus-select-group-hook
156 (function tm-gnus/decode-summary-from-and-subjects))
163 (defun tm-gnus/article-reset-variable ()
164 (setq tm-gnus/automatic-mime-preview nil)
167 (add-hook 'gnus-article-prepare-hook 'tm-gnus/article-reset-variable)
169 (defun tm-gnus/preview-article ()
170 (make-local-variable 'tm:mother-button-dispatcher)
171 (setq tm:mother-button-dispatcher
172 (function gnus-article-push-button))
173 (mime/viewer-mode nil nil nil gnus-original-article-buffer
175 (setq tm-gnus/automatic-mime-preview t)
176 (run-hooks 'tm-gnus/article-prepare-hook)
179 (setq gnus-show-mime-method (function tm-gnus/preview-article))
181 (or (fboundp 'tm::gnus-article-hide-headers-if-wanted)
182 (fset 'tm::gnus-article-hide-headers-if-wanted
183 (symbol-function 'gnus-article-hide-headers-if-wanted))
186 (defun gnus-article-hide-headers-if-wanted ()
187 (or tm-gnus/automatic-mime-preview
188 (tm::gnus-article-hide-headers-if-wanted)
195 (defun tm-gnus/bbdb-setup ()
196 (if (memq 'bbdb/gnus-update-record gnus-article-prepare-hook)
198 (remove-hook 'gnus-article-prepare-hook 'bbdb/gnus-update-record)
199 (add-hook 'tm-gnus/article-prepare-hook 'bbdb/gnus-update-record)
202 (add-hook 'gnus-startup-hook 'tm-gnus/bbdb-setup t)