XEmacs 21.4.17 "Jumbo Shrimp".
[chise/xemacs-chise.git.1] / lisp / code-files.el
index 3ff114b..2d5c5ef 100644 (file)
@@ -6,8 +6,6 @@
 
 ;; This file is part of XEmacs.
 
-;; This file is very similar to mule-files.el
-
 ;; XEmacs is free software; you can redistribute it and/or modify it
 ;; under the terms of the GNU General Public License as published by
 ;; the Free Software Foundation; either version 2, or (at your option)
 ;; General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
-;; along with XEmacs; see the file COPYING.  If not, write to the 
+;; along with XEmacs; see the file COPYING.  If not, write to the
 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 ;; Boston, MA 02111-1307, USA.
 
+;;; Synched up with: Not synched.
+
 ;;; Commentary:
 
-;;; Derived from mule.el in the original Mule but heavily modified
-;;; by Ben Wing.
+;; Derived from mule.el in the original Mule but heavily modified
+;; by Ben Wing.
 
 ;; 1997/3/11 modified by MORIOKA Tomohiko to sync with Emacs 20 API.
 
+;; This file was derived from the former mule-files.el which has been removed
+;; as of XEmacs 21.2.15.
+
 ;;; Code:
 
-(setq-default buffer-file-coding-system 'no-conversion)
+(setq-default buffer-file-coding-system 'raw-text)
 (put 'buffer-file-coding-system 'permanent-local t)
 
 (define-obsolete-variable-alias
@@ -57,21 +60,21 @@ global environment specification.")
   'buffer-file-coding-system-for-read)
 
 (defvar file-coding-system-alist
-  '(("\\.elc$" . (binary . binary))
-;; This must not be neccessary, slb suggests -kkm
+  `(
+;; This must not be necessary, slb suggests -kkm
 ;;  ("loaddefs.el$" . (binary . binary))
-    ("\\.tar$" . (binary . binary))
-    ("\\.\\(tif\\|tiff\\)$" . (binary . binary))
-    ("\\.png$" . (binary . binary))
-    ("\\.gif$" . (binary . binary))
-    ("\\.\\(jpeg\\|jpg\\)$" . (binary . binary))
-    ("TUTORIAL\\.hr$" . iso-8859-2)
-    ("TUTORIAL\\.pl$" . iso-8859-2)
-    ("TUTORIAL\\.ro$" . iso-8859-2)
+    ,@(mapcar
+       #'(lambda (regexp) (cons regexp 'binary)) binary-file-regexps)
+    ("TUTORIAL\\.\\(?:hr\\|pl\\|ro\\)\\'" . iso-8859-2)
     ;; ("\\.\\(el\\|emacs\\|info\\(-[0-9]+\\)?\\|texi\\)$" . iso-2022-8)
     ;; ("\\(ChangeLog\\|CHANGES-beta\\)$" . iso-2022-8)
-    ("\\.\\(gz\\|Z\\)$" . binary)
-    ("/spool/mail/.*$" . convert-mbox-coding-system))
+
+    ;; This idea is totally broken, and the code didn't work anyway.
+    ;; Mailboxes should be decoded by mail clients, who actually know
+    ;; how to deal with them.  Otherwise, their contents should be
+    ;; treated as `binary'.
+    ;("/spool/mail/.*$" . convert-mbox-coding-system)
+    )
   "Alist to decide a coding system to use for a file I/O operation.
 The format is ((PATTERN . VAL) ...),
 where PATTERN is a regular expression matching a file name,
@@ -106,14 +109,15 @@ the current value of `buffer-file-coding-system'."
   "Set EOL type of buffer-file-coding-system of the current buffer to
 something other than what it is at the moment."
   (interactive)
-  (let ((eol-type 
+  (let ((eol-type
         (coding-system-eol-type buffer-file-coding-system)))
     (setq buffer-file-coding-system
          (subsidiary-coding-system
           (coding-system-base buffer-file-coding-system)
           (cond ((eq eol-type 'lf) 'crlf)
                 ((eq eol-type 'crlf) 'lf)
-                ((eq eol-type 'cr) 'lf))))))
+                ((eq eol-type 'cr) 'lf))))
+    (set-buffer-modified-p t)))
 
 (define-obsolete-function-alias
   'set-file-coding-system
@@ -153,7 +157,7 @@ object (the entry specified a coding system)."
   (let ((alist file-coding-system-alist)
        (found nil)
        (codesys nil))
-    (let ((case-fold-search (eq system-type 'vax-vms)))
+    (let ((case-fold-search nil))
       (setq filename (file-name-sans-versions filename))
       (while (and (not found) alist)
        (if (string-match (car (car alist)) filename)
@@ -179,7 +183,7 @@ object (the entry specified a coding system)."
   (let ((alist file-coding-system-alist)
        (found nil)
        (codesys nil))
-    (let ((case-fold-search (eq system-type 'vax-vms)))
+    (let ((case-fold-search nil))
       (setq filename (file-name-sans-versions filename))
       (while (and (not found) alist)
        (if (string-match (car (car alist)) filename)
@@ -194,34 +198,23 @@ object (the entry specified a coding system)."
            ((find-coding-system codesys))
            ))))
 
-(defun convert-mbox-coding-system (filename visit start end)
-  "Decoding function for Unix mailboxes.
-Does separate detection and decoding on each message, since each
-message might be in a different encoding."
-  (let ((buffer-read-only nil))
-    (save-restriction
-      (narrow-to-region start end)
-      (goto-char (point-min))
-      (while (not (eobp))
-       (let ((start (point))
-             end)
-         (forward-char 1)
-         (if (re-search-forward "^From" nil 'move)
-             (beginning-of-line))
-         (setq end (point))
-         (decode-coding-region start end 'undecided))))))
+;; This was completely broken, not only in implementation (does not
+;; understand MIME), but in concept -- such high-level decoding should
+;; be done by mail readers, not by IO code!  Removed 2000-04-18.
+
+;(defun convert-mbox-coding-system (filename visit start end) ...)
 
 (defun find-coding-system-magic-cookie ()
-  "Look for the coding-system magic cookie in the current buffer.\n"
-"The coding-system magic cookie is the exact string\n"
-"\";;;###coding system: \" followed by a valid coding system symbol,\n"
-"somewhere within the first 3000 characters of the file.  If found,\n"
-"the coding system symbol is returned; otherwise nil is returned.\n"
-"Note that it is extremely unlikely that such a string would occur\n"
-"coincidentally as the result of encoding some characters in a non-ASCII\n"
-"charset, and that the spaces make it even less likely since the space\n"
-"character is not a valid octet in any ISO 2022 encoding of most non-ASCII\n"
-"charsets."
+  "Look for the coding-system magic cookie in the current buffer.
+The coding-system magic cookie is the exact string
+\";;;###coding system: \" followed by a valid coding system symbol,
+somewhere within the first 3000 characters of the file.  If found,
+the coding system symbol is returned; otherwise nil is returned.
+Note that it is extremely unlikely that such a string would occur
+coincidentally as the result of encoding some characters in a non-ASCII
+charset, and that the spaces make it even less likely since the space
+character is not a valid octet in any ISO 2022 encoding of most non-ASCII
+charsets."
   (save-excursion
     (goto-char (point-min))
     (or (and (looking-at
@@ -277,7 +270,7 @@ Return t if file exists."
       (if (or (<= (length filename) 0)
              (null (setq path
                          (locate-file filename load-path
-                                      (and (not nosuffix) ".elc:.el:")))))
+                                      (and (not nosuffix) '(".elc" ".el" ""))))))
          (and (null noerror)
               (signal 'file-error (list "Cannot open load file" filename)))
        ;; now use the internal load to actually load the file.
@@ -290,8 +283,8 @@ Return t if file exists."
               (save-excursion
                 (set-buffer (get-buffer-create " *load*"))
                 (erase-buffer)
-                (let ((coding-system-for-read 'no-conversion))
-                  (insert-file-contents path nil 1 3001))
+                (let ((coding-system-for-read 'raw-text))
+                  (insert-file-contents path nil 0 3000))
                 (find-coding-system-magic-cookie))
               (if elc
                   ;; if reading a byte-compiled file and we didn't find
@@ -360,7 +353,7 @@ CODING-SYSTEM (the actual coding system used to decode the file), and
 a cons of absolute pathname and length of data inserted (the same
 thing as will be returned from `insert-file-contents').")
 
-(defun insert-file-contents (filename &optional visit beg end replace)
+(defun insert-file-contents (filename &optional visit start end replace)
   "Insert contents of file FILENAME after point.
 Returns list of absolute file name and length of data inserted.
 If second argument VISIT is non-nil, the buffer's visited filename
@@ -368,18 +361,15 @@ and last save file modtime are set, and it is marked unmodified.
 If visiting and the file does not exist, visiting is completed
 before the error is signaled.
 
-The optional third and fourth arguments BEG and END
+The optional third and fourth arguments START and END
 specify what portion of the file to insert.
-If VISIT is non-nil, BEG and END must be nil.
+If VISIT is non-nil, START and END must be nil.
 If optional fifth argument REPLACE is non-nil,
 it means replace the current buffer contents (in the accessible portion)
 with the file contents.  This is better than simply deleting and inserting
 the whole thing because (1) it preserves some marker positions
 and (2) it puts less data in the undo list.
 
-NOTE: When Mule support is enabled, the REPLACE argument is
-currently ignored.
-
 The coding system used for decoding the file is determined as follows:
 
 1. `coding-system-for-read', if non-nil.
@@ -387,7 +377,7 @@ The coding system used for decoding the file is determined as follows:
 3. The matching value for this filename from
    `file-coding-system-alist', if any.
 4. `buffer-file-coding-system-for-read', if non-nil.
-5. The coding system 'no-conversion.
+5. The coding system 'raw-text.
 
 If a local value for `buffer-file-coding-system' in the current buffer
 does not exist, it is set to the coding system which was actually used
@@ -396,7 +386,7 @@ for reading.
 See also `insert-file-contents-access-hook',
 `insert-file-contents-pre-hook', `insert-file-contents-error-hook',
 and `insert-file-contents-post-hook'."
-  (let (return-val coding-system used-codesys conversion-func)
+  (let (return-val coding-system used-codesys)
     ;; OK, first load the file.
     (condition-case err
        (progn
@@ -416,7 +406,7 @@ and `insert-file-contents-post-hook'."
                 ;; #4.
                 buffer-file-coding-system-for-read
                 ;; #5.
-                'no-conversion))
+                'raw-text))
          (if (consp coding-system)
              (setq return-val coding-system)
            (if (null (find-coding-system coding-system))
@@ -426,7 +416,7 @@ and `insert-file-contents-post-hook'."
                   coding-system)
                  (setq coding-system 'undecided)))
            (setq return-val
-                 (insert-file-contents-internal filename visit beg end
+                 (insert-file-contents-internal filename visit start end
                                                 replace coding-system
                                                 ;; store here!
                                                 'used-codesys))
@@ -470,20 +460,19 @@ and `insert-file-contents-post-hook'."
 (defvar write-region-pre-hook nil
   "A special hook to decide the coding system used for writing out a file.
 
-Before writing a file, `write-region' calls the functions on this hook
-with arguments START, END, FILENAME, APPEND, VISIT, and CODING-SYSTEM,
-the same as the corresponding arguments in the call to
-`write-region'.
+Before writing a file, `write-region' calls the functions on this hook with
+arguments START, END, FILENAME, APPEND, VISIT, LOCKNAME and CODING-SYSTEM,
+the same as the corresponding arguments in the call to `write-region'.
 
-The return value of the functions should be either
+The return value of each function should be one of
 
 -- nil
 -- A coding system or a symbol denoting it, indicating the coding system
-   to be used for reading the file
+   to be used for writing the file
 -- A list of two elements (absolute pathname and length of data written),
-   which is used as the return value to `write-region'.  In this
-   case, `write-region' assumes that the function has written
-   the file for itself and suppresses further writing.
+   which is used as the return value to `write-region'.  In this case,
+   `write-region' assumes that the function has written the file and
+   returns.
 
 If any function returns non-nil, the remaining functions are not called.")
 
@@ -491,13 +480,17 @@ If any function returns non-nil, the remaining functions are not called.")
   "A hook called by `write-region' after a file has been written out.
 
 The functions on this hook are called with arguments START, END,
-FILENAME, APPEND, VISIT, and CODING-SYSTEM, the same as the
+FILENAME, APPEND, VISIT, LOCKNAME, and CODING-SYSTEM, the same as the
 corresponding arguments in the call to `write-region'.")
 
-(defun write-region (start end filename &optional append visit lockname coding-system)
+(defun write-region (start end filename
+                    &optional append visit lockname coding-system)
   "Write current region into specified file.
 By default the file's existing contents are replaced by the specified region.
-When called from a program, takes three arguments:
+Called interactively, prompts for a file name.  With a prefix arg, prompts
+for a coding system as well.
+
+When called from a program, takes three required arguments:
 START, END and FILENAME.  START and END are buffer positions.
 Optional fourth argument APPEND if non-nil means
   append to existing file contents (if any).
@@ -516,19 +509,19 @@ to the file, instead of any buffer contents, and END is ignored.
 Optional seventh argument CODING-SYSTEM specifies the coding system
   used to encode the text when it is written out, and defaults to
   the value of `buffer-file-coding-system' in the current buffer.
-  Interactively, with a prefix arg, you will be prompted for the
-  coding system.
 See also `write-region-pre-hook' and `write-region-post-hook'."
   (interactive "r\nFWrite region to file: \ni\ni\ni\nZCoding-system: ")
   (setq coding-system
        (or coding-system-for-write
            (run-hook-with-args-until-success
-            'write-region-pre-hook start end filename append visit lockname)
+            'write-region-pre-hook
+            start end filename append visit lockname coding-system)
            coding-system
            buffer-file-coding-system
            (find-file-coding-system-for-write-from-filename filename)
            ))
   (if (consp coding-system)
+      ;; One of the `write-region-pre-hook' functions wrote the file
       coding-system
     (let ((func
           (coding-system-property coding-system 'pre-write-conversion)))
@@ -561,4 +554,4 @@ See also `write-region-pre-hook' and `write-region-post-hook'."
                        start end filename append visit lockname
                        coding-system)))
 
-;;; mule-files.el ends here
+;;; code-files.el ends here