1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70 TODO:
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99 TODO:
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151 (require 'dired)
152 (require 'easymenu)
153 (require 'font-lock)
154 (require 'browse-url)
155
156
157 (defface mc-directory-face '((t (:bold t)))
158 "Face used to highlight directories.")
159
160 (defface mc-symlink-face '((t (:italic t)))
161 "Face used to highlight symbolic links.")
162
163 (defface mc-symlink-directory-face '((t (:italic t)))
164 "Face used to highlight symbolic directory links.")
165
166 (defface mc-help-face '((t (:foreground "Black" :background "MediumSpringGreen")))
167 "Face used to display MC help keys.")
168
169 (defface mc-window-selected-face '((t (:background "blue"))) "Face used to show a selected window")
170
171 (defface mc-window-not-selected-face '((t (:foreground "white")))
172 "Face used to show an unselected window")
173
174 (defvar mc-restore-buffer nil "Buffer to restore when mc is quit.")
175
176 (defvar mc-prior-window-configuration nil "Window configuration before mc was started.")
177
178 (defvar mc-running nil "True when midnight commander mode is running.")
179
180 (defvar mc-current-window-overlay nil
181 "Holds the current overlay which marks the current dired buffer.")
182
183 (defvar mc-left-directory "~"
184 "Dired directory for the left window. See variable `dired-directory'.")
185
186 (defvar mc-right-directory "~"
187 "Dired directory for the right window. See variable `dired-directory'.")
188
189 (defvar mc-left-window nil "The left window of dired.")
190
191 (defvar mc-right-window nil "The right window of dired.")
192
193 (defvar mc-selected-window 'left "The window to select when mc starts up.")
194
195 (defvar mc-help-buffer "*mc-help*" "Buffer used to store help info.")
196
197 (defvar mc-help-buffer-created nil "True if the help buffer has been created.")
198
199 (defvar mc-help-window nil "Window used to store help info.")
200
201 (defcustom mc-window-split-style 'horizontal
202 "The current window split configuration. May be either 'horizontal or 'vertical."
203 :group 'mc
204 :type '(choice
205 (const horizontal)
206 (const vertical)))
207
208 (defvar mc-start-message
209 "Midnight Commander emulation enabled. F-10 (or escape) to quit."
210 "Message to display when `mc' is started.")
211
212 (defvar mc-mode-map (let ((map (make-sparse-keymap)))
213 (define-key map [(f2)] 'mc-dired)
214 (define-key map [(f3)] 'mc-dired-advertised-find-file)
215 (define-key map [(f4)] 'mc-dired-advertised-find-file)
216 (define-key map [(f5)] 'dired-do-copy)
217 (define-key map [(f6)] 'dired-do-rename)
218 (define-key map [(f7)] 'dired-create-directory)
219 (define-key map [(f8)] 'dired-do-delete)
220 (define-key map [(f10)] 'keyboard-escape-quit)
221 (define-key map [return] 'mc-dired-advertised-find-file)
222 (define-key map [tab] 'mc-change-window)
223 (define-key map [(insert)] 'dired-mark)
224 (define-key map [(C-home)] 'mc-beginning-of-buffer)
225 (define-key map [(C-end)] 'mc-end-of-buffer)
226 (define-key map [?\C-c?\C-s] 'mc-split-toggle)
227 (define-key map "b" 'mc-browse)
228 (define-key map "e" 'mc-dired-advertised-find-file)
229 (define-key map "f" 'mc-dired-advertised-find-file)
230 (define-key map "g" 'mc-revert-buffer)
231 (define-key map "v" 'mc-dired-view-file)
232 (define-key map "q" 'keyboard-escape-quit)
233 (define-key map "U" 'mc-dired-prev-subdir) map)
234 "Mode specific keymap for function `mc-mode'.")
235
236 (defvar mc-mode-menu nil "Menu for `mc-mode'.")
237 (easy-menu-define mc-mode-menu mc-mode-map
238 "MC menu"
239 (list
240 "MC"
241 ["Change Window" mc-change-window [:keys "TAB"] t]
242 ["Change Directory" mc-dired t]
243 ["View/Edit current file" dired-advertised-find-file t]
244 ["Copy" dired-do-copy [:keys "f5"] t]
245 ["Rename" dired-do-rename t]
246 ["Delete" dired-do-delete t]
247 ["Previous directory" mc-dired-prev-subdir t]
248 "----"
249 ["Toggle window split (horizontal or vertical)" mc-split-toggle t]
250 "----"
251 ["Quit" keyboard-escape-quit t]))
252
253 (defun mc(&optional left-directory right-directory)
254 "Start emulated midnight commander. If the param `left-directory' is given
255 the left window will display this directory (the same for `right-directory').
256 Specifying nil for any of these values uses the default."
257 (interactive)
258
259 (message "Entering midnight commander...")
260
261 (if (not mc-running)
262 (progn
263 (catch 'exit
264
265 (if left-directory
266 (setq mc-left-directory left-directory))
267
268 (if right-directory
269 (setq mc-right-directory right-directory))
270
271 (setq mc-running t)
272
273 (setq mc-restore-buffer (current-buffer))
274
275 (setq mc-prior-window-configuration (current-window-configuration))
276
277 (mc-setup-windows)
278
279 (message mc-start-message)
280 (recursive-edit))
281 (mc-quit))
282 (progn
283
284
285
286 (message "Midnight commander already running...")
287 (mc-setup-windows)
288 (message mc-start-message))))
289
290 (defun mc-cd()
291 "Run mc but give it the current directory to use."
292 (interactive)
293
294 (let((left-directory default-directory))
295
296 (mc left-directory)))
297
298 (defun mc-setup-windows()
299 "Setup the MC window configuration (two windows both running dired.)"
300
301 (mc-help-buffer-init)
302
303
304 (delete-other-windows)
305
306
307 (let((window-min-height 1))
308 (split-window (selected-window) (- (window-height) 3)))
309
310 (setq mc-help-window (next-window))
311
312 (set-window-buffer mc-help-window (get-buffer-create mc-help-buffer))
313
314 (if (equal mc-window-split-style
315 'horizontal)
316 (split-window-horizontally)
317 (if (equal mc-window-split-style
318 'vertical)
319 (split-window-vertically)
320 (error "Don't know how to split this window: %s" mc-window-split-style)))
321
322
323 (mc-dired mc-left-directory)
324 (setq mc-left-window (selected-window))
325
326 (other-window 1)
327 (mc-dired mc-right-directory)
328 (setq mc-right-window (selected-window))
329
330
331 (mc-select-window mc-selected-window))
332
333 (defun mc-split-horizontally()
334 "If mc is running split it right now... else split this way for all future
335 buffers."
336 (interactive)
337
338 (mc-split-setup 'horizontal))
339
340 (defun mc-split-vertically()
341 "If mc is running split it right now... else split this way for all future
342 buffers."
343 (interactive)
344
345 (mc-split-setup 'vertical))
346
347 (defun mc-split-toggle()
348 "If mc is currently configured for vertical splitting... change it to
349 horizontal and vice-versa."
350 (interactive)
351
352 (if (equal mc-window-split-style
353 'horizontal)
354 (mc-split-setup 'vertical)
355 (mc-split-setup 'horizontal)))
356
357 (defun mc-split-setup(split-type)
358
359 (setq mc-window-split-style split-type)
360
361 (if mc-running
362 (progn
363 (delete-other-windows)
364 (mc-setup-windows)))
365
366 (redraw-display)
367 (message "Split is now %s." (symbol-name split-type)))
368
369 (defun mc-help-buffer-init()
370 "Init the help buffer so it looks just like MC."
371
372 (set-buffer (get-buffer-create mc-help-buffer))
373
374 (if (featurep 'highline)
375 (progn
376
377
378
379
380
381 (highline-local-mode 1)
382 (highline-local-mode -1)))
383
384 (if (or (not mc-help-buffer-created)
385 (equal (buffer-size)
386 0))
387 (progn
388
389 (toggle-read-only -1)
390 (erase-buffer)
391
392
393 (mc-mode-on)
394
395
396
397 (mc-help-buffer-insert-option "F1" "Help")
398 (mc-help-buffer-insert-option "F2" "Chdir")
399 (mc-help-buffer-insert-option "F3" "View")
400 (mc-help-buffer-insert-option "F4" "Edit")
401 (mc-help-buffer-insert-option "F5" "Copy")
402 (mc-help-buffer-insert-option "F6" "RenMov")
403 (mc-help-buffer-insert-option "F7" "Mkdir")
404 (mc-help-buffer-insert-option "F8" "Delete")
405 (mc-help-buffer-insert-option "F10" "Quit")
406
407 (toggle-read-only 1)
408 (setq mc-help-buffer-created t))))
409
410 (defun mc-help-buffer-insert-option(key option)
411 "Insert the given help option with the given key in the help buffer."
412
413 (insert (format "%s " key))
414
415 (let(begin end overlay)
416 (setq begin (point))
417
418 (insert (format "%s " option))
419
420 (setq end (point))
421
422
423
424 (setq overlay (make-overlay begin end (current-buffer)))
425
426 (overlay-put overlay 'priority 0)
427
428 (overlay-put overlay 'face 'mc-help-face)
429
430 (overlay-put overlay 'buffer (current-buffer))
431
432 (insert " ")))
433
434 (defun mc-sort-buffer-move-regexp(regexp line)
435 "Given a regular expression, move all matches to the given line"
436
437 (save-excursion
438 (goto-char (point-min))
439
440 (if (re-search-forward regexp nil t)
441
442 (let(match)
443
444 (setq match (format "%s\n" (match-string 0)))
445 (delete-region (match-beginning 0) (match-end 0))
446 (kill-line 1)
447 (save-excursion
448
449 (goto-char (point-min))
450 (forward-line line)
451 (insert match))))))
452
453 (defun mc-change-window()
454 "Change to the other mc buffer"
455 (interactive)
456
457
458
459 (if (equal (selected-window)
460 mc-right-window)
461 (mc-select-window 'left)
462 (mc-select-window 'right)))
463
464 (defun mc-select-window(window)
465 "Select/highlight the given mc window (right or left)."
466
467 (if (string= (symbol-name window)
468 "left")
469 (progn
470 (select-window mc-left-window)
471 (setq mc-selected-window 'left))
472 (progn
473 (select-window mc-right-window)
474 (setq mc-selected-window 'right)))
475
476 (mc-highlight))
477
478 (defun mc-browse()
479 "Browse the directory/file on the current line."
480 (interactive)
481
482 (let(filename)
483 (setq filename (dired-get-filename))
484 (if filename
485 (let(url)
486 (setq url (concat "file://" filename))
487 (message "Browsing %s " url)
488 (browse-url url)))))
489
490 (defun mc-quit()
491 "Quit emulated mc and restore emacs to previous operation."
492 (interactive)
493
494
495 (if mc-running
496 (progn
497 (setq mc-running nil)
498
499 (mc-save-directories)
500
501
502 (delete-other-windows)
503
504 (set-window-configuration mc-prior-window-configuration)
505
506 (set-buffer mc-restore-buffer)
507
508
509 (toggle-read-only -1))))
510
511 (defun mc-revert-buffer()
512 "Revert the dired buffer"
513 (interactive)
514
515 (revert-buffer)
516
517 (if (equal major-mode
518 'dired-mode)
519 (mc-mode 1)))
520
521 (defun mc-save-directories()
522 "Save the current directories in the mc buffer to use the next time mc starts
523 up."
524
525
526
527 (if (window-live-p mc-left-window)
528 (progn
529 (set-buffer (window-buffer mc-left-window))
530 (if (equal major-mode
531 'dired-mode)
532 (setq mc-left-directory (mc-get-dired-directory)))))
533
534 (if (window-live-p mc-right-window)
535 (progn
536 (set-buffer (window-buffer mc-right-window))
537 (if (equal major-mode
538 'dired-mode)
539 (setq mc-right-directory (mc-get-dired-directory))))))
540
541 (defun mc-get-dired-directory()
542 "Get the current dired directory."
543
544 dired-directory)
545
546 (defun mc-dired(directory)
547 "Turn mc and dired."
548 (interactive
549 (list
550 (read-file-name "Change directory (file or pattern): " nil nil nil)))
551
552
553
554
555 (if (and (not (file-directory-p directory))
556 (file-exists-p directory)
557 (file-readable-p directory))
558 (progn
559 (mc-quit)
560 (exit-recursive-edit)
561 (find-file directory)))
562
563
564 (if (and (file-directory-p directory)
565 (file-readable-p directory))
566 (progn
567 (dired directory)
568 (mc-mode 1))
569 (find-file directory)))
570
571 (defun mc-ensure()
572 "After dired changed to a new buffer, if mc mode is supposed to be on but
573 isn't... turn it on. "
574 (interactive)
575
576 (if mc-running
577 (mc-mode 1)))
578
579 (defun mc-highlight()
580 "Highlight the current buffer, destroying the previous buffer highlight if
581 necessary."
582
583
584 (if mc-current-window-overlay
585 (overlay-put mc-current-window-overlay 'face 'mc-window-not-selected-face))
586
587 (save-excursion
588 (let(begin end)
589
590
591 (goto-char (point-min))
592 (search-forward "/" nil t)
593 (setq begin (1- (point)))
594
595 (search-forward ":" nil t)
596 (setq end (1- (point)))
597
598
599 (setq mc-current-window-overlay (make-overlay begin end))
600
601 (overlay-put mc-current-window-overlay 'face 'mc-window-selected-face)
602
603 (overlay-put mc-current-window-overlay 'window (selected-window)))))
604
605 (defun mc-dired-advertised-find-file()
606 "Call dired-advertised-find-file but also perform additional actions"
607 (interactive)
608
609
610 (save-excursion
611
612
613 (let(filename)
614 (setq filename (dired-get-filename))
615
616 (if filename
617 (if (file-directory-p filename)
618 (progn
619 (dired-advertised-find-file)
620 (mc-mode 1))
621 (progn
622
623 (mc-quit)
624
625 (find-file filename)
626
627
628
629
630
631 (mc-quit)
632
633 (exit-recursive-edit)))))))
634
635 (defadvice dired-view-file(after mc-dired-view-file())
636 "See `dired-view-file'. This version will quit MC after the file is viewed."
637 (interactive)
638
639 (if mc-mode
640 (exit-recursive-edit)))
641 (ad-activate 'dired-view-file)
642
643 (defun mc-dired-prev-subdir()
644 "Go to the previous subdirectory."
645 (interactive)
646
647 (if (not (string= dired-directory
648 "/"))
649 (mc-dired "..")
650 (error "Already at root")))
651
652 (defun mc-sort-buffer()
653 "Go through the current dired buffer and sort it according to user settings."
654
655 TODO:
656
657
658 (toggle-read-only -1)
659
660 (save-excursion
661 (goto-char (point-min))
662
663 (let(match result)
664
665 (setq result '())
666
667
668 (while (re-search-forward "^..[ld].*/$" nil t)
669
670 (setq match (format "%s\n" (match-string 0)))
671
672
673 (add-to-list 'result
674 match)
675
676 (delete-region (match-beginning 0) (match-end 0))
677 (kill-line 1))
678 (goto-char (point-min))
679 (forward-line 2)
680
681 (let(i)
682 (setq i (1- (length result)))
683 (while (>= i 0)
684 (insert (nth i result))
685 (setq i (1- i))))))
686
687
688 (mc-sort-buffer-move-regexp "^.*[^.]\\.$" 2)
689 (mc-sort-buffer-move-regexp "^.*\\.\\.$" 3)
690
691 (toggle-read-only 1))
692
693 (defun mc-beginning-of-buffer()
694 "Go to the first directory/file in dired."
695 (interactive)
696
697 (goto-char (point-min))
698 (if (re-search-forward "\\.\\./$" nil t)
699 (goto-char (match-beginning 0))
700 (progn
701 (goto-char (point-min))
702 (dired-next-line 2))))
703
704 (defun mc-end-of-buffer()
705 "Go to the last directory/file in dired."
706 (interactive)
707
708 (goto-char (point-max))
709 (dired-next-line -1))
710
711 (defun mc-mode(&optional arg)
712 "turn mc-mode on/off"
713 (interactive)
714
715 (if (if arg
716 (> (prefix-numeric-value arg) 0)
717 (not mc-mode))
718 (mc-mode-on)
719 (mc-mode-off)))
720
721 (defun mc-mode-on()
722 "Turn on mc-mode."
723 (interactive)
724 (setq mc-mode t)
725
726 (if (equal major-mode
727 'dired-mode)
728 (progn
729 (mc-highlight)
730 (font-lock-mode 1)
731
732
733
734 (let(basic-line-format)
735
736 (setq basic-line-format (concat " " (expand-file-name dired-directory)))
737
738 (setq mode-line-format basic-line-format)
739
740
741 (if (functionp 'file-within-header)
742 (file-within-header)))
743
744
745
746
747 (let(first-logic-point)
748 (save-excursion
749 (if (re-search-forward "\\.\\./$" nil t)
750 (setq first-logic-point (match-beginning 0))))
751
752
753 (if (and first-logic-point
754 (< (point) first-logic-point))
755 (goto-char first-logic-point)))))
756
757 (run-hooks 'mc-hook)
758 (easy-menu-add mc-mode-menu))
759
760 (defun mc-mode-off()
761 "Turn off mc-mode."
762 (interactive)
763 (setq mc-mode nil)
764 (easy-menu-remove mc-mode-menu))
765
766
767 (add-to-list 'minor-mode-alist (list 'mc-mode " MC"))
768
769
770 (font-lock-add-keywords 'dired-mode '(("\\(^..l.*/$\\)" 1 'mc-symlink-directory-face keep)))
771
772
773 (font-lock-add-keywords 'dired-mode '(("\\(^..l.*[^/]$\\)" 1 'mc-symlink-face keep)))
774
775 (add-hook 'dired-after-load--hook 'mc-ensure)
776
777
778 (add-hook 'dired-after-readin-hook 'mc-sort-buffer)
779
780 (setq dired-listing-switches "-alp")
781
782 (provide 'mc)
783
784
785