gnus/tm-dgnus.el

   1 ;;;
   2 ;;; tm-dgnus.el --- tm-gnus module for (ding) GNUS
   3 ;;;
   4
   5 ;;; @ version
   6 ;;;
   7 (defconst tm-gnus/RCS-ID
   8   "$Id: tm-dgnus.el,v 6.3 1995/05/31 04:34:43 morioka Exp $")
   9
  10 (defconst tm-gnus/version
  11   (concat (get-version-string tm-gnus/RCS-ID) " (ding)"))
  12
  13
  14 ;;; @ autoload
  15 ;;;
  16
  17 (autoload 'mime/viewer-mode "tm-view" "View MIME message." t)
  18 (autoload 'mime/decode-message-header
  19   "tiny-mime" "Decode MIME encoded-word." t)
  20 (autoload 'mime/decode-string "tiny-mime" "Decode MIME encoded-word." t)
  21
  22
  23 ;;; @ command functions
  24 ;;;
  25
  26 (defun tm-gnus/view-message (arg)
  27   "MIME decode and play this message."
  28   (interactive "P")
  29   (let ((gnus-break-pages nil))
  30     (gnus-summary-select-article t t)
  31     )
  32   (pop-to-buffer gnus-article-buffer t)
  33   (mime/viewer-mode)
  34   )
  35
  36 (defun tm-gnus/summary-scroll-down ()
  37   "Scroll down one line current article."
  38   (interactive)
  39   (gnus-summary-scroll-up -1)
  40   )
  41
  42 (define-key gnus-summary-mode-map "v" (function tm-gnus/view-message))
  43 (define-key gnus-summary-mode-map
  44   "\e\r" (function tm-gnus/summary-scroll-down))
  45
  46
  47 ;;; @ summary filter
  48 ;;;
  49
  50 (defun tm-gnus/decode-summary-from-and-subjects ()
  51   (mapcar (function
  52            (lambda (header)
  53              (header-set-from
  54               header
  55               (mime/decode-string (or (header-from header) ""))
  56               )
  57              (header-set-subject
  58               header
  59               (mime/decode-string (or (header-subject header) ""))
  60               )
  61              ))
  62           gnus-newsgroup-headers)
  63   )
  64
  65 (add-hook 'gnus-select-group-hook
  66           (function tm-gnus/decode-summary-from-and-subjects))
  67
  68
  69 ;;; @ article filter
  70 ;;;
  71
  72 (setq gnus-show-mime-method
  73       (function
  74        (lambda ()
  75          (let (buffer-read-only)
  76            (mime/decode-message-header)
  77            ))))
  78
  79 (setq gnus-show-mime t)
  80
  81
  82 ;;; @ end
  83 ;;;
  84
  85 (provide 'tm-dgnus)