gnus/tm-sgnus.el

   1 ;;;
   2 ;;; tm-sgnus.el --- tm-gnus module for September GNUS
   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-words in message header." t)
  21 (autoload 'mime-eword/decode-string
  22   "tm-ew-d" "Decode MIME encoded-words in string." t)
  23
  24
  25 ;;; @ version
  26 ;;;
  27
  28 (defconst tm-gnus/RCS-ID
  29   "$Id: tm-sgnus.el,v 7.4 1995/10/18 08:32:36 morioka Exp $")
  30
  31 (defconst tm-gnus/version
  32   (concat (get-version-string tm-gnus/RCS-ID) " for September"))
  33
  34
  35 ;;; @ variables
  36 ;;;
  37
  38 (defvar tm-gnus/decode-all t
  39   "If it is non-nil and
  40 tm-gnus/automatic-MIME-preview-support is non-nil,
  41 article is automatic MIME decoded.")
  42
  43
  44 ;;; @ command functions
  45 ;;;
  46
  47 (defun tm-gnus/view-message (arg)
  48   "MIME decode and play this message."
  49   (interactive "P")
  50   (let ((gnus-break-pages nil))
  51     (gnus-summary-select-article t t)
  52     )
  53   (pop-to-buffer gnus-original-article-buffer t)
  54   (let (buffer-read-only)
  55     (if (text-property-any (point-min) (point-max) 'invisible t)
  56         (remove-text-properties (point-min) (point-max)
  57                                 gnus-hidden-properties)
  58       ))
  59   (mime/viewer-mode)
  60   )
  61
  62 (defun tm-gnus/summary-scroll-down ()
  63   "Scroll down one line current article."
  64   (interactive)
  65   (gnus-summary-scroll-up -1)
  66   )
  67
  68 (defun tm-gnus/summary-toggle-header (&optional arg)
  69   (interactive "P")
  70   (if (and tm-gnus/decode-all gnus-show-mime)
  71       (let ((mime-viewer/ignored-field-list
  72              (if (save-excursion
  73                    (set-buffer gnus-article-buffer)
  74                    (some-element
  75                     (lambda (field)
  76                       (rfc822/get-field-body field)
  77                       )
  78                     mime-viewer/ignored-field-list))
  79                  mime-viewer/ignored-field-list)))
  80         (gnus-summary-select-article t t)
  81         )
  82     (gnus-summary-toggle-header arg)
  83     ))
  84
  85 (define-key gnus-summary-mode-map "v" (function tm-gnus/view-message))
  86 (define-key gnus-summary-mode-map
  87   "\e\r" (function tm-gnus/summary-scroll-down))
  88 (define-key gnus-summary-mode-map
  89   "t" (function tm-gnus/summary-toggle-header))
  90
  91
  92 ;;; @ for tm-view
  93 ;;;
  94
  95 (defun mime-viewer/quitting-method-for-sgnus ()
  96   (mime-viewer/kill-buffer)
  97   (delete-other-windows)
  98   (gnus-article-show-summary)
  99   (gnus-summary-display-article (gnus-summary-article-number))
 100   )
 101
 102 (call-after-loaded
 103  'tm-view
 104  (lambda ()
 105    (set-alist 'mime-viewer/quitting-method-alist
 106               'gnus-original-article-mode
 107               (function mime-viewer/quitting-method-for-sgnus))
 108    ))
 109
 110
 111 ;;; @ summary filter
 112 ;;;
 113
 114 (cond ((not (boundp 'nnheader-encoded-words-decoding))
 115        (defun tm-gnus/decode-summary-from-and-subjects ()
 116          (mapcar (lambda (header)
 117                    (let ((from (mail-header-from header))
 118                          (subj (mail-header-subject header))
 119                          )
 120                      (mail-header-set-from
 121                       header
 122                       (if from
 123                           (mime-eword/decode-string from)
 124                         ""))
 125                      (mail-header-set-subject
 126                       header
 127                       (if subj
 128                           (mime-eword/decode-string subj)
 129                         ""))
 130                      ))
 131                  gnus-newsgroup-headers)
 132          )
 133
 134        (add-hook 'gnus-select-group-hook
 135                  (function tm-gnus/decode-summary-from-and-subjects))
 136        )
 137       (t
 138        (defalias 'mime/decode-encoded-words-string 'mime-eword/decode-string)
 139        ))
 140
 141
 142 ;;; @ article filter
 143 ;;;
 144
 145 (defun tm-gnus/preview-article ()
 146   (make-local-variable 'tm:mother-button-dispatcher)
 147   (setq tm:mother-button-dispatcher
 148         (function gnus-article-push-button))
 149   (mime/viewer-mode nil nil nil gnus-original-article-buffer
 150                     gnus-article-buffer)
 151   )
 152
 153 (defun tm-gnus/set-mime-method (mode)
 154   (setq gnus-show-mime-method
 155         (if mode
 156             (function tm-gnus/preview-article)
 157           (function mime/decode-message-header)
 158           )))
 159
 160 (tm-gnus/set-mime-method tm-gnus/decode-all)
 161
 162 (setq gnus-show-mime t)
 163
 164 (defun tm-gnus/article-hide-headers-if-wanted ()
 165   (if (not (and gnus-show-mime tm-gnus/decode-all))
 166       (gnus-article-hide-headers-if-wanted)
 167     ))
 168
 169 (remove-hook 'gnus-article-display-hook
 170              'gnus-article-hide-headers-if-wanted)
 171 (add-hook 'gnus-article-display-hook
 172           'tm-gnus/article-hide-headers-if-wanted)
 173
 174
 175 ;;; @ for tm-comp
 176 ;;;
 177
 178 (call-after-loaded
 179  'tm-comp
 180  (lambda ()
 181    (set-alist 'mime/message-sender-alist
 182               'news-reply-mode
 183               (function gnus-inews-news))
 184    ))
 185
 186
 187 ;;; @ end
 188 ;;;
 189
 190 (provide 'tm-sgnus)