gnus/tm-gnus3.el

   1 ;;;
   2 ;;; tm-gnus3.el --- tm-gnus module for GNUS 3.*
   3 ;;;
   4 ;;; Copyright (C) 1995 Free Software Foundation, Inc.
   5 ;;; Copyright (C) 1993,1994,1995 MORIOKA Tomohiko
   6 ;;;
   7 ;;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
   8 ;;; Maintainer: MORIOKA Tomohiko <morioka@jaist.ac.jp>
   9 ;;; Created: 1993/11/20
  10 ;;; Version: $Revision: 7.3 $
  11 ;;; Keywords: news, MIME, multimedia, multilingual, encoded-word
  12 ;;;
  13 ;;; This file is part of tm (Tools for MIME).
  14 ;;;
  15 ;;; This program is free software; you can redistribute it and/or
  16 ;;; modify it under the terms of the GNU General Public License as
  17 ;;; published by the Free Software Foundation; either version 2, or
  18 ;;; (at your option) any later version.
  19 ;;;
  20 ;;; This program is distributed in the hope that it will be useful,
  21 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  22 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  23 ;;; General Public License for more details.
  24 ;;;
  25 ;;; You should have received a copy of the GNU General Public License
  26 ;;; along with This program.  If not, write to the Free Software
  27 ;;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  28
  29 (require 'tl-list)
  30 (require 'tl-str)
  31 (require 'tl-misc)
  32 (require 'gnus)
  33 (require 'tm-gd3)
  34
  35 (autoload 'mime/decode-message-header
  36   "tm-ew-d" "Decode MIME encoded-words in message header." t)
  37 (autoload 'mime-eword/decode-string
  38   "tm-ew-d" "Decode MIME encoded-words in string." t)
  39
  40 (fset 'gnus-summary-select-article 'gnus-Subject-select-article)
  41
  42
  43 ;;; @ version
  44 ;;;
  45
  46 (defconst tm-gnus/RCS-ID
  47   "$Id: tm-gnus3.el,v 7.3 1995/11/21 02:08:31 morioka Exp $")
  48
  49 (defconst tm-gnus/version
  50   (concat (get-version-string tm-gnus/RCS-ID) " for GNUS 3"))
  51
  52
  53 ;;; @ variable
  54 ;;;
  55
  56 (defvar tm-gnus/decoding-mode t "*Decode MIME header if non-nil.")
  57
  58
  59 ;;; @ mode-line
  60 ;;;
  61
  62 (defun tm-gnus/add-decoding-mode-to-mode-line ()
  63   (or (assq 'tm-gnus/decoding-mode minor-mode-alist)
  64       (setq minor-mode-alist
  65             (cons (list 'tm-gnus/decoding-mode " MIME")
  66                   minor-mode-alist))
  67       ))
  68
  69 (if (not (string-match "^GNUS 3\.14\.4" gnus-version))
  70     (progn
  71       (add-hook 'gnus-Article-mode-hook
  72                 (function
  73                  (lambda ()
  74                    (make-local-variable 'minor-mode-alist)
  75                    (tm-gnus/add-decoding-mode-to-mode-line)
  76                    )))
  77       )
  78   (progn
  79     (add-hook 'gnus-Article-mode-hook
  80               (function tm-gnus/add-decoding-mode-to-mode-line))
  81     ))
  82
  83 ;;; @@ to decode subjects in mode-line
  84 ;;;
  85 ;; This function imported from gnus.el.
  86 ;;
  87 ;; New implementation in gnus 3.14.3
  88 ;;
  89
  90 (defun tm-gnus/article-set-mode-line ()
  91   "Set Article mode line string.
  92 If you don't like it, define your own gnus-article-set-mode-line."
  93   (let ((maxlen 15)                     ;Maximum subject length
  94         (subject
  95          (if gnus-current-headers
  96              (mime-eword/decode-string
  97               (nntp-header-subject gnus-current-headers))
  98            "")
  99          ))
 100     ;; The value must be a string to escape %-constructs because of subject.
 101     (setq mode-line-buffer-identification
 102           (format "GNUS: %s%s %s%s%s"
 103                   gnus-newsgroup-name
 104                   (if gnus-current-article
 105                       (format "/%d" gnus-current-article) "")
 106                   (rightful-boundary-short-string subject
 107                                                   (min (string-width subject)
 108                                                        maxlen))
 109                   (if (> (string-width subject) maxlen) "..." "")
 110                   (make-string (max 0 (- 17 (string-width subject))) ? )
 111                   )))
 112   (set-buffer-modified-p t))
 113
 114 (fset 'gnus-Article-set-mode-line 'tm-gnus/article-set-mode-line)
 115
 116
 117 ;;; @ change MIME encoded-word decoding mode, decoding or non decoding.
 118 ;;;
 119
 120 (defun tm-gnus/set-decoding-mode (arg)
 121   "Set MIME encoded-word processing.
 122 With arg, turn MIME encoded-word processing on iff arg is positive."
 123   (setq tm-gnus/decoding-mode arg)
 124   (setq gnus-have-all-headers (not gnus-have-all-headers))
 125   (gnus-summary-select-article (not gnus-have-all-headers) t)
 126   )
 127
 128 (defun tm-gnus/toggle-decoding-mode ()
 129   "Toggle MIME encoded-word processing.
 130 With arg, turn MIME encoded-word processing on iff arg is positive."
 131   (interactive)
 132   (tm-gnus/set-decoding-mode (not tm-gnus/decoding-mode))
 133   )
 134
 135
 136 ;;; @ for tm-view
 137 ;;;
 138
 139 (autoload 'mime/viewer-mode "tm-view" "View MIME message." t)
 140
 141 (defun tm-gnus/view-message (arg)
 142   "MIME decode and play this message."
 143   (interactive "P")
 144   (let ((gnus-break-pages nil))
 145     (gnus-Subject-select-article t t)
 146     )
 147   (pop-to-buffer gnus-Article-buffer t)
 148   (mime/viewer-mode)
 149   )
 150
 151 (call-after-loaded
 152  'tm-view
 153  (function
 154   (lambda ()
 155     (set-alist 'mime-viewer/quitting-method-alist
 156                'gnus-Article-mode
 157                (if (string-match (regexp-quote "3.14.4") gnus-version)
 158                    (function
 159                     (lambda ()
 160                       (mime-viewer/kill-buffer)
 161                       (delete-other-windows)
 162                       (gnus-Article-show-summary)
 163                       ))
 164                  (function
 165                   (lambda ()
 166                     (mime-viewer/kill-buffer)
 167                     (delete-other-windows)
 168                     (gnus-Article-show-subjects)
 169                     ))
 170                  ))
 171     )))
 172
 173
 174 ;;; @ for tm-partial
 175 ;;;
 176
 177 (call-after-loaded
 178  'tm-partial
 179  (function
 180   (lambda ()
 181     (set-atype 'mime/content-decoding-condition
 182                '((type . "message/partial")
 183                  (method . mime-article/grab-message/partials)
 184                  (major-mode . gnus-Article-mode)
 185                  (summary-buffer-exp . gnus-Subject-buffer)
 186                  ))
 187
 188     (set-alist 'tm-partial/preview-article-method-alist
 189                'gnus-Article-mode
 190                (function
 191                 (lambda ()
 192                   (tm-gnus/view-message (gnus-Subject-article-number))
 193                   )))
 194     )))
 195
 196
 197 ;;; @ Summary decoding
 198 ;;;
 199
 200 (add-hook 'gnus-Select-group-hook (function tm-gnus/decode-summary-subjects))
 201
 202
 203 ;;; @ set up
 204 ;;;
 205
 206 (define-key gnus-Subject-mode-map "\et" 'tm-gnus/toggle-decoding-mode)
 207 (define-key gnus-Subject-mode-map "v" 'tm-gnus/view-message)
 208
 209 (defun tm-gnus/decode-encoded-word-if-you-need ()
 210   (if (and tm-gnus/decoding-mode
 211            (cond ((boundp 'all-headers) (not all-headers))
 212                  (t                     t))
 213            )
 214       (mime/decode-message-header)
 215     )
 216   (run-hooks 'tm-gnus/article-prepare-hook)
 217   )
 218
 219 (add-hook 'gnus-Article-prepare-hook
 220           (function tm-gnus/decode-encoded-word-if-you-need) t)
 221
 222
 223 ;;; @ for BBDB
 224 ;;;
 225
 226 (defun tm-gnus/bbdb-setup ()
 227   (if (memq 'bbdb/gnus-update-record gnus-Article-prepare-hook)
 228       (progn
 229         (remove-hook 'gnus-Article-prepare-hook 'bbdb/gnus-update-record)
 230         (add-hook 'tm-gnus/article-prepare-hook 'bbdb/gnus-update-record)
 231         )))
 232
 233 (add-hook 'gnus-startup-hook 'tm-gnus/bbdb-setup t)
 234
 235 (tm-gnus/bbdb-setup)
 236
 237
 238 ;;; @ end
 239 ;;;
 240
 241 (provide 'tm-gnus3)