* lisp/obsolete/rnews.el, lisp/obsolete/rnewspost.el: Remove files.
This commit is contained in:
Glenn Morris
parent
61e42a9cb6
commit
726c535717
3 changed files with 4 additions and 1428 deletions
|
|
@ -1,981 +0,0 @@
|
|||
;;; rnews.el --- USENET news reader for GNU Emacs
|
||||
|
||||
;; Copyright (C) 1985, 1986, 1987, 2001, 2002, 2003, 2004,
|
||||
;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
|
||||
|
||||
;; Maintainer: FSF
|
||||
;; Keywords: news
|
||||
|
||||
;; This file is part of GNU Emacs.
|
||||
|
||||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; This file has been obsolete since Emacs 21.1.
|
||||
|
||||
;;; Change Log:
|
||||
|
||||
;; Created Sun Mar 10,1985 at 21:35:01 ads and sundar@hernes.ai.mit.edu
|
||||
;; Should do the point pdl stuff sometime
|
||||
;; finito except pdl.... Sat Mar 16,1985 at 06:43:44
|
||||
;; lets keep the summary stuff out until we get it working ..
|
||||
;; sundar@hermes.ai.mit.edu Wed Apr 10,1985 at 16:32:06
|
||||
;; hack slash maim. mly@gnu.org Thu 18 Apr, 1985 06:11:14
|
||||
;; modified to correct reentrance bug, to not bother with groups that
|
||||
;; received no new traffic since last read completely, to find out
|
||||
;; what traffic a group has available much more quickly when
|
||||
;; possible, to do some completing reads for group names - should
|
||||
;; be much faster...
|
||||
;; KING@KESTREL.arpa, Thu Mar 13 09:03:28 1986
|
||||
;; made news-{next,previous}-group skip groups with no new messages; and
|
||||
;; added checking for unsubscribed groups to news-add-news-group
|
||||
;; tower@gnu.org Jul 18 1986
|
||||
;; bound rmail-output to C-o; and changed header-field commands binding to
|
||||
;; agree with the new C-c C-f usage in sendmail
|
||||
;; tower@gnu.org Sep 3 1986
|
||||
;; added news-rotate-buffer-body
|
||||
;; tower@gnu.org Oct 17 1986
|
||||
;; made messages more user friendly, cleaned up news-inews
|
||||
;; move posting and mail code to new file rnewpost.el
|
||||
;; tower@gnu.org Oct 29 1986
|
||||
;; added caesar-region, rename news-caesar-buffer-body, hacked accordingly
|
||||
;; tower@gnu.org Nov 21 1986
|
||||
;; added tower@gnu.org 22 Apr 87
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'mail-utils)
|
||||
(require 'sendmail)
|
||||
|
||||
(defvar caesar-translate-table)
|
||||
(defvar minor-modes)
|
||||
(defvar news-buffer-save)
|
||||
(defvar news-group-name)
|
||||
(defvar news-minor-modes)
|
||||
|
||||
(autoload 'rmail-output "rmailout"
|
||||
"Append this message to Unix mail file named FILE-NAME."
|
||||
t)
|
||||
|
||||
(autoload 'news-reply "rnewspost"
|
||||
"Compose and post a reply to the current article on USENET.
|
||||
While composing the reply, use \\[mail-yank-original] to yank the original
|
||||
message into it."
|
||||
t)
|
||||
|
||||
(autoload 'news-mail-other-window "rnewspost"
|
||||
"Send mail in another window.
|
||||
While composing the message, use \\[mail-yank-original] to yank the
|
||||
original message into it."
|
||||
t)
|
||||
|
||||
(autoload 'news-post-news "rnewspost"
|
||||
"Begin editing a new USENET news article to be posted."
|
||||
t)
|
||||
|
||||
(autoload 'news-mail-reply "rnewspost"
|
||||
"Mail a reply to the author of the current article.
|
||||
While composing the reply, use \\[mail-yank-original] to yank the original
|
||||
message into it."
|
||||
t)
|
||||
|
||||
(defvar news-group-hook-alist nil
|
||||
"Alist of (GROUP-REGEXP . HOOK) pairs.
|
||||
Just before displaying a message, each HOOK is called
|
||||
if its GROUP-REGEXP matches the current newsgroup name.")
|
||||
|
||||
(defvar rmail-last-file (expand-file-name "~/mbox.news"))
|
||||
|
||||
;Now in paths.el.
|
||||
;(defvar news-path "/usr/spool/news/"
|
||||
; "The root directory below which all news files are stored.")
|
||||
|
||||
(defvar news-startup-file "$HOME/.newsrc" "Contains ~/.newsrc")
|
||||
(defvar news-certification-file "$HOME/.news-dates" "Contains ~/.news-dates")
|
||||
|
||||
;; random headers that we decide to ignore.
|
||||
(defvar news-ignored-headers
|
||||
"^Path:\\|^Posting-Version:\\|^Article-I.D.:\\|^Expires:\\|^Date-Received:\\|^References:\\|^Control:\\|^Xref:\\|^Lines:\\|^Posted:\\|^Relay-Version:\\|^Message-ID:\\|^Nf-ID:\\|^Nf-From:\\|^Approved:\\|^Sender:"
|
||||
"All random fields within the header of a message.")
|
||||
|
||||
(defvar news-mode-map nil)
|
||||
(defvar news-read-first-time-p t)
|
||||
;; Contains the (dotified) news groups of which you are a member.
|
||||
(defvar news-user-group-list nil)
|
||||
|
||||
(defvar news-current-news-group nil)
|
||||
(defvar news-current-group-begin nil)
|
||||
(defvar news-current-group-end nil)
|
||||
(defvar news-current-certifications nil
|
||||
"An assoc list of a group name and the time at which it is
|
||||
known that the group had no new traffic")
|
||||
(defvar news-current-certifiable nil
|
||||
"The time when the directory we are now working on was written")
|
||||
|
||||
(defvar news-message-filter nil
|
||||
"User specifiable filter function that will be called during
|
||||
formatting of the news file")
|
||||
|
||||
;(defvar news-mode-group-string "Starting-Up"
|
||||
; "Mode line group name info is held in this variable")
|
||||
(defvar news-list-of-files nil
|
||||
"Global variable in which we store the list of files
|
||||
associated with the current newsgroup")
|
||||
(defvar news-list-of-files-possibly-bogus nil
|
||||
"variable indicating we only are guessing at which files are available.
|
||||
Not currently used.")
|
||||
|
||||
;; association list in which we store lists of the form
|
||||
;; (pointified-group-name (first last old-last))
|
||||
(defvar news-group-article-assoc nil)
|
||||
|
||||
(defvar news-current-message-number 0 "Displayed Article Number")
|
||||
(defvar news-total-current-group 0 "Total no of messages in group")
|
||||
|
||||
(defvar news-unsubscribe-groups ())
|
||||
(defvar news-point-pdl () "List of visited news messages.")
|
||||
(defvar news-no-jumps-p t)
|
||||
(defvar news-buffer () "Buffer into which news files are read.")
|
||||
|
||||
(defmacro news-push (item ref)
|
||||
(list 'setq ref (list 'cons item ref)))
|
||||
|
||||
(defmacro news-cadr (x) (list 'car (list 'cdr x)))
|
||||
(defmacro news-cdar (x) (list 'cdr (list 'car x)))
|
||||
(defmacro news-caddr (x) (list 'car (list 'cdr (list 'cdr x))))
|
||||
(defmacro news-cadar (x) (list 'car (list 'cdr (list 'car x))))
|
||||
(defmacro news-caadr (x) (list 'car (list 'car (list 'cdr x))))
|
||||
(defmacro news-cdadr (x) (list 'cdr (list 'car (list 'cdr x))))
|
||||
|
||||
(defmacro news-wins (pfx index)
|
||||
`(file-exists-p (concat ,pfx "/" (int-to-string ,index))))
|
||||
|
||||
(defvar news-max-plausible-gap 2
|
||||
"* In an rnews directory, the maximum possible gap size.
|
||||
A gap is a sequence of missing messages between two messages that exist.
|
||||
An empty file does not contribute to a gap -- it ends one.")
|
||||
|
||||
(defun news-find-first-and-last (prefix base)
|
||||
(and (news-wins prefix base)
|
||||
(cons (news-find-first-or-last prefix base -1)
|
||||
(news-find-first-or-last prefix base 1))))
|
||||
|
||||
(defmacro news-/ (a1 a2)
|
||||
;; a form of / that guarantees that (/ -1 2) = 0
|
||||
(if (zerop (/ -1 2))
|
||||
`(/ ,a1 ,a2)
|
||||
`(if (< ,a1 0)
|
||||
(- (/ (- ,a1) ,a2))
|
||||
(/ ,a1 ,a2))))
|
||||
|
||||
(defun news-find-first-or-last (pfx base dirn)
|
||||
;; first use powers of two to find a plausible ceiling
|
||||
(let ((original-dir dirn))
|
||||
(while (news-wins pfx (+ base dirn))
|
||||
(setq dirn (* dirn 2)))
|
||||
(setq dirn (news-/ dirn 2))
|
||||
;; Then use a binary search to find the high water mark
|
||||
(let ((offset (news-/ dirn 2)))
|
||||
(while (/= offset 0)
|
||||
(if (news-wins pfx (+ base dirn offset))
|
||||
(setq dirn (+ dirn offset)))
|
||||
(setq offset (news-/ offset 2))))
|
||||
;; If this high-water mark is bogus, recurse.
|
||||
(let ((offset (* news-max-plausible-gap original-dir)))
|
||||
(while (and (/= offset 0) (not (news-wins pfx (+ base dirn offset))))
|
||||
(setq offset (- offset original-dir)))
|
||||
(if (= offset 0)
|
||||
(+ base dirn)
|
||||
(news-find-first-or-last pfx (+ base dirn offset) original-dir)))))
|
||||
|
||||
(defun rnews ()
|
||||
"Read USENET news for groups for which you are a member and add or
|
||||
delete groups.
|
||||
You can reply to articles posted and send articles to any group.
|
||||
|
||||
Type \\[describe-mode] once reading news to get a list of rnews commands."
|
||||
(interactive)
|
||||
(let ((last-buffer (buffer-name)))
|
||||
(make-local-variable 'rmail-last-file)
|
||||
(switch-to-buffer (setq news-buffer (get-buffer-create "*news*")))
|
||||
(news-mode)
|
||||
(setq news-buffer-save last-buffer)
|
||||
(setq buffer-read-only nil)
|
||||
(erase-buffer)
|
||||
(setq buffer-read-only t)
|
||||
(set-buffer-modified-p t)
|
||||
(sit-for 0)
|
||||
(message "Getting new USENET news...")
|
||||
(news-set-mode-line)
|
||||
(news-get-certifications)
|
||||
(news-get-new-news)))
|
||||
|
||||
(defun news-group-certification (group)
|
||||
(cdr-safe (assoc group news-current-certifications)))
|
||||
|
||||
|
||||
(defun news-set-current-certifiable ()
|
||||
;; Record the date that corresponds to the directory you are about to check
|
||||
(let ((file (concat news-path
|
||||
(string-subst-char ?/ ?. news-current-news-group))))
|
||||
(setq news-current-certifiable
|
||||
(nth 5 (file-attributes
|
||||
(or (file-symlink-p file) file))))))
|
||||
|
||||
(defun news-get-certifications ()
|
||||
;; Read the certified-read file from last session
|
||||
(save-excursion
|
||||
(save-window-excursion
|
||||
(setq news-current-certifications
|
||||
(car-safe
|
||||
(condition-case var
|
||||
(let*
|
||||
((file (substitute-in-file-name news-certification-file))
|
||||
(buf (find-file-noselect file)))
|
||||
(and (file-exists-p file)
|
||||
(progn
|
||||
(switch-to-buffer buf 'norecord)
|
||||
(unwind-protect
|
||||
(read-from-string (buffer-string))
|
||||
(kill-buffer buf)))))
|
||||
(error nil)))))))
|
||||
|
||||
(defun news-write-certifications ()
|
||||
;; Write a certification file.
|
||||
;; This is an assoc list of group names with doubletons that represent
|
||||
;; mod times of the directory when group is read completely.
|
||||
(save-excursion
|
||||
(save-window-excursion
|
||||
(with-output-to-temp-buffer
|
||||
"*CeRtIfIcAtIoNs*"
|
||||
(print news-current-certifications))
|
||||
(let ((buf (get-buffer "*CeRtIfIcAtIoNs*")))
|
||||
(switch-to-buffer buf)
|
||||
(write-file (substitute-in-file-name news-certification-file))
|
||||
(kill-buffer buf)))))
|
||||
|
||||
(defun news-set-current-group-certification ()
|
||||
(let ((cgc (assoc news-current-news-group news-current-certifications)))
|
||||
(if cgc (setcdr cgc news-current-certifiable)
|
||||
(news-push (cons news-current-news-group news-current-certifiable)
|
||||
news-current-certifications))))
|
||||
|
||||
(defun news-set-message-counters ()
|
||||
"Scan through current news-groups filelist to figure out how many messages
|
||||
are there. Set counters for use with minor mode display."
|
||||
(if (null news-list-of-files)
|
||||
(setq news-current-message-number 0)))
|
||||
|
||||
(if news-mode-map
|
||||
nil
|
||||
(setq news-mode-map (make-keymap))
|
||||
(suppress-keymap news-mode-map)
|
||||
(define-key news-mode-map "." 'beginning-of-buffer)
|
||||
(define-key news-mode-map " " 'scroll-up)
|
||||
(define-key news-mode-map "\177" 'scroll-down)
|
||||
(define-key news-mode-map "n" 'news-next-message)
|
||||
(define-key news-mode-map "c" 'news-make-link-to-message)
|
||||
(define-key news-mode-map "p" 'news-previous-message)
|
||||
(define-key news-mode-map "j" 'news-goto-message)
|
||||
(define-key news-mode-map "q" 'news-exit)
|
||||
(define-key news-mode-map "e" 'news-exit)
|
||||
(define-key news-mode-map "\ej" 'news-goto-news-group)
|
||||
(define-key news-mode-map "\en" 'news-next-group)
|
||||
(define-key news-mode-map "\ep" 'news-previous-group)
|
||||
(define-key news-mode-map "l" 'news-list-news-groups)
|
||||
(define-key news-mode-map "?" 'describe-mode)
|
||||
(define-key news-mode-map "g" 'news-get-new-news)
|
||||
(define-key news-mode-map "f" 'news-reply)
|
||||
(define-key news-mode-map "m" 'news-mail-other-window)
|
||||
(define-key news-mode-map "a" 'news-post-news)
|
||||
(define-key news-mode-map "r" 'news-mail-reply)
|
||||
(define-key news-mode-map "o" 'news-save-item-in-file)
|
||||
(define-key news-mode-map "\C-o" 'rmail-output)
|
||||
(define-key news-mode-map "t" 'news-show-all-headers)
|
||||
(define-key news-mode-map "x" 'news-force-update)
|
||||
(define-key news-mode-map "A" 'news-add-news-group)
|
||||
(define-key news-mode-map "u" 'news-unsubscribe-current-group)
|
||||
(define-key news-mode-map "U" 'news-unsubscribe-group)
|
||||
(define-key news-mode-map "\C-c\C-r" 'news-caesar-buffer-body))
|
||||
|
||||
(defun news-mode ()
|
||||
"News Mode is used by M-x rnews for reading USENET Newsgroups articles.
|
||||
New readers can find additional help in newsgroup: news.announce.newusers .
|
||||
All normal editing commands are turned off.
|
||||
Instead, these commands are available:
|
||||
|
||||
. move point to front of this news article (same as Meta-<).
|
||||
Space scroll to next screen of this news article.
|
||||
Delete scroll down previous page of this news article.
|
||||
n move to next news article, possibly next group.
|
||||
p move to previous news article, possibly previous group.
|
||||
j jump to news article specified by numeric position.
|
||||
M-j jump to news group.
|
||||
M-n goto next news group.
|
||||
M-p goto previous news group.
|
||||
l list all the news groups with current status.
|
||||
? print this help message.
|
||||
C-c C-r caesar rotate all letters by 13 places in the article's body (rot13).
|
||||
g get new USENET news.
|
||||
f post a reply article to USENET.
|
||||
a post an original news article.
|
||||
A add a newsgroup.
|
||||
o save the current article in the named file (append if file exists).
|
||||
C-o output this message to a Unix-format mail file (append it).
|
||||
c \"copy\" (actually link) current or prefix-arg msg to file.
|
||||
warning: target directory and message file must be on same device
|
||||
(UNIX magic)
|
||||
t show all the headers this news article originally had.
|
||||
q quit reading news after updating .newsrc file.
|
||||
e exit updating .newsrc file.
|
||||
m mail a news article. Same as C-x 4 m.
|
||||
x update last message seen to be the current message.
|
||||
r mail a reply to this news article. Like m but initializes some fields.
|
||||
u unsubscribe from current newsgroup.
|
||||
U unsubscribe from specified newsgroup."
|
||||
(interactive)
|
||||
(kill-all-local-variables)
|
||||
(make-local-variable 'news-read-first-time-p)
|
||||
(setq news-read-first-time-p t)
|
||||
(make-local-variable 'news-current-news-group)
|
||||
; (setq news-current-news-group "??")
|
||||
(make-local-variable 'news-current-group-begin)
|
||||
(setq news-current-group-begin 0)
|
||||
(make-local-variable 'news-current-message-number)
|
||||
(setq news-current-message-number 0)
|
||||
(make-local-variable 'news-total-current-group)
|
||||
(make-local-variable 'news-buffer-save)
|
||||
(make-local-variable 'version-control)
|
||||
(setq version-control 'never)
|
||||
(make-local-variable 'news-point-pdl)
|
||||
; This breaks it. I don't have time to figure out why. -- RMS
|
||||
; (make-local-variable 'news-group-article-assoc)
|
||||
(setq major-mode 'news-mode)
|
||||
(setq mode-line-process '(news-minor-modes))
|
||||
(setq mode-name "NEWS")
|
||||
(news-set-mode-line)
|
||||
(set-syntax-table text-mode-syntax-table)
|
||||
(use-local-map news-mode-map)
|
||||
(setq local-abbrev-table text-mode-abbrev-table)
|
||||
(run-mode-hooks 'news-mode-hook))
|
||||
|
||||
(defun string-subst-char (new old string)
|
||||
(let (index)
|
||||
(setq old (regexp-quote (char-to-string old))
|
||||
string (substring string 0))
|
||||
(while (setq index (string-match old string))
|
||||
(aset string index new)))
|
||||
string)
|
||||
|
||||
;; update read message number
|
||||
(defmacro news-update-message-read (ngroup nno)
|
||||
(list 'setcar
|
||||
(list 'news-cdadr
|
||||
(list 'assoc ngroup 'news-group-article-assoc))
|
||||
nno))
|
||||
|
||||
(defun news-parse-range (number-string)
|
||||
"Parse string representing range of numbers of he form <a>-<b>
|
||||
to a list (a . b)"
|
||||
(let ((n (string-match "-" number-string)))
|
||||
(if n
|
||||
(cons (string-to-number (substring number-string 0 n))
|
||||
(string-to-number (substring number-string (1+ n))))
|
||||
(setq n (string-to-number number-string))
|
||||
(cons n n))))
|
||||
|
||||
;(defun is-in (elt lis)
|
||||
; (catch 'foo
|
||||
; (while lis
|
||||
; (if (equal (car lis) elt)
|
||||
; (throw 'foo t)
|
||||
; (setq lis (cdr lis))))))
|
||||
|
||||
(defun news-get-new-news ()
|
||||
"Get new USENET news, if there is any for the current user."
|
||||
(interactive)
|
||||
(if (not (null news-user-group-list))
|
||||
(news-update-newsrc-file))
|
||||
(setq news-group-article-assoc ())
|
||||
(setq news-user-group-list ())
|
||||
(message "Looking up %s file..." news-startup-file)
|
||||
(let ((file (substitute-in-file-name news-startup-file))
|
||||
(temp-user-groups ()))
|
||||
(save-excursion
|
||||
(let ((newsrcbuf (find-file-noselect file))
|
||||
start end endofline tem)
|
||||
(set-buffer newsrcbuf)
|
||||
(goto-char 0)
|
||||
(while (search-forward ": " nil t)
|
||||
(setq end (point))
|
||||
(beginning-of-line)
|
||||
(setq start (point))
|
||||
(end-of-line)
|
||||
(setq endofline (point))
|
||||
(setq tem (buffer-substring start (- end 2)))
|
||||
(let ((range (news-parse-range
|
||||
(buffer-substring end endofline))))
|
||||
(if (assoc tem news-group-article-assoc)
|
||||
(message "You are subscribed twice to %s; I ignore second"
|
||||
tem)
|
||||
(setq temp-user-groups (cons tem temp-user-groups)
|
||||
news-group-article-assoc
|
||||
(cons (list tem (list (car range)
|
||||
(cdr range)
|
||||
(cdr range)))
|
||||
news-group-article-assoc)))))
|
||||
(kill-buffer newsrcbuf)))
|
||||
(setq temp-user-groups (nreverse temp-user-groups))
|
||||
(message "Prefrobnicating...")
|
||||
(switch-to-buffer news-buffer)
|
||||
(setq news-user-group-list temp-user-groups)
|
||||
(while (and temp-user-groups
|
||||
(not (news-read-files-into-buffer
|
||||
(car temp-user-groups) nil)))
|
||||
(setq temp-user-groups (cdr temp-user-groups)))
|
||||
(if (null temp-user-groups)
|
||||
(message "No news is good news.")
|
||||
(message ""))))
|
||||
|
||||
(defun news-list-news-groups ()
|
||||
"Display all the news groups to which you belong."
|
||||
(interactive)
|
||||
(with-output-to-temp-buffer "*Newsgroups*"
|
||||
(with-current-buffer standard-output
|
||||
(insert
|
||||
"News Group Msg No. News Group Msg No.\n")
|
||||
(insert
|
||||
"------------------------- -------------------------\n")
|
||||
(let ((temp news-user-group-list)
|
||||
(flag nil))
|
||||
(while temp
|
||||
(let ((item (assoc (car temp) news-group-article-assoc)))
|
||||
(insert (car item))
|
||||
(indent-to (if flag 52 20))
|
||||
(insert (int-to-string (news-cadr (news-cadr item))))
|
||||
(if flag
|
||||
(insert "\n")
|
||||
(indent-to 33))
|
||||
(setq temp (cdr temp) flag (not flag))))))))
|
||||
|
||||
;; Mode line hack
|
||||
(defun news-set-mode-line ()
|
||||
"Set mode line string to something useful."
|
||||
(setq mode-line-process
|
||||
(concat " "
|
||||
(if (integerp news-current-message-number)
|
||||
(int-to-string news-current-message-number)
|
||||
"??")
|
||||
"/"
|
||||
(if (integerp news-current-group-end)
|
||||
(int-to-string news-current-group-end)
|
||||
news-current-group-end)))
|
||||
(setq mode-line-buffer-identification
|
||||
(concat "NEWS: "
|
||||
news-current-news-group
|
||||
;; Enough spaces to pad group name to 17 positions.
|
||||
(substring " "
|
||||
0 (max 0 (- 17 (length news-current-news-group))))))
|
||||
(set-buffer-modified-p t)
|
||||
(sit-for 0))
|
||||
|
||||
(defun news-goto-news-group (gp)
|
||||
"Takes a string and goes to that news group."
|
||||
(interactive (list (completing-read "NewsGroup: "
|
||||
news-group-article-assoc)))
|
||||
(message "Jumping to news group %s..." gp)
|
||||
(news-select-news-group gp)
|
||||
(message "Jumping to news group %s... done." gp))
|
||||
|
||||
(defun news-select-news-group (gp)
|
||||
(let ((grp (assoc gp news-group-article-assoc)))
|
||||
(if (null grp)
|
||||
(error "Group %s not subscribed to" gp)
|
||||
(progn
|
||||
(news-update-message-read news-current-news-group
|
||||
(news-cdar news-point-pdl))
|
||||
(news-read-files-into-buffer (car grp) nil)
|
||||
(news-set-mode-line)))))
|
||||
|
||||
(defun news-goto-message (arg)
|
||||
"Goes to the article ARG in current newsgroup."
|
||||
(interactive "p")
|
||||
(if (null current-prefix-arg)
|
||||
(setq arg (read-no-blanks-input "Go to article: " "")))
|
||||
(news-select-message arg))
|
||||
|
||||
(defun news-select-message (arg)
|
||||
(if (stringp arg) (setq arg (string-to-number arg)))
|
||||
(let ((file (concat news-path
|
||||
(string-subst-char ?/ ?. news-current-news-group)
|
||||
"/" arg)))
|
||||
(if (= arg
|
||||
(or (news-cadr (memq (news-cdar news-point-pdl) news-list-of-files))
|
||||
0))
|
||||
(setcdr (car news-point-pdl) arg))
|
||||
(setq news-current-message-number arg)
|
||||
(if (file-exists-p file)
|
||||
(let ((buffer-read-only nil))
|
||||
(news-read-in-file file)
|
||||
(news-set-mode-line))
|
||||
(news-set-mode-line)
|
||||
(error "Article %d nonexistent" arg))))
|
||||
|
||||
(defun news-force-update ()
|
||||
"updates the position of last article read in the current news group"
|
||||
(interactive)
|
||||
(setcdr (car news-point-pdl) news-current-message-number)
|
||||
(message "Updated to %d" news-current-message-number))
|
||||
|
||||
(defun news-next-message (arg)
|
||||
"Move ARG messages forward within one newsgroup.
|
||||
Negative ARG moves backward.
|
||||
If ARG is 1 or -1, moves to next or previous newsgroup if at end."
|
||||
(interactive "p")
|
||||
(let ((no (+ arg news-current-message-number)))
|
||||
(if (or (< no news-current-group-begin)
|
||||
(> no news-current-group-end))
|
||||
(cond ((= arg 1)
|
||||
(news-set-current-group-certification)
|
||||
(news-next-group))
|
||||
((= arg -1)
|
||||
(news-previous-group))
|
||||
(t (error "Article out of range")))
|
||||
(let ((plist (news-get-motion-lists
|
||||
news-current-message-number
|
||||
news-list-of-files)))
|
||||
(if (< arg 0)
|
||||
(news-select-message (nth (1- (- arg)) (car (cdr plist))))
|
||||
(news-select-message (nth (1- arg) (car plist))))))))
|
||||
|
||||
(defun news-previous-message (arg)
|
||||
"Move ARG messages backward in current newsgroup.
|
||||
With no arg or arg of 1, move one message
|
||||
and move to previous newsgroup if at beginning.
|
||||
A negative ARG means move forward."
|
||||
(interactive "p")
|
||||
(news-next-message (- arg)))
|
||||
|
||||
(defun news-move-to-group (arg)
|
||||
"Given arg move forward or backward to a new newsgroup."
|
||||
(let ((cg news-current-news-group))
|
||||
(let ((plist (news-get-motion-lists cg news-user-group-list))
|
||||
ngrp)
|
||||
(if (< arg 0)
|
||||
(or (setq ngrp (nth (1- (- arg)) (news-cadr plist)))
|
||||
(error "No previous news groups"))
|
||||
(or (setq ngrp (nth arg (car plist)))
|
||||
(error "No more news groups")))
|
||||
(news-select-news-group ngrp))))
|
||||
|
||||
(defun news-next-group ()
|
||||
"Moves to the next user group."
|
||||
(interactive)
|
||||
; (message "Moving to next group...")
|
||||
(news-move-to-group 0)
|
||||
(while (null news-list-of-files)
|
||||
(news-move-to-group 0)))
|
||||
; (message "Moving to next group... done.")
|
||||
|
||||
(defun news-previous-group ()
|
||||
"Moves to the previous user group."
|
||||
(interactive)
|
||||
; (message "Moving to previous group...")
|
||||
(news-move-to-group -1)
|
||||
(while (null news-list-of-files)
|
||||
(news-move-to-group -1)))
|
||||
; (message "Moving to previous group... done.")
|
||||
|
||||
(defun news-get-motion-lists (arg listy)
|
||||
"Given a msgnumber/group this will return a list of two lists;
|
||||
one for moving forward and one for moving backward."
|
||||
(let ((temp listy)
|
||||
(result ()))
|
||||
(catch 'out
|
||||
(while temp
|
||||
(if (equal (car temp) arg)
|
||||
(throw 'out (cons (cdr temp) (list result)))
|
||||
(setq result (nconc (list (car temp)) result))
|
||||
(setq temp (cdr temp)))))))
|
||||
|
||||
;; miscellaneous io routines
|
||||
(defun news-read-in-file (filename)
|
||||
(erase-buffer)
|
||||
(let ((start (point)))
|
||||
(insert-file-contents filename)
|
||||
(news-convert-format)
|
||||
;; Run each hook that applies to the current newsgroup.
|
||||
(let ((hooks news-group-hook-alist))
|
||||
(while hooks
|
||||
(goto-char start)
|
||||
(if (string-match (car (car hooks)) news-group-name)
|
||||
(funcall (cdr (car hooks))))
|
||||
(setq hooks (cdr hooks))))
|
||||
(goto-char start)
|
||||
(forward-line 1)
|
||||
(if (eobp)
|
||||
(message "(Empty file?)")
|
||||
(goto-char start))))
|
||||
|
||||
(defun news-convert-format ()
|
||||
(save-excursion
|
||||
(save-restriction
|
||||
(let* ((start (point))
|
||||
(end (condition-case ()
|
||||
(progn (search-forward "\n\n") (point))
|
||||
(error nil)))
|
||||
has-from has-date)
|
||||
(cond (end
|
||||
(narrow-to-region start end)
|
||||
(goto-char start)
|
||||
(setq has-from (search-forward "\nFrom:" nil t))
|
||||
(cond ((and (not has-from) has-date)
|
||||
(goto-char start)
|
||||
(search-forward "\nDate:")
|
||||
(beginning-of-line)
|
||||
(kill-line) (kill-line)))
|
||||
(news-delete-headers start)
|
||||
(goto-char start)))))))
|
||||
|
||||
(defun news-show-all-headers ()
|
||||
"Redisplay current news item with all original headers"
|
||||
(interactive)
|
||||
(let (news-ignored-headers
|
||||
(buffer-read-only ()))
|
||||
(erase-buffer)
|
||||
(news-set-mode-line)
|
||||
(news-read-in-file
|
||||
(concat news-path
|
||||
(string-subst-char ?/ ?. news-current-news-group)
|
||||
"/" (int-to-string news-current-message-number)))))
|
||||
|
||||
(defun news-delete-headers (pos)
|
||||
(goto-char pos)
|
||||
(and (stringp news-ignored-headers)
|
||||
(while (re-search-forward news-ignored-headers nil t)
|
||||
(beginning-of-line)
|
||||
(delete-region (point)
|
||||
(progn (re-search-forward "\n[^ \t]")
|
||||
(forward-char -1)
|
||||
(point))))))
|
||||
|
||||
(defun news-exit ()
|
||||
"Quit news reading session and update the .newsrc file."
|
||||
(interactive)
|
||||
(if (y-or-n-p "Do you really wanna quit reading news ? ")
|
||||
(progn (message "Updating %s..." news-startup-file)
|
||||
(news-update-newsrc-file)
|
||||
(news-write-certifications)
|
||||
(message "Updating %s... done" news-startup-file)
|
||||
(message "Now do some real work")
|
||||
(quit-window)
|
||||
(switch-to-buffer news-buffer-save)
|
||||
(setq news-user-group-list ()))
|
||||
(message "")))
|
||||
|
||||
(defun news-update-newsrc-file ()
|
||||
"Updates the .newsrc file in the users home dir."
|
||||
(let ((newsrcbuf (find-file-noselect
|
||||
(substitute-in-file-name news-startup-file)))
|
||||
(tem news-user-group-list)
|
||||
group)
|
||||
(save-excursion
|
||||
(if (not (null news-current-news-group))
|
||||
(news-update-message-read news-current-news-group
|
||||
(news-cdar news-point-pdl)))
|
||||
(set-buffer newsrcbuf)
|
||||
(while tem
|
||||
(setq group (assoc (car tem) news-group-article-assoc))
|
||||
(if (= (news-cadr (news-cadr group)) (news-caddr (news-cadr group)))
|
||||
nil
|
||||
(goto-char 0)
|
||||
(if (search-forward (concat (car group) ": ") nil t)
|
||||
(kill-line nil)
|
||||
(insert (car group) ": \n") (backward-char 1))
|
||||
(insert (int-to-string (car (news-cadr group))) "-"
|
||||
(int-to-string (news-cadr (news-cadr group)))))
|
||||
(setq tem (cdr tem)))
|
||||
(while news-unsubscribe-groups
|
||||
(setq group (assoc (car news-unsubscribe-groups)
|
||||
news-group-article-assoc))
|
||||
(goto-char 0)
|
||||
(if (search-forward (concat (car group) ": ") nil t)
|
||||
(progn
|
||||
(backward-char 2)
|
||||
(kill-line nil)
|
||||
(insert "! " (int-to-string (car (news-cadr group)))
|
||||
"-" (int-to-string (news-cadr (news-cadr group))))))
|
||||
(setq news-unsubscribe-groups (cdr news-unsubscribe-groups)))
|
||||
(save-buffer)
|
||||
(kill-buffer (current-buffer)))))
|
||||
|
||||
|
||||
(defun news-unsubscribe-group (group)
|
||||
"Removes you from newgroup GROUP."
|
||||
(interactive (list (completing-read "Unsubscribe from group: "
|
||||
news-group-article-assoc)))
|
||||
(news-unsubscribe-internal group))
|
||||
|
||||
(defun news-unsubscribe-current-group ()
|
||||
"Removes you from the newsgroup you are now reading."
|
||||
(interactive)
|
||||
(if (y-or-n-p "Do you really want to unsubscribe from this group ? ")
|
||||
(news-unsubscribe-internal news-current-news-group)))
|
||||
|
||||
(defun news-unsubscribe-internal (group)
|
||||
(let ((tem (assoc group news-group-article-assoc)))
|
||||
(if tem
|
||||
(progn
|
||||
(setq news-unsubscribe-groups (cons group news-unsubscribe-groups))
|
||||
(news-update-message-read group (news-cdar news-point-pdl))
|
||||
(if (equal group news-current-news-group)
|
||||
(news-next-group))
|
||||
(message ""))
|
||||
(error "Not subscribed to group: %s" group))))
|
||||
|
||||
(defun news-save-item-in-file (file)
|
||||
"Save the current article that is being read by appending to a file."
|
||||
(interactive "FSave item in file: ")
|
||||
(append-to-file (point-min) (point-max) file))
|
||||
|
||||
(defun news-get-pruned-list-of-files (gp-list end-file-no)
|
||||
"Given a news group it finds all files in the news group.
|
||||
The arg must be in slashified format.
|
||||
Using ls was found to be too slow in a previous version."
|
||||
(let
|
||||
((answer
|
||||
(and
|
||||
(not (and end-file-no
|
||||
(equal (news-set-current-certifiable)
|
||||
(news-group-certification gp-list))
|
||||
(setq news-list-of-files nil
|
||||
news-list-of-files-possibly-bogus t)))
|
||||
(let* ((file-directory (concat news-path
|
||||
(string-subst-char ?/ ?. gp-list)))
|
||||
tem
|
||||
(last-winner
|
||||
(and end-file-no
|
||||
(news-wins file-directory end-file-no)
|
||||
(news-find-first-or-last file-directory end-file-no 1))))
|
||||
(setq news-list-of-files-possibly-bogus t news-list-of-files nil)
|
||||
(if last-winner
|
||||
(progn
|
||||
(setq news-list-of-files-possibly-bogus t
|
||||
news-current-group-end last-winner)
|
||||
(while (> last-winner end-file-no)
|
||||
(news-push last-winner news-list-of-files)
|
||||
(setq last-winner (1- last-winner)))
|
||||
news-list-of-files)
|
||||
(if (or (not (file-directory-p file-directory))
|
||||
(not (file-readable-p file-directory)))
|
||||
nil
|
||||
(setq news-list-of-files
|
||||
(condition-case error
|
||||
(directory-files file-directory)
|
||||
(file-error
|
||||
(if (string= (nth 2 error) "permission denied")
|
||||
(message "Newsgroup %s is read-protected"
|
||||
gp-list)
|
||||
(signal 'file-error (cdr error)))
|
||||
nil)))
|
||||
(setq tem news-list-of-files)
|
||||
(while tem
|
||||
(if (or (not (string-match "^[0-9]*$" (car tem)))
|
||||
;; don't get confused by directories that look like numbers
|
||||
(file-directory-p
|
||||
(concat file-directory "/" (car tem)))
|
||||
(<= (string-to-number (car tem)) end-file-no))
|
||||
(setq news-list-of-files
|
||||
(delq (car tem) news-list-of-files)))
|
||||
(setq tem (cdr tem)))
|
||||
(if (null news-list-of-files)
|
||||
(progn (setq news-current-group-end 0)
|
||||
nil)
|
||||
(setq news-list-of-files
|
||||
(mapcar 'string-to-number news-list-of-files))
|
||||
(setq news-list-of-files (sort news-list-of-files '<))
|
||||
(setq news-current-group-end
|
||||
(elt news-list-of-files
|
||||
(1- (length news-list-of-files))))
|
||||
news-list-of-files)))))))
|
||||
(or answer (progn (news-set-current-group-certification) nil))))
|
||||
|
||||
(defun news-read-files-into-buffer (group reversep)
|
||||
(let* ((files-start-end (news-cadr (assoc group news-group-article-assoc)))
|
||||
(start-file-no (car files-start-end))
|
||||
(end-file-no (news-cadr files-start-end))
|
||||
(buffer-read-only nil))
|
||||
(setq news-current-news-group group)
|
||||
(setq news-current-message-number nil)
|
||||
(setq news-current-group-end nil)
|
||||
(news-set-mode-line)
|
||||
(news-get-pruned-list-of-files group end-file-no)
|
||||
(news-set-mode-line)
|
||||
;; @@ should be a lot smarter than this if we have to move
|
||||
;; @@ around correctly.
|
||||
(setq news-point-pdl (list (cons (car files-start-end)
|
||||
(news-cadr files-start-end))))
|
||||
(if (null news-list-of-files)
|
||||
(progn (erase-buffer)
|
||||
(setq news-current-group-end end-file-no)
|
||||
(setq news-current-group-begin end-file-no)
|
||||
(setq news-current-message-number end-file-no)
|
||||
(news-set-mode-line)
|
||||
; (message "No new articles in " group " group.")
|
||||
nil)
|
||||
(setq news-current-group-begin (car news-list-of-files))
|
||||
(if reversep
|
||||
(setq news-current-message-number news-current-group-end)
|
||||
(if (> (car news-list-of-files) end-file-no)
|
||||
(setcdr (car news-point-pdl) (car news-list-of-files)))
|
||||
(setq news-current-message-number news-current-group-begin))
|
||||
(news-set-message-counters)
|
||||
(news-set-mode-line)
|
||||
(news-read-in-file (concat news-path
|
||||
(string-subst-char ?/ ?. group)
|
||||
"/"
|
||||
(int-to-string
|
||||
news-current-message-number)))
|
||||
(news-set-message-counters)
|
||||
(news-set-mode-line)
|
||||
t)))
|
||||
|
||||
(defun news-add-news-group (gp)
|
||||
"Resubscribe to or add a USENET news group named GROUP (a string)."
|
||||
; @@ (completing-read ...)
|
||||
; @@ could be based on news library file ../active (slightly fascist)
|
||||
; @@ or (expensive to compute) all directories under the news spool directory
|
||||
(interactive "sAdd news group: ")
|
||||
(let ((file-dir (concat news-path (string-subst-char ?/ ?. gp))))
|
||||
(save-excursion
|
||||
(if (null (assoc gp news-group-article-assoc))
|
||||
(let ((newsrcbuf (find-file-noselect
|
||||
(substitute-in-file-name news-startup-file))))
|
||||
(if (file-directory-p file-dir)
|
||||
(progn
|
||||
(switch-to-buffer newsrcbuf)
|
||||
(goto-char 0)
|
||||
(if (search-forward (concat gp "! ") nil t)
|
||||
(progn
|
||||
(message "Re-subscribing to group %s." gp)
|
||||
;;@@ news-unsubscribe-groups isn't being used
|
||||
;;(setq news-unsubscribe-groups
|
||||
;; (delq gp news-unsubscribe-groups))
|
||||
(backward-char 2)
|
||||
(delete-char 1)
|
||||
(insert ":"))
|
||||
(progn
|
||||
(message
|
||||
"Added %s to your list of newsgroups." gp)
|
||||
(goto-char (point-max))
|
||||
(insert gp ": 1-1\n")))
|
||||
(search-backward gp nil t)
|
||||
(let (start end endofline tem)
|
||||
(search-forward ": " nil t)
|
||||
(setq end (point))
|
||||
(beginning-of-line)
|
||||
(setq start (point))
|
||||
(end-of-line)
|
||||
(setq endofline (point))
|
||||
(setq tem (buffer-substring start (- end 2)))
|
||||
(let ((range (news-parse-range
|
||||
(buffer-substring end endofline))))
|
||||
(setq news-group-article-assoc
|
||||
(cons (list tem (list (car range)
|
||||
(cdr range)
|
||||
(cdr range)))
|
||||
news-group-article-assoc))))
|
||||
(save-buffer)
|
||||
(kill-buffer (current-buffer)))
|
||||
(message "Newsgroup %s doesn't exist." gp)))
|
||||
(message "Already subscribed to group %s." gp)))))
|
||||
|
||||
(defun news-make-link-to-message (number newname)
|
||||
"Forges a link to an rnews message numbered number (current if no arg)
|
||||
Good for hanging on to a message that might or might not be
|
||||
automatically deleted."
|
||||
(interactive "P
|
||||
FName to link to message: ")
|
||||
(add-name-to-file
|
||||
(concat news-path
|
||||
(string-subst-char ?/ ?. news-current-news-group)
|
||||
"/" (if number
|
||||
(prefix-numeric-value number)
|
||||
news-current-message-number))
|
||||
newname))
|
||||
|
||||
;;; caesar-region written by phr@gnu.org Nov 86
|
||||
;;; modified by tower@gnu.org Nov 86
|
||||
(defun caesar-region (&optional n)
|
||||
"Caesar rotation of region by N, default 13, for decrypting netnews."
|
||||
(interactive (if current-prefix-arg ; Was there a prefix arg?
|
||||
(list (prefix-numeric-value current-prefix-arg))
|
||||
(list nil)))
|
||||
(cond ((not (numberp n)) (setq n 13))
|
||||
(t (setq n (mod n 26)))) ;canonicalize N
|
||||
(if (not (zerop n)) ; no action needed for a rot of 0
|
||||
(progn
|
||||
(if (or (not (boundp 'caesar-translate-table))
|
||||
(/= (aref caesar-translate-table ?a) (+ ?a n)))
|
||||
(let ((i 0) (lower "abcdefghijklmnopqrstuvwxyz") upper)
|
||||
(message "Building caesar-translate-table...")
|
||||
(setq caesar-translate-table (make-vector 256 0))
|
||||
(while (< i 256)
|
||||
(aset caesar-translate-table i i)
|
||||
(setq i (1+ i)))
|
||||
(setq lower (concat lower lower) upper (upcase lower) i 0)
|
||||
(while (< i 26)
|
||||
(aset caesar-translate-table (+ ?a i) (aref lower (+ i n)))
|
||||
(aset caesar-translate-table (+ ?A i) (aref upper (+ i n)))
|
||||
(setq i (1+ i)))
|
||||
(message "Building caesar-translate-table... done")))
|
||||
(let ((from (region-beginning))
|
||||
(to (region-end))
|
||||
(i 0) str len)
|
||||
(setq str (buffer-substring from to))
|
||||
(setq len (length str))
|
||||
(while (< i len)
|
||||
(aset str i (aref caesar-translate-table (aref str i)))
|
||||
(setq i (1+ i)))
|
||||
(goto-char from)
|
||||
(kill-region from to)
|
||||
(insert str)))))
|
||||
|
||||
;;; news-caesar-buffer-body written by paul@media-lab.mit.edu Wed Oct 1, 1986
|
||||
;;; hacked further by tower@gnu.org
|
||||
(defun news-caesar-buffer-body (&optional rotnum)
|
||||
"Caesar rotates all letters in the current buffer by 13 places.
|
||||
Used to encode/decode possibly offensive messages (commonly in net.jokes).
|
||||
With prefix arg, specifies the number of places to rotate each letter forward.
|
||||
Mail and USENET news headers are not rotated."
|
||||
(interactive (if current-prefix-arg ; Was there a prefix arg?
|
||||
(list (prefix-numeric-value current-prefix-arg))
|
||||
(list nil)))
|
||||
(save-excursion
|
||||
(let ((buffer-status buffer-read-only))
|
||||
(setq buffer-read-only nil)
|
||||
;; setup the region
|
||||
(set-mark (if (equal major-mode 'news-mode)
|
||||
(progn (goto-char (point-min))
|
||||
(search-forward "\n\n" nil t))
|
||||
(mail-text-start)))
|
||||
(goto-char (point-max))
|
||||
(caesar-region rotnum)
|
||||
(setq buffer-read-only buffer-status))))
|
||||
|
||||
(provide 'rnews)
|
||||
|
||||
;; arch-tag: c032a20b-cafb-466c-b3fa-5be404a18f8c
|
||||
;;; rnews.el ends here
|
||||
|
|
@ -1,447 +0,0 @@
|
|||
;;; rnewspost.el --- USENET news poster/mailer for GNU Emacs
|
||||
|
||||
;; Copyright (C) 1985, 1986, 1987, 1995, 2001, 2002, 2003, 2004, 2005,
|
||||
;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
|
||||
|
||||
;; Maintainer: FSF
|
||||
;; Keywords: mail, news
|
||||
|
||||
;; This file is part of GNU Emacs.
|
||||
|
||||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; This file has been obsolete since Emacs 21.1.
|
||||
|
||||
;;; Change Log:
|
||||
|
||||
;; moved posting and mail code from rnews.el
|
||||
;; tower@gnu.org Wed Oct 29 1986
|
||||
;; brought posting code almost up to the revision of RFC 850 for News 2.11
|
||||
;; - couldn't see handling the special meaning of the Keyword: poster
|
||||
;; - not worth the code space to support the old A news Title: (which
|
||||
;; Subject: replaced) and Article-I.D.: (which Message-ID: replaced)
|
||||
;; tower@gnu.org Nov 86
|
||||
;; changed C-c C-r key-binding due to rename of news-caesar-buffer-body
|
||||
;; tower@gnu.org 21 Nov 86
|
||||
;; added (require 'rnews) tower@gnu.org 22 Apr 87
|
||||
;; restricted call of news-show-all-headers in news-post-news & news-reply
|
||||
;; tower@gnu.org 28 Apr 87
|
||||
;; commented out Posting-Front-End to save USENET bytes tower@gnu.org Jul 31 87
|
||||
;; commented out -n and -t args in news-inews tower@gnu.org 15 Oct 87
|
||||
|
||||
;Now in paths.el.
|
||||
;(defvar news-inews-program "inews"
|
||||
; "Function to post news.")
|
||||
|
||||
;; Replying and posting news items are done by these functions.
|
||||
;; imported from rmail and modified to work with rnews ...
|
||||
;; Mon Mar 25,1985 at 03:07:04 ads@mit-hermes.
|
||||
;; this is done so that rnews can operate independently from rmail.el and
|
||||
;; sendmail and doesn't have to autoload these functions.
|
||||
;;
|
||||
;;; >> Nuked by Mly to autoload those functions again, as the duplication of
|
||||
;;; >> code was making maintenance too difficult.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'sendmail)
|
||||
(require 'rnews)
|
||||
|
||||
(defvar mail-reply-buffer)
|
||||
|
||||
(defvar news-reply-mode-map () "Mode map used by news-reply.")
|
||||
|
||||
(or news-reply-mode-map
|
||||
(progn
|
||||
(setq news-reply-mode-map (make-keymap))
|
||||
(define-key news-reply-mode-map "\C-c\C-f\C-d" 'news-reply-distribution)
|
||||
(define-key news-reply-mode-map "\C-c\C-f\C-k" 'news-reply-keywords)
|
||||
(define-key news-reply-mode-map "\C-c\C-f\C-n" 'news-reply-newsgroups)
|
||||
(define-key news-reply-mode-map "\C-c\C-f\C-f" 'news-reply-followup-to)
|
||||
(define-key news-reply-mode-map "\C-c\C-f\C-s" 'mail-subject)
|
||||
(define-key news-reply-mode-map "\C-c\C-f\C-a" 'news-reply-summary)
|
||||
(define-key news-reply-mode-map "\C-c\C-t" 'mail-text)
|
||||
(define-key news-reply-mode-map "\C-c\C-r" 'news-caesar-buffer-body)
|
||||
(define-key news-reply-mode-map "\C-c\C-w" 'news-reply-signature)
|
||||
(define-key news-reply-mode-map "\C-c\C-y" 'news-reply-yank-original)
|
||||
(define-key news-reply-mode-map "\C-c\C-q" 'mail-fill-yanked-message)
|
||||
(define-key news-reply-mode-map "\C-c\C-c" 'news-inews)
|
||||
(define-key news-reply-mode-map "\C-c\C-s" 'news-inews)
|
||||
(define-key news-reply-mode-map [menu-bar] (make-sparse-keymap))
|
||||
(define-key news-reply-mode-map [menu-bar fields]
|
||||
(cons "Fields" (make-sparse-keymap "Fields")))
|
||||
(define-key news-reply-mode-map [menu-bar fields news-reply-distribution]
|
||||
'("Distribution" . news-reply-distribution))
|
||||
(define-key news-reply-mode-map [menu-bar fields news-reply-keywords]
|
||||
'("Keywords" . news-reply-keywords))
|
||||
(define-key news-reply-mode-map [menu-bar fields news-reply-newsgroups]
|
||||
'("Newsgroups" . news-reply-newsgroups))
|
||||
(define-key news-reply-mode-map [menu-bar fields news-reply-followup-to]
|
||||
'("Followup-to" . news-reply-followup-to))
|
||||
(define-key news-reply-mode-map [menu-bar fields mail-subject]
|
||||
'("Subject" . mail-subject))
|
||||
(define-key news-reply-mode-map [menu-bar fields news-reply-summary]
|
||||
'("Summary" . news-reply-summary))
|
||||
(define-key news-reply-mode-map [menu-bar fields mail-text]
|
||||
'("Text" . mail-text))
|
||||
(define-key news-reply-mode-map [menu-bar news]
|
||||
(cons "News" (make-sparse-keymap "News")))
|
||||
(define-key news-reply-mode-map [menu-bar news news-caesar-buffer-body]
|
||||
'("Rot13" . news-caesar-buffer-body))
|
||||
(define-key news-reply-mode-map [menu-bar news news-reply-yank-original]
|
||||
'("Yank Original" . news-reply-yank-original))
|
||||
(define-key news-reply-mode-map [menu-bar news mail-fill-yanked-message]
|
||||
'("Fill Yanked Messages" . mail-fill-yanked-message))
|
||||
(define-key news-reply-mode-map [menu-bar news news-inews]
|
||||
'("Send" . news-inews))))
|
||||
|
||||
(defun news-reply-mode ()
|
||||
"Major mode for editing news to be posted on USENET.
|
||||
First-time posters are asked to please read the articles in newsgroup:
|
||||
news.announce.newusers .
|
||||
Like Text Mode but with these additional commands:
|
||||
|
||||
C-c C-s news-inews (post the message) C-c C-c news-inews
|
||||
C-c C-f move to a header field (and create it if there isn't):
|
||||
C-c C-f C-n move to Newsgroups: C-c C-f C-s move to Subj:
|
||||
C-c C-f C-f move to Followup-To: C-c C-f C-k move to Keywords:
|
||||
C-c C-f C-d move to Distribution: C-c C-f C-a move to Summary:
|
||||
C-c C-y news-reply-yank-original (insert current message, in NEWS).
|
||||
C-c C-q mail-fill-yanked-message (fill what was yanked).
|
||||
C-c C-r caesar rotate all letters by 13 places in the article's body (rot13)."
|
||||
(interactive)
|
||||
(kill-all-local-variables)
|
||||
(make-local-variable 'mail-reply-buffer)
|
||||
(setq mail-reply-buffer nil)
|
||||
(set-syntax-table text-mode-syntax-table)
|
||||
(use-local-map news-reply-mode-map)
|
||||
(setq local-abbrev-table text-mode-abbrev-table)
|
||||
(setq major-mode 'news-reply-mode)
|
||||
(setq mode-name "News Reply")
|
||||
(make-local-variable 'paragraph-separate)
|
||||
(make-local-variable 'paragraph-start)
|
||||
(run-mode-hooks 'text-mode-hook 'news-reply-mode-hook))
|
||||
|
||||
(defvar news-reply-yank-from ""
|
||||
"Save `From:' field for `news-reply-yank-original'.")
|
||||
|
||||
(defvar news-reply-yank-message-id ""
|
||||
"Save `Message-Id:' field for `news-reply-yank-original'.")
|
||||
|
||||
(defun news-reply-yank-original (arg)
|
||||
"Insert the message being replied to, if any (in Mail mode).
|
||||
Puts point before the text and mark after.
|
||||
Indents each nonblank line ARG spaces (default 3).
|
||||
Just \\[universal-argument] as argument means don't indent
|
||||
and don't delete any header fields."
|
||||
(interactive "P")
|
||||
(mail-yank-original arg)
|
||||
(exchange-point-and-mark)
|
||||
(run-hooks 'news-reply-header-hook))
|
||||
|
||||
(defvar news-reply-header-hook
|
||||
(lambda ()
|
||||
(insert "In article " news-reply-yank-message-id
|
||||
" " news-reply-yank-from " writes:\n\n"))
|
||||
"Hook for inserting a header at the top of a yanked message.")
|
||||
|
||||
(defun news-reply-newsgroups ()
|
||||
"Move point to end of `Newsgroups:' field.
|
||||
RFC 850 constrains the `Newsgroups:' field to be a comma-separated list
|
||||
of valid newsgroup names at your site. For example,
|
||||
Newsgroups: news.misc,comp.misc,rec.misc"
|
||||
(interactive)
|
||||
(expand-abbrev)
|
||||
(goto-char (point-min))
|
||||
(mail-position-on-field "Newsgroups"))
|
||||
|
||||
(defun news-reply-followup-to ()
|
||||
"Move point to end of `Followup-To:' field. Create the field if none.
|
||||
One usually requests followups to only one newsgroup.
|
||||
RFC 850 constrains the `Followup-To:' field to be a comma-separated list
|
||||
of valid newsgroups names at your site, and it must be a subset of the
|
||||
`Newsgroups:' field. For example:
|
||||
Newsgroups: news.misc,comp.misc,rec.misc,misc.misc,soc.misc
|
||||
Followup-To: news.misc,comp.misc,rec.misc"
|
||||
(interactive)
|
||||
(expand-abbrev)
|
||||
(or (mail-position-on-field "Followup-To" t)
|
||||
(progn (mail-position-on-field "newsgroups")
|
||||
(insert "\nFollowup-To: ")))
|
||||
;; @@ could do a completing read based on the Newsgroups: field to
|
||||
;; @@ fill in the Followup-To: field
|
||||
)
|
||||
|
||||
(defun news-reply-distribution ()
|
||||
"Move point to end of `Distribution:' optional field.
|
||||
Create the field if none. Without this field the posting goes to all of
|
||||
USENET. The field is used to restrict the posting to parts of USENET."
|
||||
(interactive)
|
||||
(expand-abbrev)
|
||||
(mail-position-on-field "Distribution")
|
||||
;; @@could do a completing read based on the news library file:
|
||||
;; @@ ../distributions to fill in the field.
|
||||
)
|
||||
|
||||
(defun news-reply-keywords ()
|
||||
"Move point to end of `Keywords:' optional field. Create the field if none.
|
||||
Used as an aid to the news reader, it can contain a few, well selected keywords
|
||||
identifying the message."
|
||||
(interactive)
|
||||
(expand-abbrev)
|
||||
(mail-position-on-field "Keywords"))
|
||||
|
||||
(defun news-reply-summary ()
|
||||
"Move point to end of `Summary:' optional field. Create the field if none.
|
||||
Used as an aid to the news reader, it can contain a succinct
|
||||
summary (abstract) of the message."
|
||||
(interactive)
|
||||
(expand-abbrev)
|
||||
(mail-position-on-field "Summary"))
|
||||
|
||||
(defun news-reply-signature ()
|
||||
"The inews program appends `~/.signature' automatically."
|
||||
(interactive)
|
||||
(message "Posting news will append your signature automatically."))
|
||||
|
||||
(defun news-setup (to subject in-reply-to newsgroups replybuffer)
|
||||
"Set up the news reply or posting buffer with the proper headers and mode."
|
||||
(setq mail-reply-buffer replybuffer)
|
||||
(let ((mail-setup-hook nil)
|
||||
;; Avoid inserting a signature.
|
||||
(mail-signature))
|
||||
(if (null to)
|
||||
;; this hack is needed so that inews wont be confused by
|
||||
;; the fcc: and bcc: fields
|
||||
(let ((mail-self-blind nil)
|
||||
(mail-archive-file-name nil))
|
||||
(mail-setup to subject in-reply-to nil replybuffer nil)
|
||||
(beginning-of-line)
|
||||
(delete-region (point) (progn (forward-line 1) (point)))
|
||||
(goto-char (point-max)))
|
||||
(mail-setup to subject in-reply-to nil replybuffer nil))
|
||||
;;;(mail-position-on-field "Posting-Front-End")
|
||||
;;;(insert (emacs-version))
|
||||
(goto-char (point-max))
|
||||
(if (let ((case-fold-search t))
|
||||
(re-search-backward "^Subject:" (point-min) t))
|
||||
(progn (beginning-of-line)
|
||||
(insert "Newsgroups: " (or newsgroups "") "\n")
|
||||
(if (not newsgroups)
|
||||
(backward-char 1)
|
||||
(goto-char (point-max)))))
|
||||
(let (actual-header-separator)
|
||||
(rfc822-goto-eoh)
|
||||
(setq actual-header-separator (buffer-substring
|
||||
(point)
|
||||
(save-excursion (end-of-line) (point))))
|
||||
(setq paragraph-start
|
||||
(concat "^" actual-header-separator "$\\|" paragraph-start))
|
||||
(setq paragraph-separate
|
||||
(concat "^" actual-header-separator "$\\|" paragraph-separate)))
|
||||
(run-hooks 'news-setup-hook)))
|
||||
|
||||
(defun news-inews ()
|
||||
"Send a news message using inews."
|
||||
(interactive)
|
||||
(let* (newsgroups subject
|
||||
(case-fold-search nil))
|
||||
(save-excursion
|
||||
(save-restriction
|
||||
(narrow-to-region (point-min) (mail-header-end))
|
||||
(setq newsgroups (mail-fetch-field "newsgroups")
|
||||
subject (mail-fetch-field "subject")))
|
||||
(widen)
|
||||
(goto-char (point-min))
|
||||
(run-hooks 'news-inews-hook)
|
||||
(mail-sendmail-undelimit-header)
|
||||
(goto-char (point-max))
|
||||
;; require a newline at the end for inews to append .signature to
|
||||
(or (= (preceding-char) ?\n)
|
||||
(insert ?\n))
|
||||
(message "Posting to USENET...")
|
||||
(unwind-protect
|
||||
(if (not (eq 0
|
||||
(call-process-region (point-min) (point-max)
|
||||
news-inews-program nil 0 nil
|
||||
"-h"))) ; take all header lines!
|
||||
;@@ setting of subject and newsgroups still needed?
|
||||
;"-t" subject
|
||||
;"-n" newsgroups
|
||||
(error "Posting to USENET failed")
|
||||
(message "Posting to USENET... done"))
|
||||
(mail-sendmail-delimit-header)
|
||||
(set-buffer-modified-p nil)))
|
||||
(bury-buffer)))
|
||||
|
||||
;@@ shares some code with news-reply and news-post-news
|
||||
(defun news-mail-reply ()
|
||||
"Mail a reply to the author of the current article.
|
||||
While composing the reply, use \\[news-reply-yank-original] to yank the
|
||||
original message into it."
|
||||
(interactive)
|
||||
(let (from cc subject date to reply-to message-id
|
||||
(buffer (current-buffer)))
|
||||
(save-restriction
|
||||
(narrow-to-region (point-min) (progn (goto-char (point-min))
|
||||
(search-forward "\n\n")
|
||||
(1- (point))))
|
||||
(setq from (mail-fetch-field "from")
|
||||
subject (mail-fetch-field "subject")
|
||||
reply-to (mail-fetch-field "reply-to")
|
||||
date (mail-fetch-field "date")
|
||||
message-id (mail-fetch-field "message-id")))
|
||||
(setq to from)
|
||||
(pop-to-buffer "*mail*")
|
||||
(mail nil
|
||||
(if reply-to reply-to to)
|
||||
subject
|
||||
(let ((stop-pos (string-match " *at \\| *@ \\| *(\\| *<" from)))
|
||||
(concat (if stop-pos (substring from 0 stop-pos) from)
|
||||
"'s message "
|
||||
(if message-id
|
||||
(concat message-id " of ")
|
||||
"of ")
|
||||
date))
|
||||
nil
|
||||
buffer)))
|
||||
|
||||
;@@ the guts of news-reply and news-post-news should be combined. -tower
|
||||
(defun news-reply ()
|
||||
"Compose and post a reply (aka a followup) to the current article on USENET.
|
||||
While composing the followup, use \\[news-reply-yank-original] to yank the
|
||||
original message into it."
|
||||
(interactive)
|
||||
(if (y-or-n-p "Are you sure you want to followup to all of USENET? ")
|
||||
(let (from cc subject date to followup-to newsgroups message-of
|
||||
references distribution message-id
|
||||
(buffer (current-buffer)))
|
||||
(save-restriction
|
||||
(and (not (= 0 (buffer-size))) ;@@real problem is non-existence of
|
||||
;@@ of article file
|
||||
(equal major-mode 'news-mode) ;@@ if rmail-mode,
|
||||
;@@ should show full headers
|
||||
(progn
|
||||
(news-show-all-headers) ;@@ should save/restore header state,
|
||||
;@@ but rnews.el lacks support
|
||||
(narrow-to-region (point-min) (progn (goto-char (point-min))
|
||||
(search-forward "\n\n")
|
||||
(- (point) 1)))))
|
||||
(setq from (mail-fetch-field "from")
|
||||
news-reply-yank-from from
|
||||
;; @@ not handling old Title: field
|
||||
subject (mail-fetch-field "subject")
|
||||
date (mail-fetch-field "date")
|
||||
followup-to (mail-fetch-field "followup-to")
|
||||
newsgroups (or followup-to
|
||||
(mail-fetch-field "newsgroups"))
|
||||
references (mail-fetch-field "references")
|
||||
;; @@ not handling old Article-I.D.: field
|
||||
distribution (mail-fetch-field "distribution")
|
||||
message-id (mail-fetch-field "message-id")
|
||||
news-reply-yank-message-id message-id)
|
||||
(pop-to-buffer "*post-news*")
|
||||
(news-reply-mode)
|
||||
(if (and (buffer-modified-p)
|
||||
(not
|
||||
(y-or-n-p "Unsent article being composed; erase it? ")))
|
||||
()
|
||||
(progn
|
||||
(erase-buffer)
|
||||
(and subject
|
||||
(progn (if (string-match "\\`Re: " subject)
|
||||
(while (string-match "\\`Re: " subject)
|
||||
(setq subject (substring subject 4))))
|
||||
(setq subject (concat "Re: " subject))))
|
||||
(and from
|
||||
(progn
|
||||
(let ((stop-pos
|
||||
(string-match " *at \\| *@ \\| *(\\| *<" from)))
|
||||
(setq message-of
|
||||
(concat
|
||||
(if stop-pos (substring from 0 stop-pos) from)
|
||||
"'s message "
|
||||
(if message-id
|
||||
(concat message-id " of ")
|
||||
"of ")
|
||||
date)))))
|
||||
(news-setup
|
||||
nil
|
||||
subject
|
||||
message-of
|
||||
newsgroups
|
||||
buffer)
|
||||
(if followup-to
|
||||
(progn (news-reply-followup-to)
|
||||
(insert followup-to)))
|
||||
(if distribution
|
||||
(progn
|
||||
(mail-position-on-field "Distribution")
|
||||
(insert distribution)))
|
||||
(mail-position-on-field "References")
|
||||
(if references
|
||||
(insert references))
|
||||
(if (and references message-id)
|
||||
(insert " "))
|
||||
(if message-id
|
||||
(insert message-id))
|
||||
(goto-char (point-max))))))
|
||||
(message "")))
|
||||
|
||||
;@@ the guts of news-reply and news-post-news should be combined. -tower
|
||||
;;;###autoload
|
||||
(defun news-post-news (&optional noquery)
|
||||
"Begin editing a new USENET news article to be posted.
|
||||
Type \\[describe-mode] once editing the article to get a list of commands.
|
||||
If NOQUERY is non-nil, we do not query before doing the work."
|
||||
(interactive)
|
||||
(if (or noquery
|
||||
(y-or-n-p "Are you sure you want to post to all of USENET? "))
|
||||
(let ((buffer (current-buffer)))
|
||||
(save-restriction
|
||||
(and (not (= 0 (buffer-size))) ;@@real problem is non-existence of
|
||||
;@@ of article file
|
||||
(equal major-mode 'news-mode) ;@@ if rmail-mode,
|
||||
;@@ should show full headers
|
||||
(progn
|
||||
(news-show-all-headers) ;@@ should save/restore header state,
|
||||
;@@ but rnews.el lacks support
|
||||
(narrow-to-region (point-min) (progn (goto-char (point-min))
|
||||
(search-forward "\n\n")
|
||||
(- (point) 1)))))
|
||||
(setq news-reply-yank-from (mail-fetch-field "from")
|
||||
;; @@ not handling old Article-I.D.: field
|
||||
news-reply-yank-message-id (mail-fetch-field "message-id")))
|
||||
(pop-to-buffer "*post-news*")
|
||||
(news-reply-mode)
|
||||
(if (and (buffer-modified-p)
|
||||
(not (y-or-n-p "Unsent article being composed; erase it? ")))
|
||||
() ;@@ not saving point from last time
|
||||
(progn (erase-buffer)
|
||||
(news-setup () () () () buffer))))
|
||||
(message "")))
|
||||
|
||||
(defun news-mail-other-window ()
|
||||
"Send mail in another window.
|
||||
While composing the message, use \\[news-reply-yank-original] to yank the
|
||||
original message into it."
|
||||
(interactive)
|
||||
(mail-other-window nil nil nil nil nil (current-buffer)))
|
||||
|
||||
(provide 'rnewspost)
|
||||
|
||||
;; arch-tag: 18f7b2af-cf9a-49e4-878b-71eb49913e00
|
||||
;;; rnewspost.el ends here
|
||||
Loading…
Add table
Add a link
Reference in a new issue