Re: emacs.gnus

[Hanak David <dhanak@inf.bme.hu>]

[-- Attachment #1: Type: text/plain, Size: 1927 bytes --]

On Mon, 09 Jun 2003, Kai Großjohann wrote:

> We could still offer two alternative functions,
> nnchoke-request-group-articles and nnchoke-get-group-articles-list,
> say.  Then gnus-get-group-articles could call the latter if it
> exists, and the former if not.
>
> Sounds like a plan.  WDYT?

I like it.  So I renamed gnus-get-group-articles to
gnus-get-group-artiles-list, which calls nnchoke-get-group-articles-list if
it exists, otherwise calls nnchoke-request-group-articles and parses the
nntp-server-buffer.  How does it sound?

> A remark on the code: you could try to delete junk from the beginning
> and the end of the buffer, giving you just the list of numbers.  Then
> you add "(" at the beginning and ")" at the end (sans quotes).  Then
> you go to the "(" and invoke `read', and lo! there's your list.

Right!  Done that, too.  So, again, here's the patch.

One remark, though.  The following pattern:

/----
|  (let ((gnus-command-method (gnus-find-method-for-group group))
|	(func 'wild-and-crazy-things))
|    (when (gnus-check-backend-function func group)
|      (funcall (gnus-get-function gnus-command-method func)
|	       (gnus-group-real-name group) (nth 1 gnus-command-method)))))
\----

occurs very often in gnus-int.el, and now (with my contribution) appears in
gnus-sum.el, too.  Wouldn't it be reasonable to create a general purpose
function for this, like:

(defun gnus-group-backend-function (func group)
  "Call backend function FUNC on GROUP."
  (let ((gnus-command-method (gnus-find-method-for-group group)))
    (when (gnus-check-backend-function func group)
      (funcall (gnus-get-function gnus-command-method func)
	       (gnus-group-real-name group) (nth 1 gnus-command-method)))))

And then it would be enough to write:

(defun gnus-request-group-articles (group)
  "Request a list of existing articles in GROUP."
  (gnus-group-backend-function 'request-group-articles group))

David


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: gnus.patch --]
[-- Type: text/x-patch, Size: 3844 bytes --]

*** /usr/share/emacs/site-lisp/gnus/lisp/gnus-sum.el	2003-06-07 19:40:22.000000000 +0200
--- ./gnus-sum.el	2003-06-10 15:07:41.000000000 +0200
***************
*** 1092,1097 ****
--- 1092,1106 ----
    :type 'boolean
    :group 'gnus-article-mime)
  
+ (defcustom gnus-count-articles-in-groups nil
+ "*Regexp to match groups whose article count should be determined
+ accurately upon entering the group.  Non-matching groups are conventionally
+ looked up in the active info.
+ 
+ If t, matches all groups, if nil, matches none."
+   :type '(choice regexp (const t) (const nil))
+   :group 'gnus-summary)
+ 
  ;;; Internal variables
  
  (defvar gnus-summary-display-cache nil)
***************
*** 5226,5231 ****
--- 5235,5273 ----
        (memq article gnus-newsgroup-recent))
       (t t))))
  
+ (defun gnus-get-group-articles-list (group)
+   "Return a list of group articles if `gnus-count-articles-in-groups'
+ matches GROUP as a regexp.  Otherwise return nil."
+   (let ((group-real-name (gnus-group-real-name group)))
+     (when (and gnus-count-articles-in-groups
+ 	       (or (eq gnus-count-articles-in-groups t)
+ 		   (string-match gnus-count-articles-in-groups group)))
+       (let ((gnus-command-method (gnus-find-method-for-group group))
+ 	    (func1 'get-group-articles-list)
+ 	    (func2 'request-group-articles))
+ 	(or (and (gnus-check-backend-function func1 group)
+ 		 (funcall (gnus-get-function gnus-command-method func1)
+ 			  group-real-name (nth 1 gnus-command-method)))
+ 	    (and (gnus-check-backend-function func2 group)
+ 		 (funcall (gnus-get-function gnus-command-method func2)
+ 			  group-real-name (nth 1 gnus-command-method))
+ 		 (gnus-parse-group-articles-list)))))))
+ 
+ (defun gnus-parse-group-articles-list ()
+   "Parse article list from `nntp-server-buffer'."
+   (condition-case ()
+       (save-excursion
+ 	(set-buffer nntp-server-buffer)
+ 	(goto-char (point-min))		; first line contains comment
+ 	(delete-region (point) (line-end-position))
+ 	(insert "(")
+ 	(goto-char (point-max))
+ 	(forward-line -1)		; last line contains "."
+ 	(delete-region (point) (line-end-position))
+ 	(insert ")")
+ 	(read (point-min-marker)))
+     (error nil)))
+ 
  (defun gnus-articles-to-read (group &optional read-all)
    "Find out what articles the user wants to read."
    (let* ((display (gnus-group-find-parameter group 'display))
***************
*** 5242,5247 ****
--- 5284,5290 ----
  	      ;; articles in the group, or (if that's nil), the
  	      ;; articles in the cache.
  	      (or
+ 	       (gnus-get-group-articles-list group)
  	       (gnus-uncompress-range (gnus-active group))
  	       (gnus-cache-articles-in-group group))
  	    ;; Select only the "normal" subset of articles.
*** /usr/share/emacs/site-lisp/gnus/lisp/nnml.el	2003-05-01 16:23:15.000000000 +0200
--- ./nnml.el	2003-06-10 15:11:41.000000000 +0200
***************
*** 1007,1012 ****
--- 1007,1033 ----
  	(nnml-save-marks group server)
  	(nnheader-message 7 "Bootstrapping marks for %s...done" group)))))
  
+ (deffoo nnml-get-group-articles-list (group &optional server)
+   "Return the list of existing articles in GROUP directly.  See also
+ `nnml-request-group-articles'."
+   (sort (nnheader-directory-articles
+ 	 (nnheader-group-pathname group nnml-directory))
+ 	'<))
+ 
+ (deffoo nnml-request-group-articles (group &optional server)
+   "Return the list of existing articles in GROUP in `nntp-server-buffer'."
+   (let ((article-list (nnml-get-group-articles-list group server)))
+     (condition-case ()
+ 	(save-excursion
+ 	  (set-buffer nntp-server-buffer)
+ 	  (erase-buffer)
+ 	  (insert "211 Article list follows\n")
+ 	  (mapcar '(lambda (x) (insert (number-to-string x) "\n"))
+ 		  article-list)
+ 	  (insert ".\n")
+ 	  t)
+       (error nil))))
+ 
  (provide 'nnml)
  
  ;;; nnml.el ends here