From: LdBeth <andpuke@foxmail.com>
To: Lars Ingebrigtsen <larsi@gnus.org>
Cc: Eric Abrahamsen <eric@ericabrahamsen.net>,
LdBeth <andpuke@foxmail.com>, Emacs Devel <emacs-devel@gnu.org>
Subject: Re: [PATCH] Gnus; Restore multi encoding support for NNTP
Date: Sat, 01 Jan 2022 10:11:12 +0800 [thread overview]
Message-ID: <tencent_CA1EFFD4DC58BB7F1C417AAC30747544AD09@qq.com> (raw)
In-Reply-To: <874k6o7okc.fsf@gnus.org>
[-- Attachment #1: Type: text/plain, Size: 1618 bytes --]
>>>>> In <874k6o7okc.fsf@gnus.org>
>>>>> Lars Ingebrigtsen <larsi@gnus.org> wrote:
Lars> Ah, right, I'd totally forgotten that bit. I think it can be relied
Lars> upon. And storing the info as a text property will probably work in
Lars> Gnus -- it'll save the data to .newsrc.eld, as you've found out -- but
Lars> it sounds pretty brittle to me. That is, I wouldn't be surprised if the
Lars> text property goes missing at some point, because the code in Gnus isn't
Lars> written with text properties in mind.
I have now figured how to write text property into .newsrc.eld: Gnus
does extra UTF-8 encoding when save group names, since it is now
already using UTF-8 encoding internally, I think it would be safe to
just remove that.
ldb> Btw I figured it is not a good idea to do encoding in nntp.el because
ldb> the decoding was not done in nntp.el either.
Lars> Perhaps just having this in an alist in nntp.el somewhere would be the
Lars> most logical choice, even though it means that nntp.el peeks at Gnus
Lars> variables.
I figured it is more diffcult to do percisely the encoding in nntp.el
Besides, I think it would be more ideal to let
`gnus-group-name-charset-group-alist' still to be generic on all
backends, which is the Emacs 26's old behavior.
Right now this patch has no problem accessing, subscribing servers
with GBK coding system and save the group names with their text
property (test agains the git master branch). The only one missing
puzzle is, the text property would be lost at some point after read in
the newsrc.eld file. I'll do a trace later to find out if this can be
worked out.
[-- Attachment #2: gnus.patch --]
[-- Type: text/plain, Size: 14625 bytes --]
diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el
index b042930..9db3d11 100644
--- a/lisp/gnus/gnus-group.el
+++ b/lisp/gnus/gnus-group.el
@@ -1230,6 +1230,12 @@ gnus-group-decoded-name
(let ((charset (gnus-group-name-charset nil string)))
(gnus-group-name-decode string charset)))
+(defun gnus-group-encoded-name (string)
+ ;; search for `charset' property added by `decode-coding-string'
+ (let ((pos (text-property-not-all 0 (length string) 'charset nil string)))
+ (if pos (encode-coding-string string (get-text-property pos 'charset string))
+ string)))
+
(defun gnus-group-list-groups (&optional level unread lowest update-level)
"List newsgroups with level LEVEL or lower that have unread articles.
Default is all subscribed groups.
diff --git a/lisp/gnus/gnus-int.el b/lisp/gnus/gnus-int.el
index 255c11f..4fcc44d 100644
--- a/lisp/gnus/gnus-int.el
+++ b/lisp/gnus/gnus-int.el
@@ -472,7 +472,7 @@ gnus-request-compact-group
(result
(funcall (gnus-get-function gnus-command-method
'request-compact-group)
- (gnus-group-real-name group)
+ (gnus-group-real-name (gnus-group-encoded-name group))
(nth 1 gnus-command-method) t)))
result))
@@ -493,7 +493,8 @@ gnus-request-group
(setq gnus-command-method
(inline (gnus-server-to-method gnus-command-method))))
(funcall (inline (gnus-get-function gnus-command-method 'request-group))
- (gnus-group-real-name group) (nth 1 gnus-command-method)
+ (gnus-group-real-name (gnus-group-encoded-name group))
+ (nth 1 gnus-command-method)
dont-check
info)))
@@ -503,7 +504,8 @@ gnus-request-group-description
(func 'request-group-description))
(when (gnus-check-backend-function func group)
(funcall (gnus-get-function gnus-command-method func)
- (gnus-group-real-name group) (nth 1 gnus-command-method)))))
+ (gnus-group-real-name (gnus-group-encoded-name group))
+ (nth 1 gnus-command-method)))))
(defun gnus-request-group-scan (group info)
"Request that GROUP get a complete rescan."
@@ -511,13 +513,15 @@ gnus-request-group-scan
(func 'request-group-scan))
(when (gnus-check-backend-function func group)
(funcall (gnus-get-function gnus-command-method func)
- (gnus-group-real-name group) (nth 1 gnus-command-method) info))))
+ (gnus-group-real-name (gnus-group-encoded-name group))
+ (nth 1 gnus-command-method) info))))
(defun gnus-close-group (group)
"Request the GROUP be closed."
(let ((gnus-command-method (inline (gnus-find-method-for-group group))))
(funcall (gnus-get-function gnus-command-method 'close-group)
- (gnus-group-real-name group) (nth 1 gnus-command-method))))
+ (gnus-group-real-name (gnus-group-encoded-name group))
+ (nth 1 gnus-command-method))))
(defun gnus-retrieve-headers (articles group &optional fetch-old)
"Request headers for ARTICLES in GROUP.
@@ -531,14 +535,14 @@ gnus-retrieve-headers
(gnus-agent-retrieve-headers articles group fetch-old))
(t
(funcall (gnus-get-function gnus-command-method 'retrieve-headers)
- articles (gnus-group-real-name group)
+ articles (gnus-group-real-name (gnus-group-encoded-name group))
(nth 1 gnus-command-method) fetch-old)))))
(defun gnus-retrieve-articles (articles group)
"Request ARTICLES in GROUP."
(let ((gnus-command-method (gnus-find-method-for-group group)))
(funcall (gnus-get-function gnus-command-method 'retrieve-articles)
- articles (gnus-group-real-name group)
+ articles (gnus-group-real-name (gnus-group-encoded-name group))
(nth 1 gnus-command-method))))
(defun gnus-retrieve-groups (groups command-method)
@@ -557,7 +561,7 @@ gnus-request-type
'request-type (car gnus-command-method)))
'unknown
(funcall (gnus-get-function gnus-command-method 'request-type)
- (gnus-group-real-name group) article))))
+ (gnus-group-real-name (gnus-group-encoded-name group)) article))))
(defun gnus-request-update-group-status (group status)
"Change the status of a group.
@@ -568,7 +572,7 @@ gnus-request-update-group-status
nil
(funcall
(gnus-get-function gnus-command-method 'request-update-group-status)
- (gnus-group-real-name group) status
+ (gnus-group-real-name (gnus-group-encoded-name group)) status
(nth 1 gnus-command-method)))))
(defun gnus-request-set-mark (group action)
@@ -578,7 +582,7 @@ gnus-request-set-mark
'request-set-mark (car gnus-command-method)))
action
(funcall (gnus-get-function gnus-command-method 'request-set-mark)
- (gnus-group-real-name group) action
+ (gnus-group-real-name (gnus-group-encoded-name group)) action
(nth 1 gnus-command-method))
(gnus-run-hook-with-args gnus-after-set-mark-hook group action))))
@@ -590,7 +594,8 @@ gnus-request-update-mark
mark
(gnus-run-hook-with-args gnus-before-update-mark-hook group article mark)
(funcall (gnus-get-function gnus-command-method 'request-update-mark)
- (gnus-group-real-name group) article mark))))
+ (gnus-group-real-name (gnus-group-encoded-name group))
+ article mark))))
(defun gnus-request-article (article group &optional buffer)
"Request the ARTICLE in GROUP.
@@ -598,7 +603,7 @@ gnus-request-article
If BUFFER, insert the article in that group."
(let ((gnus-command-method (gnus-find-method-for-group group)))
(funcall (gnus-get-function gnus-command-method 'request-article)
- article (gnus-group-real-name group)
+ article (gnus-group-real-name (gnus-group-encoded-name group))
(nth 1 gnus-command-method) buffer)))
(defun gnus-request-thread (header group)
@@ -606,7 +611,7 @@ gnus-request-thread
(let ((gnus-command-method (gnus-find-method-for-group group)))
(funcall (gnus-get-function gnus-command-method 'request-thread)
header
- (gnus-group-real-name group))))
+ (gnus-group-real-name (gnus-group-encoded-name group)))))
(defun gnus-select-group-with-message-id (group message-id)
"Activate and select GROUP with the given MESSAGE-ID selected.
@@ -654,7 +659,7 @@ gnus-simplify-group-name
"Return the simplest representation of the name of GROUP.
This is the string that Gnus uses to identify the group."
(gnus-group-prefixed-name
- (gnus-group-real-name group)
+ (gnus-group-real-name (gnus-group-encoded-name group))
(gnus-group-method group)))
(defun gnus-warp-to-article ()
@@ -722,7 +727,8 @@ gnus-request-body
clean-up t))
;; Use `head' function.
((fboundp head)
- (setq res (funcall head article (gnus-group-real-name group)
+ (setq res (funcall head article
+ (gnus-group-real-name (gnus-group-encoded-name group))
(nth 1 gnus-command-method))))
;; Use `article' function.
(t
@@ -751,7 +757,7 @@ gnus-request-expunge-group
(gnus-server-to-method command-method)
command-method)))
(funcall (gnus-get-function gnus-command-method 'request-expunge-group)
- (gnus-group-real-name group)
+ (gnus-group-real-name (gnus-group-encoded-name group))
(nth 1 gnus-command-method))))
(defvar mail-source-plugged)
@@ -768,7 +774,7 @@ gnus-request-scan
(not (gnus-agent-method-p gnus-command-method)))
(setq gnus-internal-registry-spool-current-method gnus-command-method)
(funcall (gnus-get-function gnus-command-method 'request-scan)
- (and group (gnus-group-real-name group))
+ (and group (gnus-group-real-name (gnus-group-encoded-name group)))
(nth 1 gnus-command-method)))))
(defun gnus-request-update-info (info command-method)
@@ -792,7 +798,7 @@ gnus-request-marks
'request-marks (car gnus-command-method))
(let ((group (gnus-info-group info)))
(and (funcall (gnus-get-function gnus-command-method 'request-marks)
- (gnus-group-real-name group)
+ (gnus-group-real-name (gnus-group-encoded-name group))
info (nth 1 gnus-command-method))
;; If the minimum article number is greater than 1, then all
;; smaller article numbers are known not to exist; we'll
@@ -816,7 +822,8 @@ gnus-request-expire-articles
(not-deleted
(funcall
(gnus-get-function gnus-command-method 'request-expire-articles)
- articles (gnus-group-real-name group) (nth 1 gnus-command-method)
+ articles (gnus-group-real-name (gnus-group-encoded-name group))
+ (nth 1 gnus-command-method)
force)))
(when (and gnus-agent
(gnus-agent-method-p gnus-command-method))
@@ -830,7 +837,8 @@ gnus-request-move-article
(let* ((gnus-command-method (gnus-find-method-for-group group))
(result (funcall (gnus-get-function gnus-command-method
'request-move-article)
- article (gnus-group-real-name group)
+ article
+ (gnus-group-real-name (gnus-group-encoded-name group))
(nth 1 gnus-command-method) accept-function
last move-is-internal)))
(when (and result gnus-agent
@@ -864,7 +872,9 @@ gnus-request-accept-article
(result
(funcall
(gnus-get-function gnus-command-method 'request-accept-article)
- (if (stringp group) (gnus-group-real-name group) group)
+ (if (stringp group)
+ (gnus-group-real-name (gnus-group-encoded-name group))
+ group)
(cadr gnus-command-method)
last)))
(when (and gnus-agent
@@ -883,7 +893,9 @@ gnus-request-replace-article
(message-encode-message-body)))
(let* ((func (car (gnus-group-name-to-method group)))
(result (funcall (intern (format "%s-request-replace-article" func))
- article (gnus-group-real-name group) buffer)))
+ article
+ (gnus-group-real-name (gnus-group-encoded-name group))
+ buffer)))
(when (and gnus-agent (gnus-agent-method-p gnus-command-method))
(gnus-agent-regenerate-group group (list article)))
result))
@@ -892,7 +904,7 @@ gnus-request-restore-buffer
"Request a new buffer restored to the state of ARTICLE."
(let ((gnus-command-method (gnus-find-method-for-group group)))
(funcall (gnus-get-function gnus-command-method 'request-restore-buffer)
- article (gnus-group-real-name group)
+ article (gnus-group-real-name (gnus-group-encoded-name group))
(nth 1 gnus-command-method))))
(defun gnus-request-create-group (group &optional command-method args)
@@ -902,13 +914,15 @@ gnus-request-create-group
command-method)
(gnus-find-method-for-group group))))
(funcall (gnus-get-function gnus-command-method 'request-create-group)
- (gnus-group-real-name group) (nth 1 gnus-command-method) args)))
+ (gnus-group-real-name (gnus-group-encoded-name group))
+ (nth 1 gnus-command-method) args)))
(defun gnus-request-delete-group (group &optional force)
(let* ((gnus-command-method (gnus-find-method-for-group group))
(result
(funcall (gnus-get-function gnus-command-method 'request-delete-group)
- (gnus-group-real-name group) force (nth 1 gnus-command-method))))
+ (gnus-group-real-name (gnus-group-encoded-name group))
+ force (nth 1 gnus-command-method))))
(when result
(gnus-cache-delete-group group)
(gnus-agent-delete-group group))
@@ -918,8 +932,9 @@ gnus-request-rename-group
(let* ((gnus-command-method (gnus-find-method-for-group group))
(result
(funcall (gnus-get-function gnus-command-method 'request-rename-group)
- (gnus-group-real-name group)
- (gnus-group-real-name new-name) (nth 1 gnus-command-method))))
+ (gnus-group-real-name (gnus-group-encoded-name group))
+ (gnus-group-real-name (gnus-group-encoded-name new-name))
+ (nth 1 gnus-command-method))))
(when result
(gnus-cache-rename-group group new-name)
(gnus-agent-rename-group group new-name))
diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el
index fa880b7..94c6e2e 100644
--- a/lisp/gnus/gnus-srvr.el
+++ b/lisp/gnus/gnus-srvr.el
@@ -775,13 +775,12 @@ gnus-browse-foreign-server
(while (not (eobp))
(ignore-errors
(push (cons
- (decode-coding-string
- (buffer-substring
+ (gnus-group-decoded-name
+ (buffer-substring
(point)
(progn
(skip-chars-forward "^ \t")
- (point)))
- 'utf-8-emacs)
+ (point))))
(let ((last (read cur)))
(cons (read cur) last)))
groups))
@@ -789,7 +788,7 @@ gnus-browse-foreign-server
(while (not (eobp))
(ignore-errors
(push (cons
- (decode-coding-string
+ (gnus-group-decoded-name
(if (eq (char-after) ?\")
(read cur)
(let ((p (point)) (name ""))
@@ -801,8 +800,7 @@ gnus-browse-foreign-server
(skip-chars-forward "^ \t\\\\")
(setq name (concat name (buffer-substring
p (point)))))
- name))
- 'utf-8-emacs)
+ name)))
(let ((last (read cur)))
(cons (read cur) last)))
groups))
diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el
index 606bd3a..b1b2366 100644
--- a/lisp/gnus/gnus-start.el
+++ b/lisp/gnus/gnus-start.el
@@ -2893,26 +2893,6 @@ gnus-gnus-to-quick-newsrc-format
;; Remove the `gnus-killed-list' from the list of variables
;; to be saved, if required.
(delq 'gnus-killed-list (copy-sequence gnus-variable-list)))))
- ;; Encode group names in `gnus-newsrc-alist' and
- ;; `gnus-topic-alist' in order to keep newsrc.eld files
- ;; compatible with older versions of Gnus. At some point,
- ;; if/when a new version of Gnus is released, stop doing
- ;; this and move the corresponding decode in
- ;; `gnus-read-newsrc-el-file' into a conversion routine.
- (gnus-newsrc-alist
- (mapcar (lambda (info)
- (cons (encode-coding-string (car info) 'utf-8-emacs)
- (cdr info)))
- gnus-newsrc-alist))
- (gnus-topic-alist
- (when (memq 'gnus-topic-alist variables)
- (mapcar (lambda (elt)
- (cons (car elt) ; Topic name
- (mapcar (lambda (g)
- (encode-coding-string
- g 'utf-8-emacs))
- (cdr elt))))
- gnus-topic-alist)))
variable)
;; Insert the variables into the file.
(while variables
next prev parent reply other threads:[~2022-01-01 2:11 UTC|newest]
Thread overview: 25+ messages / expand[flat|nested] mbox.gz Atom feed top
2021-12-27 9:42 Gnus; Restore multi encoding support for NNTP LdBeth
2021-12-27 12:11 ` Lars Ingebrigtsen
2021-12-27 12:41 ` LdBeth
2021-12-27 12:57 ` Lars Ingebrigtsen
2021-12-27 13:58 ` LdBeth
2021-12-28 3:17 ` Eric Abrahamsen
2021-12-28 14:31 ` Lars Ingebrigtsen
2021-12-28 15:40 ` LdBeth
2021-12-28 14:29 ` Lars Ingebrigtsen
2021-12-28 15:43 ` LdBeth
2021-12-30 10:23 ` [PATCH] " LdBeth
2021-12-30 14:49 ` Lars Ingebrigtsen
2021-12-30 14:54 ` Eli Zaretskii
2021-12-30 15:18 ` LdBeth
2021-12-31 15:59 ` Lars Ingebrigtsen
2022-01-01 2:11 ` LdBeth [this message]
2022-01-01 3:32 ` LdBeth
2022-01-03 11:18 ` Lars Ingebrigtsen
2022-01-03 11:25 ` Lars Ingebrigtsen
2022-01-03 14:00 ` LdBeth
2022-01-01 6:58 ` Eli Zaretskii
2022-01-01 8:34 ` LdBeth
2022-01-01 8:56 ` Eli Zaretskii
2022-01-01 9:26 ` LdBeth
2022-01-01 9:35 ` Eli Zaretskii
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=tencent_CA1EFFD4DC58BB7F1C417AAC30747544AD09@qq.com \
--to=andpuke@foxmail.com \
--cc=emacs-devel@gnu.org \
--cc=eric@ericabrahamsen.net \
--cc=larsi@gnus.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).