]> code.delx.au - gnu-emacs/blobdiff - lisp/dired.el
*** empty log message ***
[gnu-emacs] / lisp / dired.el
index 3d3fd34b5ac5d61afcc4a8c99134c18587e95a73..037bf282eda5b30a329784b7f9230744cd7adea9 100644 (file)
@@ -1,7 +1,7 @@
 ;;; dired.el --- directory-browsing commands
 
-;; Copyright (C) 1985, 86, 92, 93, 94, 95, 96, 97, 2000, 01, 03, 2004
-;;  Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1986, 1992, 1993, 1994, 1995, 1996, 1997, 2000,
+;;   2001, 2003, 2004  Free Software Foundation, Inc.
 
 ;; Author: Sebastian Kremer <sk@thp.uni-koeln.de>
 ;; Maintainer: FSF
@@ -202,10 +202,11 @@ with the buffer narrowed to the listing."
 
 ;; Fixme: This should use mailcap.
 (defcustom dired-view-command-alist
-  '(("[.]\\(ps\\|ps_pages\\|eps\\)\\'" . "gv -spartan -color -watch %s")
-    ("[.]pdf\\'" . "xpdf %s")
-    ("[.]\\(jpe?g\\|gif\\|png\\)\\'" . "eog %s")
-    ("[.]dvi\\'" . "xdvi -sidemargin 0.5 -topmargin 1 %s"))
+  '(("\\.\\(ps\\|ps_pages\\|eps\\)\\'" . "gv %s")
+    ("\\.pdf\\'" . "xpdf %s")
+    ;; ("\\.pod\\'" . "perldoc %s")
+    ("\\.\\(jpe?g\\|gif\\|png\\)\\'" . "eog %s")
+    ("\\.dvi\\'" . "xdvi %s"))
   "Alist specifying how to view special types of files.
 Each element has the form (REGEXP . SHELL-COMMAND).
 When the file name matches REGEXP, `dired-view-file'
@@ -545,8 +546,14 @@ Optional third argument FILTER, if non-nil, is a function to select
            (if current-prefix-arg
                (read-string "Dired listing switches: "
                             dired-listing-switches))
-           (read-file-name (format "Dired %s(directory): " str)
-                           nil default-directory nil))))
+           ;; If a dialog is about to be used, call read-directory-name so
+           ;; the dialog code knows we want directories.  Some dialogs can
+           ;; only select directories or files when popped up, not both.
+           (if (next-read-file-uses-dialog-p)
+               (read-directory-name (format "Dired %s(directory): " str)
+                                    nil default-directory nil)
+             (read-file-name (format "Dired %s(directory): " str)
+                             nil default-directory nil)))))
 
 ;;;###autoload (define-key ctl-x-map "d" 'dired)
 ;;;###autoload
@@ -620,8 +627,7 @@ If DIRNAME is already in a dired buffer, that buffer is used without refresh."
             (modtime (visited-file-modtime)))
         (or (eq modtime 0)
             (not (eq (car attributes) t))
-            (and (= (car (nth 5 attributes)) (car modtime))
-                 (= (nth 1 (nth 5 attributes)) (cdr modtime)))))))
+            (equal (nth 5 attributes) modtime)))))
 
 (defun dired-buffer-stale-p (&optional noconfirm)
   "Return non-nil if current dired buffer needs updating.
@@ -735,7 +741,7 @@ for a remote directory.  This feature is used by Auto Revert Mode."
 
 (defun dired-readin ()
   "Read in a new dired buffer.
-Differs from dired-insert-subdir in that it accepts
+Differs from `dired-insert-subdir' in that it accepts
 wildcards, erases the buffer, and builds the subdir-alist anew
 \(including making it buffer-local and clearing it first)."
 
@@ -798,6 +804,112 @@ wildcards, erases the buffer, and builds the subdir-alist anew
        (dired-insert-directory dir dired-actual-switches
                                file-list (not file-list) t)))))
 
