remove sigio blocking

[bpt/emacs.git] / lisp / dired-aux.el

diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index afa0e32..bb93cce 100644 (file)
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -1,10 +1,10 @@
 ;;; dired-aux.el --- less commonly used parts of dired
 
 ;;; dired-aux.el --- less commonly used parts of dired
 

-;; Copyright (C) 1985-1986, 1992, 1994, 1998, 2000-2012
+;; Copyright (C) 1985-1986, 1992, 1994, 1998, 2000-2014

 ;;   Free Software Foundation, Inc.
 
 ;; Author: Sebastian Kremer <sk@thp.uni-koeln.de>.
 ;;   Free Software Foundation, Inc.
 
 ;; Author: Sebastian Kremer <sk@thp.uni-koeln.de>.

-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org

 ;; Keywords: files
 ;; Package: emacs
 
 ;; Keywords: files
 ;; Package: emacs
 


@@ -55,7 +55,8 @@ into this list; they also should call `dired-log' to log the errors.")
 (defun dired-diff (file &optional switches)
   "Compare file at point with file FILE using `diff'.
 If called interactively, prompt for FILE.  If the file at point
 (defun dired-diff (file &optional switches)
   "Compare file at point with file FILE using `diff'.
 If called interactively, prompt for FILE.  If the file at point

-has a backup file, use that as the default.  If the mark is active
+has a backup file, use that as the default.  If the file at point
+is a backup file, use its original.  If the mark is active

 in Transient Mark mode, use the file at the mark as the default.
 \(That's the mark set by \\[set-mark-command], not by Dired's
 \\[dired-mark] command.)
 in Transient Mark mode, use the file at the mark as the default.
 \(That's the mark set by \\[set-mark-command], not by Dired's
 \\[dired-mark] command.)


@@ -67,8 +68,10 @@ With prefix arg, prompt for second argument SWITCHES, which is
 the string of command switches for the third argument of `diff'."
   (interactive
    (let* ((current (dired-get-filename t))
 the string of command switches for the third argument of `diff'."
   (interactive
    (let* ((current (dired-get-filename t))

-         ;; Get the latest existing backup file.
-         (oldf (diff-latest-backup-file current))
+         ;; Get the latest existing backup file or its original.
+         (oldf (if (backup-file-name-p current)
+                   (file-name-sans-versions current)
+                 (diff-latest-backup-file current)))

          ;; Get the file at the mark.
          (file-at-mark (if (and transient-mark-mode mark-active)
                            (save-excursion (goto-char (mark t))
          ;; Get the file at the mark.
          (file-at-mark (if (and transient-mark-mode mark-active)
                            (save-excursion (goto-char (mark t))


@@ -107,7 +110,10 @@ the string of command switches for the third argument of `diff'."
                   (equal (expand-file-name current file)
                          (expand-file-name current))))
       (error "Attempt to compare the file to itself"))
                   (equal (expand-file-name current file)
                          (expand-file-name current))))
       (error "Attempt to compare the file to itself"))

-    (diff file current switches)))
+    (if (and (backup-file-name-p current)
+            (equal file (file-name-sans-versions current)))
+       (diff current file switches)
+      (diff file current switches))))

 
 ;;;###autoload
 (defun dired-backup-diff (&optional switches)
 
 ;;;###autoload
 (defun dired-backup-diff (&optional switches)


@@ -209,19 +215,24 @@ condition.  Two file items are considered to match if they are equal
       (dolist (file1 list1)
        (unless (let ((list list2))
                  (while (and list
       (dolist (file1 list1)
        (unless (let ((list list2))
                  (while (and list

-                             (not (let* ((file2 (car list))
-                                         (fa1 (car (cddr file1)))
-                                         (fa2 (car (cddr file2)))
-                                         (size1 (nth 7 fa1))
-                                         (size2 (nth 7 fa2))
-                                         (mtime1 (float-time (nth 5 fa1)))
-                                         (mtime2 (float-time (nth 5 fa2))))
-                                    (and
-                                     (equal (car file1) (car file2))
-                                     (not (eval predicate))))))
+                             (let* ((file2 (car list))
+                                     (fa1 (car (cddr file1)))
+                                     (fa2 (car (cddr file2))))
+                                (or
+                                 (not (equal (car file1) (car file2)))
+                                 (eval predicate
+                                       `((fa1 . ,fa1)
+                                         (fa2 . ,fa2)
+                                         (size1 . ,(nth 7 fa1))
+                                         (size2 . ,(nth 7 fa2))
+                                         (mtime1
+                                          . ,(float-time (nth 5 fa1)))
+                                         (mtime2
+                                          . ,(float-time (nth 5 fa2)))
+                                         )))))

                    (setq list (cdr list)))
                  list)
                    (setq list (cdr list)))
                  list)

-         (setq res (cons file1 res))))
+         (push file1 res)))

       (nreverse res))))
 
 (defun dired-files-attributes (dir)
       (nreverse res))))
 
 (defun dired-files-attributes (dir)


@@ -280,7 +291,7 @@ List has a form of (file-name full-file-name (attribute-list))."
                                (if (eq op-symbol 'touch)
                                    (list "-t" new-attribute)
                                  (list new-attribute)))
                                (if (eq op-symbol 'touch)
                                    (list "-t" new-attribute)
                                  (list new-attribute)))

-                             (if (string-match "gnu" system-configuration)
+                             (if (string-match-p "gnu" system-configuration)

                                  '("--") nil))
                             files))
     (dired-do-redisplay arg);; moves point if ARG is an integer
                                  '("--") nil))
                             files))
     (dired-do-redisplay arg);; moves point if ARG is an integer


