gnus/tm-gnus4.el

   1 ;;;
   2 ;;; tm-gnus4.el --- tm-gnus module for GNUS 4.*
   3 ;;;
   4
   5 (require 'tl-str)
   6 (require 'tm-ognus)
   7
   8
   9 ;;; @ version
  10 ;;;
  11
  12 (defconst tm-gnus/RCS-ID
  13   "$Id: tm-gnus4.el,v 6.2 1995/08/31 20:14:33 morioka Exp $")
  14
  15 (defconst tm-gnus/version
  16   (concat (get-version-string tm-gnus/RCS-ID) " for GNUS 4"))
  17
  18
  19 ;;; @ for tm-view
  20 ;;;
  21
  22 (autoload 'mime/viewer-mode "tm-view" "View MIME message." t)
  23
  24 (defun tm-gnus/view-message (arg)
  25   "MIME decode and play this message."
  26   (interactive "P")
  27   (let ((gnus-break-pages nil))
  28     (gnus-summary-select-article t t)
  29     )
  30   (pop-to-buffer gnus-article-buffer t)
  31   (mime/viewer-mode)
  32   )
  33
  34 (defun tm-gnus/summary-scroll-down ()
  35   "Scroll down one line current article."
  36   (interactive)
  37   (gnus-summary-scroll-up -1)
  38   )
  39
  40
  41 ;;; @ Summary decoding
  42 ;;;
  43
  44 (add-hook 'gnus-select-group-hook (function tm-gnus/decode-summary-subjects))
  45
  46
  47 ;;; @ set up
  48 ;;;
  49
  50 (define-key gnus-summary-mode-map
  51   "\et" (function tm-gnus/toggle-mime-header-decoding-mode))
  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
  56 (fset 'gnus-article-set-mode-line 'tm-gnus/article-set-mode-line)
  57 (add-hook 'gnus-article-mode-hook
  58           (function mime/add-header-decoding-mode-to-mode-line))
  59
  60 (add-hook 'gnus-article-prepare-hook
  61           (function mime/decode-message-header-if-you-need) t)
  62
  63
  64 ;;; @ for tm-comp
  65 ;;;
  66
  67 (defun tm-gnus4/message-before-send ()
  68   (let ((case-fold-search nil))
  69     (or (boundp 'mime/news-reply-mode-server-running)
  70         (make-variable-buffer-local 'mime/news-reply-mode-server-running))
  71     (setq mime/news-reply-mode-server-running (gnus-server-opened))
  72     (save-excursion
  73       (gnus-start-news-server)
  74       (widen)
  75       (goto-char (point-min))
  76       (run-hooks 'news-inews-hook)
  77       (save-restriction
  78         (narrow-to-region
  79          (point-min)
  80          (progn
  81            (goto-char (point-min))
  82            (search-forward (concat "\n" mail-header-separator "\n"))
  83            (point)))
  84
  85         (goto-char (point-min))
  86         (if (search-forward-regexp "^Newsgroups: +" nil t)
  87             (save-restriction
  88               (narrow-to-region
  89                (point)
  90                (if (re-search-forward "^[^ \t]" nil 'end)
  91                    (match-beginning 0)
  92                  (point-max)))
  93               (goto-char (point-min))
  94               (replace-regexp "\n[ \t]+" " ")
  95               (goto-char (point-min))
  96               (replace-regexp "[ \t\n]*,[ \t\n]*\\|[ \t]+" ",")
  97               ))
  98         ))))
  99
 100 (defun tm-gnus4/message-sender ()
 101   (interactive)
 102   (widen)
 103   (goto-char (point-min))
 104   (save-restriction
 105     (narrow-to-region
 106      (point-min)
 107      (progn
 108        (goto-char (point-min))
 109        (search-forward (concat "\n" mail-header-separator "\n"))
 110        (point)))
 111     ;; Mail the message too if To: or Cc: exists.
 112     (if (or (mail-fetch-field "to" nil t)
 113             (mail-fetch-field "cc" nil t))
 114         (if gnus-mail-send-method
 115             (progn
 116               (message
 117                (format "Sending (%d/%d) via mail..." (+ i 1) total))
 118               (widen)
 119               (funcall gnus-mail-send-method)
 120               (message
 121                (format "Sending (%d/%d) via mail... done" (+ i 1) total))
 122               (ding)
 123               (message
 124                "No mailer defined.  To: and/or Cc: fields ignored.")
 125               (sit-for 1)))))
 126   (message
 127    (format "Posting %d/%d to USENET..." (+ i 1) total))
 128   (if (gnus-inews-article)
 129       (message
 130        (format "Posting %d/%d to USENET... done" (+ i 1) total))
 131     ;; We cannot signal an error.
 132     (ding)
 133     (message
 134      (format "Article %d/%d rejected: %s"
 135              (+ i 1) total (gnus-status-message)))
 136     (sit-for 3))
 137   )
 138
 139 (defun tm-gnus4/message-after-send ()
 140   (or mime/news-reply-mode-server-running
 141       (gnus-close-server))
 142   (and (fboundp 'bury-buffer) (bury-buffer))
 143   )
 144
 145 (call-after-loaded
 146  'tm-comp
 147  (function
 148   (lambda ()
 149     (set-alist 'mime/message-before-send-hook-alist
 150                'news-reply-mode
 151                (function tm-gnus4/message-before-send))
 152     (set-alist 'mime/message-sender-alist
 153                'news-reply-mode
 154                (function tm-gnus4/message-sender))
 155     (set-alist 'mime/message-after-send-hook-alist
 156                'news-reply-mode
 157                (function tm-gnus4/message-after-send))
 158     )))
 159
 160
 161 ;;; @ end
 162 ;;;
 163
 164 (provide 'tm-gnus4)