lisp/international/mule.el

   1 ;;; mule.el --- basic commands for multilingual environment
   2
   3 ;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
   4 ;;   Licensed to the Free Software Foundation.
   5 ;; Copyright (C) 2001, 2002 Free Software Foundation, Inc.
   6 ;; Copyright (C) 2003
   7 ;;   National Institute of Advanced Industrial Science and Technology (AIST)
   8 ;;   Registration Number H13PRO009
   9
  10 ;; Keywords: mule, multilingual, character set, coding system
  11
  12 ;; This file is part of GNU Emacs.
  13
  14 ;; GNU Emacs is free software; you can redistribute it and/or modify
  15 ;; it under the terms of the GNU General Public License as published by
  16 ;; the Free Software Foundation; either version 2, or (at your option)
  17 ;; any later version.
  18
  19 ;; GNU Emacs is distributed in the hope that it will be useful,
  20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  22 ;; GNU General Public License for more details.
  23
  24 ;; You should have received a copy of the GNU General Public License
  25 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  26 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  27 ;; Boston, MA 02111-1307, USA.
  28
  29 ;;; Commentary:
  30
  31 ;;; Code:
  32
  33 (defconst mule-version "6.0 (HANACHIRUSATO)" "\
  34 Version number and name of this version of MULE (multilingual environment).")
  35
  36 (defconst mule-version-date "2003.9.1" "\
  37 Distribution date of this version of MULE (multilingual environment).")
  38
  39 \f
  40 ;;; CHARSET
  41
  42 ;; Backward compatibility code for handling emacs-mule charsets.
  43 (defvar private-char-area-1-min #xF0000)
  44 (defvar private-char-area-1-max #xFFFFE)
  45 (defvar private-char-area-2-min #x100000)
  46 (defvar private-char-area-2-max #x10FFFE)
  47
  48 ;; Table of emacs-mule charsets indexed by their emacs-mule ID.
  49 (defvar emacs-mule-charset-table (make-vector 256 nil))
  50 (aset emacs-mule-charset-table 0 'ascii)
  51
  52 ;; Convert the argument of old-style calll of define-charset to a
  53 ;; property list used by the new-style.
  54 ;; INFO-VECTOR is a vector of the format:
  55 ;;   [DIMENSION CHARS WIDTH DIRECTION ISO-FINAL-CHAR ISO-GRAPHIC-PLANE
  56 ;;    SHORT-NAME LONG-NAME DESCRIPTION]
  57
  58 (defun convert-define-charset-argument (emacs-mule-id info-vector)
  59   (let* ((dim (aref info-vector 0))
  60          (chars (aref info-vector 1))
  61          (total (if (= dim 1) chars (* chars chars)))
  62          (code-space (if (= dim 1) (if (= chars 96) [32 127] [33 126])
  63                        (if (= chars 96) [32 127 32 127] [33 126 33 126])))
  64          code-offset)
  65     (if (integerp emacs-mule-id)
  66         (or (= emacs-mule-id 0)
  67             (and (>= emacs-mule-id 129) (< emacs-mule-id 256))
  68             (error "Invalid CHARSET-ID: %d" emacs-mule-id))
  69       (let (from-id to-id)
  70         (if (= dim 1) (setq from-id 160 to-id 224)
  71           (setq from-id 224 to-id 255))
  72         (while (and (< from-id to-id)
  73                     (not (aref emacs-mule-charset-table from-id)))
  74           (setq from-id (1+ from-id)))
  75         (if (= from-id to-id)
  76             (error "No more room for the new Emacs-mule charset"))
  77         (setq emacs-mule-id from-id)))
  78     (if (> (- private-char-area-1-max private-char-area-1-min) total)
  79         (setq code-offset private-char-area-1-min
  80               private-char-area-1-min (+ private-char-area-1-min total))
  81       (if (> (- private-char-area-2-max private-char-area-2-min) total)
  82           (setq code-offset private-char-area-2-min
  83                 private-char-area-2-min (+ private-char-area-2-min total))
  84         (error "No more space for a new charset.")))
  85     (list :dimension dim
  86           :code-space code-space
  87           :iso-final-char (aref info-vector 4)
  88           :code-offset code-offset
  89           :emacs-mule-id emacs-mule-id)))
  90
  91 (defun define-charset (name docstring &rest props)
  92   "Define NAME (symbol) as a charset with DOCSTRING.
  93 The remaining arguments must come in pairs ATTRIBUTE VALUE.  ATTRIBUTE
  94 may be any symbol.  The following have special meanings, and one of
  95 `:code-offset', `:map', `:subset', `:superset' must be specified.
  96
  97 `:short-name'
  98
  99 VALUE must be a short string to identify the charset.  If omitted,
 100 NAME is used.
 101
 102 `:long-name'
 103
 104 VALUE must be a string longer than `:short-name' to identify the
 105 charset.  If omitted, the value of the `:short-name' attribute is used.
 106
 107 `:dimension'
 108
 109 VALUE must be an integer 0, 1, 2, or 3, specifying the dimension of
 110 code-points of the charsets.  If omitted, it is calculated from the
 111 value of the `:code-space' attribute.
 112
 113 `:code-space'
 114
 115 VALUE must be a vector of length at most 8 specifying the byte code
 116 range of each dimension in this format:
 117         [ MIN-1 MAX-1 MIN-2 MAX-2 ... ]
 118 where MIN-N is the minimum byte value of Nth dimension of code-point,
 119 MAX-N is the maximum byte value of that.
 120
 121 `:min-code'
 122
 123 VALUE must be an integer specifying the mininum code point of the
 124 charset.  If omitted, it is calculated from `:code-space'.  VALUE may
 125 be a cons (HIGH . LOW), where HIGH is the most significant 16 bits of
 126 the code point and LOW is the least significant 16 bits.
 127
 128 `:max-code'
 129
 130 VALUE must be an integer specifying the maxinum code point of the
 131 charset.  If omitted, it is calculated from `:code-space'.  VALUE may
 132 be a cons (HIGH . LOW), where HIGH is the most significant 16 bits of
 133 the code point and LOW is the least significant 16 bits.
 134
 135 `:iso-final-char'
 136
 137 VALUE must be a character in the range 32 to 127 (inclusive)
 138 specifying the final char of the charset for ISO-2022 encoding.  If
 139 omitted, the charset can't be encoded by ISO-2022 based
 140 coding-systems.
 141
 142 `:iso-revision-number'
 143
 144 VALUE must be an integer in the range 0..63, specifying the revision
 145 number of the charset for ISO-2022 encoding.
 146
 147 `:emacs-mule-id'
 148
 149 VALUE must be an integer of 0, 129..255.  If omitted, the charset
 150 can't be encoded by coding-systems of type `emacs-mule'.
 151
 152 `:ascii-compatible-p'
 153
 154 VALUE must be nil or t (default nil).  If VALUE is t, the charset is
 155 compatible with ASCII, i.e. the first 128 code points map to ASCII.
 156
 157 `:supplementary-p'
 158
 159 VALUE must be nil or t.  If the VALUE is t, the charset is
 160 supplementary, which means it is used only as a parent of some other
 161 charset.
 162
 163 `:invalid-code'
 164
 165 VALUE must be a nonnegative integer that can be used as an invalid
 166 code point of the charset.  If the minimum code is 0 and the maximum
 167 code is greater than Emacs' maximum integer value, `:invalid-code'
 168 should not be omitted.
 169
 170 `:code-offset'
 171
 172 VALUE must be an integer added to the index number of a character to
 173 get the corresponding character code.
 174
 175 `:map'
 176
 177 VALUE must be vector or string.
 178
 179 If it is a vector, the format is [ CODE-1 CHAR-1 CODE-2 CHAR-2 ... ],
 180 where CODE-n is a code-point of the charset, and CHAR-n is the
 181 corresponding character code.
 182
 183 If it is a string, it is a name of file that contains the above
 184 information.   Each line of the file must be this format:
 185         0xXXX 0xYYY
 186 where XXX is a hexadecimal representation of CODE-n and YYY is a
 187 hexadecimal representation of CHAR-n.  A line starting with `#' is a
 188 comment line.
 189
 190 `:subset'
 191
 192 VALUE must be a list:
 193         ( PARENT MIN-CODE MAX-CODE OFFSET )
 194 PARENT is a parent charset.  MIN-CODE and MAX-CODE specify the range
 195 of characters inherited from the parent.  OFFSET is an integer value
 196 to add to a code point of the parent charset to get the corresponding
 197 code point of this charset.
 198
 199 `:superset'
 200
 201 VALUE must be a list of parent charsets.  The charset inherits
 202 characters from them.  Each element of the list may be a cons (PARENT
 203 . OFFSET), where PARENT is a parent charset, and OFFSET is an offset
 204 value to add to a code point of PARENT to get the corresponding code
 205 point of this charset.
 206
 207 `:unify-map'
 208
 209 VALUE must be vector or string.
 210
 211 If it is a vector, the format is [ CODE-1 CHAR-1 CODE-2 CHAR-2 ... ],
 212 where CODE-n is a code-point of the charset, and CHAR-n is the
 213 corresponding Unicode character code.
 214
 215 If it is a string, it is a name of file that contains the above
 216 information.  The file format is the same as what described for `:map'
 217 attribute."
 218   (when (vectorp (car props))
 219     ;; Old style code:
 220     ;;   (define-charset CHARSET-ID CHARSET-SYMBOL INFO-VECTOR)
 221     ;; Convert the argument to make it fit with the current style.
 222     (let ((vec (car props)))
 223       (setq props (convert-define-charset-argument name vec)
 224             name docstring
 225             docstring (aref vec 8))))
 226   (let ((attrs (mapcar 'list '(:dimension
 227                                :code-space
 228                                :min-code
 229                                :max-code
 230                                :iso-final-char
 231                                :iso-revision-number
 232                                :emacs-mule-id
 233                                :ascii-compatible-p
 234                                :supplementary-p
 235                                :invalid-code
 236                                :code-offset
 237                                :map
 238                                :subset
 239                                :superset
 240                                :unify-map
 241                                :plist))))
 242
 243     ;; If :dimension is omitted, get the dimension from :code-space.
 244     (let ((dimension (plist-get props :dimension)))
 245       (or dimension
 246           (let ((code-space (plist-get props :code-space)))
 247             (setq dimension (if code-space (/ (length code-space) 2) 4))
 248             (setq props (plist-put props :dimension dimension)))))
 249
 250     (let ((code-space (plist-get props :code-space)))
 251       (or code-space
 252           (let ((dimension (plist-get props :dimension)))
 253             (setq code-space (make-vector 8 0))
 254             (dotimes (i dimension)
 255               (aset code-space (1+ (* i 2)) #xFF))
 256             (setq props (plist-put props :code-space code-space)))))
 257
 258     ;; If :emacs-mule-id is specified, update emacs-mule-charset-table.
 259     (let ((emacs-mule-id (plist-get props :emacs-mule-id)))
 260       (if (integerp emacs-mule-id)
 261           (aset emacs-mule-charset-table emacs-mule-id name)))
 262
 263     (dolist (slot attrs)
 264       (setcdr slot (plist-get props (car slot))))
 265
 266     ;; Make sure that the value of :code-space is a vector of 8
 267     ;; elements.
 268     (let* ((slot (assq :code-space attrs))
 269            (val (cdr slot))
 270            (len (length val)))
 271       (if (< len 8)
 272           (setcdr slot
 273                   (vconcat val (make-vector (- 8 len) 0)))))
 274
 275     ;; Add :name and :docstring properties to PROPS.
 276     (setq props
 277           (cons :name (cons name (cons :docstring (cons docstring props)))))
 278     (or (plist-get props :short-name)
 279         (plist-put props :short-name (symbol-name name)))
 280     (or (plist-get props :long-name)
 281         (plist-put props :long-name (plist-get props :short-name)))
 282     ;; We can probably get a worthwhile amount in purespace.
 283     (setq props
 284           (mapcar (lambda (elt)
 285                     (if (stringp elt)
 286                         (purecopy elt)
 287                       elt))
 288                   props))
 289     (setcdr (assq :plist attrs) props)
 290
 291     (apply 'define-charset-internal name (mapcar 'cdr attrs))))
 292
 293
 294 (defun load-with-code-conversion (fullname file &optional noerror nomessage)
 295   "Execute a file of Lisp code named FILE whose absolute name is FULLNAME.
 296 The file contents are decoded before evaluation if necessary.
 297 If optional second arg NOERROR is non-nil,
 298  report no error if FILE doesn't exist.
 299 Print messages at start and end of loading unless
 300  optional third arg NOMESSAGE is non-nil.
 301 Return t if file exists."
 302   (if (null (file-readable-p fullname))
 303       (and (null noerror)
 304            (signal 'file-error (list "Cannot open load file" file)))
 305     ;; Read file with code conversion, and then eval.
 306     (let* ((buffer
 307             ;; To avoid any autoloading, set default-major-mode to
 308             ;; fundamental-mode.
 309             ;; So that we don't get completely screwed if the
 310             ;; file is encoded in some complicated character set,
 311             ;; read it with real decoding, as a multibyte buffer,
 312             ;; even if this is a --unibyte Emacs session.
 313             (let ((default-major-mode 'fundamental-mode)
 314                   (default-enable-multibyte-characters t))
 315               ;; We can't use `generate-new-buffer' because files.el
 316               ;; is not yet loaded.
 317               (get-buffer-create (generate-new-buffer-name " *load*"))))
 318            (load-in-progress t)
 319            (source (save-match-data (string-match "\\.el\\'" fullname))))
 320       (unless nomessage
 321         (if source
 322             (message "Loading %s (source)..." file)
 323           (message "Loading %s..." file)))
 324       (when purify-flag
 325         (push file preloaded-file-list))
 326       (unwind-protect
 327           (let ((load-file-name fullname)
 328                 (set-auto-coding-for-load t)
 329                 (inhibit-file-name-operation nil))
 330             (save-excursion
 331               (set-buffer buffer)
 332               (insert-file-contents fullname)
 333               ;; If the loaded file was inserted with no-conversion or
 334               ;; raw-text coding system, make the buffer unibyte.
 335               ;; Otherwise, eval-buffer might try to interpret random
 336               ;; binary junk as multibyte characters.
 337               (if (and enable-multibyte-characters
 338                        (or (eq (coding-system-type last-coding-system-used)
 339                                'raw-text)))
 340                   (set-buffer-multibyte nil))
 341               ;; Make `kill-buffer' quiet.
 342               (set-buffer-modified-p nil))
 343             ;; Have the original buffer current while we eval.
 344             (eval-buffer buffer nil file
 345                          ;; If this Emacs is running with --unibyte,
 346                          ;; convert multibyte strings to unibyte
 347                          ;; after reading them.
 348 ;;                       (not default-enable-multibyte-characters)
 349                          nil t
 350                          ))
 351         (let (kill-buffer-hook kill-buffer-query-functions)
 352           (kill-buffer buffer)))
 353       (let ((hook (assoc file after-load-alist)))
 354         (when hook
 355           (mapcar (function eval) (cdr hook))))
 356       (unless (or nomessage noninteractive)
 357         (if source
 358             (message "Loading %s (source)...done" file)
 359           (message "Loading %s...done" file)))
 360       t)))
 361
 362 (defun charset-info (charset)
 363   "Return a vector of information of CHARSET.
 364 This function is provided for backward compatibility.
 365
 366 The elements of the vector are:
 367         CHARSET-ID, BYTES, DIMENSION, CHARS, WIDTH, DIRECTION,
 368         LEADING-CODE-BASE, LEADING-CODE-EXT,
 369         ISO-FINAL-CHAR, ISO-GRAPHIC-PLANE,
 370         REVERSE-CHARSET, SHORT-NAME, LONG-NAME, DESCRIPTION,
 371         PLIST.
 372 where
 373 CHARSET-ID is always 0.
 374 BYTES is always 0.
 375 DIMENSION is the number of bytes of a code-point of the charset:
 376   1, 2, 3, or 4.
 377 CHARS is the number of characters in a dimension:
 378   94, 96, 128, or 256.
 379 WIDTH is always 0.
 380 DIRECTION is always 0.
 381 LEADING-CODE-BASE is always 0.
 382 LEADING-CODE-EXT is always 0.
 383 ISO-FINAL-CHAR (character) is the final character of the
 384   corresponding ISO 2022 charset.  If the charset is not assigned
 385   any final character, the value is -1.
 386 ISO-GRAPHIC-PLANE is always 0.
 387 REVERSE-CHARSET is always -1.
 388 SHORT-NAME (string) is the short name to refer to the charset.
 389 LONG-NAME (string) is the long name to refer to the charset
 390 DESCRIPTION (string) is the description string of the charset.
 391 PLIST (property list) may contain any type of information a user
 392   want to put and get by functions `put-charset-property' and
 393   `get-charset-property' respectively."
 394   (vector 0
 395           0
 396           (charset-dimension charset)
 397           (charset-chars charset)
 398           0
 399           0
 400           0
 401           0
 402           (charset-iso-final-char charset)
 403           0
 404           -1
 405           (get-charset-property charset :short-name)
 406           (get-charset-property charset :short-name)
 407           (charset-description charset)
 408           (charset-plist charset)))
 409
 410 ;; It is better not to use backquote in this file,
 411 ;; because that makes a bootstrapping problem
 412 ;; if you need to recompile all the Lisp files using interpreted code.
 413
 414 (defun charset-id (charset)
 415   "Always return 0.  This is provided for backward compatibility."
 416   0)
 417
 418 (defmacro charset-bytes (charset)
 419   "Always return 0.  This is provided for backward compatibility."
 420   0)
 421
 422 (defun get-charset-property (charset propname)
 423   "Return the value of CHARSET's PROPNAME property.
 424 This is the last value stored with
 425  (put-charset-property CHARSET PROPNAME VALUE)."
 426   (plist-get (charset-plist charset) propname))
 427
 428 (defun put-charset-property (charset propname value)
 429   "Set CHARSETS's PROPNAME property to value VALUE.
 430 It can be retrieved with `(get-charset-property CHARSET PROPNAME)'."
 431   (set-charset-plist charset
 432                      (plist-put (charset-plist charset) propname value)))
 433
 434 (defun charset-description (charset)
 435   "Return description string of CHARSET."
 436   (plist-get (charset-plist charset) :docstring))
 437
 438 (defun charset-dimension (charset)
 439   "Return dimension of CHARSET."
 440   (plist-get (charset-plist charset) :dimension))
 441
 442 (defun charset-chars (charset &optional dimension)
 443   "Return number of characters contained in DIMENSION of CHARSET.
 444 DIMENSION defaults to the first dimension."
 445   (unless dimension (setq dimension 1))
 446   (let ((code-space (plist-get (charset-plist charset) :code-space)))
 447     (1+ (- (aref code-space (1- (* 2 dimension)))
 448            (aref code-space (- (* 2 dimension) 2))))))
 449
 450 (defun charset-iso-final-char (charset)
 451   "Return ISO-2022 final character of CHARSET.
 452 Return -1 if charset isn't an ISO 2022 one."
 453   (or (plist-get (charset-plist charset) :iso-final-char)
 454       -1))
 455
 456 (defmacro charset-short-name (charset)
 457   "Return short name of CHARSET."
 458   (plist-get (charset-plist charset) :short-name))
 459
 460 (defmacro charset-long-name (charset)
 461   "Return long name of CHARSET."
 462   (plist-get (charset-plist charset) :long-name))
 463
 464 (defun charset-list ()
 465   "Return list of all charsets ever defined.
 466
 467 This function is provided for backward compatibility.
 468 Now we have the variable `charset-list'."
 469   charset-list)
 470 (make-obsolete 'charset-list "Use variable `charset-list'" "22.1")
 471
 472 \f
 473 ;;; CHARACTER
 474 (defalias 'char-valid-p 'characterp)
 475 (make-obsolete 'char-valid-p 'characterp "22.1")
 476
 477 (defun generic-char-p (char)
 478   "Always return nil.  This is provided for backward compatibility."
 479   nil)
 480 (make-obsolete 'generic-char-p "Generic characters no longer exist" "22.1")
 481
 482 (defun make-char-internal (charset-id &optional code1 code2)
 483   (let ((charset (aref emacs-mule-charset-table charset-id)))
 484     (or charset
 485         (error "Invalid Emacs-mule charset ID: %d" charset-id))
 486     (make-char charset code1 code2)))
 487 \f
 488 ;; Coding system stuff
 489
 490 ;; Coding system is a symbol that has been defined by the function
 491 ;; `define-coding-system'.
 492
 493 (defconst coding-system-iso-2022-flags
 494   '(long-form
 495     ascii-at-eol
 496     ascii-at-cntl
 497     7-bit
 498     locking-shift
 499     single-shift
 500     designation
 501     revision
 502     direction
 503     init-at-bol
 504     designate-at-bol
 505     safe
 506     latin-extra
 507     composition
 508     euc-tw-shift
 509     use-roman
 510     use-oldjis)
 511   "List of symbols that control ISO-2022 encoder/decoder.
 512
 513 The value of the `:flags' attribute in the argument of the function
 514 `define-coding-system' must be one of them.
 515
 516 If `long-form' is specified, use a long designation sequence on
 517 encoding for the charsets `japanese-jisx0208-1978', `chinese-gb2312',
 518 and `japanese-jisx0208'.  The long designation sequence doesn't
 519 conform to ISO 2022, but is used by such coding systems as
 520 `compound-text'.
 521
 522 If `ascii-at-eol' is specified, designate ASCII to g0 at end of line
 523 on encoding.
 524
 525 If `ascii-at-cntl' is specified, designate ASCII to g0 before control
 526 codes and SPC on encoding.
 527
 528 If `7-bit' is specified, use 7-bit code only on encoding.
 529
 530 If `locking-shift' is specified, decode locking-shift code correctly
 531 on decoding, and use locking-shift to invoke a graphic element on
 532 encoding.
 533
 534 If `single-shift' is specified, decode single-shift code correctly on
 535 decoding, and use single-shift to invoke a graphic element on encoding.
 536
 537 If `designation' is specified, decode designation code correctly on
 538 decoding, and use designation to designate a charset to a graphic
 539 element on encoding.
 540
 541 If `revision' is specified, produce an escape sequence to specify
 542 revision number of a charset on encoding.  Such an escape sequence is
 543 always correctly decoded on decoding.
 544
 545 If `direction' is specified, decode ISO6429's code for specifying
 546 direction correctly, and produce the code on encoding.
 547
 548 If `init-at-bol' is specified, on encoding, it is assumed that
 549 invocation and designation statuses are reset at each beginning of
 550 line even if `ascii-at-eol' is not specified; thus no codes for
 551 resetting them are produced.
 552
 553 If `safe' is specified, on encoding, characters not supported by a
 554 coding are replaced with `?'.
 555
 556 If `latin-extra' is specified, the code-detection routine assumes that a
 557 code specified in `latin-extra-code-table' (which see) is valid.
 558
 559 If `composition' is specified, an escape sequence to specify
 560 composition sequence is correctly decoded on decoding, and is produced
 561 on encoding.
 562
 563 If `euc-tw-shift' is specified, the EUC-TW specific shifting code is
 564 correctly decoded on decoding, and is produced on encoding.
 565
 566 If `use-roman' is specified, JIS0201-1976-Roman is designated instead
 567 of ASCII.
 568
 569 If `use-oldjis' is specified, JIS0208-1976 is designated instead of
 570 JIS0208-1983.")
 571
 572 (defun define-coding-system (name docstring &rest props)
 573   "Define NAME (a symbol) as a coding system with DOCSTRING and attributes.
 574 The remaining arguments must come in pairs ATTRIBUTE VALUE.  ATTRIBUTE
 575 may be any symbol.
 576
 577 The following attributes have special meanings.  Those labeled as
 578 \"(required)\", should not be omitted.
 579
 580 `:mnemonic' (required)
 581
 582 VALUE is a character to display on mode line for the coding system.
 583
 584 `:coding-type' (required)
 585
 586 VALUE must be one of `charset', `utf-8', `utf-16', `iso-2022',
 587 `emacs-mule', `shift-jis', `ccl', `raw-text', `undecided'.
 588
 589 `:eol-type'
 590
 591 VALUE is the EOL (end-of-line) format of the coding system.  It must be
 592 one of `unix', `dos', `mac'.  The symbol `unix' means Unix-like EOL
 593 \(i.e. single LF), `dos' means DOS-like EOL \(i.e. sequence of CR LF),
 594 and `mac' means MAC-like EOL \(i.e. single CR).  If omitted, on
 595 decoding by the coding system, Emacs automatically detects the EOL
 596 format of the source text.
 597
 598 `:charset-list'
 599
 600 VALUE must be a list of charsets supported by the coding system.  On
 601 encoding by the coding system, if a character belongs to multiple
 602 charsets in the list, a charset that comes earlier in the list is
 603 selected.  If `:coding-type' is `iso-2022', VALUE may be `iso-2022',
 604 which indicates that the coding system supports all ISO-2022 based
 605 charsets.  If `:coding-type' is `emacs-mule', VALUE may be
 606 `emacs-mule', which indicates that the coding system supports all
 607 charsets that have the `:emacs-mule-id' property.
 608
 609 `:ascii-compatible-p'
 610
 611 If VALUE is non-nil, the coding system decodes all 7-bit bytes into
 612 the corresponding ASCII characters, and encodes all ASCII characters
 613 back to the corresponding 7-bit bytes.  VALUE defaults to nil.
 614
 615 `:decode-translation-table'
 616
 617 VALUE must be a translation table to use on decoding.
 618
 619 `:encode-translation-table'
 620
 621 VALUE must be a translation table to use on encoding.
 622
 623 `:post-read-conversion'
 624
 625 VALUE must be a function to call after some text is inserted and
 626 decoded by the coding system itself and before any functions in
 627 `after-insert-functions' are called.  The arguments to this function
 628 are the same as those of a function in `after-insert-file-functions',
 629 i.e. LENGTH of the text to be decoded with point at the head of it,
 630 and the function should leave point unchanged.
 631
 632 `:pre-write-conversion'
 633
 634 VALUE must be a function to call after all functions in
 635 `write-region-annotate-functions' and `buffer-file-format' are called,
 636 and before the text is encoded by the coding system itself.  The
 637 arguments to this function are the same as those of a function in
 638 `write-region-annotate-functions'.
 639
 640 `:default-char'
 641
 642 VALUE must be a character.  On encoding, a character not supported by
 643 the coding system is replaced with VALUE.
 644
 645 `:for-unibyte'
 646
 647 VALUE non-nil means that visiting a file with the coding system
 648 results in a unibyte buffer.
 649
 650 `:eol-type'
 651
 652 VALUE must be `unix', `dos', `mac'.  The symbol `unix' means Unix-like
 653 EOL (LF), `dos' means DOS-like EOL (CRLF), and `mac' means MAC-like
 654 EOL (CR).  If omitted, on decoding, the coding system detects EOL
 655 format automatically, and on encoding, uses Unix-like EOL.
 656
 657 `:mime-charset'
 658
 659 VALUE must be a symbol whose name is that of a MIME charset converted
 660 to lower case.
 661
 662 `:mime-text-unsuitable'
 663
 664 VALUE non-nil means the `:mime-charset' property names a charset which
 665 is unsuitable for the top-level media type \"text\".
 666
 667 `:flags'
 668
 669 VALUE must be a list of symbols that control the ISO-2022 converter.
 670 Each must be a member of the list `coding-system-iso-2022-flags'
 671 \(which see).  This attribute has a meaning only when `:coding-type'
 672 is `iso-2022'.
 673
 674 `:designation'
 675
 676 VALUE must be a vector [G0-USAGE G1-USAGE G2-USAGE G3-USAGE].
 677 GN-USAGE specifies the usage of graphic register GN as follows.
 678
 679 If it is nil, no charset can be designated to GN.
 680
 681 If it is a charset, the charset is initially designated to GN, and
 682 never used by the other charsets.
 683
 684 If it is a list, the elements must be charsets, nil, 94, or 96.  GN
 685 can be used by all the listed charsets.  If the list contains 94, any
 686 iso-2022 charset whose code-space ranges are 94 long can be designated
 687 to GN.  If the list contains 96, any charsets whose whose ranges are
 688 96 long can be designated to GN.  If the first element is a charset,
 689 that charset is initially designated to GN.
 690
 691 This attribute has a meaning only when `:coding-type' is `iso-2022'.
 692
 693 `:bom'
 694
 695 This attributes specifies whether the coding system uses a `byte order
 696 mark'.  VALUE must nil, t, or cons of coding systems whose
 697 `:coding-type' is `utf-16'.
 698
 699 If the value is nil, on decoding, don't treat the first two-byte as
 700 BOM, and on encoding, don't produce BOM bytes.
 701
 702 If the value is t, on decoding, skip the first two-byte as BOM, and on
 703 encoding, produce BOM bytes accoding to the value of `:endian'.
 704
 705 If the value is cons, on decoding, check the first two-byte.  If theyq
 706 are 0xFE 0xFF, use the car part coding system of the value.  If they
 707 are 0xFF 0xFE, use the car part coding system of the value.
 708 Otherwise, treat them as bytes for a normal character.  On encoding,
 709 produce BOM bytes accoding to the value of `:endian'.
 710
 711 This attribute has a meaning only when `:coding-type' is `utf-16'.
 712
 713 `:endian'
 714
 715 VALUE must be `big' or `little' specifying big-endian and
 716 little-endian respectively.  The default value is `big'.
 717
 718 This attribute has a meaning only when `:coding-type' is `utf-16'.
 719
 720 `:ccl-decoder'
 721
 722 VALUE is a symbol representing the registered CCL program used for
 723 decoding.  This attribute has a meaning only when `:coding-type' is
 724 `ccl'.
 725
 726 `:ccl-encoder'
 727
 728 VALUE is a symbol representing the registered CCL program used for
 729 encoding.  This attribute has a meaning only when `:coding-type' is
 730 `ccl'."
 731   (let* ((common-attrs (mapcar 'list
 732                                '(:mnemonic
 733                                  :coding-type
 734                                  :charset-list
 735                                  :ascii-compatible-p
 736                                  :decode-translation-table
 737                                  :encode-translation-table
 738                                  :post-read-conversion
 739                                  :pre-write-conversion
 740                                  :default-char
 741                                  :for-unibyte
 742                                  :plist
 743                                  :eol-type)))
 744          (coding-type (plist-get props :coding-type))
 745          (spec-attrs (mapcar 'list
 746                              (cond ((eq coding-type 'iso-2022)
 747                                     '(:initial
 748                                       :reg-usage
 749                                       :request
 750                                       :flags))
 751                                    ((eq coding-type 'utf-16)
 752                                     '(:bom
 753                                       :endian))
 754                                    ((eq coding-type 'ccl)
 755                                     '(:ccl-decoder
 756                                       :ccl-encoder
 757                                       :valids))))))
 758
 759     (dolist (slot common-attrs)
 760       (setcdr slot (plist-get props (car slot))))
 761
 762     (dolist (slot spec-attrs)
 763       (setcdr slot (plist-get props (car slot))))
 764
 765     (if (eq coding-type 'iso-2022)
 766         (let ((designation (plist-get props :designation))
 767               (flags (plist-get props :flags))
 768               (initial (make-vector 4 nil))
 769               (reg-usage (cons 4 4))
 770               request elt)
 771           (dotimes (i 4)
 772             (setq elt (aref designation i))
 773             (cond ((charsetp elt)
 774                    (aset initial i elt)
 775                    (setq request (cons (cons elt i) request)))
 776                   ((consp elt)
 777                    (aset initial i (car elt))
 778                    (if (charsetp (car elt))
 779                        (setq request (cons (cons (car elt) i) request)))
 780                    (dolist (e (cdr elt))
 781                      (cond ((charsetp e)
 782                             (setq request (cons (cons e i) request)))
 783                            ((eq e 94)
 784                             (setcar reg-usage i))
 785                            ((eq e 96)
 786                             (setcdr reg-usage i))
 787                            ((eq e t)
 788                             (setcar reg-usage i)
 789                             (setcdr reg-usage i)))))))
 790           (setcdr (assq :initial spec-attrs) initial)
 791           (setcdr (assq :reg-usage spec-attrs) reg-usage)
 792           (setcdr (assq :request spec-attrs) request)
 793
 794           ;; Change :flags value from a list to a bit-mask.
 795           (let ((bits 0)
 796                 (i 0))
 797             (dolist (elt coding-system-iso-2022-flags)
 798               (if (memq elt flags)
 799                   (setq bits (logior bits (lsh 1 i))))
 800               (setq i (1+ i)))
 801             (setcdr (assq :flags spec-attrs) bits))))
 802
 803     ;; Add :name and :docstring properties to PROPS.
 804     (setq props
 805           (cons :name (cons name (cons :docstring (cons (purecopy docstring)
 806                                                         props)))))
 807     (setcdr (assq :plist common-attrs) props)
 808     (apply 'define-coding-system-internal
 809            name (mapcar 'cdr (append common-attrs spec-attrs)))))
 810
 811 (defun coding-system-doc-string (coding-system)
 812   "Return the documentation string for CODING-SYSTEM."
 813   (plist-get (coding-system-plist coding-system) :docstring))
 814
 815 (defun coding-system-mnemonic (coding-system)
 816   "Return the mnemonic character of CODING-SYSTEM.
 817 The mnemonic character of a coding system is used in mode line to
 818 indicate the coding system.  If CODING-SYSTEM. is nil, return ?=."
 819   (plist-get (coding-system-plist coding-system) :mnemonic))
 820
 821 (defun coding-system-type (coding-system)
 822   "Return the coding type of CODING-SYSTEM.
 823 A coding type is a symbol indicating the encoding method of CODING-SYSTEM.
 824 See the function `define-coding-system' for more detail."
 825   (plist-get (coding-system-plist coding-system) :coding-type))
 826
 827 (defun coding-system-charset-list (coding-system)
 828   "Return list of charsets supported by CODING-SYSTEM.
 829 If CODING-SYSTEM supports all ISO-2022 charsets, return `iso-2022'.
 830 If CODING-SYSTEM supports all emacs-mule charsets, return `emacs-mule'."
 831   (plist-get (coding-system-plist coding-system) :charset-list))
 832
 833 (defun coding-system-category (coding-system)
 834   "Return a category symbol of CODING-SYSTEM."
 835   (plist-get (coding-system-plist coding-system) :category))
 836
 837 (defun coding-system-get (coding-system prop)
 838   "Extract a value from CODING-SYSTEM's property list for property PROP.
 839 For compatibility with Emacs 20/21, this accepts old-style symbols
 840 like `mime-charset' as well as the current style like `:mime-charset'."
 841   (or (plist-get (coding-system-plist coding-system) prop)
 842       (if (not (keywordp prop))
 843           (plist-get (coding-system-plist coding-system)
 844                      (intern (concat ":" (symbol-name prop)))))))
 845
 846 (defalias 'coding-system-parent 'coding-system-base)
 847 (make-obsolete 'coding-system-parent 'coding-system-base "20.3")
 848
 849 (defun coding-system-eol-type-mnemonic (coding-system)
 850   "Return the string indicating end-of-line format of CODING-SYSTEM."
 851   (let* ((eol-type (coding-system-eol-type coding-system))
 852          (val (cond ((eq eol-type 0) eol-mnemonic-unix)
 853                     ((eq eol-type 1) eol-mnemonic-dos)
 854                     ((eq eol-type 2) eol-mnemonic-mac)
 855                     (t eol-mnemonic-undecided))))
 856     (if (stringp val)
 857         val
 858       (char-to-string val))))
 859
 860 (defun coding-system-lessp (x y)
 861   (cond ((eq x 'no-conversion) t)
 862         ((eq y 'no-conversion) nil)
 863         ((eq x 'emacs-mule) t)
 864         ((eq y 'emacs-mule) nil)
 865         ((eq x 'undecided) t)
 866         ((eq y 'undecided) nil)
 867         (t (let ((c1 (coding-system-mnemonic x))
 868                  (c2 (coding-system-mnemonic y)))
 869              (or (< (downcase c1) (downcase c2))
 870                  (and (not (> (downcase c1) (downcase c2)))
 871                       (< c1 c2)))))))
 872
 873 (defun add-to-coding-system-list (coding-system)
 874   "Add CODING-SYSTEM to `coding-system-list' while keeping it sorted."
 875   (if (or (null coding-system-list)
 876           (coding-system-lessp coding-system (car coding-system-list)))
 877       (setq coding-system-list (cons coding-system coding-system-list))
 878     (let ((len (length coding-system-list))
 879           mid (tem coding-system-list))
 880       (while (> len 1)
 881         (setq mid (nthcdr (/ len 2) tem))
 882         (if (coding-system-lessp (car mid) coding-system)
 883             (setq tem mid
 884                   len (- len (/ len 2)))
 885           (setq len (/ len 2))))
 886       (setcdr tem (cons coding-system (cdr tem))))))
 887
 888 (defun coding-system-list (&optional base-only)
 889   "Return a list of all existing non-subsidiary coding systems.
 890 If optional arg BASE-ONLY is non-nil, only base coding systems are
 891 listed.  The value doesn't include subsidiary coding systems which are
 892 made from bases and aliases automatically for various end-of-line
 893 formats (e.g. iso-latin-1-unix, koi8-r-dos)."
 894   (let* ((codings (copy-sequence coding-system-list))
 895          (tail (cons nil codings)))
 896     ;; Remove subsidiary coding systems (eol variants) and alias
 897     ;; coding systems (if necessary).
 898     (while (cdr tail)
 899       (let* ((coding (car (cdr tail)))
 900              (aliases (coding-system-aliases coding)))
 901         (if (or
 902              ;; CODING is an eol variant if not in ALIASES.
 903              (not (memq coding aliases))
 904              ;; CODING is an alias if it is not car of ALIASES.
 905              (and base-only (not (eq coding (car aliases)))))
 906             (setcdr tail (cdr (cdr tail)))
 907           (setq tail (cdr tail)))))
 908     codings))
 909
 910 (defconst char-coding-system-table nil
 911   "This is an obsolete variable.
 912 It exists just for backward compatibility, and the value is always nil.")
 913
 914 (defun transform-make-coding-system-args (name type &optional doc-string props)
 915   "For internal use only.
 916 Transform XEmacs style args for `make-coding-system' to Emacs style.
 917 Value is a list of transformed arguments."
 918   (let ((mnemonic (string-to-char (or (plist-get props 'mnemonic) "?")))
 919         (eol-type (plist-get props 'eol-type))
 920         properties tmp)
 921     (cond
 922      ((eq eol-type 'lf) (setq eol-type 'unix))
 923      ((eq eol-type 'crlf) (setq eol-type 'dos))
 924      ((eq eol-type 'cr) (setq eol-type 'mac)))
 925     (if (setq tmp (plist-get props 'post-read-conversion))
 926         (setq properties (plist-put properties 'post-read-conversion tmp)))
 927     (if (setq tmp (plist-get props 'pre-write-conversion))
 928         (setq properties (plist-put properties 'pre-write-conversion tmp)))
 929     (cond
 930      ((eq type 'shift-jis)
 931       `(,name 1 ,mnemonic ,doc-string () ,properties ,eol-type))
 932      ((eq type 'iso2022) ; This is not perfect.
 933       (if (plist-get props 'escape-quoted)
 934           (error "escape-quoted is not supported: %S"
 935                  `(,name ,type ,doc-string ,props)))
 936       (let ((g0 (plist-get props 'charset-g0))
 937             (g1 (plist-get props 'charset-g1))
 938             (g2 (plist-get props 'charset-g2))
 939             (g3 (plist-get props 'charset-g3))
 940             (use-roman
 941              (and
 942               (eq (cadr (assoc 'latin-jisx0201
 943                                (plist-get props 'input-charset-conversion)))
 944                   'ascii)
 945               (eq (cadr (assoc 'ascii
 946                                (plist-get props 'output-charset-conversion)))
 947                   'latin-jisx0201)))
 948             (use-oldjis
 949              (and
 950               (eq (cadr (assoc 'japanese-jisx0208-1978
 951                                (plist-get props 'input-charset-conversion)))
 952                   'japanese-jisx0208)
 953               (eq (cadr (assoc 'japanese-jisx0208
 954                                (plist-get props 'output-charset-conversion)))
 955                   'japanese-jisx0208-1978))))
 956         (if (charsetp g0)
 957             (if (plist-get props 'force-g0-on-output)
 958                 (setq g0 `(nil ,g0))
 959               (setq g0 `(,g0 t))))
 960         (if (charsetp g1)
 961             (if (plist-get props 'force-g1-on-output)
 962                 (setq g1 `(nil ,g1))
 963               (setq g1 `(,g1 t))))
 964         (if (charsetp g2)
 965             (if (plist-get props 'force-g2-on-output)
 966                 (setq g2 `(nil ,g2))
 967               (setq g2 `(,g2 t))))
 968         (if (charsetp g3)
 969             (if (plist-get props 'force-g3-on-output)
 970                 (setq g3 `(nil ,g3))
 971               (setq g3 `(,g3 t))))
 972         `(,name 2 ,mnemonic ,doc-string
 973           (,g0 ,g1 ,g2 ,g3
 974            ,(plist-get props 'short)
 975            ,(not (plist-get props 'no-ascii-eol))
 976            ,(not (plist-get props 'no-ascii-cntl))
 977            ,(plist-get props 'seven)
 978            t
 979            ,(not (plist-get props 'lock-shift))
 980            ,use-roman
 981            ,use-oldjis
 982            ,(plist-get props 'no-iso6429)
 983            nil nil nil nil)
 984         ,properties ,eol-type)))
 985      ((eq type 'big5)
 986       `(,name 3 ,mnemonic ,doc-string () ,properties ,eol-type))
 987      ((eq type 'ccl)
 988       `(,name 4 ,mnemonic ,doc-string
 989               (,(plist-get props 'decode) . ,(plist-get props 'encode))
 990               ,properties ,eol-type))
 991      (t
 992       (error "unsupported XEmacs style make-coding-style arguments: %S"
 993              `(,name ,type ,doc-string ,props))))))
 994
 995 (defun make-coding-system (coding-system type mnemonic doc-string
 996                                          &optional
 997                                          flags
 998                                          properties
 999                                          eol-type)
1000   "Define a new coding system CODING-SYSTEM (symbol).
1001 This function is provided for backward compatibility.
1002 Use `define-coding-system' instead."
1003   ;; For compatiblity with XEmacs, we check the type of TYPE.  If it
1004   ;; is a symbol, perhaps, this function is called with XEmacs-style
1005   ;; arguments.  Here, try to transform that kind of arguments to
1006   ;; Emacs style.
1007   (if (symbolp type)
1008       (let ((args (transform-make-coding-system-args coding-system type
1009                                                      mnemonic doc-string)))
1010         (setq coding-system (car args)
1011               type (nth 1 args)
1012               mnemonic (nth 2 args)
1013               doc-string (nth 3 args)
1014               flags (nth 4 args)
1015               properties (nth 5 args)
1016               eol-type (nth 6 args))))
1017
1018   (setq type
1019         (cond ((eq type 0) 'emacs-mule)
1020               ((eq type 1) 'shift-jis)
1021               ((eq type 2) 'iso2022)
1022               ((eq type 3) 'big5)
1023               ((eq type 4) 'ccl)
1024               ((eq type 5) 'raw-text)
1025               (t
1026                (error "Invalid coding system type: %s" type))))
1027
1028   (setq properties
1029         (let ((plist nil) key)
1030           (dolist (elt properties)
1031             (setq key (car elt))
1032             (cond ((eq key 'post-read-conversion)
1033                    (setq key :post-read-conversion))
1034                   ((eq key 'pre-write-conversion)
1035                    (setq key :pre-write-conversion))
1036                   ((eq key 'translation-table-for-decode)
1037                    (setq key :decode-translation-table))
1038                   ((eq key 'translation-table-for-encode)
1039                    (setq key :encode-translation-table))
1040                   ((eq key 'safe-charsets)
1041                    (setq key :charset-list))
1042                   ((eq key 'mime-charset)
1043                    (setq key :mime-charset))
1044                   ((eq key 'valid-codes)
1045                    (setq key :valids)))
1046             (setq plist (plist-put plist key (cdr elt))))
1047           plist))
1048   (setq properties (plist-put properties :mnemonic mnemonic))
1049   (plist-put properties :coding-type type)
1050   (cond ((eq eol-type 0) (setq eol-type 'unix))
1051         ((eq eol-type 1) (setq eol-type 'dos))
1052         ((eq eol-type 2) (setq eol-type 'mac))
1053         ((vectorp eol-type) (setq eol-type nil)))
1054   (plist-put properties :eol-type eol-type)
1055
1056   (cond
1057    ((eq type 'iso2022)
1058     (plist-put properties :flags
1059                (list (and (or (consp (nth 0 flags))
1060                               (consp (nth 1 flags))
1061                               (consp (nth 2 flags))
1062                               (consp (nth 3 flags))) 'designation)
1063                      (or (nth 4 flags) 'long-form)
1064                      (and (nth 5 flags) 'ascii-at-eol)
1065                      (and (nth 6 flags) 'ascii-at-cntl)
1066                      (and (nth 7 flags) '7-bit)
1067                      (and (nth 8 flags) 'locking-shift)
1068                      (and (nth 9 flags) 'single-shift)
1069                      (and (nth 10 flags) 'use-roman)
1070                      (and (nth 11 flags) 'use-oldjis)
1071                      (or (nth 12 flags) 'direction)
1072                      (and (nth 13 flags) 'init-at-bol)
1073                      (and (nth 14 flags) 'designate-at-bol)
1074                      (and (nth 15 flags) 'safe)
1075                      (and (nth 16 flags) 'latin-extra)))
1076     (plist-put properties :designation
1077                (let ((vec (make-vector 4 nil)))
1078                  (dotimes (i 4)
1079                    (let ((spec (nth i flags)))
1080                      (if (eq spec t)
1081                          (aset vec i '(94 96))
1082                      (if (consp spec)
1083                          (progn
1084                            (if (memq t spec)
1085                                (setq spec (append (delq t spec) '(94 96))))
1086                            (aset vec i spec))))))
1087                  vec)))
1088
1089    ((eq type 'ccl)
1090     (plist-put properties :ccl-decoder (car flags))
1091     (plist-put properties :ccl-encoder (cdr flags))))
1092
1093   (apply 'define-coding-system coding-system doc-string properties))
1094
1095 (defun merge-coding-systems (first second)
1096   "Fill in any unspecified aspects of coding system FIRST from SECOND.
1097 Return the resulting coding system."
1098   (let ((base (coding-system-base second))
1099         (eol (coding-system-eol-type second)))
1100     ;; If FIRST doesn't specify text conversion, merge with that of SECOND.
1101     (if (eq (coding-system-base first) 'undecided)
1102         (setq first (coding-system-change-text-conversion first base)))
1103     ;; If FIRST doesn't specify eol conversion, merge with that of SECOND.
1104     (if (and (vectorp (coding-system-eol-type first))
1105              (numberp eol) (>= eol 0) (<= eol 2))
1106         (setq first (coding-system-change-eol-conversion
1107                      first eol)))
1108     first))
1109
1110 (defun set-buffer-file-coding-system (coding-system &optional force)
1111   "Set the file coding-system of the current buffer to CODING-SYSTEM.
1112 This means that when you save the buffer, it will be converted
1113 according to CODING-SYSTEM.  For a list of possible values of CODING-SYSTEM,
1114 use \\[list-coding-systems].
1115
1116 If CODING-SYSTEM leaves the text conversion unspecified, or if it
1117 leaves the end-of-line conversion unspecified, FORCE controls what to
1118 do.  If FORCE is nil, get the unspecified aspect (or aspects) from the
1119 buffer's previous `buffer-file-coding-system' value (if it is
1120 specified there).  Otherwise, leave it unspecified.
1121
1122 This marks the buffer modified so that the succeeding \\[save-buffer]
1123 surely saves the buffer with CODING-SYSTEM.  From a program, if you
1124 don't want to mark the buffer modified, just set the variable
1125 `buffer-file-coding-system' directly."
1126   (interactive "zCoding system for saving file (default, nil): \nP")
1127   (check-coding-system coding-system)
1128   (if (and coding-system buffer-file-coding-system (null force))
1129       (setq coding-system
1130             (merge-coding-systems coding-system buffer-file-coding-system)))
1131   (setq buffer-file-coding-system coding-system)
1132   ;; This is in case of an explicit call.  Normally, `normal-mode' and
1133   ;; `set-buffer-major-mode-hook' take care of setting the table.
1134   (if (fboundp 'ucs-set-table-for-input) ; don't lose when building
1135       (ucs-set-table-for-input))
1136   (set-buffer-modified-p t)
1137   (force-mode-line-update))
1138
1139 (defun revert-buffer-with-coding-system (coding-system &optional force)
1140   "Visit the current buffer's file again using coding system CODING-SYSTEM.
1141 For a list of possible values of CODING-SYSTEM, use \\[list-coding-systems].
1142
1143 If CODING-SYSTEM leaves the text conversion unspecified, or if it
1144 leaves the end-of-line conversion unspecified, FORCE controls what to
1145 do.  If FORCE is nil, get the unspecified aspect (or aspects) from the
1146 buffer's previous `buffer-file-coding-system' value (if it is
1147 specified there).  Otherwise, determine it from the file contents as
1148 usual for visiting a file."
1149   (interactive "zCoding system for visited file (default, nil): \nP")
1150   (check-coding-system coding-system)
1151   (if (and coding-system buffer-file-coding-system (null force))
1152       (setq coding-system
1153             (merge-coding-systems coding-system buffer-file-coding-system)))
1154   (let ((coding-system-for-read coding-system))
1155     (revert-buffer)))
1156
1157 (defun set-file-name-coding-system (coding-system)
1158   "Set coding system for decoding and encoding file names to CODING-SYSTEM.
1159 It actually just set the variable `file-name-coding-system' (which
1160 see) to CODING-SYSTEM."
1161   (interactive "zCoding system for file names (default, nil): ")
1162   (check-coding-system coding-system)
1163   (setq file-name-coding-system coding-system))
1164
1165 (defvar default-terminal-coding-system nil
1166   "Default value for the terminal coding system.
1167 This is normally set according to the selected language environment.
1168 See also the command `set-terminal-coding-system'.")
1169
1170 (defun set-terminal-coding-system (coding-system)
1171   "Set coding system of your terminal to CODING-SYSTEM.
1172 All text output to the terminal will be encoded
1173 with the specified coding system.
1174 For a list of possible values of CODING-SYSTEM, use \\[list-coding-systems].
1175 The default is determined by the selected language environment
1176 or by the previous use of this command."
1177   (interactive
1178    (list (let ((default (if (and (not (terminal-coding-system))
1179                                  default-terminal-coding-system)
1180                             default-terminal-coding-system)))
1181            (read-coding-system
1182             (format "Coding system for terminal display (default, %s): "
1183                     default)
1184             default))))
1185   (if (and (not coding-system)
1186            (not (terminal-coding-system)))
1187       (setq coding-system default-terminal-coding-system))
1188   (if coding-system
1189       (setq default-terminal-coding-system coding-system))
1190   (set-terminal-coding-system-internal coding-system)
1191   (redraw-frame (selected-frame)))
1192
1193 (defvar default-keyboard-coding-system nil
1194   "Default value of the keyboard coding system.
1195 This is normally set according to the selected language environment.
1196 See also the command `set-keyboard-coding-system'.")
1197
1198 (defun set-keyboard-coding-system (coding-system)
1199   "Set coding system for keyboard input to CODING-SYSTEM.
1200 In addition, this command enables Encoded-kbd minor mode.
1201 \(If CODING-SYSTEM is nil, Encoded-kbd mode is turned off -- see
1202 `encoded-kbd-mode'.)
1203 For a list of possible values of CODING-SYSTEM, use \\[list-coding-systems].
1204 The default is determined by the selected language environment
1205 or by the previous use of this command."
1206   (interactive
1207    (list (let ((default (if (and (not (keyboard-coding-system))
1208                                  default-keyboard-coding-system)
1209                             default-keyboard-coding-system)))
1210            (read-coding-system
1211             (format "Coding system for keyboard input (default, %s): "
1212                     default)
1213             default))))
1214   (if (and (not coding-system)
1215            (not (keyboard-coding-system)))
1216       (setq coding-system default-keyboard-coding-system))
1217   (if coding-system
1218       (setq default-keyboard-coding-system coding-system))
1219   (set-keyboard-coding-system-internal coding-system)
1220   (setq keyboard-coding-system coding-system)
1221   (encoded-kbd-mode (if coding-system 1 0)))
1222
1223 (defcustom keyboard-coding-system nil
1224   "Specify coding system for keyboard input.
1225 If you set this on a terminal which can't distinguish Meta keys from
1226 8-bit characters, you will have to use ESC to type Meta characters.
1227 See Info node `Specify Coding' and Info node `Single-Byte Character Support'.
1228
1229 On non-windowing terminals, this is set from the locale by default.
1230
1231 Setting this variable directly does not take effect;
1232 use either \\[customize] or \\[set-keyboard-coding-system]."
1233   :type '(coding-system :tag "Coding system")
1234   :link '(info-link "(emacs)Specify Coding")
1235   :link '(info-link "(emacs)Single-Byte Character Support")
1236   :set (lambda (symbol value)
1237          ;; Don't load encoded-kbd-mode unnecessarily.
1238          (if (or value (boundp 'encoded-kbd-mode))
1239              (set-keyboard-coding-system value)
1240            (set-default 'keyboard-coding-system nil))) ; must initialize
1241   :version "21.4"
1242   :group 'keyboard
1243   :group 'mule)
1244
1245 (defun set-buffer-process-coding-system (decoding encoding)
1246   "Set coding systems for the process associated with the current buffer.
1247 DECODING is the coding system to be used to decode input from the process,
1248 ENCODING is the coding system to be used to encode output to the process.
1249
1250 For a list of possible values of CODING-SYSTEM, use \\[list-coding-systems]."
1251   (interactive
1252    "zCoding-system for output from the process: \nzCoding-system for input to the process: ")
1253   (let ((proc (get-buffer-process (current-buffer))))
1254     (if (null proc)
1255         (error "No process")
1256       (check-coding-system decoding)
1257       (check-coding-system encoding)
1258       (set-process-coding-system proc decoding encoding)))
1259   (force-mode-line-update))
1260
1261 (defalias 'set-clipboard-coding-system 'set-selection-coding-system)
1262
1263 (defun set-selection-coding-system (coding-system)
1264   "Make CODING-SYSTEM used for communicating with other X clients.
1265 When sending or receiving text via cut_buffer, selection, and clipboard,
1266 the text is encoded or decoded by CODING-SYSTEM."
1267   (interactive "zCoding system for X selection: ")
1268   (check-coding-system coding-system)
1269   (setq selection-coding-system coding-system))
1270
1271 ;; Coding system lastly specified by the command
1272 ;; set-next-selection-coding-system.
1273 (defvar last-next-selection-coding-system nil)
1274
1275 (defun set-next-selection-coding-system (coding-system)
1276   "Use CODING-SYSTEM for next communication with other window system clients.
1277 This setting is effective for the next communication only."
1278   (interactive
1279    (list (read-coding-system
1280           (if last-next-selection-coding-system
1281               (format "Coding system for the next selection (default, %S): "
1282                       last-next-selection-coding-system)
1283             "Coding system for the next selection: ")
1284           last-next-selection-coding-system)))
1285   (if coding-system
1286       (setq last-next-selection-coding-system coding-system)
1287     (setq coding-system last-next-selection-coding-system))
1288   (check-coding-system coding-system)
1289
1290   (setq next-selection-coding-system coding-system))
1291
1292 (defun set-coding-priority (arg)
1293   "Set priority of coding categories according to ARG.
1294 ARG is a list of coding categories ordered by priority.
1295
1296 This function is provided for backward compatibility.
1297 Now we have more convenient function `set-coding-system-priority'."
1298   (apply 'set-coding-system-priority
1299          (mapcar #'(lambda (x) (symbol-value x)) arg)))
1300 (make-obsolete 'set-coding-priority 'set-coding-system-priority "22.1")
1301
1302 ;;; X selections
1303
1304 (defvar ctext-non-standard-encodings-alist
1305   '(("big5-0" big5 2 (chinese-big5-1 chinese-big5-2))
1306     ("ISO8859-14" iso-8859-14 1 latin-iso8859-14)
1307     ("ISO8859-15" iso-8859-15 1 latin-iso8859-15))
1308   "Alist of non-standard encoding names vs the corresponding usages in CTEXT.
1309
1310 It controls how extended segments of a compound text are handled
1311 by the coding system `compound-text-with-extensions'.
1312
1313 Each element has the form (ENCODING-NAME CODING-SYSTEM N-OCTET CHARSET).
1314
1315 ENCODING-NAME is an encoding name of an \"extended segments\".
1316
1317 CODING-SYSTEM is the coding-system to encode (or decode) the
1318 characters into (or from) the extended segment.
1319
1320 N-OCTET is the number of octets (bytes) that encodes a character
1321 in the segment.  It can be 0 (meaning the number of octets per
1322 character is variable), 1, 2, 3, or 4.
1323
1324 CHARSET is a charater set containing characters that are encoded
1325 in the segment.  It can be a list of character sets.  It can also
1326 be a char-table, in which case characters that have non-nil value
1327 in the char-table are the target.
1328
1329 On decoding CTEXT, all encoding names listed here are recognized.
1330
1331 On encoding CTEXT, encoding names in the variable
1332 `ctext-non-standard-encodings' (which see) and in the information
1333 listed for the current language environment under the key
1334 `ctext-non-standard-encodings' are used.")
1335
1336 (defvar ctext-non-standard-encodings
1337   '("big5-0")
1338   "List of non-standard encoding names used in extended segments of CTEXT.
1339 Each element must be one of the names listed in the variable
1340 `ctext-non-standard-encodings-alist' (which see).")
1341
1342 (defvar ctext-non-standard-encodings-regexp
1343   (string-to-multibyte
1344    (concat
1345     ;; For non-standard encodings.
1346     "\\(\e%/[0-4][\200-\377][\200-\377]\\([^\002]+\\)\002\\)"
1347     "\\|"
1348     ;; For UTF-8 encoding.
1349     "\\(\e%G[^\e]*\e%@\\)")))
1350
1351 ;; Functions to support "Non-Standard Character Set Encodings" defined
1352 ;; by the COMPOUND-TEXT spec.  They also support "The UTF-8 encoding"
1353 ;; described in the section 7 of the documentation of COMPOUND-TEXT
1354 ;; distributed with XFree86.
1355
1356 (defun ctext-post-read-conversion (len)
1357   "Decode LEN characters encoded as Compound Text with Extended Segments."
1358   ;; We don't need the following because it is expected that this
1359   ;; function is mainly used for decoding X selection which is not
1360   ;; that big data.
1361   ;;(buffer-disable-undo) ; minimize consing due to insertions and deletions
1362   (save-match-data
1363     (save-restriction
1364       (narrow-to-region (point) (+ (point) len))
1365       (let ((case-fold-search nil)
1366             last-coding-system-used
1367             pos bytes)
1368         (decode-coding-region (point-min) (point-max) 'ctext)
1369         (while (re-search-forward ctext-non-standard-encodings-regexp
1370                                   nil 'move)
1371           (setq pos (match-beginning 0))
1372           (if (match-beginning 1)
1373               ;; ESC % / [0-4] M L --ENCODING-NAME-- \002 --BYTES--
1374               (let* ((M (char-after (+ pos 4)))
1375                      (L (char-after (+ pos 5)))
1376                      (encoding (match-string 2))
1377                      (encoding-info (assoc-ignore-case
1378                                      encoding
1379                                      ctext-non-standard-encodings-alist))
1380                      (coding (if encoding-info
1381                                  (nth 1 encoding-info)
1382                                (setq encoding (intern (downcase encoding)))
1383                                (and (coding-system-p encoding)
1384                                     encoding))))
1385                 (setq bytes (- (+ (* (- M 128) 128) (- L 128))
1386                                (- (point) (+ pos 6))))
1387                 (when coding
1388                   (delete-region pos (point))
1389                   (forward-char bytes)
1390                   (decode-coding-region (- (point) bytes) (point) coding)))
1391             ;; ESC % G --UTF-8-BYTES-- ESC % @
1392             (delete-char -3)
1393             (delete-region pos (+ pos 3))
1394             (decode-coding-region pos (point) 'utf-8))))
1395       (goto-char (point-min))
1396       (- (point-max) (point)))))
1397
1398 ;; Return a char table of extended segment usage for each character.
1399 ;; Each value of the char table is nil, one of the elements of
1400 ;; `ctext-non-standard-encodings-alist', or the symbol `utf-8'.
1401
1402 (defun ctext-non-standard-encodings-table ()
1403   (let ((table (make-char-table 'translation-table)))
1404     (aset table (make-char 'mule-unicode-0100-24ff) 'utf-8)
1405     (aset table (make-char 'mule-unicode-2500-33ff) 'utf-8)
1406     (aset table (make-char 'mule-unicode-e000-ffff) 'utf-8)
1407     (dolist (encoding (reverse
1408                        (append
1409                         (get-language-info current-language-environment
1410                                            'ctext-non-standard-encodings)
1411                         ctext-non-standard-encodings)))
1412       (let* ((slot (assoc encoding ctext-non-standard-encodings-alist))
1413              (charset (nth 3 slot)))
1414         (if charset
1415             (cond ((charsetp charset)
1416                    (aset table (make-char charset) slot))
1417                   ((listp charset)
1418                    (dolist (elt charset)
1419                      (aset table (make-char elt) slot)))
1420                   ((char-table-p charset)
1421                    (map-char-table #'(lambda (k v)
1422                                    (if (and v (> k 128)) (aset table k slot)))
1423                                    charset))))))
1424     table))
1425
1426 (defun ctext-pre-write-conversion (from to)
1427   "Encode characters between FROM and TO as Compound Text w/Extended Segments.
1428
1429 If FROM is a string, or if the current buffer is not the one set up for us
1430 by encode-coding-string, generate a new temp buffer, insert the
1431 text, and convert it in the temporary buffer.  Otherwise, convert in-place."
1432   (save-match-data
1433     ;; Setup a working buffer if necessary.
1434     (when (stringp from)
1435       (set-buffer (generate-new-buffer " *temp"))
1436       (set-buffer-multibyte (multibyte-string-p from))
1437       (insert from))
1438
1439     ;; Now we can encode the whole buffer.
1440     (let ((encoding-table (ctext-non-standard-encodings-table))
1441           last-coding-system-used
1442           last-pos last-encoding-info
1443           encoding-info end-pos)
1444       (goto-char (setq last-pos (point-min)))
1445       (setq end-pos (point-marker))
1446       (while (re-search-forward "[^\000-\177]+" nil t)
1447         ;; Found a sequence of non-ASCII characters.
1448         (setq last-pos (match-beginning 0)
1449               last-encoding-info (aref encoding-table (char-after last-pos)))
1450         (set-marker end-pos (match-end 0))
1451         (goto-char (1+ last-pos))
1452         (catch 'tag
1453           (while t
1454             (setq encoding-info
1455                   (if (< (point) end-pos)
1456                       (aref encoding-table (following-char))))
1457             (unless (eq last-encoding-info encoding-info)
1458               (cond ((consp last-encoding-info)
1459                      ;; Encode the previous range using an extended
1460                      ;; segment.
1461                      (let ((encoding-name (car last-encoding-info))
1462                            (coding-system (nth 1 last-encoding-info))
1463                            (noctets (nth 2 last-encoding-info))
1464                            len)
1465                        (encode-coding-region last-pos (point) coding-system)
1466                        (setq len (+ (length encoding-name) 1
1467                                     (- (point) last-pos)))
1468                        (save-excursion
1469                          (goto-char last-pos)
1470                          (insert (string-to-multibyte
1471                                   (format "\e%%/%d%c%c%s\ 2"
1472                                           noctets
1473                                           (+ (/ len 128) 128)
1474                                           (+ (% len 128) 128)
1475                                           encoding-name))))))
1476                     ((eq last-encoding-info 'utf-8)
1477                      ;; Encode the previous range using UTF-8 encoding
1478                      ;; extention.
1479                      (encode-coding-region last-pos (point) 'mule-utf-8)
1480                      (save-excursion
1481                        (goto-char last-pos)
1482                        (insert "\e%G"))
1483                      (insert "\e%@")))
1484               (setq last-pos (point)
1485                     last-encoding-info encoding-info))
1486             (if (< (point) end-pos)
1487                 (forward-char 1)
1488               (throw 'tag nil)))))
1489       (set-marker end-pos nil)
1490       (goto-char (point-min))))
1491   ;; Must return nil, as build_annotations_2 expects that.
1492   nil)
1493
1494 ;;; FILE I/O
1495
1496 (defcustom auto-coding-alist
1497   '(("\\.\\(arc\\|zip\\|lzh\\|zoo\\|jar\\|sx[dmicw]\\|tar\\)\\'" . no-conversion-multibyte)
1498     ("\\.tgz\\'" . no-conversion)
1499     ("\\.\\(gz\\|Z\\|bz\\|bz2\\|gpg\\)\\'" . no-conversion)
1500     ("/#[^/]+#\\'" . emacs-mule))
1501   "Alist of filename patterns vs corresponding coding systems.
1502 Each element looks like (REGEXP . CODING-SYSTEM).
1503 A file whose name matches REGEXP is decoded by CODING-SYSTEM on reading.
1504
1505 The settings in this alist take priority over `coding:' tags
1506 in the file (see the function `set-auto-coding')
1507 and the contents of `file-coding-system-alist'."
1508   :group 'files
1509   :group 'mule
1510   :type '(repeat (cons (regexp :tag "File name regexp")
1511                        (symbol :tag "Coding system"))))
1512
1513 (defcustom auto-coding-regexp-alist
1514   '(("^BABYL OPTIONS:[ \t]*-\\*-[ \t]*rmail[ \t]*-\\*-" . no-conversion)
1515     ("\\`;ELC\14