mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-11-22 07:09:54 +00:00
Remove Gnus group name encoding/decoding
This completes the process started in c1b63af445. Gnus group names are
now fully decoded inside the Gnus system.
* lisp/gnus/gnus-agent.el (gnus-agent-file-coding-system): Change
default to utf-8-emacs.
(gnus-agent-decoded-group-names, gnus-agent-decoded-group-name):
Remove variable and function. Remove all usage in this file.
* lisp/gnus/gnus-cache.el (gnus-cache-decoded-group-names,
gnus-cache-unified-group-names, gnus-cache-decoded-group-name):
Remove these variables and function. Remove all usage in this file.
* lisp/gnus/gnus-group.el (gnus-tmp-decoded-group): Remove this
variable, gnus-tmp-group is now decoded.
(gnus-group-completing-read): Don't encode or decode group names
here.
(gnus-group-make-group): Remove ENCODED argument.
* lisp/gnus/gnus-srvr.el (gnus-browse-foreign-server): Decode group
names here.
* lisp/gnus/gnus-start.el (gnus-make-hashtable-from-newsrc-alist):
check for encoded group names and decode.
(gnus-active-to-gnus-format): Make sure incoming group names are
decoded.
(gnus-read-newsrc-el-file): Check for encoded group names in
gnus-topic-alist.
* lisp/gnus/nnagent.el: Don't use a unibyte buffer.
* lisp/gnus/nnheader.el (nnheader-file-coding-system): Switch default
from 'raw-text to 'undecided, on the assumption that 'undecided will
probably write 'utf-8-emacs unless the user has arranged things
otherwise.
* lisp/gnus/nnimap.el (nnimap-decode-gnus-group,
nnimap-encode-gnus-group): Remove functions and their use.
* lisp/gnus/nnmail.el (nnmail-parse-active): Remove encoding.
(nnmail-active-file-coding-system): Default to 'utf-8-emacs instead
of 'raw-text.
(nnmail-group-names-not-encoded-p): Obsolete this variable; stop
using it.
* lisp/gnus/gnus-art.el:
* lisp/gnus/gnus-cus.el:
* lisp/gnus/gnus-msg.el:
* lisp/gnus/gnus-start.el:
* lisp/gnus/gnus-sum.el:
* lisp/gnus/gnus.el:
* lisp/gnus/nnml.el:
* lisp/gnus/message.el:
* lisp/gnus/nnrss.el: Stop using gnus-group-decoded-name in all these
files.
This commit is contained in:
Eric Abrahamsen
parent
c6b4eed80a
commit
cb12a84f2c
@ -229,7 +229,7 @@ NOTES:
|
||||
"Cache of message subjects for spam messages.
|
||||
Actually a hash table holding subjects mapped to t.")
|
||||
(defvar gnus-agent-file-name nil)
|
||||
(defvar gnus-agent-file-coding-system 'raw-text)
|
||||
(defvar gnus-agent-file-coding-system 'utf-8-emacs)
|
||||
(defvar gnus-agent-file-loading-cache nil)
|
||||
(defvar gnus-agent-total-fetched-hashtb nil)
|
||||
(defvar gnus-agent-inhibit-update-total-fetched-for nil)
|
||||
@ -406,8 +406,6 @@ manipulated as follows:
|
||||
(defun gnus-agent-read-group ()
|
||||
"Read a group name in the minibuffer, with completion."
|
||||
(let ((def (or (gnus-group-group-name) gnus-newsgroup-name)))
|
||||
(when def
|
||||
(setq def (gnus-group-decoded-name def)))
|
||||
(gnus-group-completing-read nil nil t nil nil def)))
|
||||
|
||||
;;; Fetching setup functions.
|
||||
@ -1330,7 +1328,10 @@ downloaded into the agent."
|
||||
(gnus-make-directory (file-name-directory file))
|
||||
(with-temp-file file
|
||||
;; Emacs got problem to match non-ASCII group in multibyte buffer.
|
||||
(mm-disable-multibyte)
|
||||
|
||||
;; FIXME: Is this still an issue now that group names are
|
||||
;; always strings?
|
||||
;(mm-disable-multibyte)
|
||||
(when (file-exists-p file)
|
||||
(nnheader-insert-file-contents file)
|
||||
|
||||
@ -1360,7 +1361,7 @@ downloaded into the agent."
|
||||
(gnus-make-directory (file-name-directory file))
|
||||
(with-temp-buffer
|
||||
;; Emacs got problem to match non-ASCII group in multibyte buffer.
|
||||
(mm-disable-multibyte)
|
||||
;(mm-disable-multibyte)
|
||||
(when (file-exists-p file)
|
||||
(nnheader-insert-file-contents file)
|
||||
|
||||
@ -1372,18 +1373,6 @@ downloaded into the agent."
|
||||
oactive-min (read (current-buffer))) ;; min
|
||||
(cons oactive-min oactive-max))))))))
|
||||
|
||||
(defvar gnus-agent-decoded-group-names nil
|
||||
"Alist of non-ASCII group names and decoded ones.")
|
||||
|
||||
(defun gnus-agent-decoded-group-name (group)
|
||||
"Return a decoded group name of GROUP."
|
||||
(or (cdr (assoc group gnus-agent-decoded-group-names))
|
||||
(if (string-match "[^\000-\177]" group)
|
||||
(let ((decoded (gnus-group-decoded-name group)))
|
||||
(push (cons group decoded) gnus-agent-decoded-group-names)
|
||||
decoded)
|
||||
group)))
|
||||
|
||||
(defun gnus-agent-group-path (group)
|
||||
"Translate GROUP into a file name."
|
||||
|
||||
@ -1395,7 +1384,7 @@ downloaded into the agent."
|
||||
(nnheader-translate-file-chars
|
||||
(nnheader-replace-duplicate-chars-in-string
|
||||
(nnheader-replace-chars-in-string
|
||||
(gnus-group-real-name (gnus-agent-decoded-group-name group))
|
||||
(gnus-group-real-name group)
|
||||
?/ ?_)
|
||||
?. ?_)))
|
||||
(if (or nnmail-use-long-file-names
|
||||
@ -1409,7 +1398,7 @@ downloaded into the agent."
|
||||
;; unplugged. The agent must, therefore, use the same directory
|
||||
;; while plugged.
|
||||
(nnmail-group-pathname
|
||||
(gnus-group-real-name (gnus-agent-decoded-group-name group))
|
||||
(gnus-group-real-name group)
|
||||
(if gnus-command-method
|
||||
(gnus-agent-directory)
|
||||
(let ((gnus-command-method (gnus-find-method-for-group group)))
|
||||
@ -1437,7 +1426,7 @@ downloaded into the agent."
|
||||
(format " *Gnus agent %s history*"
|
||||
(gnus-agent-method)))))
|
||||
gnus-agent-history-buffers)
|
||||
(mm-disable-multibyte) ;; everything is binary
|
||||
;(mm-disable-multibyte) ;; everything is binary
|
||||
(erase-buffer)
|
||||
(insert "\n")
|
||||
(let ((file (gnus-agent-lib-file "history")))
|
||||
@ -1525,8 +1514,7 @@ downloaded into the agent."
|
||||
(setq selected-sets (nreverse selected-sets))
|
||||
|
||||
(gnus-make-directory dir)
|
||||
(gnus-message 7 "Fetching articles for %s..."
|
||||
(gnus-agent-decoded-group-name group))
|
||||
(gnus-message 7 "Fetching articles for %s..." group)
|
||||
|
||||
(unwind-protect
|
||||
(while (setq articles (pop selected-sets))
|
||||
@ -1537,8 +1525,7 @@ downloaded into the agent."
|
||||
(let (article)
|
||||
(while (setq article (pop articles))
|
||||
(gnus-message 10 "Fetching article %s for %s..."
|
||||
article
|
||||
(gnus-agent-decoded-group-name group))
|
||||
article group)
|
||||
(when (or
|
||||
(gnus-backlog-request-article group article
|
||||
nntp-server-buffer)
|
||||
@ -1875,8 +1862,7 @@ article numbers will be returned."
|
||||
(with-current-buffer nntp-server-buffer
|
||||
(if articles
|
||||
(progn
|
||||
(gnus-message 8 "Fetching headers for %s..."
|
||||
(gnus-agent-decoded-group-name group))
|
||||
(gnus-message 8 "Fetching headers for %s..." group)
|
||||
|
||||
;; Fetch them.
|
||||
(gnus-make-directory (nnheader-translate-file-chars
|
||||
@ -3058,8 +3044,7 @@ FORCE is equivalent to setting the expiration predicates to true."
|
||||
;; provided a non-nil active
|
||||
|
||||
(let ((dir (gnus-agent-group-pathname group))
|
||||
(file-name-coding-system nnmail-pathname-coding-system)
|
||||
(decoded (gnus-agent-decoded-group-name group)))
|
||||
(file-name-coding-system nnmail-pathname-coding-system))
|
||||
(gnus-agent-with-refreshed-group
|
||||
group
|
||||
(when (boundp 'gnus-agent-expire-current-dirs)
|
||||
@ -3068,8 +3053,8 @@ FORCE is equivalent to setting the expiration predicates to true."
|
||||
(if (and (not force)
|
||||
(eq 'DISABLE (gnus-agent-find-parameter group
|
||||
'agent-enable-expiration)))
|
||||
(gnus-message 5 "Expiry skipping over %s" decoded)
|
||||
(gnus-message 5 "Expiring articles in %s" decoded)
|
||||
(gnus-message 5 "Expiry skipping over %s" group)
|
||||
(gnus-message 5 "Expiring articles in %s" group)
|
||||
(gnus-agent-load-alist group)
|
||||
(let* ((bytes-freed 0)
|
||||
(size-files-deleted 0.0)
|
||||
@ -3293,7 +3278,7 @@ line." (point) nov-file)))
|
||||
(keep
|
||||
(gnus-agent-message 10
|
||||
"gnus-agent-expire: %s:%d: Kept %s article%s."
|
||||
decoded article-number keep (if fetch-date " and file" ""))
|
||||
group article-number keep (if fetch-date " and file" ""))
|
||||
(when fetch-date
|
||||
(unless (file-exists-p
|
||||
(concat dir (number-to-string
|
||||
@ -3301,7 +3286,7 @@ line." (point) nov-file)))
|
||||
(setf (nth 1 entry) nil)
|
||||
(gnus-agent-message 3 "gnus-agent-expire cleared \
|
||||
download flag on %s:%d as the cached article file is missing."
|
||||
decoded (caar dlist)))
|
||||
group (caar dlist)))
|
||||
(unless marker
|
||||
(gnus-message 1 "gnus-agent-expire detected a \
|
||||
missing NOV entry. Run gnus-agent-regenerate-group to restore it.")))
|
||||
@ -3379,12 +3364,12 @@ article alist" type) actions))
|
||||
|
||||
(when actions
|
||||
(gnus-agent-message 8 "gnus-agent-expire: %s:%d: %s"
|
||||
decoded article-number
|
||||
group article-number
|
||||
(mapconcat #'identity actions ", ")))))
|
||||
(t
|
||||
(gnus-agent-message
|
||||
10 "gnus-agent-expire: %s:%d: Article kept as \
|
||||
expiration tests failed." decoded article-number)
|
||||
expiration tests failed." group article-number)
|
||||
(gnus-agent-append-to-list
|
||||
tail-alist (cons article-number fetch-date)))
|
||||
)
|
||||
@ -3835,7 +3820,7 @@ If REREAD is not nil, downloaded articles are marked as unread."
|
||||
(sit-for 1)
|
||||
t)))))
|
||||
(when group
|
||||
(gnus-message 5 "Regenerating in %s" (gnus-agent-decoded-group-name group))
|
||||
(gnus-message 5 "Regenerating in %s" group)
|
||||
(let* ((gnus-command-method (or gnus-command-method
|
||||
(gnus-find-method-for-group group)))
|
||||
(file (gnus-agent-article-name ".overview" group))
|
||||
@ -3912,8 +3897,7 @@ If REREAD is not nil, downloaded articles are marked as unread."
|
||||
(> (car downloaded) (car nov-arts))))
|
||||
;; This entry is missing from the overview file
|
||||
(gnus-message 3 "Regenerating NOV %s %d..."
|
||||
(gnus-agent-decoded-group-name group)
|
||||
(car downloaded))
|
||||
group (car downloaded))
|
||||
(let ((file (concat dir (number-to-string (car downloaded)))))
|
||||
(mm-with-unibyte-buffer
|
||||
(nnheader-insert-file-contents file)
|
||||
|
||||
@ -4506,9 +4506,7 @@ commands:
|
||||
(defun gnus-article-setup-buffer ()
|
||||
"Initialize the article buffer."
|
||||
(let* ((name (if gnus-single-article-buffer "*Article*"
|
||||
(concat "*Article "
|
||||
(gnus-group-decoded-name gnus-newsgroup-name)
|
||||
"*")))
|
||||
(concat "*Article " gnus-newsgroup-name "*")))
|
||||
(original
|
||||
(progn (string-match "\\*Article" name)
|
||||
(concat " *Original Article"
|
||||
|
||||
@ -430,41 +430,7 @@ Returns the list of articles removed."
|
||||
(and unread (memq 'unread class))
|
||||
(and (not unread) (not ticked) (not dormant) (memq 'read class))))
|
||||
|
||||
(defvar gnus-cache-decoded-group-names nil
|
||||
"Alist of original group names and decoded group names.
|
||||
Decoding is done according to `gnus-group-name-charset-method-alist'
|
||||
or `gnus-group-name-charset-group-alist'.")
|
||||
|
||||
(defvar gnus-cache-unified-group-names nil
|
||||
"Alist of unified decoded group names and original group names.
|
||||
A group name is decoded according to
|
||||
`gnus-group-name-charset-method-alist' or
|
||||
`gnus-group-name-charset-group-alist' first, and is encoded and
|
||||
decoded again according to `nnmail-pathname-coding-system',
|
||||
`file-name-coding-system', or `default-file-name-coding-system'.
|
||||
|
||||
It is used when asking for an original group name from a cache
|
||||
directory name, in which non-ASCII characters might have been unified
|
||||
into the ones of a certain charset particularly if the `utf-8' coding
|
||||
system for example was used.")
|
||||
|
||||
(defun gnus-cache-decoded-group-name (group)
|
||||
"Return a decoded group name of GROUP."
|
||||
(or (cdr (assoc group gnus-cache-decoded-group-names))
|
||||
(let ((decoded (gnus-group-decoded-name group))
|
||||
(coding (or nnmail-pathname-coding-system
|
||||
file-name-coding-system
|
||||
default-file-name-coding-system)))
|
||||
(push (cons group decoded) gnus-cache-decoded-group-names)
|
||||
(push (cons (decode-coding-string
|
||||
(encode-coding-string decoded coding)
|
||||
coding)
|
||||
group)
|
||||
gnus-cache-unified-group-names)
|
||||
decoded)))
|
||||
|
||||
(defun gnus-cache-file-name (group article)
|
||||
(setq group (gnus-cache-decoded-group-name group))
|
||||
(expand-file-name
|
||||
(if (stringp article) article (int-to-string article))
|
||||
(file-name-as-directory
|
||||
@ -733,12 +699,7 @@ If LOW, update the lower bound instead."
|
||||
(push (pop files) alphs)))
|
||||
;; If we have nums, then this is probably a valid group.
|
||||
(when (setq nums (sort nums '<))
|
||||
;; Use non-decoded group name.
|
||||
;; FIXME: this is kind of a workaround. The active file should
|
||||
;; be updated at the time articles are cached. It will make
|
||||
;; `gnus-cache-unified-group-names' needless.
|
||||
(puthash (or (cdr (assoc group gnus-cache-unified-group-names))
|
||||
group)
|
||||
(puthash group
|
||||
(cons (car nums) (car (last nums)))
|
||||
gnus-cache-active-hashtb))
|
||||
;; Go through all the other files.
|
||||
|
||||
@ -396,7 +396,7 @@ category."))
|
||||
:tag "topic parameters"
|
||||
"(gnus)Topic Parameters"))
|
||||
(widget-insert " for <")
|
||||
(widget-insert (gnus-group-decoded-name (or group topic)))
|
||||
(widget-insert (or group topic))
|
||||
(widget-insert "> and press ")
|
||||
(widget-create 'push-button
|
||||
:tag "done"
|
||||
@ -845,8 +845,7 @@ When called interactively, FILE defaults to the current score file.
|
||||
This can be changed using the `\\[gnus-score-change-score-file]' command."
|
||||
(interactive (list gnus-current-score-file))
|
||||
(unless file
|
||||
(error "No score file for %s"
|
||||
(gnus-group-decoded-name gnus-newsgroup-name)))
|
||||
(error "No score file for %s" gnus-newsgroup-name))
|
||||
(let ((scores (gnus-score-load file))
|
||||
(types (mapcar (lambda (entry)
|
||||
`(group :format "%v%h\n"
|
||||
|
||||
@ -479,7 +479,6 @@ simple manner."
|
||||
(defvar gnus-tmp-news-method)
|
||||
(defvar gnus-tmp-colon)
|
||||
(defvar gnus-tmp-news-server)
|
||||
(defvar gnus-tmp-decoded-group)
|
||||
(defvar gnus-tmp-header)
|
||||
(defvar gnus-tmp-process-marked)
|
||||
(defvar gnus-tmp-summary-live)
|
||||
@ -518,14 +517,9 @@ simple manner."
|
||||
(?T (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))) ?d)
|
||||
(?i (+ (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked)))
|
||||
(gnus-range-length (cdr (assq 'tick gnus-tmp-marked)))) ?d)
|
||||
(?g (if (boundp 'gnus-tmp-decoded-group)
|
||||
gnus-tmp-decoded-group
|
||||
gnus-tmp-group)
|
||||
?s)
|
||||
(?g gnus-tmp-group ?s)
|
||||
(?G gnus-tmp-qualified-group ?s)
|
||||
(?c (gnus-short-group-name (if (boundp 'gnus-tmp-decoded-group)
|
||||
gnus-tmp-decoded-group
|
||||
gnus-tmp-group))
|
||||
(?c (gnus-short-group-name gnus-tmp-group)
|
||||
?s)
|
||||
(?C gnus-tmp-comment ?s)
|
||||
(?D gnus-tmp-newsgroup-description ?s)
|
||||
@ -1398,8 +1392,7 @@ if it is a string, only list groups matching REGEXP."
|
||||
((functionp regexp) (funcall regexp group))))
|
||||
(add-text-properties
|
||||
(point) (prog1 (1+ (point))
|
||||
(insert " " mark " *: "
|
||||
(gnus-group-decoded-name group)
|
||||
(insert " " mark " *: " group
|
||||
"\n"))
|
||||
(list 'gnus-group group
|
||||
'gnus-unread t
|
||||
@ -1508,8 +1501,6 @@ if it is a string, only list groups matching REGEXP."
|
||||
"Insert a group line in the group buffer."
|
||||
(let* ((gnus-tmp-method
|
||||
(gnus-server-get-method gnus-tmp-group gnus-tmp-method))
|
||||
(group-name-charset (gnus-group-name-charset gnus-tmp-method
|
||||
gnus-tmp-group))
|
||||
(gnus-tmp-active (gnus-active gnus-tmp-group))
|
||||
(gnus-tmp-number-total
|
||||
(if gnus-tmp-active
|
||||
@ -1528,16 +1519,13 @@ if it is a string, only list groups matching REGEXP."
|
||||
((= gnus-tmp-level gnus-level-zombie) ?Z)
|
||||
(t ?K)))
|
||||
(gnus-tmp-qualified-group
|
||||
(gnus-group-name-decode (gnus-group-real-name gnus-tmp-group)
|
||||
group-name-charset))
|
||||
(gnus-group-real-name gnus-tmp-group))
|
||||
(gnus-tmp-comment
|
||||
(or (gnus-group-get-parameter gnus-tmp-group 'comment t)
|
||||
gnus-tmp-group))
|
||||
(gnus-tmp-newsgroup-description
|
||||
(if gnus-description-hashtb
|
||||
(or (gnus-group-name-decode
|
||||
(gethash gnus-tmp-group gnus-description-hashtb)
|
||||
group-name-charset) "")
|
||||
(or (gethash gnus-tmp-group gnus-description-hashtb) "")
|
||||
""))
|
||||
(gnus-tmp-moderated
|
||||
(if (and gnus-moderated-hashtb
|
||||
@ -1574,9 +1562,7 @@ if it is a string, only list groups matching REGEXP."
|
||||
(point)
|
||||
(prog1 (1+ (point))
|
||||
;; Insert the text.
|
||||
(let ((gnus-tmp-decoded-group (gnus-group-name-decode
|
||||
gnus-tmp-group group-name-charset)))
|
||||
(eval gnus-group-line-format-spec)))
|
||||
(eval gnus-group-line-format-spec))
|
||||
`(gnus-group ,gnus-tmp-group
|
||||
gnus-unread ,(if (numberp number)
|
||||
(string-to-number gnus-tmp-number-of-unread)
|
||||
@ -2117,9 +2103,7 @@ be permanent."
|
||||
(defun gnus-group-name-at-point ()
|
||||
"Return a group name from around point if it exists, or nil."
|
||||
(if (derived-mode-p 'gnus-group-mode)
|
||||
(let ((group (gnus-group-group-name)))
|
||||
(when group
|
||||
(gnus-group-decoded-name group)))
|
||||
(gnus-group-group-name)
|
||||
;; FIXME: Use rx.
|
||||
(let ((regexp "[][\C-@-\t\v-*,/:-@\\^`{-\C-?]*\
|
||||
\\(nn[a-z]+\\(?:\\+[^][\C-@-*,/:-@\\^`{-\C-?]+\\)?:\
|
||||
@ -2160,41 +2144,25 @@ be permanent."
|
||||
require-match initial-input hist
|
||||
def)
|
||||
"Read a group name with completion.
|
||||
Non-ASCII group names are allowed. The arguments are the same as
|
||||
`completing-read' except that COLLECTION and HIST default to
|
||||
`gnus-active-hashtb' and `gnus-group-history' respectively if
|
||||
they are omitted. Can handle COLLECTION as a list, hash table,
|
||||
or vector."
|
||||
The arguments are the same as `completing-read' except that
|
||||
COLLECTION and HIST default to `gnus-active-hashtb' and
|
||||
`gnus-group-history' respectively if they are omitted. Can
|
||||
handle COLLECTION as a list, hash table, or vector."
|
||||
;; This function handles vectors for backwards compatibility. In
|
||||
;; theory, `collection' will only ever be a list or a hash table.
|
||||
(or collection (setq collection gnus-active-hashtb))
|
||||
(let* ((choices
|
||||
(mapcar
|
||||
(lambda (g)
|
||||
(if (string-match "[^\000-\177]" g)
|
||||
(gnus-group-decoded-name g)
|
||||
g))
|
||||
(cond ((listp collection)
|
||||
collection)
|
||||
((vectorp collection)
|
||||
(mapatoms #'symbol-name collection))
|
||||
((hash-table-p collection)
|
||||
(hash-table-keys collection)))))
|
||||
(hash-table-keys collection))))
|
||||
(group
|
||||
(gnus-completing-read (or prompt "Group") (reverse choices)
|
||||
require-match initial-input
|
||||
(or hist 'gnus-group-history)
|
||||
def)))
|
||||
(unless (cond ((and (listp collection)
|
||||
(symbolp (car collection)))
|
||||
(member group (mapcar 'symbol-name collection)))
|
||||
((listp collection)
|
||||
(member group collection))
|
||||
((vectorp collection)
|
||||
(symbol-value (intern-soft group collection)))
|
||||
((hash-table-p collection)
|
||||
(gethash group collection)))
|
||||
(setq group
|
||||
(encode-coding-string
|
||||
group (gnus-group-name-charset nil group))))
|
||||
(replace-regexp-in-string "\n" "" group)))
|
||||
|
||||
;;;###autoload
|
||||
@ -2755,13 +2723,13 @@ The user will be prompted for GROUP."
|
||||
(interactive (list (gnus-group-completing-read)))
|
||||
(gnus-group-make-group (gnus-group-real-name group)
|
||||
(gnus-group-server group)
|
||||
nil nil t))
|
||||
nil nil))
|
||||
|
||||
(defun gnus-group-make-group (name &optional method address args encoded)
|
||||
(defun gnus-group-make-group (name &optional method address args)
|
||||
"Add a new newsgroup.
|
||||
The user will be prompted for a NAME, for a select METHOD, and an
|
||||
ADDRESS. NAME should be a human-readable string (i.e., not be encoded
|
||||
even if it contains non-ASCII characters) unless ENCODED is non-nil.
|
||||
even if it contains non-ASCII characters).
|
||||
|
||||
If the backend supports it, the group will also be created on the
|
||||
server."
|
||||
@ -2772,10 +2740,6 @@ server."
|
||||
|
||||
(when (stringp method)
|
||||
(setq method (or (gnus-server-to-method method) method)))
|
||||
(unless encoded
|
||||
(setq name (encode-coding-string
|
||||
name
|
||||
(gnus-group-name-charset method name))))
|
||||
(let* ((meth (gnus-method-simplify
|
||||
(when (and method
|
||||
(not (gnus-server-equal method gnus-select-method)))
|
||||
@ -2784,7 +2748,7 @@ server."
|
||||
(nname (if method (gnus-group-prefixed-name name meth) name))
|
||||
backend info)
|
||||
(when (gnus-group-entry nname)
|
||||
(error "Group %s already exists" (gnus-group-decoded-name nname)))
|
||||
(error "Group %s already exists" nname))
|
||||
;; Subscribe to the new group.
|
||||
(gnus-group-change-level
|
||||
(setq info (list t nname gnus-level-default-subscribed nil nil meth))
|
||||
@ -2860,20 +2824,19 @@ be removed from the server, even when it's empty."
|
||||
(unless (gnus-check-backend-function 'request-delete-group group)
|
||||
(error "This back end does not support group deletion"))
|
||||
(prog1
|
||||
(let ((group-decoded (gnus-group-decoded-name group)))
|
||||
(when (or no-prompt
|
||||
(gnus-yes-or-no-p
|
||||
(format
|
||||
"Do you really want to delete %s%s? "
|
||||
group-decoded (if force " and all its contents" ""))))
|
||||
(gnus-message 6 "Deleting group %s..." group-decoded)
|
||||
(if (not (gnus-request-delete-group group force))
|
||||
(gnus-error 3 "Couldn't delete group %s" group-decoded)
|
||||
(gnus-message 6 "Deleting group %s...done" group-decoded)
|
||||
(gnus-group-goto-group group)
|
||||
(gnus-group-kill-group 1 t)
|
||||
(gnus-set-active group nil)
|
||||
t)))
|
||||
(when (or no-prompt
|
||||
(gnus-yes-or-no-p
|
||||
(format
|
||||
"Do you really want to delete %s%s? "
|
||||
group (if force " and all its contents" ""))))
|
||||
(gnus-message 6 "Deleting group %s..." group)
|
||||
(if (not (gnus-request-delete-group group force))
|
||||
(gnus-error 3 "Couldn't delete group %s" group)
|
||||
(gnus-message 6 "Deleting group %s...done" group)
|
||||
(gnus-group-goto-group group)
|
||||
(gnus-group-kill-group 1 t)
|
||||
(gnus-set-active group nil)
|
||||
t))
|
||||
(gnus-group-position-point)))
|
||||
|
||||
(defun gnus-group-rename-group (group new-name)
|
||||
@ -2887,13 +2850,9 @@ and NEW-NAME will be prompted for."
|
||||
(error "This back end does not support renaming groups"))
|
||||
(setq new-name (gnus-read-group
|
||||
"Rename group to: "
|
||||
(gnus-group-real-name (gnus-group-decoded-name group)))
|
||||
(gnus-group-real-name group))
|
||||
method (gnus-info-method (gnus-get-info group)))
|
||||
(list group (encode-coding-string
|
||||
new-name
|
||||
(gnus-group-name-charset
|
||||
method
|
||||
(gnus-group-prefixed-name new-name method))))))
|
||||
(list group (gnus-group-prefixed-name new-name method))))
|
||||
|
||||
(unless (gnus-check-backend-function 'request-rename-group group)
|
||||
(error "This back end does not support renaming groups"))
|
||||
@ -2912,34 +2871,30 @@ and NEW-NAME will be prompted for."
|
||||
(gnus-group-real-name new-name)
|
||||
(gnus-info-method (gnus-get-info group)))))
|
||||
|
||||
(let ((decoded-group (gnus-group-decoded-name group))
|
||||
(decoded-new-name (gnus-group-decoded-name new-name)))
|
||||
(when (gnus-active new-name)
|
||||
(error "The group %s already exists" decoded-new-name))
|
||||
(when (gnus-active new-name)
|
||||
(error "The group %s already exists" new-name))
|
||||
|
||||
(gnus-message 6 "Renaming group %s to %s..."
|
||||
decoded-group decoded-new-name)
|
||||
(prog1
|
||||
(if (progn
|
||||
(gnus-group-goto-group group)
|
||||
(not (when (< (gnus-group-group-level) gnus-level-zombie)
|
||||
(gnus-request-rename-group group new-name))))
|
||||
(gnus-error 3 "Couldn't rename group %s to %s"
|
||||
decoded-group decoded-new-name)
|
||||
;; We rename the group internally by killing it...
|
||||
(gnus-group-kill-group)
|
||||
;; ... changing its name ...
|
||||
(setcar (cdar gnus-list-of-killed-groups) new-name)
|
||||
;; ... and then yanking it. Magic!
|
||||
(gnus-group-yank-group)
|
||||
(gnus-set-active new-name (gnus-active group))
|
||||
(gnus-message 6 "Renaming group %s to %s...done"
|
||||
decoded-group decoded-new-name)
|
||||
new-name)
|
||||
(setq gnus-killed-list (delete group gnus-killed-list))
|
||||
(gnus-set-active group nil)
|
||||
(gnus-dribble-touch)
|
||||
(gnus-group-position-point))))
|
||||
(gnus-message 6 "Renaming group %s to %s..." group new-name)
|
||||
(prog1
|
||||
(if (progn
|
||||
(gnus-group-goto-group group)
|
||||
(not (when (< (gnus-group-group-level) gnus-level-zombie)
|
||||
(gnus-request-rename-group group new-name))))
|
||||
(gnus-error 3 "Couldn't rename group %s to %s"
|
||||
group new-name)
|
||||
;; We rename the group internally by killing it...
|
||||
(gnus-group-kill-group)
|
||||
;; ... changing its name ...
|
||||
(setcar (cdar gnus-list-of-killed-groups) new-name)
|
||||
;; ... and then yanking it. Magic!
|
||||
(gnus-group-yank-group)
|
||||
(gnus-set-active new-name (gnus-active group))
|
||||
(gnus-message 6 "Renaming group %s to %s...done" group new-name)
|
||||
new-name)
|
||||
(setq gnus-killed-list (delete group gnus-killed-list))
|
||||
(gnus-set-active group nil)
|
||||
(gnus-dribble-touch)
|
||||
(gnus-group-position-point)))
|
||||
|
||||
(defun gnus-group-edit-group (group &optional part)
|
||||
"Edit the group on the current line."
|
||||
@ -2966,7 +2921,7 @@ and NEW-NAME will be prompted for."
|
||||
((eq part 'method) "select method")
|
||||
((eq part 'params) "group parameters")
|
||||
(t "group info"))
|
||||
(gnus-group-decoded-name group))
|
||||
group)
|
||||
`(lambda (form)
|
||||
(gnus-group-edit-group-done ',part ,group form)))
|
||||
(local-set-key
|
||||
@ -3105,8 +3060,7 @@ If called with a prefix argument, ask for the file type."
|
||||
(coding (gnus-group-name-charset method name)))
|
||||
(setcar (cdr method) (encode-coding-string file coding))
|
||||
(gnus-group-make-group
|
||||
(encode-coding-string (gnus-group-real-name name) coding)
|
||||
method nil nil t)))
|
||||
(gnus-group-real-name name) method nil nil)))
|
||||
|
||||
(defvar nnweb-type-definition)
|
||||
(defvar gnus-group-web-type-history nil)
|
||||
@ -3611,7 +3565,7 @@ up is returned."
|
||||
"Do you really want to mark all articles in %s as read? "
|
||||
"Mark all unread articles in %s as read? ")
|
||||
(if (= (length groups) 1)
|
||||
(gnus-group-decoded-name (car groups))
|
||||
(car groups)
|
||||
(format "these %d groups" (length groups)))))))
|
||||
n
|
||||
(while (setq group (pop groups))
|
||||
@ -3696,8 +3650,7 @@ Uses the process/prefix convention."
|
||||
|
||||
(defun gnus-group-expire-articles-1 (group)
|
||||
(when (gnus-check-backend-function 'request-expire-articles group)
|
||||
(gnus-message 6 "Expiring articles in %s..."
|
||||
(gnus-group-decoded-name group))
|
||||
(gnus-message 6 "Expiring articles in %s..." group)
|
||||
(let* ((info (gnus-get-info group))
|
||||
(expirable (if (gnus-group-total-expirable-p group)
|
||||
(cons nil (gnus-list-of-read-articles group))
|
||||
@ -3724,8 +3677,7 @@ Uses the process/prefix convention."
|
||||
;; Just expire using the normal expiry values.
|
||||
(gnus-request-expire-articles articles-to-expire group))))
|
||||
(gnus-close-group group))
|
||||
(gnus-message 6 "Expiring articles in %s...done"
|
||||
(gnus-group-decoded-name group))
|
||||
(gnus-message 6 "Expiring articles in %s...done" group)
|
||||
;; Return the list of un-expired articles.
|
||||
(cdr expirable))))
|
||||
|
||||
@ -3762,7 +3714,7 @@ Uses the process/prefix convention."
|
||||
(dolist (group (gnus-group-process-prefix n))
|
||||
(gnus-group-remove-mark group)
|
||||
(gnus-message 6 "Changed level of %s from %d to %d"
|
||||
(gnus-group-decoded-name group)
|
||||
group
|
||||
(or (gnus-group-group-level) gnus-level-killed)
|
||||
level)
|
||||
(gnus-group-change-level
|
||||
@ -3909,7 +3861,7 @@ of groups killed."
|
||||
;; `gnus-newsrc-hashtb', this check will always return nil.
|
||||
(when (numberp (gnus-group-unread group))
|
||||
(gnus-request-update-group-status group 'unsubscribe))
|
||||
(message "Killed group %s" (gnus-group-decoded-name group)))
|
||||
(message "Killed group %s" group))
|
||||
;; If there are lots and lots of groups to be killed, we use
|
||||
;; this thing instead.
|
||||
(dolist (group (nreverse groups))
|
||||
@ -4047,7 +3999,7 @@ entail asking the server for the groups."
|
||||
(add-text-properties
|
||||
(point) (prog1 (1+ (point))
|
||||
(insert " *: "
|
||||
(gnus-group-decoded-name group)
|
||||
group
|
||||
"\n"))
|
||||
(list 'gnus-group group
|
||||
'gnus-unread t
|
||||
@ -4494,9 +4446,9 @@ and the second element is the address."
|
||||
(prin1-to-string (car method)))
|
||||
(and (consp method)
|
||||
(nth 1 (gnus-info-method info)))
|
||||
nil t)
|
||||
nil)
|
||||
;; It's a native group.
|
||||
(gnus-group-make-group (gnus-info-group info) nil nil nil t)))
|
||||
(gnus-group-make-group (gnus-info-group info) nil nil nil)))
|
||||
(gnus-message 6 "Note: New group created")
|
||||
(setq entry
|
||||
(gnus-group-entry (gnus-group-prefixed-name
|
||||
@ -4685,7 +4637,7 @@ This command may read the active file."
|
||||
(while (setq point (text-property-not-all (point) (point-max)
|
||||
'gnus-group nil))
|
||||
(goto-char point)
|
||||
(push (symbol-name (get-text-property point 'gnus-group)) groups)
|
||||
(push (get-text-property point 'gnus-group) groups)
|
||||
(forward-char 1))
|
||||
groups))
|
||||
|
||||
@ -4776,21 +4728,20 @@ Note: currently only implemented in nnml."
|
||||
(error "No group to compact"))
|
||||
(unless (gnus-check-backend-function 'request-compact-group group)
|
||||
(error "This back end does not support group compaction"))
|
||||
(let ((group-decoded (gnus-group-decoded-name group)))
|
||||
(gnus-message 6 "\
|
||||
(gnus-message 6 "\
|
||||
Compacting group %s... (this may take a long time)"
|
||||
group-decoded)
|
||||
(prog1
|
||||
(if (not (gnus-request-compact-group group))
|
||||
(gnus-error 3 "Couldn't compact group %s" group-decoded)
|
||||
(gnus-message 6 "Compacting group %s...done" group-decoded)
|
||||
t)
|
||||
;; Invalidate the "original article" buffer which might be out of date.
|
||||
;; #### NOTE: Yes, this might be a bit rude, but since compaction
|
||||
;; #### will not happen very often, I think this is acceptable.
|
||||
(gnus-kill-buffer gnus-original-article-buffer)
|
||||
;; Update the group line to reflect new information (art number etc).
|
||||
(gnus-group-update-group-line))))
|
||||
group)
|
||||
(prog1
|
||||
(if (not (gnus-request-compact-group group))
|
||||
(gnus-error 3 "Couldn't compact group %s" group)
|
||||
(gnus-message 6 "Compacting group %s...done" group)
|
||||
t)
|
||||
;; Invalidate the "original article" buffer which might be out of date.
|
||||
;; #### NOTE: Yes, this might be a bit rude, but since compaction
|
||||
;; #### will not happen very often, I think this is acceptable.
|
||||
(gnus-kill-buffer gnus-original-article-buffer)
|
||||
;; Update the group line to reflect new information (art number etc).
|
||||
(gnus-group-update-group-line)))
|
||||
|
||||
(provide 'gnus-group)
|
||||
|
||||
|
||||
@ -391,7 +391,7 @@ only affect the Gcc copy, but not the original message."
|
||||
(defun gnus-inews-make-draft (articles)
|
||||
`(lambda ()
|
||||
(gnus-inews-make-draft-meta-information
|
||||
,(gnus-group-decoded-name gnus-newsgroup-name) ',articles)))
|
||||
,gnus-newsgroup-name ',articles)))
|
||||
|
||||
(autoload 'nnir-article-number "nnir" nil nil 'macro)
|
||||
(autoload 'nnir-article-group "nnir" nil nil 'macro)
|
||||
@ -1680,7 +1680,6 @@ this is a reply."
|
||||
(defun gnus-inews-insert-gcc (&optional group)
|
||||
"Insert the Gcc to say where the article is to be archived."
|
||||
(let* ((group (or group gnus-newsgroup-name))
|
||||
(group (when group (gnus-group-decoded-name group)))
|
||||
(var (or gnus-outgoing-message-group gnus-message-archive-group))
|
||||
(gcc-self-val
|
||||
(and group (not (gnus-virtual-group-p group))
|
||||
|
||||
@ -784,11 +784,13 @@ claim them."
|
||||
(while (not (eobp))
|
||||
(ignore-errors
|
||||
(push (cons
|
||||
(buffer-substring
|
||||
(point)
|
||||
(progn
|
||||
(skip-chars-forward "^ \t")
|
||||
(point)))
|
||||
(decode-coding-string
|
||||
(buffer-substring
|
||||
(point)
|
||||
(progn
|
||||
(skip-chars-forward "^ \t")
|
||||
(point)))
|
||||
'utf-8-emacs)
|
||||
(let ((last (read cur)))
|
||||
(cons (read cur) last)))
|
||||
groups))
|
||||
@ -796,18 +798,20 @@ claim them."
|
||||
(while (not (eobp))
|
||||
(ignore-errors
|
||||
(push (cons
|
||||
(if (eq (char-after) ?\")
|
||||
(read cur)
|
||||
(let ((p (point)) (name ""))
|
||||
(skip-chars-forward "^ \t\\\\")
|
||||
(setq name (buffer-substring p (point)))
|
||||
(while (eq (char-after) ?\\)
|
||||
(setq p (1+ (point)))
|
||||
(forward-char 2)
|
||||
(skip-chars-forward "^ \t\\\\")
|
||||
(setq name (concat name (buffer-substring
|
||||
p (point)))))
|
||||
name))
|
||||
(decode-coding-string
|
||||
(if (eq (char-after) ?\")
|
||||
(read cur)
|
||||
(let ((p (point)) (name ""))
|
||||
(skip-chars-forward "^ \t\\\\")
|
||||
(setq name (buffer-substring p (point)))
|
||||
(while (eq (char-after) ?\\)
|
||||
(setq p (1+ (point)))
|
||||
(forward-char 2)
|
||||
(skip-chars-forward "^ \t\\\\")
|
||||
(setq name (concat name (buffer-substring
|
||||
p (point)))))
|
||||
name))
|
||||
'utf-8-emacs)
|
||||
(let ((last (read cur)))
|
||||
(cons (read cur) last)))
|
||||
groups))
|
||||
@ -859,12 +863,7 @@ claim them."
|
||||
((= level gnus-level-zombie) ?Z)
|
||||
(t ?K)))
|
||||
(max 0 (- (1+ (cddr group)) (cadr group)))
|
||||
;; Don't decode if name is ASCII
|
||||
(if (eq (detect-coding-string name t) 'undecided)
|
||||
name
|
||||
(decode-coding-string
|
||||
name
|
||||
(inline (gnus-group-name-charset method name)))))))
|
||||
name)))
|
||||
(list 'gnus-group name)
|
||||
)))
|
||||
(switch-to-buffer (current-buffer)))
|
||||
|
||||
@ -35,6 +35,7 @@
|
||||
(autoload 'gnus-agent-read-servers-validate "gnus-agent")
|
||||
(autoload 'gnus-agent-save-local "gnus-agent")
|
||||
(autoload 'gnus-agent-possibly-alter-active "gnus-agent")
|
||||
(declare-function gnus-group-decoded-name "gnus-group" (string))
|
||||
|
||||
(eval-when-compile (require 'cl-lib))
|
||||
|
||||
@ -1828,17 +1829,22 @@ The info element is shared with the same element of
|
||||
(if (setq rest (member method methods))
|
||||
(gnus-info-set-method info (car rest))
|
||||
(push method methods)))
|
||||
;; Check for encoded group names and decode them.
|
||||
(when (string-match-p "[^[:ascii:]]" (setq gname (car info)))
|
||||
(let ((decoded (gnus-group-decoded-name gname)))
|
||||
(setf gname decoded
|
||||
(car info) decoded)))
|
||||
;; Check for duplicates.
|
||||
(if (gethash (car info) gnus-newsrc-hashtb)
|
||||
(if (gethash gname gnus-newsrc-hashtb)
|
||||
;; Remove this entry from the alist.
|
||||
(setcdr alist (cddr alist))
|
||||
(puthash
|
||||
(car info)
|
||||
gname
|
||||
;; Preserve number of unread articles in groups.
|
||||
(list (and ohashtb (car (gethash (car info) ohashtb)))
|
||||
(list (and ohashtb (car (gethash gname ohashtb)))
|
||||
info)
|
||||
gnus-newsrc-hashtb)
|
||||
(push (car info) gnus-group-list))
|
||||
(push gname gnus-group-list))
|
||||
(setq alist (cdr alist)))
|
||||
(setq gnus-group-list (nreverse gnus-group-list))
|
||||
;; Make the same select-methods in `gnus-server-alist' identical
|
||||
@ -2144,9 +2150,7 @@ The info element is shared with the same element of
|
||||
(cond ((numberp group)
|
||||
(number-to-string group))
|
||||
((symbolp group)
|
||||
(encode-coding-string
|
||||
(symbol-name group)
|
||||
'latin-1))
|
||||
(symbol-name group))
|
||||
((stringp group)
|
||||
group)))))
|
||||
(numberp (setq max (read cur)))
|
||||
@ -2155,7 +2159,11 @@ The info element is shared with the same element of
|
||||
(skip-chars-forward " \t")
|
||||
(memq (char-after)
|
||||
'(?= ?x ?j)))))
|
||||
(progn (puthash group (cons min max) hashtb)
|
||||
(progn (when (string-match-p "[^[:ascii:]]" group)
|
||||
;; NNTP servers may give us encoded group
|
||||
;; names.
|
||||
(setq group (gnus-group-decoded-name group)))
|
||||
(puthash group (cons min max) hashtb)
|
||||
;; If group is moderated, stick it in the
|
||||
;; moderation cache.
|
||||
(when (eq (char-after) ?m)
|
||||
@ -2394,6 +2402,17 @@ If FORCE is non-nil, the .newsrc file is read."
|
||||
(when gnus-newsrc-assoc
|
||||
(setq gnus-newsrc-alist gnus-newsrc-assoc))))
|
||||
(gnus-make-hashtable-from-newsrc-alist)
|
||||
(when gnus-topic-alist
|
||||
(setq gnus-topic-alist
|
||||
(mapcar
|
||||
(lambda (elt)
|
||||
(cons (car elt)
|
||||
(mapcar (lambda (g)
|
||||
(if (string-match-p "[^[:ascii:]]" g)
|
||||
(gnus-group-decoded-name g)
|
||||
g))
|
||||
(cdr elt))))
|
||||
gnus-topic-alist)))
|
||||
(when (file-newer-than-file-p file ding-file)
|
||||
;; Old format quick file
|
||||
(gnus-message 5 "Reading %s..." file)
|
||||
@ -2492,7 +2511,9 @@ If FORCE is non-nil, the .newsrc file is read."
|
||||
(read buf))
|
||||
group (if (numberp group)
|
||||
(number-to-string group)
|
||||
(symbol-name group)))
|
||||
;; newsrc files are written as 'raw-text.
|
||||
(decode-coding-string
|
||||
(symbol-name group) 'raw-text)))
|
||||
(widen)
|
||||
(cond
|
||||
;; It's possible that "group" is actually an options line.
|
||||
@ -2911,10 +2932,6 @@ SPECIFIC-VARIABLES, or those in `gnus-variable-list'."
|
||||
(setq default-directory (file-name-directory buffer-file-name))
|
||||
(buffer-disable-undo)
|
||||
(erase-buffer)
|
||||
;; Use a unibyte buffer since group names are unibyte strings;
|
||||
;; in particular, non-ASCII group names are the ones encoded by
|
||||
;; a certain coding system.
|
||||
(mm-disable-multibyte)
|
||||
;; Write options.
|
||||
(when gnus-newsrc-options
|
||||
(insert gnus-newsrc-options))
|
||||
|
||||
@ -3500,8 +3500,7 @@ value of GROUP, and puts the buffer in `gnus-summary-mode'.
|
||||
|
||||
Returns non-nil if the setup was successful."
|
||||
(let ((buffer (gnus-summary-buffer-name group))
|
||||
(dead-name (concat "*Dead Summary "
|
||||
(gnus-group-decoded-name group) "*")))
|
||||
(dead-name (concat "*Dead Summary " group "*")))
|
||||
;; If a dead summary buffer exists, we kill it.
|
||||
(gnus-kill-buffer dead-name)
|
||||
(if (get-buffer buffer)
|
||||
@ -3984,8 +3983,7 @@ If SELECT-ARTICLES, only select those articles from GROUP."
|
||||
;; (when (and (not (gnus-group-native-p group))
|
||||
;; (not (gethash group gnus-newsrc-hashtb)))
|
||||
;; (error "Dead non-native groups can't be entered"))
|
||||
(gnus-message 7 "Retrieving newsgroup: %s..."
|
||||
(gnus-group-decoded-name group))
|
||||
(gnus-message 7 "Retrieving newsgroup: %s..." group)
|
||||
(let* ((new-group (gnus-summary-setup-buffer group))
|
||||
(quit-config (gnus-group-quit-config group))
|
||||
(did-select (and new-group (gnus-select-newsgroup
|
||||
@ -4016,8 +4014,7 @@ If SELECT-ARTICLES, only select those articles from GROUP."
|
||||
(gnus-group-next-unread-group 1))
|
||||
(gnus-handle-ephemeral-exit quit-config)))
|
||||
(if (null (gnus-list-of-unread-articles group))
|
||||
(gnus-message 3 "Group %s contains no messages"
|
||||
(gnus-group-decoded-name group))
|
||||
(gnus-message 3 "Group %s contains no messages" group)
|
||||
(gnus-message 3 "Can't select group"))
|
||||
nil)
|
||||
;; The user did a `C-g' while prompting for number of articles,
|
||||
@ -5618,25 +5615,24 @@ or a straight list of headers."
|
||||
|
||||
(defun gnus-fetch-headers (articles &optional limit force-new dependencies)
|
||||
"Fetch headers of ARTICLES."
|
||||
(let ((name (gnus-group-decoded-name gnus-newsgroup-name)))
|
||||
(gnus-message 7 "Fetching headers for %s..." name)
|
||||
(prog1
|
||||
(if (eq 'nov
|
||||
(setq gnus-headers-retrieved-by
|
||||
(gnus-retrieve-headers
|
||||
articles gnus-newsgroup-name
|
||||
(or limit
|
||||
;; We might want to fetch old headers, but
|
||||
;; not if there is only 1 article.
|
||||
(and (or (and
|
||||
(not (eq gnus-fetch-old-headers 'some))
|
||||
(not (numberp gnus-fetch-old-headers)))
|
||||
(> (length articles) 1))
|
||||
gnus-fetch-old-headers)))))
|
||||
(gnus-get-newsgroup-headers-xover
|
||||
articles force-new dependencies gnus-newsgroup-name t)
|
||||
(gnus-get-newsgroup-headers dependencies force-new))
|
||||
(gnus-message 7 "Fetching headers for %s...done" name))))
|
||||
(gnus-message 7 "Fetching headers for %s..." gnus-newsgroup-name)
|
||||
(prog1
|
||||
(if (eq 'nov
|
||||
(setq gnus-headers-retrieved-by
|
||||
(gnus-retrieve-headers
|
||||
articles gnus-newsgroup-name
|
||||
(or limit
|
||||
;; We might want to fetch old headers, but
|
||||
;; not if there is only 1 article.
|
||||
(and (or (and
|
||||
(not (eq gnus-fetch-old-headers 'some))
|
||||
(not (numberp gnus-fetch-old-headers)))
|
||||
(> (length articles) 1))
|
||||
gnus-fetch-old-headers)))))
|
||||
(gnus-get-newsgroup-headers-xover
|
||||
articles force-new dependencies gnus-newsgroup-name t)
|
||||
(gnus-get-newsgroup-headers dependencies force-new))
|
||||
(gnus-message 7 "Fetching headers for %s...done" gnus-newsgroup-name)))
|
||||
|
||||
(defun gnus-select-newsgroup (group &optional read-all select-articles)
|
||||
"Select newsgroup GROUP.
|
||||
@ -5649,13 +5645,12 @@ If SELECT-ARTICLES, only select those articles from GROUP."
|
||||
t
|
||||
gnus-summary-ignore-duplicates))
|
||||
(info (nth 1 entry))
|
||||
charset articles fetched-articles cached)
|
||||
articles fetched-articles cached)
|
||||
|
||||
(unless (gnus-check-server
|
||||
(set (make-local-variable 'gnus-current-select-method)
|
||||
(gnus-find-method-for-group group)))
|
||||
(error "Couldn't open server"))
|
||||
(setq charset (gnus-group-name-charset gnus-current-select-method group))
|
||||
|
||||
(or (and entry (not (eq (car entry) t))) ; Either it's active...
|
||||
(gnus-activate-group group) ; Or we can activate it...
|
||||
@ -5663,16 +5658,12 @@ If SELECT-ARTICLES, only select those articles from GROUP."
|
||||
(when (derived-mode-p 'gnus-summary-mode)
|
||||
(gnus-kill-buffer (current-buffer)))
|
||||
(error
|
||||
"Couldn't activate group %s: %s"
|
||||
(decode-coding-string group charset)
|
||||
(decode-coding-string (gnus-status-message group) charset))))
|
||||
"Couldn't activate group %s: %s" group (gnus-status-message group))))
|
||||
|
||||
(unless (gnus-request-group group t nil info)
|
||||
(when (derived-mode-p 'gnus-summary-mode)
|
||||
(gnus-kill-buffer (current-buffer)))
|
||||
(error "Couldn't request group %s: %s"
|
||||
(decode-coding-string group charset)
|
||||
(decode-coding-string (gnus-status-message group) charset)))
|
||||
(error "Couldn't request group %s: %s" group (gnus-status-message group)))
|
||||
|
||||
(when (and gnus-agent
|
||||
(gnus-active group))
|
||||
@ -5938,13 +5929,11 @@ If SELECT-ARTICLES, only select those articles from GROUP."
|
||||
(if only-read-p
|
||||
(format
|
||||
"How many articles from %s (available %d, default %d): "
|
||||
(gnus-group-real-name
|
||||
(gnus-group-decoded-name gnus-newsgroup-name))
|
||||
(gnus-group-real-name gnus-newsgroup-name)
|
||||
number default)
|
||||
(format
|
||||
"How many articles from %s (%d default): "
|
||||
(gnus-group-real-name
|
||||
(gnus-group-decoded-name gnus-newsgroup-name))
|
||||
(gnus-group-real-name gnus-newsgroup-name)
|
||||
default))
|
||||
nil
|
||||
nil
|
||||
@ -5956,8 +5945,7 @@ If SELECT-ARTICLES, only select those articles from GROUP."
|
||||
(read-string
|
||||
(format "%s %s (%d scored, %d total): "
|
||||
"How many articles from"
|
||||
(gnus-group-decoded-name
|
||||
(gnus-group-real-name gnus-newsgroup-name))
|
||||
(gnus-group-real-name gnus-newsgroup-name)
|
||||
scored number))))
|
||||
(if (string-match "^[ \t]*$" input)
|
||||
number input)))
|
||||
@ -6199,8 +6187,7 @@ If WHERE is `summary', the summary mode line format will be used."
|
||||
(intern
|
||||
(format "gnus-%s-mode-line-format-spec" where))))
|
||||
(gnus-tmp-group-name (gnus-mode-string-quote
|
||||
(gnus-group-decoded-name
|
||||
gnus-newsgroup-name)))
|
||||
gnus-newsgroup-name))
|
||||
(gnus-tmp-article-number (or gnus-current-article 0))
|
||||
(gnus-tmp-unread gnus-newsgroup-unreads)
|
||||
(gnus-tmp-unread-and-unticked (length gnus-newsgroup-unreads))
|
||||
@ -7921,11 +7908,11 @@ If BACKWARD, the previous article is selected instead of the next."
|
||||
(not (gnus-ephemeral-group-p gnus-newsgroup-name)))
|
||||
(format " (Type %s for %s [%s])"
|
||||
(single-key-description cmd)
|
||||
(gnus-group-decoded-name group)
|
||||
group
|
||||
(gnus-group-unread group))
|
||||
(format " (Type %s to exit %s)"
|
||||
(single-key-description cmd)
|
||||
(gnus-group-decoded-name gnus-newsgroup-name)))))
|
||||
gnus-newsgroup-name))))
|
||||
;; Confirm auto selection.
|
||||
(setq key (car (setq keve (gnus-read-event-char prompt)))
|
||||
ended t)
|
||||
@ -10110,7 +10097,7 @@ ACTION can be either `move' (the default), `crosspost' or `copy'."
|
||||
(copy-buf (save-excursion
|
||||
(nnheader-set-temp-buffer " *copy article*")))
|
||||
art-group to-method new-xref article to-groups
|
||||
articles-to-update-marks encoded)
|
||||
articles-to-update-marks)
|
||||
(unless (assq action names)
|
||||
(error "Unknown action %s" action))
|
||||
;; Read the newsgroup name.
|
||||
@ -10132,22 +10119,12 @@ ACTION can be either `move' (the default), `crosspost' or `copy'."
|
||||
(symbol-value
|
||||
(intern (format "gnus-current-%s-group" action)))
|
||||
articles prefix)
|
||||
encoded to-newsgroup
|
||||
to-method (gnus-server-to-method (gnus-group-method to-newsgroup)))
|
||||
(set (intern (format "gnus-current-%s-group" action))
|
||||
(decode-coding-string
|
||||
to-newsgroup
|
||||
(gnus-group-name-charset to-method to-newsgroup))))
|
||||
(set (intern (format "gnus-current-%s-group" action)) to-newsgroup))
|
||||
(unless to-method
|
||||
(setq to-method (or select-method
|
||||
(gnus-server-to-method
|
||||
(gnus-group-method to-newsgroup)))))
|
||||
(setq to-newsgroup
|
||||
(or encoded
|
||||
(and to-newsgroup
|
||||
(encode-coding-string
|
||||
to-newsgroup
|
||||
(gnus-group-name-charset to-method to-newsgroup)))))
|
||||
;; Check the method we are to move this article to...
|
||||
(unless (gnus-check-backend-function
|
||||
'request-accept-article (car to-method))
|
||||
@ -10157,7 +10134,7 @@ ACTION can be either `move' (the default), `crosspost' or `copy'."
|
||||
(gnus-message 6 "%s to %s: %s..."
|
||||
(caddr (assq action names))
|
||||
(or (car select-method)
|
||||
(gnus-group-decoded-name to-newsgroup))
|
||||
to-newsgroup)
|
||||
articles)
|
||||
;; This `while' is not equivalent to a `dolist' (bug#33653#134).
|
||||
(while articles
|
||||
@ -12469,27 +12446,23 @@ save those articles instead."
|
||||
(t
|
||||
(gnus-completing-read
|
||||
prom (nreverse split-name) nil nil 'gnus-group-history))))
|
||||
(to-method (gnus-server-to-method (gnus-group-method to-newsgroup)))
|
||||
encoded)
|
||||
(to-method (gnus-server-to-method (gnus-group-method to-newsgroup))))
|
||||
(when to-newsgroup
|
||||
(if (or (string= to-newsgroup "")
|
||||
(string= to-newsgroup prefix))
|
||||
(setq to-newsgroup default))
|
||||
(unless to-newsgroup
|
||||
(user-error "No group name entered"))
|
||||
(setq encoded (encode-coding-string
|
||||
to-newsgroup
|
||||
(gnus-group-name-charset to-method to-newsgroup)))
|
||||
(or (gnus-active encoded)
|
||||
(gnus-activate-group encoded nil nil to-method)
|
||||
(error "No group name entered"))
|
||||
(or (gnus-active to-newsgroup)
|
||||
(gnus-activate-group to-newsgroup nil nil to-method)
|
||||
(if (gnus-y-or-n-p (format "No such group: %s. Create it? "
|
||||
to-newsgroup))
|
||||
(or (and (gnus-request-create-group encoded to-method)
|
||||
(gnus-activate-group encoded nil nil to-method)
|
||||
(gnus-subscribe-group encoded))
|
||||
(or (and (gnus-request-create-group to-newsgroup to-method)
|
||||
(gnus-activate-group to-newsgroup nil nil to-method)
|
||||
(gnus-subscribe-group to-newsgroup))
|
||||
(error "Couldn't create group %s" to-newsgroup)))
|
||||
(user-error "No such group: %s" to-newsgroup))
|
||||
encoded)))
|
||||
(error "No such group: %s" to-newsgroup))
|
||||
to-newsgroup)))
|
||||
|
||||
(defvar gnus-summary-save-parts-counter)
|
||||
(declare-function mm-uu-dissect "mm-uu" (&optional noheader mime-type))
|
||||
@ -13156,7 +13129,7 @@ If ALL is a number, fetch this number of articles."
|
||||
(read-string
|
||||
(format
|
||||
"How many articles from %s (%s %d): "
|
||||
(gnus-group-decoded-name gnus-newsgroup-name)
|
||||
gnus-newsgroup-name
|
||||
(if initial "max" "default")
|
||||
len)
|
||||
nil nil
|
||||
|
||||
@ -1173,16 +1173,9 @@ ARG is passed to the first function."
|
||||
"Return non-nil if all ELEMENTS are non-nil."
|
||||
(not (memq nil elements)))
|
||||
|
||||
;; gnus.el requires mm-util.
|
||||
(declare-function mm-disable-multibyte "mm-util")
|
||||
|
||||
(defun gnus-write-active-file (file hashtb &optional full-names)
|
||||
;; `coding-system-for-write' should be `raw-text' or equivalent.
|
||||
(let ((coding-system-for-write nnmail-active-file-coding-system))
|
||||
(with-temp-file file
|
||||
;; The buffer should be in the unibyte mode because group names
|
||||
;; are ASCII text or encoded non-ASCII text (i.e., unibyte).
|
||||
(mm-disable-multibyte)
|
||||
(maphash
|
||||
(lambda (group active)
|
||||
(when active
|
||||
|
||||
@ -3444,11 +3444,9 @@ server is native)."
|
||||
"Return the prefix of the current group name."
|
||||
(< 0 (length (gnus-group-real-prefix group))))
|
||||
|
||||
(declare-function gnus-group-decoded-name "gnus-group" (string))
|
||||
|
||||
(defun gnus-summary-buffer-name (group)
|
||||
"Return the summary buffer name of GROUP."
|
||||
(concat "*Summary " (gnus-group-decoded-name group) "*"))
|
||||
(concat "*Summary " group "*"))
|
||||
|
||||
(defun gnus-group-method (group)
|
||||
"Return the server or method used for selecting GROUP.
|
||||
|
||||
@ -1894,7 +1894,6 @@ You must have the \"hashcash\" binary installed, see `hashcash-path'."
|
||||
(autoload 'gnus-delay-article "gnus-delay")
|
||||
(autoload 'gnus-extract-address-components "gnus-util")
|
||||
(autoload 'gnus-find-method-for-group "gnus")
|
||||
(autoload 'gnus-group-decoded-name "gnus-group")
|
||||
(autoload 'gnus-group-name-charset "gnus-group")
|
||||
(autoload 'gnus-group-name-decode "gnus-group")
|
||||
(autoload 'gnus-groups-from-server "gnus")
|
||||
@ -5628,7 +5627,7 @@ In posting styles use `(\"Expires\" (make-expires-date 30))'."
|
||||
(concat
|
||||
msg-id (if msg-id " (")
|
||||
(if (car name)
|
||||
(if (string-match "[^\000-\177]" (car name))
|
||||
(if (string-match "[^[:ascii:]]" (car name))
|
||||
;; Quote a string containing non-ASCII characters.
|
||||
;; It will make the RFC2047 encoder cause an error
|
||||
;; if there are special characters.
|
||||
@ -7285,12 +7284,11 @@ news, Source is the list of newsgroups is was posted to."
|
||||
(let* ((group (message-fetch-field "newsgroups"))
|
||||
(from (message-fetch-field "from"))
|
||||
(prefix
|
||||
(if group
|
||||
(gnus-group-decoded-name group)
|
||||
(or (and from (or
|
||||
(car (gnus-extract-address-components from))
|
||||
(cadr (gnus-extract-address-components from))))
|
||||
"(nowhere)"))))
|
||||
(or group
|
||||
(or (and from (or
|
||||
(car (gnus-extract-address-components from))
|
||||
(cadr (gnus-extract-address-components from))))
|
||||
"(nowhere)"))))
|
||||
(concat "["
|
||||
(if message-forward-decoded-p
|
||||
prefix
|
||||
@ -7304,10 +7302,9 @@ Source is the sender, and if the original message was news, Source is
|
||||
the list of newsgroups is was posted to."
|
||||
(let* ((group (message-fetch-field "newsgroups"))
|
||||
(prefix
|
||||
(if group
|
||||
(gnus-group-decoded-name group)
|
||||
(or (message-fetch-field "from")
|
||||
"(nowhere)"))))
|
||||
(or group
|
||||
(or (message-fetch-field "from")
|
||||
"(nowhere)"))))
|
||||
(concat "["
|
||||
(if message-forward-decoded-p
|
||||
prefix
|
||||
|
||||
@ -117,18 +117,17 @@
|
||||
(gnus-request-accept-article "nndraft:queue" nil t t))
|
||||
|
||||
(deffoo nnagent-request-set-mark (group action server)
|
||||
(mm-with-unibyte-buffer
|
||||
(insert "(gnus-agent-synchronize-group-flags \""
|
||||
group
|
||||
"\" '")
|
||||
(gnus-pp action)
|
||||
(insert " \""
|
||||
(gnus-method-to-server gnus-command-method)
|
||||
"\"")
|
||||
(insert ")\n")
|
||||
(let ((coding-system-for-write nnheader-file-coding-system))
|
||||
(write-region (point-min) (point-max) (gnus-agent-lib-file "flags")
|
||||
t 'silent)))
|
||||
(insert "(gnus-agent-synchronize-group-flags \""
|
||||
group
|
||||
"\" '")
|
||||
(gnus-pp action)
|
||||
(insert " \""
|
||||
(gnus-method-to-server gnus-command-method)
|
||||
"\"")
|
||||
(insert ")\n")
|
||||
(let ((coding-system-for-write nnheader-file-coding-system))
|
||||
(write-region (point-min) (point-max) (gnus-agent-lib-file "flags")
|
||||
t 'silent))
|
||||
;; Also set the marks for the original back end that keeps marks in
|
||||
;; the local system.
|
||||
(let ((gnus-agent nil))
|
||||
|
||||
@ -30,7 +30,6 @@
|
||||
|
||||
(defvar nnmail-extra-headers)
|
||||
(defvar gnus-newsgroup-name)
|
||||
(defvar nnheader-file-coding-system)
|
||||
(defvar jka-compr-compression-info-list)
|
||||
|
||||
;; Requiring `gnus-util' at compile time creates a circular
|
||||
@ -499,7 +498,8 @@ the line could be found."
|
||||
|
||||
(defvar nntp-server-buffer nil)
|
||||
(defvar nntp-process-response nil)
|
||||
|
||||
(defvar nnheader-file-coding-system 'undecided
|
||||
"Coding system used in file backends of Gnus.")
|
||||
(defvar nnheader-callback-function nil)
|
||||
|
||||
(defun nnheader-init-server-buffer ()
|
||||
@ -871,9 +871,6 @@ first. Otherwise, find the newest one, though it may take a time."
|
||||
(when (string-match (car ange-ftp-path-format) path)
|
||||
(ange-ftp-re-read-dir path)))))
|
||||
|
||||
(defvar nnheader-file-coding-system 'raw-text
|
||||
"Coding system used in file backends of Gnus.")
|
||||
|
||||
(defun nnheader-insert-file-contents (filename &optional visit beg end replace)
|
||||
"Like `insert-file-contents', q.v., but only reads in the file.
|
||||
A buffer may be modified in several ways after reading into the buffer due
|
||||
|
||||
@ -118,12 +118,6 @@ some servers.")
|
||||
|
||||
(defvoo nnimap-namespace nil)
|
||||
|
||||
(defun nnimap-decode-gnus-group (group)
|
||||
(decode-coding-string group 'utf-8))
|
||||
|
||||
(defun nnimap-encode-gnus-group (group)
|
||||
(encode-coding-string group 'utf-8))
|
||||
|
||||
(defvoo nnimap-fetch-partial-articles nil
|
||||
"If non-nil, Gnus will fetch partial articles.
|
||||
If t, Gnus will fetch only the first part. If a string, it
|
||||
@ -208,8 +202,6 @@ textual parts.")
|
||||
(format "%s" (nreverse params))))
|
||||
|
||||
(deffoo nnimap-retrieve-headers (articles &optional group server _fetch-old)
|
||||
(when group
|
||||
(setq group (nnimap-decode-gnus-group group)))
|
||||
(with-current-buffer nntp-server-buffer
|
||||
(erase-buffer)
|
||||
(when (nnimap-change-group group server)
|
||||
@ -644,8 +636,6 @@ textual parts.")
|
||||
nnimap-status-string)
|
||||
|
||||
(deffoo nnimap-request-article (article &optional group server to-buffer)
|
||||
(when group
|
||||
(setq group (nnimap-decode-gnus-group group)))
|
||||
(with-current-buffer nntp-server-buffer
|
||||
(let ((result (nnimap-change-group group server))
|
||||
parts structure)
|
||||
@ -677,8 +667,6 @@ textual parts.")
|
||||
(cons group article)))))))
|
||||
|
||||
(deffoo nnimap-request-head (article &optional group server to-buffer)
|
||||
(when group
|
||||
(setq group (nnimap-decode-gnus-group group)))
|
||||
(when (nnimap-change-group group server)
|
||||
(with-current-buffer (nnimap-buffer)
|
||||
(when (stringp article)
|
||||
@ -696,8 +684,6 @@ textual parts.")
|
||||
(cons group article)))))))
|
||||
|
||||
(deffoo nnimap-request-articles (articles &optional group server)
|
||||
(when group
|
||||
(setq group (nnimap-decode-gnus-group group)))
|
||||
(with-current-buffer nntp-server-buffer
|
||||
(let ((result (nnimap-change-group group server)))
|
||||
(when result
|
||||
@ -847,7 +833,6 @@ textual parts.")
|
||||
(nreverse parts)))
|
||||
|
||||
(deffoo nnimap-request-group (group &optional server dont-check info)
|
||||
(setq group (nnimap-decode-gnus-group group))
|
||||
(let ((result (nnimap-change-group
|
||||
;; Don't SELECT the group if we're going to select it
|
||||
;; later, anyway.
|
||||
@ -874,11 +859,10 @@ textual parts.")
|
||||
(- (cdr active) (car active))
|
||||
(car active)
|
||||
(cdr active)
|
||||
(nnimap-encode-gnus-group group)))
|
||||
group))
|
||||
t))))
|
||||
|
||||
(deffoo nnimap-request-group-scan (group &optional server info)
|
||||
(setq group (nnimap-decode-gnus-group group))
|
||||
(when (nnimap-change-group nil server)
|
||||
(let (marks high low)
|
||||
(with-current-buffer (nnimap-buffer)
|
||||
@ -910,23 +894,20 @@ textual parts.")
|
||||
(insert
|
||||
(format
|
||||
"211 %d %d %d %S\n" (1+ (- high low)) low high
|
||||
(nnimap-encode-gnus-group group)))
|
||||
group))
|
||||
t))))
|
||||
|
||||
(deffoo nnimap-request-create-group (group &optional server _args)
|
||||
(setq group (nnimap-decode-gnus-group group))
|
||||
(when (nnimap-change-group nil server)
|
||||
(with-current-buffer (nnimap-buffer)
|
||||
(car (nnimap-command "CREATE %S" (nnimap-group-to-imap group))))))
|
||||
|
||||
(deffoo nnimap-request-delete-group (group &optional _force server)
|
||||
(setq group (nnimap-decode-gnus-group group))
|
||||
(when (nnimap-change-group nil server)
|
||||
(with-current-buffer (nnimap-buffer)
|
||||
(car (nnimap-command "DELETE %S" (nnimap-group-to-imap group))))))
|
||||
|
||||
(deffoo nnimap-request-rename-group (group new-name &optional server)
|
||||
(setq group (nnimap-decode-gnus-group group))
|
||||
(when (nnimap-change-group nil server)
|
||||
(with-current-buffer (nnimap-buffer)
|
||||
(nnimap-unselect-group)
|
||||
@ -941,7 +922,6 @@ textual parts.")
|
||||
(nnimap-command "EXAMINE DOES.NOT.EXIST"))
|
||||
|
||||
(deffoo nnimap-request-expunge-group (group &optional server)
|
||||
(setq group (nnimap-decode-gnus-group group))
|
||||
(when (nnimap-change-group group server)
|
||||
(with-current-buffer (nnimap-buffer)
|
||||
(car (nnimap-command "EXPUNGE")))))
|
||||
@ -970,9 +950,6 @@ textual parts.")
|
||||
(deffoo nnimap-request-move-article (article group server accept-form
|
||||
&optional _last
|
||||
internal-move-group)
|
||||
(setq group (nnimap-decode-gnus-group group))
|
||||
(when internal-move-group
|
||||
(setq internal-move-group (nnimap-decode-gnus-group internal-move-group)))
|
||||
(with-temp-buffer
|
||||
(mm-disable-multibyte)
|
||||
(when (funcall (if internal-move-group
|
||||
@ -1006,7 +983,6 @@ textual parts.")
|
||||
result))))))
|
||||
|
||||
(deffoo nnimap-request-expire-articles (articles group &optional server force)
|
||||
(setq group (nnimap-decode-gnus-group group))
|
||||
(cond
|
||||
((null articles)
|
||||
nil)
|
||||
@ -1151,8 +1127,6 @@ If LIMIT, first try to limit the search to the N last articles."
|
||||
"delete this article now"))))))
|
||||
|
||||
(deffoo nnimap-request-scan (&optional group server)
|
||||
(when group
|
||||
(setq group (nnimap-decode-gnus-group group)))
|
||||
(when (and (nnimap-change-group nil server)
|
||||
nnimap-inbox
|
||||
nnimap-split-methods)
|
||||
@ -1171,7 +1145,6 @@ If LIMIT, first try to limit the search to the N last articles."
|
||||
flags))
|
||||
|
||||
(deffoo nnimap-request-update-group-status (group status &optional server)
|
||||
(setq group (nnimap-decode-gnus-group group))
|
||||
(when (nnimap-change-group nil server)
|
||||
(let ((command (assoc
|
||||
status
|
||||
@ -1182,7 +1155,6 @@ If LIMIT, first try to limit the search to the N last articles."
|
||||
(nnimap-command "%s %S" (cadr command) (nnimap-group-to-imap group)))))))
|
||||
|
||||
(deffoo nnimap-request-set-mark (group actions &optional server)
|
||||
(setq group (nnimap-decode-gnus-group group))
|
||||
(when (nnimap-change-group group server)
|
||||
(let (sequence)
|
||||
(with-current-buffer (nnimap-buffer)
|
||||
@ -1217,8 +1189,7 @@ If LIMIT, first try to limit the search to the N last articles."
|
||||
;; that's determined by the IMAP server later. So just
|
||||
;; return the group name.
|
||||
(lambda (group)
|
||||
(list (list group)))))))
|
||||
(setq group (nnimap-decode-gnus-group group))
|
||||
(list (list group)))))))
|
||||
(when (nnimap-change-group nil server)
|
||||
(nnmail-check-syntax)
|
||||
(let ((message-id (message-field-value "message-id"))
|
||||
@ -1296,7 +1267,6 @@ If LIMIT, first try to limit the search to the N last articles."
|
||||
result))
|
||||
|
||||
(deffoo nnimap-request-replace-article (article group buffer)
|
||||
(setq group (nnimap-decode-gnus-group group))
|
||||
(let (group-art)
|
||||
(when (and (nnimap-change-group group)
|
||||
;; Put the article into the group.
|
||||
@ -1380,8 +1350,7 @@ If LIMIT, first try to limit the search to the N last articles."
|
||||
(dolist (response responses)
|
||||
(let* ((sequence (car response))
|
||||
(response (cadr response))
|
||||
(group (cadr (assoc sequence sequences)))
|
||||
(egroup (nnimap-encode-gnus-group group)))
|
||||
(group (cadr (assoc sequence sequences))))
|
||||
(when (and group
|
||||
(equal (caar response) "OK"))
|
||||
(let ((uidnext (nnimap-find-parameter "UIDNEXT" response))
|
||||
@ -1393,14 +1362,14 @@ If LIMIT, first try to limit the search to the N last articles."
|
||||
(setq highest (1- (string-to-number (car uidnext)))))
|
||||
(cond
|
||||
((null highest)
|
||||
(insert (format "%S 0 1 y\n" egroup)))
|
||||
(insert (format "%S 0 1 y\n" group)))
|
||||
((zerop exists)
|
||||
;; Empty group.
|
||||
(insert (format "%S %d %d y\n" egroup
|
||||
(insert (format "%S %d %d y\n" group
|
||||
highest (1+ highest))))
|
||||
(t
|
||||
;; Return the widest possible range.
|
||||
(insert (format "%S %d 1 y\n" egroup
|
||||
(insert (format "%S %d 1 y\n" group
|
||||
(or highest exists)))))))))
|
||||
t)))))
|
||||
|
||||
@ -1412,7 +1381,7 @@ If LIMIT, first try to limit the search to the N last articles."
|
||||
(nnimap-get-groups)))
|
||||
(unless (assoc group nnimap-current-infos)
|
||||
;; Insert dummy numbers here -- they don't matter.
|
||||
(insert (format "%S 0 1 y\n" (nnimap-encode-gnus-group group)))))
|
||||
(insert (format "%S 0 1 y\n" group))))
|
||||
t)))
|
||||
|
||||
(deffoo nnimap-retrieve-group-data-early (server infos)
|
||||
@ -1429,8 +1398,7 @@ If LIMIT, first try to limit the search to the N last articles."
|
||||
;; what and how to request the data.
|
||||
(dolist (info infos)
|
||||
(setq params (gnus-info-params info)
|
||||
group (nnimap-decode-gnus-group
|
||||
(gnus-group-real-name (gnus-info-group info)))
|
||||
group (gnus-group-real-name (gnus-info-group info))
|
||||
active (cdr (assq 'active params))
|
||||
unexist (assq 'unexist (gnus-info-marks info))
|
||||
uidvalidity (cdr (assq 'uidvalidity params))
|
||||
@ -1511,16 +1479,13 @@ If LIMIT, first try to limit the search to the N last articles."
|
||||
(active (gnus-active group)))
|
||||
(when active
|
||||
(insert (format "%S %d %d y\n"
|
||||
(nnimap-encode-gnus-group
|
||||
(nnimap-decode-gnus-group
|
||||
(gnus-group-real-name group)))
|
||||
(gnus-group-real-name group)
|
||||
(cdr active)
|
||||
(car active))))))))))))
|
||||
|
||||
(defun nnimap-update-infos (flags infos)
|
||||
(dolist (info infos)
|
||||
(let* ((group (nnimap-decode-gnus-group
|
||||
(gnus-group-real-name (gnus-info-group info))))
|
||||
(let* ((group (gnus-group-real-name (gnus-info-group info)))
|
||||
(marks (cdr (assoc group flags))))
|
||||
(when marks
|
||||
(nnimap-update-info info marks)))))
|
||||
@ -1734,8 +1699,7 @@ If LIMIT, first try to limit the search to the N last articles."
|
||||
(nreverse result))))
|
||||
|
||||
(defun nnimap-store-info (info active)
|
||||
(let* ((group (nnimap-decode-gnus-group
|
||||
(gnus-group-real-name (gnus-info-group info))))
|
||||
(let* ((group (gnus-group-real-name (gnus-info-group info)))
|
||||
(entry (assoc group nnimap-current-infos)))
|
||||
(if entry
|
||||
(setcdr entry (list info active))
|
||||
@ -1860,8 +1824,6 @@ If LIMIT, first try to limit the search to the N last articles."
|
||||
(autoload 'nnir-search-thread "nnir")
|
||||
|
||||
(deffoo nnimap-request-thread (header &optional group server)
|
||||
(when group
|
||||
(setq group (nnimap-decode-gnus-group group)))
|
||||
(if gnus-refer-thread-use-nnir
|
||||
(nnir-search-thread header)
|
||||
(when (nnimap-change-group group server)
|
||||
|
||||
@ -665,9 +665,12 @@ nn*-request-list should have been called before calling this function."
|
||||
(condition-case err
|
||||
(progn
|
||||
(narrow-to-region (point) (point-at-eol))
|
||||
(setq group (read buffer))
|
||||
(unless (stringp group)
|
||||
(setq group (encode-coding-string (symbol-name group) 'latin-1)))
|
||||
(setq group (read buffer)
|
||||
group
|
||||
(cond ((symbolp group)
|
||||
(symbol-name group))
|
||||
((numberp group)
|
||||
(number-to-string group))))
|
||||
(if (and (numberp (setq max (read buffer)))
|
||||
(numberp (setq min (read buffer))))
|
||||
(push (list group (cons min max))
|
||||
@ -677,7 +680,7 @@ nn*-request-list should have been called before calling this function."
|
||||
(forward-line 1))
|
||||
group-assoc))
|
||||
|
||||
(defcustom nnmail-active-file-coding-system 'raw-text
|
||||
(defcustom nnmail-active-file-coding-system 'utf-8-emacs
|
||||
"Coding system for active file."
|
||||
:group 'nnmail-various
|
||||
:type 'coding-system)
|
||||
@ -687,7 +690,7 @@ nn*-request-list should have been called before calling this function."
|
||||
(let ((coding-system-for-write nnmail-active-file-coding-system))
|
||||
(when file-name
|
||||
(with-temp-file file-name
|
||||
(mm-disable-multibyte)
|
||||
; (mm-disable-multibyte)
|
||||
(nnmail-generate-active group-assoc)))))
|
||||
|
||||
(defun nnmail-generate-active (alist)
|
||||
@ -695,7 +698,7 @@ nn*-request-list should have been called before calling this function."
|
||||
(erase-buffer)
|
||||
(let (group)
|
||||
(while (setq group (pop alist))
|
||||
(insert (format "%S %d %d y\n" (intern (car group)) (cdadr group)
|
||||
(insert (format "%s %d %d y\n" (car group) (cdadr group)
|
||||
(caadr group))))
|
||||
(goto-char (point-max))
|
||||
(while (search-backward "\\." nil t)
|
||||
@ -1027,8 +1030,8 @@ If SOURCE is a directory spec, try to return the group name component."
|
||||
(nnmail-check-duplication message-id func artnum-func))
|
||||
1))
|
||||
|
||||
(defvar nnmail-group-names-not-encoded-p nil
|
||||
"Non-nil means group names are not encoded.")
|
||||
(make-obsolete-variable 'nnmail-group-names-not-encoded-p
|
||||
"Group names are always decoded" "27.1")
|
||||
|
||||
(defun nnmail-split-incoming (incoming func &optional exit-func
|
||||
group artnum-func junk-func)
|
||||
@ -1036,18 +1039,21 @@ If SOURCE is a directory spec, try to return the group name component."
|
||||
FUNC will be called with the buffer narrowed to each mail.
|
||||
INCOMING can also be a buffer object. In that case, the mail
|
||||
will be copied over from that buffer."
|
||||
(let ( ;; If this is a group-specific split, we bind the split
|
||||
(let (;; If this is a group-specific split, we bind the split
|
||||
;; methods to just this group.
|
||||
(nnmail-split-methods (if (and group
|
||||
(not nnmail-resplit-incoming))
|
||||
(list (list group ""))
|
||||
nnmail-split-methods))
|
||||
(nnmail-group-names-not-encoded-p t))
|
||||
nnmail-split-methods)))
|
||||
;; Insert the incoming file.
|
||||
(with-current-buffer (get-buffer-create nnmail-article-buffer)
|
||||
(erase-buffer)
|
||||
(if (bufferp incoming)
|
||||
(insert-buffer-substring incoming)
|
||||
;; The following coding system is set to
|
||||
;; `mm-text-coding-system', which is set to some flavor of
|
||||
;; 'raw-text "to get rid of ^Ms". But it's going to do a lot
|
||||
;; more than that, right? Shouldn't this also be 'undecided?
|
||||
(let ((coding-system-for-read nnmail-incoming-coding-system))
|
||||
(mm-insert-file-contents incoming)))
|
||||
(prog1
|
||||
|
||||
@ -415,7 +415,7 @@ This variable is set by `nnmaildir-request-article'.")
|
||||
(t (signal (car err) (cdr err)))))))))
|
||||
|
||||
(defun nnmaildir--update-nov (server group article)
|
||||
(let ((nnheader-file-coding-system 'binary)
|
||||
(let ((nnheader-file-coding-system 'undecided)
|
||||
(srv-dir (nnmaildir--srv-dir server))
|
||||
(storage-version 1) ;; [version article-number msgid [...nov...]]
|
||||
dir gname pgname msgdir prefix suffix file attr mtime novdir novfile
|
||||
|
||||
@ -111,36 +111,9 @@ non-nil.")
|
||||
|
||||
(nnoo-define-basics nnml)
|
||||
|
||||
(eval-when-compile
|
||||
(defsubst nnml-group-name-charset (group server-or-method)
|
||||
(gnus-group-name-charset
|
||||
(if (stringp server-or-method)
|
||||
(gnus-server-to-method
|
||||
(if (string-match "\\+" server-or-method)
|
||||
(concat (substring server-or-method 0 (match-beginning 0))
|
||||
":" (substring server-or-method (match-end 0)))
|
||||
(concat "nnml:" server-or-method)))
|
||||
(or server-or-method gnus-command-method '(nnml "")))
|
||||
group)))
|
||||
|
||||
(defun nnml-decoded-group-name (group &optional server-or-method)
|
||||
"Return a decoded group name of GROUP on SERVER-OR-METHOD."
|
||||
(if nnmail-group-names-not-encoded-p
|
||||
group
|
||||
(decode-coding-string
|
||||
group
|
||||
(nnml-group-name-charset group server-or-method))))
|
||||
|
||||
(defun nnml-encoded-group-name (group &optional server-or-method)
|
||||
"Return an encoded group name of GROUP on SERVER-OR-METHOD."
|
||||
(encode-coding-string
|
||||
group
|
||||
(nnml-group-name-charset group server-or-method)))
|
||||
|
||||
(defun nnml-group-pathname (group &optional file server)
|
||||
"Return an absolute file name of FILE for GROUP on SERVER."
|
||||
(nnmail-group-pathname (inline (nnml-decoded-group-name group server))
|
||||
nnml-directory file))
|
||||
(nnmail-group-pathname group nnml-directory file))
|
||||
|
||||
(deffoo nnml-retrieve-headers (sequence &optional group server fetch-old)
|
||||
(when (nnml-possibly-change-directory group server)
|
||||
@ -243,8 +216,7 @@ non-nil.")
|
||||
(string-to-number (file-name-nondirectory path)))))))
|
||||
|
||||
(deffoo nnml-request-group (group &optional server dont-check info)
|
||||
(let ((file-name-coding-system nnmail-pathname-coding-system)
|
||||
(decoded (nnml-decoded-group-name group server)))
|
||||
(let ((file-name-coding-system nnmail-pathname-coding-system))
|
||||
(cond
|
||||
((not (nnml-possibly-change-directory group server))
|
||||
(nnheader-report 'nnml "Invalid group (no such directory)"))
|
||||
@ -254,15 +226,15 @@ non-nil.")
|
||||
((not (file-directory-p nnml-current-directory))
|
||||
(nnheader-report 'nnml "%s is not a directory" nnml-current-directory))
|
||||
(dont-check
|
||||
(nnheader-report 'nnml "Group %s selected" decoded)
|
||||
(nnheader-report 'nnml "Group %s selected" group)
|
||||
t)
|
||||
(t
|
||||
(nnheader-re-read-dir nnml-current-directory)
|
||||
(nnmail-activate 'nnml)
|
||||
(let ((active (nth 1 (assoc-string group nnml-group-alist))))
|
||||
(if (not active)
|
||||
(nnheader-report 'nnml "No such group: %s" decoded)
|
||||
(nnheader-report 'nnml "Selected group %s" decoded)
|
||||
(nnheader-report 'nnml "No such group: %s" group)
|
||||
(nnheader-report 'nnml "Selected group %s" group)
|
||||
(nnheader-insert "211 %d %d %d %s\n"
|
||||
(max (1+ (- (cdr active) (car active))) 0)
|
||||
(car active) (cdr active) group)))))))
|
||||
@ -332,7 +304,6 @@ non-nil.")
|
||||
(active-articles
|
||||
(nnml-directory-articles nnml-current-directory))
|
||||
(is-old t)
|
||||
(decoded (nnml-decoded-group-name group server))
|
||||
article rest mod-time number target)
|
||||
(nnmail-activate 'nnml)
|
||||
|
||||
@ -370,7 +341,7 @@ non-nil.")
|
||||
(if target
|
||||
(progn
|
||||
(nnheader-message 5 "Deleting article %s in %s"
|
||||
number decoded)
|
||||
number group)
|
||||
(condition-case ()
|
||||
(funcall nnmail-delete-file-function article)
|
||||
(file-error
|
||||
@ -506,13 +477,12 @@ non-nil.")
|
||||
nnml-current-directory t
|
||||
(concat
|
||||
nnheader-numerical-short-files
|
||||
"\\|" (regexp-quote nnml-nov-file-name) "$")))
|
||||
(decoded (nnml-decoded-group-name group server)))
|
||||
"\\|" (regexp-quote nnml-nov-file-name) "$"))))
|
||||
(dolist (article articles)
|
||||
(when (file-writable-p article)
|
||||
(nnheader-message 5 "Deleting article %s in %s..."
|
||||
(file-name-nondirectory article)
|
||||
decoded)
|
||||
group)
|
||||
(funcall nnmail-delete-file-function article))))
|
||||
;; Try to delete the directory itself.
|
||||
(ignore-errors (delete-directory nnml-current-directory))))
|
||||
@ -687,15 +657,7 @@ article number. This function is called narrowed to an article."
|
||||
(if (stringp nnml-use-compressed-files)
|
||||
nnml-use-compressed-files
|
||||
".gz")))
|
||||
decoded dec file first headers)
|
||||
(when nnmail-group-names-not-encoded-p
|
||||
(dolist (ga (prog1 group-art (setq group-art nil)))
|
||||
(setq group-art (nconc group-art
|
||||
(list (cons (nnml-encoded-group-name (car ga)
|
||||
server)
|
||||
(cdr ga))))
|
||||
decoded (nconc decoded (list (car ga)))))
|
||||
(setq dec decoded))
|
||||
file first headers)
|
||||
(nnmail-insert-xref group-art)
|
||||
(run-hooks 'nnmail-prepare-save-mail-hook)
|
||||
(run-hooks 'nnml-prepare-save-mail-hook)
|
||||
@ -705,16 +667,10 @@ article number. This function is called narrowed to an article."
|
||||
(forward-line 1))
|
||||
;; We save the article in all the groups it belongs in.
|
||||
(dolist (ga group-art)
|
||||
(if nnmail-group-names-not-encoded-p
|
||||
(progn
|
||||
(nnml-possibly-create-directory (car decoded) server)
|
||||
(setq file (nnmail-group-pathname
|
||||
(pop decoded) nnml-directory
|
||||
(concat (number-to-string (cdr ga)) extension))))
|
||||
(nnml-possibly-create-directory (car ga) server)
|
||||
(setq file (nnml-group-pathname
|
||||
(car ga) (concat (number-to-string (cdr ga)) extension)
|
||||
server)))
|
||||
(nnml-possibly-create-directory (car ga) server)
|
||||
(setq file (nnml-group-pathname
|
||||
(car ga) (concat (number-to-string (cdr ga)) extension)
|
||||
server))
|
||||
(if first
|
||||
;; It was already saved, so we just make a hard link.
|
||||
(let ((file-name-coding-system nnmail-pathname-coding-system))
|
||||
@ -731,18 +687,13 @@ article number. This function is called narrowed to an article."
|
||||
(let ((func (if full-nov
|
||||
'nnml-add-nov
|
||||
'nnml-add-incremental-nov)))
|
||||
(if nnmail-group-names-not-encoded-p
|
||||
(dolist (ga group-art)
|
||||
(funcall func (pop dec) (cdr ga) headers))
|
||||
(dolist (ga group-art)
|
||||
(funcall func (car ga) (cdr ga) headers)))))
|
||||
(dolist (ga group-art)
|
||||
(funcall func (car ga) (cdr ga) headers))))
|
||||
group-art)
|
||||
|
||||
(defun nnml-active-number (group &optional server)
|
||||
"Compute the next article number in GROUP on SERVER."
|
||||
(let* ((encoded (if nnmail-group-names-not-encoded-p
|
||||
(nnml-encoded-group-name group server)))
|
||||
(active (cadr (assoc-string (or encoded group) nnml-group-alist))))
|
||||
(let ((active (cadr (assoc-string group nnml-group-alist))))
|
||||
;; The group wasn't known to nnml, so we just create an active
|
||||
;; entry for it.
|
||||
(unless active
|
||||
@ -760,7 +711,7 @@ article number. This function is called narrowed to an article."
|
||||
(cons (caar nnml-article-file-alist)
|
||||
(caar (last nnml-article-file-alist)))
|
||||
(cons 1 0)))
|
||||
(push (list (or encoded group) active) nnml-group-alist))
|
||||
(push (list group active) nnml-group-alist))
|
||||
(setcdr active (1+ (cdr active)))
|
||||
(while (file-exists-p
|
||||
(nnml-group-pathname group (int-to-string (cdr active)) server))
|
||||
@ -821,16 +772,15 @@ article number. This function is called narrowed to an article."
|
||||
headers))))
|
||||
|
||||
(defun nnml-get-nov-buffer (group &optional incrementalp)
|
||||
(let* ((decoded (nnml-decoded-group-name group))
|
||||
(buffer (get-buffer-create (format " *nnml %soverview %s*"
|
||||
(let ((buffer (get-buffer-create (format " *nnml %soverview %s*"
|
||||
(if incrementalp
|
||||
"incremental "
|
||||
"")
|
||||
decoded)))
|
||||
group)))
|
||||
(file-name-coding-system nnmail-pathname-coding-system))
|
||||
(with-current-buffer buffer
|
||||
(set (make-local-variable 'nnml-nov-buffer-file-name)
|
||||
(nnmail-group-pathname decoded nnml-directory nnml-nov-file-name))
|
||||
(nnmail-group-pathname group nnml-directory nnml-nov-file-name))
|
||||
(erase-buffer)
|
||||
(when (and (not incrementalp)
|
||||
(file-exists-p nnml-nov-buffer-file-name))
|
||||
@ -908,7 +858,7 @@ Unless no-active is non-nil, update the active file too."
|
||||
;; Update the active info for this group.
|
||||
(let ((group (directory-file-name dir))
|
||||
entry last)
|
||||
(setq group (nnheader-file-to-group (nnml-encoded-group-name group)
|
||||
(setq group (nnheader-file-to-group group
|
||||
nnml-directory)
|
||||
entry (assoc group nnml-group-alist)
|
||||
last (or (caadr entry) 0)
|
||||
|
||||
@ -368,7 +368,7 @@ for decoding when the cdr that the data specify is not available.")
|
||||
(with-current-buffer nntp-server-buffer
|
||||
(erase-buffer)
|
||||
(dolist (group groups)
|
||||
(let ((elem (assoc-string (gnus-group-decoded-name group) nnrss-server-data)))
|
||||
(let ((elem (assoc-string group nnrss-server-data)))
|
||||
(insert (format "%S %s 1 y\n" group (or (cadr elem) 0)))))
|
||||
'active))
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user