]> code.delx.au - gnu-emacs/blobdiff - lisp/files.el
(dired-do-create-files): On DOS/Windows, allow to
[gnu-emacs] / lisp / files.el
index 5015964928ffc2ad96da6b479ab8840d949d3ff8..b86b8d640040bb2314c3648e4a5d8b07415099aa 100644 (file)
@@ -141,14 +141,14 @@ Checks for files in `temporary-file-directory' or
                                        name 0 nil)))
             ;; Directory is under temporary-file-directory.
             (and (not (eq comp t))
-                 (< comp -1)))
+                 (< comp (- (length temporary-file-directory)))))
           (if small-temporary-file-directory
               (let ((comp (compare-strings small-temporary-file-directory
                                            0 nil
                                            name 0 nil)))
                 ;; Directory is under small-temporary-file-directory.
                 (and (not (eq comp t))
-                     (< comp -1)))))))
+                     (< comp (- (length small-temporary-file-directory)))))))))
 
 (defvar backup-enable-predicate 'normal-backup-enable-predicate
   "Predicate that looks at a file name and decides whether to make backups.
@@ -2676,7 +2676,7 @@ After saving the buffer, this function runs `after-save-hook'."
        (cond ((and tempsetmodes (not setmodes))
               ;; Change the mode back, after writing.
               (setq setmodes (file-modes buffer-file-name))
-              (set-file-modes buffer-file-name 511)))
+              (set-file-modes buffer-file-name (logior setmodes 128))))
        (write-region (point-min) (point-max)
                      buffer-file-name nil t buffer-file-truename)))
     setmodes))
@@ -3217,7 +3217,7 @@ See also `auto-save-file-name-p'."
            (let ((fn (file-name-nondirectory buffer-file-name)))
              (string-match "\\`\\([^.]+\\)\\(\\.\\(..?\\)?.?\\|\\)\\'" fn)
              (concat (file-name-directory buffer-file-name)
-                     "#" (match-string 1 fn) 
+                     "#" (match-string 1 fn)
                      "." (match-string 3 fn) "#"))
          (concat (file-name-directory filename)
                  "#"
@@ -3411,6 +3411,52 @@ and `list-directory-verbose-switches'."
        (let ((wildcard (not (file-directory-p dirname))))
          (insert-directory dirname switches wildcard (not wildcard)))))))
 
+(defun shell-quote-wildcard-pattern (pattern)
+  "Quote characters special to the shell in PATTERN, leave wildcards alone.
+
+PATTERN is assumed to represent a file-name wildcard suitable for the
+underlying filesystem.  For Unix and GNU/Linux, the characters from the
+set [ \\t\\n;<>&|()#$] are quoted with a backslash; for DOS/Windows, all
+the parts of the pattern which don't include wildcard characters are
+quoted with double quotes.
+Existing quote characters in PATTERN are left alone, so you can pass
+PATTERN that already quotes some of the special characters."
+  (save-match-data
+    (cond
+     ((memq system-type '(ms-dos windows-nt))
+      ;; DOS/Windows don't allow `"' in file names.  So if the
+      ;; argument has quotes, we can safely assume it is already
+      ;; quoted by the caller.
+      (if (or (string-match "[\"]" pattern)
+             ;; We quote [&()#$'] in case their shell is a port of a
+             ;; Unixy shell.  We quote [,=+] because stock DOS and
+             ;; Windows shells require that in some cases, such as
+             ;; passing arguments to batch files that use positional
+             ;; arguments like %1.
+             (not (string-match "[ \t;&()#$',=+]" pattern)))
+         pattern
+       (let ((result "\"")
+             (beg 0)
+             end)
+         (while (string-match "[*?]+" pattern beg)
+           (setq end (match-beginning 0)
+                 result (concat result (substring pattern beg end)
+                                "\""
+                                (substring pattern end (match-end 0))
+                                "\"")
+                 beg (match-end 0)))
+         (concat result (substring pattern beg) "\""))))
+     (t
+      (let ((beg 0))
+       (while (string-match "[ \t\n;<>&|()#$]" pattern beg)
+         (setq pattern
+               (concat (substring pattern 0 (match-beginning 0))
+                       "\\"
+                       (substring pattern (match-beginning 0)))
+               beg (1+ (match-end 0)))))
+      pattern))))
+  
+
 (defvar insert-directory-program "ls"
   "Absolute or relative name of the `ls' program used by `insert-directory'.")
 
