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 ;;; Created: 1993/11/20
  10 ;;; Version: $Revision: 7.9 $
  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 ;;; Code:
  30
  31 (require 'tl-list)
  32 (require 'tl-str)
  33 (require 'tl-misc)
  34 (require 'gnus)
  35 (require 'tm-gd3)
  36
  37 (autoload 'mime/decode-message-header
  38   "tm-ew-d" "Decode MIME encoded-words in message header." t)
  39 (autoload 'mime-eword/decode-string
  40   "tm-ew-d" "Decode MIME encoded-words in string." t)
  41
  42 (fset 'gnus-summary-select-article 'gnus-Subject-select-article)
  43
  44
  45 ;;; @ version
  46 ;;;
  47
  48 (defconst tm-gnus/RCS-ID
  49   "$Id: tm-gnus3.el,v 7.9 1996/06/06 16:44:17 shuhei-k Exp $")
  50
  51 (defconst tm-gnus/version
  52   (concat (get-version-string tm-gnus/RCS-ID) " for GNUS 3"))
  53
  54
  55 ;;; @ variable
  56 ;;;
  57
  58 (defvar tm-gnus/decoding-mode t "*Decode MIME header if non-nil.")
  59
  60
  61 ;;; @ mode-line
  62 ;;;
  63
  64 (defun tm-gnus/add-decoding-mode-to-mode-line ()
  65   (or (assq 'tm-gnus/decoding-mode minor-mode-alist)
  66       (setq minor-mode-alist
  67             (cons (list 'tm-gnus/decoding-mode " MIME")
  68                   minor-mode-alist))
  69       ))
  70
  71 (if (not (string-match "^GNUS 3\.14\.4" gnus-version))
  72     (progn
  73       (add-hook 'gnus-Article-mode-hook
  74                 (function
  75                  (lambda ()
  76                    (make-local-variable 'minor-mode-alist)
  77                    (tm-gnus/add-decoding-mode-to-mode-line)
  78                    )))
  79       )
  80   (progn
  81     (add-hook 'gnus-Article-mode-hook
  82               (function tm-gnus/add-decoding-mode-to-mode-line))
  83     ))
  84
  85 ;;; @@ to decode subjects in mode-line
  86 ;;;
  87 ;; This function imported from gnus.el.
  88 ;;
  89 ;; New implementation in gnus 3.14.3
  90 ;;
  91
  92 (defun tm-gnus/article-set-mode-line ()
  93   "Set Article mode line string.
  94 If you don't like it, define your own gnus-article-set-mode-line."
  95   (let ((maxlen 15)                     ;Maximum subject length
  96         (subject
  97          (if gnus-current-headers
  98              (mime-eword/decode-string
  99               (nntp-header-subject gnus-current-headers))
 100            "")
 101          ))
 102     ;; The value must be a string to escape %-constructs because of subject.
 103     (setq mode-line-buffer-identification
 104           (format "GNUS: %s%s %s%s%s"
 105                   gnus-newsgroup-name
 106                   (if gnus-current-article
 107                       (format "/%d" gnus-current-article) "")
 108                   (truncate-string subject (min (string-width subject)
 109                                                 maxlen))
 110                   (if (> (string-width subject) maxlen) "..." "")
 111                   (make-string (max 0 (- 17 (string-width subject))) ? )
 112                   )))
 113   (set-buffer-modified-p t))
 114
 115 (fset 'gnus-Article-set-mode-line 'tm-gnus/article-set-mode-line)
 116
 117
 118 ;;; @ change MIME encoded-word decoding mode, decoding or non decoding.
 119 ;;;
 120
 121 (defun tm-gnus/set-decoding-mode (arg)
 122   "Set MIME encoded-word processing.
 123 With arg, turn MIME encoded-word processing on iff arg is positive."
 124   (setq tm-gnus/decoding-mode arg)
 125   (setq gnus-have-all-headers (not gnus-have-all-headers))
 126   (gnus-summary-select-article (not gnus-have-all-headers) t)
 127   )
 128
 129 (defun tm-gnus/toggle-decoding-mode ()
 130   "Toggle MIME encoded-word processing.
 131 With arg, turn MIME encoded-word processing on iff arg is positive."
 132   (interactive)
 133   (tm-gnus/set-decoding-mode (not tm-gnus/decoding-mode))
 134   )
 135
 136
 137 ;;; @ for tm-view
 138 ;;;
 139
 140 (autoload 'mime/viewer-mode "tm-view" "View MIME message." t)
 141
 142 (defun tm-gnus/view-message (arg)
 143   "MIME decode and play this message."
 144   (interactive "P")
 145   (let ((gnus-break-pages nil))
 146     (gnus-Subject-select-article t t)
 147     )
 148   (pop-to-buffer gnus-Article-buffer t)
 149   (mime/viewer-mode)
 150   )
 151
 152 (call-after-loaded
 153  'tm-view
 154  (function
 155   (lambda ()
 156     (set-alist 'mime-viewer/quitting-method-alist
 157                'gnus-Article-mode
 158                (if (string-match (regexp-quote "3.14.4") gnus-version)
 159                    (function
 160                     (lambda ()
 161                       (mime-viewer/kill-buffer)
 162                       (delete-other-windows)
 163                       (gnus-Article-show-summary)
 164                       ))
 165                  (function
 166                   (lambda ()
 167                     (mime-viewer/kill-buffer)
 168                     (delete-other-windows)
 169                     (gnus-Article-show-subjects)
 170                     ))
 171                  ))
 172     )))
 173
 174
 175 ;;; @ for tm-edit
 176 ;;;
 177
 178 ;; suggested by OKABE Yasuo <okabe@kudpc.kyoto-u.ac.jp>
 179 ;;      1995/11/08 (c.f. [tm ML:1067])
 180 (defun tm-gnus/insert-article (&optional message)
 181   (interactive)
 182   (let (;; for Emacs 18
 183         (mail-yank-ignored-headers mime-editor/yank-ignored-field-regexp)
 184         (news-make-reply-yank-header (function
 185                                       (lambda (message-id from) "")
 186                                       ))
 187         (news-yank-original-quoting-indicator "")
 188
 189         ;; select raw article buffer
 190         (mail-reply-buffer
 191          (save-excursion
 192            (set-buffer gnus-article-buffer)
 193            (if (eq major-mode 'mime/viewer-mode)
 194                mime::preview/article-buffer
 195              gnus-article-buffer)))
 196         )
 197     (news-reply-yank-original 0)
 198     ))
 199
 200 (call-after-loaded
 201  'tm-edit
 202  (function
 203   (lambda ()
 204     (set-alist
 205      'mime-editor/message-inserter-alist
 206      'news-reply-mode (function tm-gnus/insert-article))
 207
 208     (autoload 'tm-mail/insert-message "tm-mail")
 209     (set-alist 'mime-editor/message-inserter-alist
 210                'mail-mode (function tm-mail/insert-message))
 211     )))
 212
 213
 214 ;;; @ for tm-partial
 215 ;;;
 216
 217 (call-after-loaded
 218  'tm-partial
 219  (function
 220   (lambda ()
 221     (set-atype 'mime/content-decoding-condition
 222                '((type . "message/partial")
 223                  (method . mime-article/grab-message/partials)
 224                  (major-mode . gnus-Article-mode)
 225                  (summary-buffer-exp . gnus-Subject-buffer)
 226                  ))
 227
 228     (set-alist 'tm-partial/preview-article-method-alist
 229                'gnus-Article-mode
 230                (function
 231                 (lambda ()
 232                   (tm-gnus/view-message (gnus-Subject-article-number))
 233                   )))
 234     )))
 235
 236
 237 ;;; @ Summary decoding
 238 ;;;
 239
 240 (add-hook 'gnus-Select-group-hook (function tm-gnus/decode-summary-subjects))
 241
 242
 243 ;;; @ set up
 244 ;;;
 245
 246 (define-key gnus-Subject-mode-map "\et" 'tm-gnus/toggle-decoding-mode)
 247 (define-key gnus-Subject-mode-map "v" 'tm-gnus/view-message)
 248
 249 (defun tm-gnus/decode-encoded-word-if-you-need ()
 250   (if (and tm-gnus/decoding-mode
 251            (cond ((boundp 'all-headers) (not all-headers))
 252                  (t                     t))
 253            )
 254       (mime/decode-message-header)
 255     )
 256   (run-hooks 'tm-gnus/article-prepare-hook)
 257   )
 258
 259 (add-hook 'gnus-Article-prepare-hook
 260           (function tm-gnus/decode-encoded-word-if-you-need) t)
 261
 262
 263 ;;; @ for BBDB
 264 ;;;
 265
 266 (call-after-loaded
 267  'bbdb
 268  (function
 269   (lambda ()
 270     (require 'tm-bbdb)
 271     )))
 272
 273 (autoload 'tm-bbdb/update-record "tm-bbdb")
 274
 275 (defun tm-gnus/bbdb-setup ()
 276   (if (memq 'bbdb/gnus-update-record gnus-Article-prepare-hook)
 277       (progn
 278         (remove-hook 'gnus-Article-prepare-hook 'bbdb/gnus-update-record)
 279         (add-hook 'gnus-Article-prepare-hook 'tm-bbdb/update-record)
 280         )))
 281
 282 (add-hook 'gnus-startup-hook 'tm-gnus/bbdb-setup t)
 283
 284 (tm-gnus/bbdb-setup)
 285
 286
 287 ;;; @ end
 288 ;;;
 289
 290 (provide 'tm-gnus3)
 291
 292 ;;; tm-gnus3.el ends here