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.5 1995/06/22 05:34:56 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 ;;; @ variables
  24 ;;;
  25
  26 (defvar tm-gnus/original-article-display-hook gnus-article-display-hook)
  27
  28 (defvar tm-gnus/decode-all t)
  29
  30 (defvar tm-gnus/preview-buffer (concat "*Preview-" gnus-article-buffer "*"))
  31
  32
  33 ;;; @ command functions
  34 ;;;
  35
  36 (defun tm-gnus/view-message (arg)
  37   "MIME decode and play this message."
  38   (interactive "P")
  39   (let ((gnus-break-pages nil))
  40     (gnus-summary-select-article t t)
  41     )
  42   (pop-to-buffer gnus-article-buffer t)
  43   (mime/viewer-mode)
  44   )
  45
  46 (defun tm-gnus/summary-scroll-down ()
  47   "Scroll down one line current article."
  48   (interactive)
  49   (gnus-summary-scroll-up -1)
  50   )
  51
  52 (define-key gnus-summary-mode-map "v" (function tm-gnus/view-message))
  53 (define-key gnus-summary-mode-map
  54   "\e\r" (function tm-gnus/summary-scroll-down))
  55 (define-key gnus-summary-mode-map "\et" (function tm-gnus/toggle-mime))
  56
  57
  58 (defun gnus-summary-next-page (lines)
  59   "Show next page of selected article.
  60 If end of article, select next article.
  61 Argument LINES specifies lines to be scrolled up."
  62   (interactive "P")
  63   (let ((article (gnus-summary-article-number))
  64         (endp nil))
  65     (if (or (null gnus-current-article)
  66             (/= article gnus-current-article))
  67         ;; Selected subject is different from current article's.
  68         (gnus-summary-display-article article)
  69       (gnus-configure-windows 'article)
  70       (pop-to-buffer gnus-summary-buffer)
  71       (gnus-eval-in-buffer-window (cdr (assq 'article gnus-window-to-buffer))
  72         (setq endp (gnus-article-next-page lines)))
  73       (cond ((and endp lines)
  74              (message "End of message"))
  75             ((and endp (null lines))
  76              (gnus-summary-next-unread-article)))
  77       )))
  78
  79 (defun gnus-summary-scroll-up (lines)
  80   "Scroll up (or down) one line current article.
  81 Argument LINES specifies lines to be scrolled up (or down if negative)."
  82   (interactive "p")
  83   (gnus-set-global-variables)
  84   (gnus-configure-windows 'article)
  85   (or (gnus-summary-select-article nil nil 'pseudo)
  86       (gnus-eval-in-buffer-window
  87           (cdr (assq 'article gnus-window-to-buffer))
  88         (cond ((> lines 0)
  89                (if (gnus-article-next-page lines)
  90                    (gnus-message 3 "End of message")))
  91               ((< lines 0)
  92                (gnus-article-prev-page (- lines))))))
  93   (gnus-summary-recenter)
  94   (gnus-summary-position-cursor))
  95
  96 (defun gnus-summary-prev-page (lines)
  97   "Show previous page of selected article.
  98 Argument LINES specifies lines to be scrolled down."
  99   (interactive "P")
 100   (gnus-set-global-variables)
 101   (let ((article (gnus-summary-article-number)))
 102     (gnus-configure-windows 'article)
 103     (if (or (null gnus-current-article)
 104             (null gnus-article-current)
 105             (/= article (cdr gnus-article-current))
 106             (not (equal (car gnus-article-current) gnus-newsgroup-name)))
 107         ;; Selected subject is different from current article's.
 108         (gnus-summary-display-article article)
 109       (gnus-summary-recenter)
 110       (gnus-eval-in-buffer-window
 111        (cdr (assq 'article gnus-window-to-buffer))
 112        (gnus-article-prev-page lines))))
 113   (gnus-summary-position-cursor))
 114
 115 (defun gnus-summary-toggle-header (arg)
 116   "Show the headers if they are hidden, or hide them if they are shown.
 117 If ARG is a positive number, show the entire header.
 118 If ARG is a negative number, hide the unwanted header lines."
 119   (interactive "P")
 120   (gnus-set-global-variables)
 121   (save-excursion
 122     (set-buffer (cdr (assq 'article gnus-window-to-buffer)))
 123     (let ((buffer-read-only nil))
 124       (if (numberp arg)
 125           (if (> arg 0) (remove-text-properties (point-min) (point-max)
 126                                                 gnus-hidden-properties)
 127             (if (< arg 0) (run-hooks 'gnus-article-display-hook)))
 128         (if (text-property-any (point-min) (point-max) 'invisible t)
 129             (if tm-gnus/decode-all
 130                 (let (mime-viewer/ignored-field-list)
 131                   (run-hooks 'gnus-article-display-hook)
 132                   )
 133               (remove-text-properties (point-min) (point-max)
 134                                       gnus-hidden-properties)
 135               )
 136           (let (gnus-have-all-headers)
 137             (run-hooks 'gnus-article-display-hook)
 138             ))
 139         )
 140       (pop-to-buffer gnus-summary-buffer)
 141       (set-window-point (get-buffer-window (current-buffer)) (point-min)))))
 142
 143
 144 ;; Set article window start at LINE, where LINE is the number of lines
 145 ;; from the head of the article.
 146 (defun gnus-article-set-window-start (&optional line)
 147   (let ((article-buffer (cdr (assq 'article gnus-window-to-buffer))))
 148     (set-window-start
 149      (get-buffer-window article-buffer)
 150      (save-excursion
 151        (set-buffer article-buffer)
 152        (goto-char (point-min))
 153        (if (not line)
 154            (point-min)
 155          (gnus-message 6 "Moved to bookmark")
 156          (search-forward "\n\n" nil t)
 157          (forward-line line)
 158          (point))))))
 159
 160
 161 ;;; @ summary filter
 162 ;;;
 163
 164 (defun tm-gnus/decode-summary-from-and-subjects ()
 165   (mapcar (function
 166            (lambda (header)
 167              (header-set-from
 168               header
 169               (mime/decode-string (or (header-from header) ""))
 170               )
 171              (header-set-subject
 172               header
 173               (mime/decode-string (or (header-subject header) ""))
 174               )
 175              ))
 176           gnus-newsgroup-headers)
 177   )
 178
 179 (add-hook 'gnus-select-group-hook
 180           (function tm-gnus/decode-summary-from-and-subjects))
 181
 182
 183 ;;; @ article filter
 184 ;;;
 185
 186 (setq gnus-show-mime-method
 187           (function
 188            (lambda ()
 189              (let (buffer-read-only)
 190                (mime/decode-message-header)
 191                ))))
 192
 193 (defun tm-gnus/set-mime-method (mode)
 194   (if mode
 195       (progn
 196         (setq gnus-show-mime nil)
 197         (setq gnus-article-display-hook
 198               (list (function (lambda ()
 199                                 (mime/viewer-mode)
 200                                 (gnus-set-mode-line 'article)
 201                                 (set-buffer-modified-p nil)
 202                                 (pop-to-buffer mime::preview/article-buffer)
 203                                 ))))
 204         (set-alist 'gnus-window-to-buffer 'article tm-gnus/preview-buffer)
 205         )
 206     (setq gnus-show-mime t)
 207     (setq gnus-article-display-hook tm-gnus/original-article-display-hook)
 208     (set-alist 'gnus-window-to-buffer 'article gnus-article-buffer)
 209     ))
 210
 211 (tm-gnus/set-mime-method tm-gnus/decode-all)
 212
 213 (defun tm-gnus/toggle-mime (arg)
 214   "Toggle MIME processing mode.
 215 With arg, turn MIME processing on if arg is positive."
 216   (interactive "P")
 217   (setq tm-gnus/decode-all
 218         (if (null arg)
 219             (not tm-gnus/decode-all)
 220           arg))
 221   (gnus-set-global-variables)
 222   (tm-gnus/set-mime-method tm-gnus/decode-all)
 223   (gnus-summary-select-article gnus-show-all-headers 'force)
 224   )
 225
 226
 227 ;;; @ etc
 228 ;;;
 229
 230 (add-hook 'gnus-exit-gnus-hook
 231           (function
 232            (lambda ()
 233              (let ((buf (get-buffer tm-gnus/preview-buffer)))
 234                (if buf
 235                    (kill-buffer buf)
 236                  )))))
 237
 238
 239 ;;; @ end
 240 ;;;
 241
 242 (provide 'tm-dgnus)