;;; Code:
-(defconst mule-version "4.0 (HANANOEN)" "\
+(defconst mule-version "5.0 (SAKAKI)" "\
Version number and name of this version of MULE (multilingual environment).")
-(defconst mule-version-date "1998.7.1" "\
+(defconst mule-version-date "1999.12.7" "\
Distribution date of this version of MULE (multilingual environment).")
(defun load-with-code-conversion (fullname file &optional noerror nomessage)
;; convert multibyte strings to unibyte
;; after reading them.
;; (not default-enable-multibyte-characters)
+ nil t
))
(let (kill-buffer-hook kill-buffer-query-functions)
(kill-buffer buffer)))
(< (aref vector 0) 160)))))
(defsubst charsetp (object)
- "T is OBJECT is a charset."
+ "T if OBJECT is a charset."
(and (symbolp object) (vectorp (get object 'charset))))
(defsubst charset-info (charset)
PLIST,
where
CHARSET-ID (integer) is the identification number of the charset.
+BYTES (integer) is the length of multi-byte form of a character in
+ the charset: one of 1, 2, 3, and 4.
DIMENSION (integer) is the number of bytes to represent a character of
the charset: 1 or 2.
CHARS (integer) is the number of characters in a dimension: 94 or 96.
-BYTE (integer) is the length of multi-byte form of a character in
- the charset: one of 1, 2, 3, and 4.
WIDTH (integer) is the number of columns a character in the charset
occupies on the screen: one of 0, 1, and 2.
DIRECTION (integer) is the rendering direction of characters in the
`get-charset-property' respectively."
(get charset 'charset))
+;; It is better not to use backquote in this file,
+;; because that makes a bootstrapping problem
+;; if you need to recompile all the Lisp files using interpreted code.
+
(defmacro charset-id (charset)
"Return charset identification number of CHARSET."
(if (charset-quoted-standard-p charset)
(aref (charset-info (nth 1 charset)) 0)
- `(aref (charset-info ,charset) 0)))
+ (list 'aref (list 'charset-info charset) 0)))
(defmacro charset-bytes (charset)
"Return bytes of CHARSET.
See the function `charset-info' for more detail."
(if (charset-quoted-standard-p charset)
(aref (charset-info (nth 1 charset)) 1)
- `(aref (charset-info ,charset) 1)))
+ (list 'aref (list 'charset-info charset) 1)))
(defmacro charset-dimension (charset)
"Return dimension of CHARSET.
See the function `charset-info' for more detail."
(if (charset-quoted-standard-p charset)
(aref (charset-info (nth 1 charset)) 2)
- `(aref (charset-info ,charset) 2)))
+ (list 'aref (list 'charset-info charset) 2)))
(defmacro charset-chars (charset)
"Return character numbers contained in a dimension of CHARSET.
See the function `charset-info' for more detail."
(if (charset-quoted-standard-p charset)
(aref (charset-info (nth 1 charset)) 3)
- `(aref (charset-info ,charset) 3)))
+ (list 'aref (list 'charset-info charset) 3)))
(defmacro charset-width (charset)
"Return width (how many column occupied on a screen) of CHARSET.
See the function `charset-info' for more detail."
(if (charset-quoted-standard-p charset)
(aref (charset-info (nth 1 charset)) 4)
- `(aref (charset-info ,charset) 4)))
+ (list 'aref (list 'charset-info charset) 4)))
(defmacro charset-direction (charset)
"Return direction of CHARSET.
See the function `charset-info' for more detail."
(if (charset-quoted-standard-p charset)
(aref (charset-info (nth 1 charset)) 5)
- `(aref (charset-info ,charset) 5)))
+ (list 'aref (list 'charset-info charset) 5)))
(defmacro charset-iso-final-char (charset)
"Return final char of CHARSET.
See the function `charset-info' for more detail."
(if (charset-quoted-standard-p charset)
(aref (charset-info (nth 1 charset)) 8)
- `(aref (charset-info ,charset) 8)))
+ (list 'aref (list 'charset-info charset) 8)))
(defmacro charset-iso-graphic-plane (charset)
"Return graphic plane of CHARSET.
See the function `charset-info' for more detail."
(if (charset-quoted-standard-p charset)
(aref (charset-info (nth 1 charset)) 9)
- `(aref (charset-info ,charset) 9)))
+ (list 'aref (list 'charset-info charset) 9)))
(defmacro charset-reverse-charset (charset)
"Return reverse charset of CHARSET.
See the function `charset-info' for more detail."
(if (charset-quoted-standard-p charset)
(aref (charset-info (nth 1 charset)) 10)
- `(aref (charset-info ,charset) 10)))
+ (list 'aref (list 'charset-info charset) 10)))
(defmacro charset-short-name (charset)
"Return short name of CHARSET.
See the function `charset-info' for more detail."
(if (charset-quoted-standard-p charset)
(aref (charset-info (nth 1 charset)) 11)
- `(aref (charset-info ,charset) 11)))
+ (list 'aref (list 'charset-info charset) 11)))
(defmacro charset-long-name (charset)
"Return long name of CHARSET.
See the function `charset-info' for more detail."
(if (charset-quoted-standard-p charset)
(aref (charset-info (nth 1 charset)) 12)
- `(aref (charset-info ,charset) 12)))
+ (list 'aref (list 'charset-info charset) 12)))
(defmacro charset-description (charset)
"Return description of CHARSET.
See the function `charset-info' for more detail."
(if (charset-quoted-standard-p charset)
(aref (charset-info (nth 1 charset)) 13)
- `(aref (charset-info ,charset) 13)))
+ (list 'aref (list 'charset-info charset) 13)))
(defmacro charset-plist (charset)
"Return list charset property of CHARSET.
See the function `charset-info' for more detail."
- (if (charset-quoted-standard-p charset)
- `(aref ,(charset-info (nth 1 charset)) 14)
- `(aref (charset-info ,charset) 14)))
+ (list 'aref
+ (if (charset-quoted-standard-p charset)
+ (charset-info (nth 1 charset))
+ (list 'charset-info charset))
+ 14))
(defun set-charset-plist (charset plist)
"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'.
;;
;; o coding-category
;;
;; The value is a coding category the coding system belongs to. The
-;; function `make-coding-system' and `define-coding-system-alias' sets
-;; this value automatically.
+;; function `make-coding-system' sets this value automatically
+;; unless its argument PROPERTIES specifies this property.
;;
;; o alias-coding-systems
;;
;; The value is a list of coding systems of the same alias group. The
;; first element is the coding system made at first, which we call as
-;; `base coding system'. The function `make-coding-system' and
-;; `define-coding-system-alias' set this value automatically.
+;; `base coding system'. The function `make-coding-system' sets this
+;; value automatically and `define-coding-system-alias' updates it.
;;
;; o post-read-conversion
;;
;;
;; 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
(car (coding-system-get coding-system 'alias-coding-systems)))
(defalias 'coding-system-parent 'coding-system-base)
-(make-obsolete 'coding-system-parent 'coding-system-base)
+(make-obsolete 'coding-system-parent 'coding-system-base "20.3")
;; Coding system also has a property `eol-type'.
;;
(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 properties)
+ &optional
+ flags
+ properties
+ eol-type)
"Define a new coding system CODING-SYSTEM (symbol).
Remaining arguments are TYPE, MNEMONIC, DOC-STRING, FLAGS (optional),
and PROPERTIES (optional) which construct a coding-spec of CODING-SYSTEM
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.
also sets properties `coding-category' and `alias-coding-systems'
automatically.
+EOL-TYPE specifies the EOL type of the coding-system in one of the
+following formats:
+
+ o symbol (unix, dos, or mac)
+
+ The symbol `unix' means Unix-like EOL (LF), `dos' means
+ DOS-like EOL (CRLF), and `mac' means MAC-like EOL (CR).
+
+ o number (0, 1, or 2)
+
+ The number 0, 1, and 2 mean UNIX, DOS, and MAC-like EOL
+ respectively.
+
+ o vector of coding-systems of length 3
+
+ 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-like EOL, DOS-like EOL, and Mac-like EOL
+ in this order.
+
Kludgy features for backward compatibility:
1. If TYPE is 4 and car or cdr of FLAGS is a vector, the vector is
2. If PROPERTIES is just a list of character sets, the list is set as
a value of `safe-charsets' in PLIST."
- (if (memq coding-system coding-system-list)
- (error "Coding system %s already exists" coding-system))
+
+ ;; 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"))
(aset coding-spec coding-spec-type-idx type)
(aset coding-spec coding-spec-mnemonic-idx mnemonic)
(aset coding-spec coding-spec-doc-string-idx
- (if (stringp doc-string) doc-string ""))
+ (purecopy (if (stringp doc-string) doc-string "")))
(cond ((= type 0)
(setq coding-category 'coding-category-emacs-mule))
((= type 1)
(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)
- (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))
(aset coding-spec coding-spec-plist-idx plist))
(put coding-system 'coding-system coding-spec)
(put coding-category 'coding-systems
(cons coding-system (get coding-category 'coding-systems))))
- ;; Next, set a value of `eol-type' property. The value is a vector
- ;; of subsidiary coding systems, each corresponds to a coding system
- ;; for the detected end-of-line format.
- (put coding-system 'eol-type
- (if (or (<= type 3) (= type 5))
- (make-subsidiary-coding-system coding-system)
- 0))
+ ;; Next, set a value of `eol-type' property.
+ (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.
+ (setq eol-type (make-subsidiary-coding-system coding-system)))
+ (setq eol-type
+ (cond ((or (eq eol-type 'unix) (null eol-type))
+ 0)
+ ((eq eol-type 'dos)
+ 1)
+ ((eq eol-type 'mac)
+ 2)
+ ((or (and (vectorp eol-type)
+ (= (length eol-type) 3))
+ (and (numberp eol-type)
+ (and (>= eol-type 0)
+ (<= eol-type 2))))
+ eol-type)
+ (t
+ (error "Invalid EOL-TYPE spec:%S" eol-type))))
+ (put coding-system 'eol-type eol-type)
;; At last, register CODING-SYSTEM in `coding-system-list' and
;; `coding-system-alist'.
(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
+don't want to mark the buffer modified, just set the variable
+`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'.
;; in its line.
(let* ((prefix (regexp-quote (match-string 1)))
(suffix (regexp-quote (match-string 2)))
- (re-coding (concat
- "^" prefix
- "coding[ \t]*:[ \t]*\\([^ \t]+\\)[ \t]*"
- suffix "$"))
- (re-unibyte (concat
- "^" prefix
- "unibyte[ \t]*:[ \t]*\\([^ \t]+\\)[ \t]*"
- suffix "$"))
- (re-end (concat
- "^" prefix "end *:[ \t]*" suffix "$"))
+ (re-coding
+ (concat
+ "^" prefix
+ "[ \t]*coding[ \t]*:[ \t]*\\([^ \t]+\\)[ \t]*"
+ suffix "$"))
+ (re-unibyte
+ (concat
+ "^" prefix
+ "[ \t]*unibyte[ \t]*:[ \t]*\\([^ \t]+\\)[ \t]*"
+ suffix "$"))
+ (re-end
+ (concat "^" prefix "[ \t]*end *:[ \t]*" suffix "$"))
(pos (point)))
(re-search-forward re-end tail-end 'move)
(setq tail-end (point))
(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))
- ;; If buffer was unmodified, we must be visiting it.
- (not modified-p))
+ ;; If buffer was unmodified and the size is the
+ ;; same as INSERTED, we must be visiting it.
+ (not modified-p)
+ (= (buffer-size) inserted))
;; For coding systems no-conversion and raw-text...,
;; edit the buffer as unibyte.
(let ((pos-byte (position-bytes (+ (point) inserted))))
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
(put symbol 'translation-table-id id)
id))
+(put 'with-category-table 'lisp-indent-function 1)
+
+(defmacro with-category-table (category-table &rest body)
+ `(let ((current-category-table (category-table)))
+ (set-category-table ,category-table)
+ (unwind-protect
+ (progn ,@body)
+ (set-category-table current-category-table))))
+
;;; Initialize some variables.
(put 'use-default-ascent 'char-table-extra-slots 0)
HCoop / bpt / emacs.git / blobdiff