# HG changeset patch # User Miles Bader # Date 1104104031 0 # Node ID 22da0004ae3c38c7227d20e658fabcfea723a882 # Parent ebbf26327c314b029589a91ed7dd44b224d9ecb7 Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-750 Merge from gnus--rel--5.10 Patches applied: * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-78 Merge from emacs--cvs-trunk--0 * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-79 - miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-80 Update from CVS 2004-12-22 Katsumi Yamaoka * lisp/gnus/gnus-spec.el (gnus-spec-tab): Make a Lisp form which works correctly even if there are wide characters. 2004-12-21 Katsumi Yamaoka * lisp/gnus/rfc2231.el (rfc2231-parse-string): Decode encoded value after concatenating segments rather than before concatenating them. Suggested by ARISAWA Akihiro . 2004-12-17 Katsumi Yamaoka * lisp/gnus/mm-util.el (mm-xemacs-find-mime-charset): New macro. 2004-12-17 Aidan Kehoe * lisp/gnus/mm-util.el (mm-xemacs-find-mime-charset-1): New function used to unify Latin characters in XEmacs. (mm-find-mime-charset-region): Use it. 2004-12-17 Katsumi Yamaoka * lisp/gnus/gnus-util.el (gnus-delete-directory): New function. * lisp/gnus/gnus-agent.el (gnus-agent-delete-group): Use it. * lisp/gnus/gnus-cache.el (gnus-cache-delete-group): Use it. diff -r ebbf26327c31 -r 22da0004ae3c lisp/gnus/ChangeLog --- a/lisp/gnus/ChangeLog Sun Dec 26 19:57:35 2004 +0000 +++ b/lisp/gnus/ChangeLog Sun Dec 26 23:33:51 2004 +0000 @@ -4,6 +4,35 @@ * gnus-sum.el (gnus-summary-mode-map): Likewise. +2004-12-22 Katsumi Yamaoka + + * gnus-spec.el (gnus-spec-tab): Make a Lisp form which works + correctly even if there are wide characters. + +2004-12-21 Katsumi Yamaoka + + * rfc2231.el (rfc2231-parse-string): Decode encoded value after + concatenating segments rather than before concatenating them. + Suggested by ARISAWA Akihiro . + +2004-12-17 Katsumi Yamaoka + + * mm-util.el (mm-xemacs-find-mime-charset): New macro. + +2004-12-17 Aidan Kehoe + + * mm-util.el (mm-xemacs-find-mime-charset-1): New function used to + unify Latin characters in XEmacs. + (mm-find-mime-charset-region): Use it. + +2004-12-17 Katsumi Yamaoka + + * gnus-util.el (gnus-delete-directory): New function. + + * gnus-agent.el (gnus-agent-delete-group): Use it. + + * gnus-cache.el (gnus-cache-delete-group): Use it. + 2004-12-08 Stefan Monnier * gnus-art.el (gnus-narrow-to-page): Don't hardcode point-min. diff -r ebbf26327c31 -r 22da0004ae3c lisp/gnus/gnus-agent.el --- a/lisp/gnus/gnus-agent.el Sun Dec 26 19:57:35 2004 +0000 +++ b/lisp/gnus/gnus-agent.el Sun Dec 26 23:33:51 2004 +0000 @@ -891,7 +891,7 @@ (path (directory-file-name (let (gnus-command-method command-method) (gnus-agent-group-pathname group))))) - (gnus-delete-file path) + (gnus-delete-directory path) (let* ((real-group (gnus-group-real-name group))) (gnus-agent-save-group-info command-method real-group nil) diff -r ebbf26327c31 -r 22da0004ae3c lisp/gnus/gnus-cache.el --- a/lisp/gnus/gnus-cache.el Sun Dec 26 19:57:35 2004 +0000 +++ b/lisp/gnus/gnus-cache.el Sun Dec 26 23:33:51 2004 +0000 @@ -754,7 +754,7 @@ disabled, as the old cache files would corrupt gnus when the cache was next enabled. Depends upon the caller to determine whether group deletion is supported." (let ((dir (gnus-cache-file-name group ""))) - (gnus-delete-file dir)) + (gnus-delete-directory dir)) (let ((no-save gnus-cache-active-hashtb)) (unless gnus-cache-active-hashtb diff -r ebbf26327c31 -r 22da0004ae3c lisp/gnus/gnus-spec.el --- a/lisp/gnus/gnus-spec.el Sun Dec 26 19:57:35 2004 +0000 +++ b/lisp/gnus/gnus-spec.el Sun Dec 26 23:33:51 2004 +0000 @@ -275,21 +275,15 @@ (defun gnus-spec-tab (column) (if (> column 0) - `(insert (make-string (max (- ,column (current-column)) 0) ? )) + `(insert-char ? (max (- ,column (current-column)) 0)) (let ((column (abs column))) - (if gnus-use-correct-string-widths - `(progn - (if (> (current-column) ,column) - (while (progn - (delete-backward-char 1) - (> (current-column) ,column)))) - (insert (make-string (max (- ,column (current-column)) 0) ? ))) - `(progn - (if (> (current-column) ,column) - (delete-region (point) - (- (point) (- (current-column) ,column))) - (insert (make-string (max (- ,column (current-column)) 0) - ? )))))))) + `(if (> (current-column) ,column) + (let ((end (point))) + (if (= (move-to-column ,column) ,column) + (delete-region (point) end) + (delete-region (1- (point)) end) + (insert " "))) + (insert-char ? (max (- ,column (current-column)) 0)))))) (defun gnus-correct-length (string) "Return the correct width of STRING." diff -r ebbf26327c31 -r 22da0004ae3c lisp/gnus/gnus-util.el --- a/lisp/gnus/gnus-util.el Sun Dec 26 19:57:35 2004 +0000 +++ b/lisp/gnus/gnus-util.el Sun Dec 26 23:33:51 2004 +0000 @@ -708,6 +708,23 @@ (when (file-exists-p file) (delete-file file))) +(defun gnus-delete-directory (directory) + "Delete files in DIRECTORY. Subdirectories remain. +If there's no subdirectory, delete DIRECTORY as well." + (when (file-directory-p directory) + (let ((files (directory-files + directory t "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*")) + file dir) + (while files + (setq file (pop files)) + (if (eq t (car (file-attributes file))) + ;; `file' is a subdirectory. + (setq dir t) + ;; `file' is a file or a symlink. + (delete-file file))) + (unless dir + (delete-directory directory))))) + (defun gnus-strip-whitespace (string) "Return STRING stripped of all whitespace." (while (string-match "[\r\n\t ]+" string) diff -r ebbf26327c31 -r 22da0004ae3c lisp/gnus/mm-util.el --- a/lisp/gnus/mm-util.el Sun Dec 26 19:57:35 2004 +0000 +++ b/lisp/gnus/mm-util.el Sun Dec 26 23:33:51 2004 +0000 @@ -576,6 +576,83 @@ (length (memq (coding-system-base b) priorities))) t)))) +(eval-when-compile + (autoload 'latin-unity-massage-name "latin-unity") + (autoload 'latin-unity-maybe-remap "latin-unity") + (autoload 'latin-unity-representations-feasible-region "latin-unity") + (autoload 'latin-unity-representations-present-region "latin-unity") + (defvar latin-unity-coding-systems) + (defvar latin-unity-ucs-list)) + +(defun mm-xemacs-find-mime-charset-1 (begin end) + "Determine which MIME charset to use to send region as message. +This uses the XEmacs-specific latin-unity package to better handle the +case where identical characters from diverse ISO-8859-? character sets +can be encoded using a single one of the corresponding coding systems. + +It treats `mm-coding-system-priorities' as the list of preferred +coding systems; a useful example setting for this list in Western +Europe would be '(iso-8859-1 iso-8859-15 utf-8), which would default +to the very standard Latin 1 coding system, and only move to coding +systems that are less supported as is necessary to encode the +characters that exist in the buffer. + +Latin Unity doesn't know about those non-ASCII Roman characters that +are available in various East Asian character sets. As such, its +behavior if you have a JIS 0212 LATIN SMALL LETTER A WITH ACUTE in a +buffer and it can otherwise be encoded as Latin 1, won't be ideal. +But this is very much a corner case, so don't worry about it." + (let ((systems mm-coding-system-priorities) csets psets curset) + + ;; Load the Latin Unity library, if available. + (when (and (not (featurep 'latin-unity)) (locate-library "latin-unity")) + (require 'latin-unity)) + + ;; Now, can we use it? + (if (featurep 'latin-unity) + (progn + (setq csets (latin-unity-representations-feasible-region begin end) + psets (latin-unity-representations-present-region begin end)) + + (catch 'done + + ;; Pass back the first coding system in the preferred list + ;; that can encode the whole region. + (dolist (curset systems) + (setq curset (latin-unity-massage-name 'buffer-default curset)) + + ;; If the coding system is a universal coding system, then + ;; it can certainly encode all the characters in the region. + (if (memq curset latin-unity-ucs-list) + (throw 'done (list curset))) + + ;; If a coding system isn't universal, and isn't in + ;; the list that latin unity knows about, we can't + ;; decide whether to use it here. Leave that until later + ;; in `mm-find-mime-charset-region' function, whence we + ;; have been called. + (unless (memq curset latin-unity-coding-systems) + (throw 'done nil)) + + ;; Right, we know about this coding system, and it may + ;; conceivably be able to encode all the characters in + ;; the region. + (if (latin-unity-maybe-remap begin end curset csets psets t) + (throw 'done (list curset)))) + + ;; Can't encode using anything from the + ;; `mm-coding-system-priorities' list. + ;; Leave `mm-find-mime-charset' to do most of the work. + nil)) + + ;; Right, latin unity isn't available; let `mm-find-charset-region' + ;; take its default action, which equally applies to GNU Emacs. + nil))) + +(defmacro mm-xemacs-find-mime-charset (begin end) + (when (featurep 'xemacs) + `(mm-xemacs-find-mime-charset-1 ,begin ,end))) + (defun mm-find-mime-charset-region (b e &optional hack-charsets) "Return the MIME charsets needed to encode the region between B and E. nil means ASCII, a single-element list represents an appropriate MIME @@ -617,8 +694,12 @@ (setq systems nil charsets (list cs)))))) charsets)) - ;; Otherwise we're not multibyte, we're XEmacs, or a single - ;; coding system won't cover it. + ;; If we're XEmacs, and some coding system is appropriate, + ;; mm-xemacs-find-mime-charset will return an appropriate list. + ;; Otherwise, we'll get nil, and the next setq will get invoked. + (setq charsets (mm-xemacs-find-mime-charset b e)) + + ;; We're not multibyte, or a single coding system won't cover it. (setq charsets (mm-delete-duplicates (mapcar 'mm-mime-charset diff -r ebbf26327c31 -r 22da0004ae3c lisp/gnus/rfc2231.el --- a/lisp/gnus/rfc2231.el Sun Dec 26 19:57:35 2004 +0000 +++ b/lisp/gnus/rfc2231.el Sun Dec 26 23:33:51 2004 +0000 @@ -88,7 +88,6 @@ (point) (progn (forward-sexp 1) (point)))))) (error "Invalid header: %s" string)) (setq c (char-after)) - (setq encoded nil) (when (eq c ?*) (forward-char 1) (setq c (char-after)) @@ -126,16 +125,22 @@ (point) (progn (forward-sexp) (point))))) (t (error "Invalid header: %s" string))) - (when encoded - (setq value (rfc2231-decode-encoded-string value))) (if number (setq prev-attribute attribute prev-value (concat prev-value value)) - (push (cons attribute value) parameters)))) + (push (cons attribute + (if encoded + (rfc2231-decode-encoded-string value) + value)) + parameters)))) ;; Take care of any final continuations. (when prev-attribute - (push (cons prev-attribute prev-value) parameters)) + (push (cons prev-attribute + (if encoded + (rfc2231-decode-encoded-string prev-value) + prev-value)) + parameters)) (when type `(,type ,@(nreverse parameters)))))))