Mercurial > emacs
comparison lisp/dired.el @ 878:5b1c5b4286e7
*** empty log message ***
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Mon, 27 Jul 1992 02:56:28 +0000 |
parents | 2e0cd4e83c2e |
children | bad1b9af86a1 |
comparison
equal
deleted
inserted
replaced
877:e0dde8b90613 | 878:5b1c5b4286e7 |
---|---|
1 ;; dired.el --- directory-browsing commands | 1 ;; dired.el --- directory-browsing commands |
2 | |
3 ;; Copyright (C) 1985, 1986, 1992 Free Software Foundation, Inc. | |
2 | 4 |
3 ;; Author: Sebastian Kremer <sk@thp.uni-koeln.de>. | 5 ;; Author: Sebastian Kremer <sk@thp.uni-koeln.de>. |
4 ;; Version: 5.234 | 6 ;; Version: 5.234 |
5 ;; Last-Modified: 14 Jul 1992 | |
6 | |
7 ;; Copyright (C) 1985, 1986, 1992 Free Software Foundation, Inc. | |
8 | 7 |
9 ;; This file is part of GNU Emacs. | 8 ;; This file is part of GNU Emacs. |
10 | 9 |
11 ;; GNU Emacs is free software; you can redistribute it and/or modify | 10 ;; GNU Emacs is free software; you can redistribute it and/or modify |
12 ;; it under the terms of the GNU General Public License as published by | 11 ;; it under the terms of the GNU General Public License as published by |
27 ;; Rewritten in 1990/1991 to add tree features, file marking and | 26 ;; Rewritten in 1990/1991 to add tree features, file marking and |
28 ;; sorting by Sebastian Kremer <sk@thp.uni-koeln.de>. | 27 ;; sorting by Sebastian Kremer <sk@thp.uni-koeln.de>. |
29 ;; Finished up by rms in 1992. | 28 ;; Finished up by rms in 1992. |
30 | 29 |
31 ;;; Code: | 30 ;;; Code: |
32 | |
33 ;; compatibility package when using Emacs 18.55 | |
34 (defvar dired-emacs-19-p (equal (substring emacs-version 0 2) "19")) | |
35 ;;;>>> install (is there a better way to test for Emacs 19?) | |
36 (or dired-emacs-19-p | |
37 (require 'emacs-19)) | |
38 | 31 |
39 ;;; Customizable variables | 32 ;;; Customizable variables |
40 | 33 |
41 ;;; The funny comments are for autoload.el, to automagically update | 34 ;;; The funny comments are for autoload.el, to automagically update |
42 ;;; loaddefs. | 35 ;;; loaddefs. |
154 | 147 |
155 (defvar dired-del-marker ?D | 148 (defvar dired-del-marker ?D |
156 "Character used to flag files for deletion.") | 149 "Character used to flag files for deletion.") |
157 | 150 |
158 (defvar dired-shrink-to-fit | 151 (defvar dired-shrink-to-fit |
159 (if (fboundp 'baud-rate) (> (baud-rate) search-slow-speed) t) | 152 t |
153 ;; I see no reason ever to make this nil -- rms. | |
154 ;; (> baud-rate search-slow-speed) | |
160 "Non-nil means Dired shrinks the display buffer to fit the marked files.") | 155 "Non-nil means Dired shrinks the display buffer to fit the marked files.") |
161 | 156 |
162 (defvar dired-flagging-regexp nil);; Last regexp used to flag files. | 157 (defvar dired-flagging-regexp nil);; Last regexp used to flag files. |
158 | |
159 (defvar dired-file-version-alist) | |
163 | 160 |
164 (defvar dired-directory nil | 161 (defvar dired-directory nil |
165 "The directory name or shell wildcard that was used as argument to `ls'. | 162 "The directory name or shell wildcard that was used as argument to `ls'. |
166 Local to each dired buffer.") | 163 Local to each dired buffer.") |
167 | 164 |
684 (define-key dired-mode-map "k" 'dired-kill-line-or-subdir) | 681 (define-key dired-mode-map "k" 'dired-kill-line-or-subdir) |
685 (define-key dired-mode-map "l" 'dired-do-redisplay) | 682 (define-key dired-mode-map "l" 'dired-do-redisplay) |
686 (define-key dired-mode-map "m" 'dired-mark) | 683 (define-key dired-mode-map "m" 'dired-mark) |
687 (define-key dired-mode-map "n" 'dired-next-line) | 684 (define-key dired-mode-map "n" 'dired-next-line) |
688 (define-key dired-mode-map "o" 'dired-find-file-other-window) | 685 (define-key dired-mode-map "o" 'dired-find-file-other-window) |
686 (define-key dired-mode-map "\C-o" 'dired-display-file) | |
689 (define-key dired-mode-map "p" 'dired-previous-line) | 687 (define-key dired-mode-map "p" 'dired-previous-line) |
690 (define-key dired-mode-map "q" 'dired-quit) | 688 (define-key dired-mode-map "q" 'dired-quit) |
691 (define-key dired-mode-map "s" 'dired-sort-toggle-or-edit) | 689 (define-key dired-mode-map "s" 'dired-sort-toggle-or-edit) |
692 (define-key dired-mode-map "u" 'dired-unmark) | 690 (define-key dired-mode-map "u" 'dired-unmark) |
693 (define-key dired-mode-map "v" 'dired-view-file) | 691 (define-key dired-mode-map "v" 'dired-view-file) |
898 | 896 |
899 (defun dired-find-file-other-window () | 897 (defun dired-find-file-other-window () |
900 "In dired, visit this file or directory in another window." | 898 "In dired, visit this file or directory in another window." |
901 (interactive) | 899 (interactive) |
902 (find-file-other-window (dired-get-filename))) | 900 (find-file-other-window (dired-get-filename))) |
901 | |
902 (defun dired-display-file () | |
903 "In dired, display this file or directory in another window." | |
904 (interactive) | |
905 (display-buffer (find-file-noselect (dired-get-filename)))) | |
903 | 906 |
904 ;;; Functions for extracting and manipulating file names in dired buffers. | 907 ;;; Functions for extracting and manipulating file names in dired buffers. |
905 | 908 |
906 (defun dired-get-filename (&optional localp no-error-if-not-filep) | 909 (defun dired-get-filename (&optional localp no-error-if-not-filep) |
907 "In dired, return name of file mentioned on this line. | 910 "In dired, return name of file mentioned on this line. |
1333 (let ((fn (car (car l)))) | 1336 (let ((fn (car (car l)))) |
1334 ;; This test is equivalent to | 1337 ;; This test is equivalent to |
1335 ;; (and (file-directory-p fn) (not (file-symlink-p fn))) | 1338 ;; (and (file-directory-p fn) (not (file-symlink-p fn))) |
1336 ;; but more efficient | 1339 ;; but more efficient |
1337 (if (eq t (car (file-attributes fn))) | 1340 (if (eq t (car (file-attributes fn))) |
1338 (remove-directory fn) | 1341 (delete-directory fn) |
1339 (delete-file fn)) | 1342 (delete-file fn)) |
1340 ;; if we get here, removing worked | 1343 ;; if we get here, removing worked |
1341 (setq succ (1+ succ)) | 1344 (setq succ (1+ succ)) |
1342 (message "%s of %s deletions" succ count) | 1345 (message "%s of %s deletions" succ count) |
1343 (delete-region (progn (beginning-of-line) (point)) | 1346 (delete-region (progn (beginning-of-line) (point)) |
1709 with a prefix argument." | 1712 with a prefix argument." |
1710 (interactive "P") | 1713 (interactive "P") |
1711 (setq keep (if keep (prefix-numeric-value keep) dired-kept-versions)) | 1714 (setq keep (if keep (prefix-numeric-value keep) dired-kept-versions)) |
1712 (let ((early-retention (if (< keep 0) (- keep) kept-old-versions)) | 1715 (let ((early-retention (if (< keep 0) (- keep) kept-old-versions)) |
1713 (late-retention (if (<= keep 0) dired-kept-versions keep)) | 1716 (late-retention (if (<= keep 0) dired-kept-versions keep)) |
1714 (file-version-assoc-list ())) | 1717 (dired-file-version-alist ())) |
1715 (message "Cleaning numerical backups (keeping %d late, %d old)..." | 1718 (message "Cleaning numerical backups (keeping %d late, %d old)..." |
1716 late-retention early-retention) | 1719 late-retention early-retention) |
1717 ;; Look at each file. | 1720 ;; Look at each file. |
1718 ;; If the file has numeric backup versions, | 1721 ;; If the file has numeric backup versions, |
1719 ;; put on file-version-assoc-list an element of the form | 1722 ;; put on dired-file-version-alist an element of the form |
1720 ;; (FILENAME . VERSION-NUMBER-LIST) | 1723 ;; (FILENAME . VERSION-NUMBER-LIST) |
1721 (dired-map-dired-file-lines (function dired-collect-file-versions)) | 1724 (dired-map-dired-file-lines (function dired-collect-file-versions)) |
1722 ;; Sort each VERSION-NUMBER-LIST, | 1725 ;; Sort each VERSION-NUMBER-LIST, |
1723 ;; and remove the versions not to be deleted. | 1726 ;; and remove the versions not to be deleted. |
1724 (let ((fval file-version-assoc-list)) | 1727 (let ((fval dired-file-version-alist)) |
1725 (while fval | 1728 (while fval |
1726 (let* ((sorted-v-list (cons 'q (sort (cdr (car fval)) '<))) | 1729 (let* ((sorted-v-list (cons 'q (sort (cdr (car fval)) '<))) |
1727 (v-count (length sorted-v-list))) | 1730 (v-count (length sorted-v-list))) |
1728 (if (> v-count (+ early-retention late-retention)) | 1731 (if (> v-count (+ early-retention late-retention)) |
1729 (rplacd (nthcdr early-retention sorted-v-list) | 1732 (rplacd (nthcdr early-retention sorted-v-list) |
1764 (possibilities (file-name-all-completions | 1767 (possibilities (file-name-all-completions |
1765 base-versions | 1768 base-versions |
1766 (file-name-directory fn))) | 1769 (file-name-directory fn))) |
1767 (versions (mapcar 'backup-extract-version possibilities))) | 1770 (versions (mapcar 'backup-extract-version possibilities))) |
1768 (if versions | 1771 (if versions |
1769 (setq file-version-assoc-list (cons (cons fn versions) | 1772 (setq dired-file-version-alist (cons (cons fn versions) |
1770 file-version-assoc-list))))) | 1773 dired-file-version-alist))))) |
1771 | 1774 |
1772 (defun dired-trample-file-versions (fn) | 1775 (defun dired-trample-file-versions (fn) |
1773 (let* ((start-vn (string-match "\\.~[0-9]+~$" fn)) | 1776 (let* ((start-vn (string-match "\\.~[0-9]+~$" fn)) |
1774 base-version-list) | 1777 base-version-list) |
1775 (and start-vn | 1778 (and start-vn |
1776 (setq base-version-list ; there was a base version to which | 1779 (setq base-version-list ; there was a base version to which |
1777 (assoc (substring fn 0 start-vn) ; this looks like a | 1780 (assoc (substring fn 0 start-vn) ; this looks like a |
1778 file-version-assoc-list)) ; subversion | 1781 dired-file-version-alist)) ; subversion |
1779 (not (memq (string-to-int (substring fn (+ 2 start-vn))) | 1782 (not (memq (string-to-int (substring fn (+ 2 start-vn))) |
1780 base-version-list)) ; this one doesn't make the cut | 1783 base-version-list)) ; this one doesn't make the cut |
1781 (progn (beginning-of-line) | 1784 (progn (beginning-of-line) |
1782 (delete-char 1) | 1785 (delete-char 1) |
1783 (insert dired-del-marker))))) | 1786 (insert dired-del-marker))))) |
1921 ;; to make the separation invisible. | 1924 ;; to make the separation invisible. |
1922 | 1925 |
1923 (autoload 'dired-diff "dired-aux" | 1926 (autoload 'dired-diff "dired-aux" |
1924 "Compare file at point with file FILE using `diff'. | 1927 "Compare file at point with file FILE using `diff'. |
1925 FILE defaults to the file at the mark. | 1928 FILE defaults to the file at the mark. |
1926 The prompted-for file is the first file given to `diff'. | 1929 The prompted-for file is the first file given to `diff'." |
1927 Prefix arg lets you edit the diff switches. See the command `diff'." | |
1928 t) | 1930 t) |
1929 | 1931 |
1930 (autoload 'dired-backup-diff "dired-aux" | 1932 (autoload 'dired-backup-diff "dired-aux" |
1931 "Diff this file with its backup file or vice versa. | 1933 "Diff this file with its backup file or vice versa. |
1932 Uses the latest backup, if there are several numerical backups. | 1934 Uses the latest backup, if there are several numerical backups. |
1933 If this file is a backup, diff it with its original. | 1935 If this file is a backup, diff it with its original. |
1934 The backup file is the first file given to `diff'. | 1936 The backup file is the first file given to `diff'." |
1935 Prefix arg lets you edit the diff switches. See the command `diff'." | |
1936 t) | 1937 t) |
1937 | 1938 |
1938 (autoload 'dired-do-chmod "dired-aux" | 1939 (autoload 'dired-do-chmod "dired-aux" |
1939 "Change the mode of the marked (or next ARG) files. | 1940 "Change the mode of the marked (or next ARG) files. |
1940 This calls chmod, thus symbolic modes like `g+w' are allowed." | 1941 This calls chmod, thus symbolic modes like `g+w' are allowed." |