tm 7.27.
[elisp/tm.git] / gnus / tm-gnus3.el
index a33cd87..782a01b 100644 (file)
 ;;;
 ;;; tm-gnus3.el --- tm-gnus module for GNUS 3.*
 ;;;
+;;; Copyright (C) 1995 Free Software Foundation, Inc.
+;;; Copyright (C) 1995 MORIOKA Tomohiko
+;;;
+;;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;;; Keywords: news, MIME, multimedia, multilingual, encoded-word
+;;;
+;;; This file is part of tm (Tools for MIME).
+;;;
 
 (require 'tl-list)
 (require 'tl-str)
 (require 'tl-misc)
-(require 'tm-ognus)
+(require 'gnus)
+(require 'tm-gd3)
+
+(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.0 1995/10/22 12:02:04 morioka Exp $")
+  "$Id: tm-gnus3.el,v 7.1 1995/11/19 07:23:29 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
 ;;;
 
 (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)
-
-(fset 'gnus-Article-set-mode-line 'tm-gnus/article-set-mode-line)
-
 (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)
+  )
 
 (add-hook 'gnus-Article-prepare-hook
          (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)
-                  (tm-gnus/add-decoding-mode-to-mode-line)
-                  )))
-      )
-  (progn
-    (add-hook 'gnus-Article-mode-hook
-             (function tm-gnus/add-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