(detect-mime-charset-region): Don't call
[elisp/apel.git] / poem-om.el
index 080ca0a..7a6b335 100644 (file)
@@ -3,6 +3,7 @@
 ;; Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc.
 
 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;;         Katsumi Yamaoka  <yamaoka@jpl.org>
 ;; Keywords: emulation, compatibility, Mule
 
 ;; This file is part of APEL (A Portable Emacs Library).
@@ -48,7 +49,7 @@
                     0))
               ))))
 
-       (define-ccl-program ccl-decode-raw-text
+       (define-ccl-program poem-ccl-decode-raw-text
         '(1
           ((read r1 r0)
            (loop
           (write r1))
         "Convert line-break code from CRLF to LF.")
 
-       (define-ccl-program ccl-encode-raw-text
+       (define-ccl-program poem-ccl-encode-raw-text
         '(1
           ((read r0)
            (loop (write-read-repeat r0))))
         "Pass through without any conversions.")
 
-       (define-ccl-program ccl-encode-raw-text-CRLF
+       (define-ccl-program poem-ccl-encode-raw-text-CRLF
         '(2
           ((loop
              (read r0)
        'raw-text 4 ?=
        "No conversion"
        nil
-       (cons ccl-decode-raw-text ccl-encode-raw-text))
+       (cons poem-ccl-decode-raw-text poem-ccl-encode-raw-text))
 
        (make-coding-system
        'raw-text-dos 4 ?=
        "No conversion"
        nil
-       (cons ccl-decode-raw-text ccl-encode-raw-text-CRLF))
-
-       (make-coding-system
-       'binary nil ?=
-       "No conversion")
+       (cons poem-ccl-decode-raw-text poem-ccl-encode-raw-text-CRLF))
+       )
+      (t
+       (defun poem-decode-raw-text (from to)
+        (save-restriction
+          (narrow-to-region from to)
+          (goto-char (point-min))
+          (while (re-search-forward "\r$" nil t)
+            (replace-match "")
+            )))
+       (defun poem-encode-raw-text-CRLF (from to)
+        (save-restriction
+          (narrow-to-region from to)
+          (goto-char (point-min))
+          (while (re-search-forward "\\(\\=\\|[^\r]\\)\n" nil t)
+            (replace-match "\\1\r\n")
+            )))
+
+       (make-coding-system 'raw-text nil ?= "No conversion")
+       (put 'raw-text 'post-read-conversion 'poem-decode-raw-text)
+       
+       (make-coding-system 'raw-text-dos nil ?= "No conversion")
+       (put 'raw-text-dos 'post-read-conversion 'poem-decode-raw-text)
+       (put 'raw-text-dos 'pre-write-conversion 'poem-encode-raw-text-CRLF)
        ))
 
 
@@ -216,6 +236,8 @@ be applied to `file-coding-system-for-read'."
 ;;; @ without code-conversion
 ;;;
 
+(make-coding-system 'binary nil ?= "No conversion")
+
 (defmacro as-binary-process (&rest body)
   (` (let (selective-display   ; Disable ^M to nl translation.
           ;; Mule
@@ -249,123 +271,40 @@ find-file-hooks, etc.
    ;; Returns list absolute file name and length of data inserted.
    (insert-file-contents-literally filename visit beg end replace)))
 
-(cond
- ((>= emacs-major-version 19)
-  ;; for MULE 2.*.
-  (defun insert-file-contents-as-binary (filename
-                                        &optional visit beg end replace)
-    "Like `insert-file-contents', q.v., but don't code and format conversion.
+(defun insert-file-contents-as-binary (filename
+                                      &optional visit beg end replace)
+  "Like `insert-file-contents', q.v., but don't code and format conversion.
 Like `insert-file-contents-literary', but it allows find-file-hooks,
 automatic uncompression, etc.
 
 Namely this function ensures that only format decoding and character
 code conversion will not take place."
-    ;; Returns list absolute file name and length of data inserted.
-    (insert-file-contents-as-coding-system 'binary
-                                          filename visit beg end replace))
+  (as-binary-input-file
+   ;; Returns list absolute file name and length of data inserted.
+   (insert-file-contents filename visit beg end replace)))
 
-  (defun insert-file-contents-as-raw-text (filename
-                                          &optional visit beg end replace)
-    "Like `insert-file-contents', q.v., but don't code and format conversion.
-Like `insert-file-contents-literary', but it allows find-file-hooks,
-automatic uncompression, etc.
-Like `insert-file-contents-as-binary', but it converts line-break
-code."
-    ;; Returns list absolute file name and length of data inserted.
-    (insert-file-contents-as-coding-system 'raw-text
-                                          filename visit beg end replace))
-
-  (defun write-region-as-binary (start end filename
-                                      &optional append visit lockname)
-    "Like `write-region', q.v., but don't code conversion."
-    (write-region-as-coding-system 'binary
-                                  start end filename append visit lockname))
-
-  (defun write-region-as-raw-text-CRLF (start end filename
-                                             &optional append visit lockname)
-    "Like `write-region', q.v., but don't code conversion."
-    (write-region-as-coding-system 'raw-text-dos
-                                  start end filename append visit lockname))
-
-  (defun find-file-noselect-as-binary (filename &optional nowarn rawfile)
-    "Like `find-file-noselect', q.v., but don't code and format conversion."
-    (find-file-noselect-as-coding-system 'binary
-                                        filename nowarn rawfile))
-
-  (defun find-file-noselect-as-raw-text (filename &optional nowarn rawfile)
-    "Like `find-file-noselect', q.v., but it does not code and format
-conversion except for line-break code."
-    (find-file-noselect-as-coding-system 'raw-text
-                                        filename nowarn rawfile))
-  )
- (t
-  ;; for MULE 1.*.
-  (defun insert-file-contents-as-binary (filename
+(defun insert-file-contents-as-raw-text (filename
                                         &optional visit beg end replace)
-    "Like `insert-file-contents', q.v., but don't code and format conversion.
-Like `insert-file-contents-literary', but it allows find-file-hooks,
-automatic uncompression, etc.
-
-Namely this function ensures that only format decoding and character
-code conversion will not take place."
-    (as-binary-input-file
-     ;; Returns list absolute file name and length of data inserted.
-     (insert-file-contents filename visit beg end replace)))
-
-  (defun insert-file-contents-as-raw-text (filename
-                                          &optional visit beg end replace)
-    "Like `insert-file-contents', q.v., but don't code and format conversion.
+  "Like `insert-file-contents', q.v., but don't code and format conversion.
 Like `insert-file-contents-literary', but it allows find-file-hooks,
 automatic uncompression, etc.
 Like `insert-file-contents-as-binary', but it converts line-break
 code."
-    (save-excursion
-      (save-restriction
-       (narrow-to-region (point)(point))
-       (let ((return-val
-              ;; Returns list absolute file name and length of data inserted.
-              (insert-file-contents-as-binary filename
-                                              visit beg end replace)))
-         (goto-char (point-min))
-         (while (re-search-forward "\r$" nil t)
-           (replace-match ""))
-         (list (car return-val) (buffer-size))))))
-
-  (defun write-region-as-binary (start end filename
-                                      &optional append visit lockname)
-    "Like `write-region', q.v., but don't code conversion."
-    (as-binary-output-file
-     (write-region start end filename append visit)))
-
-  (defun write-region-as-raw-text-CRLF (start end filename
-                                             &optional append visit lockname)
-    "Like `write-region', q.v., but don't code conversion."
-    (let ((the-buf (current-buffer)))
-      (with-temp-buffer
-       (insert-buffer-substring the-buf start end)
-       (goto-char (point-min))
-       (while (re-search-forward "\\(\\=\\|[^\r]\\)\n" nil t)
-         (replace-match "\\1\r\n"))
-       (write-region-as-binary (point-min)(point-max)
-                               filename append visit))))
-
-  (defun find-file-noselect-as-binary (filename &optional nowarn rawfile)
-    "Like `find-file-noselect', q.v., but don't code and format conversion."
-    (as-binary-input-file (find-file-noselect filename nowarn)))
-
-  (defun find-file-noselect-as-raw-text (filename &optional nowarn rawfile)
-    "Like `find-file-noselect', q.v., but it does not code and format
-conversion except for line-break code."
-    (save-current-buffer
-      (prog1
-         (set-buffer (find-file-noselect-as-binary filename nowarn rawfile))
-       (let ((flag (buffer-modified-p)))
-         (save-excursion
-           (goto-char (point-min))
-           (while (re-search-forward "\r$" nil t)
-             (replace-match "")))
-         (set-buffer-modified-p flag)))))
-  ))
+  ;; Returns list absolute file name and length of data inserted.
+  (insert-file-contents-as-coding-system 'raw-text
+                                        filename visit beg end replace))
+
+(defun write-region-as-binary (start end filename
+                                    &optional append visit lockname)
+  "Like `write-region', q.v., but don't code conversion."
+  (write-region-as-coding-system 'binary
+                                start end filename append visit lockname))
+
+(defun write-region-as-raw-text-CRLF (start end filename
+                                           &optional append visit lockname)
+  "Like `write-region', q.v., but don't code conversion."
+  (write-region-as-coding-system 'raw-text-dos
+                                start end filename append visit lockname))
 
 (defun open-network-stream-as-binary (name buffer host service)
   "Like `open-network-stream', q.v., but don't code conversion."
@@ -373,6 +312,15 @@ conversion except for line-break code."
     (set-process-coding-system process *noconv* *noconv*)
     process))
 
+(defun find-file-noselect-as-binary (filename &optional nowarn rawfile)
+  "Like `find-file-noselect', q.v., but don't code and format conversion."
+  (find-file-noselect-as-coding-system 'binary filename nowarn rawfile))
+
+(defun find-file-noselect-as-raw-text (filename &optional nowarn rawfile)
+  "Like `find-file-noselect', q.v., but it does not code and format
+conversion except for line-break code."
+  (find-file-noselect-as-coding-system 'raw-text filename nowarn rawfile))
+
 
 ;;; @ buffer representation
 ;;;