Mercurial > hg > xemacs-beta

comparison lisp/efs/dired-fsf.el @ 98:0d2f883870bc r20-1b1

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-1b1
author cvs
date Mon, 13 Aug 2007 09:13:56 +0200
parents 8fc7fe29b841
children
comparison
equal deleted inserted replaced
97:498bf5da1c90 98:0d2f883870bc
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