1 ;;; sunrise-commander.el --- two-pane file manager for Emacs based on Dired and inspired by MC -*- lexical-binding: t -*-
3 ;; Copyright (C) 2007-2012 José Alfredo Romero Latouche.
5 ;; Author: José Alfredo Romero L. <escherdragon@gmail.com>
6 ;; Štěpán Němec <stepnem@gmail.com>
7 ;; Maintainer: José Alfredo Romero L. <escherdragon@gmail.com>
8 ;; Created: 24 Sep 2007
10 ;; RCS Version: $Rev: 434 $
11 ;; Keywords: files, dired, midnight commander, norton, orthodox
12 ;; URL: http://www.emacswiki.org/emacs/sunrise-commander.el
13 ;; Compatibility: GNU Emacs 22+
15 ;; This file is not part of GNU Emacs.
17 ;; This program is free software: you can redistribute it and/or modify it under
18 ;; the terms of the GNU General Public License as published by the Free Software
19 ;; Foundation, either version 3 of the License, or (at your option) any later
22 ;; This program is distributed in the hope that it will be useful, but WITHOUT
23 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
24 ;; FOR A PARTICULAR PURPOSE. See the GNU General Public License for more de-
27 ;; You should have received a copy of the GNU General Public License along with
28 ;; this program. If not, see <http://www.gnu.org/licenses/>.
32 ;; The Sunrise Commmander is an double-pane file manager for Emacs. It's built
33 ;; atop of Dired and takes advantage of all its power, but also provides many
34 ;; handy features of its own:
36 ;; * Sunrise is implemented as a derived major mode confined inside the pane
37 ;; buffers, so its buffers and Dired ones can live together without easymenu or
38 ;; viper to avoid key binding collisions.
40 ;; * It automatically closes unused buffers and tries to never keep open more
41 ;; than the one or two used to display the panes, though this behavior may be
42 ;; disabled if desired.
44 ;; * Each pane has its own history stack: press M-y / M-u for moving backwards /
45 ;; forwards in the history of directories.
47 ;; * Press M-t to swap (transpose) the panes.
49 ;; * Press C-= for "smart" file comparison using `ediff'. It compares together
50 ;; the first two files marked on each pane or, if no files have been marked, it
51 ;; assumes that the second pane contains a file with the same name as the
52 ;; selected one and tries to compare these two. You can also mark whole lists of
53 ;; files to be compared and then just press C-= for comparing the next pair.
55 ;; * Press = for fast "smart" file comparison -- like above, but using regular
58 ;; * Press C-M-= for directory comparison (by date / size / contents of files).
60 ;; * Press C-c C-s to change the layout of the panes (horizontal/vertical/top)
62 ;; * Press C-c / to interactively refine the contents of the current pane using
63 ;; fuzzy (a.k.a. flex) matching, then:
64 ;; - press Delete or Backspace to revert the buffer to its previous state
65 ;; - press Return, C-n or C-p to exit and accept the current narrowed state
66 ;; - press Esc or C-g to abort the operation and revert the buffer
67 ;; - use ! to prefix characters that should NOT appear after a given position
68 ;; Once narrowed and accepted, you can restore the original contents of the pane
69 ;; by pressing g (revert-buffer).
71 ;; * Sticky search: press C-c s to launch an interactive search that will remain
72 ;; active from directory to directory, until you hit a regular file or press C-g
74 ;; * Press C-x C-q to put the current pane in Editable Dired mode (allows to
75 ;; edit the pane as if it were a regular file -- press C-c C-c to commit your
76 ;; changes to the filesystem, or C-c C-k to abort).
78 ;; * Press y to recursively calculate the total size (in bytes) of all files and
79 ;; directories currently selected/marked in the active pane.
81 ;; * Sunrise VIRTUAL mode integrates dired-virtual mode to Sunrise, allowing to
82 ;; capture find and locate results in regular files and to use them later as if
83 ;; they were directories with all Dired and Sunrise operations at your
85 ;; The results of the following operations are displayed in VIRTUAL mode:
86 ;; - find-name-dired (press C-c C-n),
87 ;; - find-grep-dired (press C-c C-g),
88 ;; - find-dired (press C-c C-f),
89 ;; - locate (press C-c C-l),
90 ;; - list all recently visited files (press C-c C-r -- requires recentf),
91 ;; - list all directories in active pane's history ring (press C-c C-d).
93 ;; * Supports AVFS (http://avf.sourceforge.net/) for transparent navigation
94 ;; inside compressed archives (*.zip, *.tgz, *.tar.bz2, *.deb, etc. etc.)
95 ;; You need to have AVFS with coda or fuse installed and running on your system
96 ;; for this to work, though.
98 ;; * Opening terminals directly from Sunrise:
99 ;; - Press C-c C-t to inconditionally open a new terminal into the currently
100 ;; selected directory in the active pane.
101 ;; - Use C-c t to switch to the last opened terminal, or (when already inside
102 ;; a terminal) to cycle through all open terminals.
103 ;; - Press C-c T to switch to the last opened terminal and change directory
104 ;; to the one in the current directory.
105 ;; - Press C-c M-t to be prompted for a program name, and then open a new
106 ;; terminal using that program into the currently selected directory
107 ;; (eshell is a valid value; if no program can be found with the given name
108 ;; then the value of `sr-terminal-program' is used instead).
110 ;; * Terminal integration and Command line expansion: integrates tightly with
111 ;; `eshell' and `term-mode' to allow interaction between terminal emulators in
112 ;; line mode (C-c C-j) and the panes: the most important navigation commands
113 ;; (up, down, mark, unmark, go to parent dir) can be executed on the active pane
114 ;; directly from the terminal by pressing the usual keys with Meta: <M-up>,
115 ;; <M-down>, etc. Additionally, the following substitutions are automagically
116 ;; performed in `eshell' and `term-line-mode':
117 ;; %f - expands to the currently selected file in the left pane
118 ;; %F - expands to the currently selected file in the right pane
119 ;; %m - expands to the list of paths of all marked files in the left pane
120 ;; %M - expands to the list of paths of all marked files in the right pane
121 ;; %n - expands to the list of names of all marked files in the left pane
122 ;; %N - expands to the list of names of all marked files in the right pane
123 ;; %d - expands to the current directory in the left pane
124 ;; %D - expands to the current directory in the right pane
125 ;; %a - expands to the list of paths of all marked files in the active pane
126 ;; %A - expands to the current directory in the active pane
127 ;; %p - expands to the list of paths of all marked files in the passive pane
128 ;; %P - expands to the current directory in the passive pane
130 ;; * Cloning of complete directory trees: press K to clone the selected files
131 ;; and directories into the passive pane. Cloning is a more general operation
132 ;; than copying, in which all directories are recursively created with the same
133 ;; names and structures at the destination, while what happens to the files
134 ;; within them depends on the option you choose:
135 ;; - "(D)irectories only" ignores all files, copies only directories,
136 ;; - "(C)opies" performs a regular recursive copy of all files and dirs,
137 ;; - "(H)ardlinks" makes every new file a (hard) link to the original one
138 ;; - "(S)ymlinks" creates absolute symbolic links for all files in the tree,
139 ;; - "(R)elative symlinks” creates relative symbolic links.
141 ;; * Passive navigation: the usual navigation keys (n, p, Return, U, ;) combined
142 ;; with Meta allow to move across the passive pane without actually having to
145 ;; * Synchronized navigation: press C-c C-z to enable / disable synchronized
146 ;; navigation. In this mode, the passive navigation keys (M-n, M-p, M-Return,
147 ;; etc.) operate on both panes simultaneously. I've found this quite useful for
148 ;; comparing hierarchically small to medium-sized directory trees (for large to
149 ;; very large directory trees one needs something on the lines of diff -r
152 ;; * And much more -- press ? while in Sunrise mode for basic help, or h for a
153 ;; complete list of all keybindings available (use C-e and C-y to scroll).
155 ;; There is no help window like in MC, but if you really miss it, just get and
156 ;; install the sunrise-x-buttons extension.
158 ;; A lot of this code was once adapted from Kevin's mc.el, but it has evolved
159 ;; considerably since then. Another part (the code for file copying and
160 ;; renaming) derives originally from the Dired extensions written by Kurt
161 ;; Nørmark for LAML (http://www.cs.aau.dk/~normark/scheme/distribution/laml/).
163 ;; It was written on GNU Emacs 24 on Linux and tested on GNU Emacs 22, 23 and 24
164 ;; for Linux and on EmacsW32 (version 23) for Windows. I have also received
165 ;; feedback from users reporting it works OK on the Mac. It does not work either
166 ;; on GNU Emacs 21 or XEmacs -- please drop me a line if you would like to help
167 ;; porting it. All contributions and/or bug reports will be very welcome.
169 ;; For more details on the file manager, several available extensions and many
170 ;; cool tips & tricks visit http://www.emacswiki.org/emacs/Sunrise_Commander
172 ;;; Installation and Usage:
174 ;; 1) Put this file somewhere in your Emacs `load-path'.
176 ;; 2) Add a (require 'sunrise-commander) to your .emacs file.
178 ;; 3) Choose some unused extension for files to be opened in Sunrise VIRTUAL
179 ;; mode and add it to `auto-mode-alist', e.g. if you want to name your virtual
180 ;; directories like *.svrm just add to your .emacs file a line like the
183 ;; (add-to-list 'auto-mode-alist '("\\.srvm\\'" . sr-virtual-mode))
185 ;; 4) Evaluate the new lines, or reload your .emacs file, or restart Emacs.
187 ;; 5) Type M-x sunrise to invoke the Sunrise Commander (or much better: bind the
188 ;; function to your favorite key combination). The command `sunrise-cd' invokes
189 ;; Sunrise and automatically selects the current file wherever it is in the
190 ;; filesystem. Type h at any moment for information on available key bindings.
192 ;; 6) Type M-x customize-group <RET> sunrise <RET> to customize options, fonts
193 ;; and colors (activate AVFS support here, too).
202 (require 'find-dired)
207 (eval-when-compile (require 'cl)
214 (defgroup sunrise nil
215 "The Sunrise Commander File Manager."
218 (defcustom sr-show-file-attributes t
219 "Whether to initially display file attributes in Sunrise panes.
220 You can always toggle file attributes display pressing
221 \\<sr-mode-map>\\[sr-toggle-attributes]."
225 (defcustom sr-autoload-extensions t
226 "Whether to load extensions immediately after their declaration, or when the
227 SC core is loaded (e.g. when using autoload cookies)."
231 (defcustom sr-show-hidden-files nil
232 "Whether to initially display hidden files in Sunrise panes.
233 You can always toggle hidden files display pressing
234 \\<sr-mode-map>\\[dired-omit-mode].
235 You can also customize what files are considered hidden by setting
236 `dired-omit-files' and `dired-omit-extensions' in your .emacs file."
240 (defcustom sr-terminal-kill-buffer-on-exit t
241 "Whether to kill terminal buffers after their shell process ends."
245 (defcustom sr-terminal-program "eshell"
246 "The program to use for terminal emulation.
247 If this value is set to \"eshell\", the Emacs shell (`eshell')
252 (defcustom sr-listing-switches "-al"
253 "Listing switches passed to `ls' when building Sunrise buffers.
254 \(Cf. `dired-listing-switches'.)
255 Most portable value: -al
256 Recommended value on GNU systems: \
257 --time-style=locale --group-directories-first -alDhgG"
261 (defcustom sr-virtual-listing-switches "-ald"
262 "Listing switches for building buffers in `sr-virtual-mode'.
263 Should not contain the -D option. See also `sr-listing-switches'."
267 (defcustom sr-avfs-root nil
268 "Root of the AVFS virtual filesystem used for navigating compressed archives.
269 Setting this value activates AVFS support."
272 (const :tag "AVFS support disabled" nil)
273 (directory :tag "AVFS root directory")))
275 (defcustom sr-avfs-handlers-alist '(("\\.[jwesh]ar$" . "#uzip/")
276 ("\\.wsar$" . "#uzip/")
277 ("\\.xpi$" . "#uzip/")
278 ("\\.apk$" . "#uzip/")
279 ("\\.iso$" . "#iso9660/")
283 "List of AVFS handlers to manage specific file extensions."
287 (defcustom sr-md5-shell-command "md5sum %f | cut -d' ' -f1 2>/dev/null"
288 "Shell command to use for calculating MD5 sums for files.
289 Used when comparing directories using the ``(c)ontents'' option.
290 Use %f as a placeholder for the name of the file."
294 (defcustom sr-window-split-style 'horizontal
295 "The current window split configuration.
296 May be `horizontal', `vertical' or `top'."
303 (defcustom sr-windows-locked t
304 "When non-nil, vertical size of the panes will remain constant."
308 (defcustom sr-windows-default-ratio 66
309 "Percentage of the total height of the frame to use by default for the Sunrise
313 :set (defun sr-set-windows-default-ratio (symbol value)
314 "Setter function for the `sr-windows-default-ratio' custom option."
315 (if (and (integerp value) (>= value 0) (<= value 100))
316 (set-default symbol value)
317 (error "Invalid value: %s" value))))
319 (defcustom sr-history-length 20
320 "Number of entries to keep in each pane's history rings."
324 (defcustom sr-kill-unused-buffers t
325 "Whether buffers should be killed automatically by Sunrise when not displayed
326 in any of the panes."
330 (defcustom sr-confirm-kill-viewer t
331 "Whether to ask for confirmation before killing a buffer opened in quick-view
336 (defcustom sr-attributes-display-mask nil
337 "Contols hiding/transforming columns with `sr-toggle-attributes'.
338 If set, its value must be a list of symbols, one for each
339 attributes column. If the symbol is nil, then the corresponding
340 column will be hidden, and if it's not nil then the column will
341 be left untouched. The symbol may also be the name of a function
342 that takes one string argument and evaluates to a different
343 string -- in this case this function will be used to transform
344 the contents of the corresponding column and its result will be
347 :type '(repeat symbol))
349 (defcustom sr-fast-backup-extension ".bak"
350 "Determines the extension to append to the names of new files
351 created with the `sr-fast-backup-files' function (@!). This can
352 be either a simple string or an s-expression to be evaluated at
356 (string :tag "Literal text")
357 (sexp :tag "Symbolic expression")))
359 (defcustom sr-fuzzy-negation-character ?!
360 "Character to use for negating patterns when fuzzy-narrowing a pane."
363 (const :tag "Fuzzy matching negation disabled" nil)
364 (character :tag "Fuzzy matching negation character" ?!)))
366 (defcustom sr-init-hook nil
367 "List of functions to be called before the Sunrise panes are displayed."
370 :options '(auto-insert))
372 (defcustom sr-start-hook nil
373 "List of functions to be called after the Sunrise panes are displayed."
376 :options '(auto-insert))
378 (defcustom sr-refresh-hook nil
379 "List of functions to be called every time a pane is refreshed."
382 :options '(auto-insert))
384 (defcustom sr-quit-hook nil
385 "List of functions to be called after the Sunrise panes are hidden."
388 :options '(auto-insert))
390 (defvar sr-restore-buffer nil
391 "Buffer to restore when Sunrise quits.")
393 (defvar sr-prior-window-configuration nil
394 "Window configuration before Sunrise was started.")
396 (defvar sr-running nil
397 "True when Sunrise commander mode is running.")
399 (defvar sr-synchronized nil
400 "True when synchronized navigation is on")
402 (defvar sr-current-window-overlay nil
403 "Holds the current overlay which marks the current Dired buffer.")
405 (defvar sr-clex-hotchar-overlay nil
406 "Overlay used to highlight the hot character (%) during CLEX operations.")
408 (defvar sr-left-directory "~/"
409 "Dired directory for the left window. See variable `dired-directory'.")
411 (defvar sr-left-buffer nil
412 "Dired buffer for the left window.")
414 (defvar sr-left-window nil
415 "The left window of Dired.")
417 (defvar sr-right-directory "~/"
418 "Dired directory for the right window. See variable `dired-directory'.")
420 (defvar sr-right-buffer nil
421 "Dired buffer for the right window.")
423 (defvar sr-right-window nil
424 "The right window of Dired.")
426 (defvar sr-current-frame nil
427 "The frame Sunrise is active on (if any).")
429 (defvar sr-this-directory "~/"
430 "Dired directory in the active pane.
431 This isn't necessarily the same as `dired-directory'.")
433 (defvar sr-other-directory "~/"
434 "Dired directory in the passive pane.")
436 (defvar sr-selected-window 'left
437 "The window to select when Sunrise starts up.")
439 (defvar sr-selected-window-width nil
440 "The width the selected window should have on startup.")
442 (defvar sr-history-registry '((left) (right))
443 "Registry of visited directories for both panes.")
445 (defvar sr-history-stack '((left 0 . 0) (right 0 . 0))
446 "History stack counters.
447 The first counter on each side tracks (by value) the absolute
448 depth of the stack and (by sign) the direction it is currently
449 being traversed. The second counter points at the position of the
450 element that is immediately beneath the top of the stack.")
452 (defvar sr-ti-openterms nil
453 "Stack of currently open terminal buffers.")
455 (defvar sr-ediff-on nil
456 "Flag that indicates whether an `ediff' is being currently done.")
458 (defvar sr-clex-on nil
459 "Flag that indicates that a CLEX operation is taking place.")
461 (defvar sr-virtual-buffer nil
462 "Local flag that indicates the current buffer was originally in
465 (defvar sr-dired-directory ""
466 "Directory inside which `sr-mode' is currently active.")
468 (defvar sr-start-message
469 "Been coding all night? Enjoy the Sunrise! (or press q to quit)"
470 "Message to display when Sunrise is started.")
472 (defvar sr-panes-height nil
473 "Current height of the pane windows.
474 Initial value is 2/3 the viewport height.")
476 (defvar sr-current-path-faces nil
477 "List of faces to display the path in the current pane (first wins)")
478 (make-variable-buffer-local 'sr-current-path-faces)
480 (defvar sr-inhibit-highlight nil
481 "Special variable used to temporarily inhibit highlighting in panes.")
483 (defvar sr-find-items nil
484 "Special variable used by `sr-find' to control the scope of find operations.")
486 (defvar sr-desktop-save-handlers nil
487 "List of extension-defined handlers to save Sunrise buffers with desktop.")
489 (defvar sr-desktop-restore-handlers nil
490 "List of extension-defined handlers to restore Sunrise buffers from desktop.")
492 (defvar sr-backup-buffer nil
493 "Variable holding a buffer-local value of the backup buffer.")
494 (make-variable-buffer-local 'sr-backup-buffer)
496 (defvar sr-goto-dir-function nil
497 "Function to use to navigate to a given directory, or nil to do
498 the default. The function receives one argument DIR, which is
499 the directory to go to.")
501 (defconst sr-side-lookup (list '(left . right) '(right . left))
502 "Trivial alist used by the Sunrise Commander to lookup its own passive side.")
504 (defface sr-active-path-face
505 '((((type tty) (class color) (min-colors 8))
506 :background "green" :foreground "yellow" :bold t)
507 (((type tty) (class mono)) :inverse-video t)
508 (t :background "#ace6ac" :foreground "yellow" :bold t :height 120))
509 "Face of the directory path in the active pane."
512 (defface sr-passive-path-face
513 '((((type tty) (class color) (min-colors 8) (background dark))
514 :background "black" :foreground "cyan")
515 (((type tty) (class color) (min-colors 8) (background light))
516 :background "white" :foreground "cyan")
517 (t :background "white" :foreground "lightgray" :bold t :height 120))
518 "Face of the directory path in the passive pane."
521 (defface sr-editing-path-face
522 '((t :background "red" :foreground "yellow" :bold t :height 120))
523 "Face of the directory path in the active pane while in editable pane mode."
526 (defface sr-highlight-path-face
527 '((t :background "yellow" :foreground "#ace6ac" :bold t :height 120))
528 "Face of the directory path on mouse hover."
531 (defface sr-clex-hotchar-face
532 '((t :foreground "red" :bold t))
533 "Face of the hot character (%) in CLEX mode.
534 Indicates that a CLEX substitution may be about to happen."
537 ;;; ============================================================================
538 ;;; This is the core of Sunrise: the main idea is to apply `sr-mode' only inside
539 ;;; Sunrise buffers while keeping all of `dired-mode' untouched.
541 ;;; preserve this variable when switching from `dired-mode' to another mode
542 (put 'dired-subdir-alist 'permanent-local t)
545 (define-derived-mode sr-mode dired-mode "Sunrise Commander"
546 "Two-pane file manager for Emacs based on Dired and inspired by MC.
547 The following keybindings are available:
549 /, j .......... go to directory
550 p, n .......... move cursor up/down
551 M-p, M-n ...... move cursor up/down in passive pane
552 ^, J .......... go to parent directory
553 M-^, M-J ...... go to parent directory in passive pane
554 Tab ........... switch to other pane
555 C-Tab.......... switch to viewer window
556 C-c Tab ....... switch to viewer window (console compatible)
557 RET, f ........ visit selected file/directory
558 M-RET, M-f .... visit selected file/directory in passive pane
559 C-c RET ....... visit selected in passive pane (console compatible)
560 b ............. visit selected file/directory in default browser
561 F ............. visit all marked files, each in its own window
562 C-u F ......... visit all marked files in the background
563 o,v ........... quick visit selected file (scroll with C-M-v, C-M-S-v)
564 C-u o, C-u v .. kill quick-visited buffer (restores normal scrolling)
565 X ............. execute selected file
566 C-u X.......... execute selected file with arguments
568 + ............. create new directory
569 M-+ ........... create new empty file(s)
570 C ............. copy marked (or current) files and directories
571 R ............. rename marked (or current) files and directories
572 D ............. delete marked (or current) files and directories
573 S ............. soft-link selected file/directory to passive pane
574 Y ............. do relative soft-link of selected file in passive pane
575 H ............. hard-link selected file to passive pane
576 K ............. clone selected files and directories into passive pane
577 M-C ........... copy (using traditional dired-do-copy)
578 M-R ........... rename (using traditional dired-do-rename)
579 M-D ........... delete (using traditional dired-do-delete)
580 M-S............ soft-link (using traditional dired-do-symlink)
581 M-Y............ do relative soft-link (traditional dired-do-relsymlink)
582 M-H............ hard-link selected file/directory (dired-do-hardlink)
583 A ............. search marked files for regular expression
584 Q ............. perform query-replace-regexp on marked files
585 C-c s ......... start a \"sticky\" interactive search in the current pane
587 M-a ........... move to beginning of current directory
588 M-e ........... move to end of current directory
589 M-y ........... go to previous directory in history
590 M-u ........... go to next directory in history
591 C-M-y ......... go to previous directory in history on passive pane
592 C-M-u ......... go to next directory in history on passive pane
594 g, C-c C-c .... refresh pane
595 s ............. sort entries (by name, number, size, time or extension)
596 r ............. reverse the order of entries in the active pane (sticky)
597 C-o ........... show/hide hidden files (requires dired-omit-mode)
598 C-Backspace ... hide/show file attributes in pane
599 C-c Backspace . hide/show file attributes in pane (console compatible)
600 y ............. show file type / size of selected files and directories.
601 M-l ........... truncate/continue long lines in pane
602 C-c v ......... put current panel in VIRTUAL mode
603 C-c C-v ....... create new pure VIRTUAL buffer
604 C-c C-w ....... browse directory tree using w3m
606 M-t ........... transpose panes
607 M-o ........... synchronize panes
608 C-c C-s ....... change panes layout (vertical/horizontal/top-only)
609 [ ............. enlarges the right pane by 5 columns
610 ] ............. enlarges the left pane by 5 columns
611 } ............. enlarges the panes vertically by 1 row
612 C-} ........... enlarges the panes vertically as much as it can
613 C-c } ......... enlarges the panes vertically as much as it can
614 { ............. shrinks the panes vertically by 1 row
615 C-{ ........... shrinks the panes vertically as much as it can
616 C-c { ......... shrinks the panes vertically as much as it can
617 \\ ............. restores the size of all windows back to «normal»
618 C-c C-z ....... enable/disable synchronized navigation
620 C-= ........... smart compare files (ediff)
621 C-c = ......... smart compare files (console compatible)
622 = ............. fast smart compare files (plain diff)
623 C-M-= ......... compare panes
624 C-x = ......... compare panes (console compatible)
626 C-c C-f ....... execute Find-dired in Sunrise VIRTUAL mode
627 C-c C-n ....... execute find-Name-dired in Sunrise VIRTUAL mode
628 C-c C-g ....... execute find-Grep-dired in Sunrise VIRTUAL mode
629 C-u C-c C-g ... execute find-Grep-dired with additional grep options
630 C-c C-l ....... execute Locate in Sunrise VIRTUAL mode
631 C-c C-r ....... browse list of Recently visited files (requires recentf)
632 C-c C-c ....... [after find, locate or recent] dismiss virtual buffer
633 C-c / ......... narrow the contents of current pane using fuzzy matching
634 C-c b ......... partial Branch view of selected items in current pane
635 C-c p ......... Prune paths matching regular expression from current pane
636 ; ............. follow file (go to same directory as selected file)
637 M-; ........... follow file in passive pane
638 C-M-o ......... follow a projection of current directory in passive pane
640 C-> ........... save named checkpoint (a.k.a. \"bookmark panes\")
641 C-c > ......... save named checkpoint (console compatible)
642 C-. ........ restore named checkpoint
643 C-c . ........ restore named checkpoint
645 C-x C-q ....... put pane in Editable Dired mode (commit with C-c C-c)
646 @! ............ fast backup files (not dirs!), each to [filename].bak
648 C-c t ......... open new terminal or switch to already open one
649 C-c T ......... open terminal AND/OR change directory to current
650 C-c C-t ....... open always a new terminal in current directory
651 C-c M-t ....... open a new terminal using an alternative shell program
652 q, C-x k ...... quit Sunrise Commander, restore previous window setup
653 M-q ........... quit Sunrise Commander, don't restore previous windows
655 Additionally, the following traditional commander-style keybindings are provided
656 \(these may be disabled by customizing the `sr-use-commander-keys' option):
658 F2 ............ go to directory
659 F3 ............ quick visit selected file
660 F4 ............ visit selected file
661 F5 ............ copy marked (or current) files and directories
662 F6 ............ rename marked (or current) files and directories
663 F7 ............ create new directory
664 F8 ............ delete marked (or current) files and directories
665 F10 ........... quit Sunrise Commander
666 C-F3 .......... sort contents of current pane by name
667 C-F4 .......... sort contents of current pane by extension
668 C-F5 .......... sort contents of current pane by time
669 C-F6 .......... sort contents of current pane by size
670 C-F7 .......... sort contents of current pane numerically
671 S-F7 .......... soft-link selected file/directory to passive pane
672 Insert ........ mark file
673 C-PgUp ........ go to parent directory
675 Any other dired keybinding (not overridden by any of the above) can be used in
676 Sunrise, like G for changing group, M for changing mode and so on.
678 Some more bindings are available in terminals opened using any of the Sunrise
679 functions (i.e. one of: C-c t, C-c T, C-c C-t, C-c M-t):
681 C-c Tab ....... switch focus to the active pane
682 C-c t ......... cycle through all currently open terminals
683 C-c T ......... cd to the directory in the active pane
684 C-c C-t ....... open new terminal, cd to directory in the active pane
685 C-c ; ......... follow the current directory in the active pane
686 C-c { ......... shrink the panes vertically as much as possible
687 C-c } ......... enlarge the panes vertically as much as possible
688 C-c \\ ......... restore the size of all windows back to «normal»
689 C-c C-j ....... put terminal in line mode
690 C-c C-k ....... put terminal back in char mode
692 The following bindings are available only in line mode (eshell is considered to
693 be *always* in line mode):
695 M-<up>, M-P ... move cursor up in the active pane
696 M-<down>, M-N . move cursor down in the active pane
697 M-Return ...... visit selected file/directory in the active pane
698 M-J ........... go to parent directory in the active pane
699 M-G ........... refresh active pane
700 M-Tab ......... switch to passive pane (without leaving the terminal)
701 M-M ........... mark selected file/directory in the active pane
702 M-Backspace ... unmark previous file/directory in the active pane
703 M-U ........... remove all marks from the active pane
704 C-Tab ......... switch focus to the active pane
706 In a terminal in line mode the following substitutions are also performed
709 %f - expands to the currently selected file in the left pane
710 %F - expands to the currently selected file in the right pane
711 %m - expands to the list of paths of all marked files in the left pane
712 %M - expands to the list of paths of all marked files in the right pane
713 %n - expands to the list of names of all marked files in the left pane
714 %N - expands to the list of names of all marked files in the right pane
715 %d - expands to the current directory in the left pane
716 %D - expands to the current directory in the right pane
717 %a - expands to the list of paths of all marked files in the active pane
718 %A - expands to the current directory in the active pane
719 %p - expands to the list of paths of all marked files in the passive pane
720 %P - expands to the current directory in the passive pane
721 %% - inserts a single % sign.
724 (unless (string-match "\\(Sunrise\\)" (buffer-name))
725 (rename-buffer (concat (buffer-name) " (Sunrise)") t))
726 (set-keymap-parent sr-mode-map dired-mode-map)
728 (dired-omit-mode dired-omit-mode)
730 (make-local-variable 'truncate-partial-width-windows)
731 (setq truncate-partial-width-windows (sr-truncate-v t))
733 (set (make-local-variable 'dired-header-face) 'sr-passive-path-face)
734 (set (make-local-variable 'dired-recursive-deletes) 'top)
735 (set (make-local-variable 'truncate-lines) nil)
736 (set (make-local-variable 'desktop-save-buffer) 'sr-desktop-save-buffer)
737 (set (make-local-variable 'revert-buffer-function) 'sr-revert-buffer)
738 (set (make-local-variable 'buffer-quit-function) 'sr-quit)
739 (set (make-local-variable 'sr-show-file-attributes) sr-show-file-attributes)
740 (set (make-local-variable 'hl-line-sticky-flag) nil)
745 (define-derived-mode sr-virtual-mode dired-virtual-mode "Sunrise VIRTUAL"
746 "Sunrise Commander Virtual Mode. Useful for reusing find and locate results."
748 (set-keymap-parent sr-virtual-mode-map sr-mode-map)
752 (make-local-variable 'truncate-partial-width-windows)
753 (setq truncate-partial-width-windows (sr-truncate-v t))
755 (set (make-local-variable 'dired-header-face) 'sr-passive-path-face)
756 (set (make-local-variable 'truncate-lines) nil)
757 (set (make-local-variable 'desktop-save-buffer) 'sr-desktop-save-buffer)
758 (set (make-local-variable 'revert-buffer-function) 'sr-revert-buffer)
759 (set (make-local-variable 'buffer-quit-function) 'sr-quit)
760 (set (make-local-variable 'sr-show-file-attributes) sr-show-file-attributes)
761 (set (make-local-variable 'hl-line-sticky-flag) nil)
764 (define-key sr-virtual-mode-map "\C-c\C-c" 'sr-virtual-dismiss))
766 (defmacro sr-within (dir form)
767 "Evaluate FORM in Sunrise context."
770 (setq sr-dired-directory
771 (file-name-as-directory (abbreviate-file-name ,dir)))
772 (ad-activate 'dired-find-buffer-nocreate)
774 (ad-deactivate 'dired-find-buffer-nocreate)
775 (setq sr-dired-directory "")))
777 (defmacro sr-save-aspect (&rest body)
778 "Restore omit mode, hidden attributes and point after a directory transition."
779 `(let ((inhibit-read-only t)
780 (omit (or dired-omit-mode -1))
781 (attrs (eval 'sr-show-file-attributes))
782 (path-faces sr-current-path-faces))
784 (dired-omit-mode omit)
786 (setq sr-current-path-faces path-faces))
787 (if (string= "NUMBER" (get sr-selected-window 'sorting-order))
788 (sr-sort-by-operation 'sr-numerical-sort-op))
789 (if (get sr-selected-window 'sorting-reverse)
791 (setq sr-show-file-attributes attrs)
792 (sr-display-attributes (point-min) (point-max) sr-show-file-attributes)
793 (sr-restore-point-if-same-buffer)))
795 (defmacro sr-alternate-buffer (form)
796 "Execute FORM in a new buffer, after killing the previous one."
797 `(let ((dispose nil))
798 (unless (or (not (or dired-directory (eq major-mode 'sr-tree-mode)))
799 (eq sr-left-buffer sr-right-buffer))
800 (setq dispose (current-buffer)))
802 (setq sr-this-directory default-directory)
805 (when (and sr-kill-unused-buffers (buffer-live-p dispose))
806 (with-current-buffer dispose
808 (set-buffer-modified-p nil)
809 (unless (kill-buffer dispose)
810 (kill-local-variable 'sr-current-path-faces))))))
812 (defmacro sr-in-other (form)
813 "Execute FORM in the context of the passive pane.
814 Helper macro for passive & synchronized navigation."
815 `(let ((home sr-selected-window))
816 (let ((sr-inhibit-highlight t))
817 (if sr-synchronized ,form)
819 (condition-case description
821 (error (message (cadr description)))))
823 (sr-select-window home)
824 (run-hooks 'sr-refresh-hook)
825 (sr-change-window))))
827 (defmacro sr-silently (&rest body)
828 "Inhibit calls to `message' in BODY."
829 `(letf (((symbol-function 'message) (lambda (_msg &rest _args) (ignore))))
833 (defun sr-symbol (side type)
834 "Synthesize Sunrise symbols (`sr-left-buffer', `sr-right-window', etc.)."
835 (intern (concat "sr-" (symbol-name side) "-" (symbol-name type)))))
837 (defun sr-dired-mode ()
838 "Set Sunrise mode in every Dired buffer opened in Sunrise (called in a hook)."
840 (eq (selected-frame) sr-current-frame)
841 (sr-equal-dirs dired-directory default-directory)
842 (not (eq major-mode 'sr-mode)))
843 (let ((dired-listing-switches dired-listing-switches)
844 (sorting-options (or (get sr-selected-window 'sorting-options) "")))
845 (unless (and (featurep 'tramp)
846 (string-match tramp-file-name-regexp default-directory))
847 (setq dired-listing-switches
848 (concat sr-listing-switches sorting-options)))
850 (dired-unadvertise dired-directory))))
851 (add-hook 'dired-before-readin-hook 'sr-dired-mode)
853 (defun sr-bookmark-jump ()
854 "Handle panes opened from bookmarks in Sunrise."
855 (when (and sr-running
856 (memq (selected-window) (list sr-left-window sr-right-window)))
857 (let ((last-buf (symbol-value (sr-symbol sr-selected-window 'buffer))))
858 (setq dired-omit-mode (with-current-buffer last-buf dired-omit-mode))
859 (setq sr-this-directory default-directory)
860 (if (sr-equal-dirs sr-this-directory sr-other-directory)
861 (sr-synchronize-panes t)
864 (unless (memq last-buf (list (current-buffer) (sr-other 'buffer)))
865 (kill-buffer last-buf)))))
866 (add-hook 'bookmark-after-jump-hook 'sr-bookmark-jump)
868 (defun sr-virtualize-pane ()
869 "Put the current normal view in VIRTUAL mode."
871 (when (eq major-mode 'sr-mode)
872 (let ((focus (dired-get-filename 'verbatim t)))
874 (when (eq sr-left-buffer sr-right-buffer)
875 (dired default-directory)
878 (if focus (sr-focus-filename focus)))))
880 (defun sr-virtual-dismiss ()
881 "Restore normal pane view in Sunrise VIRTUAL mode."
883 (when (eq major-mode 'sr-virtual-mode)
884 (let ((focus (dired-get-filename 'verbatim t)))
887 (sr-alternate-buffer (sr-goto-dir sr-this-directory))
888 (if focus (sr-focus-filename focus))
891 (defun sr-select-window (side)
892 "Select/highlight the given Sunrise window (right or left)."
893 (select-window (symbol-value (sr-symbol side 'window)))
894 (setq sr-selected-window side)
895 (setq sr-this-directory default-directory)
898 (defun sr-viewer-window ()
899 "Return an active window that can be used as the viewer."
900 (if (or (memq major-mode '(sr-mode sr-virtual-mode sr-tree-mode))
901 (memq (current-buffer) (list sr-left-buffer sr-right-buffer)))
902 (let ((current-window (selected-window)) (target-window))
904 (setq current-window (next-window current-window))
905 (unless (memq current-window (list sr-left-window sr-right-window))
906 (setq target-window current-window)))
910 (defun sr-select-viewer-window (&optional force-setup)
911 "Select a window that is not a Sunrise pane.
912 If no suitable active window can be found and FORCE-SETUP is set,
913 calls the function `sr-setup-windows' and tries once again."
915 (let ((viewer (sr-viewer-window)))
916 (if (memq major-mode '(sr-mode sr-virtual-mode sr-tree-mode))
919 (select-window viewer)
922 (select-window (sr-viewer-window))))))
924 (defun sr-backup-buffer ()
925 "Create a backup copy of the current buffer.
926 Used as a cache during revert operations."
927 (if (buffer-live-p sr-backup-buffer) (sr-kill-backup-buffer))
928 (let ((buf (current-buffer)))
929 (setq sr-backup-buffer (generate-new-buffer "*Sunrise Backup*"))
930 (with-current-buffer sr-backup-buffer
931 (insert-buffer-substring buf))
932 (run-hooks 'sr-refresh-hook)))
934 (defun sr-kill-backup-buffer ()
935 "Kill the backup buffer associated to the current one, if there is any."
936 (when (buffer-live-p sr-backup-buffer)
937 (kill-buffer sr-backup-buffer)
938 (setq sr-backup-buffer nil)))
939 (add-hook 'kill-buffer-hook 'sr-kill-backup-buffer)
940 (add-hook 'change-major-mode-hook 'sr-kill-backup-buffer)
942 (add-to-list 'enriched-translations '(invisible (t "x-invisible")))
943 (defun sr-enrich-buffer ()
944 "Activate `enriched-mode' before saving a Sunrise buffer to a file.
945 This is done so all its dired-filename attributes are kept in the file."
946 (if (memq major-mode '(sr-mode sr-virtual-mode))
948 (add-hook 'before-save-hook 'sr-enrich-buffer)
950 (defun sr-extend-with (extension &optional filename)
951 "Try to enhance Sunrise with EXTENSION (argument must be a symbol).
952 An extension can be loaded from optional FILENAME. If found, the extension is
953 immediately loaded, but only if `sr-autoload-extensions' is not nil."
954 (when sr-autoload-extensions
955 (require extension filename t)))
957 (defadvice dired-find-buffer-nocreate
958 (before sr-advice-findbuffer (dirname &optional mode))
959 "A hack to avoid some Dired mode quirks in the Sunrise Commander."
960 (if (sr-equal-dirs sr-dired-directory dirname)
961 (setq mode 'sr-mode)))
962 ;; ^--- activated by sr-within macro
964 (defadvice dired-dwim-target-directory
965 (around sr-advice-dwim-target ())
966 "Tweak the target directory guessing mechanism when Sunrise Commander is on."
967 (if (and sr-running (eq (selected-frame) sr-current-frame))
968 (setq ad-return-value sr-other-directory)
970 (ad-activate 'dired-dwim-target-directory)
972 (defadvice other-window
973 (around sr-advice-other-window (count &optional all-frames))
974 "Select the correct Sunrise Commander pane when switching from other windows."
975 (if (or (not sr-running) sr-ediff-on)
977 (let ((from (selected-window)))
979 (unless (memq from (list sr-left-window sr-right-window))
980 ;; switching from outside
981 (sr-select-window sr-selected-window))
983 (when (eq (selected-window) (sr-other 'window))
984 ;; switching from the other pane
985 (sr-change-window))))))
986 (ad-activate 'other-window)
988 (defadvice use-hard-newlines
989 (around sr-advice-use-hard-newlines (&optional arg insert))
990 "Stop asking if I want hard lines the in Sunrise Commander, just guess."
991 (if (memq major-mode '(sr-mode sr-virtual-mode))
992 (let ((inhibit-read-only t))
996 (ad-activate 'use-hard-newlines)
998 (defadvice dired-insert-set-properties
999 (after sr-advice-dired-insert-set-properties (beg end))
1000 "Manage hidden attributes in files added externally (e.g. from find-dired) to
1001 the Sunrise Commander."
1002 (when (memq major-mode '(sr-mode sr-virtual-mode))
1004 (sr-display-attributes beg end sr-show-file-attributes))))
1005 (ad-activate 'dired-insert-set-properties)
1007 ;;; ============================================================================
1008 ;;; Sunrise Commander keybindings:
1010 (define-key sr-mode-map "\C-m" 'sr-advertised-find-file)
1011 (define-key sr-mode-map "f" 'sr-advertised-find-file)
1012 (define-key sr-mode-map "X" 'sr-advertised-execute-file)
1013 (define-key sr-mode-map "o" 'sr-quick-view)
1014 (define-key sr-mode-map "v" 'sr-quick-view)
1015 (define-key sr-mode-map "/" 'sr-goto-dir)
1016 (define-key sr-mode-map "j" 'sr-goto-dir)
1017 (define-key sr-mode-map "^" 'sr-dired-prev-subdir)
1018 (define-key sr-mode-map "J" 'sr-dired-prev-subdir)
1019 (define-key sr-mode-map ";" 'sr-follow-file)
1020 (define-key sr-mode-map "\M-t" 'sr-transpose-panes)
1021 (define-key sr-mode-map "\M-o" 'sr-synchronize-panes)
1022 (define-key sr-mode-map "\C-\M-o" 'sr-project-path)
1023 (define-key sr-mode-map "\M-y" 'sr-history-prev)
1024 (define-key sr-mode-map "\M-u" 'sr-history-next)
1025 (define-key sr-mode-map "\C-c>" 'sr-checkpoint-save)
1026 (define-key sr-mode-map "\C-c." 'sr-checkpoint-restore)
1027 (define-key sr-mode-map "\C-c\C-z" 'sr-sync)
1028 (define-key sr-mode-map "\C-c\C-c" 'revert-buffer)
1030 (define-key sr-mode-map "\t" 'sr-change-window)
1031 (define-key sr-mode-map "\C-c\t" 'sr-select-viewer-window)
1032 (define-key sr-mode-map "\M-a" 'sr-beginning-of-buffer)
1033 (define-key sr-mode-map "\M-e" 'sr-end-of-buffer)
1034 (define-key sr-mode-map "\C-c\C-s" 'sr-split-toggle)
1035 (define-key sr-mode-map "]" 'sr-enlarge-left-pane)
1036 (define-key sr-mode-map "[" 'sr-enlarge-right-pane)
1037 (define-key sr-mode-map "}" 'sr-enlarge-panes)
1038 (define-key sr-mode-map "{" 'sr-shrink-panes)
1039 (define-key sr-mode-map "\\" 'sr-lock-panes)
1040 (define-key sr-mode-map "\C-c}" 'sr-max-lock-panes)
1041 (define-key sr-mode-map "\C-c{" 'sr-min-lock-panes)
1042 (define-key sr-mode-map "\C-o" 'dired-omit-mode)
1043 (define-key sr-mode-map "b" 'sr-browse-file)
1044 (define-key sr-mode-map "\C-c\C-w" 'sr-browse-pane)
1045 (define-key sr-mode-map "\C-c\d" 'sr-toggle-attributes)
1046 (define-key sr-mode-map "\M-l" 'sr-toggle-truncate-lines)
1047 (define-key sr-mode-map "s" 'sr-interactive-sort)
1048 (define-key sr-mode-map "r" 'sr-reverse-pane)
1049 (define-key sr-mode-map "\C-e" 'sr-scroll-up)
1050 (define-key sr-mode-map "\C-y" 'sr-scroll-down)
1051 (define-key sr-mode-map " " 'sr-scroll-quick-view)
1052 (define-key sr-mode-map "\M- " 'sr-scroll-quick-view-down)
1053 (define-key sr-mode-map [?\S- ] 'sr-scroll-quick-view-down)
1055 (define-key sr-mode-map "C" 'sr-do-copy)
1056 (define-key sr-mode-map "K" 'sr-do-clone)
1057 (define-key sr-mode-map "R" 'sr-do-rename)
1058 (define-key sr-mode-map "D" 'sr-do-delete)
1059 (define-key sr-mode-map "x" 'sr-do-flagged-delete)
1060 (define-key sr-mode-map "S" 'sr-do-symlink)
1061 (define-key sr-mode-map "Y" 'sr-do-relsymlink)
1062 (define-key sr-mode-map "H" 'sr-do-hardlink)
1063 (define-key sr-mode-map "\M-C" 'dired-do-copy)
1064 (define-key sr-mode-map "\M-R" 'dired-do-rename)
1065 (define-key sr-mode-map "\M-D" 'dired-do-delete)
1066 (define-key sr-mode-map "\M-S" 'dired-do-symlink)
1067 (define-key sr-mode-map "\M-Y" 'dired-do-relsymlink)
1068 (define-key sr-mode-map "\M-H" 'dired-do-hardlink)
1069 (define-key sr-mode-map "\C-x\C-q" 'sr-editable-pane)
1070 (define-key sr-mode-map "@" 'sr-fast-backup-files)
1071 (define-key sr-mode-map "\M-+" 'sr-create-files)
1073 (define-key sr-mode-map "=" 'sr-diff)
1074 (define-key sr-mode-map "\C-c=" 'sr-ediff)
1075 (define-key sr-mode-map "\C-x=" 'sr-compare-panes)
1077 (define-key sr-mode-map "\C-c\C-f" 'sr-find)
1078 (define-key sr-mode-map "\C-c\C-n" 'sr-find-name)
1079 (define-key sr-mode-map "\C-c\C-g" 'sr-find-grep)
1080 (define-key sr-mode-map "\C-cb" 'sr-flatten-branch)
1081 (define-key sr-mode-map "\C-cp" 'sr-prune-paths)
1082 (define-key sr-mode-map "\C-c\C-l" 'sr-locate)
1083 (define-key sr-mode-map "\C-c/" 'sr-fuzzy-narrow)
1084 (define-key sr-mode-map "\C-c\C-r" 'sr-recent-files)
1085 (define-key sr-mode-map "\C-c\C-d" 'sr-recent-directories)
1086 (define-key sr-mode-map "\C-cv" 'sr-virtualize-pane)
1087 (define-key sr-mode-map "\C-c\C-v" 'sr-pure-virtual)
1088 (define-key sr-mode-map "Q" 'sr-do-query-replace-regexp)
1089 (define-key sr-mode-map "F" 'sr-do-find-marked-files)
1090 (define-key sr-mode-map "A" 'sr-do-search)
1091 (define-key sr-mode-map "\C-cs" 'sr-sticky-isearch-forward)
1092 (define-key sr-mode-map "\C-cr" 'sr-sticky-isearch-backward)
1093 (define-key sr-mode-map "\C-x\C-f" 'sr-find-file)
1094 (define-key sr-mode-map "y" 'sr-show-files-info)
1096 (define-key sr-mode-map "\M-n" 'sr-next-line-other)
1097 (define-key sr-mode-map [M-down] 'sr-next-line-other)
1098 (define-key sr-mode-map [A-down] 'sr-next-line-other)
1099 (define-key sr-mode-map "\M-p" 'sr-prev-line-other)
1100 (define-key sr-mode-map [M-up] 'sr-prev-line-other)
1101 (define-key sr-mode-map [A-up] 'sr-prev-line-other)
1102 (define-key sr-mode-map "\M-j" 'sr-goto-dir-other)
1103 (define-key sr-mode-map "\M-\C-m" 'sr-advertised-find-file-other)
1104 (define-key sr-mode-map "\M-f" 'sr-advertised-find-file-other)
1105 (define-key sr-mode-map "\C-c\C-m" 'sr-advertised-find-file-other)
1106 (define-key sr-mode-map "\M-^" 'sr-prev-subdir-other)
1107 (define-key sr-mode-map "\M-J" 'sr-prev-subdir-other)
1108 (define-key sr-mode-map "\M-m" 'sr-mark-other)
1109 (define-key sr-mode-map "\M-M" 'sr-unmark-backward-other)
1110 (define-key sr-mode-map "\M-U" 'sr-unmark-all-marks-other)
1111 (define-key sr-mode-map "\M-;" 'sr-follow-file-other)
1112 (define-key sr-mode-map "\C-\M-y" 'sr-history-prev-other)
1113 (define-key sr-mode-map "\C-\M-u" 'sr-history-next-other)
1115 (define-key sr-mode-map "\C-ct" 'sr-term)
1116 (define-key sr-mode-map "\C-cT" 'sr-term-cd)
1117 (define-key sr-mode-map "\C-c\C-t" 'sr-term-cd-newterm)
1118 (define-key sr-mode-map "\C-c\M-t" 'sr-term-cd-program)
1119 (define-key sr-mode-map "\C-c;" 'sr-follow-viewer)
1120 (define-key sr-mode-map "q" 'sr-quit)
1121 (define-key sr-mode-map "\C-xk" 'sr-kill-pane-buffer)
1122 (define-key sr-mode-map "\M-q" 'sunrise-cd)
1123 (define-key sr-mode-map "h" 'sr-describe-mode)
1124 (define-key sr-mode-map "?" 'sr-summary)
1125 (define-key sr-mode-map "k" 'dired-do-kill-lines)
1126 (define-key sr-mode-map [remap undo] 'sr-undo)
1127 (define-key sr-mode-map [remap undo-only] 'sr-undo)
1128 (define-key sr-mode-map [backspace] 'dired-unmark-backward)
1130 (define-key sr-mode-map [mouse-1] 'sr-mouse-advertised-find-file)
1131 (define-key sr-mode-map [mouse-2] 'sr-mouse-change-window)
1133 (define-key sr-mode-map [(control >)] 'sr-checkpoint-save)
1134 (define-key sr-mode-map [(control .)] 'sr-checkpoint-restore)
1135 (define-key sr-mode-map [(control tab)] 'sr-select-viewer-window)
1136 (define-key sr-mode-map [(control backspace)] 'sr-toggle-attributes)
1137 (define-key sr-mode-map [(control ?\=)] 'sr-ediff)
1138 (define-key sr-mode-map [(control meta ?\=)] 'sr-compare-panes)
1139 (define-key sr-mode-map [(control })] 'sr-max-lock-panes)
1140 (define-key sr-mode-map [(control {)] 'sr-min-lock-panes)
1142 (define-key sr-mode-map (kbd "<down-mouse-1>") 'ignore)
1144 (defvar sr-commander-keys
1145 '(([(f2)] . sr-goto-dir)
1146 ([(f3)] . sr-quick-view)
1147 ([(f4)] . sr-advertised-find-file)
1148 ([(f5)] . sr-do-copy)
1149 ([(f6)] . sr-do-rename)
1150 ([(f7)] . dired-create-directory)
1151 ([(f8)] . sr-do-delete)
1153 ([(control f3)] . sr-sort-by-name)
1154 ([(control f4)] . sr-sort-by-extension)
1155 ([(control f5)] . sr-sort-by-time)
1156 ([(control f6)] . sr-sort-by-size)
1157 ([(control f7)] . sr-sort-by-number)
1158 ([(shift f7)] . sr-do-symlink)
1159 ([(insert)] . sr-mark-toggle)
1160 ([(control prior)] . sr-dired-prev-subdir))
1161 "Traditional commander-style keybindings for the Sunrise Commander.")
1163 (defcustom sr-use-commander-keys t
1164 "Whether to use traditional commander-style function keys (F5 = copy, etc)"
1167 :set (defun sr-set-commander-keys (symbol value)
1168 "Setter function for the `sr-use-commander-keys' custom option."
1171 (define-key sr-mode-map (car x) (cdr x))) sr-commander-keys)
1173 (define-key sr-mode-map (car x) nil)) sr-commander-keys))
1174 (set-default symbol value)))
1176 ;;; ============================================================================
1177 ;;; Initialization and finalization functions:
1180 (defun sunrise (&optional left-directory right-directory filename)
1181 "Toggle the Sunrise Commander file manager.
1182 If LEFT-DIRECTORY is given, the left window will display that
1183 directory (same for RIGHT-DIRECTORY). Specifying nil for any of
1184 these values uses the default, ie. $HOME."
1186 (message "Starting Sunrise Commander...")
1188 (if (not sr-running)
1189 (let ((welcome sr-start-message))
1191 (setq sr-left-directory left-directory))
1193 (setq sr-right-directory right-directory))
1195 (sr-switch-to-nonpane-buffer)
1196 (setq sr-restore-buffer (current-buffer)
1197 sr-current-frame (window-frame (selected-window))
1198 sr-prior-window-configuration (current-window-configuration)
1202 (condition-case description
1203 (sr-focus-filename (file-name-nondirectory filename))
1204 (error (setq welcome (cadr description)))))
1205 (setq sr-this-directory default-directory)
1206 (message "%s" welcome)
1207 (sr-highlight) ;;<-- W32Emacs needs this
1209 (let ((my-frame (window-frame (selected-window))))
1211 (message "All life leaps out to greet the light...")
1212 (unless (eq my-frame (window-frame (selected-window)))
1213 (select-frame my-frame)
1214 (sunrise left-directory right-directory filename)))))
1217 (defun sr-dired (&optional target switches)
1218 "Visit the given target (file or directory) in `sr-mode'."
1221 (read-file-name "Visit (file or directory): " nil nil nil)))
1222 (let* ((target (expand-file-name (or target default-directory)))
1223 (file (if (file-directory-p target) nil target))
1224 (directory (if file (file-name-directory target) target))
1225 (dired-omit-mode (if sr-show-hidden-files -1 1))
1226 (sr-listing-switches (or switches sr-listing-switches)))
1227 (unless (file-readable-p directory)
1228 (error "%s is not readable!" (sr-directory-name-proper directory)))
1229 (unless (and sr-running (eq (selected-frame) sr-current-frame)) (sunrise))
1230 (sr-select-window sr-selected-window)
1232 (sr-follow-file file)
1233 (sr-goto-dir directory))
1235 (sr-display-attributes (point-min) (point-max) sr-show-file-attributes)
1238 (defun sr-choose-cd-target ()
1239 "Select a suitable target directory for cd operations."
1240 (if (and sr-running (eq (selected-frame) sr-current-frame))
1245 (defun sunrise-cd ()
1246 "Toggle the Sunrise Commander FM keeping the current file in focus.
1247 If Sunrise is off, enable it and focus the file displayed in the current buffer.
1248 If Sunrise is on, disable it and switch to the buffer currently displayed in the
1251 (if (not (and sr-running
1252 (eq (window-frame sr-left-window) (selected-frame))))
1253 (sr-dired (or (buffer-file-name) (sr-choose-cd-target)))
1255 (message "Hast thou a charm to stay the morning-star in his deep course?")))
1257 (defun sr-this (&optional type)
1258 "Return object of type TYPE corresponding to the active side of the manager.
1259 If TYPE is not specified (nil), returns a symbol (`left' or `right').
1260 If TYPE is `buffer' or `window', returns the corresponding buffer
1263 (symbol-value (sr-symbol sr-selected-window type))
1264 sr-selected-window))
1266 (defun sr-other (&optional type)
1267 "Return object of type TYPE corresponding to the passive side of the manager.
1268 If TYPE is not specified (nil), returns a symbol (`left' or `right').
1269 If TYPE is `buffer' or `window', returns the corresponding
1271 (let ((side (cdr (assq sr-selected-window sr-side-lookup))))
1273 (symbol-value (sr-symbol side type))
1276 ;;; ============================================================================
1277 ;;; Window management functions:
1279 (defmacro sr-setup-pane (side)
1280 "Helper macro for the function `sr-setup-windows'."
1281 `(let ((sr-selected-window ',side))
1282 (setq ,(sr-symbol side 'window) (selected-window))
1283 (if (buffer-live-p ,(sr-symbol side 'buffer))
1285 (switch-to-buffer ,(sr-symbol side 'buffer))
1286 (setq ,(sr-symbol side 'directory) default-directory))
1287 (sr-dired ,(sr-symbol side 'directory)))))
1289 (defun sr-setup-visible-panes ()
1290 "Set up sunrise on all visible panes."
1291 (sr-setup-pane left)
1292 (unless (eq sr-window-split-style 'top)
1294 (sr-setup-pane right)))
1296 (defun sr-setup-windows()
1297 "Set up the Sunrise window configuration (two windows in `sr-mode')."
1298 (run-hooks 'sr-init-hook)
1299 ;;get rid of all windows except one (not any of the panes!)
1300 (sr-select-viewer-window)
1301 (delete-other-windows)
1302 (if (buffer-live-p other-window-scroll-buffer)
1303 (switch-to-buffer other-window-scroll-buffer)
1304 (sr-switch-to-nonpane-buffer))
1306 ;;now create the viewer window
1307 (unless (and sr-panes-height (< sr-panes-height (frame-height)))
1308 (setq sr-panes-height (sr-get-panes-size)))
1309 (if (and (<= sr-panes-height (* 2 window-min-height))
1310 (eq sr-window-split-style 'vertical))
1311 (setq sr-panes-height (* 2 window-min-height)))
1312 (split-window (selected-window) sr-panes-height)
1314 (case sr-window-split-style
1315 (horizontal (split-window-horizontally))
1316 (vertical (split-window-vertically))
1318 (t (error "Unrecognised `sr-window-split-style' value: %s"
1319 sr-window-split-style)))
1321 (sr-setup-visible-panes)
1323 ;;select the correct window
1324 (sr-select-window sr-selected-window)
1325 (sr-restore-panes-width)
1326 (run-hooks 'sr-start-hook))
1328 (defun sr-switch-to-nonpane-buffer ()
1329 "Try to switch to a buffer that is *not* a Sunrise pane."
1330 (let ((start (current-buffer)))
1333 (or (memq major-mode '(sr-mode sr-virtual-mode sr-tree-mode))
1334 (memq (current-buffer) (list sr-left-buffer sr-right-buffer))))
1336 (if (eq start (current-buffer)) (setq start nil)))))
1338 (defun sr-restore-prior-configuration ()
1339 "Restore the configuration stored in `sr-prior-window-configuration' if any."
1340 (set-window-configuration sr-prior-window-configuration)
1341 (if (buffer-live-p sr-restore-buffer)
1342 (set-buffer sr-restore-buffer)))
1344 (defun sr-lock-window (_frame)
1345 "Resize the left Sunrise pane to have the \"right\" size."
1347 (if (not (window-live-p sr-left-window))
1348 (setq sr-running nil)
1349 (let ((sr-windows-locked sr-windows-locked))
1350 (when (> window-min-height (- (frame-height)
1351 (window-height sr-left-window)))
1352 (setq sr-windows-locked nil))
1353 (and sr-windows-locked
1355 (not (eq sr-window-split-style 'vertical))
1356 (window-live-p sr-left-window)
1357 (save-selected-window
1358 (select-window sr-left-window)
1359 (let ((my-delta (- sr-panes-height (window-height))))
1360 (enlarge-window my-delta))
1362 (when (window-live-p sr-right-window)
1363 (select-window sr-right-window)
1364 (scroll-right))))))))
1366 ;; This keeps the size of the Sunrise panes constant:
1367 (add-hook 'window-size-change-functions 'sr-lock-window)
1369 (defun sr-highlight(&optional face)
1370 "Set up the path line in the current buffer.
1371 With optional FACE, register this face as the current face to display the active
1373 (when (and (memq major-mode '(sr-mode sr-virtual-mode sr-tree-mode))
1374 (not sr-inhibit-highlight))
1375 (let ((inhibit-read-only t))
1377 (goto-char (point-min))
1379 (sr-highlight-broken-links)
1380 (sr-graphical-highlight face)
1381 (sr-force-passive-highlight)
1382 (run-hooks 'sr-refresh-hook)))))
1384 (defun sr-unhighlight (face)
1385 "Remove FACE from the list of faces of the active path line."
1387 (setq sr-current-path-faces (delq face sr-current-path-faces))
1388 (overlay-put sr-current-window-overlay 'face
1389 (or (car sr-current-path-faces) 'sr-active-path-face))))
1391 (defun sr-hide-avfs-root ()
1392 "Hide the AVFS virtual filesystem root (if any) on the path line."
1394 (let ((start nil) (end nil)
1395 (next (search-forward sr-avfs-root (point-at-eol) t)))
1396 (if next (setq start (- next (length sr-avfs-root))))
1399 next (search-forward sr-avfs-root (point-at-eol) t)))
1401 (add-text-properties start end '(invisible t))))))
1403 (defun sr-highlight-broken-links ()
1404 "Mark broken symlinks with an exclamation mark."
1405 (let ((dired-marker-char ?!))
1406 (while (search-forward-regexp dired-re-sym nil t)
1407 (unless (or (not (eq 32 (char-after (line-beginning-position))))
1408 (file-exists-p (dired-get-filename)))
1411 (defsubst sr-invalid-overlayp ()
1412 "Test for invalidity of the current buffer's graphical path line overlay.
1413 Returns t if the overlay is no longer valid and should be replaced."
1414 (or (not (overlayp sr-current-window-overlay))
1415 (eq (overlay-start sr-current-window-overlay)
1416 (overlay-end sr-current-window-overlay))))
1418 (defun sr-graphical-highlight (&optional face)
1419 "Set up the graphical path line in the current buffer.
1420 \(Fancy fonts and clickable path.)"
1421 (let ((begin) (end) (inhibit-read-only t))
1423 (when (sr-invalid-overlayp)
1424 ;;determine begining and end
1426 (goto-char (point-min))
1427 (search-forward-regexp "\\S " nil t)
1428 (setq begin (1- (point)))
1430 (setq end (1- (point))))
1433 (when sr-current-window-overlay
1434 (delete-overlay sr-current-window-overlay))
1435 (set (make-local-variable 'sr-current-window-overlay)
1436 (make-overlay begin end))
1438 ;;path line hover effect:
1439 (add-text-properties
1442 '(mouse-face sr-highlight-path-face
1443 help-echo "click to move up")
1446 (setq sr-current-path-faces (cons face sr-current-path-faces)))
1447 (overlay-put sr-current-window-overlay 'face
1448 (or (car sr-current-path-faces) 'sr-active-path-face))
1449 (overlay-put sr-current-window-overlay 'window (selected-window))))
1451 (defun sr-force-passive-highlight (&optional revert)
1452 "Set up the graphical path line in the passive pane.
1453 With optional argument REVERT, executes `revert-buffer' on the passive buffer."
1454 (unless (or (not (buffer-live-p (sr-other 'buffer)))
1455 (eq sr-left-buffer sr-right-buffer))
1456 (with-current-buffer (sr-other 'buffer)
1457 (when sr-current-window-overlay
1458 (delete-overlay sr-current-window-overlay))
1460 (memq major-mode '(sr-mode sr-virtual-mode sr-tree-mode)))
1463 (defun sr-quit (&optional norestore)
1464 "Quit Sunrise and restore Emacs to the previous state."
1468 (setq sr-running nil)
1469 (sr-save-directories)
1470 (sr-save-panes-width)
1473 (sr-select-viewer-window)
1474 (delete-other-windows))
1475 (sr-restore-prior-configuration))
1477 (setq buffer-read-only nil)
1478 (run-hooks 'sr-quit-hook)
1479 (setq sr-current-frame nil))
1482 (add-hook 'delete-frame-functions
1484 (if (and sr-running (eq frame sr-current-frame)) (sr-quit))))
1486 (defun sr-save-directories ()
1487 "Save current directories in the panes to use them at the next startup."
1488 (when (window-live-p sr-left-window)
1489 (set-buffer (window-buffer sr-left-window))
1490 (when (memq major-mode '(sr-mode sr-tree-mode))
1491 (setq sr-left-directory default-directory)
1492 (setq sr-left-buffer (current-buffer))))
1494 (when (window-live-p sr-right-window)
1495 (set-buffer (window-buffer sr-right-window))
1496 (when (memq major-mode '(sr-mode sr-tree-mode))
1497 (setq sr-right-directory default-directory)
1498 (setq sr-right-buffer (current-buffer)))))
1500 (defun sr-bury-panes ()
1501 "Send both pane buffers to the end of the `buffer-list'."
1503 (bury-buffer (symbol-value (sr-symbol x 'buffer))))
1506 (defun sr-save-panes-width ()
1507 "Save the width of the panes to use them at the next startup."
1508 (unless sr-selected-window-width
1509 (if (and (window-live-p sr-left-window)
1510 (window-live-p sr-right-window))
1511 (setq sr-selected-window-width
1513 (symbol-value (sr-symbol sr-selected-window 'window))))
1514 (setq sr-selected-window-width t))))
1516 (defun sr-restore-panes-width ()
1517 "Restore the last registered pane width."
1518 (when (and (eq sr-window-split-style 'horizontal)
1519 (numberp sr-selected-window-width))
1520 (enlarge-window-horizontally
1521 (min (- sr-selected-window-width (window-width))
1522 (- (frame-width) (window-width) window-min-width)))))
1524 (defun sr-resize-panes (&optional reverse)
1525 "Enlarge (or shrink, if REVERSE is t) the left pane by 5 columns."
1526 (when (and (window-live-p sr-left-window)
1527 (window-live-p sr-right-window))
1528 (let ((direction (or (and reverse -1) 1)))
1529 (save-selected-window
1530 (select-window sr-left-window)
1531 (enlarge-window-horizontally (* 5 direction))))
1532 (setq sr-selected-window-width nil)))
1534 (defun sr-enlarge-left-pane ()
1535 "Enlarge the left pane by 5 columns."
1537 (when (< (1+ window-min-width) (window-width sr-right-window))
1539 (sr-save-panes-width)))
1541 (defun sr-enlarge-right-pane ()
1542 "Enlarge the right pane by 5 columns."
1544 (when (< (1+ window-min-width) (window-width sr-left-window))
1546 (sr-save-panes-width)))
1548 (defun sr-get-panes-size (&optional size)
1549 "Tell what the maximal, minimal and normal pane sizes should be."
1550 (let ((frame (frame-height)))
1552 (max (max (- frame window-min-height 1) 5))
1553 (min (min (1+ window-min-height) 5))
1554 (t (/ (* sr-windows-default-ratio (frame-height)) 100)))))
1556 (defun sr-enlarge-panes ()
1557 "Enlarge both panes vertically."
1559 (let ((sr-windows-locked nil)
1560 (max (sr-get-panes-size 'max))
1563 (save-selected-window
1564 (when (eq sr-window-split-style 'vertical)
1565 (select-window sr-right-window)
1567 (setq delta (- max (window-height)))
1568 (if (> (/ max ratio) (window-height))
1569 (shrink-window (if (< 2 delta) -2 -1))))
1570 (select-window sr-left-window)
1571 (if (> (/ max ratio) (window-height))
1573 (setq sr-panes-height (* (window-height) ratio)))))
1575 (defun sr-shrink-panes ()
1576 "Shink both panes vertically."
1578 (let ((sr-windows-locked nil)
1579 (min (sr-get-panes-size 'min))
1582 (save-selected-window
1583 (when (eq sr-window-split-style 'vertical)
1584 (select-window sr-right-window)
1586 (setq delta (- (window-height) min))
1587 (if (< min (window-height))
1588 (shrink-window (if (< 2 delta) 2 1))))
1589 (select-window sr-left-window)
1590 (if (< min (window-height))
1592 (setq sr-panes-height (* (window-height) ratio)))))
1594 (defun sr-lock-panes (&optional height)
1595 "Resize and lock the panes at some vertical position.
1596 The optional argument determines the height to lock the panes at.
1597 Valid values are `min' and `max'; given any other value, locks
1598 the panes at normal position."
1601 (if (not (and (window-live-p sr-left-window)
1602 (or (window-live-p sr-right-window)
1603 (eq sr-window-split-style 'top))))
1605 (setq sr-panes-height (sr-get-panes-size height))
1606 (let ((locked sr-windows-locked))
1607 (setq sr-windows-locked t)
1610 (setq sr-selected-window-width t)
1614 (setq sr-windows-locked nil))))
1617 (defun sr-max-lock-panes ()
1619 (sr-save-panes-width)
1620 (sr-lock-panes 'max))
1622 (defun sr-min-lock-panes ()
1624 (sr-save-panes-width)
1625 (sr-lock-panes 'min))
1627 ;;; ============================================================================
1628 ;;; File system navigation functions:
1630 (defun sr-advertised-find-file (&optional filename)
1631 "Handle accesses to file system objects through the user interface.
1632 Includes cases when the user presses return, f or clicks on the path line."
1635 (if (eq 1 (line-number-at-pos)) ;; <- Click or Enter on path line.
1636 (let* ((path (buffer-substring (point) (point-at-eol)))
1637 (levels (1- (length (split-string path "/")))))
1639 (sr-dired-prev-subdir levels)
1640 (sr-beginning-of-buffer)))
1641 (setq filename (dired-get-filename nil t)
1642 filename (and filename (expand-file-name filename)))))
1644 (if (file-exists-p filename)
1645 (sr-find-file filename)
1646 (error "Sunrise: nonexistent target"))))
1648 (defun sr-advertised-execute-file (&optional prefix)
1649 "Execute the currently selected file in a new subprocess."
1651 (let ((path (dired-get-filename nil t)) (label) (args))
1653 (setq label (file-name-nondirectory path))
1654 (error "Sunrise: no executable file on this line"))
1655 (unless (and (not (file-directory-p path)) (file-executable-p path))
1656 (error "Sunrise: \"%s\" is not an executable file" label))
1658 (setq args (read-string (format "arguments for \"%s\": " label))
1659 label (format "%s %s" label args)))
1660 (message "Sunrise: executing \"%s\" in new process" label)
1662 (apply #'start-process (append (list "Sunrise Subprocess" nil path)
1663 (split-string args)))
1664 (start-process "Sunrise Subprocess" nil path))))
1666 (defun sr-find-file (filename &optional wildcards)
1667 "Determine the proper way of handling an object in the file system.
1668 FILENAME can be either a regular file, a regular directory, a
1669 Sunrise VIRTUAL directory, or a virtual directory served by
1671 (interactive (find-file-read-args "Find file or directory: " nil))
1672 (cond ((file-directory-p filename) (sr-find-regular-directory filename))
1673 ((and (sr-avfs-directory-p filename) (sr-avfs-dir filename))
1674 (sr-find-regular-directory (sr-avfs-dir filename)))
1675 ((sr-virtual-directory-p filename) (sr-find-virtual-directory filename))
1676 (t (sr-find-regular-file filename wildcards))))
1678 (defun sr-virtual-directory-p (filename)
1679 "Tell whether FILENAME is the path to a Sunrise VIRTUAL directory."
1680 (eq 'sr-virtual-mode (assoc-default filename auto-mode-alist 'string-match)))
1682 (defun sr-avfs-directory-p (filename)
1683 "Tell whether FILENAME can be seen as the root of an AVFS virtual directory."
1684 (let ((mode (assoc-default filename auto-mode-alist 'string-match)))
1686 (or (eq 'archive-mode mode)
1688 (and (listp mode) (eq 'jka-compr (cadr mode)))
1689 (not (equal "." (sr-assoc-key filename
1690 sr-avfs-handlers-alist
1691 'string-match)))))))
1693 (defun sr-find-regular-directory (directory)
1694 "Visit the given regular directory in the active pane."
1695 (setq directory (file-name-as-directory directory))
1696 (let ((parent (expand-file-name "../")))
1697 (if (and (not (sr-equal-dirs parent default-directory))
1698 (sr-equal-dirs directory parent))
1699 (sr-dired-prev-subdir)
1700 (sr-goto-dir directory))))
1702 (defun sr-find-virtual-directory (sr-virtual-dir)
1703 "Visit the given Sunrise VIRTUAL directory in the active pane."
1705 (sr-alternate-buffer (find-file sr-virtual-dir)))
1706 (sr-history-push sr-virtual-dir)
1707 (set-visited-file-name nil t)
1711 (defun sr-find-regular-file (filename &optional wildcards)
1712 "Deactivate Sunrise and visit FILENAME as a regular file with WILDCARDS.
1713 \(See `find-file' for more details on wildcard expansion.)"
1714 (condition-case description
1715 (let ((buff (find-file-noselect filename nil nil wildcards)))
1716 (sr-save-panes-width)
1718 (set-window-configuration sr-prior-window-configuration)
1719 (switch-to-buffer buff))
1720 (error (message "%s" (cadr description)))))
1722 (defun sr-avfs-dir (filename)
1723 "Return the virtual path for accessing FILENAME through AVFS.
1724 Returns nil if AVFS cannot manage this kind of file."
1725 (let* ((handler (assoc-default filename sr-avfs-handlers-alist 'string-match))
1726 (vdir (concat filename handler)))
1727 (unless (sr-overlapping-paths-p sr-avfs-root vdir)
1728 (setq vdir (concat sr-avfs-root vdir)))
1729 (if (file-attributes vdir) vdir nil)))
1731 (defun sr-goto-dir (dir)
1732 "Change the current directory in the active pane to the given one."
1733 (interactive "DChange directory (file or pattern): ")
1734 (if sr-goto-dir-function
1735 (funcall sr-goto-dir-function dir)
1736 (unless (and (eq major-mode 'sr-mode) (sr-equal-dirs dir default-directory))
1737 (if (and sr-avfs-root
1738 (null (posix-string-match "#" dir)))
1739 (setq dir (replace-regexp-in-string
1740 (expand-file-name sr-avfs-root) "" dir)))
1742 (sr-within dir (sr-alternate-buffer (dired dir))))
1743 (sr-history-push default-directory)
1744 (sr-beginning-of-buffer))))
1746 (defun sr-dired-prev-subdir (&optional count)
1747 "Go to the parent directory, or COUNT subdirectories upwards."
1749 (unless (sr-equal-dirs default-directory "/")
1750 (let* ((count (or count 1))
1751 (to (replace-regexp-in-string "x" "../" (make-string count ?x)))
1752 (from (expand-file-name (substring to 1)))
1753 (from (sr-directory-name-proper from))
1754 (from (replace-regexp-in-string "\\(?:#.*/?$\\|/$\\)" "" from))
1755 (to (replace-regexp-in-string "\\.\\./$" "" (expand-file-name to))))
1757 (unless (sr-equal-dirs from to)
1758 (sr-focus-filename from)))))
1760 (defun sr-follow-file (&optional target-path)
1761 "Go to the same directory where the selected file is.
1762 Very useful inside Sunrise VIRTUAL buffers."
1764 (if (null target-path)
1765 (setq target-path (dired-get-filename nil t)))
1767 (let ((target-dir (file-name-directory target-path))
1768 (target-symlink (file-symlink-p target-path))
1771 ;; if the target is a symlink and there's nothing more interesting to do
1772 ;; then follow the symlink:
1773 (when (and target-symlink
1774 (string= target-dir (dired-current-directory))
1775 (not (eq major-mode 'sr-virtual-mode)))
1776 (unless (file-exists-p target-symlink)
1777 (error "Sunrise: file is a symlink to a nonexistent target"))
1778 (setq target-path target-symlink)
1779 (setq target-dir (file-name-directory target-symlink)))
1781 (setq target-file (file-name-nondirectory target-path))
1783 (when target-dir ;; <-- nil in symlinks to other files in same directory:
1784 (setq target-dir (sr-chop ?/ target-dir))
1785 (sr-goto-dir target-dir))
1786 (sr-focus-filename target-file)))
1788 (defun sr-follow-viewer ()
1789 "Go to the directory of the file displayed in the viewer window."
1792 (let* ((viewer (sr-viewer-window))
1793 (viewer-buffer (if viewer (window-buffer viewer)))
1794 (target-dir) (target-file))
1796 (with-current-buffer viewer-buffer
1797 (setq target-dir default-directory
1798 target-file (sr-directory-name-proper (buffer-file-name)))))
1799 (sr-select-window sr-selected-window)
1800 (if target-dir (sr-goto-dir target-dir))
1801 (if target-file (sr-focus-filename target-file)))))
1803 (defun sr-project-path ()
1804 "Find projections of the active directory over the passive one.
1806 Locates interactively all descendants of the directory in the passive pane that
1807 have a path similar to the directory in the active pane.
1809 For instance, if the active pane is displaying directory /a/b/c and the passive
1810 one is displaying /x/y, this command will check for the existence of any of the
1811 following: /x/y/a/b/c, /x/y/b/c, /x/y/c and /x/y. Each (existing) directory
1812 located according to this schema will be known hereafter as a 'projection of the
1813 directory /a/b/c over /x/y'.
1815 If many projections of the active directory over the passive one exist, one can
1816 rotate among all of them by invoking `sr-project-path' repeatedly : they will be
1817 visited in order, from longest path to shortest."
1820 (let* ((sr-synchronized nil)
1821 (path (sr-chop ?/ (expand-file-name (dired-current-directory))))
1822 (pos (if (< 0 (length path)) 1)) (candidate) (next-key))
1824 (setq candidate (concat sr-other-directory (substring path pos))
1825 pos (string-match "/" path (1+ pos))
1826 pos (if pos (1+ pos)))
1827 (when (and (file-directory-p candidate)
1828 (not (sr-equal-dirs sr-this-directory candidate)))
1829 (sr-goto-dir-other candidate)
1830 (setq next-key (read-key-sequence "(press C-M-o again for more)"))
1831 (if (eq (lookup-key sr-mode-map next-key) 'sr-project-path)
1832 (sr-history-prev-other)
1833 (setq unread-command-events (listify-key-sequence next-key)
1836 (message "Sunrise: sorry, no suitable projections found"))))
1838 (defun sr-history-push (element)
1839 "Push a new path into the history stack of the current pane."
1840 (unless (or (null element)
1841 (and (featurep 'tramp)
1842 (string-match tramp-file-name-regexp element)))
1843 (let* ((pane (assoc sr-selected-window sr-history-registry))
1845 (len (length hist)))
1846 (if (>= len sr-history-length)
1847 (nbutlast hist (- len sr-history-length)))
1848 (setq element (abbreviate-file-name (sr-chop ?/ element))
1849 hist (delete element hist))
1852 (sr-history-stack-reset)))
1854 (defun sr-history-next ()
1855 "Navigate forward in the history of the active pane."
1857 (let ((side (assoc sr-selected-window sr-history-stack)))
1858 (unless (zerop (cadr side))
1859 (sr-history-move -1))
1860 (when (zerop (cadr side))
1861 (sr-history-stack-reset))))
1863 (defun sr-history-prev ()
1864 "Navigate backwards in the history of the active pane."
1866 (let ((history (cdr (assoc sr-selected-window sr-history-registry)))
1867 (stack (cdr (assoc sr-selected-window sr-history-stack))))
1868 (when (< (abs (cdr stack)) (1- (length history)))
1869 (sr-history-move 1))))
1871 (defun sr-history-move (step)
1872 "Traverse the history of the active pane in a stack-like fashion.
1873 This function re-arranges the history list of the current pane so as to make it
1874 simulate a stack of directories, from which one can 'pop' the current directory
1875 and 'push' it back, keeping the most recently visited entries always near the
1877 (let* ((side (assoc sr-selected-window sr-history-stack))
1878 (depth (cadr side)) (goal) (target-dir))
1879 (when (> 0 (* step depth))
1880 (sr-history-stack-reset))
1881 (setq goal (1+ (cddr side))
1882 depth (* step (+ (abs depth) step))
1883 target-dir (sr-history-pick goal))
1885 (sr-goto-dir target-dir)
1886 (setcdr side (cons depth goal)))))
1888 (defun sr-history-stack-reset ()
1889 "Reset the current history stack counter."
1890 (let ((side (assoc sr-selected-window sr-history-stack)))
1891 (setcdr side '(0 . 0))))
1893 (defun sr-history-pick (position)
1894 "Return directory at POSITION in current history.
1895 If the entry was removed or made inaccessible since our last visit, remove it
1896 from the history list and check among the previous ones until an accessible
1897 directory is found, or the list runs out of entries."
1898 (let* ((history (cdr (assoc sr-selected-window sr-history-registry)))
1899 (target (nth position history)))
1900 (while (and target (not (file-accessible-directory-p target)))
1901 (delete target history)
1902 (setq target (nth position history)))
1905 (defun sr-require-checkpoints-extension (&optional noerror)
1906 "Bootstrap code for checkpoint support.
1907 Just tries to require the appropriate checkpoints extension
1908 depending on the version of bookmark.el being used."
1909 (require 'bookmark nil t)
1911 (cond ((fboundp 'bookmark-make-record) 'sunrise-x-checkpoints)
1912 (t 'sunrise-x-old-checkpoints)))
1913 (name (symbol-name feature)))
1915 (not (featurep 'sunrise-commander))
1916 (require feature nil t)
1918 (error "Feature `%s' not found!\
1919 For checkpoints to work, download http://joseito.republika.pl/%s.el.gz\
1920 and add it to your `load-path'" name name))))
1922 (defmacro sr-checkpoint-command (function-name)
1923 `(defun ,function-name (&optional arg)
1925 (sr-require-checkpoints-extension)
1926 (if (commandp #',function-name)
1927 (call-interactively #',function-name)
1928 (funcall #',function-name arg))))
1929 (sr-checkpoint-command sr-checkpoint-save)
1930 (sr-checkpoint-command sr-checkpoint-restore)
1931 (sr-checkpoint-command sr-checkpoint-handler)
1932 ;;;###autoload (autoload 'sr-checkpoint-handler "sunrise-commander" "" t)
1934 (defun sr-do-find-marked-files (&optional noselect)
1935 "Sunrise replacement for `dired-do-find-marked-files'."
1937 (let* ((files (delq nil (mapcar (lambda (x)
1938 (and (file-regular-p x) x))
1939 (dired-get-marked-files)))))
1941 (error "Sunrise: no regular files to open"))
1942 (unless noselect (sr-quit))
1943 (dired-simultaneous-find-file files noselect)))
1945 ;;; ============================================================================
1946 ;;; Graphical interface interaction functions:
1948 (defun sr-change-window()
1949 "Change to the other Sunrise pane."
1951 (if (and (window-live-p sr-left-window) (window-live-p sr-right-window))
1952 (let ((here sr-this-directory))
1953 (setq sr-this-directory sr-other-directory)
1954 (setq sr-other-directory here)
1955 (sr-select-window (sr-other)))))
1957 (defun sr-mouse-change-window (e)
1958 "Change to the Sunrise pane clicked in by the mouse."
1961 (if (eq (selected-window) (sr-other 'window))
1962 (sr-change-window)))
1964 (defun sr-beginning-of-buffer()
1965 "Go to the first directory/file in Dired."
1967 (goto-char (point-min))
1968 (when (re-search-forward directory-listing-before-filename-regexp nil t)
1970 (when (looking-at "\.\.?/?$")
1971 (dired-next-line 1)))))
1973 (defun sr-end-of-buffer()
1974 "Go to the last directory/file in Dired."
1976 (goto-char (point-max))
1977 (re-search-backward directory-listing-before-filename-regexp)
1978 (dired-next-line 0))
1980 (defun sr-focus-filename (filename)
1981 "Try to select FILENAME in the current buffer."
1982 (if (and dired-omit-mode
1983 (string-match (dired-omit-regexp) filename))
1984 (dired-omit-mode -1))
1985 (let ((sr-inhibit-highlight t)
1986 (expr (sr-chop ?/ filename)))
1987 (cond ((file-symlink-p filename)
1988 (setq expr (concat (regexp-quote expr) " ->")))
1989 ((file-directory-p filename)
1990 (setq expr (concat (regexp-quote expr) "\\(?:/\\|$\\)")))
1991 ((file-regular-p filename)
1992 (setq expr (concat (regexp-quote expr) "$"))))
1993 (setq expr (concat "[0-9] +" expr))
1995 (unless (re-search-forward expr nil t)
1996 (re-search-backward expr nil t)))
1998 (re-search-forward directory-listing-before-filename-regexp nil t))
2000 (defun sr-split-toggle()
2001 "Change Sunrise window layout from horizontal to vertical to top and so on."
2003 (case sr-window-split-style
2004 (horizontal (sr-split-setup 'vertical))
2005 (vertical (sr-split-setup 'top))
2007 (sr-split-setup 'horizontal)
2008 (sr-in-other (revert-buffer))))
2009 (t (sr-split-setup 'horizontal))))
2011 (defun sr-split-setup(split-type)
2012 (setq sr-window-split-style split-type)
2014 (when (eq sr-window-split-style 'top)
2015 (sr-select-window 'left)
2016 (delete-window sr-right-window)
2017 (setq sr-panes-height (window-height)))
2019 (message "Sunrise: split style changed to \"%s\"" (symbol-name split-type)))
2021 (defun sr-transpose-panes ()
2022 "Change the order of the panes."
2024 (unless (eq sr-left-buffer sr-right-buffer)
2026 (let ((left (sr-symbol 'left x)) (right (sr-symbol 'right x)) (tmp))
2027 (setq tmp (symbol-value left))
2028 (set left (symbol-value right))
2030 '(directory buffer window))
2031 (let ((tmp sr-this-directory))
2032 (setq sr-this-directory sr-other-directory
2033 sr-other-directory tmp))
2034 (select-window sr-right-window)
2035 (sr-setup-visible-panes)
2036 (sr-select-window sr-selected-window)))
2038 (defun sr-synchronize-panes (&optional reverse)
2039 "Change the directory in the other pane to that in the current one.
2040 If the optional parameter REVERSE is non-nil, performs the
2041 opposite operation, ie. changes the directory in the current pane
2042 to that in the other one."
2044 (let ((target (current-buffer)) (sr-inhibit-highlight t))
2047 (setq target (current-buffer))
2048 (sr-alternate-buffer (switch-to-buffer target))
2049 (sr-history-push default-directory))
2052 (sr-alternate-buffer (switch-to-buffer target))
2053 (sr-history-push default-directory)
2057 (defun sr-browse-pane ()
2058 "Browse the directory in the active pane."
2060 (if (not (featurep 'browse-url))
2061 (error "Sunrise: feature `browse-url' not available!")
2062 (let ((url (concat "file://" (expand-file-name default-directory))))
2063 (message "Browsing directory %s " default-directory)
2065 (eval '(w3m-goto-url url))
2066 (browse-url url)))))
2068 (defun sr-browse-file (&optional file)
2069 "Display the selected file in the default web browser."
2071 (unless (featurep 'browse-url)
2072 (error "ERROR: Feature browse-url not available!"))
2073 (setq file (or file (dired-get-filename)))
2074 (save-selected-window
2075 (sr-select-viewer-window)
2076 (let ((buff (current-buffer)))
2077 (browse-url (concat "file://" file))
2078 (unless (eq buff (current-buffer))
2079 (sr-scrollable-viewer (current-buffer)))))
2080 (message "Browsing \"%s\" in web browser" file))
2082 (defun sr-revert-buffer (&optional _ignore-auto _no-confirm)
2083 "Revert the current pane using the contents of the backup buffer (if any).
2084 If the buffer is non-virtual the backup buffer is killed."
2086 (if (buffer-live-p sr-backup-buffer)
2087 (let ((marks (dired-remember-marks (point-min) (point-max)))
2088 (focus (dired-get-filename 'verbatim t))
2089 (inhibit-read-only t))
2091 (insert-buffer-substring sr-backup-buffer)
2092 (sr-beginning-of-buffer)
2093 (dired-mark-remembered marks)
2094 (if focus (sr-focus-filename focus))
2095 (dired-change-marks ?\t ?*)
2096 (if (eq 'sr-mode major-mode) (sr-kill-backup-buffer)))
2097 (unless (or (eq major-mode 'sr-virtual-mode)
2098 (local-variable-p 'sr-virtual-buffer))
2100 (if (string= "NUMBER" (get sr-selected-window 'sorting-order))
2101 (sr-sort-by-number t)
2102 (if (get sr-selected-window 'sorting-reverse)
2103 (sr-reverse-pane)))))
2104 (sr-display-attributes (point-min) (point-max) sr-show-file-attributes)
2107 (defun sr-kill-pane-buffer ()
2108 "Kill the buffer currently displayed in the active pane, or quit Sunrise.
2109 Custom variable `sr-kill-unused-buffers' controls whether unused buffers are
2110 killed automatically by Sunrise when the user navigates away from the directory
2111 they contain. When this flag is set, all requests to kill the current buffer are
2112 managed by just calling `sr-quit'."
2114 (if sr-kill-unused-buffers
2116 (kill-buffer (current-buffer))
2117 (let ((_x (pop (cdr (assoc sr-selected-window sr-history-registry)))))
2118 (sr-history-stack-reset))))
2120 (defun sr-quick-view (&optional arg)
2121 "Quickly view the currently selected item.
2122 On regular files, opens the file in quick-view mode (see `sr-quick-view-file'
2123 for more details), on directories, visits the selected directory in the passive
2124 pane, and on symlinks follows the file the link points to in the passive pane.
2125 With optional argument kills the last quickly viewed file without opening a new
2129 (sr-quick-view-kill)
2130 (let ((name (dired-get-filename nil t)))
2131 (cond ((file-directory-p name) (sr-quick-view-directory name))
2132 ((file-symlink-p name) (sr-quick-view-symlink name))
2133 (t (sr-quick-view-file))))))
2135 (defun sr-quick-view-kill ()
2136 "Kill the last buffer opened using quick view (if any)."
2137 (let ((buf other-window-scroll-buffer))
2138 (when (and (buffer-live-p buf)
2139 (or (not sr-confirm-kill-viewer)
2140 (y-or-n-p (format "Kill buffer %s? " (buffer-name buf)))))
2141 (setq other-window-scroll-buffer nil)
2142 (save-window-excursion (kill-buffer buf)))))
2144 (defun sr-quick-view-directory (name)
2145 "Open the directory NAME in the passive pane."
2146 (let ((name (expand-file-name name)))
2147 (sr-in-other (sr-advertised-find-file name))))
2149 (defun sr-quick-view-symlink (name)
2150 "Follow the target of the symlink NAME in the passive pane."
2151 (let ((name (expand-file-name (file-symlink-p name))))
2152 (if (file-exists-p name)
2153 (sr-in-other (sr-follow-file name))
2154 (error "Sunrise: file is a symlink to a nonexistent target"))))
2156 (defun sr-quick-view-file ()
2157 "Open the selected file on the viewer window without selecting it.
2158 Kills any other buffer opened previously the same way."
2159 (let ((split-width-threshold (* 10 (window-width)))
2160 (filename (expand-file-name (dired-get-filename nil t))))
2161 (save-selected-window
2162 (condition-case description
2164 (sr-select-viewer-window)
2165 (find-file filename)
2166 (if (and (not (eq (current-buffer) other-window-scroll-buffer))
2167 (buffer-live-p other-window-scroll-buffer))
2168 (kill-buffer other-window-scroll-buffer))
2169 (sr-scrollable-viewer (current-buffer)))
2170 (error (message "%s" (cadr description)))))))
2172 ;; These clean up after a quick view:
2173 (add-hook 'sr-quit-hook (defun sr-sr-quit-function ()
2174 (setq other-window-scroll-buffer nil)))
2175 (add-hook 'kill-buffer-hook
2176 (defun sr-kill-viewer-function ()
2177 (if (eq (current-buffer) other-window-scroll-buffer)
2178 (setq other-window-scroll-buffer nil))))
2180 (defun sr-mask-attributes (beg end)
2181 "Manage the hiding of attributes in region from BEG to END.
2182 Selective hiding of specific attributes can be controlled by customizing the
2183 `sr-attributes-display-mask' variable."
2184 (let ((cursor beg) props)
2185 (labels ((sr-make-display-props
2186 (display-function-or-flag)
2187 (cond ((functionp display-function-or-flag)
2189 ,(apply display-function-or-flag
2190 (list (buffer-substring cursor (1- (point)))))))
2191 ((null display-function-or-flag) '(invisible t))
2193 (if sr-attributes-display-mask
2195 (mapc (lambda (do-display)
2196 (search-forward-regexp "\\w")
2197 (search-forward-regexp "\\s-")
2198 (setq props (sr-make-display-props do-display))
2200 (add-text-properties cursor (point) props))
2201 (setq cursor (point))
2202 (if (>= (point) end) (return-from block)))
2203 sr-attributes-display-mask))
2204 (unless (>= cursor end)
2205 (add-text-properties cursor end '(invisible t)))))))
2207 (defun sr-display-attributes (beg end visiblep)
2208 "Manage the display of file attributes in the region from BEG to END.
2209 if VISIBLEP is nil then shows file attributes in region, otherwise hides them."
2210 (let ((inhibit-read-only t) (next))
2214 (while (and (null next) (< (point) end))
2216 (setq next (dired-move-to-filename)))
2217 (while (and next (< next end))
2221 (sr-mask-attributes (point) next)
2222 (remove-text-properties (point) next '(invisible t))
2223 (remove-text-properties (point) next '(display)))
2225 (setq next (dired-move-to-filename))))))
2227 (defun sr-toggle-attributes ()
2228 "Hide/Show the attributes of all files in the active pane."
2230 (setq sr-show-file-attributes (not sr-show-file-attributes))
2231 (sr-display-attributes (point-min) (point-max) sr-show-file-attributes))
2233 (defun sr-toggle-truncate-lines ()
2234 "Enable/Disable truncation of long lines in the active pane."
2238 (setq truncate-partial-width-windows (sr-truncate-v nil))
2239 (message "Sunrise: wrapping long lines"))
2241 (setq truncate-partial-width-windows (sr-truncate-v t))
2242 (message "Sunrise: truncating long lines")))
2243 (sr-silently (dired-do-redisplay)))
2245 (defun sr-truncate-p ()
2246 "Return non-nil if `truncate-partial-width-windows' affects the current pane.
2247 Used by `sr-toggle-truncate-lines'."
2248 (if (numberp truncate-partial-width-windows)
2249 (< 0 truncate-partial-width-windows)
2250 truncate-partial-width-windows))
2252 (defun sr-truncate-v (active)
2253 "Return the appropriate value for `truncate-partial-width-widows'.
2254 Depends on the Emacs version being used. Used by
2255 `sr-toggle-truncate-lines'."
2256 (or (and (version<= "23" emacs-version)
2257 (or (and active 3000) 0))
2260 (defun sr-sort-order (label option)
2261 "Change the sorting order of the active pane.
2262 Appends additional options to `dired-listing-switches' and
2263 reverts the buffer."
2264 (if (eq major-mode 'sr-virtual-mode)
2265 (sr-sort-virtual option)
2267 (put sr-selected-window 'sorting-order label)
2268 (put sr-selected-window 'sorting-options option)
2269 (let ((dired-listing-switches dired-listing-switches))
2270 (unless (string-match "^/ftp:" default-directory)
2271 (setq dired-listing-switches sr-listing-switches))
2272 (dired-sort-other (concat dired-listing-switches option) t))
2274 (message "Sunrise: sorting entries by %s" label))
2276 (defmacro sr-defun-sort-by (postfix options)
2277 "Helper macro for defining `sr-sort-by-xxx' functions."
2278 `(defun ,(intern (format "sr-sort-by-%s" postfix)) ()
2279 ,(format "Sorts the contents of the current Sunrise pane by %s." postfix)
2281 (sr-sort-order ,(upcase postfix) ,options)))
2282 (sr-defun-sort-by "name" "")
2283 (sr-defun-sort-by "extension" "X")
2284 (sr-defun-sort-by "time" "t")
2285 (sr-defun-sort-by "size" "S")
2287 (defun sr-sort-by-number (&optional inhibit-label)
2288 "Sort the contents of the current Sunrise pane numerically.
2289 Displays entries containing unpadded numbers in a more logical
2290 order than when sorted alphabetically by name."
2292 (sr-sort-by-operation 'sr-numerical-sort-op (unless inhibit-label "NUMBER"))
2293 (if (get sr-selected-window 'sorting-reverse) (sr-reverse-pane)))
2295 (defun sr-interactive-sort (order)
2296 "Prompt for a new sorting order for the active pane and apply it."
2297 (interactive "cSort by (n)ame, n(u)mber, (s)ize, (t)ime or e(x)tension? ")
2299 (setq order (- order 32)))
2301 (?U (sr-sort-by-number))
2302 (?T (sr-sort-by-time))
2303 (?S (sr-sort-by-size))
2304 (?X (sr-sort-by-extension))
2305 (t (sr-sort-by-name))))
2307 (defun sr-reverse-pane (&optional interactively)
2308 "Reverse the contents of the active pane."
2310 (let ((line (line-number-at-pos))
2311 (reverse (get sr-selected-window 'sorting-reverse)))
2312 (sr-sort-by-operation 'identity)
2314 (put sr-selected-window 'sorting-reverse (not reverse))
2315 (goto-char (point-min)) (forward-line (1- line))
2316 (re-search-forward directory-listing-before-filename-regexp nil t))))
2318 (defun sr-sort-virtual (option)
2319 "Manage sorting of buffers in Sunrise VIRTUAL mode."
2320 (let ((opt (string-to-char option)) (inhibit-read-only t) (beg) (end))
2322 (?X (sr-end-of-buffer)
2323 (setq end (point-at-eol))
2324 (sr-beginning-of-buffer)
2325 (setq beg (point-at-bol))
2326 (sort-regexp-fields nil "^.*$" "[/.][^/.]+$" beg end))
2327 (?t (sr-sort-by-operation
2328 (lambda (x) (sr-attribute-sort-op 5 t x)) "TIME"))
2329 (?S (sr-sort-by-operation
2330 (lambda (x) (sr-attribute-sort-op 7 t x)) "SIZE"))
2331 (t (sr-sort-by-operation
2332 (lambda (x) (sr-attribute-sort-op -1 nil x)) "NAME")))))
2334 (defun sr-sort-by-operation (operation &optional label)
2335 "General function for reordering the contents of a Sunrise pane.
2336 OPERATION is a function that receives a list produced by
2337 `sr-build-sort-lists', reorders it in some way, transforming it
2338 into a list that can be passed to `sort-reorder', so the records
2339 in the current buffer are reordered accordingly. The LABEL is a
2340 string that will be used to set the sorting order of the current
2341 pane and then displayed in the minibuffer; if it's not provided
2342 or its value is nil then the ordering enforced by this function
2343 is transient and can be undone by reverting the pane, or by
2344 moving it to a different directory. See `sr-numerical-sort-op'
2345 and `sr-attribute-sort-op' for examples of OPERATIONs."
2347 (let ((messages (> (- (point-max) (point-min)) 50000))
2348 (focus (dired-get-filename 'verbatim t))
2349 (inhibit-read-only t))
2350 (if messages (message "Finding sort keys..."))
2351 (let* ((sort-lists (sr-build-sort-lists))
2352 (old (reverse sort-lists))
2354 (if messages (message "Sorting records..."))
2355 (setq sort-lists (apply operation (list sort-lists)))
2356 (if messages (message "Reordering buffer..."))
2360 (setq end (point-at-eol))
2361 (sr-beginning-of-buffer)
2362 (setq beg (point-at-bol))
2363 (narrow-to-region beg end)
2364 (sort-reorder-buffer sort-lists old)))
2365 (if messages (message "Reordering buffer... Done")))
2367 (if focus (sr-focus-filename focus))
2369 (put sr-selected-window 'sorting-order label)
2370 (message "Sunrise: sorting entries by %s" label)))
2373 (defun sr-numerical-sort-op (sort-lists)
2374 "Strategy used to numerically sort contents of a Sunrise pane.
2375 Used by `sr-sort-by-operation'. See `sr-sort-by-number' for more
2376 on this kind of sorting."
2383 (let ((key (buffer-substring-no-properties (car x) (cddr x))))
2386 (string-to-number (replace-regexp-in-string "^[^0-9]*" "" key))
2390 (lambda (a b) (string< (car a) (car b))))
2391 (lambda (a b) (< (cadr a) (cadr b))))))
2393 (defun sr-attribute-sort-op (nth-attr as-number sort-lists)
2394 "Strategy used to sort contents of a Sunrise pane according to file attributes.
2395 Used by `sr-sort-by-operation'. See `file-attributes' for a list
2396 of supported attributes and their positions. Directories are
2397 forced to remain always on top. NTH-ATTR is the position of the
2398 attribute to use for sorting, or -1 for the name of the file.
2399 AS-NUMBER determines whether comparisons will be numeric or
2400 alphabetical. SORT-LISTS is a list of positions obtained from
2401 `sr-build-sort-lists'."
2402 (let ((attributes (sr-files-attributes))
2403 (zero (if as-number 0 "")))
2410 (let* ((key (buffer-substring-no-properties (car x) (cddr x)))
2411 (key (sr-chop ?/ (replace-regexp-in-string " -> .*$" "" key)))
2412 (attrs (assoc-default key attributes))
2415 (setq attrs (apply 'cons attrs)
2416 index (or (nth (1+ nth-attr) attrs) zero))
2417 (append (list (cadr attrs) index (cdr x)) (cdr x)))))
2419 (lambda (a b) (sr-compare nth-attr (cadr b) (cadr a))))
2421 (if (and (car a) (car b))
2422 (sr-compare nth-attr (cadr b) (cadr a))
2423 (and (car a) (not (stringp (car a))))))))))
2425 (defun sr-build-sort-lists ()
2426 "Analyse contents of the current Sunrise pane for `sr-sort-by-operation'.
2427 Builds a list of dotted lists of the form (a b . c) -- where 'a'
2428 is the position at the start of the file name in an entry, while
2429 'b' and 'c' are the start and end positions of the whole entry.
2430 These lists are used by `sr-sort-by-operation' to sort the
2431 contents of the pane in arbitrary ways."
2434 (lambda (x) (and (atom (car x)) x))
2436 (sr-beginning-of-buffer)
2438 (sort-build-lists 'forward-line 'end-of-line 'dired-move-to-filename
2441 (defun sr-compare (mode a b)
2442 "General comparison function, used to sort files in VIRTUAL buffers.
2443 MODE must be a number; if it is less than 0, the direction of the
2444 comparison is inverted: (sr-compare -1 a b) === (sr-compare 1
2445 b a). Compares numbers using `<', strings case-insensitively
2446 using `string<' and lists recursively until the first two
2447 elements that are non-equal are found."
2448 (if (< mode 0) (let (tmp) (setq tmp a a b b tmp mode (abs mode))))
2449 (cond ((or (null a) (null b)) nil)
2450 ((and (listp a) (listp b)) (if (= (car a) (car b))
2451 (sr-compare mode (cdr a) (cdr b))
2452 (sr-compare mode (car a) (car b))))
2453 ((and (stringp a) (stringp b)) (string< (downcase a) (downcase b)))
2454 ((and (numberp a) (numberp b)) (< a b))
2457 (defun sr-scroll-up ()
2458 "Scroll the current pane or (if active) the viewer pane 1 line up."
2460 (if (buffer-live-p other-window-scroll-buffer)
2461 (save-selected-window
2462 (sr-select-viewer-window)
2466 (defun sr-scroll-down ()
2467 "Scroll the current pane or (if active) the viewer pane 1 line down."
2469 (if (buffer-live-p other-window-scroll-buffer)
2470 (save-selected-window
2471 (sr-select-viewer-window)
2475 (defun sr-scroll-quick-view ()
2476 "Scroll down the viewer window during a quick view."
2478 (if other-window-scroll-buffer (scroll-other-window)))
2480 (defun sr-scroll-quick-view-down ()
2481 "Scroll down the viewer window during a quick view."
2483 (if other-window-scroll-buffer (scroll-other-window-down nil)))
2486 "Restore selection as it was before the last file operation."
2491 ;;; ============================================================================
2492 ;;; Passive & synchronized navigation functions:
2495 "Toggle the Sunrise synchronized navigation feature."
2497 (setq sr-synchronized (not sr-synchronized))
2498 (mapc 'sr-mark-sync (list sr-left-buffer sr-right-buffer))
2499 (message "Sunrise: sync navigation is now %s" (if sr-synchronized "ON" "OFF"))
2500 (run-hooks 'sr-refresh-hook)
2501 (sr-in-other (run-hooks 'sr-refresh-hook)))
2503 (defun sr-mark-sync (&optional buffer)
2504 "Change `mode-name' depending on whether synchronized navigation is enabled."
2505 (save-window-excursion
2507 (switch-to-buffer buffer))
2508 (setq mode-name (concat "Sunrise "
2509 (if sr-synchronized "SYNC-NAV" "Commander")))))
2511 ;; This advertises synchronized navigation in all new buffers:
2512 (add-hook 'sr-mode-hook 'sr-mark-sync)
2514 (defun sr-next-line-other ()
2515 "Move the cursor down in the passive pane."
2517 (sr-in-other (dired-next-line 1)))
2519 (defun sr-prev-line-other ()
2520 "Move the cursor up in the passive pane."
2522 (sr-in-other (dired-next-line -1)))
2524 (defun sr-goto-dir-other (dir)
2525 "Change the current directory in the passive pane to the given one."
2526 (interactive (list (read-directory-name
2527 "Change directory in PASSIVE pane (file or pattern): "
2528 sr-other-directory)))
2529 (sr-in-other (sr-goto-dir dir)))
2531 (defun sr-advertised-find-file-other ()
2532 "Open the file/directory selected in the passive pane."
2535 (let ((target (sr-directory-name-proper (dired-get-filename))))
2537 (if (file-directory-p target)
2538 (sr-goto-dir (expand-file-name target))
2539 (if (y-or-n-p "Unable to synchronize. Disable sync navigation? ")
2542 (sr-advertised-find-file))
2543 (sr-in-other (sr-advertised-find-file))))
2545 (defun sr-mouse-advertised-find-file (e)
2546 "Open the file/directory pointed to by the mouse."
2548 (sr-mouse-change-window e)
2549 (sr-advertised-find-file))
2551 (defun sr-prev-subdir-other (&optional count)
2552 "Go to the previous subdirectory in the passive pane."
2554 (let ((count (or count 1)))
2555 (sr-in-other (sr-dired-prev-subdir count))))
2557 (defun sr-follow-file-other ()
2558 "Go to the directory of the selected file, but in the passive pane."
2560 (let ((filename (dired-get-filename nil t)))
2561 (sr-in-other (sr-follow-file filename))))
2563 (defun sr-history-prev-other ()
2564 "Change to previous directory (if any) in the passive pane's history list."
2566 (sr-in-other (sr-history-prev)))
2568 (defun sr-history-next-other ()
2569 "Change to the next directory (if any) in the passive pane's history list."
2571 (sr-in-other (sr-history-next)))
2573 (defun sr-mark-other (arg)
2574 "Mark the current (or next ARG) files in the passive pane."
2576 (setq arg (or arg 1))
2577 (sr-in-other (dired-mark arg)))
2579 (defun sr-unmark-backward-other (arg)
2581 (sr-in-other (dired-unmark-backward arg)))
2583 (defun sr-unmark-all-marks-other ()
2584 "Remove all marks from the passive pane."
2586 (sr-in-other (dired-unmark-all-marks)))
2588 ;;; ============================================================================
2589 ;;; Progress feedback functions:
2591 (defun sr-progress-prompt (op-name)
2592 "Build the default progress feedback message."
2593 (concat "Sunrise: " op-name "... "))
2595 (defun sr-make-progress-reporter (op-name totalsize)
2596 "Make a new Sunrise progress reporter.
2597 Prepends two integers (accumulator and scale) to a standard
2598 progress reporter (built using `make-progress-reporter' from
2599 subr.el): accumulator keeps the current state of the reporter,
2600 and scale is used when the absolute value of 100% is bigger than
2601 `most-positive-fixnum'."
2602 (let ((accumulator 0) (scale 1) (maxval totalsize))
2603 (when (> totalsize most-positive-fixnum)
2604 (setq scale (/ totalsize most-positive-fixnum))
2605 (setq maxval most-positive-fixnum))
2606 (list accumulator scale
2607 (make-progress-reporter
2608 (sr-progress-prompt op-name) 0 maxval 0 1 0.5))))
2610 (defun sr-progress-reporter-update (reporter size)
2611 "Update REPORTER (a Sunrise progress reporter) by adding SIZE to its state."
2612 (let ((scale (cadr reporter)))
2613 (setcar reporter (+ (truncate (/ size scale)) (car reporter)))
2614 (progress-reporter-update (caddr reporter) (car reporter))))
2616 (defun sr-progress-reporter-done (reporter)
2617 "Print REPORTER's feedback message followed by \"done\" in echo area."
2618 (progress-reporter-done (caddr reporter)))
2620 ;;; ============================================================================
2621 ;;; File manipulation functions:
2623 (defun sr-create-files (&optional qty)
2624 "Interactively create empty file(s) with the given name or template.
2625 Optional prefix argument specifies the number of files to create.
2626 *NEVER* overwrites existing files. A template may contain one
2627 %-sequence like those used by `format', but the only supported
2628 specifiers are: d (decimal), x (hex) or o (octal)."
2630 (let* ((qty (or (and (integerp qty) (< 0 qty) qty) 1))
2631 (prompt (if (>= 1 qty) "Create file: "
2632 (format "Create %d files using template: " qty)))
2633 (filename (read-file-name prompt)) (name))
2636 (unless (file-exists-p filename) (write-file filename))
2637 (unless (string-match "%[0-9]*[dox]" filename)
2638 (setq filename (concat filename ".%d")))
2639 (setq filename (replace-regexp-in-string "%\\([^%]\\)" "%%\\1" filename)
2640 filename (replace-regexp-in-string
2641 "%%\\([0-9]*[dox]\\)" "%\\1" filename))
2643 (setq name (format filename (1+ n)))
2644 (unless (file-exists-p name) (write-file name)))))
2645 (sr-revert-buffer)))
2647 (defun sr-editable-pane ()
2648 "Put the current pane in File Names Editing mode (`wdired-mode')."
2650 (sr-graphical-highlight 'sr-editing-path-face)
2651 (let* ((was-virtual (eq major-mode 'sr-virtual-mode))
2652 (major-mode 'dired-mode))
2653 (wdired-change-to-wdired-mode)
2655 (set (make-local-variable 'sr-virtual-buffer) t)))
2656 (run-hooks 'sr-refresh-hook))
2658 (defun sr-readonly-pane (as-virtual)
2659 "Put the current pane back in Sunrise mode."
2662 (sr-force-passive-highlight t))
2663 (dired-build-subdir-alist)
2666 (defun sr-terminate-wdired (fun)
2667 "Restore the current pane's original mode after editing with WDired."
2671 (intern (concat "sr-advice-" (symbol-name fun))) nil t
2674 (if (not sr-running)
2676 (let ((was-virtual (local-variable-p 'sr-virtual-buffer))
2677 (saved-point (point)))
2679 (setq major-mode 'wdired-mode)
2680 (letf (((symbol-function 'yes-or-no-p) (lambda (prompt) (ignore)))
2681 ((symbol-function 'revert-buffer)
2682 (lambda (&optional ignore-auto noconfirm preserve-modes)
2685 (sr-readonly-pane was-virtual)
2686 (goto-char saved-point))
2687 (sr-unhighlight 'sr-editing-path-face)))))
2689 (ad-activate fun nil))
2690 (sr-terminate-wdired 'wdired-finish-edit)
2691 (sr-terminate-wdired 'wdired-abort-changes)
2693 (defun sr-do-copy ()
2694 "Copy selected files and directories recursively to the passive pane."
2696 (let* ((items (dired-get-marked-files nil))
2697 (vtarget (sr-virtual-target))
2698 (target (or vtarget sr-other-directory))
2700 (if (and (not vtarget) (sr-equal-dirs default-directory sr-other-directory))
2702 (when (sr-ask "Copy" target items #'y-or-n-p)
2706 (message "Done: %d items(s) copied" (length items)))
2708 (setq progress (sr-make-progress-reporter
2709 "copying" (sr-files-size items)))
2710 (sr-clone items target #'copy-file progress ?C)
2711 (sr-progress-reporter-done progress)))
2712 (sr-silently (dired-unmark-all-marks))))))
2714 (defun sr-do-symlink ()
2715 "Symlink selected files or directories from one pane to the other."
2717 (if (sr-equal-dirs default-directory sr-other-directory)
2719 (sr-link #'make-symbolic-link "Symlink" dired-keep-marker-symlink)))
2721 (defun sr-do-relsymlink ()
2722 "Symlink selected files or directories from one pane to the other relatively.
2723 See `dired-make-relative-symlink'."
2725 (if (sr-equal-dirs default-directory sr-other-directory)
2726 (dired-do-relsymlink)
2727 (sr-link #'dired-make-relative-symlink
2729 dired-keep-marker-relsymlink)))
2731 (defun sr-do-hardlink ()
2732 "Same as `dired-do-hardlink', but refuse to hardlink files to VIRTUAL buffers."
2734 (if (sr-virtual-target)
2735 (error "Cannot hardlink files to a VIRTUAL buffer, try (C)opying instead")
2736 (dired-do-hardlink)))
2738 (defun sr-do-rename ()
2739 "Move selected files and directories recursively from one pane to the other."
2741 (when (sr-virtual-target)
2742 (error "Cannot move files to a VIRTUAL buffer, try (C)opying instead"))
2743 (if (sr-equal-dirs default-directory sr-other-directory)
2745 (let ((marked (dired-get-marked-files)))
2746 (when (sr-ask "Move" sr-other-directory marked #'y-or-n-p)
2747 (let ((names (mapcar #'file-name-nondirectory marked))
2748 (progress (sr-make-progress-reporter "renaming" (length marked)))
2749 (inhibit-read-only t))
2752 (sr-move-files marked default-directory progress)
2754 (when (eq major-mode 'sr-mode)
2755 (dired-mark-remembered
2756 (mapcar (lambda (x) (cons (expand-file-name x) ?R)) names))
2757 (sr-focus-filename (car names)))))
2758 (sr-progress-reporter-done progress))
2759 (sr-silently (revert-buffer))))))
2761 (defun sr-do-delete ()
2762 "Remove selected files from the file system."
2764 (let* ((files (dired-get-marked-files))
2765 (mode (sr-ask "Delete" nil files #'sr-y-n-or-a-p))
2766 (deletion-mode (cond ((eq mode 'ALWAYS) 'always)
2768 (t (error "(No deletions performed)")))))
2770 (message "Deleting %s" x)
2771 (dired-delete-file x deletion-mode)) files)
2772 (if (eq major-mode 'sr-virtual-mode)
2773 (dired-do-kill-lines)
2776 (defun sr-do-flagged-delete ()
2777 "Remove flagged files from the file system."
2779 (let* ((dired-marker-char dired-del-marker)
2780 (regexp (dired-marker-regexp)) )
2781 (if (save-excursion (goto-char (point-min))
2782 (re-search-forward regexp nil t))
2784 (message "(No deletions requested)"))))
2786 (defun sr-do-clone (&optional mode)
2787 "Clone all selected items recursively into the passive pane."
2788 (interactive "cClone as: (D)irectories only, (C)opies, (H)ardlinks,\
2789 (S)ymlinks or (R)elative symlinks? ")
2791 (if (sr-virtual-target)
2792 (error "Cannot clone into a VIRTUAL buffer, try (C)opying instead"))
2793 (if (sr-equal-dirs default-directory sr-other-directory)
2794 (error "Cannot clone inside one single directory, please select a\
2795 different one in the passive pane"))
2797 (let ((target sr-other-directory) clone-op items progress)
2798 (if (and mode (>= mode 97)) (setq mode (- mode 32)))
2803 (?H #'add-name-to-file)
2804 (?S #'make-symbolic-link)
2805 (?R #'dired-make-relative-symlink)
2806 (t (error "Invalid cloning mode: %c" mode))))
2807 (setq items (dired-get-marked-files nil))
2808 (setq progress (sr-make-progress-reporter
2809 "cloning" (sr-files-size items)))
2810 (sr-clone items target clone-op progress ?K)
2811 (dired-unmark-all-marks)
2812 (message "Done: %d items(s) dispatched" (length items))))
2814 (defun sr-fast-backup-files ()
2815 "Make backup copies of all marked files inside the same directory.
2816 The extension to append to each filename can be controlled by
2817 setting the value of the `sr-fast-backup-extension' custom
2818 variable. Directories are not copied."
2820 (let ((extension (if (listp sr-fast-backup-extension)
2821 (eval sr-fast-backup-extension)
2822 sr-fast-backup-extension)))
2823 (dired-do-copy-regexp "$" extension))
2826 (defun sr-clone (items target clone-op progress mark-char)
2827 "Clone all given items (files and dirs) recursively into the passive pane."
2828 (let ((names (mapcar #'file-name-nondirectory items))
2829 (inhibit-read-only t))
2830 (with-current-buffer (sr-other 'buffer)
2831 (sr-clone-files items target clone-op progress))
2832 (when (window-live-p (sr-other 'window))
2836 (when (memq major-mode '(sr-mode sr-virtual-mode))
2837 (dired-mark-remembered
2838 (mapcar (lambda (x) (cons (expand-file-name x) mark-char)) names))
2839 (sr-focus-filename (car names))))))))
2841 (defun sr-clone-files (file-paths target-dir clone-op progress &optional do-overwrite)
2842 "Clone all files in FILE-PATHS to TARGET-DIR using CLONE-OP to clone the files.
2843 FILE-PATHS should be a list of full paths."
2844 (setq target-dir (replace-regexp-in-string "/?$" "/" target-dir))
2848 (sr-progress-reporter-update progress (nth 7 (file-attributes f)))
2849 (let* ((name (file-name-nondirectory f))
2850 (target-file (concat target-dir name))
2851 (symlink-to (file-symlink-p (sr-chop ?/ f)))
2852 (clone-args (list f target-file t)))
2856 (if (file-exists-p symlink-to)
2857 (setq symlink-to (expand-file-name symlink-to)))
2858 (make-symbolic-link symlink-to target-file do-overwrite)))
2860 ((file-directory-p f)
2861 (let ((initial-path (file-name-directory f)))
2862 (unless (file-symlink-p initial-path)
2864 initial-path name target-dir clone-op progress do-overwrite))))
2867 ;; (message "[[Cloning: %s => %s]]" f target-file)
2868 (if (eq clone-op 'copy-file)
2870 (append clone-args (list dired-copy-preserve-time))))
2871 (if (file-exists-p target-file)
2872 (if (or (eq do-overwrite 'ALWAYS)
2873 (setq do-overwrite (sr-ask-overwrite target-file)))
2874 (apply clone-op clone-args))
2875 (apply clone-op clone-args)))))))
2878 (defun sr-clone-directory (in-dir d to-dir clone-op progress do-overwrite)
2879 "Clone directory IN-DIR/D and all its files recursively to TO-DIR.
2880 IN-DIR/D => TO-DIR/D using CLONE-OP to clone the files."
2881 (setq d (replace-regexp-in-string "/?$" "/" d))
2883 (setq to-dir (concat to-dir (sr-directory-name-proper in-dir))))
2884 (let* ((files-in-d (sr-list-of-contents (concat in-dir d)))
2886 (mapcar (lambda (f) (concat in-dir d f)) files-in-d)))
2887 (unless (file-exists-p (concat to-dir d))
2888 (make-directory (concat to-dir d)))
2889 (sr-clone-files file-paths-in-d (concat to-dir d) clone-op progress do-overwrite)))
2891 (defsubst sr-move-op (file target target-dir progress do-overwrite)
2892 "Helper function used by `sr-move-files' to rename files and directories."
2894 (dired-rename-file file target do-overwrite)
2896 (sr-clone-directory file "" target-dir 'copy-file progress do-overwrite)
2897 (dired-delete-file file 'always))))
2899 (defun sr-move-files (file-path-list target-dir progress &optional do-overwrite)
2900 "Move all files in FILE-PATH-LIST (list of full paths) to TARGET-DIR."
2904 (if (file-directory-p f)
2906 (setq f (replace-regexp-in-string "/?$" "/" f))
2907 (sr-progress-reporter-update progress 1)
2908 (let* ((target (concat target-dir (sr-directory-name-proper f))))
2909 (if (file-exists-p target)
2910 (when (or (eq do-overwrite 'ALWAYS)
2911 (setq do-overwrite (sr-ask-overwrite target)))
2912 (sr-move-op f target target-dir progress do-overwrite))
2913 (sr-move-op f target target-dir progress do-overwrite))))
2914 (let* ((name (file-name-nondirectory f))
2915 (target-file (concat target-dir name)))
2916 ;; (message "Renaming: %s => %s" f target-file)
2917 (sr-progress-reporter-update progress 1)
2918 (if (file-exists-p target-file)
2919 (if (or (eq do-overwrite 'ALWAYS)
2920 (setq do-overwrite (sr-ask-overwrite target-file)))
2921 (dired-rename-file f target-file t))
2922 (dired-rename-file f target-file t)) ))))
2925 (defun sr-link (creator action marker)
2926 "Helper function for implementing `sr-do-symlink' and `sr-do-relsymlink'."
2927 (if (sr-virtual-target)
2928 (error "Cannot link files to a VIRTUAL buffer, try (C)opying instead.")
2929 (dired-create-files creator action (dired-get-marked-files nil)
2931 (setq from (sr-chop ?/ from))
2932 (if (file-directory-p from)
2933 (setq from (sr-directory-name-proper from))
2934 (setq from (file-name-nondirectory from)))
2935 (expand-file-name from sr-other-directory))
2938 (defun sr-virtual-target ()
2939 "If the passive pane is in VIRTUAL mode, return its name as a string.
2940 Otherwise returns nil."
2941 (save-window-excursion
2942 (switch-to-buffer (sr-other 'buffer))
2943 (if (eq major-mode 'sr-virtual-mode)
2944 (or (buffer-file-name) "Sunrise VIRTUAL buffer")
2947 (defun sr-copy-virtual ()
2948 "Manage copying of files or directories to buffers in VIRTUAL mode."
2949 (let ((fileset (dired-get-marked-files nil))
2950 (inhibit-read-only t) (beg))
2952 (goto-char (point-max))
2954 (mapc (lambda (file)
2956 (setq file (dired-make-relative file default-directory)
2957 file (sr-chop ?/ file))
2958 (insert-directory file sr-virtual-listing-switches))
2960 (sr-display-attributes beg (point-at-eol) sr-show-file-attributes)
2962 (delete-region (point) (line-end-position))
2965 (dired-unmark-all-marks)))))
2967 (defun sr-ask (prompt target files function)
2968 "Use FUNCTION to ask whether to do PROMPT on FILES with TARGET as destination."
2969 (if (and files (listp files))
2970 (let* ((len (length files))
2972 (format "* [%d items]" len)
2973 (file-name-nondirectory (car files)))))
2975 (setq msg (format "%s to %s" msg target)))
2976 (funcall function (format "%s %s? " prompt msg)))))
2978 (defun sr-ask-overwrite (file-name)
2979 "Ask whether to overwrite the given FILE-NAME."
2980 (sr-y-n-or-a-p (format "File %s exists. OK to overwrite? " file-name)))
2982 (defun sr-y-n-or-a-p (prompt)
2983 "Ask the user with PROMPT for an answer y/n/a ('a' stands for 'always').
2984 Returns t if the answer is y/Y, nil if the answer is n/N or the
2985 symbol `ALWAYS' if the answer is a/A."
2986 (setq prompt (concat prompt "([y]es, [n]o or [a]lways)"))
2988 (while (not (memq resp '(?y ?Y ?n ?N ?a ?A)))
2989 (setq resp (read-event prompt))
2990 (setq prompt "Please answer [y]es, [n]o or [a]lways "))
2992 (setq resp (- resp 32)))
2998 (defun sr-overlapping-paths-p (dir1 dir2)
2999 "Return non-nil if directory DIR2 is located inside directory DIR1."
3000 (when (and dir1 dir2)
3001 (setq dir1 (expand-file-name (file-name-as-directory dir1))
3002 dir2 (expand-file-name dir2))
3003 (if (>= (length dir2) (length dir1))
3004 (equal (substring dir2 0 (length dir1)) dir1)
3007 (defun sr-list-of-contents (dir)
3008 "Return the list of all files in DIR as a list of strings."
3009 (sr-filter (function (lambda (x) (not (string-match "\\.\\.?/?$" x))))
3010 (directory-files dir)))
3012 (defun sr-list-of-directories (dir)
3013 "Return the list of directories in DIR as a list of strings.
3014 The list does not include the current directory and the parent directory."
3015 (let ((result (sr-filter (function (lambda (x)
3016 (file-directory-p (concat dir "/" x))))
3017 (sr-list-of-contents dir))))
3018 (mapcar (lambda (x) (concat x "/")) result)))
3020 (defun sr-list-of-files (dir)
3021 "Return the list of regular files in DIR as a list of strings.
3022 Broken links are *not* considered regular files."
3024 (function (lambda (x) (file-regular-p (concat dir "/" x))))
3025 (sr-list-of-contents dir)))
3027 (defun sr-filter (p x)
3028 "Return the elements of the list X that satisfy the predicate P."
3029 (let ((res-list nil))
3031 (if (apply p (list (car x)))
3032 (setq res-list (cons (car x) res-list)))
3034 (reverse res-list)))
3036 (defun sr-directory-name-proper (file-path)
3037 "Return the proper name of the directory FILE-PATH, without initial path."
3040 (file-path-1 (substring file-path 0 (- (length file-path) 1)))
3041 (lastchar (substring file-path (- (length file-path) 1)))
3043 (concat (file-name-nondirectory file-path-1) lastchar))))
3045 ;;; ============================================================================
3046 ;;; Directory and file comparison functions:
3048 (defun sr-compare-panes ()
3049 "Compare the contents of Sunrise panes."
3051 (let* ((file-alist1 (sr-files-attributes))
3052 (other (sr-other 'buffer))
3053 (file-alist2 (with-current-buffer other (sr-files-attributes)))
3055 (sr-make-progress-reporter
3056 "comparing" (+ (length file-alist1) (length file-alist2))))
3057 (predicate `(prog1 ,(sr-ask-compare-panes-predicate)
3058 (sr-progress-reporter-update ',progress 1)))
3059 (file-list1 (mapcar 'cadr (dired-file-set-difference
3060 file-alist1 file-alist2 predicate)))
3061 (file-list2 (mapcar 'cadr (dired-file-set-difference
3062 file-alist2 file-alist1 predicate))))
3064 (dired-mark-if (member (dired-get-filename nil t) file-list1) nil)
3065 (with-current-buffer other
3066 (dired-mark-if (member (dired-get-filename nil t) file-list2) nil))
3067 (message "Marked in pane1: %s files, in pane2: %s files"
3069 (length file-list2))
3072 (defun sr-ask-compare-panes-predicate ()
3073 "Prompt for the criterion to use for comparing the contents of the panes."
3074 (let ((prompt "Compare by (d)ate, (s)ize, date_(a)nd_size, (n)ame \
3077 (while (not (memq response '(?d ?D ?s ?S ?a ?A ?n ?N ?c ?C)))
3078 (setq response (read-event prompt))
3079 (setq prompt "Please select: Compare by (d)ate, (s)ize, date_(a)nd_size,\
3080 (n)ame or (c)ontents? "))
3081 (if (>= response 97)
3082 (setq response (- response 32)))
3084 (?D `(not (= mtime1 mtime2)))
3085 (?S `(not (= size1 size2)))
3087 (?C `(not (string= (sr-md5 file1 t) (sr-md5 file2 t))))
3088 (t `(or (not (= mtime1 mtime2)) (not (= size1 size2)))))))
3090 (defun sr-files-attributes ()
3091 "Return a list of all file names and attributes in the current pane.
3092 The list has the same form as the one returned by
3093 `dired-files-attributes', but contains all the files currently
3094 displayed in VIRTUAL panes."
3099 (unless (member file-name '("." ".."))
3100 (let ((full-file-name (expand-file-name file-name default-directory)))
3101 (list file-name full-file-name (file-attributes full-file-name)))))
3104 (defun sr-pane-files ()
3105 "Return the list of files in the current pane.
3106 For VIRTUAL panes, returns the list of all files being currently
3110 (if (eq major-mode 'sr-virtual-mode)
3111 (sr-buffer-files (current-buffer))
3112 (directory-files default-directory))))
3114 (defvar sr-md5 '(nil) "Memoization cache for the sr-md5 function.")
3115 (defun sr-md5 (file-alist &optional memoize)
3116 "Build and execute a shell command to calculate the MD5 checksum of a file.
3117 Second element of FILE-ALIST is the absolute path of the file. If
3118 MEMOIZE is non-nil, save the result into the `sr-md5' alist so it
3119 can be reused the next time this function is called with the same
3120 path. This cache can be cleared later calling `sr-md5' with nil
3121 as its first argument."
3122 (if (null file-alist)
3123 (setq sr-md5 '(nil))
3124 (let* ((filename (cadr file-alist))
3125 (md5-digest (cdr (assoc filename sr-md5)))
3129 (replace-regexp-in-string
3130 "%f" (format "\"%s\"" filename) sr-md5-shell-command))
3131 (setq md5-digest (shell-command-to-string md5-command))
3133 (push (cons filename md5-digest) sr-md5)))
3137 "Run `diff' on the top two marked files in both panes."
3139 (eval (sr-diff-form 'diff))
3140 (sr-scrollable-viewer (get-buffer "*Diff*")))
3143 "Run `ediff' on the two top marked files in both panes."
3145 (eval (sr-diff-form 'ediff)))
3147 (add-hook 'ediff-before-setup-windows-hook
3148 (defun sr-ediff-before-setup-windows-function ()
3149 (setq sr-ediff-on t)))
3151 (add-hook 'ediff-quit-hook
3152 (defun sr-ediff-quit-function ()
3153 (setq sr-ediff-on nil)
3155 (if (buffer-live-p sr-restore-buffer)
3156 (switch-to-buffer sr-restore-buffer))
3157 (delete-other-windows)
3158 (sr-setup-windows))))
3160 (defun sr-diff-form (fun)
3161 "Return the appropriate form to evaluate for comparing files using FUN."
3162 (let ((this (sr-pop-mark)) (other nil))
3164 (setq this (car (dired-get-marked-files t))))
3165 (if (sr-equal-dirs default-directory sr-other-directory)
3166 (setq other (sr-pop-mark))
3169 (setq other (sr-pop-mark))
3171 (setq other (or other
3172 (if (file-exists-p (concat sr-other-directory this))
3174 (file-name-nondirectory this))))))
3175 (setq this (concat default-directory this)
3176 other (concat sr-other-directory other))
3177 (list fun this other)))
3179 (defun sr-pop-mark ()
3180 "Pop the first mark in the current Dired buffer."
3182 (condition-case description
3184 (goto-char (point-min))
3185 (dired-next-marked-file 1)
3186 (setq result (dired-get-filename t t))
3188 (error (message (cadr description))))
3191 ;;; ============================================================================
3192 ;;; File search & analysis functions:
3194 (defun sr-process-kill ()
3195 "Kill the process running in the current buffer (if any)."
3197 (let ((proc (get-buffer-process (current-buffer))))
3198 (and proc (eq (process-status proc) 'run)
3200 (delete-process proc)
3203 (defvar sr-process-map (let ((map (make-sparse-keymap)))
3204 (set-keymap-parent map sr-virtual-mode-map)
3205 (define-key map "\C-c\C-k" 'sr-process-kill)
3207 "Local map used in Sunrise panes during find and locate operations.")
3209 (defun sr-find-decorate-buffer (find-items)
3210 "Provide details on `sr-find' execution in the current buffer.
3211 If the current find operation is done only in selected files and directories,
3212 modify the info line of the buffer to reflect this. Additionally, display an
3213 appropriate message in the minibuffer."
3216 (let ((items-len (length find-items))
3217 (max-items-len (window-width))
3218 (inhibit-read-only t))
3219 (goto-char (point-min))
3221 (when (re-search-forward "find \." nil t)
3222 (if (> items-len max-items-len)
3224 (concat (substring find-items 0 max-items-len) " ...")))
3225 (replace-match (format "find %s" find-items)))))
3226 (sr-beginning-of-buffer)
3229 (message (propertize "Sunrise find (C-c C-k to kill)"
3230 'face 'minibuffer-prompt)))
3232 (defun sr-find-apply (fun pattern)
3233 "Helper function for functions `sr-find', `sr-find-name' and `sr-find-grep'."
3234 (let* ((suffix (if (eq 'w32 window-system) " {} ;" " \\{\\} \\;"))
3237 (concat "-exec ls -d " sr-virtual-listing-switches suffix)
3239 (sr-find-items (sr-quote-marked)) (dir))
3241 (if (not (y-or-n-p "Find in marked items only? "))
3242 (setq sr-find-items nil)
3243 (setq dir (directory-file-name (expand-file-name default-directory)))
3244 (add-to-list 'file-name-handler-alist (cons dir 'sr-multifind-handler))))
3246 (sr-alternate-buffer (apply fun (list default-directory pattern)))
3248 (use-local-map sr-process-map)
3250 (run-with-idle-timer 0.01 nil 'sr-find-decorate-buffer sr-find-items)))
3252 (defun sr-find (pattern)
3253 "Run `find-dired' passing the current directory as first parameter."
3254 (interactive "sRun find (with args): ")
3255 (sr-find-apply 'find-dired pattern))
3257 (defun sr-find-name (pattern)
3258 "Run `find-name-dired' passing the current directory as first parameter."
3259 (interactive "sFind name pattern: ")
3260 (sr-find-apply 'find-name-dired pattern))
3262 (defun sr-find-grep (pattern)
3263 "Run `find-grep-dired' passing the current directory as first
3264 parameter. Called with prefix asks for additional grep options."
3265 (interactive "sFind files containing pattern: ")
3266 (let ((find-grep-options
3267 (if current-prefix-arg
3268 (concat find-grep-options
3270 (read-string "Additional Grep Options: "))
3271 find-grep-options)))
3272 (sr-find-apply 'find-grep-dired pattern)))
3274 (defadvice find-dired-sentinel
3275 (after sr-advice-find-dired-sentinel (proc state))
3276 "If the current find operation was launched inside the Sunrise
3277 Commander, create a new backup buffer on operation completion or
3279 (with-current-buffer (process-buffer proc)
3280 (when (eq 'sr-virtual-mode major-mode)
3281 (sr-backup-buffer))))
3282 (ad-activate 'find-dired-sentinel)
3284 (defadvice find-dired-filter
3285 (around sr-advice-find-dired-filter (proc string))
3286 "Disable the \"non-foolproof\" padding mechanism in `find-dired-filter' that
3287 breaks Dired when using ls options that omit some columns (like g or G). Defined
3288 by the Sunrise Commander."
3289 (if (and (eq 'sr-virtual-mode major-mode)
3290 (or (string-match "g" sr-virtual-listing-switches)
3291 (string-match "G" sr-virtual-listing-switches)))
3292 (let ((find-ls-option nil)) ad-do-it)
3294 (ad-activate 'find-dired-filter)
3296 (defun sr-multifind-handler (operation &rest args)
3297 "Magic file name handler for manipulating the command executed by `find-dired'
3298 when the user requests to perform the find operation on all currently marked
3299 items (as opposed to the current default directory). Removes itself from the
3300 `inhibit-file-name-handlers' every time it's executed."
3301 (let ((inhibit-file-name-handlers
3302 (cons 'sr-multifind-handler
3303 (and (eq inhibit-file-name-operation operation)
3304 inhibit-file-name-handlers)))
3305 (inhibit-file-name-operation operation))
3306 (when (eq operation 'shell-command)
3307 (setq file-name-handler-alist
3308 (rassq-delete-all 'sr-multifind-handler file-name-handler-alist))
3310 (setcar args (replace-regexp-in-string
3311 "find \." (format "find %s" sr-find-items) (car args)))))
3312 (apply operation args)))
3314 (defun sr-flatten-branch (&optional mode)
3315 "Display a flat view of the items contained in the current directory and all
3316 its subdirectories, sub-subdirectories and so on (recursively) in the active
3318 (interactive "cFlatten branch showing: (E)verything, (D)irectories,\
3319 (N)on-directories or (F)iles only?")
3320 (if (and mode (>= mode 97)) (setq mode (- mode 32)))
3322 (?E (sr-find-name "*"))
3323 (?D (sr-find "-type d"))
3324 (?N (sr-find "-not -type d"))
3325 (?F (sr-find "-type f"))))
3327 (defun sr-prune-paths (regexp)
3328 "Kill all lines (only the lines) in the current pane matching REGEXP."
3329 (interactive "sPrune paths matching: ")
3331 (sr-beginning-of-buffer)
3332 (while (if (string-match regexp (dired-get-filename t))
3334 (dired-next-line 1)))))
3336 (defun sr-locate-filter (locate-buffer search-string)
3337 "Return a filter function for the background `locate' process."
3338 `(lambda (process output)
3339 (let ((inhibit-read-only t)
3340 (search-regexp ,(regexp-quote search-string))
3342 (set-buffer ,locate-buffer)
3345 (when (and (string-match search-regexp x) (file-exists-p x))
3346 (goto-char (point-max))
3348 (insert-directory x sr-virtual-listing-switches nil nil)))
3349 (split-string output "[\r\n]" t))
3350 (sr-display-attributes beg (point-at-eol) sr-show-file-attributes)))))
3352 (defun sr-locate-sentinel (locate-buffer)
3353 "Return a sentinel function for the background locate process.
3354 Used to notify about the termination status of the process."
3355 `(lambda (process status)
3356 (let ((inhibit-read-only t))
3357 (set-buffer ,locate-buffer)
3358 (goto-char (point-max))
3359 (insert "\n " locate-command " " status)
3361 (insert " at " (substring (current-time-string) 0 19))
3363 (sr-beginning-of-buffer)
3367 (defun sr-locate-prompt ()
3368 "Display the message that appears when a locate process is launched."
3369 (message (propertize "Sunrise locate (C-c C-k to kill)"
3370 'face 'minibuffer-prompt)))
3372 (defvar locate-command)
3373 (autoload 'locate-prompt-for-search-string "locate")
3374 (defun sr-locate (search-string &optional _filter _arg)
3375 "Run locate asynchronously and display the results in Sunrise virtual mode."
3377 (list (locate-prompt-for-search-string) nil current-prefix-arg))
3378 (let ((locate-buffer (create-file-buffer "*Sunrise Locate*"))
3379 (process-connection-type nil)
3380 (locate-process nil))
3382 (sr-alternate-buffer (switch-to-buffer locate-buffer))
3384 (insert " " default-directory ":")(newline)
3385 (insert " Results of: " locate-command " " search-string)(newline)
3388 (setq locate-process
3389 (start-process "Async Locate" nil locate-command search-string))
3390 (sr-locate-filter locate-buffer search-string))
3391 (set-process-sentinel locate-process (sr-locate-sentinel locate-buffer))
3392 (set-process-buffer locate-process locate-buffer)
3393 (use-local-map sr-process-map)
3394 (run-with-idle-timer 0.01 nil 'sr-locate-prompt))))
3396 (defun sr-fuzzy-narrow ()
3397 "Interactively narrow contents of the current pane using fuzzy matching:
3398 * press Delete or Backspace to revert the buffer to its previous state
3399 * press Return, C-n or C-p to exit and accept the current narrowed state
3400 * press Esc or C-g to abort the operation and revert the buffer
3401 * use ! to prefix characters that should NOT appear beyond a given position.
3402 Once narrowed and accepted, you can restore the original contents of the pane
3403 by pressing g (`revert-buffer')."
3406 (sr-beginning-of-buffer)
3407 (dired-change-marks ?* ?\t)
3408 (let ((stack nil) (filter "") (regex "") (next-char nil) (inhibit-quit t))
3409 (labels ((read-next (f) (read-char (concat "Fuzzy narrow: " f))))
3410 (setq next-char (read-next filter))
3414 ((?\e ?\C-g) (setq next-char nil) (sr-revert-buffer))
3415 (?\C-n (setq next-char nil) (sr-beginning-of-buffer))
3416 (?\C-p (setq next-char nil) (sr-end-of-buffer))
3417 ((?\n ?\r) (setq next-char nil))
3420 (setq stack (cdr stack) filter (caar stack) regex (cdar stack))
3421 (unless stack (setq next-char nil)))
3423 (setq filter (concat filter (char-to-string next-char)))
3424 (if (not (eq next-char sr-fuzzy-negation-character))
3425 (setq next-char (char-to-string next-char)
3426 regex (if (string= "" regex) ".*" regex)
3427 regex (concat regex (regexp-quote next-char) ".*"))
3428 (setq next-char (char-to-string (read-next filter))
3429 filter (concat filter next-char)
3430 regex (replace-regexp-in-string "\\.\\*\\'" "" regex)
3431 regex (concat regex "[^"(regexp-quote next-char)"]*")
3432 regex (replace-regexp-in-string "\\]\\*\\[\\^" "" regex)))
3433 (setq stack (cons (cons filter regex) stack))))
3435 (dired-mark-files-regexp (concat "^" regex "$"))
3436 (dired-toggle-marks)
3437 (dired-do-kill-lines)
3438 (setq next-char (read-next filter)))))
3439 (dired-change-marks ?\t ?*))))
3441 (defun sr-recent-files ()
3442 "Display the history of recent files in Sunrise virtual mode."
3444 (if (not (featurep 'recentf))
3445 (error "ERROR: Feature recentf not available!"))
3448 (let ((dired-actual-switches dired-listing-switches))
3449 (sr-switch-to-clean-buffer "*Recent Files*")
3450 (insert "Recently Visited Files: \n")
3451 (dolist (file recentf-list)
3453 (insert-directory file sr-virtual-listing-switches nil nil)
3458 (defun sr-recent-directories ()
3459 "Display the history of directories recently visited in the current pane."
3462 (let ((hist (cdr (assoc sr-selected-window sr-history-registry)))
3463 (dired-actual-switches dired-listing-switches)
3464 (pane-name (capitalize (symbol-name sr-selected-window)))
3465 (switches (concat sr-virtual-listing-switches " -d")))
3466 (sr-switch-to-clean-buffer (format "*%s Pane History*" pane-name))
3467 (insert (concat "Recent Directories in " pane-name " Pane: \n"))
3471 (setq dir (sr-chop ?/ (expand-file-name dir)))
3472 (insert-directory dir switches nil nil))
3474 (sr-virtual-mode))))
3476 (defun sr-switch-to-clean-buffer (name)
3477 (sr-alternate-buffer (switch-to-buffer name))
3480 (defun sr-pure-virtual (&optional passive)
3481 "Create a new empty buffer in Sunrise VIRTUAL mode.
3482 If the optional argument PASSIVE is non-nil, creates the virtual
3483 buffer in the passive pane."
3487 (sr-synchronize-panes)
3488 (sr-in-other (sr-pure-virtual nil)))
3490 (let* ((dir (directory-file-name (dired-current-directory)))
3491 (buff (generate-new-buffer-name (buffer-name (current-buffer)))))
3492 (sr-alternate-buffer (switch-to-buffer buff))
3493 (goto-char (point-min))
3494 (insert " " dir ":")(newline)
3495 (insert " Pure VIRTUAL buffer: ")(newline)
3497 (sr-keep-buffer)))))
3499 (defun sr-dired-do-apply (dired-fun)
3500 "Helper function for implementing `sr-do-query-replace-regexp' and Co."
3501 (let ((buff (current-buffer)) (orig sr-restore-buffer))
3505 (switch-to-buffer buff)
3506 (call-interactively dired-fun)
3507 (replace-buffer-in-windows buff)
3510 (when orig (switch-to-buffer orig))
3513 (defun sr-do-query-replace-regexp ()
3514 "Force Sunrise to quit before executing `dired-do-query-replace-regexp'."
3516 (sr-dired-do-apply 'dired-do-query-replace-regexp))
3518 (defun sr-do-search ()
3519 "Force Sunrise to quit before executing `dired-do-search'."
3521 (sr-dired-do-apply 'dired-do-search))
3523 (defun sr-sticky-isearch-prompt ()
3524 "Display the message that appears when a sticky search is launched."
3525 (message (propertize "Sunrise sticky I-search (C-g to exit): "
3526 'face 'minibuffer-prompt)))
3528 (defvar sr-sticky-isearch-commands
3530 ("\C-o" . dired-omit-mode)
3531 ("\M-a" . sr-beginning-of-buffer)
3532 ("\M-e" . sr-end-of-buffer)
3533 ("\C-v" . scroll-up-command)
3534 ("\M-v" . (lambda () (interactive) (scroll-up-command '-)))
3535 ) "Keybindings installed in `isearch-mode' during a sticky search.")
3537 (defun sr-sticky-isearch-remap-commands (&optional restore)
3538 "Remap `isearch-mode-map' commands using `sr-sticky-isearch-commands'.
3539 Replace the bindings in our table with the previous ones from `isearch-mode-map'
3540 so we can restore them when the current sticky search operation finishes."
3541 (when (eq restore (car sr-sticky-isearch-commands))
3542 (setcar sr-sticky-isearch-commands (not restore))
3543 (mapc (lambda (entry)
3544 (let* ((binding (car entry))
3545 (old-command (lookup-key isearch-mode-map binding))
3546 (new-command (cdr entry)))
3547 (define-key isearch-mode-map binding new-command)
3548 (setcdr entry old-command)))
3549 (cdr sr-sticky-isearch-commands))))
3551 (defun sr-sticky-isearch (&optional backward)
3552 "Concatenate Isearch operations to allow fast file system navigation.
3553 Search continues until C-g is pressed (to abort) or Return is
3554 pressed on a regular file (to end the operation and visit that
3556 (set (make-local-variable 'search-nonincremental-instead) nil)
3557 (add-hook 'isearch-mode-end-hook 'sr-sticky-post-isearch)
3558 (sr-sticky-isearch-remap-commands)
3560 (isearch-backward nil t)
3561 (isearch-forward nil t))
3562 (run-hooks 'sr-refresh-hook)
3563 (run-with-idle-timer 0.01 nil 'sr-sticky-isearch-prompt))
3565 (defun sr-sticky-isearch-forward ()
3566 "Start a sticky forward search in the current pane."
3568 (sr-sticky-isearch))
3570 (defun sr-sticky-isearch-backward ()
3571 "Start a sticky backward search in the current pane."
3573 (sr-sticky-isearch t))
3575 (defun sr-sticky-post-isearch ()
3576 "`isearch-mode-end-hook' function for Sunrise sticky Isearch operations."
3578 (dired-get-filename nil t)
3579 (let* ((filename (expand-file-name (dired-get-filename nil t)))
3580 (is-dir (or (file-directory-p filename)
3581 (sr-avfs-dir filename)
3582 (sr-virtual-directory-p filename))))
3583 (cond ((or isearch-mode-end-hook-quit (not is-dir))
3585 (remove-hook 'isearch-mode-end-hook 'sr-sticky-post-isearch)
3586 (kill-local-variable 'search-nonincremental-instead)
3587 (sr-sticky-isearch-remap-commands t)
3589 (if isearch-mode-end-hook-quit
3590 (run-hooks 'sr-refresh-hook)
3591 (sr-find-file filename))))
3594 (sr-find-file filename)
3595 (set (make-local-variable 'search-nonincremental-instead) nil)
3596 (isearch-forward nil t)
3597 (run-with-idle-timer 0.01 nil 'sr-sticky-isearch-prompt)))))))
3599 (defun sr-show-files-info (&optional deref-symlinks)
3600 "Enhanced version of `dired-show-file-type' from dired‐aux.
3601 If at most one item is marked, print the filetype of the current
3602 item according to the \"file\" command, including its size in bytes.
3603 If more than one item is marked, print the total size in
3604 bytes (calculated recursively) of all marked items."
3606 (message "Calculating total size of selection... (C-g to abort)")
3607 (let* ((selection (dired-get-marked-files t))
3608 (size (sr-size-format (sr-files-size selection)))
3609 (items (length selection)) (label) (regex))
3612 (setq selection (car selection)
3613 label (file-name-nondirectory selection)
3614 regex (concat "^.*" label "[:;]")
3615 label (concat label ":"))
3616 (dired-show-file-type selection deref-symlinks)
3619 (replace-regexp-in-string regex label (current-message)) size))
3620 (message "%s bytes in %d selected items" size items))
3624 (defsubst sr-size-attr (file)
3625 "Helper function for `sr-files-size'."
3626 (float (or (nth 7 (file-attributes file)) 0))))
3628 (defun sr-files-size (files)
3629 "Recursively calculate the total size of all FILES.
3630 FILES should be a list of paths."
3633 (lambda (x) (setq result (+ x result)))
3634 (mapcar (lambda (f) (cond ((string-match "\\.\\./?$" f) 0)
3635 ((string-match "\\./?$" f) (sr-size-attr f))
3636 ((file-symlink-p f) (sr-size-attr f))
3637 ((file-directory-p f) (sr-directory-size f))
3638 (t (float (sr-size-attr f)))))
3642 (defun sr-directory-size (directory)
3643 "Recursively calculate the total size of the given DIRECTORY."
3644 (sr-files-size (directory-files directory t nil t)))
3646 (defun sr-size-format (size)
3647 "Return integer representation of SIZE (a float) as a string.
3648 Uses comma as the thousands separator."
3649 (let* ((num (replace-regexp-in-string "\\..*$" "" (number-to-string size)))
3650 (digits (reverse (split-string num "" t)))
3652 (dotimes (n (length digits))
3653 (when (and (< 0 n) (zerop (% n 3)))
3654 (setq result (concat "," result)))
3655 (setq result (concat (pop digits) result)))
3658 ;;; ============================================================================
3659 ;;; TI (Terminal Integration) and CLEX (Command Line EXpansion) functions:
3662 (defun sr-term (&optional cd newterm program)
3663 "Run terminal in a new buffer or switch to an existing one.
3664 If the optional argument CD is non-nil, directory is changed to
3665 the current one in the active pane. A non-nil NEWTERM argument
3666 forces the creation of a new terminal. If PROGRAM is provided
3667 and exists in `exec-path', then it will be used instead of the
3668 default `sr-terminal-program'."
3670 (let ((aterm (car sr-ti-openterms)))
3671 (if (and (null program)
3672 (or (eq major-mode 'eshell-mode)
3673 (and (buffer-live-p aterm)
3674 (with-current-buffer aterm
3675 (eq major-mode 'eshell-mode)))))
3676 (setq program "eshell")
3677 (setq program (or program sr-terminal-program))))
3678 (if (memq major-mode '(sr-mode sr-virtual-mode sr-tree-mode))
3680 (if (string= program "eshell")
3681 (sr-term-eshell cd newterm)
3682 (sr-term-extern cd newterm program)))
3685 (defun sr-term-cd ()
3686 "Run terminal in a new buffer or switch to an existing one.
3687 cd's to the current directory of the active pane."
3692 (defun sr-term-cd-newterm ()
3693 "Open a NEW terminal (don't switch to an existing one).
3694 cd's to the current directory of the active pane."
3699 (defun sr-term-cd-program (&optional program)
3700 "Open a NEW terminal using PROGRAM as the shell."
3701 (interactive "sShell program to use: ")
3702 (sr-term t t program))
3704 (defmacro sr-term-excursion (newterm form &optional is-external)
3705 "Take care of the common mechanics of launching or switching to a terminal.
3707 `(let* ((start-buffer (current-buffer))
3708 (new-term (or (null sr-ti-openterms) ,newterm))
3709 (next-buffer (or (cadr (memq start-buffer sr-ti-openterms))
3710 (car sr-ti-openterms)))
3711 (new-name) (is-line-mode))
3712 (sr-select-viewer-window t)
3714 (switch-to-buffer next-buffer)
3716 (with-current-buffer next-buffer
3717 (setq is-line-mode (and (boundp 'sr-term-line-minor-mode)
3718 (symbol-value 'sr-term-line-minor-mode)))))
3720 (if ,is-external (sr-term-char-mode))
3721 (if is-line-mode (sr-term-line-mode))
3722 (when (memq (current-buffer) sr-ti-openterms)
3724 (setq new-name (buffer-name))
3727 (message "Sunrise: previous terminal renamed to %s" new-name))
3728 (push (current-buffer) sr-ti-openterms))))
3730 (defun sr-term-line-mode ()
3731 "Switch the current terminal to line mode.
3732 Apply additional Sunrise keybindings for terminal integration."
3735 (sr-term-line-minor-mode 1))
3737 (defun sr-term-char-mode ()
3738 "Switch the current terminal to character mode.
3739 Bind C-j and C-k to Sunrise terminal integration commands."
3742 (sr-term-line-minor-mode 0)
3743 (sr-term-char-minor-mode 1))
3745 (defun sr-term-extern (&optional cd newterm program)
3746 "Implementation of `sr-term' for external terminal programs.
3747 See `sr-term' for a description of the arguments."
3748 (let* ((program (if program (executable-find program)))
3749 (program (or program sr-terminal-program))
3750 (dir (expand-file-name (sr-choose-cd-target)))
3751 (aterm (car sr-ti-openterms))
3752 (cd (or cd (null sr-ti-openterms)))
3753 (line-mode (if (buffer-live-p aterm)
3754 (with-current-buffer aterm (term-in-line-mode)))))
3755 (sr-term-excursion newterm (term program) t)
3757 (when (or line-mode (term-in-line-mode))
3758 (sr-term-line-mode))
3760 (term-send-raw-string
3761 (concat "cd " (shell-quote-wildcard-pattern dir) "
3764 (defun sr-term-eshell (&optional cd newterm)
3765 "Implementation of `sr-term' when using `eshell'."
3766 (let ((dir (expand-file-name (sr-choose-cd-target)))
3767 (cd (or cd (null sr-ti-openterms))))
3768 (sr-term-excursion newterm (eshell))
3770 (insert (concat "cd " (shell-quote-wildcard-pattern dir)))
3771 (eshell-send-input))
3772 (sr-term-line-mode)))
3774 (defmacro sr-ti (form)
3775 "Evaluate FORM in the context of the selected pane.
3776 Helper macro for implementing terminal integration in Sunrise."
3779 (sr-select-window sr-selected-window)
3780 (hl-line-unhighlight)
3784 (sr-select-viewer-window))))))
3786 (defun sr-ti-previous-line ()
3787 "Move one line backward on active pane from the terminal window."
3789 (sr-ti (forward-line -1)))
3791 (defun sr-ti-next-line ()
3792 "Move one line forward on active pane from the terminal window."
3794 (sr-ti (forward-line 1)))
3796 (defun sr-ti-select ()
3797 "Run `dired-advertised-find-file' on active pane from the terminal window."
3799 (sr-ti (sr-advertised-find-file)))
3801 (defun sr-ti-mark ()
3802 "Run `dired-mark' on active pane from the terminal window."
3804 (sr-ti (dired-mark 1)))
3806 (defun sr-ti-unmark ()
3807 "Run `dired-unmark-backward' on active pane from the terminal window."
3809 (sr-ti (dired-unmark-backward 1)))
3811 (defun sr-ti-prev-subdir (&optional count)
3812 "Run `dired-prev-subdir' on active pane from the terminal window."
3814 (let ((count (or count 1)))
3815 (sr-ti (sr-dired-prev-subdir count))))
3817 (defun sr-ti-unmark-all-marks ()
3818 "Remove all marks on active pane from the terminal window."
3820 (sr-ti (dired-unmark-all-marks)))
3822 (defun sr-ti-change-window ()
3823 "Switch focus to the currently active pane."
3825 (sr-select-window sr-selected-window))
3827 (defun sr-ti-change-pane ()
3828 "Change selection of active pane to passive one."
3830 (sr-ti (sr-change-window)))
3834 (defun sr-ti-cleanup-openterms ()
3835 "Remove the current buffer from the list of open terminals."
3836 (setq sr-ti-openterms (delete (current-buffer) sr-ti-openterms))))
3838 (defun sr-ti-revert-buffer ()
3839 "Refresh the currently active pane."
3841 (let ((dir default-directory))
3842 (if (not (sr-equal-dirs dir sr-this-directory))
3843 (sr-ti (sr-goto-dir dir))
3844 (sr-ti (sr-revert-buffer)))))
3846 (defun sr-ti-lock-panes ()
3847 "Resize and lock the panes at standard position from the command line."
3849 (sr-ti (sr-lock-panes)))
3851 (defun sr-ti-min-lock-panes ()
3852 "Minimize the panes from the command line."
3854 (sr-ti (sr-min-lock-panes)))
3856 (defun sr-ti-max-lock-panes ()
3857 "Maximize the panes from the command line."
3859 (sr-ti (sr-max-lock-panes)))
3861 (defmacro sr-clex (pane form)
3862 "Evaluate FORM in the context of PANE.
3863 Helper macro for implementing command line expansion in Sunrise."
3864 `(save-window-excursion
3865 (setq pane (if (atom pane) pane (eval pane)))
3866 (select-window (symbol-value (sr-symbol ,pane 'window)))
3869 (defun sr-clex-marked (pane)
3870 "Return a string containing the list of marked files in PANE."
3873 (mapconcat 'shell-quote-wildcard-pattern (dired-get-marked-files) " ")))
3875 (defun sr-clex-file (pane)
3876 "Return the file currently selected in PANE."
3879 (concat (shell-quote-wildcard-pattern (dired-get-filename)) " ")))
3881 (defun sr-clex-marked-nodir (pane)
3882 "Return a list of basenames of all the files currently marked in PANE."
3885 (mapconcat 'shell-quote-wildcard-pattern
3886 (dired-get-marked-files 'no-dir) " ")))
3888 (defun sr-clex-dir (pane)
3889 "Return the current directory of the given pane."
3892 (concat (shell-quote-wildcard-pattern default-directory) " ")))
3894 (defun sr-clex-start ()
3895 "Start a new CLEX operation.
3896 Puts `sr-clex-commit' into local `after-change-functions'."
3900 (setq sr-clex-on nil)
3901 (delete-overlay sr-clex-hotchar-overlay))
3906 (add-hook 'after-change-functions 'sr-clex-commit nil t)
3908 (setq sr-clex-hotchar-overlay (make-overlay (point) (1- (point))))
3909 (overlay-put sr-clex-hotchar-overlay 'face 'sr-clex-hotchar-face)
3911 "Sunrise: CLEX is now ON for keys: m f n d a p M F N D A P %%"))))))
3913 (defun sr-clex-commit (&optional _beg _end _range)
3914 "Commit the current CLEX operation (if any).
3915 This function is added to the local `after-change-functions' list
3916 by `sr-clex-start'."
3920 (setq sr-clex-on nil)
3921 (delete-overlay sr-clex-hotchar-overlay)
3922 (let* ((xchar (char-before))
3923 (expansion (case xchar
3924 (?m (sr-clex-marked 'left))
3925 (?f (sr-clex-file 'left))
3926 (?n (sr-clex-marked-nodir 'left))
3927 (?d (sr-clex-dir 'left))
3928 (?M (sr-clex-marked 'right))
3929 (?F (sr-clex-file 'right))
3930 (?N (sr-clex-marked-nodir 'right))
3931 (?D (sr-clex-dir 'right))
3932 (?a (sr-clex-marked '(sr-this)))
3933 (?A (sr-clex-dir '(sr-this)))
3934 (?p (sr-clex-marked '(sr-other)))
3935 (?P (sr-clex-dir '(sr-other)))
3940 (insert expansion)))))))
3942 (define-minor-mode sr-term-char-minor-mode
3943 "Sunrise Commander terminal add-on for character (raw) mode."
3945 '(("\C-c\C-j" . sr-term-line-mode)
3946 ("\C-c\C-k" . sr-term-char-mode)
3947 ("\C-c\t" . sr-ti-change-window)
3949 ("\C-cT" . sr-term-cd)
3950 ("\C-c\C-t" . sr-term-cd-newterm)
3951 ("\C-c\M-t" . sr-term-cd-program)
3952 ("\C-c;" . sr-follow-viewer)
3953 ("\C-c\\" . sr-ti-lock-panes)
3954 ("\C-c{" . sr-ti-min-lock-panes)
3955 ("\C-c}" . sr-ti-max-lock-panes)))
3957 (define-minor-mode sr-term-line-minor-mode
3958 "Sunrise Commander terminal add-on for line (cooked) mode."
3960 '(([M-up] . sr-ti-previous-line)
3961 ([A-up] . sr-ti-previous-line)
3962 ("\M-P" . sr-ti-previous-line)
3963 ([M-down] . sr-ti-next-line)
3964 ([A-down] . sr-ti-next-line)
3965 ("\M-N" . sr-ti-next-line)
3966 ("\M-\C-m" . sr-ti-select)
3967 ("\C-\M-j" . sr-ti-select)
3968 ([M-return] . sr-ti-select)
3969 ([S-M-return] . sr-ti-select)
3970 ("\M-M" . sr-ti-mark)
3971 ([M-backspace] . sr-ti-unmark)
3972 ("\M-\d" . sr-ti-unmark)
3973 ("\M-J" . sr-ti-prev-subdir)
3974 ("\M-U" . sr-ti-unmark-all-marks)
3975 ([C-tab] . sr-ti-change-window)
3976 ([M-tab] . sr-ti-change-pane)
3977 ("\C-c\t" . sr-ti-change-window)
3979 ("\C-cT" . sr-term-cd)
3980 ("\C-c\C-t" . sr-term-cd-newterm)
3981 ("\C-c\M-t" . sr-term-cd-program)
3982 ("\C-c;" . sr-follow-viewer)
3983 ("\M-\S-g" . sr-ti-revert-buffer)
3984 ("%" . sr-clex-start)
3985 ("\t" . term-dynamic-complete)
3986 ("\C-c\\" . sr-ti-lock-panes)
3987 ("\C-c{" . sr-ti-min-lock-panes)
3988 ("\C-c}" . sr-ti-max-lock-panes))
3991 (defadvice term-sentinel (around sr-advice-term-sentinel (proc msg) activate)
3992 "Take care of killing Sunrise Commander terminal buffers on exit."
3993 (if (and (or sr-term-char-minor-mode sr-term-line-minor-mode)
3994 sr-terminal-kill-buffer-on-exit
3995 (memq (process-status proc) '(signal exit)))
3996 (let ((buffer (process-buffer proc)))
3998 (bury-buffer buffer)
3999 (kill-buffer buffer))
4002 ;;; ============================================================================
4003 ;;; Desktop support:
4005 (defun sr-pure-virtual-p (&optional buffer)
4006 "Return t if BUFFER (or the current buffer if nil) is purely virtual.
4007 Purely virtual means it is not attached to any directory or any
4008 file in the file system."
4009 (with-current-buffer (if (bufferp buffer) buffer (current-buffer))
4010 (not (or (eq 'sr-mode major-mode)
4011 (and (eq 'sr-virtual-mode major-mode)
4012 buffer-file-truename
4013 (file-exists-p buffer-file-truename))))))
4015 (defun sr-desktop-save-buffer (desktop-dir)
4016 "Return the additional data for saving a Sunrise buffer to a desktop file."
4017 (unless (sr-pure-virtual-p)
4022 (if (eq major-mode 'sr-virtual-mode)
4023 (list 'dirs buffer-file-truename)
4024 (cons 'dirs (dired-desktop-buffer-misc-data desktop-dir)))
4025 (if (eq (current-buffer) sr-left-buffer) (cons 'left t))
4026 (if (eq (current-buffer) sr-right-buffer) (cons 'right t))
4027 (if (eq major-mode 'sr-virtual-mode) (cons 'virtual t))))
4028 (mapcar (lambda (fun)
4029 (funcall fun desktop-dir))
4030 sr-desktop-save-handlers))))
4032 (defun sr-desktop-restore-buffer (desktop-buffer-file-name
4034 desktop-buffer-misc)
4035 "Restore a Sunrise (normal or VIRTUAL) buffer from its desktop file data."
4036 (let* ((sr-running t)
4037 (misc-data (cdr (assoc 'dirs desktop-buffer-misc)))
4038 (is-virtual (assoc 'virtual desktop-buffer-misc))
4040 (if (not is-virtual)
4041 (with-current-buffer
4042 (dired-restore-desktop-buffer desktop-buffer-file-name
4047 (desktop-restore-file-buffer (car misc-data)
4050 (with-current-buffer buffer
4051 (when is-virtual (set-visited-file-name nil t))
4052 (mapc (lambda (side)
4053 (when (cdr (assq side desktop-buffer-misc))
4054 (set (sr-symbol side 'buffer) buffer)
4055 (set (sr-symbol side 'directory) default-directory)))
4059 desktop-buffer-file-name
4061 desktop-buffer-misc))
4062 sr-desktop-restore-handlers))
4065 (defun sr-reset-state ()
4066 "Reset some environment variables that control the Sunrise behavior.
4067 Used for desktop support."
4068 (setq sr-left-directory "~/" sr-right-directory "~/"
4069 sr-this-directory "~/" sr-other-directory "~/")
4070 (if sr-running (sr-quit))
4073 ;; These register the previous functions in the desktop framework:
4074 (add-to-list 'desktop-buffer-mode-handlers
4075 '(sr-mode . sr-desktop-restore-buffer))
4076 (add-to-list 'desktop-buffer-mode-handlers
4077 '(sr-virtual-mode . sr-desktop-restore-buffer))
4079 ;; This initializes (and sometimes starts) Sunrise after desktop restoration:
4080 (add-hook 'desktop-after-read-hook
4081 (defun sr-desktop-after-read-function ()
4082 (unless (assoc 'sr-running desktop-globals-to-clear)
4083 (add-to-list 'desktop-globals-to-clear
4084 '(sr-running . (sr-reset-state))))
4085 (if (memq major-mode '(sr-mode sr-virtual-mode sr-tree-mode))
4088 ;;; ============================================================================
4089 ;;; Miscellaneous functions:
4091 (defun sr-buffer-files (buffer-or-name)
4092 "Return the list of all file names currently displayed in the given buffer."
4093 (with-current-buffer buffer-or-name
4096 (sr-beginning-of-buffer)
4098 (setq result (cons (dired-get-filename t t) result))
4100 (reverse result)))))
4102 (defun sr-keep-buffer (&optional side)
4103 "Keep the currently displayed buffer in SIDE (left or right) window.
4104 Keeps it there even if it does not belong to the panel's history
4105 ring. If SIDE is nil, use the value of `sr-selected-window'
4106 instead. Useful for maintaining the contents of the pane during
4108 (let* ((side (or side sr-selected-window))
4109 (window (symbol-value (sr-symbol side 'window))))
4110 (set (sr-symbol side 'buffer) (window-buffer window))))
4112 (defun sr-scrollable-viewer (buffer)
4113 "Set the `other-window-scroll-buffer' variable to BUFFER.
4114 Doing so allows to scroll the given buffer directly from the active pane."
4115 (setq other-window-scroll-buffer buffer)
4117 (message "QUICK VIEW: Press C-e/C-y to scroll, Space/M-Space to page, and C-u v (or C-u o) to dismiss")))
4119 (defun sr-describe-mode ()
4120 "Call `describe-mode' and make the resulting buffer C-M-v scrollable."
4123 (sr-scrollable-viewer (get-buffer "*Help*"))
4124 (sr-select-window sr-selected-window))
4126 (defun sr-equal-dirs (dir1 dir2)
4127 "Return non-nil if the two paths DIR1 and DIR2 represent the same directory."
4128 (string= (expand-file-name (concat (directory-file-name dir1) "/"))
4129 (expand-file-name (concat (directory-file-name dir2) "/"))))
4131 (defun sr-summary ()
4132 "Summarize basic Sunrise commands and show recent Dired errors."
4135 (message "C-opy, R-ename, K-lone, D-elete, v-iew, e-X-ecute, Ff-ollow, \
4136 Jj-ump, q-uit, m-ark, u-nmark, h-elp"))
4138 (defun sr-restore-point-if-same-buffer ()
4139 "Synchronize point position if the same buffer is displayed in both panes."
4140 (let ((this-win)(other-win)(point))
4141 (when (and (eq sr-left-buffer sr-right-buffer)
4142 (window-live-p (setq other-win (sr-other 'window))))
4143 (setq this-win (selected-window))
4144 (setq point (point))
4145 (select-window other-win)
4147 (select-window this-win))))
4149 (defun sr-mark-toggle ()
4150 "Toggle the mark on the current file or directory."
4152 (when (dired-get-filename t t)
4153 (if (eq ? (char-after (line-beginning-position)))
4157 (defun sr-assoc-key (name alist test)
4158 "Return the key in ALIST matched by NAME according to TEST."
4159 (let (head (tail alist) found)
4160 (while (and tail (not found))
4161 (setq head (caar tail)
4162 found (and (apply test (list head name)) head)
4166 (defun sr-quote-marked ()
4167 "Return current pane's selected entries quoted and space-separated as a string."
4168 (let ((marked (dired-get-marked-files t nil nil t)))
4169 (if (< (length marked) 2)
4171 (if (eq t (car marked)) (setq marked (cdr marked)))
4172 (format "\"%s\"" (mapconcat 'identity marked "\" \"")))))
4174 (defun sr-fix-listing-switches()
4175 "Work around a bug in Dired that makes `dired-move-to-filename' misbehave
4176 when any of the options -p or -F is used with ls."
4178 (let ((val (replace-regexp-in-string "\\(?:^\\| \\)-[pF]*\\(?: \\|$\\)" " " (symbol-value sym))))
4179 (while (string-match "\\(?:^\\| \\)-[^- ]*[pF]" val)
4180 (setq val (replace-regexp-in-string "\\(\\(?:^\\| \\)-[^- ]*\\)[pF]\\([^ ]*\\)" "\\1\\2" val)))
4182 '(sr-listing-switches sr-virtual-listing-switches))
4183 (remove-hook 'sr-init-hook 'sr-fix-listing-switches))
4184 (add-hook 'sr-init-hook 'sr-fix-listing-switches)
4186 (defun sr-chop (char path)
4187 "Remove all trailing instances of character CHAR from the string PATH."
4188 (while (and (< 1 (length path))
4189 (eq (string-to-char (substring path -1)) char))
4190 (setq path (substring path 0 -1)))
4193 ;;; ============================================================================
4196 (defun sr-ad-enable (regexp &optional function)
4197 "Put all or FUNCTION-specific advice matching REGEXP into effect.
4198 If provided, only update FUNCTION itself, otherwise all functions
4199 with advice matching REGEXP."
4201 (progn (ad-enable-advice function 'any regexp)
4202 (ad-activate function))
4203 (ad-enable-regexp regexp)
4204 (ad-activate-regexp regexp)))
4206 (defun sr-ad-disable (regexp &optional function)
4207 "Stop all FUNCTION-specific advice matching REGEXP from taking effect.
4208 If provided, only update FUNCTION itself, otherwise all functions
4209 with advice matching REGEXP."
4211 (progn (ad-disable-advice function 'any regexp)
4212 (ad-update function))
4213 (ad-disable-regexp regexp)
4214 (ad-update-regexp regexp)))
4216 (defun sunrise-commander-unload-function ()
4217 (sr-ad-disable "^sr-advice-"))
4219 ;;; ============================================================================
4220 ;;; Font-Lock colors & styles:
4222 (defmacro sr-rainbow (symbol spec regexp)
4224 (defface ,symbol '((t ,spec)) "Sunrise rainbow face" :group 'sunrise)
4225 ,@(mapcar (lambda (m)
4226 `(font-lock-add-keywords ',m '((,regexp 1 ',symbol))))
4227 '(sr-mode sr-virtual-mode))))
4229 (sr-rainbow sr-html-face (:foreground "DarkOliveGreen") "\\(^[^!].[^d].*\\.x?html?$\\)")
4230 (sr-rainbow sr-xml-face (:foreground "DarkGreen") "\\(^[^!].[^d].*\\.\\(xml\\|xsd\\|xslt?\\|wsdl\\)$\\)")
4231 (sr-rainbow sr-log-face (:foreground "brown") "\\(^[^!].[^d].*\\.log$\\)")
4232 (sr-rainbow sr-compressed-face (:foreground "magenta") "\\(^[^!].[^d].*\\.\\(zip\\|bz2\\|t?[gx]z\\|[zZ]\\|[jwers]?ar\\|xpi\\|apk\\|xz\\)$\\)")
4233 (sr-rainbow sr-packaged-face (:foreground "DarkMagenta") "\\(^[^!].[^d].*\\.\\(deb\\|rpm\\)$\\)")
4234 (sr-rainbow sr-encrypted-face (:foreground "DarkOrange1") "\\(^[^!].[^d].*\\.\\(gpg\\|pgp\\)$\\)")
4236 (sr-rainbow sr-directory-face (:inherit dired-directory :bold t) "\\(^[^!].d.*\\)")
4237 (sr-rainbow sr-symlink-face (:inherit dired-symlink :italic t) "\\(^[^!].l.*[^/]$\\)")
4238 (sr-rainbow sr-symlink-directory-face (:inherit dired-directory :italic t) "\\(^[^!].l.*/$\\)")
4239 (sr-rainbow sr-alt-marked-dir-face (:foreground "DeepPink" :bold t) "\\(^[^ *!D].d.*$\\)")
4240 (sr-rainbow sr-alt-marked-file-face (:foreground "DeepPink") "\\(^[^ *!D].[^d].*$\\)")
4241 (sr-rainbow sr-marked-dir-face (:inherit dired-marked) "\\(^[*!D].d.*$\\)")
4242 (sr-rainbow sr-marked-file-face (:inherit dired-marked :bold nil) "\\(^[*!D].[^d].*$\\)")
4243 (sr-rainbow sr-broken-link-face (:inherit dired-warning :italic t) "\\(^[!].l.*$\\)")
4245 (provide 'sunrise-commander)
4247 ;;; sunrise-commander.el ends here