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.23 1995/09/24 20:20:32 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                'fundamental-mode
  84                (function mime-viewer/quitting-method-for-sgnus))
  85     (set-alist 'tm:callback-property-alist
  86                'fundamental-mode 'gnus-callback)
  87     (set-alist 'tm:data-property-alist
  88                'fundamental-mode 'gnus-data)
  89     )))
  90
  91
  92 ;;; @ summary filter
  93 ;;;
  94
  95 (defun tm-gnus/decode-summary-from-and-subjects ()
  96   (mapcar (function
  97            (lambda (header)
  98              (mail-header-set-from
  99               header
 100               (mime/decode-string (or (mail-header-from header) ""))
 101               )
 102              (mail-header-set-subject
 103               header
 104               (mime/decode-string (or (mail-header-subject header) ""))
 105               )
 106              ))
 107           gnus-newsgroup-headers)
 108   )
 109
 110 (add-hook 'gnus-select-group-hook
 111           (function tm-gnus/decode-summary-from-and-subjects))
 112
 113
 114 ;;; @ article filter
 115 ;;;
 116
 117 (defun tm-gnus/preview-article ()
 118   (let (mime-viewer/ignored-field-list)
 119     (make-local-variable 'tm:mother-button-dispatcher)
 120     (setq tm:mother-button-dispatcher
 121           (function gnus-article-push-button))
 122     (mime/viewer-mode nil nil nil gnus-original-article-buffer
 123                       gnus-article-buffer)
 124     ))
 125
 126 (defun tm-gnus/set-mime-method (mode)
 127   (setq gnus-show-mime-method
 128         (if mode
 129             (function tm-gnus/preview-article)
 130           (function mime/decode-message-header)
 131           )))
 132
 133 (tm-gnus/set-mime-method tm-gnus/decode-all)
 134
 135 (setq gnus-show-mime t)
 136
 137
 138 ;;; @ for tm-comp
 139 ;;;
 140
 141 (call-after-loaded
 142  'tm-comp
 143  (lambda ()
 144    (set-alist 'mime/message-sender-alist
 145               'news-reply-mode
 146               (function gnus-inews-news))
 147    ))
 148
 149
 150 ;;; @ end
 151 ;;;
 152
 153 (provide 'tm-sgnus)