Annotation of 43BSDReno/contrib/emacs-18.55/lisp/rnewspost.el, revision 1.1

1.1     ! root        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: ;;     [email protected] 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) 2)))
        !           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) 2)))))
        !           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) 2)))))
        !           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)))

unix.superglobalmegacorp.com

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.