Mercurial > emacs

--- 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  <yamaoka@jpl.org>
+
+	* gnus-spec.el (gnus-spec-tab): Make a Lisp form which works
+	correctly even if there are wide characters.
+
+2004-12-21  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+	* rfc2231.el (rfc2231-parse-string): Decode encoded value after
+	concatenating segments rather than before concatenating them.
+	Suggested by ARISAWA Akihiro <ari@mbf.ocn.ne.jp>.
+
+2004-12-17  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+	* mm-util.el (mm-xemacs-find-mime-charset): New macro.
+
+2004-12-17  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* 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  <yamaoka@jpl.org>
+
+	* 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  <monnier@iro.umontreal.ca>

 	* gnus-art.el (gnus-narrow-to-page): Don't hardcode point-min.
--- 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)
--- 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
--- 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."
--- 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)
--- 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
--- 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)))))))