pces-xfc.el

   1 ;;; pces-xfc.el --- pces module for XEmacs with file coding
   2
   3 ;; Copyright (C) 1998,1999 Free Software Foundation, Inc.
   4
   5 ;; Author: MORIOKA Tomohiko <tomo@m17n.org>
   6 ;; Keywords: emulation, compatibility, Mule
   7
   8 ;; This file is part of APEL (A Portable Emacs Library).
   9
  10 ;; This program is free software; you can redistribute it and/or
  11 ;; modify it under the terms of the GNU General Public License as
  12 ;; published by the Free Software Foundation; either version 2, or (at
  13 ;; your option) any later version.
  14
  15 ;; This program is distributed in the hope that it will be useful, but
  16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  18 ;; General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 ;; Boston, MA 02111-1307, USA.
  24
  25 ;;; Code:
  26
  27 (require 'pces-20)
  28
  29 (if (featurep 'mule)
  30     (require 'pces-xm)
  31   )
  32
  33
  34 ;;; @ fix coding-system definition
  35 ;;;
  36
  37 ;; Redefine if -{dos|mac|unix} is not found.
  38 (or (find-coding-system 'raw-text-dos)
  39     (copy-coding-system 'no-conversion-dos 'raw-text-dos))
  40 (or (find-coding-system 'raw-text-mac)
  41     (copy-coding-system 'no-conversion-mac 'raw-text-mac))
  42 (or (find-coding-system 'raw-text-unix)
  43     (copy-coding-system 'no-conversion-unix 'raw-text-unix))
  44
  45
  46 ;;; @ without code-conversion
  47 ;;;
  48
  49 (require 'broken)
  50
  51 (broken-facility insert-file-contents-literacy-treats-binary
  52   "Function `insert-file-contents-literacy' decodes text."
  53   (let ((str "\xa1\xa3")
  54         (coding-system-for-write 'binary)
  55         (coding-system-for-read 'euc-jp))
  56     (with-temp-buffer
  57       (insert str)
  58       (write-region (point-min)(point-max) "literal-test-file")
  59       )
  60     (string=
  61      (with-temp-buffer
  62        (let (file-name-handler-alist)
  63          (insert-file-contents-literally "literal-test-file")
  64          )
  65        (buffer-string)
  66        )
  67      str)))
  68
  69 (broken-facility insert-file-contents-literacy-treats-file-name-handler
  70   "Function `insert-file-contents' doesn't call file-name-handler."
  71   (let (called)
  72     (with-temp-buffer
  73       (let ((file-name-handler-alist
  74              '(("literal-test-file" . (lambda (operation &rest args)
  75                                         (setq called t)
  76                                         (let (file-name-handler-alist)
  77                                           (apply operation args)
  78                                           ))))))
  79         (insert-file-contents-literally "literal-test-file")
  80         )
  81       (delete-file "literal-test-file")
  82       )
  83     called))
  84
  85 (static-if
  86     (or (broken-p 'insert-file-contents-literacy-treats-binary)
  87         (broken-p 'insert-file-contents-literacy-treats-file-name-handler))
  88     (defun insert-file-contents-as-binary (filename
  89                                            &optional visit beg end replace)
  90       "Like `insert-file-contents', but only reads in the file literally.
  91 A buffer may be modified in several ways after reading into the buffer,
  92 to Emacs features such as format decoding, character code
  93 conversion, find-file-hooks, automatic uncompression, etc.
  94
  95 This function ensures that none of these modifications will take place."
  96       (let ((format-alist nil)
  97             (after-insert-file-functions nil)
  98             (coding-system-for-read 'binary)
  99             (coding-system-for-write 'binary)
 100             (jka-compr-compression-info-list nil)
 101             (jam-zcat-filename-list nil)
 102             (find-buffer-file-type-function
 103              (if (fboundp 'find-buffer-file-type)
 104                  (symbol-function 'find-buffer-file-type)
 105                nil)))
 106         (unwind-protect
 107             (progn
 108               (fset 'find-buffer-file-type (lambda (filename) t))
 109               (insert-file-contents filename visit beg end replace))
 110           (if find-buffer-file-type-function
 111               (fset 'find-buffer-file-type find-buffer-file-type-function)
 112             (fmakunbound 'find-buffer-file-type)))))
 113   (defalias 'insert-file-contents-as-binary 'insert-file-contents-literally)
 114   )
 115
 116
 117 ;;; @ end
 118 ;;;
 119
 120 (provide 'pces-xfc)
 121
 122 ;;; pces-xfc.el ends here