Mercurial > hg > xemacs-beta

comparison lisp/efs/default-dir.el @ 22:8fc7fe29b841 r19-15b94

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b94
author cvs
date Mon, 13 Aug 2007 08:50:29 +0200
parents
children 4103f0995bd7
comparison
equal deleted inserted replaced
21:b88636d63495 22:8fc7fe29b841
1 ;; -*-Emacs-Lisp-*-
2 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3 ;;
4 ;; File: default-dir.el
5 ;; RCS:
6 ;; Version: $Revision: 1.5 $
7 ;; Description: Defines the function default-directory, for fancy handling
8 ;; of the initial contents in the minibuffer when reading
9 ;; file names.
10 ;; Authors: Sebastian Kremer <sk@thp.uni-koeln.de>
11 ;; Sandy Rutherford <sandy@ibm550.sissa.it>
12 ;; Created: Sun Jul 18 11:38:06 1993 by sandy on ibm550
13 ;;
14 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
15
16 ;; This program is free software; you can redistribute it and/or modify
17 ;; it under the terms of the GNU General Public License as published by
18 ;; the Free Software Foundation; either version 1, or (at your option)
19 ;; any later version.
20
21 ;; This program is distributed in the hope that it will be useful,
22 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
23 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
24 ;; GNU General Public License for more details.
25
26 ;; You should have received a copy of the GNU General Public License
27 ;; along with GNU Emacs; see the file COPYING. If not, write to
28 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
29
30 (provide 'default-dir)
31 (require 'efs-ovwrt)
32
33 (defconst default-dir-emacs-variant
34 (cond ((string-match "XEmacs" emacs-version) 'xemacs)
35 ((>= (string-to-int (substring emacs-version 0 2)) 19) 'fsf-19)
36 (t 'fsf-18)))
37
38 ;;;###autoload
39 (defvar default-directory-function nil
40 "A function to call to compute the default-directory for the current buffer.
41 If this is nil, the function default-directory will return the value of the
42 variable default-directory.
43 Buffer local.")
44 (make-variable-buffer-local 'default-directory-function)
45
46 ;; As a bonus we give shell-command history if possible.
47 (defvar shell-command-history nil
48 "History list of previous shell commands.")
49
50 (defun default-directory ()
51 " Returns the default-directory for the current buffer.
52 Will use the variable default-directory-function if it non-nil."
53 (if default-directory-function
54 (funcall default-directory-function)
55 (if (eq default-dir-emacs-version 'xemacs)
56 (abbreviate-file-name default-directory t)
57 (abbreviate-file-name default-directory))))
58
59 ;;; Overloads
60
61 (if (or (featurep 'mule)
62 (boundp 'MULE))
63 (progn
64
65 (defun default-dir-find-file (file &optional coding-system)
66 "Documented as original"
67 (interactive
68 (list
69 (expand-file-name
70 (read-file-name "Find file: " (default-directory)))
71 (and current-prefix-arg
72 (read-coding-system "Coding-system: "))))
73 (default-dir-real-find-file file coding-system))
74
75 (defun default-dir-find-file-other-window (file &optional coding-system)
76 "Documented as original"
77 (interactive
78 (list
79 (expand-file-name
80 (read-file-name "Find file in other window: " (default-directory)))
81 (and current-prefix-arg
82 (read-coding-system "Coding-system: "))))
83 (default-dir-real-find-file-other-window file coding-system))
84
85 (defun default-dir-find-file-read-only (file &optional coding-system)
86 "Documented as original"
87 (interactive
88 (list
89 (expand-file-name
90 (read-file-name "Find file read-only: " (default-directory) nil t))
91 (and current-prefix-arg
92 (read-coding-system "Coding-system: "))))
93 (default-dir-real-find-file-read-only file coding-system))
94
95 (if (fboundp 'find-file-read-only-other-window)
96 (progn
97 (defun default-dir-find-file-read-only-other-window
98 (file &optional coding-system)
99 "Documented as original"
100 (interactive
101 (list
102 (expand-file-name
103 (read-file-name
104 "Find file read-only in other window: "
105 (default-directory) nil t))
106 (and current-prefix-arg
107 (read-coding-system "Coding-system: "))))
108 (default-dir-real-find-file-read-only-other-window file
109 coding-system))))
110
111 (if (fboundp 'find-file-other-frame)
112 (progn
113 (defun default-dir-find-file-other-frame
114 (file &optional coding-system)
115 "Documented as original"
116 (interactive
117 (list
118 (expand-file-name
119 (read-file-name "Find file in other frame: "
120 (default-directory)))
121 (and current-prefix-arg
122 (read-coding-system "Coding-system: "))))
123 (default-dir-real-find-file-other-frame file
124 coding-system))))
125
126 (if (fboundp 'find-file-read-only-other-frame)
127 (progn
128 (defun default-dir-find-file-read-only-other-frame
129 (file &optional coding-system)
130 "Documented as original"
131 (interactive
132 (list
133 (expand-file-name
134 (read-file-name "Find file read-only in other frame: "
135 (default-directory) nil t))
136 (and current-prefix-arg
137 (read-coding-system "Coding-system: "))))
138 (default-dir-real-find-file-read-only-other-frame file
139 coding-system)))))
140
141 (defun default-dir-find-file (file)
142 "Documented as original"
143 (interactive
144 (list
145 (expand-file-name
146 (read-file-name "Find file: " (default-directory)))))
147 (default-dir-real-find-file file))
148
149 (defun default-dir-find-file-other-window (file)
150 "Documented as original"
151 (interactive
152 (list
153 (expand-file-name
154 (read-file-name "Find file in other window: " (default-directory)))))
155 (default-dir-real-find-file-other-window file))
156
157 (defun default-dir-find-file-read-only (file)
158 "Documented as original"
159 (interactive
160 (list
161 (expand-file-name
162 (read-file-name "Find file read-only: " (default-directory) nil t))))
163 (default-dir-real-find-file-read-only file))
164
165 (if (fboundp 'find-file-read-only-other-window)
166 (progn
167 (defun default-dir-find-file-read-only-other-window (file)
168 "Documented as original"
169 (interactive
170 (list
171 (expand-file-name
172 (read-file-name
173 "Find file read-only in other window: "
174 (default-directory) nil t))))
175 (default-dir-real-find-file-read-only-other-window file))))
176
177 (if (fboundp 'find-file-other-frame)
178 (progn
179 (defun default-dir-find-file-other-frame (file)
180 "Documented as original"
181 (interactive
182 (list
183 (expand-file-name
184 (read-file-name "Find file in other frame: "
185 (default-directory)))))
186 (default-dir-real-find-file-other-frame file))))
187
188 (if (fboundp 'find-file-read-only-other-frame)
189 (progn
190 (defun default-dir-find-file-read-only-other-frame (file)
191 "Documented as original"
192 (interactive
193 (list
194 (expand-file-name
195 (read-file-name "Find file read-only in other frame: "
196 (default-directory) nil t))))
197 (default-dir-real-find-file-read-only-other-frame file)))))
198
199 (efs-overwrite-fn "default-dir" 'find-file 'default-dir-find-file)
200 (efs-overwrite-fn "default-dir" 'find-file-other-window
201 'default-dir-find-file-other-window)
202 (if (fboundp 'find-file-other-frame)
203 (efs-overwrite-fn "default-dir" 'find-file-other-frame
204 'default-dir-find-file-other-frame))
205 (efs-overwrite-fn "default-dir" 'find-file-read-only
206 'default-dir-find-file-read-only)
207 (if (fboundp 'find-file-read-only-other-window)
208 (efs-overwrite-fn "default-dir" 'find-file-read-only-other-window
209 'default-dir-find-file-read-only-other-window))
210 (if (fboundp 'find-file-read-only-other-frame)
211 (efs-overwrite-fn "default-dir" 'find-file-read-only-other-frame
212 'default-dir-find-file-read-only-other-frame))
213
214
215 (defun default-dir-load-file (file)
216 "Documented as original"
217 (interactive
218 (list
219 (expand-file-name
220 (read-file-name "Load file: " (default-directory) nil t))))
221 (default-dir-real-load-file file))
222
223 (efs-overwrite-fn "default-dir" 'load-file 'default-dir-load-file)
224
225 (require 'view)
226
227 (defun default-dir-view-file (file)
228 "Documented as original"
229 (interactive
230 (list
231 (expand-file-name
232 (read-file-name "View file: " (default-directory) nil t))))
233 (default-dir-real-view-file file))
234
235 (efs-overwrite-fn "default-dir" 'view-file 'default-dir-view-file)
236
237 (if (fboundp 'view-file-other-window)
238 (progn
239 (defun default-dir-view-file-other-window (file)
240 "Documented as original"
241 (interactive
242 (list
243 (expand-file-name
244 (read-file-name "View file in other window: "
245 (default-directory) nil t))))
246 (default-dir-real-view-file-other-window file))
247 (efs-overwrite-fn "default-dir" 'view-file-other-window
248 'default-dir-view-file-other-window)))
249
250 (if (fboundp 'view-file-other-frame)
251 (progn
252 (defun default-dir-view-file-other-frame (file)
253 "Documented as original"
254 (interactive
255 (list
256 (expand-file-name
257 (read-file-name "View file in other frame: "
258 (default-directory) nil t))))
259 (default-dir-real-view-file-other-frame file))
260 (efs-overwrite-fn "default-dir" 'view-file-other-frame
261 'default-dir-view-file-other-frame)))
262
263
264 (defun default-dir-shell-command (command &optional insert)
265 "Documented as original"
266 (interactive
267 (list
268 (let ((prompt (format "Shell command in %s: " (default-directory))))
269 (cond
270 ((memq default-dir-emacs-variant '(fsf-19 xemacs))
271 (read-from-minibuffer prompt nil nil nil
272 'shell-command-history))
273 ((featurep 'gmhist)
274 (let ((minibuffer-history-symbol 'shell-command-history))
275 (read-string prompt)))
276 (t (read-string prompt))))
277 current-prefix-arg))
278 (let ((default-directory (expand-file-name (default-directory))))
279 (default-dir-real-shell-command command insert)))
280
281 (efs-overwrite-fn "default-dir" 'shell-command 'default-dir-shell-command)
282
283 ;; Is advice about?
284 (if (featurep 'advice)
285 (defadvice cd (before default-dir-cd activate compile)
286 (interactive
287 (list
288 (expand-file-name
289 (read-file-name "Change default directory: " (default-directory))))))
290
291 (defun default-dir-cd (dir)
292 "Documented as original"
293 (interactive
294 (list
295 (expand-file-name
296 (read-file-name "Change default directory: " (default-directory)))))
297 (default-dir-real-cd dir))
298
299 (efs-overwrite-fn "default-dir" 'cd 'default-dir-cd))
300
301 (defun default-dir-set-visited-file-name (filename)
302 "Documented as original"
303 (interactive
304 (list
305 (expand-file-name
306 (read-file-name "Set visited file name: " (default-directory)))))
307 (default-dir-real-set-visited-file-name filename))
308
309 (efs-overwrite-fn "default-dir" 'set-visited-file-name
310 'default-dir-set-visited-file-name)
311
312 (defun default-dir-insert-file (filename &rest args)
313 "Documented as original"
314 (interactive
315 (list
316 (expand-file-name
317 (read-file-name "Insert file: " (default-directory) nil t))))
318 (apply 'default-dir-real-insert-file filename args))
319
320 (efs-overwrite-fn "default-dir" 'insert-file 'default-dir-insert-file)
321
322 (defun default-dir-append-to-file (start end filename &rest args)
323 "Documented as original"
324 (interactive
325 (progn
326 (or (mark) (error "The mark is not set now"))
327 (list
328 (min (mark) (point))
329 (max (mark) (point))
330 (expand-file-name
331 (read-file-name "Append to file: " (default-directory))))))
332 (apply 'default-dir-real-append-to-file start end filename args))
333
334 (efs-overwrite-fn "default-dir" 'append-to-file 'default-dir-append-to-file)
335
336 (defun default-dir-delete-file (file)
337 "Documented as original"
338 (interactive
339 (list
340 (expand-file-name
341 (read-file-name "Delete file: " (default-directory) nil t))))
342 (default-dir-real-delete-file file))
343
344 (efs-overwrite-fn "default-dir" 'delete-file 'default-dir-delete-file)
345
346 ;;; end of default-dir.el