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 .. 1996 MORIOKA Tomohiko
   6 ;;;
   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
  13 ;;;
  14 ;;; This file is part of tm (Tools for MIME).
  15 ;;;
  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.
  20 ;;;
  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.
  25 ;;;
  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.
  29 ;;;
  30 ;;; Code:
  31
  32 (require 'tl-list)
  33 (require 'tl-str)
  34 (require 'tl-misc)
  35 (require 'gnus)
  36 (require 'tm-gd3)
  37
  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)
  42
  43 (fset 'gnus-summary-select-article 'gnus-Subject-select-article)
  44
  45
  46 ;;; @ version
  47 ;;;
  48
  49 (defconst tm-gnus/RCS-ID
  50   "$Id: tm-gnus3.el,v 7.10 1996/06/09 06:51:09 morioka Exp $")
  51
  52 (defconst tm-gnus/version
  53   (concat (get-version-string tm-gnus/RCS-ID) " for GNUS 3"))
  54
  55
  56 ;;; @ variable
  57 ;;;
  58
  59 (defvar tm-gnus/decoding-mode t "*Decode MIME header if non-nil.")
  60
  61
  62 ;;; @ mode-line
  63 ;;;
  64
  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")
  69                   minor-mode-alist))
  70       ))
  71
  72 (if (not (string-match "^GNUS 3\.14\.4" gnus-version))
  73     (progn
  74       (add-hook 'gnus-Article-mode-hook
  75                 (function
  76                  (lambda ()
  77                    (make-local-variable 'minor-mode-alist)
  78                    (tm-gnus/add-decoding-mode-to-mode-line)
  79                    )))
  80       )
  81   (progn
  82     (add-hook 'gnus-Article-mode-hook
  83               (function tm-gnus/add-decoding-mode-to-mode-line))
  84     ))
  85
  86 ;;; @@ to decode subjects in mode-line
  87 ;;;
  88 ;; This function imported from gnus.el.
  89 ;;
  90 ;; New implementation in gnus 3.14.3
  91 ;;
  92
  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
  97         (subject
  98          (if gnus-current-headers
  99              (mime-eword/decode-string
 100               (nntp-header-subject gnus-current-headers))
 101            "")
 102          ))
 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"
 106                   gnus-newsgroup-name
 107                   (if gnus-current-article
 108                       (format "/%d" gnus-current-article) "")
 109                   (truncate-string subject (min (string-width subject)
 110                                                 maxlen))
 111                   (if (> (string-width subject) maxlen) "..." "")
 112                   (make-string (max 0 (- 17 (string-width subject))) ? )
 113                   )))
 114   (set-buffer-modified-p t))
 115
 116 (fset 'gnus-Article-set-mode-line 'tm-gnus/article-set-mode-line)
 117
 118
 119 ;;; @ change MIME encoded-word decoding mode, decoding or non decoding.
 120 ;;;
 121
 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)
 128   )
 129
 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."
 133   (interactive)
 134   (tm-gnus/set-decoding-mode (not tm-gnus/decoding-mode))
 135   )
 136
 137
 138 ;;; @ for tm-view
 139 ;;;
 140
 141 (autoload 'mime/viewer-mode "tm-view" "View MIME message." t)
 142
 143 (defun tm-gnus/view-message (arg)
 144   "MIME decode and play this message."
 145   (interactive "P")
 146   (let ((gnus-break-pages nil))
 147     (gnus-Subject-select-article t t)
 148     )
 149   (pop-to-buffer gnus-Article-buffer t)
 150   (mime/viewer-mode)
 151   )
 152
 153 (call-after-loaded
 154  'tm-view
 155  (function
 156   (lambda ()
 157     (set-alist 'mime-viewer/quitting-method-alist
 158                'gnus-Article-mode
 159                (if (string-match (regexp-quote "3.14.4") gnus-version)
 160                    (function
 161                     (lambda ()
 162                       (mime-viewer/kill-buffer)
 163                       (delete-other-windows)
 164                       (gnus-Article-show-summary)
 165                       ))
 166                  (function
 167                   (lambda ()
 168                     (mime-viewer/kill-buffer)
 169                     (delete-other-windows)
 170                     (gnus-Article-show-subjects)
 171                     ))
 172                  ))
 173     )))
 174
 175
 176 ;;; @ for tm-edit
 177 ;;;
 178
 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)
 182   (interactive)
 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) "")
 187                                       ))
 188         (news-yank-original-quoting-indicator "")
 189
 190         ;; select raw article buffer
 191         (mail-reply-buffer
 192          (save-excursion
 193            (set-buffer gnus-article-buffer)
 194            (if (eq major-mode 'mime/viewer-mode)
 195                mime::preview/article-buffer
 196              gnus-article-buffer)))
 197         )
 198     (news-reply-yank-original 0)
 199     ))
 200
 201 (call-after-loaded
 202  'tm-edit
 203  (function
 204   (lambda ()
 205     (set-alist
 206      'mime-editor/message-inserter-alist
 207      'news-reply-mode (function tm-gnus/insert-article))
 208
 209     (autoload 'tm-mail/insert-message "tm-mail")
 210     (set-alist 'mime-editor/message-inserter-alist
 211                'mail-mode (function tm-mail/insert-message))
 212
 213     (set-alist 'mime-editor/split-message-sender-alist
 214                'news-reply-mode
 215                'gnus-inews-news)
 216     )))
 217
 218
 219 ;;; @ for tm-partial
 220 ;;;
 221
 222 (call-after-loaded
 223  'tm-partial
 224  (function
 225   (lambda ()
 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)
 231                  ))
 232
 233     (set-alist 'tm-partial/preview-article-method-alist
 234                'gnus-Article-mode
 235                (function
 236                 (lambda ()
 237                   (tm-gnus/view-message (gnus-Subject-article-number))
 238                   )))
 239     )))
 240
 241
 242 ;;; @ Summary decoding
 243 ;;;
 244
 245 (add-hook 'gnus-Select-group-hook (function tm-gnus/decode-summary-subjects))
 246
 247
 248 ;;; @ set up
 249 ;;;
 250
 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)
 253
 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))
 257                  (t                     t))
 258            )
 259       (mime/decode-message-header)
 260     )
 261   (run-hooks 'tm-gnus/article-prepare-hook)
 262   )
 263
 264 (add-hook 'gnus-Article-prepare-hook
 265           (function tm-gnus/decode-encoded-word-if-you-need) t)
 266
 267
 268 ;;; @ for BBDB
 269 ;;;
 270
 271 (call-after-loaded
 272  'bbdb
 273  (function
 274   (lambda ()
 275     (require 'tm-bbdb)
 276     )))
 277
 278 (autoload 'tm-bbdb/update-record "tm-bbdb")
 279
 280 (defun tm-gnus/bbdb-setup ()
 281   (if (memq 'bbdb/gnus-update-record gnus-Article-prepare-hook)
 282       (progn
 283         (remove-hook 'gnus-Article-prepare-hook 'bbdb/gnus-update-record)
 284         (add-hook 'gnus-Article-prepare-hook 'tm-bbdb/update-record)
 285         )))
 286
 287 (add-hook 'gnus-startup-hook 'tm-gnus/bbdb-setup t)
 288
 289 (tm-gnus/bbdb-setup)
 290
 291
 292 ;;; @ end
 293 ;;;
 294
 295 (provide 'tm-gnus3)
 296
 297 ;;; tm-gnus3.el ends here