rnews.el

早期freebsd实现

	     "/" (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")
	     (and (fboundp 'bury-buffer) (bury-buffer (current-buffer)))
	     (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)))
      (switch-to-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)))
			 ;; dont get confused by directories that look like numbers
			 (file-directory-p
			  (concat file-directory "/" (car tem)))
			 (<= (string-to-int (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-int 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 facist)
; @@ 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)
		      (end-of-buffer)
		      (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 [e-mail]  Nov 86
;;; modified by tower@prep 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))
	((< n 0) (setq n (- 26 (% (- n) 26))))
	(t (setq n (% 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 [e-mail]  Wed Oct 1, 1986
;;; hacked further by [e-mail]
(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 (progn (goto-char (point-min))
			    (search-forward
			     (concat "\n"
				     (if (equal major-mode 'news-mode)
					 ""
				       mail-header-separator)
				     "\n") nil t))
		     (point)
		   (point-min)))
      (goto-char (point-max))
      (caesar-region rotnum)
      (setq buffer-read-only buffer-status))))