@@ -321,7 +332,7 @@ into the minibuffer."
           ;; We used to treat empty input as DEFAULT, but that is not
           ;; such a good idea (Bug#9361).
           (error "No file mode specified"))
           ;; We used to treat empty input as DEFAULT, but that is not
           ;; such a good idea (Bug#9361).
           (error "No file mode specified"))

-         ((string-match "^[0-7]+" modes)
+         ((string-match-p "^[0-7]+" modes)

           (setq num-modes (string-to-number modes 8))))
 
     (dolist (file files)
           (setq num-modes (string-to-number modes 8))))
 
     (dolist (file files)


@@ -409,6 +420,12 @@ Uses the shell command coming from variables `lpr-command' and
 `lpr-switches' as default."
   (interactive "P")
   (let* ((file-list (dired-get-marked-files t arg))
 `lpr-switches' as default."
   (interactive "P")
   (let* ((file-list (dired-get-marked-files t arg))

+        (lpr-switches
+         (if (and (stringp printer-name)
+                  (string< "" printer-name))
+             (cons (concat lpr-printer-switch printer-name)
+                   lpr-switches)
+           lpr-switches))

         (command (dired-mark-read-string
                   "Print %s with: "
                   (mapconcat 'identity
         (command (dired-mark-read-string
                   "Print %s with: "
                   (mapconcat 'identity


@@ -494,7 +511,7 @@ with a prefix argument."
       (goto-char (point-min))
       (while (not (eobp))
        (save-excursion
       (goto-char (point-min))
       (while (not (eobp))
        (save-excursion

-         (and (not (looking-at dired-re-dir))
+         (and (not (looking-at-p dired-re-dir))

               (not (eolp))
               (setq file (dired-get-filename nil t)) ; nil on non-file
               (progn (end-of-line)
               (not (eolp))
               (setq file (dired-get-filename nil t)) ; nil on non-file
               (progn (end-of-line)


@@ -524,7 +541,7 @@ with a prefix argument."
                        dired-file-version-alist)))))))
 
 (defun dired-trample-file-versions (fn)
                        dired-file-version-alist)))))))
 
 (defun dired-trample-file-versions (fn)

-  (let* ((start-vn (string-match "\\.~[0-9]+~$" fn))
+  (let* ((start-vn (string-match-p "\\.~[0-9]+~$" fn))

         base-version-list)
     (and start-vn
         (setq base-version-list        ; there was a base version to which
         base-version-list)
     (and start-vn
         (setq base-version-list        ; there was a base version to which


@@ -596,7 +613,7 @@ The output appears in the buffer `*Async Shell Command*'."
       (dired-read-shell-command "& on %s: " current-prefix-arg files)
       current-prefix-arg
       files)))
       (dired-read-shell-command "& on %s: " current-prefix-arg files)
       current-prefix-arg
       files)))

-  (unless (string-match "&[ \t]*\\'" command)
+  (unless (string-match-p "&[ \t]*\\'" command)

     (setq command (concat command " &")))
   (dired-do-shell-command command arg file-list))
 
     (setq command (concat command " &")))
   (dired-do-shell-command command arg file-list))
 


