gnus/tm-gnus5.el

   1 ;;;
   2 ;;; tm-gnus5.el --- tm-gnus module for Gnus 5.*
   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-list)
  15 (require 'tl-misc)
  16 (require 'gnus)
  17
  18 (autoload 'mime/viewer-mode "tm-view" "View MIME message." t)
  19 (autoload 'mime/decode-message-header
  20   "tm-ew-d" "Decode MIME encoded-word." t)
  21 (autoload 'mime/decode-encoded-words-string
  22   "tm-ew-d" "Decode MIME encoded-word." t)
  23
  24
  25 ;;; @ version
  26 ;;;
  27
  28 (defconst tm-gnus/RCS-ID
  29   "$Id: tm-gnus5.el,v 7.0 1995/10/03 05:07:54 morioka Exp $")
  30
  31 (defconst tm-gnus/version
  32   (concat (get-version-string tm-gnus/RCS-ID) " for GNUS 5"))
  33
  34 (defconst tm-gnus/automatic-MIME-preview-support
  35   (cond ((boundp 'gnus-clean-article-buffer)
  36          (defconst gnus-version (concat gnus-version " with tm patch"))
  37          t)
  38         (t
  39          (defvar gnus-clean-article-buffer gnus-article-buffer)
  40          nil)
  41         ))
  42
  43 (defvar tm-gnus/preview-buffer
  44   (if tm-gnus/automatic-MIME-preview-support
  45       (concat "*Preview-" gnus-clean-article-buffer "*"))
  46   )
  47
  48
  49 ;;; @ variables
  50 ;;;
  51
  52 (defvar tm-gnus/original-article-display-hook gnus-article-display-hook)
  53
  54 (defvar tm-gnus/decode-all tm-gnus/automatic-MIME-preview-support
  55   "If it is non-nil and
  56 tm-gnus/automatic-MIME-preview-support is non-nil,
  57 article is automatic MIME decoded.")
  58
  59
  60 ;;; @ command functions
  61 ;;;
  62
  63 (defun tm-gnus/view-message (arg)
  64   "MIME decode and play this message."
  65   (interactive "P")
  66   (let ((gnus-break-pages nil))
  67     (gnus-summary-select-article t t)
  68     )
  69   (pop-to-buffer gnus-clean-article-buffer t)
  70   (let (buffer-read-only)
  71     (if (text-property-any (point-min) (point-max) 'invisible t)
  72         (remove-text-properties (point-min) (point-max)
  73                                 gnus-hidden-properties)
  74       ))
  75   (mime/viewer-mode)
  76   )
  77
  78 (defun tm-gnus/summary-scroll-down ()
  79   "Scroll down one line current article."
  80   (interactive)
  81   (gnus-summary-scroll-up -1)
  82   )
  83
  84 (define-key gnus-summary-mode-map "v" (function tm-gnus/view-message))
  85 (define-key gnus-summary-mode-map
  86   "\e\r" (function tm-gnus/summary-scroll-down))
  87
  88
  89 ;;; @ for tm-view
  90 ;;;
  91
  92 (defun mime-viewer/quitting-method-for-gnus5 ()
  93   (mime-viewer/kill-buffer)
  94   (delete-other-windows)
  95   (gnus-article-show-summary)
  96   (gnus-summary-display-article (gnus-summary-article-number))
  97   )
  98
  99 (call-after-loaded
 100  'tm-view
 101  (function
 102   (lambda ()
 103     (set-alist 'mime-viewer/quitting-method-alist
 104                'gnus-article-mode
 105                (function mime-viewer/quitting-method-for-gnus5))
 106     )))
 107
 108
 109 ;;; @ summary filter
 110 ;;;
 111
 112 (defun tm-gnus/decode-summary-from-and-subjects ()
 113   (mapcar (lambda (header)
 114             (let ((from (mail-header-from header))
 115                   (subj (mail-header-subject header))
 116                   )
 117               (mail-header-set-from
 118                header
 119                (if from
 120                    (mime/decode-encoded-words-string from)
 121                  ""))
 122               (mail-header-set-subject
 123                header
 124                (if subj
 125                    (mime/decode-encoded-words-string subj)
 126                  ""))
 127               ))
 128           gnus-newsgroup-headers)
 129   )
 130
 131 (add-hook 'gnus-select-group-hook
 132           (function tm-gnus/decode-summary-from-and-subjects))
 133
 134
 135 ;;; @ article filter
 136 ;;;
 137
 138 (setq gnus-show-mime-method (function mime/decode-message-header))
 139
 140
 141 ;;; @ automatic MIME preview support
 142 ;;;
 143
 144 (defun tm-gnus/summary-toggle-header (&optional arg)
 145   (interactive "P")
 146   (if tm-gnus/decode-all
 147       (let ((mime-viewer/ignored-field-list
 148              (if (save-window-excursion
 149                    (switch-to-buffer tm-gnus/preview-buffer)
 150                    (some-element
 151                     (function
 152                      (lambda (field)
 153                        (message/get-field-body field)
 154                        ))
 155                     mime-viewer/ignored-field-list))
 156                  mime-viewer/ignored-field-list)))
 157         (gnus-summary-select-article t t)
 158         )
 159     (gnus-summary-toggle-header arg)
 160     ))
 161
 162 (defun tm-gnus/set-mime-method (mode)
 163   (if mode
 164       (progn
 165         (setq gnus-show-mime nil)
 166         (setq gnus-article-display-hook
 167               (list (function (lambda ()
 168                                 (mime/viewer-mode)
 169                                 (gnus-set-mode-line 'article)
 170                                 ))))
 171         (set-alist 'gnus-window-to-buffer 'article tm-gnus/preview-buffer)
 172         (setq gnus-article-buffer tm-gnus/preview-buffer)
 173         )
 174     (setq gnus-show-mime t)
 175     (setq gnus-article-display-hook tm-gnus/original-article-display-hook)
 176     (set-alist 'gnus-window-to-buffer 'article gnus-clean-article-buffer)
 177     (setq gnus-article-buffer gnus-clean-article-buffer)
 178     ))
 179
 180 (defun tm-gnus/toggle-mime (arg)
 181   "Toggle MIME processing mode.
 182 With arg, turn MIME processing on if arg is positive."
 183   (interactive "P")
 184   (setq tm-gnus/decode-all
 185         (if (null arg)
 186             (not tm-gnus/decode-all)
 187           arg))
 188   (gnus-set-global-variables)
 189   (tm-gnus/set-mime-method tm-gnus/decode-all)
 190   (gnus-summary-select-article gnus-show-all-headers 'force)
 191   )
 192
 193 (if tm-gnus/automatic-MIME-preview-support
 194     (progn
 195       (define-key gnus-summary-mode-map
 196         "t" (function tm-gnus/summary-toggle-header))
 197       (define-key gnus-summary-mode-map "\et" (function tm-gnus/toggle-mime))
 198
 199       (tm-gnus/set-mime-method tm-gnus/decode-all)
 200
 201       (add-hook 'gnus-exit-gnus-hook
 202                 (function
 203                  (lambda ()
 204                    (let ((buf (get-buffer tm-gnus/preview-buffer)))
 205                      (if buf
 206                          (kill-buffer buf)
 207                        )))))
 208       )
 209   (setq gnus-article-display-hook tm-gnus/original-article-display-hook)
 210   (setq gnus-show-mime t)
 211   )
 212
 213
 214 ;;; @ for tm-comp
 215 ;;;
 216
 217 (call-after-loaded
 218  'tm-comp
 219  (function
 220   (lambda ()
 221     (set-alist 'mime/message-sender-alist
 222                'news-reply-mode
 223                (function gnus-inews-news))
 224     )))
 225
 226
 227 ;;; @ end
 228 ;;;
 229
 230 (provide 'tm-gnus5)