@@ -3444,8 +3490,8 @@ This works by running a directory listing program
 whose name is in the variable `insert-directory-program'.
 If WILDCARD, it also runs the shell specified by `shell-file-name'."
   ;; We need the directory in order to find the right handler.
-  (let ((handler (find-file-name-handler (expand-file-name file)
-                                        'insert-directory)))
+  (let* ((file (expand-file-name file))
+         (handler (find-file-name-handler file 'insert-directory)))
     (if handler
        (funcall handler 'insert-directory file switches
                 wildcard full-directory-p)
@@ -3459,61 +3505,51 @@ If WILDCARD, it also runs the shell specified by `shell-file-name'."
               (coding-system-for-write coding-system-for-read)
               (result
                (if wildcard
-                   ;; Run ls in the directory of the file pattern we asked for.
-                   (let ((default-directory
-                           (if (file-name-absolute-p file)
-                               (file-name-directory file)
-                             (file-name-directory (expand-file-name file))))
-                         (pattern (file-name-nondirectory file))
-                         (beg 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.
-                     (while (string-match "[ \t\n;<>&|()#$]" pattern beg)
-                       (setq pattern
-                             (concat (substring pattern 0 (match-beginning 0))
-                                     "\\"
-                                     (substring pattern (match-beginning 0)))
-                             beg (1+ (match-end 0))))
-                     (call-process shell-file-name nil t nil
-                                   "-c" (concat "\\";; Disregard shell aliases!
-                                                insert-directory-program
-                                                " -d "
-                                                (if (stringp switches)
-                                                    switches
-                                                  (mapconcat 'identity switches " "))
-                                                " -- "
-                                                 pattern)))
+                   ;; Run ls in the directory of the file pattern we asked for
+                   (let ((default-directory (file-name-directory file))
+                         (pattern (file-name-nondirectory file)))
+                     (call-process
+                       shell-file-name nil t nil
+                       "-c" (concat (if (memq system-type '(ms-dos windows-nt))
+                                       ""
+                                     "\\") ; Disregard Unix shell aliases!
+                                    insert-directory-program
+                                    " -d "
+                                    (if (stringp switches)
+                                        switches
+                                        (mapconcat 'identity switches " "))
+                                    " -- "
+                                   ;; 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.
+                                    (shell-quote-wildcard-pattern pattern))))
                  ;; SunOS 4.1.3, SVr4 and others need the "." to list the
                  ;; directory if FILE is a symbolic link.
                  (apply 'call-process
                          insert-directory-program nil t nil
-                         (let (list)
-                           (if (listp switches)
-                               (setq list switches)
-                             (if (not (equal switches ""))
-                                 (progn
-                                   ;; Split the switches at any spaces
-                                   ;; so we can pass separate options as separate args.
-                                   (while (string-match " " switches)
-                                     (setq list (cons (substring switches 0 (match-beginning 0))
-                                                      list)
-                                           switches (substring switches (match-end 0))))
-                                   (setq list (nreverse (cons switches list))))))
-                           (append list
-                                   ;; Avoid lossage if FILE starts with `-'.
-                                   '("--")
-                                   (progn
-                                     (if (string-match "\\`~" file)
-                                         (setq file (expand-file-name file)))
-                                     (list
-                                      (if full-directory-p
-                                          (concat (file-name-as-directory file) ".")
-                                        file)))))))))
+                          (append
+                           (if (listp switches) switches
+                               (unless (equal switches "")
+                                 ;; Split the switches at any spaces so we can
+                                 ;; pass separate options as separate args.
+                                 (split-string switches)))
+                           ;; Avoid lossage if FILE starts with `-'.
+                           '("--")
+                           (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.
+             ;; We get here if `insert-directory-program' failed.
              ;; Access the file to get a suitable error.
              (access-file file "Reading directory")
            ;; Replace "total" with "used", to avoid confusion.
@@ -3534,7 +3570,7 @@ If WILDCARD, it also runs the shell specified by `shell-file-name'."
                      (forward-word -1)
                      (setq available (buffer-substring (point) end))))
                  (insert " available " available))))))))))
-                   
+
 (defvar kill-emacs-query-functions nil
   "Functions to call with no arguments to query about killing Emacs.
 If any of these functions returns nil, killing Emacs is cancelled.