@@ -657,10 +674,10 @@ can be produced by `dired-get-marked-files', for example."
       (dired-read-shell-command "! on %s: " current-prefix-arg files)
       current-prefix-arg
       files)))
       (dired-read-shell-command "! on %s: " current-prefix-arg files)
       current-prefix-arg
       files)))

-  (let* ((on-each (not (string-match dired-star-subst-regexp command)))
-        (no-subst (not (string-match dired-quark-subst-regexp command)))
-        (star (string-match "\\*" command))
-        (qmark (string-match "\\?" command)))
+  (let* ((on-each (not (string-match-p dired-star-subst-regexp command)))
+        (no-subst (not (string-match-p dired-quark-subst-regexp command)))
+        (star (string-match-p "\\*" command))
+        (qmark (string-match-p "\\?" command)))

     ;; Get confirmation for wildcards that may have been meant
     ;; to control substitution of a file name or the file name list.
     (if (cond ((not (or on-each no-subst))
     ;; Get confirmation for wildcards that may have been meant
     ;; to control substitution of a file name or the file name list.
     (if (cond ((not (or on-each no-subst))


@@ -707,8 +724,8 @@ can be produced by `dired-get-marked-files', for example."
                      (substring command 0 (match-beginning 0))
                    command))
         (stuff-it
                      (substring command 0 (match-beginning 0))
                    command))
         (stuff-it

-         (if (or (string-match dired-star-subst-regexp command)
-                 (string-match dired-quark-subst-regexp command))
+         (if (or (string-match-p dired-star-subst-regexp command)
+                 (string-match-p dired-quark-subst-regexp command))

              (lambda (x)
                (let ((retval command))
                  (while (string-match
              (lambda (x)
                (let ((retval command))
                  (while (string-match


@@ -834,9 +851,7 @@ command with a prefix argument (the value does not matter)."
     (if new-file
        (let ((start (point)))
          ;; Remove any preexisting entry for the name NEW-FILE.
     (if new-file
        (let ((start (point)))
          ;; Remove any preexisting entry for the name NEW-FILE.

-         (condition-case nil
-             (dired-remove-entry new-file)
-           (error nil))
+         (ignore-errors (dired-remove-entry new-file))

          (goto-char start)
          ;; Now replace the current line with an entry for NEW-FILE.
          (dired-update-file-line new-file) nil)
          (goto-char start)
          ;; Now replace the current line with an entry for NEW-FILE.
          (dired-update-file-line new-file) nil)


@@ -1137,16 +1152,16 @@ files matching `dired-omit-regexp'."
          ;; Avoid calling ls for files that are going to be omitted anyway.
          (let ((omit-re (dired-omit-regexp)))
            (or (string= omit-re "")
          ;; Avoid calling ls for files that are going to be omitted anyway.
          (let ((omit-re (dired-omit-regexp)))
            (or (string= omit-re "")

-               (not (string-match omit-re
-                                  (cond
-                                   ((eq 'no-dir dired-omit-localp)
-                                    filename)
-                                   ((eq t dired-omit-localp)
-                                    (dired-make-relative filename))
-                                   (t
-                                    (dired-make-absolute
-                                     filename
-                                     (file-name-directory filename)))))))))
+               (not (string-match-p omit-re
+                                    (cond
+                                     ((eq 'no-dir dired-omit-localp)
+                                      filename)
+                                     ((eq t dired-omit-localp)
+                                      (dired-make-relative filename))
+                                     (t
+                                      (dired-make-absolute
+                                       filename
+                                       (file-name-directory filename)))))))))

       ;; Do it!
       (progn
        (setq filename (directory-file-name filename))
       ;; Do it!
       (progn
        (setq filename (directory-file-name filename))


@@ -1174,7 +1189,7 @@ files matching `dired-omit-regexp'."
                    ;; else try to find correct place to insert
                    (if (dired-goto-subdir directory)
                        (progn ;; unhide if necessary
                    ;; else try to find correct place to insert
                    (if (dired-goto-subdir directory)
                        (progn ;; unhide if necessary

-                         (if (looking-at "\r")
+                         (if (looking-at-p "\r")

                              ;; Point is at end of subdir line.
                              (dired-unhide-subdir))
                          ;; found - skip subdir and `total' line
                              ;; Point is at end of subdir line.
                              (dired-unhide-subdir))
                          ;; found - skip subdir and `total' line


@@ -1333,9 +1348,7 @@ Special value `always' suppresses confirmation."
             (eq t (car attrs))
             (or (eq recursive 'always)
                 (yes-or-no-p (format "Recursive copies of %s? " from))))
             (eq t (car attrs))
             (or (eq recursive 'always)
                 (yes-or-no-p (format "Recursive copies of %s? " from))))

-       ;; This is a directory.

        (copy-directory from to preserve-time)
        (copy-directory from to preserve-time)

-      ;; Not a directory.

       (or top (dired-handle-overwrite to))
       (condition-case err
          (if (stringp (car attrs))
       (or top (dired-handle-overwrite to))
       (condition-case err
          (if (stringp (car attrs))


@@ -1913,8 +1926,9 @@ Type SPC or `y' to %s one match, DEL or `n' to skip to next,
         (arg
          (if whole-name nil current-prefix-arg))
         (regexp
         (arg
          (if whole-name nil current-prefix-arg))
         (regexp

-         (dired-read-regexp
-          (concat (if whole-name "Abs. " "") operation " from (regexp): ")))
+         (read-regexp
+          (concat (if whole-name "Abs. " "") operation " from (regexp): ")
+          nil 'dired-regexp-history))

         (newname
          (read-string
           (concat (if whole-name "Abs. " "") operation " " regexp " to: "))))
         (newname
          (read-string
           (concat (if whole-name "Abs. " "") operation " " regexp " to: "))))


@@ -2084,7 +2098,7 @@ This function takes some pains to conform to `ls -lR' output."
     (and (not switches) cons (setq switches (cdr cons)))
     (dired-insert-subdir-validate dirname switches)
     ;; case-fold-search is nil now, so we can test for capital `R':
     (and (not switches) cons (setq switches (cdr cons)))
     (dired-insert-subdir-validate dirname switches)
     ;; case-fold-search is nil now, so we can test for capital `R':

-    (if (setq switches-have-R (and switches (string-match "R" switches)))
+    (if (setq switches-have-R (and switches (string-match-p "R" switches)))

        ;; avoid duplicated subdirs
        (setq mark-alist (dired-kill-tree dirname t)))
     (if elt
        ;; avoid duplicated subdirs
        (setq mark-alist (dired-kill-tree dirname t)))
     (if elt


@@ -2122,8 +2136,8 @@ This function takes some pains to conform to `ls -lR' output."
        (mapcar
         (function
          (lambda (x)
        (mapcar
         (function
          (lambda (x)

-           (or (eq (null (string-match x real-switches))
-                   (null (string-match x dired-actual-switches)))
+           (or (eq (null (string-match-p x real-switches))
+                   (null (string-match-p x dired-actual-switches)))

                (error
                 "Can't have dirs with and without -%s switches together" x))))
         ;; all switches that make a difference to dired-get-filename:
                (error
                 "Can't have dirs with and without -%s switches together" x))))
         ;; all switches that make a difference to dired-get-filename:


@@ -2164,7 +2178,7 @@ of marked files.  If KILL-ROOT is non-nil, kill DIRNAME as well."
 (defun dired-insert-subdir-newpos (new-dir)
   ;; Find pos for new subdir, according to tree order.
   ;;(goto-char (point-max))
 (defun dired-insert-subdir-newpos (new-dir)
   ;; Find pos for new subdir, according to tree order.
   ;;(goto-char (point-max))

-  (let ((alist dired-subdir-alist) elt dir pos new-pos)
+  (let ((alist dired-subdir-alist) elt dir new-pos)

     (while alist
       (setq elt (car alist)
            alist (cdr alist)
     (while alist
       (setq elt (car alist)
            alist (cdr alist)


@@ -2415,7 +2429,7 @@ Lower levels are unaffected."
   (and selective-display
        (save-excursion
         (dired-goto-subdir dir)
   (and selective-display
        (save-excursion
         (dired-goto-subdir dir)

-        (looking-at "\r"))))
+        (looking-at-p "\r"))))

 
 ;;;###autoload
 (defun dired-hide-subdir (arg)
 
 ;;;###autoload
 (defun dired-hide-subdir (arg)


@@ -2485,20 +2499,21 @@ a file name.  Otherwise, it searches the whole buffer without restrictions."
   :group 'dired
   :version "23.1")
 
   :group 'dired
   :version "23.1")
 

-(defvar dired-isearch-filter-predicate-orig nil)
-
-(defun dired-isearch-filenames-toggle ()
+(define-minor-mode dired-isearch-filenames-mode

   "Toggle file names searching on or off.
 When on, Isearch skips matches outside file names using the predicate
 `dired-isearch-filter-filenames' that matches only at file names.
 When off, it uses the original predicate."
   "Toggle file names searching on or off.
 When on, Isearch skips matches outside file names using the predicate
 `dired-isearch-filter-filenames' that matches only at file names.
 When off, it uses the original predicate."

-  (interactive)
-  (setq isearch-filter-predicate
-       (if (eq isearch-filter-predicate 'dired-isearch-filter-filenames)
-           dired-isearch-filter-predicate-orig
-         'dired-isearch-filter-filenames))
-  (setq isearch-success t isearch-adjusted t)
-  (isearch-update))
+  nil nil nil
+  (if dired-isearch-filenames-mode
+      (add-function :before-while (local 'isearch-filter-predicate)
+                  #'dired-isearch-filter-filenames
+                  '((isearch-message-prefix . "filename ")))
+    (remove-function (local 'isearch-filter-predicate)
+                     #'dired-isearch-filter-filenames))
+  (when isearch-mode
+    (setq isearch-success t isearch-adjusted t)
+    (isearch-update)))

 
 ;;;###autoload
 (defun dired-isearch-filenames-setup ()
 
 ;;;###autoload
 (defun dired-isearch-filenames-setup ()


@@ -2507,43 +2522,36 @@ Intended to be added to `isearch-mode-hook'."
   (when (or (eq dired-isearch-filenames t)
            (and (eq dired-isearch-filenames 'dwim)
                 (get-text-property (point) 'dired-filename)))
   (when (or (eq dired-isearch-filenames t)
            (and (eq dired-isearch-filenames 'dwim)
                 (get-text-property (point) 'dired-filename)))

-    (setq isearch-message-prefix-add "filename ")
-    (define-key isearch-mode-map "\M-sf" 'dired-isearch-filenames-toggle)
-    (setq dired-isearch-filter-predicate-orig
-         (default-value 'isearch-filter-predicate))
-    (setq-default isearch-filter-predicate 'dired-isearch-filter-filenames)
+    (define-key isearch-mode-map "\M-sff" 'dired-isearch-filenames-mode)
+    (dired-isearch-filenames-mode 1)

     (add-hook 'isearch-mode-end-hook 'dired-isearch-filenames-end nil t)))
 
 (defun dired-isearch-filenames-end ()
   "Clean up the Dired file name search after terminating isearch."
     (add-hook 'isearch-mode-end-hook 'dired-isearch-filenames-end nil t)))
 
 (defun dired-isearch-filenames-end ()
   "Clean up the Dired file name search after terminating isearch."

-  (setq isearch-message-prefix-add nil)
-  (define-key isearch-mode-map "\M-sf" nil)
-  (setq-default isearch-filter-predicate dired-isearch-filter-predicate-orig)
+  (define-key isearch-mode-map "\M-sff" nil)
+  (dired-isearch-filenames-mode -1)

   (remove-hook 'isearch-mode-end-hook 'dired-isearch-filenames-end t))
 
 (defun dired-isearch-filter-filenames (beg end)
   (remove-hook 'isearch-mode-end-hook 'dired-isearch-filenames-end t))
 
 (defun dired-isearch-filter-filenames (beg end)

-  "Test whether the current search hit is a visible file name.
+  "Test whether the current search hit is a file name.

 Return non-nil if the text from BEG to END is part of a file
 Return non-nil if the text from BEG to END is part of a file

-name (has the text property `dired-filename') and is visible."
-  (and (isearch-filter-visible beg end)
-       (if dired-isearch-filenames
-          (text-property-not-all (min beg end) (max beg end)
-                                 'dired-filename nil)
-        t)))
+name (has the text property `dired-filename')."
+  (text-property-not-all (min beg end) (max beg end)
+                        'dired-filename nil))

 
 ;;;###autoload
 (defun dired-isearch-filenames ()
   "Search for a string using Isearch only in file names in the Dired buffer."
   (interactive)
   (let ((dired-isearch-filenames t))
 
 ;;;###autoload
 (defun dired-isearch-filenames ()
   "Search for a string using Isearch only in file names in the Dired buffer."
   (interactive)
   (let ((dired-isearch-filenames t))

-    (isearch-forward)))
+    (isearch-forward nil t)))

 
 ;;;###autoload
 (defun dired-isearch-filenames-regexp ()
   "Search for a regexp using Isearch only in file names in the Dired buffer."
   (interactive)
   (let ((dired-isearch-filenames t))
 
 ;;;###autoload
 (defun dired-isearch-filenames-regexp ()
   "Search for a regexp using Isearch only in file names in the Dired buffer."
   (interactive)
   (let ((dired-isearch-filenames t))

-    (isearch-forward-regexp)))
+    (isearch-forward-regexp nil t)))

 
 \f
 ;; Functions for searching in tags style among marked files.
 
 \f
 ;; Functions for searching in tags style among marked files.