Mercurial > hg > xemacs-beta

comparison lisp/efs/default-dir.el @ 114:8619ce7e4c50 r20-1b9

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-1b9
author cvs
date Mon, 13 Aug 2007 09:21:54 +0200
parents 4be1180a9e89
children 9f59509498e1
comparison
equal deleted inserted replaced
113:2ec2fe4a4c89 114:8619ce7e4c50
1 ;; -*-Emacs-Lisp-*- 1 ;; -*-Emacs-Lisp-*-
2 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3 ;; 3 ;;
4 ;; File: default-dir.el 4 ;; File: default-dir.el
5 ;; RCS: 5 ;; RCS:
6 ;; Version: $Revision: 1.3 $ 6 ;; Version: $Revision: 1.4 $
7 ;; Description: Defines the function default-directory, for fancy handling 7 ;; Description: Defines the function default-directory, for fancy handling
8 ;; of the initial contents in the minibuffer when reading 8 ;; of the initial contents in the minibuffer when reading
9 ;; file names. 9 ;; file names.
10 ;; Authors: Sebastian Kremer <sk@thp.uni-koeln.de> 10 ;; Authors: Sebastian Kremer <sk@thp.uni-koeln.de>
11 ;; Sandy Rutherford <sandy@ibm550.sissa.it> 11 ;; Sandy Rutherford <sandy@ibm550.sissa.it>
56 (abbreviate-file-name default-directory t) 56 (abbreviate-file-name default-directory t)
57 (abbreviate-file-name default-directory)))) 57 (abbreviate-file-name default-directory))))
58 58
59 ;;; Overloads 59 ;;; Overloads
60 60
61 (if (or (featurep 'mule) 61 (cond
62 (boundp 'MULE)) 62 ((or (featurep 'mule)
63 (progn 63 (boundp 'MULE))
64 64
65 (defun default-dir-find-file (file &optional coding-system) 65 (defun default-dir-find-file (file &optional coding-system)
66 "Documented as original" 66 "Documented as original"
67 (interactive 67 (interactive
68 (list 68 (list
69 (expand-file-name 69 (expand-file-name
70 (read-file-name "Find file: " (default-directory))) 70 (read-file-name "Find file: " (default-directory)))
71 (and current-prefix-arg 71 (and current-prefix-arg
72 (read-coding-system "Coding-system: ")))) 72 (read-coding-system "Coding-system: "))))
73 (default-dir-real-find-file file coding-system)) 73 (default-dir-real-find-file file coding-system))
74 74
75 (defun default-dir-find-file-other-window (file &optional coding-system) 75 (defun default-dir-find-file-other-window (file &optional coding-system)
76 "Documented as original" 76 "Documented as original"
77 (interactive 77 (interactive
78 (list 78 (list
79 (expand-file-name 79 (expand-file-name
80 (read-file-name "Find file in other window: " (default-directory))) 80 (read-file-name "Find file in other window: " (default-directory)))
81 (and current-prefix-arg 81 (and current-prefix-arg
82 (read-coding-system "Coding-system: ")))) 82 (read-coding-system "Coding-system: "))))
83 (default-dir-real-find-file-other-window file coding-system)) 83 (default-dir-real-find-file-other-window file coding-system))
84 84
85 (defun default-dir-find-file-read-only (file &optional coding-system) 85 (defun default-dir-find-file-read-only (file &optional coding-system)
86 "Documented as original" 86 "Documented as original"
87 (interactive 87 (interactive
88 (list 88 (list
89 (expand-file-name 89 (expand-file-name
90 (read-file-name "Find file read-only: " (default-directory) nil t)) 90 (read-file-name "Find file read-only: " (default-directory) nil t))
91 (and current-prefix-arg 91 (and current-prefix-arg
92 (read-coding-system "Coding-system: ")))) 92 (read-coding-system "Coding-system: "))))
93 (default-dir-real-find-file-read-only file coding-system)) 93 (default-dir-real-find-file-read-only file coding-system))
94 94
95 (if (fboundp 'find-file-read-only-other-window) 95 (if (fboundp 'find-file-read-only-other-window)
96 (progn 96 (progn
97 (defun default-dir-find-file-read-only-other-window 97 (defun default-dir-find-file-read-only-other-window
98 (file &optional coding-system) 98 (file &optional coding-system)
99 "Documented as original" 99 "Documented as original"
100 (interactive 100 (interactive
101 (list 101 (list
102 (expand-file-name 102 (expand-file-name
103 (read-file-name 103 (read-file-name
104 "Find file read-only in other window: " 104 "Find file read-only in other window: "
105 (default-directory) nil t)) 105 (default-directory) nil t))
106 (and current-prefix-arg 106 (and current-prefix-arg
107 (read-coding-system "Coding-system: ")))) 107 (read-coding-system "Coding-system: "))))
108 (default-dir-real-find-file-read-only-other-window file 108 (default-dir-real-find-file-read-only-other-window file
109 coding-system)))) 109 coding-system))))
110 110
111 (if (fboundp 'find-file-other-frame) 111 (if (fboundp 'find-file-other-frame)
112 (progn 112 (progn
113 (defun default-dir-find-file-other-frame 113 (defun default-dir-find-file-other-frame
114 (file &optional coding-system) 114 (file &optional coding-system)
115 "Documented as original" 115 "Documented as original"
116 (interactive 116 (interactive
117 (list 117 (list
118 (expand-file-name 118 (expand-file-name
119 (read-file-name "Find file in other frame: " 119 (read-file-name "Find file in other frame: "
120 (default-directory))) 120 (default-directory)))
121 (and current-prefix-arg 121 (and current-prefix-arg
122 (read-coding-system "Coding-system: ")))) 122 (read-coding-system "Coding-system: "))))
123 (default-dir-real-find-file-other-frame file 123 (default-dir-real-find-file-other-frame file
124 coding-system)))) 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 (default-dir-find-file-takes-coding-system
142 ;; This lossage is due to the fact that XEmacs 20.x without mule
143 ;; still accepts an optional argument for find-file related
144 ;; functions. Things like advice.el insist on passing nil for
145 ;; optional arguments, and the interaction screws things up.
146 ;; Therefore these functions accept an optional dummy coding-system
147 ;; argument.
148
149 (defun default-dir-find-file (file &optional coding-system)
150 "Documented as original"
151 (interactive
152 (list
153 (expand-file-name
154 (read-file-name "Find file: " (default-directory)))))
155 (default-dir-real-find-file file coding-system))
125 156
126 (if (fboundp 'find-file-read-only-other-frame) 157 (defun default-dir-find-file-other-window (file &optional coding-system)
127 (progn 158 "Documented as original"
128 (defun default-dir-find-file-read-only-other-frame 159 (interactive
129 (file &optional coding-system) 160 (list
130 "Documented as original" 161 (expand-file-name
131 (interactive 162 (read-file-name "Find file in other window: " (default-directory)))))
132 (list 163 (default-dir-real-find-file-other-window file coding-system))
133 (expand-file-name 164
134 (read-file-name "Find file read-only in other frame: " 165 (defun default-dir-find-file-read-only (file &optional coding-system)
135 (default-directory) nil t)) 166 "Documented as original"
136 (and current-prefix-arg 167 (interactive
137 (read-coding-system "Coding-system: ")))) 168 (list
138 (default-dir-real-find-file-read-only-other-frame file 169 (expand-file-name
139 coding-system))))) 170 (read-file-name "Find file read-only: " (default-directory) nil t))))
140 171 (default-dir-real-find-file-read-only file coding-system))
172
173 (if (fboundp 'find-file-read-only-other-window)
174 (progn
175 (defun default-dir-find-file-read-only-other-window
176 (file &optional coding-system)
177 "Documented as original"
178 (interactive
179 (list
180 (expand-file-name
181 (read-file-name
182 "Find file read-only in other window: "
183 (default-directory) nil t))))
184 (default-dir-real-find-file-read-only-other-window file))))
185
186 (if (fboundp 'find-file-other-frame)
187 (progn
188 (defun default-dir-find-file-other-frame
189 (file &optional coding-system)
190 "Documented as original"
191 (interactive
192 (list
193 (expand-file-name
194 (read-file-name "Find file in other frame: "
195 (default-directory)))))
196 (default-dir-real-find-file-other-frame file))))
197
198 (if (fboundp 'find-file-read-only-other-frame)
199 (progn
200 (defun default-dir-find-file-read-only-other-frame
201 (file &optional coding-system)
202 "Documented as original"
203 (interactive
204 (list
205 (expand-file-name
206 (read-file-name "Find file read-only in other frame: "
207 (default-directory) nil t))))
208 (default-dir-real-find-file-read-only-other-frame file)))))
209
210 (t
141 (defun default-dir-find-file (file) 211 (defun default-dir-find-file (file)
142 "Documented as original" 212 "Documented as original"
143 (interactive 213 (interactive
144 (list 214 (list
145 (expand-file-name 215 (expand-file-name
192 (interactive 262 (interactive
193 (list 263 (list
194 (expand-file-name 264 (expand-file-name
195 (read-file-name "Find file read-only in other frame: " 265 (read-file-name "Find file read-only in other frame: "
196 (default-directory) nil t)))) 266 (default-directory) nil t))))
197 (default-dir-real-find-file-read-only-other-frame file))))) 267 (default-dir-real-find-file-read-only-other-frame file))))))
268
269
198 270
199 (efs-overwrite-fn "default-dir" 'find-file 'default-dir-find-file) 271 (efs-overwrite-fn "default-dir" 'find-file 'default-dir-find-file)
200 (efs-overwrite-fn "default-dir" 'find-file-other-window 272 (efs-overwrite-fn "default-dir" 'find-file-other-window
201 'default-dir-find-file-other-window) 273 'default-dir-find-file-other-window)
202 (if (fboundp 'find-file-other-frame) 274 (if (fboundp 'find-file-other-frame)
280 (let ((default-directory (expand-file-name (default-directory)))) 352 (let ((default-directory (expand-file-name (default-directory))))
281 (default-dir-real-shell-command command insert))) 353 (default-dir-real-shell-command command insert)))
282 354
283 (efs-overwrite-fn "default-dir" 'shell-command 'default-dir-shell-command) 355 (efs-overwrite-fn "default-dir" 'shell-command 'default-dir-shell-command)
284 356
285 ;; Is advice about? 357 (defun default-dir-cd (dir)
286 (if (featurep 'advice) 358 "Documented as original"
287 (defadvice cd (before default-dir-cd activate compile) 359 (interactive
288 (interactive 360 (list
289 (list 361 (expand-file-name
290 (expand-file-name 362 (read-file-name "Change default directory: " (default-directory)))))
291 (read-file-name "Change default directory: " (default-directory)))))) 363 (default-dir-real-cd dir))
292 364
293 (defun default-dir-cd (dir) 365 (efs-overwrite-fn "default-dir" 'cd 'default-dir-cd)
294 "Documented as original"
295 (interactive
296 (list
297 (expand-file-name
298 (read-file-name "Change default directory: " (default-directory)))))
299 (default-dir-real-cd dir))
300
301 (efs-overwrite-fn "default-dir" 'cd 'default-dir-cd))
302 366
303 (defun default-dir-set-visited-file-name (filename) 367 (defun default-dir-set-visited-file-name (filename)
304 "Documented as original" 368 "Documented as original"
305 (interactive 369 (interactive
306 (list 370 (list