From: yamaoka <yamaoka>
Date: Wed, 16 Dec 1998 13:19:00 +0000 (+0000)
Subject: *** empty log message ***
X-Git-Tag: apel-199812161505~4
X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=2fda29efef72960530258650cf7271e62e80d44c;p=elisp%2Fapel.git

*** empty log message ***
---

diff --git a/ChangeLog b/ChangeLog
index 5091cd0..d8b501b 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,20 @@
 1998-12-16  Katsumi Yamaoka   <yamaoka@jpl.org>
 
+	* poem-om.el (find-file-noselect-as-raw-text): Use
+	`find-file-noselect-as-coding-system' under Mule 2.*.
+	(find-file-noselect-as-binary): Likewise.
+	(insert-file-contents-as-raw-text): Use
+	`insert-file-contents-as-coding-system' under Mule 2.*.
+	(insert-file-contents-as-binary): Likewise.
+	(write-region-as-raw-text-CRLF): Use
+	`write-region-as-coding-system' under Mule 2.*.
+	(write-region-as-binary): Likewise.
+	(truncate-string): Use `defun-maybe'.
+	(toplevel): Don't refer to `running-emacs-19_29-or-later', use
+	`emacs-major-version' and `emacs-minor-version' instead.
+
+1998-12-16  Katsumi Yamaoka   <yamaoka@jpl.org>
+
 	* pccl-om.el (toplevel): Don't require `poem'.
 	Use `code-convert-string' instead of `encode-coding-string' or
 	`decode-coding-string'.
diff --git a/poem-om.el b/poem-om.el
index e9dc6b1..080ca0a 100644
--- a/poem-om.el
+++ b/poem-om.el
@@ -166,13 +166,60 @@
 (defalias 'set-buffer-file-coding-system 'set-file-coding-system)
 
 
+;;; @ with code-conversion
+;;;
+
+(defun insert-file-contents-as-coding-system
+  (coding-system filename &optional visit beg end replace)
+  "Like `insert-file-contents', q.v., but CODING-SYSTEM the first arg will
+be applied to `file-coding-system-for-read'."
+  (let ((file-coding-system-for-read coding-system))
+    (insert-file-contents filename visit beg end replace)))
+
+(cond
+ ((and (>= emacs-major-version 19) (>= emacs-minor-version 29))
+  ;; for MULE 2.3 based on Emacs 19.34.
+  (defun write-region-as-coding-system
+    (coding-system start end filename &optional append visit lockname)
+    "Like `write-region', q.v., but CODING-SYSTEM the first arg will be
+applied to `file-coding-system'."
+    (let ((file-coding-system coding-system)
+	  jka-compr-compression-info-list jam-zcat-filename-list)
+      (write-region start end filename append visit lockname)))
+
+  (defun find-file-noselect-as-coding-system
+    (coding-system filename &optional nowarn rawfile)
+    "Like `find-file-noselect', q.v., but CODING-SYSTEM the first arg will
+be applied to `file-coding-system-for-read'."
+    (let ((file-coding-system-for-read coding-system))
+      (find-file-noselect filename nowarn rawfile)))
+  )
+ (t
+  ;; for MULE 2.3 based on Emacs 19.28 or MULE 1.*.
+  (defun write-region-as-coding-system
+    (coding-system start end filename &optional append visit lockname)
+    "Like `write-region', q.v., but CODING-SYSTEM the first arg will be
+applied to `file-coding-system'."
+    (let ((file-coding-system coding-system)
+	  jka-compr-compression-info-list jam-zcat-filename-list)
+      (write-region start end filename append visit)))
+
+  (defun find-file-noselect-as-coding-system
+    (coding-system filename &optional nowarn rawfile)
+    "Like `find-file-noselect', q.v., but CODING-SYSTEM the first arg will
+be applied to `file-coding-system-for-read'."
+    (let ((file-coding-system-for-read coding-system))
+      (find-file-noselect filename nowarn)))
+  ))
+
+
 ;;; @ without code-conversion
 ;;;
 
 (defmacro as-binary-process (&rest body)
   (` (let (selective-display	; Disable ^M to nl translation.
 	   ;; Mule
-	   mc-flag	
+	   mc-flag
 	   (default-process-coding-system (cons *noconv* *noconv*))
 	   program-coding-system-alist)
        (,@ body))))
@@ -191,36 +238,6 @@
 
 (defalias 'set-process-input-coding-system 'set-process-coding-system)
 
