tm-gnus.el

   1 ;;;
   2 ;;; $Id: tm-gnus.el,v 2.0 1994/07/24 08:33:00 morioka Exp morioka $
   3 ;;;
   4 ;;;   A MIME extension for GNUS
   5 ;;;
   6 ;;; by Morioka Tomohiko, 1993/11/20
   7
   8 (provide 'tm-gnus)
   9
  10 (require 'tm-misc)
  11 (require 'gnus)
  12
  13
  14 ;;; @ variables
  15 ;;;
  16 (defvar tm-gnus/startup-hook nil)
  17
  18
  19 ;;; @ to decode subject in mode-line
  20 ;;;
  21 ;; This function imported from gnus.el.
  22 ;;
  23 ;; New implementation in gnus 3.14.3
  24 ;;
  25 (defun tm-gnus/article-set-mode-line ()
  26   "Set Article mode line string.
  27 If you don't like it, define your own gnus-article-set-mode-line."
  28   (let ((maxlen 15)                     ;Maximum subject length
  29         (subject
  30          (if gnus-current-headers
  31              (mime/decode-string (nntp-header-subject gnus-current-headers))
  32            "")
  33          ))
  34     ;; The value must be a string to escape %-constructs because of subject.
  35     (setq mode-line-buffer-identification
  36           (format "GNUS: %s%s %s%s%s"
  37                   gnus-newsgroup-name
  38                   (if gnus-current-article
  39                       (format "/%d" gnus-current-article) "")
  40                   (rightful-boundary-short-string subject
  41                                                   (min (string-width subject)
  42                                                        maxlen))
  43                   (if (> (string-width subject) maxlen) "..." "")
  44                   (make-string (max 0 (- 17 (string-width subject))) ? )
  45                   )))
  46   (set-buffer-modified-p t))
  47
  48
  49 ;;; @ MIME full decode message
  50 ;;;
  51 (defun tm-gnus/full-decode-message-old (arg)
  52   "MIME full-decode this article."
  53   (interactive "P")
  54   (let ((gnus-Article-prepare-hook mime/body-decoding-method))
  55     ;; The following is a trick
  56     ;; to force to read the current article again.
  57     (setq gnus-have-all-headers (not gnus-have-all-headers))
  58     (gnus-summary-select-article (not gnus-have-all-headers) t)
  59     ))
  60
  61 (defun tm-gnus/full-decode-message-new (arg)
  62   "MIME full-decode this article."
  63   (interactive "P")
  64   (setq gnus-show-mime t)
  65   ;; The following is a trick to force to read the current article again.
  66   (setq gnus-have-all-headers (not gnus-have-all-headers))
  67   (gnus-summary-select-article (not gnus-have-all-headers) t)
  68   (setq gnus-show-mime nil))
  69
  70 (defun tm-gnus/play-message (arg)
  71   "MIME decode and play this message."
  72   (interactive "P")
  73   (let ((mime/body-decoding-mode "play"))
  74     (tm-gnus/full-decode-message arg)
  75     )
  76   (mime/show-body-decoded-result)
  77   )
  78
  79 (defun tm-gnus/extract-message (arg)
  80   "MIME decode and extract files from this message."
  81   (interactive "P")
  82   (let ((mime/body-decoding-mode "extract"))
  83     (tm-gnus/full-decode-message arg)
  84     )
  85   (mime/show-body-decoded-result)
  86   )
  87
  88 (defun tm-gnus/print-message (arg)
  89   "MIME decode and print contents of this message."
  90   (interactive "P")
  91   (let ((mime/body-decoding-mode "print"))
  92     (tm-gnus/full-decode-message arg)
  93     )
  94   (mime/show-body-decoded-result)
  95   )
  96
  97
  98 ;;; @ change MIME header decoding mode, decoding or non decoding.
  99 ;;;
 100 (defun tm-gnus/set-mime-header-decoding-mode (arg)
 101   "Set MIME header processing.
 102 With arg, turn MIME processing on iff arg is positive."
 103   (setq mime/header-decoding-mode arg)
 104   (setq gnus-have-all-headers (not gnus-have-all-headers))
 105   (gnus-summary-select-article (not gnus-have-all-headers) t)
 106   )
 107
 108 (defun tm-gnus/toggle-mime-header-decoding-mode ()
 109   "Toggle MIME header processing.
 110 With arg, turn MIME processing on iff arg is positive."
 111   (interactive)
 112   (tm-gnus/set-mime-header-decoding-mode (not mime/header-decoding-mode))
 113   )
 114
 115 ;;; @ set up
 116 ;;;
 117 (if (string-match "^GNUS [0-3]" gnus-version)
 118     (require 'tm-gnus3)
 119   (require 'tm-gnus4)
 120   )
 121
 122 (run-hooks 'tm-gnus/startup-hook)