home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.006 / xemacs-1 / lib / xemacs-19.13 / lisp / packages / rnewspost.el < prev    next >
Encoding:
Text File  |  1995-03-25  |  17.5 KB  |  467 lines
  1. ;;; rnewspost.el --- USENET news poster/mailer for GNU Emacs
  2. ;; Keywords: mail, news
  3.  
  4. ;; Copyright (C) 1985, 1993, 1994 Free Software Foundation, Inc.
  5.  
  6. ;; This file is part of XEmacs.
  7.  
  8. ;; XEmacs is free software; you can redistribute it and/or modify it
  9. ;; under the terms of the GNU General Public License as published by
  10. ;; the Free Software Foundation; either version 2, or (at your option)
  11. ;; any later version.
  12.  
  13. ;; XEmacs is distributed in the hope that it will be useful, but
  14. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  15. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  16. ;; General Public License for more details.
  17.  
  18. ;; You should have received a copy of the GNU General Public License
  19. ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  20. ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  21.  
  22. ;; moved posting and mail code from rnews.el
  23. ;;    tower@prep.ai.mit.edu Wed Oct 29 1986
  24. ;; brought posting code almost up to the revision of RFC 850 for News 2.11
  25. ;; - couldn't see handling the special meaning of the Keyword: poster
  26. ;; - not worth the code space to support the old A news Title: (which
  27. ;;   Subject: replaced) and Article-I.D.: (which Message-ID: replaced)
  28. ;;    tower@prep Nov 86
  29. ;; changed C-c C-r key-binding due to rename of news-caesar-buffer-body
  30. ;;    tower@prep 21 Nov 86
  31. ;; added (require 'rnews)    tower@prep 22 Apr 87
  32. ;; restricted call of news-show-all-headers in news-post-news & news-reply
  33. ;;    tower@prep 28 Apr 87
  34. ;; commented out Posting-Front-End to save USENET bytes tower@prep Jul 31 87
  35. ;; commented out -n and -t args in news-inews     tower@prep 15 Oct 87
  36. (require 'sendmail)
  37. (require 'rnews)
  38.  
  39. ;Now in paths.el.
  40. ;(defvar news-inews-program "inews"
  41. ;  "Function to post news.")
  42.  
  43. ;; Replying and posting news items are done by these functions.
  44. ;; imported from rmail and modified to work with rnews ...
  45. ;; Mon Mar 25,1985 at 03:07:04 ads@mit-hermes.
  46. ;; this is done so that rnews can operate independently from rmail.el and
  47. ;; sendmail and dosen't have to autoload these functions.
  48. ;;
  49. ;;; >> Nuked by Mly to autoload those functions again, as the duplication of
  50. ;;; >>  code was making maintenance too difficult.
  51.  
  52. (defvar news-reply-mode-map () "Mode map used by news-reply.")
  53.  
  54. (or news-reply-mode-map
  55.     (progn
  56.       (setq news-reply-mode-map (make-keymap))
  57.       (define-key news-reply-mode-map "\C-c?" 'describe-mode)
  58.       (define-key news-reply-mode-map "\C-c\C-f\C-d" 'news-reply-distribution)
  59.       (define-key news-reply-mode-map "\C-c\C-f\C-k" 'news-reply-keywords)
  60.       (define-key news-reply-mode-map "\C-c\C-f\C-n" 'news-reply-newsgroups)
  61.       (define-key news-reply-mode-map "\C-c\C-f\C-f" 'news-reply-followup-to)
  62.       (define-key news-reply-mode-map "\C-c\C-f\C-s" 'mail-subject)
  63.       (define-key news-reply-mode-map "\C-c\C-f\C-a" 'news-reply-summary)
  64.       (define-key news-reply-mode-map "\C-c\C-r" 'news-caesar-buffer-body)
  65.       (define-key news-reply-mode-map "\C-c\C-w" 'news-reply-signature)
  66.       (define-key news-reply-mode-map "\C-c\C-y" 'news-reply-yank-original)
  67.       (define-key news-reply-mode-map "\C-c\C-q" 'mail-fill-yanked-message)
  68.       (define-key news-reply-mode-map "\C-c\C-c" 'news-inews)
  69.       (define-key news-reply-mode-map "\C-c\C-s" 'news-inews)
  70.       (define-key news-reply-mode-map 'button3 'news-reply-menu)))
  71.  
  72. (defun news-reply-mode ()
  73.   "Major mode for editing news to be posted on USENET.
  74. First-time posters are asked to please read the articles in newsgroup:
  75.                                                      news.announce.newusers .
  76. Like Text Mode but with these additional commands:
  77.  
  78. C-c C-s  news-inews (post the message)    C-c C-c  news-inews
  79. C-c C-f     move to a header field (and create it if there isn't):
  80.      C-c C-f C-n  move to Newsgroups:    C-c C-f C-s  move to Subj:
  81.      C-c C-f C-f  move to Followup-To:      C-c C-f C-k  move to Keywords:
  82.      C-c C-f C-d  move to Distribution:    C-c C-f C-a  move to Summary:
  83. C-c C-y  news-reply-yank-original (insert current message, in NEWS).
  84. C-c C-q  mail-fill-yanked-message (fill what was yanked).
  85. C-c C-r  caesar rotate all letters by 13 places in the article's body (rot13)."
  86.   (interactive)
  87.   ;; require...
  88.   (or (fboundp 'mail-setup) (load "sendmail"))
  89.   (kill-all-local-variables)
  90.   (make-local-variable 'mail-reply-buffer)
  91.   (setq mail-reply-buffer nil)
  92.   (set-syntax-table text-mode-syntax-table)
  93.   (use-local-map news-reply-mode-map)
  94.   (setq local-abbrev-table text-mode-abbrev-table)
  95.   (setq major-mode 'news-reply-mode)
  96.   (setq mode-name "News")
  97.   (make-local-variable 'paragraph-separate)
  98.   (make-local-variable 'paragraph-start)
  99.   (setq paragraph-start (concat "^" mail-header-separator "$\\|"
  100.                 paragraph-start))
  101.   (setq paragraph-separate (concat "^" mail-header-separator "$\\|"
  102.                    paragraph-separate))
  103.   (run-hooks 'text-mode-hook 'news-reply-mode-hook))
  104.  
  105. (defvar news-reply-yank-from ""
  106.   "Save From: field for news-reply-yank-original.")
  107.  
  108. (defvar news-reply-yank-message-id ""
  109.   "Save Message-Id: field for news-reply-yank-original.")
  110.  
  111. (defun news-reply-yank-original (arg)
  112.   "Insert the message being replied to, if any (in postnews).
  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.   (let ((zmacs-regions nil))
  119.     (mail-yank-original arg)
  120.     (exchange-point-and-mark)
  121.     (run-hooks 'news-reply-header-hook)))
  122.  
  123. (defvar news-reply-header-hook
  124.   '(lambda ()
  125.      (insert "In article " news-reply-yank-message-id
  126.              " " news-reply-yank-from " writes:\n\n"))
  127.   "Hook for inserting a header at the top of a yanked message.")
  128.  
  129. (defun news-reply-newsgroups ()
  130.   "Move point to end of Newsgroups: field.
  131. RFC 850 constrains the Newsgroups: field to be a comma separated list of valid
  132. newsgroups names at your site:
  133. Newsgroups: news.misc,comp.misc,rec.misc"
  134.   (interactive)
  135.   (expand-abbrev)
  136.   (goto-char (point-min))
  137.   (mail-position-on-field "Newsgroups"))
  138.  
  139. (defun news-reply-followup-to ()
  140.   "Move point to end of Followup-To: field.  Create the field if none.
  141. One usually requests followups to only one newsgroup.
  142. RFC 850 constrains the Followup-To: field to be a comma separated list of valid
  143. newsgroups names at your site, that are also in the Newsgroups: field:
  144. Newsgroups: news.misc,comp.misc,rec.misc,misc.misc,soc.misc
  145. Followup-To: news.misc,comp.misc,rec.misc"
  146.   (interactive)
  147.   (expand-abbrev)
  148.   (or (mail-position-on-field "Followup-To" t)
  149.       (progn (mail-position-on-field "newsgroups")
  150.          (insert "\nFollowup-To: ")))
  151.      ;; @@ could do a completing read based on the Newsgroups: field to
  152.      ;; @@ fill in the Followup-To: field
  153. )
  154.  
  155. (defun news-reply-distribution ()
  156.   "Move point to end of Distribution: optional field.
  157. Create the field if none.  Without this field the posting goes to all of
  158. USENET.  The field is used to restrict the posting to parts of USENET."
  159.   (interactive)
  160.   (expand-abbrev)
  161.   (mail-position-on-field "Distribution")
  162.   ;; @@could do a completing read based on the news library file:
  163.   ;; @@    ../distributions  to fill in the field.
  164.   )
  165.  
  166. (defun news-reply-keywords ()
  167.   "Move point to end of Keywords: optional field.  Create the field if none.
  168. Used as an aid to the news reader, it can contain a few, well selected keywords
  169. identifying the message."
  170.   (interactive)
  171.   (expand-abbrev)
  172.   (mail-position-on-field "Keywords"))
  173.  
  174. (defun news-reply-summary ()
  175.   "Move point to end of Summary: optional field.  Create the field if none.
  176. Used as an aid to the news reader, it can contain a succinct
  177. summary (abstract) of the message."
  178.   (interactive)
  179.   (expand-abbrev)
  180.   (mail-position-on-field "Summary"))
  181.  
  182. (defun news-reply-signature ()
  183.   "The inews program appends ~/.signature automatically."
  184.   (interactive)
  185.   (message "~/.signature will be appended automatically."))
  186.  
  187. (defun news-setup (to subject in-reply-to newsgroups replybuffer)
  188.   "Setup the news reply or posting buffer with the proper headers and in
  189. news-reply-mode."
  190.   (setq mail-reply-buffer replybuffer)
  191.   (let ((mail-setup-hook nil))
  192.     (if (null to)
  193.     ;; this hack is needed so that inews wont be confused by 
  194.     ;; the fcc: and bcc: fields
  195.     (let ((mail-self-blind nil)
  196.           (mail-archive-file-name nil))
  197.       (mail-setup to subject in-reply-to nil replybuffer nil)
  198.       (beginning-of-line)
  199.       ;;(kill-line 1) ; XEmacs fix to longstanding damned annoying bug
  200.       (delete-region (point) (progn (forward-line 1) (point)))
  201.       (goto-char (point-max)))
  202.       (mail-setup to subject in-reply-to nil replybuffer nil))
  203.     ;;;(mail-position-on-field "Posting-Front-End")
  204.     ;;;(insert (emacs-version))
  205.     (goto-char (point-max))
  206.     (if (let ((case-fold-search t))
  207.       (re-search-backward "^Subject:" (point-min) t))
  208.     (progn (beginning-of-line)
  209.            (insert "Newsgroups: " (or newsgroups "") "\n")
  210.            (if (not newsgroups)
  211.            (backward-char 1)
  212.          (goto-char (point-max)))))
  213.     (run-hooks 'news-setup-hook)))
  214.    
  215. (defun news-inews ()
  216.   "Send a news message using inews."
  217.   (interactive)
  218.   (let* ((case-fold-search nil)
  219.      ;;newsgroups subject
  220.      )
  221.     (save-excursion
  222.       (save-restriction
  223.     (goto-char (point-min))
  224.     (search-forward (concat "\n" mail-header-separator "\n"))
  225.     (narrow-to-region (point-min) (point))
  226.     ;;(setq newsgroups (mail-fetch-field "newsgroups")
  227.     ;;      subject (mail-fetch-field "subject"))
  228.     )
  229.       (widen)
  230.       (goto-char (point-min))
  231.       (run-hooks 'news-inews-hook)
  232.       (goto-char (point-min))
  233.       (search-forward (concat "\n" mail-header-separator "\n"))
  234.       (replace-match "\n\n")
  235.       (goto-char (point-max))
  236.       ;; require a newline at the end for inews to append .signature to
  237.       (or (= (preceding-char) ?\n)
  238.       (insert ?\n))
  239.       (message "Posting to USENET...")
  240.       (call-process-region (point-min) (point-max) 
  241.                news-inews-program nil 0 nil
  242.                "-h")    ; take all header lines!
  243.                ;@@ setting of subject and newsgroups still needed?
  244.                ;"-t" subject
  245.                ;"-n" newsgroups
  246.       (message "Posting to USENET... done")
  247.       (goto-char (point-min))        ;restore internal header separator
  248.       (search-forward "\n\n")
  249.       (replace-match (concat "\n" mail-header-separator "\n"))
  250.       (set-buffer-modified-p nil))
  251.     (and (fboundp 'bury-buffer) (bury-buffer))))
  252.  
  253. (defvar news-reply-subject-prefix nil
  254.   "*The prefix to use when replying to a news message (such as \"Re:\").")
  255.  
  256. ;@@ shares some code with news-reply and news-post-news
  257. (defun news-mail-reply ()
  258.   "Mail a reply to the author of the current article.
  259. While composing the reply, use \\[news-reply-yank-original] to yank the
  260. original message into it."
  261.   (interactive)
  262.   (let (from subject date to reply-to references message-id ;;b
  263.     (buffer (current-buffer)))
  264.     (save-restriction
  265.       (widen)
  266.       (narrow-to-region (point-min) (progn (goto-char (point-min))
  267.                        (search-forward "\n\n")
  268.                        (- (point) 1)))
  269.       (setq from (mail-fetch-field "from")
  270.         subject (mail-fetch-field "subject")
  271.         reply-to (mail-fetch-field "reply-to")
  272.         date (mail-fetch-field "date")
  273.         references (mail-fetch-field "references")
  274.         message-id (mail-fetch-field "message-id"))
  275.       (if (and news-reply-subject-prefix subject
  276.        (not (string-match
  277.          (concat "^[ \t]*" (regexp-quote news-reply-subject-prefix)
  278.              "[ )t]*")
  279.          subject)))
  280.       (setq subject (concat news-reply-subject-prefix " " subject)))
  281.       (setq to from)
  282.       (pop-to-buffer "*mail*")
  283. ;;      (setq b (current-buffer))
  284.       (if (mail nil (if reply-to reply-to to) subject
  285.         (let ((stop-pos
  286.                (string-match "  *at \\|  *@ \\| *(\\| *<" from)))
  287.           (concat (if stop-pos (substring from 0 stop-pos) from)
  288.               "'s message of "
  289.               date))
  290.         nil
  291.         buffer)
  292.       (save-excursion
  293. ;;        (set-buffer b)
  294.         (mail-position-on-field "References")
  295.         (if references (insert references))
  296.         (if (and references message-id) (insert " "))
  297.         (if message-id (insert message-id)))))))
  298.  
  299. ;@@ the guts of news-reply and news-post-news should be combined. -tower
  300. (defun news-reply ()
  301.   "Compose and post a reply (aka a followup) to the current article on USENET.
  302. While composing the followup, use \\[news-reply-yank-original] to yank the
  303. original message into it."
  304.   (interactive)
  305.   (if (y-or-n-p "Are you sure you want to followup to all of USENET? ")
  306.       (let (from subject date followup-to newsgroups message-of
  307.         references distribution message-id
  308.         (buffer (current-buffer)))
  309.     (save-restriction
  310.       (and (not (= 0 (buffer-size))) ;@@real problem is non-existence of
  311.                     ;@@    of article file
  312.            (equal major-mode 'news-mode) ;@@ if rmail-mode,
  313.                     ;@@    should show full headers
  314.            (progn
  315.          (news-show-all-headers) ;@@ should save/restore header state,
  316.                     ;@@    but rnews.el lacks support
  317.          (narrow-to-region (point-min) (progn (goto-char (point-min))
  318.                               (search-forward "\n\n")
  319.                               (- (point) 1)))))
  320.       (setq from (mail-fetch-field "from")
  321.         news-reply-yank-from from
  322.         ;; @@ not handling old Title: field
  323.         subject (mail-fetch-field "subject")
  324.         date (mail-fetch-field "date")
  325.         followup-to (mail-fetch-field "followup-to")
  326.         newsgroups (or followup-to
  327.                    (mail-fetch-field "newsgroups"))
  328.         references (mail-fetch-field "references")
  329.         ;; @@ not handling old Article-I.D.: field
  330.         distribution (mail-fetch-field "distribution")
  331.         message-id (mail-fetch-field "message-id")
  332.         news-reply-yank-message-id message-id)
  333.       (pop-to-buffer "*post-news*")
  334.       (news-reply-mode)
  335.       (if (and (buffer-modified-p)
  336.            (not
  337.             (y-or-n-p "Unsent article being composed; erase it? ")))
  338.           ()
  339.         (progn
  340.           (erase-buffer)
  341.           (and subject
  342.            (progn (if (string-match "\\`Re: " subject)
  343.                   (while (string-match "\\`Re: " subject)
  344.                 (setq subject (substring subject 4))))
  345.               (setq subject (concat "Re: " subject))))
  346.           (and from
  347.            (progn
  348.              (let ((stop-pos
  349.                 (string-match "  *at \\|  *@ \\| *(\\| *<" from)))
  350.                (setq message-of
  351.                  (concat
  352.                   (if stop-pos (substring from 0 stop-pos) from)
  353.                   "'s message of "
  354.                   date)))))
  355.           (news-setup
  356.            nil
  357.            subject
  358.            message-of
  359.            newsgroups
  360.            buffer)
  361.           (if followup-to
  362.           (progn (news-reply-followup-to)
  363.              (insert followup-to)))
  364.           (if distribution
  365.           (progn
  366.             (mail-position-on-field "Distribution")
  367.             (insert distribution)))
  368.           (mail-position-on-field "References")
  369.           (if references
  370.           (insert references))
  371.           (if (and references message-id)
  372.           (insert " "))
  373.           (if message-id
  374.           (insert message-id))
  375.           (goto-char (point-max))))))
  376.     (message "")))
  377.  
  378. ;@@ the guts of news-reply and news-post-news should be combined. -tower
  379. (defun news-post-news ()
  380.   "Begin editing a new USENET news article to be posted.
  381. Type \\[describe-mode] once editing the article to get a list of commands."
  382.   (interactive)
  383.   (if (y-or-n-p "Are you sure you want to post to all of USENET? ")
  384.       (let ((buffer (current-buffer)))
  385.     (save-restriction
  386.       (and (not (= 0 (buffer-size))) ;@@real problem is non-existence of
  387.                     ;@@    of article file
  388.            (equal major-mode 'news-mode) ;@@ if rmail-mode,
  389.                     ;@@    should show full headers
  390.            (progn
  391.          (news-show-all-headers) ;@@ should save/restore header state,
  392.                     ;@@    but rnews.el lacks support
  393.          (narrow-to-region (point-min) (progn (goto-char (point-min))
  394.                               (search-forward "\n\n")
  395.                               (- (point) 1)))))
  396.       (setq news-reply-yank-from (mail-fetch-field "from")
  397.         ;; @@ not handling old Article-I.D.: field
  398.         news-reply-yank-message-id (mail-fetch-field "message-id")))
  399.     (pop-to-buffer "*post-news*")
  400.     (news-reply-mode)
  401.     (if (and (buffer-modified-p)
  402.          (not (y-or-n-p "Unsent article being composed; erase it? ")))
  403.         ()                ;@@ not saving point from last time
  404.       (progn (erase-buffer)
  405.          (news-setup () () () () buffer))))
  406.   (message "")))
  407.  
  408. (defun news-mail-other-window ()
  409.   "Send mail in another window.
  410. While composing the message, use \\[news-reply-yank-original] to yank the
  411. original message into it."
  412.   (interactive)
  413.   (mail-other-window nil nil nil nil nil (current-buffer)))
  414.  
  415.  
  416. ;; menus
  417.  
  418. (defconst news-reply-menu
  419.   '("Post News"
  420.     "Go to Field:"
  421.     "----"
  422.     ["Subject:"            mail-subject         t]
  423.     ["Summary:"            news-reply-summary     t]
  424.     ["Keywords:"        news-reply-keywords     t]
  425.     ["Newsgroups:"        news-reply-newsgroups     t]
  426.     ["Followup-To:"        news-reply-followup-to     t]
  427.     ["Distribution:"        news-reply-distribution     t]
  428.     ["Text" (let ((mail-header-separator "")) (mail-text)) t]
  429.     "----"
  430.     "Miscellaneous Commands:"
  431.     "----"
  432.     ["Yank Original"        news-reply-yank-original t]
  433.     ["Fill Yanked Message"    mail-fill-yanked-message t]
  434. ;;  ["Insert Signature"        news-reply-signature     t]
  435.     ["Caesar (rot13) Message"    news-caesar-buffer-body     t]
  436.     "----"
  437.     ["Post Message"        news-inews         t]
  438.     ))
  439.  
  440. (defun news-reply-menu (event)
  441.   (interactive "e")
  442.   (select-window (event-window event))
  443.   (let (yank sig fill rot (rest news-reply-menu))
  444.     (while rest
  445.       (if (vectorp (car rest))
  446.       (cond ((eq (aref (car rest) 1) 'news-reply-yank-original)
  447.          (setq yank (car rest)))
  448.         ((eq (aref (car rest) 1) 'news-reply-signature)
  449.          (setq sig (car rest)))
  450.         ((eq (aref (car rest) 1) 'mail-fill-yanked-message)
  451.          (setq fill (car rest)))
  452.         ((eq (aref (car rest) 1) 'news-caesar-buffer-body)
  453.          (setq rot (car rest)))))
  454.       (setq rest (cdr rest)))
  455.     (if yank (aset yank 2 (not (null mail-reply-buffer))))
  456.     (if sig (aset sig 2 (and (stringp mail-signature-file)
  457.                  (file-exists-p mail-signature-file))))
  458.     (let ((body-p (save-excursion
  459.             (goto-char (point-min))
  460.             (and (search-forward (concat "\n" mail-header-separator
  461.                          "\n") nil t)
  462.              (not (looking-at "[ \t\n]*\\'"))))))
  463.       (if fill (aset fill 2 body-p))
  464.       (if rot (aset rot 2 body-p))))
  465.   (let ((popup-menu-titles nil))
  466.     (popup-menu 'news-reply-menu)))
  467.