;; 2005, 2006, 2007, 2008
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H14PRO021
+;; Copyright (C) 2003
+;; National Institute of Advanced Industrial Science and Technology (AIST)
+;; Registration Number H13PRO009
;; Keywords: mule, multilingual
;; (("foobarbaz" 6 nil nil "...") . "foo...")
;; (("foobarbaz" 7 2 nil "...") . "ob...")
;; (("foobarbaz" 9 3 nil "...") . "barbaz")
-;; (("\e$B$3\e(Bh\e$B$s\e(Be\e$B$K\e(Bl\e$B$A\e(Bl\e$B$O\e(Bo" 15 1 ? t) . " h\e$B$s\e(Be\e$B$K\e(Bl\e$B$A\e(Bl\e$B$O\e(Bo")
-;; (("\e$B$3\e(Bh\e$B$s\e(Be\e$B$K\e(Bl\e$B$A\e(Bl\e$B$O\e(Bo" 14 1 ? t) . " h\e$B$s\e(Be\e$B$K\e(Bl\e$B$A\e(B...")
-;; (("x" 3 nil nil "\e$(0GnM$\e(B") . "x")
-;; (("\e$AVP\e(B" 2 nil nil "\e$(0GnM$\e(B") . "\e$AVP\e(B")
-;; (("\e$AVP\e(B" 1 nil ?x "\e$(0GnM$\e(B") . "x") ;; XEmacs error
-;; (("\e$AVPND\e(B" 3 nil ? "\e$(0GnM$\e(B") . "\e$AVP\e(B ") ;; XEmacs error
-;; (("foobarbaz" 4 nil nil "\e$(0GnM$\e(B") . "\e$(0GnM$\e(B")
-;; (("foobarbaz" 5 nil nil "\e$(0GnM$\e(B") . "f\e$(0GnM$\e(B")
-;; (("foobarbaz" 6 nil nil "\e$(0GnM$\e(B") . "fo\e$(0GnM$\e(B")
-;; (("foobarbaz" 8 3 nil "\e$(0GnM$\e(B") . "b\e$(0GnM$\e(B")
-;; (("\e$B$3\e(Bh\e$B$s\e(Be\e$B$K\e(Bl\e$B$A\e(Bl\e$B$O\e(Bo" 14 4 ?x "\e$BF|K\8l\e(B") . "xe\e$B$KF|K\8l\e(B")
-;; (("\e$B$3\e(Bh\e$B$s\e(Be\e$B$K\e(Bl\e$B$A\e(Bl\e$B$O\e(Bo" 13 4 ?x "\e$BF|K\8l\e(B") . "xex\e$BF|K\8l\e(B")
+;; (("\e$A$3\e(Bh\e$A$s\e(Be\e$A$K\e(Bl\e$A$A\e(Bl\e$A$O\e(Bo" 15 1 ? t) . " h\e$A$s\e(Be\e$A$K\e(Bl\e$A$A\e(Bl\e$A$O\e(Bo")
+;; (("\e$A$3\e(Bh\e$A$s\e(Be\e$A$K\e(Bl\e$A$A\e(Bl\e$A$O\e(Bo" 14 1 ? t) . " h\e$A$s\e(Be\e$A$K\e(Bl\e$A$A\e(B...")
+;; (("x" 3 nil nil "\e$(Gemk#\e(B") . "x")
+;; (("\e$AVP\e(B" 2 nil nil "\e$(Gemk#\e(B") . "\e$AVP\e(B")
+;; (("\e$AVP\e(B" 1 nil ?x "\e$(Gemk#\e(B") . "x") ;; XEmacs error
+;; (("\e$AVPND\e(B" 3 nil ? "\e$(Gemk#\e(B") . "\e$AVP\e(B ") ;; XEmacs error
+;; (("foobarbaz" 4 nil nil "\e$(Gemk#\e(B") . "\e$(Gemk#\e(B")
+;; (("foobarbaz" 5 nil nil "\e$(Gemk#\e(B") . "f\e$(Gemk#\e(B")
+;; (("foobarbaz" 6 nil nil "\e$(Gemk#\e(B") . "fo\e$(Gemk#\e(B")
+;; (("foobarbaz" 8 3 nil "\e$(Gemk#\e(B") . "b\e$(Gemk#\e(B")
+;; (("\e$A$3\e(Bh\e$A$s\e(Be\e$A$K\e(Bl\e$A$A\e(Bl\e$A$O\e(Bo" 14 4 ?x "\e$AHU1>\e$(Gk#\e(B") . "xe\e$A$KHU1>\e$(Gk#\e(B")
+;; (("\e$A$3\e(Bh\e$A$s\e(Be\e$A$K\e(Bl\e$A$A\e(Bl\e$A$O\e(Bo" 13 4 ?x "\e$AHU1>\e$(Gk#\e(B") . "xex\e$AHU1>\e$(Gk#\e(B")
;; ))
;; (let (ret)
;; (condition-case e
;;;###autoload
(defun coding-system-post-read-conversion (coding-system)
"Return the value of CODING-SYSTEM's `post-read-conversion' property."
- (coding-system-get coding-system 'post-read-conversion))
+ (coding-system-get coding-system :post-read-conversion))
;;;###autoload
(defun coding-system-pre-write-conversion (coding-system)
"Return the value of CODING-SYSTEM's `pre-write-conversion' property."
- (coding-system-get coding-system 'pre-write-conversion))
+ (coding-system-get coding-system :pre-write-conversion))
;;;###autoload
(defun coding-system-translation-table-for-decode (coding-system)
- "Return the value of CODING-SYSTEM's `translation-table-for-decode' property."
- (coding-system-get coding-system 'translation-table-for-decode))
+ "Return the value of CODING-SYSTEM's `decode-translation-table' property."
+ (coding-system-get coding-system :decode-translation-table))
;;;###autoload
(defun coding-system-translation-table-for-encode (coding-system)
- "Return the value of CODING-SYSTEM's `translation-table-for-encode' property."
- (coding-system-get coding-system 'translation-table-for-encode))
+ "Return the value of CODING-SYSTEM's `encode-translation-table' property."
+ (coding-system-get coding-system :encode-translation-table))
+
+;;;###autoload
+(defmacro with-coding-priority (coding-systems &rest body)
+ "Execute BODY like `progn' with CODING-SYSTEMS at the front of priority list.
+CODING-SYSTEMS is a list of coding systems. See
+`set-coding-priority'. This affects the implicit sorting of lists of
+coding sysems returned by operations such as `find-coding-systems-region'."
+ (let ((current (make-symbol "current")))
+ `(let ((,current (coding-system-priority-list)))
+ (apply #'set-coding-system-priority ,coding-systems)
+ (unwind-protect
+ (progn ,@body)
+ (apply #'set-coding-system-priority ,current)))))
+(put 'with-coding-priority 'lisp-indent-function 1)
+(put 'with-coding-priority 'edebug-form-spec t)
;;;###autoload
(defmacro detect-coding-with-priority (from to priority-list)
"Detect a coding system of the text between FROM and TO with PRIORITY-LIST.
PRIORITY-LIST is an alist of coding categories vs the corresponding
coding systems ordered by priority."
- `(unwind-protect
- (let* ((prio-list ,priority-list)
- (coding-category-list coding-category-list)
- ,@(mapcar (function (lambda (x) (list x x)))
- coding-category-list))
- (mapc (function (lambda (x) (set (car x) (cdr x))))
- prio-list)
- (set-coding-priority (mapcar #'car prio-list))
- ;; Changing the binding of a coding category requires this call.
- (update-coding-systems-internal)
- (detect-coding-region ,from ,to))
- ;; We must restore the internal database.
- (set-coding-priority coding-category-list)
- (update-coding-systems-internal)))
+ `(with-coding-priority (mapcar #'cdr ,priority-list)
+ (detect-coding-region ,from ,to)))
+(make-obsolete 'detect-coding-with-priority
+ "Use with-coding-priority and detect-coding-region" "23.1")
;;;###autoload
(defun detect-coding-with-language-environment (from to lang-env)
- "Detect a coding system of the text between FROM and TO with LANG-ENV.
+ "Detect a coding system for the text between FROM and TO with LANG-ENV.
The detection takes into account the coding system priorities for the
language environment LANG-ENV."
(let ((coding-priority (get-language-info lang-env 'coding-priority)))
(if coding-priority
- (detect-coding-with-priority
- from to
- (mapcar (function (lambda (x)
- (cons (coding-system-get x 'coding-category) x)))
- coding-priority))
- (detect-coding-region from to))))
+ (with-coding-priority coding-priority
+ (detect-coding-region from to)))))
;;;###autoload
(defun char-displayable-p (char)
;; currently selected frame.
(car (internal-char-font nil char)))
(t
- (let ((coding (terminal-coding-system)))
+ (let ((coding 'iso-2022-7bit))
(if coding
- (let ((safe-chars (coding-system-get coding 'safe-chars))
- (safe-charsets (coding-system-get coding 'safe-charsets)))
- (or (and safe-chars
- (aref safe-chars char))
- (and safe-charsets
- (memq (char-charset char) safe-charsets)))))))))
+ (let ((cs-list (coding-system-get coding :charset-list)))
+ (cond
+ ((listp cs-list)
+ (catch 'tag
+ (mapc #'(lambda (charset)
+ (if (encode-char char charset)
+ (throw 'tag charset)))
+ cs-list)
+ nil))
+ ((eq cs-list 'iso-2022)
+ (catch 'tag2
+ (mapc #'(lambda (charset)
+ (if (and (plist-get (charset-plist charset)
+ :iso-final-char)
+ (encode-char char charset))
+ (throw 'tag2 charset)))
+ charset-list)
+ nil))
+ ((eq cs-list 'emacs-mule)
+ (catch 'tag3
+ (mapc #'(lambda (charset)
+ (if (and (plist-get (charset-plist charset)
+ :emacs-mule-id)
+ (encode-char char charset))
+ (throw 'tag3 charset)))
+ charset-list)
+ nil)))))))))
\f
(provide 'mule-util)