Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

*** empty log message ***

  • Loading branch information...
commit 29442cafaf4083cf60418f8f51fc7d0923184902 1 parent b1a2d22
@larsmagne larsmagne authored
View
30 GNUS-NEWS
@@ -34,3 +34,33 @@ used to pick articles.
*** Commands for moving the .newsrc.eld from one server to
another have been added.
+
+ `M-x gnus-change-server'
+
+*** A way to specify that "uninteresting" fields be suppressed when
+generating lines in buffers.
+
+*** Several commands in the group buffer can be undone with
+`M-C-_'.
+
+*** Scoring can be done on words using the new score type `w'.
+
+*** Adaptive scoring can be done on a Subject word-by-word basis:
+
+ (setq gnus-use-adaptive-scoring '(word))
+
+*** Scores can be decayed.
+
+ (setq gnus-decay-scores t)
+
+*** Scoring can be performed using a regexp on the Date header. The
+Date is normalized to compact ISO 8601 format first.
+
+*** A new command has been added to remove all data on articles from
+the native server.
+
+ `M-x gnus-group-clear-data-on-native-groups'
+
+*** A new command for reading collections of documents
+(nndoc with nnvirtual on top) has been added -- `M-C-d'.
+
View
151 lisp/ChangeLog
@@ -1,3 +1,154 @@
+Sat Aug 10 06:03:07 1996 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus-soup.el (gnus-soup-write-prefixes): Protect against
+ existing dirs.
+
+ * gnus-topic.el (gnus-topic-parameters): Third parameter instead
+ of second.
+ (gnus-topic-set-parameters): Ditto.
+
+Sat Aug 10 05:22:43 1996 Lee Iverson <leei@ai.sri.com>
+
+ * message.el (message-send-mail-with-mh): Didn't work.
+
+Sat Aug 10 03:57:42 1996 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus-dup.el (gnus-dup-unsuppress-article): Data instead of
+ ingo.
+ (gnus-dup-unsuppress-article): Set the wrong variable.
+
+Sat Aug 10 00:52:26 1996 Jack Vinson <jvinson@cheux.ecs.umass.edu>
+
+ * gnus.el (gnus-short-group-name): Bug in dotless names.
+
+Sat Aug 10 00:45:32 1996 Jens Lautenbacher <jens@lemhrem.lem.uni-karlsruhe.de>
+
+ * gnus-msg.el (gnus-inews-insert-archive-gcc): Use the `gcc-self'
+ parameter.
+
+Sat Aug 10 00:28:41 1996 Fran�ois Pinard <pinard@progiciels-bpi.ca>
+
+ * gnus-load.el (gnus-info-nodes): Add info node for
+ `mime/viewer-mode'.
+
+Sat Aug 10 00:25:51 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * message.el (message-reply): Don't include first empty line.
+
+Sat Aug 10 00:11:52 1996 Fran�ois Pinard <pinard@progiciels-bpi.ca>
+
+ * gnus-sum.el (gnus-summary-prev-unread-article): Doc fix.
+
+Sat Aug 10 00:08:42 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus-util.el (gnus-date-iso8601): Protect agains buggy Dates.
+
+Fri Aug 9 06:39:22 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus-topic.el (gnus-topic-mode): Hook into parameter thingies.
+ (gnus-topic-parameters): Buggy definition.
+
+ * gnus-group.el (gnus-group-get-parameter-function): New
+ variable.
+
+ * gnus.el (gnus-group-find-parameter): New function.
+
+ * gnus-sum.el (gnus-summary-read-document): New command and
+ keystroke.
+
+ * gnus-group.el (gnus-group-clear-data-on-native-groups): New
+ command.
+ (gnus-group-read-ephemeral-group): Accept an ACTIVATE-ONLY
+ parameter.
+
+ * gnus-score.el (gnus-decay-score): New function.
+ (gnus-decay-scores): New function.
+ (gnus-decay-score-function): New variable.
+ (gnus-score-date): Accept a `regexp' match.
+
+ * gnus-util.el (gnus-time-to-day): New function.
+
+ * gnus-score.el (gnus-decay-scores): New variable.
+ (gnus-score-decay-constant): New variable.
+ (gnus-score-decay-scale): New variable.
+
+ * gnus-sum.el (gnus-group-make-articles-read): Register undo.
+
+ * gnus-group.el (gnus-update-read-articles): Register undo.
+
+ * gnus-undo.el (gnus-undo-register-1): Renamed.
+ (gnus-undo-register): New macro.
+
+ * gnus-group.el (gnus-group-yank-group): Be undoable.
+ (gnus-group-kill-group): Be undoable.
+ (gnus-undo): Required.
+ (gnus-group-clear-data): New keystroke.
+
+ * gnus-undo.el (gnus-undo-last-command): New variable.
+ (gnus-undo): Didn't work.
+ (gnus-undo-boundary): Keep track of whether the last command did a
+ boundary.
+ (gnus-undo): Set boundary.
+
+Thu Aug 8 19:43:02 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus-spec.el (gnus-tilde-cut-form): New function.
+ (gnus-tilde-max-form): New definition.
+ (gnus-tilde-ignore-form): New function.
+ (gnus-parse-format): Rewrite to accept extended syntax.
+
+ * gnus-topic.el (gnus-topic-goto-missing-group): Try to be a bit
+ faster.
+
+ * gnus-group.el (gnus-group-goto-group): Accept optional FAR
+ parameter.
+
+ * gnus-int.el (gnus-request-newgroups): Don't bug out on servers
+ that don't support this.
+
+ * gnus.el (gnus-server-extend-method): Would bug out on non-known
+ methods.
+
+ * gnus-group.el (gnus-group-get-new-news): Put point in the group
+ buffer.
+
+Wed Aug 7 15:40:44 1996 Jan Vroonhof <vroonhof@math.ethz.ch>
+
+ * nntp.el (nntp-open-rlogin): Now can be used as
+ nntp-open-connection function
+ (nntp-open-telnet): Ditto
+ (nntp-open-rlogin): Needed to remove telnet junk from nntp buffer
+ to make new nntp-wait-for happy
+ all: required carriage return for end of line
+
+Tue Aug 6 21:58:26 1996 Jan Vroonhof <vroonhof@math.ethz.ch (Jan Vroonhof)>
+
+ * nndoc.el (nndoc-generate-lanl-gov-head): New function
+ (nndoc-transform-lanl-gov-announce): New function
+ (nndoc-lanl-gov-announce-type-p): New funtion
+ (nndoc-type-alist): Added support for preprint announcements
+ (nndoc-type-alist): Only use 'slack-digests' if forced to.
+
+Tue Aug 6 20:41:02 1996 Jan Vroonhof <vroonhof@math.ethz.ch>
+
+ * nndoc.el (nndoc-type-alist): tried to call nndoc-guess-type-p
+
+Thu Aug 8 05:40:28 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus-sum.el (gnus-summary-walk-group-buffer): Put cursor in echo
+ area.
+
+ * gnus-dup.el (gnus-dup-unsuppress-article): New function.
+
+ * gnus-sum.el (gnus-mark-article-as-unread): Unsuppress
+ duplicates.
+
+ * gnus-msg.el (gnus-debug): Scan gnus-load.el.
+
+Thu Aug 8 01:48:57 1996 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus.el: Red Gnus v0.8 is released.
+
Thu Aug 8 01:36:34 1996 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
* gnus.el: Red Gnus v0.7 is released.
View
4 lisp/gnus-art.el
@@ -493,8 +493,8 @@ If variable `gnus-use-long-file-name' is non-nil, it is
All normal editing commands are switched off.
-The following commands are available:
-
+The following commands are available in addition to all summary mode
+commands:
\\<gnus-article-mode-map>
\\[gnus-article-next-page]\t Scroll the article one page forwards
\\[gnus-article-prev-page]\t Scroll the article one page backwards
View
7 lisp/gnus-dup.el
@@ -127,6 +127,13 @@ seen in the same session.")
(pop headers)))
(gnus-message 6 "Suppressing duplicates...done"))
+(defun gnus-dup-unsuppress-article (article)
+ "Stop suppression of ARTICLE."
+ (let ((id (mail-header-id (gnus-data-header (gnus-data-find article)))))
+ (when id
+ (setq gnus-duplicate-list (delete id gnus-dup-list))
+ (unintern id gnus-dup-hashtb))))
+
(provide 'gnus-dup)
;;; gnus-dup.el ends here
View
182 lisp/gnus-group.el
@@ -32,6 +32,7 @@
(require 'gnus-int)
(require 'gnus-range)
(require 'gnus-win)
+(require 'gnus-undo)
(defvar gnus-group-archive-directory
"/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list/"
@@ -193,6 +194,7 @@ variable.")
(defvar gnus-group-indentation-function nil)
(defvar gnus-goto-missing-group-function nil)
+(defvar gnus-group-get-parameter-function 'gnus-group-get-parameter)
(defvar gnus-group-goto-next-group-function nil
"Function to override finding the next group after listing groups.")
@@ -273,6 +275,7 @@ variable.")
"U" gnus-group-unsubscribe-group
"c" gnus-group-catchup-current
"C" gnus-group-catchup-current-all
+ "\M-c" gnus-group-clear-data
"l" gnus-group-list-groups
"L" gnus-group-list-all-groups
"m" gnus-group-mail
@@ -1090,7 +1093,15 @@ Returns whether the fetching was successful or not."
;; Enter a group that is not in the group buffer. Non-nil is returned
;; if selection was successful.
(defun gnus-group-read-ephemeral-group
- (group method &optional activate quit-config)
+ (group method &optional activate quit-config request-only)
+ "Read GROUP from METHOD as an ephemeral group.
+If ACTIVATE, request the group first.
+If QUIT-CONFIG, use that window configuration when
+exiting from the ephemeral group.
+If REQUEST-ONLY, don't actually read the group; just
+request it.
+
+Return the name of the group is selection was successful."
(let ((group (if (gnus-group-foreign-p group) group
(gnus-group-prefixed-name group method))))
(gnus-sethash
@@ -1102,12 +1113,16 @@ Returns whether the fetching was successful or not."
(set-buffer gnus-group-buffer)
(unless (gnus-check-server method)
(error "Unable to contact server: %s" (gnus-status-message method)))
- (if activate (or (gnus-request-group group)
- (error "Couldn't request group")))
- (condition-case ()
- (gnus-group-read-group t t group)
- ;(error nil)
- (quit nil))))
+ (when activate
+ (unless (gnus-request-group group)
+ (error "Couldn't request group")))
+ (if request-only
+ group
+ (condition-case ()
+ (when (gnus-group-read-group t t group)
+ group)
+ ;;(error nil)
+ (quit nil)))))
(defun gnus-group-jump-to-group (group)
"Jump to newsgroup GROUP."
@@ -1145,35 +1160,41 @@ Returns whether the fetching was successful or not."
;; Adjust cursor point.
(gnus-group-position-point)))
-(defun gnus-group-goto-group (group)
- "Goto to newsgroup GROUP."
+(defun gnus-group-goto-group (group &optional far)
+ "Goto to newsgroup GROUP.
+If FAR, it is likely that the group is not on the current line."
(when group
- (beginning-of-line)
- (cond
- ;; It's quite likely that we are on the right line, so
- ;; we check the current line first.
- ((eq (get-text-property (point) 'gnus-group)
- (gnus-intern-safe group gnus-active-hashtb))
- (point))
- ;; Previous and next line are also likely, so we check them as well.
- ((save-excursion
+ (if far
+ (gnus-goto-char
+ (text-property-any
+ (point-min) (point-max)
+ 'gnus-group (gnus-intern-safe group gnus-active-hashtb)))
+ (beginning-of-line)
+ (cond
+ ;; It's quite likely that we are on the right line, so
+ ;; we check the current line first.
+ ((eq (get-text-property (point) 'gnus-group)
+ (gnus-intern-safe group gnus-active-hashtb))
+ (point))
+ ;; Previous and next line are also likely, so we check them as well.
+ ((save-excursion
+ (forward-line -1)
+ (eq (get-text-property (point) 'gnus-group)
+ (gnus-intern-safe group gnus-active-hashtb)))
(forward-line -1)
- (eq (get-text-property (point) 'gnus-group)
- (gnus-intern-safe group gnus-active-hashtb)))
- (forward-line -1)
- (point))
- ((save-excursion
+ (point))
+ ((save-excursion
+ (forward-line 1)
+ (eq (get-text-property (point) 'gnus-group)
+ (gnus-intern-safe group gnus-active-hashtb)))
(forward-line 1)
- (eq (get-text-property (point) 'gnus-group)
- (gnus-intern-safe group gnus-active-hashtb)))
- (forward-line 1)
- (point))
- (t
- ;; Search through the entire buffer.
- (gnus-goto-char
- (text-property-any
- (point-min) (point-max)
- 'gnus-group (gnus-intern-safe group gnus-active-hashtb)))))))
+ (point))
+ (t
+ ;; Search through the entire buffer.
+ (gnus-goto-char
+ (text-property-any
+ (point-min) (point-max)
+ 'gnus-group (gnus-intern-safe group gnus-active-hashtb))))))))
(defun gnus-group-next-group (n &optional silent)
"Go to next N'th newsgroup.
@@ -1743,7 +1764,7 @@ If REVERSE, sort in reverse order."
(and (= level1 level2)
(> (gnus-info-score info1) (gnus-info-score info2))))))
-;; Group catching up.
+;;; Clearing data
(defun gnus-group-clear-data (n)
"Clear all marks and read ranges from the current group."
@@ -1751,15 +1772,37 @@ If REVERSE, sort in reverse order."
(let ((groups (gnus-group-process-prefix n))
group info)
(while (setq group (pop groups))
- (setq info (gnus-get-info group))
- (gnus-info-set-read info nil)
- (when (gnus-info-marks info)
- (gnus-info-set-marks info nil))
+ (gnus-info-clear-data (setq info (gnus-get-info group)))
(gnus-get-unread-articles-in-group info (gnus-active group) t)
(when (gnus-group-goto-group group)
(gnus-group-remove-mark group)
(gnus-group-update-group-line)))))
+(defun gnus-group-clear-data-on-native-groups ()
+ "Clear all marks and read ranges from all native groups."
+ (interactive)
+ (when (gnus-yes-or-no-p "Really clear all data from almost all groups? ")
+ (let ((alist (cdr gnus-newsrc-alist))
+ info)
+ (while (setq info (pop alist))
+ (gnus-info-clear-data info))
+ (gnus-get-unread-articles))))
+
+(defun gnus-info-clear-data (info)
+ "Clear all marks and read ranges from INFO."
+ (let ((group (gnus-info-group info)))
+ (gnus-undo-register
+ `(progn
+ (gnus-info-set-marks ,info ,(gnus-info-marks info))
+ (gnus-info-set-read ,info ,(gnus-info-read info))
+ (when (gnus-group-goto-group ,group)
+ (gnus-group-update-group-line))))
+ (gnus-info-set-read info nil)
+ (when (gnus-info-marks info)
+ (gnus-info-set-marks info nil))))
+
+;; Group catching up.
+
(defun gnus-group-catchup-current (&optional n all)
"Mark all articles not marked as unread in current newsgroup as read.
If prefix argument N is numeric, the ARG next newsgroups will be
@@ -1847,7 +1890,7 @@ or nil if no action could be taken."
(expirable (if (gnus-group-total-expirable-p group)
(cons nil (gnus-list-of-read-articles group))
(assq 'expire (gnus-info-marks info))))
- (expiry-wait (gnus-group-get-parameter group 'expiry-wait)))
+ (expiry-wait (gnus-group-find-parameter group 'expiry-wait)))
(when expirable
(setcdr
expirable
@@ -2022,6 +2065,10 @@ of groups killed."
(gnus-delete-line)
(when (and (not discard)
(setq entry (gnus-gethash group gnus-newsrc-hashtb)))
+ (gnus-undo-register
+ `(progn
+ (gnus-group-goto-group ,(gnus-group-group-name))
+ (gnus-group-yank-group)))
(push (cons (car entry) (nth 2 entry))
gnus-list-of-killed-groups))
(gnus-group-change-level
@@ -2073,7 +2120,10 @@ is returned."
info (gnus-info-level (cdr info)) gnus-level-killed
(and prev (gnus-gethash prev gnus-newsrc-hashtb))
t)
- (gnus-group-insert-group-line-info group))
+ (gnus-group-insert-group-line-info group)
+ (gnus-undo-register
+ `(when (gnus-group-goto-group ,group)
+ (gnus-group-kill-group 1))))
(forward-line -1)
(gnus-group-position-point)
(if (< (length out) 2) (car out) (nreverse out))))
@@ -2181,26 +2231,28 @@ If ARG is a number, it specifies which levels you are interested in
re-scanning. If ARG is non-nil and not a number, this will force
\"hard\" re-reading of the active files from all servers."
(interactive "P")
- (run-hooks 'gnus-get-new-news-hook)
- ;; We might read in new NoCeM messages here.
- (when (and gnus-use-nocem
- (null arg))
- (gnus-nocem-scan-groups))
- ;; If ARG is not a number, then we read the active file.
- (when (and arg (not (numberp arg)))
- (let ((gnus-read-active-file t))
- (gnus-read-active-file))
- (setq arg nil))
-
- (setq arg (gnus-group-default-level arg t))
- (if (and gnus-read-active-file (not arg))
- (progn
- (gnus-read-active-file)
- (gnus-get-unread-articles arg))
- (let ((gnus-read-active-file (if arg nil gnus-read-active-file)))
- (gnus-get-unread-articles arg)))
- (run-hooks 'gnus-after-getting-new-news-hook)
- (gnus-group-list-groups))
+ (save-excursion
+ (set-buffer gnus-group-buffer)
+ (run-hooks 'gnus-get-new-news-hook)
+ ;; We might read in new NoCeM messages here.
+ (when (and gnus-use-nocem
+ (null arg))
+ (gnus-nocem-scan-groups))
+ ;; If ARG is not a number, then we read the active file.
+ (when (and arg (not (numberp arg)))
+ (let ((gnus-read-active-file t))
+ (gnus-read-active-file))
+ (setq arg nil))
+
+ (setq arg (gnus-group-default-level arg t))
+ (if (and gnus-read-active-file (not arg))
+ (progn
+ (gnus-read-active-file)
+ (gnus-get-unread-articles arg))
+ (let ((gnus-read-active-file (if arg nil gnus-read-active-file)))
+ (gnus-get-unread-articles arg)))
+ (run-hooks 'gnus-after-getting-new-news-hook)
+ (gnus-group-list-groups)))
(defun gnus-group-get-new-news-this-group (&optional n)
"Check for newly arrived news in the current group (and the N-1 next groups).
@@ -2612,10 +2664,7 @@ and the second element is the address."
(copy-sequence articles)) '<) t))))))
(defun gnus-update-read-articles (group unread)
- "Update the list of read and ticked articles in GROUP using the
-UNREAD and TICKED lists.
-Note: UNSELECTED has to be sorted over `<'.
-Returns whether the updating was successful."
+ "Update the list of read articles in GROUP."
(let* ((active (or gnus-newsgroup-active (gnus-active group)))
(entry (gnus-gethash group gnus-newsrc-hashtb))
(info (nth 2 entry))
@@ -2645,6 +2694,11 @@ Returns whether the updating was successful."
(setq unread (cdr unread)))
(when (<= prev (cdr active))
(setq read (cons (cons prev (cdr active)) read)))
+ (gnus-undo-register
+ `(progn
+ (gnus-info-set-marks ,info ,(gnus-info-marks info))
+ (gnus-info-set-read ,info ,(gnus-info-read info))
+ (gnus-get-unread-articles-in-group ,info (gnus-active ,group))))
;; Enter this list into the group info.
(gnus-info-set-read
info (if (> (length read) 1) (nreverse read) read))
View
5 lisp/gnus-int.el
@@ -192,8 +192,9 @@ If it is down, start it up (again)."
"Request all new groups since DATE from METHOD."
(when (stringp method)
(setq method (gnus-server-to-method method)))
- (funcall (gnus-get-function method 'request-newgroups)
- date (nth 1 method)))
+ (let ((func (gnus-get-function method 'request-newgroups t)))
+ (when func
+ (funcall func date (nth 1 method)))))
(defun gnus-server-opened (method)
"Check whether a connection to METHOD has been opened."
View
4 lisp/gnus-load.el
@@ -471,6 +471,7 @@ It is called with three parameters -- GROUP, LEVEL and OLDLEVEL.")
'((gnus-group-mode "(gnus)The Group Buffer")
(gnus-summary-mode "(gnus)The Summary Buffer")
(gnus-article-mode "(gnus)The Article Buffer")
+ (mime/viewer-mode "(gnus)The Article Buffer")
(gnus-server-mode "(gnus)The Server Buffer")
(gnus-browse-mode "(gnus)Browse Foreign Server")
(gnus-tree-mode "(gnus)Tree Display"))
@@ -699,7 +700,8 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.")
("gnus-move" :interactive t
gnus-group-move-group-to-server gnus-change-server)
("gnus-logic" gnus-score-advanced)
- ("gnus-undo" gnus-undo-mode gnus-undo-register)
+ ("gnus-undo" gnus-undo-mode gnus-undo-register
+ gnus-dup-unsuppress-article)
("gnus-async" gnus-async-request-fetched-article gnus-async-prefetch-next
gnus-async-prefetch-article gnus-async-prefetch-remove-group)
("gnus-vm" :interactive t gnus-summary-save-in-vm
View
41 lisp/gnus-msg.el
@@ -319,9 +319,9 @@ header line with the old Message-ID."
(pgroup group)
to-address to-group mailing-list to-list)
(when group
- (setq to-address (gnus-group-get-parameter group 'to-address)
- to-group (gnus-group-get-parameter group 'to-group)
- to-list (gnus-group-get-parameter group 'to-list)
+ (setq to-address (gnus-group-find-parameter group 'to-address)
+ to-group (gnus-group-find-parameter group 'to-group)
+ to-list (gnus-group-find-parameter group 'to-list)
mailing-list (when gnus-mailing-list-groups
(string-match gnus-mailing-list-groups group))
group (gnus-group-real-name group)))
@@ -532,7 +532,7 @@ If prefix argument YANK is non-nil, original article is yanked automatically."
(gnus-setup-message (if yank 'reply-yank 'reply)
(gnus-summary-select-article)
(set-buffer (gnus-copy-article-buffer))
- (message-reply nil nil (gnus-group-get-parameter
+ (message-reply nil nil (gnus-group-find-parameter
gnus-newsgroup-name 'broken-reply-to))
(when yank
(gnus-inews-yank-articles yank)))))
@@ -682,6 +682,8 @@ If YANK is non-nil, include the original article."
(defun gnus-bug ()
"Send a bug report to the Gnus maintainers."
(interactive)
+ (unless (gnus-alive-p)
+ (error "Gnus has been shut down"))
(gnus-setup-message 'bug
(delete-other-windows)
(switch-to-buffer "*Gnus Help Bug*")
@@ -710,7 +712,7 @@ If YANK is non-nil, include the original article."
"Attemps to go through the Gnus source file and report what variables have been changed.
The source file has to be in the Emacs load path."
(interactive)
- (let ((files '("gnus-sum.el" "gnus-group.el"
+ (let ((files '("gnus-load.el" "gnus-sum.el" "gnus-group.el"
"gnus-art.el" "gnus-start.el"
"gnus-msg.el" "gnus-score.el"
"nnmail.el" "message.el"))
@@ -866,6 +868,7 @@ this is a reply."
(let* ((var gnus-message-archive-group)
(group (or group gnus-newsgroup-name ""))
result
+ gcc-self-val
(groups
(cond
((null gnus-message-archive-method)
@@ -909,13 +912,27 @@ this is a reply."
(gnus-inews-narrow-to-headers)
(goto-char (point-max))
(insert "Gcc: ")
- (while (setq name (pop groups))
- (insert (if (string-match ":" name)
- name
- (gnus-group-prefixed-name
- name gnus-message-archive-method)))
- (if groups (insert " ")))
- (insert "\n"))))))
+ (if (and gnus-newsgroup-name
+ (setq gcc-self-val
+ (gnus-group-get-parameter
+ gnus-newsgroup-name 'gcc-self)))
+ (progn
+ (insert
+ (if (stringp gcc-self-val)
+ gcc-self-val
+ group))
+ (if (not (eq gcc-self-val 'none))
+ (insert "\n")
+ (progn
+ (beginning-of-line)
+ (kill-line))))
+ (while (setq name (pop groups))
+ (insert (if (string-match ":" name)
+ name
+ (gnus-group-prefixed-name
+ name gnus-message-archive-method)))
+ (if groups (insert " ")))
+ (insert "\n")))))))
(defun gnus-summary-send-draft ()
"Enter a mail/post buffer to edit and send the draft."
View
102 lisp/gnus-score.el
@@ -110,6 +110,19 @@ will be expired along with non-matching score entries.")
(defvar gnus-orphan-score nil
"*All orphans get this score added. Set in the score file.")
+(defvar gnus-decay-scores nil
+ "*If non-nil, decay non-permanent scores.")
+
+(defvar gnus-decay-score-function 'gnus-decay-score
+ "*Function called to decay a score.
+It is called with one parameter -- the score to be decayed.")
+
+(defvar gnus-score-decay-constant 3
+ "*Decay all \"small\" scores with this amount.")
+
+(defvar gnus-score-decay-scale .05
+ "*Decay all \"big\" scores with this factor.")
+
(defvar gnus-home-score-file nil
"Variable to control where interative score entries are to go.
It can be:
@@ -561,7 +574,7 @@ used as score."
(defun gnus-newsgroup-score-alist ()
(or
- (let ((param-file (gnus-group-get-parameter
+ (let ((param-file (gnus-group-find-parameter
gnus-newsgroup-name 'score-file)))
(when param-file
(gnus-score-load param-file)))
@@ -782,7 +795,7 @@ SCORE is the score to add."
(when (gnus-buffer-live-p gnus-summary-buffer)
(save-excursion
(save-restriction
- (goto-char (point-min))
+ (message-narrow-to-headers)
(let ((id (mail-fetch-field "message-id")))
(when id
(set-buffer gnus-summary-buffer)
@@ -948,7 +961,13 @@ SCORE is the score to add."
(car (gnus-score-get 'thread-mark-and-expunge alist)))
(adapt-file (car (gnus-score-get 'adapt-file alist)))
(local (gnus-score-get 'local alist))
+ (decay (car (gnus-score-get 'decay alist)))
(eval (car (gnus-score-get 'eval alist))))
+ ;; Perform possible decays.
+ (when (and gnus-decay-scores
+ (gnus-decay-scores alist decay))
+ (gnus-score-set 'touched '(t) alist)
+ (gnus-score-set 'decay (list (gnus-time-to-day (current-time)))))
;; We do not respect eval and files atoms from global score
;; files.
(and files (not global)
@@ -1389,7 +1408,7 @@ SCORE is the score to add."
(defun gnus-score-date (scores header now expire &optional trace)
(let ((gnus-score-index (nth 1 (assoc header gnus-header-index)))
- entries alist)
+ entries alist match match-func article)
;; Find matches.
(while scores
@@ -1399,37 +1418,40 @@ SCORE is the score to add."
(while (cdr entries) ;First entry is the header index.
(let* ((rest (cdr entries))
(kill (car rest))
- (match (timezone-make-date-sortable (nth 0 kill)))
(type (or (nth 3 kill) 'before))
(score (or (nth 1 kill) gnus-score-interactive-default-score))
(date (nth 2 kill))
(found nil)
- (match-func
- (cond ((eq type 'after) 'string<)
- ((eq type 'before) 'gnus-string>)
- ((eq type 'at) 'string=)
- (t (error "Illegal match type: %s" type))))
(articles gnus-scores-articles)
l)
+ (cond
+ ((eq type 'after)
+ (setq match-func 'string<
+ match (gnus-date-iso8601 (nth 0 kill))))
+ ((eq type 'before)
+ (setq match-func 'gnus-string>
+ match (gnus-date-iso8601 (nth 0 kill))))
+ ((eq type 'at)
+ (setq match-func 'string=
+ match (gnus-date-iso8601 (nth 0 kill))))
+ ((eq type 'regexp)
+ (setq match-func 'string-match
+ match (nth 0 kill)))
+ (t (error "Illegal match type: %s" type)))
;; Instead of doing all the clever stuff that
;; `gnus-score-string' does to minimize searches and stuff,
;; I will assume that people generally will put so few
;; matches on numbers that any cleverness will take more
;; time than one would gain.
- (while articles
- (and
- (setq l (aref (caar articles) gnus-score-index))
- (funcall match-func match (timezone-make-date-sortable l))
- (progn
- (and trace (setq gnus-score-trace
- (cons
- (cons
- (car-safe (rassq alist gnus-score-cache))
- kill)
- gnus-score-trace)))
- (setq found t)
- (setcdr (car articles) (+ score (cdar articles)))))
- (setq articles (cdr articles)))
+ (while (setq article (pop articles))
+ (when (and
+ (setq l (aref (car article) gnus-score-index))
+ (funcall match-func match (gnus-date-iso8601 l)))
+ (when trace
+ (push (cons (car-safe (rassq alist gnus-score-cache)) kill)
+ gnus-score-trace))
+ (setq found t)
+ (setcdr article (+ score (cdr article)))))
;; Update expire date
(cond ((null date)) ;Permanent entry.
((and found gnus-update-score-entry-dates) ;Match, update date.
@@ -2377,7 +2399,7 @@ The list is determined from the variable gnus-score-file-alist."
(push home score-files)
(setq gnus-newsgroup-adaptive-score-file home)))
;; Check whether there is a `adapt-file' group parameter.
- (let ((param-file (gnus-group-get-parameter group 'adapt-file)))
+ (let ((param-file (gnus-group-find-parameter group 'adapt-file)))
(when param-file
(push param-file score-files)
(setq gnus-newsgroup-adaptive-score-file param-file)))
@@ -2393,7 +2415,7 @@ The list is determined from the variable gnus-score-file-alist."
(when home
(push home score-files)))
;; Check whether there is a `score-file' group parameter.
- (let ((param-file (gnus-group-get-parameter group 'score-file)))
+ (let ((param-file (gnus-group-find-parameter group 'score-file)))
(when param-file
(push param-file score-files)))
;; Do the scoring if there are any score files for this group.
@@ -2492,9 +2514,37 @@ If ADAPT, return the home adaptive file instead."
(concat group "." gnus-adaptive-file-suffix)))
;;;
-;;; Adaptive word scoring
+;;; Score decays
;;;
+(defun gnus-decay-score (score)
+ "Decay SCORE."
+ (floor
+ (- score
+ (* (if (< score 0) 1 -1)
+ (min score
+ (max gnus-score-decay-constant
+ (* (abs score)
+ gnus-score-decay-scale)))))))
+
+(defun gnus-decay-scores (alist day)
+ "Decay non-permanent scores in ALIST."
+ (let ((times (- (gnus-time-to-day (current-time)) day))
+ kill entry updated score n)
+ (unless (zerop times) ;Done decays today already?
+ (while (setq entry (pop alist))
+ (when (stringp (car entry))
+ (setq entry (cdr entry))
+ (while (setq kill (pop entry))
+ (when (nth 2 kill)
+ (setq updated t)
+ (setq score (or (car kill) gnus-score-interactive-default-score)
+ n times)
+ (while (natnump (decf n))
+ (setq score (funcall gnus-decay-score-function score)))
+ (setcar kill score))))))
+ ;; Return whether this score file needs to be saved. By Je-haysuss!
+ updated))
(provide 'gnus-score)
View
3  lisp/gnus-soup.el
@@ -326,7 +326,8 @@ If NOT-ALL, don't pack ticked articles."
(while prefix
(gnus-set-work-buffer)
(insert (format "(setq gnus-soup-prev-prefix %d)\n" (cdar prefix)))
- (make-directory (caar prefix) t)
+ (unless (file-exists-p (caar prefix))
+ (make-directory (caar prefix) t))
(write-region (point-min) (point-max)
(concat (caar prefix) gnus-soup-prefix-file)
nil 'nomesg)
View
189 lisp/gnus-spec.el
@@ -242,18 +242,46 @@
(point) (progn ,@form (point))
'face ',(symbol-value (intern (format "gnus-face-%d" type)))))
-(defun gnus-max-width-function (el max-width)
- (or (numberp max-width) (signal 'wrong-type-argument '(numberp max-width)))
+(defun gnus-tilde-max-form (el max-width)
+ "Return a form that limits EL to MAX-WIDTH."
+ (let ((max (abs max-width)))
+ (if (symbolp el)
+ `(if (> (length ,el) ,max)
+ ,(if (< max-width 0)
+ `(substring ,el (- (length el) ,max))
+ `(substring ,el 0 ,max))
+ ,el)
+ `(let ((val (eval ,el)))
+ (if (> (length val) ,max)
+ ,(if (< max-width 0)
+ `(substring val (- (length val) ,max))
+ `(substring val 0 ,max))
+ val)))))
+
+(defun gnus-tilde-cut-form (el cut-width)
+ "Return a form that cuts CUT-WIDTH off of EL."
+ (let ((cut (abs cut-width)))
+ (if (symbolp el)
+ `(if (> (length ,el) ,cut)
+ ,(if (< cut-width 0)
+ `(substring ,el 0 (- (length el) ,cut))
+ `(substring ,el ,cut))
+ ,el)
+ `(let ((val (eval ,el)))
+ (if (> (length val) ,cut)
+ ,(if (< cut-width 0)
+ `(substring val 0 (- (length val) ,cut))
+ `(substring va 0 ,cut))
+ val)))))
+
+(defun gnus-tilde-ignore-form (el ignore-value)
+ "Return a form that is blank when EL is IGNORE-VALUE."
(if (symbolp el)
- `(if (> (length ,el) ,max-width)
- (substring ,el 0 ,max-width)
- ,el)
+ `(if (equal ,el ,ignore-value)
+ "" ,el)
`(let ((val (eval ,el)))
- (if (numberp val)
- (setq val (int-to-string val)))
- (if (> (length val) ,max-width)
- (substring val 0 ,max-width)
- val))))
+ (if (equal val ,ignore-value)
+ "" val))))
(defun gnus-parse-format (format spec-alist &optional insert)
;; This function parses the FORMAT string with the help of the
@@ -306,55 +334,110 @@
;; SPEC-ALIST and returns a list that can be eval'ed to return a
;; string.
(let ((max-width 0)
- spec flist fstring newspec elem beg result dontinsert)
+ spec flist fstring newspec elem beg result dontinsert user-defined
+ type spec value pad-width spec-beg cut-width ignore-value
+ tilde-form tilde elem-type)
(save-excursion
(gnus-set-work-buffer)
(insert format)
(goto-char (point-min))
- (while (re-search-forward "%[-0-9]*\\(,[0-9]+\\)?\\([^0-9]\\)\\(.\\)?"
- nil t)
- (if (= (setq spec (string-to-char (match-string 2))) ?%)
- (setq newspec "%"
- beg (1+ (match-beginning 0)))
- ;; First check if there are any specs that look anything like
- ;; "%12,12A", ie. with a "max width specification". These have
- ;; to be treated specially.
- (if (setq beg (match-beginning 1))
- (setq max-width
- (string-to-int
- (buffer-substring
- (1+ (match-beginning 1)) (match-end 1))))
- (setq max-width 0)
- (setq beg (match-beginning 2)))
- ;; Find the specification from `spec-alist'.
- (unless (setq elem (cdr (assq spec spec-alist)))
- (setq elem '("*" ?s)))
- ;; Treat user defined format specifiers specially.
- (when (eq (car elem) 'gnus-tmp-user-defined)
+ (while (re-search-forward "%" nil t)
+ (setq user-defined nil
+ spec-beg nil
+ pad-width nil
+ max-width nil
+ cut-width nil
+ ignore-value nil
+ tilde-form nil)
+ (setq spec-beg (1- (point)))
+
+ ;; Parse this spec fully.
+ (while
+ (cond
+ ((looking-at "\\([-.0-9]+\\)\\(,[-0-9]+\\)?")
+ (setq pad-width (string-to-number (match-string 1)))
+ (when (match-beginning 2)
+ (setq max-width (string-to-number (buffer-substring
+ (1+ (match-beginning 2))
+ (match-end 2)))))
+ (goto-char (match-end 0)))
+ ((looking-at "~")
+ (forward-char 1)
+ (setq tilde (read (current-buffer))
+ type (car tilde)
+ value (cadr tilde))
+ (cond
+ ((memq type '(pad pad-left))
+ (setq pad-width value))
+ ((eq type 'pad-right)
+ (setq pad-width (- value)))
+ ((eq type 'max)
+ (setq max-width value))
+ ((memq type '(cut cut-left))
+ (setq cut-width value))
+ ((eq type 'cut-right)
+ (setq cut-width (- value)))
+ ((eq type 'ignore)
+ (setq ignore-value
+ (if (stringp value) value (format "%s" value))))
+ ((eq type 'form)
+ (setq tilde-form value))
+ (t
+ (error "Unknown tilde type: %s" tilde)))
+ t)
+ (t
+ nil)))
+ (when (= (setq spec (following-char)) ?u)
+ (forward-char 1)
+ (setq user-defined (following-char)))
+ (forward-char 1)
+ (delete-region spec-beg (point))
+
+ ;; Now we have all the relevant data on this spec, so
+ ;; we start doing stuff.
+ (insert "%")
+ (if (eq spec ?%)
+ ;; "%%" just results in a "%".
+ (insert "%")
+ (cond
+ ;; Do tilde forms.
+ ((eq spec ?@)
+ (setq elem (list tilde-form ?s)))
+ ;; Treat user defined format specifiers specially.
+ (user-defined
(setq elem
(list
- (list (intern (concat "gnus-user-format-function-"
- (match-string 3)))
- 'gnus-tmp-header) ?s))
- (delete-region (match-beginning 3) (match-end 3)))
- (if (not (zerop max-width))
- (let ((el (car elem)))
- (cond ((= (cadr elem) ?c)
- (setq el (list 'char-to-string el)))
- ((= (cadr elem) ?d)
- (setq el (list 'int-to-string el))))
- (setq flist (cons (gnus-max-width-function el max-width)
- flist))
- (setq newspec ?s))
- (progn
- (setq flist (cons (car elem) flist))
- (setq newspec (cadr elem)))))
- ;; Remove the old specification (and possibly a ",12" string).
- (delete-region beg (match-end 2))
- ;; Insert the new specification.
- (goto-char beg)
- (insert newspec))
- (setq fstring (buffer-substring 1 (point-max))))
+ (list (intern (format "gnus-user-format-function-%c"
+ user-defined))
+ 'gnus-tmp-header) ?s)))
+ ;; Find the specification from `spec-alist'.
+ ((setq elem (cdr (assq spec spec-alist))))
+ (t
+ (setq elem '("*" ?s))))
+ (setq elem-type (cadr elem))
+ ;; Insert the new format elements.
+ (when pad-width
+ (insert (number-to-string pad-width)))
+ ;; Create the form to be evaled.
+ (if (or max-width cut-width ignore-value)
+ (progn
+ (insert ?s)
+ (let ((el (car elem)))
+ (cond ((= (cadr elem) ?c)
+ (setq el (list 'char-to-string el)))
+ ((= (cadr elem) ?d)
+ (setq el (list 'int-to-string el))))
+ (when ignore-value
+ (setq el (gnus-tilde-ignore-form el ignore-value)))
+ (when cut-width
+ (setq el (gnus-tilde-cut-form el cut-width)))
+ (when max-width
+ (setq el (gnus-tilde-max-form el max-width)))
+ (push el flist)))
+ (insert elem-type)
+ (push (car elem) flist))))
+ (setq fstring (buffer-string)))
+
;; Do some postprocessing to increase efficiency.
(setq
result
View
115 lisp/gnus-sum.el
@@ -30,6 +30,7 @@
(require 'gnus-spec)
(require 'gnus-range)
(require 'gnus-int)
+(require 'gnus-undo)
(require 'gnus)
@@ -882,6 +883,7 @@ increase the score of each group you read."
"l" gnus-summary-goto-last-article
"\C-c\C-v\C-v" gnus-uu-decode-uu-view
"\C-d" gnus-summary-enter-digest-group
+ "\M-\C-d" gnus-summary-read-document
"\C-c\C-b" gnus-bug
"*" gnus-cache-enter-article
"\M-*" gnus-cache-remove-article
@@ -1641,7 +1643,7 @@ This is all marks except unread, ticked, dormant, and expirable."
(defun gnus-summary-set-local-parameters (group)
"Go through the local params of GROUP and set all variable specs in that list."
- (let ((params (gnus-info-params (gnus-get-info group)))
+ (let ((params (gnus-group-find-parameter group))
elem)
(while params
(setq elem (car params)
@@ -3101,6 +3103,7 @@ The resulting hash table is returned, or nil if no Xrefs were found."
xref-hashtb)))))
(defun gnus-group-make-articles-read (group articles)
+ "Update the info of GROUP to say that only ARTICLES are unread."
(let* ((num 0)
(entry (gnus-gethash group gnus-newsrc-hashtb))
(info (nth 2 entry))
@@ -3125,6 +3128,11 @@ The resulting hash table is returned, or nil if no Xrefs were found."
(when (or (> id (cdr active))
(< id (car active)))
(setq articles (delq id articles))))))
+ (gnus-undo-register
+ `(progn
+ (gnus-info-set-marks ,info ,(gnus-info-marks info))
+ (gnus-info-set-read ,info ,(gnus-info-read info))
+ (gnus-group-update-group group t)))
;; If the read list is nil, we init it.
(and active
(null (gnus-info-read info))
@@ -3138,25 +3146,24 @@ The resulting hash table is returned, or nil if no Xrefs were found."
(gnus-info-read info) (setq articles (sort articles '<)))))
;; Then we have to re-compute how many unread
;; articles there are in this group.
- (if active
- (progn
- (cond
- ((not range)
- (setq num (- (1+ (cdr active)) (car active))))
- ((not (listp (cdr range)))
- (setq num (- (cdr active) (- (1+ (cdr range))
- (car range)))))
- (t
- (while range
- (if (numberp (car range))
- (setq num (1+ num))
- (setq num (+ num (- (1+ (cdar range)) (caar range)))))
- (setq range (cdr range)))
- (setq num (- (cdr active) num))))
- ;; Update the number of unread articles.
- (setcar entry num)
- ;; Update the group buffer.
- (gnus-group-update-group group t)))))
+ (when active
+ (cond
+ ((not range)
+ (setq num (- (1+ (cdr active)) (car active))))
+ ((not (listp (cdr range)))
+ (setq num (- (cdr active) (- (1+ (cdr range))
+ (car range)))))
+ (t
+ (while range
+ (if (numberp (car range))
+ (setq num (1+ num))
+ (setq num (+ num (- (1+ (cdar range)) (caar range)))))
+ (setq range (cdr range)))
+ (setq num (- (cdr active) num))))
+ ;; Update the number of unread articles.
+ (setcar entry num)
+ ;; Update the group buffer.
+ (gnus-group-update-group group t))))
(defun gnus-methods-equal-p (m1 m2)
(let ((m1 (or m1 gnus-select-method))
@@ -4345,6 +4352,7 @@ If BACKWARD, the previous article is selected instead of the next."
(defun gnus-summary-walk-group-buffer (from-group cmd unread backward)
(let ((keystrokes '((?\C-n (gnus-group-next-unread-group 1))
(?\C-p (gnus-group-prev-unread-group 1))))
+ (cursor-in-echo-area t)
keve key group ended)
(save-excursion
(set-buffer gnus-group-buffer)
@@ -4398,7 +4406,7 @@ If UNREAD is non-nil, only unread articles are selected."
(gnus-summary-next-article unread subject t))
(defun gnus-summary-prev-unread-article ()
- "Select unred article before current one."
+ "Select unread article before current one."
(interactive)
(gnus-summary-prev-article t (and gnus-auto-select-same
(gnus-summary-article-subject))))
@@ -5034,7 +5042,9 @@ Return how many articles were fetched."
(gnus-message 3 "Couldn't fetch article %s" message-id)))))))
(defun gnus-summary-enter-digest-group (&optional force)
- "Enter a digest group based on the current article."
+ "Enter an nndoc group based on the current article.
+If FORCE, force a digest interpretation. If not, try
+to guess what the document format is."
(interactive "P")
(gnus-set-global-variables)
(gnus-summary-select-article)
@@ -5070,6 +5080,49 @@ Return how many articles were fetched."
(gnus-message 3 "Article couldn't be entered?"))
(kill-buffer dig))))
+(defun gnus-summary-read-document (n)
+ "Open a new group based on the current article(s).
+Obeys the standard process/prefix convention."
+ (interactive "P")
+ (let ((articles (gnus-summary-work-articles n))
+ (ogroup gnus-newsgroup-name)
+ article group egroup groups vgroup)
+ (while (setq article (pop articles))
+ (setq group (format "%s-%d" gnus-newsgroup-name gnus-current-article))
+ (gnus-summary-remove-process-mark article)
+ (when (gnus-summary-display-article article)
+ (save-excursion
+ (nnheader-temp-write nil
+ (insert-buffer-substring gnus-original-article-buffer)
+ ;; Remove some headers that may lead nndoc to make
+ ;; the wrong guess.
+ (message-narrow-to-head)
+ (goto-char (point-min))
+ (delete-matching-lines "^\\(Path\\):\\|^From ")
+ (widen)
+ (if (setq egroup
+ (gnus-group-read-ephemeral-group
+ group `(nndoc ,group (nndoc-address ,(current-buffer))
+ (nndoc-article-type guess))
+ t nil t))
+ (progn
+ ;; Make all postings to this group go to the parent group.
+ (nconc (gnus-info-params (gnus-get-info egroup))
+ (list (cons 'to-group ogroup)))
+ (push egroup groups))
+ ;; Couldn't select this doc group.
+ (gnus-error 3 "Article couldn't be entered"))))))
+ ;; Now we have selected all the documents.
+ (cond
+ ((not groups)
+ (error "None of the articles could be interpreted as documents"))
+ ((gnus-group-read-ephemeral-group
+ (setq vgroup (format "%s-%s" gnus-newsgroup-name (current-time-string)))
+ `(nnvirtual ,vgroup (nnvirtual-component-groups ,groups))
+ t))
+ (t
+ (error "Couldn't select virtual nndoc group")))))
+
(defun gnus-summary-isearch-article (&optional regexp-p)
"Do incremental search forward on the current article.
If REGEXP-P (the prefix) is non-nil, do regexp isearch."
@@ -5626,7 +5679,7 @@ latter case, they will be copied into the relevant groups."
(setq gnus-newsgroup-expirable
(sort gnus-newsgroup-expirable '<))))
(expiry-wait (if now 'immediate
- (gnus-group-get-parameter
+ (gnus-group-find-parameter
gnus-newsgroup-name 'expiry-wait)))
es)
(when expirable
@@ -5641,7 +5694,8 @@ latter case, they will be copied into the relevant groups."
expirable gnus-newsgroup-name)))
(setq es (gnus-request-expire-articles
expirable gnus-newsgroup-name)))
- (or total (setq gnus-newsgroup-expirable es))
+ (unless total
+ (setq gnus-newsgroup-expirable es))
;; We go through the old list of expirable, and mark all
;; really expired articles as nonexistent.
(unless (eq es expirable) ;If nothing was expired, we don't mark.
@@ -6175,10 +6229,15 @@ marked."
(defun gnus-mark-article-as-unread (article &optional mark)
"Enter ARTICLE in the pertinent lists and remove it from others."
(let ((mark (or mark gnus-ticked-mark)))
- (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
- (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
- (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable))
- (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads))
+ (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked)
+ gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant)
+ gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable)
+ gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads))
+
+ ;; Unsuppress duplicates?
+ (when gnus-suppress-duplicates
+ (gnus-dup-unsuppress-article article))
+
(cond ((= mark gnus-ticked-mark)
(push article gnus-newsgroup-marked))
((= mark gnus-dormant-mark)
View
34 lisp/gnus-topic.el
@@ -276,7 +276,7 @@ with some simple extensions.
(let ((top (gnus-topic-find-topology topic)))
(unless top
(error "No such topic: %s" topic))
- (nth 2 (car top))))
+ (nth 3 (cadr top))))
(defun gnus-topic-set-parameters (topic parameters)
"Set the topic parameters of TOPIC to PARAMETERS."
@@ -287,7 +287,9 @@ with some simple extensions.
;; to begin with.
(unless (nthcdr 2 (car top))
(nconc (car top) (list nil)))
- (setcar (nthcdr 2 (car top)) parameters)))
+ (unless (nthcdr 3 (car top))
+ (nconc (car top) (list nil)))
+ (setcar (nthcdr 3 (car top)) parameters)))
(defun gnus-group-topic-parameters (group)
"Compute the group parameters for GROUP taking into account inheretance from topics."
@@ -496,14 +498,14 @@ articles in the topic and its subtopics."
(groups (cdr (assoc topic gnus-topic-alist)))
(g (cdr (member group groups)))
(unfound t))
- (while (and g unfound)
- (when (gnus-group-goto-group (pop g))
- (beginning-of-line)
- (setq unfound nil)))
- (when unfound
+ ;; Try to jump to a visible group.
+ (while (and g (not (gnus-group-goto-group (car g) t)))
+ (pop g))
+ ;; It wasn't visible, so we try to see where to insert it.
+ (when (not g)
(setq g (cdr (member group (reverse groups))))
(while (and g unfound)
- (when (gnus-group-goto-group (pop g))
+ (when (gnus-group-goto-group (pop g) t)
(forward-line 1)
(setq unfound nil)))
(when unfound
@@ -851,16 +853,16 @@ articles in the topic and its subtopics."
(add-hook 'gnus-summary-exit-hook 'gnus-topic-update-topic)
(add-hook 'gnus-group-catchup-group-hook 'gnus-topic-update-topic)
(add-hook 'gnus-group-update-group-hook 'gnus-topic-update-topic)
- (make-local-variable 'gnus-group-prepare-function)
- (setq gnus-group-prepare-function 'gnus-group-prepare-topics)
- (make-local-variable 'gnus-group-goto-next-group-function)
- (setq gnus-group-goto-next-group-function
- 'gnus-topic-goto-next-group)
+ (set (make-local-variable 'gnus-group-prepare-function)
+ 'gnus-group-prepare-topics)
+ (set (make-local-variable 'gnus-group-get-parameter-function)
+ 'gnus-group-topic-parameters)
+ (set (make-local-variable 'gnus-group-goto-next-group-function)
+ 'gnus-topic-goto-next-group)
+ (set (make-local-variable 'gnus-group-indentation-function)
+ 'gnus-topic-group-indentation)
(setq gnus-group-change-level-function 'gnus-topic-change-level)
(setq gnus-goto-missing-group-function 'gnus-topic-goto-missing-group)
- (make-local-variable 'gnus-group-indentation-function)
- (setq gnus-group-indentation-function
- 'gnus-topic-group-indentation)
(gnus-make-local-hook 'gnus-check-bogus-groups-hook)
(add-hook 'gnus-check-bogus-groups-hook 'gnus-topic-clean-alist)
(setq gnus-topology-checked-p nil)
View
37 lisp/gnus-undo.el
@@ -57,6 +57,7 @@
(defvar gnus-undo-actions nil)
(defvar gnus-undo-boundary t)
(defvar gnus-undo-last nil)
+(defvar gnus-undo-boundary-inhibit nil)
;;; Minor mode definition.
@@ -113,9 +114,23 @@
(defun gnus-undo-boundary ()
"Set Gnus undo boundary."
- (setq gnus-undo-boundary t))
+ (if gnus-undo-boundary-inhibit
+ (setq gnus-undo-boundary-inhibit nil)
+ (setq gnus-undo-boundary t)))
-(defun gnus-undo-register (function)
+(defun gnus-undo-register (form)
+ "Register FORMS as something to be performed to undo a change.
+FORMS may use backtick quote syntax."
+ (when gnus-undo-mode
+ (gnus-undo-register-1
+ `(lambda ()
+ ,@form))))
+
+(put 'gnus-undo-register 'lisp-indent-function 0)
+(put 'gnus-undo-register 'lisp-indent-hook 0)
+(put 'gnus-undo-register 'edebug-form-spec '(body))
+
+(defun gnus-undo-register-1 (function)
"Register FUNCTION as something to be performed to undo a change."
(when gnus-undo-mode
(cond
@@ -128,7 +143,8 @@
(setcar gnus-undo-actions (cons function (car gnus-undo-actions))))
;; Initialize list.
(t
- (setq gnus-undo-actions (list (list function)))))))
+ (setq gnus-undo-actions (list (list function)))))
+ (setq gnus-undo-boundary-inhibit t)))
(defun gnus-undo (n)
"Undo some previous changes in Gnus buffers.
@@ -137,16 +153,17 @@ A numeric argument serves as a repeat count."
(interactive "p")
(unless gnus-undo-mode
(error "Undoing is not enabled in this buffer"))
+ (message "%s" last-command)
(when (or (not (eq last-command 'gnus-undo))
(not gnus-undo-last))
(setq gnus-undo-last gnus-undo-actions))
- (let (actions action)
- (while (setq actions (pop gnus-undo-last))
- (unless action
- (error "Nothing further to undo"))
- (setq gnus-undo-actions (delq action gnus-undo-actions))
- (while action
- (funcall (pop action))))))
+ (let ((action (pop gnus-undo-last)))
+ (unless action
+ (error "Nothing further to undo"))
+ (setq gnus-undo-actions (delq action gnus-undo-actions))
+ (setq gnus-undo-boundary t)
+ (while action
+ (funcall (pop action)))))
(provide 'gnus-undo)
View
12 lisp/gnus-util.el
@@ -228,6 +228,12 @@
(timezone-absolute-from-gregorian
(nth 1 dat) (nth 2 dat) (car dat))))
+(defun gnus-time-to-day (time)
+ "Convert TIME to day number."
+ (let ((tim (decode-time time)))
+ (timezone-absolute-from-gregorian
+ (nth 4 tim) (nth 3 tim) (nth 5 tim))))
+
(defun gnus-encode-date (date)
"Convert DATE to internal time."
(let* ((parse (timezone-parse-date date))
@@ -342,8 +348,10 @@
(defun gnus-date-iso8601 (header)
"Convert the date field in HEADER to YYMMDDTHHMMSS"
- (format-time-string "%y%m%dT%H%M%S"
- (nnmail-date-to-time (mail-header-date header))))
+ (condition-case ()
+ (format-time-string "%Y%m%dT%H%M%S"
+ (nnmail-date-to-time (mail-header-date header)))
+ (error "")))
(defun gnus-mode-string-quote (string)
"Quote all \"%\" in STRING."
View
34 lisp/gnus.el
@@ -28,7 +28,7 @@
(eval '(run-hooks 'gnus-load-hook))
-(defconst gnus-version-number "0.8"
+(defconst gnus-version-number "0.9"
"Version number for this version of Gnus.")
(defconst gnus-version (format "Red Gnus v%s" gnus-version-number)
@@ -317,9 +317,8 @@ If ARG, insert string at point."
"Find Info documentation of Gnus."
(interactive)
;; Enlarge info window if needed.
- (let ((mode major-mode)
- gnus-info-buffer)
- (Info-goto-node (cadr (assq mode gnus-info-nodes)))
+ (let (gnus-info-buffer)
+ (Info-goto-node (cadr (assq major-mode gnus-info-nodes)))
(setq gnus-info-buffer (current-buffer))
(gnus-configure-windows 'info)))
@@ -334,7 +333,7 @@ that that variable is buffer-local to the summary buffers."
(defun gnus-group-total-expirable-p (group)
"Check whether GROUP is total-expirable or not."
- (let ((params (gnus-info-params (gnus-get-info group))))
+ (let ((params (gnus-group-find-parameter group)))
(or (memq 'total-expire params)
(cdr (assq 'total-expire params)) ; (total-expire . t)
(and gnus-total-expirable-newsgroups ; Check var.
@@ -342,7 +341,7 @@ that that variable is buffer-local to the summary buffers."
(defun gnus-group-auto-expirable-p (group)
"Check whether GROUP is total-expirable or not."
- (let ((params (gnus-info-params (gnus-get-info group))))
+ (let ((params (gnus-group-find-parameter group)))
(or (memq 'auto-expire params)
(cdr (assq 'auto-expire params)) ; (auto-expire . t)
(and gnus-auto-expirable-newsgroups ; Check var.
@@ -559,8 +558,18 @@ that that variable is buffer-local to the summary buffers."
"Say whether the group is secondary or not."
(gnus-secondary-method-p (gnus-find-method-for-group group)))
+(defun gnus-group-find-parameter (group &optional symbol)
+ "Return the group parameters for GROUP.
+If SYMBOL, return the value of that symbol in the group parameters."
+ (save-excursion
+ (set-buffer gnus-group-buffer)
+ (let ((parameters (funcall gnus-group-get-parameter-function group)))
+ (if symbol
+ (gnus-group-parameter-value parameters symbol)
+ parameters))))
+
(defun gnus-group-get-parameter (group &optional symbol)
- "Returns the group parameters for GROUP.
+ "Return the group parameters for GROUP.
If SYMBOL, return the value of that symbol in the group parameters."
(let ((params (gnus-info-params (gnus-get-info group))))
(if symbol
@@ -624,7 +633,8 @@ just the host name."
(dot (string-match "\\." group)))
(setq foreign (concat
(substring group (+ 1 plus)
- (cond ((< colon dot) colon)
+ (cond ((null dot) colon)
+ ((< colon dot) colon)
((< dot colon) dot))) ":")
group (substring group (+ 1 colon))
)))
@@ -711,10 +721,12 @@ If NEWSGROUP is nil, return the global kill file name instead."
;; called "hello+alt.alt".
(let ((entry
(gnus-copy-sequence
- (if (equal (car method) "native") gnus-select-method
+ (if (gnus-server-equal method gnus-select-method) gnus-select-method
(cdr (assoc (car method) gnus-server-alist))))))
- (setcar (cdr entry) (concat (nth 1 entry) "+" group))
- (nconc entry (cdr method))))
+ (if (not entry)
+ method
+ (setcar (cdr entry) (concat (nth 1 entry) "+" group))
+ (nconc entry (cdr method)))))
(defun gnus-server-status (method)
"Return the status of METHOD."
View
17 lisp/message.el
@@ -1414,10 +1414,17 @@ the user from the mailer."
(concat (file-name-as-directory message-autosave-directory)
"msg."))))
(setq buffer-file-name name)
- (mh-send-letter)
- (condition-case ()
- (delete-file name)
- (error nil))))
+ ;; MH wants to generate these headers itself.
+ (let ((headers message-deletable-headers))
+ (while headers
+ (goto-char (point-min))
+ ;;(message "Deleting header %s" (car headers)) (sit-for 5)
+ (and (re-search-forward
+ (concat "^" (symbol-name (car headers)) ": *") nil t)
+ (message-delete-line))
+ (pop headers)))
+ ;; Pass it on to mh.
+ (mh-send-letter)))
(defun message-send-news (&optional arg)
(let ((tembuf (generate-new-buffer " *message temp*"))
@@ -2436,7 +2443,7 @@ Headers already prepared in the buffer are not modified."
(narrow-to-region
(goto-char (point-min))
(if (search-forward "\n\n" nil t)
- (1- (point))
+ (point)
(point-max)))
;; Allow customizations to have their say.
(if (not wide)
View
60 lisp/nndoc.el
@@ -1,4 +1,3 @@
-;;; nndoc.el --- single file access for Gnus
;; Copyright (C) 1995,96 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
@@ -97,11 +96,26 @@ One of `mbox', `babyl', `digest', `news', `rnews', `mmdf', `forward',
(body-begin . "^ ?$")
(file-end . "^End of")
(prepare-body-function . nndoc-unquote-dashes)
- (subtype digest guess))
+ (subtype digest)) ;; impossible to really guess?
+ (lanl-gov-announce
+ (article-begin . "^\\\\\\\\\n")
+ (head-begin . "^Paper.*:")
+ (head-end . "^\\\\\\\\\n")
+ (body-begin . "")
+ (body-end . "-------------------------------------------------")
+ (file-end . "^Title: Recent Seminal")
+ (generate-head-function . nndoc-generate-lanl-gov-head)
+ (article-transform-function . nndoc-transform-lanl-gov-announce)
+ (subtype preprints guess))
(guess
- (guess . nndoc-guess-type))
+ (guess . t)
+ (subtype nil))
(digest
- (guess . nndoc-guess-digest-type))
+ (guess . t)
+ (subtype nil))
+ (preprints
+ (guess . t)
+ (subtype nil))
))
@@ -444,6 +458,44 @@ One of `mbox', `babyl', `digest', `news', `rnews', `mmdf', `forward',
(defun nndoc-slack-digest-type-p ()
0)
+(defun nndoc-lanl-gov-announce-type-p ()
+ (when (let ((case-fold-search nil))
+ (re-search-forward "^\\\\\\\\\nPaper: [a-z-]+/[0-9]+" nil t))
+ t))
+
+(defun nndoc-transform-lanl-gov-announce (article)
+ (goto-char (point-max))
+ (when (re-search-backward "^\\\\\\\\ +(\\([^ ]*\\) , *\\([^ ]*\\))" nil t)
+ (replace-match "\n\nGet it at \\1 (\\2)" t nil))
+ ;; (when (re-search-backward "^\\\\\\\\$" nil t)
+ ;; (replace-match "" t t))
+ )
+
+(defun nndoc-generate-lanl-gov-head (article)
+ (let ((entry (cdr (assq article nndoc-dissection-alist)))
+ (e-mail "no address given")
+ subject from)
+ (save-excursion
+ (set-buffer nndoc-current-buffer)
+ (save-restriction
+ (narrow-to-region (car entry) (nth 1 entry))
+ (goto-char (point-min))
+ (when (looking-at "^Paper.*: \\([a-z-]+/[0-9]+\\)")
+ (setq subject (concat " (" (match-string 1) ")"))
+ (when (re-search-forward "^From: \\([^ ]+\\)" nil t)
+ (setq e-mail (match-string 1)))
+ (when (re-search-forward "^Title: \\([^\f]*\\)\nAuthors?: \\(.*\\)"
+ nil t)
+ (setq subject (concat (match-string 1) subject))
+ (setq from (concat (match-string 2) " <" e-mail ">"))))
+ ))
+ (while (string-match "(\[^)\]*)" from)
+ (setq from (replace-match "" t t from)))
+ (insert "From: " (or from "unknown")
+ "\nSubject: " (or subject "(no subject)") "\n")))
+
+
+
;;;
;;; Functions for dissecting the documents
;;;
View
71 lisp/nntp.el
@@ -64,15 +64,16 @@ You probably don't want to do that, though.")
(defvoo nntp-open-connection-function 'nntp-open-network-stream
"*Function used for connecting to a remote system.
-It will be called with the address of the remote system.
+It will be called with the buffer to output in.
Two pre-made functions are `nntp-open-network-stream', which is the
default, and simply connects to some port or other on the remote
-system (see nntp-port-number). The other is `nntp-open-rlogin', which
+system (see nntp-port-number). The other are `nntp-open-rlogin', which
does an rlogin on the remote system, and then does a telnet to the
-NNTP server available there (see nntp-rlogin-parameters).")
+NNTP server available there (see nntp-rlogin-parameters) and `nntp-open-telnet' which
+telnets to a remote system, logs in and does the same")
-(defvoo nntp-rlogin-parameters '("telnet" "${NNTPSERVER:=localhost}" "nntp")
+(defvoo nntp-rlogin-parameters '("telnet" "-8" "${NNTPSERVER:=news}" "nntp")
"*Parameters to `nntp-open-login'.
That function may be used as `nntp-open-server-function'. In that
case, this list will be used as the parameter list given to rsh.")
@@ -80,7 +81,7 @@ case, this list will be used as the parameter list given to rsh.")
(defvoo nntp-rlogin-user-name nil
"*User name on remote system when using the rlogin connect method.")
-(defvoo nntp-telnet-parameters '("exec" "telnet" "-8" "${NNTPSERVER:=localhost}" "nntp")
+(defvoo nntp-telnet-parameters '("exec" "telnet" "-8" "${NNTPSERVER:=news}" "nntp")
"*Parameters to `nntp-open-telnet'.
That function may be used as `nntp-open-server-function'. In that
case, this list will be executed as a command after logging in
@@ -131,7 +132,7 @@ If can be used to set up a server remotely, for instance. Say you
have an account at the machine \"other.machine\". This machine has
access to an NNTP server that you can't access locally. You could
then use this hook to rsh to the remote machine and start a proxy NNTP
-server there that you can connect to.")
+server there that you can connect to. See also `nntp-open-connection-function'")
(defvoo nntp-warn-about-losing-connection t
"*If non-nil, beep when a server closes connection.")
@@ -231,7 +232,7 @@ server there that you can connect to.")
(deffoo nntp-request-article (article &optional group server buffer command)
(nntp-possibly-change-group group server)
(when (nntp-send-command-and-decode
- "\r\n\\.\r\n" "ARTICLE"
+ "\r?\n\\.\r?\n" "ARTICLE"
(if (numberp article) (int-to-string article) article))
(when buffer
(save-excursion
@@ -250,12 +251,12 @@ server there that you can connect to.")
(deffoo nntp-request-body (article &optional group server)
(nntp-possibly-change-group group server)
(nntp-send-command-and-decode
- "\r\n\\.\r\n" "BODY"
+ "\r?\n\\.\r?\n" "BODY"
(if (numberp article) (int-to-string article) article)))
(deffoo nntp-request-group (group &optional server dont-check)
(nntp-possibly-change-group nil server)
- (when (nntp-send-command "^2.*\r\n" "GROUP" group)
+ (when (nntp-send-command "^2.*\n" "GROUP" group)
(let ((entry (nntp-find-connection-entry nntp-server-buffer)))
(setcar (cddr entry) group))))
@@ -297,11 +298,11 @@ server there that you can connect to.")
(deffoo nntp-request-list (&optional server)
(nntp-possibly-change-group nil server)
- (nntp-send-command-and-decode "\r\n\\.\r\n" "LIST"))
+ (nntp-send-command-and-decode "\r?\n\\.\r?\n" "LIST"))
(deffoo nntp-request-list-newsgroups (&optional server)
(nntp-possibly-change-group nil server)
- (nntp-send-command "\r\n\\.\r\n" "LIST NEWSGROUPS"))
+ (nntp-send-command "\r?\n\\.\r?\n" "LIST NEWSGROUPS"))
(deffoo nntp-request-newgroups (date &optional server)
(nntp-possibly-change-group nil server)
@@ -334,23 +335,23 @@ server there that you can connect to.")
This function is supposed to be called from `nntp-server-opened-hook'.
It will make innd servers spawn an nnrpd process to allow actual article
reading."
- (nntp-send-command "^.*\r\n" "MODE READER"))
+ (nntp-send-command "^.*\r?\n" "MODE READER"))
(defun nntp-send-nosy-authinfo ()
"Send the AUTHINFO to the nntp server.
This function is supposed to be called from `nntp-server-opened-hook'.
It will prompt for a password."
- (nntp-send-command "^.*\r\n" "AUTHINFO USER"
+ (nntp-send-command "^.*\r?\n" "AUTHINFO USER"
(read-string "NNTP user name: "))
- (nntp-send-command "^.*\r\n" "AUTHINFO PASS"
+ (nntp-send-command "^.*\r?\n" "AUTHINFO PASS"
(read-string "NNTP password: ")))
(defun nntp-send-authinfo ()
"Send the AUTHINFO to the nntp server.
This function is supposed to be called from `nntp-server-opened-hook'.
It will prompt for a password."
- (nntp-send-command "^.*\r\n" "AUTHINFO USER" (user-login-name))
- (nntp-send-command "^.*\r\n" "AUTHINFO PASS"
+ (nntp-send-command "^.*\r?\n" "AUTHINFO USER" (user-login-name))
+ (nntp-send-command "^.*\r?\n" "AUTHINFO PASS"
(read-string "NNTP password: ")))
(defun nntp-send-authinfo-from-file ()
@@ -364,9 +365,9 @@ It will prompt for a password."
(erase-buffer)
(insert-file-contents "~/.nntp-authinfo")
(goto-char (point-min))
- (nntp-send-command "^.*\r\n" "AUTHINFO USER" (user-login-name))
+ (nntp-send-command "^.*\r?\n" "AUTHINFO USER" (user-login-name))
(nntp-send-command
- "^.*\r\n" "AUTHINFO PASS"
+ "^.*\r?\n" "AUTHINFO PASS"
(buffer-substring (point) (progn (end-of-line) (point))))
(kill-buffer (current-buffer)))))
@@ -454,11 +455,12 @@ It will prompt for a password."
(current-buffer)))
(process
(condition-case ()
- (funcall nntp-open-connection-function pbuffer)
+ (funcall
+ nntp-open-connection-function pbuffer)
(error nil))))
(when process
(process-kill-without-query process)
- (nntp-wait-for process "^.*\r\n" buffer)
+ (nntp-wait-for process "^.*\n" buffer)
(if (memq (process-status process) '(open run))
(prog1
(caar (push (list process buffer nil)
@@ -749,14 +751,14 @@ It will prompt for a password."
;; If `nntp-server-xover' is a string, then we just send this
;; command.
(if wait-for-reply
- (nntp-send-command-nodelete "\r\n\\.\r\n" nntp-server-xover range)
+ (nntp-send-command-nodelete "\r?\n\\.\r?\n" nntp-server-xover range)
;; We do not wait for the reply.
- (nntp-send-command-nodelete "\r\n\\.\r\n" nntp-server-xover range))
+ (nntp-send-command-nodelete "\r?\n\\.\r?\n" nntp-server-xover range))
(let ((commands nntp-xover-commands))
;; `nntp-xover-commands' is a list of possible XOVER commands.
;; We try them all until we get at positive response.
(while (and commands (eq nntp-server-xover 'try))
- (nntp-send-command-nodelete "\r\n\\.\r\n" (car commands) range)
+ (nntp-send-command-nodelete "\r?\n\\.\r?\n" (car commands) range)
(save-excursion
(set-buffer nntp-server-buffer)
(goto-char (point-min))
@@ -788,16 +790,16 @@ It will prompt for a password."
(set-buffer buf)
(goto-char (point-min)))))
-(defun nntp-open-telnet (server)
+(defun nntp-open-telnet (buffer)
(save-excursion
- (set-buffer nntp-server-buffer)
+ (set-buffer buffer)
(erase-buffer)
(let ((proc (start-process
- "nntpd" nntp-server-buffer "telnet" "-8"))
+ "nntpd" buffer "telnet" "-8"))
(case-fold-search t))
(when (memq (process-status proc) '(open run))
(process-send-string proc "set escape \^X\n")
- (process-send-string proc (concat "open " server "\n"))
+ (process-send-string proc (concat "open " nntp-address "\n"))
(nntp-wait-for-string "^\r*.?login:")
(process-send-string
proc (concat
@@ -828,19 +830,24 @@ It will prompt for a password."
(delete-region (point) (point-max)))
proc)))
-(defun nntp-open-rlogin (server)
+(defun nntp-open-rlogin (buffer)
"Open a connection to SERVER using rsh."
(let ((proc (if nntp-rlogin-user-name
(start-process
- "nntpd" nntp-server-buffer "rsh"
- server "-l" nntp-rlogin-user-name
+ "nntpd" buffer "rsh"
+ nntp-address "-l" nntp-rlogin-user-name
(mapconcat 'identity
nntp-rlogin-parameters " "))
(start-process
- "nntpd" nntp-server-buffer "rsh" server
+ "nntpd" buffer "rsh" nntp-address
(mapconcat 'identity
nntp-rlogin-parameters " ")))))
- proc))
+ (set-buffer buffer)
+ (nntp-wait-for-string "^\r*200")
+ (beginning-of-line)
+ (delete-region (point-min) (point))
+ proc)
+ )
(defun nntp-find-group-and-number ()
(save-excursion
View
21 lisp/nnvirtual.el
@@ -51,12 +51,14 @@ virtual group.")
(defvoo nnvirtual-component-regexp nil
"*Regexp to match component groups.")
+(defvoo nnvirtual-component-groups nil
+ "Component group in this nnvirtual group.")
+
(defconst nnvirtual-version "nnvirtual 1.0")
(defvoo nnvirtual-current-group nil)
-(defvoo nnvirtual-component-groups nil)
(defvoo nnvirtual-mapping nil)
(defvoo nnvirtual-status-string "")
@@ -192,14 +194,15 @@ virtual group.")
(if nnvirtual-component-groups
t
(setq nnvirtual-mapping nil)
- ;; Go through the newsrc alist and find all component groups.
- (let ((newsrc (cdr gnus-newsrc-alist))
- group)
- (while (setq group (car (pop newsrc)))
- (when (string-match nnvirtual-component-regexp group) ; Match
- ;; Add this group to the list of component groups.
- (setq nnvirtual-component-groups
- (cons group (delete group nnvirtual-component-groups))))))
+ (when nnvirtual-component-regexp
+ ;; Go through the newsrc alist and find all component groups.
+ (let ((newsrc (cdr gnus-newsrc-alist))
+ group)
+ (while (setq group (car (pop newsrc)))
+ (when (string-match nnvirtual-component-regexp group) ; Match
+ ;; Add this group to the list of component groups.
+ (setq nnvirtual-component-groups
+ (cons group (delete group nnvirtual-component-groups)))))))
(if (not nnvirtual-component-groups)
(nnheader-report 'nnvirtual "No component groups: %s" server)
t)))
View
26 texi/ChangeLog
@@ -1,3 +1,29 @@
+Sat Aug 10 00:13:39 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.texi (Summary Buffer Lines): Correction.
+ (Top): Name fix.
+ (Compilation ): Addition.
+ (Group Parameters): Addition.
+
+Fri Aug 9 07:17:59 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.texi (Selecting a Group): Addition.
+ (Score Decays): New.
+ (Score File Format): Addition.
+ (Changing Servers): Addition.
+ (Selecting a Group): Addition.
+ (Really Various Summary Commands): Addition.
+
+Thu Aug 8 05:39:31 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.texi (Read Articles): Addition.
+ (Foreign Groups): Addition.
+ (User-Defined Specs): Separated.
+ (Formatting Fonts): Ditto.
+ (Advanced Formatting): New.
+ (Formatting Basics): Addition.
+ (Formatting Variables): Split.
+
Wed Aug 7 22:00:56 1996 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
* gnus.texi (Hooking New Backends Into Gnus): New node.
View
61 texi/Makefile
@@ -0,0 +1,61 @@
+TEXI2DVI=texi2dvi
+EMACS=emacs
+MAKEINFO=$(EMACS) -batch -q -no-site-file
+INFOSWI=-l texinfmt -f texinfo-every-node-update -f texinfo-format-buffer -f save-buffer
+LATEX=latex
+DVIPS=dvips
+PERL=perl
+
+all: gnus message
+
+most: texi2latexi.elc latex latexps
+
+gnus: gnus.texi
+ $(MAKEINFO) gnus.texi $(INFOSWI)
+
+message: message.texi
+ $(MAKEINFO) message.texi $(INFOSWI)
+
+dvi: gnus.texi
+ $(PERL) -n -e 'if (/\@iflatex/) { $$latex=1; } if (!$$latex) { print; } if (/\@end iflatex/) { $$latex=0; }' gnus.texi > gnus.tmptexi
+ $(TEXI2DVI) gnus.tmptexi
+
+refcard.dvi: refcard.tex
+ $(LATEX) refcard.tex
+
+clean:
+ rm -f gnus.*.bak gnus.ky gnus.cp gnus.fn gnus.cps gnus.kys *.log \
+ gnus.log gnus.pg gnus.tp gnus.vr gnus.toc gnus.latexi *.aux gnus.cidx \
+ gnus.cind gnus.ilg gnus.ind gnus.kidx gnus.kind gnus.idx \
+ gnus.tmptexi gnus.tmplatexi *.latexi texput.log *.orig *.rej
+
+makeinfo:
+ makeinfo -o gnus gnus.texi
+ makeinfo -o message message.texi
+
+texi2latexi.elc:
+ $(EMACS) -batch -l bytecomp -f batch-byte-recompile-directory
+
+latex: gnus.texi
+ $(EMACS) -batch -q -no-site-file gnus.texi -l ./texi2latex.elc -f latexi-translate
+
+latexps:
+ $(LATEX) gnus.latexi
+ splitindex
+ makeindex -o gnus.kind gnus.kidx
+ makeindex -o gnus.cind gnus.cidx
+ egrep -v "end{document}|label.*Index|chapter.*Index" gnus.latexi > gnus.tmplatexi
+ cat postamble.latexi >> gnus.tmplatexi
+ $(LATEX) gnus.tmplatexi
+ $(DVIPS) -f gnus.dvi > gnus.ps
+
+latexboth:
+ rm -f gnus-manual-a4.ps.gz gnus-manual-standard.ps.gz
+ make latexps
+ mv gnus.ps gnus-manual-a4.ps
+ gzip gnus-manual-a4.ps
+ sed 's/,a4paper//' gnus.latexi > gnus-standard.latexi
+ make latexps
+ mv gnus.ps gnus-manual-standard.ps
+ gzip gnus-manual-standard.ps
+
View
327 texi/gnus.texi
@@ -257,7 +257,7 @@ into another language, under the above conditions for modified versions.
@node Top
-@top The Gnus Newsreader
+@top The Red Gnus Newsreader
@ifinfo
@@ -687,6 +687,13 @@ You can also move individual groups with the @kbd{M-x
gnus-group-move-group-to-server} command. This is useful if you want to
move a (foreign) group from one server to another.
+@kindex M-x gnus-group-clear-data-on-native-groups
+@findex gnus-group-clear-data-on-native-groups
+If you don't have access to both the old and new server, all your marks
+and read ranges have become worthless. You can use the @kbd{M-x
+gnus-group-clear-data-on-native-groups} command to clear out all data
+that you have on your native groups. Use with caution.
+
@node Startup Files
@section Startup Files
@@ -1240,6 +1247,21 @@ the group buffer.
@findex gnus-group-catchup-current-all
Mark all articles in this group, even the ticked ones, as read
(@code{gnus-group-catchup-current-all}).
+
+@item M-c
+@kindex M-c (Group)
+@findex gnus-group-clear-data
+Clear the data from the current group---nix out marks and the list of
+read articles (@code{gnus-group-clear-data}).
+
+@item M-x gnus-group-clear-data-on-native-groups
+@kindex M-x gnus-group-clear-data-on-native-groups
+@findex gnus-group-clear-data-on-native-groups
+If you have switced from one @sc{nntp} server to another, all your marks
+and read ranges have become worthless. You can use this command to
+clear out all data that you have on your native groups. Use with
+caution.
+
@end table
@vindex gnus-large-newsgroup
@@ -1524,9 +1546,11 @@ the command to be executed.
@node Foreign Groups
@section Foreign Groups
-Here are some group mode commands for making and editing general foreign
+Below are some group mode commands for making and editing general foreign
groups, as well as commands to ease the creation of a few
-special-purpose groups:
+special-purpose groups. All these commands insert the newly created
+groups under point---@code{gnus-subscribe-newsgroup-method} is not
+consulted.
@table @kbd
@@ -1709,6 +1733,11 @@ broken behavior. So there!
If the group parameter list contains an element like @code{(to-group
. "some.group.name")}, all posts will be sent to that group.
+@item gcc-self
+@cindex gcc-self
+If this symbol is present in the group parameter list, new composed
+messages will be @code{Gcc}'d to the current group.
+
@item auto-expire
@cindex auto-expire
If this symbol is present in the group parameter list, all articles that
@@ -2724,7 +2753,7 @@ Total thread score.
@item d
The @code{Date} in @code{YY-MMM} format.
@item o
-The @code{Date} in @code{YYMMDD-HH:MM:SS} format.
+The @code{Date} in @code{YYYYMMDDTHHMMSS} format.
@item M
@code{Message-ID}.
@item r
@@ -3404,11 +3433,18 @@ Canceled article (@code{gnus-canceled-mark})
@item F
@vindex gnus-souped-mark
-@sc{SOUP}ed article (@code{gnus-souped-mark}).
+@sc{SOUP}ed article (@code{gnus-souped-mark}). @xref{SOUP}
@item Q
@vindex gnus-sparse-mark
-Sparsely reffed article (@code{gnus-sparse-mark}).
+Sparsely reffed article (@code{gnus-sparse-mark}). @xref{Customizing
+Threading}
+
+@item M
+@vindex gnus-duplicate-mark
+Article marked as read by duplicate suppression
+(@code{gnus-duplicated-mark}). @xref{Duplicate Suppression}
+
@end table
All these marks just mean that the article is marked as read, really.
@@ -6093,8 +6129,8 @@ the process mark (@code{gnus-summary-universal-argument}).
@table @kbd
-@item A D
-@kindex A D (Summary)
+@item C-d
+@kindex C-d (Summary)
@findex gnus-summary-enter-digest-group
If the current article is a collection of other articles (for instance,
a digest), you might use this command to enter a group based on the that
@@ -6102,9 +6138,20 @@ article (@code{gnus-summary-enter-digest-group}). Gnus will try to
guess what article type is currently displayed unless you give a prefix
to this command, which forces a ``digest'' interpretation. Basically,
whenever you see a message that is a collection of other messages on
-some format, you @kbd{A D} and read these messages in a more convenient
+some format, you @kbd{C-d} and read these messages in a more convenient
fashion.
+@item M-C-d
+@kindex M-C-d (Summary)
+@findex gnus-summary-read-document
+This command is very similar to the one above, but lets you gather
+several documents into one biiig group
+(@code{gnus-summary-read-document}). It does this by opening several
+@code{nndoc} groups for each document, and then opening an
+@code{nnvirtual} group on top of these @code{nndoc} groups. This
+command understands the process/prefix convention
+(@pxref{Process/Prefix}).
+
@item C-t
@kindex C-t (Summary)
@findex gnus-summary-toggle-truncation
@@ -9060,8 +9107,8 @@ variables to ensure that all your followups and replies end up in the
In specific, this is what it does:
@lisp
-(setq gnus-inews-article-function 'nnsoup-request-post)
-(setq send-mail-function 'nnsoup-request-mail)
+(setq message-send-news-function 'nnsoup-request-post)
+(setq message-send-mail-function 'nnsoup-request-mail)
@end lisp
And that's it, really. If you only want news to go into the @sc{soup}
@@ -9238,6 +9285,7 @@ silently to help keep the sizes of the score files down.
* Kill Files:: They are still here, but they can be ignored.
* GroupLens:: Getting predictions on what you like to read.
* Advanced Scoring:: Using logical expressions to build score rules.
+* Score Decays:: It can be useful to let scores wither away.
@end menu
@@ -9738,13 +9786,23 @@ These two headers use different match types: @code{<}, @code{>},
@code{=}, @code{>=} and @code{<=}.
@item Date
-For the Date header we have three match types: @code{before}, @code{at}
-and @code{after}. I can't really imagine this ever being useful, but,
-like, it would feel kinda silly not to provide this function. Just in
-case. You never know. Better safe than sorry. Once burnt, twice shy.
-Don't judge a book by its cover. Never not have sex on a first date.
-(I have been told that at least one person, and I quote, ``found this
-function indispensable'', however.)
+For the Date header we have three kinda silly match types:
+@code{before}, @code{at} and @code{after}. I can't really imagine this
+ever being useful, but, like, it would feel kinda silly not to provide
+this function. Just in case. You never know. Better safe than sorry.
+Once burnt, twice shy. Don't judge a book by its cover. Never not have
+sex on a first date. (I have been told that at least one person, and I
+quote, ``found this function indispensable'', however.)
+
+A more useful match type is @code{regexp}. With it, you can match the
+date string using a regular expression. The date is normalized to
+ISO8601 compact format first, which looks like @samp{YYYYMMDDTHHMMSS}.
+If you want to match all articles that have been posted on April 1st in
+every year, you could use @samp{....0401.........} as a match string,
+for instance. (Note that the date is kept in its original time zone, so
+this will match articles that were posted when it was April 1st where
+the article was posted from. Time zones are such wholesome fun for the
+whole family, eh?)
@item Head, Body, All
These three match keys use the same match types as the @code{From} (etc)
@@ -9994,10 +10052,11 @@ the length of the match is less than
this variable is @code{nil}, exact matching will always be used to avoid
this problem.
+@vindex gnus-default-adaptive-word-score-alist
As mentioned above, you can adapt either on individual words or entire
headers. If you adapt on words, the
-@code{gnus-default-adaptive-word-score-alist} says what score each
-instance of a word should add given a mark.
+@code{gnus-default-adaptive-word-score-alist} variable says what score
+each instance of a word should add given a mark.
@lisp
(setq gnus-default-adaptive-word-score-alist
@@ -10012,6 +10071,10 @@ word that appears in subjects of articles that are marked with
@code{gnus-read-mark} will result in a score rule that increase the
score with 30 points.
+@vindex gnus-ignored-adaptive-words
+Words that appear in the @code{gnus-ignored-adaptive-words} list will be
+ignored.
+
After using this scheme for a while, it might be nice to write a
@code{gnus-psychoanalyze-user} command to go through the rules and see
what words you like and what words you don't like. Or perhaps not.
@@ -10129,9 +10192,9 @@ This will add a score to all articles that appear in a thread ``below''
your own article.
@end table
-@vindex gnus-inews-article-hook
+@vindex message-sent-hook
These two functions are both primarily meant to be used in hooks like
-@code{message-send-hook}.
+@code{message-sent-hook}.
@node Scoring Tips
@section Scoring Tips
@@ -10731,6 +10794,62 @@ than it is to say:
@end example
+@node Score Decays
+@section Score Decays
+@cindex score decays
+@cindex decays
+
+You may find that your scores have a tendency to grow without
+bounds, especially if you're using adaptive scoring. If scores get too
+big, they lose all meaning---they simply max out and it's difficult to
+use them in any sensible way.
+
+@vindex gnus-decay-scores
+@findex gnus-decay-score
+@vindex gnus-score-decay-function
+Gnus provides a mechanism for decaying scores to help with this problem.
+When score files are loaded and @code{gnus-decay-scores} is
+non-@code{nil}, Gnus will run the score files through the decaying
+mechanism thereby lowering the scores of all non-permanent score rules.
+The decay itself if performed by the @code{gnus-score-decay-function}
+function, which is @code{gnus-decay-score} by default. Here's the
+definition of that function:
+
+@lisp
+(defun gnus-decay-score (score)
+ (floor
+ (- score
+ (* (if (< score 0) 1 -1)
+ (min score
+ (max gnus-score-decay-constant
+ (* (abs score)
+ gnus-score-decay-scale)))))))
+@end lisp
+
+@vindex gnus-score-decay-scale
+@vindex gnus-score-decay-constant
+@code{gnus-score-decay-constant} is 3 by default and
+@code{gnus-score-decay-scale} is 0.05. This should cause the following:
+
+@enumerate
+@item
+Scores between -3 and 3 will be set to 0 when this function is called.
+
+@item
+Scores with magnitudes between 3 and 60 will be shrunk by 3.
+
+@item
+Scores with magnutudes greater than 60 will be shrunk by 5% of the
+score.
+@end enumerate
+
+If you don't like this decay function, write your own. It is called
+with the score to be decayed as its only parameter, and it should return
+the new score, which should be an integer.
+
+Gnus will try to decay scores once a day. If you haven't run Gnus for
+four days, Gnus will decay the scores four times, for instance.
+
@node Various
@chapter Various
@@ -10839,17 +10958,119 @@ Here's an example format spec (from the group buffer): @samp{%M%S%5y:
%(%g%)\n}. We see that it is indeed extremely ugly, and that there are
lots of percentages everywhere.
+@menu
+* Formatting Basics:: A formatting variable is basically a format string.
+* Advanced Formatting:: Modifying output in various ways.
+* User-Defined Specs:: Having Gnus call your own functions.
+* Formatting Fonts:: Making the formatting look colorful and nice.
+@end menu
+
+Currently Gnus uses the following formatting variables:
+@code{gnus-group-line-format}, @code{gnus-summary-line-format},
+@code{gnus-server-line-format}, @code{gnus-topic-line-format},
+@code{gnus-group-mode-line-format},
+@code{gnus-summary-mode-line-format},
+@code{gnus-article-mode-line-format},
+@code{gnus-server-mode-line-format}, and
+@code{gnus-summary-pick-line-format}.
+
+All these format variables can also be arbitrary elisp forms. In that
+case, they will be @code{eval}ed to insert the required lines.
+
+@kindex M-x gnus-update-format
+@findex gnus-update-format
+Gnus includes a command to help you while creating your own format
+specs. @kbd{M-x gnus-update-format} will @code{eval} the current form,
+update the spec in question and pop you to a buffer where you can
+examine the resulting lisp code to be run to generate the line.
+
+
+
+@node Formatting Basics
+@subsection Formatting Basics
+
Each @samp{%} element will be replaced by some string or other when the
buffer in question is generated. @samp{%5y} means ``insert the @samp{y}
-spec, and pad with spaces (to the left) to get a 5-character field''.
-(@samp{%-5y} means the same, but pad to the right instead.) Just like a
-normal format spec, almost.
+spec, and pad with spaces to get a 5-character field''.
+
+As with normal C and Emacs Lisp formatting strings, the numerical
+modifier between the @samp{%} and the formatting type character will
+@dfn{pad} the output so that it is always at least that long.
+@samp{%5y} will make the field always (at least) five characters wide by
+padding with spaces to the left. If you say @samp{%-5y}, it will pad to
+the right instead.
+
+You may also wish to limit the length of the field to protect against
+particularly wide values. For that you can say @samp{%4,6y}, which
+means that the field will never be more than 6 characters wide and never
+less than 4 characters wide.
+
+
+@node Advanced Formatting
+@subsection Advanced Formatting
+
+It is frequently useful to post-process the fields in some way.
+Padding, limiting, cutting off parts and suppressing certain values can
+be achieved by using @dfn{tilde modifiers}. A typical tilde spec might
+look like @samp{%~(cut 3)~(ignore "0")y}.
+
+These are the legal modifiers:
+
+@table @code
+@item pad
+@itemx pad-left
+Pad the field to the left with spaces until it reaches the required
+length.
+
+@item pad-right
+Pad the field to the right with spaces until it reaches the required
+length.
+
+@item max
+@itemx max-left
+Cut off characters from the left until it reaches the specified length.
+
+@item max-right
+Cut off characters from the right until it reaches the specified
+length.
+
+@item cut
+@itemx cut-left
+Cut off the specified number of characters from the left.
+
+@item cut-right
+Cut off the specified number of characters from the right.
+
+@item ignore
+Return an empty string if the field is equal to the specified value.
+
+@item form
+Use the specified form as the field value when the @samp{@} spec is
+used.
+@end table
+
+Let's take an example. The @samp{%o} spec in the summary mode lines
+will return a date in compact ISO8601 format---@samp{19960809T230410}.
+This is quite a mouthful, so we want to shave off the century number and
+the time, leaving us with a six-character date. That would be
+@samp{%~(cut-left 2)~(max-right 6)~(pad 6)o}. (Cutting is done before
+maxing, and we need the padding to ensure that the date is never less
+than 6 characters to make it look nice in columns.)
+
+Ignoring is done first; then cutting; then maxing; and then as the very
+last operation, padding.
+
+If you use lots of these advanced thingies, you'll find that Gnus gets
+quite slow. This can be helped enourmously by running @kbd{M-x
+gnus-compile} when you are setisfied with the look of your lines.
+@xref{Compiling}.
-You can also say @samp{%4,6y}, which means that the field will never be
-more than 6 characters wide and never less than 4 characters wide.
-All the specs allow for inserting user defined specifiers -- @samp{u}.
-The next character in the format string should be a letter. @sc{gnus}
+@node User-Defined Specs
+@subsection User-Defined Specs
+
+All the specs allow for inserting user defined specifiers---@samp{u}.
+The next character in the format string should be a letter. Gnus
will call the function @code{gnus-user-format-function-}@samp{X}, where
@samp{X} is the letter following @samp{%u}. The function will be passed
a single parameter---what the parameter means depends on what buffer