* poem-20.el, poem-e20_2.el, poem-ltn1.el, poem-nemacs.el, poem-om.el

[elisp/apel.git] / poem-om.el

diff --git a/poem-om.el b/poem-om.el
index 5579e09..9875330 100644 (file)
--- a/poem-om.el
+++ b/poem-om.el
@@ -224,6 +224,76 @@ find-file-hooks, etc.
                                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 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."
+  (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."
+  (let ((process (open-network-stream name buffer host service)))
+    (set-process-coding-system process *noconv* *noconv*)
+    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
 ;;;
@@ -257,6 +327,36 @@ but the contents viewed as characters do change.
   "Return index of character succeeding CHAR whose index is INDEX."
   (` (+ (, index) (char-bytes (, char)))))
 
+(if (subr-fboundp 'char-before)
+    (condition-case err
+       (char-before)
+      (error
+       (when (and (eq (car (get (car err) 'error-conditions))
+                     'wrong-number-of-arguments)
+                 (not (boundp 'si:char-before)))
+        (fset 'si:char-before (symbol-function 'char-before))
+        (defun char-before (&optional pos)
+          "Return character in current buffer preceding position POS.
+POS is an integer or a buffer pointer.
+If POS is out of range, the value is nil."
+          (si:char-before (or pos (point)))
+          )))))
+
+(if (subr-fboundp 'char-after)
+    (condition-case err
+       (char-after)
+      (error
+       (when (and (eq (car (get (car err) 'error-conditions))
+                     'wrong-number-of-arguments)
+                 (not (boundp 'si:char-after)))
+        (fset 'si:char-after (symbol-function 'char-after))
+        (defun char-after (&optional pos)
+          "Return character in current buffer at position POS.
+POS is an integer or a buffer pointer.
+If POS is out of range, the value is nil."
+          (si:char-after (or pos (point)))
+          )))))
+
 ;;; @@ obsoleted aliases
 ;;;
 ;;; You should not use them.