Mercurial > emacs
diff lisp/dired-aux.el @ 89943:4c90ffeb71c5
Revision: miles@gnu.org--gnu-2004/emacs--unicode--0--patch-15
Merge from emacs--cvs-trunk--0
Patches applied:
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-218
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-220
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-221
Restore deleted tagline in etc/TUTORIAL.ru
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-222
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-228
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-229
Remove TeX output files from the archive
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-230
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-247
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-248
src/lisp.h (CYCLE_CHECK): Macro moved from xfaces.c
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-249
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-256
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-258
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-263
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-264
Update from CVS: lispref/display.texi: emacs -> Emacs.
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-265
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-274
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-275
Update from CVS: man/makefile.w32-in: Revert last change
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-276
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-295
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-296
Allow restarting an existing debugger session that's exited
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-297
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-299
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-300
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-327
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-328
Update from CVS: src/.gdbinit (xsymbol): Fix last change.
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-329
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-344
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-345
Tweak source regexps so that building in place won't cause problems
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-346
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-351
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-352
Update from CVS: lisp/flymake.el: New file.
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-353
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-361
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-362
Support " [...]" style defaults in minibuffer-electric-default-mode
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-363
(read-number): Use canonical format for default in prompt.
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-364
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-367
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-368
Improve display-supports-face-attributes-p on non-ttys
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-369
Rewrite face-differs-from-default-p
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-370
Move `display-supports-face-attributes-p' entirely into C code
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-371
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-372
Simplify face-differs-from-default-p; don't consider :stipple.
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-373
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-374
(tty_supports_face_attributes_p): Ensure attributes differ from default
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-375
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-376
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-377
(Fdisplay_supports_face_attributes_p): Work around bootstrapping problem
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-378
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-380
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-381
Face merging cleanups
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-382
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-384
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-385
src/xfaces.c (push_named_merge_point): Return 0 if a cycle is detected
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-386
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-395
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-396
Tweak arch tagging to make build/install-in-place less annoying
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-397
Work around vc-arch problems when building eshell
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-398
Tweak permissions
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-399
Tweak directory permissions
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-400
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-401
More build-in-place tweaking of arch tagging
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-402
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-403
Yet more build-in-place tweaking of arch tagging
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-404
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-409
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-410
Make sure image types are initialized for lookup too
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-411
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-416
Update from CVS
author | Miles Bader <miles@gnu.org> |
---|---|
date | Mon, 28 Jun 2004 07:56:49 +0000 |
parents | 68c22ea6027c 1f13c1cdc0b1 |
children | b9eee0a7bef5 |
line wrap: on
line diff
--- a/lisp/dired-aux.el Sat May 29 02:17:09 2004 +0000 +++ b/lisp/dired-aux.el Mon Jun 28 07:56:49 2004 +0000 @@ -64,7 +64,10 @@ (if default (concat "(default " default ") ") "")) - (dired-current-directory) default t) + (if default + (dired-current-directory) + (dired-dwim-target-directory)) + default t) (if current-prefix-arg (read-string "Options for diff: " (if (stringp diff-switches) @@ -185,6 +188,18 @@ (file-attributes full-file-name)))) (directory-files dir))) + +(defun dired-touch-initial (files) + "Create initial input value for `touch' command." + (let (initial) + (while files + (let ((current (nth 5 (file-attributes (car files))))) + (if (and initial (not (equal initial current))) + (setq initial (current-time) files nil) + (setq initial current)) + (setq files (cdr files)))) + (format-time-string "%Y%m%d%H%M.%S" initial))) + (defun dired-do-chxxx (attribute-name program op-symbol arg) ;; Change file attributes (mode, group, owner, timestamp) of marked files and ;; refresh their file lines. @@ -196,7 +211,8 @@ (new-attribute (dired-mark-read-string (concat "Change " attribute-name " of %s to: ") - nil op-symbol arg files)) + (if (eq op-symbol 'touch) (dired-touch-initial files)) + op-symbol arg files)) (operation (concat program " " new-attribute)) failures) (setq failures @@ -239,6 +255,7 @@ (error "chown not supported on this system")) (dired-do-chxxx "Owner" dired-chown-program 'chown arg)) +;;;###autoload (defun dired-do-touch (&optional arg) "Change the timestamp of the marked (or next ARG) files. This calls touch." @@ -326,6 +343,7 @@ (defvar dired-file-version-alist) +;;;###autoload (defun dired-clean-directory (keep) "Flag numerical backups for deletion. Spares `dired-kept-versions' latest versions, and `kept-old-versions' oldest. @@ -535,6 +553,7 @@ (funcall stuff-it files))))) ;; This is an extra function so that it can be redefined by ange-ftp. +;;;###autoload (defun dired-run-shell-command (command) (let ((handler (find-file-name-handler (directory-file-name default-directory) @@ -789,6 +808,7 @@ ;; None of these keys quit - use C-g for that. )) +;;;###autoload (defun dired-query (qs-var qs-prompt &rest qs-args) ;; Query user and return nil or t. ;; Store answer in symbol VAR (which must initially be bound to nil). @@ -875,13 +895,27 @@ (defun dired-do-redisplay (&optional arg test-for-subdir) "Redisplay all marked (or next ARG) files. If on a subdir line, redisplay that subdirectory. In that case, -a prefix arg lets you edit the `ls' switches used for the new listing." +a prefix arg lets you edit the `ls' switches used for the new listing. + +Dired remembers switches specified with a prefix arg, so that reverting +the buffer will not reset them. However, using `dired-undo' to re-insert +or delete subdirectories can bypass this machinery. Hence, you sometimes +may have to reset some subdirectory switches after a `dired-undo'. +You can reset all subdirectory switches to the default using +\\<dired-mode-map>\\[dired-reset-subdir-switches]. +See Info node `(emacs-xtra)Subdir switches' for more details." ;; Moves point if the next ARG files are redisplayed. (interactive "P\np") (if (and test-for-subdir (dired-get-subdir)) - (dired-insert-subdir - (dired-get-subdir) - (if arg (read-string "Switches for listing: " dired-actual-switches))) + (let* ((dir (dired-get-subdir)) + (switches (cdr (assoc-string dir dired-switches-alist)))) + (dired-insert-subdir + dir + (when arg + (read-string "Switches for listing: " + (or switches + dired-subdir-switches + dired-actual-switches))))) (message "Redisplaying...") ;; message much faster than making dired-map-over-marks show progress (dired-uncache @@ -892,6 +926,12 @@ arg) (dired-move-to-filename) (message "Redisplaying...done"))) + +(defun dired-reset-subdir-switches () + "Set `dired-switches-alist' to nil and revert dired buffer." + (interactive) + (setq dired-switches-alist nil) + (revert-buffer)) (defun dired-update-file-line (file) ;; Delete the current line, and insert an entry for FILE. @@ -1191,9 +1231,10 @@ (dired-advertise))))) (defun dired-rename-subdir-2 (elt dir to) - ;; Update the headerline and dired-subdir-alist element of directory - ;; described by alist-element ELT to reflect the moving of DIR to TO. - ;; Thus, ELT describes either DIR itself or a subdir of DIR. + ;; Update the headerline and dired-subdir-alist element, as well as + ;; dired-switches-alist element, of directory described by + ;; alist-element ELT to reflect the moving of DIR to TO. Thus, ELT + ;; describes either DIR itself or a subdir of DIR. (save-excursion (let ((regexp (regexp-quote (directory-file-name dir))) (newtext (directory-file-name to)) @@ -1207,10 +1248,12 @@ (if (re-search-forward regexp (match-end 1) t) (replace-match newtext t t) (error "Expected to find `%s' in headerline of %s" dir (car elt)))) - ;; Update buffer-local dired-subdir-alist - (setcar elt - (dired-normalize-subdir - (dired-replace-in-string regexp newtext (car elt))))))) + ;; Update buffer-local dired-subdir-alist and dired-switches-alist + (let ((cons (assoc-string (car elt) dired-switches-alist)) + (cur-dir (dired-normalize-subdir + (dired-replace-in-string regexp newtext (car elt))))) + (setcar elt cur-dir) + (when cons (setcar cons cur-dir)))))) ;; The basic function for half a dozen variations on cp/mv/ln/ln -s. (defun dired-create-files (file-creator operation fn-list name-constructor @@ -1702,11 +1745,20 @@ With a prefix arg, you may edit the ls switches used for this listing. You can add `R' to the switches to expand the whole tree starting at this subdirectory. -This function takes some pains to conform to `ls -lR' output." +This function takes some pains to conform to `ls -lR' output. + +Dired remembers switches specified with a prefix arg, so that reverting +the buffer will not reset them. However, using `dired-undo' to re-insert +or delete subdirectories can bypass this machinery. Hence, you sometimes +may have to reset some subdirectory switches after a `dired-undo'. +You can reset all subdirectory switches to the default using +\\<dired-mode-map>\\[dired-reset-subdir-switches]. +See Info node `(emacs-xtra)Subdir switches' for more details." (interactive (list (dired-get-filename) (if current-prefix-arg - (read-string "Switches for listing: " dired-actual-switches)))) + (read-string "Switches for listing: " + (or dired-subdir-switches dired-actual-switches))))) (let ((opoint (point))) ;; We don't need a marker for opoint as the subdir is always ;; inserted *after* opoint. @@ -1733,14 +1785,19 @@ (interactive (list (dired-get-filename) (if current-prefix-arg - (read-string "Switches for listing: " dired-actual-switches)))) + (read-string "Switches for listing: " + (or dired-subdir-switches dired-actual-switches))))) (setq dirname (file-name-as-directory (expand-file-name dirname))) - (dired-insert-subdir-validate dirname switches) (or no-error-if-not-dir-p (file-directory-p dirname) (error "Attempt to insert a non-directory: %s" dirname)) (let ((elt (assoc dirname dired-subdir-alist)) - switches-have-R mark-alist case-fold-search buffer-read-only) + (cons (assoc-string dirname dired-switches-alist)) + (modflag (buffer-modified-p)) + (old-switches switches) + switches-have-R mark-alist case-fold-search buffer-read-only) + (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))) ;; avoid duplicated subdirs @@ -1751,9 +1808,23 @@ (dired-insert-subdir-newpos dirname)) ; else compute new position (dired-insert-subdir-doupdate dirname elt (dired-insert-subdir-doinsert dirname switches)) - (if switches-have-R (dired-build-subdir-alist switches)) + (when old-switches + (if cons + (setcdr cons switches) + (push (cons dirname switches) dired-switches-alist))) + (when switches-have-R + (dired-build-subdir-alist switches) + (setq switches (dired-replace-in-string "R" "" switches)) + (dolist (cur-ass dired-subdir-alist) + (let ((cur-dir (car cur-ass))) + (and (dired-in-this-tree cur-dir dirname) + (let ((cur-cons (assoc-string cur-dir dired-switches-alist))) + (if cur-cons + (setcdr cur-cons switches) + (push (cons cur-dir switches) dired-switches-alist))))))) (dired-initial-position dirname) - (save-excursion (dired-mark-remembered mark-alist)))) + (save-excursion (dired-mark-remembered mark-alist)) + (restore-buffer-modified-p modflag))) ;; This is a separate function for dired-vms. (defun dired-insert-subdir-validate (dirname &optional switches) @@ -1761,17 +1832,18 @@ ;; Signal an error if invalid (e.g. user typed `i' on `..'). (or (dired-in-this-tree dirname (expand-file-name default-directory)) (error "%s: not in this directory tree" dirname)) - (if switches + (let ((real-switches (or switches dired-subdir-switches))) + (when real-switches (let (case-fold-search) (mapcar (function (lambda (x) - (or (eq (null (string-match x switches)) + (or (eq (null (string-match x real-switches)) (null (string-match x dired-actual-switches))) - (error "Can't have dirs with and without -%s switches together" - x)))) + (error + "Can't have dirs with and without -%s switches together" x)))) ;; all switches that make a difference to dired-get-filename: - '("F" "b"))))) + '("F" "b")))))) (defun dired-alist-add (dir new-marker) ;; Add new DIR at NEW-MARKER. Sort alist. @@ -1786,19 +1858,23 @@ (> (dired-get-subdir-min elt1) (dired-get-subdir-min elt2))))))) -(defun dired-kill-tree (dirname &optional remember-marks) +(defun dired-kill-tree (dirname &optional remember-marks kill-root) "Kill all proper subdirs of DIRNAME, excluding DIRNAME itself. -With optional arg REMEMBER-MARKS, return an alist of marked files." - (interactive "DKill tree below directory: ") - (setq dirname (expand-file-name dirname)) +Interactively, you can kill DIRNAME as well by using a prefix argument. +In interactive use, the command prompts for DIRNAME. + +When called from Lisp, if REMEMBER-MARKS is non-nil, return an alist +of marked files. If KILL-ROOT is non-nil, kill DIRNAME as well." + (interactive "DKill tree below directory: \ni\nP") + (setq dirname (file-name-as-directory (expand-file-name dirname))) (let ((s-alist dired-subdir-alist) dir m-alist) (while s-alist (setq dir (car (car s-alist)) s-alist (cdr s-alist)) - (if (and (not (string-equal dir dirname)) - (dired-in-this-tree dir dirname) - (dired-goto-subdir dir)) - (setq m-alist (nconc (dired-kill-subdir remember-marks) m-alist)))) + (and (or kill-root (not (string-equal dir dirname))) + (dired-in-this-tree dir dirname) + (dired-goto-subdir dir) + (setq m-alist (nconc (dired-kill-subdir remember-marks) m-alist)))) m-alist)) (defun dired-insert-subdir-newpos (new-dir) @@ -1839,16 +1915,15 @@ ;; Return the boundary of the inserted text (as list of BEG and END). (save-excursion (let ((begin (point))) - (message "Reading directory %s..." dirname) (let ((dired-actual-switches (or switches + dired-subdir-switches (dired-replace-in-string "R" "" dired-actual-switches)))) (if (equal dirname (car (car (last dired-subdir-alist)))) ;; If doing the top level directory of the buffer, ;; redo it as specified in dired-directory. (dired-readin-insert) (dired-insert-directory dirname dired-actual-switches nil nil t))) - (message "Reading directory %s...done" dirname) (list begin (point))))) (defun dired-insert-subdir-doupdate (dirname elt beg-end) @@ -1991,10 +2066,12 @@ Lower levels are unaffected." ;; With optional REMEMBER-MARKS, return a mark-alist. (interactive) - (let ((beg (dired-subdir-min)) - (end (dired-subdir-max)) - buffer-read-only cur-dir) - (setq cur-dir (dired-current-directory)) + (let* ((beg (dired-subdir-min)) + (end (dired-subdir-max)) + (modflag (buffer-modified-p)) + (cur-dir (dired-current-directory)) + (cons (assoc-string cur-dir dired-switches-alist)) + buffer-read-only) (if (equal cur-dir default-directory) (error "Attempt to kill top level directory")) (prog1 @@ -2002,7 +2079,10 @@ (delete-region beg end) (if (eobp) ; don't leave final blank line (delete-char -1)) - (dired-unsubdir cur-dir)))) + (dired-unsubdir cur-dir) + (when cons + (setq dired-switches-alist (delete cons dired-switches-alist))) + (restore-buffer-modified-p modflag)))) (defun dired-unsubdir (dir) ;; Remove DIR from the alist @@ -2061,19 +2141,21 @@ Use \\[dired-hide-all] to (un)hide all directories." (interactive "p") (dired-hide-check) - (while (>= (setq arg (1- arg)) 0) - (let* ((cur-dir (dired-current-directory)) - (hidden-p (dired-subdir-hidden-p cur-dir)) - (elt (assoc cur-dir dired-subdir-alist)) - (end-pos (1- (dired-get-subdir-max elt))) - buffer-read-only) - ;; keep header line visible, hide rest - (goto-char (dired-get-subdir-min elt)) - (skip-chars-forward "^\n\r") - (if hidden-p - (subst-char-in-region (point) end-pos ?\r ?\n) - (subst-char-in-region (point) end-pos ?\n ?\r))) - (dired-next-subdir 1 t))) + (let ((modflag (buffer-modified-p))) + (while (>= (setq arg (1- arg)) 0) + (let* ((cur-dir (dired-current-directory)) + (hidden-p (dired-subdir-hidden-p cur-dir)) + (elt (assoc cur-dir dired-subdir-alist)) + (end-pos (1- (dired-get-subdir-max elt))) + buffer-read-only) + ;; keep header line visible, hide rest + (goto-char (dired-get-subdir-min elt)) + (skip-chars-forward "^\n\r") + (if hidden-p + (subst-char-in-region (point) end-pos ?\r ?\n) + (subst-char-in-region (point) end-pos ?\n ?\r))) + (dired-next-subdir 1 t)) + (restore-buffer-modified-p modflag))) ;;;###autoload (defun dired-hide-all (arg) @@ -2082,7 +2164,8 @@ Use \\[dired-hide-subdir] to (un)hide a particular subdirectory." (interactive "P") (dired-hide-check) - (let (buffer-read-only) + (let ((modflag (buffer-modified-p)) + buffer-read-only) (if (save-excursion (goto-char (point-min)) (search-forward "\r" nil t)) @@ -2091,7 +2174,7 @@ ;; hide (let ((pos (point-max)) ; pos of end of last directory (alist dired-subdir-alist)) - (while alist ; while there are dirs before pos + (while alist ; while there are dirs before pos (subst-char-in-region (dired-get-subdir-min (car alist)) ; pos of prev dir (save-excursion (goto-char pos) ; current dir @@ -2100,7 +2183,8 @@ (point)) ?\n ?\r) (setq pos (dired-get-subdir-min (car alist))) ; prev dir gets current dir - (setq alist (cdr alist))))))) + (setq alist (cdr alist))))) + (restore-buffer-modified-p modflag))) ;;;###end dired-ins.el