From: Gnus developers Date: Sun, 31 Oct 2010 22:31:24 +0000 (+0000) Subject: Merge changes made in Gnus trunk. X-Git-Tag: emacs-pretest-24.0.90~104^2~275^2~438^2~45^2~422^2~36 X-Git-Url: https://code.delx.au/gnu-emacs/commitdiff_plain/389b76fa1b4e96b7da8896cea16d57403d76a947 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. --- diff --git a/doc/misc/ChangeLog b/doc/misc/ChangeLog index d5c5df9208..5e99132389 100644 --- a/doc/misc/ChangeLog +++ b/doc/misc/ChangeLog @@ -1,3 +1,7 @@ +2010-10-31 Lars Magne Ingebrigtsen + + * gnus.texi (Paging the Article): Document C-u g/C-u C-u g. + 2010-10-31 Glenn Morris * mh-e.texi (Preface, From Bill Wohler): Change 23 to past tense. diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index dd3e07ef3c..c3dd2b31a5 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -6153,8 +6153,9 @@ Scroll the current article one line backward @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 @@ the headers of the article; if the value is @code{nil}, the header 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 diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 5dd4ac9215..0a1ca2bd10 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,74 @@ +2010-10-31 Lars Magne Ingebrigtsen + + * 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 + + * gnus-msg.el (gnus-configure-posting-styles): Permit the use of + regular expression match and replace in posting styles. + +2010-10-31 Andrew Cohen + + * 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 + + * 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 * nnmairix.el (nnmairix-get-valid-servers): Return list of strings to diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 6d77793758..713773ea88 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -1590,7 +1590,7 @@ predicate. See Info node `(gnus)Customizing Articles'." :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 @@ regexp." (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 @@ all parts." (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 @@ If displaying \"text/html\" is discouraged \(see (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 @@ For example: ;;; 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 @@ For example: (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)) diff --git a/lisp/gnus/gnus-cite.el b/lisp/gnus/gnus-cite.el index 7419cedac5..a010a833e9 100644 --- a/lisp/gnus/gnus-cite.el +++ b/lisp/gnus/gnus-cite.el @@ -516,10 +516,15 @@ Lines matching `gnus-cite-attribution-suffix' and perhaps (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 @@ If WIDTH (the numerical prefix), use that text width when filling." (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 @@ If WIDTH (the numerical prefix), use that text width when filling." 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 diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el index a7d67113b3..46cbc75f2a 100644 --- a/lisp/gnus/gnus-msg.el +++ b/lisp/gnus/gnus-msg.el @@ -1891,7 +1891,11 @@ this is a reply." (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) diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el index b532b74045..ae773657d2 100644 --- a/lisp/gnus/gnus-srvr.el +++ b/lisp/gnus/gnus-srvr.el @@ -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 @@ If nil, a faster, but more primitive, buffer is used instead." "g" gnus-server-regenerate-server + "G" gnus-group-make-nnir-group + "z" gnus-server-compact-server "\C-c\C-i" gnus-info-find-node diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 53645bfdb5..7de7a0a4a2 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -7596,6 +7596,7 @@ be displayed." (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 @@ article currently." 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 @@ strokes are `C-u g'." ((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 @@ strokes are `C-u g'." ;; 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)) diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el index 5bcda97ab1..0bffb36f2b 100644 --- a/lisp/gnus/gnus-util.el +++ b/lisp/gnus/gnus-util.el @@ -1982,6 +1982,28 @@ Sizes are in pixels." (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 diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index d214901646..6f4ef631ae 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -1032,10 +1032,11 @@ be set in `.emacs' instead." (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 @@ be set in `.emacs' instead." (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-registry.el will populate this if it's loaded.") ("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) diff --git a/lisp/gnus/nndoc.el b/lisp/gnus/nndoc.el index 9f147e32b4..0dee06d293 100644 --- a/lisp/gnus/nndoc.el +++ b/lisp/gnus/nndoc.el @@ -918,7 +918,8 @@ from the document.") (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 diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index 98839e2070..3940e64353 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el @@ -382,14 +382,13 @@ textual parts.") ;; 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 @@ textual parts.") (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 @@ textual parts.") (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 @@ textual parts.") (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 @@ textual parts.") (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 @@ textual parts.") (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 @@ textual parts.") (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 @@ textual parts.") (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 @@ textual parts.") (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. diff --git a/lisp/gnus/nnir.el b/lisp/gnus/nnir.el index 9e3dd9c523..3e00158aad 100644 --- a/lisp/gnus/nnir.el +++ b/lisp/gnus/nnir.el @@ -491,10 +491,12 @@ result, `gnus-retrieve-headers' will be called instead.") 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 @@ and show thread that contains this article." (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 @@ details on the language and supported extensions" (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 @@ Tested with Namazu 2.0.6 on a GNU/Linux system." (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 @@ Tested with Namazu 2.0.6 on a GNU/Linux system." (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 @@ artitem (counting from 1)." 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) diff --git a/lisp/gnus/shr.el b/lisp/gnus/shr.el index d72473527d..c39dd05455 100644 --- a/lisp/gnus/shr.el +++ b/lisp/gnus/shr.el @@ -286,7 +286,9 @@ redirects somewhere else." (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))