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.7 1995/09/02 07:28:38 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-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 tm-gnus/add-decoding-mode-to-mode-line))
  59
  60 (defun tm-gnus/decode-encoded-word-if-you-need ()
  61   (if (and tm-gnus/decoding-mode (not gnus-have-all-headers))
  62       (mime/decode-message-header)
  63     ))
  64
  65 (add-hook 'gnus-article-prepare-hook
  66           (function tm-gnus/decode-encoded-word-if-you-need) t)
  67
  68
  69 ;;; @ for tm-comp
  70 ;;;
  71
  72 (defun tm-gnus4/message-before-send ()
  73   (let ((case-fold-search nil))
  74     (or (boundp 'mime/news-reply-mode-server-running)
  75         (make-variable-buffer-local 'mime/news-reply-mode-server-running))
  76     (setq mime/news-reply-mode-server-running (gnus-server-opened))
  77     (save-excursion
  78       (gnus-start-news-server)
  79       (widen)
  80       (goto-char (point-min))
  81       (run-hooks 'news-inews-hook)
  82       (save-restriction
  83         (narrow-to-region
  84          (point-min)
  85          (progn
  86            (goto-char (point-min))
  87            (search-forward (concat "\n" mail-header-separator "\n"))
  88            (point)))
  89
  90         (goto-char (point-min))
  91         (if (search-forward-regexp "^Newsgroups: +" nil t)
  92             (save-restriction
  93               (narrow-to-region
  94                (point)
  95                (if (re-search-forward "^[^ \t]" nil 'end)
  96                    (match-beginning 0)
  97                  (point-max)))
  98               (goto-char (point-min))
  99               (replace-regexp "\n[ \t]+" " ")
 100               (goto-char (point-min))
 101               (replace-regexp "[ \t\n]*,[ \t\n]*\\|[ \t]+" ",")
 102               ))
 103         ))))
 104
 105 (defun tm-gnus4/message-sender ()
 106   (interactive)
 107   (widen)
 108   (goto-char (point-min))
 109   (save-restriction
 110     (narrow-to-region
 111      (point-min)
 112      (progn
 113        (goto-char (point-min))
 114        (search-forward (concat "\n" mail-header-separator "\n"))
 115        (point)))
 116     ;; Mail the message too if To: or Cc: exists.
 117     (if (or (mail-fetch-field "to" nil t)
 118             (mail-fetch-field "cc" nil t))
 119         (if gnus-mail-send-method
 120             (progn
 121               (message
 122                (format "Sending (%d/%d) via mail..." (+ i 1) total))
 123               (widen)
 124               (funcall gnus-mail-send-method)
 125               (message
 126                (format "Sending (%d/%d) via mail... done" (+ i 1) total))
 127               (ding)
 128               (message
 129                "No mailer defined.  To: and/or Cc: fields ignored.")
 130               (sit-for 1)))))
 131   (message
 132    (format "Posting %d/%d to USENET..." (+ i 1) total))
 133   (if (gnus-inews-article)
 134       (message
 135        (format "Posting %d/%d to USENET... done" (+ i 1) total))
 136     ;; We cannot signal an error.
 137     (ding)
 138     (message
 139      (format "Article %d/%d rejected: %s"
 140              (+ i 1) total (gnus-status-message)))
 141     (sit-for 3))
 142   )
 143
 144 (defun tm-gnus4/message-after-send ()
 145   (or mime/news-reply-mode-server-running
 146       (gnus-close-server))
 147   (and (fboundp 'bury-buffer) (bury-buffer))
 148   )
 149
 150 (call-after-loaded
 151  'tm-comp
 152  (function
 153   (lambda ()
 154     (set-alist 'mime/message-before-send-hook-alist
 155                'news-reply-mode
 156                (function tm-gnus4/message-before-send))
 157     (set-alist 'mime/message-sender-alist
 158                'news-reply-mode
 159                (function tm-gnus4/message-sender))
 160     (set-alist 'mime/message-after-send-hook-alist
 161                'news-reply-mode
 162                (function tm-gnus4/message-after-send))
 163     )))
 164
 165
 166 ;;; @ end
 167 ;;;
 168
 169 (provide 'tm-gnus4)