home *** CD-ROM | disk | FTP | other *** search
/ Education Sampler 1992 [NeXTSTEP] / Education_1992_Sampler.iso / NeXT / GnuSource / emacs-15.0.3 / lisp / rnewspost.el < prev    next >
Lisp/Scheme  |  1990-07-19  |  15KB  |  387 lines
  1. ;;; USENET news poster/mailer for GNU Emacs
  2. ;; Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc.
  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. ;; moved posting and mail code from rnews.el
  22. ;;    tower@prep.ai.mit.edu Wed Oct 29 1986
  23. ;; brought posting code almost up to the revision of RFC 850 for News 2.11
  24. ;; - couldn't see handling the special meaning of the Keyword: poster
  25. ;; - not worth the code space to support the old A news Title: (which
  26. ;;   Subject: replaced) and Article-I.D.: (which Message-ID: replaced)
  27. ;;    tower@prep Nov 86
  28. ;; changed C-c C-r key-binding due to rename of news-caesar-buffer-body
  29. ;;    tower@prep 21 Nov 86
  30. ;; added (require 'rnews)    tower@prep 22 Apr 87
  31. ;; restricted call of news-show-all-headers in news-post-news & news-reply
  32. ;;    tower@prep 28 Apr 87
  33. ;; commented out Posting-Front-End to save USENET bytes tower@prep Jul 31 87
  34. ;; commented out -n and -t args in news-inews     tower@prep 15 Oct 87
  35. (require 'sendmail)
  36. (require 'rnews)
  37.  
  38. ;Now in paths.el.
  39. ;(defvar news-inews-program "inews"
  40. ;  "Function to post news.")
  41.  
  42. ;; Replying and posting news items are done by these functions.
  43. ;; imported from rmail and modified to work with rnews ...
  44. ;; Mon Mar 25,1985 at 03:07:04 ads@mit-hermes.
  45. ;; this is done so that rnews can operate independently from rmail.el and
  46. ;; sendmail and dosen't have to autoload these functions.
  47. ;;
  48. ;;; >> Nuked by Mly to autoload those functions again, as the duplication of
  49. ;;; >>  code was making maintenance too difficult.
  50.  
  51. (defvar news-reply-mode-map () "Mode map used by news-reply.")
  52.  
  53. (or news-reply-mode-map
  54.     (progn
  55.       (setq news-reply-mode-map (make-keymap))
  56.       (define-key news-reply-mode-map "\C-c?" 'describe-mode)
  57.       (define-key news-reply-mode-map "\C-c\C-f\C-d" 'news-reply-distribution)
  58.       (define-key news-reply-mode-map "\C-c\C-f\C-k" 'news-reply-keywords)
  59.       (define-key news-reply-mode-map "\C-c\C-f\C-n" 'news-reply-newsgroups)
  60.       (define-key news-reply-mode-map "\C-c\C-f\C-f" 'news-reply-followup-to)
  61.       (define-key news-reply-mode-map "\C-c\C-f\C-s" 'mail-subject)
  62.       (define-key news-reply-mode-map "\C-c\C-f\C-a" 'news-reply-summary)
  63.       (define-key news-reply-mode-map "\C-c\C-r" 'news-caesar-buffer-body)
  64.       (define-key news-reply-mode-map "\C-c\C-w" 'news-reply-signature)
  65.       (define-key news-reply-mode-map "\C-c\C-y" 'news-reply-yank-original)
  66.       (define-key news-reply-mode-map "\C-c\C-q" 'mail-fill-yanked-message)
  67.       (define-key news-reply-mode-map "\C-c\C-c" 'news-inews)
  68.       (define-key news-reply-mode-map "\C-c\C-s" 'news-inews)))
  69.  
  70. (defun news-reply-mode ()
  71.   "Major mode for editing news to be posted on USENET.
  72. First-time posters are asked to please read the articles in newsgroup:
  73.                                                      news.announce.newusers .
  74. Like Text Mode but with these additional commands:
  75.  
  76. C-c C-s  news-inews (post the message)    C-c C-c  news-inews
  77. C-c C-f     move to a header field (and create it if there isn't):
  78.      C-c C-f C-n  move to Newsgroups:    C-c C-f C-s  move to Subj:
  79.      C-c C-f C-f  move to Followup-To:      C-c C-f C-k  move to Keywords:
  80.      C-c C-f C-d  move to Distribution:    C-c C-f C-a  move to Summary:
  81. C-c C-y  news-reply-yank-original (insert current message, in NEWS).
  82. C-c C-q  mail-fill-yanked-message (fill what was yanked).
  83. C-c C-r  caesar rotate all letters by 13 places in the article's body (rot13)."
  84.   (interactive)
  85.   ;; require...
  86.   (or (fboundp 'mail-setup) (load "sendmail"))
  87.   (kill-all-local-variables)
  88.   (make-local-variable 'mail-reply-buffer)
  89.   (setq mail-reply-buffer nil)
  90.   (set-syntax-table text-mode-syntax-table)
  91.   (use-local-map news-reply-mode-map)
  92.   (setq local-abbrev-table text-mode-abbrev-table)
  93.   (setq major-mode 'news-reply-mode)
  94.   (setq mode-name "News")
  95.   (make-local-variable 'paragraph-separate)
  96.   (make-local-variable 'paragraph-start)
  97.   (setq paragraph-start (concat "^" mail-header-separator "$\\|"
  98.                 paragraph-start))
  99.   (setq paragraph-separate (concat "^" mail-header-separator "$\\|"
  100.                    paragraph-separate))
  101.   (run-hooks 'text-mode-hook 'news-reply-mode-hook))
  102.  
  103. (defvar news-reply-yank-from
  104.   "Save From: field for news-reply-yank-original."
  105.   "")
  106.  
  107. (defvar news-reply-yank-message-id
  108.   "Save Message-Id: field for news-reply-yank-original."
  109.   "")
  110.  
  111. (defun news-reply-yank-original (arg)
  112.   "Insert the message being replied to, if any (in rmail).
  113. Puts point before the text and mark after.
  114. Indents each nonblank line ARG spaces (default 3).
  115. Just \\[universal-argument] as argument means don't indent
  116. and don't delete any header fields."
  117.   (interactive "P")
  118.   (mail-yank-original arg)
  119.   (exchange-point-and-mark)
  120.   (insert "In article " news-reply-yank-message-id
  121.       " " news-reply-yank-from " writes:\n\n"))
  122.  
  123. (defun news-reply-newsgroups ()
  124.   "Move point to end of Newsgroups: field.
  125. RFC 850 constrains the Newsgroups: field to be a comma separated list of valid
  126. newsgroups names at your site:
  127. Newsgroups: news.misc,comp.misc,rec.misc"
  128.   (interactive)
  129.   (expand-abbrev)
  130.   (goto-char (point-min))
  131.   (mail-position-on-field "Newsgroups"))
  132.  
  133. (defun news-reply-followup-to ()
  134.   "Move point to end of Followup-To: field.  Create the field if none.
  135. One usually requests followups to only one newsgroup.
  136. RFC 850 constrains the Followup-To: field to be a comma separated list of valid
  137. newsgroups names at your site, that are also in the Newsgroups: field:
  138. Newsgroups: news.misc,comp.misc,rec.misc,misc.misc,soc.misc
  139. Followup-To: news.misc,comp.misc,rec.misc"
  140.   (interactive)
  141.   (expand-abbrev)
  142.   (or (mail-position-on-field "Followup-To" t)
  143.       (progn (mail-position-on-field "newsgroups")
  144.          (insert "\nFollowup-To: ")))
  145.      ;; @@ could do a completing read based on the Newsgroups: field to
  146.      ;; @@ fill in the Followup-To: field
  147. )
  148.  
  149. (defun news-reply-distribution ()
  150.   "Move point to end of Distribution: optional field.
  151. Create the field if none.  Without this field the posting goes to all of
  152. USENET.  The field is used to restrict the posting to parts of USENET."
  153.   (interactive)
  154.   (expand-abbrev)
  155.   (mail-position-on-field "Distribution")
  156.   ;; @@could do a completing read based on the news library file:
  157.   ;; @@    ../distributions  to fill in the field.
  158.   )
  159.  
  160. (defun news-reply-keywords ()
  161.   "Move point to end of Keywords: optional field.  Create the field if none.
  162. Used as an aid to the news reader, it can contain a few, well selected keywords
  163. identifying the message."
  164.   (interactive)
  165.   (expand-abbrev)
  166.   (mail-position-on-field "Keywords"))
  167.  
  168. (defun news-reply-summary ()
  169.   "Move point to end of Summary: optional field.  Create the field if none.
  170. Used as an aid to the news reader, it can contain a succinct
  171. summary (abstract) of the message."
  172.   (interactive)
  173.   (expand-abbrev)
  174.   (mail-position-on-field "Summary"))
  175.  
  176. (defun news-reply-signature ()
  177.   "The inews program appends ~/.signature automatically."
  178.   (interactive)
  179.   (message "~/.signature will be appended automatically."))
  180.  
  181. (defun news-setup (to subject in-reply-to newsgroups replybuffer)
  182.   "Setup the news reply or posting buffer with the proper headers and in
  183. news-reply-mode."
  184.   (setq mail-reply-buffer replybuffer)
  185.   (let ((mail-setup-hook nil))
  186.     (if (null to)
  187.     ;; this hack is needed so that inews wont be confused by 
  188.     ;; the fcc: and bcc: fields
  189.     (let ((mail-self-blind nil)
  190.           (mail-archive-file-name nil))
  191.       (mail-setup to subject in-reply-to nil replybuffer)
  192.       (beginning-of-line)
  193.       (kill-line 1)
  194.       (goto-char (point-max)))
  195.       (mail-setup to subject in-reply-to nil replybuffer))
  196.     ;;;(mail-position-on-field "Posting-Front-End")
  197.     ;;;(insert (emacs-version))
  198.     (goto-char (point-max))
  199.     (if (let ((case-fold-search t))
  200.       (re-search-backward "^Subject:" (point-min) t))
  201.     (progn (beginning-of-line)
  202.            (insert "Newsgroups: " (or newsgroups "") "\n")
  203.            (if (not newsgroups)
  204.            (backward-char 1)
  205.          (goto-char (point-max)))))
  206.     (run-hooks 'news-setup-hook)))
  207.    
  208. (defun news-inews ()
  209.   "Send a news message using inews."
  210.   (interactive)
  211.   (let* (newsgroups subject
  212.             (case-fold-search nil))
  213.     (save-excursion
  214.       (save-restriction
  215.     (goto-char (point-min))
  216.     (search-forward (concat "\n" mail-header-separator "\n"))
  217.     (narrow-to-region (point-min) (point))
  218.     (setq newsgroups (mail-fetch-field "newsgroups")
  219.           subject (mail-fetch-field "subject")))
  220.       (widen)
  221.       (goto-char (point-min))
  222.       (run-hooks 'news-inews-hook)
  223.       (goto-char (point-min))
  224.       (search-forward (concat "\n" mail-header-separator "\n"))
  225.       (replace-match "\n\n")
  226.       (goto-char (point-max))
  227.       ;; require a newline at the end for inews to append .signature to
  228.       (or (= (preceding-char) ?\n)
  229.       (insert ?\n))
  230.       (message "Posting to USENET...")
  231.       (call-process-region (point-min) (point-max) 
  232.                news-inews-program nil 0 nil
  233.                "-h")    ; take all header lines!
  234.                ;@@ setting of subject and newsgroups still needed?
  235.                ;"-t" subject
  236.                ;"-n" newsgroups
  237.       (message "Posting to USENET... done")
  238.       (goto-char (point-min))        ;restore internal header separator
  239.       (search-forward "\n\n")
  240.       (replace-match (concat "\n" mail-header-separator "\n"))
  241.       (set-buffer-modified-p nil))
  242.     (and (fboundp 'bury-buffer) (bury-buffer))))
  243.  
  244. ;@@ shares some code with news-reply and news-post-news
  245. (defun news-mail-reply ()
  246.   "Mail a reply to the author of the current article.
  247. While composing the reply, use \\[news-reply-yank-original] to yank the
  248. original message into it."
  249.   (interactive)
  250.   (let (from cc subject date to reply-to
  251.          (buffer (current-buffer)))
  252.     (save-restriction
  253.       (narrow-to-region (point-min) (progn (goto-line (point-min))
  254.                        (search-forward "\n\n")
  255.                        (- (point) 1)))
  256.       (setq from (mail-fetch-field "from")
  257.         subject (mail-fetch-field "subject")
  258.         reply-to (mail-fetch-field "reply-to")
  259.         date (mail-fetch-field "date"))
  260.       (setq to from)
  261.       (pop-to-buffer "*mail*")
  262.       (mail nil
  263.         (if reply-to reply-to to)
  264.         subject
  265.         (let ((stop-pos (string-match "  *at \\|  *@ \\| *(\\| *<" from)))
  266.           (concat (if stop-pos (substring from 0 stop-pos) from)
  267.               "'s message of "
  268.               date))
  269.         nil
  270.        buffer))))
  271.  
  272. ;@@ the guts of news-reply and news-post-news should be combined. -tower
  273. (defun news-reply ()
  274.   "Compose and post a reply (aka a followup) to the current article on USENET.
  275. While composing the followup, use \\[news-reply-yank-original] to yank the
  276. original message into it."
  277.   (interactive)
  278.   (if (y-or-n-p "Are you sure you want to followup to all of USENET? ")
  279.       (let (from cc subject date to followup-to newsgroups message-of
  280.          references distribution message-id
  281.          (buffer (current-buffer)))
  282.     (save-restriction
  283.       (and (not (= 0 (buffer-size))) ;@@real problem is non-existence of
  284.                     ;@@    of article file
  285.            (equal major-mode 'news-mode) ;@@ if rmail-mode,
  286.                     ;@@    should show full headers
  287.            (progn
  288.          (news-show-all-headers) ;@@ should save/restore header state,
  289.                     ;@@    but rnews.el lacks support
  290.          (narrow-to-region (point-min) (progn (goto-char (point-min))
  291.                               (search-forward "\n\n")
  292.                               (- (point) 1)))))
  293.       (setq from (mail-fetch-field "from")
  294.         news-reply-yank-from from
  295.         ;; @@ not handling old Title: field
  296.         subject (mail-fetch-field "subject")
  297.         date (mail-fetch-field "date")
  298.         followup-to (mail-fetch-field "followup-to")
  299.         newsgroups (or followup-to
  300.                    (mail-fetch-field "newsgroups"))
  301.         references (mail-fetch-field "references")
  302.         ;; @@ not handling old Article-I.D.: field
  303.         distribution (mail-fetch-field "distribution")
  304.         message-id (mail-fetch-field "message-id")
  305.         news-reply-yank-message-id message-id)
  306.       (pop-to-buffer "*post-news*")
  307.       (news-reply-mode)
  308.       (if (and (buffer-modified-p)
  309.            (not
  310.             (y-or-n-p "Unsent article being composed; erase it? ")))
  311.           ()
  312.         (progn
  313.           (erase-buffer)
  314.           (and subject
  315.            (progn (if (string-match "\\`Re: " subject)
  316.                   (while (string-match "\\`Re: " subject)
  317.                 (setq subject (substring subject 4))))
  318.               (setq subject (concat "Re: " subject))))
  319.           (and from
  320.            (progn
  321.              (let ((stop-pos
  322.                 (string-match "  *at \\|  *@ \\| *(\\| *<" from)))
  323.                (setq message-of
  324.                  (concat
  325.                   (if stop-pos (substring from 0 stop-pos) from)
  326.                   "'s message of "
  327.                   date)))))
  328.           (news-setup
  329.            nil
  330.            subject
  331.            message-of
  332.            newsgroups
  333.            buffer)
  334.           (if followup-to
  335.           (progn (news-reply-followup-to)
  336.              (insert followup-to)))
  337.           (if distribution
  338.           (progn
  339.             (mail-position-on-field "Distribution")
  340.             (insert distribution)))
  341.           (mail-position-on-field "References")
  342.           (if references
  343.           (insert references))
  344.           (if (and references message-id)
  345.           (insert " "))
  346.           (if message-id
  347.           (insert message-id))
  348.           (goto-char (point-max))))))
  349.     (message "")))
  350.  
  351. ;@@ the guts of news-reply and news-post-news should be combined. -tower
  352. (defun news-post-news ()
  353.   "Begin editing a new USENET news article to be posted.
  354. Type \\[describe-mode] once editing the article to get a list of commands."
  355.   (interactive)
  356.   (if (y-or-n-p "Are you sure you want to post to all of USENET? ")
  357.       (let ((buffer (current-buffer)))
  358.     (save-restriction
  359.       (and (not (= 0 (buffer-size))) ;@@real problem is non-existence of
  360.                     ;@@    of article file
  361.            (equal major-mode 'news-mode) ;@@ if rmail-mode,
  362.                     ;@@    should show full headers
  363.            (progn
  364.          (news-show-all-headers) ;@@ should save/restore header state,
  365.                     ;@@    but rnews.el lacks support
  366.          (narrow-to-region (point-min) (progn (goto-char (point-min))
  367.                               (search-forward "\n\n")
  368.                               (- (point) 1)))))
  369.       (setq news-reply-yank-from (mail-fetch-field "from")
  370.         ;; @@ not handling old Article-I.D.: field
  371.         news-reply-yank-message-id (mail-fetch-field "message-id")))
  372.     (pop-to-buffer "*post-news*")
  373.     (news-reply-mode)
  374.     (if (and (buffer-modified-p)
  375.          (not (y-or-n-p "Unsent article being composed; erase it? ")))
  376.         ()                ;@@ not saving point from last time
  377.       (progn (erase-buffer)
  378.          (news-setup () () () () buffer))))
  379.   (message "")))
  380.  
  381. (defun news-mail-other-window ()
  382.   "Send mail in another window.
  383. While composing the message, use \\[news-reply-yank-original] to yank the
  384. original message into it."
  385.   (interactive)
  386.   (mail-other-window nil nil nil nil nil (current-buffer)))
  387.