2. group-name charset.
3. improve underlining.
+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
: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
(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.
(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))))))
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)))
((<= 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
(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
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)))))
(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
(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)))))))
(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))
(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."
(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)))))
;; 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
(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))))
(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)))
(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.
(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)
(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))
(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))
(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)))))
"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
(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
(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))
(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)"))
(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))
(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