]> git.rkrishnan.org Git - .emacs.d.git/blob - emacs/sunrise-commander.el
submodulized .emacs.d setup
[.emacs.d.git] / emacs / sunrise-commander.el
1 ;;; sunrise-commander.el --- two-pane file manager for Emacs based on Dired and inspired by MC  -*- lexical-binding: t -*-
2
3 ;; Copyright (C) 2007-2012 José Alfredo Romero Latouche.
4
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
9 ;; Version: 6
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+
14
15 ;; This file is not part of GNU Emacs.
16
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
20 ;; version.
21 ;;
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-
25 ;; tails.
26
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/>.
29
30 ;;; Commentary:
31
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:
35
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.
39
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.
43
44 ;; * Each pane has its own history stack: press M-y / M-u for moving backwards /
45 ;; forwards in the history of directories.
46
47 ;; * Press M-t to swap (transpose) the panes.
48
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.
54
55 ;; * Press = for fast "smart" file comparison -- like above, but using regular
56 ;; diff.
57
58 ;; * Press C-M-= for directory comparison (by date / size / contents of files).
59
60 ;; * Press C-c C-s to change the layout of the panes (horizontal/vertical/top)
61
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).
70
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
73
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).
77
78 ;; * Press y to recursively calculate the total size (in bytes) of all files and
79 ;; directories currently selected/marked in the active pane.
80
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
84 ;; fingertips.
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).
92
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.
97
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).
109
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
129
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.
140
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
143 ;; switch to it.
144
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
150 ;; though).
151
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).
154
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.
157
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/).
162
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.
168
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
171
172 ;;; Installation and Usage:
173
174 ;; 1) Put this file somewhere in your Emacs `load-path'.
175
176 ;; 2) Add a (require 'sunrise-commander) to your .emacs file.
177
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
181 ;; following:
182 ;;
183 ;;     (add-to-list 'auto-mode-alist '("\\.srvm\\'" . sr-virtual-mode))
184
185 ;; 4) Evaluate the new lines, or reload your .emacs file, or restart Emacs.
186
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.
191
192 ;; 6) Type M-x customize-group <RET> sunrise <RET> to customize options, fonts
193 ;; and colors (activate AVFS support here, too).
194
195 ;; 7) Enjoy :)
196
197 ;;; Code:
198
199 (require 'dired)
200 (require 'dired-x)
201 (require 'enriched)
202 (require 'find-dired)
203 (require 'font-lock)
204 (require 'hl-line)
205 (require 'sort)
206 (require 'term)
207 (eval-when-compile (require 'cl)
208                    (require 'desktop)
209                    (require 'dired-aux)
210                    (require 'esh-mode)
211                    (require 'recentf)
212                    (require 'tramp))
213
214 (defgroup sunrise nil
215   "The Sunrise Commander File Manager."
216   :group 'files)
217
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]."
222   :group 'sunrise
223   :type 'boolean)
224
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)."
228   :group 'sunrise
229   :type 'boolean)
230
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."
237   :group 'sunrise
238   :type 'boolean)
239
240 (defcustom sr-terminal-kill-buffer-on-exit t
241   "Whether to kill terminal buffers after their shell process ends."
242   :group 'sunrise
243   :type 'boolean)
244
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')
248 will be used."
249   :group 'sunrise
250   :type 'string)
251
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"
258   :group 'sunrise
259   :type 'string)
260
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'."
264   :group 'sunrise
265   :type 'string)
266
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."
270   :group 'sunrise
271   :type '(choice
272           (const :tag "AVFS support disabled" nil)
273           (directory :tag "AVFS root directory")))
274
275 (defcustom sr-avfs-handlers-alist '(("\\.[jwesh]ar$" . "#uzip/")
276                                     ("\\.wsar$"      . "#uzip/")
277                                     ("\\.xpi$"       . "#uzip/")
278                                     ("\\.apk$"       . "#uzip/")
279                                     ("\\.iso$"       . "#iso9660/")
280                                     ("\\.patch$"     . "#/")
281                                     ("\\.txz$"       . "#/")
282                                     ("."             . "#/"))
283   "List of AVFS handlers to manage specific file extensions."
284   :group 'sunrise
285   :type 'alist)
286
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."
291   :group 'sunrise
292   :type 'string)
293
294 (defcustom sr-window-split-style 'horizontal
295   "The current window split configuration.
296 May be `horizontal', `vertical' or `top'."
297   :group 'sunrise
298   :type '(choice
299           (const horizontal)
300           (const vertical)
301           (const top)))
302
303 (defcustom sr-windows-locked t
304   "When non-nil, vertical size of the panes will remain constant."
305   :group 'sunrise
306   :type 'boolean)
307
308 (defcustom sr-windows-default-ratio 66
309   "Percentage of the total height of the frame to use by default for the Sunrise
310 Commander panes."
311   :group 'sunrise
312   :type 'integer
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))))
318
319 (defcustom sr-history-length 20
320   "Number of entries to keep in each pane's history rings."
321   :group 'sunrise
322   :type 'integer)
323
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."
327   :group 'sunrise
328   :type 'boolean)
329
330 (defcustom sr-confirm-kill-viewer t
331   "Whether to ask for confirmation before killing a buffer opened in quick-view
332 mode."
333   :group 'sunrise
334   :type 'boolean)
335
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
345 displayed instead."
346   :group 'sunrise
347   :type '(repeat symbol))
348
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
353 run-time."
354   :group 'sunrise
355   :type '(choice
356           (string :tag "Literal text")
357           (sexp :tag "Symbolic expression")))
358
359 (defcustom sr-fuzzy-negation-character ?!
360   "Character to use for negating patterns when fuzzy-narrowing a pane."
361   :group 'sunrise
362   :type '(choice
363           (const :tag "Fuzzy matching negation disabled" nil)
364           (character :tag "Fuzzy matching negation character" ?!)))
365
366 (defcustom sr-init-hook nil
367   "List of functions to be called before the Sunrise panes are displayed."
368   :group 'sunrise
369   :type 'hook
370   :options '(auto-insert))
371
372 (defcustom sr-start-hook nil
373   "List of functions to be called after the Sunrise panes are displayed."
374   :group 'sunrise
375   :type 'hook
376   :options '(auto-insert))
377
378 (defcustom sr-refresh-hook nil
379   "List of functions to be called every time a pane is refreshed."
380   :group 'sunrise
381   :type 'hook
382   :options '(auto-insert))
383
384 (defcustom sr-quit-hook nil
385   "List of functions to be called after the Sunrise panes are hidden."
386   :group 'sunrise
387   :type 'hook
388   :options '(auto-insert))
389
390 (defvar sr-restore-buffer nil
391   "Buffer to restore when Sunrise quits.")
392
393 (defvar sr-prior-window-configuration nil
394   "Window configuration before Sunrise was started.")
395
396 (defvar sr-running nil
397   "True when Sunrise commander mode is running.")
398
399 (defvar sr-synchronized nil
400   "True when synchronized navigation is on")
401
402 (defvar sr-current-window-overlay nil
403   "Holds the current overlay which marks the current Dired buffer.")
404
405 (defvar sr-clex-hotchar-overlay nil
406   "Overlay used to highlight the hot character (%) during CLEX operations.")
407
408 (defvar sr-left-directory "~/"
409   "Dired directory for the left window. See variable `dired-directory'.")
410
411 (defvar sr-left-buffer nil
412   "Dired buffer for the left window.")
413
414 (defvar sr-left-window nil
415   "The left window of Dired.")
416
417 (defvar sr-right-directory "~/"
418   "Dired directory for the right window. See variable `dired-directory'.")
419
420 (defvar sr-right-buffer nil
421   "Dired buffer for the right window.")
422
423 (defvar sr-right-window nil
424   "The right window of Dired.")
425
426 (defvar sr-current-frame nil
427   "The frame Sunrise is active on (if any).")
428
429 (defvar sr-this-directory "~/"
430   "Dired directory in the active pane.
431 This isn't necessarily the same as `dired-directory'.")
432
433 (defvar sr-other-directory "~/"
434   "Dired directory in the passive pane.")
435
436 (defvar sr-selected-window 'left
437   "The window to select when Sunrise starts up.")
438
439 (defvar sr-selected-window-width nil
440   "The width the selected window should have on startup.")
441
442 (defvar sr-history-registry '((left) (right))
443   "Registry of visited directories for both panes.")
444
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.")
451
452 (defvar sr-ti-openterms nil
453   "Stack of currently open terminal buffers.")
454
455 (defvar sr-ediff-on nil
456   "Flag that indicates whether an `ediff' is being currently done.")
457
458 (defvar sr-clex-on nil
459   "Flag that indicates that a CLEX operation is taking place.")
460
461 (defvar sr-virtual-buffer nil
462   "Local flag that indicates the current buffer was originally in
463   VIRTUAL mode.")
464
465 (defvar sr-dired-directory ""
466   "Directory inside which `sr-mode' is currently active.")
467
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.")
471
472 (defvar sr-panes-height nil
473   "Current height of the pane windows.
474 Initial value is 2/3 the viewport height.")
475
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)
479
480 (defvar sr-inhibit-highlight nil
481   "Special variable used to temporarily inhibit highlighting in panes.")
482
483 (defvar sr-find-items nil
484   "Special variable used by `sr-find' to control the scope of find operations.")
485
486 (defvar sr-desktop-save-handlers nil
487   "List of extension-defined handlers to save Sunrise buffers with desktop.")
488
489 (defvar sr-desktop-restore-handlers nil
490   "List of extension-defined handlers to restore Sunrise buffers from desktop.")
491
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)
495
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.")
500
501 (defconst sr-side-lookup (list '(left . right) '(right . left))
502   "Trivial alist used by the Sunrise Commander to lookup its own passive side.")
503
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."
510   :group 'sunrise)
511
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."
519   :group 'sunrise)
520
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."
524   :group 'sunrise)
525
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."
529   :group 'sunrise)
530
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."
535   :group 'sunrise)
536
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.
540
541 ;;; preserve this variable when switching from `dired-mode' to another mode
542 (put 'dired-subdir-alist 'permanent-local t)
543
544 ;;;###autoload
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:
548
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
567
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
586
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
593
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
605
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
619
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)
625
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
639
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
644
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
647
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
654
655 Additionally, the following traditional commander-style keybindings are provided
656 \(these may be disabled by customizing the `sr-use-commander-keys' option):
657
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
674
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.
677
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):
680
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
691
692 The following bindings are available only in line mode (eshell is considered to
693 be *always* in line mode):
694
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
705
706 In a terminal in line mode the following substitutions are also performed
707 automatically:
708
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.
722 "
723   :group 'sunrise
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)
727   (sr-highlight)
728   (dired-omit-mode dired-omit-mode)
729
730   (make-local-variable 'truncate-partial-width-windows)
731   (setq truncate-partial-width-windows (sr-truncate-v t))
732
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)
741   (hl-line-mode 1)
742 )
743
744 ;;;###autoload
745 (define-derived-mode sr-virtual-mode dired-virtual-mode "Sunrise VIRTUAL"
746   "Sunrise Commander Virtual Mode. Useful for reusing find and locate results."
747   :group 'sunrise
748   (set-keymap-parent sr-virtual-mode-map sr-mode-map)
749   (sr-highlight)
750   (enriched-mode -1)
751
752   (make-local-variable 'truncate-partial-width-windows)
753   (setq truncate-partial-width-windows (sr-truncate-v t))
754
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)
762   (hl-line-mode 1)
763
764   (define-key sr-virtual-mode-map "\C-c\C-c" 'sr-virtual-dismiss))
765
766 (defmacro sr-within (dir form)
767   "Evaluate FORM in Sunrise context."
768   `(unwind-protect
769        (progn
770          (setq sr-dired-directory
771                (file-name-as-directory (abbreviate-file-name ,dir)))
772          (ad-activate 'dired-find-buffer-nocreate)
773          ,form)
774      (ad-deactivate 'dired-find-buffer-nocreate)
775      (setq sr-dired-directory "")))
776
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))
783      ,@body
784      (dired-omit-mode omit)
785      (if path-faces
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)
790          (sr-reverse-pane))
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)))
794
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)))
801      ,form
802      (setq sr-this-directory default-directory)
803      (sr-keep-buffer)
804      (sr-highlight)
805      (when (and sr-kill-unused-buffers (buffer-live-p dispose))
806        (with-current-buffer dispose
807          (bury-buffer)
808          (set-buffer-modified-p nil)
809          (unless (kill-buffer dispose)
810            (kill-local-variable 'sr-current-path-faces))))))
811
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)
818        (sr-change-window)
819        (condition-case description
820            ,form
821          (error (message (cadr description)))))
822      (if (not sr-running)
823          (sr-select-window home)
824        (run-hooks 'sr-refresh-hook)
825        (sr-change-window))))
826
827 (defmacro sr-silently (&rest body)
828   "Inhibit calls to `message' in BODY."
829   `(letf (((symbol-function 'message) (lambda (_msg &rest _args) (ignore))))
830      ,@body))
831
832 (eval-and-compile
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)))))
836
837 (defun sr-dired-mode ()
838   "Set Sunrise mode in every Dired buffer opened in Sunrise (called in a hook)."
839   (if (and sr-running
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)))
849         (sr-mode)
850         (dired-unadvertise dired-directory))))
851 (add-hook 'dired-before-readin-hook 'sr-dired-mode)
852
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)
862         (revert-buffer))
863       (sr-keep-buffer)
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)
867
868 (defun sr-virtualize-pane ()
869   "Put the current normal view in VIRTUAL mode."
870   (interactive)
871   (when (eq major-mode 'sr-mode)
872     (let ((focus (dired-get-filename 'verbatim t)))
873       (sr-save-aspect
874        (when (eq sr-left-buffer sr-right-buffer)
875          (dired default-directory)
876          (sr-keep-buffer))
877        (sr-virtual-mode))
878       (if focus (sr-focus-filename focus)))))
879
880 (defun sr-virtual-dismiss ()
881   "Restore normal pane view in Sunrise VIRTUAL mode."
882   (interactive)
883   (when (eq major-mode 'sr-virtual-mode)
884     (let ((focus (dired-get-filename 'verbatim t)))
885       (sr-process-kill)
886       (sr-save-aspect
887        (sr-alternate-buffer (sr-goto-dir sr-this-directory))
888        (if focus (sr-focus-filename focus))
889        (revert-buffer)))))
890
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)
896   (sr-highlight))
897
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))
903         (dotimes (_times 2)
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)))
907         target-window)
908     (selected-window)))
909
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."
914   (interactive "p")
915   (let ((viewer (sr-viewer-window)))
916     (if (memq major-mode '(sr-mode sr-virtual-mode sr-tree-mode))
917         (hl-line-mode 1))
918     (if viewer
919         (select-window viewer)
920       (when force-setup
921         (sr-setup-windows)
922         (select-window (sr-viewer-window))))))
923
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)))
933
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)
941
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))
947       (enriched-mode 1)))
948 (add-hook 'before-save-hook 'sr-enrich-buffer)
949
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)))
956
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
963
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)
969     ad-do-it))
970 (ad-activate 'dired-dwim-target-directory)
971
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)
976       ad-do-it
977     (let ((from (selected-window)))
978       ad-do-it
979       (unless (memq from (list sr-left-window sr-right-window))
980         ;; switching from outside
981         (sr-select-window sr-selected-window))
982       (with-no-warnings
983         (when (eq (selected-window) (sr-other 'window))
984           ;; switching from the other pane
985           (sr-change-window))))))
986 (ad-activate 'other-window)
987
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))
993         (setq insert 'guess)
994         ad-do-it)
995     ad-do-it))
996 (ad-activate 'use-hard-newlines)
997
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))
1003     (with-no-warnings
1004       (sr-display-attributes beg end sr-show-file-attributes))))
1005 (ad-activate 'dired-insert-set-properties)
1006
1007 ;;; ============================================================================
1008 ;;; Sunrise Commander keybindings:
1009
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)
1029
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)
1054
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)
1072
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)
1076
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)
1095
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)
1114
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)
1129
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)
1132
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)
1141
1142 (define-key sr-mode-map (kbd "<down-mouse-1>")  'ignore)
1143
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)
1152     ([(f10)]           . sr-quit)
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.")
1162
1163 (defcustom sr-use-commander-keys t
1164   "Whether to use traditional commander-style function keys (F5 = copy, etc)"
1165   :group 'sunrise
1166   :type 'boolean
1167   :set (defun sr-set-commander-keys (symbol value)
1168          "Setter function for the `sr-use-commander-keys' custom option."
1169          (if value
1170              (mapc (lambda (x)
1171                      (define-key sr-mode-map (car x) (cdr x))) sr-commander-keys)
1172            (mapc (lambda (x)
1173                    (define-key sr-mode-map (car x) nil)) sr-commander-keys))
1174          (set-default symbol value)))
1175
1176 ;;; ============================================================================
1177 ;;; Initialization and finalization functions:
1178
1179 ;;;###autoload
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."
1185   (interactive)
1186   (message "Starting Sunrise Commander...")
1187
1188   (if (not sr-running)
1189       (let ((welcome sr-start-message))
1190         (if left-directory
1191             (setq sr-left-directory left-directory))
1192         (if right-directory
1193             (setq sr-right-directory right-directory))
1194
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)
1199               sr-running t)
1200         (sr-setup-windows)
1201         (if filename
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
1208         (hl-line-mode 1))
1209     (let ((my-frame (window-frame (selected-window))))
1210       (sr-quit)
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)))))
1215  
1216 ;;;###autoload
1217 (defun sr-dired (&optional target switches)
1218   "Visit the given target (file or directory) in `sr-mode'."
1219   (interactive
1220    (list
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)
1231     (if file
1232         (sr-follow-file file)
1233       (sr-goto-dir directory))
1234     (hl-line-mode 1)
1235     (sr-display-attributes (point-min) (point-max) sr-show-file-attributes)
1236     (sr-this 'buffer)))
1237
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))
1241       sr-this-directory
1242     default-directory))
1243
1244 ;;;###autoload
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
1249 viewer window."
1250   (interactive)
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)))
1254     (sr-quit t)
1255     (message "Hast thou a charm to stay the morning-star in his deep course?")))
1256
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
1261 or window."
1262   (if type
1263       (symbol-value (sr-symbol sr-selected-window type))
1264     sr-selected-window))
1265
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
1270 buffer or window."
1271   (let ((side (cdr (assq sr-selected-window sr-side-lookup))))
1272     (if type
1273         (symbol-value (sr-symbol side type))
1274       side)))
1275
1276 ;;; ============================================================================
1277 ;;; Window management functions:
1278
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))
1284          (progn
1285            (switch-to-buffer ,(sr-symbol side 'buffer))
1286            (setq ,(sr-symbol side 'directory) default-directory))
1287        (sr-dired ,(sr-symbol side 'directory)))))
1288
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)
1293     (other-window 1)
1294     (sr-setup-pane right)))
1295
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))
1305
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)
1313
1314   (case sr-window-split-style
1315     (horizontal (split-window-horizontally))
1316     (vertical   (split-window-vertically))
1317     (top        (ignore))
1318     (t (error "Unrecognised `sr-window-split-style' value: %s"
1319               sr-window-split-style)))
1320
1321   (sr-setup-visible-panes)
1322
1323   ;;select the correct window
1324   (sr-select-window sr-selected-window)
1325   (sr-restore-panes-width)
1326   (run-hooks 'sr-start-hook))
1327
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)))
1331     (while (and
1332               start
1333               (or (memq major-mode '(sr-mode sr-virtual-mode sr-tree-mode))
1334                   (memq (current-buffer) (list sr-left-buffer sr-right-buffer))))
1335         (bury-buffer)
1336         (if (eq start (current-buffer)) (setq start nil)))))
1337
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)))
1343
1344 (defun sr-lock-window (_frame)
1345   "Resize the left Sunrise pane to have the \"right\" size."
1346   (when sr-running
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
1354              (not sr-ediff-on)
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))
1361                (scroll-right)
1362                (when (window-live-p sr-right-window)
1363                  (select-window sr-right-window)
1364                  (scroll-right))))))))
1365
1366 ;; This keeps the size of the Sunrise panes constant:
1367 (add-hook 'window-size-change-functions 'sr-lock-window)
1368
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
1372 path line."
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))
1376       (save-excursion
1377         (goto-char (point-min))
1378         (sr-hide-avfs-root)
1379         (sr-highlight-broken-links)
1380         (sr-graphical-highlight face)
1381         (sr-force-passive-highlight)
1382         (run-hooks 'sr-refresh-hook)))))
1383
1384 (defun sr-unhighlight (face)
1385   "Remove FACE from the list of faces of the active path line."
1386   (when face
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))))
1390
1391 (defun sr-hide-avfs-root ()
1392   "Hide the AVFS virtual filesystem root (if any) on the path line."
1393   (if sr-avfs-root
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))))
1397         (while next
1398           (setq end (point)
1399                 next (search-forward sr-avfs-root (point-at-eol) t)))
1400         (when end
1401           (add-text-properties start end '(invisible t))))))
1402
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)))
1409         (dired-mark 1)))))
1410
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))))
1417
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))
1422
1423     (when (sr-invalid-overlayp)
1424       ;;determine begining and end
1425       (save-excursion
1426         (goto-char (point-min))
1427         (search-forward-regexp "\\S " nil t)
1428         (setq begin (1- (point)))
1429         (end-of-line)
1430         (setq end (1- (point))))
1431
1432       ;;build overlay
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))
1437
1438       ;;path line hover effect:
1439       (add-text-properties
1440        begin
1441        end
1442        '(mouse-face sr-highlight-path-face
1443                     help-echo "click to move up")
1444        nil))
1445     (when face
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))))
1450
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))
1459         (when (and revert
1460                    (memq major-mode '(sr-mode sr-virtual-mode sr-tree-mode)))
1461           (revert-buffer)))))
1462
1463 (defun sr-quit (&optional norestore)
1464   "Quit Sunrise and restore Emacs to the previous state."
1465   (interactive)
1466   (if sr-running
1467       (progn
1468         (setq sr-running nil)
1469         (sr-save-directories)
1470         (sr-save-panes-width)
1471         (if norestore
1472             (progn
1473               (sr-select-viewer-window)
1474               (delete-other-windows))
1475           (sr-restore-prior-configuration))
1476         (sr-bury-panes)
1477         (setq buffer-read-only nil)
1478         (run-hooks 'sr-quit-hook)
1479         (setq sr-current-frame nil))
1480     (bury-buffer)))
1481
1482 (add-hook 'delete-frame-functions
1483           (lambda (frame)
1484             (if (and sr-running (eq frame sr-current-frame)) (sr-quit))))
1485
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))))
1493
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)))))
1499
1500 (defun sr-bury-panes ()
1501   "Send both pane buffers to the end of the `buffer-list'."
1502   (mapc (lambda (x)
1503           (bury-buffer (symbol-value (sr-symbol x 'buffer))))
1504         '(left right)))
1505
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
1512               (window-width
1513                (symbol-value (sr-symbol sr-selected-window 'window))))
1514       (setq sr-selected-window-width t))))
1515
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)))))
1523
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)))
1533
1534 (defun sr-enlarge-left-pane ()
1535   "Enlarge the left pane by 5 columns."
1536   (interactive)
1537   (when (< (1+ window-min-width) (window-width sr-right-window))
1538       (sr-resize-panes)
1539       (sr-save-panes-width)))
1540
1541 (defun sr-enlarge-right-pane ()
1542   "Enlarge the right pane by 5 columns."
1543   (interactive)
1544   (when (< (1+ window-min-width) (window-width sr-left-window))
1545       (sr-resize-panes t)
1546       (sr-save-panes-width)))
1547
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)))
1551     (case size
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)))))
1555
1556 (defun sr-enlarge-panes ()
1557   "Enlarge both panes vertically."
1558   (interactive)
1559   (let ((sr-windows-locked nil)
1560         (max (sr-get-panes-size 'max))
1561         (ratio 1)
1562         delta)
1563     (save-selected-window
1564       (when (eq sr-window-split-style 'vertical)
1565         (select-window sr-right-window)
1566         (setq ratio 2)
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))
1572           (shrink-window -1))
1573       (setq sr-panes-height (* (window-height) ratio)))))
1574
1575 (defun sr-shrink-panes ()
1576   "Shink both panes vertically."
1577   (interactive)
1578   (let ((sr-windows-locked nil)
1579         (min (sr-get-panes-size 'min))
1580         (ratio 1)
1581         delta)
1582     (save-selected-window
1583       (when (eq sr-window-split-style 'vertical)
1584         (select-window sr-right-window)
1585         (setq ratio 2)
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))
1591           (shrink-window 1))
1592       (setq sr-panes-height (* (window-height) ratio)))))
1593
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."
1599   (interactive)
1600   (if sr-running
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))))
1604         (sr-setup-windows)
1605       (setq sr-panes-height (sr-get-panes-size height))
1606       (let ((locked sr-windows-locked))
1607         (setq sr-windows-locked t)
1608         (if height
1609             (shrink-window 1)
1610           (setq sr-selected-window-width t)
1611           (balance-windows))
1612         (unless locked
1613           (sit-for 0.1)
1614           (setq sr-windows-locked nil))))
1615     (sunrise)))
1616
1617 (defun sr-max-lock-panes ()
1618   (interactive)
1619   (sr-save-panes-width)
1620   (sr-lock-panes 'max))
1621
1622 (defun sr-min-lock-panes ()
1623   (interactive)
1624   (sr-save-panes-width)
1625   (sr-lock-panes 'min))
1626
1627 ;;; ============================================================================
1628 ;;; File system navigation functions:
1629
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."
1633   (interactive)
1634   (unless filename
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 "/")))))
1638           (if (< 0 levels)
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)))))
1643   (if filename
1644       (if (file-exists-p filename)
1645           (sr-find-file filename)
1646         (error "Sunrise: nonexistent target"))))
1647
1648 (defun sr-advertised-execute-file (&optional prefix)
1649   "Execute the currently selected file in a new subprocess."
1650   (interactive "P")
1651   (let ((path (dired-get-filename nil t)) (label) (args))
1652     (if path
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))
1657     (when prefix
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)
1661     (if args
1662         (apply #'start-process (append (list "Sunrise Subprocess" nil path)
1663                                        (split-string args)))
1664       (start-process "Sunrise Subprocess" nil path))))
1665
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
1670 AVFS."
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))))
1677
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)))
1681
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)))
1685     (and sr-avfs-root
1686          (or (eq 'archive-mode mode)
1687              (eq 'tar-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)))))))
1692
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))))
1701
1702 (defun sr-find-virtual-directory (sr-virtual-dir)
1703   "Visit the given Sunrise VIRTUAL directory in the active pane."
1704   (sr-save-aspect
1705    (sr-alternate-buffer (find-file sr-virtual-dir)))
1706   (sr-history-push sr-virtual-dir)
1707   (set-visited-file-name nil t)
1708   (sr-keep-buffer)
1709   (sr-backup-buffer))
1710
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)
1717         (sr-quit)
1718         (set-window-configuration sr-prior-window-configuration)
1719         (switch-to-buffer buff))
1720     (error (message "%s" (cadr description)))))
1721
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)))
1730
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)))
1741       (sr-save-aspect
1742        (sr-within dir (sr-alternate-buffer (dired dir))))
1743       (sr-history-push default-directory)
1744       (sr-beginning-of-buffer))))
1745
1746 (defun sr-dired-prev-subdir (&optional count)
1747   "Go to the parent directory, or COUNT subdirectories upwards."
1748   (interactive "P")
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))))
1756       (sr-goto-dir to)
1757       (unless (sr-equal-dirs from to)
1758         (sr-focus-filename from)))))
1759
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."
1763   (interactive)
1764   (if (null target-path)
1765       (setq target-path (dired-get-filename nil t)))
1766
1767   (let ((target-dir (file-name-directory target-path))
1768         (target-symlink (file-symlink-p target-path))
1769         (target-file))
1770
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)))
1780
1781     (setq target-file (file-name-nondirectory target-path))
1782
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)))
1787
1788 (defun sr-follow-viewer ()
1789   "Go to the directory of the file displayed in the viewer window."
1790   (interactive)
1791   (when sr-running
1792     (let* ((viewer (sr-viewer-window))
1793            (viewer-buffer (if viewer (window-buffer viewer)))
1794            (target-dir) (target-file))
1795       (when viewer-buffer
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)))))
1802
1803 (defun sr-project-path ()
1804   "Find projections of the active directory over the passive one.
1805
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.
1808
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'.
1814
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."
1818
1819   (interactive)
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))
1823     (while pos
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)
1834                 pos nil))))
1835     (unless next-key
1836       (message "Sunrise: sorry, no suitable projections found"))))
1837
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))
1844            (hist (cdr pane))
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))
1850       (push element hist)
1851       (setcdr pane hist))
1852     (sr-history-stack-reset)))
1853
1854 (defun sr-history-next ()
1855   "Navigate forward in the history of the active pane."
1856   (interactive)
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))))
1862
1863 (defun sr-history-prev ()
1864   "Navigate backwards in the history of the active pane."
1865   (interactive)
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))))
1870
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
1876 top of the stack."
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))
1884     (when target-dir
1885       (sr-goto-dir target-dir)
1886       (setcdr side (cons depth goal)))))
1887
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))))
1892
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)))
1903     target))
1904
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)
1910   (let* ((feature
1911           (cond ((fboundp 'bookmark-make-record) 'sunrise-x-checkpoints)
1912                 (t 'sunrise-x-old-checkpoints)))
1913          (name (symbol-name feature)))
1914     (or
1915      (not (featurep 'sunrise-commander))
1916      (require feature nil t)
1917      noerror
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))))
1921
1922 (defmacro sr-checkpoint-command (function-name)
1923   `(defun ,function-name (&optional arg)
1924      (interactive)
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)
1933
1934 (defun sr-do-find-marked-files (&optional noselect)
1935   "Sunrise replacement for `dired-do-find-marked-files'."
1936   (interactive "P")
1937   (let* ((files (delq nil (mapcar (lambda (x)
1938                                     (and (file-regular-p x) x))
1939                                   (dired-get-marked-files)))))
1940     (unless files
1941       (error "Sunrise: no regular files to open"))
1942     (unless noselect (sr-quit))
1943     (dired-simultaneous-find-file files noselect)))
1944
1945 ;;; ============================================================================
1946 ;;; Graphical interface interaction functions:
1947
1948 (defun sr-change-window()
1949   "Change to the other Sunrise pane."
1950   (interactive)
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)))))
1956
1957 (defun sr-mouse-change-window (e)
1958   "Change to the Sunrise pane clicked in by the mouse."
1959   (interactive "e")
1960   (mouse-set-point e)
1961   (if (eq (selected-window) (sr-other 'window))
1962       (sr-change-window)))
1963
1964 (defun sr-beginning-of-buffer()
1965   "Go to the first directory/file in Dired."
1966   (interactive)
1967   (goto-char (point-min))
1968   (when (re-search-forward directory-listing-before-filename-regexp nil t)
1969     (dotimes (_times 2)
1970       (when (looking-at "\.\.?/?$")
1971         (dired-next-line 1)))))
1972
1973 (defun sr-end-of-buffer()
1974   "Go to the last directory/file in Dired."
1975   (interactive)
1976   (goto-char (point-max))
1977   (re-search-backward directory-listing-before-filename-regexp)
1978   (dired-next-line 0))
1979
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))
1994     (beginning-of-line)
1995     (unless (re-search-forward expr nil t)
1996       (re-search-backward expr nil t)))
1997   (beginning-of-line)
1998   (re-search-forward directory-listing-before-filename-regexp nil t))
1999
2000 (defun sr-split-toggle()
2001   "Change Sunrise window layout from horizontal to vertical to top and so on."
2002   (interactive)
2003   (case sr-window-split-style
2004     (horizontal (sr-split-setup 'vertical))
2005     (vertical (sr-split-setup 'top))
2006     (top (progn
2007            (sr-split-setup 'horizontal)
2008            (sr-in-other (revert-buffer))))
2009     (t (sr-split-setup 'horizontal))))
2010
2011 (defun sr-split-setup(split-type)
2012   (setq sr-window-split-style split-type)
2013   (when sr-running
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)))
2018     (sr-setup-windows))
2019   (message "Sunrise: split style changed to \"%s\"" (symbol-name split-type)))
2020
2021 (defun sr-transpose-panes ()
2022   "Change the order of the panes."
2023   (interactive)
2024   (unless (eq sr-left-buffer sr-right-buffer)
2025     (mapc (lambda (x)
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))
2029               (set right tmp)))
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)))
2037
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."
2043   (interactive "P")
2044   (let ((target (current-buffer)) (sr-inhibit-highlight t))
2045     (sr-change-window)
2046     (if reverse
2047         (setq target (current-buffer))
2048       (sr-alternate-buffer (switch-to-buffer target))
2049       (sr-history-push default-directory))
2050     (sr-change-window)
2051     (when reverse
2052       (sr-alternate-buffer (switch-to-buffer target))
2053       (sr-history-push default-directory)
2054       (revert-buffer)))
2055   (sr-highlight))
2056
2057 (defun sr-browse-pane ()
2058   "Browse the directory in the active pane."
2059   (interactive)
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)
2064       (if (featurep 'w3m)
2065           (eval '(w3m-goto-url url))
2066         (browse-url url)))))
2067
2068 (defun sr-browse-file (&optional file)
2069   "Display the selected file in the default web browser."
2070   (interactive)
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))
2081
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."
2085   (interactive)
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))
2090         (erase-buffer)
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))
2099       (dired-revert)
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)
2105   (sr-highlight))
2106
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'."
2113   (interactive)
2114   (if sr-kill-unused-buffers
2115       (sr-quit)
2116     (kill-buffer (current-buffer))
2117     (let ((_x (pop (cdr (assoc sr-selected-window sr-history-registry)))))
2118       (sr-history-stack-reset))))
2119
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
2126 buffer."
2127   (interactive "P")
2128   (if arg
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))))))
2134
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)))))
2143
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))))
2148
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"))))
2155
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
2163           (progn
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)))))))
2171
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))))
2179
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)
2188                    `(display
2189                      ,(apply display-function-or-flag
2190                              (list (buffer-substring cursor (1- (point)))))))
2191                   ((null display-function-or-flag) '(invisible t))
2192                   (t nil))))
2193       (if sr-attributes-display-mask
2194           (block block 
2195             (mapc (lambda (do-display)
2196                     (search-forward-regexp "\\w")
2197                     (search-forward-regexp "\\s-")
2198                     (setq props (sr-make-display-props do-display))
2199                     (when props 
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)))))))
2206
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))
2211     (save-excursion
2212       (goto-char beg)
2213       (forward-line -1)
2214       (while (and (null next) (< (point) end))
2215         (forward-line 1)
2216         (setq next (dired-move-to-filename)))
2217       (while (and next (< next end))
2218         (beginning-of-line)
2219         (forward-char 2)
2220         (if (not visiblep)
2221             (sr-mask-attributes (point) next)
2222           (remove-text-properties (point) next '(invisible t))
2223           (remove-text-properties (point) next '(display)))
2224         (forward-line 1)
2225         (setq next (dired-move-to-filename))))))
2226
2227 (defun sr-toggle-attributes ()
2228   "Hide/Show the attributes of all files in the active pane."
2229   (interactive)
2230   (setq sr-show-file-attributes (not sr-show-file-attributes))
2231   (sr-display-attributes (point-min) (point-max) sr-show-file-attributes))
2232
2233 (defun sr-toggle-truncate-lines ()
2234   "Enable/Disable truncation of long lines in the active pane."
2235   (interactive)
2236   (if (sr-truncate-p)
2237       (progn
2238         (setq truncate-partial-width-windows (sr-truncate-v nil))
2239         (message "Sunrise: wrapping long lines"))
2240     (progn
2241       (setq truncate-partial-width-windows (sr-truncate-v t))
2242       (message "Sunrise: truncating long lines")))
2243   (sr-silently (dired-do-redisplay)))
2244
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))
2251
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))
2258       active))
2259
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)
2266     (progn
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))
2273       (revert-buffer)))
2274   (message "Sunrise: sorting entries by %s" label))
2275
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)
2280      (interactive)
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")
2286
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."
2291   (interactive)
2292   (sr-sort-by-operation 'sr-numerical-sort-op (unless inhibit-label "NUMBER"))
2293   (if (get sr-selected-window 'sorting-reverse) (sr-reverse-pane)))
2294
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? ")
2298   (if (>= order 97)
2299       (setq order (- order 32)))
2300   (case order
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))))
2306
2307 (defun sr-reverse-pane (&optional interactively)
2308   "Reverse the contents of the active pane."
2309   (interactive "p")
2310   (let ((line (line-number-at-pos))
2311         (reverse (get sr-selected-window 'sorting-reverse)))
2312     (sr-sort-by-operation 'identity)
2313     (when interactively
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))))
2317
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))
2321     (case opt
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")))))
2333
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."
2346   (interactive)
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))
2353            (beg) (end))
2354       (if messages (message "Sorting records..."))
2355       (setq sort-lists (apply operation (list sort-lists)))
2356       (if messages (message "Reordering buffer..."))
2357       (save-excursion
2358         (save-restriction
2359           (sr-end-of-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")))
2366     (sr-highlight)
2367     (if focus (sr-focus-filename focus))
2368     (when label
2369       (put sr-selected-window 'sorting-order label)
2370       (message "Sunrise: sorting entries by %s" label)))
2371   nil)
2372
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."
2377   (mapcar
2378    'cddr
2379    (sort
2380     (sort
2381      (mapcar
2382       (lambda (x)
2383         (let ((key (buffer-substring-no-properties (car x) (cddr x))))
2384           (append
2385            (list key
2386                  (string-to-number (replace-regexp-in-string "^[^0-9]*" "" key))
2387                  (cdr x))
2388            (cdr x))))
2389       sort-lists)
2390      (lambda (a b) (string< (car a) (car b))))
2391     (lambda (a b) (< (cadr a) (cadr b))))))
2392
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 "")))
2404     (mapcar
2405      'cddr
2406      (sort
2407       (sort
2408        (mapcar
2409         (lambda (x)
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))
2413                  (index))
2414             (when attrs
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)))))
2418         sort-lists)
2419        (lambda (a b) (sr-compare nth-attr (cadr b) (cadr a))))
2420       (lambda (a b)
2421         (if (and (car a) (car b))
2422             (sr-compare nth-attr (cadr b) (cadr a))
2423           (and (car a) (not (stringp (car a))))))))))
2424
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."
2432   (delq nil
2433         (mapcar
2434          (lambda (x) (and (atom (car x)) x))
2435          (save-excursion
2436            (sr-beginning-of-buffer)
2437            (beginning-of-line)
2438            (sort-build-lists 'forward-line 'end-of-line 'dired-move-to-filename
2439                              nil)))))
2440
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))
2455         (t nil)))
2456
2457 (defun sr-scroll-up ()
2458   "Scroll the current pane or (if active) the viewer pane 1 line up."
2459   (interactive)
2460   (if (buffer-live-p other-window-scroll-buffer)
2461       (save-selected-window
2462         (sr-select-viewer-window)
2463         (scroll-up 1))
2464     (scroll-up 1)))
2465
2466 (defun sr-scroll-down ()
2467   "Scroll the current pane or (if active) the viewer pane 1 line down."
2468   (interactive)
2469   (if (buffer-live-p other-window-scroll-buffer)
2470       (save-selected-window
2471         (sr-select-viewer-window)
2472         (scroll-down 1))
2473     (scroll-down 1)))
2474
2475 (defun sr-scroll-quick-view ()
2476   "Scroll down the viewer window during a quick view."
2477   (interactive)
2478   (if other-window-scroll-buffer (scroll-other-window)))
2479
2480 (defun sr-scroll-quick-view-down ()
2481   "Scroll down the viewer window during a quick view."
2482   (interactive)
2483   (if other-window-scroll-buffer (scroll-other-window-down nil)))
2484
2485 (defun sr-undo ()
2486   "Restore selection as it was before the last file operation."
2487   (interactive)
2488   (dired-undo)
2489   (sr-highlight))
2490
2491 ;;; ============================================================================
2492 ;;; Passive & synchronized navigation functions:
2493
2494 (defun sr-sync ()
2495   "Toggle the Sunrise synchronized navigation feature."
2496   (interactive)
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)))
2502
2503 (defun sr-mark-sync (&optional buffer)
2504   "Change `mode-name' depending on whether synchronized navigation is enabled."
2505   (save-window-excursion
2506     (if buffer
2507         (switch-to-buffer buffer))
2508     (setq mode-name (concat "Sunrise "
2509                             (if sr-synchronized "SYNC-NAV" "Commander")))))
2510
2511 ;; This advertises synchronized navigation in all new buffers:
2512 (add-hook 'sr-mode-hook 'sr-mark-sync)
2513
2514 (defun sr-next-line-other ()
2515   "Move the cursor down in the passive pane."
2516   (interactive)
2517   (sr-in-other (dired-next-line 1)))
2518
2519 (defun sr-prev-line-other ()
2520   "Move the cursor up in the passive pane."
2521   (interactive)
2522   (sr-in-other (dired-next-line -1)))
2523
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)))
2530
2531 (defun sr-advertised-find-file-other ()
2532   "Open the file/directory selected in the passive pane."
2533   (interactive)
2534   (if sr-synchronized
2535       (let ((target (sr-directory-name-proper (dired-get-filename))))
2536         (sr-change-window)
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? ")
2540               (sr-sync)))
2541         (sr-change-window)
2542         (sr-advertised-find-file))
2543     (sr-in-other (sr-advertised-find-file))))
2544
2545 (defun sr-mouse-advertised-find-file (e)
2546   "Open the file/directory pointed to by the mouse."
2547   (interactive "e")
2548   (sr-mouse-change-window e)
2549   (sr-advertised-find-file))
2550
2551 (defun sr-prev-subdir-other (&optional count)
2552   "Go to the previous subdirectory in the passive pane."
2553   (interactive "P")
2554   (let ((count (or count 1)))
2555     (sr-in-other (sr-dired-prev-subdir count))))
2556
2557 (defun sr-follow-file-other ()
2558   "Go to the directory of the selected file, but in the passive pane."
2559   (interactive)
2560   (let ((filename (dired-get-filename nil t)))
2561     (sr-in-other (sr-follow-file filename))))
2562
2563 (defun sr-history-prev-other ()
2564   "Change to previous directory (if any) in the passive pane's history list."
2565   (interactive)
2566   (sr-in-other (sr-history-prev)))
2567
2568 (defun sr-history-next-other ()
2569   "Change to the next directory (if any) in the passive pane's history list."
2570   (interactive)
2571   (sr-in-other (sr-history-next)))
2572
2573 (defun sr-mark-other (arg)
2574   "Mark the current (or next ARG) files in the passive pane."
2575   (interactive "P")
2576   (setq arg (or arg 1))
2577   (sr-in-other (dired-mark arg)))
2578
2579 (defun sr-unmark-backward-other (arg)
2580   (interactive "p")
2581   (sr-in-other (dired-unmark-backward arg)))
2582
2583 (defun sr-unmark-all-marks-other ()
2584   "Remove all marks from the passive pane."
2585   (interactive)
2586   (sr-in-other (dired-unmark-all-marks)))
2587
2588 ;;; ============================================================================
2589 ;;; Progress feedback functions:
2590
2591 (defun sr-progress-prompt (op-name)
2592   "Build the default progress feedback message."
2593   (concat "Sunrise: " op-name "... "))
2594
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))))
2609
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))))
2615
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)))
2619
2620 ;;; ============================================================================
2621 ;;; File manipulation functions:
2622
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)."
2629   (interactive "p")
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))
2634     (with-temp-buffer
2635       (if (>= 1 qty)
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))
2642         (dotimes (n qty)
2643           (setq name (format filename (1+ n)))
2644           (unless (file-exists-p name) (write-file name)))))
2645     (sr-revert-buffer)))
2646
2647 (defun sr-editable-pane ()
2648   "Put the current pane in File Names Editing mode (`wdired-mode')."
2649   (interactive)
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)
2654     (if was-virtual
2655         (set (make-local-variable 'sr-virtual-buffer) t)))
2656   (run-hooks 'sr-refresh-hook))
2657
2658 (defun sr-readonly-pane (as-virtual)
2659   "Put the current pane back in Sunrise mode."
2660   (when as-virtual
2661     (sr-virtual-mode)
2662     (sr-force-passive-highlight t))
2663   (dired-build-subdir-alist)
2664   (sr-revert-buffer))
2665
2666 (defun sr-terminate-wdired (fun)
2667   "Restore the current pane's original mode after editing with WDired."
2668   (ad-add-advice
2669    fun
2670    (ad-make-advice
2671     (intern (concat "sr-advice-" (symbol-name fun))) nil t
2672     `(advice
2673       lambda ()
2674       (if (not sr-running)
2675           ad-do-it
2676         (let ((was-virtual (local-variable-p 'sr-virtual-buffer))
2677               (saved-point (point)))
2678           (sr-save-aspect
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)
2683                      (ignore))))
2684              ad-do-it)
2685            (sr-readonly-pane was-virtual)
2686            (goto-char saved-point))
2687           (sr-unhighlight 'sr-editing-path-face)))))
2688    'around 'last)
2689   (ad-activate fun nil))
2690 (sr-terminate-wdired 'wdired-finish-edit)
2691 (sr-terminate-wdired 'wdired-abort-changes)
2692
2693 (defun sr-do-copy ()
2694   "Copy selected files and directories recursively to the passive pane."
2695   (interactive)
2696   (let* ((items (dired-get-marked-files nil))
2697          (vtarget (sr-virtual-target))
2698          (target (or vtarget sr-other-directory))
2699          (progress))
2700     (if (and (not vtarget) (sr-equal-dirs default-directory sr-other-directory))
2701         (dired-do-copy)
2702       (when (sr-ask "Copy" target items #'y-or-n-p)
2703         (if vtarget
2704             (progn
2705               (sr-copy-virtual)
2706               (message "Done: %d items(s) copied" (length items)))
2707           (progn
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))))))
2713
2714 (defun sr-do-symlink ()
2715   "Symlink selected files or directories from one pane to the other."
2716   (interactive)
2717   (if (sr-equal-dirs default-directory sr-other-directory)
2718       (dired-do-symlink)
2719     (sr-link #'make-symbolic-link "Symlink" dired-keep-marker-symlink)))
2720
2721 (defun sr-do-relsymlink ()
2722   "Symlink selected files or directories from one pane to the other relatively.
2723 See `dired-make-relative-symlink'."
2724   (interactive)
2725   (if (sr-equal-dirs default-directory sr-other-directory)
2726       (dired-do-relsymlink)
2727     (sr-link #'dired-make-relative-symlink
2728              "RelSymLink"
2729              dired-keep-marker-relsymlink)))
2730
2731 (defun sr-do-hardlink ()
2732   "Same as `dired-do-hardlink', but refuse to hardlink files to VIRTUAL buffers."
2733   (interactive)
2734   (if (sr-virtual-target)
2735       (error "Cannot hardlink files to a VIRTUAL buffer, try (C)opying instead")
2736     (dired-do-hardlink)))
2737
2738 (defun sr-do-rename ()
2739   "Move selected files and directories recursively from one pane to the other."
2740   (interactive)
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)
2744       (dired-do-rename)
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))
2750           (sr-in-other
2751            (progn
2752              (sr-move-files marked default-directory progress)
2753              (revert-buffer)
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))))))
2760
2761 (defun sr-do-delete ()
2762   "Remove selected files from the file system."
2763   (interactive)
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)
2767                               (mode 'top)
2768                               (t (error "(No deletions performed)")))))
2769     (mapc (lambda (x)
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)
2774       (revert-buffer))))
2775
2776 (defun sr-do-flagged-delete ()
2777   "Remove flagged files from the file system."
2778   (interactive)
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))
2783         (sr-do-delete)
2784       (message "(No deletions requested)"))))
2785
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? ")
2790
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"))
2796
2797   (let ((target sr-other-directory) clone-op items progress)
2798     (if (and mode (>= mode 97)) (setq mode (- mode 32)))
2799     (setq clone-op
2800           (case mode
2801             (?D nil)
2802             (?C #'copy-file)
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))))
2813
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."
2819   (interactive)
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))
2824   (revert-buffer))
2825
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))
2833       (sr-in-other
2834        (progn
2835          (revert-buffer)
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))))))))
2840
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))
2845   (mapc
2846    (function
2847     (lambda (f)
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)))
2853         (cond
2854          (symlink-to
2855           (progn
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)))
2859
2860          ((file-directory-p f)
2861           (let ((initial-path (file-name-directory f)))
2862             (unless (file-symlink-p initial-path)
2863               (sr-clone-directory
2864                initial-path name target-dir clone-op progress do-overwrite))))
2865
2866          (clone-op
2867           ;; (message "[[Cloning: %s => %s]]" f target-file)
2868           (if (eq clone-op 'copy-file)
2869               (setq clone-args
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)))))))
2876    file-paths))
2877
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))
2882   (if (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)))
2885          (file-paths-in-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)))
2890
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."
2893   (condition-case nil
2894       (dired-rename-file file target do-overwrite)
2895     (error
2896      (sr-clone-directory file "" target-dir 'copy-file progress do-overwrite)
2897      (dired-delete-file file 'always))))
2898
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."
2901   (mapc
2902    (function
2903     (lambda (f)
2904       (if (file-directory-p f)
2905           (progn
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)) ))))
2923    file-path-list))
2924
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)
2930                         (lambda (from)
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))
2936                         marker)))
2937
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")
2945       nil)))
2946
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))
2951     (sr-change-window)
2952     (goto-char (point-max))
2953     (setq beg (point))
2954     (mapc (lambda (file)
2955             (insert-char 32 2)
2956             (setq file (dired-make-relative file default-directory)
2957                   file (sr-chop ?/ file))
2958             (insert-directory file sr-virtual-listing-switches))
2959           fileset)
2960     (sr-display-attributes beg (point-at-eol) sr-show-file-attributes)
2961     (unwind-protect
2962         (delete-region (point) (line-end-position))
2963       (progn
2964         (sr-change-window)
2965         (dired-unmark-all-marks)))))
2966
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))
2971              (msg (if (< 1 len)
2972                       (format "* [%d items]" len)
2973                     (file-name-nondirectory (car files)))))
2974         (if target
2975             (setq msg (format "%s to %s" msg target)))
2976         (funcall function (format "%s %s? " prompt msg)))))
2977
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)))
2981
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)"))
2987   (let ((resp -1))
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 "))
2991     (if (>= resp 97)
2992         (setq resp (- resp 32)))
2993     (case resp
2994       (?Y t)
2995       (?A 'ALWAYS)
2996       (t nil))))
2997
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)
3005       nil)))
3006
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)))
3011
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)))
3019
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."
3023   (sr-filter
3024    (function (lambda (x) (file-regular-p (concat dir "/" x))))
3025    (sr-list-of-contents dir)))
3026
3027 (defun sr-filter (p x)
3028   "Return the elements of the list X that satisfy the predicate P."
3029   (let ((res-list nil))
3030     (while x
3031       (if (apply p (list (car x)))
3032           (setq res-list (cons (car x) res-list)))
3033       (setq x (cdr x)))
3034     (reverse res-list)))
3035
3036 (defun sr-directory-name-proper (file-path)
3037   "Return the proper name of the directory FILE-PATH, without initial path."
3038   (if file-path
3039       (let (
3040             (file-path-1 (substring file-path 0 (- (length file-path) 1)))
3041             (lastchar (substring file-path (- (length file-path) 1)))
3042             )
3043         (concat (file-name-nondirectory file-path-1) lastchar))))
3044
3045 ;;; ============================================================================
3046 ;;; Directory and file comparison functions:
3047
3048 (defun sr-compare-panes ()
3049   "Compare the contents of Sunrise panes."
3050   (interactive)
3051   (let* ((file-alist1 (sr-files-attributes))
3052          (other (sr-other 'buffer))
3053          (file-alist2 (with-current-buffer other (sr-files-attributes)))
3054          (progress
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))))
3063     (sr-md5 nil)
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"
3068              (length file-list1)
3069              (length file-list2))
3070     (sit-for 0.2)))
3071
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 \
3075 or (c)ontents? ")
3076         (response -1))
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)))
3083     (case response
3084       (?D `(not (= mtime1 mtime2)))
3085       (?S `(not (= size1 size2)))
3086       (?N nil)
3087       (?C `(not (string= (sr-md5 file1 t) (sr-md5 file2 t))))
3088       (t `(or (not (= mtime1 mtime2)) (not (= size1 size2)))))))
3089
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."
3095   (delq
3096    nil
3097    (mapcar
3098     (lambda (file-name)
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)))))
3102     (sr-pane-files))))
3103
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
3107 displayed."
3108   (delq
3109    nil
3110    (if (eq major-mode 'sr-virtual-mode)
3111        (sr-buffer-files (current-buffer))
3112      (directory-files default-directory))))
3113
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)))
3126            (md5-command))
3127       (unless md5-digest
3128         (setq md5-command
3129               (replace-regexp-in-string
3130                "%f" (format "\"%s\"" filename) sr-md5-shell-command))
3131         (setq md5-digest (shell-command-to-string md5-command))
3132         (if memoize
3133             (push (cons filename md5-digest) sr-md5)))
3134       md5-digest)))
3135
3136 (defun sr-diff ()
3137   "Run `diff' on the top two marked files in both panes."
3138   (interactive)
3139   (eval (sr-diff-form 'diff))
3140   (sr-scrollable-viewer (get-buffer "*Diff*")))
3141
3142 (defun sr-ediff ()
3143   "Run `ediff' on the two top marked files in both panes."
3144   (interactive)
3145   (eval (sr-diff-form 'ediff)))
3146
3147 (add-hook 'ediff-before-setup-windows-hook
3148           (defun sr-ediff-before-setup-windows-function ()
3149             (setq sr-ediff-on t)))
3150
3151 (add-hook 'ediff-quit-hook
3152           (defun sr-ediff-quit-function ()
3153             (setq sr-ediff-on nil)
3154             (when sr-running
3155               (if (buffer-live-p sr-restore-buffer)
3156                   (switch-to-buffer sr-restore-buffer))
3157               (delete-other-windows)
3158               (sr-setup-windows))))
3159
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))
3163     (unless this
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))
3167       (progn
3168         (sr-change-window)
3169         (setq other (sr-pop-mark))
3170         (sr-change-window)
3171         (setq other (or other
3172                         (if (file-exists-p (concat sr-other-directory this))
3173                             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)))
3178
3179 (defun sr-pop-mark ()
3180   "Pop the first mark in the current Dired buffer."
3181   (let ((result nil))
3182     (condition-case description
3183       (save-excursion
3184         (goto-char (point-min))
3185         (dired-next-marked-file 1)
3186         (setq result (dired-get-filename t t))
3187         (dired-unmark 1))
3188       (error (message (cadr description))))
3189     result))
3190
3191 ;;; ============================================================================
3192 ;;; File search & analysis functions:
3193
3194 (defun sr-process-kill ()
3195   "Kill the process running in the current buffer (if any)."
3196   (interactive)
3197   (let ((proc (get-buffer-process (current-buffer))))
3198     (and proc (eq (process-status proc) 'run)
3199          (condition-case nil
3200              (delete-process proc)
3201            (error nil)))))
3202
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)
3206                          map)
3207   "Local map used in Sunrise panes during find and locate operations.")
3208
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."
3214   (rename-uniquely)
3215   (when find-items
3216     (let ((items-len (length find-items))
3217           (max-items-len (window-width))
3218           (inhibit-read-only t))
3219       (goto-char (point-min))
3220       (forward-line 1)
3221       (when (re-search-forward "find \." nil t)
3222         (if (> items-len max-items-len)
3223             (setq find-items
3224                   (concat (substring find-items 0 max-items-len) " ...")))
3225         (replace-match (format "find %s" find-items)))))
3226   (sr-beginning-of-buffer)
3227   (sr-highlight)
3228   (hl-line-mode 1)
3229   (message (propertize "Sunrise find (C-c C-k to kill)"
3230                        'face 'minibuffer-prompt)))
3231
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) " {} ;" " \\{\\} \\;"))
3235          (find-ls-option
3236           (cons
3237            (concat "-exec ls -d " sr-virtual-listing-switches suffix)
3238            "ls -ld"))
3239          (sr-find-items (sr-quote-marked)) (dir))
3240     (when sr-find-items
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))))
3245     (sr-save-aspect
3246      (sr-alternate-buffer (apply fun (list default-directory pattern)))
3247      (sr-virtual-mode)
3248      (use-local-map sr-process-map)
3249      (sr-keep-buffer))
3250     (run-with-idle-timer 0.01 nil 'sr-find-decorate-buffer sr-find-items)))
3251
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))
3256
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))
3261
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
3269                      " "
3270                      (read-string "Additional Grep Options: "))
3271          find-grep-options)))
3272     (sr-find-apply 'find-grep-dired pattern)))
3273
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
3278 abort."
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)
3283
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)
3293     ad-do-it))
3294 (ad-activate 'find-dired-filter)
3295
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))
3309       (when sr-find-items
3310         (setcar args (replace-regexp-in-string
3311                       "find \." (format "find %s" sr-find-items) (car args)))))
3312     (apply operation args)))
3313
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
3317 pane."
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)))
3321   (case mode
3322     (?E (sr-find-name "*"))
3323     (?D (sr-find "-type d"))
3324     (?N (sr-find "-not -type d"))
3325     (?F (sr-find "-type f"))))
3326
3327 (defun sr-prune-paths (regexp)
3328   "Kill all lines (only the lines) in the current pane matching REGEXP."
3329   (interactive "sPrune paths matching: ")
3330   (save-excursion
3331     (sr-beginning-of-buffer)
3332     (while (if (string-match regexp (dired-get-filename t))
3333                (dired-kill-line)
3334              (dired-next-line 1)))))
3335
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))
3341            (beg (point-max)))
3342        (set-buffer ,locate-buffer)
3343        (save-excursion
3344          (mapc (lambda (x)
3345                  (when (and (string-match search-regexp x) (file-exists-p x))
3346                    (goto-char (point-max))
3347                    (insert-char 32 2)
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)))))
3351
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)
3360        (forward-char -1)
3361        (insert " at " (substring (current-time-string) 0 19))
3362        (forward-char 1))
3363      (sr-beginning-of-buffer)
3364      (sr-highlight)
3365      (hl-line-mode 1)))
3366
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)))
3371
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."
3376   (interactive
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))
3381     (sr-save-aspect
3382      (sr-alternate-buffer (switch-to-buffer locate-buffer))
3383      (cd "/")
3384      (insert "  " default-directory ":")(newline)
3385      (insert " Results of: " locate-command " " search-string)(newline)
3386      (sr-virtual-mode)
3387      (set-process-filter
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))))
3395
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')."
3404   (interactive)
3405   (when sr-running
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))
3411         (sr-backup-buffer)
3412         (while next-char
3413           (case next-char
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))
3418             ((?\b ?\d)
3419              (revert-buffer)
3420              (setq stack (cdr stack) filter (caar stack) regex (cdar stack))
3421              (unless stack (setq next-char nil)))
3422             (t
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))))
3434           (when next-char
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 ?*))))
3440
3441 (defun sr-recent-files ()
3442   "Display the history of recent files in Sunrise virtual mode."
3443   (interactive)
3444   (if (not (featurep 'recentf))
3445       (error "ERROR: Feature recentf not available!"))
3446
3447   (sr-save-aspect
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)
3452        (condition-case nil
3453            (insert-directory file sr-virtual-listing-switches nil nil)
3454          (error (ignore))))
3455      (sr-virtual-mode)
3456      (sr-keep-buffer))))
3457
3458 (defun sr-recent-directories ()
3459   "Display the history of directories recently visited in the current pane."
3460   (interactive)
3461   (sr-save-aspect
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"))
3468      (dolist (dir hist)
3469        (condition-case nil
3470            (when dir
3471              (setq dir (sr-chop ?/ (expand-file-name dir)))
3472              (insert-directory dir switches nil nil))
3473          (error (ignore))))
3474      (sr-virtual-mode))))
3475
3476 (defun sr-switch-to-clean-buffer (name)
3477   (sr-alternate-buffer (switch-to-buffer name))
3478   (erase-buffer))
3479
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."
3484   (interactive "P")
3485   (if passive
3486       (progn
3487         (sr-synchronize-panes)
3488         (sr-in-other (sr-pure-virtual nil)))
3489     (sr-save-aspect
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)
3496        (sr-virtual-mode)
3497        (sr-keep-buffer)))))
3498
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))
3502     (condition-case nil
3503         (progn
3504           (sr-quit)
3505           (switch-to-buffer buff)
3506           (call-interactively dired-fun)
3507           (replace-buffer-in-windows buff)
3508           (sr-bury-panes))
3509       (quit
3510        (when orig (switch-to-buffer orig))
3511        (sunrise)))))
3512
3513 (defun sr-do-query-replace-regexp ()
3514   "Force Sunrise to quit before executing `dired-do-query-replace-regexp'."
3515   (interactive)
3516   (sr-dired-do-apply 'dired-do-query-replace-regexp))
3517
3518 (defun sr-do-search ()
3519   "Force Sunrise to quit before executing `dired-do-search'."
3520   (interactive)
3521   (sr-dired-do-apply 'dired-do-search))
3522
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)))
3527
3528 (defvar sr-sticky-isearch-commands
3529   '(nil
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.")
3536
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))))
3550
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
3555 file)."
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)
3559   (if backward
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))
3564
3565 (defun sr-sticky-isearch-forward ()
3566   "Start a sticky forward search in the current pane."
3567   (interactive)
3568   (sr-sticky-isearch))
3569
3570 (defun sr-sticky-isearch-backward ()
3571   "Start a sticky backward search in the current pane."
3572   (interactive)
3573   (sr-sticky-isearch t))
3574
3575 (defun sr-sticky-post-isearch ()
3576   "`isearch-mode-end-hook' function for Sunrise sticky Isearch operations."
3577   (and
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))
3584             (progn
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)
3588               (isearch-done)
3589               (if isearch-mode-end-hook-quit
3590                   (run-hooks 'sr-refresh-hook)
3591                 (sr-find-file filename))))
3592            (t
3593             (progn
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)))))))
3598
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."
3605   (interactive "P")
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))
3610     (if (>= 1 items)
3611         (progn
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)
3617           (message
3618            "%s (%s bytes)"
3619            (replace-regexp-in-string regex label (current-message)) size))
3620       (message "%s bytes in %d selected items" size items))
3621     (sit-for 0.5)))
3622
3623 (eval-when-compile
3624   (defsubst sr-size-attr (file)
3625     "Helper function for `sr-files-size'."
3626     (float (or (nth 7 (file-attributes file)) 0))))
3627
3628 (defun sr-files-size (files)
3629   "Recursively calculate the total size of all FILES.
3630 FILES should be a list of paths."
3631   (let ((result 0))
3632     (mapc
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)))))
3639              files))
3640     result))
3641
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)))
3645
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)))
3651          result)
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)))
3656     result))
3657
3658 ;;; ============================================================================
3659 ;;; TI (Terminal Integration) and CLEX (Command Line EXpansion) functions:
3660
3661 ;;;###autoload
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'."
3669   (interactive)
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))
3679       (hl-line-mode 1))
3680   (if (string= program "eshell")
3681       (sr-term-eshell cd newterm)
3682     (sr-term-extern cd newterm program)))
3683
3684 ;;;###autoload
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."
3688   (interactive)
3689   (sr-term t))
3690
3691 ;;;###autoload
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."
3695   (interactive)
3696   (sr-term t t))
3697
3698 ;;;###autoload
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))
3703
3704 (defmacro sr-term-excursion (newterm form &optional is-external)
3705   "Take care of the common mechanics of launching or switching to a terminal.
3706 Helper macro."
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)
3713      (if (not new-term)
3714          (switch-to-buffer next-buffer)
3715        (when 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)))))
3719        ,form
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)
3723          (rename-uniquely)
3724          (setq new-name (buffer-name))
3725          ,form)
3726        (when new-name
3727          (message "Sunrise: previous terminal renamed to %s" new-name))
3728        (push (current-buffer) sr-ti-openterms))))
3729
3730 (defun sr-term-line-mode ()
3731   "Switch the current terminal to line mode.
3732 Apply additional Sunrise keybindings for terminal integration."
3733   (interactive)
3734   (term-line-mode)
3735   (sr-term-line-minor-mode 1))
3736
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."
3740   (interactive)
3741   (term-char-mode)
3742   (sr-term-line-minor-mode 0)
3743   (sr-term-char-minor-mode 1))
3744
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)
3756     (sr-term-char-mode)
3757     (when (or line-mode (term-in-line-mode))
3758       (sr-term-line-mode))
3759     (when cd
3760       (term-send-raw-string
3761        (concat "cd " (shell-quote-wildcard-pattern dir) "
3762 ")))))
3763
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))
3769     (when cd
3770       (insert (concat "cd " (shell-quote-wildcard-pattern dir)))
3771       (eshell-send-input))
3772     (sr-term-line-mode)))
3773
3774 (defmacro sr-ti (form)
3775   "Evaluate FORM in the context of the selected pane.
3776 Helper macro for implementing terminal integration in Sunrise."
3777   `(if sr-running
3778        (progn
3779          (sr-select-window sr-selected-window)
3780          (hl-line-unhighlight)
3781          (unwind-protect
3782              ,form
3783            (when sr-running
3784              (sr-select-viewer-window))))))
3785
3786 (defun sr-ti-previous-line ()
3787   "Move one line backward on active pane from the terminal window."
3788   (interactive)
3789   (sr-ti (forward-line -1)))
3790
3791 (defun sr-ti-next-line ()
3792   "Move one line forward on active pane from the terminal window."
3793   (interactive)
3794   (sr-ti (forward-line 1)))
3795
3796 (defun sr-ti-select ()
3797   "Run `dired-advertised-find-file' on active pane from the terminal window."
3798   (interactive)
3799   (sr-ti (sr-advertised-find-file)))
3800
3801 (defun sr-ti-mark ()
3802   "Run `dired-mark' on active pane from the terminal window."
3803   (interactive)
3804   (sr-ti (dired-mark 1)))
3805
3806 (defun sr-ti-unmark ()
3807   "Run `dired-unmark-backward' on active pane from the terminal window."
3808   (interactive)
3809   (sr-ti (dired-unmark-backward 1)))
3810
3811 (defun sr-ti-prev-subdir (&optional count)
3812   "Run `dired-prev-subdir' on active pane from the terminal window."
3813   (interactive "P")
3814   (let ((count (or count 1)))
3815     (sr-ti (sr-dired-prev-subdir count))))
3816
3817 (defun sr-ti-unmark-all-marks ()
3818   "Remove all marks on active pane from the terminal window."
3819   (interactive)
3820   (sr-ti (dired-unmark-all-marks)))
3821
3822 (defun sr-ti-change-window ()
3823   "Switch focus to the currently active pane."
3824   (interactive)
3825   (sr-select-window sr-selected-window))
3826
3827 (defun sr-ti-change-pane ()
3828   "Change selection of active pane to passive one."
3829   (interactive)
3830   (sr-ti (sr-change-window)))
3831
3832 (add-hook
3833  'kill-buffer-hook
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))))
3837
3838 (defun sr-ti-revert-buffer ()
3839   "Refresh the currently active pane."
3840   (interactive)
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)))))
3845
3846 (defun sr-ti-lock-panes ()
3847   "Resize and lock the panes at standard position from the command line."
3848   (interactive)
3849   (sr-ti (sr-lock-panes)))
3850
3851 (defun sr-ti-min-lock-panes ()
3852   "Minimize the panes from the command line."
3853   (interactive)
3854   (sr-ti (sr-min-lock-panes)))
3855
3856 (defun sr-ti-max-lock-panes ()
3857   "Maximize the panes from the command line."
3858   (interactive)
3859   (sr-ti (sr-max-lock-panes)))
3860
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)))
3867      ,form))
3868
3869 (defun sr-clex-marked (pane)
3870   "Return a string containing the list of marked files in PANE."
3871   (sr-clex
3872    pane
3873    (mapconcat 'shell-quote-wildcard-pattern (dired-get-marked-files) " ")))
3874
3875 (defun sr-clex-file (pane)
3876   "Return the file currently selected in PANE."
3877   (sr-clex
3878    pane
3879    (concat (shell-quote-wildcard-pattern (dired-get-filename)) " ")))
3880
3881 (defun sr-clex-marked-nodir (pane)
3882   "Return a list of basenames of all the files currently marked in PANE."
3883   (sr-clex
3884    pane
3885    (mapconcat 'shell-quote-wildcard-pattern
3886               (dired-get-marked-files 'no-dir) " ")))
3887
3888 (defun sr-clex-dir (pane)
3889   "Return the current directory of the given pane."
3890   (sr-clex
3891    pane
3892    (concat (shell-quote-wildcard-pattern default-directory) " ")))
3893
3894 (defun sr-clex-start ()
3895   "Start a new CLEX operation.
3896 Puts `sr-clex-commit' into local `after-change-functions'."
3897   (interactive)
3898   (if sr-clex-on
3899       (progn
3900         (setq sr-clex-on nil)
3901         (delete-overlay sr-clex-hotchar-overlay))
3902     (progn
3903       (insert-char ?% 1)
3904       (if sr-running
3905           (progn
3906             (add-hook 'after-change-functions 'sr-clex-commit nil t)
3907             (setq sr-clex-on t)
3908             (setq sr-clex-hotchar-overlay (make-overlay (point) (1- (point))))
3909             (overlay-put sr-clex-hotchar-overlay 'face 'sr-clex-hotchar-face)
3910             (message
3911              "Sunrise: CLEX is now ON for keys: m f n d a p M F N D A P %%"))))))
3912
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'."
3917   (interactive)
3918   (if sr-clex-on
3919       (progn
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)))
3936                             (t nil))))
3937           (if expansion
3938               (progn
3939                 (delete-char -2)
3940                 (insert expansion)))))))
3941
3942 (define-minor-mode sr-term-char-minor-mode
3943   "Sunrise Commander terminal add-on for character (raw) mode."
3944   nil nil
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)
3948     ("\C-ct"    . sr-term)
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)))
3956
3957 (define-minor-mode sr-term-line-minor-mode
3958   "Sunrise Commander terminal add-on for line (cooked) mode."
3959   nil nil
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)
3978     ("\C-ct"       . sr-term)
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))
3989   :group 'sunrise)
3990
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)))
3997         ad-do-it
3998         (bury-buffer buffer)
3999         (kill-buffer buffer))
4000     ad-do-it))
4001
4002 ;;; ============================================================================
4003 ;;; Desktop support:
4004
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))))))
4014
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)
4018     (apply
4019      'append
4020      (delq nil
4021            (list
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))))
4031
4032 (defun sr-desktop-restore-buffer (desktop-buffer-file-name
4033                                   desktop-buffer-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))
4039          (buffer
4040           (if (not is-virtual)
4041               (with-current-buffer
4042                   (dired-restore-desktop-buffer desktop-buffer-file-name
4043                                                 desktop-buffer-name
4044                                                 misc-data)
4045                 (sr-mode)
4046                 (current-buffer))
4047             (desktop-restore-file-buffer (car misc-data)
4048                                          desktop-buffer-name
4049                                          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)))
4056             '(left right))
4057       (mapc (lambda (fun)
4058               (funcall fun
4059                        desktop-buffer-file-name
4060                        desktop-buffer-name
4061                        desktop-buffer-misc))
4062             sr-desktop-restore-handlers))
4063     buffer))
4064
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))
4071   nil)
4072
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))
4078
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))
4086                 (sunrise))))
4087
4088 ;;; ============================================================================
4089 ;;; Miscellaneous functions:
4090
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
4094     (save-excursion
4095       (let ((result nil))
4096         (sr-beginning-of-buffer)
4097         (while (not (eobp))
4098           (setq result (cons (dired-get-filename t t) result))
4099           (forward-line 1))
4100         (reverse result)))))
4101
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
4107 layout switching."
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))))
4111
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)
4116   (if 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")))
4118
4119 (defun sr-describe-mode ()
4120   "Call `describe-mode' and make the resulting buffer C-M-v scrollable."
4121   (interactive)
4122   (describe-mode)
4123   (sr-scrollable-viewer (get-buffer "*Help*"))
4124   (sr-select-window sr-selected-window))
4125
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) "/"))))
4130
4131 (defun sr-summary ()
4132   "Summarize basic Sunrise commands and show recent Dired errors."
4133   (interactive)
4134   (dired-why)
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"))
4137
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)
4146       (goto-char point)
4147       (select-window this-win))))
4148
4149 (defun sr-mark-toggle ()
4150   "Toggle the mark on the current file or directory."
4151   (interactive)
4152   (when (dired-get-filename t t)
4153     (if (eq ?  (char-after (line-beginning-position)))
4154         (dired-mark 1)
4155       (dired-unmark 1))))
4156
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)
4163             tail (cdr tail)))
4164     found))
4165
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)
4170         (setq marked nil)
4171       (if (eq t (car marked)) (setq marked (cdr marked)))
4172       (format "\"%s\"" (mapconcat 'identity marked "\" \"")))))
4173
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."
4177   (mapc (lambda (sym)
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)))
4181             (set sym 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)
4185
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)))
4191   path)
4192
4193 ;;; ============================================================================
4194 ;;; Advice
4195
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."
4200   (if function
4201       (progn (ad-enable-advice function 'any regexp)
4202              (ad-activate function))
4203     (ad-enable-regexp regexp)
4204     (ad-activate-regexp regexp)))
4205
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."
4210   (if function
4211       (progn (ad-disable-advice function 'any regexp)
4212              (ad-update function))
4213     (ad-disable-regexp regexp)
4214     (ad-update-regexp regexp)))
4215
4216 (defun sunrise-commander-unload-function ()
4217   (sr-ad-disable "^sr-advice-"))
4218
4219 ;;; ============================================================================
4220 ;;; Font-Lock colors & styles:
4221
4222 (defmacro sr-rainbow (symbol spec regexp)
4223   `(progn
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))))
4228
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\\)$\\)")
4235
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.*$\\)")
4244
4245 (provide 'sunrise-commander)
4246
4247 ;;; sunrise-commander.el ends here