gnus/tm-sgnus.el

   1 ;;;
   2 ;;; tm-sgnus.el --- tm-gnus module for September GNUS
   3 ;;;
   4
   5 (require 'tl-str)
   6 (require 'tl-list)
   7 (require 'tl-misc)
   8 (require 'gnus)
   9
  10
  11 ;;; @ version
  12 ;;;
  13
  14 (defconst tm-gnus/RCS-ID
  15   "$Id: tm-sgnus.el,v 6.24 1995/09/26 12:08:35 morioka Exp $")
  16
  17 (defconst tm-gnus/version
  18   (concat (get-version-string tm-gnus/RCS-ID) " for September"))
  19
  20
  21 ;;; @ autoload
  22 ;;;
  23
  24 (autoload 'mime/viewer-mode "tm-view" "View MIME message." t)
  25 (autoload 'mime/decode-message-header
  26   "tiny-mime" "Decode MIME encoded-word." t)
  27 (autoload 'mime/decode-string "tiny-mime" "Decode MIME encoded-word." t)
  28
  29
  30 ;;; @ variables
  31 ;;;
  32
  33 (defvar tm-gnus/decode-all t
  34   "If it is non-nil and
  35 tm-gnus/automatic-MIME-preview-support is non-nil,
  36 article is automatic MIME decoded.")
  37
  38
  39 ;;; @ command functions
  40 ;;;
  41
  42 (defun tm-gnus/view-message (arg)
  43   "MIME decode and play this message."
  44   (interactive "P")
  45   (let ((gnus-break-pages nil))
  46     (gnus-summary-select-article t t)
  47     )
  48   (pop-to-buffer gnus-original-article-buffer t)
  49   (let (buffer-read-only)
  50     (if (text-property-any (point-min) (point-max) 'invisible t)
  51         (remove-text-properties (point-min) (point-max)
  52                                 gnus-hidden-properties)
  53       ))
  54   (mime/viewer-mode)
  55   )
  56
  57 (defun tm-gnus/summary-scroll-down ()
  58   "Scroll down one line current article."
  59   (interactive)
  60   (gnus-summary-scroll-up -1)
  61   )
  62
  63 (define-key gnus-summary-mode-map "v" (function tm-gnus/view-message))
  64 (define-key gnus-summary-mode-map
  65   "\e\r" (function tm-gnus/summary-scroll-down))
  66
  67
  68 ;;; @ for tm-view
  69 ;;;
  70
  71 (defun mime-viewer/quitting-method-for-sgnus ()
  72   (mime-viewer/kill-buffer)
  73   (delete-other-windows)
  74   (gnus-article-show-summary)
  75   (gnus-summary-display-article (gnus-summary-article-number))
  76   )
  77
  78 (call-after-loaded
  79  'tm-view
  80  (function
  81   (lambda ()
  82     (set-alist 'mime-viewer/quitting-method-alist
  83                'gnus-original-article-mode
  84                (function mime-viewer/quitting-method-for-sgnus))
  85     )))
  86
  87
  88 ;;; @ summary filter
  89 ;;;
  90
  91 (defun tm-gnus/decode-summary-from-and-subjects ()
  92   (mapcar (function
  93            (lambda (header)
  94              (mail-header-set-from
  95               header
  96               (mime/decode-string (or (mail-header-from header) ""))
  97               )
  98              (mail-header-set-subject
  99               header
 100               (mime/decode-string (or (mail-header-subject header) ""))
 101               )
 102              ))
 103           gnus-newsgroup-headers)
 104   )
 105
 106 (add-hook 'gnus-select-group-hook
 107           (function tm-gnus/decode-summary-from-and-subjects))
 108
 109
 110 ;;; @ article filter
 111 ;;;
 112
 113 (defun tm-gnus/preview-article ()
 114   (let (mime-viewer/ignored-field-list)
 115     (make-local-variable 'tm:mother-button-dispatcher)
 116     (setq tm:mother-button-dispatcher
 117           (function gnus-article-push-button))
 118     (mime/viewer-mode nil nil nil gnus-original-article-buffer
 119                       gnus-article-buffer)
 120     ))
 121
 122 (defun tm-gnus/set-mime-method (mode)
 123   (setq gnus-show-mime-method
 124         (if mode
 125             (function tm-gnus/preview-article)
 126           (function mime/decode-message-header)
 127           )))
 128
 129 (tm-gnus/set-mime-method tm-gnus/decode-all)
 130
 131 (setq gnus-show-mime t)
 132
 133
 134 ;;; @ for tm-comp
 135 ;;;
 136
 137 (call-after-loaded
 138  'tm-comp
 139  (lambda ()
 140    (set-alist 'mime/message-sender-alist
 141               'news-reply-mode
 142               (function gnus-inews-news))
 143    ))
 144
 145
 146 ;;; @ end
 147 ;;;
 148
 149 (provide 'tm-sgnus)