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 69512322441f015a67aafc71d9e633e9ee7f2894 1 parent e6beea6
@larsmagne larsmagne authored
View
70 lisp/ChangeLog
@@ -1,5 +1,75 @@
+Tue Apr 23 00:13:22 1996 Lars Magne Ingebrigtsen <larsi@trym.ifi.uio.no>
+
+ * gnus.el (gnus-get-newsgroup-headers): Run
+ `gnus-parse-headers-hook'.
+ (gnus-mime-decode-quoted-printable): Make interactive.
+ (gnus-setup-news): Don't scan nocem on gnus-no-server.
+ (gnus-read-header): Let `gnus-refer-article-method' override.
+ (gnus-rebuild-thread): Cut threads before inserting.
+
+Mon Apr 22 23:54:10 1996 Lars Magne Ingebrigtsen <larsi@trym.ifi.uio.no>
+
+ * message.el (message-check-news-syntax): Didn't check for
+ shortened Followup-To.
+
+Mon Apr 22 22:36:48 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.el (gnus-group-catchup-current): Warn about dead groups.
+
+Mon Apr 22 21:41:51 1996 William Perry <wmperry@monolith.spry.com>
+
+ * gnus-xmas.el (gnus-xmas-define): Correct background mode under
+ XEmacs.
+
+Mon Apr 22 03:50:52 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * message.el (message-mode-map): New keystroke for
+ `message-sort-headers'.
+ (message-syntax-checks): Reverse default.
+ (message-check-element): Use it.
+
+ * nnbabyl.el (nnbabyl-read-mbox): Try to make sure that article
+ numbers aren't reused.
+ * nnmbox.el (nnmbox-read-mbox): Ditto.
+
+ * gnus.el (gnus-continuum-version): New function.
+ (gnus-convert-old-newsrc): New function.
+ (gnus-convert-old-ticks): New function.
+
+ * nnmbox.el (nnmbox-request-scan): Save active.
+
+ * nnbabyl.el (nnbabyl-request-scan): Save the active file.
+
+ * nnmbox.el (nnmbox-request-list): Odd logic.
+
+ * nnbabyl.el (nnbabyl-request-list): Odd logic.
+
+ * gnus-uu.el (gnus-uu-generated-file-list): Removed.
+ (gnus-uu-delete-work-dir): Delete recursively.
+
+ * gnus.el (gnus-group-insert-group-line-info): Indent properly
+ when using topics.
+ (gnus-group-make-group): Place point on the newly created group.
+
+ * gnus-vis.el (gnus-group-make-menu-bar): Would bug out when not
+ using gnus-topic-mode.
+
+Mon Apr 22 03:45:14 1996 Brad Miller <bmiller@cs.umn.edu>
+
+ * gnus-gl.el: New version.
+
+Mon Apr 22 02:34:05 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus-xmas.el (gnus-xmas-find-glyph-directory): Secure agains nil
+ path elements.
+
+ * nnml.el (nnml-request-move-article): Change directory back to
+ source group before deleting.
+
Sun Apr 21 19:59:58 1996 Lars Magne Ingebrigtsen <larsi@hler.ifi.uio.no>
+ * gnus.el: September Gnus v0.77 is released.
+
* message.el (message-bounce): Wrong interactive spec.
(message-bounce): Handle mimeish bounces.
View
2  lisp/browse-url.el
@@ -665,7 +665,7 @@ in an Xterm window."
(interactive (browse-url-interactive-arg "Lynx URL: "))
(start-process (concat "lynx" url) nil "xterm" "-e" "lynx" url))
-(eval-when-compile (require 'term))
+;(eval-when-compile (require 'term))
(defun browse-url-lynx-emacs (url)
"Ask the Lynx WWW browser to load URL.
View
42 lisp/gnus-gl.el
@@ -174,11 +174,13 @@ GroupLens predictions with scores calculated by other score methods.")
"This variable allows the user to magnify the effect of GroupLens scores.
The scale factor is applied after the offset.")
-(defvar gnus-grouplens-override-scoring t
+(defvar gnus-grouplens-override-scoring 'override
"Tell Grouplens to override the normal Gnus scoring mechanism.
-If this variable is non-nill than Grouplens will completely override
-the normal scoring mechanism of Gnus. When nil, GroupLens will not
-override the normal scoring mechanism so both can be used at once.")
+GroupLens scores can be combined with gnus scores in one of three ways.
+'override -- just use grouplens predictions for grouplens groups
+'combine -- combine grouplens scores with gnus scores
+'separate -- treat grouplens scores completely separate from gnus")
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; Program global variables
@@ -434,11 +436,11 @@ recommend using both scores and grouplens predictions together."
(buffer-substring (match-beginning 1) (match-end 1)))
(defun bbb-get-pred ()
- (let ((tpred (round (string-to-int (buffer-substring
+ (let ((tpred (string-to-number (buffer-substring
(match-beginning 2)
- (match-end 2))))))
+ (match-end 2)))))
(if (> tpred 0)
- (* grouplens-score-scale-factor (+ grouplens-score-offset tpred))
+ (round (* grouplens-score-scale-factor (+ grouplens-score-offset tpred)))
1)))
(defun bbb-get-confl ()
@@ -457,7 +459,7 @@ recommend using both scores and grouplens predictions together."
(defvar gnus-tmp-score)
(defun bbb-grouplens-score (header)
- (if (null gnus-grouplens-override-scoring)
+ (if (eq gnus-grouplens-override-scoring 'separate)
(bbb-grouplens-other-score header)
(let* ((rate-string (make-string 12 ? ))
(mid (aref header (nth 1 (assoc "message-id" gnus-header-index))))
@@ -828,12 +830,24 @@ recommend using both scores and grouplens predictions together."
(make-local-hook 'gnus-exit-group-hook)
(add-hook 'gnus-exit-group-hook 'bbb-put-ratings nil 'local))
(make-local-variable 'gnus-score-find-score-files-function)
- (if gnus-grouplens-override-scoring
- (setq gnus-score-find-score-files-function
- 'bbb-build-mid-scores-alist)
- (add-hook 'gnus-select-group-hook
- '(lambda()
- (bbb-build-mid-scores-alist gnus-newsgroup-name))))
+ (cond ((eq gnus-grouplens-override-scoring 'combine)
+ ;; either add bbb-buld-mid-scores-alist to a list
+ ;; or make a list
+ (if (listp gnus-score-find-score-files-function)
+ (setq gnus-score-find-score-files-function
+ (append 'bbb-build-mid-scores-alist
+ gnus-score-find-score-files-function ))
+ (setq gnus-score-find-score-files-function
+ (list gnus-score-find-score-files-function
+ 'bbb-build-mid-scores-alist))))
+ ;; leave the gnus-score-find-score-files variable alone
+ ((eq gnus-grouplens-override-scoring 'separate)
+ (add-hook 'gnus-select-group-hook
+ '(lambda()
+ (bbb-build-mid-scores-alist gnus-newsgroup-name))))
+ ;; default is to override
+ (t (setq gnus-score-find-score-files-function
+ 'bbb-build-mid-scores-alist)))
(make-local-variable 'gnus-summary-line-format)
(setq gnus-summary-line-format
gnus-summary-grouplens-line-format)
View
64 lisp/gnus-uu.el
@@ -265,7 +265,6 @@ The headers will be included in the sequence they are matched.")
(defconst gnus-uu-uudecode-process nil)
(defvar gnus-uu-binhex-article-name nil)
-(defvar gnus-uu-generated-file-list nil)
(defvar gnus-uu-work-dir nil)
(defconst gnus-uu-output-buffer-name " *Gnus UU Output*")
@@ -362,9 +361,7 @@ The headers will be included in the sequence they are matched.")
gnus-uu-default-dir
gnus-uu-default-dir)))
(setq gnus-uu-saved-article-name file)
- (gnus-uu-decode-with-method 'gnus-uu-save-article n nil t)
- (setq gnus-uu-generated-file-list
- (delete file gnus-uu-generated-file-list)))
+ (gnus-uu-decode-with-method 'gnus-uu-save-article n nil t))
(defun gnus-uu-decode-binhex (n dir)
"Unbinhexes the current article."
@@ -443,7 +440,6 @@ The headers will be included in the sequence they are matched.")
buf subject from)
(setq gnus-uu-digest-from-subject nil)
(gnus-uu-decode-save n file)
- (gnus-uu-add-file file)
(setq buf (switch-to-buffer (get-buffer-create " *gnus-uu-forward*")))
(gnus-add-current-to-buffer-list)
(erase-buffer)
@@ -672,7 +668,6 @@ The headers will be included in the sequence they are matched.")
(and save (gnus-uu-save-files files save))
(if (eq gnus-uu-do-not-unpack-archives nil)
(setq files (gnus-uu-unpack-files files)))
- (gnus-uu-add-file (mapcar (lambda (file) (cdr (assq 'name file))) files))
(setq files (nreverse (gnus-uu-get-actions files)))
(or not-insert (not gnus-insert-pseudo-articles)
(gnus-summary-insert-pseudos files save))))
@@ -1328,8 +1323,7 @@ The headers will be included in the sequence they are matched.")
(set-process-sentinel
gnus-uu-uudecode-process 'gnus-uu-uudecode-sentinel)
(setq state (list 'begin))
- (push (concat gnus-uu-work-dir gnus-uu-file-name) files)
- (gnus-uu-add-file (car files)))
+ (push (concat gnus-uu-work-dir gnus-uu-file-name) files))
;; We look for the end of the thing to be decoded.
(if (re-search-forward gnus-uu-end-string nil t)
@@ -1479,7 +1473,6 @@ The headers will be included in the sequence they are matched.")
(let* ((totfiles (gnus-uu-ls-r gnus-uu-work-dir))
(ofiles files)
file did-unpack)
- (gnus-uu-add-file totfiles)
(while files
(setq file (cdr (assq 'name (car files))))
(if (and (not (member file ignore))
@@ -1491,7 +1484,6 @@ The headers will be included in the sequence they are matched.")
(gnus-message 2 "Error during unpacking of %s" file))
(let* ((newfiles (gnus-uu-ls-r gnus-uu-work-dir))
(nfiles newfiles))
- (gnus-uu-add-file newfiles)
(while nfiles
(or (member (car nfiles) totfiles)
(setq ofiles (cons (list (cons 'name (car nfiles))
@@ -1582,7 +1574,6 @@ The headers will be included in the sequence they are matched.")
(setq gnus-uu-work-dir
(make-temp-name (concat gnus-uu-tmp-dir "gnus")))
- (gnus-uu-add-file gnus-uu-work-dir)
(if (not (file-directory-p gnus-uu-work-dir))
(gnus-make-directory gnus-uu-work-dir))
(set-file-modes gnus-uu-work-dir 448)
@@ -1595,38 +1586,12 @@ The headers will be included in the sequence they are matched.")
(defun gnus-uu-clean-up ()
(let (buf pst)
(and gnus-uu-uudecode-process
- (setq pst (process-status (or gnus-uu-uudecode-process "nevair")))
- (if (or (eq pst 'stop) (eq pst 'run))
- (delete-process gnus-uu-uudecode-process)))
+ (memq (process-status (or gnus-uu-uudecode-process "nevair"))
+ '(stop run))
+ (delete-process gnus-uu-uudecode-process))
(and (setq buf (get-buffer gnus-uu-output-buffer-name))
(kill-buffer buf))))
-;; `gnus-uu-check-for-generated-files' deletes any generated files that
-;; hasn't been deleted, if, for instance, the user terminated decoding
-;; with `C-g'.
-(defun gnus-uu-check-for-generated-files ()
- (let (file dirs)
- ;; First delete the generated files.
- (while (setq file (pop gnus-uu-generated-file-list))
- (unless (string-match "/\\.[\\.]?$" file)
- (if (file-directory-p file)
- (push file dirs)
- (when (file-exists-p file)
- (delete-file file)))))
- ;; Then delete the directories.
- (setq dirs (nreverse dirs))
- (while (setq file (pop dirs))
- (delete-directory (directory-file-name file)))))
-
-;; Add a file (or a list of files) to be checked (and deleted if it/they
-;; still exists upon exiting the newsgroup).
-(defun gnus-uu-add-file (file)
- (if (stringp file)
- (setq gnus-uu-generated-file-list
- (cons file gnus-uu-generated-file-list))
- (setq gnus-uu-generated-file-list
- (append file gnus-uu-generated-file-list))))
-
;; Inputs an action and a file and returns a full command, putting
;; quotes round the file name and escaping any quotes in the file name.
(defun gnus-uu-command (action file)
@@ -1642,11 +1607,28 @@ The headers will be included in the sequence they are matched.")
(format action ofile)
(concat action " " ofile))))
+(defun gnus-uu-delete-work-dir (&optional dir)
+ "Delete recursively all files and directories under `gnus-uu-work-dir'."
+ (unless dir
+ (setq dir gnus-uu-work-dir))
+ (gnus-message 7 "Deleting directory %s..." dir)
+ (when (and dir
+ (file-exists-p dir))
+ (let ((files (directory-files dir t nil t))
+ file)
+ (while (setq file (pop files))
+ (unless (string-match "/\\.\\.?$" file)
+ (if (file-directory-p file)
+ (gnus-uu-delete-work-dir file)
+ (gnus-message 9 "Deleting file %s..." file)
+ (delete-file file))))
+ (delete-directory dir)))
+ (gnus-message 7 ""))
;; Initializing
(add-hook 'gnus-exit-group-hook 'gnus-uu-clean-up)
-(add-hook 'gnus-exit-group-hook 'gnus-uu-check-for-generated-files)
+(add-hook 'gnus-exit-group-hook 'gnus-uu-delete-work-dir)
View
16 lisp/gnus-vis.el
@@ -366,19 +366,19 @@ ticked: The number of ticked articles in the group.
["List active file" gnus-group-list-active t])
("Sort"
["Default sort" gnus-group-sort-groups
- (not gnus-topic-mode)]
+ (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
["Sort by method" gnus-group-sort-groups-by-method
- (not gnus-topic-mode)]
+ (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
["Sort by rank" gnus-group-sort-groups-by-rank
- (not gnus-topic-mode)]
+ (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
["Sort by score" gnus-group-sort-groups-by-score
- (not gnus-topic-mode)]
+ (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
["Sort by level" gnus-group-sort-groups-by-level
- (not gnus-topic-mode)]
+ (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
["Sort by unread" gnus-group-sort-groups-by-unread
- (not gnus-topic-mode)]
+ (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
["Sort by name" gnus-group-sort-groups-by-alphabet
- (not gnus-topic-mode)])
+ (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))])
("Mark"
["Mark group" gnus-group-mark-group
(and (gnus-group-group-name)
@@ -1530,7 +1530,7 @@ specified by `gnus-button-alist'."
(defun gnus-button-reply (address)
;; Reply to ADDRESS.
- (message-reply t address))
+ (message-reply))
(defun gnus-button-url (address)
"Browse ADDRESS."
View
29 lisp/gnus-xmas.el
@@ -375,15 +375,18 @@ pounce directly on the real variables themselves.")
(make-color-instance color)))))
(defvar gnus-background-mode
- (let ((bg-resource
- (condition-case ()
- (x-get-resource ".backgroundMode" "BackgroundMode" 'string)
- (error nil)))
- (params (frame-parameters)))
+ (let* ((bg-resource
+ (condition-case ()
+ (x-get-resource ".backgroundMode" "BackgroundMode" 'string)
+ (error nil)))
+ (params (frame-parameters))
+ (color (or (assq 'background-color params)
+ (color-instance-name
+ (specifier-instance
+ (face-background 'default))))))
(cond (bg-resource (intern (downcase bg-resource)))
- ((and (assq 'background-color params)
- (< (apply '+ (gnus-x-color-values
- (cdr (assq 'background-color params))))
+ ((and color
+ (< (apply '+ (gnus-x-color-values color))
(/ (apply '+ (gnus-x-color-values "white")) 3)))
'dark)
(t 'light)))
@@ -448,10 +451,12 @@ pounce directly on the real variables themselves.")
;; We try to find the dir by looking at the load path,
;; stripping away the last component and adding "etc/".
(while path
- (setq dir (concat
- (file-name-directory (directory-file-name (car path)))
- "etc/gnus/"))
- (if (and (file-exists-p dir)
+ (if (and (car path)
+ (file-exists-p
+ (setq dir (concat
+ (file-name-directory
+ (directory-file-name (car path)))
+ "etc/gnus/")))
(file-directory-p dir)
(file-exists-p (concat dir "gnus-group-exit-icon-up.xpm")))
(setq gnus-xmas-glyph-directory dir
View
190 lisp/gnus.el
@@ -1533,6 +1533,11 @@ It is called with three parameters -- GROUP, LEVEL and OLDLEVEL.")
;; Internal variables
+(defvar gnus-thread-indent-array nil)
+(defvar gnus-thread-indent-array-level gnus-thread-indent-level)
+
+(defvar gnus-newsrc-file-version nil)
+
(defvar gnus-method-history nil)
;; Variable holding the user answers to all method prompts.
@@ -1702,7 +1707,7 @@ variable (string, integer, character, etc).")
"gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls + Boys)"
"The mail address of the Gnus maintainers.")
-(defconst gnus-version "September Gnus v0.77"
+(defconst gnus-version "September Gnus v0.78"
"Version number for this version of Gnus.")
(defvar gnus-info-nodes
@@ -4771,16 +4776,18 @@ increase the score of each group you read."
(setq method (gnus-info-method info))
(when (gnus-server-equal method "native")
(setq method nil))
- (if method
- ;; It's a foreign group...
- (gnus-group-make-group
- (gnus-group-real-name (gnus-info-group info))
- (if (stringp method) method
- (prin1-to-string (car method)))
- (and (consp method)
- (nth 1 (gnus-info-method info))))
- ;; It's a native group.
- (gnus-group-make-group (gnus-info-group info)))
+ (save-excursion
+ (set-buffer gnus-group-buffer)
+ (if method
+ ;; It's a foreign group...
+ (gnus-group-make-group
+ (gnus-group-real-name (gnus-info-group info))
+ (if (stringp method) method
+ (prin1-to-string (car method)))
+ (and (consp method)
+ (nth 1 (gnus-info-method info))))
+ ;; It's a native group.
+ (gnus-group-make-group (gnus-info-group info))))
(gnus-message 6 "Note: New group created")
(setq entry
(gnus-gethash (gnus-group-prefixed-name
@@ -4823,6 +4830,7 @@ increase the score of each group you read."
"Insert GROUP on the current line."
(let ((entry (gnus-gethash group gnus-newsrc-hashtb))
active info)
+ (setq gnus-group-indentation (gnus-group-group-indentation))
(if entry
(progn
;; (Un)subscribed group.
@@ -5436,35 +5444,40 @@ ADDRESS."
(t
(list method ""))))))
- (save-excursion
- (set-buffer gnus-group-buffer)
- (let* ((meth (and method (if address (list (intern method) address)
- method)))
- (nname (if method (gnus-group-prefixed-name name meth) name))
- backend info)
- (and (gnus-gethash nname gnus-newsrc-hashtb)
- (error "Group %s already exists" nname))
- (gnus-group-change-level
- (setq info (list t nname gnus-level-default-subscribed nil nil meth))
- gnus-level-default-subscribed gnus-level-killed
- (and (gnus-group-group-name)
- (gnus-gethash (gnus-group-group-name)
- gnus-newsrc-hashtb))
- t)
- (gnus-set-active nname (cons 1 0))
- (or (gnus-ephemeral-group-p name)
- (gnus-dribble-enter
- (concat "(gnus-group-set-info '" (prin1-to-string (cdr info)) ")")))
- (gnus-group-insert-group-line-info nname)
-
- (when (assoc (symbol-name (setq backend (car (gnus-server-get-method
- nil meth))))
- gnus-valid-select-methods)
- (require backend))
- (gnus-check-server meth)
- (and (gnus-check-backend-function 'request-create-group nname)
- (gnus-request-create-group nname))
- t)))
+ (let* ((meth (and method (if address (list (intern method) address)
+ method)))
+ (nname (if method (gnus-group-prefixed-name name meth) name))
+ backend info)
+ (when (gnus-gethash nname gnus-newsrc-hashtb)
+ (error "Group %s already exists" nname))
+ ;; Subscribe to the new group.
+ (gnus-group-change-level
+ (setq info (list t nname gnus-level-default-subscribed nil nil meth))
+ gnus-level-default-subscribed gnus-level-killed
+ (and (gnus-group-group-name)
+ (gnus-gethash (gnus-group-group-name)
+ gnus-newsrc-hashtb))
+ t)
+ ;; Make it active.
+ (gnus-set-active nname (cons 1 0))
+ (or (gnus-ephemeral-group-p name)
+ (gnus-dribble-enter
+ (concat "(gnus-group-set-info '" (prin1-to-string (cdr info)) ")")))
+ ;; Insert the line.
+ (gnus-group-insert-group-line-info nname)
+ (forward-line -1)
+ (gnus-group-position-point)
+
+ ;; Load the backend and try to make the backend create
+ ;; the group as well.
+ (when (assoc (symbol-name (setq backend (car (gnus-server-get-method
+ nil meth))))
+ gnus-valid-select-methods)
+ (require backend))
+ (gnus-check-server meth)
+ (and (gnus-check-backend-function 'request-create-group nname)
+ (gnus-request-create-group nname))
+ t))
(defun gnus-group-delete-group (group &optional force)
"Delete the current group.
@@ -5680,9 +5693,7 @@ of the Earth\". There is no undo."
(gnus-group-real-name name)
(list 'nndoc (file-name-nondirectory file)
(list 'nndoc-address file)
- (list 'nndoc-article-type (or type 'guess))))
- (forward-line -1)
- (gnus-group-position-point)))
+ (list 'nndoc-article-type (or type 'guess))))))
(defun gnus-group-make-archive-group (&optional all)
"Create the (ding) Gnus archive group of the most recent articles.
@@ -5697,9 +5708,7 @@ Given a prefix, create a full group."
(list 'nndir (if all "hpc" "edu")
(list 'nndir-directory
(if all gnus-group-archive-directory
- gnus-group-recent-archive-directory)))))
- (forward-line -1)
- (gnus-group-position-point))
+ gnus-group-recent-archive-directory))))))
(defun gnus-group-make-directory-group (dir)
"Create an nndir group.
@@ -5722,9 +5731,7 @@ mail messages or news articles in files that have numeric names."
(setq ext (format "<%d>" (setq i (1+ i)))))
(gnus-group-make-group
(gnus-group-real-name group)
- (list 'nndir group (list 'nndir-directory dir))))
- (forward-line -1)
- (gnus-group-position-point))
+ (list 'nndir group (list 'nndir-directory dir)))))
(defun gnus-group-make-kiboze-group (group address scores)
"Create an nnkiboze group.
@@ -5749,14 +5756,9 @@ score file entries for articles to include in the group."
(setq scores (cons (cons header regexps) scores)))
scores)))
(gnus-group-make-group group "nnkiboze" address)
- (save-excursion
- (gnus-set-work-buffer)
+ (nnheader-temp-write (gnus-score-file-name (concat "nnkiboze:" group))
(let (emacs-lisp-mode-hook)
- (pp scores (current-buffer)))
- (write-region (point-min) (point-max)
- (gnus-score-file-name (concat "nnkiboze:" group))))
- (forward-line -1)
- (gnus-group-position-point))
+ (pp scores (current-buffer)))))
(defun gnus-group-add-to-virtual (n vgroup)
"Add the current group to a virtual group."
@@ -5946,11 +5948,13 @@ caught up is returned."
(nnvirtual-catchup-group
(gnus-group-real-name (car groups)) (nth 1 method) all)))
(gnus-group-remove-mark (car groups))
- (if (prog1
- (gnus-group-goto-group (car groups))
- (gnus-group-catchup (car groups) all))
- (gnus-group-update-group-line)
- (setq ret (1+ ret)))
+ (if (>= (gnus-group-group-level) gnus-level-zombie)
+ (gnus-message 2 "Dead groups can't be caught up")
+ (if (prog1
+ (gnus-group-goto-group (car groups))
+ (gnus-group-catchup (car groups) all))
+ (gnus-group-update-group-line)
+ (setq ret (1+ ret))))
(setq groups (cdr groups)))
(gnus-group-next-unread-group 1)
ret)))
@@ -7388,8 +7392,6 @@ This is all marks except unread, ticked, dormant, and expirable."
(point) (progn (eval gnus-summary-dummy-line-format-spec) (point))
(list 'gnus-number gnus-tmp-number 'gnus-intangible gnus-tmp-number)))
-(defvar gnus-thread-indent-array nil)
-(defvar gnus-thread-indent-array-level gnus-thread-indent-level)
(defun gnus-make-thread-indent-array ()
(let ((n 200))
(unless (and gnus-thread-indent-array
@@ -7978,7 +7980,7 @@ If NO-DISPLAY, don't generate a summary buffer."
(let (threads)
;; We then insert this thread into the summary buffer.
(let (gnus-newsgroup-data gnus-newsgroup-threads)
- (gnus-summary-prepare-threads (list thread))
+ (gnus-summary-prepare-threads (gnus-cut-threads (list thread)))
(setq data (nreverse gnus-newsgroup-data))
(setq threads gnus-newsgroup-threads))
;; We splice the new data into the data structure.
@@ -9015,6 +9017,7 @@ The resulting hash table is returned, or nil if no Xrefs were found."
headers id id-dep ref-dep end ref)
(save-excursion
(set-buffer nntp-server-buffer)
+ (run-hooks 'gnus-parse-headers-hook)
(let ((case-fold-search t)
in-reply-to header p lines)
(goto-char (point-min))
@@ -13430,6 +13433,9 @@ The following commands are available:
(defun gnus-read-header (id &optional header)
"Read the headers of article ID and enter them into the Gnus system."
(let ((group gnus-newsgroup-name)
+ (gnus-override-method
+ (and (gnus-news-group-p gnus-newsgroup-name)
+ gnus-refer-article-method))
where)
;; First we check to see whether the header in question is already
;; fetched.
@@ -13904,6 +13910,7 @@ or not."
(defun gnus-mime-decode-quoted-printable (from to)
"Decode Quoted-Printable in the region between FROM and TO."
+ (interactive "r")
(goto-char from)
(while (search-forward "=" to t)
(cond ((eq (following-char) ?\n)
@@ -15108,7 +15115,9 @@ If LEVEL is non-nil, the news will be set up at level LEVEL."
(gnus-find-new-newsgroups))
;; We might read in new NoCeM messages here.
- (when gnus-use-nocem
+ (when (and gnus-use-nocem
+ (not level)
+ (not dont-connect))
(gnus-nocem-scan-groups))
;; Find the number of unread articles in each non-dead group.
@@ -16030,8 +16039,55 @@ If FORCE is non-nil, the .newsrc file is read."
(gnus-message 5 "Reading %s...done" newsrc-file)))
;; Read any slave files.
- (or gnus-slave
- (gnus-master-read-slave-newsrc)))))
+ (unless gnus-slave
+ (gnus-master-read-slave-newsrc))
+
+ ;; Convert old to new.
+ (gnus-convert-old-newsrc))))
+
+(defun gnus-continuum-version (version)
+ "Return VERSION as a floating point number."
+ (when (string-match "^\\([^ ]+\\)? ?Gnus v?\\([0-9.]+\\)$" version)
+ (let* ((alpha (and (match-beginning 1) (match-string 1 version)))
+ (number (match-string 2 version))
+ major minor least)
+ (string-match "\\([0-9]\\)\\.\\([0-9]+\\)\\.?\\([0-9]+\\)?" number)
+ (setq major (string-to-number (match-string 1 number)))
+ (setq minor (string-to-number (match-string 2 number)))
+ (setq least (if (match-beginning 3)
+ (string-to-number (match-string 3 number))
+ 0))
+ (string-to-number
+ (if (zerop major)
+ (format "%s00%02d%02d"
+ (cond
+ ((string= alpha "(ding)") "4.99")
+ ((string= alpha "September") "5.01")
+ ((string= alpha "Red") "5.03"))
+ minor least)
+ (format "%d.%02d%20d" major minor least))))))
+
+(defun gnus-convert-old-newsrc ()
+ "Convert old newsrc into the new format, if needed."
+ (let ((fcv (gnus-continuum-version gnus-newsrc-file-version)))
+ (cond
+ ((< fcv (gnus-continuum-version "September Gnus v0.1"))
+ (gnus-convert-old-ticks)))))
+
+(defun gnus-convert-old-ticks ()
+ (let ((newsrc (cdr gnus-newsrc-alist))
+ marks info dormant ticked)
+ (while (setq info (pop newsrc))
+ (when (setq marks (gnus-info-marks info))
+ (setq dormant (cdr (assq 'dormant marks))
+ ticked (cdr (assq 'tick marks)))
+ (when (or dormant ticked)
+ (gnus-info-set-read
+ info
+ (gnus-add-to-range
+ (gnus-info-read info)
+ (nconc (gnus-uncompress-range dormant)
+ (gnus-uncompress-range ticked)))))))))
(defun gnus-read-newsrc-el-file (file)
(let ((ding-file (concat file "d")))
View
390 lisp/message.el
@@ -67,14 +67,16 @@ Otherwise, most addresses look like `angles', but they look like
`parens' if `angles' would need quoting and `parens' would not.")
;;;###autoload
-(defvar message-syntax-checks
- '(subject-cmsg multiple-headers sendsys message-id from
- long-lines control-chars size new-text
- redirected-followup signature approved sender
- empty empty-headers message-id from subject)
- "In non-nil, message will attempt to run some checks on outgoing posts.
-If this variable is t, message will check everything it can. If it is
-a list, then those elements in that list will be checked.")
+(defvar message-syntax-checks nil
+ "Controls what syntax checks should not be performed on outgoing posts.
+To disable checking of long signatures, for instance, add
+ `(signature . disable)' to this list.
+
+Don't touch this variable unless you really know what you're doing.
+
+Checks include subject-cmsg multiple-headers sendsys message-id from
+long-lines control-chars size new-text redirected-followup signature
+approved sender empty empty-headers message-id from subject.")
;;;###autoload
(defvar message-required-news-headers
@@ -213,7 +215,8 @@ always use the value.")
(defvar gnus-select-method)
;;;###autoload
(defvar message-post-method
- (cond ((boundp 'gnus-post-method)
+ (cond ((and (boundp 'gnus-post-method)
+ gnus-post-method)
gnus-post-method)
((boundp 'gnus-select-method)
gnus-select-method)
@@ -606,9 +609,11 @@ Return the number of headers removed."
(define-key message-mode-map "\C-c\C-q" 'message-fill-yanked-message)
(define-key message-mode-map "\C-c\C-w" 'message-insert-signature)
(define-key message-mode-map "\C-c\C-r" 'message-caesar-buffer-body)
+ (define-key message-mode-map "\C-c\C-h" 'message-sort-headers)
(define-key message-mode-map "\C-c\C-c" 'message-send-and-exit)
- (define-key message-mode-map "\C-c\C-s" 'message-send))
+ (define-key message-mode-map "\C-c\C-s" 'message-send)
+ (define-key message-mode-map "\C-c\C-k" 'message-dont-send))
(defun message-make-menu-bar ()
(unless (boundp 'message-menu)
@@ -871,10 +876,8 @@ Numeric argument means justify as well."
(save-excursion
(goto-char (point-min))
(search-forward (concat "\n" mail-header-separator "\n") nil t)
- (fill-individual-paragraphs (point)
- (point-max)
- justifyp
- t)))
+ (let ((fill-prefix message-yank-prefix))
+ (fill-individual-paragraphs (point) (point-max) justifyp t))))
(defun message-indent-citation ()
"Modify text just inserted from a message to be cited.
@@ -1213,188 +1216,185 @@ the user from the mailer."
(defun message-check-news-syntax ()
"Check the syntax of the message."
- (or
- (not message-syntax-checks)
- (and
- ;; We narrow to the headers and check them first.
- (save-excursion
- (save-restriction
- (message-narrow-to-headers)
- (and
- ;; Check for commands in Subject.
- (or
- (message-check-element 'subject-cmsg)
- (save-excursion
- (if (string-match "^cmsg " (mail-fetch-field "subject"))
- (y-or-n-p
- "The control code \"cmsg \" is in the subject. Really post? ")
- t)))
- ;; Check for multiple identical headers.
- (or (message-check-element 'multiple-headers)
- (save-excursion
- (let (found)
- (while (and (not found)
- (re-search-forward "^[^ \t:]+: " nil t))
- (save-excursion
- (or (re-search-forward
- (concat "^" (setq found
- (buffer-substring
- (match-beginning 0)
- (- (match-end 0) 2))))
- nil t)
- (setq found nil))))
- (if found
- (y-or-n-p
- (format "Multiple %s headers. Really post? " found))
- t))))
- ;; Check for Version and Sendsys.
- (or (message-check-element 'sendsys)
- (save-excursion
- (if (re-search-forward "^Sendsys:\\|^Version:" nil t)
- (y-or-n-p
- (format "The article contains a %s command. Really post? "
- (buffer-substring (match-beginning 0)
- (1- (match-end 0)))))
- t)))
- ;; See whether we can shorten Followup-To.
- (or (message-check-element 'shorten-followup-to)
- (let ((newsgroups (mail-fetch-field "newsgroups"))
- (followup-to (mail-fetch-field "followup-to"))
- to)
- (when (and newsgroups (string-match "," newsgroups)
- (not followup-to)
- (not
- (zerop
- (length
- (setq to (completing-read
- "Followups to: (default all groups) "
- (mapcar (lambda (g) (list g))
- (cons "poster"
- (message-tokenize-header
- newsgroups)))))))))
- (goto-char (point-min))
- (insert "Followup-To: " to "\n"))))
-
- ;; Check for Approved.
- (or (message-check-element 'approved)
- (save-excursion
- (if (re-search-forward "^Approved:" nil t)
- (y-or-n-p
- "The article contains an Approved header. Really post? ")
- t)))
- ;; Check the Message-Id header.
- (or (message-check-element 'message-id)
- (save-excursion
- (let* ((case-fold-search t)
- (message-id (mail-fetch-field "message-id")))
- (or (not message-id)
- (and (string-match "@" message-id)
- (string-match "@[^\\.]*\\." message-id))
- (y-or-n-p
- (format
- "The Message-ID looks strange: \"%s\". Really post? "
- message-id))))))
- ;; Check the Subject header.
- (or
- (message-check-element 'subject)
- (save-excursion
- (let* ((case-fold-search t)
- (subject (mail-fetch-field "subject")))
- (or
- (and subject
- (not (string-match "\\`[ \t]*\\'" subject)))
- (progn
- (message
- "The subject field is empty or missing. Posting is denied.")
- nil)))))
- ;; Check the From header.
- (or (message-check-element 'from)
- (save-excursion
- (let* ((case-fold-search t)
- (from (mail-fetch-field "from")))
- (cond
- ((not from)
- (message "There is no From line. Posting is denied.")
- nil)
- ((not (string-match "@[^\\.]*\\." from))
- (message
- "Denied posting -- the From looks strange: \"%s\"." from)
- nil)
- ((string-match "@[^@]*@" from)
- (message
- "Denied posting -- two \"@\"'s in the From header: %s."
- from)
- nil)
- ((string-match "(.*).*(.*)" from)
- (message
- "Denied posting -- the From header looks strange: \"%s\"."
- from)
- nil)
- (t t))))))))
- ;; Check for long lines.
- (or (message-check-element 'long-lines)
- (save-excursion
- (goto-char (point-min))
- (re-search-forward
- (concat "^" (regexp-quote mail-header-separator) "$"))
- (while (and
- (progn
- (end-of-line)
- (< (current-column) 80))
- (zerop (forward-line 1))))
- (or (bolp)
- (eobp)
- (y-or-n-p
- "You have lines longer than 79 characters. Really post? "))))
- ;; Check whether the article is empty.
- (or (message-check-element 'empty)
- (save-excursion
- (goto-char (point-min))
- (re-search-forward
- (concat "^" (regexp-quote mail-header-separator) "$"))
- (forward-line 1)
- (or (re-search-forward "[^ \n\t]" nil t)
- (y-or-n-p "Empty article. Really post?"))))
- ;; Check for control characters.
- (or (message-check-element 'control-chars)
- (save-excursion
- (if (re-search-forward "[\000-\007\013\015-\037\200-\237]" nil t)
- (y-or-n-p
- "The article contains control characters. Really post? ")
- t)))
- ;; Check excessive size.
- (or (message-check-element 'size)
- (if (> (buffer-size) 60000)
- (y-or-n-p
- (format "The article is %d octets long. Really post? "
- (buffer-size)))
- t))
- ;; Check whether any new text has been added.
- (or (message-check-element 'new-text)
- (not message-checksum)
- (not (eq (message-checksum) message-checksum))
- (y-or-n-p
- "It looks like no new text has been added. Really post? "))
- ;; Check the length of the signature.
- (or (message-check-element 'signature)
- (progn
- (goto-char (point-max))
- (if (not (re-search-backward "^-- $" nil t))
- t
- (if (> (count-lines (point) (point-max)) 5)
- (y-or-n-p
- (format
- "Your .sig is %d lines; it should be max 4. Really post? "
- (count-lines (point) (point-max))))
- t)))))))
-
-;; Returns non-nil if this type is not to be checked.
+ (and
+ ;; We narrow to the headers and check them first.
+ (save-excursion
+ (save-restriction
+ (message-narrow-to-headers)
+ (and
+ ;; Check for commands in Subject.
+ (or
+ (message-check-element 'subject-cmsg)
+ (save-excursion
+ (if (string-match "^cmsg " (mail-fetch-field "subject"))
+ (y-or-n-p
+ "The control code \"cmsg \" is in the subject. Really post? ")
+ t)))
+ ;; Check for multiple identical headers.
+ (or (message-check-element 'multiple-headers)
+ (save-excursion
+ (let (found)
+ (while (and (not found)
+ (re-search-forward "^[^ \t:]+: " nil t))
+ (save-excursion
+ (or (re-search-forward
+ (concat "^" (setq found
+ (buffer-substring
+ (match-beginning 0)
+ (- (match-end 0) 2))))
+ nil t)
+ (setq found nil))))
+ (if found
+ (y-or-n-p
+ (format "Multiple %s headers. Really post? " found))
+ t))))
+ ;; Check for Version and Sendsys.
+ (or (message-check-element 'sendsys)
+ (save-excursion
+ (if (re-search-forward "^Sendsys:\\|^Version:" nil t)
+ (y-or-n-p
+ (format "The article contains a %s command. Really post? "
+ (buffer-substring (match-beginning 0)
+ (1- (match-end 0)))))
+ t)))
+ ;; See whether we can shorten Followup-To.
+ (or (message-check-element 'shorten-followup-to)
+ (let ((newsgroups (mail-fetch-field "newsgroups"))
+ (followup-to (mail-fetch-field "followup-to"))
+ to)
+ (when (and newsgroups (string-match "," newsgroups)
+ (not followup-to)
+ (not
+ (zerop
+ (length
+ (setq to (completing-read
+ "Followups to: (default all groups) "
+ (mapcar (lambda (g) (list g))
+ (cons "poster"
+ (message-tokenize-header
+ newsgroups)))))))))
+ (goto-char (point-min))
+ (insert "Followup-To: " to "\n"))
+ t))
+
+ ;; Check for Approved.
+ (or (message-check-element 'approved)
+ (save-excursion
+ (if (re-search-forward "^Approved:" nil t)
+ (y-or-n-p
+ "The article contains an Approved header. Really post? ")
+ t)))
+ ;; Check the Message-Id header.
+ (or (message-check-element 'message-id)
+ (save-excursion
+ (let* ((case-fold-search t)
+ (message-id (mail-fetch-field "message-id")))
+ (or (not message-id)
+ (and (string-match "@" message-id)
+ (string-match "@[^\\.]*\\." message-id))
+ (y-or-n-p
+ (format
+ "The Message-ID looks strange: \"%s\". Really post? "
+ message-id))))))
+ ;; Check the Subject header.
+ (or
+ (message-check-element 'subject)
+ (save-excursion
+ (let* ((case-fold-search t)
+ (subject (mail-fetch-field "subject")))
+ (or
+ (and subject
+ (not (string-match "\\`[ \t]*\\'" subject)))
+ (progn
+ (message
+ "The subject field is empty or missing. Posting is denied.")
+ nil)))))
+ ;; Check the From header.
+ (or (message-check-element 'from)
+ (save-excursion
+ (let* ((case-fold-search t)
+ (from (mail-fetch-field "from")))
+ (cond
+ ((not from)
+ (message "There is no From line. Posting is denied.")
+ nil)
+ ((not (string-match "@[^\\.]*\\." from))
+ (message
+ "Denied posting -- the From looks strange: \"%s\"." from)
+ nil)
+ ((string-match "@[^@]*@" from)
+ (message
+ "Denied posting -- two \"@\"'s in the From header: %s."
+ from)
+ nil)
+ ((string-match "(.*).*(.*)" from)
+ (message
+ "Denied posting -- the From header looks strange: \"%s\"."
+ from)
+ nil)
+ (t t))))))))
+ ;; Check for long lines.
+ (or (message-check-element 'long-lines)
+ (save-excursion
+ (goto-char (point-min))
+ (re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "$"))
+ (while (and
+ (progn
+ (end-of-line)
+ (< (current-column) 80))
+ (zerop (forward-line 1))))
+ (or (bolp)
+ (eobp)
+ (y-or-n-p
+ "You have lines longer than 79 characters. Really post? "))))
+ ;; Check whether the article is empty.
+ (or (message-check-element 'empty)
+ (save-excursion
+ (goto-char (point-min))
+ (re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "$"))
+ (forward-line 1)
+ (or (re-search-forward "[^ \n\t]" nil t)
+ (y-or-n-p "Empty article. Really post?"))))
+ ;; Check for control characters.
+ (or (message-check-element 'control-chars)
+ (save-excursion
+ (if (re-search-forward "[\000-\007\013\015-\037\200-\237]" nil t)
+ (y-or-n-p
+ "The article contains control characters. Really post? ")
+ t)))
+ ;; Check excessive size.
+ (or (message-check-element 'size)
+ (if (> (buffer-size) 60000)
+ (y-or-n-p
+ (format "The article is %d octets long. Really post? "
+ (buffer-size)))
+ t))
+ ;; Check whether any new text has been added.
+ (or (message-check-element 'new-text)
+ (not message-checksum)
+ (not (eq (message-checksum) message-checksum))
+ (y-or-n-p
+ "It looks like no new text has been added. Really post? "))
+ ;; Check the length of the signature.
+ (or (message-check-element 'signature)
+ (progn
+ (goto-char (point-max))
+ (if (not (re-search-backward "^-- $" nil t))
+ t
+ (if (> (count-lines (point) (point-max)) 5)
+ (y-or-n-p
+ (format
+ "Your .sig is %d lines; it should be max 4. Really post? "
+ (count-lines (point) (point-max))))
+ t))))))
+
(defun message-check-element (type)
- (not
- (or (not message-syntax-checks)
- (if (listp message-syntax-checks)
- (memq type message-syntax-checks)
- t))))
+ "Returns non-nil if this type is not to be checked."
+ (let ((able (assq type message-syntax-checks)))
+ (and (consp able)
+ (eq (cdr able) 'disabled))))
(defun message-checksum ()
"Return a \"checksum\" for the current buffer."
View
193 lisp/nnbabyl.el
@@ -73,37 +73,37 @@
(nnoo-define-basics nnbabyl)
-(deffoo nnbabyl-retrieve-headers (sequence &optional newsgroup server fetch-old)
+(deffoo nnbabyl-retrieve-headers (articles &optional group server fetch-old)
(save-excursion
(set-buffer nntp-server-buffer)
(erase-buffer)
- (let ((number (length sequence))
+ (let ((number (length articles))
(count 0)
+ (delim (concat "^" nnbabyl-mail-delimiter))
article art-string start stop)
- (nnbabyl-possibly-change-newsgroup newsgroup server)
- (while sequence
- (setq article (car sequence))
+ (nnbabyl-possibly-change-newsgroup group server)
+ (while (setq article (pop articles))
(setq art-string (nnbabyl-article-string article))
(set-buffer nnbabyl-mbox-buffer)
- (if (or (search-forward art-string nil t)
- (search-backward art-string nil t))
- (progn
- (re-search-backward (concat "^" nnbabyl-mail-delimiter) nil t)
- (while (and (not (looking-at ".+:"))
- (zerop (forward-line 1))))
- (setq start (point))
- (search-forward "\n\n" nil t)
- (setq stop (1- (point)))
- (set-buffer nntp-server-buffer)
- (insert "221 " (int-to-string article) " Article retrieved.\n")
- (insert-buffer-substring nnbabyl-mbox-buffer start stop)
- (goto-char (point-max))
- (insert ".\n")))
- (setq sequence (cdr sequence))
- (setq count (1+ count))
+ (beginning-of-line)
+ (when (or (search-forward art-string nil t)
+ (search-backward art-string nil t))
+ (re-search-backward delim nil t)
+ (while (and (not (looking-at ".+:"))
+ (zerop (forward-line 1))))
+ (setq start (point))
+ (search-forward "\n\n" nil t)
+ (setq stop (1- (point)))
+ (set-buffer nntp-server-buffer)
+ (insert "221 ")
+ (princ article (current-buffer))
+ (insert " Article retrieved.\n")
+ (insert-buffer-substring nnbabyl-mbox-buffer start stop)
+ (goto-char (point-max))
+ (insert ".\n"))
(and (numberp nnmail-large-newsgroup)
(> number nnmail-large-newsgroup)
- (zerop (% count 20))
+ (zerop (% (incf count) 20))
(nnheader-message 5 "nnbabyl: Receiving headers... %d%%"
(/ (* count 100) number))))
@@ -155,56 +155,54 @@
(save-excursion
(set-buffer nnbabyl-mbox-buffer)
(goto-char (point-min))
- (if (search-forward (nnbabyl-article-string article) nil t)
- (let (start stop summary-line)
- (re-search-backward (concat "^" nnbabyl-mail-delimiter) nil t)
- (while (and (not (looking-at ".+:"))
- (zerop (forward-line 1))))
- (setq start (point))
- (or (and (re-search-forward
- (concat "^" nnbabyl-mail-delimiter) nil t)
- (forward-line -1))
- (goto-char (point-max)))
- (setq stop (point))
- (let ((nntp-server-buffer (or buffer nntp-server-buffer)))
- (set-buffer nntp-server-buffer)
- (erase-buffer)
- (insert-buffer-substring nnbabyl-mbox-buffer start stop)
- (goto-char (point-min))
- ;; If there is an EOOH header, then we have to remove some
- ;; duplicated headers.
- (setq summary-line (looking-at "Summary-line:"))
- (when (search-forward "\n*** EOOH ***" nil t)
- (if summary-line
- ;; The headers to be deleted are located before the
- ;; EOOH line...
- (delete-region (point-min) (progn (forward-line 1)
- (point)))
- ;; ...or after.
- (delete-region (progn (beginning-of-line) (point))
- (or (search-forward "\n\n" nil t)
- (point)))))
- (if (numberp article)
- (cons nnbabyl-current-group article)
- (nnbabyl-article-group-number)))))))
+ (when (search-forward (nnbabyl-article-string article) nil t)
+ (let (start stop summary-line)
+ (re-search-backward (concat "^" nnbabyl-mail-delimiter) nil t)
+ (while (and (not (looking-at ".+:"))
+ (zerop (forward-line 1))))
+ (setq start (point))
+ (or (and (re-search-forward
+ (concat "^" nnbabyl-mail-delimiter) nil t)
+ (forward-line -1))
+ (goto-char (point-max)))
+ (setq stop (point))
+ (let ((nntp-server-buffer (or buffer nntp-server-buffer)))
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)
+ (insert-buffer-substring nnbabyl-mbox-buffer start stop)
+ (goto-char (point-min))
+ ;; If there is an EOOH header, then we have to remove some
+ ;; duplicated headers.
+ (setq summary-line (looking-at "Summary-line:"))
+ (when (search-forward "\n*** EOOH ***" nil t)
+ (if summary-line
+ ;; The headers to be deleted are located before the
+ ;; EOOH line...
+ (delete-region (point-min) (progn (forward-line 1)
+ (point)))
+ ;; ...or after.
+ (delete-region (progn (beginning-of-line) (point))
+ (or (search-forward "\n\n" nil t)
+ (point)))))
+ (if (numberp article)
+ (cons nnbabyl-current-group article)
+ (nnbabyl-article-group-number)))))))
(deffoo nnbabyl-request-group (group &optional server dont-check)
(let ((active (cadr (assoc group nnbabyl-group-alist))))
(save-excursion
(cond
- ((null active)
- (nnheader-report 'nnbabyl "No such group: %s" group))
- ((null (nnbabyl-possibly-change-newsgroup group server))
+ ((or (null active)
+ (null (nnbabyl-possibly-change-newsgroup group server)))
(nnheader-report 'nnbabyl "No such group: %s" group))
(dont-check
(nnheader-report 'nnbabyl "Selected group %s" group)
- t)
+ (nnheader-insert ""))
(t
(nnheader-report 'nnbabyl "Selected group %s" group)
(nnheader-insert "211 %d %d %d %s\n"
(1+ (- (cdr active) (car active)))
- (car active) (cdr active) group)
- t)))))
+ (car active) (cdr active) group))))))
(deffoo nnbabyl-request-scan (&optional group server)
(nnbabyl-read-mbox)
@@ -225,7 +223,8 @@
(goto-char (point-max))
(search-backward "\n\^_" nil t)
(goto-char (match-end 0))
- (insert-buffer-substring in-buf))))))
+ (insert-buffer-substring in-buf)))
+ (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file))))
(deffoo nnbabyl-close-group (group &optional server)
t)
@@ -240,11 +239,8 @@
(deffoo nnbabyl-request-list (&optional server)
(save-excursion
- (or (nnmail-find-file nnbabyl-active-file)
- (progn
- (setq nnbabyl-group-alist (nnmail-get-active))
- (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)
- (nnmail-find-file nnbabyl-active-file)))))
+ (nnmail-find-file nnbabyl-active-file)
+ (setq nnbabyl-group-alist (nnmail-get-active))))
(deffoo nnbabyl-request-newgroups (date &optional server)
(nnbabyl-request-list server))
@@ -337,10 +333,9 @@
(search-backward "\n\^_")
(goto-char (match-end 0))
(insert-buffer-substring buf)
- (and last (progn
- (save-buffer)
- (nnmail-save-active
- nnbabyl-group-alist nnbabyl-active-file)))
+ (when last
+ (save-buffer)
+ (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file))
result))))
(deffoo nnbabyl-request-replace-article (article group buffer)
@@ -530,27 +525,29 @@
(defun nnbabyl-read-mbox ()
(nnmail-activate 'nnbabyl)
- (or (file-exists-p nnbabyl-mbox-file)
- (save-excursion
- (set-buffer (setq nnbabyl-mbox-buffer
- (create-file-buffer nnbabyl-mbox-file)))
- (setq buffer-file-name nnbabyl-mbox-file)
- (insert "BABYL OPTIONS:\n\n\^_")
- (write-region (point-min) (point-max) nnbabyl-mbox-file t 'nomesg)))
+ (unless (file-exists-p nnbabyl-mbox-file)
+ ;; Create a new, empty RMAIL mbox file.
+ (save-excursion
+ (set-buffer (setq nnbabyl-mbox-buffer
+ (create-file-buffer nnbabyl-mbox-file)))
+ (setq buffer-file-name nnbabyl-mbox-file)
+ (insert "BABYL OPTIONS:\n\n\^_")
+ (write-region (point-min) (point-max) nnbabyl-mbox-file t 'nomesg)))
(if (and nnbabyl-mbox-buffer
(buffer-name nnbabyl-mbox-buffer)
(save-excursion
(set-buffer nnbabyl-mbox-buffer)
(= (buffer-size) (nth 7 (file-attributes nnbabyl-mbox-file)))))
- ()
+ () ; This buffer hasn't changed since we read it last. Possibly.
(save-excursion
(let ((delim (concat "^" nnbabyl-mail-delimiter))
- start end)
+ (alist nnbabyl-group-alist)
+ start end number)
(set-buffer (setq nnbabyl-mbox-buffer
(nnheader-find-file-noselect
nnbabyl-mbox-file nil 'raw)))
- ;; Save buffer mode.
+ ;; Save previous buffer mode.
(setq nnbabyl-previous-buffer-mode
(cons (cons (point-min) (point-max))
major-mode))
@@ -559,23 +556,39 @@
(widen)
(setq buffer-read-only nil)
(fundamental-mode)
+
+ ;; Go through the group alist and compare against
+ ;; the rmail file.
+ (while alist
+ (goto-char (point-max))
+ (when (and (re-search-backward
+ (format "^X-Gnus-Newsgroup: %s:\\([0-9]+\\) "
+ (caar alist)) nil t)
+ (>= (setq number
+ (string-to-number
+ (buffer-substring
+ (match-beginning 1) (match-end 1))))
+ (cdadar alist)))
+ (setcdr (cadar alist) (1+ number)))
+ (setq alist (cdr alist)))
+ ;; We go through the mbox and make sure that each and
+ ;; every mail belongs to some group or other.
(goto-char (point-min))
(re-search-forward delim nil t)
(setq start (match-end 0))
(while (re-search-forward delim nil t)
(setq end (match-end 0))
- (or (search-backward "\nX-Gnus-Newsgroup: " start t)
- (progn
- (goto-char end)
- (save-excursion
- (save-restriction
- (goto-char start)
- (narrow-to-region start end)
- (nnbabyl-save-mail)
- (setq end (point-max))))))
+ (unless (search-backward "\nX-Gnus-Newsgroup: " start t)
+ (goto-char end)
+ (save-excursion
+ (save-restriction
+ (narrow-to-region (goto-char start) end)
+ (nnbabyl-save-mail)
+ (setq end (point-max)))))
(goto-char (setq start end)))
- (and (buffer-modified-p (current-buffer)) (save-buffer))
+ (when (buffer-modified-p (current-buffer))
+ (save-buffer))
(nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)))))
(defun nnbabyl-remove-incoming-delims ()
View
37 lisp/nnmbox.el
@@ -173,9 +173,8 @@
(deffoo nnmbox-request-group (group &optional server dont-check)
(let ((active (cadr (assoc group nnmbox-group-alist))))
(cond
- ((null active)
- (nnheader-report 'nnmbox "No such group: %s" group))
- ((null (nnmbox-possibly-change-newsgroup group server))
+ ((or (null active)
+ (null (nnmbox-possibly-change-newsgroup group server)))
(nnheader-report 'nnmbox "No such group: %s" group))
(dont-check
(nnheader-report 'nnmbox "Selected group %s" group)
@@ -184,8 +183,7 @@
(nnheader-report 'nnmbox "Selected group %s" group)
(nnheader-insert "211 %d %d %d %s\n"
(1+ (- (cdr active) (car active)))
- (car active) (cdr active) group)
- t))))
+ (car active) (cdr active) group)))))
(deffoo nnmbox-request-scan (&optional group server)
(nnmbox-read-mbox)
@@ -201,18 +199,16 @@
(let ((in-buf (current-buffer)))
(set-buffer nnmbox-mbox-buffer)
(goto-char (point-max))
- (insert-buffer-substring in-buf))))))
+ (insert-buffer-substring in-buf)))
+ (nnmail-save-active nnmbox-group-alist nnmbox-active-file))))
(deffoo nnmbox-close-group (group &optional server)
t)
(deffoo nnmbox-request-list (&optional server)
(save-excursion
- (or (nnmail-find-file nnmbox-active-file)
- (progn
- (setq nnmbox-group-alist (nnmail-get-active))
- (nnmail-save-active nnmbox-group-alist nnmbox-active-file)
- (nnmail-find-file nnmbox-active-file)))))
+ (nnmail-find-file nnmbox-active-file)
+ (setq nnmbox-group-alist (nnmail-get-active))))
(deffoo nnmbox-request-newgroups (date &optional server)
(nnmbox-request-list server))
@@ -490,11 +486,28 @@
()
(save-excursion
(let ((delim (concat "^" rmail-unix-mail-delimiter))
- start end)
+ (alist nnmbox-group-alist)
+ start end number)
(set-buffer (setq nnmbox-mbox-buffer
(nnheader-find-file-noselect
nnmbox-mbox-file nil 'raw)))
(buffer-disable-undo (current-buffer))
+
+ ;; Go through the group alist and compare against
+ ;; the mbox file.
+ (while alist
+ (goto-char (point-max))
+ (when (and (re-search-backward
+ (format "^X-Gnus-Newsgroup: %s:\\([0-9]+\\) "
+ (caar alist)) nil t)
+ (>= (setq number
+ (string-to-number
+ (buffer-substring
+ (match-beginning 1) (match-end 1))))
+ (cdadar alist)))
+ (setcdr (cadar alist) (1+ number)))
+ (setq alist (cdr alist)))
+
(goto-char (point-min))
(while (re-search-forward delim nil t)
(setq start (match-beginning 0))
View
1  lisp/nnml.el
@@ -304,6 +304,7 @@ all. This may very well take some time.")
(kill-buffer (current-buffer))
result)
(progn
+ (nnml-possibly-change-directory group server)
(condition-case ()
(funcall nnmail-delete-file-function
(concat nnml-current-directory
View
24 texi/gnus.texi
@@ -10674,13 +10674,25 @@ next article, just type @kbd{4 n}.
@node Displaying Predictions
@subsection Displaying Predictions
+GroupLens makes a prediction for you about how much you will like a
+news article. The predictions from GroupLens are on a scale from 1 to
+5, where 1 is the worst and 5 is the best. You can use the predictions
+from GroupLens in one of three ways controlled by the variable
+@code{gnus-grouplens-override-scoring}.
+
@vindex gnus-grouplens-override-scoring
-There are two ways to display predictions in grouplens. One is to have
-the grouplens scores contribute to, or override the regular gnus scoring
-mechanism. This behavior is the default; however, some people prefer to
-see the Gnus scores plus the grouplens scores. To get the separate
-scoring behavior you need to set @code{gnus-grouplens-override-scoring}
-to @code{nil}.
+There are three ways to display predictions in grouplens. You may
+choose to have the GroupLens scores contribute to, or override the
+regular gnus scoring mechanism. override is the default; however, some
+people prefer to see the Gnus scores plus the grouplens scores. To get
+the separate scoring behavior you need to set
+@code{gnus-grouplens-override-scoring} to @code{'separate}. To have the
+GroupLens predictions combined with the grouplens scores set it to
+@code{'override} and to combine the scores set
+@code{gnus-grouplens-override-scoring} to @code{'combine}. When you use
+the combine option you will also want to set the values for
+@code{grouplens-prediction-offset} and
+@code{grouplens-score-scale-factor}.
@vindex grouplens-prediction-display
In either case, GroupLens gives you a few choices for how you would like
Please sign in to comment.
Something went wrong with that request. Please try again.