gnus/tm-gnus4.el

   1 ;;;
   2 ;;; tm-gnus4.el --- tm-gnus module for GNUS 4, 5.0.* and 5.1.*.
   3 ;;;
   4 ;;; Copyright (C) 1995 Free Software Foundation, Inc.
   5 ;;; Copyright (C) 1995 MORIOKA Tomohiko
   6 ;;;
   7 ;;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
   8 ;;; Keywords: news, MIME, multimedia, multilingual, encoded-word
   9 ;;;
  10 ;;; This file is part of tm (Tools for MIME).
  11 ;;;
  12
  13 (require 'tl-str)
  14 (require 'tl-misc)
  15
  16
  17 ;;; @ version
  18 ;;;
  19
  20 (defconst tm-gnus/RCS-ID
  21   "$Id: tm-gnus4.el,v 7.2 1995/11/19 08:10:33 morioka Exp $")
  22
  23 (defconst tm-gnus/version
  24   (concat (get-version-string tm-gnus/RCS-ID) " for 4 .. 5.1"))
  25
  26
  27 ;;; @ variable
  28 ;;;
  29
  30 (defvar tm-gnus/automatic-mime-preview t
  31   "*If non-nil, show MIME processed article.
  32 This variable is set to `gnus-show-mime'.")
  33
  34
  35 ;;; @ for tm-view
  36 ;;;
  37
  38 (autoload 'mime/viewer-mode "tm-view" "View MIME message." t)
  39
  40 (defun tm-gnus/view-message (arg)
  41   "MIME decode and play this message."
  42   (interactive "P")
  43   (let ((gnus-break-pages nil))
  44     (gnus-summary-select-article t t)
  45     )
  46   (pop-to-buffer gnus-article-buffer t)
  47   (mime/viewer-mode)
  48   )
  49
  50 (defun tm-gnus/summary-scroll-down ()
  51   "Scroll down one line current article."
  52   (interactive)
  53   (gnus-summary-scroll-up -1)
  54   )
  55
  56 (defun mime-viewer/quitting-method-for-gnus4 ()
  57   (mime-viewer/kill-buffer)
  58   (delete-other-windows)
  59   (gnus-article-show-summary)
  60   (if (null gnus-have-all-headers)
  61       (gnus-summary-select-article nil t)
  62     ))
  63
  64 (call-after-loaded
  65  'tm-view
  66  (function
  67   (lambda ()
  68     (set-alist 'mime-viewer/quitting-method-alist
  69                'gnus-article-mode
  70                (function mime-viewer/quitting-method-for-gnus4))
  71     )))
  72
  73
  74 ;;; @ for tm-partial
  75 ;;;
  76
  77 (call-after-loaded
  78  'tm-partial
  79  (function
  80   (lambda ()
  81     (set-atype 'mime/content-decoding-condition
  82                '((type . "message/partial")
  83                  (method . mime-article/grab-message/partials)
  84                  (major-mode . gnus-article-mode)
  85                  (summary-buffer-exp . gnus-summary-buffer)
  86                  ))
  87
  88     (set-alist 'tm-partial/preview-article-method-alist
  89                'gnus-article-mode
  90                (function
  91                 (lambda ()
  92                   (tm-gnus/view-message (gnus-summary-article-number))
  93                   )))
  94     )))
  95
  96
  97 ;;; @ set up
  98 ;;;
  99
 100 (define-key gnus-summary-mode-map "v" (function tm-gnus/view-message))
 101 (define-key gnus-summary-mode-map
 102   "\e\r" (function tm-gnus/summary-scroll-down))
 103
 104 (defun tm-gnus/decode-encoded-word-if-you-need ()
 105   (if (not gnus-have-all-headers)
 106       (progn
 107         (mime/decode-message-header)
 108         (run-hooks 'tm-gnus/article-prepare-hook)
 109         )))
 110
 111 (defvar tm-gnus/original-article-buffer " *Original Article*")
 112
 113 (defun tm-gnus/preview-article-if-you-need ()
 114   (if (not gnus-have-all-headers)
 115       (let ((str (buffer-string))
 116             (obuf (get-buffer tm-gnus/original-article-buffer))
 117             (pbuf (current-buffer))
 118             )
 119         (if obuf
 120             (progn
 121               (set-buffer obuf)
 122               (setq buffer-read-only nil)
 123               (erase-buffer)
 124               )
 125           (setq obuf (get-buffer-create tm-gnus/original-article-buffer))
 126           (set-buffer obuf)
 127           )
 128         (insert str)
 129         (gnus-article-mode)
 130         (set-buffer pbuf)
 131         (make-local-variable 'tm:mother-button-dispatcher)
 132         (setq tm:mother-button-dispatcher
 133               (function gnus-article-push-button))
 134         (mime/viewer-mode
 135          nil nil nil tm-gnus/original-article-buffer gnus-article-buffer)
 136         (setq buffer-read-only nil)
 137         (gnus-article-show-summary)
 138         (run-hooks 'tm-gnus/article-prepare-hook)
 139         )))
 140
 141 (setq gnus-show-mime-method
 142       (if tm-gnus/automatic-mime-preview
 143           (function tm-gnus/preview-article-if-you-need)
 144         (function tm-gnus/decode-encoded-word-if-you-need)
 145         ))
 146
 147 (setq gnus-show-mime t)
 148
 149
 150 ;;; @ for BBDB
 151 ;;;
 152
 153 (defun tm-gnus/bbdb-setup ()
 154   (if (memq 'bbdb/gnus-update-record gnus-article-prepare-hook)
 155       (progn
 156         (remove-hook 'gnus-article-prepare-hook 'bbdb/gnus-update-record)
 157         (add-hook 'tm-gnus/article-prepare-hook 'bbdb/gnus-update-record)
 158         )))
 159
 160 (add-hook 'gnus-startup-hook 'tm-gnus/bbdb-setup t)
 161
 162 (tm-gnus/bbdb-setup)
 163
 164
 165 ;;; @ end
 166 ;;;
 167
 168 (provide 'tm-gnus4)