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