2 ;;; tm-gnus3.el --- tm-gnus module for GNUS 3.*
4 ;;; Copyright (C) 1995 Free Software Foundation, Inc.
5 ;;; Copyright (C) 1993 .. 1996 MORIOKA Tomohiko
7 ;;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
8 ;;; Maintainer: MORIOKA Tomohiko <morioka@jaist.ac.jp>
9 ;;; and KOBAYASHI Shuhei <shuhei-k@jaist.ac.jp>
10 ;;; Created: 1993/11/20
11 ;;; Version: $Revision: 7.10 $
12 ;;; Keywords: news, MIME, multimedia, multilingual, encoded-word
14 ;;; This file is part of tm (Tools for MIME).
16 ;;; This program is free software; you can redistribute it and/or
17 ;;; modify it under the terms of the GNU General Public License as
18 ;;; published by the Free Software Foundation; either version 2, or
19 ;;; (at your option) any later version.
21 ;;; This program is distributed in the hope that it will be useful,
22 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
23 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
24 ;;; General Public License for more details.
26 ;;; You should have received a copy of the GNU General Public License
27 ;;; along with This program. If not, write to the Free Software
28 ;;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
38 (autoload 'mime/decode-message-header
39 "tm-ew-d" "Decode MIME encoded-words in message header." t)
40 (autoload 'mime-eword/decode-string
41 "tm-ew-d" "Decode MIME encoded-words in string." t)
43 (fset 'gnus-summary-select-article 'gnus-Subject-select-article)
49 (defconst tm-gnus/RCS-ID
50 "$Id: tm-gnus3.el,v 7.10 1996/06/09 06:51:09 morioka Exp $")
52 (defconst tm-gnus/version
53 (concat (get-version-string tm-gnus/RCS-ID) " for GNUS 3"))
59 (defvar tm-gnus/decoding-mode t "*Decode MIME header if non-nil.")
65 (defun tm-gnus/add-decoding-mode-to-mode-line ()
66 (or (assq 'tm-gnus/decoding-mode minor-mode-alist)
67 (setq minor-mode-alist
68 (cons (list 'tm-gnus/decoding-mode " MIME")
72 (if (not (string-match "^GNUS 3\.14\.4" gnus-version))
74 (add-hook 'gnus-Article-mode-hook
77 (make-local-variable 'minor-mode-alist)
78 (tm-gnus/add-decoding-mode-to-mode-line)
82 (add-hook 'gnus-Article-mode-hook
83 (function tm-gnus/add-decoding-mode-to-mode-line))
86 ;;; @@ to decode subjects in mode-line
88 ;; This function imported from gnus.el.
90 ;; New implementation in gnus 3.14.3
93 (defun tm-gnus/article-set-mode-line ()
94 "Set Article mode line string.
95 If you don't like it, define your own gnus-article-set-mode-line."
96 (let ((maxlen 15) ;Maximum subject length
98 (if gnus-current-headers
99 (mime-eword/decode-string
100 (nntp-header-subject gnus-current-headers))
103 ;; The value must be a string to escape %-constructs because of subject.
104 (setq mode-line-buffer-identification
105 (format "GNUS: %s%s %s%s%s"
107 (if gnus-current-article
108 (format "/%d" gnus-current-article) "")
109 (truncate-string subject (min (string-width subject)
111 (if (> (string-width subject) maxlen) "..." "")
112 (make-string (max 0 (- 17 (string-width subject))) ? )
114 (set-buffer-modified-p t))
116 (fset 'gnus-Article-set-mode-line 'tm-gnus/article-set-mode-line)
119 ;;; @ change MIME encoded-word decoding mode, decoding or non decoding.
122 (defun tm-gnus/set-decoding-mode (arg)
123 "Set MIME encoded-word processing.
124 With arg, turn MIME encoded-word processing on iff arg is positive."
125 (setq tm-gnus/decoding-mode arg)
126 (setq gnus-have-all-headers (not gnus-have-all-headers))
127 (gnus-summary-select-article (not gnus-have-all-headers) t)
130 (defun tm-gnus/toggle-decoding-mode ()
131 "Toggle MIME encoded-word processing.
132 With arg, turn MIME encoded-word processing on iff arg is positive."
134 (tm-gnus/set-decoding-mode (not tm-gnus/decoding-mode))
141 (autoload 'mime/viewer-mode "tm-view" "View MIME message." t)
143 (defun tm-gnus/view-message (arg)
144 "MIME decode and play this message."
146 (let ((gnus-break-pages nil))
147 (gnus-Subject-select-article t t)
149 (pop-to-buffer gnus-Article-buffer t)
157 (set-alist 'mime-viewer/quitting-method-alist
159 (if (string-match (regexp-quote "3.14.4") gnus-version)
162 (mime-viewer/kill-buffer)
163 (delete-other-windows)
164 (gnus-Article-show-summary)
168 (mime-viewer/kill-buffer)
169 (delete-other-windows)
170 (gnus-Article-show-subjects)
179 ;; suggested by OKABE Yasuo <okabe@kudpc.kyoto-u.ac.jp>
180 ;; 1995/11/08 (c.f. [tm ML:1067])
181 (defun tm-gnus/insert-article (&optional message)
183 (let (;; for Emacs 18
184 (mail-yank-ignored-headers mime-editor/yank-ignored-field-regexp)
185 (news-make-reply-yank-header (function
186 (lambda (message-id from) "")
188 (news-yank-original-quoting-indicator "")
190 ;; select raw article buffer
193 (set-buffer gnus-article-buffer)
194 (if (eq major-mode 'mime/viewer-mode)
195 mime::preview/article-buffer
196 gnus-article-buffer)))
198 (news-reply-yank-original 0)
206 'mime-editor/message-inserter-alist
207 'news-reply-mode (function tm-gnus/insert-article))
209 (autoload 'tm-mail/insert-message "tm-mail")
210 (set-alist 'mime-editor/message-inserter-alist
211 'mail-mode (function tm-mail/insert-message))
213 (set-alist 'mime-editor/split-message-sender-alist
226 (set-atype 'mime/content-decoding-condition
227 '((type . "message/partial")
228 (method . mime-article/grab-message/partials)
229 (major-mode . gnus-Article-mode)
230 (summary-buffer-exp . gnus-Subject-buffer)
233 (set-alist 'tm-partial/preview-article-method-alist
237 (tm-gnus/view-message (gnus-Subject-article-number))
242 ;;; @ Summary decoding
245 (add-hook 'gnus-Select-group-hook (function tm-gnus/decode-summary-subjects))
251 (define-key gnus-Subject-mode-map "\et" 'tm-gnus/toggle-decoding-mode)
252 (define-key gnus-Subject-mode-map "v" 'tm-gnus/view-message)
254 (defun tm-gnus/decode-encoded-word-if-you-need ()
255 (if (and tm-gnus/decoding-mode
256 (cond ((boundp 'all-headers) (not all-headers))
259 (mime/decode-message-header)
261 (run-hooks 'tm-gnus/article-prepare-hook)
264 (add-hook 'gnus-Article-prepare-hook
265 (function tm-gnus/decode-encoded-word-if-you-need) t)
278 (autoload 'tm-bbdb/update-record "tm-bbdb")
280 (defun tm-gnus/bbdb-setup ()
281 (if (memq 'bbdb/gnus-update-record gnus-Article-prepare-hook)
283 (remove-hook 'gnus-Article-prepare-hook 'bbdb/gnus-update-record)
284 (add-hook 'gnus-Article-prepare-hook 'tm-bbdb/update-record)
287 (add-hook 'gnus-startup-hook 'tm-gnus/bbdb-setup t)
297 ;;; tm-gnus3.el ends here