;; rs-sort-coding-systems-21-3-fix.el -- Fix broken `sort-coding-systems'
;; $Id: rs-sort-coding-systems-21-3-fix.el,v 1.11 2006/04/19 12:43:36 ste Exp $

;; Author: Reiner Steib <reiner.steib@gmx.de>
;; Keywords: i18n
;; X-URL: http://theotp1.physik.uni-ulm.de/~ste/comp/emacs/rs-sort-coding-systems-21-3-fix.el

;;; This program is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 2 of the License, or
;;; (at your option) any later version.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with this program; if not, write to the Free Software
;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

;;; Commentary:

;; Emacs 21.3 and Emacs 21.4 come with a slightly broken version of the
;; function `sort-coding-systems'.  Therefore in some cases, Gnus uses
;; utf-16-x rather than utf-8.  Additionally, it's not correct utf-16-be.  See
;; <URL:http://news.gmane.org/v9adfeig1c.fsf@marauder.physik.uni-ulm.de> for
;; details.
;;
;; This file provides a simple solution for this problem.  It's specific to
;; these Emacs versions, don't use is with other Emacs versions.

;; Required files:
;;
;; This file `rs-sort-coding-systems-21-3-fix.el'.
;;
;; If you want to byte-compile the files (not necessary), you should use:
;;
;; $ emacs -q -batch --no-site-file --multibyte -f batch-byte-compile \
;;     rs-sort-coding-systems-21-3-fix.el

;;; Installation:

;; Put `rs-sort-coding-systems-21-3-fix.el' in a directory that's at the
;; beginning of your `load-path', e.g. ~/lisp:
;;
;; ;; Make sure this path comes before system paths:
;; (setq load-path (nconc (list "~/lisp") load-path))
;;
;; Load the file, by adding the following in your startup file (usually
;; ~/.emacs):
;;
;; (require 'rs-sort-coding-systems-21-3-fix)
;;
;; That's all.

;;; Background information:

;; Note, that patching `international/mule-cmds.el' is not a proper solution,
;; because `mule-cmds.el' is dumped into the Emacs binary at build time.
;;
;; This is the relevant patch:
;;
;; --- mule-cmds.el	26 Dec 2002 17:27:20 -0000	1.216
;; +++ mule-cmds.el	3 Jan 2003 20:16:11 -0000	1.217
;; @@ -425,9 +425,18 @@
;;  		    (let ((base (coding-system-base x)))
;;  		      (+ (if (eq base most-preferred) 64 0)
;;  			 (let ((mime (coding-system-get base 'mime-charset)))
;; +			   ;; Prefer coding systems corresponding to a
;; +			   ;; MIME charset.
;;  			   (if mime
;; -			       (if (string-match "^x-" (symbol-name mime))
;; -				   16 32)
;; +			       ;; Lower utf-16 priority so that we
;; +			       ;; normally prefer utf-8 to it, and put
;; +			       ;; x-ctext below that.
;; +			       (cond ((or (eq base 'mule-utf-16-le)
;; +					  (eq base 'mule-utf-16-be))
;; +				      16)
;; +				     ((string-match "^x-" (symbol-name mime))
;; +				      8)
;; +				     (t 32))
;;  			     0))
;;  			 (if (memq base lang-preferred) 8 0)
;;  			 (if (string-match "-with-esc$" (symbol-name base))
;;
;; This is the ChangeLog entry:
;; ,----
;; | 2003-01-03  Dave Love  <fx@gnu.org>
;; |
;; | 	* international/mule-cmds.el (sort-coding-systems):
;; | 	Adjust priority of utf-16 and x-ctext.
;; `----
;;
;; The patch has been applied in the EMACS_21_1_RC branch:
;; <URL:http://article.gmane.org/gmane.emacs.devel/13709>.  But this branch
;; was never released, i.e. Emacs 21.4 also has this bug.

;;; Code:

(when (featurep 'xemacs)
  (error (concat "This file cannot be used with XEmacs.")))

;;;###autoload
(defun rs-sort-coding-systems (codings)
  "Sort coding system list CODINGS by a priority of each coding system.

The most preferred coding system has the highest priority.  Otherwise,
coding systems corresponding to some MIME charset has higher priority.
Among them, a coding system included in the `coding-priority' key of
the current language environment has highest priority.  See also the
documentation of `language-info-alist'.

If the variable `sort-coding-systems-predicate' (which see) is
non-nil, it is used to sort CODINGS differently from the above recipe.

The original version from `international/mule-cmds.el' is broken."
  (if sort-coding-systems-predicate
      (sort codings sort-coding-systems-predicate)
    (let* ((most-preferred (symbol-value (car coding-category-list)))
	   (lang-preferred (get-language-info current-language-environment
					      'coding-priority))
	   (func (function
		  (lambda (x)
		    (let ((base (coding-system-base x)))
		      (+ (if (eq base most-preferred) 64 0)
			 (let ((mime (coding-system-get base 'mime-charset)))
			   ;; Prefer coding systems corresponding to a
			   ;; MIME charset.
			   (if mime
			       ;; Lower utf-16 priority so that we
			       ;; normally prefer utf-8 to it, and put
			       ;; x-ctext below that.
			       (cond ((or (eq base 'mule-utf-16-le)
					  (eq base 'mule-utf-16-be))
				      16)
				     ((string-match "^x-" (symbol-name mime))
				      8)
				     (t 32))
			     0))
			 (if (memq base lang-preferred) 8 0)
			 (if (string-match "-with-esc$" (symbol-name base))
			     0 4)
			 (if (eq (coding-system-type base) 2)
			     ;; For ISO based coding systems, prefer
			     ;; one that doesn't use escape sequences.
			     (let ((flags (coding-system-flags base)))
			       (if (or (consp (aref flags 0))
				       (consp (aref flags 1))
				       (consp (aref flags 2))
				       (consp (aref flags 3)))
				   (if (or (aref flags 8) (aref flags 9))
				       0
				     1)
				 2))
			   1)))))))
      (sort codings (function (lambda (x y)
				(> (funcall func x) (funcall func y))))))))

(defun rs-sort-coding-systems-21-3-fix-p ()
  "Return non-nil iff we need to use `rs-sort-coding-systems'."
  (let ((pref (car (sort-coding-systems
		    (copy-sequence
		     '(mule-utf-16-be mule-utf-16-le mule-utf-8))))))
    ;;(message "pref=%s" pref)
    (not (eq 'mule-utf-8 pref))))
;; Suggested by Stefan Monnier in
;; http://article.gmane.org/gmane.emacs.devel/13662
;; Message-ID: <200305031842.h43IgBDm025358@rum.cs.yale.edu>

;;;###autoload
(defun rs-sort-coding-systems-initialize ()
  "Initialize `rs-sort-coding-systems' when needed."
  (interactive)
  (if (rs-sort-coding-systems-21-3-fix-p)
      (progn
	(message "Aliasing `sort-coding-systems' to `rs-sort-coding-systems'")
	(defalias 'sort-coding-systems 'rs-sort-coding-systems)
	t)
    (message
     (concat "`sort-coding-systems' in this Emacs build (%s of %s) and the\n"
	     "current language environment (%s) doesn't need this fix.")
     emacs-version
     (format-time-string "%Y-%m-%d" emacs-build-time)
     current-language-environment)
    nil))

(rs-sort-coding-systems-initialize)

;;; provide ourself

(provide 'rs-sort-coding-systems-21-3-fix)

;;; rs-sort-coding-systems-21-3-fix.el ends here

;; Local Variables:
;; coding: iso-latin-1
;; sentence-end-double-space: t
;; colon-double-space: nil
;; End: