;;;
-;;; $Id: tm-gnus3.el,v 6.0 1995/03/11 22:51:37 morioka Exp morioka $
+;;; tm-gnus3.el --- tm-gnus module for GNUS 3.*
;;;
+;;; Copyright (C) 1995 Free Software Foundation, Inc.
+;;; Copyright (C) 1993,1994,1995 MORIOKA Tomohiko
+;;;
+;;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;;; Maintainer: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;;; Created: 1993/11/20
+;;; Version: $Revision: 7.3 $
+;;; Keywords: news, MIME, multimedia, multilingual, encoded-word
+;;;
+;;; This file is part of tm (Tools for MIME).
+;;;
+;;; 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.
-(require 'tm-view)
(require 'tl-list)
-(require 'tm-ognus)
+(require 'tl-str)
+(require 'tl-misc)
+(require 'gnus)
+(require 'tm-gd3)
-(set-alist 'mime-viewer/quitting-method-alist
- 'gnus-Article-mode
- (if (string-match (regexp-quote "3.14.4") gnus-version)
- (function
- (lambda ()
- (mime-viewer/kill-buffer)
- (delete-other-windows)
- (gnus-Article-show-summary)
- ))
- (function
- (lambda ()
- (mime-viewer/kill-buffer)
- (delete-other-windows)
- (gnus-Article-show-subjects)
- ))))
+(autoload 'mime/decode-message-header
+ "tm-ew-d" "Decode MIME encoded-words in message header." t)
+(autoload 'mime-eword/decode-string
+ "tm-ew-d" "Decode MIME encoded-words in string." t)
+
+(fset 'gnus-summary-select-article 'gnus-Subject-select-article)
+
+
+;;; @ version
+;;;
+
+(defconst tm-gnus/RCS-ID
+ "$Id: tm-gnus3.el,v 7.3 1995/11/21 02:08:31 morioka Exp $")
+
+(defconst tm-gnus/version
+ (concat (get-version-string tm-gnus/RCS-ID) " for GNUS 3"))
+
+
+;;; @ variable
+;;;
+
+(defvar tm-gnus/decoding-mode t "*Decode MIME header if non-nil.")
+
+
+;;; @ mode-line
+;;;
+
+(defun tm-gnus/add-decoding-mode-to-mode-line ()
+ (or (assq 'tm-gnus/decoding-mode minor-mode-alist)
+ (setq minor-mode-alist
+ (cons (list 'tm-gnus/decoding-mode " MIME")
+ minor-mode-alist))
+ ))
+
+(if (not (string-match "^GNUS 3\.14\.4" gnus-version))
+ (progn
+ (add-hook 'gnus-Article-mode-hook
+ (function
+ (lambda ()
+ (make-local-variable 'minor-mode-alist)
+ (tm-gnus/add-decoding-mode-to-mode-line)
+ )))
+ )
+ (progn
+ (add-hook 'gnus-Article-mode-hook
+ (function tm-gnus/add-decoding-mode-to-mode-line))
+ ))
+
+;;; @@ to decode subjects in mode-line
+;;;
+;; This function imported from gnus.el.
+;;
+;; New implementation in gnus 3.14.3
+;;
+
+(defun tm-gnus/article-set-mode-line ()
+ "Set Article mode line string.
+If you don't like it, define your own gnus-article-set-mode-line."
+ (let ((maxlen 15) ;Maximum subject length
+ (subject
+ (if gnus-current-headers
+ (mime-eword/decode-string
+ (nntp-header-subject gnus-current-headers))
+ "")
+ ))
+ ;; The value must be a string to escape %-constructs because of subject.
+ (setq mode-line-buffer-identification
+ (format "GNUS: %s%s %s%s%s"
+ gnus-newsgroup-name
+ (if gnus-current-article
+ (format "/%d" gnus-current-article) "")
+ (rightful-boundary-short-string subject
+ (min (string-width subject)
+ maxlen))
+ (if (> (string-width subject) maxlen) "..." "")
+ (make-string (max 0 (- 17 (string-width subject))) ? )
+ )))
+ (set-buffer-modified-p t))
+
+(fset 'gnus-Article-set-mode-line 'tm-gnus/article-set-mode-line)
+
+
+;;; @ change MIME encoded-word decoding mode, decoding or non decoding.
+;;;
+
+(defun tm-gnus/set-decoding-mode (arg)
+ "Set MIME encoded-word processing.
+With arg, turn MIME encoded-word processing on iff arg is positive."
+ (setq tm-gnus/decoding-mode arg)
+ (setq gnus-have-all-headers (not gnus-have-all-headers))
+ (gnus-summary-select-article (not gnus-have-all-headers) t)
+ )
+
+(defun tm-gnus/toggle-decoding-mode ()
+ "Toggle MIME encoded-word processing.
+With arg, turn MIME encoded-word processing on iff arg is positive."
+ (interactive)
+ (tm-gnus/set-decoding-mode (not tm-gnus/decoding-mode))
+ )
+
+
+;;; @ for tm-view
+;;;
+
+(autoload 'mime/viewer-mode "tm-view" "View MIME message." t)
(defun tm-gnus/view-message (arg)
"MIME decode and play this message."
(mime/viewer-mode)
)
+(call-after-loaded
+ 'tm-view
+ (function
+ (lambda ()
+ (set-alist 'mime-viewer/quitting-method-alist
+ 'gnus-Article-mode
+ (if (string-match (regexp-quote "3.14.4") gnus-version)
+ (function
+ (lambda ()
+ (mime-viewer/kill-buffer)
+ (delete-other-windows)
+ (gnus-Article-show-summary)
+ ))
+ (function
+ (lambda ()
+ (mime-viewer/kill-buffer)
+ (delete-other-windows)
+ (gnus-Article-show-subjects)
+ ))
+ ))
+ )))
+
+
+;;; @ for tm-partial
+;;;
+
+(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-Article-mode)
+ (summary-buffer-exp . gnus-Subject-buffer)
+ ))
+
+ (set-alist 'tm-partial/preview-article-method-alist
+ 'gnus-Article-mode
+ (function
+ (lambda ()
+ (tm-gnus/view-message (gnus-Subject-article-number))
+ )))
+ )))
+
+
+;;; @ Summary decoding
+;;;
+
(add-hook 'gnus-Select-group-hook (function tm-gnus/decode-summary-subjects))
-(define-key gnus-Subject-mode-map
- "\et" 'tm-gnus/toggle-mime-header-decoding-mode)
+
+;;; @ set up
+;;;
+
+(define-key gnus-Subject-mode-map "\et" 'tm-gnus/toggle-decoding-mode)
(define-key gnus-Subject-mode-map "v" 'tm-gnus/view-message)
-(fset 'gnus-summary-select-article 'gnus-Subject-select-article)
+(defun tm-gnus/decode-encoded-word-if-you-need ()
+ (if (and tm-gnus/decoding-mode
+ (cond ((boundp 'all-headers) (not all-headers))
+ (t t))
+ )
+ (mime/decode-message-header)
+ )
+ (run-hooks 'tm-gnus/article-prepare-hook)
+ )
-(fset 'gnus-Article-set-mode-line 'tm-gnus/article-set-mode-line)
(add-hook 'gnus-Article-prepare-hook
- (function mime/decode-message-header-if-you-need) t)
+ (function tm-gnus/decode-encoded-word-if-you-need) t)
-(if (not (string-match "^GNUS 3\.14\.4" gnus-version))
- (progn
- (add-hook 'gnus-Article-mode-hook
- (function
- (lambda ()
- (make-local-variable 'minor-mode-alist)
- (mime/add-header-decoding-mode-to-mode-line)
- )))
- )
- (progn
- (add-hook 'gnus-Article-mode-hook
- (function mime/add-header-decoding-mode-to-mode-line))
- ))
+
+;;; @ for BBDB
+;;;
+
+(defun tm-gnus/bbdb-setup ()
+ (if (memq 'bbdb/gnus-update-record gnus-Article-prepare-hook)
+ (progn
+ (remove-hook 'gnus-Article-prepare-hook 'bbdb/gnus-update-record)
+ (add-hook 'tm-gnus/article-prepare-hook 'bbdb/gnus-update-record)
+ )))
+
+(add-hook 'gnus-startup-hook 'tm-gnus/bbdb-setup t)
+
+(tm-gnus/bbdb-setup)
+
+
+;;; @ end
+;;;
(provide 'tm-gnus3)
projects / elisp / tm.git / blobdiff