-(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."
-  (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."
-  (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 insert-binary-file-contents-literally (filename
 					      &optional visit beg end replace)
   "Like `insert-file-contents-literally', q.v., but don't code conversion.
@@ -233,32 +250,87 @@ find-file-hooks, etc.
    (insert-file-contents-literally filename visit beg end replace)))
 
 (cond
- (running-emacs-19_29-or-later
-  ;; for MULE 2.3 based on Emacs 19.34.
+ ((>= 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.
+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))
+
+  (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."
-    (as-binary-output-file
-     (write-region start end filename append visit lockname)))
+    (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."
-    (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 lockname))))
+    (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."
-    (as-binary-input-file (find-file-noselect filename nowarn rawfile)))
+    (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 2.3 based on Emacs 19.28.
+  ;; for MULE 1.*.
+  (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."
+    (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."
+    (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."
@@ -280,20 +352,20 @@ find-file-hooks, etc.
   (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)))))
+  (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)))))
+  ))
 
 (defun open-network-stream-as-binary (name buffer host service)
   "Like `open-network-stream', q.v., but don't code conversion."
@@ -302,53 +374,6 @@ except for line-break code."
     process))
 
 
-;;; @ with code-conversion
-;;;
-
-(defun insert-file-contents-as-coding-system
-  (coding-system filename &optional visit beg end replace)
-  "Like `insert-file-contents', q.v., but CODING-SYSTEM the first arg will
-be applied to `file-coding-system-for-read'."
-  (let ((file-coding-system-for-read coding-system))
-    (insert-file-contents filename visit beg end replace)))
-
-(cond
- (running-emacs-19_29-or-later
-  ;; for MULE 2.3 based on Emacs 19.34.
-  (defun write-region-as-coding-system
-    (coding-system start end filename &optional append visit lockname)
-    "Like `write-region', q.v., but CODING-SYSTEM the first arg will be
-applied to `file-coding-system'."
-    (let ((file-coding-system coding-system)
-	  jka-compr-compression-info-list jam-zcat-filename-list)
-      (write-region start end filename append visit lockname)))
-
-  (defun find-file-noselect-as-coding-system
-    (coding-system filename &optional nowarn rawfile)
-    "Like `find-file-noselect', q.v., but CODING-SYSTEM the first arg will
-be applied to `file-coding-system-for-read'."
-    (let ((file-coding-system-for-read coding-system))
-      (find-file-noselect filename nowarn rawfile)))
-  )
- (t
-  ;; for MULE 2.3 based on Emacs 19.28.
-  (defun write-region-as-coding-system
-    (coding-system start end filename &optional append visit lockname)
-    "Like `write-region', q.v., but CODING-SYSTEM the first arg will be
-applied to `file-coding-system'."
-    (let ((file-coding-system coding-system)
-	  jka-compr-compression-info-list jam-zcat-filename-list)
-      (write-region start end filename append visit)))
-
-  (defun find-file-noselect-as-coding-system
-    (coding-system filename &optional nowarn rawfile)
-    "Like `find-file-noselect', q.v., but CODING-SYSTEM the first arg will
-be applied to `file-coding-system-for-read'."
-    (let ((file-coding-system-for-read coding-system))
-      (find-file-noselect filename nowarn)))
-  ))
-
-
 ;;; @ buffer representation
 ;;;
 
@@ -426,39 +451,37 @@ If POS is out of range, the value is nil."
 
 (defalias 'string-to-int-list 'string-to-char-list)
 
-(or (fboundp 'truncate-string)
-    ;; Imported from Mule-2.3
-    (defun truncate-string (str width &optional start-column)
-      "\
+;; Imported from Mule-2.3
+(defun-maybe truncate-string (str width &optional start-column)
+  "\
 Truncate STR to fit in WIDTH columns.
 Optional non-nil arg START-COLUMN specifies the starting column.
 \[emu-mule.el; Mule 2.3 emulating function]"
-      (or start-column
-	  (setq start-column 0))
-      (let ((max-width (string-width str))
-	    (len (length str))
-	    (from 0)
-	    (column 0)
-	    to-prev to ch)
-	(if (>= width max-width)
-	    (setq width max-width))
-	(if (>= start-column width)
-	    ""
-	  (while (< column start-column)
-	    (setq ch (aref str from)
-		  column (+ column (char-width ch))
-		  from (+ from (char-bytes ch))))
-	  (if (< width max-width)
-	      (progn
-		(setq to from)
-		(while (<= column width)
-		  (setq ch (aref str to)
-			column (+ column (char-width ch))
-			to-prev to
-			to (+ to (char-bytes ch))))
-		(setq to to-prev)))
-	  (substring str from to))))
-    )
+  (or start-column
+      (setq start-column 0))
+  (let ((max-width (string-width str))
+	(len (length str))
+	(from 0)
+	(column 0)
+	to-prev to ch)
+    (if (>= width max-width)
+	(setq width max-width))
+    (if (>= start-column width)
+	""
+      (while (< column start-column)
+	(setq ch (aref str from)
+	      column (+ column (char-width ch))
+	      from (+ from (char-bytes ch))))
+      (if (< width max-width)
+	  (progn
+	    (setq to from)
+	    (while (<= column width)
+	      (setq ch (aref str to)
+		    column (+ column (char-width ch))
+		    to-prev to
+		    to (+ to (char-bytes ch))))
+	    (setq to to-prev)))
+      (substring str from to))))
 
 (defalias 'looking-at-as-unibyte 'looking-at)