Commit 776ca83d authored by Eli Zaretskii's avatar Eli Zaretskii
Browse files

(cp-coding-system-for-codepage-1):

Create separate encoders and decoders, for DOS and Unix.  Make the
usual family of 3 coding systems, so that automatic detection of
EOL type works.
(cp-make-coding-systems-for-codepage): Don't intern DOS- and
Unix-specific symbols here, and don't call
cp-coding-system-for-codepage-1 twice.  (Suggested by Ken'ichi
Handa <handa@etl.go.jp>.)
parent 9d45accd
...@@ -52,75 +52,79 @@ encoding to Emacs multibyte characters. ...@@ -52,75 +52,79 @@ encoding to Emacs multibyte characters.
ENCODER is a translation table for encoding Emacs multibyte characters into ENCODER is a translation table for encoding Emacs multibyte characters into
external DOS codepage codes. external DOS codepage codes.
Note that the coding systems created by this function don't support Note that the coding systems created by this function support automatic
automatic detection of the EOL format. Use explicit -dos or -unix variants detection of the EOL format."
as appropriate (Mac EOL style is not supported, as it doesn't make sense for
these coding systems).
If the coding system's name ends with \"-dos\", this function automatically
creates a coding system which converts from and to DOS EOL format; otherwise
the created coding system assumes Unix-style EOL (i.e., it doesn't perform
any EOL conversions)."
(save-match-data (save-match-data
(let* ((coding-name (symbol-name coding)) (let* ((coding-name (symbol-name coding))
(eol-type (string-match "-\\(dos\\|unix\\)\\'" coding-name)) (ccl-decoder-dos
(dos-p (ccl-compile
(and eol-type `(4 (loop (read r1)
(string= "-dos" (substring coding-name eol-type)))) (if (r1 != ?\r)
(coding-sans-eol (if (r1 >= 128)
(if eol-type (substring coding-name 0 eol-type) coding-name)) ((r0 = ,(charset-id 'ascii))
(ccl-decoder (translate-character ,decoder r0 r1)
(if dos-p (if (r0 == ,(charset-id 'ascii))
(ccl-compile (write r1)
`(4 (loop (read r1) (write-multibyte-character r0 r1)))
(if (r1 != ?\r) (write r1)))
(if (r1 >= 128) (repeat)))))
((r0 = ,(charset-id 'ascii)) (ccl-decoder-unix
(translate-character ,decoder r0 r1) (ccl-compile
(if (r0 == ,(charset-id 'ascii)) `(4 (loop (read r1)
(write r1) (if (r1 >= 128)
(write-multibyte-character r0 r1))) ((r0 = ,(charset-id 'ascii))
(write r1))) (translate-character ,decoder r0 r1)
(repeat)))) (if (r0 == ,(charset-id 'ascii))
(ccl-compile (write r1)
`(4 (loop (read r1) (write-multibyte-character r0 r1)))
(if (r1 >= 128) (write r1))
((r0 = ,(charset-id 'ascii)) (repeat)))))
(translate-character ,decoder r0 r1) (ccl-encoder-dos
(if (r0 == ,(charset-id 'ascii)) (ccl-compile
(write r1) `(1 (loop (read-multibyte-character r0 r1)
(write-multibyte-character r0 r1))) (if (r1 == ?\n)
(write r1)) (write ?\r)
(repeat))))))
(ccl-encoder
(if dos-p
(ccl-compile
`(1 (loop (read-multibyte-character r0 r1)
(if (r1 == ?\n)
(write ?\r)
(if (r0 != ,(charset-id 'ascii))
((translate-character ,encoder r0 r1)
(if (r0 == ,(charset-id 'japanese-jisx0208))
((r1 = ??)
(write r1))))))
(write-repeat r1))))
(ccl-compile
`(1 (loop (read-multibyte-character r0 r1)
(if (r0 != ,(charset-id 'ascii)) (if (r0 != ,(charset-id 'ascii))
((translate-character ,encoder r0 r1) ((translate-character ,encoder r0 r1)
(if (r0 == ,(charset-id 'japanese-jisx0208)) (if (r0 == ,(charset-id 'japanese-jisx0208))
((r1 = ??) ((r1 = ??)
(write r1))))) (write r1))))))
(write-repeat r1))))))) (write-repeat r1)))))
(ccl-encoder-unix
(ccl-compile
`(1 (loop (read-multibyte-character r0 r1)
(if (r0 != ,(charset-id 'ascii))
((translate-character ,encoder r0 r1)
(if (r0 == ,(charset-id 'japanese-jisx0208))
((r1 = ??)
(write r1)))))
(write-repeat r1))))))
(if (memq coding coding-system-list) (if (memq coding coding-system-list)
(setq coding-system-list (delq coding coding-system-list))) (setq coding-system-list (delq coding coding-system-list)))
;; Make coding system CODING.
(make-coding-system (make-coding-system
coding 4 mnemonic coding 4 mnemonic
(concat "8-bit encoding of " (symbol-name iso-name) (concat "8-bit encoding of " (symbol-name iso-name)
" characters using IBM codepage " (substring coding-sans-eol 2)) " characters using IBM codepage " coding-name)
(cons ccl-decoder ccl-encoder) (cons ccl-decoder-unix ccl-encoder-unix)
`((safe-charsets ascii ,iso-name))) `((safe-charsets ascii ,iso-name)))
(put coding 'eol-type (if dos-p 1 0))))) ;;; Make coding systems CODING-unix, CODING-dos, CODING-mac.
(make-subsidiary-coding-system coding)
(put coding 'eol-type (vector (intern (format "%s-unix" coding))
(intern (format "%s-dos" coding))
(intern (format "%s-mac" coding))))
;; Change CCL code for CODING-dos.
(let ((coding-spec (copy-sequence (get coding 'coding-system))))
(aset coding-spec 4
(cons (check-ccl-program
ccl-decoder-dos
(intern (format "%s-dos-decoder" coding)))
(check-ccl-program
ccl-encoder-dos
(intern (format "%s-dos-encoder" coding)))))
(put (intern (concat coding-name "-dos")) 'coding-system
coding-spec)))))
(defun cp-decoding-vector-for-codepage (table charset offset) (defun cp-decoding-vector-for-codepage (table charset offset)
"Create a vector for decoding IBM PC characters using conversion table "Create a vector for decoding IBM PC characters using conversion table
...@@ -418,11 +422,7 @@ perform any EOL conversions." ...@@ -418,11 +422,7 @@ perform any EOL conversions."
(decode-translation (decode-translation
(intern (format "%s-decode-translation-table" codepage))) (intern (format "%s-decode-translation-table" codepage)))
(encode-translation (encode-translation
(intern (format "%s-encode-translation-table" codepage))) (intern (format "%s-encode-translation-table" codepage))))
(codepage-dos
(intern (format "%s-dos" codepage)))
(codepage-unix
(intern (format "%s-unix" codepage))))
(set nonascii-table (set nonascii-table
(make-translation-table-from-vector (make-translation-table-from-vector
(cp-decoding-vector-for-codepage (cp-decoding-vector-for-codepage
...@@ -444,9 +444,8 @@ perform any EOL conversions." ...@@ -444,9 +444,8 @@ perform any EOL conversions."
(define-translation-table decode-translation (define-translation-table decode-translation
(symbol-value nonascii-table)) (symbol-value nonascii-table))
(cp-coding-system-for-codepage-1 (cp-coding-system-for-codepage-1
codepage-dos ?D iso-name decode-translation encode-translation) (intern codepage) ?D iso-name decode-translation encode-translation)
(cp-coding-system-for-codepage-1 ))
codepage-unix ?D iso-name decode-translation encode-translation)))
(defun cp-codepage-decoder (codepage) (defun cp-codepage-decoder (codepage)
"If CODEPAGE is the name of a supported codepage, return its decode table; "If CODEPAGE is the name of a supported codepage, return its decode table;
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment