+2007-07-13 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-agent.el (gnus-agent-rename-group, gnus-agent-delete-group)
+ (gnus-agent-fetch-articles, gnus-agent-unfetch-articles)
+ (gnus-agent-crosspost, gnus-agent-backup-overview-buffer)
+ (gnus-agent-flush-group, gnus-agent-flush-cache)
+ (gnus-agent-fetch-headers, gnus-agent-load-alist)
+ (gnus-agent-read-agentview, gnus-agent-expire-group-1)
+ (gnus-agent-retrieve-headers, gnus-agent-request-article)
+ (gnus-agent-regenerate-group)
+ (gnus-agent-update-files-total-fetched-for)
+ (gnus-agent-update-view-total-fetched-for): Bind
+ file-name-coding-system to nnmail-pathname-coding-system.
+ (gnus-agent-group-pathname): Don't encode file names by
+ nnmail-pathname-coding-system.
+ (gnus-agent-save-local): Bind file-name-coding-system correctly; bind
+ coding-system-for-write instead of buffer-file-coding-system to
+ gnus-agent-file-coding-system.
+
+ * gnus-msg.el (gnus-inews-make-draft, gnus-inews-insert-archive-gcc):
+ Decode group name.
+
+ * gnus-srvr.el (gnus-browse-foreign-server): Make group names unibyte.
+
+ * gnus-start.el (gnus-update-active-hashtb-from-killed)
+ (gnus-read-newsrc-el-file): Make group names unibyte.
+
+ * nnmail.el (nnmail-group-pathname): Don't encode file names by
+ nnmail-pathname-coding-system.
+
+ * nnrss.el (nnrss-file-coding-system): Doc fix; make it begin with *.
+ (nnrss-request-delete-group): Bind file-name-coding-system to
+ nnmail-pathname-coding-system.
+ (nnrss-read-server-data, nnrss-read-group-data): Bind
+ file-name-coding-system correctly.
+ (nnrss-check-group): Pass nnrss-file-coding-system to md5.
+
+ * nntp.el: Require gnus-group for the function gnus-group-name-charset.
+ (nntp-server-to-method-cache): New variable.
+ (nntp-group-pathname): New function that decodes non-ASCII group names.
+ (nntp-possibly-create-directory, nntp-marks-changed-p)
+ (nntp-save-marks, nntp-open-marks): Use it.
+ (nntp-possibly-create-directory, nntp-open-marks):
+ Bind file-name-coding-system to nnmail-pathname-coding-system.
+ (nntp-open-marks): Decode group names when bootstrapping marks.
+
+ * rfc2047.el (rfc2047-encode-message-header): Make XEmacs decode
+ Newsgroups and Folowup-To headers.
+
2007-07-13 Katsumi Yamaoka <yamaoka@jpl.org>
* gnus-srvr.el (gnus-server-agent-face, gnus-server-opened-face)
(new-command-method (gnus-find-method-for-group new-group))
(new-path (directory-file-name
(let (gnus-command-method new-command-method)
- (gnus-agent-group-pathname new-group)))))
+ (gnus-agent-group-pathname new-group))))
+ (file-name-coding-system nnmail-pathname-coding-system))
(gnus-rename-file old-path new-path t)
(let* ((old-real-group (gnus-group-real-name old-group))
(let* ((command-method (gnus-find-method-for-group group))
(path (directory-file-name
(let (gnus-command-method command-method)
- (gnus-agent-group-pathname group)))))
+ (gnus-agent-group-pathname group))))
+ (file-name-coding-system nnmail-pathname-coding-system))
(gnus-delete-directory path)
(let* ((real-group (gnus-group-real-name group)))
(if (or nnmail-use-long-file-names
(file-directory-p (expand-file-name group (gnus-agent-directory))))
group
- (mm-encode-coding-string
- (nnheader-replace-chars-in-string group ?. ?/)
- nnmail-pathname-coding-system)))
+ (nnheader-replace-chars-in-string group ?. ?/)))
(defun gnus-agent-group-pathname (group)
"Translate GROUP into a file name."
(dir (gnus-agent-group-pathname group))
(date (time-to-days (current-time)))
(case-fold-search t)
- pos crosses id)
+ pos crosses id
+ (file-name-coding-system nnmail-pathname-coding-system))
(setcar selected-sets (nreverse (car selected-sets)))
(setq selected-sets (nreverse selected-sets))
(delete-this (pop articles)))
(while (and (cdr next-possibility) delete-this)
(let ((have-this (caar (cdr next-possibility))))
- (cond ((< delete-this have-this)
- (setq delete-this (pop articles)))
- ((= delete-this have-this)
- (let ((timestamp (cdar (cdr next-possibility))))
- (when timestamp
- (let* ((file-name (concat (gnus-agent-group-pathname group)
- (number-to-string have-this)))
- (size-file (float (or (and gnus-agent-total-fetched-hashtb
- (nth 7 (file-attributes file-name)))
- 0))))
- (delete-file file-name)
- (gnus-agent-update-files-total-fetched-for group (- size-file)))))
-
- (setcdr next-possibility (cddr next-possibility)))
- (t
- (setq next-possibility (cdr next-possibility))))))
+ (cond
+ ((< delete-this have-this)
+ (setq delete-this (pop articles)))
+ ((= delete-this have-this)
+ (let ((timestamp (cdar (cdr next-possibility))))
+ (when timestamp
+ (let* ((file-name (concat (gnus-agent-group-pathname group)
+ (number-to-string have-this)))
+ (size-file
+ (float (or (and gnus-agent-total-fetched-hashtb
+ (nth 7 (file-attributes file-name)))
+ 0)))
+ (file-name-coding-system
+ nnmail-pathname-coding-system))
+ (delete-file file-name)
+ (gnus-agent-update-files-total-fetched-for
+ group (- size-file)))))
+
+ (setcdr next-possibility (cddr next-possibility)))
+ (t
+ (setq next-possibility (cdr next-possibility))))))
(setq gnus-agent-article-alist (cdr alist))
(gnus-agent-save-alist group)))))
(when (= (point-max) (point-min))
(push (cons group (current-buffer)) gnus-agent-buffer-alist)
(ignore-errors
- (nnheader-insert-file-contents
- (gnus-agent-article-name ".overview" group))))
+ (let ((file-name-coding-system nnmail-pathname-coding-system))
+ (nnheader-insert-file-contents
+ (gnus-agent-article-name ".overview" group)))))
(nnheader-find-nov-line (string-to-number (cdar crosses)))
(insert (string-to-number (cdar crosses)))
(insert-buffer-substring gnus-agent-overview-buffer beg end)
(when gnus-newsgroup-name
(let ((root (gnus-agent-article-name ".overview" gnus-newsgroup-name))
(cnt 0)
- name)
+ name
+ (file-name-coding-system nnmail-pathname-coding-system))
(while (file-exists-p
(setq name (concat root "~"
(int-to-string (setq cnt (1+ cnt))) "~"))))
(let* ((gnus-command-method (or gnus-command-method
(gnus-find-method-for-group group)))
(overview (gnus-agent-article-name ".overview" group))
- (agentview (gnus-agent-article-name ".agentview" group)))
+ (agentview (gnus-agent-article-name ".agentview" group))
+ (file-name-coding-system nnmail-pathname-coding-system))
(if (file-exists-p overview)
(delete-file overview))
(gnus-agent-save-group-info nil group nil)))
(defun gnus-agent-flush-cache ()
-"Flush the agent's index files such that the group no longer
+ "Flush the agent's index files such that the group no longer
appears to have any local content. The actual content, the
article files, is then deleted using gnus-agent-expire-group. The
gnus-agent-regenerate-group method provides an undo mechanism by
reconstructing the index files from the article files."
(save-excursion
- (while gnus-agent-buffer-alist
- (set-buffer (cdar gnus-agent-buffer-alist))
- (let ((coding-system-for-write
- gnus-agent-file-coding-system))
- (write-region (point-min) (point-max)
- (gnus-agent-article-name ".overview"
- (caar gnus-agent-buffer-alist))
- nil 'silent))
- (setq gnus-agent-buffer-alist (cdr gnus-agent-buffer-alist)))
- (while gnus-agent-group-alist
- (with-temp-file (gnus-agent-article-name
- ".agentview" (caar gnus-agent-group-alist))
- (princ (cdar gnus-agent-group-alist))
- (insert "\n")
- (princ 1 (current-buffer))
- (insert "\n"))
- (setq gnus-agent-group-alist (cdr gnus-agent-group-alist)))))
+ (let ((file-name-coding-system nnmail-pathname-coding-system))
+ (while gnus-agent-buffer-alist
+ (set-buffer (cdar gnus-agent-buffer-alist))
+ (let ((coding-system-for-write gnus-agent-file-coding-system))
+ (write-region (point-min) (point-max)
+ (gnus-agent-article-name ".overview"
+ (caar gnus-agent-buffer-alist))
+ nil 'silent))
+ (setq gnus-agent-buffer-alist (cdr gnus-agent-buffer-alist)))
+ (while gnus-agent-group-alist
+ (with-temp-file (gnus-agent-article-name
+ ".agentview" (caar gnus-agent-group-alist))
+ (princ (cdar gnus-agent-group-alist))
+ (insert "\n")
+ (princ 1 (current-buffer))
+ (insert "\n"))
+ (setq gnus-agent-group-alist (cdr gnus-agent-group-alist))))))
;;;###autoload
(defun gnus-agent-find-parameter (group symbol)
(gnus-list-of-unread-articles group)))
(gnus-decode-encoded-word-function 'identity)
(gnus-decode-encoded-address-function 'identity)
- (file (gnus-agent-article-name ".overview" group)))
+ (file (gnus-agent-article-name ".overview" group))
+ (file-name-coding-system nnmail-pathname-coding-system))
(unless fetch-all
;; Add articles with marks to the list of article headers we want to
(defun gnus-agent-load-alist (group)
"Load the article-state alist for GROUP."
;; Bind free variable that's used in `gnus-agent-read-agentview'.
- (let ((gnus-agent-read-agentview group))
+ (let ((gnus-agent-read-agentview group)
+ (file-name-coding-system nnmail-pathname-coding-system))
(setq gnus-agent-article-alist
(gnus-cache-file-contents
(gnus-agent-article-name ".agentview" group)
;; If the agent directory exists, attempt to perform a brute-force
;; reconstruction of its contents.
(let* (alist
+ (file-name-coding-system nnmail-pathname-coding-system)
(file-attributes (directory-files-and-attributes
(gnus-agent-article-name ""
gnus-agent-read-agentview) nil "^[0-9]+$" t)))
(dest (gnus-agent-lib-file "local")))
(gnus-make-directory (gnus-agent-lib-file ""))
- (let ((buffer-file-coding-system gnus-agent-file-coding-system))
+ (let ((coding-system-for-write gnus-agent-file-coding-system)
+ (file-name-coding-system nnmail-pathname-coding-system))
(with-temp-file dest
(let ((gnus-command-method (symbol-value (intern "+method" my-obarray)))
- (file-name-coding-system nnmail-pathname-coding-system)
print-level print-length item article
(standard-output (current-buffer)))
(mapatoms (lambda (symbol)
;; gnus-command-method, initialized overview buffer, and to have
;; provided a non-nil active
- (let ((dir (gnus-agent-group-pathname group)))
+ (let ((dir (gnus-agent-group-pathname group))
+ (file-name-coding-system nnmail-pathname-coding-system))
(gnus-agent-with-refreshed-group
group
(when (boundp 'gnus-agent-expire-current-dirs)
(let ((gnus-decode-encoded-word-function 'identity)
(gnus-decode-encoded-address-function 'identity)
(file (gnus-agent-article-name ".overview" group))
- cached-articles uncached-articles)
+ cached-articles uncached-articles
+ (file-name-coding-system nnmail-pathname-coding-system))
(gnus-make-directory (nnheader-translate-file-chars
(file-name-directory file) t))
(numberp article))
(let* ((gnus-command-method (gnus-find-method-for-group group))
(file (gnus-agent-article-name (number-to-string article) group))
- (buffer-read-only nil))
+ (buffer-read-only nil)
+ (file-name-coding-system nnmail-pathname-coding-system))
(when (and (file-exists-p file)
(> (nth 7 (file-attributes file)) 0))
(erase-buffer)
(file (gnus-agent-article-name ".overview" group))
(dir (file-name-directory file))
point
+ (file-name-coding-system nnmail-pathname-coding-system)
(downloaded (if (file-exists-p dir)
(sort (delq nil (mapcar (lambda (name)
(and (not (file-directory-p (nnheader-concat dir name)))
(path (or path (gnus-agent-group-pathname group)))
(entry (or (gnus-gethash path gnus-agent-total-fetched-hashtb)
(gnus-sethash path (make-list 3 0)
- gnus-agent-total-fetched-hashtb))))
+ gnus-agent-total-fetched-hashtb)))
+ (file-name-coding-system nnmail-pathname-coding-system))
(when (listp delta)
(if delta
(let ((sum 0.0)
(entry (or (gnus-gethash path gnus-agent-total-fetched-hashtb)
(gnus-sethash path (make-list 3 0)
gnus-agent-total-fetched-hashtb)))
+ (file-name-coding-system nnmail-pathname-coding-system)
(size (or (nth 7 (file-attributes
(nnheader-concat
path (if agent-over
(defun gnus-inews-make-draft (articles)
`(lambda ()
(gnus-inews-make-draft-meta-information
- ,gnus-newsgroup-name ',articles)))
+ ,(gnus-group-decoded-name gnus-newsgroup-name) ',articles)))
(defvar gnus-article-reply nil)
(defmacro gnus-setup-message (config &rest forms)
(defun gnus-inews-insert-archive-gcc (&optional group)
"Insert the Gcc to say where the article is to be archived."
+ (setq group (cond (group
+ (gnus-group-decoded-name group))
+ (gnus-newsgroup-name
+ (gnus-group-decoded-name gnus-newsgroup-name))
+ (t
+ "")))
(let* ((var gnus-message-archive-group)
- (group (or group gnus-newsgroup-name ""))
(gcc-self-val
(and gnus-newsgroup-name
(not (equal gnus-newsgroup-name ""))
(while (not (eobp))
(ignore-errors
(push (cons
- (buffer-substring
- (point)
- (progn
- (skip-chars-forward "^ \t")
- (point)))
+ (mm-string-as-unibyte
+ (buffer-substring
+ (point)
+ (progn
+ (skip-chars-forward "^ \t")
+ (point))))
(let ((last (read cur)))
(cons (read cur) last)))
groups))
(while (not (eobp))
(ignore-errors
(push (cons
- (if (eq (char-after) ?\")
- (read cur)
- (let ((p (point)) (name ""))
- (skip-chars-forward "^ \t\\\\")
- (setq name (buffer-substring p (point)))
- (while (eq (char-after) ?\\)
- (setq p (1+ (point)))
- (forward-char 2)
- (skip-chars-forward "^ \t\\\\")
- (setq name (concat name (buffer-substring
- p (point)))))
- name))
+ (mm-string-as-unibyte
+ (if (eq (char-after) ?\")
+ (read cur)
+ (let ((p (point)) (name ""))
+ (skip-chars-forward "^ \t\\\\")
+ (setq name (buffer-substring p (point)))
+ (while (eq (char-after) ?\\)
+ (setq p (1+ (point)))
+ (forward-char 2)
+ (skip-chars-forward "^ \t\\\\")
+ (setq name (concat name (buffer-substring
+ p (point)))))
+ name)))
(let ((last (read cur)))
(cons (read cur) last)))
groups))
(while lists
(setq killed (car lists))
(while killed
- (gnus-sethash (car killed) nil hashtb)
+ (gnus-sethash (mm-string-as-unibyte (car killed)) nil hashtb)
(setq killed (cdr killed)))
(setq lists (cdr lists)))))
(setq gnus-format-specs gnus-default-format-specs)))
(when gnus-newsrc-assoc
(setq gnus-newsrc-alist gnus-newsrc-assoc))))
+ (dolist (elem gnus-newsrc-alist)
+ (setcar elem (mm-string-as-unibyte (car elem))))
(gnus-make-hashtable-from-newsrc-alist)
(when (file-newer-than-file-p file ding-file)
;; Old format quick file
(expand-file-name group dir)
;; If not, we translate dots into slashes.
(expand-file-name
- (mm-encode-coding-string
- (nnheader-replace-chars-in-string group ?. ?/)
- nnmail-pathname-coding-system)
+ (nnheader-replace-chars-in-string group ?. ?/)
dir))))
(or file "")))
ARTICLE is the article number of the current headline.")
(defvar nnrss-file-coding-system mm-universal-coding-system
- "Coding system used when reading and writing files.")
+ "*Coding system used when reading and writing files.
+If you run Gnus with various versions of Emacsen, the value of this
+variable should be the coding system that all those Emacsen support.
+Note that you have to regenerate all the nnrss groups if you change
+the value. Moreover, you should be patient even if you are made to
+read the same articles twice, that arises for the difference of the
+versions of xml.el.")
(defvar nnrss-compatible-encoding-alist
(delq nil (mapcar (lambda (elem)
(delq (assoc group nnrss-server-data) nnrss-server-data))
(nnrss-save-server-data server)
(ignore-errors
- (delete-file (nnrss-make-filename group server)))
+ (let ((file-name-coding-system nnmail-pathname-coding-system))
+ (delete-file (nnrss-make-filename group server))))
t)
(deffoo nnrss-request-list-newsgroups (&optional server)
(defun nnrss-read-server-data (server)
(setq nnrss-server-data nil)
- (let ((file (nnrss-make-filename "nnrss" server)))
+ (let ((file (nnrss-make-filename "nnrss" server))
+ (file-name-coding-system nnmail-pathname-coding-system))
(when (file-exists-p file)
;; In Emacs 21.3 and earlier, `load' doesn't support non-ASCII
;; file names. So, we use `insert-file-contents' instead.
(mm-with-multibyte-buffer
- (let ((coding-system-for-read nnrss-file-coding-system)
- (file-name-coding-system nnmail-pathname-coding-system))
+ (let ((coding-system-for-read nnrss-file-coding-system))
(insert-file-contents file)
(eval-region (point-min) (point-max)))))))
(let ((pair (assoc 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)))
+ (let ((file (nnrss-make-filename group server))
+ (file-name-coding-system nnmail-pathname-coding-system))
(when (file-exists-p file)
;; In Emacs 21.3 and earlier, `load' doesn't support non-ASCII
;; file names. So, we use `insert-file-contents' instead.
(mm-with-multibyte-buffer
- (let ((coding-system-for-read nnrss-file-coding-system)
- (file-name-coding-system nnmail-pathname-coding-system))
+ (let ((coding-system-for-read nnrss-file-coding-system))
(insert-file-contents file)
(eval-region (point-min) (point-max))))
(dolist (e nnrss-group-data)
(dolist (item (nreverse (nnrss-find-el (intern (concat rss-ns "item")) xml)))
(when (and (listp item)
(string= (concat rss-ns "item") (car item))
- (progn (setq hash-index (md5 (gnus-prin1-to-string item)))
+ (progn (setq hash-index (md5 (gnus-prin1-to-string item)
+ nil nil
+ nnrss-file-coding-system))
(not (gethash hash-index nnrss-group-hashtb))))
(setq subject (nnrss-node-text rss-ns 'title item))
(setq url (nnrss-decode-entities-string
(require 'nnoo)
(require 'gnus-util)
(require 'gnus)
+(require 'gnus-group) ;; gnus-group-name-charset
(nnoo-declare nntp)
(defun nntp-marks-directory (server)
(expand-file-name server nntp-marks-directory))
+(defvar nntp-server-to-method-cache nil
+ "Alist of servers and select methods.")
+
+(defun nntp-group-pathname (server group &optional file)
+ "Return an absolute file name of FILE for GROUP on SERVER."
+ (let ((method (cdr (assoc server nntp-server-to-method-cache))))
+ (unless method
+ (push (cons server (setq method (or (gnus-server-to-method server)
+ (gnus-find-method-for-group group))))
+ nntp-server-to-method-cache))
+ (nnmail-group-pathname
+ (mm-decode-coding-string group
+ (inline (gnus-group-name-charset method group)))
+ (nntp-marks-directory server)
+ file)))
+
(defun nntp-possibly-create-directory (group server)
- (let ((dir (nnmail-group-pathname
- group (nntp-marks-directory server))))
+ (let ((dir (nntp-group-pathname server group))
+ (file-name-coding-system nnmail-pathname-coding-system))
(unless (file-exists-p dir)
(make-directory (directory-file-name dir) t)
(nnheader-message 5 "Creating nntp marks directory %s" dir))))
(autoload 'time-less-p "time-date"))
(defun nntp-marks-changed-p (group server)
- (let ((file (expand-file-name
- nntp-marks-file-name
- (nnmail-group-pathname
- group (nntp-marks-directory server)))))
+ (let ((file (nntp-group-pathname server group nntp-marks-file-name)))
(if (null (gnus-gethash file nntp-marks-modtime))
t ;; never looked at marks file, assume it has changed
(time-less-p (gnus-gethash file nntp-marks-modtime)
(defun nntp-save-marks (group server)
(let ((file-name-coding-system nnmail-pathname-coding-system)
- (file (expand-file-name
- nntp-marks-file-name
- (nnmail-group-pathname
- group (nntp-marks-directory server)))))
+ (file (nntp-group-pathname server group nntp-marks-file-name)))
(condition-case err
(progn
(nntp-possibly-create-directory group server)
(error "Cannot write to %s (%s)" file err))))))
(defun nntp-open-marks (group server)
- (let ((file (expand-file-name
- nntp-marks-file-name
- (nnmail-group-pathname
- group (nntp-marks-directory server)))))
+ (let ((file (nntp-group-pathname server group nntp-marks-file-name))
+ (file-name-coding-system nnmail-pathname-coding-system))
(if (file-exists-p file)
(condition-case err
(with-temp-buffer
(let ((info (gnus-get-info
(gnus-group-prefixed-name
group
- (gnus-server-to-method (format "nntp:%s" server))))))
- (nnheader-message 7 "Bootstrapping marks for %s..." group)
+ (gnus-server-to-method (format "nntp:%s" server)))))
+ (decoded-name (mm-decode-coding-string
+ group
+ (gnus-group-name-charset
+ (gnus-server-to-method server) group))))
+ (nnheader-message 7 "Bootstrapping marks for %s..." decoded-name)
(setq nntp-marks (gnus-info-marks info))
(push (cons 'read (gnus-info-read info)) nntp-marks)
(dolist (el gnus-article-unpropagated-mark-lists)
(setq nntp-marks (gnus-remassoc el nntp-marks)))
(nntp-save-marks group server)
- (nnheader-message 7 "Bootstrapping marks for %s...done" group)))))
+ (nnheader-message 7 "Bootstrapping marks for %s...done"
+ decoded-name)))))
(provide 'nntp)
;;; (rfc2047-encode-region (point-min) (point-max))
;;; (error "Cannot send unencoded text")))
((mm-coding-system-p method)
- (if (and (featurep 'mule)
- (if (boundp 'default-enable-multibyte-characters)
- default-enable-multibyte-characters))
+ (if (or (and (featurep 'mule)
+ (if (boundp 'default-enable-multibyte-characters)
+ default-enable-multibyte-characters))
+ (featurep 'file-coding))
(mm-encode-coding-region (point) (point-max) method)))
;; Hm.
(t)))
projects / gnus / commitdiff