rnews.el

早期freebsd实现

;;; USENET news reader for gnu emacs
;; Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc.

;; 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 1, 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; see the file COPYING.  If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.

;; Created Sun Mar 10,1985 at 21:35:01 ads and [e-mail]
;; 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 ..
;;	[e-mail] Wed Apr 10,1985 at 16:32:06
;; hack slash maim. [e-mail] 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...
;;	[e-mail], 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
;;	[e-mail] 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@prep Sep  3 1986
;; added news-rotate-buffer-body
;;	tower@prep Oct 17 1986
;; made messages more user friendly, cleanuped news-inews
;; move posting and mail code to new file rnewpost.el
;;	tower@prep Oct 29 1986
;; added caesar-region, rename news-caesar-buffer-body, hacked accordingly
;;	tower@prep Nov 21 1986
;; added (provide 'rnews)	tower@prep 22 Apr 87
(provide 'rnews)
(require 'mail-utils)

(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 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-minor-modes ()
  "Creates a minor mode list that has group name, total articles,
and attribute for current article."
  (setq news-minor-modes (list (cons 'foo
				     (concat news-current-message-number
					     "/"
					     news-total-current-group
					     (news-get-attribute-string)))))
  ;; Detect Emacs versions 18.16 and up, which display
  ;; directly from news-minor-modes by using a list for mode-name.
  (or (boundp 'minor-mode-alist)
      (setq minor-modes news-minor-modes)))

(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.