gnus/tm-gnus4.el

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