+2000-05-17 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * lisp/nndraft.el (nndraft-request-replace-article): Replace
+ `mm-text-coding-system' with `mail-source-text-coding-system';
+ Replace `mm-auto-save-coding-system' with
+ `message-draft-coding-system'.
+
+ * lisp/mail-source.el (mail-source-fetch-maildir): Replace
+ `mm-text-coding-system' with `mail-source-text-coding-system'.
+ (mail-source-text-coding-system): New variable.
+
+ * lisp/dgnushack.el (dgnushack-texi-format): Use
+ `output-coding-system' instead of `coding-system-for-write' when
+ old Mule is used.
+
2000-05-16 Katsumi Yamaoka <yamaoka@jpl.org>
* lisp/message.el (message-forward) Replace the use of `eolp' with
+2000-05-16 18:15:24 Shenghuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-group.el (gnus-group-apropos): Group name charset.
+ * gnus-sum.el (gnus-set-mode-line): Ditto.
+ * gnus-group.el (gnus-group-decoded-name): New function.
+ (gnus-group-edit-group): Use it.
+ * gnus-cus.el (gnus-group-customize): Use it.
+
+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
(require 'texinfmt)
(let ((auto-save-default nil)
(find-file-run-dired nil)
- coding-system-for-write)
+ coding-system-for-write
+ output-coding-system)
(let ((error 0)
file
(files ()))
(progn
(if buffer-file-name (kill-buffer (current-buffer)))
(find-file file)
- (setq coding-system-for-write buffer-file-coding-system)
+ (if (boundp 'MULE)
+ (setq coding-system-for-write buffer-file-coding-system)
+ (setq output-coding-system (symbol-value 'file-coding-system)))
(when (and addsuffix
(re-search-forward
"^@setfilename[\t ]+\\([^\t\n ]+\\)" nil t)
:tag "topic parameters"
"(gnus)Topic Parameters"))
(widget-insert " for <")
- (widget-insert (or group topic))
+ (widget-insert (gnus-group-decoded-name (or group topic)))
(widget-insert "> and press ")
(widget-create 'push-button
:tag "done"
: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 string charset (featurep 'mule))
+ (decode-coding-string string charset)
+ string))
+
+(defun gnus-group-decoded-name (string)
+ (let ((charset (gnus-group-name-charset nil string)))
+ (gnus-group-name-decode string charset)))
+
(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
((eq part 'method) "select method")
((eq part 'params) "group parameters")
(t "group info"))
- group)
+ (gnus-group-decoded-name group))
`(lambda (form)
(gnus-group-edit-group-done ',part ,group form)))))
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 (symbol-name 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
(while groups
;; Groups may be entered twice into the list of groups.
(when (not (string= (car groups) prev))
- (insert (setq prev (car groups)) "\n")
- (when (and gnus-description-hashtb
- (setq des (gnus-gethash (car groups)
- gnus-description-hashtb)))
- (insert " " des "\n")))
+ (setq prev (car groups))
+ (let ((charset (gnus-group-name-charset nil prev)))
+ (insert (gnus-group-name-decode prev charset) "\n")
+ (when (and gnus-description-hashtb
+ (setq des (gnus-gethash (car groups)
+ gnus-description-hashtb)))
+ (insert " " (gnus-group-name-decode des charset) "\n"))))
(setq groups (cdr groups)))
(goto-char (point-min))))
(pop-to-buffer obuf)))
(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)
- (gnus-select-method nil)
- name)
+ (let ((buffer-read-only nil) charset)
(while groups
- (setq group (car groups)
- name (format "%s" (car group)))
- (insert (if (cadr (gnus-gethash
- (gnus-group-prefixed-name name method)
- gnus-newsrc-hashtb))
- " " "K")
- (format "%7d: " (cdr group)) name "\n")
+ (setq group (car groups))
+ (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."
(let* ((mformat (symbol-value
(intern
(format "gnus-%s-mode-line-format-spec" where))))
- (gnus-tmp-group-name gnus-newsgroup-name)
+ (gnus-tmp-group-name (gnus-group-name-decode
+ gnus-newsgroup-name
+ (gnus-group-name-charset
+ nil
+ 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))
(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)))))
:group 'mail-source
:type 'number)
+(defvar mail-source-text-coding-system
+ (if (memq system-type '(windows-nt ms-dos ms-windows))
+ 'raw-text-dos
+ 'raw-text)
+ "Text-safe coding system (For removing ^M).")
+
;;; Internal variables.
(defvar mail-source-string ""
(when (and (not (file-directory-p file))
(not (if function
(funcall function file mail-source-crash-box)
- (let ((coding-system-for-write
- mm-text-coding-system)
- (coding-system-for-read
- mm-text-coding-system))
+ (let ((coding-system-for-write
+ mail-source-text-coding-system)
+ (coding-system-for-read
+ mail-source-text-coding-system)
+ (output-coding-system
+ mail-source-text-coding-system)
+ (input-coding-system
+ mail-source-text-coding-system))
(with-temp-file mail-source-crash-box
(insert-file-contents file)
(goto-char (point-min))
(nndraft-possibly-change-group group)
(let ((nnmail-file-coding-system
(if (equal group "drafts")
- mm-auto-save-coding-system
- mm-text-coding-system)))
+ message-draft-coding-system
+ mail-source-text-coding-system)))
(nnoo-parent-function 'nndraft 'nnmh-request-replace-article
(list article group buffer))))
;; Change group.
(when (and group
(not (equal group nnfolder-current-group)))
- (nnmail-activate 'nnfolder)
- (if dont-check
- (setq nnfolder-current-group group
- nnfolder-current-buffer nil)
- ;; If we have to change groups, see if we don't already have the
- ;; folder in memory. If we do, verify the modtime and destroy
- ;; the folder if needed so we can rescan it.
- (setq nnfolder-current-buffer
- (nth 1 (assoc group nnfolder-buffer-alist)))
-
- ;; If the buffer is not live, make sure it isn't in the alist. If it
- ;; is live, verify that nobody else has touched the file since last
- ;; time.
- (when (and nnfolder-current-buffer
- (not (gnus-buffer-live-p nnfolder-current-buffer)))
- (setq nnfolder-current-buffer nil))
-
- (setq nnfolder-current-group group)
-
- (when (or (not nnfolder-current-buffer)
- (not (verify-visited-file-modtime
- nnfolder-current-buffer)))
- (save-excursion
- (when (setq nnfolder-current-buffer (nnfolder-read-folder group))
- (set-buffer nnfolder-current-buffer)
- (push (list group nnfolder-current-buffer)
- nnfolder-buffer-alist)))))))
+ (let ((file-name-coding-system nnmail-pathname-coding-system)
+ (pathname-coding-system nnmail-pathname-coding-system))
+ (nnmail-activate 'nnfolder)
+ (when (and (not (assoc group nnfolder-group-alist))
+ (not (file-exists-p
+ (nnfolder-group-pathname group))))
+ ;; The group doesn't exist, so we create a new entry for it.
+ (push (list group (cons 1 0)) nnfolder-group-alist)
+ (nnfolder-save-active nnfolder-group-alist nnfolder-active-file))
+
+ (if dont-check
+ (setq nnfolder-current-group group
+ nnfolder-current-buffer nil)
+ (let (inf file)
+ ;; If we have to change groups, see if we don't already have the
+ ;; folder in memory. If we do, verify the modtime and destroy
+ ;; the folder if needed so we can rescan it.
+ (setq nnfolder-current-buffer
+ (nth 1 (assoc group nnfolder-buffer-alist)))
+
+ ;; If the buffer is not live, make sure it isn't in the alist. If it
+ ;; is live, verify that nobody else has touched the file since last
+ ;; time.
+ (when (and nnfolder-current-buffer
+ (not (gnus-buffer-live-p nnfolder-current-buffer)))
+ (setq nnfolder-buffer-alist (delq inf nnfolder-buffer-alist)
+ nnfolder-current-buffer nil))
+
+ (setq nnfolder-current-group group)
+
+ (when (or (not nnfolder-current-buffer)
+ (not (verify-visited-file-modtime
+ nnfolder-current-buffer)))
+ (save-excursion
+ (setq file (nnfolder-group-pathname group))
+ ;; See whether we need to create the new file.
+ (unless (file-exists-p file)
+ (gnus-make-directory (file-name-directory file))
+ (let ((nnmail-file-coding-system
+ (or nnfolder-file-coding-system-for-write
+ nnfolder-file-coding-system-for-write)))
+ (nnmail-write-region 1 1 file t 'nomesg)))
+ (when (setq nnfolder-current-buffer (nnfolder-read-folder group))
+ (set-buffer nnfolder-current-buffer)
+ (push (list group nnfolder-current-buffer)
+ nnfolder-buffer-alist)))))))))
(defun nnfolder-save-mail (group-art-list)
"Called narrowed to an article."
(let* ((file nil)
(number (length articles))
(count 0)
+ (file-name-coding-system 'binary)
(pathname-coding-system 'binary)
(case-fold-search t)
(cur (current-buffer))
(set-buffer nntp-server-buffer)
(delete-region (point-min) (point-max))
(let ((format-alist nil)
- (after-insert-file-functions nil))
+ (after-insert-file-functions nil))
(condition-case ()
(let ((auto-mode-alist (nnheader-auto-mode-alist))
+ (file-name-coding-system nnmail-pathname-coding-system)
(pathname-coding-system nnmail-pathname-coding-system))
(insert-file-contents-as-coding-system
nnmail-file-coding-system file)
(defun nnmail-write-region (start end filename &optional append visit lockname)
"Do a `write-region', and then set the file modes."
- (let ((pathname-coding-system nnmail-pathname-coding-system))
-
+ (let ((file-name-coding-system nnmail-pathname-coding-system)
+ (pathname-coding-system nnmail-pathname-coding-system))
(write-region-as-coding-system
nnmail-file-coding-system 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)
+ (pathname-coding-system nnmail-pathname-coding-system)
beg article)
(nnmh-possibly-change-directory newsgroup server)
;; We don't support fetching by Message-ID.
(large (and (numberp nnmail-large-newsgroup)
(> number nnmail-large-newsgroup)))
(count 0)
+ (file-name-coding-system 'binary)
(pathname-coding-system 'binary)
(case-fold-search t)
;;beg
(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)
+ (pathname-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)
+ (pathname-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)
+ (pathname-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)
+ (pathname-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)
+ (pathname-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)
+ (pathname-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)
+ (pathname-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)
+ (pathname-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)
+ (pathname-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)
+ (pathname-coding-system nnmail-pathname-coding-system))
(when (not (equal pathname nnml-current-directory))
(setq nnml-current-directory pathname
nnml-current-group group