tm 6.50

[elisp/tm.git] / gnus / tm-dgnus.el

diff --git a/gnus/tm-dgnus.el b/gnus/tm-dgnus.el
new file mode 100644 (file)
index 0000000..5f1e3fd
--- /dev/null
+++ b/gnus/tm-dgnus.el
@@ -0,0 +1,85 @@
+;;;
+;;; tm-dgnus.el --- tm-gnus module for (ding) GNUS
+;;;
+
+;;; @ version
+;;;
+(defconst tm-gnus/RCS-ID
+  "$Id: tm-dgnus.el,v 6.3 1995/05/31 04:34:43 morioka Exp $")
+
+(defconst tm-gnus/version
+  (concat (get-version-string tm-gnus/RCS-ID) " (ding)"))
+
+
+;;; @ autoload
+;;;
+
+(autoload 'mime/viewer-mode "tm-view" "View MIME message." t)
+(autoload 'mime/decode-message-header
+  "tiny-mime" "Decode MIME encoded-word." t)
+(autoload 'mime/decode-string "tiny-mime" "Decode MIME encoded-word." t)
+
+
+;;; @ command functions
+;;;
+
+(defun tm-gnus/view-message (arg)
+  "MIME decode and play this message."
+  (interactive "P")
+  (let ((gnus-break-pages nil))
+    (gnus-summary-select-article t t)
+    )
+  (pop-to-buffer gnus-article-buffer t)
+  (mime/viewer-mode)
+  )
+
+(defun tm-gnus/summary-scroll-down ()
+  "Scroll down one line current article."
+  (interactive)
+  (gnus-summary-scroll-up -1)
+  )
+
+(define-key gnus-summary-mode-map "v" (function tm-gnus/view-message))
+(define-key gnus-summary-mode-map
+  "\e\r" (function tm-gnus/summary-scroll-down))
+
+
+;;; @ summary filter
+;;;
+
+(defun tm-gnus/decode-summary-from-and-subjects ()
+  (mapcar (function
+          (lambda (header)
+            (header-set-from
+             header
+             (mime/decode-string (or (header-from header) ""))
+             )
+            (header-set-subject
+             header
+             (mime/decode-string (or (header-subject header) ""))
+             )
+            ))
+         gnus-newsgroup-headers)
+  )
+
+(add-hook 'gnus-select-group-hook
+         (function tm-gnus/decode-summary-from-and-subjects))
+
+
+;;; @ article filter
+;;;
+
+(setq gnus-show-mime-method
+      (function
+       (lambda ()
+        (let (buffer-read-only)
+          (mime/decode-message-header)
+          ))))
+
+(setq gnus-show-mime t)
+
+
+;;; @ end
+;;;
+
+(provide 'tm-dgnus)