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