1. use file-name-coding-system instead of pathname-coding-system.
authorShengHuo ZHU <zsh@cs.rochester.edu>
Tue, 16 May 2000 21:58:20 +0000 (21:58 +0000)
committerShengHuo ZHU <zsh@cs.rochester.edu>
Tue, 16 May 2000 21:58:20 +0000 (21:58 +0000)
2. group-name charset.
3. improve underlining.

lisp/ChangeLog
lisp/gnus-group.el
lisp/gnus-srvr.el
lisp/gnus-util.el
lisp/nnfolder.el
lisp/nnmail.el
lisp/nnmh.el
lisp/nnml.el

index 0a8b138..fd21ad1 100644 (file)
@@ -1,3 +1,39 @@
+2000-05-16 17:55:57  Karl Kleinpaste <karl@charcoal.com>
+
+       * gnus-util.el (gnus-put-text-property-excluding-newlines): Improve.
+
+2000-05-16 16:22:17  Shenghuo ZHU  <zsh@cs.rochester.edu>
+
+       * gnus-group.el (gnus-group-name-charset-method-alist): New variable.
+       (gnus-group-name-charset-group-alist): Ditto.
+       (gnus-group-name-charset): New function.
+       (gnus-group-name-decode): New function.
+       (gnus-group-insert-group-line): Use them.
+       (gnus-group-prepare-flat-list-dead): Ditto.
+       (gnus-group-list-active): Ditto.
+       (gnus-group-describe-all-groups): Ditto.
+       (gnus-group-prepare-flat-list-dead-predicate): Ditto.
+       * gnus-srvr.el: (gnus-browse-foreign-server): Decode group name and 
+       add gnus-group property.
+       (gnus-browse-group-name): Read gnus-group property.
+       
+2000-05-16 15:27:08  Shenghuo ZHU  <zsh@cs.rochester.edu>
+
+       * nnfolder.el (nnfolder-possibly-change-group): Use
+       file-name-coding-system instead of pathname-coding-system.
+       * nnmail.el (nnmail-find-file): Ditto.
+       (nnmail-write-region): Ditto.
+       * nnmh.el (nnmh-retrieve-headers): Ditto.
+       (nnmh-request-article): Ditto.
+       (nnmh-request-group): Ditto.
+       (nnmh-request-list): Ditto.
+       (nnmh-possibly-change-directory): Ditto.
+       (nnmh-active-number): Ditto.
+       * nnml.el (nnml-possibly-change-directory): Ditto.
+       (nnml-request-list): Ditto.
+       (nnml-request-article): Ditto.
+       (nnml-retrieve-headers): Ditto.
+       
 2000-05-16  Simon Josefsson  <jas@pdc.kth.se>
 
        * nnimap.el (nnimap-request-accept-article): Don't unselect
index d9bb4a2..0d53d3c 100644 (file)
@@ -394,6 +394,24 @@ ticked: The number of ticked articles."
   :group 'gnus-group-icons
   :type '(repeat (cons (sexp :tag "Form") file)))
 
