-;;; mule-util.el --- Utility functions for mulitilingual environment (mule)
+;;; mule-util.el --- utility functions for mulitilingual environment (mule)
-;; Copyright (C) 1995 Free Software Foundation, Inc.
;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
+;; Licensed to the Free Software Foundation.
+;; Copyright (C) 2000, 2002 Free Software Foundation, Inc.
;; Keywords: mule, multilingual
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to
-;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
;;; Code:
;;;###autoload
(defun string-to-sequence (string type)
"Convert STRING to a sequence of TYPE which contains characters in STRING.
-TYPE should be `list' or `vector'.
-Multibyte characters are conserned."
- (or (eq type 'list) (eq type 'vector)
- (error "Invalid type: %s" type))
- (let* ((len (length string))
- (i 0)
- l ch)
- (while (< i len)
- (setq ch (sref string i))
- (setq l (cons ch l))
- (setq i (+ i (char-bytes ch))))
- (setq l (nreverse l))
- (if (eq type 'list)
- l
- (vconcat l))))
+TYPE should be `list' or `vector'."
+;;; (let ((len (length string))
+;;; (i 0)
+;;; val)
+ (cond ((eq type 'list)
+ ;; Applicable post-Emacs 20.2 and asymptotically ~10 times
+ ;; faster than the code below:
+ (append string nil))
+;;; (setq val (make-list len 0))
+;;; (let ((l val))
+;;; (while (< i len)
+;;; (setcar l (aref string i))
+;;; (setq l (cdr l) i (1+ i))))))
+ ((eq type 'vector)
+ ;; As above.
+ (vconcat string))
+;;; (setq val (make-vector len 0))
+;;; (while (< i len)
+;;; (aset val i (aref string i))
+;;; (setq i (1+ i))))
+ (t
+ (error "Invalid type: %s" type)))
+;;; val)
+)
+
+;;;###autoload
+(make-obsolete 'string-to-sequence
+ "use `string-to-list' or `string-to-vector'."
+ "21.4")
;;;###autoload
(defsubst string-to-list (string)
"Return a list of characters in STRING."
- (string-to-sequence string 'list))
+ (append string nil))
;;;###autoload
(defsubst string-to-vector (string)
"Return a vector of characters in STRING."
- (string-to-sequence string 'vector))
+ (vconcat string))
;;;###autoload
(defun store-substring (string idx obj)
"Embed OBJ (string or character) at index IDX of STRING."
- (let* ((str (cond ((stringp obj) obj)
- ((integerp obj) (char-to-string obj))
- (t (error
- "Invalid argument (should be string or character): %s"
- obj))))
- (string-len (length string))
- (len (length str))
- (i 0))
- (while (and (< i len) (< idx string-len))
- (aset string idx (aref str i))
- (setq idx (1+ idx) i (1+ i)))
- string))
+ (if (integerp obj)
+ (aset string idx obj)
+ (let ((len1 (length obj))
+ (len2 (length string))
+ (i 0))
+ (while (< i len1)
+ (aset string (+ idx i) (aref obj i))
+ (setq i (1+ i)))))
+ string)
;;;###autoload
-(defun truncate-string-to-width (str width &optional start-column padding)
- "Truncate string STR to fit in WIDTH columns.
-Optional 1st arg START-COLUMN if non-nil specifies the starting column.
-Optional 2nd arg PADDING if non-nil, space characters are padded at
-the head and tail of the resulting string to fit in WIDTH if necessary.
-If PADDING is nil, the resulting string may be narrower than WIDTH."
+(defun truncate-string-to-width (str end-column
+ &optional start-column padding ellipsis)
+ "Truncate string STR to end at column END-COLUMN.
+The optional 3rd arg START-COLUMN, if non-nil, specifies the starting
+column; that means to return the characters occupying columns
+START-COLUMN ... END-COLUMN of STR. Both END-COLUMN and START-COLUMN
+are specified in terms of character display width in the current
+buffer; see also `char-width'.
+
+The optional 4th arg PADDING, if non-nil, specifies a padding
+character (which should have a display width of 1) to add at the end
+of the result if STR doesn't reach column END-COLUMN, or if END-COLUMN
+comes in the middle of a character in STR. PADDING is also added at
+the beginning of the result if column START-COLUMN appears in the
+middle of a character in STR.
+
+If PADDING is nil, no padding is added in these cases, so
+the resulting string may be narrower than END-COLUMN.
+
+If ELLIPSIS is non-nil, it should be a string which will replace the
+end of STR (including any padding) if it extends beyond END-COLUMN,
+unless the display width of STR is equal to or less than the display
+width of ELLIPSIS. If it is non-nil and not a string, then ELLIPSIS
+defaults to \"...\"."
(or start-column
(setq start-column 0))
- (let ((len (length str))
+ (when (and ellipsis (not (stringp ellipsis)))
+ (setq ellipsis "..."))
+ (let ((str-len (length str))
+ (str-width (string-width str))
+ (ellipsis-len (if ellipsis (length ellipsis) 0))
+ (ellipsis-width (if ellipsis (string-width ellipsis) 0))
(idx 0)
(column 0)
(head-padding "") (tail-padding "")
ch last-column last-idx from-idx)
(condition-case nil
(while (< column start-column)
- (setq ch (sref str idx)
+ (setq ch (aref str idx)
column (+ column (char-width ch))
- idx (+ idx (char-bytes ch))))
- (args-out-of-range (setq idx len)))
+ idx (1+ idx)))
+ (args-out-of-range (setq idx str-len)))
(if (< column start-column)
- (if padding (make-string width ?\ ) "")
- (if (and padding (> column start-column))
- (setq head-padding (make-string (- column start-column) ?\ )))
+ (if padding (make-string end-column padding) "")
+ (when (and padding (> column start-column))
+ (setq head-padding (make-string (- column start-column) padding)))
(setq from-idx idx)
- (condition-case nil
- (while (< column width)
- (setq last-column column
- last-idx idx
- ch (sref str idx)
- column (+ column (char-width ch))
- idx (+ idx (char-bytes ch))))
- (args-out-of-range (setq idx len)))
- (if (> column width)
- (setq column last-column idx last-idx))
- (if (and padding (< column width))
- (setq tail-padding (make-string (- width column) ?\ )))
- (setq str (substring str from-idx idx))
- (if padding
- (concat head-padding str tail-padding)
- str))))
-
-;;; For backward compatiblity ...
+ (when (>= end-column column)
+ (if (and (< end-column str-width)
+ (> str-width ellipsis-width))
+ (setq end-column (- end-column ellipsis-width))
+ (setq ellipsis ""))
+ (condition-case nil
+ (while (< column end-column)
+ (setq last-column column
+ last-idx idx
+ ch (aref str idx)
+ column (+ column (char-width ch))
+ idx (1+ idx)))
+ (args-out-of-range (setq idx str-len)))
+ (when (> column end-column)
+ (setq column last-column
+ idx last-idx))
+ (when (and padding (< column end-column))
+ (setq tail-padding (make-string (- end-column column) padding))))
+ (concat head-padding (substring str from-idx idx)
+ tail-padding ellipsis))))
+
+;;; Test suite for truncate-string-to-width
+;; (dolist (test '((("" 0) . "")
+;; (("x" 1) . "x")
+;; (("xy" 1) . "x")
+;; (("xy" 2 1) . "y")
+;; (("xy" 0) . "")
+;; (("xy" 3) . "xy")
+;; (("\e$AVP\e(B" 0) . "")
+;; (("\e$AVP\e(B" 1) . "")
+;; (("\e$AVP\e(B" 2) . "\e$AVP\e(B")
+;; (("\e$AVP\e(B" 1 nil ? ) . " ")
+;; (("\e$AVPND\e(B" 3 1 ? ) . " ")
+;; (("x\e$AVP\e(Bx" 2) . "x")
+;; (("x\e$AVP\e(Bx" 3) . "x\e$AVP\e(B")
+;; (("x\e$AVP\e(Bx" 3) . "x\e$AVP\e(B")
+;; (("x\e$AVP\e(Bx" 4 1) . "\e$AVP\e(Bx")
+;; (("kor\e$(CGQ\e(Be\e$(C1[\e(Ban" 8 1 ? ) . "or\e$(CGQ\e(Be\e$(C1[\e(B")
+;; (("kor\e$(CGQ\e(Be\e$(C1[\e(Ban" 7 2 ? ) . "r\e$(CGQ\e(Be ")
+;; (("" 0 nil nil "...") . "")
+;; (("x" 3 nil nil "...") . "x")
+;; (("\e$AVP\e(B" 3 nil nil "...") . "\e$AVP\e(B")
+;; (("foo" 3 nil nil "...") . "foo")
+;; (("foo" 2 nil nil "...") . "fo") ;; XEmacs failure?
+;; (("foobar" 6 0 nil "...") . "foobar")
+;; (("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")
+;; ))
+;; (let (ret)
+;; (condition-case e
+;; (setq ret (apply #'truncate-string-to-width (car test)))
+;; (error (setq ret e)))
+;; (unless (equal ret (cdr test))
+;; (error "%s: expected %s, got %s"
+;; (prin1-to-string (cons 'truncate-string-to-width (car test)))
+;; (prin1-to-string (cdr test))
+;; (if (consp ret)
+;; (format "error: %s: %s" (car ret)
+;; (prin1-to-string (cdr ret)))
+;; (prin1-to-string ret))))))
+
+;;; For backward compatibility ...
;;;###autoload
(defalias 'truncate-string 'truncate-string-to-width)
-(make-obsolete 'truncate-string 'truncate-string-to-width)
+
+;;;###autoload
+(make-obsolete 'truncate-string 'truncate-string-to-width "20.1")
\f
;;; Nested alist handler. Nested alist is alist whose elements are
;;; also nested alist.
;;;###autoload
(defsubst nested-alist-p (obj)
- "Return t if OBJ is a nesetd alist.
+ "Return t if OBJ is a nested alist.
Nested alist is a list of the form (ENTRY . BRANCHES), where ENTRY is
any Lisp object, and BRANCHES is a list of cons cells of the form
-(KEY-ELEMENT . NESTED-ALIST).
+\(KEY-ELEMENT . NESTED-ALIST).
You can use a nested alist to store any Lisp object (ENTRY) for a key
sequence KEYSEQ, where KEYSEQ is a sequence of KEY-ELEMENT. KEYSEQ
;;;###autoload
(defun set-nested-alist (keyseq entry alist &optional len branches)
"Set ENTRY for KEYSEQ in a nested alist ALIST.
-Optional 4th arg LEN non-nil means the firlst LEN elements in KEYSEQ
+Optional 4th arg LEN non-nil means the first LEN elements in KEYSEQ
is considered.
Optional argument BRANCHES if non-nil is branches for a keyseq
longer than KEYSEQ.
See the documentation of `nested-alist-p' for more detail."
(or (nested-alist-p alist)
- (error "Invalid arguement %s" alist))
+ (error "Invalid argument %s" alist))
(let ((islist (listp keyseq))
(len (or len (length keyseq)))
(i 0)
(setq i (1+ i)))
(setcar alist entry)
(if branches
- (if (cdr alist)
- (error "Can't set branches for keyseq %s" keyseq)
- (setcdr alist branches)))))
+ (setcdr (last alist) branches))))
;;;###autoload
(defun lookup-nested-alist (keyseq alist &optional len start nil-for-too-long)
Optional 3rd argument NIL-FOR-TOO-LONG non-nil means return nil
even if ALIST is not deep enough."
(or (nested-alist-p alist)
- (error "invalid arguement %s" alist))
+ (error "Invalid argument %s" alist))
(or len
(setq len (length keyseq)))
(let ((i (or start 0)))
(if nil-for-too-long nil i)
alist)))
+\f
;; Coding system related functions.
;;;###autoload
-(defun set-coding-system-alist (target-type regexp coding-system
- &optional operation)
- "Update `coding-system-alist' according to the arguments.
-TARGET-TYPE specifies a type of the target: `file', `process', or `network'.
- TARGET-TYPE tells which slots of coding-system-alist should be affected.
- If `file', it affects slots for insert-file-contents and write-region.
- If `process', it affects slots for call-process, call-process-region, and
- start-process.
- If `network', it affects a slot for open-network-process.
-REGEXP is a regular expression matching a target of I/O operation.
-CODING-SYSTEM is a coding system to perform code conversion
- on the I/O operation, or a cons of coding systems for decoding and
- encoding respectively, or a function symbol which returns the cons.
-Optional arg OPERATION if non-nil specifies directly one of slots above.
- The valid value is: insert-file-contents, write-region,
- call-process, call-process-region, start-process, or open-network-stream.
-If OPERATION is specified, TARGET-TYPE is ignored.
-See the documentation of `coding-system-alist' for more detail."
- (or (stringp regexp)
- (error "Invalid regular expression: %s" regexp))
- (or (memq target-type '(file process network))
- (error "Invalid target type: %s" target-type))
- (if (symbolp coding-system)
- (if (not (fboundp coding-system))
- (progn
- (check-coding-system coding-system)
- (setq coding-system (cons coding-system coding-system))))
- (check-coding-system (car coding-system))
- (check-coding-system (cdr coding-system)))
- (let ((op-list (if operation (list operation)
- (cond ((eq target-type 'file)
- '(insert-file-contents write-region))
- ((eq target-type 'process)
- '(call-process call-process-region start-process))
- (t ; i.e. (eq target-type network)
- '(open-network-stream)))))
- slot)
- (while op-list
- (setq slot (assq (car op-list) coding-system-alist))
- (if slot
- (let ((chain (cdr slot)))
- (if (catch 'tag
- (while chain
- (if (string= regexp (car (car chain)))
- (progn
- (setcdr (car chain) coding-system)
- (throw 'tag nil)))
- (setq chain (cdr chain)))
- t)
- (setcdr slot (cons (cons regexp coding-system) (cdr slot)))))
- (setq coding-system-alist
- (cons (cons (car op-list) (list (cons regexp coding-system)))
- coding-system-alist)))
- (setq op-list (cdr op-list)))))
+(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))
;;;###autoload
-(defun coding-system-list ()
- "Return a list of all existing coding systems."
- (let (l)
- (mapatoms (lambda (x) (if (get x 'coding-system) (setq l (cons x l)))))
- l))
-
-\f
-;;; Composite charcater manipulations.
+(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))
;;;###autoload
-(defun compose-region (start end)
- "Compose all characters in the current region into one composite character.
-When called from a program, expects two arguments,
-positions (integers or markers) specifying the region."
- (interactive "r")
- (save-excursion
- (let ((str (buffer-substring start end)))
- (goto-char start)
- (delete-region start end)
- (insert (compose-string str)))))
+(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))
;;;###autoload
-(defun decompose-region (start end)
- "Decompose all composite characters in the current region.
-Composite characters are broken up into individual components.
-When called from a program, expects two arguments,
-positions (integers or markers) specifying the region."
- (interactive "r")
- (save-restriction
- (narrow-to-region start end)
- (goto-char (point-min))
- (let ((enable-multibyte-characters nil)
- ;; This matches the whole bytes of single composite character.
- (re-cmpchar "\200[\240-\377]+")
- p ch str)
- (while (re-search-forward re-cmpchar nil t)
- (setq str (buffer-substring (match-beginning 0) (match-end 0)))
- (delete-region (match-beginning 0) (match-end 0))
- (insert (decompose-composite-char (string-to-char str)))))))
+(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))
;;;###autoload
-(defconst reference-point-alist
- '((tl . 0) (tc . 1) (tr . 2)
- (ml . 3) (mc . 4) (mr . 5)
- (bl . 6) (bc . 7) (br . 8)
- (top-left . 0) (top-center . 1) (top-right . 2)
- (mid-left . 3) (mid-center . 4) (mid-right . 5)
- (bottom-left . 6) (bottom-center . 7) (bottom-right . 8)
- (0 . 0) (1 . 1) (2 . 2)
- (3 . 3) (4 . 4) (5 . 5)
- (6 . 6) (7 . 7) (8 . 8))
- "Alist of reference point symbols vs reference point codes.
-Meanings of reference point codes are as follows:
-
- 0----1----2 <-- ascent 0:tl or top-left
- | | 1:tc or top-center
- | | 2:tr or top-right
- | | 3:ml or mid-left
- | 4 <--+---- center 4:mc or mid-center
- | | 5:mr or mid-right
---- 3 5 <-- baseline 6:bl or bottom-left
- | | 7:bc or bottom-center
- 6----7----8 <-- descent 8:br or bottom-right
-
-Reference point symbols are to be used to specify composition rule of
-the form \(GLOBAL-REF-POINT . NEW-REF-POINT), where GLOBAL-REF-POINT
-is a reference point in the overall glyphs already composed, and
-NEW-REF-POINT is a reference point in the new glyph to be added.
-
-For instance, if GLOBAL-REF-POINT is 8 and NEW-REF-POINT is 1, the
-overall glyph is updated as follows:
-
- +-------+--+ <--- new ascent
- | | |
- | global| |
- | glyph | |
---- | | | <--- baseline (doesn't change)
- +----+--+--+
- | | new |
- | |glyph|
- +----+-----+ <--- new descent
-")
-
-;; Return a string for char CH to be embedded in multibyte form of
-;; composite character.
-(defun compose-chars-component (ch)
- (if (< ch 128)
- (format "\240%c" (+ ch 128))
- (let ((str (char-to-string ch)))
- (if (cmpcharp ch)
- (if (/= (aref str 1) ?\xFF)
- (error "Char %c can't be composed" ch)
- (substring str 2))
- (aset str 0 (+ (aref str 0) ?\x20))
- str))))
-
-;; Return a string for composition rule RULE to be embedded in
-;; multibyte form of composite character.
-(defsubst compose-chars-rule (rule)
- (char-to-string (+ ?\xA0
- (* (cdr (assq (car rule) reference-point-alist)) 9)
- (cdr (assq (cdr rule) reference-point-alist)))))
+(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))
+ (detect-coding-region ,from ,to))
+ ;; We must restore the internal database.
+ (set-coding-priority coding-category-list)
+ (update-coding-systems-internal)))
;;;###autoload
-(defun compose-chars (first-component &rest args)
- "Return one char string composed from the arguments.
-Each argument is a character (including a composite chararacter)
-or a composition rule.
-A composition rule has the form \(GLOBAL-REF-POINT . NEW-REF-POINT).
-See the documentation of `reference-point-alist' for more detail."
- (if (= (length args) 0)
- (char-to-string first-component)
- (let* ((with-rule (consp (car args)))
- (str (if with-rule (concat (vector leading-code-composition ?\xFF))
- (char-to-string leading-code-composition))))
- (setq str (concat str (compose-chars-component first-component)))
- (while args
- (if with-rule
- (progn
- (if (not (consp (car args)))
- (error "Invalid composition rule: %s" (car args)))
- (setq str (concat str (compose-chars-rule (car args))
- (compose-chars-component (car (cdr args))))
- args (cdr (cdr args))))
- (setq str (concat str (compose-chars-component (car args)))
- args (cdr args))))
- str)))
+(defun detect-coding-with-language-environment (from to lang-env)
+ "Detect a coding system of 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))))
;;;###autoload
-(defun decompose-composite-char (char &optional type with-composition-rule)
- "Convert composite character CHAR to a string containing components of CHAR.
-Optional 1st arg TYPE specifies the type of sequence returned.
-It should be `string' (default), `list', or `vector'.
-Optional 2nd arg WITH-COMPOSITION-RULE non-nil means the returned
-sequence contains embedded composition rules if any. In this case, the
-order of elements in the sequence is the same as arguments for
-`compose-chars' to create CHAR.
-If TYPE is omitted or is `string', composition rules are omitted
-even if WITH-COMPOSITION-RULE is t."
- (or type
- (setq type 'string))
- (let* ((len (composite-char-component-count char))
- (i (1- len))
- l)
- (setq with-composition-rule (and with-composition-rule
- (not (eq type 'string))
- (composite-char-composition-rule-p char)))
- (while (> i 0)
- (setq l (cons (composite-char-component char i) l))
- (if with-composition-rule
- (let ((rule (- (composite-char-composition-rule char i) ?\xA0)))
- (setq l (cons (cons (/ rule 9) (% rule 9)) l))))
- (setq i (1- i)))
- (setq l (cons (composite-char-component char 0) l))
- (cond ((eq type 'string)
- (apply 'concat-chars l))
- ((eq type 'list)
- l)
- (t ; i.e. TYPE is vector
- (vconcat l)))))
+(defun char-displayable-p (char)
+ "Return non-nil if we should be able to display CHAR.
+On a multi-font display, the test is only whether there is an
+appropriate font from the selected frame's fontset to display CHAR's
+charset in general. Since fonts may be specified on a per-character
+basis, this may not be accurate."
+ (cond ((< char 256)
+ ;; Single byte characters are always displayable.
+ t)
+ ((display-multi-font-p)
+ ;; On a window system, a character is displayable if we have
+ ;; a font for that character in the default face of the
+ ;; currently selected frame.
+ (car (internal-char-font nil char)))
+ (t
+ (let ((coding (terminal-coding-system)))
+ (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)))))))))
+\f
+(provide 'mule-util)
+
+;; Local Variables:
+;; coding: iso-2022-7bit
+;; End:
+;;; arch-tag: 5bdb52b6-a3a5-4529-b7a0-37d01b0e570b
;;; mule-util.el ends here