rnews.el

早期freebsd实现

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)
  (if (boundp 'minor-mode-alist)
      ;; Emacs versions 18.16 and up.
      (setq mode-name '("NEWS" news-minor-modes))
    ;; Earlier versions display minor-modes via a special mechanism.
    (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-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-int (substring number-string 0 n))
	      (string-to-int (substring number-string (1+ n))))
      (setq n (string-to-int 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*"
    (save-excursion
      (set-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 not subscribed to in file %s." news-startup-file)
      (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-int arg)))
  (let ((file (concat news-path
		      (string-subst-char ?/ ?. news-current-news-group)
		      "/" arg)))
    (if (file-exists-p file)
	(let ((buffer-read-only ()))
	  (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)
	  (news-read-in-file file)
	  (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)
  (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)