bug#33653: 27.0.50; Change Gnus obarrays-as-hash-tables into real hash tables

[Eric Abrahamsen <eric@ericabrahamsen.net>]

[-- Attachment #1: Type: text/plain, Size: 2308 bytes --]


On 04/08/19 17:13 PM, Katsumi Yamaoka wrote:
> On Wed, 27 Mar 2019 13:54:42 +0900, Katsumi Yamaoka wrote:
>> The group level of nnml:テスト is 1 and there are some unread
>> articles in it, however the group is not listed in the Group
>> buffer when I launch Gnus by `C-u 1 M-x gnus RET'...
>
> I found a cause of it not to be listed in the group buffer just
> after launching Gnus.
>
> The group entry in the ~/Mail/active file is:
>
> テスト 5 1 y
>
> The file coding is utf-8-unix.  So, the binary expression of the
> group name is \343\203\206\343\202\271\343\203\210, where \343
> is a single character, and this form is what the hash tables use
> (in the ~/.newsrc.eld file, "\343" consists of four characters
>  "\", "3", "4", and "3", though).
>
> `gnus-active-to-gnus-format' reads it in the following way:
>
> ・Load the active file to the " *nntpd*" buffer in the binary
> 　mode.  Copy it to another temp buffer.  There \343 is a single
> 　character.
> ・Read the group name using `(read (current-buffer))'.
> 　Then it is read as a symbol; \343 is still a single character.
> ・Convert it to a string using `symbol-name'.
> 　\343 is expanded into the one consists of four characters. :<
> 　It should never match to the one in the hash tables.
>
> Why the single-char to four-chars conversion happens is that
> the buffer where those processes are done is in the multibyte
> mode.  So, the patch attached below solves the problem.  I'm
> going to test it for the other back ends...
>
> --- gnus-start.el~	2019-03-25 21:22:46.184139100 +0000
> +++ gnus-start.el	2019-04-08 08:07:41.906976900 +0000
> @@ -2139,3 +2139,3 @@
>
> -    (with-temp-buffer
> +    (mm-with-unibyte-buffer
>        (insert-buffer-substring cur)

I was asking on emacs.devel about that, and with Andreas' help came up
with the attached patch. It's a terrible hack, but it seems to work, and
I think would be good as an intermediate step.

What you're doing -- changing the unibyte/multibyte status of the
buffers -- is I think part of the final, more correct solution to the
problem, that will leave group names decoded everywhere. But I would
like to Gnus back into an intermediate working state before tackling
that...

What do you think?

Eric


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-WIP-on-nnmail-group-names.patch --]
[-- Type: text/x-patch, Size: 8190 bytes --]

From 4905ecb5dfd301d3ce9c6d92d2c0b6005a24fa51 Mon Sep 17 00:00:00 2001
From: Eric Abrahamsen <eric@ericabrahamsen.net>
Date: Sun, 31 Mar 2019 09:09:18 -0700
Subject: [PATCH] WIP on nnmail group names

---
 lisp/gnus/gnus-start.el | 15 +++++++++------
 lisp/gnus/nnmail.el     |  2 +-
 lisp/gnus/nnml.el       | 16 ++++++++--------
 lisp/gnus/nnrss.el      | 18 +++++++++---------
 4 files changed, 27 insertions(+), 24 deletions(-)

diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el
index 9b1be65067..2beb685822 100644
--- a/lisp/gnus/gnus-start.el
+++ b/lisp/gnus/gnus-start.el
@@ -2145,12 +2145,15 @@ gnus-active-to-gnus-format
 	(condition-case ()
 	    (if (and (stringp (progn
 				(setq group (read cur)
-				      group (cond ((numberp group)
-						   (number-to-string group))
-						  ((symbolp group)
-						   (symbol-name group))
-						  ((stringp group)
-						   group)))))
+				      group
+				      (encode-coding-string
+				       (cond ((numberp group)
+					      (number-to-string group))
+					     ((symbolp group)
+					      (symbol-name group))
+					     ((stringp group)
+					      group))
+				       'latin-1))))
 		     (numberp (setq max (read cur)))
 		     (numberp (setq min (read cur)))
 		     (null (progn
diff --git a/lisp/gnus/nnmail.el b/lisp/gnus/nnmail.el
index a95cdb4a4f..b6dbbea74c 100644
--- a/lisp/gnus/nnmail.el
+++ b/lisp/gnus/nnmail.el
@@ -663,7 +663,7 @@ nnmail-parse-active
 	    (narrow-to-region (point) (point-at-eol))
 	    (setq group (read buffer))
 	    (unless (stringp group)
-	      (setq group (symbol-name group)))
+	      (setq group (encode-coding-string (symbol-name group) 'latin-1)))
 	    (if (and (numberp (setq max (read buffer)))
 		     (numberp (setq min (read buffer))))
 		(push (list group (cons min max))
diff --git a/lisp/gnus/nnml.el b/lisp/gnus/nnml.el
index 5770777ad4..205e9e4803 100644
--- a/lisp/gnus/nnml.el
+++ b/lisp/gnus/nnml.el
@@ -259,7 +259,7 @@ nnml-request-group
      (t
       (nnheader-re-read-dir nnml-current-directory)
       (nnmail-activate 'nnml)
-      (let ((active (nth 1 (assoc group nnml-group-alist))))
+      (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)
@@ -295,7 +295,7 @@ nnml-request-create-group
     (nnheader-report 'nnml "%s is a file"
 		     (directory-file-name (nnml-group-pathname group
 							       nil server))))
-   ((assoc group nnml-group-alist)
+   ((assoc-string group nnml-group-alist)
     t)
    (t
     (let (active)
@@ -379,7 +379,7 @@ nnml-request-expire-articles
 		  (nnml-nov-delete-article group number))
 	      (push number rest)))
 	(push number rest)))
-    (let ((active (nth 1 (assoc group nnml-group-alist))))
+    (let ((active (nth 1 (assoc-string group nnml-group-alist))))
       (when active
 	(setcar active (or (and active-articles
 				(apply 'min active-articles))
@@ -520,7 +520,7 @@ nnml-request-delete-group
       (nnheader-report 'nnml "No such directory: %s/" file))
     ;; Remove the group from all structures.
     (setq nnml-group-alist
-	  (delq (assoc group nnml-group-alist) nnml-group-alist)
+	  (delq (assoc-string group nnml-group-alist) nnml-group-alist)
 	  nnml-current-group nil
 	  nnml-current-directory nil)
     ;; Save the active file.
@@ -549,7 +549,7 @@ nnml-request-rename-group
       (when (<= (length (directory-files old-dir)) 2)
 	(ignore-errors (delete-directory old-dir)))
       ;; That went ok, so we change the internal structures.
-      (let ((entry (assoc group nnml-group-alist)))
+      (let ((entry (assoc-string group nnml-group-alist)))
 	(when entry
 	  (setcar entry new-name))
 	(setq nnml-current-directory nil
@@ -597,7 +597,7 @@ nnml-deletable-article-p
     (when (setq path (nnml-article-to-file article))
       (when (file-writable-p path)
 	(or (not nnmail-keep-last-article)
-	    (not (eq (cdr (nth 1 (assoc group nnml-group-alist)))
+	    (not (eq (cdr (nth 1 (assoc-string group nnml-group-alist)))
 		     article)))))))
 
 ;; Find an article number in the current group given the Message-ID.
@@ -742,7 +742,7 @@ nnml-active-number
   "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 (or encoded group) nnml-group-alist))))
+	 (active (cadr (assoc-string (or encoded group) nnml-group-alist))))
     ;; The group wasn't known to nnml, so we just create an active
     ;; entry for it.
     (unless active
@@ -783,7 +783,7 @@ nnml-save-incremental-nov
 	    (cdr nnml-incremental-nov-buffer-alist)))))
 
 (defun nnml-open-incremental-nov (group)
-  (or (cdr (assoc group nnml-incremental-nov-buffer-alist))
+  (or (cdr (assoc-string group nnml-incremental-nov-buffer-alist))
       (let ((buffer (nnml-get-nov-buffer group t)))
 	(push (cons group buffer) nnml-incremental-nov-buffer-alist)
 	buffer)))
diff --git a/lisp/gnus/nnrss.el b/lisp/gnus/nnrss.el
index 7f2accc2b6..0bfecb28e0 100644
--- a/lisp/gnus/nnrss.el
+++ b/lisp/gnus/nnrss.el
@@ -340,10 +340,10 @@ nnrss-request-delete-group
   (let (elem)
     ;; There may be two or more entries in `nnrss-group-alist' since
     ;; this function didn't delete them formerly.
-    (while (setq elem (assoc group nnrss-group-alist))
+    (while (setq elem (assoc-string group nnrss-group-alist))
       (setq nnrss-group-alist (delq elem nnrss-group-alist))))
   (setq nnrss-server-data
-	(delq (assoc group nnrss-server-data) nnrss-server-data))
+	(delq (assoc-string group nnrss-server-data) nnrss-server-data))
   (nnrss-save-server-data server)
   (ignore-errors
     (let ((file-name-coding-system nnmail-pathname-coding-system))
@@ -367,7 +367,7 @@ nnrss-retrieve-groups
   (with-current-buffer nntp-server-buffer
     (erase-buffer)
     (dolist (group groups)
-      (let ((elem (assoc (gnus-group-decoded-name group) nnrss-server-data)))
+      (let ((elem (assoc-string (gnus-group-decoded-name group) nnrss-server-data)))
 	(insert (format "%S %s 1 y\n" group (or (cadr elem) 0)))))
     'active))
 
@@ -539,7 +539,7 @@ nnrss-read-group-data
   (if (hash-table-p nnrss-group-hashtb)
       (clrhash nnrss-group-hashtb)
     (setq nnrss-group-hashtb (make-hash-table :test 'equal)))
-  (let ((pair (assoc group nnrss-server-data)))
+  (let ((pair (assoc-string group nnrss-server-data)))
     (setq nnrss-group-max (or (cadr pair) 0))
     (setq nnrss-group-min (+ nnrss-group-max 1)))
   (let ((file (nnrss-make-filename group server))
@@ -644,8 +644,8 @@ nnrss-check-group
 					 (concat group ".xml"))
 					nnrss-directory))))
 	(setq xml (nnrss-fetch file t))
-      (setq url (or (nth 2 (assoc group nnrss-server-data))
-		    (cadr (assoc group nnrss-group-alist))))
+      (setq url (or (nth 2 (assoc-string group nnrss-server-data))
+		    (cadr (assoc-string group nnrss-group-alist))))
       (unless url
 	(setq url
 	      (cdr
@@ -653,7 +653,7 @@ nnrss-check-group
 		      (nnrss-discover-feed
 		       (read-string
 			(format "URL to search for %s: " group) "http://")))))
-	(let ((pair (assoc group nnrss-server-data)))
+	(let ((pair (assoc-string group nnrss-server-data)))
 	  (if pair
 	      (setcdr (cdr pair) (list url))
 	    (push (list group nnrss-group-max url) nnrss-server-data)))
@@ -721,7 +721,7 @@ nnrss-check-group
       (setq extra nil))
     (when changed
       (nnrss-save-group-data group server)
-      (let ((pair (assoc group nnrss-server-data)))
+      (let ((pair (assoc-string group nnrss-server-data)))
 	(if pair
 	    (setcar (cdr pair) nnrss-group-max)
 	  (push (list group nnrss-group-max) nnrss-server-data)))
@@ -792,7 +792,7 @@ nnrss-generate-download-script
   (insert "RSSDIR='" (expand-file-name nnrss-directory) "'\n")
   (dolist (elem nnrss-server-data)
     (let ((url (or (nth 2 elem)
-		   (cadr (assoc (car elem) nnrss-group-alist)))))
+		   (cadr (assoc-string (car elem) nnrss-group-alist)))))
       (insert "$WGET -q -O \"$RSSDIR\"/'"
 	      (nnrss-translate-file-chars (concat (car elem) ".xml"))
 	      "' '" url "'\n"))))
-- 
2.21.0