|
0
|
1 ;;; -*- Mode: Emacs-lisp -*- ;;;
|
|
|
2 ;;; dired-cd.el - Adjust Working Directory for Tree Dired Shell Commands
|
|
|
3 ;;; Id: dired-cd.el,v 1.14 1991/11/01 14:28:27 sk RelBeta
|
|
|
4 ;;; Copyright (C) 1991 Hugh Secker-Walker
|
|
|
5 ;;;
|
|
|
6 ;;; Author: Hugh Secker-Walker hugh@ear-ache.mit.edu
|
|
|
7 ;;;
|
|
|
8 ;;; Modified by Sebastian Kremer <sk@thp.uni-koeln.de>
|
|
|
9 ;;;
|
|
|
10 ;;; This program is free software; you can redistribute it and/or modify
|
|
|
11 ;;; it under the terms of the GNU General Public License as published by
|
|
|
12 ;;; the Free Software Foundation; either version 1, or (at your option)
|
|
|
13 ;;; any later version.
|
|
|
14 ;;;
|
|
|
15 ;;; This program is distributed in the hope that it will be useful,
|
|
|
16 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
17 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
18 ;;; GNU General Public License for more details.
|
|
|
19 ;;;
|
|
|
20 ;;; A copy of the GNU General Public License can be obtained from this
|
|
|
21 ;;; program's author (send electronic mail to the above address) or from
|
|
|
22 ;;; Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
|
23
|
|
|
24 ;; LISPDIR ENTRY for the Elisp Archive ===============================
|
|
|
25 ;; LCD Archive Entry:
|
|
|
26 ;; dired-cd|Hugh Secker-Walker|hugh@ear-ache.mit.edu
|
|
|
27 ;; |Adjust Working Directory for Tree Dired Shell Commands
|
|
|
28 ;; |Date: 1991/11/01 14:28:27 |Revision: 1.14 |
|
|
|
29
|
|
|
30 ;;; SUMMARY
|
|
|
31
|
|
|
32 ;;; This extension to Sebastian Kremer's (sk@thp.Uni-Koeln.DE) Tree-Dired
|
|
|
33 ;;; permits the working directory of the dired shell commands
|
|
|
34 ;;; dired-do-shell-command and dired-do-background-shell-command
|
|
|
35 ;;; to be the files' subdirectory under certain circumstances.
|
|
|
36 ;;; Loading this extension does not change the behavior of dired until
|
|
|
37 ;;; the variables dired-cd-same-subdir and/or dired-cd-on-each are
|
|
|
38 ;;; non-nil.
|
|
|
39
|
|
|
40
|
|
|
41 ;;; FUNCTIONALITY PROVIDED
|
|
|
42
|
|
|
43 ;;; If dired-cd-same-subdir is non-nil and if all the selected files
|
|
|
44 ;;; (marked, non-zero numeric ARG, etc.) are in the same directory, then
|
|
|
45 ;;; dired-do-shell-command and dired-do-background-shell-command will
|
|
|
46 ;;; cause the shell to perform a cd into that directory before the
|
|
|
47 ;;; commands are executed. Also, the selected filenames will be provided
|
|
|
48 ;;; to the command without any directory components.
|
|
|
49
|
|
|
50 ;;; If dired-cd-on-each is non-nil and if the on-each option is specified
|
|
|
51 ;;; (numeric arg of zero), then dired-do-shell-command and
|
|
|
52 ;;; dired-do-background-shell-command will perform a cd into the
|
|
|
53 ;;; directory of each file before the commands on that file are executed.
|
|
|
54 ;;; Also, each filename will be provided to the command without any
|
|
|
55 ;;; directory components. Note that this on-each behavior occurs
|
|
|
56 ;;; regardless of whether the files are all in the same directory or not.
|
|
|
57
|
|
|
58 ;;; After the above "cd wrapping" has occured, the existing
|
|
|
59 ;;; dired-shell-stuff-it is used to do file-name substitution and
|
|
|
60 ;;; quoting, so custom versions of this procedure should work, e.g.
|
|
|
61 ;;; dired-trans will transform commands correctly. However, since
|
|
|
62 ;;; filenames lack any directory components, features that use the
|
|
|
63 ;;; directory components will fail, e.g. the dired-trans [d] transform
|
|
|
64 ;;; specifier will be empty.
|
|
|
65
|
|
|
66 ;;; New variables (user options):
|
|
|
67 ;;; dired-cd-same-subdir
|
|
|
68 ;;; dired-cd-on-each
|
|
|
69 ;;;
|
|
|
70 ;;; Replaces procedures:
|
|
|
71 ;;; dired-do-shell-command (new doc and prompt, calls dired-cd-wrap-it)
|
|
|
72 ;;;
|
|
|
73 ;;; Adds procedures:
|
|
|
74 ;;; dired-cd-wrap-it (wraps calls to dired-shell-stuff-it with "cd <dir>")
|
|
|
75 ;;; dired-files-same-directory
|
|
|
76
|
|
|
77
|
|
|
78 ;; INSTALLATION
|
|
|
79 ;;
|
|
|
80 ;; Put this file into your load-path and add (load "dired-cd") to
|
|
|
81 ;; your dired-load-hook, e.g.
|
|
|
82 ;;
|
|
|
83 ;; (setq dired-load-hook '(lambda ()
|
|
|
84 ;; ;; possibly more statements here
|
|
|
85 ;; (load "dired-cd")))
|
|
|
86 ;;
|
|
|
87 ;; Do (setq dired-cd-same-subdir t) and perhaps (setq dired-cd-on-each t)
|
|
|
88 ;; in your .emacs. By default, dired-cd doesn't change the behavior of
|
|
|
89 ;; dired when it is loaded.
|
|
|
90 ;;
|
|
|
91 ;; If dired-cd-same-subdir is non-nil, then the shell commands cd to
|
|
|
92 ;; the appropriate directory if all the selected files (marked,
|
|
|
93 ;; numeric ARG, etc.) are in that directory; however, on-each behavior
|
|
|
94 ;; is not changed.
|
|
|
95 ;;
|
|
|
96 ;; If dired-cd-on-each is non-nil, then each instance of the command
|
|
|
97 ;; for an on-each shell command runs in the file's directory
|
|
|
98 ;; regardless of whether the files are all in the same directory.
|
|
|
99
|
|
|
100
|
|
|
101 (defvar dired-cd-same-subdir nil
|
|
|
102 "*If non-nil, and selected file(s) (by marks, numeric arg, \\[universal-argument]) are in same
|
|
|
103 subdir, causes dired shell command to run in that subdir. Filenames provided
|
|
|
104 to shell commands are stripped of their directory components. Does not
|
|
|
105 affect behavior of on-each, for that see variable dired-cd-on-each.")
|
|
|
106
|
|
|
107 (defvar dired-cd-on-each nil
|
|
|
108 "*If non-nil, on-each causes each dired shell command to run in the
|
|
|
109 file's directory. Filenames provided to shell commands are stripped of
|
|
|
110 their directory components. Also see variable dired-cd-same-subdir.")
|
|
|
111
|
|
|
112 ;; Redefines dired.el's version.
|
|
|
113 ;; Changes to documentation and prompt, and uses dired-cd-wrap-it.
|
|
|
114 (defun dired-do-shell-command (&optional arg in-background)
|
|
|
115 "Run a shell command on the marked files.
|
|
|
116 If there is output, it goes to a separate buffer.
|
|
|
117 The list of marked files is appended to the command string unless asterisks
|
|
|
118 `*' indicate the place(s) where the list should go.
|
|
|
119 If no files are marked or a specific numeric prefix arg is given, uses
|
|
|
120 next ARG files. With a zero argument, run command on each marked file
|
|
|
121 separately: `cmd * foo' results in `cmd F1 foo; ...; cmd Fn foo'.
|
|
|
122 As always, a raw arg (\\[universal-argument]) means the current file.
|
|
|
123 The option variables dired-cd-same-subdir and dired-cd-on-each
|
|
|
124 permit the command\(s\) to run in the files' directories if appropriate,
|
|
|
125 and thus determine where output files are created. Default is top
|
|
|
126 directory. The prompt mentions the file(s) or the marker, the cd subdir,
|
|
|
127 and the on-each flags when they apply.
|
|
|
128 No automatic redisplay is attempted, as the file names may have
|
|
|
129 changed. Type \\[dired-do-redisplay] to redisplay the marked files."
|
|
|
130 ;; Function dired-shell-stuff-it (called by dired-cd-wrap-it) does the
|
|
|
131 ;; actual file-name substitution and can be redefined for customization.
|
|
|
132 (interactive "P")
|
|
|
133 (let* ((on-each (equal arg 0))
|
|
|
134 (file-list (dired-mark-get-files t (if on-each nil arg)))
|
|
|
135 (prompt (concat (if in-background "& " "! ")
|
|
|
136 (if (or (and on-each dired-cd-on-each)
|
|
|
137 (and dired-cd-same-subdir
|
|
|
138 (not on-each)
|
|
|
139 (dired-files-same-directory file-list)))
|
|
|
140 "cd <dir>; " "")
|
|
|
141 "on "
|
|
|
142 (if on-each "each " "")
|
|
|
143 "%s: "))
|
|
|
144 ;; Give feedback on file(s) and working directory status
|
|
|
145 (command (dired-read-shell-command
|
|
|
146 prompt (if on-each nil arg) file-list))
|
|
|
147 (result (dired-cd-wrap-it command file-list on-each arg)))
|
|
|
148 ;; execute the shell command
|
|
|
149 (dired-run-shell-command result in-background)))
|
|
|
150
|
|
|
151 (defun dired-cd-wrap-it (command files on-each &optional raw)
|
|
|
152 "Args COMMAND FILES ON-EACH &optional RAW-ARG, like dired-shell-stuff-it.
|
|
|
153 Calls dired-shell-stuff-it, but wraps the resulting command\(s\)
|
|
|
154 with \"cd <dir>\" commands when appropriate. Note: when ON-EACH is non-nil,
|
|
|
155 dired-shell-stuff-it is called once for each file in FILES.
|
|
|
156 See documentation of variables dired-cd-same-subdir and dired-cd-on-each
|
|
|
157 for wrap conditions."
|
|
|
158 (if on-each;; command applied to each file separately
|
|
|
159 ;; cd's are done in subshells since all shells I know of have subshells
|
|
|
160 (let* ((cwd "");; current working directory
|
|
|
161 (in-subshell nil)
|
|
|
162 (cmd (mapconcat;; files over command, fuss with "cd <dir>"
|
|
|
163 (function
|
|
|
164 (lambda (file)
|
|
|
165 (let ((cd "") d);; cd command and file's directory
|
|
|
166 (if (not dired-cd-on-each) nil;; poor man's (when ...)
|
|
|
167 (setq d;; directory, relative to default-directory
|
|
|
168 (directory-file-name
|
|
|
169 (or (file-name-directory file) ""))
|
|
|
170 file (file-name-nondirectory file))
|
|
|
171 (if (not (string= d cwd));; new subdir, new subshell
|
|
|
172 (setq cwd d
|
|
|
173 ;; close existing subshell,
|
|
|
174 ;; open a new one
|
|
|
175 cd (concat (if in-subshell "); " "")
|
|
|
176 "(cd " (shell-quote cwd) "; ")
|
|
|
177 in-subshell t))
|
|
|
178 )
|
|
|
179 ;; existing dired-shell-stuff-it does
|
|
|
180 ;; actual command substitution
|
|
|
181 (concat cd (dired-shell-stuff-it command (list file)
|
|
|
182 on-each raw)))))
|
|
|
183 files "; ")))
|
|
|
184 (if in-subshell (concat cmd ")") cmd));; close an open subshell
|
|
|
185
|
|
|
186 ;; not on-each, all files are args to single command instance
|
|
|
187 (let ((same-dir (and dired-cd-same-subdir
|
|
|
188 (dired-files-same-directory files nil)))
|
|
|
189 (cd ""))
|
|
|
190 ;; Let the prepended cd command be relative to default-directory,
|
|
|
191 ;; and only give it if necessary. This way, after ange-ftp
|
|
|
192 ;; prepends its own cd command, it will still work.
|
|
|
193 ;; sk 3-Sep-1991 14:23
|
|
|
194 ;; hsw 31-Oct-1991 -- filenames relative to default-directory
|
|
|
195 (if (and same-dir (not (equal same-dir "")))
|
|
|
196 (setq files (mapcar (function file-name-nondirectory) files)
|
|
|
197 cd (concat "cd " (shell-quote same-dir) "; ")))
|
|
|
198 ;; existing dired-shell-stuff-it does the command substitution
|
|
|
199 (concat cd (dired-shell-stuff-it command files on-each raw)))))
|
|
|
200
|
|
|
201 (defun dired-files-same-directory (file-list &optional absolute)
|
|
|
202 "If all files in LIST are in the same directory return it, otherwise nil.
|
|
|
203 Returned name has no trailing slash. \"Same\" means file-name-directory of
|
|
|
204 the files are string=. File names in LIST must all be absolute or all be
|
|
|
205 relative. Implicitly, relative file names are in default-directory. If
|
|
|
206 optional ABS is non-nil, the returned name will be absolute, otherwise the
|
|
|
207 returned name will be absolute or relative as per the files in LIST."
|
|
|
208 (let ((dir (file-name-directory (car file-list))))
|
|
|
209 (if (memq nil (mapcar (function
|
|
|
210 (lambda (file)
|
|
|
211 (string= dir (file-name-directory file))))
|
|
|
212 file-list))
|
|
|
213 nil
|
|
|
214 (directory-file-name
|
|
|
215 (if (or (not absolute) (and dir (file-name-absolute-p dir)))
|
|
|
216 (or dir "")
|
|
|
217 (concat default-directory dir))))))
|
|
|
218
|
|
|
219 (provide 'dired-cd)
|
