2 ;;; tm-gnus4.el --- tm-gnus module for GNUS 4.*
13 (defconst tm-gnus/RCS-ID
14 "$Id: tm-gnus4.el,v 7.0 1995/10/22 12:12:56 morioka Exp $")
16 (defconst tm-gnus/version
17 (concat (get-version-string tm-gnus/RCS-ID) " for GNUS 4"))
23 (autoload 'mime/viewer-mode "tm-view" "View MIME message." t)
25 (defun tm-gnus/view-message (arg)
26 "MIME decode and play this message."
28 (let ((gnus-break-pages nil))
29 (gnus-summary-select-article t t)
31 (pop-to-buffer gnus-article-buffer t)
35 (defun tm-gnus/summary-scroll-down ()
36 "Scroll down one line current article."
38 (gnus-summary-scroll-up -1)
41 (defun mime-viewer/quitting-method-for-gnus4 ()
42 (mime-viewer/kill-buffer)
43 (delete-other-windows)
44 (gnus-article-show-summary)
45 (if (null gnus-have-all-headers)
46 (gnus-summary-select-article nil t)
53 (set-alist 'mime-viewer/quitting-method-alist
55 (function mime-viewer/quitting-method-for-gnus4))
66 (set-atype 'mime/content-decoding-condition
67 '((type . "message/partial")
68 (method . mime-article/grab-message/partials)
69 (major-mode . gnus-article-mode)
70 (summary-buffer-exp . gnus-summary-buffer)
73 (set-alist 'tm-partial/preview-article-method-alist
77 (tm-gnus/view-message (gnus-summary-article-number))
82 ;;; @ Summary decoding
85 (add-hook 'gnus-select-group-hook (function tm-gnus/decode-summary-subjects))
91 (define-key gnus-summary-mode-map
92 "\et" (function tm-gnus/toggle-decoding-mode))
93 (define-key gnus-summary-mode-map "v" (function tm-gnus/view-message))
94 (define-key gnus-summary-mode-map
95 "\e\r" (function tm-gnus/summary-scroll-down))
97 (fset 'gnus-article-set-mode-line 'tm-gnus/article-set-mode-line)
98 (add-hook 'gnus-article-mode-hook
99 (function tm-gnus/add-decoding-mode-to-mode-line))
101 (defun tm-gnus/decode-encoded-word-if-you-need ()
102 (if (and tm-gnus/decoding-mode (not gnus-have-all-headers))
103 (mime/decode-message-header)
106 (add-hook 'gnus-article-prepare-hook
107 (function tm-gnus/decode-encoded-word-if-you-need) t)
113 (defun tm-gnus4/message-before-send ()
114 (let ((case-fold-search nil))
115 (or (boundp 'mime/news-reply-mode-server-running)
116 (make-variable-buffer-local 'mime/news-reply-mode-server-running))
117 (setq mime/news-reply-mode-server-running (gnus-server-opened))
119 (gnus-start-news-server)
121 (goto-char (point-min))
122 (run-hooks 'news-inews-hook)
127 (goto-char (point-min))
128 (search-forward (concat "\n" mail-header-separator "\n"))
131 (goto-char (point-min))
132 (if (search-forward-regexp "^Newsgroups: +" nil t)
136 (if (re-search-forward "^[^ \t]" nil 'end)
139 (goto-char (point-min))
140 (replace-regexp "\n[ \t]+" " ")
141 (goto-char (point-min))
142 (replace-regexp "[ \t\n]*,[ \t\n]*\\|[ \t]+" ",")
146 (defun tm-gnus4/message-sender ()
149 (goto-char (point-min))
154 (goto-char (point-min))
155 (search-forward (concat "\n" mail-header-separator "\n"))
157 ;; Mail the message too if To: or Cc: exists.
158 (if (or (mail-fetch-field "to" nil t)
159 (mail-fetch-field "cc" nil t))
160 (if gnus-mail-send-method
163 (format "Sending (%d/%d) via mail..." (+ i 1) total))
165 (funcall gnus-mail-send-method)
167 (format "Sending (%d/%d) via mail... done" (+ i 1) total))
170 "No mailer defined. To: and/or Cc: fields ignored.")
173 (format "Posting %d/%d to USENET..." (+ i 1) total))
174 (if (gnus-inews-article)
176 (format "Posting %d/%d to USENET... done" (+ i 1) total))
177 ;; We cannot signal an error.
180 (format "Article %d/%d rejected: %s"
181 (+ i 1) total (gnus-status-message)))
185 (defun tm-gnus4/message-after-send ()
186 (or mime/news-reply-mode-server-running
188 (and (fboundp 'bury-buffer) (bury-buffer))
195 (set-alist 'mime/message-before-send-hook-alist
197 (function tm-gnus4/message-before-send))
198 (set-alist 'mime/message-sender-alist
200 (function tm-gnus4/message-sender))
201 (set-alist 'mime/message-after-send-hook-alist
203 (function tm-gnus4/message-after-send))