poem-20.el

   1 ;;; -*-byte-compile-dynamic: t;-*-
   2 ;;; poem-20.el --- poem submodule for Emacs 20 and XEmacs-mule
   3
   4 ;; Copyright (C) 1997,1998 Free Software Foundation, Inc.
   5
   6 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
   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 write-region-as-raw-text-CRLF (start end filename
  74                                             &optional append visit lockname)
  75   "Like `write-region', q.v., but write as network representation."
  76   (let ((coding-system-for-write 'raw-text-dos))
  77     (write-region start end filename append visit lockname)))
  78
  79 (defun find-file-noselect-as-binary (filename &optional nowarn rawfile)
  80   "Like `find-file-noselect', q.v., but don't code and format conversion."
  81   (let ((coding-system-for-write 'binary)
  82         format-alist)
  83     (find-file-noselect filename nowarn rawfile)))
  84
  85 (defun find-file-noselect-as-raw-text (filename &optional nowarn rawfile)
  86   "Like `find-file-noselect', q.v., but it does not code and format conversion
  87 except for line-break code."
  88   (let ((coding-system-for-read 'raw-text)
  89         format-alist)
  90     (find-file-noselect filename nowarn rawfile)))
  91
  92 (defun open-network-stream-as-binary (name buffer host service)
  93   "Like `open-network-stream', q.v., but don't code conversion."
  94   (let ((coding-system-for-read 'binary)
  95         (coding-system-for-write 'binary))
  96     (open-network-stream name buffer host service)))
  97
  98
  99 ;;; @ with code-conversion
 100 ;;;
 101
 102 (defun insert-file-contents-as-coding-system
 103   (filename coding-system &optional visit beg end replace)
 104   "Like `insert-file-contents', q.v., but CODING-SYSTEM the second arg will
 105 be applied to `coding-system-for-read'."
 106   (let ((coding-system-for-read coding-system)
 107         format-alist)
 108     (insert-file-contents filename visit beg end replace)))
 109
 110 (defun write-region-as-coding-system (start end filename coding-system
 111                                             &optional append visit lockname)
 112   "Like `write-region', q.v., but CODING-SYSTEM the fourth arg will be
 113 applied to `coding-system-for-write'."
 114   (let ((coding-system-for-write coding-system)
 115         jka-compr-compression-info-list jam-zcat-filename-list)
 116     (write-region start end filename append visit lockname)))
 117
 118 (defun find-file-noselect-as-coding-system (filename coding-system
 119                                                      &optional nowarn rawfile)
 120   "Like `find-file-noselect', q.v., but CODING-SYSTEM the second arg will
 121 be applied to `coding-system-for-read'."
 122   (let ((coding-system-for-read coding-system)
 123         format-alist)
 124     (find-file-noselect filename nowarn rawfile)))
 125
 126
 127 ;;; @ end
 128 ;;;
 129
 130 (provide 'poem-20)
 131
 132 ;;; poem-20.el ends here