+(defcustom gnus-group-name-charset-method-alist nil
+  "*Alist for method and the charset for group names.
+
+For example:
+    (((nntp \"news.com.cn\") . cn-gb-2312))
+"
+  :group 'gnus-charset
+  :type '(repeat (cons (sexp :tag "Method") (symbol :tag "Charset"))))
+
+(defcustom gnus-group-name-charset-group-alist nil
+  "*Alist for group regexp and the charset for group names.
+
+For example:
+    ((\"\\.com\\.cn:\" . cn-gb-2312))
+"
+  :group 'gnus-charset
+  :type '(repeat (cons (regexp :tag "Group") (symbol :tag "Charset"))))
+
 ;;; Internal variables
 
 (defvar gnus-group-sort-alist-function 'gnus-group-sort-flat
@@ -874,6 +892,25 @@ The following commands are available:
     (when gnus-carpal
       (gnus-carpal-setup-buffer 'group))))
 
+(defsubst gnus-group-name-charset (method group)
+  (if (null method)
+      (setq method (gnus-find-method-for-group group)))
+  (let ((item (assoc method gnus-group-name-charset-method-alist))
+       (alist gnus-group-name-charset-group-alist)
+       result)
+    (if item 
+       (cdr item)
+      (while (setq item (pop alist))
+       (if (string-match (car item) group)
+           (setq alist nil
+                 result (cdr item))))
+      result)))
+
+(defsubst gnus-group-name-decode (string charset)
+  (if (and charset (featurep 'mule))
+      (mm-decode-coding-string string charset)
+    string))
+
 (defun gnus-group-list-groups (&optional level unread lowest)
   "List newsgroups with level LEVEL or lower that have unread articles.
 Default is all subscribed groups.
@@ -1017,16 +1054,24 @@ If REGEXP, only list groups matching REGEXP."
          (when (string-match regexp group)
            (gnus-add-text-properties
             (point) (prog1 (1+ (point))
-                      (insert " " mark "     *: " group "\n"))
+                      (insert " " mark "     *: "
+                              (gnus-group-name-decode group 
+                                                      (gnus-group-name-charset
+                                                       nil group)) 
+                              "\n"))
             (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb)
                   'gnus-unread t
                   'gnus-level level))))
       ;; This loop is used when listing all groups.
       (while groups
+       (setq group (pop groups))
        (gnus-add-text-properties
         (point) (prog1 (1+ (point))
                   (insert " " mark "     *: "
-                          (setq group (pop groups)) "\n"))
+                          (gnus-group-name-decode group 
+                                                  (gnus-group-name-charset
+                                                   nil group)) 
+                          "\n"))
         (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb)
               'gnus-unread t
               'gnus-level level))))))
@@ -1078,7 +1123,11 @@ If REGEXP, only list groups matching REGEXP."
                                                    gnus-tmp-marked number
                                                    gnus-tmp-method)
   "Insert a group line in the group buffer."
-  (let* ((gnus-tmp-active (gnus-active gnus-tmp-group))
+  (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
              (1+ (- (cdr gnus-tmp-active) (car gnus-tmp-active)))
@@ -1095,10 +1144,14 @@ If REGEXP, only list groups matching REGEXP."
                ((<= gnus-tmp-level gnus-level-unsubscribed) ?U)
                ((= gnus-tmp-level gnus-level-zombie) ?Z)
                (t ?K)))
-        (gnus-tmp-qualified-group (gnus-group-real-name gnus-tmp-group))
+        (gnus-tmp-qualified-group 
+         (gnus-group-name-decode (gnus-group-real-name gnus-tmp-group)
+                                 group-name-charset))
         (gnus-tmp-newsgroup-description
          (if gnus-description-hashtb
-             (or (gnus-gethash gnus-tmp-group gnus-description-hashtb) "")
+             (or (gnus-group-name-decode
+                  (gnus-gethash gnus-tmp-group gnus-description-hashtb) 
+                  group-name-charset) "")
            ""))
         (gnus-tmp-moderated
          (if (and gnus-moderated-hashtb
@@ -1107,8 +1160,6 @@ If REGEXP, only list groups matching REGEXP."
         (gnus-tmp-moderated-string
          (if (eq gnus-tmp-moderated ?m) "(m)" ""))
         (gnus-tmp-group-icon "==&&==")
-        (gnus-tmp-method
-         (gnus-server-get-method gnus-tmp-group gnus-tmp-method)) ;
         (gnus-tmp-news-server (or (cadr gnus-tmp-method) ""))
         (gnus-tmp-news-method (or (car gnus-tmp-method) ""))
         (gnus-tmp-news-method-string
@@ -3040,10 +3091,14 @@ entail asking the server for the groups."
        group)
     (erase-buffer)
     (while groups
+      (setq group (pop groups))
       (gnus-add-text-properties
        (point) (prog1 (1+ (point))
                 (insert "       *: "
-                        (setq group (pop groups)) "\n"))
+                        (gnus-group-name-decode group 
+                                                (gnus-group-name-charset
+                                                 nil group))
+                        "\n"))
        (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb)
             'gnus-unread t
             'gnus-level (inline (gnus-group-level group)))))
@@ -3202,8 +3257,12 @@ to use."
     (mapatoms
      (lambda (group)
        (setq b (point))
-       (insert (format "      *: %-20s %s\n" (symbol-name group)
-                      (symbol-value group)))
+       (let ((charset (gnus-group-name-charset nil group)))
+        (insert (format "      *: %-20s %s\n" 
+                        (gnus-group-name-decode
+                         (symbol-name group) charset)
+                        (gnus-group-name-decode
+                         (symbol-value group) charset))))
        (gnus-add-text-properties
        b (1+ b) (list 'gnus-group group
                       'gnus-unread t 'gnus-marked nil
@@ -3578,7 +3637,11 @@ or `gnus-group-catchup-group-hook'."
          (when (funcall predicate group)
            (gnus-add-text-properties
             (point) (prog1 (1+ (point))
-                      (insert " " mark "     *: " group "\n"))
+                      (insert " " mark "     *: " 
+                              (gnus-group-name-decode group 
+                                                      (gnus-group-name-charset
+                                                       nil group))
+                              "\n"))
             (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb)
                   'gnus-unread t
                   'gnus-level level)))))))
index b45fed0..23a251c 100644 (file)
@@ -626,11 +626,17 @@ The following commands are available:
       (setq groups (sort groups
                         (lambda (l1 l2)
                           (string< (car l1) (car l2)))))
-      (let ((buffer-read-only nil))
+      (let ((buffer-read-only nil) charset)
        (while groups
          (setq group (car groups))
-         (insert
-          (format "K%7d: %s\n" (cdr group) (car group)))
+         (setq charset (gnus-group-name-charset method group))
+         (gnus-add-text-properties
+          (point)
+          (prog1 (1+ (point))
+            (insert
+             (format "K%7d: %s\n" (cdr group)
+                     (gnus-group-name-decode (car group) charset))))
+          (list 'gnus-group (car group)))
          (setq groups (cdr groups))))
       (switch-to-buffer (current-buffer))
       (goto-char (point-min))
@@ -718,11 +724,12 @@ buffer.
 (defun gnus-browse-group-name ()
   (save-excursion
     (beginning-of-line)
-    (when (re-search-forward ": \\(.*\\)$" (gnus-point-at-eol) t)
-      (gnus-group-prefixed-name
-       ;; Remove text props.
-       (format "%s" (match-string 1))
-       gnus-browse-current-method))))
+    (let ((name (get-text-property (point) 'gnus-group)))
+      (when (re-search-forward ": \\(.*\\)$" (gnus-point-at-eol) t)
+       (gnus-group-prefixed-name
+        (or name
+            (format "%s" (match-string 1)))
+        gnus-browse-current-method)))))
 
 (defun gnus-browse-unsubscribe-group ()
   "Toggle subscription of the current group in the browse buffer."
index 1df730a..5293071 100644 (file)
@@ -568,7 +568,7 @@ Bind `print-quoted' and `print-readably' to t while printing."
     (save-excursion
       (save-restriction
        (goto-char beg)
-       (while (re-search-forward "[ \t]*\n" end 'move)
+       (while (re-search-forward "[ \t]+\\|[ \t]*\n" end 'move)
          (gnus-put-text-property beg (match-beginning 0) prop val)
          (setq beg (point)))
        (gnus-put-text-property beg (point) prop val)))))
index 2c77996..d782835 100644 (file)
@@ -584,7 +584,7 @@ deleted.  Point is left where the deleted region was."
   ;; Change group.
   (when (and group
             (not (equal group nnfolder-current-group)))
-    (let ((pathname-coding-system nnmail-pathname-coding-system))
+    (let ((file-name-coding-system nnmail-pathname-coding-system))
       (nnmail-activate 'nnfolder)
       (when (and (not (assoc group nnfolder-group-alist))
                 (not (file-exists-p
index 21cd1ee..8b81eb3 100644 (file)
@@ -468,7 +468,7 @@ parameter.  It should return nil, `warn' or `delete'."
     (condition-case ()
        (let ((coding-system-for-read nnmail-file-coding-system)
              (auto-mode-alist (mm-auto-mode-alist))
-             (pathname-coding-system nnmail-pathname-coding-system))
+             (file-name-coding-system nnmail-pathname-coding-system))
          (insert-file-contents file)
          t)
       (file-error nil))))
@@ -1623,7 +1623,7 @@ See the documentation for the variable `nnmail-split-fancy' for documentation."
 (defun nnmail-write-region (start end filename &optional append visit lockname)
   "Do a `write-region', and then set the file modes."
   (let ((coding-system-for-write nnmail-file-coding-system)
-       (pathname-coding-system nnmail-pathname-coding-system))
+       (file-name-coding-system nnmail-pathname-coding-system))
     (write-region start end filename append visit lockname)
     (set-file-modes filename nnmail-default-file-modes)))
 
index 6272d54..da72c95 100644 (file)
@@ -83,7 +83,7 @@ as unread by Gnus.")
           (large (and (numberp nnmail-large-newsgroup)
                       (> number nnmail-large-newsgroup)))
           (count 0)
-          (pathname-coding-system 'binary)
+          (file-name-coding-system nnmail-pathname-coding-system)
           beg article)
       (nnmh-possibly-change-directory newsgroup server)
       ;; We don't support fetching by Message-ID.
@@ -142,7 +142,7 @@ as unread by Gnus.")
   (let ((file (if (stringp id)
                  nil
                (concat nnmh-current-directory (int-to-string id))))
-       (pathname-coding-system 'binary)
+       (file-name-coding-system nnmail-pathname-coding-system)
        (nntp-server-buffer (or buffer nntp-server-buffer)))
     (and (stringp file)
         (file-exists-p file)
@@ -154,7 +154,7 @@ as unread by Gnus.")
   (nnheader-init-server-buffer)
   (nnmh-possibly-change-directory group server)
   (let ((pathname (nnmail-group-pathname group nnmh-directory))
-       (pathname-coding-system 'binary)
+       (file-name-coding-system nnmail-pathname-coding-system)
        dir)
     (cond
      ((not (file-directory-p pathname))
@@ -197,7 +197,7 @@ as unread by Gnus.")
 (deffoo nnmh-request-list (&optional server dir)
   (nnheader-insert "")
   (nnmh-possibly-change-directory nil server)
-  (let ((pathname-coding-system 'binary)
+  (let ((file-name-coding-system nnmail-pathname-coding-system)
        (nnmh-toplev
         (file-truename (or dir (file-name-as-directory nnmh-directory)))))
     (nnmh-request-list-1 nnmh-toplev))
@@ -410,7 +410,7 @@ as unread by Gnus.")
     (nnmh-open-server server))
   (when newsgroup
     (let ((pathname (nnmail-group-pathname newsgroup nnmh-directory))
-         (pathname-coding-system 'binary))
+         (file-name-coding-system nnmail-pathname-coding-system))
       (if (file-directory-p pathname)
          (setq nnmh-current-directory pathname)
        (error "No such newsgroup: %s" newsgroup)))))
@@ -459,7 +459,7 @@ as unread by Gnus.")
   "Compute the next article number in GROUP."
   (let ((active (cadr (assoc group nnmh-group-alist)))
        (dir (nnmail-group-pathname group nnmh-directory))
-       (pathname-coding-system 'binary)
+       (file-name-coding-system nnmail-pathname-coding-system)
        file)
     (unless active
       ;; The group wasn't known to nnmh, so we just create an active
index 07fdbc6..9fef341 100644 (file)
@@ -103,7 +103,7 @@ all.  This may very well take some time.")
       (let ((file nil)
            (number (length sequence))
            (count 0)
-           (pathname-coding-system 'binary)
+           (file-name-coding-system nnmail-pathname-coding-system)
            beg article)
        (if (stringp (car sequence))
            'headers
@@ -164,7 +164,7 @@ all.  This may very well take some time.")
 (deffoo nnml-request-article (id &optional group server buffer)
   (nnml-possibly-change-directory group server)
   (let* ((nntp-server-buffer (or buffer nntp-server-buffer))
-        (pathname-coding-system 'binary)
+        (file-name-coding-system nnmail-pathname-coding-system)
         path gpath group-num)
     (if (stringp id)
        (when (and (setq group-num (nnml-find-group-number id))
@@ -195,7 +195,7 @@ all.  This may very well take some time.")
            (string-to-int (file-name-nondirectory path)))))))
 
 (deffoo nnml-request-group (group &optional server dont-check)
-  (let ((pathname-coding-system 'binary))
+  (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)"))
@@ -253,7 +253,7 @@ all.  This may very well take some time.")
 (deffoo nnml-request-list (&optional server)
   (save-excursion
     (let ((nnmail-file-coding-system nnmail-active-file-coding-system)
-         (pathname-coding-system 'binary))
+         (file-name-coding-system nnmail-pathname-coding-system))
       (nnmail-find-file nnml-active-file))
     (setq nnml-group-alist (nnmail-get-active))
     t))
@@ -569,7 +569,7 @@ all.  This may very well take some time.")
   (if (not group)
       t
     (let ((pathname (nnmail-group-pathname group nnml-directory))
-         (pathname-coding-system 'binary))
+         (file-name-coding-system nnmail-pathname-coding-system))
       (when (not (equal pathname nnml-current-directory))
        (setq nnml-current-directory pathname
              nnml-current-group group