import xemacs-21.2.37
[chise/xemacs-chise.git.1] / lisp / files.el
index f59d54f..05d60f6 100644 (file)
@@ -291,11 +291,11 @@ changing the major mode does not clear it.  However, calling
 (defvar after-set-visited-file-name-hooks nil
   "List of functions to be called after \\[set-visited-file-name]
 or during \\[write-file].
-You can use this hook to restore local values of write-file-hooks,
-after-save-hook, and revert-buffer-function, which pertain
+You can use this hook to restore local values of `write-file-hooks',
+`after-save-hook', and `revert-buffer-function', which pertain
 to a specific file and therefore are normally killed by a rename.
-Put hooks pertaining to the buffer contents on write-contents-hooks
-and revert-buffer-insert-file-contents-function.")
+Put hooks pertaining to the buffer contents on `write-contents-hooks'
+and `revert-buffer-insert-file-contents-function'.")
 
 (defvar write-contents-hooks nil
   "List of functions to be called before writing out a buffer to a file.
@@ -794,29 +794,36 @@ If optional argument HACK-HOMEDIR is non-nil, then this also substitutes
          (setq tail (cdr tail))))
       (when hack-homedir
        ;; Compute and save the abbreviated homedir name.
-       ;; We defer computing this until the first time it's needed, to
-       ;; give time for directory-abbrev-alist to be set properly.
-       ;; We include a slash at the end, to avoid spurious matches
-       ;; such as `/usr/foobar' when the home dir is `/usr/foo'.
+       ;; We defer computing this until the first time it's needed,
+       ;; to give time for directory-abbrev-alist to be set properly.
+       ;; We include the separator at the end, to avoid spurious
+       ;; matches such as `/usr/foobar' when the home dir is
+       ;; `/usr/foo'.
        (or abbreviated-home-dir
            (setq abbreviated-home-dir
                  (let ((abbreviated-home-dir "$foo"))
-                   (concat "\\`" (regexp-quote (abbreviate-file-name
-                                                (expand-file-name "~")))
-                           "\\(/\\|\\'\\)"))))
+                   (concat "\\`"
+                           (regexp-quote
+                            (abbreviate-file-name (expand-file-name "~")))
+                           "\\("
+                           (regexp-quote (string directory-sep-char))
+                           "\\|\\'\\)"))))
        ;; If FILENAME starts with the abbreviated homedir,
        ;; make it start with `~' instead.
        (if (and (string-match abbreviated-home-dir filename)
                 ;; If the home dir is just /, don't change it.
-                (not (and (= (match-end 0) 1) ;#### unix-specific
-                          (= (aref filename 0) ?/)))
-                (not (and (memq system-type '(ms-dos windows-nt))
+                (not (and (= (match-end 0) 1)
+                          (= (aref filename 0) directory-sep-char)))
+                (not (and (eq system-type 'windows-nt)
                           (save-match-data
-                            (string-match "^[a-zA-Z]:/$" filename)))))
+                            (string-match (concat "\\`[a-zA-Z]:"
+                                                  (regexp-quote
+                                                   (string directory-sep-char))
+                                                  "\\'")
+                                          filename)))))
            (setq filename
                  (concat "~"
-                         (substring filename
-                                    (match-beginning 1) (match-end 1))
+                         (match-string 1 filename)
                          (substring filename (match-end 0))))))
       filename)))
 
@@ -863,26 +870,34 @@ If there is no such live buffer, return nil."
                 (setq list (cdr list))))
          found))))
 
