;;; Code:
-(defconst mule-version "5.0 (AOI)" "\
+(defconst mule-version "5.0 (SAKAKI)" "\
Version number and name of this version of MULE (multilingual environment).")
(defconst mule-version-date "1999.12.7" "\
"Set CHARSET's property list to PLIST, and return PLIST."
(aset (charset-info charset) 14 plist))
-(defun make-char (charset &optional c1 c2)
- "Return a character of CHARSET and position codes CODE1 and CODE2.
+(defun make-char (charset &optional code1 code2)
+ "Return a character of CHARSET whose position codes are CODE1 and CODE2.
CODE1 and CODE2 are optional, but if you don't supply
sufficient position codes, return a generic character which stands for
all characters or group of characters in the character set.
-A generic character can be used to index a char table (e.g. syntax-table)."
- (make-char-internal (charset-id charset) c1 c2))
+A generic character can be used to index a char table (e.g. syntax-table).
+
+Such character sets as ascii, eight-bit-control, and eight-bit-graphic
+don't have corresponding generic characters. If CHARSET is one of
+them and you don't supply CODE1, return the character of the smallest
+code in CHARSET.
+
+If CODE1 or CODE2 are invalid (out of range), this function signals an error."
+ (make-char-internal (charset-id charset) code1 code2))
(put 'make-char 'byte-compile
(function
(and (or (= (nth 1 l) 0) (eq (nth 2 l) 0))
(not (eq (car l) 'composition))))))
+(defun decode-char (ccs code-point &optional restriction)
+ "Return character specified by coded character set CCS and CODE-POINT in it.
+Return nil if such a character is not supported.
+Currently the only supported coded character set is `ucs' (ISO/IEC
+10646: Universal Multi-Octet Coded Character Set).
+
+Optional argument RESTRICTION specifies a way to map the pair of CCS
+and CODE-POINT to a chracter. Currently not supported and just ignored."
+ (cond ((eq ccs 'ucs)
+ (cond ((< code-point 160)
+ code-point)
+ ((< code-point 256)
+ (make-char 'latin-iso8859-1 code-point))
+ ((< code-point #x2500)
+ (setq code-point (- code-point #x0100))
+ (make-char 'mule-unicode-0100-24ff
+ (+ (/ code-point 96) 32) (+ (% code-point 96) 32)))
+ ((< code-point #x3400)
+ (setq code-point (- code-point #x2500))
+ (make-char 'mule-unicode-2500-33ff
+ (+ (/ code-point 96) 32) (+ (% code-point 96) 32)))
+ ((and (>= code-point #xe000) (< code-point #x10000))
+ (setq code-point (- code-point #xe000))
+ (make-char 'mule-unicode-e000-ffff
+ (+ (/ code-point 96) 32) (+ (% code-point 96) 32)))
+ ))))
+
+(defun encode-char (char ccs &optional restriction)
+ "Return code-point in coded character set CCS that corresponds to CHAR.
+Return nil if CHAR is not included in CCS.
+Currently the only supported coded character set is `ucs' (ISO/IEC
+10646: Universal Multi-Octet Coded Character Set).
+
+CHAR should be in one of these charsets:
+ ascii, latin-iso8859-1, mule-unicode-0100-24ff, mule-unicode-2500-33ff,
+ mule-unicode-e000-ffff, eight-bit-control
+Otherwise, return nil.
+
+Optional argument RESTRICTION specifies a way to map CHAR to a
+code-point in CCS. Currently not supported and just ignored."
+ (let* ((split (split-char char))
+ (charset (car split)))
+ (cond ((eq ccs 'ucs)
+ (cond ((eq charset 'ascii)
+ char)
+ ((eq charset 'latin-iso8859-1)
+ (+ (nth 1 split) 128))
+ ((eq charset 'mule-unicode-0100-24ff)
+ (+ #x0100 (+ (* (- (nth 1 split) 32) 96)
+ (- (nth 2 split) 32))))
+ ((eq charset 'mule-unicode-2500-33ff)
+ (+ #x2500 (+ (* (- (nth 1 split) 32) 96)
+ (- (nth 2 split) 32))))
+ ((eq charset 'mule-unicode-e000-ffff)
+ (+ #xe000 (+ (* (- (nth 1 split) 32) 96)
+ (- (nth 2 split) 32))))
+ ((eq charset 'eight-bit-control)
+ char))))))
+
\f
-;; Coding system staffs
+;; Coding system stuff
;; Coding system is a symbol that has the property `coding-system'.
;;
;;
;; The value is a translation table to be applied on encoding.
;;
+;; o safe-chars
+;;
+;; The value is a char table. If a character has non-nil value in it,
+;; the character is safely supported by the coding system. This
+;; overrides the specification of safe-charsets.
+
;; o safe-charsets
;;
;; The value is a list of charsets safely supported by the coding
(setcdr tem (cons coding-system (cdr tem))))))
(defun coding-system-list (&optional base-only)
- "Return a list of all existing coding systems.
-If optional arg BASE-ONLY is non-nil, only base coding systems are listed."
+ "Return a list of all existing non-subsidiary coding systems.
+If optional arg BASE-ONLY is non-nil, only base coding systems are listed.
+The value doesn't include subsidiary coding systems which are what
+made from bases and aliases automatically for various end-of-line
+formats (e.g. iso-latin-1-unix, koi8-r-dos)."
(let* ((codings (copy-sequence coding-system-list))
(tail (cons nil codings)))
;; Remove subsidiary coding systems (eol variants) and alias
(setq tail (cdr tail)))))
codings))
+(defun register-char-codings (coding-system safe-chars)
+ (let ((general (char-table-extra-slot char-coding-system-table 0)))
+ (if (eq safe-chars t)
+ (or (memq coding-system general)
+ (set-char-table-extra-slot char-coding-system-table 0
+ (cons coding-system general)))
+ (map-char-table
+ (function
+ (lambda (key val)
+ (if (and (>= key 128) val)
+ (let ((codings (aref char-coding-system-table key)))
+ (or (memq coding-system codings)
+ (aset char-coding-system-table key
+ (cons coding-system codings)))))))
+ safe-chars))))
+
+
;; Make subsidiary coding systems (eol-type variants) of CODING-SYSTEM.
(defun make-subsidiary-coding-system (coding-system)
(let ((coding-spec (coding-system-spec coding-system))
(setq i (1+ i)))
subsidiaries))
+(defun transform-make-coding-system-args (name type &optional doc-string props)
+ "For internal use only.
+Transform XEmacs style args for `make-coding-system' to Emacs style.
+Value is a list of transformed arguments."
+ (let ((mnemonic (string-to-char (or (plist-get props 'mnemonic) "?")))
+ (eol-type (plist-get props 'eol-type))
+ properties tmp)
+ (cond
+ ((eq eol-type 'lf) (setq eol-type 'unix))
+ ((eq eol-type 'crlf) (setq eol-type 'dos))
+ ((eq eol-type 'cr) (setq eol-type 'mac)))
+ (if (setq tmp (plist-get props 'post-read-conversion))
+ (setq properties (plist-put properties 'post-read-conversion tmp)))
+ (if (setq tmp (plist-get props 'pre-write-conversion))
+ (setq properties (plist-put properties 'pre-write-conversion tmp)))
+ (cond
+ ((eq type 'ccl)
+ `(,name 4
+ ,mnemonic
+ ,doc-string
+ (,(plist-get props 'decode) . ,(plist-get props 'encode))
+ ,properties
+ ,eol-type))
+ (t
+ (error "Unsupported XEmacs style arguments for make-coding-style: %S"
+ `(,name ,type ,doc-string ,props))))))
+
(defun make-coding-system (coding-system type mnemonic doc-string
&optional
flags
DESIGNATION-BOL non-nil means designation sequences should be placed
at beginning of line on output.
SAFE non-nil means convert unsafe characters to `?' on output.
- Unsafe characters are what not specified in SAFE-CHARSET.
+ Characters not specified in the property `safe-charsets' nor
+ `safe-chars' are unsafe.
ACCEPT-LATIN-EXTRA-CODE non-nil means code-detection routine accepts
a code specified in `latin-extra-code-table' (which see) as a valid
code of the coding system.
The EOL type is detected automatically for the coding system.
And, according to the detected EOL type, one of the coding
systems in the vector is selected. Elements of the vector
- corresponds to Unix-liek EOL, DOS-like EOL, and Mac-like EOL
+ corresponds to Unix-like EOL, DOS-like EOL, and Mac-like EOL
in this order.
Kludgy features for backward compatibility:
2. If PROPERTIES is just a list of character sets, the list is set as
a value of `safe-charsets' in PLIST."
+
+ ;; For compatiblity with XEmacs, we check the type of TYPE. If it
+ ;; is a symbol, perhaps, this function is called with XEmacs-style
+ ;; arguments. Here, try to transform that kind of arguments to
+ ;; Emacs style.
+ (if (symbolp type)
+ (let ((args (transform-make-coding-system-args coding-system type
+ mnemonic doc-string)))
+ (setq coding-system (car args)
+ type (nth 1 args)
+ mnemonic (nth 2 args)
+ doc-string (nth 3 args)
+ flags (nth 4 args)
+ properties (nth 5 args)
+ eol-type (nth 6 args))))
+
;; Set a value of `coding-system' property.
(let ((coding-spec (make-vector 5 nil))
(no-initial-designation t)
(no-alternative-designation t)
+ (accept-latin-extra-code nil)
coding-category)
(if (or (not (integerp type)) (< type 0) (> type 5))
(error "TYPE argument must be 0..5"))
(setq fl (cdr fl) i (1+ i)))
(while (and (< i 32) fl)
(aset vec i (car fl))
+ (if (and (= i 16) ; ACCEPT-LATIN-EXTRA-CODE
+ (car fl))
+ (setq accept-latin-extra-code t))
(setq fl (cdr fl) i (1+ i)))
(aset coding-spec 4 vec)
(setq coding-category
(not (consp (car properties)))))
;; In the old version, the arg PROPERTIES is a list to be
;; set in PLIST as a value of property `safe-charsets'.
- (plist-put plist 'safe-charsets properties)
- ;; In the current version PROPERTIES is a property list.
- ;; Reflect it into PLIST one by one.
- (let ((l properties))
- (while l
- (plist-put plist (car (car l)) (cdr (car l)))
- (setq l (cdr l)))))
+ (setq properties (list (cons 'safe-charsets properties))))
+ ;; In the current version PROPERTIES is a property list.
+ ;; Reflect it into PLIST one by one while handling safe-chars
+ ;; specially.
+ (let ((safe-charsets (cdr (assq 'safe-charsets properties)))
+ (safe-chars (cdr (assq 'safe-chars properties)))
+ (l properties)
+ prop val)
+ ;; If only safe-charsets is specified, make a char-table from
+ ;; it, and store that char-table as the value of `safe-chars'.
+ (if (and (not safe-chars) safe-charsets)
+ (let (charset)
+ (if (eq safe-charsets t)
+ (setq safe-chars t)
+ (setq safe-chars (make-char-table 'safe-chars))
+ (while safe-charsets
+ (setq charset (car safe-charsets)
+ safe-charsets (cdr safe-charsets))
+ (cond ((eq charset 'ascii)) ; just ignore
+ ((eq charset 'eight-bit-control)
+ (let ((i 128))
+ (while (< i 160)
+ (aset safe-chars i t)
+ (setq i (1+ i)))))
+ ((eq charset 'eight-bit-graphic)
+ (let ((i 160))
+ (while (< i 256)
+ (aset safe-chars i t)
+ (setq i (1+ i)))))
+ (t
+ (aset safe-chars (make-char charset) t))))
+ (if accept-latin-extra-code
+ (let ((i 128))
+ (while (< i 160)
+ (if (aref latin-extra-code-table i)
+ (aset safe-chars i t))
+ (setq i (1+ i))))))
+ (setq l (cons (cons 'safe-chars safe-chars) l))))
+ (while l
+ (setq prop (car (car l)) val (cdr (car l)) l (cdr l))
+ (if (eq prop 'safe-chars)
+ (progn
+ (if (and (symbolp val)
+ (get val 'translation-table))
+ (setq safe-chars (get val 'translation-table)))
+ (register-char-codings coding-system safe-chars)
+ (setq val safe-chars)))
+ (plist-put plist prop val)))
;; The property `coding-category' may have been set differently
;; through PROPERTIES.
(setq coding-category (plist-get plist 'coding-category))
(cons coding-system (get coding-category 'coding-systems))))
;; Next, set a value of `eol-type' property.
- (if (and (not eol-type)
- (or (<= type 3) (= type 5)))
+ (if (not eol-type)
;; If EOL-TYPE is nil, set a vector of subsidiary coding
;; systems, each corresponds to a coding system for the detected
;; EOL format.
(if (or (eq coding-category 'coding-category-iso-8-1)
(eq coding-category 'coding-category-iso-8-2))
(let ((esc (intern (concat (symbol-name coding-system) "-with-esc")))
- (doc (format "Same as %s but can handle any charsets by ISO's escape sequences." coding-system)))
+ (doc (format "Same as %s but can handle any charsets by ISO's escape sequences." coding-system))
+ (safe-charsets (assq 'safe-charsets properties))
+ (mime-charset (assq 'mime-charset properties)))
+ (if safe-charsets
+ (setcdr safe-charsets t)
+ (setq properties (cons (cons 'safe-charsets t) properties)))
+ (if mime-charset
+ (setcdr mime-charset nil))
(make-coding-system esc type mnemonic doc
(if (listp (car flags))
(cons (append (car flags) '(t)) (cdr flags))
(cons (list (car flags) t) (cdr flags)))
- properties)
- (coding-system-put esc 'mime-charset nil)
- (coding-system-put esc 'safe-charsets t))))
+ properties))))
coding-system)
If the buffer's previous file coding-system value specifies end-of-line
conversion, and CODING-SYSTEM does not specify one, CODING-SYSTEM is
merged with the already-specified end-of-line conversion.
-However, if the optional prefix argument FORCE is non-nil,
-then CODING-SYSTEM is used exactly as specified.
+
+If the buffer's previous file coding-system value specifies text
+conversion, and CODING-SYSTEM does not specify one, CODING-SYSTEM is
+merged with the already-specified text conversion.
+
+However, if the optional prefix argument FORCE is non-nil, then
+CODING-SYSTEM is used exactly as specified.
This marks the buffer modified so that the succeeding \\[save-buffer]
surely saves the buffer with CODING-SYSTEM. From a program, if you
`buffer-file-coding-system' directly."
(interactive "zCoding system for visited file (default, nil): \nP")
(check-coding-system coding-system)
- (if (null force)
- (let ((x (coding-system-eol-type buffer-file-coding-system))
- (y (coding-system-eol-type coding-system)))
- (if (and (numberp x) (>= x 0) (<= x 2) (vectorp y))
- (setq coding-system (aref y x)))))
+ (if (and coding-system buffer-file-coding-system (null force))
+ (let ((base (coding-system-base buffer-file-coding-system))
+ (eol (coding-system-eol-type buffer-file-coding-system)))
+ ;; If CODING-SYSTEM doesn't specify text conversion, merge
+ ;; with that of buffer-file-coding-system.
+ (if (eq (coding-system-base coding-system) 'undecided)
+ (setq coding-system (coding-system-change-text-conversion
+ coding-system base)))
+ ;; If CODING-SYSTEM doesn't specify eol conversion, merge with
+ ;; that of buffer-file-coding-system.
+ (if (and (vectorp (coding-system-eol-type coding-system))
+ (numberp eol) (>= eol 0) (<= eol 2))
+ (setq coding-system (coding-system-change-eol-conversion
+ coding-system eol)))))
(setq buffer-file-coding-system coding-system)
(set-buffer-modified-p t)
(force-mode-line-update))
(defun set-keyboard-coding-system (coding-system)
"Set coding system for keyboard input to CODING-SYSTEM.
In addition, this command enables Encoded-kbd minor mode.
-\(If CODING-SYSTEM is nil, Encoded-kbd mode is turned off.)
+\(If CODING-SYSTEM is nil, Encoded-kbd mode is turned off -- see
+`encoded-kbd-mode'.)
For a list of possible values of CODING-SYSTEM, use \\[list-coding-systems].
The default is determined by the selected language environment
or by the previous use of this command."
(set-keyboard-coding-system-internal coding-system)
(encoded-kbd-mode (if coding-system 1 0)))
+(defcustom keyboard-coding-system nil
+ "Specify coding system for keyboard input.
+If you set this on a terminal which can't distinguish Meta keys from
+8-bit characters, you will have to use ESC to type Meta characters.
+See Info node `Specify Coding' and Info node `Single-Byte Character Support'.
+
+Setting this variable directly does not take effect;
+use either M-x customize or \\[set-keyboard-coding-system]."
+ :type '(coding-system :tag "Coding system")
+ :link '(info-link "(emacs)Specify Coding")
+ :link '(info-link "(emacs)Single-Byte Character Support")
+ :set (lambda (symbol value)
+ ;; Don't load encoded-kbd-mode unnecessarily.
+ (if (or value (boundp 'encoded-kbd-mode))
+ (set-keyboard-coding-system value)
+ (set-default 'keyboard-coding-system nil))) ; must initialize
+ :version "21.1"
+ :group 'keyboard
+ :group 'mule)
+
(defun set-buffer-process-coding-system (decoding encoding)
"Set coding systems for the process associated with the current buffer.
DECODING is the coding system to be used to decode input from the process,
For a list of possible values of CODING-SYSTEM, use \\[list-coding-systems]."
(interactive
- "zCoding-system for process input: \nzCoding-system for process output: ")
+ "zCoding-system for output from the process: \nzCoding-system for input to the process: ")
(let ((proc (get-buffer-process (current-buffer))))
(if (null proc)
(error "no process")
;;; FILE I/O
-(defvar auto-coding-alist
+(defcustom auto-coding-alist
'(("\\.\\(arc\\|zip\\|lzh\\|zoo\\|jar\\|tar\\|tgz\\)\\'" . no-conversion)
("\\.\\(ARC\\|ZIP\\|LZH\\|ZOO\\|JAR\\|TAR\\|TGZ\\)\\'" . no-conversion))
"Alist of filename patterns vs corresponding coding systems.
The settings in this alist take priority over `coding:' tags
in the file (see the function `set-auto-coding')
-and the contents of `file-coding-system-alist'.")
+and the contents of `file-coding-system-alist'."
+ :group 'files
+ :group 'mule
+ :type '(repeat (cons (regexp :tag "File name regexp")
+ (symbol :tag "Coding system"))))
(defvar set-auto-coding-for-load nil
"Non-nil means look for `load-coding' property instead of `coding'.
(find-new-buffer-file-coding-system last-coding-system-used))
(modified-p (buffer-modified-p)))
(when coding-system
- (set-buffer-file-coding-system coding-system)
+ (set-buffer-file-coding-system coding-system t)
(if (and enable-multibyte-characters
(or (eq coding-system 'no-conversion)
(eq (coding-system-type coding-system) 5))
a generic character containing the same number of characters, or a
ordinary character. If FROM and TO are both generic characters, all
characters belonging to FROM are translated to characters belonging to TO
-without changing their position code(s)."
+without changing their position code(s).
+
+The arguments and forms in each argument are processed in the given
+order, and if a previous form already translates TO to some other
+character, say TO-ALT, FROM is also translated to TO-ALT."
(let ((table (make-char-table 'translation-table))
revlist)
(while args
HCoop / bpt / emacs.git / blobdiff