Mercurial > emacs
changeset 111269:3d7a1caabf14
Merge changes made in Gnus trunk.
nnimap.el (nnimap-open-connection): Only send AUTHENTICATE PLAIN if LOGINDISABLED is set.
gnus.el (gnus-group-startup-message): Move point to the start of the buffer.
nndoc.el (nndoc-dissect-buffer): Reverse the order of the articles to reflect the order they're in in the digest.
gnus-sum.el (gnus-summary-select-article): Make `C-d' work reliably by checking whether the original article buffer is alive.
shr.el (shr-find-fill-point): Don't break lines between punctuation and non-punctuation (like after the apostrophe in "'We").
gnus-cite.el (gnus-article-fill-cited-article): Remove unused `force' parameter.
gnus-art.el (gnus-treatment-function-alist): Have gnus-treat-fill-long-lines point to gnus-article-fill-cited-long-lines.
gnus-art.el (gnus-treat-fill-long-lines): Change default to fill all text/plain sections.
gnus.el: Autoload gnus-article-fill-cited-long-lines.
gnus-art.el (gnus-mime-display-alternative): Actually pass the type on to `gnus-treat-article'.
gnus-sum.el (gnus-summary-show-article): Add `C-u C-u g' for showing the raw article, and change `C-u g' to show the article without doing treatments.
gnus.texi (Paging the Article): Document C-u g/C-u C-u g.
gnus-cite.el (gnus-article-foldable-buffer): Refactor out.
gnus-cite.el (gnus-article-foldable-buffer): Don't fold regions that have a ragged left edge.
gnus-cite.el (gnus-article-foldable-buffer): Skip past the prefix when determining raggedness.
gnus-srvr.el, nnir.el: Allow nnir searching for an entire server.
gnus-msg.el (gnus-configure-posting-styles): Permit the use of regular expression match and replace in posting styles.
gnus-art.el (gnus-treat-article): Only inhibit body washing, and leave the header washing to take place.
nnimap.el (nnimap-request-accept-article): Erase buffer before appending for easier debugging.
nnimap.el (nnimap-wait-for-connection): Take a regexp.
nnimap.el (nnimap-request-accept-article): Wait for the continuation line before sending anything unless we're streaming.
| author | Katsumi Yamaoka <yamaoka@jpl.org> |
|---|---|
| date | Sun, 31 Oct 2010 22:31:24 +0000 |
| parents | a8ba29b9ad19 |
| children | 83641cd010c7 |
| files | doc/misc/ChangeLog doc/misc/gnus.texi lisp/gnus/ChangeLog lisp/gnus/gnus-art.el lisp/gnus/gnus-cite.el lisp/gnus/gnus-msg.el lisp/gnus/gnus-srvr.el lisp/gnus/gnus-sum.el lisp/gnus/gnus-util.el lisp/gnus/gnus.el lisp/gnus/nndoc.el lisp/gnus/nnimap.el lisp/gnus/nnir.el lisp/gnus/shr.el |
| diffstat | 14 files changed, 269 insertions(+), 52 deletions(-) [+] |
line wrap: on
line diff
--- a/doc/misc/ChangeLog Sun Oct 31 15:25:39 2010 -0400 +++ b/doc/misc/ChangeLog Sun Oct 31 22:31:24 2010 +0000 @@ -1,3 +1,7 @@ +2010-10-31 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus.texi (Paging the Article): Document C-u g/C-u C-u g. + 2010-10-31 Glenn Morris <rgm@gnu.org> * mh-e.texi (Preface, From Bill Wohler): Change 23 to past tense.
--- a/doc/misc/gnus.texi Sun Oct 31 15:25:39 2010 -0400 +++ b/doc/misc/gnus.texi Sun Oct 31 22:31:24 2010 +0000 @@ -6153,8 +6153,9 @@ @vindex gnus-summary-show-article-charset-alist (Re)fetch the current article (@code{gnus-summary-show-article}). If given a prefix, fetch the current article, but don't run any of the -article treatment functions. This will give you a ``raw'' article, just -the way it came from the server. +article treatment functions. If given a prefix twice (i.e., @kbd{C-u +C-u g'}), show a completely ``raw'' article, just the way it came from +the server. @cindex charset, view article with different charset If given a numerical prefix, you can do semi-manual charset stuff. @@ -13428,14 +13429,20 @@ name will be removed. If the attribute name is @code{eval}, the form is evaluated, and the result is thrown away. -The attribute value can be a string (used verbatim), a function with -zero arguments (the return value will be used), a variable (its value -will be used) or a list (it will be @code{eval}ed and the return value -will be used). The functions and sexps are called/@code{eval}ed in the -message buffer that is being set up. The headers of the current article -are available through the @code{message-reply-headers} variable, which -is a vector of the following headers: number subject from date id -references chars lines xref extra. +The attribute value can be a string, a function with zero arguments +(the return value will be used), a variable (its value will be used) +or a list (it will be @code{eval}ed and the return value will be +used). The functions and sexps are called/@code{eval}ed in the +message buffer that is being set up. The headers of the current +article are available through the @code{message-reply-headers} +variable, which is a vector of the following headers: number subject +from date id references chars lines xref extra. + +In the case of a string value, if the @code{match} is a regular +expression, a @samp{gnus-match-substitute-replacement} is proceed on +the value to replace the positional parameters @samp{\@var{n}} by the +corresponding parenthetical matches (see @xref{Replacing the Text that +Matched, , Text Replacement, elisp, The Emacs Lisp Reference Manual}.) @vindex message-reply-headers
--- a/lisp/gnus/ChangeLog Sun Oct 31 15:25:39 2010 -0400 +++ b/lisp/gnus/ChangeLog Sun Oct 31 22:31:24 2010 +0000 @@ -1,3 +1,74 @@ +2010-10-31 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * nnimap.el (nnimap-request-accept-article): Erase buffer before + appending for easier debugging. + (nnimap-wait-for-connection): Take a regexp. + (nnimap-request-accept-article): Wait for the continuation line before + sending anything unless we're streaming. + + * gnus-art.el (gnus-treat-article): Only inhibit body washing, and + leave the header washing to take place. + +2010-10-31 Daniel Dehennin <daniel.dehennin@baby-gnu.org> + + * gnus-msg.el (gnus-configure-posting-styles): Permit the use of + regular expression match and replace in posting styles. + +2010-10-31 Andrew Cohen <cohen@andy.bu.edu> + + * nnir.el (gnus-group-make-nnir-group,nnir-run-query): Allow searching + an entire server. + (nnir-get-active): New function. + (nnir-run-imap): Use it. + (nnir-run-gmane): Who knew, gmane search returns an article score! + + * gnus-srvr.el (gnus-server-mode-map): add binding "G" to search the + server on the current line with nnir. + +2010-10-31 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus-cite.el (gnus-article-foldable-buffer): Refactor out. + (gnus-article-foldable-buffer): Don't fold regions that have a ragged + left edge. + (gnus-article-foldable-buffer): Skip past the prefix when determining + raggedness. + + * gnus-sum.el (gnus-summary-show-article): Add `C-u C-u g' for showing + the raw article, and change `C-u g' to show the article without doing + treatments. + + * gnus-art.el (gnus-mime-display-alternative): Actually pass the type + on to `gnus-treat-article'. + (gnus-inhibit-article-treatments): New variable. + + * gnus.el: Autoload gnus-article-fill-cited-long-lines. + + * gnus-art.el (gnus-treatment-function-alist): Have + gnus-treat-fill-long-lines point to gnus-article-fill-cited-long-lines. + (gnus-treat-fill-long-lines): Change default to fill all text/plain + sections. + + * gnus-cite.el (gnus-article-fill-cited-article): Remove unused `force' + parameter. + (gnus-article-fill-cited-long-lines): New function. + (gnus-article-fill-cited-article): Allow filling only long sections. + + * shr.el (shr-find-fill-point): Don't break lines between punctuation + and non-punctuation (like after the apostrophe in "'We"). + + * gnus-sum.el (gnus-summary-select-article): Make sure + gnus-original-article-buffer is alive. + + * nndoc.el (nndoc-dissect-buffer): Reverse the order of the articles to + reflect the order they're in in the digest. + + * gnus.el (gnus-group-startup-message): Move point to the start of the + buffer. + + * nnimap.el (nnimap-capability): New function. + (nnimap-open-connection): Only send AUTHENTICATE PLAIN if LOGINDISABLED + is set. + 2010-10-31 David Engster <dengste@eml.cc> * nnmairix.el (nnmairix-get-valid-servers): Return list of strings to
--- a/lisp/gnus/gnus-art.el Sun Oct 31 15:25:39 2010 -0400 +++ b/lisp/gnus/gnus-art.el Sun Oct 31 22:31:24 2010 +0000 @@ -1590,7 +1590,7 @@ :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-custom) -(defcustom gnus-treat-fill-long-lines nil +(defcustom gnus-treat-fill-long-lines '(typep "text/plain") "Fill long lines. Valid values are nil, t, `head', `first', `last', an integer or a predicate. See Info node `(gnus)Customizing Articles'." @@ -1664,7 +1664,7 @@ (gnus-treat-highlight-signature gnus-article-highlight-signature) (gnus-treat-buttonize gnus-article-add-buttons) (gnus-treat-fill-article gnus-article-fill-cited-article) - (gnus-treat-fill-long-lines gnus-article-fill-long-lines) + (gnus-treat-fill-long-lines gnus-article-fill-cited-long-lines) (gnus-treat-strip-cr gnus-article-remove-cr) (gnus-treat-unsplit-urls gnus-article-unsplit-urls) (gnus-treat-date-ut gnus-article-date-ut) @@ -5704,7 +5704,7 @@ (save-restriction (article-goto-body) (narrow-to-region (point) (point-max)) - (gnus-treat-article nil 1 1) + (gnus-treat-article nil 1 1 "text/plain") (widen))) (unless ihandles ;; Highlight the headers. @@ -5992,7 +5992,7 @@ (gnus-treat-article nil (length gnus-article-mime-handle-alist) (gnus-article-mime-total-parts) - (mm-handle-media-type handle)))))) + (mm-handle-media-type preferred)))))) (goto-char (point-max)) (setcdr begend (point-marker))))) (when ibegend @@ -8255,6 +8255,8 @@ ;;; Treatment top-level handling. ;;; +(defvar gnus-inhibit-article-treatments nil) + (defun gnus-treat-article (condition &optional part-number total-parts type) (let ((length (- (point-max) (point-min))) (alist gnus-treatment-function-alist) @@ -8277,6 +8279,8 @@ (symbol-value (car elem)))) (when (and (or (consp val) treated-type) + (or (not gnus-inhibit-article-treatments) + (eq condition 'head)) (gnus-treat-predicate val) (or (not (get (car elem) 'highlight)) highlightp))
--- a/lisp/gnus/gnus-cite.el Sun Oct 31 15:25:39 2010 -0400 +++ b/lisp/gnus/gnus-cite.el Sun Oct 31 22:31:24 2010 +0000 @@ -516,10 +516,15 @@ (setq m (cdr m)))) marks)))) -(defun gnus-article-fill-cited-article (&optional force width) +(defun gnus-article-fill-cited-long-lines () + (gnus-article-fill-cited-article nil t)) + +(defun gnus-article-fill-cited-article (&optional width long-lines) "Do word wrapping in the current article. -If WIDTH (the numerical prefix), use that text width when filling." - (interactive (list t current-prefix-arg)) +If WIDTH (the numerical prefix), use that text width when +filling. If LONG-LINES, only fill sections that have lines +longer than the frame width." + (interactive "P") (with-current-buffer gnus-article-buffer (let ((buffer-read-only nil) (inhibit-point-motion-hooks t) @@ -535,8 +540,12 @@ (fill-prefix (if (string= (cdar marks) "") "" (concat (cdar marks) " "))) + (do-fill (not long-lines)) use-hard-newlines) - (fill-region (point-min) (point-max))) + (unless do-fill + (setq do-fill (gnus-article-foldable-buffer (cdar marks)))) + (when do-fill + (fill-region (point-min) (point-max)))) (set-marker (caar marks) nil) (setq marks (cdr marks))) (when marks @@ -548,6 +557,28 @@ gnus-cite-loose-attribution-alist nil gnus-cite-article nil))))) +(defun gnus-article-foldable-buffer (prefix) + (let ((do-fill nil) + columns) + (goto-char (point-min)) + (while (not (eobp)) + (forward-char (length prefix)) + (skip-chars-forward " \t") + (unless (eolp) + (let ((elem (assq (current-column) columns))) + (unless elem + (setq elem (cons (current-column) 0)) + (push elem columns)) + (setcdr elem (1+ (cdr elem))))) + (end-of-line) + (when (> (current-column) (frame-width)) + (setq do-fill t)) + (forward-line 1)) + (and do-fill + ;; We know know that there are long lines here, but does this look + ;; like code? Check for ragged edges on the left. + (< (length columns) 3)))) + (defun gnus-article-natural-long-line-p () "Return true if the current line is long, and it's natural text." (save-excursion
--- a/lisp/gnus/gnus-msg.el Sun Oct 31 15:25:39 2010 -0400 +++ b/lisp/gnus/gnus-msg.el Sun Oct 31 22:31:24 2010 +0000 @@ -1891,7 +1891,11 @@ (setq v (cond ((stringp value) - value) + (if (and (stringp match) + (string-match-p "\\\\[&[:digit:]]" value) + (match-beginning 1)) + (gnus-match-substitute-replacement value nil nil group) + value)) ((or (symbolp value) (functionp value)) (cond ((functionp value)
--- a/lisp/gnus/gnus-srvr.el Sun Oct 31 15:25:39 2010 -0400 +++ b/lisp/gnus/gnus-srvr.el Sun Oct 31 22:31:24 2010 +0000 @@ -34,6 +34,8 @@ (require 'gnus-int) (require 'gnus-range) +(autoload 'gnus-group-make-nnir-group "nnir") + (defcustom gnus-server-mode-hook nil "Hook run in `gnus-server-mode' buffers." :group 'gnus-server @@ -165,6 +167,8 @@ "g" gnus-server-regenerate-server + "G" gnus-group-make-nnir-group + "z" gnus-server-compact-server "\C-c\C-i" gnus-info-find-node
--- a/lisp/gnus/gnus-sum.el Sun Oct 31 15:25:39 2010 -0400 +++ b/lisp/gnus/gnus-sum.el Sun Oct 31 22:31:24 2010 +0000 @@ -7596,6 +7596,7 @@ (not (get-buffer gnus-original-article-buffer)))) (and (not gnus-single-article-buffer) (or (null gnus-current-article) + (not (get-buffer gnus-original-article-buffer)) (not (eq gnus-current-article article)))) force) ;; The requested article is different from the current article. @@ -9392,9 +9393,10 @@ If ARG (the prefix) is a number, show the article with the charset defined in `gnus-summary-show-article-charset-alist', or the charset input. -If ARG (the prefix) is non-nil and not a number, show the raw article -without any article massaging functions being run. Normally, the key -strokes are `C-u g'." +If ARG (the prefix) is non-nil and not a number, show the article, +but without running any of the article treatment functions +article. Normally, the keystroke is `C-u g'. When using `C-u +C-u g', show the raw article." (interactive "P") (cond ((numberp arg) @@ -9436,7 +9438,8 @@ ((not arg) ;; Select the article the normal way. (gnus-summary-select-article nil 'force)) - (t + ((equal arg '(16)) + ;; C-u C-u g ;; We have to require this here to make sure that the following ;; dynamic binding isn't shadowed by autoloading. (require 'gnus-async) @@ -9454,6 +9457,9 @@ ;; Set it to nil for safety reason. (setq gnus-article-mime-handle-alist nil) (setq gnus-article-mime-handles nil))) + (gnus-summary-select-article nil 'force))) + (t + (let ((gnus-inhibit-article-treatments t)) (gnus-summary-select-article nil 'force)))) (gnus-summary-goto-subject gnus-current-article) (gnus-summary-position-point))
--- a/lisp/gnus/gnus-util.el Sun Oct 31 15:25:39 2010 -0400 +++ b/lisp/gnus/gnus-util.el Sun Oct 31 22:31:24 2010 +0000 @@ -1982,6 +1982,28 @@ (memq elem list)))) found)) +(eval-and-compile + (cond + ((fboundp 'match-substitute-replacement) + (defalias 'gnus-match-substitute-replacement 'match-substitute-replacement)) + (t + (defun gnus-match-substitute-replacement (replacement &optional fixedcase literal string subexp) + "Return REPLACEMENT as it will be inserted by `replace-match'. +In other words, all back-references in the form `\\&' and `\\N' +are substituted with actual strings matched by the last search. +Optional FIXEDCASE, LITERAL, STRING and SUBEXP have the same +meaning as for `replace-match'. + +This is the definition of match-substitute-replacement in subr.el from GNU Emacs." + (let ((match (match-string 0 string))) + (save-match-data + (set-match-data (mapcar (lambda (x) + (if (numberp x) + (- x (match-beginning 0)) + x)) + (match-data t))) + (replace-match replacement fixedcase literal match subexp))))))) + (provide 'gnus-util) ;;; gnus-util.el ends here
--- a/lisp/gnus/gnus.el Sun Oct 31 15:25:39 2010 -0400 +++ b/lisp/gnus/gnus.el Sun Oct 31 22:31:24 2010 +0000 @@ -1032,10 +1032,11 @@ (unless (and (fboundp 'find-image) (display-graphic-p) - ;; Make sure the library defining `image-load-path' is loaded - ;; (`find-image' is autoloaded) (and discard the result). Else, we may - ;; get "defvar ignored because image-load-path is let-bound" when calling - ;; `find-image' below. + ;; Make sure the library defining `image-load-path' is + ;; loaded (`find-image' is autoloaded) (and discard the + ;; result). Else, we may get "defvar ignored because + ;; image-load-path is let-bound" when calling `find-image' + ;; below. (or (find-image '(nil (:type xpm :file "gnus.xpm"))) t) (let* ((data-directory (nnheader-find-etc-directory "images/gnus")) (image-load-path (cond (data-directory @@ -1065,9 +1066,10 @@ (insert-char ?\ (max 0 (round (- (window-width) (or x (car size))) 2))) (insert-image image)) + (goto-char (point-min)) t))) (insert - (format " + (format " _ ___ _ _ _ ___ __ ___ __ _ ___ __ _ ___ __ ___ @@ -2772,7 +2774,8 @@ ("gnus-cite" :interactive t gnus-article-highlight-citation gnus-article-hide-citation-maybe gnus-article-hide-citation gnus-article-fill-cited-article - gnus-article-hide-citation-in-followups) + gnus-article-hide-citation-in-followups + gnus-article-fill-cited-long-lines) ("gnus-kill" gnus-kill gnus-apply-kill-file-internal gnus-kill-file-edit-file gnus-kill-file-raise-followups-to-author gnus-execute gnus-expunge gnus-batch-kill gnus-batch-score)
--- a/lisp/gnus/nndoc.el Sun Oct 31 15:25:39 2010 -0400 +++ b/lisp/gnus/nndoc.el Sun Oct 31 22:31:24 2010 +0000 @@ -918,7 +918,8 @@ (setq body-end (point)) (push (list (incf i) head-begin head-end body-begin body-end (count-lines body-begin body-end)) - nndoc-dissection-alist))))))) + nndoc-dissection-alist))))) + (setq nndoc-dissection-alist (nreverse nndoc-dissection-alist)))) (defun nndoc-article-begin () (if nndoc-article-begin-function
--- a/lisp/gnus/nnimap.el Sun Oct 31 15:25:39 2010 -0400 +++ b/lisp/gnus/nnimap.el Sun Oct 31 22:31:24 2010 +0000 @@ -382,14 +382,13 @@ ;; connection and start a STARTTLS connection instead. (cond ((and (or (and (eq nnimap-stream 'network) - (member "STARTTLS" - (nnimap-capabilities nnimap-object))) + (nnimap-capability "STARTTLS")) (eq nnimap-stream 'starttls)) (fboundp 'open-gnutls-stream)) (nnimap-command "STARTTLS") (gnutls-negotiate (nnimap-process nnimap-object) nil)) ((and (eq nnimap-stream 'network) - (member "STARTTLS" (nnimap-capabilities nnimap-object))) + (nnimap-capability "STARTTLS")) (let ((nnimap-stream 'starttls)) (let ((tls-process (nnimap-open-connection buffer))) @@ -416,8 +415,8 @@ (nnimap-credentials nnimap-address ports))))) (setq nnimap-object nil) (setq login-result - (if (member "AUTH=PLAIN" - (nnimap-capabilities nnimap-object)) + (if (and (nnimap-capability "AUTH=PLAIN") + (nnimap-capability "LOGINDISABLED")) (nnimap-command "AUTHENTICATE PLAIN %s" (base64-encode-string @@ -439,7 +438,7 @@ (delete-process (nnimap-process nnimap-object)) (setq nnimap-object nil)))) (when nnimap-object - (when (member "QRESYNC" (nnimap-capabilities nnimap-object)) + (when (nnimap-capability "QRESYNC") (nnimap-command "ENABLE QRESYNC")) (nnimap-process nnimap-object)))))))) @@ -555,8 +554,11 @@ (delete-region (point) (point-max))) t))) +(defun nnimap-capability (capability) + (member capability (nnimap-capabilities nnimap-object))) + (defun nnimap-ver4-p () - (member "IMAP4REV1" (nnimap-capabilities nnimap-object))) + (nnimap-capability "IMAP4REV1")) (defun nnimap-get-partial-article (article parts structure) (let ((result @@ -872,7 +874,7 @@ (nnimap-command "UID STORE %s +FLAGS.SILENT (\\Deleted)" (nnimap-article-ranges articles)) (cond - ((member "UIDPLUS" (nnimap-capabilities nnimap-object)) + ((nnimap-capability "UIDPLUS") (nnimap-command "UID EXPUNGE %s" (nnimap-article-ranges articles)) t) @@ -928,9 +930,12 @@ (nnimap-add-cr) (setq message (buffer-substring-no-properties (point-min) (point-max))) (with-current-buffer (nnimap-buffer) + (erase-buffer) (setq sequence (nnimap-send-command "APPEND %S {%d}" (utf7-encode group t) (length message))) + (unless nnimap-streaming + (nnimap-wait-for-connection "^[+]")) (process-send-string (get-buffer-process (current-buffer)) message) (process-send-string (get-buffer-process (current-buffer)) (if (nnimap-newlinep nnimap-object) @@ -1031,7 +1036,7 @@ (with-current-buffer (nnimap-buffer) (erase-buffer) (setf (nnimap-group nnimap-object) nil) - (let ((qresyncp (member "QRESYNC" (nnimap-capabilities nnimap-object))) + (let ((qresyncp (nnimap-capability "QRESYNC")) params groups sequences active uidvalidity modseq group) ;; Go through the infos and gather the data needed to know ;; what and how to request the data. @@ -1477,12 +1482,14 @@ (nnimap-wait-for-response sequence) (nnimap-parse-response)) -(defun nnimap-wait-for-connection () +(defun nnimap-wait-for-connection (&optional regexp) + (unless regexp + (setq regexp "^[*.] .*\n")) (let ((process (get-buffer-process (current-buffer)))) (goto-char (point-min)) (while (and (memq (process-status process) '(open run)) - (not (re-search-forward "^[*.] .*\n" nil t))) + (not (re-search-forward regexp nil t))) (nnheader-accept-process-output process) (goto-char (point-min))) (forward-line -1) @@ -1669,7 +1676,7 @@ (cond ;; If the server supports it, we now delete the message we have ;; just copied over. - ((member "UIDPLUS" (nnimap-capabilities nnimap-object)) + ((nnimap-capability "UIDPLUS") (setq sequence (nnimap-send-command "UID EXPUNGE %s" range))) ;; If it doesn't support UID EXPUNGE, then we only expunge if the ;; user has configured it.
--- a/lisp/gnus/nnir.el Sun Oct 31 15:25:39 2010 -0400 +++ b/lisp/gnus/nnir.el Sun Oct 31 22:31:24 2010 +0000 @@ -491,10 +491,12 @@ nnir-current-group-marked nil nnir-artlist nil) (let* ((query (read-string "Query: " nil 'nnir-search-history)) - (parms (list (cons 'query query)))) + (parms (list (cons 'query query))) + (srv (if (gnus-server-server-name) + "all" ""))) (add-to-list 'parms (cons 'unique-id (message-unique-id)) t) (gnus-group-read-ephemeral-group - (concat "nnir:" (prin1-to-string parms)) '(nnir "") t + (concat "nnir:" (prin1-to-string parms)) (list 'nnir srv) t (cons (current-buffer) gnus-current-window-configuration) nil))) @@ -566,7 +568,7 @@ (equal server nnir-current-server))) nnir-artlist ;; Cache miss. - (setq nnir-artlist (nnir-run-query group))) + (setq nnir-artlist (nnir-run-query group server))) (with-current-buffer nntp-server-buffer (setq nnir-current-query group) (when server (setq nnir-current-server server)) @@ -765,6 +767,7 @@ (cdr (assoc nnir-imap-default-search-key nnir-imap-search-arguments)))) (gnus-inhibit-demon t) + (groups (or groups (nnir-get-active srv))) artlist) (message "Opening server %s" server) (apply @@ -1414,15 +1417,22 @@ (while (not (eobp)) (unless (or (eolp) (looking-at "\x0d")) (let ((header (nnheader-parse-nov))) - (let ((xref (mail-header-xref header))) + (let ((xref (mail-header-xref header)) + (xscore (string-to-number (cdr (assoc 'X-Score + (mail-header-extra header)))))) (when (string-match " \\([^:]+\\)[:/]\\([0-9]+\\)" xref) (push (vector (gnus-group-prefixed-name (match-string 1 xref) srv) - (string-to-number (match-string 2 xref)) 1) + (string-to-number (match-string 2 xref)) xscore) artlist))))) (forward-line 1))) - (reverse artlist)) + ;; Sort by score + (apply 'vector + (sort artlist + (function (lambda (x y) + (> (nnir-artitem-rsv x) + (nnir-artitem-rsv y))))))) (message "Can't search non-gmane nntp groups"))) ;;; Util Code: @@ -1445,13 +1455,16 @@ (cons sym (format (cdr mapping) result))) (cons sym (read-string prompt))))) -(defun nnir-run-query (query) +(defun nnir-run-query (query nserver) "Invoke appropriate search engine function (see `nnir-engines'). If some groups were process-marked, run the query for each of the groups and concat the results." (let ((q (car (read-from-string query))) - (groups (nnir-sort-groups-by-server - (or gnus-group-marked (list (gnus-group-group-name)))))) + (groups (if (string= "all-ephemeral" nserver) + (with-current-buffer gnus-server-buffer + (list (list (gnus-server-server-name)))) + (nnir-sort-groups-by-server + (or gnus-group-marked (list (gnus-group-group-name))))))) (apply 'vconcat (mapcar (lambda (x) (let* ((server (car x)) @@ -1551,6 +1564,44 @@ value) nil)) +(defun nnir-get-active (srv) + (let ((method (gnus-server-to-method srv)) + groups) + (gnus-request-list method) + (with-current-buffer nntp-server-buffer + (let ((cur (current-buffer)) + name) + (goto-char (point-min)) + (unless (string= gnus-ignored-newsgroups "") + (delete-matching-lines gnus-ignored-newsgroups)) + ;; We treat NNTP as a special case to avoid problems with + ;; garbage group names like `"foo' that appear in some badly + ;; managed active files. -jh. + (if (eq (car method) 'nntp) + (while (not (eobp)) + (ignore-errors + (push (cons + (mm-string-as-unibyte + (buffer-substring + (point) + (progn + (skip-chars-forward "^ \t") + (point)))) + (let ((last (read cur))) + (cons (read cur) last))) + groups)) + (forward-line)) + (while (not (eobp)) + (ignore-errors + (push (mm-string-as-unibyte + (let ((p (point))) + (skip-chars-forward "^ \t\\\\") + (setq name (buffer-substring (+ p 1) (- (point) 1))) + (gnus-group-full-name name method))) + groups)) + (forward-line))))) + groups)) + ;; The end. (provide 'nnir)
--- a/lisp/gnus/shr.el Sun Oct 31 15:25:39 2010 -0400 +++ b/lisp/gnus/shr.el Sun Oct 31 22:31:24 2010 +0000 @@ -286,7 +286,9 @@ (aref (char-category-set (following-char)) ?>))) (backward-char 1)) (while (and (>= (setq count (1- count)) 0) - (aref (char-category-set (following-char)) ?>)) + (aref (char-category-set (following-char)) ?>) + (aref fill-find-break-point-function-table + (following-char))) (forward-char 1))) (when (eq (following-char) ? ) (forward-char 1))