home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / gnu / lucid / lemacs-19.6 / lisp / gnus / gnusmail.el < prev    next >
Encoding:
Text File  |  1993-01-18  |  7.1 KB  |  210 lines
  1. ;;; Mail reply commands for GNUS newsreader
  2. ;; Copyright (C) 1990 Masanobu UMEDA
  3.  
  4. ;; This file is part of GNU Emacs.
  5.  
  6. ;; GNU Emacs is distributed in the hope that it will be useful,
  7. ;; but WITHOUT ANY WARRANTY.  No author or distributor
  8. ;; accepts responsibility to anyone for the consequences of using it
  9. ;; or for whether it serves any particular purpose or works at all,
  10. ;; unless he says so in writing.  Refer to the GNU Emacs General Public
  11. ;; License for full details.
  12.  
  13. ;; Everyone is granted permission to copy, modify and redistribute
  14. ;; GNU Emacs, but only under the conditions described in the
  15. ;; GNU Emacs General Public License.   A copy of this license is
  16. ;; supposed to have been given to you along with GNU Emacs so you
  17. ;; can know your rights and responsibilities.  It should be in a
  18. ;; file named COPYING.  Among other things, the copyright notice
  19. ;; and this notice must be preserved on all copies.
  20.  
  21. (provide 'gnusmail)
  22. (require 'gnus)
  23.  
  24. ;; Provides mail reply and mail other window command using usual mail
  25. ;; interface and mh-e interface.
  26. ;;
  27. ;; To use MAIL: set the variables gnus-mail-reply-method to
  28. ;; gnus-mail-reply-using-mail, gnus-mail-forward-method to
  29. ;; gnus-mail-forward-using-mail, and gnus-mail-other-window-method to
  30. ;; gnus-mail-other-window-using-mail.
  31. ;;
  32. ;; To use MH-E: set the variables gnus-mail-reply-method to
  33. ;; gnus-mail-reply-using-mhe, gnus-mail-forward-method to
  34. ;; gnus-mail-forward-using-mhe, and gnus-mail-other-window-method to
  35. ;; gnus-mail-other-window-using-mhe.
  36.  
  37. (autoload 'news-mail-reply "rnewspost")
  38. (autoload 'news-mail-other-window "rnewspost")
  39.  
  40. (autoload 'mh-send "mh-e")
  41. (autoload 'mh-send-other-window "mh-e")
  42. (autoload 'mh-find-path "mh-e")
  43. (autoload 'mh-yank-cur-msg "mh-e")
  44.  
  45. ;;; Mail reply commands of GNUS Subject Mode
  46.  
  47. (defun gnus-Subject-mail-reply (yank)
  48.   "Reply mail to news author.
  49. If prefix argument YANK is non-nil, original article is yanked automatically.
  50. Customize the variable gnus-mail-reply-method to use another mailer."
  51.   (interactive "P")
  52.   (gnus-Subject-select-article)
  53.   (switch-to-buffer gnus-Article-buffer)
  54.   (widen)
  55.   (delete-other-windows)
  56.   (bury-buffer gnus-Article-buffer)
  57.   (funcall gnus-mail-reply-method yank))
  58.  
  59. (defun gnus-Subject-mail-reply-with-original ()
  60.   "Reply mail to news author with original article.
  61. Customize the variable gnus-mail-reply-method to use another mailer."
  62.   (interactive)
  63.   (gnus-Subject-mail-reply t))
  64.  
  65. (defun gnus-Subject-mail-forward ()
  66.   "Forward the current message to another user.
  67. Customize the variable gnus-mail-forward-method to use another mailer."
  68.   (interactive)
  69.   (gnus-Subject-select-article)
  70.   (switch-to-buffer gnus-Article-buffer)
  71.   (widen)
  72.   (delete-other-windows)
  73.   (bury-buffer gnus-Article-buffer)
  74.   (funcall gnus-mail-forward-method))
  75.  
  76. (defun gnus-Subject-mail-other-window ()
  77.   "Compose mail in other window.
  78. Customize the variable gnus-mail-other-window-method to use another mailer."
  79.   (interactive)
  80.   (gnus-Subject-select-article)
  81.   (switch-to-buffer gnus-Article-buffer)
  82.   (widen)
  83.   (delete-other-windows)
  84.   (bury-buffer gnus-Article-buffer)
  85.   (funcall gnus-mail-other-window-method))
  86.  
  87.  
  88. ;;; Send mail using sendmail mail mode.
  89.  
  90. (defun gnus-mail-reply-using-mail (&optional yank)
  91.   "Compose reply mail using mail.
  92. Optional argument YANK means yank original article."
  93.   (gnus-Article-show-all-headers) ; to get references field
  94.   (news-mail-reply)
  95.   (gnus-news-mail-reply-init)
  96.   (gnus-overload-functions)
  97.   (if yank
  98.       (let ((last (point)))
  99.     (goto-char (point-max))
  100.     (mail-yank-original nil)
  101.     (goto-char last)
  102.     )))
  103.  
  104. (defun gnus-news-mail-reply-init ()
  105.   (save-excursion
  106.     (or (eq major-mode 'mail-mode) (error "confused about major mode"))
  107.     (use-local-map (if (current-local-map)
  108.                (copy-keymap (current-local-map))
  109.              (make-sparse-keymap)))
  110.     (define-key (current-local-map) "\^C\^Y" 'news-reply-yank-original)
  111.     (set-buffer "*Article*")
  112.     (if (and (not (zerop (buffer-size)))
  113.          (equal major-mode 'gnus-Article-mode))
  114.     (progn
  115.       (gnus-Article-show-all-headers)
  116.       (narrow-to-region (point-min)
  117.                 (progn (goto-char (point-min))
  118.                    (search-forward "\n\n")
  119.                    (- (point) 2)))
  120.       (setq news-reply-yank-from (mail-fetch-field "from")
  121.         news-reply-yank-message-id (mail-fetch-field "message-id"))
  122.       (widen)))))
  123.  
  124.  
  125. (defvar gnus-forward-header-function
  126.   '(lambda ()
  127.      (concat "[" gnus-newsgroup-name "] "
  128.          (or (gnus-fetch-field "Subject") ""))))
  129.  
  130. (defun gnus-mail-forward-using-mail ()
  131.   "Forward the current message to another user using mail, RFC944 style."
  132.   (let ((forward-buffer gnus-Article-buffer)
  133.     (subject (funcall gnus-forward-header-function)))
  134.     (if (mail nil nil subject)
  135.     (save-excursion
  136.       (goto-char (point-max))
  137.       (or (bolp) (insert "\n"))
  138.       (insert "------- Start of forwarded message -------\n")
  139.       (let ((p (point)))
  140.         (insert-buffer forward-buffer)
  141.         (goto-char p)
  142.         (while (re-search-forward "^-" nil t)
  143.           (replace-match "- -" t t)))
  144.       (goto-char (point-max))
  145.       (insert "\n------- End of forwarded message -------\n")
  146.       ;; You have a chance to arrange the message.
  147.       (run-hooks 'gnus-mail-forward-hook)
  148.       ))))
  149.  
  150. (defun gnus-mail-other-window-using-mail ()
  151.   "Compose mail other window using mail."
  152.   (news-mail-other-window)
  153.   (gnus-overload-functions))
  154.  
  155.  
  156. ;;; Send mail using mh-e.
  157.  
  158. ;; The following mh-e interface is all cooperative works of
  159. ;; tanaka@flab.fujitsu.CO.JP (TANAKA Hiroshi), kawabe@sra.CO.JP
  160. ;; (Yoshikatsu Kawabe), and shingu@casund.cpr.canon.co.jp (Toshiaki
  161. ;; SHINGU).
  162.  
  163. (defun gnus-mail-reply-using-mhe (&optional yank)
  164.   "Compose reply mail using mh-e.
  165. Optional argument YANK means yank original article.
  166. The command \\[mh-yank-cur-msg] yank the original message into current buffer."
  167.   ;; First of all, prepare mhe mail buffer.
  168.   (let (from cc subject date to reply-to (buffer (current-buffer)))
  169.     (save-restriction
  170.       (gnus-Article-show-all-headers)    ;I don't think this is really needed.
  171.       (setq from (gnus-fetch-field "from")
  172.         subject (let ((subject (gnus-fetch-field "subject")))
  173.               (if (and subject
  174.                    (not (string-match "^[Rr][Ee]:.+$" subject)))
  175.               (concat "Re: " subject) subject))
  176.         reply-to (gnus-fetch-field "reply-to")
  177.         cc (gnus-fetch-field "cc")
  178.         date (gnus-fetch-field "date"))
  179.       (setq mh-show-buffer buffer)
  180.       (setq to (or reply-to from))
  181.       (mh-find-path)
  182.       (mh-send to (or cc "") subject)
  183.       (save-excursion
  184.     (mh-insert-fields
  185.      "In-reply-to:"
  186.      (concat
  187.       (substring from 0 (string-match "  *at \\|  *@ \\| *(\\| *<" from))
  188.       "'s message of " date)))
  189.       (setq mh-sent-from-folder buffer)
  190.       (setq mh-sent-from-msg 1)
  191.       ))
  192.   ;; Then, yank original article if requested.
  193.   (if yank
  194.       (let ((last (point)))
  195.     (mh-yank-cur-msg)
  196.     (goto-char last)
  197.     )))
  198.  
  199. (defun gnus-mail-other-window-using-mhe ()
  200.   "Compose mail other window using mh-e."
  201.   (let ((to (read-string "To: "))
  202.     (cc (read-string "Cc: "))
  203.     (subject (read-string "Subject: " (gnus-fetch-field "subject"))))
  204.     (gnus-Article-show-all-headers)    ;I don't think this is really needed.
  205.     (setq mh-show-buffer (current-buffer))
  206.     (mh-find-path)
  207.     (mh-send-other-window to cc subject)
  208.     (setq mh-sent-from-folder (current-buffer))
  209.     (setq mh-sent-from-msg 1)))
  210.