;;; mule-cmds.el --- commands for mulitilingual environment -*-coding: iso-2022-7bit -*-
+
+;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
;; Copyright (C) 1995, 2003 Electrotechnical Laboratory, JAPAN.
-;; Licensed to the Free Software Foundation.
-;; Copyright (C) 2000, 2001, 2002, 2003 Free Software Foundation, Inc.
+;; Licensed to the Free Software Foundation.
;; Copyright (C) 2003
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H13PRO009
(or (local-variable-p 'buffer-file-coding-system buffer)
(ucs-set-table-for-input buffer))))
- (if default-enable-multibyte-characters
+ (if (and default-enable-multibyte-characters (not (eq system-type 'darwin)))
+ ;; The file-name coding system on Darwin systems is always utf-8.
(setq default-file-name-coding-system coding-system))
;; If coding-system is nil, honor that on MS-DOS as well, so
;; that they could reset the terminal coding system.
function `select-safe-coding-system' (which see). This variable
overrides that argument.")
+(defun select-safe-coding-system-interactively (from to codings unsafe
+ &optional rejected default)
+ "Select interactively a coding system for the region FROM ... TO.
+FROM can be a string, as in `write-region'.
+CODINGS is the list of base coding systems known to be safe for this region,
+ typically obtained with `find-coding-systems-region'.
+UNSAFE is a list of coding systems known to be unsafe for this region.
+REJECTED is a list of coding systems which were safe but for some reason
+ were not recommended in the particular context.
+DEFAULT is the coding system to use by default in the query."
+ ;; At first, if some defaults are unsafe, record at most 11
+ ;; problematic characters and their positions for them by turning
+ ;; (CODING ...)
+ ;; into
+ ;; ((CODING (POS . CHAR) (POS . CHAR) ...) ...)
+ (if unsafe
+ (setq unsafe
+ (mapcar #'(lambda (coding)
+ (cons coding
+ (if (stringp from)
+ (mapcar #'(lambda (pos)
+ (cons pos (aref from pos)))
+ (unencodable-char-position
+ 0 (length from) coding
+ 11 from))
+ (mapcar #'(lambda (pos)
+ (cons pos (char-after pos)))
+ (unencodable-char-position
+ from to coding 11)))))
+ unsafe)))
+
+ ;; Change each safe coding system to the corresponding
+ ;; mime-charset name if it is also a coding system. Such a name
+ ;; is more friendly to users.
+ (let ((l codings)
+ mime-charset)
+ (while l
+ (setq mime-charset (coding-system-get (car l) :mime-charset))
+ (if (and mime-charset (coding-system-p mime-charset)
+ (coding-system-equal (car l) mime-charset))
+ (setcar l mime-charset))
+ (setq l (cdr l))))
+
+ ;; Don't offer variations with locking shift, which you
+ ;; basically never want.
+ (let (l)
+ (dolist (elt codings (setq codings (nreverse l)))
+ (unless (or (eq 'coding-category-iso-7-else
+ (coding-system-category elt))
+ (eq 'coding-category-iso-8-else
+ (coding-system-category elt)))
+ (push elt l))))
+
+ ;; Remove raw-text, emacs-mule and no-conversion unless nothing
+ ;; else is available.
+ (setq codings
+ (or (delq 'raw-text
+ (delq 'emacs-mule
+ (delq 'no-conversion codings)))
+ '(raw-text emacs-mule no-conversion)))
+
+ (let ((window-configuration (current-window-configuration))
+ (bufname (buffer-name))
+ coding-system)
+ (save-excursion
+ ;; If some defaults are unsafe, make sure the offending
+ ;; buffer is displayed.
+ (when (and unsafe (not (stringp from)))
+ (pop-to-buffer bufname)
+ (goto-char (apply 'min (mapcar #'(lambda (x) (car (cadr x)))
+ unsafe))))
+ ;; Then ask users to select one from CODINGS while showing
+ ;; the reason why none of the defaults are not used.
+ (with-output-to-temp-buffer "*Warning*"
+ (with-current-buffer standard-output
+ (if (and (null rejected) (null unsafe))
+ (insert "No default coding systems to try for "
+ (if (stringp from)
+ (format "string \"%s\"." from)
+ (format "buffer `%s'." bufname)))
+ (insert
+ "These default coding systems were tried to encode"
+ (if (stringp from)
+ (concat " \"" (if (> (length from) 10)
+ (concat (substring from 0 10) "...\"")
+ (concat from "\"")))
+ (format " text\nin the buffer `%s'" bufname))
+ ":\n")
+ (let ((pos (point))
+ (fill-prefix " "))
+ (dolist (x (append rejected unsafe))
+ (princ " ") (princ (car x)))
+ (insert "\n")
+ (fill-region-as-paragraph pos (point)))
+ (when rejected
+ (insert "These safely encodes the target text,
+but it is not recommended for encoding text in this context,
+e.g., for sending an email message.\n ")
+ (dolist (x rejected)
+ (princ " ") (princ x))
+ (insert "\n"))
+ (when unsafe
+ (insert (if rejected "And the others"
+ "However, each of them")
+ " encountered these problematic characters:\n")
+ (dolist (coding unsafe)
+ (insert (format " %s:" (car coding)))
+ (let ((i 0)
+ (func1
+ #'(lambda (bufname pos)
+ (when (buffer-live-p (get-buffer bufname))
+ (pop-to-buffer bufname)
+ (goto-char pos))))
+ (func2
+ #'(lambda (bufname pos coding)
+ (when (buffer-live-p (get-buffer bufname))
+ (pop-to-buffer bufname)
+ (if (< (point) pos)
+ (goto-char pos)
+ (forward-char 1)
+ (search-unencodable-char coding)
+ (forward-char -1))))))
+ (dolist (elt (cdr coding))
+ (insert " ")
+ (if (stringp from)
+ (insert (if (< i 10) (cdr elt) "..."))
+ (if (< i 10)
+ (insert-text-button
+ (cdr elt)
+ :type 'help-xref
+ 'help-echo
+ "mouse-2, RET: jump to this character"
+ 'help-function func1
+ 'help-args (list bufname (car elt)))
+ (insert-text-button
+ "..."
+ :type 'help-xref
+ 'help-echo
+ "mouse-2, RET: next unencodable character"
+ 'help-function func2
+ 'help-args (list bufname (car elt)
+ (car coding)))))
+ (setq i (1+ i))))
+ (insert "\n"))
+ (insert "\
+The first problematic character is at point in the displayed buffer,\n"
+ (substitute-command-keys "\
+and \\[universal-argument] \\[what-cursor-position] will give information about it.\n"))))
+ (insert "\nSelect \
+one of the following safe coding systems, or edit the buffer:\n")
+ (let ((pos (point))
+ (fill-prefix " "))
+ (dolist (x codings)
+ (princ " ") (princ x))
+ (insert "\n")
+ (fill-region-as-paragraph pos (point)))
+ (insert "Or specify any other coding system
+at the risk of losing the problematic characters.\n")))
+
+ ;; Read a coding system.
+ (setq coding-system
+ (read-coding-system
+ (format "Select coding system (default %s): " default)
+ default))
+ (setq last-coding-system-specified coding-system))
+
+ (kill-buffer "*Warning*")
+ (set-window-configuration window-configuration)
+ coding-system))
+
(defun select-safe-coding-system (from to &optional default-coding-system
accept-default-p file)
"Ask a user to select a safe coding system from candidates.
(let ((codings (find-coding-systems-region from to))
(coding-system nil)
- (bufname (buffer-name))
safe rejected unsafe)
;; Classify the defaults into safe, rejected, and unsafe.
(dolist (elt default-coding-system)
;; If all the defaults failed, ask a user.
(unless coding-system
- ;; At first, if some defaults are unsafe, record at most 11
- ;; problematic characters and their positions for them by turning
- ;; (CODING ...)
- ;; into
- ;; ((CODING (POS . CHAR) (POS . CHAR) ...) ...)
- (if unsafe
- (if (stringp from)
- (setq unsafe
- (mapcar #'(lambda (coding)
- (cons coding
- (mapcar #'(lambda (pos)
- (cons pos (aref from pos)))
- (unencodable-char-position
- 0 (length from) coding
- 11 from))))
- unsafe))
- (setq unsafe
- (mapcar #'(lambda (coding)
- (cons coding
- (mapcar #'(lambda (pos)
- (cons pos (char-after pos)))
- (unencodable-char-position
- from to coding 11))))
- unsafe))))
-
- ;; Change each safe coding system to the corresponding
- ;; mime-charset name if it is also a coding system. Such a name
- ;; is more friendly to users.
- (let ((l codings)
- mime-charset)
- (while l
- (setq mime-charset (coding-system-get (car l) :mime-charset))
- (if (and mime-charset (coding-system-p mime-charset)
- (coding-system-equal (car l) mime-charset))
- (setcar l mime-charset))
- (setq l (cdr l))))
-
- ;; Don't offer variations with locking shift, which you
- ;; basically never want.
- (let (l)
- (dolist (elt codings (setq codings (nreverse l)))
- (unless (or (eq 'coding-category-iso-7-else
- (coding-system-category elt))
- (eq 'coding-category-iso-8-else
- (coding-system-category elt)))
- (push elt l))))
-
- ;; Remove raw-text, emacs-mule and no-conversion unless nothing
- ;; else is available.
- (setq codings
- (or (delq 'raw-text
- (delq 'emacs-mule
- (delq 'no-conversion codings)))
- '(raw-text emacs-mule no-conversion)))
-
- (let ((window-configuration (current-window-configuration)))
- (save-excursion
- ;; If some defaults are unsafe, make sure the offending
- ;; buffer is displayed.
- (when (and unsafe (not (stringp from)))
- (pop-to-buffer bufname)
- (goto-char (apply 'min (mapcar #'(lambda (x) (car (cadr x)))
- unsafe))))
- ;; Then ask users to select one from CODINGS while showing
- ;; the reason why none of the defaults are not used.
- (with-output-to-temp-buffer "*Warning*"
- (save-excursion
- (set-buffer standard-output)
- (if (not default-coding-system)
- (insert "No default coding systems to try for "
- (if (stringp from)
- (format "string \"%s\"." from)
- (format "buffer `%s'." bufname)))
- (insert
- "These default coding systems were tried to encode"
- (if (stringp from)
- (concat " \"" (if (> (length from) 10)
- (concat (substring from 0 10) "...\"")
- (concat from "\"")))
- (format " text\nin the buffer `%s'" bufname))
- ":\n")
- (let ((pos (point))
- (fill-prefix " "))
- (mapc #'(lambda (x) (princ " ") (princ (car x)))
- default-coding-system)
- (insert "\n")
- (fill-region-as-paragraph pos (point)))
- (when rejected
- (insert "These safely encodes the target text,
-but it is not recommended for encoding text in this context,
-e.g., for sending an email message.\n ")
- (mapc #'(lambda (x) (princ " ") (princ x)) rejected)
- (insert "\n"))
- (when unsafe
- (insert (if rejected "And the others"
- "However, each of them")
- " encountered these problematic characters:\n")
- (mapc
- #'(lambda (coding)
- (insert (format " %s:" (car coding)))
- (let ((i 0)
- (func1
- #'(lambda (bufname pos)
- (when (buffer-live-p (get-buffer bufname))
- (pop-to-buffer bufname)
- (goto-char pos))))
- (func2
- #'(lambda (bufname pos coding)
- (when (buffer-live-p (get-buffer bufname))
- (pop-to-buffer bufname)
- (if (< (point) pos)
- (goto-char pos)
- (forward-char 1)
- (search-unencodable-char coding)
- (forward-char -1))))))
- (dolist (elt (cdr coding))
- (insert " ")
- (if (stringp from)
- (insert (if (< i 10) (cdr elt) "..."))
- (if (< i 10)
- (insert-text-button
- (cdr elt)
- :type 'help-xref
- 'help-echo
- "mouse-2, RET: jump to this character"
- 'help-function func1
- 'help-args (list bufname (car elt)))
- (insert-text-button
- "..."
- :type 'help-xref
- 'help-echo
- "mouse-2, RET: next unencodable character"
- 'help-function func2
- 'help-args (list bufname (car elt)
- (car coding)))))
- (setq i (1+ i))))
- (insert "\n"))
- unsafe)
- (insert "\
-The first problematic character is at point in the displayed buffer,\n"
- (substitute-command-keys "\
-and \\[universal-argument] \\[what-cursor-position] will give information about it.\n"))))
- (insert (if rejected
- "\nSelect the above, or "
- "\nSelect ")
- "\
-one of the following safe coding systems, or edit the buffer:\n")
- (let ((pos (point))
- (fill-prefix " "))
- (mapcar (function (lambda (x) (princ " ") (princ x)))
- codings)
- (insert "\n")
- (fill-region-as-paragraph pos (point)))
- (insert "Or specify any other coding system
-at the risk of losing the problematic characters.\n")))
-
- ;; Read a coding system.
- (setq default-coding-system (or (car safe) (car codings)))
- (setq coding-system
- (read-coding-system
- (format "Select coding system (default %s): "
- default-coding-system)
- default-coding-system))
- (setq last-coding-system-specified coding-system))
-
- (kill-buffer "*Warning*")
- (set-window-configuration window-configuration)))
+ (setq coding-system (select-safe-coding-system-interactively
+ from to codings unsafe rejected (car codings))))
(if (and coding-system (vectorp (coding-system-eol-type coding-system)))
(let ((eol (coding-system-eol-type buffer-file-coding-system)))
current-input-method-title nil)
(force-mode-line-update)))))
-(defun set-input-method (input-method)
+(defun set-input-method (input-method &optional interactive)
"Select and activate input method INPUT-METHOD for the current buffer.
This also sets the default input method to the one you specify.
If INPUT-METHOD is nil, this function turns off the input method, and
also causes you to be prompted for a name of an input method the next
time you invoke \\[toggle-input-method].
+When called interactively, the optional arg INTERACTIVE is non-nil,
+which marks the variable `default-input-method' as set for Custom buffers.
To deactivate the input method interactively, use \\[toggle-input-method].
To deactivate it programmatically, use \\[inactivate-input-method]."
(let* ((default (or (car input-method-history) default-input-method)))
(list (read-input-method-name
(if default "Select input method (default %s): " "Select input method: ")
- default t))))
+ default t)
+ t)))
(activate-input-method input-method)
(setq default-input-method input-method)
- (when (interactive-p)
+ (when interactive
(customize-mark-as-set 'default-input-method))
default-input-method)
-(defun toggle-input-method (&optional arg)
+(defun toggle-input-method (&optional arg interactive)
"Enable or disable multilingual text input method for the current buffer.
Only one input method can be enabled at any time in a given buffer.
With a prefix argument, read an input method name with the minibuffer
and enable that one. The default is the most recent input method specified
-\(not including the currently active input method, if any)."
+\(not including the currently active input method, if any).
- (interactive "P")
+When called interactively, the optional arg INTERACTIVE is non-nil,
+which marks the variable `default-input-method' as set for Custom buffers."
+
+ (interactive "P\np")
(if (and current-input-method (not arg))
(inactivate-input-method)
(let ((default (or (car input-method-history) default-input-method)))
(unless default-input-method
(prog1
(setq default-input-method current-input-method)
- (when (interactive-p)
+ (when interactive
(customize-mark-as-set 'default-input-method)))))))
(eval-when-compile (autoload 'help-buffer "help-mode"))
(set-default-coding-systems nil)
(setq default-sendmail-coding-system 'iso-latin-1)
+ ;; On Darwin systems, this should be utf-8, but when this file is loaded
+ ;; utf-8 is not yet defined, so we set it in set-locale-environment instead.
(setq default-file-name-coding-system 'iso-latin-1)
;; Preserve eol-type from existing default-process-coding-systems.
;; On non-unix-like systems in particular, these may have been set
(if (eq window-system 'pc)
(setq nonascii (intern "cp%d" dos-codepage)))
(or (and (charsetp nonascii)
- (= (charset-dimension nonascii) 1))
+ (get-charset-property nonascii :ascii-compatible-p))
(setq nonascii 'iso-8859-1))
(set-unibyte-charset nonascii))
(require (car required-features))
(setq required-features (cdr required-features))))
- ;; Don't invoke fontset-related functions if fontsets aren't
- ;; supported in this build of Emacs.
- (when (fboundp 'fontset-list)
- (let ((overriding-fontspec (get-language-info language-name
- 'overriding-fontspec)))
- (if overriding-fontspec
- (set-overriding-fontspec-internal overriding-fontspec))))
-
(let ((func (get-language-info language-name 'setup-function)))
(if (functionp func)
(funcall func)))
Setting this variable directly does not take effect. See
`set-language-info-alist' for use in programs."
:group 'mule
- :version "22.1"
+ :version "23.1"
:set (lambda (s v)
(custom-set-default s v)
;; Can't do this before language environments are set up.
;; different there.
(or (and (eq window-system 'pc) (not default-enable-multibyte-characters))
(progn
- ;; Make non-line-break space display as a plain space.
- ;; Most X fonts do the wrong thing for code 160.
- (aset standard-display-table 160 [32])
- ;; With luck, non-Latin-1 fonts are more recent and so don't
- ;; have this bug.
- (aset standard-display-table (make-char 'latin-iso8859-1 160) [32])
+ ;; Most X fonts used to do the wrong thing for latin-1 code 160.
+ (unless (and (eq window-system 'x)
+ ;; XFree86 4 has fixed the fonts.
+ (string= "The XFree86 Project, Inc" (x-server-vendor))
+ (> (aref (number-to-string (nth 2 (x-server-version))) 0)
+ ?3))
+ ;; Make non-line-break space display as a plain space.
+ (aset standard-display-table 160 [32]))
;; Most Windows programs send out apostrophes as \222. Most X fonts
;; don't contain a character at that position. Map it to the ASCII
;; apostrophe. [This is actually RIGHT SINGLE QUOTATION MARK,
;; fonts probably have the appropriate glyph at this position,
;; so they could use standard-display-8bit. It's better to use a
;; proper windows-1252 coding system. --fx]
- (aset standard-display-table 146 [39])
- ;; XFree86 4 has changed most of the fonts from their designed
- ;; versions such that `' no longer appears as balanced quotes.
- ;; Assume it has iso10646 fonts installed, so we can display
- ;; balanced quotes.
- (when (and (eq window-system 'x)
- (string= "The XFree86 Project, Inc" (x-server-vendor))
- (> (aref (number-to-string (nth 2 (x-server-version))) 0)
- ?3))
- ;; We suppress these setting for the moment because the
- ;; above assumption is wrong.
- ;; (aset standard-display-table ?' [?\e$B!G\e(B])
- ;; (aset standard-display-table ?` [?\e$B!F\e(B])
- ;; The fonts don't have the relevant bug.
- (aset standard-display-table 160 nil)
- (aset standard-display-table (make-char 'latin-iso8859-1 160)
- nil)))))
+ (aset standard-display-table 146 [39]))))
(defun set-language-environment-coding-systems (language-name
&optional eol-type)
(setq language-name (symbol-name language-name)))
(dolist (feature (get-language-info language-name 'features))
(require feature))
- (let ((doc (get-language-info language-name 'documentation))
- pos)
+ (let ((doc (get-language-info language-name 'documentation)))
(help-setup-xref (list #'describe-language-environment language-name)
(interactive-p))
(with-output-to-temp-buffer (help-buffer)
; zh_HK/BIG5-HKSCS \
("zh.*[._]big5" . "Chinese-BIG5")
- ("zh.*[._].gb18030" . "Chinese-GB18030") ; zh_CN.GB18030/GB18030 in glibc
- ("zh.*[._].gbk" . "Chinese-GBK")
+ ("zh.*[._]gb18030" . "Chinese-GB18030") ; zh_CN.GB18030/GB18030 in glibc
+ ("zh.*[._]gbk" . "Chinese-GBK")
;; glibc has zh_TW.EUC-TW, with zh_TW defaulting to Big5
("zh_tw" . "Chinese-CNS") ; glibc uses big5
("zh_tw[._]euc-tw" . "Chinese-EUC-TW")
(message "Warning: Default coding system `%s' disagrees with
system codeset `%s' for this locale." coding-system codeset))))))))
- ;; On Windows, override locale-coding-system, keyboard-coding-system,
- ;; selection-coding-system with system codepage.
+ ;; On Windows, override locale-coding-system,
+ ;; keyboard-coding-system with system codepage. Note:
+ ;; selection-coding-system is already set in w32select.c.
(when (boundp 'w32-ansi-code-page)
(let ((code-page-coding (intern (format "cp%d" w32-ansi-code-page))))
(when (coding-system-p code-page-coding)
(setq locale-coding-system code-page-coding)
- (set-selection-coding-system code-page-coding)
(set-keyboard-coding-system code-page-coding)
(set-terminal-coding-system code-page-coding))))
+ ;; On Darwin, file names are always encoded in utf-8, no matter the locale.
+ (when (eq system-type 'darwin)
+ (setq default-file-name-coding-system 'utf-8))
+
;; Default to A4 paper if we're not in a C, POSIX or US locale.
;; (See comments in Flocale_info.)
(let ((locale locale)
'a4))))))
nil)
\f
-;;; Character code property
-(put 'char-code-property-table 'char-table-extra-slots 0)
+;;; Character property
+
+;; Each element has the form (PROP . TABLE).
+;; PROP is a symbol representing a character property.
+;; TABLE is a char-table containing the property value for each character.
+;; TABLE may be a name of file to load to build a char-table.
+;; Don't modify this variable directly but use `define-char-code-property'.
+
+(defvar char-code-property-alist nil
+ "Alist of character property name vs char-table containing property values.
+Internal use only.")
+
+(put 'char-code-property-table 'char-table-extra-slots 5)
+
+(defun define-char-code-property (name table &optional docstring)
+ "Define NAME as a character code property given by TABLE.
+TABLE is a char-table of purpose `char-code-property-table' with
+these extra slots:
+ 1st: NAME.
+ 2nd: Function to call to get a property value of a character.
+ It is called with three arugments CHAR, VAL, and TABLE, where
+ CHAR is a character, VAL is the value of (aref TABLE CHAR).
+ 3rd: Function to call to put a property value of a character.
+ It is called with the same arguments as above.
+ 4th: Function to call to get a description string of a property value.
+ It is called with one argument VALUE, a property value.
+ 5th: Data used by the above functions.
+
+TABLE may be a name of file to load to build a char-table. The
+file should contain a call of `define-char-code-property' with a
+char-table of the above format as the argument TABLE.
+
+TABLE may also be nil, in which case no property value is pre-assigned.
+
+Optional 3rd argment DOCSTRING is a documentation string of the property.
+
+See also the documentation of `get-char-code-property' and
+`put-char-code-property'."
+ (or (symbolp name)
+ (error "Not a symbol: %s" name))
+ (if (char-table-p table)
+ (or (and (eq (char-table-subtype table) 'char-code-property-table)
+ (eq (char-table-extra-slot table 0) name))
+ (error "Invalid char-table: %s" table))
+ (or (stringp table)
+ (error "Not a char-table nor a file name: %s" table)))
+ (let ((slot (assq name char-code-property-alist)))
+ (if slot
+ (setcdr slot table)
+ (setq char-code-property-alist
+ (cons (cons name table) char-code-property-alist))))
+ (put name 'char-code-property-documentation docstring))
(defvar char-code-property-table
(make-char-table 'char-code-property-table)
"Char-table containing a property list of each character code.
-
+This table is used for properties not listed in `char-code-property-alist'.
See also the documentation of `get-char-code-property' and
`put-char-code-property'.")
(defun get-char-code-property (char propname)
- "Return the value of CHAR's PROPNAME property in `char-code-property-table'."
- (let ((plist (aref char-code-property-table char)))
- (if (listp plist)
- (car (cdr (memq propname plist))))))
+ "Return the value of CHAR's PROPNAME property."
+ (let ((slot (assq propname char-code-property-alist)))
+ (if slot
+ (let (table value func)
+ (if (stringp (cdr slot))
+ (load (cdr slot)))
+ (setq table (cdr slot)
+ value (aref table char)
+ func (char-table-extra-slot table 1))
+ (if (functionp func)
+ (setq value (funcall func char value table)))
+ value)
+ (plist-get (aref char-code-property-table char) propname))))
(defun put-char-code-property (char propname value)
- "Store CHAR's PROPNAME property with VALUE in `char-code-property-table'.
+ "Store CHAR's PROPNAME property with VALUE.
It can be retrieved with `(get-char-code-property CHAR PROPNAME)'."
- (let ((plist (aref char-code-property-table char)))
- (if plist
- (let ((slot (memq propname plist)))
- (if slot
- (setcar (cdr slot) value)
- (nconc plist (list propname value))))
- (aset char-code-property-table char (list propname value)))))
+ (let ((slot (assq propname char-code-property-alist)))
+ (if slot
+ (let (table func)
+ (if (stringp (cdr slot))
+ (load (cdr slot)))
+ (setq table (cdr slot)
+ func (char-table-extra-slot table 2))
+ (if (functionp func)
+ (funcall func char value table)
+ (aset table char value)))
+ (let* ((plist (aref char-code-property-table char))
+ (x (plist-put plist propname value)))
+ (or (eq x plist)
+ (aset char-code-property-table char x))))
+ value))
+
+(defun char-code-property-description (prop value)
+ "Return a description string of character property PROP's value VALUE.
+If there's no description string for VALUE, return nil."
+ (let ((slot (assq prop char-code-property-alist)))
+ (if slot
+ (let (table func)
+ (if (stringp (cdr slot))
+ (load (cdr slot)))
+ (setq table (cdr slot)
+ func (char-table-extra-slot table 3))
+ (if (functionp func)
+ (funcall func value))))))
\f
;; Pretty description of encoded string
(defvar nonascii-translation-table nil "This variable is obsolete.")
-;;; arch-tag: b382c432-4b36-460e-bf4c-05efd0bb18dc
+;; arch-tag: b382c432-4b36-460e-bf4c-05efd0bb18dc
;;; mule-cmds.el ends here