update.

[elisp/apel.git] / emu-x20.el

diff --git a/emu-x20.el b/emu-x20.el
index e63cda3..48154f7 100644 (file)
--- a/emu-x20.el
+++ b/emu-x20.el
@@ -28,9 +28,62 @@
 
 ;;; Code:
 
+(require 'emu-20)
+
+
+;;; @ fix coding-system definition
+;;;
+
+;; It seems not bug, but I can not permit it...
 (and (coding-system-property 'iso-2022-jp 'input-charset-conversion)
      (copy-coding-system 'iso-2022-7bit 'iso-2022-jp))
 
+;; Redefine if -{dos|mac|unix} is not found.
+(or (find-coding-system 'raw-text-dos)
+    (copy-coding-system 'no-conversion-dos 'raw-text-dos))
+(or (find-coding-system 'raw-text-mac)
+    (copy-coding-system 'no-conversion-mac 'raw-text-mac))
+(or (find-coding-system 'raw-text-unix)
+    (copy-coding-system 'no-conversion-unix 'raw-text-unix))
+
+(or (find-coding-system 'ctext-dos)
+    (make-coding-system
+     'ctext 'iso2022
+     "Coding-system used in X as Compound Text Encoding."
+     '(charset-g0 ascii charset-g1 latin-iso8859-1
+                 eol-type nil
+                 mnemonic "CText")))
+
+(or (find-coding-system 'iso-2022-jp-2-dos)
+    (make-coding-system
+     'iso-2022-jp-2 'iso2022
+     "ISO-2022 coding system using SS2 for 96-charset in 7-bit code."
+     '(charset-g0 ascii
+       charset-g2 t ;; unspecified but can be used later.
+       seven t
+       short t
+       mnemonic "ISO7/SS2"
+       eol-type nil)))
+
+(or (find-coding-system 'euc-kr-dos)
+    (make-coding-system
+     'euc-kr 'iso2022
+     "Coding-system of Korean EUC (Extended Unix Code)."
+     '(charset-g0 ascii charset-g1 korean-ksc5601
+                 mnemonic "ko/EUC"
+                 eol-type nil)))
+
+
+;;; @ CCL
+;;;
+
+(defun make-ccl-coding-system (name mnemonic doc-string decoder encoder)
+  (make-coding-system
+   name 'ccl doc-string
+   (list 'mnemonic (char-to-string mnemonic)
+         'decode (symbol-value decoder)
+         'encode (symbol-value encoder))))
+
 
 ;;; @ without code-conversion
 ;;;
@@ -46,8 +99,8 @@ to advanced Emacs features, such as file-name-handlers, format decoding,
 find-file-hooks, etc.
   This function ensures that none of these modifications will take place."
   (let ((coding-system-for-read 'binary))
-    (insert-file-contents-literally filename visit beg end replace)
-    ))
+    ;; Returns list absolute file name and length of data inserted.
+    (insert-file-contents-literally filename visit beg end replace)))
 
     
 ;;; @ MIME charset
@@ -70,8 +123,8 @@ find-file-hooks, etc.
   :group 'i18n
   :type '(repeat (cons mime-charset function)))
 
-(defsubst decode-mime-charset-region-default (start end charset)
-  (let ((cs (mime-charset-to-coding-system charset)))
+(defsubst decode-mime-charset-region-default (start end charset lbt)
+  (let ((cs (mime-charset-to-coding-system charset lbt)))
     (if cs
        (decode-coding-region start end cs)
       )))
@@ -107,8 +160,9 @@ find-file-hooks, etc.
   :group 'i18n
   :type 'integer)
 
-(defun decode-mime-charset-region-with-iso646-unification (start end charset)
-  (decode-mime-charset-region-default start end charset)
+(defun decode-mime-charset-region-with-iso646-unification (start end charset
+                                                                lbt)
+  (decode-mime-charset-region-default start end charset lbt)
   (if (<= (- end start) mime-character-unification-limit-size)
       (save-excursion
        (let ((rest mime-iso646-character-unification-alist))
@@ -125,18 +179,23 @@ find-file-hooks, etc.
            (setq rest (cdr rest)))))
     ))
 
-(defun decode-mime-charset-region-for-hz (start end charset)
-  (decode-hz-region start end))
+(defun decode-mime-charset-region-for-hz (start end charset lbt)
+  (if lbt
+      (save-restriction
+       (narrow-to-region start end)
+       (decode-coding-region (point-min)(point-max)
+                             (mime-charset-to-coding-system 'raw-text lbt))
+       (decode-hz-region (point-min)(point-max)))
+    (decode-hz-region start end)))
 
-(defun decode-mime-charset-region (start end charset)
+(defun decode-mime-charset-region (start end charset &optional lbt)
   "Decode the text between START and END as MIME CHARSET."
   (if (stringp charset)
       (setq charset (intern (downcase charset)))
     )
   (let ((func (cdr (or (assq charset mime-charset-decoder-alist)
                       (assq t mime-charset-decoder-alist)))))
-    (funcall func start end charset)
-    ))
+    (funcall func start end charset lbt)))
 
 (defsubst encode-mime-charset-string (string charset)
   "Encode the STRING as MIME CHARSET."
@@ -151,13 +210,12 @@ find-file-hooks, etc.
 ;;     (if cs
 ;;         (decode-coding-string string cs)
 ;;       string)))
-(defun decode-mime-charset-string (string charset)
+(defun decode-mime-charset-string (string charset &optional lbt)
   "Decode the STRING as MIME CHARSET."
   (with-temp-buffer
     (insert string)
-    (decode-mime-charset-region (point-min)(point-max) charset)
-    (buffer-string)
-    ))
+    (decode-mime-charset-region (point-min)(point-max) charset lbt)
+    (buffer-string)))
 
 
 (defvar charsets-mime-charset-alist
@@ -233,8 +291,7 @@ but the contents viewed as characters do change.
              (setq dest (cons (logand code 127) dest)
                    code (lsh code -7)
                    i (1+ i)))
-           (cons charset dest)
-           ))))
+           (cons charset dest)))))
     )
 
 (defmacro char-next-index (char index)
@@ -252,8 +309,7 @@ but the contents viewed as characters do change.
 CHAR can be any multilingual character
 TABLE defaults to the current buffer's category table."
   (mapconcat (lambda (chr)
-              (char-to-string (int-char chr))
-              )
+              (char-to-string (int-char chr)))
             (char-category-list character)
             ""))
 
@@ -262,8 +318,7 @@ TABLE defaults to the current buffer's category table."
 ;;;
 
 (defun string-to-int-list (str)
-  (mapcar #'char-int str)
-  )
+  (mapcar #'char-int str))
 
 (defalias 'looking-at-as-unibyte 'looking-at)