emacs: lisp/gnus/mm-util.el comparison

comparison lisp/gnus/mm-util.el @ 57923:d7def5572cf3

Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-668 Merge from gnus--rel--5.10 Patches applied: * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-66 - miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-68 Update from CVS 2004-11-04 Katsumi Yamaoka <yamaoka@jpl.org> * lisp/gnus/gnus-art. (gnus-article-edit-article): Don't associate the article buffer with a draft file. This is a temporary measure against the 2004-08-22 change to gnus-article-edit-mode. 2004-11-02 Katsumi Yamaoka <yamaoka@jpl.org> * lisp/gnus/html2text.el (html2text-get-attr): Remove unused argument `tag'. (html2text-format-tags): Remove unused variable `attr'. * lisp/gnus/mm-util.el (mm-enrich-utf-8-by-mule-ucs): Fix cleaning of after-load-alist. * lisp/gnus/mm-util.el (mm-mime-mule-charset-alist): Add the windows-1251 entry. From Ilya N. Golubev <gin@mo.msk.ru>. (mm-enrich-utf-8-by-mule-ucs): New function run when Mule-UCS is loaded under XEmacs. (): Don't make duplicated entries in mm-mime-mule-charset-alist. * lisp/gnus/mm-util.el (mm-coding-system-p): Return a coding-system. (mm-mime-mule-charset-alist): Use shift_jis instead of iso-2022-jp-2 for the katakana-jisx0201 mule charset; add new entries for the mime charsets iso-2022-jp-3 and shift_jis. (mm-coding-system-priorities): Use shift_jis and iso-8859-1 instead of japanese-shift-jis and iso-latin-1 respectively in order to share the default value with both Emacs and XEmacs-mule. (mm-mule-charset-to-mime-charset): Make mm-coding-system-priorities effective. (mm-sort-coding-systems-predicate): Canonicalize coding-systems while predicating of candidates upon the priorities. 2004-11-02 Katsumi Yamaoka <yamaoka@jpl.org> * man/emacs-mime.texi (Encoding Customization): Fix mm-coding-system-priorities entry.

author	Miles Bader <miles@gnu.org>
date	Thu, 04 Nov 2004 08:12:39 +0000
parents	55829134ac17
children	22da0004ae3c e24e2e78deda

comparison

equal deleted inserted replaced

-:8089248edf3c
+:d7def5572cf3
 (or mm-coding-system-list
 (setq mm-coding-system-list (mm-coding-system-list))))
 (defun mm-coding-system-p (cs)
 "Return non-nil if CS is a symbol naming a coding system.
-In XEmacs, also return non-nil if CS is a coding system object."
+In XEmacs, also return non-nil if CS is a coding system object.
+If CS is available, return CS itself in Emacs, and return a coding
+system object in XEmacs."
 (if (fboundp 'find-coding-system)
 (find-coding-system cs)
 (if (fboundp 'coding-system-p)
-	(coding-system-p cs)
+	(when (coding-system-p cs)
+	  cs)
 ;; Is this branch ever actually useful?
-(memq cs (mm-get-coding-system-list)))))
+(car (memq cs (mm-get-coding-system-list))))))
 (defvar mm-charset-synonym-alist
 `(
 ;; Not in XEmacs, but it's not a proper MIME charset anyhow.
 ,@(unless (mm-coding-system-p 'x-ctext)
 (euc-kr korean-ksc5601)
 (gb2312 chinese-gb2312)
 (big5 chinese-big5-1 chinese-big5-2)
 (tibetan tibetan)
 (thai-tis620 thai-tis620)
+(windows-1251 cyrillic-iso8859-5)
 (iso-2022-7bit ethiopic arabic-1-column arabic-2-column)
 (iso-2022-jp-2 latin-iso8859-1 greek-iso8859-7
 		   latin-jisx0201 japanese-jisx0208-1978
 		   chinese-gb2312 japanese-jisx0208
-		   korean-ksc5601 japanese-jisx0212
+		   korean-ksc5601 japanese-jisx0212)
-		   katakana-jisx0201)
 (iso-2022-int-1 latin-iso8859-1 greek-iso8859-7
 		    latin-jisx0201 japanese-jisx0208-1978
 		    chinese-gb2312 japanese-jisx0208
 		    korean-ksc5601 japanese-jisx0212
 		    chinese-cns11643-1 chinese-cns11643-2)
 		    korean-ksc5601 japanese-jisx0212
 		    chinese-cns11643-1 chinese-cns11643-2
 		    chinese-cns11643-3 chinese-cns11643-4
 		    chinese-cns11643-5 chinese-cns11643-6
 		    chinese-cns11643-7)
+(iso-2022-jp-3 latin-jisx0201 japanese-jisx0208-1978 japanese-jisx0208
+		   japanese-jisx0213-1 japanese-jisx0213-2)
+(shift_jis latin-jisx0201 katakana-jisx0201 japanese-jisx0208)
 ,(if (or (not (fboundp 'charsetp)) ;; non-Mule case
 	     (charsetp 'unicode-a)
 	     (not (mm-coding-system-p 'mule-utf-8)))
 	 '(utf-8 unicode-a unicode-b unicode-c unicode-d unicode-e)
 ;; If we have utf-8 we're in Mule 5+.
 (append '(utf-8)
 	       (delete 'ascii
 		       (coding-system-get 'mule-utf-8 'safe-charsets)))))
 "Alist of MIME-charset/MULE-charsets.")
-;; Correct by construction, but should be unnecessary:
+(defun mm-enrich-utf-8-by-mule-ucs ()
-;; XEmacs hates it.
+"Make the `utf-8' MIME charset usable by the Mule-UCS package.
-(when (and (not (featurep 'xemacs))
+This function will run when the `un-define' module is loaded under
-	   (fboundp 'coding-system-list)
+XEmacs, and fill the `utf-8' entry in `mm-mime-mule-charset-alist'
-	   (fboundp 'sort-coding-systems))
+with Mule charsets.  It is completely useless for Emacs."
-(setq mm-mime-mule-charset-alist
+(unless (cdr (delete '(mm-enrich-utf-8-by-mule-ucs)
-	(apply
+		       (assoc "un-define" after-load-alist)))
-	 'nconc
+(setq after-load-alist
-	 (mapcar
+	  (delete '("un-define") after-load-alist)))
-	  (lambda (cs)
+(when (boundp 'unicode-basic-translation-charset-order-list)
-	    (when (and (or (coding-system-get cs :mime-charset)	; Emacs 22
+(condition-case nil
-			   (coding-system-get cs 'mime-charset))
+	(let ((val (delq
-		       (not (eq t (coding-system-get cs 'safe-charsets))))
+		    'ascii
-	      (list (cons (or (coding-system-get cs :mime-charset)
+		    (copy-sequence
-			      (coding-system-get cs 'mime-charset))
+		     (symbol-value
-			  (delq 'ascii
+		      'unicode-basic-translation-charset-order-list))))
-				(coding-system-get cs 'safe-charsets))))))
+	      (elem (assq 'utf-8 mm-mime-mule-charset-alist)))
-	  (sort-coding-systems (coding-system-list 'base-only))))))
+	  (if elem
+	      (setcdr elem val)
+	    (setq mm-mime-mule-charset-alist
+		  (nconc mm-mime-mule-charset-alist
+			 (list (cons 'utf-8 val))))))
+(error))))
+;; Correct by construction, but should be unnecessary for Emacs:
+(if (featurep 'xemacs)
+(eval-after-load "un-define" '(mm-enrich-utf-8-by-mule-ucs))
+(when (and (fboundp 'coding-system-list)
+	     (fboundp 'sort-coding-systems))
+(let ((css (sort-coding-systems (coding-system-list 'base-only)))
+	  cs mime mule alist)
+(while css
+	(setq cs (pop css)
+	      mime (or (coding-system-get cs :mime-charset) ; Emacs 22
+		       (coding-system-get cs 'mime-charset)))
+	(when (and mime
+		   (not (eq t (setq mule
+				    (coding-system-get cs 'safe-charsets))))
+		   (not (assq mime alist)))
+	  (push (cons mime (delq 'ascii mule)) alist)))
+(setq mm-mime-mule-charset-alist (nreverse alist)))))
 (defvar mm-hack-charsets '(iso-8859-15 iso-2022-jp-2)
 "A list of special charsets.
 Valid elements include:
 `iso-8859-15'    convert ISO-8859-1, -9 to ISO-8859-15 if ISO-8859-15 exists.
 (defun mm-mule-charset-to-mime-charset (charset)
 "Return the MIME charset corresponding to the given Mule CHARSET."
 (if (and (fboundp 'find-coding-systems-for-charsets)
 	   (fboundp 'sort-coding-systems))
-(let (mime)
+(let ((css (sort (sort-coding-systems
-	(dolist (cs (sort-coding-systems
+			(find-coding-systems-for-charsets (list charset)))
-		     (copy-sequence
+		       'mm-sort-coding-systems-predicate))
-		      (find-coding-systems-for-charsets (list charset)))))
+	    cs mime)
-	  (unless mime
+	(while (and (not mime)
-	    (when cs
+		    css)
-	      (setq mime (or (coding-system-get cs :mime-charset)
+	  (when (setq cs (pop css))
-			     (coding-system-get cs 'mime-charset))))))
+	    (setq mime (or (coding-system-get cs :mime-charset)
+			   (coding-system-get cs 'mime-charset)))))
 	mime)
-(let ((alist mm-mime-mule-charset-alist)
+(let ((alist (mapcar (lambda (cs)
+			   (assq cs mm-mime-mule-charset-alist))
+			 (sort (mapcar 'car mm-mime-mule-charset-alist)
+			       'mm-sort-coding-systems-predicate)))
 	  out)
 (while alist
 	(when (memq charset (cdar alist))
 	  (setq out (caar alist)
 		alist nil))
 (defun mm-sort-coding-systems-predicate (a b)
 (let ((priorities
 	 (mapcar (lambda (cs)
 		   ;; Note: invalid entries are dropped silently
-		   (and (coding-system-p cs)
+		   (and (setq cs (mm-coding-system-p cs))
 			(coding-system-base cs)))
 		 mm-coding-system-priorities)))
-(> (length (memq a priorities))
+(and (setq a (mm-coding-system-p a))
-(length (memq b priorities)))))
+	 (if (setq b (mm-coding-system-p b))
+	     (> (length (memq (coding-system-base a) priorities))
+		(length (memq (coding-system-base b) priorities)))
+	   t))))
 (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
 charset, and a longer list means no appropriate charset."

Mercurial > emacs

comparison lisp/gnus/mm-util.el @ 57923:d7def5572cf3