-(defun insert-file-contents-literally (filename &optional visit beg end replace)
+(defun insert-file-contents-literally (filename &optional visit start end replace)
   "Like `insert-file-contents', q.v., but only reads in the file.
 A buffer may be modified in several ways after reading into the buffer due
-to advanced Emacs features, such as file-name-handlers, format decoding,
-find-file-hooks, etc.
+to advanced Emacs features, such as format decoding, character code
+conversion, find-file-hooks, automatic uncompression, etc.
+
   This function ensures that none of these modifications will take place."
-  (let ((file-name-handler-alist nil)
-       (format-alist nil)
-       (after-insert-file-functions nil)
-       (find-buffer-file-type-function
-        (if (fboundp 'find-buffer-file-type)
-            (symbol-function 'find-buffer-file-type)
-          nil)))
-    (unwind-protect
-       (progn
-         (fset 'find-buffer-file-type (lambda (filename) t))
-         (insert-file-contents filename visit beg end replace))
-      (if find-buffer-file-type-function
-         (fset 'find-buffer-file-type find-buffer-file-type-function)
-       (fmakunbound 'find-buffer-file-type)))))
+  (let ((wrap-func (find-file-name-handler filename
+                                          'insert-file-contents-literally)))
+    (if wrap-func
+       (funcall wrap-func 'insert-file-contents-literally filename
+                visit start end replace)
+      (let ((file-name-handler-alist nil)
+           (format-alist nil)
+           (after-insert-file-functions nil)
+           (coding-system-for-read 'binary)
+           (coding-system-for-write 'binary)
+           (find-buffer-file-type-function
+            (if (fboundp 'find-buffer-file-type)
+                (symbol-function 'find-buffer-file-type)
+              nil)))
+       (unwind-protect
+           (progn
+             (fset 'find-buffer-file-type (lambda (filename) t))
+             (insert-file-contents filename visit start end replace))
+         (if find-buffer-file-type-function
+             (fset 'find-buffer-file-type find-buffer-file-type-function)
+           (fmakunbound 'find-buffer-file-type)))))))
 
 (defun find-file-noselect (filename &optional nowarn rawfile)
   "Read file FILENAME into a buffer and return the buffer.
@@ -1021,7 +1036,8 @@ If RAWFILE is non-nil, the file is read literally."
                  (setq buf (current-buffer))))
            (t
             (kill-buffer buf)
-            (signal (car data) (cdr data))))))
+            (signal (car data) (cdr data))))
+       ))
       buf)))
 \f
 ;; FSF has `insert-file-literally' and `find-file-literally' here.
@@ -1157,11 +1173,12 @@ run `normal-mode' explicitly."
     ("\\.m\\(?:[mes]\\|an\\)\\'" . nroff-mode)
     ("\\.icn\\'" . icon-mode)
     ("\\.\\(?:[ckz]?sh\\|shar\\)\\'" . sh-mode)
-    ("\\.pro\\'" . idlwave-mode)
+    ("\\.[Pp][Rr][Oo]\\'" . idlwave-mode)
     ;; #### Unix-specific!
     ("/\\.\\(?:bash_\\|z\\)?\\(profile\\|login\\|logout\\)\\'" . sh-mode)
     ("/\\.\\(?:[ckz]sh\\|bash\\|tcsh\\|es\\|xinit\\|startx\\)rc\\'" . sh-mode)
     ("/\\.\\(?:[kz]shenv\\|xsession\\)\\'" . sh-mode)
+    ("\\.m?spec$" .sh-mode)
     ;; The following come after the ChangeLog pattern for the sake of
     ;; ChangeLog.1, etc. and after the .scm.[0-9] pattern too.
     ("\\.[12345678]\\'" . nroff-mode)
@@ -1186,8 +1203,9 @@ run `normal-mode' explicitly."
     ("\\.lex\\'" . c-mode)
     ("\\.m\\'" . objc-mode)
     ("\\.oak\\'" . scheme-mode)
-    ("\\.s?html?\\'" . html-mode)
-    ("\\.htm?l?3\\'" . html3-mode)
+    ("\\.[sj]?html?\\'" . html-mode)
+    ("\\.jsp\\'" . html-mode)
+    ("\\.xml\\'" . xml-mode)
     ("\\.\\(?:sgml?\\|dtd\\)\\'" . sgml-mode)
     ("\\.c?ps\\'" . postscript-mode)
     ;; .emacs following a directory delimiter in either Unix or
@@ -1196,7 +1214,7 @@ run `normal-mode' explicitly."
     ("\\.m4\\'" . autoconf-mode)
     ("configure\\.in\\'" . autoconf-mode)
     ("\\.ml\\'" . lisp-mode)
-    ("\\.ma?k\\'" . makefile-mode)
+    ("\\.ma?ke?\\'" . makefile-mode)
     ("[Mm]akefile\\(\\.\\|\\'\\)" . makefile-mode)
     ("\\.X\\(defaults\\|environment\\|resources\\|modmap\\)\\'" . xrdb-mode)
     ;; #### The following three are Unix-specific (but do we care?)
@@ -1241,8 +1259,7 @@ with the name of the interpreter specified in the first line.
 If it matches, mode MODE is selected.")
 
 (defvar binary-file-regexps
-  (purecopy
-   '("\\.\\(?:bz2\\|elc\\|g\\(if\\|z\\)\\|jp\\(eg\\|g\\)\\|png\\|t\\(ar\\|gz\\|iff\\)\\|[Zo]\\)\\'"))
+  '("\\.\\(?:bz2\\|elc\\|g\\(if\\|z\\)\\|jp\\(eg\\|g\\)\\|png\\|t\\(ar\\|gz\\|iff\\)\\|[Zo]\\)\\'")
   "List of regexps of filenames containing binary (non-text) data.")
 
 ;   (eval-when-compile
@@ -1262,9 +1279,9 @@ If it matches, mode MODE is selected.")
 ;               "tiff"
 ;               "jpg"
 ;               "jpeg"))))))
-  
+
 (defvar inhibit-first-line-modes-regexps
-  (purecopy binary-file-regexps)
+  binary-file-regexps
   "List of regexps; if one matches a file name, don't look for `-*-'.")
 
 (defvar inhibit-first-line-modes-suffixes nil
@@ -1312,9 +1329,15 @@ and we don't even do that unless it would come from the file name."
             (setq keep-going nil)
             (let ((alist auto-mode-alist)
                   (mode nil))
+
               ;; Find first matching alist entry.
+
+             ;; #### This is incorrect. In NT, case sensitivity is a volume
+             ;; property. For instance, NFS mounts *are* case sensitive.
+             ;; Need internal function (file-name-case-sensitive f), F
+             ;; being file or directory name. - kkm
              (let ((case-fold-search
-                    (memq system-type '(windows-nt))))
+                    (eq system-type 'windows-nt)))
                (while (and (not mode) alist)
                  (if (string-match (car (car alist)) name)
                      (if (and (consp (cdr (car alist)))
@@ -1456,7 +1479,7 @@ for current buffer."
               (or force
                    (hack-local-variables-p nil))))
        (let ((continue t)
-             prefix prefixlen suffix beg
+             prefix prefixlen suffix start
               (enable-local-eval enable-local-eval))
          ;; The prefix is what comes before "local variables:" in its line.
          ;; The suffix is what comes after "local variables:" in its line.
@@ -1483,11 +1506,11 @@ for current buffer."
                  (error "Local variables entry is missing the prefix")))
            ;; Find the variable name; strip whitespace.
            (skip-chars-forward " \t")
-           (setq beg (point))
+           (setq start (point))
            (skip-chars-forward "^:\n")
            (if (eolp) (error "Missing colon in local variables entry"))
            (skip-chars-backward " \t")
-           (let* ((str (buffer-substring beg (point)))
+           (let* ((str (buffer-substring start (point)))
                   (var (read str))
                  val)
              ;; Setting variable named "end" means end of list.
@@ -1526,7 +1549,7 @@ for current buffer."
        (cond ((not (search-forward "-*-" end t))
               ;; doesn't have one.
               (setq force t))
-             ((looking-at "[ \t]*\\([^ \t\n\r:;]+\\)\\([ \t]*-\\*-\\)")
+             ((looking-at "[ \t]*\\([^ \t\n\r:;]+?\\)\\([ \t]*-\\*-\\)")
               ;; Antiquated form: "-*- ModeName -*-".
               (setq result
                     (list (cons 'mode
@@ -1818,7 +1841,7 @@ with a prefix argument, you will be prompted for the coding system."
                                          (buffer-local-variables)))
                               nil nil (buffer-name)))
         t
-        (if (and current-prefix-arg (featurep 'mule))
+        (if (and current-prefix-arg (featurep 'file-coding))
             (read-coding-system "Coding system: "))))
   (and (eq (current-buffer) mouse-grabbed-buffer)
        (error "Can't write minibuffer window"))
@@ -1872,7 +1895,7 @@ of the new file to agree with the old modes."
                        (let ((delete-old-versions
                               ;; If have old versions to maybe delete,
                               ;; ask the user to confirm now, before doing anything.
-                              ;; But don't actually delete til later.
+                              ;; But don't actually delete till later.
                               (and targets
                                    (or (eq delete-old-versions t)
                                        (eq delete-old-versions nil))
@@ -1990,21 +2013,13 @@ the value is \"\"."
 (defun make-backup-file-name (file)
   "Create the non-numeric backup file name for FILE.
 This is a separate function so you can redefine it for customization."
-  (if (eq system-type 'ms-dos)
-      (let ((fn (file-name-nondirectory file)))
-       (concat (file-name-directory file)
-               (if (string-match "\\([^.]*\\)\\(\\..*\\)?" fn)
-                   (substring fn 0 (match-end 1)))
-               ".bak"))
-    (concat file "~")))
+    (concat file "~"))
 
 (defun backup-file-name-p (file)
   "Return non-nil if FILE is a backup file name (numeric or not).
 This is a separate function so you can redefine it for customization.
 You may need to redefine `file-name-sans-versions' as well."
-  (if (eq system-type 'ms-dos)
-      (string-match "\\.bak\\'" file)
-      (string-match "~\\'" file)))
+  (string-match "~\\'" file))
 
 ;; This is used in various files.
 ;; The usage of bv-length is not very clean,
@@ -2075,16 +2090,15 @@ If the value is nil, don't make a backup."
   "Convert FILENAME to be relative to DIRECTORY (default: default-directory).
 This function returns a relative file name which is equivalent to FILENAME
 when used with that default directory as the default.
-If this is impossible (which can happen on MSDOS and Windows
-when the file name and directory use different drive names)
-then it returns FILENAME."
+If this is impossible (which can happen on MS Windows when the file name
+and directory use different drive names) then it returns FILENAME."
   (save-match-data
     (let ((fname (expand-file-name filename)))
       (setq directory (file-name-as-directory
                       (expand-file-name (or directory default-directory))))
       ;; On Microsoft OSes, if FILENAME and DIRECTORY have different
       ;; drive names, they can't be relative, so return the absolute name.
-      (if (and (memq system-type '(ms-dos windows-nt))
+      (if (and (eq system-type 'windows-nt)
               (not (string-equal (substring fname  0 2)
                                  (substring directory 0 2))))
          filename
@@ -2229,7 +2243,7 @@ After saving the buffer, run `after-save-hook'."
                (goto-char (point-max))
                (insert ?\n)))
 
-           ;; Run the write-file-hooks until one returns non-null.
+           ;; Run the write-file-hooks until one returns non-nil.
            ;; Bind after-save-hook to nil while running the
            ;; write-file-hooks so that if this function is called
            ;; recursively (from inside a write-file-hook) the
@@ -2345,9 +2359,9 @@ After saving the buffer, run `after-save-hook'."
   "Provide a clean way for a write-file-hook to wrap AROUND
 the execution of the remaining hooks and writing to disk.
 Do not call this function except from a functions
-on the write-file-hooks or write-contents-hooks list.
+on the `write-file-hooks' or `write-contents-hooks' list.
 A hook that calls this function must return non-nil,
-to signal completion to its caller.  continue-save-buffer
+to signal completion to its caller.  `continue-save-buffer'
 always returns non-nil."
   (let ((hooks (cdr (or continue-save-buffer-hooks-tail
                        (error
@@ -2454,7 +2468,7 @@ Optional second argument EXITING means ask about certain non-file buffers
                               (recursive-edit)
                               ;; Return nil to ask about BUF again.
                               nil)
-                      "display the current buffer"))))
+                      "%_Display Buffer"))))
         (abbrevs-done
          (and save-abbrevs abbrevs-changed
               (progn
@@ -2685,7 +2699,7 @@ non-nil, it is called instead of rereading visited file contents."
                                      file-name)))
             (run-hooks 'before-revert-hook)
             ;; If file was backed up but has changed since,
-            ;; we shd make another backup.
+            ;; we should make another backup.
             (and (not auto-save-p)
                  (not (verify-visited-file-modtime (current-buffer)))
                  (setq buffer-backed-up nil))
@@ -3136,6 +3150,8 @@ If WILDCARD, it also runs the shell specified by `shell-file-name'."
        (funcall handler 'insert-directory file switches
                 wildcard full-directory-p)
       (cond
+       ;; #### mswindows-insert-directory should be called
+       ;; nt-insert-directory - kkm.
        ((and (fboundp 'mswindows-insert-directory)
             (eq system-type 'windows-nt))
        (mswindows-insert-directory file switches wildcard full-directory-p))
@@ -3147,19 +3163,19 @@ If WILDCARD, it also runs the shell specified by `shell-file-name'."
                           (file-name-directory file)
                           (file-name-directory (expand-file-name file))))
                  (pattern (file-name-nondirectory file))
-                 (beg 0))
+                 (start 0))
              ;; Quote some characters that have special meanings in shells;
              ;; but don't quote the wildcards--we want them to be special.
              ;; We also currently don't quote the quoting characters
              ;; in case people want to use them explicitly to quote
              ;; wildcard characters.
               ;;#### Unix-specific
-             (while (string-match "[ \t\n;<>&|()#$]" pattern beg)
+             (while (string-match "[ \t\n;<>&|()#$]" pattern start)
                (setq pattern
                      (concat (substring pattern 0 (match-beginning 0))
                              "\\"
                              (substring pattern (match-beginning 0)))
-                     beg (1+ (match-end 0))))
+                     start (1+ (match-end 0))))
              (call-process shell-file-name nil t nil
                            "-c" (concat "\\"  ;; Disregard shell aliases!
                                         insert-directory-program