aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorRichard M. Stallman2002-09-15 01:52:54 +0000
committerRichard M. Stallman2002-09-15 01:52:54 +0000
commit0b7bc76fbf1dd1e5d8fdf03690bbcb9306676885 (patch)
tree772c7b26b41a2f77a16f21b4c02fe833adecdbfa
parente5369aad6d4f5e8d022ad3b78fa82701c0473e01 (diff)
downloademacs-0b7bc76fbf1dd1e5d8fdf03690bbcb9306676885.tar.gz
emacs-0b7bc76fbf1dd1e5d8fdf03690bbcb9306676885.zip
(dired-use-ls-dired): New variable.
(dired-directory): Document the rules better. (dired-insert-headerline): Function deleted. (dired-revert): Pass no args to dired-readin. (dired-move-to-filename): First try using dired-filename property. (dired-move-to-end-of-filename): Likewise. (dired-why): Try to show the start of this page of warnings. (dired-log): Insert the buffer name at start of page, not end. (dired-log-summary): If just one failure, explain it in echo area. (dired-internal-noselect): Always set dired-directory, when buffer is not new. Pass dir-or-list, not dirname, to dired-mode. Call dired-readin with no args. Don't call dired-after-readin-hook here. (dired-find-buffer-nocreate): Expand dirname. Expand the dir from dired-directory to compare with dirname. (dired-readin): Take no args. Get the directory from dired-directory. Run dired-before-reading hook inside save-excursion. Run dired-after-readin-hook here. Don't make undo entries at all. Call dired-readin-insert with no args. Don't change indentation here. Don't insert headerline here. (dired-readin-insert): Take no args. Get dir and file-list from dired-directory. Call dired-insert-directory the new way. Don't insert "wildcard" info here. (dired-insert-directory): New arg FILE-LIST. First arg now DIR, always just the directory. This function fully handles setting up the buffer text: update indentation, insert headerline and "wildcard" info. Pass --dired arg if appropriate; put info in dired-filename props. Don't expand file names here.
-rw-r--r--lisp/dired.el384
1 files changed, 202 insertions, 182 deletions
diff --git a/lisp/dired.el b/lisp/dired.el
index eef78d94805..f0306d32d7a 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -1,6 +1,6 @@
1;;; dired.el --- directory-browsing commands 1;;; dired.el --- directory-browsing commands
2 2
3;; Copyright (C) 1985, 86, 92, 93, 94, 95, 96, 1997, 2000, 2001, 2002 3;; Copyright (C) 1985, 86, 92, 93, 94, 95, 96, 1997, 2000, 2001
4;; Free Software Foundation, Inc. 4;; Free Software Foundation, Inc.
5 5
6;; Author: Sebastian Kremer <sk@thp.uni-koeln.de> 6;; Author: Sebastian Kremer <sk@thp.uni-koeln.de>
@@ -72,6 +72,9 @@ some of the `ls' switches are not supported; see the doc string of
72 "/etc/chown")) 72 "/etc/chown"))
73 "Name of chown command (usually `chown' or `/etc/chown').") 73 "Name of chown command (usually `chown' or `/etc/chown').")
74 74
75(defvar dired-use-ls-dired (not (not (string-match "gnu" system-configuration)))
76 "Non-nil means Dired should use `ls --dired'.")
77
75(defvar dired-chmod-program "chmod" 78(defvar dired-chmod-program "chmod"
76 "Name of chmod command (usually `chmod').") 79 "Name of chmod command (usually `chmod').")
77 80
@@ -217,9 +220,10 @@ This is what the `do' commands look for and what the `mark' commands store.")
217(defvar dired-file-version-alist) 220(defvar dired-file-version-alist)
218 221
219(defvar dired-directory nil 222(defvar dired-directory nil
220 "The directory name or shell wildcard that was used as argument to `ls'. 223 "The directory name or wildcard spec that this Dired directory lists.
221Local to each dired buffer. May be a list, in which case the car is the 224Local to each dired buffer. May be a list, in which case the car is the
222directory name and the cdr is the actual files to list.") 225directory name and the cdr is the list of files to mention.
226The directory name must be absolute, but need not be fully expanded.")
223 227
224(defvar dired-actual-switches nil 228(defvar dired-actual-switches nil
225 "The value of `dired-listing-switches' used to make this buffer's text.") 229 "The value of `dired-listing-switches' used to make this buffer's text.")
@@ -420,9 +424,6 @@ Optional third argument FILTER, if non-nil, is a function to select
420 (push file result))) 424 (push file result)))
421 result))) 425 result)))
422 426
423;; Function dired-ls is redefinable for VMS, ange-ftp, Prospero or
424;; other special applications.
425
426;; The dired command 427;; The dired command
427 428
428(defun dired-read-dir-and-switches (str) 429(defun dired-read-dir-and-switches (str)
@@ -511,14 +512,17 @@ If DIRNAME is already in a dired buffer, that buffer is used without refresh."
511 ;; like find-file does. 512 ;; like find-file does.
512 ;; Optional argument MODE is passed to dired-find-buffer-nocreate, 513 ;; Optional argument MODE is passed to dired-find-buffer-nocreate,
513 ;; see there. 514 ;; see there.
514 (let* ((dirname (if (consp dir-or-list) (car dir-or-list) dir-or-list)) 515 (let* (dirname
515 ;; The following line used to use dir-or-list. 516 buffer
516 ;; That never found an existing buffer, in the case
517 ;; where it is a list.
518 (buffer (dired-find-buffer-nocreate dirname mode))
519 ;; note that buffer already is in dired-mode, if found 517 ;; note that buffer already is in dired-mode, if found
520 (new-buffer-p (not buffer)) 518 new-buffer-p
521 (old-buf (current-buffer))) 519 (old-buf (current-buffer)))
520 (if (consp dir-or-list)
521 (setq dirname (car dir-or-list))
522 (setq dirname dir-or-list))
523 ;; Look for an existing buffer.
524 (setq buffer (dired-find-buffer-nocreate dirname mode)
525 new-buffer-p (null buffer))
522 (or buffer 526 (or buffer
523 (let ((default-major-mode 'fundamental-mode)) 527 (let ((default-major-mode 'fundamental-mode))
524 ;; We don't want default-major-mode to run hooks and set auto-fill 528 ;; We don't want default-major-mode to run hooks and set auto-fill
@@ -529,8 +533,7 @@ If DIRNAME is already in a dired buffer, that buffer is used without refresh."
529 (if (not new-buffer-p) ; existing buffer ... 533 (if (not new-buffer-p) ; existing buffer ...
530 (cond (switches ; ... but new switches 534 (cond (switches ; ... but new switches
531 ;; file list may have changed 535 ;; file list may have changed
532 (if (consp dir-or-list) 536 (setq dired-directory dir-or-list)
533 (setq dired-directory dir-or-list))
534 ;; this calls dired-revert 537 ;; this calls dired-revert
535 (dired-sort-other switches)) 538 (dired-sort-other switches))
536 ;; If directory has changed on disk, offer to revert. 539 ;; If directory has changed on disk, offer to revert.
@@ -553,21 +556,16 @@ If DIRNAME is already in a dired buffer, that buffer is used without refresh."
553 (file-name-directory dirname)) 556 (file-name-directory dirname))
554 (or switches (setq switches dired-listing-switches)) 557 (or switches (setq switches dired-listing-switches))
555 (if mode (funcall mode) 558 (if mode (funcall mode)
556 (dired-mode dirname switches)) 559 (dired-mode dir-or-list switches))
557 ;; default-directory and dired-actual-switches are set now 560 ;; default-directory and dired-actual-switches are set now
558 ;; (buffer-local), so we can call dired-readin: 561 ;; (buffer-local), so we can call dired-readin:
559 (let ((failed t)) 562 (let ((failed t))
560 (unwind-protect 563 (unwind-protect
561 (progn (dired-readin dir-or-list buffer) 564 (progn (dired-readin)
562 (setq failed nil)) 565 (setq failed nil))
563 ;; dired-readin can fail if parent directories are inaccessible. 566 ;; dired-readin can fail if parent directories are inaccessible.
564 ;; Don't leave an empty buffer around in that case. 567 ;; Don't leave an empty buffer around in that case.
565 (if failed (kill-buffer buffer)))) 568 (if failed (kill-buffer buffer))))
566 ;; No need to narrow since the whole buffer contains just
567 ;; dired-readin's output, nothing else. The hook can
568 ;; successfully use dired functions (e.g. dired-get-filename)
569 ;; as the subdir-alist has been built in dired-readin.
570 (run-hooks 'dired-after-readin-hook)
571 (goto-char (point-min)) 569 (goto-char (point-min))
572 (dired-initial-position dirname)) 570 (dired-initial-position dirname))
573 (set-buffer old-buf) 571 (set-buffer old-buf)
@@ -583,6 +581,7 @@ If DIRNAME is already in a dired buffer, that buffer is used without refresh."
583 ;; This differs from dired-buffers-for-dir in that it does not consider 581 ;; This differs from dired-buffers-for-dir in that it does not consider
584 ;; subdirs of default-directory and searches for the first match only. 582 ;; subdirs of default-directory and searches for the first match only.
585 ;; Also, the major mode must be MODE. 583 ;; Also, the major mode must be MODE.
584 (setq dirname (expand-file-name dirname))
586 (let (found (blist dired-buffers)) ; was (buffer-list) 585 (let (found (blist dired-buffers)) ; was (buffer-list)
587 (or mode (setq mode 'dired-mode)) 586 (or mode (setq mode 'dired-mode))
588 (while blist 587 (while blist
@@ -591,9 +590,11 @@ If DIRNAME is already in a dired buffer, that buffer is used without refresh."
591 (save-excursion 590 (save-excursion
592 (set-buffer (cdr (car blist))) 591 (set-buffer (cdr (car blist)))
593 (if (and (eq major-mode mode) 592 (if (and (eq major-mode mode)
594 (if (consp dired-directory) 593 (equal dirname
595 (equal (car dired-directory) dirname) 594 (expand-file-name
596 (equal dired-directory dirname))) 595 (if (consp dired-directory)
596 (car dired-directory)
597 dired-directory))))
597 (setq found (cdr (car blist)) 598 (setq found (cdr (car blist))
598 blist nil) 599 blist nil)
599 (setq blist (cdr blist)))))) 600 (setq blist (cdr blist))))))
@@ -605,40 +606,30 @@ If DIRNAME is already in a dired buffer, that buffer is used without refresh."
605;; dired-readin differs from dired-insert-subdir in that it accepts 606;; dired-readin differs from dired-insert-subdir in that it accepts
606;; wildcards, erases the buffer, and builds the subdir-alist anew 607;; wildcards, erases the buffer, and builds the subdir-alist anew
607;; (including making it buffer-local and clearing it first). 608;; (including making it buffer-local and clearing it first).
608(defun dired-readin (dir-or-list buffer) 609(defun dired-readin ()
609 ;; default-directory and dired-actual-switches must be buffer-local 610 ;; default-directory and dired-actual-switches must be buffer-local
610 ;; and initialized by now. 611 ;; and initialized by now.
611 ;; Thus we can test (equal default-directory dirname) instead of 612 (let (dirname)
612 ;; (file-directory-p dirname) and save a filesystem transaction. 613 (if (consp dired-directory)
613 ;; Also, we can run this hook which may want to modify the switches 614 (setq dirname (car dired-directory))
614 ;; based on default-directory, e.g. with ange-ftp to a SysV host 615 (setq dirname dired-directory))
615 ;; where ls won't understand -Al switches.
616 (let (dirname
617 (indent-tabs-mode nil))
618 (if (consp dir-or-list)
619 (setq dirname (car dir-or-list))
620 (setq dirname dir-or-list))
621 (setq dirname (expand-file-name dirname)) 616 (setq dirname (expand-file-name dirname))
622 (if (consp dir-or-list)
623 (setq dir-or-list (cons dirname (cdr dir-or-list))))
624 (run-hooks 'dired-before-readin-hook)
625 (save-excursion 617 (save-excursion
618 ;; This hook which may want to modify dired-actual-switches
619 ;; based on dired-directory, e.g. with ange-ftp to a SysV host
620 ;; where ls won't understand -Al switches.
621 (run-hooks 'dired-before-readin-hook)
626 (message "Reading directory %s..." dirname) 622 (message "Reading directory %s..." dirname)
627 (set-buffer buffer) 623 (if (consp buffer-undo-list)
628 (let (buffer-read-only (failed t)) 624 (setq buffer-undo-list nil))
625 (let (buffer-read-only
626 ;; Don't make undo entries for readin.
627 (buffer-undo-list t))
629 (widen) 628 (widen)
630 (erase-buffer) 629 (erase-buffer)
631 (dired-readin-insert dir-or-list) 630 (dired-readin-insert))
632 (indent-rigidly (point-min) (point-max) 2)
633 ;; We need this to make the root dir have a header line as all
634 ;; other subdirs have:
635 (goto-char (point-min))
636 (if (not (looking-at "^ /.*:$"))
637 (dired-insert-headerline default-directory))
638 ;; can't run dired-after-readin-hook here, it may depend on the subdir
639 ;; alist to be OK.
640 )
641 (message "Reading directory %s...done" dirname) 631 (message "Reading directory %s...done" dirname)
632 (goto-char (point-min))
642 ;; Must first make alist buffer local and set it to nil because 633 ;; Must first make alist buffer local and set it to nil because
643 ;; dired-build-subdir-alist will call dired-clear-alist first 634 ;; dired-build-subdir-alist will call dired-clear-alist first
644 (set (make-local-variable 'dired-subdir-alist) nil) 635 (set (make-local-variable 'dired-subdir-alist) nil)
@@ -646,56 +637,56 @@ If DIRNAME is already in a dired buffer, that buffer is used without refresh."
646 (let ((attributes (file-attributes dirname))) 637 (let ((attributes (file-attributes dirname)))
647 (if (eq (car attributes) t) 638 (if (eq (car attributes) t)
648 (set-visited-file-modtime (nth 5 attributes)))) 639 (set-visited-file-modtime (nth 5 attributes))))
649 (if (consp buffer-undo-list) 640 (set-buffer-modified-p nil)
650 (setq buffer-undo-list nil)) 641 ;; No need to narrow since the whole buffer contains just
651 (set-buffer-modified-p nil)))) 642 ;; dired-readin's output, nothing else. The hook can
643 ;; successfully use dired functions (e.g. dired-get-filename)
644 ;; as the subdir-alist has been built in dired-readin.
645 (run-hooks 'dired-after-readin-hook))))
652 646
653;; Subroutines of dired-readin 647;; Subroutines of dired-readin
654 648
655(defun dired-readin-insert (dir-or-list) 649(defun dired-readin-insert ()
656 ;; Just insert listing for the passed-in directory or 650 ;; Insert listing for the specified dir (and maybe file list)
657 ;; directory-and-file list, assuming a clean buffer. 651 ;; already in dired-directory, assuming a clean buffer.
658 (let (dirname) 652 (let (dir file-list)
659 (if (consp dir-or-list) 653 (if (consp dired-directory)
660 (setq dirname (car dir-or-list)) 654 (setq dir (car dired-directory)
661 (setq dirname dir-or-list)) 655 file-list (cdr dired-directory))
662 ;; Expand before comparing in case one or both have been abbreviated. 656 (setq dir dired-directory
663 (if (and (equal (expand-file-name default-directory) 657 file-list nil))
664 (expand-file-name dirname)) 658 (if (and (equal "" (file-name-nondirectory dir))
665 (not (consp dir-or-list))) 659 (not file-list))
666 ;; If we are reading a whole single directory... 660 ;; If we are reading a whole single directory...
667 (dired-insert-directory dir-or-list dired-actual-switches nil t) 661 (dired-insert-directory dir dired-actual-switches nil nil t)
668 (if (not (file-readable-p 662 (if (not (file-readable-p
669 (directory-file-name (file-name-directory dirname)))) 663 (directory-file-name (file-name-directory dir))))
670 (error "Directory %s inaccessible or nonexistent" dirname) 664 (error "Directory %s inaccessible or nonexistent" dir)
671 ;; Else assume it contains wildcards, 665 ;; Else treat it as a wildcard spec
672 ;; unless it is an explicit list of files. 666 ;; unless we have an explicit list of files.
673 (dired-insert-directory dir-or-list dired-actual-switches 667 (dired-insert-directory dir dired-actual-switches
674 (not (listp dir-or-list))) 668 file-list (not file-list) t)))))
675 (or (consp dir-or-list) 669
676 (save-excursion ;; insert wildcard instead of total line: 670(defun dired-insert-directory (dir switches &optional file-list wildcard hdr)
677 (goto-char (point-min)) 671 "Insert a directory listing of DIR, Dired style.
678 (insert "wildcard " (file-name-nondirectory dirname) "\n"))))))) 672Use SWITCHES to make the listings.
679 673If FILE-LIST is non-nil, list only those files.
680(defun dired-insert-directory (dir-or-list switches &optional wildcard full-p) 674Otherwise, if WILDCARD is non-nil, expand wildcards;
681 ;; Do the right thing whether dir-or-list is atomic or not. If it is, 675 in that case, DIR should be a file name that uses wildcards.
682 ;; inset all files listed in the cdr (the car is the passed-in directory 676In other cases, DIR should be a directory name or a directory filename.
683 ;; list). 677If HDR is non-nil, insert a header line with the directory name."
684 (let ((opoint (point)) 678 (let ((opoint (point))
685 (process-environment (copy-sequence process-environment)) 679 (process-environment (copy-sequence process-environment))
686 end) 680 end)
681 (if dired-use-ls-dired
682 (setq switches (concat "--dired " switches)))
687 ;; We used to specify the C locale here, to force English month names; 683 ;; We used to specify the C locale here, to force English month names;
688 ;; but this should not be necessary any more, 684 ;; but this should not be necessary any more,
689 ;; with the new value of dired-move-to-filename-regexp. 685 ;; with the new value of dired-move-to-filename-regexp.
690 (if (consp dir-or-list) 686 (if file-list
691 ;; In this case, use the file names in the cdr 687 (dolist (f file-list)
692 ;; exactly as originally given to dired-noselect. 688 (insert-directory f switches nil nil))
693 (mapcar 689 (insert-directory dir switches wildcard (not wildcard)))
694 (function (lambda (x) (insert-directory x switches wildcard full-p)))
695 (cdr dir-or-list))
696 ;; Expand the file name here because it may have been abbreviated
697 ;; in dired-noselect.
698 (insert-directory (expand-file-name dir-or-list) switches wildcard full-p))
699 ;; Quote certain characters, unless ls quoted them for us. 690 ;; Quote certain characters, unless ls quoted them for us.
700 (if (not (string-match "b" dired-actual-switches)) 691 (if (not (string-match "b" dired-actual-switches))
701 (save-excursion 692 (save-excursion
@@ -707,8 +698,25 @@ If DIRNAME is already in a dired buffer, that buffer is used without refresh."
707 (while (search-forward "\^m" end t) 698 (while (search-forward "\^m" end t)
708 (replace-match "\\015" nil t)) 699 (replace-match "\\015" nil t))
709 (set-marker end nil))) 700 (set-marker end nil)))
710 (dired-insert-set-properties opoint (point))) 701 (dired-insert-set-properties opoint (point))
711 (setq dired-directory dir-or-list)) 702 ;; If we used --dired and it worked, the lines are already indented.
703 ;; Otherwise, indent them.
704 (unless (save-excursion
705 (forward-line -1)
706 (looking-at " "))
707 (let ((indent-tabs-mode nil))
708 (indent-rigidly opoint (point) 2)))
709 ;; Insert text at the beginning to standardize things.
710 (save-excursion
711 (goto-char opoint)
712 (if (and (or hdr wildcard) (not (looking-at "^ /.*:$")))
713 ;; Note that dired-build-subdir-alist will replace the name
714 ;; by its expansion, so it does not matter whether what we insert
715 ;; here is fully expanded, but it should be absolute.
716 (insert " " (directory-file-name (file-name-directory dir)) ":\n"))
717 (when wildcard
718 ;; Insert "wildcard" line where "total" line would be for a full dir.
719 (insert " wildcard " (file-name-nondirectory dir) "\n")))))
712 720
713;; Make the file names highlight when the mouse is on them. 721;; Make the file names highlight when the mouse is on them.
714(defun dired-insert-set-properties (beg end) 722(defun dired-insert-set-properties (beg end)
@@ -726,13 +734,6 @@ If DIRNAME is already in a dired buffer, that buffer is used without refresh."
726 help-echo "mouse-2: visit this file in other window"))) 734 help-echo "mouse-2: visit this file in other window")))
727 (error nil)) 735 (error nil))
728 (forward-line 1)))) 736 (forward-line 1))))
729
730(defun dired-insert-headerline (dir);; also used by dired-insert-subdir
731 ;; Insert DIR's headerline with no trailing slash, exactly like ls
732 ;; would, and put cursor where dired-build-subdir-alist puts subdir
733 ;; boundaries.
734 (save-excursion (insert " " (directory-file-name dir) ":\n")))
735
736 737
737;; Reverting a dired buffer 738;; Reverting a dired buffer
738 739
@@ -755,7 +756,7 @@ If DIRNAME is already in a dired buffer, that buffer is used without refresh."
755 ;; treat top level dir extra (it may contain wildcards) 756 ;; treat top level dir extra (it may contain wildcards)
756 (dired-uncache 757 (dired-uncache
757 (if (consp dired-directory) (car dired-directory) dired-directory)) 758 (if (consp dired-directory) (car dired-directory) dired-directory))
758 (dired-readin dired-directory (current-buffer)) 759 (dired-readin)
759 (let ((dired-after-readin-hook nil)) 760 (let ((dired-after-readin-hook nil))
760 ;; don't run that hook for each subdir... 761 ;; don't run that hook for each subdir...
761 (dired-insert-old-subdirs old-subdir-alist)) 762 (dired-insert-old-subdirs old-subdir-alist))
@@ -1474,6 +1475,7 @@ Optional arg NO-ERROR-IF-NOT-FILEP means return nil if no filename on
1474 (let ((handler (find-file-name-handler file nil))) 1475 (let ((handler (find-file-name-handler file nil)))
1475 ;; check for safe-magic property so that we won't 1476 ;; check for safe-magic property so that we won't
1476 ;; put /: for names that don't really need them. 1477 ;; put /: for names that don't really need them.
1478 ;; For instance, .gz files when auto-compression-mode is on.
1477 (if (and handler (not (get handler 'safe-magic))) 1479 (if (and handler (not (get handler 'safe-magic)))
1478 (concat "/:" file) 1480 (concat "/:" file)
1479 file))) 1481 file)))
@@ -1584,10 +1586,14 @@ regardless of the language.")
1584 ;; This is the UNIX version. 1586 ;; This is the UNIX version.
1585 (or eol (setq eol (progn (end-of-line) (point)))) 1587 (or eol (setq eol (progn (end-of-line) (point))))
1586 (beginning-of-line) 1588 (beginning-of-line)
1587 (if (re-search-forward dired-move-to-filename-regexp eol t) 1589 ;; First try assuming `ls --dired' was used.
1588 (goto-char (match-end 0)) 1590 (let ((change (next-single-property-change (point) 'dired-filename
1589 (if raise-error 1591 nil eol)))
1590 (error "No file on this line")))) 1592 (if change (goto-char change)
1593 (if (re-search-forward dired-move-to-filename-regexp eol t)
1594 (goto-char (match-end 0))
1595 (if raise-error
1596 (error "No file on this line"))))))
1591 1597
1592(defun dired-move-to-end-of-filename (&optional no-error) 1598(defun dired-move-to-end-of-filename (&optional no-error)
1593 ;; Assumes point is at beginning of filename, 1599 ;; Assumes point is at beginning of filename,
@@ -1596,63 +1602,65 @@ regardless of the language.")
1596 ;; (dired-move-to-filename t). 1602 ;; (dired-move-to-filename t).
1597 ;; On failure, signals an error (with non-nil NO-ERROR just returns nil). 1603 ;; On failure, signals an error (with non-nil NO-ERROR just returns nil).
1598 ;; This is the UNIX version. 1604 ;; This is the UNIX version.
1599 (let (opoint file-type executable symlink hidden case-fold-search used-F eol) 1605 (if (get-text-property (point) 'dired-filename)
1600 ;; case-fold-search is nil now, so we can test for capital F: 1606 (goto-char (next-single-property-change (point) 'dired-filename))
1601 (setq used-F (string-match "F" dired-actual-switches) 1607 (let (opoint file-type executable symlink hidden case-fold-search used-F eol)
1602 opoint (point) 1608 ;; case-fold-search is nil now, so we can test for capital F:
1603 eol (save-excursion (end-of-line) (point)) 1609 (setq used-F (string-match "F" dired-actual-switches)
1604 hidden (and selective-display 1610 opoint (point)
1605 (save-excursion (search-forward "\r" eol t)))) 1611 eol (save-excursion (end-of-line) (point))
1606 (if hidden 1612 hidden (and selective-display
1607 nil 1613 (save-excursion (search-forward "\r" eol t))))
1608 (save-excursion;; Find out what kind of file this is: 1614 (if hidden
1609 ;; Restrict perm bits to be non-blank, 1615 nil
1610 ;; otherwise this matches one char to early (looking backward): 1616 (save-excursion ;; Find out what kind of file this is:
1611 ;; "l---------" (some systems make symlinks that way) 1617 ;; Restrict perm bits to be non-blank,
1612 ;; "----------" (plain file with zero perms) 1618 ;; otherwise this matches one char to early (looking backward):
1613 (if (re-search-backward 1619 ;; "l---------" (some systems make symlinks that way)
1614 dired-permission-flags-regexp nil t) 1620 ;; "----------" (plain file with zero perms)
1615 (setq file-type (char-after (match-beginning 1)) 1621 (if (re-search-backward
1616 symlink (eq file-type ?l) 1622 dired-permission-flags-regexp nil t)
1617 ;; Only with -F we need to know whether it's an executable 1623 (setq file-type (char-after (match-beginning 1))
1618 executable (and 1624 symlink (eq file-type ?l)
1619 used-F 1625 ;; Only with -F we need to know whether it's an executable
1620 (string-match 1626 executable (and
1621 "[xst]";; execute bit set anywhere? 1627 used-F
1622 (concat 1628 (string-match
1623 (buffer-substring (match-beginning 2) 1629 "[xst]" ;; execute bit set anywhere?
1624 (match-end 2)) 1630 (concat
1625 (buffer-substring (match-beginning 3) 1631 (buffer-substring (match-beginning 2)
1626 (match-end 3)) 1632 (match-end 2))
1627 (buffer-substring (match-beginning 4) 1633 (buffer-substring (match-beginning 3)
1628 (match-end 4)))))) 1634 (match-end 3))
1629 (or no-error (error "No file on this line")))) 1635 (buffer-substring (match-beginning 4)
1630 ;; Move point to end of name: 1636 (match-end 4))))))
1631 (if symlink 1637 (or no-error (error "No file on this line"))))
1632 (if (search-forward " ->" eol t) 1638 ;; Move point to end of name:
1633 (progn 1639 (if symlink
1634 (forward-char -3) 1640 (if (search-forward " ->" eol t)
1635 (and used-F 1641 (progn
1636 dired-ls-F-marks-symlinks 1642 (forward-char -3)
1637 (eq (preceding-char) ?@);; did ls really mark the link? 1643 (and used-F
1638 (forward-char -1)))) 1644 dired-ls-F-marks-symlinks
1639 (goto-char eol);; else not a symbolic link 1645 (eq (preceding-char) ?@) ;; did ls really mark the link?
1640 ;; ls -lF marks dirs, sockets and executables with exactly one 1646 (forward-char -1))))
1641 ;; trailing character. (Executable bits on symlinks ain't mean 1647 (goto-char eol) ;; else not a symbolic link
1642 ;; a thing, even to ls, but we know it's not a symlink.) 1648 ;; ls -lF marks dirs, sockets and executables with exactly one
1643 (and used-F 1649 ;; trailing character. (Executable bits on symlinks ain't mean
1644 (or (memq file-type '(?d ?s)) 1650 ;; a thing, even to ls, but we know it's not a symlink.)
1645 executable) 1651 (and used-F
1646 (forward-char -1)))) 1652 (or (memq file-type '(?d ?s))
1647 (or no-error 1653 executable)
1648 (not (eq opoint (point))) 1654 (forward-char -1))))
1649 (error (if hidden 1655 (or no-error
1650 (substitute-command-keys 1656 (not (eq opoint (point)))
1651 "File line is hidden, type \\[dired-hide-subdir] to unhide") 1657 (error (if hidden
1652 "No file on this line"))) 1658 (substitute-command-keys
1653 (if (eq opoint (point)) 1659 "File line is hidden, type \\[dired-hide-subdir] to unhide")
1654 nil 1660 "No file on this line")))
1655 (point)))) 1661 (if (eq opoint (point))
1662 nil
1663 (point)))))
1656 1664
1657 1665
1658;;; COPY NAMES OF MARKED FILES INTO KILL-RING. 1666;;; COPY NAMES OF MARKED FILES INTO KILL-RING.
@@ -2645,38 +2653,50 @@ Thus, use \\[backward-page] to find the beginning of a group of errors."
2645 (progn 2653 (progn
2646 (select-window window) 2654 (select-window window)
2647 (goto-char (point-max)) 2655 (goto-char (point-max))
2648 (recenter -1)) 2656 (forward-line -1)
2657 (backward-page 1)
2658 (recenter 0))
2649 (select-window owindow))))) 2659 (select-window owindow)))))
2650 2660
2651(defun dired-log (log &rest args) 2661(defun dired-log (log &rest args)
2652 ;; Log a message or the contents of a buffer. 2662 ;; Log a message or the contents of a buffer.
2653 ;; If LOG is a string and there are more args, it is formatted with 2663 ;; If LOG is a string and there are more args, it is formatted with
2654 ;; those ARGS. Usually the LOG string ends with a \n. 2664 ;; those ARGS. Usually the LOG string ends with a \n.
2655 ;; End each bunch of errors with (dired-log t): this inserts 2665 ;; End each bunch of errors with (dired-log t):
2656 ;; current time and buffer, and a \f (formfeed). 2666 ;; this inserts the current time and buffer at the start of the page,
2667 ;; and \f (formfeed) at the end.
2657 (let ((obuf (current-buffer))) 2668 (let ((obuf (current-buffer)))
2658 (unwind-protect ; want to move point 2669 (with-current-buffer (get-buffer-create dired-log-buffer)
2659 (progn 2670 (goto-char (point-max))
2660 (set-buffer (get-buffer-create dired-log-buffer)) 2671 (let ((inhibit-read-only t))
2661 (goto-char (point-max)) 2672 (cond ((stringp log)
2662 (let (buffer-read-only) 2673 (insert (if args
2663 (cond ((stringp log) 2674 (apply (function format) log args)
2664 (insert (if args 2675 log)))
2665 (apply (function format) log args) 2676 ((bufferp log)
2666 log))) 2677 (insert-buffer log))
2667 ((bufferp log) 2678 ((eq t log)
2668 (insert-buffer log)) 2679 (backward-page 1)
2669 ((eq t log) 2680 (unless (bolp)
2670 (insert "\n\t" (current-time-string) 2681 (insert "\n"))
2671 "\tBuffer `" (buffer-name obuf) "'\n\f\n"))))) 2682 (insert (current-time-string)
2672 (set-buffer obuf)))) 2683 "\tBuffer `" (buffer-name obuf) "'\n")
2684 (goto-char (point-max))
2685 (insert "\f\n")))))))
2673 2686
2674(defun dired-log-summary (string failures) 2687(defun dired-log-summary (string failures)
2675 (message (if failures "%s--type ? for details (%s)" 2688 (if (= (length failures) 1)
2676 "%s--type ? for details") 2689 (message "%s"
2677 string failures) 2690 (with-current-buffer dired-log-buffer
2691 (goto-char (point-max))
2692 (backward-page 1)
2693 (if (eolp) (forward-line 1))
2694 (buffer-substring (point) (point-max))))
2695 (message (if failures "%s--type ? for details (%s)"
2696 "%s--type ? for details")
2697 string failures))
2678 ;; Log a summary describing a bunch of errors. 2698 ;; Log a summary describing a bunch of errors.
2679 (dired-log (concat "\n" string)) 2699 (dired-log (concat "\n" string "\n"))
2680 (dired-log t)) 2700 (dired-log t))
2681 2701
2682;;; Sorting 2702;;; Sorting