lisp/international/mule-cmds.el

   1 ;;; mule-cmds.el --- Commands for mulitilingual environment
   2
   3 ;; Copyright (C) 1995 Free Software Foundation, Inc.
   4 ;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
   5
   6 ;; Keywords: mule, multilingual
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 2, or (at your option)
  13 ;; any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 ;; Boston, MA 02111-1307, USA.
  24
  25 ;;; Code:
  26
  27 ;;; MULE related key bindings and menus.
  28
  29 (defvar mule-keymap nil
  30   "Keymap for MULE (Multilingual environment) specific commands.")
  31 (define-prefix-command 'mule-keymap)
  32
  33 ;; Keep "C-x C-m ..." for mule specific commands.
  34 (define-key ctl-x-map "\C-m" 'mule-keymap)
  35
  36 (define-key mule-keymap "m" 'toggle-enable-multibyte-characters)
  37 (define-key mule-keymap "f" 'set-buffer-file-coding-system)
  38 (define-key mule-keymap "t" 'set-terminal-coding-system)
  39 (define-key mule-keymap "k" 'set-keyboard-coding-system)
  40 (define-key mule-keymap "p" 'set-buffer-process-coding-system)
  41 (define-key mule-keymap "\C-\\" 'select-input-method)
  42 (define-key mule-keymap "c" 'universal-coding-system-argument)
  43
  44 (define-key help-map "\C-L" 'describe-language-support)
  45 (define-key help-map "\C-\\" 'describe-input-method)
  46 (define-key help-map "C" 'describe-current-coding-system)
  47 (define-key help-map "h" 'view-hello-file)
  48
  49 (defvar mule-menu-keymap nil
  50   "Keymap for MULE (Multilingual environment) menu specific commands.")
  51 (define-prefix-command 'mule-menu-keymap)
  52
  53 (define-key global-map [menu-bar mule] (cons "Mule" mule-menu-keymap))
  54
  55 (setq menu-bar-final-items (cons 'mule menu-bar-final-items))
  56
  57 (defvar describe-language-support-map nil)
  58 (define-prefix-command 'describe-language-support-map)
  59
  60 (defvar setup-language-environment-map nil)
  61 (define-prefix-command 'setup-language-environment-map)
  62
  63 (defvar set-coding-system-map nil)
  64 (define-prefix-command 'set-coding-system-map)
  65
  66 (define-key-after mule-menu-keymap [toggle-mule]
  67   '("Toggle MULE facility" . toggle-enable-multibyte-characters)
  68   t)
  69 (define-key-after mule-menu-keymap [describe-language-support]
  70   '("Describe language support" . describe-language-support-map)
  71   t)
  72 (define-key-after mule-menu-keymap [set-language-environment]
  73   '("Set language environment" . setup-language-environment-map)
  74   t)
  75 (define-key-after mule-menu-keymap [separator-mule]
  76   '("--")
  77   t)
  78 (define-key-after mule-menu-keymap [toggle-input-method]
  79   '("Toggle input method" . toggle-input-method)
  80   t)
  81 (define-key-after mule-menu-keymap [select-input-method]
  82   '("Select input method" . select-input-method)
  83   t)
  84 (define-key-after mule-menu-keymap [describe-input-method]
  85   '("Describe input method" . describe-input-method)
  86   t)
  87 (define-key-after mule-menu-keymap [separator-input-method]
  88   '("--")
  89   t)
  90 (define-key-after mule-menu-keymap [describe-current-coding-system]
  91   '("Describe coding systems" . describe-current-coding-system)
  92   t)
  93 (define-key-after mule-menu-keymap [set-various-coding-system]
  94   '("Set coding systems" . set-coding-system-map)
  95   t)
  96 (define-key-after mule-menu-keymap [separator-coding-system]
  97   '("--")
  98   t)
  99 (define-key-after mule-menu-keymap [mule-diag]
 100   '("Show diagnosis for MULE" . mule-diag)
 101   t)
 102 (define-key-after mule-menu-keymap [view-hello-file]
 103   '("Show many languages" . view-hello-file)
 104   t)
 105
 106 (define-key-after set-coding-system-map [set-buffer-file-coding-system]
 107   '("Buffer file" . set-buffer-file-coding-system)
 108   t)
 109 (define-key-after set-coding-system-map [set-terminal-coding-system]
 110   '("Terminal" . set-terminal-coding-system)
 111   t)
 112 (define-key-after set-coding-system-map [set-keyboard-coding-system]
 113   '("Keyboard" . set-keyboard-coding-system)
 114   t)
 115 (define-key-after set-coding-system-map [set-buffer-process-coding-system]
 116   '("Buffer process" . set-buffer-process-coding-system)
 117   t)
 118
 119 (define-key setup-language-environment-map
 120   [Default] '("Default" . setup-specified-language-environment))
 121
 122 ;; These are meaningless when running under X.
 123 (put 'set-terminal-coding-system 'menu-enable
 124      '(null window-system))
 125 (put 'set-keyboard-coding-system 'menu-enable
 126      '(null window-system))
 127
 128 ;; This should be a single character key binding because users use it
 129 ;; very frequently while editing multilingual text.  Now we can use
 130 ;; only two such keys: "\C-\\" and "\C-^", but the latter is not
 131 ;; convenient because it requires shifting on most keyboards.  An
 132 ;; alternative is "\C-\]" which is now bound to `abort-recursive-edit'
 133 ;; but it won't be used that frequently.
 134 (define-key global-map "\C-\\" 'toggle-input-method)
 135
 136 (defun toggle-enable-multibyte-characters (&optional arg)
 137   "Change whether this buffer enables multibyte characters.
 138 With arg, make them enable iff arg is positive."
 139   (interactive "P")
 140   (setq enable-multibyte-characters
 141         (if (null arg) (null enable-multibyte-characters)
 142           (> (prefix-numeric-value arg) 0)))
 143   (force-mode-line-update))
 144
 145 (defun view-hello-file ()
 146   "Display the HELLO file which list up many languages and characters."
 147   (interactive)
 148   ;; We have to decode the file in any environment.
 149   (let ((default-enable-multibyte-characters t)
 150         (coding-system-for-read 'iso-2022-7))
 151     (find-file-read-only (expand-file-name "HELLO" data-directory))))
 152
 153 (defun universal-coding-system-argument ()
 154   "Execute an I/O command using the specified coding system."
 155   (interactive)
 156   (let* ((coding-system (read-coding-system "Coding system: "))
 157          (keyseq (read-key-sequence
 158                   (format "With coding system %s:" coding-system)))
 159          (cmd (key-binding keyseq)))
 160     (let ((coding-system-for-read coding-system)
 161           (coding-system-for-write coding-system))
 162       (message "")
 163       (call-interactively cmd))))
 164
 165 \f
 166 ;;; Language support staffs.
 167
 168 (defvar primary-language "English"
 169   "Name of a user's primary language.
 170 Emacs provide various language supports based on this variable.")
 171
 172 (defvar language-info-alist nil
 173   "Alist of language names vs the corresponding information of various kind.
 174 Each element looks like:
 175         (LANGUAGE-NAME . ((KEY . INFO) ...))
 176 where LANGUAGE-NAME is a string,
 177 KEY is a symbol denoting the kind of information,
 178 INFO is any Lisp object which contains the actual information related
 179 to KEY.")
 180
 181 (defun get-language-info (language-name key)
 182   "Return the information for LANGUAGE-NAME of the kind KEY.
 183 LANGUAGE-NAME is a string.
 184 KEY is a symbol denoting the kind of required information."
 185   (let ((lang-slot (assoc-ignore-case language-name language-info-alist)))
 186     (if lang-slot
 187         (cdr (assq key (cdr lang-slot))))))
 188
 189 (defun set-language-info (language-name key info)
 190   "Set for LANGUAGE-NAME the information INFO under KEY.
 191 LANGUAGE-NAME is a string
 192 KEY is a symbol denoting the kind of information.
 193 INFO is any Lisp object which contains the actual information.
 194
 195 Currently, the following KEYs are used by Emacs:
 196 charset: list of symbols whose values are charsets specific to the language.
 197 coding-system: list of coding systems specific to the langauge.
 198 tutorial: a tutorial file name written in the language.
 199 sample-text: one line short text containing characters of the language.
 200 input-method: alist of input method names for the language vs information
 201   for activating them.  Use `register-input-method' (which see)
 202   to add a new input method to the alist.
 203 documentation: t or a string describing how Emacs supports the language.
 204   If a string is specified, it is shown before any other information
 205   of the language by the command describe-language-support.
 206 setup-function: a function to call for setting up environment
 207  convenient for a user of the language.
 208
 209 If KEY is documentation or setup-function, you can also specify
 210 a cons cell as INFO, in which case, the car part should be
 211 a normal value as INFO for KEY (as described above),
 212 and the cdr part should be a symbol whose value is a menu keymap
 213 in which an entry for the language is defined.  But, only the car part
 214 is actually set as the information.
 215
 216 Emacs will use more KEYs in the future.  To avoid conflict, users
 217 should use prefix \"user-\" in the name of KEY if he wants to set
 218 different kind of information for personal use."
 219   (let (lang-slot key-slot)
 220     (setq lang-slot (assoc language-name language-info-alist))
 221     (if (null lang-slot)                ; If no slot for the language, add it.
 222         (setq lang-slot (list language-name)
 223               language-info-alist (cons lang-slot language-info-alist)))
 224     (setq key-slot (assq key lang-slot))
 225     (if (null key-slot)                 ; If no slot for the key, add it.
 226         (progn
 227           (setq key-slot (list key))
 228           (setcdr lang-slot (cons key-slot (cdr lang-slot)))))
 229     ;; Setup menu.
 230     (cond ((eq key 'documentation)
 231            (define-key-after
 232              (if (consp info)
 233                  (prog1 (symbol-value (cdr info))
 234                    (setq info (car info)))
 235                describe-language-support-map)
 236              (vector (intern language-name))
 237              (cons language-name 'describe-specified-language-support)
 238              t))
 239           ((eq key 'setup-function)
 240            (define-key-after
 241              (if (consp info)
 242                  (prog1 (symbol-value (cdr info))
 243                    (setq info (car info)))
 244                setup-language-environment-map)
 245              (vector (intern language-name))
 246              (cons language-name 'setup-specified-language-environment)
 247              t)))
 248
 249     (setcdr key-slot info)
 250     ))
 251
 252 (defun set-language-info-alist (language-name alist)
 253   "Set for LANGUAGE-NAME the information in ALIST.
 254 ALIST is an alist of KEY and INFO.  See the documentation of
 255 `set-langauge-info' for the meanings of KEY and INFO."
 256   (while alist
 257     (set-language-info language-name (car (car alist)) (cdr (car alist)))
 258     (setq alist (cdr alist))))
 259
 260 (defun read-language-name (key prompt &optional initial-input)
 261   "Read language name which has information for KEY, prompting with PROMPT."
 262   (let* ((completion-ignore-case t)
 263          (name (completing-read prompt
 264                                 language-info-alist
 265                                 (function (lambda (elm) (assq key elm)))
 266                                 t
 267                                 initial-input)))
 268     (if (and (> (length name) 0)
 269              (get-language-info name key))
 270         name)))
 271 \f
 272 ;;; Multilingual input methods.
 273
 274 (defvar current-input-method nil
 275   "The current input method for multilingual text.
 276 The value is a cons of language name and input method name.
 277 If nil, it means no input method is activated now.")
 278 (make-variable-buffer-local 'current-input-method)
 279 (put 'current-input-method 'permanent-local t)
 280
 281 (defvar current-input-method-title nil
 282   "Title string of the current input method shown in mode line.
 283 Every input method should set this to an appropriate value when activated.")
 284 (make-variable-buffer-local 'current-input-method-title)
 285 (put 'current-input-method-title 'permanent-local t)
 286
 287 (defvar default-input-method nil
 288   "Default input method.
 289 The default input method is the one activated automatically by the command
 290 `toggle-input-method' (\\[toggle-input-method]).
 291 The value is a cons of language name and input method name.")
 292 (make-variable-buffer-local 'default-input-method)
 293 (put 'default-input-method 'permanent-local t)
 294
 295 (defvar default-input-method-title nil
 296   "Title string of the default input method.")
 297 (make-variable-buffer-local 'default-input-method-title)
 298 (put 'default-input-method-title 'permanent-local t)
 299
 300 (defvar previous-input-method nil
 301   "Input method selected previously.
 302 This is the one selected before the current input method is selected.
 303 See also the documentation of `default-input-method'.")
 304 (make-variable-buffer-local 'previous-input-method)
 305 (put 'previous-input-method 'permanent-local t)
 306
 307 (defvar inactivate-current-input-method-function nil
 308   "Function to call for inactivating the current input method.
 309 Every input method should set this to an appropriate value when activated.
 310 This function is called with no argument.")
 311 (make-variable-buffer-local 'inactivate-current-input-method-function)
 312 (put 'inactivate-current-input-method-function 'permanent-local t)
 313
 314 (defvar describe-current-input-method-function nil
 315   "Function to call for describing the current input method.
 316 This function is called with no argument.")
 317 (make-variable-buffer-local 'describe-current-input-method-function)
 318 (put 'describe-current-input-method-function 'permanent-local t)
 319
 320 (defun register-input-method (language-name input-method)
 321   "Register INPUT-METHOD as an input method of LANGUAGE-NAME.
 322 LANGUAGE-NAME is a string.
 323 INPUT-METHOD is a list of the form:
 324         (METHOD-NAME ACTIVATE-FUNC ARG ...)
 325 where METHOD-NAME is the name of this method,
 326 ACTIVATE-FUNC is the function to call for activating this method.
 327 Arguments for the function are METHOD-NAME and ARGs."
 328   (let ((slot (get-language-info language-name 'input-method))
 329         method-slot)
 330     (if (null slot)
 331         (set-language-info language-name 'input-method (list input-method))
 332       (setq method-slot (assoc (car input-method) slot))
 333       (if method-slot
 334           (setcdr method-slot (cdr input-method))
 335         (set-language-info language-name 'input-method
 336                            (cons input-method slot))))))
 337
 338 (defun read-language-and-input-method-name ()
 339   "Read a language name and the corresponding input method from a minibuffer.
 340 Return a list of those names."
 341   (let* ((default-val (or previous-input-method default-input-method))
 342          (language-name (read-language-name
 343                          'input-method "Language: "
 344                          (if default-val (cons (car default-val) 0)))))
 345     (if (null language-name)
 346         (error "No input method for the specified language"))
 347     (if (not (string= language-name (car default-val)))
 348         ;; Now the default value has no meaning.
 349         (setq default-val nil))
 350     (let* ((completion-ignore-case t)
 351            (key-slot (cdr (assq 'input-method
 352                                 (assoc language-name language-info-alist))))
 353            (method-name
 354             (completing-read "Input method: " key-slot nil t
 355                              (if default-val (cons (cdr default-val) 0)))))
 356       (if (= (length method-name) 0)
 357           (error "No input method specified"))
 358       (list language-name
 359             (car (assoc-ignore-case method-name key-slot))))))
 360
 361 ;; Actvate input method METHOD-NAME for langauge LANGUAGE-NAME.
 362 (defun activate-input-method (language-name method-name)
 363   (if (and current-input-method
 364            (or (not (string= (car current-input-method) language-name))
 365                (not (string= (cdr current-input-method) method-name))))
 366       (inactivate-input-method))
 367   (or current-input-method
 368       (let* ((key-slot (get-language-info language-name 'input-method))
 369              (method-slot (cdr (assoc method-name key-slot))))
 370         (if (null method-slot)
 371             (error "Invalid input method `%s' for  %s"
 372                    method-name language-name))
 373         (apply (car method-slot) method-name (cdr method-slot))
 374         (setq current-input-method (cons language-name method-name))
 375         (if (not (equal default-input-method current-input-method))
 376             (progn
 377               (setq previous-input-method default-input-method)
 378               (setq default-input-method current-input-method)
 379               (setq default-input-method-title current-input-method-title))))))
 380
 381 ;; Inactivate the current input method.
 382 (defun inactivate-input-method ()
 383   (if current-input-method
 384       (unwind-protect
 385           (funcall inactivate-current-input-method-function)
 386         (setq current-input-method nil))))
 387
 388 (defun select-input-method (language-name method-name)
 389   "Select and activate input method METHOD-NAME for inputting LANGUAGE-NAME.
 390 Both the default and local values of default-input-method are
 391 set to the selected input method.
 392
 393 The information for activating METHOD-NAME is stored
 394 in `language-info-alist' under the key 'input-method.
 395 The format of the information has the form:
 396         ((METHOD-NAME ACTIVATE-FUNC ARG ...) ...)
 397 where ACTIVATE-FUNC is a function to call for activating this method.
 398 Arguments for the function are METHOD-NAME and ARGs."
 399   (interactive (read-language-and-input-method-name))
 400   (activate-input-method language-name method-name)
 401   (setq-default default-input-method default-input-method)
 402   (setq-default default-input-method-title default-input-method-title))
 403
 404 (defun toggle-input-method (&optional arg)
 405   "Turn on or off a multilingual text input method for the current buffer.
 406 With arg, turn on an input method specified interactively.
 407 Without arg, if some input method is currently activated, turn it off,
 408 else turn on default-input-method (which see).
 409 In the latter case, if default-input-method is nil, select an input method
 410 interactively."
 411   (interactive "P")
 412   (if arg
 413       (let ((input-method (read-language-and-input-method-name)))
 414         (activate-input-method (car input-method) (nth 1 input-method)))
 415     (if current-input-method
 416         (inactivate-input-method)
 417       (if default-input-method
 418           (activate-input-method (car default-input-method)
 419                                  (cdr default-input-method))
 420         (let ((input-method (read-language-and-input-method-name)))
 421           (activate-input-method (car input-method) (nth 1 input-method)))))))
 422
 423 (defun describe-input-method ()
 424   "Describe the current input method."
 425   (interactive)
 426   (if current-input-method
 427       (if (and (symbolp describe-current-input-method-function)
 428                (fboundp describe-current-input-method-function))
 429           (funcall describe-current-input-method-function)
 430         (message "No way to describe the current input method `%s'"
 431                  (cdr current-input-method))
 432         (ding))
 433     (message "No input method is activated now")
 434     (ding)))
 435
 436 (defun read-multilingual-string (prompt &optional initial-input
 437                                         language-name method-name)
 438   "Read a multilingual string from minibuffer, prompting with string PROMPT.
 439 The input method selected last time is activated in minibuffer.
 440 If optional second arg INITIAL-INPUT is non-nil, insert it in the minibuffer
 441  initially
 442 Optional 3rd and 4th arguments LANGUAGE-NAME and METHOD-NAME specify
 443  the input method to be activated instead of the one selected last time."
 444   (let ((default-input-method default-input-method))
 445     (if (and language-name method-name)
 446         (setq default-input-method (cons language-name method-name))
 447       (or default-input-method
 448           (let ((lang-and-input-method (read-language-and-input-method-name)))
 449             (setq default-input-method (cons (car lang-and-input-method)
 450                                              (nth 1 lang-and-input-method))))))
 451     (let ((minibuffer-setup-hook '(toggle-input-method)))
 452       (read-string prompt initial-input))))
 453
 454 ;; Variables to control behavior of input methods.  All input methods
 455 ;; should react to these variables.
 456
 457 (defvar input-method-tersely-flag nil
 458   "*If this flag is non-nil, input method works rather tersely.
 459
 460 For instance, Quail input method does not show guidance buffer while
 461 inputting at minibuffer if this flag is t.")
 462
 463 (defvar input-method-activate-hook nil
 464   "Normal hook run just after an input method is activated.")
 465
 466 (defvar input-method-inactivate-hook nil
 467   "Normal hook run just after an input method is inactivated.")
 468
 469 (defvar input-method-after-insert-chunk-hook nil
 470   "Normal hook run just after an input method insert some chunk of text.")
 471
 472 \f
 473 (defun setup-specified-language-environment ()
 474   "Setup multi-lingual environment convenient for the specified language."
 475   (interactive)
 476   (let (language-name func)
 477     (if (and (symbolp last-command-event)
 478              (or (not (eq last-command-event 'Default))
 479                  (setq last-command-event 'English))
 480              (setq language-name (symbol-name last-command-event))
 481              (setq func (get-language-info language-name 'setup-function)))
 482         (progn
 483           (funcall func)
 484           (force-mode-line-update t))
 485       (error "Bogus calling sequence"))))
 486
 487 ;;;###autoload
 488 (defun set-language-environment (language-name)
 489   "Set up multi-lingual environment for using LANGUAGE-NAME.
 490 This sets the coding system priority and the default input method
 491 and sometimes other things."
 492   (interactive (list (read-language-name 'setup-function "Language: ")))
 493   (if (or (null language-name)
 494           (null (get-language-info language-name 'setup-function)))
 495       (error "No way to setup environment for the specified language"))
 496   (let ((last-command-event (intern language-name)))
 497     (setup-specified-language-environment)))
 498
 499 ;; Print all arguments with `princ', then print "\n".
 500 (defsubst princ-list (&rest args)
 501   (while args (princ (car args)) (setq args (cdr args)))
 502   (princ "\n"))
 503
 504 ;; Print a language specific information such as input methods,
 505 ;; charsets, and coding systems.  This function is intended to be
 506 ;; called from the menu:
 507 ;;   [menu-bar mule describe-language-support LANGUAGE]
 508 ;; and should not run it by `M-x describe-current-input-method-function'.
 509 (defun describe-specified-language-support ()
 510   "Describe how Emacs supports the specified langugage."
 511   (interactive)
 512   (let (language-name doc)
 513     (if (not (and (symbolp last-command-event)
 514                   (setq language-name (symbol-name last-command-event))
 515                   (setq doc (get-language-info language-name 'documentation))))
 516         (error "Bogus calling sequence"))
 517     (with-output-to-temp-buffer "*Help*"
 518       (if (stringp doc)
 519           (princ-list doc))
 520       (princ "-----------------------------------------------------------\n")
 521       (princ-list "List of items specific to "
 522                   language-name
 523                   " support")
 524       (princ "-----------------------------------------------------------\n")
 525       (let ((str (get-language-info language-name 'sample-text)))
 526         (if (stringp str)
 527             (progn
 528               (princ "<sample text>\n")
 529               (princ-list "  " str))))
 530       (princ "<input methods>\n")
 531       (let ((l (get-language-info language-name 'input-method)))
 532         (while l
 533           (princ-list "  " (car (car l)))
 534           (setq l (cdr l))))
 535       (princ "<character sets>\n")
 536       (let ((l (get-language-info language-name 'charset)))
 537         (if (null l)
 538             (princ-list "  nothing specific to " language-name)
 539           (while l
 540             (princ-list "  " (car l) ": "
 541                         (charset-description (car l)))
 542             (setq l (cdr l)))))
 543       (princ "<coding systems>\n")
 544       (let ((l (get-language-info language-name 'coding-system)))
 545         (if (null l)
 546             (princ-list "  nothing specific to " language-name)
 547           (while l
 548             (princ-list "  " (car l) ":\n\t"
 549                         (coding-system-docstring (car l)))
 550             (setq l (cdr l))))))))
 551
 552 (defun describe-language-support (language-name)
 553   "Describe how Emacs supports LANGUAGE-NAME."
 554   (interactive (list (read-language-name 'documentation "Language: ")))
 555   (if (or (null language-name)
 556           (null (get-language-info language-name 'documentation)))
 557       (error "No documentation for the specified language"))
 558   (let ((last-command-event (intern language-name)))
 559     (describe-specified-language-support)))
 560 \f
 561 ;;; Charset property
 562
 563 (defsubst get-charset-property (charset propname)
 564   "Return the value of CHARSET's PROPNAME property.
 565 This is the last value stored with
 566 `(put-charset-property CHARSET PROPNAME VALUE)'."
 567   (plist-get (charset-plist charset) propname))
 568
 569 (defsubst put-charset-property (charset propname value)
 570   "Store CHARSETS's PROPNAME property with value VALUE.
 571 It can be retrieved with `(get-charset-property CHARSET PROPNAME)'."
 572   (set-charset-plist charset
 573                      (plist-put (charset-plist charset) propname value)))
 574
 575 ;;; Character code property
 576 (put 'char-code-property-table 'char-table-extra-slots 0)
 577
 578 (defvar char-code-property-table
 579   (make-char-table 'char-code-property-table)
 580   "Char-table containing a property list of each character code.
 581
 582 See also the documentation of `get-char-code-property' and
 583 `put-char-code-property'")
 584
 585 (defun get-char-code-property (char propname)
 586   "Return the value of CHAR's PROPNAME property in `char-code-property-table'."
 587   (let ((plist (aref char-code-property-table char)))
 588     (if (listp plist)
 589         (car (cdr (memq propname plist))))))
 590
 591 (defun put-char-code-property (char propname value)
 592   "Store CHAR's PROPNAME property with VALUE in `char-code-property-table'.
 593 It can be retrieved with `(get-char-code-property CHAR PROPNAME)'."
 594   (let ((plist (aref char-code-property-table char)))
 595     (if plist
 596         (let ((slot (memq propname plist)))
 597           (if slot
 598               (setcar (cdr slot) value)
 599             (nconc plist (list propname value))))
 600       (aset char-code-property-table char (list propname value)))))
 601
 602 ;;; mule-cmds.el ends here