22
|
1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
2 ;;
|
|
3 ;; File: dired-fsf.el
|
|
4 ;; Dired Version: $Revision: 1.1 $
|
|
5 ;; RCS:
|
|
6 ;; Description: dired functions for V19 of the original GNU Emacs from FSF
|
|
7 ;; Created: Sat Jan 29 01:38:49 1994 by sandy on ibm550
|
|
8 ;;
|
|
9 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
10
|
|
11 ;;;; Requirements and provisions
|
|
12 (provide 'dired-fsf)
|
|
13 (require 'dired)
|
|
14
|
|
15 ;;;; Variables to set.
|
|
16
|
|
17 (setq dired-modeline-tracking-cmds '(mouse-set-point))
|
|
18
|
|
19 ;;;; Support for text properties
|
|
20
|
|
21 (defun dired-insert-set-properties (beg end)
|
|
22 ;; Sets the text properties for the file names.
|
|
23 (save-excursion
|
|
24 (goto-char beg)
|
|
25 (beginning-of-line)
|
|
26 (let ((eol (save-excursion (end-of-line) (point)))
|
|
27 (bol (point)))
|
|
28 (while (< (point) end)
|
|
29 (setq eol (save-excursion (end-of-line) (point)))
|
|
30 (if (dired-manual-move-to-filename nil bol eol)
|
|
31 (dired-set-text-properties
|
|
32 (point) (dired-manual-move-to-end-of-filename nil bol eol)))
|
|
33 (goto-char (setq bol (1+ eol)))))))
|
|
34
|
|
35 (defun dired-remove-text-properties (start end &optional object)
|
|
36 ;; Removes text properties. Called in popup buffers.
|
|
37 (remove-text-properties start end '(mouse-face dired-file-name) object))
|
|
38
|
|
39 (defun dired-set-text-properties (start end)
|
|
40 ;; Sets dired's text properties
|
|
41 (put-text-property start end 'mouse-face 'highlight)
|
|
42 (put-text-property start end 'dired-file-name t))
|
|
43
|
|
44 (defun dired-move-to-filename (&optional raise-error bol eol)
|
|
45 (or bol (setq bol (save-excursion
|
|
46 (skip-chars-backward "^\n\r")
|
|
47 (point))))
|
|
48 (or eol (setq eol (save-excursion
|
|
49 (skip-chars-forward "^\n\r")
|
|
50 (point))))
|
|
51 (goto-char bol)
|
|
52 (let ((spot (next-single-property-change bol 'dired-file-name nil eol)))
|
|
53 (if (= spot eol)
|
|
54 (if raise-error
|
|
55 (error "No file on this line")
|
|
56 nil)
|
|
57 (goto-char spot))))
|
|
58
|
|
59 (defun dired-move-to-end-of-filename (&optional no-error bol eol)
|
|
60 ;; Assumes point is at beginning of filename,
|
|
61 ;; thus the rwx bit re-search-backward below will succeed in *this*
|
|
62 ;; line if at all. So, it should be called only after
|
|
63 ;; (dired-move-to-filename t).
|
|
64 ;; On failure, signals an error (with non-nil NO-ERROR just returns nil).
|
|
65 (or eol (setq eol (save-excursion (skip-chars-forward "^\r\n") (point))))
|
|
66 (and
|
|
67 (null no-error)
|
|
68 selective-display
|
|
69 (or bol (setq bol (save-excursion (skip-chars-backward "^\r\n") (point))))
|
|
70 (eq (char-after (1- bol)) ?\r)
|
|
71 (cond
|
|
72 ((dired-subdir-hidden-p (dired-current-directory))
|
|
73 (error
|
|
74 (substitute-command-keys
|
|
75 "File line is hidden. Type \\[dired-hide-subdir] to unhide.")))
|
|
76 ((error
|
|
77 (substitute-command-keys
|
|
78 "File line is omitted. Type \\[dired-omit-toggle] to un-omit.")))))
|
|
79 (if (get-text-property (point) 'dired-file-name nil)
|
|
80 (goto-char (next-single-property-change (point) 'dired-file-name
|
|
81 nil eol))
|
|
82 (and (null no-error) (error "No file on this line"))))
|
|
83
|
|
84 ;; Text properties do not work properly in pre-19.26.
|
|
85
|
|
86 (if (or (not (boundp 'emacs-major-version))
|
|
87 (= emacs-major-version 19))
|
|
88 (progn
|
|
89 (if (not (boundp 'emacs-minor-version))
|
|
90 ;; Argument structure of where-is-internal went through some
|
|
91 ;; changes.
|
|
92 (defun dired-key-description (cmd &rest prefixes)
|
|
93 ;; Return a key description string for a menu.
|
|
94 ;; If prefixes are given, they should be either strings,
|
|
95 ;; integers, or 'universal-argument.
|
|
96 (let ((key (where-is-internal cmd dired-mode-map nil t)))
|
|
97 (if key
|
|
98 (key-description
|
|
99 (apply 'vconcat
|
|
100 (append
|
|
101 (mapcar
|
|
102 (function
|
|
103 (lambda (x)
|
|
104 (if (eq x 'universal-argument)
|
|
105 (where-is-internal 'universal-argument
|
|
106 dired-mode-map nil t)
|
|
107 x)))
|
|
108 prefixes)
|
|
109 (list key))))
|
|
110 ""))))
|
|
111 (if (or (not (boundp 'emacs-minor-version))
|
|
112 (< emacs-minor-version 26))
|
|
113 (progn
|
|
114 (fset 'dired-insert-set-properties 'ignore)
|
|
115 (fset 'dired-remove-text-properties 'ignore)
|
|
116 (fset 'dired-set-text-properties 'ignore)
|
|
117 (fset 'dired-move-to-filename 'dired-manual-move-to-filename)
|
|
118 (fset 'dired-move-to-end-of-filename
|
|
119 'dired-manual-move-to-end-of-filename)))))
|
|
120
|
|
121 ;;;; Keymaps
|
|
122
|
|
123 ;;; Caching Menus
|
|
124
|
|
125 (defun dired-menu-item (menu-item cmd width &rest prefixes)
|
|
126 ;; Return a key description string for a menu. If prefixes are given,
|
|
127 ;; they should be either characters, or 'universal-argument.
|
|
128 (let ((desc (apply 'dired-key-description cmd prefixes)))
|
|
129 (if (string-equal desc "")
|
|
130 menu-item
|
|
131 (concat menu-item
|
|
132 (make-string
|
|
133 (max (- width (length menu-item) (length desc) 2) 1) 32)
|
|
134 "(" desc ")"))))
|
|
135
|
|
136 (defun dired-cache-key (keymap event cmd &rest prefixes)
|
|
137 ;; Caches a keybinding for cms in a menu keymap.
|
|
138 ;; This is able to handle prefix keys.
|
|
139 (let ((desc (apply 'dired-key-description cmd prefixes)))
|
|
140 (or (string-equal desc "")
|
|
141 (progn
|
|
142 (let ((elt (assq event keymap)))
|
|
143 (if elt
|
|
144 (let ((tail (cdr elt)))
|
|
145 (setcdr tail
|
|
146 (cons
|
|
147 (cons
|
|
148 nil (concat " (" desc ")"))
|
|
149 (cdr tail))))))))))
|
|
150
|
|
151 ;; Don't cache keys in old emacs versions. Is 23 the right cut-off point?
|
|
152 (if (or (not (boundp 'emacs-minor-version))
|
|
153 (< emacs-minor-version 23))
|
|
154 (fset 'dired-cache-key 'ignore))
|
|
155
|
|
156 (defvar dired-visit-popup-menu nil)
|
|
157 ;; Menus of commands in the Visit popup menu.
|
|
158 (defvar dired-do-popup-menu nil)
|
|
159 ;; Menu of commands in the dired Do popup menu.
|
|
160
|
|
161 ;; Menus for the menu bar.
|
|
162 (defvar dired-subdir-menu
|
|
163 (cons "Subdir" (make-sparse-keymap "Subdir")))
|
|
164 (defvar dired-mark-menu
|
|
165 (cons "Mark" (make-sparse-keymap "Mark")))
|
|
166 (defvar dired-do-menu
|
|
167 (cons "Do" (make-sparse-keymap "Do")))
|
|
168 (defvar dired-regex-menu
|
|
169 (cons "Regexp" (make-sparse-keymap "Regex")))
|
|
170 (defvar dired-look-menu
|
|
171 (cons "Look" (make-sparse-keymap "Look")))
|
|
172 (defvar dired-sort-menu
|
|
173 (cons "Sort" (make-sparse-keymap "Sort")))
|
|
174 (defvar dired-help-menu nil)
|
|
175
|
|
176 (defun dired-setup-menus ()
|
|
177
|
|
178 ;; popup menu
|
|
179
|
|
180 (setq dired-visit-popup-menu
|
|
181 (list
|
|
182 (cons (dired-menu-item "Find File" 'dired-find-file 35)
|
|
183 'dired-advertised-find-file)
|
|
184 (cons (dired-menu-item "Find in Other Window"
|
|
185 'dired-find-file-other-window 35)
|
|
186 'dired-find-file-other-window)
|
|
187 (cons (dired-menu-item "Find in Other Frame"
|
|
188 'dired-find-file-other-frame 35)
|
|
189 'dired-find-file-other-frame)
|
|
190 (cons (dired-menu-item "View File" 'dired-view-file 35)
|
|
191 'dired-view-file)
|
|
192 (cons (dired-menu-item "Display in Other Window"
|
|
193 'dired-find-file-other-window 35
|
|
194 'universal-argument)
|
|
195 'dired-display-file)))
|
|
196
|
|
197 ;; Operate popup menu
|
|
198
|
|
199 (setq dired-do-popup-menu
|
|
200 (list
|
|
201 (cons (dired-menu-item "Copy to..." 'dired-do-copy 35 1)
|
|
202 'dired-do-copy)
|
|
203 (cons (dired-menu-item "Rename to..." 'dired-do-rename 35 1)
|
|
204 'dired-do-rename)
|
|
205 (cons (dired-menu-item "Compress/Uncompress" 'dired-do-compress
|
|
206 35 1) 'dired-do-compress)
|
|
207 (cons (dired-menu-item "Uuencode/Uudecode" 'dired-do-uucode
|
|
208 35 1) 'dired-do-uucode)
|
|
209 (cons (dired-menu-item "Change Mode..." 'dired-do-chmod 35 1)
|
|
210 'dired-do-chmod)
|
|
211 (cons (dired-menu-item "Change Owner..." 'dired-do-chown 35 1)
|
|
212 'dired-do-chown)
|
|
213 (cons (dired-menu-item "Change Group..." 'dired-do-chgrp 35 1)
|
|
214 'dired-do-chgrp)
|
|
215 (cons (dired-menu-item "Load" 'dired-do-load 35 1)
|
|
216 'dired-do-load)
|
|
217 (cons (dired-menu-item "Byte-compile" 'dired-do-byte-compile 35 1)
|
|
218 'dired-do-byte-compile)
|
|
219 (cons (dired-menu-item "Hardlink to..." 'dired-do-hardlink 35 1)
|
|
220 'dired-do-hardlink)
|
|
221 (cons (dired-menu-item "Symlink to..." 'dired-do-symlink 35 1)
|
|
222 'dired-do-symlink)
|
|
223 (cons (dired-menu-item "Relative Symlink to..."
|
|
224 'dired-do-relsymlink 35 1)
|
|
225 'dired-do-relsymlink)
|
|
226 (cons (dired-menu-item "Shell Command..."
|
|
227 'dired-do-shell-command 35 1)
|
|
228 'dired-do-shell-command)
|
|
229 (cons (dired-menu-item "Background Shell Command..."
|
|
230 'dired-do-background-shell-command 35 1)
|
|
231 'dired-do-background-shell-command)
|
|
232 (cons (dired-menu-item "Delete" 'dired-do-delete 35 1)
|
|
233 'dired-do-delete)))
|
|
234
|
|
235 ;; Subdir Menu-bar Menu
|
|
236
|
|
237 (define-key dired-mode-map [menu-bar subdir] dired-subdir-menu)
|
|
238 (define-key dired-mode-map [menu-bar subdir uncompress-subdir-files]
|
|
239 (cons "Uncompress Compressed Files"
|
|
240 (function
|
|
241 (lambda () (interactive) (dired-compress-subdir-files t)))))
|
|
242 (dired-cache-key dired-subdir-menu 'uncompress-subdir-files
|
|
243 'dired-compress-subdir-files 'universal-argument)
|
|
244 (define-key dired-mode-map [menu-bar subdir compress-subdir-files]
|
|
245 '("Compress Uncompressed Files" . dired-compress-subdir-files))
|
|
246 (define-key dired-mode-map [menu-bar subdir flag]
|
|
247 '("Flag Files for Deletion" . dired-flag-subdir-files))
|
|
248 (define-key dired-mode-map [menu-bar subdir mark]
|
|
249 '("Mark Files" . dired-mark-subdir-files))
|
|
250 (define-key dired-mode-map [menu-bar subdir redisplay]
|
|
251 '("Redisplay Subdir" . dired-redisplay-subdir))
|
|
252 (define-key dired-mode-map [menu-bar subdir subdir-separator]
|
|
253 '("-- Commands on All Files in Subdir --"))
|
|
254 (define-key dired-mode-map [menu-bar subdir kill-subdir]
|
|
255 '("Kill This Subdir" . dired-kill-subdir))
|
|
256 (define-key dired-mode-map [menu-bar subdir create-directory]
|
|
257 '("Create Directory..." . dired-create-directory))
|
|
258 (define-key dired-mode-map [menu-bar subdir insert]
|
|
259 '("Insert This Subdir" . dired-maybe-insert-subdir))
|
|
260 (define-key dired-mode-map [menu-bar subdir down-dir]
|
|
261 '("Down Dir" . dired-down-directory))
|
|
262 (define-key dired-mode-map [menu-bar subdir up-dir]
|
|
263 '("Up Dir" . dired-up-directory))
|
|
264 (define-key dired-mode-map [menu-bar subdir prev-dirline]
|
|
265 '("Prev Dirline" . dired-prev-dirline))
|
|
266 (define-key dired-mode-map [menu-bar subdir next-dirline]
|
|
267 '("Next Dirline" . dired-next-dirline))
|
|
268 (define-key dired-mode-map [menu-bar subdir prev-subdir]
|
|
269 '("Prev Subdir" . dired-prev-subdir))
|
|
270 (define-key dired-mode-map [menu-bar subdir next-subdir]
|
|
271 '("Next Subdir" . dired-next-subdir))
|
|
272
|
|
273 ;; Mark Menu-bar Menu
|
|
274
|
|
275 (define-key dired-mode-map [menu-bar mark] dired-mark-menu)
|
|
276 (define-key dired-mode-map [menu-bar mark mark-from-compilation-buffer]
|
|
277 '("Mark Files from Compile Buffer..." . dired-mark-files-compilation-buffer))
|
|
278 (define-key dired-mode-map [menu-bar mark mark-from-other-buffer]
|
|
279 '("Mark Files from Other Dired" .
|
|
280 dired-mark-files-from-other-dired-buffer))
|
|
281 (define-key dired-mode-map [menu-bar mark mark-separator]
|
|
282 '("--"))
|
|
283 (define-key dired-mode-map [menu-bar mark marker-char-right]
|
|
284 '("Marker stack right" . dired-marker-stack-right))
|
|
285 (define-key dired-mode-map [menu-bar mark marker-char-left]
|
|
286 '("Marker stack left" . dired-marker-stack-left))
|
|
287 (define-key dired-mode-map [menu-bar mark restore-marker]
|
|
288 '("Restore marker char" . dired-restore-marker-char))
|
|
289 (define-key dired-mode-map [menu-bar mark add-marker]
|
|
290 '("Set new marker char..." . dired-set-marker-char))
|
|
291 (define-key dired-mode-map [menu-bar mark auto-save-files]
|
|
292 '("Flag Auto-save Files" . dired-flag-auto-save-files))
|
|
293 (define-key dired-mode-map [menu-bar mark backup-files]
|
|
294 '("Flag Backup Files" . dired-flag-backup-files))
|
|
295 (define-key dired-mode-map [menu-bar mark executables]
|
|
296 '("Mark Executables" . dired-mark-executables))
|
|
297 (define-key dired-mode-map [menu-bar mark directory]
|
|
298 '("Mark Old Backups" . dired-clean-directory))
|
|
299 (define-key dired-mode-map [menu-bar mark directories]
|
|
300 '("Mark Directories" . dired-mark-directories))
|
|
301 (define-key dired-mode-map [menu-bar mark symlinks]
|
|
302 '("Mark Symlinks" . dired-mark-symlinks))
|
|
303 (define-key dired-mode-map [menu-bar mark toggle]
|
|
304 (cons "Toggle Marks..."
|
|
305 (function (lambda () (interactive)
|
|
306 (let ((current-prefix-arg t))
|
|
307 (call-interactively 'dired-change-marks))))))
|
|
308 (dired-cache-key dired-mark-menu 'toggle 'dired-change-marks
|
|
309 'universal-argument)
|
|
310 (define-key dired-mode-map [menu-bar mark unmark-all]
|
|
311 '("Unmark All" . dired-unmark-all-files))
|
|
312 (define-key dired-mode-map [menu-bar mark marks]
|
|
313 '("Change Marks..." . dired-change-marks))
|
|
314 (define-key dired-mode-map [menu-bar mark prev]
|
|
315 '("Previous Marked" . dired-prev-marked-file))
|
|
316 (define-key dired-mode-map [menu-bar mark next]
|
|
317 '("Next Marked" . dired-next-marked-file))
|
|
318
|
|
319 ;; Do Menu-bar Menu
|
|
320
|
|
321 (define-key dired-mode-map [menu-bar do]
|
|
322 dired-do-menu)
|
|
323 (define-key dired-mode-map [menu-bar do do-popup]
|
|
324 (cons "Operate on file menu >"
|
|
325 'dired-do-popup-menu-internal))
|
|
326 (dired-cache-key dired-do-menu 'do-popup
|
|
327 'dired-do-popup-menu)
|
|
328 (define-key dired-mode-map [menu-bar do visit-popup]
|
|
329 (cons "Visit file menu >"
|
|
330 'dired-visit-popup-menu-internal))
|
|
331 (dired-cache-key dired-do-menu 'visit-popup
|
|
332 'dired-visit-popup-menu)
|
|
333 (define-key dired-mode-map [menu-bar do delete]
|
|
334 '("Delete Marked Files" . dired-do-delete))
|
|
335 (define-key dired-mode-map [menu-bar do background-command]
|
|
336 '("Background Shell Command..." . dired-do-background-shell-command))
|
|
337 (define-key dired-mode-map [menu-bar do command]
|
|
338 '("Shell Command..." . dired-do-shell-command))
|
|
339 (define-key dired-mode-map [menu-bar do symlink]
|
|
340 '("Symlink to..." . dired-do-symlink))
|
|
341 (define-key dired-mode-map [menu-bar do hardlink]
|
|
342 '("Hardlink to..." . dired-do-hardlink))
|
|
343 (define-key dired-mode-map [menu-bar do compile]
|
|
344 '("Byte-compile" . dired-do-byte-compile))
|
|
345 (define-key dired-mode-map [menu-bar do load]
|
|
346 '("Load" . dired-do-load))
|
|
347 (define-key dired-mode-map [menu-bar do chgrp]
|
|
348 '("Change Group..." . dired-do-chgrp))
|
|
349 (define-key dired-mode-map [menu-bar do chown]
|
|
350 '("Change Owner..." . dired-do-chown))
|
|
351 (define-key dired-mode-map [menu-bar do chmod]
|
|
352 '("Change Mode..." . dired-do-chmod))
|
|
353 (define-key dired-mode-map [menu-bar do print]
|
|
354 '("Print..." . dired-do-print))
|
|
355 (define-key dired-mode-map [menu-bar do uucode]
|
|
356 '("Uuencode/Uudecode" . dired-do-uucode))
|
|
357 (define-key dired-mode-map [menu-bar do compress]
|
|
358 '("Compress/Uncompress" . dired-do-compress))
|
|
359 (define-key dired-mode-map [menu-bar do expunge]
|
|
360 '("Expunge File Flagged for Deletion" . dired-expunge-deletions))
|
|
361 (define-key dired-mode-map [menu-bar do rename]
|
|
362 '("Rename to..." . dired-do-rename))
|
|
363 (define-key dired-mode-map [menu-bar do copy]
|
|
364 '("Copy to..." . dired-do-copy))
|
|
365
|
|
366 ;; Regex Menu-bar Menu
|
|
367
|
|
368 (define-key dired-mode-map [menu-bar regex] dired-regex-menu)
|
|
369 (define-key dired-mode-map [menu-bar regex show-omit-regexp]
|
|
370 (cons "Show Omit Regex"
|
|
371 (function
|
|
372 (lambda ()
|
|
373 (interactive)
|
|
374 (let ((current-prefix-arg 0))
|
|
375 (call-interactively 'dired-add-omit-regexp))))))
|
|
376 (dired-cache-key dired-regex-menu 'show-omit-regexp
|
|
377 'dired-add-omit-regexp 0)
|
|
378 (define-key dired-mode-map [menu-bar regex remove-omit-extension]
|
|
379 (cons "Remove Omit Extension..."
|
|
380 (function
|
|
381 (lambda ()
|
|
382 (interactive)
|
|
383 (let ((current-prefix-arg '(16)))
|
|
384 (call-interactively 'dired-add-omit-regexp))))))
|
|
385 (dired-cache-key dired-regex-menu 'remove-omit-extension
|
|
386 'dired-add-omit-regexp 'universal-argument
|
|
387 'universal-argument)
|
|
388 (define-key dired-mode-map [menu-bar regex add-omit-extension]
|
|
389 (cons "Add Omit Extension..."
|
|
390 (function
|
|
391 (lambda ()
|
|
392 (interactive)
|
|
393 (let ((current-prefix-arg '(4)))
|
|
394 (call-interactively 'dired-add-omit-regexp))))))
|
|
395 (dired-cache-key dired-regex-menu 'add-omit-extension
|
|
396 'dired-add-omit-regexp 'universal-argument)
|
|
397 (define-key dired-mode-map [menu-bar regex remove-omit-regexp]
|
|
398 (cons "Remove Omit Regex..."
|
|
399 (function
|
|
400 (lambda ()
|
|
401 (interactive)
|
|
402 (let ((current-prefix-arg 1))
|
|
403 (call-interactively 'dired-add-omit-regexp))))))
|
|
404 (dired-cache-key dired-regex-menu 'remove-omit-regexp
|
|
405 'dired-add-omit-regexp 1)
|
|
406 (define-key dired-mode-map [menu-bar regex add-omit-regexp]
|
|
407 '("Add Omit Regex..." . dired-add-omit-regexp))
|
|
408 (define-key dired-mode-map [menu-bar regex separator]
|
|
409 '("--"))
|
|
410 (define-key dired-mode-map [menu-bar regex relsymlink]
|
|
411 '("Relative Symlink..." . dired-do-relsymlink-regexp))
|
|
412 (define-key dired-mode-map [menu-bar regex symlink]
|
|
413 '("Symlink..." . dired-do-symlink-regexp))
|
|
414 (define-key dired-mode-map [menu-bar regex hardlink]
|
|
415 '("Hardlink..." . dired-do-hardlink-regexp))
|
|
416 (define-key dired-mode-map [menu-bar regex rename]
|
|
417 '("Rename..." . dired-do-rename-regexp))
|
|
418 (define-key dired-mode-map [menu-bar regex copy]
|
|
419 '("Copy..." . dired-do-copy-regexp))
|
|
420 (define-key dired-mode-map [menu-bar regex upcase]
|
|
421 '("Upcase" . dired-upcase))
|
|
422 (define-key dired-mode-map [menu-bar regex downcase]
|
|
423 '("Downcase" . dired-downcase))
|
|
424 (define-key dired-mode-map [menu-bar regex dired-flag-extension]
|
|
425 '("Flag Files with Extension..." . dired-flag-extension))
|
|
426 (define-key dired-mode-map [menu-bar regex flag]
|
|
427 '("Flag..." . dired-flag-files-regexp))
|
|
428 (define-key dired-mode-map [menu-bar regex mark-extension]
|
|
429 '("Mark Files with Extension..." . dired-mark-extension))
|
|
430 (define-key dired-mode-map [menu-bar regex mark]
|
|
431 '("Mark..." . dired-mark-files-regexp))
|
|
432
|
|
433 ;; Look Menu-bar Menu
|
|
434
|
|
435 (define-key dired-mode-map [menu-bar look] dired-look-menu)
|
|
436 (define-key dired-mode-map [menu-bar look patch]
|
|
437 '("Patch File" . dired-epatch))
|
|
438 (define-key dired-mode-map [menu-bar look ediff]
|
|
439 '("Ediff Files..." . dired-ediff))
|
|
440 (define-key dired-mode-map [menu-bar look emerge-with-ancestor]
|
|
441 '("Merge Files Having Common Ancestor..." . dired-emerge-with-ancestor))
|
|
442 (define-key dired-mode-map [menu-bar look emerge]
|
|
443 '("Merge Files..." . dired-emerge))
|
|
444 (define-key dired-mode-map [menu-bar look backup-diff]
|
|
445 '("Diff with Backup" . dired-backup-diff))
|
|
446 (define-key dired-mode-map [menu-bar look diff]
|
|
447 '("Diff File..." . dired-diff))
|
|
448 ;; Put in a separator line.
|
|
449 (define-key dired-mode-map [menu-bar look look-separator]
|
|
450 '("--"))
|
|
451 (define-key dired-mode-map [menu-bar look tags-query-replace]
|
|
452 '("Tags Query Replace..." . dired-do-tags-query-replace))
|
|
453 (define-key dired-mode-map [menu-bar look tags-search]
|
|
454 '("Tags Search for..." . dired-do-tags-search))
|
|
455 (define-key dired-mode-map [menu-bar look grep]
|
|
456 '("Grep for..." . dired-do-grep))
|
|
457
|
|
458 ;; Sort Menu-bar Menu
|
|
459
|
|
460 (define-key dired-mode-map [menu-bar sort] dired-sort-menu)
|
|
461 (define-key dired-mode-map [menu-bar sort redisplay-killed]
|
|
462 (cons "Redisplay Killed Lines"
|
|
463 (function (lambda () (interactive) (dired-do-kill-file-lines 0)))))
|
|
464 (dired-cache-key dired-sort-menu 'redisplay-killed
|
|
465 'dired-do-kill-file-lines 0)
|
|
466 (define-key dired-mode-map [menu-bar sort kill]
|
|
467 '("Kill Marked Lines" . dired-do-kill-file-lines))
|
|
468 (define-key dired-mode-map [menu-bar sort toggle-omit]
|
|
469 '("Toggle Omit" . dired-omit-toggle))
|
|
470 (define-key dired-mode-map [menu-bar sort hide-subdir]
|
|
471 '("Hide Subdir" . dired-hide-subdir))
|
|
472 (define-key dired-mode-map [menu-bar sort hide-all]
|
|
473 '("Hide All Subdirs" . dired-hide-all))
|
|
474 (define-key dired-mode-map [menu-bar sort sort-separator]
|
|
475 '("--"))
|
|
476 (define-key dired-mode-map [menu-bar sort entire-edit]
|
|
477 (cons "Edit Switches for Entire Buffer..."
|
|
478 (function (lambda () (interactive)
|
|
479 (dired-sort-toggle-or-edit '(16))))))
|
|
480 (dired-cache-key dired-sort-menu 'entire-edit
|
|
481 'dired-sort-toggle-or-edit 'universal-argument
|
|
482 'universal-argument)
|
|
483 (define-key dired-mode-map [menu-bar sort entire-name]
|
|
484 (cons "Sort Entire Buffer by Name"
|
|
485 (function (lambda () (interactive)
|
|
486 (dired-sort-toggle-or-edit 'name)))))
|
|
487 (dired-cache-key dired-sort-menu 'entire-name 'dired-sort-toggle-or-edit
|
|
488 'universal-argument)
|
|
489 (define-key dired-mode-map [menu-bar sort entire-date]
|
|
490 (cons "Sort Entire Buffer by Date"
|
|
491 (function (lambda () (interactive)
|
|
492 (dired-sort-toggle-or-edit 'date)))))
|
|
493 (dired-cache-key dired-sort-menu 'entire-date 'dired-sort-toggle-or-edit
|
|
494 'universal-argument)
|
|
495 (define-key dired-mode-map [menu-bar sort new-edit]
|
|
496 (cons "Edit Default Switches for Inserted Subdirs..."
|
|
497 (function (lambda () (interactive) (dired-sort-toggle-or-edit 2)))))
|
|
498 (dired-cache-key dired-sort-menu 'new-edit 'dired-sort-toggle-or-edit 2)
|
|
499 (define-key dired-mode-map [menu-bar sort edit]
|
|
500 (cons "Edit Switches for Current Subdir..."
|
|
501 (function (lambda () (interactive) (dired-sort-toggle-or-edit 1)))))
|
|
502 (dired-cache-key dired-sort-menu 'edit 'dired-sort-toggle-or-edit 1)
|
|
503 (define-key dired-mode-map [menu-bar sort show]
|
|
504 (cons "Show Current Switches"
|
|
505 (function (lambda () (interactive) (dired-sort-toggle-or-edit 0)))))
|
|
506 (dired-cache-key dired-sort-menu 'show 'dired-sort-toggle-or-edit 0)
|
|
507 (define-key dired-mode-map [menu-bar sort toggle]
|
|
508 '("Toggle Current Subdir by Name/Date" . dired-sort-toggle-or-edit))
|
|
509
|
|
510 ;; Help Menu-bar Menu
|
|
511
|
|
512 (or dired-help-menu
|
|
513 (setq dired-help-menu
|
|
514 (if (and (boundp 'menu-bar-help-menu) (keymapp menu-bar-help-menu))
|
|
515 (cons "Help" (cons 'keymap (cdr menu-bar-help-menu)))
|
|
516 (cons "Help" (make-sparse-keymap "Help")))))
|
|
517 (define-key dired-mode-map [menu-bar dired-help] dired-help-menu)
|
|
518 (define-key dired-mode-map [menu-bar dired-help help-separator]
|
|
519 '("--"))
|
|
520 (define-key dired-mode-map [menu-bar dired-help dired-bug]
|
|
521 '("Report Dired Bug" . dired-report-bug))
|
|
522 (define-key dired-mode-map [menu-bar dired-help dired-var-apropos]
|
|
523 (cons "Dired Variable Apropos"
|
|
524 (function (lambda ()
|
|
525 (interactive)
|
|
526 (let ((current-prefix-arg t))
|
|
527 (call-interactively 'dired-apropos))))))
|
|
528 (dired-cache-key dired-help-menu 'dired-var-apropos
|
|
529 'dired-apropos 'universal-argument)
|
|
530 (define-key dired-mode-map [menu-bar dired-help dired-apropos]
|
|
531 '("Dired Command Apropos" . dired-apropos))
|
|
532 (define-key dired-mode-map [menu-bar dired-help dired-info]
|
|
533 (cons "Dired Info Manual"
|
|
534 (function (lambda ()
|
|
535 (interactive)
|
|
536 (dired-describe-mode t)))))
|
|
537 (dired-cache-key dired-help-menu 'dired-info 'dired-describe-mode
|
|
538 'universal-argument)
|
|
539 (define-key dired-mode-map [menu-bar dired-help dired-describe-mode]
|
|
540 '("Describe Dired" . dired-describe-mode))
|
|
541 (define-key dired-mode-map [menu-bar dired-help dired-summary]
|
|
542 '("Dired Summary Help" . dired-summary)))
|
|
543
|
|
544 (add-hook 'dired-setup-keys-hook 'dired-setup-menus)
|
|
545
|
|
546 ;;; Mouse functions
|
|
547
|
|
548 (defun dired-mouse-find-file (event)
|
|
549 "In dired, visit the file or directory name you click on."
|
|
550 (interactive "e")
|
|
551 (save-excursion
|
|
552 (set-buffer (window-buffer (posn-window (event-end event))))
|
|
553 (if dired-subdir-alist
|
|
554 (save-excursion
|
|
555 (goto-char (posn-point (event-end event)))
|
|
556 (dired-find-file))
|
|
557 (error
|
|
558 (concat "dired-subdir-alist seems to be mangled. "
|
|
559 (substitute-command-keys
|
|
560 "\\<dired-mode-map>Try dired-revert (\\[dired-revert])."))))))
|
|
561
|
|
562 (defun dired-mouse-mark (event)
|
|
563 "In dired, mark the file name that you click on.
|
|
564 If the file name is already marked, this unmarks it."
|
|
565 (interactive "e")
|
|
566 (save-excursion
|
|
567 (set-buffer (window-buffer (posn-window (event-end event))))
|
|
568 (if dired-subdir-alist
|
|
569 (save-excursion
|
|
570 (goto-char (posn-point (event-end event)))
|
|
571 (beginning-of-line)
|
|
572 (if (looking-at dired-re-mark)
|
|
573 (dired-unmark 1)
|
|
574 (dired-mark 1)))
|
|
575 (error
|
|
576 (concat "dired-subdir-alist seems to be mangled. "
|
|
577 (substitute-command-keys
|
|
578 "\\<dired-mode-map>Try dired-revert (\\[dired-revert])."))))))
|
|
579
|
|
580 (defun dired-mouse-flag (event)
|
|
581 "In dired, flag for deletion the file name that you click on.
|
|
582 If the file name is already flag, this unflags it."
|
|
583 (interactive "e")
|
|
584 (save-excursion
|
|
585 (set-buffer (window-buffer (posn-window (event-end event))))
|
|
586 (if dired-subdir-alist
|
|
587 (save-excursion
|
|
588 (goto-char (posn-point (event-end event)))
|
|
589 (beginning-of-line)
|
|
590 (if (char-equal (following-char) dired-del-marker)
|
|
591 (dired-unflag 1)
|
|
592 (dired-flag-file-deletion 1)))
|
|
593 (error
|
|
594 (concat "dired-subdir-alist seems to be mangled. "
|
|
595 (substitute-command-keys
|
|
596 "\\<dired-mode-map>Try dired-revert (\\[dired-revert])."))))))
|
|
597
|
|
598 (defun dired-mouse-get-target (event)
|
|
599 "In dired, put a copy of the selected directory in the active minibuffer."
|
|
600 (interactive "e")
|
|
601 (let ((obuff (current-buffer))
|
|
602 mb)
|
|
603 (set-buffer (window-buffer (posn-window (event-end event))))
|
|
604 (if (and dired-subdir-alist (setq mb (dired-get-active-minibuffer-window)))
|
|
605 (let (dir)
|
|
606 (goto-char (posn-point (event-end event)))
|
|
607 (setq dir (dired-current-directory))
|
|
608 (select-window mb)
|
|
609 (set-buffer (window-buffer mb))
|
|
610 (erase-buffer)
|
|
611 (insert dir))
|
|
612 (set-buffer obuff)
|
|
613 (if mb
|
|
614 (error "No directory specified")
|
|
615 (error "No active minibuffer")))))
|
|
616
|
|
617 (defun dired-visit-popup-menu (event)
|
|
618 "Popup a menu to visit the moused file."
|
|
619 (interactive "e")
|
|
620 (save-excursion
|
|
621 (set-buffer (window-buffer (posn-window (event-end event))))
|
|
622 (save-excursion
|
|
623 (goto-char (posn-point (event-end event)))
|
|
624 (dired-visit-popup-menu-internal event))))
|
|
625
|
|
626 (defun dired-visit-popup-menu-internal (event)
|
|
627 (interactive "e")
|
|
628 (let ((fn (dired-get-filename 'no-dir))
|
|
629 fun)
|
|
630 (dired-remove-text-properties 0 (length fn) fn)
|
|
631 (setq fun (x-popup-menu
|
|
632 event
|
|
633 (list "Visit popup menu"
|
|
634 (cons
|
|
635 (concat "Visit " fn " with")
|
|
636 dired-visit-popup-menu))))
|
|
637 (if fun (funcall fun))))
|
|
638
|
|
639 (defun dired-do-popup-menu (event)
|
|
640 ;; Pop up a menu do an operation on the moused file.
|
|
641 (interactive "e")
|
|
642 (let ((obuff (current-buffer)))
|
|
643 (unwind-protect
|
|
644 (progn
|
|
645 (set-buffer (window-buffer (posn-window (event-end event))))
|
|
646 (dired-save-excursion
|
|
647 (goto-char (posn-point (event-end event)))
|
|
648 (dired-do-popup-menu-internal event)))
|
|
649 (set-buffer obuff))))
|
|
650
|
|
651 (defun dired-do-popup-menu-internal (event)
|
|
652 (interactive "e")
|
|
653 (let ((fn (dired-get-filename 'no-dir))
|
|
654 fun)
|
|
655 (dired-remove-text-properties 0 (length fn) fn)
|
|
656 (setq fun (x-popup-menu
|
|
657 event
|
|
658 (list "Do popup menu"
|
|
659 (cons
|
|
660 (concat "Do operation on " fn)
|
|
661 dired-do-popup-menu))))
|
|
662 (dired-save-excursion
|
|
663 (if fun (let ((current-prefix-arg 1))
|
|
664 (call-interactively fun))))))
|
|
665
|
|
666 ;;; Key maps
|
|
667
|
|
668 ;; Get rid of the Edit menu bar item to save space.
|
|
669 (define-key dired-mode-map [menu-bar edit] 'undefined)
|
|
670 ;; We have our own help item
|
|
671 (define-key dired-mode-map [menu-bar help] 'undefined)
|
|
672 (define-key dired-mode-map [mouse-2] 'dired-mouse-find-file)
|
|
673 (define-key dired-mode-map [S-mouse-1] 'dired-mouse-mark)
|
|
674 (define-key dired-mode-map [C-S-mouse-1] 'dired-mouse-flag)
|
|
675 (define-key dired-mode-map [down-mouse-3] 'dired-visit-popup-menu)
|
|
676 ;; This can be useful in dired, so move to double click.
|
|
677 (define-key dired-mode-map [double-mouse-3] 'mouse-save-then-kill)
|
|
678 (define-key dired-mode-map [C-down-mouse-2] 'dired-do-popup-menu)
|
|
679 (define-key dired-mode-map [M-mouse-2] 'dired-mouse-get-target)
|
|
680
|
|
681 (or (memq 'dired-help menu-bar-final-items)
|
|
682 (setq menu-bar-final-items (cons 'dired-help menu-bar-final-items)))
|
|
683
|
|
684 ;;; end of dired-fsf.el
|