+(defun dired-align-file (beg end)
+  "Align the fields of a file to the ones of surrounding lines.
+BEG..END is the line where the file info is located."
+  ;; Some versions of ls try to adjust the size of each field so as to just
+  ;; hold the largest element ("largest" in the current invocation, of
+  ;; course).  So when a single line is output, the size of each field is
+  ;; just big enough for that one output.  Thus when dired refreshes one
+  ;; line, the alignment if this line w.r.t the rest is messed up because
+  ;; the fields of that one line will generally be smaller.
+  ;;
+  ;; To work around this problem, we here add spaces to try and re-align the
+  ;; fields as needed.  Since this is purely aesthetic, it is of utmost
+  ;; importance that it doesn't mess up anything like
+  ;; `dired-move-to-filename'.  To this end, we limit ourselves to adding
+  ;; spaces only, and to only add them at places where there was already at
+  ;; least one space.  This way, as long as `dired-move-to-filename-regexp'
+  ;; always matches spaces with "*" or "+", we know we haven't made anything
+  ;; worse.  There is one spot where the exact number of spaces is
+  ;; important, which is just before the actual filename, so we refrain from
+  ;; adding spaces there (and within the filename as well, of course).
+  (save-excursion
+    (let (file file-col other other-col)
+      ;; Check the there is indeed a file, and that there is anoter adjacent
+      ;; file with which to align, and that additional spaces are needed to
+      ;; align the filenames.
+      (when (and (setq file (progn (goto-char beg)
+                                  (dired-move-to-filename nil end)))
+                (setq file-col (current-column))
+                (setq other
+                      (or (and (goto-char beg)
+                               (zerop (forward-line -1))
+                               (dired-move-to-filename))
+                          (and (goto-char beg)
+                               (zerop (forward-line 1))
+                               (dired-move-to-filename))))
+                (setq other-col (current-column))
+                (/= file other)
+                ;; Make sure there is some work left to do.
+                (> other-col file-col))
+       ;; If we've only looked at the line above, check to see if the line
+       ;; below exists as well and if so, align with the shorter one.
+       (when (and (< other file)
+                  (goto-char beg)
+                  (zerop (forward-line 1))
+                  (dired-move-to-filename))
+         (let ((alt-col (current-column)))
+           (when (< alt-col other-col)
+             (setq other-col alt-col)
+             (setq other (point)))))
+       ;; Keep positions uptodate when we insert stuff.
+       (if (> other file) (setq other (copy-marker other)))
+       (setq file (copy-marker file))
+       ;; Main loop.
+       (goto-char beg)
+       (skip-chars-forward " ")        ;Skip to the first field.
+       (while (and (> other-col file-col)
+                   ;; Don't touch anything just before (and after) the
+                   ;; beginning of the filename.
+                   (> file (point)))
+         ;; We're now just in front of a field, with a space behind us.
+         (let* ((curcol (current-column))
+                ;; Nums are right-aligned.
+                (num-align (looking-at "[0-9]"))
+                ;; Let's look at the other line, in the same column: we
+                ;; should be either near the end of the previous field, or
+                ;; in the space between that field and the next.
+                ;; [ Of course, it's also possible that we're already within
+                ;; the next field or even past it, but that's unlikely since
+                ;; other-col > file-col. ]
+                ;; Let's find the distance to the alignment-point (either
+                ;; the beginning or the end of the next field, depending on
+                ;; whether this field is left or right aligned).
+                (align-pt-offset
+                 (save-excursion
+                   (goto-char other)
+                   (move-to-column curcol)
+                   (when (looking-at
+                          (concat
+                           (if (eq (char-before) ?\ ) " *" "[^ ]* *")
+                           (if num-align "[0-9][^ ]*")))
+                     (- (match-end 0) (match-beginning 0)))))
+                ;; Now, the number of spaces to insert is align-pt-offset
+                ;; minus the distance to the equivalent point on the
+                ;; current line.
+                (spaces
+                 (if (not num-align)
+                     align-pt-offset
+                   (and align-pt-offset
+                        (save-excursion
+                          (skip-chars-forward "^ ")
+                          (- align-pt-offset (- (current-column) curcol)))))))
+           (when (and spaces (> spaces 0))
+             (setq file-col (+ spaces file-col))
+             (if (> file-col other-col)
+                 (setq spaces (- spaces (- file-col other-col))))
+             (insert-char ?\s spaces)
+             ;; Let's just make really sure we did not mess up.
+             (unless (save-excursion
+                       (eq (dired-move-to-filename) (marker-position file)))
+               ;; Damn!  We messed up: let's revert the change.
+               (delete-char (- spaces)))))
+         ;; Now skip to next field.
+         (skip-chars-forward "^ ") (skip-chars-forward " "))
+       (set-marker file nil)))))
+
+
 (defun dired-insert-directory (dir switches &optional file-list wildcard hdr)
   "Insert a directory listing of DIR, Dired style.
 Use SWITCHES to make the listings.
@@ -816,7 +928,10 @@ If HDR is non-nil, insert a header line with the directory name."
     ;; with the new value of dired-move-to-filename-regexp.
     (if file-list
        (dolist (f file-list)
-         (insert-directory f switches nil nil))
+         (let ((beg (point)))
+           (insert-directory f switches nil nil)
+           ;; Re-align fields, if necessary.
+           (dired-align-file beg (point))))
       (insert-directory dir switches wildcard (not wildcard)))
     ;; Quote certain characters, unless ls quoted them for us.
     (if (not (string-match "b" dired-actual-switches))
@@ -880,7 +995,8 @@ Must also be called after dired-actual-switches have changed.
 Should not fail even on completely garbaged buffers.
 Preserves old cursor, marks/flags, hidden-p."
   (widen)                              ; just in case user narrowed
-  (let ((opoint (point))
+  (let ((modflag (buffer-modified-p))
+       (opoint (point))
        (ofile (dired-get-filename nil t))
        (mark-alist nil)                ; save marked files
        (hidden-subdirs (dired-remember-hidden))
@@ -907,9 +1023,10 @@ Preserves old cursor, marks/flags, hidden-p."
     (save-excursion                    ; hide subdirs that were hidden
       (dolist (dir hidden-subdirs)
        (if (dired-goto-subdir dir)
-           (dired-hide-subdir 1)))))
+           (dired-hide-subdir 1))))
+    (unless modflag (restore-buffer-modified-p nil)))
   ;; outside of the let scope
