* dired.el (dired-goto-file): Recognize absolute file name listings.

(dired-goto-file-1): New helper function.
(dired-toggle-read-only): Inhibit warnings.

Fixes: debbugs:7126

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 0684afde475229ea73412e743d9a163a6116fd9f..4419099388717de4b58a7b375d927284931a4f2f 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,10 @@
+2012-03-10  Chong Yidong  <cyd@gnu.org>
+
+       * dired.el (dired-goto-file): Recognize absolute file name
+       listings (Bug#7126).
+       (dired-goto-file-1): New helper function.
+       (dired-toggle-read-only): Inhibit warnings.
+
 2012-03-09  Michael Albinus  <michael.albinus@gmx.de>
 
        * net/dbus.el: (dbus-property-handler): Return empty array if

diff --git a/lisp/dired.el b/lisp/dired.el
index 57bf3c88322011ff745fa7bbdd570af0143980dd..d26e7004cc3ba52c7916d54ac8bdc8cc54f8b8ff 100644 (file)
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -1964,7 +1964,8 @@ Otherwise, for buffers inheriting from dired-mode, call `toggle-read-only'."
   (interactive)
   (if (eq major-mode 'dired-mode)
       (wdired-change-to-wdired-mode)
-    (toggle-read-only)))
+    (with-no-warnings
+      (toggle-read-only))))
 
 (defun dired-next-line (arg)
   "Move down lines then position at filename.
@@ -2622,58 +2623,61 @@ instead of `dired-actual-switches'."
              (read-file-name "Goto file: "
                              (dired-current-directory))))
      (push-mark)))
-  (setq file (directory-file-name file)) ; does no harm if no directory
-  (let (found case-fold-search dir)
-    (setq dir (or (file-name-directory file)
-                 (error "File name `%s' is not absolute" file)))
-    (save-excursion
-      ;; The hair here is to get the result of dired-goto-subdir
-      ;; without really calling it if we don't have any subdirs.
-      (if (if (string= dir (expand-file-name default-directory))
-             (goto-char (point-min))
-           (and (cdr dired-subdir-alist)
-                (dired-goto-subdir dir)))
-         (let ((base (file-name-nondirectory file))
-               search-string
-               (boundary (dired-subdir-max)))
-           (setq search-string
-                 (replace-regexp-in-string "\^m" "\\^m" base nil t))
-           (setq search-string
-                 (replace-regexp-in-string "\\\\" "\\\\" search-string nil t))
-           (and (dired-switches-escape-p dired-actual-switches)
-                (string-match "[ \t\n]" search-string)
-                ;; FIXME to fix this for all possible file names
-                ;; (embedded control characters etc), we need to
-                ;; escape everything that `ls -b' does.
-                (setq search-string
-                      (replace-regexp-in-string " " "\\ "
-                                                search-string nil t)
-                      search-string
-                      (replace-regexp-in-string "\t" "\\t"
-                                                search-string nil t)
-                      search-string
-                      (replace-regexp-in-string "\n" "\\n"
-                                                search-string nil t)))
-           (while (and (not found)
-                       ;; filenames are preceded by SPC, this makes
-                       ;; the search faster (e.g. for the filename "-"!).
-                       (search-forward (concat " " search-string)
-                                       boundary 'move))
-             ;; Match could have BASE just as initial substring or
-             ;; or in permission bits or date or
-             ;; not be a proper filename at all:
-             (if (equal base (dired-get-filename 'no-dir t))
-                   ;; Must move to filename since an (actually
-                   ;; correct) match could have been elsewhere on the
-                   ;; ;; line (e.g. "-" would match somewhere in the
-                   ;; permission bits).
-                 (setq found (dired-move-to-filename))
-               ;; If this isn't the right line, move forward to avoid
-               ;; trying this line again.
-               (forward-line 1))))))
-    (and found
-        ;; return value of point (i.e., FOUND):
-        (goto-char found))))
+  (unless (file-name-absolute-p file)
+    (error "File name `%s' is not absolute" file))
+  (setq file (directory-file-name file)) ; does no harm if not a directory
+  (let* ((case-fold-search nil)
+        (dir (file-name-directory file))
+        (found (or
+                ;; First, look for a listing under the absolute name.
+                (save-excursion
+                  (goto-char (point-min))
+                  (dired-goto-file-1 file file (point-max)))
+                ;; Otherwise, look for it as a relative name.  The
+                ;; hair is to get the result of `dired-goto-subdir'
+                ;; without calling it if we don't have any subdirs.
+                (save-excursion
+                  (when (if (string= dir (expand-file-name default-directory))
+                            (goto-char (point-min))
+                          (and (cdr dired-subdir-alist)
+                               (dired-goto-subdir dir)))
+                    (dired-goto-file-1 (file-name-nondirectory file)
+                                       file
+                                       (dired-subdir-max)))))))
+    ;; Return buffer position, if found.
+    (if found
+       (goto-char found))))
+
+(defun dired-goto-file-1 (file full-name limit)
+  "Advance to the Dired listing labeled by FILE; return its position.
+Return nil if the listing is not found.  If FILE contains
+characters that would not appear in a Dired buffer, search using
+the quoted forms of those characters.
+
+FULL-NAME specifies the actual file name the listing must have,
+as returned by `dired-get-filename'.  LIMIT is the search limit."
+  (let (str)
+    (setq str (replace-regexp-in-string "\^m" "\\^m"  file nil t))
+    (setq str (replace-regexp-in-string "\\\\" "\\\\" str nil t))
+    (and (dired-switches-escape-p dired-actual-switches)
+        (string-match "[ \t\n]" str)
+        ;; FIXME: to fix this for embedded control characters etc, we
+        ;; should escape everything that `ls -b' does.
+        (setq str (replace-regexp-in-string " " "\\ "  str nil t)
+              str (replace-regexp-in-string "\t" "\\t" str nil t)
+              str (replace-regexp-in-string "\n" "\\n" str nil t)))
+    (let ((found nil)
+         ;; filenames are preceded by SPC, this makes the search faster
+         ;; (e.g. for the filename "-").
+         (search-string (concat " " str)))
+      (while (and (not found)
+                 (search-forward search-string limit 'move))
+       ;; Check that we are in the right place.  Match could have
+       ;; BASE just as initial substring or in permission bits etc.
+       (if (equal full-name (dired-get-filename nil t))
+           (setq found (dired-move-to-filename))
+         (forward-line 1)))
+      found)))
 
 (defvar dired-find-subdir)