pces-20.el

   1 ;;; -*-byte-compile-dynamic: t;-*-
   2 ;;; pces-20.el --- pces submodule for Emacs 20 and XEmacs-mule
   3
   4 ;; Copyright (C) 1997,1998,1999 Free Software Foundation, Inc.
   5
   6 ;; Author: MORIOKA Tomohiko <tomo@m17n.org>
   7 ;; Keywords: emulation, compatibility, Mule
   8
   9 ;; This file is part of APEL (A Portable Emacs Library).
  10
  11 ;; This program is free software; you can redistribute it and/or
  12 ;; modify it under the terms of the GNU General Public License as
  13 ;; published by the Free Software Foundation; either version 2, or (at
  14 ;; your option) any later version.
  15
  16 ;; This program is distributed in the hope that it will be useful, but
  17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  19 ;; General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  24 ;; Boston, MA 02111-1307, USA.
  25
  26 ;;; Commentary:
  27
  28 ;;    This module requires Emacs 20.0.93, XEmacs 20.3-b5 (with mule)
  29 ;;    or later.
  30
  31 ;;; Code:
  32
  33 ;;; @ without code-conversion
  34 ;;;
  35
  36 (defmacro as-binary-process (&rest body)
  37   `(let (selective-display      ; Disable ^M to nl translation.
  38          (coding-system-for-read  'binary)
  39          (coding-system-for-write 'binary))
  40      ,@body))
  41
  42 (defmacro as-binary-input-file (&rest body)
  43   `(let ((coding-system-for-read 'binary))
  44      ,@body))
  45
  46 (defmacro as-binary-output-file (&rest body)
  47   `(let ((coding-system-for-write 'binary))
  48      ,@body))
  49
  50 (defun write-region-as-binary (start end filename
  51                                      &optional append visit lockname)
  52   "Like `write-region', q.v., but don't encode."
  53   (let ((coding-system-for-write 'binary)
  54         jka-compr-compression-info-list jam-zcat-filename-list)
  55     (write-region start end filename append visit lockname)))
  56
  57 ;; `insert-file-contents-literally' of Emacs 20 supports
  58 ;; `file-name-handler-alist'.
  59 (defalias 'insert-file-contents-as-binary 'insert-file-contents-literally)
  60
  61 (defun insert-file-contents-as-raw-text (filename
  62                                          &optional visit beg end replace)
  63   "Like `insert-file-contents', q.v., but don't code and format conversion.
  64 Like `insert-file-contents-literary', but it allows find-file-hooks,
  65 automatic uncompression, etc.
  66 Like `insert-file-contents-as-binary', but it converts line-break
  67 code."
  68   (let ((coding-system-for-read 'raw-text)
  69         format-alist)
  70     ;; Returns list of absolute file name and length of data inserted.
  71     (insert-file-contents filename visit beg end replace)))
  72
  73 (defun insert-file-contents-as-raw-text-CRLF (filename
  74                                               &optional visit beg end replace)
  75   "Like `insert-file-contents', q.v., but don't code and format conversion.
  76 Like `insert-file-contents-literary', but it allows find-file-hooks,
  77 automatic uncompression, etc.
  78 Like `insert-file-contents-as-binary', but it converts line-break code
  79 from CRLF to LF."
  80   (let ((coding-system-for-read 'raw-text-dos)
  81         format-alist)
  82     ;; Returns list of absolute file name and length of data inserted.
  83     (insert-file-contents filename visit beg end replace)))
  84
  85 (defun write-region-as-raw-text-CRLF (start end filename
  86                                             &optional append visit lockname)
  87   "Like `write-region', q.v., but write as network representation."
  88   (let ((coding-system-for-write 'raw-text-dos))
  89     (write-region start end filename append visit lockname)))
  90
  91 (defun find-file-noselect-as-binary (filename &optional nowarn rawfile)
  92   "Like `find-file-noselect', q.v., but don't code and format conversion."
  93   (let ((coding-system-for-read 'binary)
  94         format-alist)
  95     (find-file-noselect filename nowarn rawfile)))
  96
  97 (defun find-file-noselect-as-raw-text (filename &optional nowarn rawfile)
  98   "Like `find-file-noselect', q.v., but it does not code and format conversion
  99 except for line-break code."
 100   (let ((coding-system-for-read 'raw-text)
 101         format-alist)
 102     (find-file-noselect filename nowarn rawfile)))
 103
 104 (defun find-file-noselect-as-raw-text-CRLF (filename &optional nowarn rawfile)
 105   "Like `find-file-noselect', q.v., but it does not code and format conversion
 106 except for line-break code."
 107   (let ((coding-system-for-read 'raw-text-dos)
 108         format-alist)
 109     (find-file-noselect filename nowarn rawfile)))
 110
 111 (defun save-buffer-as-binary (&optional args)
 112   "Like `save-buffer', q.v., but don't encode."
 113   (let ((coding-system-for-write 'binary))
 114     (save-buffer args)))
 115
 116 (defun save-buffer-as-raw-text-CRLF (&optional args)
 117   "Like `save-buffer', q.v., but save as network representation."
 118   (let ((coding-system-for-write 'raw-text-dos))
 119     (save-buffer args)))
 120
 121 (defun open-network-stream-as-binary (name buffer host service)
 122   "Like `open-network-stream', q.v., but don't code conversion."
 123   (let ((coding-system-for-read 'binary)
 124         (coding-system-for-write 'binary))
 125     (open-network-stream name buffer host service)))
 126
 127
 128 ;;; @ with code-conversion
 129 ;;;
 130
 131 (defun insert-file-contents-as-coding-system
 132   (coding-system filename &optional visit beg end replace)
 133   "Like `insert-file-contents', q.v., but CODING-SYSTEM the first arg will
 134 be applied to `coding-system-for-read'."
 135   (let ((coding-system-for-read coding-system)
 136         format-alist)
 137     (insert-file-contents filename visit beg end replace)))
 138
 139 (defun write-region-as-coding-system
 140   (coding-system start end filename &optional append visit lockname)
 141   "Like `write-region', q.v., but CODING-SYSTEM the first arg will be
 142 applied to `coding-system-for-write'."
 143   (let ((coding-system-for-write coding-system)
 144         jka-compr-compression-info-list jam-zcat-filename-list)
 145     (write-region start end filename append visit lockname)))
 146
 147 (defun find-file-noselect-as-coding-system
 148   (coding-system filename &optional nowarn rawfile)
 149   "Like `find-file-noselect', q.v., but CODING-SYSTEM the first arg will
 150 be applied to `coding-system-for-read'."
 151   (let ((coding-system-for-read coding-system)
 152         format-alist)
 153     (find-file-noselect filename nowarn rawfile)))
 154
 155 (defun save-buffer-as-coding-system (coding-system &optional args)
 156   "Like `save-buffer', q.v., but CODING-SYSTEM the first arg will be
 157 applied to `coding-system-for-write'."
 158   (let ((coding-system-for-write coding-system))
 159     (save-buffer args)))
 160
 161
 162 ;;; @ end
 163 ;;;
 164
 165 (provide 'pces-20)
 166
 167 ;;; pces-20.el ends here