(w32_menu_show): Set widget call_data to 0 if definition is nil.
[bpt/emacs.git] / lisp / files.el
index 1790e1d..07c64a2 100644 (file)
@@ -170,6 +170,19 @@ If the buffer is visiting a new file, the value is nil.")
 (defvar buffer-file-numbers-unique (not (memq system-type '(windows-nt)))
   "Non-nil means that buffer-file-number uniquely identifies files.")
 
+(defvar file-name-invalid-regexp
+  (cond ((and (eq system-type 'ms-dos) (not (msdos-long-file-names)))
+        (concat "\\(^\\([A-z]:\\)?/?.*:\\)\\|"   ; colon except after drive
+                "[+, ;=|<>\"?*]\\|\\[\\|\\]\\|"  ; invalid characters
+                "[\000-\031]|"                   ; control characters
+                "\\(/\\.\\.?[^/]\\)\\|"          ; leading dots
+                "\\(/[^/.]+\\.[^/.]*\\.\\)"))    ; more than a single dot
+       ((memq system-type '(ms-dos windows-nt))
+        (concat "\\(^\\([A-z]:\\)?/?.*:\\)\\|"   ; colon except after drive
+                "[|<>\"?*\000-\031]"))           ; invalid characters
+       (t "[\000]"))
+  "Regexp recognizing file names which aren't allowed by the filesystem.")
+
 (defcustom file-precious-flag nil
   "*Non-nil means protect against I/O errors while saving files.
 Some modes set this non-nil in particular buffers.
@@ -190,7 +203,9 @@ breaks any hard links between it and other files."
 t means make numeric backup versions unconditionally.
 nil means make them for files that have some already.
 `never' means do not make them."
-  :type 'boolean
+  :type '(choice (const :tag "Never" never)
+                (const :tag "If existing" nil)
+                (other :tag "Always" t))
   :group 'backup
   :group 'vc)
 
@@ -205,7 +220,7 @@ nil means make them for files that have some already.
 If nil, ask confirmation.  Any other value prevents any trimming."
   :type '(choice (const :tag "Delete" t)
                 (const :tag "Ask" nil)
-                (sexp :tag "Leave" :format "%t\n" other))
+                (other :tag "Leave" other))
   :group 'backup)
 
 (defcustom kept-old-versions 2
@@ -225,7 +240,7 @@ Non-nil but not t says ask user whether to add a newline when there isn't one.
 nil means don't add newlines."
   :type '(choice (const :tag "Off" nil)
                 (const :tag "Add" t)
-                (sexp :tag "Ask" :format "%t\n" ask))
+                (other :tag "Ask" ask))
   :group 'editing-basics)
 
 (defcustom auto-save-default t
@@ -316,9 +331,14 @@ The command \\[normal-mode] always obeys file local variable
 specifications and ignores this variable."
   :type '(choice (const :tag "Obey" t)
                 (const :tag "Ignore" nil)
-                (sexp :tag "Query" :format "%t\n" other))
+                (other :tag "Query" other))
   :group 'find-file)
 
+(defvar local-enable-local-variables t
+  "Like `enable-local-variables' but meant for buffer-local bindings.
+If a major mode sets this to nil, buffer-locally, then any local
+variables list in the file will be ignored.")
+
 (defcustom enable-local-eval 'maybe
   "*Control processing of the \"variable\" `eval' in a file's local variables.
 The value can be t, nil or something else.
@@ -329,7 +349,7 @@ The command \\[normal-mode] always obeys local-variables lists
 and ignores this variable."
   :type '(choice (const :tag "Obey" t)
                 (const :tag "Ignore" nil)
-                (sexp :tag "Query" :format "%t\n" other))
+                (other :tag "Query" other))
   :group 'find-file)
 
 ;; Avoid losing in versions where CLASH_DETECTION is disabled.
@@ -343,6 +363,19 @@ and ignores this variable."
 (defvar view-read-only nil
   "*Non-nil means buffers visiting files read-only, do it in view mode.")
 
+(defvar temporary-file-directory
+  (file-name-as-directory
+   (cond ((memq system-type '(ms-dos windows-nt))
+         (or (getenv "TEMP") (getenv "TMPDIR") (getenv "TMP") "c:/temp"))
+        ((memq system-type '(vax-vms axp-vms))
+         (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") "SYS$SCRATCH:"))
+        (t
+         (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") "/tmp"))))
+  "The directory for writing temporary files.")
+
+;; The system null device. (Should reference NULL_DEVICE from C.)
+(defvar null-device "/dev/null" "The system null device.")
+
 ;; This hook function provides support for ange-ftp host name
 ;; completion.  It runs the usual ange-ftp hook, but only for
 ;; completion operations.  Having this here avoids the need
@@ -373,9 +406,6 @@ with a definition that really does change some file names."
   "Value of the CDPATH environment variable, as a list.
 Not actually set up until the first time you you use it.")
 
-(defvar path-separator ":"
-  "Character used to separate directories in search paths.")
-
 (defun parse-colon-path (cd-path)
   "Explode a colon-separated search path into a list of directory names."
   (and cd-path
@@ -850,8 +880,7 @@ Optional second arg RAWFILE non-nil means the file is read literally."
           (truename (abbreviate-file-name (file-truename filename)))
           (number (nthcdr 10 (file-attributes truename)))
           ;; Find any buffer for a file which has same truename.
-          (other (and (not buf) (find-buffer-visiting filename)))
-          error)
+          (other (and (not buf) (find-buffer-visiting filename))))
       ;; Let user know if there is a buffer with the same truename.
       (if other
          (progn
@@ -863,111 +892,142 @@ Optional second arg RAWFILE non-nil means the file is read literally."
            (if (or find-file-existing-other-name find-file-visit-truename)
                (setq buf other))))
       (if buf
-         (or nowarn
-             (verify-visited-file-modtime buf)
-             (cond ((not (file-exists-p filename))
-                    (error "File %s no longer exists!" filename))
-                   ;; Certain files should be reverted automatically
-                   ;; if they have changed on disk and not in the buffer.
-                   ((and (not (buffer-modified-p buf))
-                         (let ((tail revert-without-query)
-                               (found nil))
-                           (while tail
-                             (if (string-match (car tail) filename)
-                                 (setq found t))
-                             (setq tail (cdr tail)))
-                           found))
-                    (with-current-buffer buf
-                     (message "Reverting file %s..." filename)
-                     (revert-buffer t t)
-                     (message "Reverting file %s...done" filename)))
-                   ((yes-or-no-p
-                     (if (string= (file-name-nondirectory filename)
-                                  (buffer-name buf))
+         ;; We are using an existing buffer.
+         (progn
+           (or nowarn
+               (verify-visited-file-modtime buf)
+               (cond ((not (file-exists-p filename))
+                      (error "File %s no longer exists!" filename))
+                     ;; Certain files should be reverted automatically
+                     ;; if they have changed on disk and not in the buffer.
+                     ((and (not (buffer-modified-p buf))
+                           (let ((tail revert-without-query)
+                                 (found nil))
+                             (while tail
+                               (if (string-match (car tail) filename)
+                                   (setq found t))
+                               (setq tail (cdr tail)))
+                             found))
+                      (with-current-buffer buf
+                        (message "Reverting file %s..." filename)
+                        (revert-buffer t t)
+                        (message "Reverting file %s...done" filename)))
+                     ((yes-or-no-p
+                       (if (string= (file-name-nondirectory filename)
+                                    (buffer-name buf))
+                           (format
+                            (if (buffer-modified-p buf)
+                                "File %s changed on disk.  Discard your edits? "
+                              "File %s changed on disk.  Reread from disk? ")
+                            (file-name-nondirectory filename))
                          (format
                           (if (buffer-modified-p buf)
-       "File %s changed on disk.  Discard your edits? "
-       "File %s changed on disk.  Reread from disk? ")
-                          (file-name-nondirectory filename))
-                       (format
-                        (if (buffer-modified-p buf)
-      "File %s changed on disk.  Discard your edits in %s? "
-      "File %s changed on disk.  Reread from disk into %s? ")
-                        (file-name-nondirectory filename)
-                        (buffer-name buf))))
-                    (with-current-buffer buf
-                      (revert-buffer t t)))
-                   ((not (eq rawfile (not (null find-file-literally))))
-                    (if rawfile
-                        (message "File is already visited, and not literally")
-                      (message "File is already visited, and visited literally")))))
-       (save-excursion
-;;; The truename stuff makes this obsolete.
-;;;      (let* ((link-name (car (file-attributes filename)))
-;;;             (linked-buf (and (stringp link-name)
-;;;                              (get-file-buffer link-name))))
-;;;        (if (bufferp linked-buf)
-;;;            (message "Symbolic link to file in buffer %s"
-;;;                     (buffer-name linked-buf))))
-         (setq buf (create-file-buffer filename))
-         (set-buffer-major-mode buf)
-         (set-buffer buf)
-         (erase-buffer)
-         (if rawfile
-             (condition-case ()
-                 (insert-file-contents-literally filename t)
-               (file-error
-                (when (and (file-exists-p filename)
-                           (not (file-readable-p filename)))
-                  (kill-buffer buf)
-                  (signal 'file-error (list "File is not readable"
-                                            filename)))
-                ;; Unconditionally set error
-                (setq error t)))
-           (condition-case ()
-               (insert-file-contents filename t)
-             (file-error
-              (when (and (file-exists-p filename)
-                         (not (file-readable-p filename)))
-                (kill-buffer buf)
-                (signal 'file-error (list "File is not readable"
-                                          filename)))
-              ;; Run find-file-not-found-hooks until one returns non-nil.
-              (or (run-hook-with-args-until-success 'find-file-not-found-hooks)
-                  ;; If they fail too, set error.
-                  (setq error t)))))
-         ;; Find the file's truename, and maybe use that as visited name.
-         (setq buffer-file-truename truename)
-         (setq buffer-file-number number)
-         ;; On VMS, we may want to remember which directory in a search list
-         ;; the file was found in.
-         (and (eq system-type 'vax-vms)
-              (let (logical)
-                (if (string-match ":" (file-name-directory filename))
-                    (setq logical (substring (file-name-directory filename)
-                                             0 (match-beginning 0))))
-                (not (member logical find-file-not-true-dirname-list)))
-              (setq buffer-file-name buffer-file-truename))
-         (if find-file-visit-truename
-             (setq buffer-file-name
-                   (setq filename
-                         (expand-file-name buffer-file-truename))))
-         ;; Set buffer's default directory to that of the file.
-         (setq default-directory (file-name-directory filename))
-         ;; Turn off backup files for certain file names.  Since
-         ;; this is a permanent local, the major mode won't eliminate it.
-         (and (not (funcall backup-enable-predicate buffer-file-name))
-              (progn
-                (make-local-variable 'backup-inhibited)
-                (setq backup-inhibited t)))
-         (if rawfile
-             (progn
-               (set-buffer-multibyte nil)
-               (make-local-variable 'find-file-literally)
-               (setq find-file-literally t))
-           (after-find-file error (not nowarn))
-           (setq buf (current-buffer)))))
-      buf)))
+                              "File %s changed on disk.  Discard your edits in %s? "
+                            "File %s changed on disk.  Reread from disk into %s? ")
+                          (file-name-nondirectory filename)
+                          (buffer-name buf))))
+                      (with-current-buffer buf
+                        (revert-buffer t t)))))
+           (when (not (eq rawfile (not (null find-file-literally))))
+             (with-current-buffer buf
+               (if (buffer-modified-p)
+                   (if (y-or-n-p (if rawfile
+                                     "Save file and revisit literally? "
+                                   "Save file and revisit non-literally? "))
+                       (progn
+                         (save-buffer)
+                         (find-file-noselect-1 buf filename nowarn
+                                               rawfile truename number))
+                     (if (y-or-n-p (if rawfile
+                                       "Discard your edits and revisit file literally? "
+                                     "Discard your edits and revisit file non-literally? "))
+                         (find-file-noselect-1 buf filename nowarn
+                                               rawfile truename number)
+                       (error (if rawfile "File already visited non-literally"
+                                "File already visited literally"))))
+                 (if (y-or-n-p (if rawfile
+                                   "Revisit file literally? "
+                                 "Revisit file non-literally? "))
+                     (find-file-noselect-1 buf filename nowarn
+                                           rawfile truename number)
+                   (error (if rawfile "File already visited non-literally"
+                            "File already visited literally"))))))
+           ;; Return the buffer we are using.
+           buf)
+       ;; Create a new buffer.
+       (setq buf (create-file-buffer filename))
+       (set-buffer-major-mode buf)
+       ;; find-file-noselect-1 may use a different buffer.
+       (find-file-noselect-1 buf filename nowarn
+                             rawfile truename number)))))
+
+(defun find-file-noselect-1 (buf filename nowarn rawfile truename number)
+  (let ((inhibit-read-only t)
+       error)
+    (with-current-buffer buf
+      (kill-local-variable 'find-file-literally)
+      ;; Needed in case we are re-visiting the file with a different
+      ;; text representation.
+      (setq buffer-file-coding-system default-buffer-file-coding-system)
+      (erase-buffer)
+      (and (default-value 'enable-multibyte-characters)
+          (not rawfile)
+          (set-buffer-multibyte t))
+      (if rawfile
+         (condition-case ()
+             (insert-file-contents-literally filename t)
+           (file-error
+            (when (and (file-exists-p filename)
+                       (not (file-readable-p filename)))
+              (kill-buffer buf)
+              (signal 'file-error (list "File is not readable"
+                                        filename)))
+            ;; Unconditionally set error
+            (setq error t)))
+       (condition-case ()
+           (insert-file-contents filename t)
+         (file-error
+          (when (and (file-exists-p filename)
+                     (not (file-readable-p filename)))
+            (kill-buffer buf)
+            (signal 'file-error (list "File is not readable"
+                                      filename)))
+          ;; Run find-file-not-found-hooks until one returns non-nil.
+          (or (run-hook-with-args-until-success 'find-file-not-found-hooks)
+              ;; If they fail too, set error.
+              (setq error t)))))
+      ;; Find the file's truename, and maybe use that as visited name.
+      (setq buffer-file-truename truename)
+      (setq buffer-file-number number)
+      ;; On VMS, we may want to remember which directory in a search list
+      ;; the file was found in.
+      (and (eq system-type 'vax-vms)
+          (let (logical)
+            (if (string-match ":" (file-name-directory filename))
+                (setq logical (substring (file-name-directory filename)
+                                         0 (match-beginning 0))))
+            (not (member logical find-file-not-true-dirname-list)))
+          (setq buffer-file-name buffer-file-truename))
+      (if find-file-visit-truename
+         (setq buffer-file-name
+               (setq filename
+                     (expand-file-name buffer-file-truename))))
+      ;; Set buffer's default directory to that of the file.
+      (setq default-directory (file-name-directory filename))
+      ;; Turn off backup files for certain file names.  Since
+      ;; this is a permanent local, the major mode won't eliminate it.
+      (and (not (funcall backup-enable-predicate buffer-file-name))
+          (progn
+            (make-local-variable 'backup-inhibited)
+            (setq backup-inhibited t)))
+      (if rawfile
+         (progn
+           (set-buffer-multibyte nil)
+           (setq buffer-file-coding-system 'no-conversion)
+           (make-local-variable 'find-file-literally)
+           (setq find-file-literally t))
+       (after-find-file error (not nowarn)))
+      (current-buffer))))
 \f
 (defun insert-file-contents-literally (filename &optional visit beg end replace)
   "Like `insert-file-contents', but only reads in the file literally.
@@ -1211,6 +1271,7 @@ run `normal-mode' explicitly."
     ("\\.lex\\'" . c-mode)
     ("\\.oak\\'" . scheme-mode)
     ("\\.sgml?\\'" . sgml-mode)
+    ("\\.xml\\'" . sgml-mode)
     ("\\.dtd\\'" . sgml-mode)
     ("\\.ds\\(ss\\)?l\\'" . dsssl-mode)
     ;; .emacs following a directory delimiter
@@ -1281,9 +1342,8 @@ If it matches, mode MODE is selected.")
 When checking `inhibit-first-line-modes-regexps', we first discard
 from the end of the file name anything that matches one of these regexps.")
 
-(defvar user-init-file
-  "" ; set by command-line
-  "File name including directory of user's initialization file.")
+(defvar user-init-file nil
+  "File name, including directory, of user's initialization file.")
 
 (defun set-auto-mode (&optional just-from-file-name)
   "Select major mode appropriate for current buffer.
@@ -1307,6 +1367,7 @@ and we don't even do that unless it would come from the file name."
       (goto-char (point-min))
       (skip-chars-forward " \t\n")
       (and enable-local-variables
+          local-enable-local-variables
           ;; Don't look for -*- if this file name matches any
           ;; of the regexps in inhibit-first-line-modes-regexps.
           (let ((temp inhibit-first-line-modes-regexps)
@@ -1393,7 +1454,13 @@ and we don't even do that unless it would come from the file name."
                              keep-going nil)))
                  (setq alist (cdr alist))))
              (if mode
-                 (funcall mode)
+                 ;; When JUST-FROM-FILE-NAME is set,
+                 ;; we are working on behalf of set-visited-file-name.
+                 ;; In that case, if the major mode specified is the
+                 ;; same one we already have, don't actually reset it.
+                 ;; We don't want to lose minor modes such as Font Lock.
+                 (unless (and just-from-file-name (eq mode major-mode))
+                   (funcall mode))
                ;; If we can't deduce a mode from the file name,
                ;; look for an interpreter specified in the first line.
                ;; As a special case, allow for things like "#!/bin/env perl",
@@ -1616,7 +1683,7 @@ is specified, returning t if it is specified."
        ;; Likewise for setting hook variables.
        ((or (get var 'risky-local-variable)
             (and
-             (string-match "-hooks?$\\|-functions?$\\|-forms?$\\|-program$\\|-command$"
+             (string-match "-hooks?$\\|-functions?$\\|-forms?$\\|-program$\\|-command$\\|-predicate$"
                            (symbol-name var))
              (not (get var 'safe-local-variable))))
         ;; Permit evalling a put of a harmless property.
@@ -1789,7 +1856,7 @@ Interactively, confirmation is required unless you supply a prefix argument."
           (read-file-name "Write file: "
                               (cdr (assq 'default-directory
                                          (buffer-local-variables)))
-                              nil nil (buffer-name)))
+                              nil nil (file-name-nondirectory (buffer-name))))
         (not current-prefix-arg)))
   (or (null filename) (string-equal filename "")
       (progn
@@ -2143,6 +2210,14 @@ the last real save, but optional arg FORCE non-nil means delete anyway."
 (defvar after-save-hook nil
   "Normal hook that is run after a buffer is saved to its file.")
 
+(defvar save-buffer-coding-system nil
+  "If non-nil, use this coding system for saving the buffer.
+More precisely, use this coding system in place of the
+value of `buffer-file-coding-system', when saving the buffer.
+Calling `write-region' for any purpose other than saving the buffer
+will still use `buffer-file-coding-system'; this variable has no effect
+in such cases.")
+
 (defun basic-save-buffer ()
   "Save the current buffer in its visited file, if it has been modified.
 After saving the buffer, run `after-save-hook'."
@@ -2207,7 +2282,9 @@ After saving the buffer, run `after-save-hook'."
            ;; Now we have saved the current buffer.  Let's make sure
            ;; that buffer-file-coding-system is fixed to what
            ;; actually used for saving by binding it locally.
-           (setq buffer-file-coding-system last-coding-system-used)
+           (if save-buffer-coding-system
+               (setq save-buffer-coding-system last-coding-system-used)
+             (setq buffer-file-coding-system last-coding-system-used))
            (setq buffer-file-number
                  (nthcdr 10 (file-attributes buffer-file-name)))
            (if setmodes
@@ -2227,7 +2304,10 @@ After saving the buffer, run `after-save-hook'."
 ;; but inhibited if one of write-file-hooks returns non-nil.
 ;; It returns a value to store in setmodes.
 (defun basic-save-buffer-1 ()
-  (let (tempsetmodes setmodes)
+  (let ((buffer-file-coding-system
+        (or save-buffer-coding-system
+            buffer-file-coding-system))
+       tempsetmodes setmodes)
     (if (not (file-writable-p buffer-file-name))
        (let ((dir (file-name-directory buffer-file-name)))
          (if (not (file-directory-p dir))
@@ -2374,7 +2454,9 @@ If visiting file read-only and `view-read-only' is non-nil, enter view mode."
     nil)                               ; do nothing.
    ;; Toggle.
    ((and buffer-read-only view-mode)
-    (View-exit-and-edit))              ; Must leave view mode.
+    (View-exit-and-edit)
+    (make-local-variable 'view-read-only)
+    (setq view-read-only t))           ; Must leave view mode.
    ((and (not buffer-read-only) view-read-only
         (not (eq (get major-mode 'mode-class) 'special)))
     (view-mode-enter))
@@ -2668,6 +2750,7 @@ This command is used in the special Dired buffer created by
   (let ((file (dired-get-filename))
        files
        (buffer (get-buffer-create " *recover*")))
+    (dired-unmark 1)
     (dired-do-flagged-delete t)
     (unwind-protect
        (save-excursion
@@ -2991,7 +3074,7 @@ If WILDCARD, it also runs the shell specified by `shell-file-name'."
                (and enable-multibyte-characters
                     (or file-name-coding-system
                         default-file-name-coding-system)))
-              ;; This binding is for encoding arguements by call-process.
+              ;; This is to control encoding the arguments in call-process.
               (coding-system-for-write coding-system-for-read)
               (result
                (if wildcard
@@ -3041,10 +3124,13 @@ If WILDCARD, it also runs the shell specified by `shell-file-name'."
                            (append list
                                    ;; Avoid lossage if FILE starts with `-'.
                                    '("--")
-                                   (list
-                                    (if full-directory-p
-                                        (concat (file-name-as-directory file) ".")
-                                      file))))))))
+                                   (progn
+                                     (if (string-match "\\`~" file)
+                                         (setq file (expand-file-name file)))
+                                     (list
+                                      (if full-directory-p
+                                          (concat (file-name-as-directory file) ".")
+                                        file)))))))))
          (if (/= result 0)
              ;; We get here if ls failed.
              ;; Access the file to get a suitable error.