-;;; Might as well not override the user if the user changed this.
+;;;  Might as well not override the user if the user changed this.
 ;;;  (setq buffer-read-only t)
   )
 
@@ -987,6 +1104,7 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST."
   (let ((map (make-keymap)))
     (suppress-keymap map)
     (define-key map [mouse-2] 'dired-mouse-find-file-other-window)
+    (define-key map [follow-link] 'mouse-face)
     ;; Commands to mark or flag certain categories of files
     (define-key map "#" 'dired-flag-auto-save-files)
     (define-key map "." 'dired-clean-directory)
@@ -1365,22 +1483,22 @@ again for the directory tree.
 Customization variables (rename this buffer and type \\[describe-variable] on each line
 for more info):
 
-  dired-listing-switches
-  dired-trivial-filenames
-  dired-shrink-to-fit
-  dired-marker-char
-  dired-del-marker
-  dired-keep-marker-rename
-  dired-keep-marker-copy
-  dired-keep-marker-hardlink
-  dired-keep-marker-symlink
+  `dired-listing-switches'
+  `dired-trivial-filenames'
+  `dired-shrink-to-fit'
+  `dired-marker-char'
+  `dired-del-marker'
+  `dired-keep-marker-rename'
+  `dired-keep-marker-copy'
+  `dired-keep-marker-hardlink'
+  `dired-keep-marker-symlink'
 
 Hooks (use \\[describe-variable] to see their documentation):
 
-  dired-before-readin-hook
-  dired-after-readin-hook
-  dired-mode-hook
-  dired-load-hook
+  `dired-before-readin-hook'
+  `dired-after-readin-hook'
+  `dired-mode-hook'
+  `dired-load-hook'
 
 Keybindings:
 \\{dired-mode-map}"
@@ -1391,7 +1509,7 @@ Keybindings:
   (dired-advertise)                    ; default-directory is already set
   (setq major-mode 'dired-mode
        mode-name "Dired"
-;;     case-fold-search nil
+       ;; case-fold-search nil
        buffer-read-only t
        selective-display t             ; for subdirectory hiding
        mode-line-buffer-identification
@@ -1707,7 +1825,7 @@ DIR must be a directory name, not a file name."
       (setq dir (expand-file-name dir)))
   (if (string-match (concat "^" (regexp-quote dir)) file)
       (substring file (match-end 0))
-;;; (or no-error
+;;;  (or no-error
 ;;;    (error "%s: not in directory tree growing at %s" file dir))
     file))
 \f
@@ -1761,6 +1879,8 @@ regardless of the language.")
 ;; Move to first char of filename on this line.
 ;; Returns position (point) or nil if no filename on this line."
 (defun dired-move-to-filename (&optional raise-error eol)
+  "Move to the beginning of the filename on the current line.
+Return the position of the beginning of the filename, or nil if none found."
   ;; This is the UNIX version.
   (or eol (setq eol (line-end-position)))
   (beginning-of-line)
@@ -1773,8 +1893,10 @@ regardless of the language.")
       (goto-char (match-end 0)))
      ((re-search-forward dired-permission-flags-regexp eol t)
       ;; Ha!  There *is* a file.  Our regexp-from-hell just failed to find it.
-      (funcall (if raise-error 'error 'message)
-              "Unrecognized line!  Check dired-move-to-filename-regexp"))
+      (if raise-error
+         (error "Unrecognized line!  Check dired-move-to-filename-regexp"))
+      (beginning-of-line)
+      nil)
      (raise-error
       (error "No file on this line")))))
 
@@ -1817,9 +1939,9 @@ regardless of the language.")
            (or no-error (error "No file on this line"))))
        ;; Move point to end of name:
        (if symlink
-           (if (search-forward " ->" eol t)
+           (if (search-forward " -> " eol t)
                (progn
-                 (forward-char -3)
+                 (forward-char -4)
                  (and used-F
                       dired-ls-F-marks-symlinks
                       (eq (preceding-char) ?@) ;; did ls really mark the link?
@@ -1884,7 +2006,7 @@ You can then feed the file name(s) to other commands with \\[yank]."
 ;; As a side effect, killed dired buffers for DIR are removed from
 ;; dired-buffers.
   (setq dir (file-name-as-directory dir))
-  (let ((alist dired-buffers) result elt buf pattern)
+  (let ((alist dired-buffers) result elt buf)
     (while alist
       (setq elt (car alist)
            buf (cdr elt))
@@ -2900,7 +3022,7 @@ Thus, use \\[backward-page] to find the beginning of a group of errors."
 ;; So anything that does not contain these is sort "by name".
 
 (defvar dired-ls-sorting-switches "SXU"
-  "String of `ls' switches \(single letters\) except `t' that influence sorting.
+  "String of `ls' switches \(single letters\) except \"t\" that influence sorting.
 
 This indicates to Dired which option switches to watch out for because they
 will change the sorting order behavior of `ls'.
@@ -3032,6 +3154,19 @@ To be called first in body of `dired-sort-other', etc."
 
 ;;;;  Drag and drop support
 
+(defcustom dired-recursive-copies nil
+  "*Decide whether recursive copies are allowed.
+nil means no recursive copies.
+`always' means copy recursively without asking.
+`top' means ask for each directory at top level.
+Anything else means ask for each directory."
+  :type '(choice :tag "Copy directories"
+                (const :tag "No recursive copies" nil)
+                (const :tag "Ask for each directory" t)
+                (const :tag "Ask for each top directory only" top)
+                (const :tag "Copy directories without asking" always))
+  :group 'dired)
+
 (defun dired-dnd-test-function (window action types)
   "The test function for drag and drop into dired buffers.
 WINDOW is where the mouse is when this function is called.  It may be a frame
@@ -3165,5 +3300,5 @@ Ask means pop up a menu for the user to select one of copy, move or link."
 
 (run-hooks 'dired-load-hook)           ; for your customizations
 
-;;; arch-tag: e1af7a8f-691c-41a0-aac1-ddd4d3c87517
+;; arch-tag: e1af7a8f-691c-41a0-aac1-ddd4d3c87517
 ;;; dired.el ends here