mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2025-01-02 11:21:42 +00:00
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.
This commit is contained in:
Gnus developers
Katsumi Yamaoka
parent
430e7297cb
commit
389b76fa1b
@ -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.
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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))
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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))
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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.
|
||||
|
||||
@ -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)
|
||||
|
||||
|
||||
@ -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))
|
||||
|
||||
Loading…
Reference in New Issue
Block a user