mirror of
git://git.sv.gnu.org/emacs.git
synced 2026-04-27 08:43:40 -07:00
Merge changes made in Gnus trunk.
mail-parse.el (mail-header-encode-parameter): Define as rfc2045-encode-string. nnheader.el (nnheader-insert-nov): Protect against junk appearing in the extra mail headers. gnus-html.el: Prefetch and html washing additions. gnus-html.el (gnus-html-prefetch-images): Fix up the url-retrieve calling conventions so that prefetch doesn't bug out. Pass proper format strings to gnus-message. nnimap.el: Allow anonymous login. nnimap.el (nnimap-transform-headers): The chars header is called Chars not Bytes. nnimap.el (nnimap-wait-for-response): Don't infloop if the IMAP connection drops. gnus-start.el (gnus-get-unread-articles): Call `gnus-open-server' on each method before trying to scan them etc. gnus-sum.el (gnus-summary-update-mark): Replace subst-char-in-region by subst-char-in-region. gnus.el (gnus-similar-server-opened): Refactor a bit and add comments. gnus.el: Fix a speed regression based in methods that were similar weren't the same. gnus.el (gnus): When using the development version of Gnus, load the gnus-load file. nnimap.el (nnimap-open-connection): When looking for credentials, also use the nnimap-server-port. nnimap.el (nnimap-request-article): Return the group/article number, so that Gnus `^' works as expected. nnimap.el (nnimap-find-wanted-parts-1): Return the MIME parts as IMAP wants them. gnus-start.el (gnus-ignored-newsgroups): Remove [] from the list of bogus characters. gnus-html.el (gnus-html-image-fetched): Protect against the data not arriving. nnimap.el (nnimap-wait-for-connection): Avoid a race condition while waiting for the connection string. gnus.texi (Required Back End Functions): Document INFO.
This commit is contained in:
Lars Magne Ingebrigtsen
Katsumi Yamaoka
parent
596880ea94
commit
bdaa75c74d
15 changed files with 306 additions and 97 deletions
|
|
@ -29672,7 +29672,7 @@ group and article numbers are when fetching articles by
|
|||
on successful article retrieval.
|
||||
|
||||
|
||||
@item (nnchoke-request-group GROUP &optional SERVER FAST)
|
||||
@item (nnchoke-request-group GROUP &optional SERVER FAST INFO)
|
||||
|
||||
Get data on @var{group}. This function also has the side effect of
|
||||
making @var{group} the current group.
|
||||
|
|
@ -29680,6 +29680,9 @@ making @var{group} the current group.
|
|||
If @var{fast}, don't bother to return useful data, just make @var{group}
|
||||
the current group.
|
||||
|
||||
If @var{info}, it allows the backend to update the group info
|
||||
structure.
|
||||
|
||||
Here's an example of some result data and a definition of the same:
|
||||
|
||||
@example
|
||||
|
|
|
|||
|
|
@ -1,5 +1,90 @@
|
|||
2010-09-19 Lars Magne Ingebrigtsen <larsi@gnus.org>
|
||||
|
||||
* nnimap.el (nnimap-wait-for-connection): Avoid a race condition while
|
||||
waiting for the connection string.
|
||||
|
||||
* gnus-html.el (gnus-html-image-fetched): Protect against the data not
|
||||
arriving.
|
||||
|
||||
* gnus-start.el (gnus-ignored-newsgroups): Remove [] from the list of
|
||||
bogus characters. This allows selecting certain Gmail groups.
|
||||
|
||||
* nnimap.el (nnimap-find-wanted-parts-1): New function.
|
||||
(nnimap-fetch-partial-articles): New variable.
|
||||
(nnimap-open-connection): When looking for credentials, also use the
|
||||
nnimap-server-port.
|
||||
(nnimap-request-article): Return the group/article number, so that Gnus
|
||||
`^' works as expected.
|
||||
(nnimap-find-wanted-parts-1): Return the MIME parts as IMAP wants
|
||||
them.
|
||||
|
||||
* gnus.el (gnus-similar-server-opened): Refactor a bit and add
|
||||
comments.
|
||||
(gnus-methods-sloppily-equal): New function.
|
||||
(gnus): When using the development version of Gnus, load the gnus-load
|
||||
file.
|
||||
|
||||
* gnus-start.el (gnus-get-unread-articles): Make sure that we call
|
||||
`gnus-open-server' on each method before trying to scan them etc. This
|
||||
ensures that all the backend parameters are set correctly.
|
||||
|
||||
* nnimap.el (nnimap-authenticator): New variable.
|
||||
(nnimap-open-connection): Allow anonymous login.
|
||||
(nnimap-transform-headers): The chars header is called Chars not
|
||||
Bytes.
|
||||
(nnimap-wait-for-response): Don't infloop if the IMAP connection
|
||||
drops.
|
||||
|
||||
* gnus-art.el (gnus-article-describe-briefly): Fix up typo in last
|
||||
patch, found by Knut Anders Hatlen.
|
||||
|
||||
2010-09-19 Andreas Schwab <schwab@linux-m68k.org>
|
||||
|
||||
* gnus-agent.el (gnus-agent-batch-confirmation)
|
||||
(gnus-agent-expire-group, gnus-agent-expire): Pass proper format string
|
||||
to gnus-message.
|
||||
* gnus-art.el (gnus-article-describe-briefly): Likewise.
|
||||
* gnus-group.el (gnus-group-list-groups, gnus-group-describe-group)
|
||||
(gnus-group-edit-global-kill, gnus-group-describe-briefly): Likewise.
|
||||
* gnus-int.el (gnus-open-server): Likewise.
|
||||
* gnus-score.el (gnus-score-edit-current-scores, gnus-score-edit-file)
|
||||
(gnus-score-check-syntax): Likewise.
|
||||
* gnus-srvr.el (gnus-browse-describe-briefly): Likewise.
|
||||
* gnus-start.el (gnus-read-active-file-1, gnus-read-active-file-1):
|
||||
Likewise.
|
||||
* gnus-sum.el (gnus-summary-describe-briefly): Likewise.
|
||||
|
||||
2010-09-19 Lars Magne Ingebrigtsen <larsi@gnus.org>
|
||||
|
||||
* gnus-html.el (gnus-html-prefetch-images): Fix up the url-retrieve
|
||||
calling conventions so that prefetch doesn't bug out.
|
||||
|
||||
2010-09-19 Julien Danjou <julien@danjou.info>
|
||||
|
||||
* gnus-sum.el (gnus-summary-update-mark): Use `subst-char-in-string'
|
||||
rather than `subst-char-in-region' in order to be able to replace ASCII
|
||||
char by UTF-8 ones.
|
||||
|
||||
* gnus-html.el (gnus-html-prefetch-images): Use `url-retrieve' rather
|
||||
than curl.
|
||||
(gnus-html-image-fetched): Fix `gnus-html-put-image' call not setting
|
||||
the right URL and ALT text on images.
|
||||
(gnus-html-wash-tags): Fix tag case.
|
||||
Add support for `s' and `ins' tags. Use gnus-emphasis-* faces.
|
||||
(gnus-article-html): Add -o display_ins_del=2 option.
|
||||
(gnus-html-wash-tags): Add better support for <ul> tags symbols.
|
||||
|
||||
2010-09-19 Lars Magne Ingebrigtsen <larsi@gnus.org>
|
||||
|
||||
* nnheader.el (nnheader-insert-nov): Protect against junk appearing in
|
||||
the extra mail headers, which sometimes seem to happen for unknown
|
||||
reasons.
|
||||
|
||||
* mail-parse.el (mail-header-encode-parameter): Define as
|
||||
rfc2045-encode-string instead of as rfc2231-encode-string, since some
|
||||
(or most, perhaps?) mail readers don't understand the latter, but do
|
||||
understand the former.
|
||||
|
||||
* gnus-agent.el (gnus-agent-auto-agentize-methods): Switch the default
|
||||
to nil, so that no methods are automatically agentized. I think this
|
||||
is probably what most users want.
|
||||
|
|
@ -41,7 +126,7 @@
|
|||
the range update right.
|
||||
(nnimap-request-group): Don't make `M-g' bug out on group with no
|
||||
marks.
|
||||
(nnoo): Require, so that other packages can require nnimap.
|
||||
(nnoo): Required, so that other packages can require nnimap.
|
||||
(nnimap-wait-for-response): Be a bit more lax in finding the end of the
|
||||
command we're looking for. This helps when the server sends more
|
||||
responses after we've gotten everything we expected.
|
||||
|
|
|
|||
|
|
@ -2377,7 +2377,7 @@ modified) original contents, they are first saved to their own file."
|
|||
|
||||
(defun gnus-agent-batch-confirmation (msg)
|
||||
"Show error message and return t."
|
||||
(gnus-message 1 msg)
|
||||
(gnus-message 1 "%s" msg)
|
||||
t)
|
||||
|
||||
;;;###autoload
|
||||
|
|
@ -3123,7 +3123,7 @@ FORCE is equivalent to setting the expiration predicates to true."
|
|||
group overview (gnus-gethash-safe group orig)
|
||||
articles force))))
|
||||
(kill-buffer overview))))
|
||||
(gnus-message 4 (gnus-agent-expire-done-message)))))
|
||||
(gnus-message 4 "%s" (gnus-agent-expire-done-message)))))
|
||||
|
||||
(defun gnus-agent-expire-group-1 (group overview active articles force)
|
||||
;; Internal function - requires caller to have set
|
||||
|
|
@ -3548,7 +3548,7 @@ articles in every agentized group? "))
|
|||
expiring-group overview active articles force))))))))
|
||||
(kill-buffer overview))
|
||||
(gnus-agent-expire-unagentized-dirs)
|
||||
(gnus-message 4 (gnus-agent-expire-done-message))))))
|
||||
(gnus-message 4 "%s" (gnus-agent-expire-done-message))))))
|
||||
|
||||
(defun gnus-agent-expire-done-message ()
|
||||
(if (and (> gnus-verbose 4)
|
||||
|
|
|
|||
|
|
@ -6406,7 +6406,7 @@ not have a face in `gnus-article-boring-faces'."
|
|||
(defun gnus-article-describe-briefly ()
|
||||
"Describe article mode commands briefly."
|
||||
(interactive)
|
||||
(gnus-message 6 (substitute-command-keys "\\<gnus-article-mode-map>\\[gnus-article-goto-next-page]:Next page \\[gnus-article-goto-prev-page]:Prev page \\[gnus-article-show-summary]:Show summary \\[gnus-info-find-node]:Run Info \\[gnus-article-describe-briefly]:This help")))
|
||||
(gnus-message 6 "%s" (substitute-command-keys "\\<gnus-article-mode-map>\\[gnus-article-goto-next-page]:Next page \\[gnus-article-goto-prev-page]:Prev page \\[gnus-article-show-summary]:Show summary \\[gnus-info-find-node]:Run Info \\[gnus-article-describe-briefly]:This help")))
|
||||
|
||||
(defun gnus-article-check-buffer ()
|
||||
"Beep if not in an article buffer."
|
||||
|
|
|
|||
|
|
@ -1273,7 +1273,7 @@ Also see the `gnus-group-use-permanent-levels' variable."
|
|||
(zerop number))
|
||||
(zerop (buffer-size)))
|
||||
;; No groups in the buffer.
|
||||
(gnus-message 5 gnus-no-groups-message))
|
||||
(gnus-message 5 "%s" gnus-no-groups-message))
|
||||
;; We have some groups displayed.
|
||||
(goto-char (point-max))
|
||||
(when (or (not gnus-group-goto-next-group-function)
|
||||
|
|
@ -4136,7 +4136,7 @@ If given a prefix argument, prompt for a group."
|
|||
(gnus-gethash mname gnus-description-hashtb))
|
||||
(setq desc (gnus-group-get-description group))
|
||||
(gnus-read-descriptions-file method))
|
||||
(gnus-message 1
|
||||
(gnus-message 1 "%s"
|
||||
(or desc (gnus-gethash group gnus-description-hashtb)
|
||||
"No description available")))))
|
||||
|
||||
|
|
@ -4297,11 +4297,9 @@ If GROUP, edit that local kill file instead."
|
|||
(interactive "P")
|
||||
(setq gnus-current-kill-article article)
|
||||
(gnus-kill-file-edit-file group)
|
||||
(gnus-message
|
||||
6
|
||||
(substitute-command-keys
|
||||
(format "Editing a %s kill file (Type \\[gnus-kill-file-exit] to exit)"
|
||||
(if group "local" "global")))))
|
||||
(gnus-message 6 "Editing a %s kill file (Type %s to exit)"
|
||||
(if group "local" "global")
|
||||
(substitute-command-keys "\\[gnus-kill-file-exit]")))
|
||||
|
||||
(defun gnus-group-edit-local-kill (article group)
|
||||
"Edit a local kill file."
|
||||
|
|
@ -4392,7 +4390,7 @@ The hook `gnus-exit-gnus-hook' is called before actually exiting."
|
|||
(defun gnus-group-describe-briefly ()
|
||||
"Give a one line description of the group mode commands."
|
||||
(interactive)
|
||||
(gnus-message 7 (substitute-command-keys "\\<gnus-group-mode-map>\\[gnus-group-read-group]:Select \\[gnus-group-next-unread-group]:Forward \\[gnus-group-prev-unread-group]:Backward \\[gnus-group-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-group-describe-briefly]:This help")))
|
||||
(gnus-message 7 "%s" (substitute-command-keys "\\<gnus-group-mode-map>\\[gnus-group-read-group]:Select \\[gnus-group-next-unread-group]:Forward \\[gnus-group-prev-unread-group]:Backward \\[gnus-group-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-group-describe-briefly]:This help")))
|
||||
|
||||
(defun gnus-group-browse-foreign-server (method)
|
||||
"Browse a foreign news server.
|
||||
|
|
|
|||
|
|
@ -114,6 +114,7 @@ fit these criteria."
|
|||
"-I" "UTF-8"
|
||||
"-O" "UTF-8"
|
||||
"-o" "ext_halfdump=1"
|
||||
"-o" "display_ins_del=2"
|
||||
"-o" "pre_conv=1"
|
||||
"-t" (format "%s" tab-width)
|
||||
"-cols" (format "%s" gnus-html-frame-width)
|
||||
|
|
@ -253,13 +254,39 @@ fit these criteria."
|
|||
;; should be deleted.
|
||||
((equal tag "IMG_ALT")
|
||||
(delete-region start end))
|
||||
;; w3m does not normalize the case
|
||||
((or (equal tag "b")
|
||||
(equal tag "B"))
|
||||
(gnus-overlay-put (gnus-make-overlay start end) 'face 'gnus-emphasis-bold))
|
||||
((or (equal tag "u")
|
||||
(equal tag "U"))
|
||||
(gnus-overlay-put (gnus-make-overlay start end) 'face 'gnus-emphasis-underline))
|
||||
((or (equal tag "i")
|
||||
(equal tag "I"))
|
||||
(gnus-overlay-put (gnus-make-overlay start end) 'face 'gnus-emphasis-italic))
|
||||
((or (equal tag "s")
|
||||
(equal tag "S"))
|
||||
(gnus-overlay-put (gnus-make-overlay start end) 'face 'gnus-emphasis-strikethru))
|
||||
((or (equal tag "ins")
|
||||
(equal tag "INS"))
|
||||
(gnus-overlay-put (gnus-make-overlay start end) 'face 'gnus-emphasis-underline))
|
||||
;; Handle different UL types
|
||||
((equal tag "_SYMBOL")
|
||||
(when (string-match "TYPE=\\(.+\\)" parameters)
|
||||
(let ((type (string-to-number (match-string 1 parameters))))
|
||||
(delete-region start end)
|
||||
(cond ((= type 33) (insert " "))
|
||||
((= type 34) (insert " "))
|
||||
((= type 35) (insert " "))
|
||||
((= type 36) (insert " "))
|
||||
((= type 37) (insert " "))
|
||||
((= type 38) (insert " "))
|
||||
((= type 39) (insert " "))
|
||||
((= type 40) (insert " "))
|
||||
((= type 42) (insert " "))
|
||||
((= type 43) (insert " "))
|
||||
(t (insert " "))))))
|
||||
;; Whatever. Just ignore the tag.
|
||||
((equal tag "b")
|
||||
(gnus-overlay-put (gnus-make-overlay start end) 'face 'bold))
|
||||
((equal tag "U")
|
||||
(gnus-overlay-put (gnus-make-overlay start end) 'face 'underline))
|
||||
((equal tag "i")
|
||||
(gnus-overlay-put (gnus-make-overlay start end) 'face 'italic))
|
||||
(t
|
||||
))
|
||||
(goto-char start))
|
||||
|
|
@ -307,23 +334,25 @@ fit these criteria."
|
|||
(expand-file-name (sha1 url) gnus-html-cache-directory))
|
||||
|
||||
(defun gnus-html-image-fetched (status buffer image)
|
||||
(when (and (buffer-live-p buffer)
|
||||
;; If the position of the marker is 1, then that
|
||||
;; means that the text it was in has been deleted;
|
||||
;; i.e., that the user has selected a different
|
||||
;; article before the image arrived.
|
||||
(not (= (marker-position (cadr image)) (point-min))))
|
||||
(let ((file (gnus-html-image-id (car image))))
|
||||
;; Search the start of the image data
|
||||
(search-forward "\n\n")
|
||||
;; Write region (image) silently
|
||||
(let ((file (gnus-html-image-id (car image))))
|
||||
;; Search the start of the image data
|
||||
(when (search-forward "\n\n" nil t)
|
||||
;; Write region (image data) silently
|
||||
(write-region (point) (point-max) file nil 1)
|
||||
(kill-buffer)
|
||||
(with-current-buffer buffer
|
||||
(let ((inhibit-read-only t)
|
||||
(string (buffer-substring (cadr image) (caddr image))))
|
||||
(delete-region (cadr image) (caddr image))
|
||||
(gnus-html-put-image file (cadr image) string))))))
|
||||
(when (and (buffer-live-p buffer)
|
||||
;; If the `image' has no marker, do not replace anything
|
||||
(cadr image)
|
||||
;; If the position of the marker is 1, then that
|
||||
;; means that the text it was in has been deleted;
|
||||
;; i.e., that the user has selected a different
|
||||
;; article before the image arrived.
|
||||
(not (= (marker-position (cadr image)) (point-min))))
|
||||
(with-current-buffer buffer
|
||||
(let ((inhibit-read-only t)
|
||||
(string (buffer-substring (cadr image) (caddr image))))
|
||||
(delete-region (cadr image) (caddr image))
|
||||
(gnus-html-put-image file (cadr image) (car image) string)))))))
|
||||
|
||||
(defun gnus-html-put-image (file point string &optional url alt-text)
|
||||
(when (gnus-graphic-display-p)
|
||||
|
|
@ -441,27 +470,18 @@ This only works if the article in question is HTML."
|
|||
|
||||
;;;###autoload
|
||||
(defun gnus-html-prefetch-images (summary)
|
||||
(let (blocked-images urls)
|
||||
(when (and (buffer-live-p summary)
|
||||
(executable-find "curl"))
|
||||
(with-current-buffer summary
|
||||
(setq blocked-images gnus-blocked-images))
|
||||
(when (buffer-live-p summary)
|
||||
(let ((blocked-images (with-current-buffer summary
|
||||
gnus-blocked-images)))
|
||||
(save-match-data
|
||||
(while (re-search-forward "<img.*src=[\"']\\([^\"']+\\)" nil t)
|
||||
(let ((url (match-string 1)))
|
||||
(unless (gnus-html-image-url-blocked-p url blocked-images)
|
||||
(unless (file-exists-p (gnus-html-image-id url))
|
||||
(push (mm-url-decode-entities-string url) urls)
|
||||
(push (gnus-html-image-id url) urls)
|
||||
(push "-o" urls)))))
|
||||
(let ((process
|
||||
(apply 'start-process
|
||||
"images" nil "curl"
|
||||
"-s" "--create-dirs"
|
||||
"--location"
|
||||
"--max-time" "60"
|
||||
urls)))
|
||||
(gnus-set-process-query-on-exit-flag process nil))))))
|
||||
(ignore-errors
|
||||
(url-retrieve (mm-url-decode-entities-string url)
|
||||
'gnus-html-image-fetched
|
||||
(list nil (list url))))))))))))
|
||||
|
||||
(provide 'gnus-html)
|
||||
|
||||
|
|
|
|||
|
|
@ -245,9 +245,8 @@ If it is down, start it up (again)."
|
|||
(nth 1 gnus-command-method)
|
||||
(nthcdr 2 gnus-command-method))
|
||||
(error
|
||||
(gnus-message 1 (format
|
||||
"Unable to open server %s due to: %s"
|
||||
server (error-message-string err)))
|
||||
(gnus-message 1 "Unable to open server %s due to: %s"
|
||||
server (error-message-string err))
|
||||
nil)
|
||||
(quit
|
||||
(gnus-message 1 "Quit trying to open server %s" server)
|
||||
|
|
|
|||
|
|
@ -1114,8 +1114,8 @@ EXTRA is the possible non-standard header."
|
|||
(make-local-variable 'gnus-prev-winconf)
|
||||
(setq gnus-prev-winconf winconf))
|
||||
(gnus-message
|
||||
4 (substitute-command-keys
|
||||
"\\<gnus-score-mode-map>\\[gnus-score-edit-exit] to save edits"))))
|
||||
4 "%s" (substitute-command-keys
|
||||
"\\<gnus-score-mode-map>\\[gnus-score-edit-exit] to save edits"))))
|
||||
|
||||
(defun gnus-score-edit-all-score ()
|
||||
"Edit the all.SCORE file."
|
||||
|
|
@ -1142,8 +1142,8 @@ EXTRA is the possible non-standard header."
|
|||
(make-local-variable 'gnus-prev-winconf)
|
||||
(setq gnus-prev-winconf winconf))
|
||||
(gnus-message
|
||||
4 (substitute-command-keys
|
||||
"\\<gnus-score-mode-map>\\[gnus-score-edit-exit] to save edits")))
|
||||
4 "%s" (substitute-command-keys
|
||||
"\\<gnus-score-mode-map>\\[gnus-score-edit-exit] to save edits")))
|
||||
|
||||
(defun gnus-score-edit-file-at-point (&optional format)
|
||||
"Edit score file at point in Score Trace buffers.
|
||||
|
|
@ -1391,7 +1391,7 @@ If FORMAT, also format the current score file."
|
|||
(if err
|
||||
(progn
|
||||
(ding)
|
||||
(gnus-message 3 err)
|
||||
(gnus-message 3 "%s" err)
|
||||
(sit-for 2)
|
||||
nil)
|
||||
alist)))))
|
||||
|
|
|
|||
|
|
@ -976,7 +976,7 @@ If NUMBER, fetch this number of articles."
|
|||
(defun gnus-browse-describe-briefly ()
|
||||
"Give a one line description of the group mode commands."
|
||||
(interactive)
|
||||
(gnus-message 6
|
||||
(gnus-message 6 "%s"
|
||||
(substitute-command-keys "\\<gnus-browse-mode-map>\\[gnus-group-next-group]:Forward \\[gnus-group-prev-group]:Backward \\[gnus-browse-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-browse-describe-briefly]:This help")))
|
||||
|
||||
(defun gnus-server-regenerate-server ()
|
||||
|
|
|
|||
|
|
@ -268,7 +268,7 @@ not match this regexp will be removed before saving the list."
|
|||
(mapconcat 'identity
|
||||
'("^to\\." ; not "real" groups
|
||||
"^[0-9. \t]+\\( \\|$\\)" ; all digits in name
|
||||
"^[\"][]\"[#'()]" ; bogus characters
|
||||
"^[\"][\"#'()]" ; bogus characters
|
||||
)
|
||||
"\\|")
|
||||
"*A regexp to match uninteresting newsgroups in the active file.
|
||||
|
|
@ -1759,14 +1759,16 @@ If SCAN, request a scan of that group as well."
|
|||
(dolist (elem type-cache)
|
||||
(destructuring-bind (method method-type infos dummy) elem
|
||||
(when (and method infos
|
||||
(not (gnus-method-denied-p method))
|
||||
(gnus-check-backend-function
|
||||
'retrieve-group-data-early (car method)))
|
||||
(when (gnus-check-backend-function 'request-scan (car method))
|
||||
(dolist (info infos)
|
||||
(gnus-request-scan (gnus-info-group info) method)))
|
||||
(setcar (nthcdr 3 elem)
|
||||
(gnus-retrieve-group-data-early method infos)))))
|
||||
(not (gnus-method-denied-p method)))
|
||||
(unless (gnus-server-opened method)
|
||||
(gnus-open-server method))
|
||||
(when (gnus-check-backend-function
|
||||
'retrieve-group-data-early (car method))
|
||||
(when (gnus-check-backend-function 'request-scan (car method))
|
||||
(dolist (info infos)
|
||||
(gnus-request-scan (gnus-info-group info) method)))
|
||||
(setcar (nthcdr 3 elem)
|
||||
(gnus-retrieve-group-data-early method infos))))))
|
||||
|
||||
;; Do the rest of the retrieval.
|
||||
(dolist (elem type-cache)
|
||||
|
|
@ -2054,7 +2056,7 @@ If SCAN, request a scan of that group as well."
|
|||
(if (and where (not (zerop (length where))))
|
||||
(concat " from " where) "")
|
||||
(car method)))
|
||||
(gnus-message 5 mesg)
|
||||
(gnus-message 5 "%s" mesg)
|
||||
(when (gnus-check-server method)
|
||||
;; Request that the backend scan its incoming messages.
|
||||
(when (and (or (and gnus-agent
|
||||
|
|
@ -2089,7 +2091,7 @@ If SCAN, request a scan of that group as well."
|
|||
(unless (equal method gnus-message-archive-method)
|
||||
(gnus-error 1 "Cannot read active file from %s server"
|
||||
(car method)))
|
||||
(gnus-message 5 mesg)
|
||||
(gnus-message 5 "%s" mesg)
|
||||
(gnus-active-to-gnus-format method gnus-active-hashtb nil t)
|
||||
;; We mark this active file as read.
|
||||
(push method gnus-have-read-active-file)
|
||||
|
|
|
|||
|
|
@ -7330,7 +7330,7 @@ in."
|
|||
(defun gnus-summary-describe-briefly ()
|
||||
"Describe summary mode commands briefly."
|
||||
(interactive)
|
||||
(gnus-message 6 (substitute-command-keys "\\<gnus-summary-mode-map>\\[gnus-summary-next-page]:Select \\[gnus-summary-next-unread-article]:Forward \\[gnus-summary-prev-unread-article]:Backward \\[gnus-summary-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-summary-describe-briefly]:This help")))
|
||||
(gnus-message 6 "%s" (substitute-command-keys "\\<gnus-summary-mode-map>\\[gnus-summary-next-page]:Select \\[gnus-summary-next-unread-article]:Forward \\[gnus-summary-prev-unread-article]:Backward \\[gnus-summary-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-summary-describe-briefly]:This help")))
|
||||
|
||||
;; Walking around group mode buffer from summary mode.
|
||||
|
||||
|
|
@ -10768,7 +10768,11 @@ If NO-EXPIRE, auto-expiry will be inhibited."
|
|||
;; Go to the right position on the line.
|
||||
(goto-char (+ forward (point)))
|
||||
;; Replace the old mark with the new mark.
|
||||
(subst-char-in-region (point) (1+ (point)) (char-after) mark)
|
||||
(let ((to-insert
|
||||
(subst-char-in-string (char-after) mark
|
||||
(buffer-substring (point) (1+ (point))))))
|
||||
(delete-region (point) (1+ (point)))
|
||||
(insert to-insert))
|
||||
;; Optionally update the marks by some user rule.
|
||||
(when (eq type 'unread)
|
||||
(gnus-data-set-mark
|
||||
|
|
|
|||
|
|
@ -3678,6 +3678,41 @@ that that variable is buffer-local to the summary buffers."
|
|||
gnus-valid-select-methods)))
|
||||
(equal (nth 1 m1) (nth 1 m2)))))))
|
||||
|
||||
(defun gnus-methods-sloppily-equal (m1 m2)
|
||||
;; Same method.
|
||||
(or
|
||||
(eq m1 m2)
|
||||
;; Type and name are equal.
|
||||
(and
|
||||
(eq (car m1) (car m2))
|
||||
(equal (cadr m1) (cadr m2))
|
||||
;; Check parameters for sloppy equalness.
|
||||
(let ((p1 (copy-list (cddr m1)))
|
||||
(p2 (copy-list (cddr m2)))
|
||||
e1 e2)
|
||||
(block nil
|
||||
(while (setq e1 (pop p1))
|
||||
(unless (setq e2 (assq (car e1) p2))
|
||||
;; The parameter doesn't exist in p2.
|
||||
(return nil))
|
||||
(setq p2 (delq e2 p2))
|
||||
(unless (equalp e1 e2)
|
||||
(if (not (and (stringp (cadr e1))
|
||||
(stringp (cadr e2))))
|
||||
(return nil)
|
||||
;; Special-case string parameter comparison so that we
|
||||
;; can uniquify them.
|
||||
(let ((s1 (cadr e1))
|
||||
(s2 (cadr e2)))
|
||||
(when (string-match "/$" s1)
|
||||
(setq s1 (directory-file-name s1)))
|
||||
(when (string-match "/$" s2)
|
||||
(setq s2 (directory-file-name s2)))
|
||||
(unless (equal s1 s2)
|
||||
(return nil))))))
|
||||
;; If p2 now is empty, they were equal.
|
||||
(null p2))))))
|
||||
|
||||
(defun gnus-server-equal (m1 m2)
|
||||
"Say whether two methods are equal."
|
||||
(let ((m1 (cond ((null m1) gnus-select-method)
|
||||
|
|
@ -4142,13 +4177,19 @@ If NEWSGROUP is nil, return the global kill file name instead."
|
|||
gnus-valid-select-methods)))
|
||||
|
||||
(defun gnus-similar-server-opened (method)
|
||||
(let ((opened gnus-opened-servers))
|
||||
"Return non-nil if we have a similar server opened.
|
||||
This is defined as a server with the same name, but different
|
||||
parameters."
|
||||
(let ((opened gnus-opened-servers)
|
||||
open)
|
||||
(while (and method opened)
|
||||
(when (and (equal (cadr method) (cadaar opened))
|
||||
(equal (car method) (caaar opened))
|
||||
(not (equal method (caar opened))))
|
||||
(setq method nil))
|
||||
(pop opened))
|
||||
(setq open (car (pop opened)))
|
||||
;; Type and name are the same...
|
||||
(when (and (equal (car method) (car open))
|
||||
(equal (cadr method) (cadr open))
|
||||
;; ... but the rest of the parameters differ.
|
||||
(not (gnus-methods-sloppily-equal method open)))
|
||||
(setq method nil)))
|
||||
(not method)))
|
||||
|
||||
(defun gnus-server-extend-method (group method)
|
||||
|
|
@ -4397,6 +4438,10 @@ If ARG is non-nil and a positive number, Gnus will use that as the
|
|||
startup level. If ARG is non-nil and not a positive number, Gnus will
|
||||
prompt the user for the name of an NNTP server to use."
|
||||
(interactive "P")
|
||||
;; When using the development version of Gnus, load the gnus-load
|
||||
;; file.
|
||||
(unless (string-match "^Gnus" gnus-version)
|
||||
(load "gnus-load"))
|
||||
(unless (byte-code-function-p (symbol-function 'gnus))
|
||||
(message "You should byte-compile Gnus")
|
||||
(sit-for 2))
|
||||
|
|
|
|||
|
|
@ -45,8 +45,7 @@
|
|||
(defalias 'mail-header-parse-content-type 'rfc2231-parse-qp-string)
|
||||
(defalias 'mail-header-parse-content-disposition 'rfc2231-parse-qp-string)
|
||||
(defalias 'mail-content-type-get 'rfc2231-get-value)
|
||||
;(defalias 'mail-header-encode-parameter 'rfc2045-encode-string)
|
||||
(defalias 'mail-header-encode-parameter 'rfc2231-encode-string)
|
||||
(defalias 'mail-header-encode-parameter 'rfc2045-encode-string)
|
||||
|
||||
(defalias 'mail-header-remove-comments 'ietf-drums-remove-comments)
|
||||
(defalias 'mail-header-remove-whitespace 'ietf-drums-remove-whitespace)
|
||||
|
|
|
|||
|
|
@ -463,7 +463,7 @@ on your system, you could say something like:
|
|||
(let ((extra (mail-header-extra header)))
|
||||
(while extra
|
||||
(insert (symbol-name (caar extra))
|
||||
": " (cdar extra) "\t")
|
||||
": " (if (stringp (cdar extra)) (cdar extra) "") "\t")
|
||||
(pop extra))))
|
||||
(insert "\n")
|
||||
(backward-char 1)
|
||||
|
|
|
|||
|
|
@ -66,6 +66,17 @@ Values are `ssl' and `network'.")
|
|||
This is always done if the server supports UID EXPUNGE, but it's
|
||||
not done by default on servers that doesn't support that command.")
|
||||
|
||||
(defvoo nnimap-authenticator nil
|
||||
"How nnimap authenticate itself to the server.
|
||||
Possible choices are nil (use default methods) or `anonymous'.")
|
||||
|
||||
(defvoo nnimap-fetch-partial-articles nil
|
||||
"If non-nil, nnimap will fetch partial articles.
|
||||
If t, nnimap will fetch only the first part. If a string, it
|
||||
will fetch all parts that have types that match that string. A
|
||||
likely value would be \"text/\" to automatically fetch all
|
||||
textual parts.")
|
||||
|
||||
(defvoo nnimap-connection-alist nil)
|
||||
|
||||
(defvoo nnimap-current-infos nil)
|
||||
|
|
@ -146,7 +157,7 @@ not done by default on servers that doesn't support that command.")
|
|||
(delete-region (line-beginning-position) (line-end-position))
|
||||
(insert (format "211 %s Article retrieved." article))
|
||||
(forward-line 1)
|
||||
(insert (format "Bytes: %d\n" bytes))
|
||||
(insert (format "Chars: %d\n" bytes))
|
||||
(when lines
|
||||
(insert (format "Lines: %s\n" lines)))
|
||||
(re-search-forward "^\r$")
|
||||
|
|
@ -254,7 +265,14 @@ not done by default on servers that doesn't support that command.")
|
|||
(when (setq connection-result (nnimap-wait-for-connection))
|
||||
(unless (equal connection-result "PREAUTH")
|
||||
(if (not (setq credentials
|
||||
(nnimap-credentials nnimap-address ports)))
|
||||
(if (eq nnimap-authenticator 'anonymous)
|
||||
(list "anonymous"
|
||||
(message-make-address))
|
||||
(nnimap-credentials
|
||||
nnimap-address
|
||||
(if nnimap-server-port
|
||||
(cons (format "%s" nnimap-server-port) ports)
|
||||
ports)))))
|
||||
(setq nnimap-object nil)
|
||||
(setq login-result (nnimap-command "LOGIN %S %S"
|
||||
(car credentials)
|
||||
|
|
@ -302,7 +320,8 @@ not done by default on servers that doesn't support that command.")
|
|||
|
||||
(deffoo nnimap-request-article (article &optional group server to-buffer)
|
||||
(with-current-buffer nntp-server-buffer
|
||||
(let ((result (nnimap-possibly-change-group group server)))
|
||||
(let ((result (nnimap-possibly-change-group group server))
|
||||
parts)
|
||||
(when (stringp article)
|
||||
(setq article (nnimap-find-article-by-message-id group article)))
|
||||
(when (and result
|
||||
|
|
@ -310,6 +329,14 @@ not done by default on servers that doesn't support that command.")
|
|||
(erase-buffer)
|
||||
(with-current-buffer (nnimap-buffer)
|
||||
(erase-buffer)
|
||||
(when nnimap-fetch-partial-articles
|
||||
(if (eq nnimap-fetch-partial-articles t)
|
||||
(setq parts '(1))
|
||||
(nnimap-command "UID FETCH %d (BODYSTRUCTURE)" article)
|
||||
(goto-char (point-min))
|
||||
(when (re-search-forward "FETCH.*BODYSTRUCTURE" nil t)
|
||||
(let ((structure (ignore-errors (read (current-buffer)))))
|
||||
(setq parts (nnimap-find-wanted-parts structure))))))
|
||||
(setq result
|
||||
(nnimap-command
|
||||
(if (member "IMAP4REV1" (nnimap-capabilities nnimap-object))
|
||||
|
|
@ -331,7 +358,30 @@ not done by default on servers that doesn't support that command.")
|
|||
(goto-char (+ (point) bytes))
|
||||
(delete-region (point) (point-max))
|
||||
(nnheader-ms-strip-cr))
|
||||
t)))))))
|
||||
(cons group article))))))))
|
||||
|
||||
(defun nnimap-find-wanted-parts (structure)
|
||||
(message-flatten-list (nnimap-find-wanted-parts-1 structure "")))
|
||||
|
||||
(defun nnimap-find-wanted-parts-1 (structure prefix)
|
||||
(let ((num 1)
|
||||
parts)
|
||||
(while (consp (car structure))
|
||||
(let ((sub (pop structure)))
|
||||
(if (consp (car sub))
|
||||
(push (nnimap-find-wanted-parts-1
|
||||
sub (if (string= prefix "")
|
||||
(number-to-string num)
|
||||
(format "%s.%s" prefix num)))
|
||||
parts)
|
||||
(let ((type (format "%s/%s" (nth 0 sub) (nth 1 sub))))
|
||||
(when (string-match nnimap-fetch-partial-articles type)
|
||||
(push (if (string= prefix "")
|
||||
(number-to-string num)
|
||||
(format "%s.%s" prefix num))
|
||||
parts)))
|
||||
(incf num))))
|
||||
(nreverse parts)))
|
||||
|
||||
(deffoo nnimap-request-group (group &optional server dont-check info)
|
||||
(with-current-buffer nntp-server-buffer
|
||||
|
|
@ -825,21 +875,25 @@ not done by default on servers that doesn't support that command.")
|
|||
(goto-char (point-min))
|
||||
(while (and (memq (process-status process)
|
||||
'(open run))
|
||||
(not (re-search-forward "^\\* " nil t)))
|
||||
(not (re-search-forward "^\\* .*\n" nil t)))
|
||||
(nnheader-accept-process-output process)
|
||||
(goto-char (point-min)))
|
||||
(and (looking-at "[A-Z0-9]+")
|
||||
(match-string 0))))
|
||||
(forward-line -1)
|
||||
(and (looking-at "\\* \\([A-Z0-9]+\\)")
|
||||
(match-string 1))))
|
||||
|
||||
(defun nnimap-wait-for-response (sequence &optional messagep)
|
||||
(goto-char (point-max))
|
||||
(while (not (re-search-backward (format "^%d .*\n" sequence)
|
||||
(max (point-min) (- (point) 500))
|
||||
t))
|
||||
(when messagep
|
||||
(message "Read %dKB" (/ (buffer-size) 1000)))
|
||||
(nnheader-accept-process-output (get-buffer-process (current-buffer)))
|
||||
(goto-char (point-max))))
|
||||
(let ((process (get-buffer-process (current-buffer))))
|
||||
(goto-char (point-max))
|
||||
(while (and (memq (process-status process)
|
||||
'(open run))
|
||||
(not (re-search-backward (format "^%d .*\n" sequence)
|
||||
(max (point-min) (- (point) 500))
|
||||
t)))
|
||||
(when messagep
|
||||
(message "Read %dKB" (/ (buffer-size) 1000)))
|
||||
(nnheader-accept-process-output process)
|
||||
(goto-char (point-max)))))
|
||||
|
||||
(defun nnimap-parse-response ()
|
||||
(let ((lines (split-string (nnimap-last-response-string) "\r\n" t))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue