i.ortega
/
dotfiles
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity
dotfiles/.doom.d/lisp/sunrise.el

4796 lines
197 KiB
EmacsLisp
Raw Blame History

;;; sunrise.el --- The Sunrise Commander: a two-pane file manager -*- lexical-binding: t -*-
;; Copyright (C) 2007-2015 José Alfredo Romero Latouche.
;; Author: José Alfredo Romero Latouche <escherdragon@gmail.com>
;; Štěpán Němec <stepnem@gmail.com>
;; Maintainer: José Alfredo Romero Latouche <escherdragon@gmail.com>
;; Created: 24 Sep 2007
;; Version: 6
;; Package-Requires: ((emacs "24.3") (cl-lib "0.5"))
;; Keywords: files, dired, midnight commander, norton, orthodox
;; URL: https://github.com/sunrise-commander/sunrise-commander
;; This file is not part of GNU Emacs.
;; This program is free software: you can redistribute it and/or modify it under
;; the terms of the GNU General Public License as published by the Free Software
;; Foundation, either version 3 of the License, or (at your option) any later
;; version.
;;
;; This program is distributed in the hope that it will be useful, but WITHOUT
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
;; FOR A PARTICULAR PURPOSE. See the GNU General Public License for more de-
;; tails.
;; You should have received a copy of the GNU General Public License along with
;; this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; The Sunrise Commander is a double-pane file manager for Emacs. It's built
;; atop of Dired and takes advantage of all its power, but also provides many
;; handy features of its own:
;; * Sunrise is implemented as a derived major mode confined inside the pane
;; buffers, so its buffers and Dired ones can live together without easymenu or
;; viper to avoid key binding collisions.
;; * It automatically closes unused buffers and tries to never keep open more
;; than the one or two used to display the panes, though this behavior may be
;; disabled if desired.
;; * Each pane has its own history stack: press M-y / M-u for moving backwards /
;; forwards in the history of directories.
;; * Press M-t to swap (transpose) the panes.
;; * Press C-= for "smart" file comparison using `ediff'. It compares together
;; the first two files marked on each pane or, if no files have been marked, it
;; assumes that the second pane contains a file with the same name as the
;; selected one and tries to compare these two. You can also mark whole lists of
;; files to be compared and then just press C-= for comparing the next pair.
;; * Press = for fast "smart" file comparison -- like above, but using regular
;; diff.
;; * Press C-M-= for directory comparison (by date / size / contents of files).
;; * Press C-c C-s to change the layout of the panes (horizontal/vertical/top)
;; * Press C-c / to interactively refine the contents of the current pane using
;; fuzzy (a.k.a. flex) matching, then:
;; - press Delete or Backspace to revert the buffer to its previous state
;; - press Return, C-n or C-p to exit and accept the current narrowed state
;; - press Esc or C-g to abort the operation and revert the buffer
;; - use ! to prefix characters that should NOT appear after a given position
;; Once narrowed and accepted, you can restore the original contents of the pane
;; by pressing g (revert-buffer).
;; * Sticky search: press C-c s to launch an interactive search that will remain
;; active from directory to directory, until you hit a regular file or press C-g
;; * Press C-x C-q to put the current pane in Editable Dired mode (allows to
;; edit the pane as if it were a regular file -- press C-c C-c to commit your
;; changes to the filesystem, or C-c C-k to abort).
;; * Press y to recursively calculate the total size (in bytes) of all files and
;; directories currently selected/marked in the active pane.
;; * Sunrise VIRTUAL mode integrates dired-virtual mode to Sunrise, allowing to
;; capture grep, find and locate results in regular files and to use them later
;; as if they were directories with all the Dired and Sunrise operations at your
;; fingertips.
;;
;; * The results of the following operations are displayed in VIRTUAL mode:
;; - find-name-dired (press C-c C-n),
;; - find-dired (press C-c C-f),
;; - grep (press C-c C-g),
;; - locate (press C-c C-l),
;; - list all recently visited files (press C-c C-r -- requires recentf),
;; - list all directories in active pane's history ring (press C-c C-d).
;; * Supports AVFS (http://avf.sourceforge.net/) for transparent navigation
;; inside compressed archives (*.zip, *.tgz, *.tar.bz2, *.deb, etc. etc.)
;; You need to have AVFS with coda or fuse installed and running on your system
;; for this to work, though.
;; * Opening terminals directly from Sunrise:
;; - Press C-c C-t to inconditionally open a new terminal into the currently
;; selected directory in the active pane.
;; - Use C-c t to switch to the last opened terminal, or (when already inside
;; a terminal) to cycle through all open terminals.
;; - Press C-c T to switch to the last opened terminal and change directory
;; to the one in the current directory.
;; - Press C-c M-t to be prompted for a program name, and then open a new
;; terminal using that program into the currently selected directory
;; (eshell is a valid value; if no program can be found with the given name
;; then the value of `sunrise-terminal-program' is used instead).
;; * Terminal integration and Command line expansion: integrates tightly with
;; `eshell' and `term-mode' to allow interaction between terminal emulators in
;; line mode (C-c C-j) and the panes: the most important navigation commands
;; (up, down, mark, unmark, go to parent dir) can be executed on the active pane
;; directly from the terminal by pressing the usual keys with Meta: <M-up>,
;; <M-down>, etc. Additionally, the following substitutions are automagically
;; performed in `eshell' and `term-line-mode':
;; %f - expands to the currently selected file in the left pane
;; %F - expands to the currently selected file in the right pane
;; %m - expands to the list of paths of all marked files in the left pane
;; %M - expands to the list of paths of all marked files in the right pane
;; %n - expands to the list of names of all marked files in the left pane
;; %N - expands to the list of names of all marked files in the right pane
;; %d - expands to the current directory in the left pane
;; %D - expands to the current directory in the right pane
;; %a - expands to the list of paths of all marked files in the active pane
;; %A - expands to the current directory in the active pane
;; %p - expands to the list of paths of all marked files in the passive pane
;; %P - expands to the current directory in the passive pane
;; * Cloning of complete directory trees: press K to clone the selected files
;; and directories into the passive pane. Cloning is a more general operation
;; than copying, in which all directories are recursively created with the same
;; names and structures at the destination, while what happens to the files
;; within them depends on the option you choose:
;; - "(F)ile System of..." clones the FS structure of paths in a VIRTUAL pane,
;; - "(D)irectories only" ignores all files, copies only directories,
;; - "(C)opies" performs a regular recursive copy of all files and dirs,
;; - "(H)ardlinks" makes every new file a (hard) link to the original one
;; - "(S)ymlinks" creates absolute symbolic links for all files in the tree,
;; - "(R)elative symlinks” creates relative symbolic links.
;; * Passive navigation: the usual navigation keys (n, p, Return, U, ;) combined
;; with Meta allow to move across the passive pane without actually having to
;; switch to it.
;; * Synchronized navigation: press C-c C-z to enable / disable synchronized
;; navigation. In this mode, the passive navigation keys (M-n, M-p, M-Return,
;; etc.) operate on both panes simultaneously. I've found this quite useful for
;; comparing hierarchically small to medium-sized directory trees (for large to
;; very large directory trees one needs something on the lines of diff -r
;; though).
;; * And much more -- press ? while in Sunrise mode for basic help, or h for a
;; complete list of all keybindings available (use C-e and C-y to scroll).
;; There is no help window like in MC, but if you really miss it, just get and
;; install the sunrise-buttons extension.
;; A lot of this code was once adapted from Kevin Burton's mc.el, but it has
;; evolved considerably since then. Another part (the code for file copying and
;; renaming) derives originally from the Dired extensions written by Kurt
;; Nørmark for LAML (http://www.cs.aau.dk/~normark/scheme/distribution/laml/).
;; It's written on GNU Emacs 25 on Linux and tested on GNU Emacs 22, 23, 24 and
;; 25 for Linux and on EmacsW32 (version 23) for Windows. I have also received
;; feedback from users reporting it works OK on the Mac. It does not work either
;; on GNU Emacs 21 or XEmacs -- please drop me a line if you would like to help
;; porting it. All contributions and/or bug reports will be very welcome.
;; For more details on the file manager, several available extensions and many
;; cool tips & tricks visit http://www.emacswiki.org/emacs/Sunrise_Commander
;;; Installation and Usage:
;; 1) Put this file somewhere in your Emacs `load-path'.
;; 2) Add a (require 'sunrise) to your .emacs file.
;; 3) Choose some unused extension for files to be opened in Sunrise VIRTUAL
;; mode and add it to `auto-mode-alist', e.g. if you want to name your virtual
;; directories like *.svrm just add to your .emacs file a line like the
;; following:
;;
;; (add-to-list 'auto-mode-alist '("\\.srvm\\'" . sunrise-virtual-mode))
;; 4) Evaluate the new lines, or reload your .emacs file, or restart Emacs.
;; 5) Type M-x sunrise to invoke the Sunrise Commander (or much better: bind the
;; function to your favorite key combination). The command `sunrise-cd' invokes
;; Sunrise and automatically selects the current file wherever it is in the
;; filesystem. Type h at any moment for information on available key bindings.
;; 6) Type M-x customize-group <RET> sunrise <RET> to customize options, fonts
;; and colors (activate AVFS support here, too).
;; 7) Enjoy :)
;;; Code:
(eval-when-compile
(require 'cl-lib)
(require 'recentf))
(require 'advice)
(require 'desktop)
(require 'dired)
(require 'dired-aux)
(require 'dired-x)
(require 'enriched)
(require 'esh-mode)
(require 'find-dired)
(require 'font-lock)
(require 'hl-line)
(require 'sort)
(require 'term)
(require 'tramp)
(defgroup sunrise nil
"The Sunrise Commander File Manager."
:group 'files)
(defcustom sunrise-show-file-attributes t
"Whether to initially display file attributes in Sunrise panes.
You can always toggle file attributes display pressing
\\<sunrise-mode-map>\\[sunrise-toggle-attributes]."
:group 'sunrise
:type 'boolean)
(defcustom sunrise-show-hidden-files nil
"Whether to initially display hidden files in Sunrise panes.
You can always toggle hidden files display pressing
\\<sunrise-mode-map>\\[dired-omit-mode].
You can also customize what files are considered hidden by setting
`dired-omit-files' and `dired-omit-extensions' in your .emacs file."
:group 'sunrise
:type 'boolean)
(defcustom sunrise-visit-buffer-function 'sunrise-visit-buffer-in-current-frame
"Determines how newly opened buffers are to be displayed.
The following options are supported:
* Visit in current frame - Quit Sunrise and display the new
buffer in the current frame.
* Visit in dedicated frame - Create a separate dedicated frame
and display the buffer in it. The frame will be automatically
destroyed when the buffer is killed.
* Other - Provide your own function to display the given buffer."
:group 'sunrise
:type '(choice
(function-item :tag "Visit in current frame" sunrise-visit-buffer-in-current-frame)
(function-item :tag "Visit in dedicated frame" special-display-popup-frame)
(function :tag "Other")))
(defcustom sunrise-terminal-kill-buffer-on-exit t
"If non-nil, kill terminal buffers after their shell process ends."
:group 'sunrise
:type 'boolean)
(defcustom sunrise-terminal-program "eshell"
"The program to use for terminal emulation.
If this value is set to \"eshell\", the Emacs shell (`eshell')
will be used."
:group 'sunrise
:type 'string)
(defcustom sunrise-listing-switches "-al"
"Listing switches passed to `ls' when building Sunrise buffers.
\(Cf. `dired-listing-switches'.)
Most portable value: -al
Recommended value on GNU systems: \
--time-style=locale --group-directories-first -alDhgG"
:group 'sunrise
:type 'string)
(defcustom sunrise-virtual-listing-switches "-ald"
"Listing switches for building buffers in `sunrise-virtual-mode'.
Should not contain the -D option. See also `sunrise-listing-switches'."
:group 'sunrise
:type 'string)
(defun sunrise-set-cursor-follows-mouse (symbol value)
"Helper for `sunrise-cursor-follows-mouse' custom option.
Set SYMBOL to VALUE whenever the option is set."
(mapc (lambda (buf)
(with-current-buffer buf
(when (memq major-mode
'(sunrise-mode
sunrise-tree-mode
sunrise-virtual-mode))
(setq track-mouse value))))
(buffer-list))
(set-default symbol value))
(defcustom sunrise-cursor-follows-mouse t
"Whether text cursor inside Sunrise panes follows mouse cursor.
The mouse is only followed in graphical environments."
:group 'sunrise
:type 'boolean
:set 'sunrise-set-cursor-follows-mouse)
(defcustom sunrise-mouse-events-threshold 10
"Minimum number of mouse movement events before cursor follows mouse.
Helps avoid accidentally capturing the text cursor when Sunrise
is activated."
:group 'sunrise
:type 'integer)
(defcustom sunrise-avfs-root nil
"Root of AVFS virtual filesystem used to navigate compressed archives.
Setting this option activates AVFS support."
:group 'sunrise
:type '(choice
(const :tag "AVFS support disabled" nil)
(const :tag "~/.avfs (default mountavfs mount point)" "~/.avfs")
(directory :tag "Other AVFS root directory")))
(defcustom sunrise-avfs-handlers-alist '(("\\.[jwesh]ar$" . "#uzip/")
("\\.wsar$" . "#uzip/")
("\\.xpi$" . "#uzip/")
("\\.apk$" . "#uzip/")
("\\.iso$" . "#iso9660/")
("\\.patch$" . "#/")
("\\.txz$" . "#/")
("." . "#/"))
"List of AVFS handlers to manage specific file extensions."
:group 'sunrise
:type 'alist)
(defcustom sunrise-md5-shell-command "md5sum %f | cut -d' ' -f1 2>/dev/null"
"Shell command to use for calculating MD5 sums for files.
Used when comparing directories using the ``(c)ontents'' option.
Use %f as a placeholder for the name of the file."
:group 'sunrise
:type 'string)
(defcustom sunrise-window-split-style 'horizontal
"The current window split configuration.
May be `horizontal', `vertical' or `top'."
:group 'sunrise
:type '(choice
(const horizontal)
(const vertical)
(const top)))
(defcustom sunrise-windows-locked t
"When non-nil, vertical size of the panes will remain constant."
:group 'sunrise
:type 'boolean)
(defun sunrise-set-windows-default-ratio (symbol value)
"Helper for `sunrise-windows-default-ratio' custom option.
Set SYMBOL to VALUE whenever the option is set."
(if (and (integerp value) (>= value 0) (<= value 100))
(set-default symbol value)
(error "Invalid value: %s" value)))
(defcustom sunrise-windows-default-ratio 66
"Percentage of frame height to use for Sunrise panes by default."
:group 'sunrise
:type 'integer
:set 'sunrise-set-windows-default-ratio)
(defcustom sunrise-history-length 20
"Number of entries to keep in each pane's history rings."
:group 'sunrise
:type 'integer)
(defcustom sunrise-kill-unused-buffers t
"If non-nil, kill Sunrise buffers no longer shown in any pane."
:group 'sunrise
:type 'boolean)
(defcustom sunrise-kill-quick-view-buffers t
"If non-nil, kill prior quick-view buffers when opening a new one."
:group 'sunrise
:type 'boolean)
(defcustom sunrise-confirm-kill-viewer t
"If non-nil, confirm before killing a quick-view buffer."
:group 'sunrise
:type 'boolean)
(defcustom sunrise-attributes-display-mask nil
"Contols hiding/transforming columns with `sunrise-toggle-attributes'.
If set, its value must be a list of symbols, one for each
attributes column. If the symbol is nil, then the corresponding
column will be hidden, and if it's not nil then the column will
be left untouched. The symbol may also be the name of a function
that takes one string argument and evaluates to a different
string -- in this case this function will be used to transform
the contents of the corresponding column and its result will be
displayed instead."
:group 'sunrise
:type '(repeat symbol))
(defcustom sunrise-fast-backup-extension ".bak"
"Extension for files created by `sunrise-fast-backup-files' (@!).
This can be either a string or an Lisp form to be evaluated at
run-time."
:group 'sunrise
:type '(choice
(string :tag "Literal text")
(sexp :tag "Symbolic expression")))
(defcustom sunrise-traditional-other-window nil
"If non-nil, focus selected pane when switching from non-Sunrise windows.
By default, Sunrise modifies the behavior of Emacs `other-window'
command so that focus is always given to the currently selected
pane when switching to any Sunrise window from a non-Sunrise
window. If you'd prefer the default Emacs behavior instead, set
this flag to t."
:group 'sunrise
:type 'boolean)
(defcustom sunrise-fuzzy-negation-character ?!
"Character to use for negating patterns when fuzzy-narrowing a pane."
:group 'sunrise
:type '(choice
(const :tag "Fuzzy matching negation disabled" nil)
(character :tag "Fuzzy matching negation character" ?!)))
;;;###autoload
(defcustom sunrise-mode-hook nil
"Run at the very end of `sunrise-mode'."
:group 'sunrise
:type 'hook)
(defcustom sunrise-init-hook nil
"List of functions to be called before the Sunrise panes are displayed."
:group 'sunrise
:type 'hook
:options '(auto-insert))
(defcustom sunrise-start-hook nil
"List of functions to be called after the Sunrise panes are displayed."
:group 'sunrise
:type 'hook
:options '(auto-insert))
(defcustom sunrise-refresh-hook nil
"List of functions to be called every time a pane is refreshed."
:group 'sunrise
:type 'hook
:options '(auto-insert))
(defcustom sunrise-quit-hook nil
"List of functions to be called after the Sunrise panes are hidden."
:group 'sunrise
:type 'hook
:options '(auto-insert))
(defcustom sunrise-recursive-grep-supported t
"If non-nil, `sunrise-grep-command' supports the \"-r\" recursive flag."
:group 'sunrise
:type 'boolean)
(defcustom sunrise-grep-command "grep"
"Full path to the grep command for Sunrise to use.
In contrast to Emacs' own `grep-command', this one does not
support any options."
:group 'sunrise
:type 'string)
(defvar sunrise-restore-buffer nil
"Buffer to restore when Sunrise quits.")
(defvar sunrise-prior-window-configuration nil
"Window configuration before Sunrise was started.")
(defvar sunrise-running nil
"Non-nil when Sunrise Commander is running.")
(defvar sunrise-synchronized nil
"Non-nil when synchronized navigation is on.")
(defvar sunrise-current-window-overlay nil
"Holds the current overlay which marks the current Dired buffer.")
(defvar sunrise-clex-hotchar-overlay nil
"Overlay used to highlight the hot character (%) during CLEX operations.")
(defvar sunrise-left-directory "~/"
"Dired directory for the left window. See variable `dired-directory'.")
(defvar sunrise-left-buffer nil
"Dired buffer for the left window.")
(defvar sunrise-left-window nil
"The left window of Dired.")
(defvar sunrise-right-directory "~/"
"Dired directory for the right window. See variable `dired-directory'.")
(defvar sunrise-right-buffer nil
"Dired buffer for the right window.")
(defvar sunrise-right-window nil
"The right window of Dired.")
(defvar sunrise-current-frame nil
"The frame Sunrise is active on (if any).")
(defvar sunrise-this-directory "~/"
"Dired directory in the active pane.
This isn't necessarily the same as `dired-directory'.")
(defvar sunrise-other-directory "~/"
"Dired directory in the passive pane.")
(defvar sunrise-selected-window 'left
"The window to select when Sunrise starts up.")
(defvar sunrise-selected-window-width nil
"The width the selected window should have on startup.")
(defvar sunrise-history-registry '((left) (right))
"Registry of visited directories for both panes.")
(defvar sunrise-history-stack '((left 0 . 0) (right 0 . 0))
"History stack counters.
The first counter on each side tracks (by value) the absolute
depth of the stack and (by sign) the direction it is currently
being traversed. The second counter points at the position of the
element that is immediately beneath the top of the stack.")
(defvar sunrise-ti-openterms nil
"Stack of currently open terminal buffers.")
(defvar sunrise-ediff-on nil
"Flag that indicates whether an `ediff' is being currently done.")
(defvar sunrise-clex-on nil
"Flag that indicates that a CLEX operation is taking place.")
(defvar-local sunrise-virtual-buffer nil
"If non-nil, the current buffer was originally in Sunrise virtual mode.")
(defvar sunrise-dired-directory ""
"Directory inside which `sunrise-mode' is currently active.")
(defvar sunrise-start-message
"Been coding all night? Enjoy the Sunrise! (or press q to quit)"
"Message to display when Sunrise is started.")
(defvar sunrise-panes-height nil
"Current height of the pane windows.
Initial value is 2/3 the viewport height.")
(defvar-local sunrise-current-path-faces nil
"List of faces to display the path in the current pane (first wins)")
(defvar sunrise-inhibit-highlight nil
"Special variable used to temporarily inhibit highlighting in panes.")
(defvar sunrise-inhibit-switch nil
"Special variable used to inhibit switching from one pane to the other.")
(defvar sunrise-find-items nil
"Special variable used by `sunrise-find' to control the scope of find operations.")
(defvar sunrise-desktop-save-handlers nil
"List of extension-defined handlers to save Sunrise buffers with desktop.")
(defvar sunrise-desktop-restore-handlers nil
"List of extension-defined handlers to restore Sunrise buffers from desktop.")
(defvar-local sunrise-backup-buffer nil
"Variable holding a buffer-local value of the backup buffer.")
(defvar sunrise-goto-dir-function nil
"Function to use to navigate to a particular directory.
Set to nil for default behavior. The function receives one
argument DIR which is the directory to go to.")
(defvar sunrise-mouse-events-count 0
"Number of mouse movement events received since switching to Sunrise.
Used with `sunrise-mouse-events-threshold' to selectively
activate `sunrise-cursor-follows-mouse'.")
(defconst sunrise-side-lookup (list '(left . right) '(right . left))
"Trivial alist used by the Sunrise Commander to lookup its own passive side.")
(defgroup sunrise-faces nil
"Faces used by Sunrise Commander"
:group 'sunrise)
(defface sunrise-active-path-face
'((((type tty) (class color) (min-colors 8))
:background "green" :foreground "yellow" :bold t)
(((type tty) (class mono)) :inverse-video t)
(t :background "#ace6ac" :foreground "yellow" :bold t :height 120))
"Face of the directory path in the active pane."
:group 'sunrise-faces)
(defface sunrise-passive-path-face
'((((type tty) (class color) (min-colors 8) (background dark))
:background "black" :foreground "cyan")
(((type tty) (class color) (min-colors 8) (background light))
:background "white" :foreground "cyan")
(t :background "white" :foreground "lightgray" :bold t :height 120))
"Face of the directory path in the passive pane."
:group 'sunrise-faces)
(defface sunrise-editing-path-face
'((t :background "red" :foreground "yellow" :bold t :height 120))
"Face of the directory path in the active pane while in editable pane mode."
:group 'sunrise-faces)
(defface sunrise-highlight-path-face
'((t :background "yellow" :foreground "#ace6ac" :bold t :height 120))
"Face of the directory path on mouse hover."
:group 'sunrise-faces)
(defface sunrise-clex-hotchar-face
'((t :foreground "red" :bold t))
"Face of the hot character (%) in CLEX mode.
Indicates that a CLEX substitution may be about to happen."
:group 'sunrise-faces)
;;; ============================================================================
;;; This is the core of Sunrise: the main idea is to apply `sunrise-mode' only inside
;;; Sunrise buffers while keeping all of `dired-mode' untouched.
;;; preserve this variable when switching from `dired-mode' to another mode
(put 'dired-subdir-alist 'permanent-local t)
;;;###autoload
(define-derived-mode sunrise-mode dired-mode "Sunrise Commander"
"Two-pane file manager for Emacs based on Dired and inspired by MC.
The following keybindings are available:
/, j .......... go to directory
p, n .......... move cursor up/down
M-p, M-n ...... move cursor up/down in passive pane
^, J .......... go to parent directory
M-^, M-J ...... go to parent directory in passive pane
Tab ........... switch to other pane
C-Tab.......... switch to viewer window
C-c Tab ....... switch to viewer window (console compatible)
RET, f ........ visit selected file/directory
M-RET, M-f .... visit selected file/directory in passive pane
C-c RET ....... visit selected in passive pane (console compatible)
b ............. visit selected file/directory in default browser
F ............. visit all marked files, each in its own window
C-u F ......... visit all marked files in the background
o,v ........... quick visit selected file (scroll with C-M-v, C-M-S-v)
C-u o, C-u v .. kill quick-visited buffer (restores normal scrolling)
X ............. execute selected file
C-u X.......... execute selected file with arguments
+ ............. create new directory
M-+ ........... create new empty file(s)
C ............. copy marked (or current) files and directories
R ............. rename marked (or current) files and directories
D ............. delete marked (or current) files and directories
S ............. soft-link selected file/directory to passive pane
Y ............. do relative soft-link of selected file in passive pane
H ............. hard-link selected file to passive pane
K ............. clone selected files and directories into passive pane
N ............. in place copy/rename/link marked (or current) entries
M-C ........... copy (using traditional dired-do-copy)
M-R ........... rename (using traditional dired-do-rename)
M-D ........... delete (using traditional dired-do-delete)
M-S............ soft-link (using traditional dired-do-symlink)
M-Y............ do relative soft-link (traditional dired-do-relsymlink)
M-H............ hard-link selected file/directory (dired-do-hardlink)
A ............. search marked files for regular expression
Q ............. perform query-replace-regexp on marked files
C-q ........... search occurrences of a string in marked files
C-c s ......... start a \"sticky\" interactive search in the current pane
M-a ........... move to beginning of current directory
M-e ........... move to end of current directory
M-y ........... go to previous directory in history
M-u ........... go to next directory in history
C-M-y ......... go to previous directory in history on passive pane
C-M-u ......... go to next directory in history on passive pane
g, C-c C-c .... refresh pane
s ............. sort entries (by name, number, size, time or extension)
r ............. reverse the order of entries in the active pane (sticky)
C-o ........... show/hide hidden files (requires dired-omit-mode)
C-Backspace ... hide/show file attributes in pane
C-c Backspace . hide/show file attributes in pane (console compatible)
y ............. show file type / size of selected files and directories.
M-l ........... truncate/continue long lines in pane
C-c v ......... put current panel in VIRTUAL mode
C-c C-v ....... create new pure VIRTUAL buffer
C-c C-w ....... browse directory tree using w3m
M-t ........... transpose panes
M-o ........... synchronize panes
C-c C-s ....... change panes layout (vertical/horizontal/top-only)
[ ............. enlarges the right pane by 5 columns
] ............. enlarges the left pane by 5 columns
} ............. enlarges the panes vertically by 1 row
C-} ........... enlarges the panes vertically as much as it can
C-c } ......... enlarges the panes vertically as much as it can
{ ............. shrinks the panes vertically by 1 row
C-{ ........... shrinks the panes vertically as much as it can
C-c { ......... shrinks the panes vertically as much as it can
\\ ............. restores the size of all windows back to «normal»
C-c C-z ....... enable/disable synchronized navigation
C-= ........... smart compare files (ediff)
C-c = ......... smart compare files (console compatible)
= ............. fast smart compare files (plain diff)
C-M-= ......... compare panes
C-x = ......... compare panes (console compatible)
C-c C-f ....... execute Find-dired in Sunrise VIRTUAL mode
C-c C-n ....... execute find-Name-dired in Sunrise VIRTUAL mode
C-u C-c C-g ... execute find-Grep-dired with additional grep options
C-c C-g ....... execute grep in Sunrise VIRTUAL mode
C-c C-l ....... execute Locate in Sunrise VIRTUAL mode
C-c C-r ....... browse list of Recently visited files (requires recentf)
C-c C-c ....... [after find, locate or recent] dismiss virtual buffer
C-c / ......... narrow the contents of current pane using fuzzy matching
C-c b ......... partial Branch view of selected items in current pane
C-c p ......... Prune paths matching regular expression from current pane
; ............. follow file (go to same directory as selected file)
M-; ........... follow file in passive pane
C-M-o ......... follow a projection of current directory in passive pane
C-> ........... save named checkpoint (a.k.a. \"bookmark panes\")
C-c > ......... save named checkpoint (console compatible)
C-. ........ restore named checkpoint
C-c . ........ restore named checkpoint
C-x C-q ....... put pane in Editable Dired mode (commit with C-c C-c)
@! ............ fast backup files (not dirs!), each to [filename].bak
C-c t ......... open new terminal or switch to already open one
C-c T ......... open terminal AND/OR change directory to current
C-c C-t ....... open always a new terminal in current directory
C-c M-t ....... open a new terminal using an alternative shell program
q, C-x k ...... quit Sunrise Commander, restore previous window setup
M-q ........... quit Sunrise Commander, don't restore previous windows
Additionally, the following traditional commander-style keybindings are provided
\(these may be disabled by customizing the `sunrise-use-commander-keys' option):
F2 ............ go to directory
F3 ............ quick visit selected file
F4 ............ visit selected file
F5 ............ copy marked (or current) files and directories
F6 ............ rename marked (or current) files and directories
F7 ............ create new directory
F8 ............ delete marked (or current) files and directories
F10 ........... quit Sunrise Commander
C-F3 .......... sort contents of current pane by name
C-F4 .......... sort contents of current pane by extension
C-F5 .......... sort contents of current pane by time
C-F6 .......... sort contents of current pane by size
C-F7 .......... sort contents of current pane numerically
S-F7 .......... soft-link selected file/directory to passive pane
Insert ........ mark file
C-PgUp ........ go to parent directory
Any other dired keybinding (not overridden by any of the above) can be used in
Sunrise, like G for changing group, M for changing mode and so on.
Some more bindings are available in terminals opened using any of the Sunrise
functions (i.e. one of: C-c t, C-c T, C-c C-t, C-c M-t):
C-c Tab ....... switch focus to the active pane
C-c t ......... cycle through all currently open terminals
C-c T ......... cd to the directory in the active pane
C-c C-t ....... open new terminal, cd to directory in the active pane
C-c ; ......... follow the current directory in the active pane
C-c { ......... shrink the panes vertically as much as possible
C-c } ......... enlarge the panes vertically as much as possible
C-c \\ ......... restore the size of all windows back to «normal»
C-c C-j ....... put terminal in line mode
C-c C-k ....... put terminal back in char mode
The following bindings are available only in line mode (eshell is considered to
be *always* in line mode):
M-<up>, M-P ... move cursor up in the active pane
M-<down>, M-N . move cursor down in the active pane
M-Return ...... visit selected file/directory in the active pane
M-J ........... go to parent directory in the active pane
M-G ........... refresh active pane
M-Tab ......... switch to passive pane (without leaving the terminal)
M-M ........... mark selected file/directory in the active pane
M-Backspace ... unmark previous file/directory in the active pane
M-U ........... remove all marks from the active pane
C-Tab ......... switch focus to the active pane
In a terminal in line mode the following substitutions are also performed
automatically:
%f - expands to the currently selected file in the left pane
%F - expands to the currently selected file in the right pane
%m - expands to the list of paths of all marked files in the left pane
%M - expands to the list of paths of all marked files in the right pane
%n - expands to the list of names of all marked files in the left pane
%N - expands to the list of names of all marked files in the right pane
%d - expands to the current directory in the left pane
%D - expands to the current directory in the right pane
%a - expands to the list of paths of all marked files in the active pane
%A - expands to the current directory in the active pane
%p - expands to the list of paths of all marked files in the passive pane
%P - expands to the current directory in the passive pane
%% - inserts a single % sign.
"
:group 'sunrise
(unless (string-match "\\(Sunrise\\)" (buffer-name))
(rename-buffer (concat (buffer-name) " (Sunrise)") t))
(set-keymap-parent sunrise-mode-map dired-mode-map)
(sunrise-highlight)
(dired-omit-mode dired-omit-mode)
(make-local-variable 'truncate-partial-width-windows)
(setq truncate-partial-width-windows (sunrise-truncate-v t))
(set (make-local-variable 'buffer-read-only) t)
(set (make-local-variable 'dired-header-face) 'sunrise-passive-path-face)
(set (make-local-variable 'truncate-lines) nil)
(set (make-local-variable 'desktop-save-buffer) 'sunrise-desktop-save-buffer)
(set (make-local-variable 'revert-buffer-function) 'sunrise-revert-buffer)
(set (make-local-variable 'buffer-quit-function) 'sunrise-quit)
(set (make-local-variable 'sunrise-show-file-attributes) sunrise-show-file-attributes)
(set (make-local-variable 'mouse-1-click-follows-link) nil)
(set (make-local-variable 'track-mouse) sunrise-cursor-follows-mouse)
(set (make-local-variable 'hl-line-sticky-flag) nil)
(hl-line-mode 1)
(run-mode-hooks 'sunrise-mode-hook))
;;;###autoload
(define-derived-mode sunrise-virtual-mode dired-virtual-mode "Sunrise VIRTUAL"
"Sunrise Commander Virtual Mode. Useful for reusing find and locate results."
:group 'sunrise
(set-keymap-parent sunrise-virtual-mode-map sunrise-mode-map)
(sunrise-highlight)
(enriched-mode -1)
(make-local-variable 'truncate-partial-width-windows)
(setq truncate-partial-width-windows (sunrise-truncate-v t))
(set (make-local-variable 'buffer-read-only) t)
(set (make-local-variable 'dired-header-face) 'sunrise-passive-path-face)
(set (make-local-variable 'truncate-lines) nil)
(set (make-local-variable 'desktop-save-buffer) 'sunrise-desktop-save-buffer)
(set (make-local-variable 'revert-buffer-function) 'sunrise-revert-buffer)
(set (make-local-variable 'buffer-quit-function) 'sunrise-quit)
(set (make-local-variable 'sunrise-show-file-attributes) sunrise-show-file-attributes)
(set (make-local-variable 'mouse-1-click-follows-link) nil)
(set (make-local-variable 'track-mouse) sunrise-cursor-follows-mouse)
(set (make-local-variable 'hl-line-sticky-flag) nil)
(hl-line-mode 1)
(define-key sunrise-virtual-mode-map "\C-c\C-c" 'sunrise-virtual-dismiss)
(define-key sunrise-virtual-mode-map "\C-cv" 'sunrise-backup-buffer))
(defmacro sunrise-within (dir form)
"Evaluate FORM in Sunrise Commander context in directory DIR."
`(unwind-protect
(progn
(setq sunrise-dired-directory
(file-name-as-directory (abbreviate-file-name ,dir)))
(ad-activate 'dired-find-buffer-nocreate)
,form)
(ad-deactivate 'dired-find-buffer-nocreate)
(setq sunrise-dired-directory "")))
(defmacro sunrise-save-aspect (&rest body)
"Restore omit mode, hidden attributes and point after a directory transition.
BODY is the code to evaluate within an implicit `progn'."
`(let ((inhibit-read-only t)
(omit (or dired-omit-mode -1))
(attrs (eval 'sunrise-show-file-attributes))
(path-faces sunrise-current-path-faces))
,@body
(dired-omit-mode omit)
(when path-faces
(setq sunrise-current-path-faces path-faces))
(when (string= "NUMBER" (get sunrise-selected-window 'sorting-order))
(sunrise-sort-by-operation 'sunrise-numerical-sort-op))
(when (get sunrise-selected-window 'sorting-reverse)
(sunrise-reverse-pane))
(setq sunrise-show-file-attributes attrs)
(sunrise-display-attributes (point-min) (point-max) sunrise-show-file-attributes)
(sunrise-restore-point-if-same-buffer)))
(defmacro sunrise-save-selected-window (&rest body)
"Execute BODY, then select the previously selected window.
During the operation, `sunrise-inhibit-switch' is set to t.
Uses `save-selected-window' internally."
`(let ((sunrise-inhibit-switch t))
(save-selected-window
,@body)))
(defmacro sunrise-alternate-buffer (form)
"Execute FORM in a new buffer, after killing the previous one."
`(let ((dispose nil))
(unless (or (not (or dired-directory (eq major-mode 'sunrise-tree-mode)))
(eq sunrise-left-buffer sunrise-right-buffer))
(setq dispose (current-buffer)))
,form
(setq sunrise-this-directory default-directory)
(sunrise-keep-buffer)
(sunrise-highlight)
(when (and sunrise-kill-unused-buffers (buffer-live-p dispose))
(with-current-buffer dispose
(bury-buffer)
(set-buffer-modified-p nil)
(unless (kill-buffer dispose)
(kill-local-variable 'sunrise-current-path-faces))))))
(defun sunrise-assert-other ()
"Signal an error if we have no other pane."
(unless (window-live-p (sunrise-other 'window))
(user-error "No other Sunrise Commander pane")))
(defmacro sunrise-in-other (form)
"Execute FORM in the context of the passive pane.
Helper macro for passive & synchronized navigation."
`(let ((home sunrise-selected-window))
(let ((sunrise-inhibit-highlight t))
(when sunrise-synchronized
,form)
(sunrise-change-window)
(condition-case description
,form
(error (message (cadr description)))))
(cond ((not sunrise-running)
(sunrise-select-window home))
(t
(run-hooks 'sunrise-refresh-hook)
(sunrise-change-window)))))
(defmacro sunrise-silently (&rest body)
"Silence all `message' output within BODY."
`(cl-letf (((symbol-function 'message) (lambda (_msg &rest _args) (ignore))))
,@body))
(eval-and-compile
(defun sunrise-symbol (side type)
"Synthesize Sunrise symbols (`sunrise-left-buffer', `sunrise-right-window', etc.)."
(intern (concat "sunrise-" (symbol-name side) "-" (symbol-name type)))))
(defun sunrise-dired-mode ()
"Set Sunrise mode in every Dired buffer opened in Sunrise (called in a hook)."
(if (and sunrise-running
(eq (selected-frame) sunrise-current-frame)
(sunrise-equal-dirs dired-directory default-directory)
(not (eq major-mode 'sunrise-mode)))
(let ((dired-listing-switches dired-listing-switches)
(sorting-options (or (get sunrise-selected-window 'sorting-options) "")))
(unless (string-match tramp-file-name-regexp default-directory)
(setq dired-listing-switches
(concat sunrise-listing-switches sorting-options)))
(sunrise-mode)
(dired-unadvertise dired-directory))))
(add-hook 'dired-before-readin-hook 'sunrise-dired-mode)
(defun sunrise-bookmark-jump ()
"Handle panes opened from bookmarks in Sunrise."
(when (and sunrise-running
(memq (selected-window) (list sunrise-left-window sunrise-right-window)))
(let ((last-buf (symbol-value (sunrise-symbol sunrise-selected-window 'buffer))))
(setq dired-omit-mode (with-current-buffer last-buf dired-omit-mode))
(setq sunrise-this-directory default-directory)
(if (sunrise-equal-dirs sunrise-this-directory sunrise-other-directory)
(sunrise-synchronize-panes t)
(revert-buffer))
(sunrise-keep-buffer)
(unless (memq last-buf (list (current-buffer) (sunrise-other 'buffer)))
(kill-buffer last-buf)))))
(add-hook 'bookmark-after-jump-hook 'sunrise-bookmark-jump)
(defun sunrise-virtualize-pane ()
"Put the current normal view in VIRTUAL mode."
(interactive)
(when (eq major-mode 'sunrise-mode)
(let ((focus (dired-get-filename 'verbatim t)))
(sunrise-save-aspect
(when (eq sunrise-left-buffer sunrise-right-buffer)
(dired default-directory)
(sunrise-keep-buffer))
(sunrise-virtual-mode))
(when focus (sunrise-focus-filename focus)))))
(defun sunrise-virtual-dismiss ()
"Restore normal pane view in Sunrise VIRTUAL mode."
(interactive)
(when (eq major-mode 'sunrise-virtual-mode)
(let ((focus (dired-get-filename 'verbatim t)))
(sunrise-process-kill)
(sunrise-save-aspect
(sunrise-alternate-buffer (sunrise-goto-dir sunrise-this-directory))
(when focus (sunrise-focus-filename focus))
(revert-buffer)))))
(defun sunrise-backup-buffer ()
"Create a backup copy of the current buffer.
Used as a cache during revert operations."
(interactive)
(sunrise-kill-backup-buffer)
(let ((buf (current-buffer)))
(setq sunrise-backup-buffer (generate-new-buffer "*Sunrise Backup*"))
(with-current-buffer sunrise-backup-buffer
(insert-buffer-substring buf))
(run-hooks 'sunrise-refresh-hook)))
(defun sunrise-kill-backup-buffer ()
"Kill the backup buffer associated to the current one, if there is any."
(when (buffer-live-p sunrise-backup-buffer)
(kill-buffer sunrise-backup-buffer)
(setq sunrise-backup-buffer nil)))
(add-hook 'kill-buffer-hook 'sunrise-kill-backup-buffer)
(add-hook 'change-major-mode-hook 'sunrise-kill-backup-buffer)
(add-to-list 'enriched-translations
'(invisible (sunrise "x-sunrise-invisible")))
(defun sunrise-enrich-buffer ()
"Ensure enriched mode is enabled in the current buffer.
This is done before saving the buffer to a file so that its dired
file attributes are preserved. See the function `enriched-mode'."
(when (memq major-mode '(sunrise-mode sunrise-virtual-mode))
(enriched-mode 1)))
(add-hook 'before-save-hook 'sunrise-enrich-buffer)
;; Activated by the `sunrise-within' macro.
(defadvice dired-find-buffer-nocreate
(before sunrise-advice-findbuffer (dirname &optional mode))
"A hack to avoid some Dired mode quirks in the Sunrise Commander."
(when (sunrise-equal-dirs sunrise-dired-directory dirname)
(setq mode 'sunrise-mode)))
(defadvice dired-dwim-target-directory
(around sunrise-advice-dwim-target ())
"Tweak the target directory guessing mechanism when Sunrise Commander is on."
(if (and sunrise-running (eq (selected-frame) sunrise-current-frame))
(setq ad-return-value sunrise-other-directory)
ad-do-it))
(ad-activate 'dired-dwim-target-directory)
(defadvice select-window
(after sunrise-ad-select-window (window &optional norecord))
"Detect Sunrise pane switch and update tracking state accordingly."
(sunrise-detect-switch))
(ad-activate 'select-window)
(defadvice other-window
(around sunrise-advice-other-window (count &optional all-frames interactive))
"Select the correct Sunrise Commander pane when switching from other windows."
(if (or (not sunrise-running) sunrise-ediff-on)
ad-do-it
(let ((from (selected-window))
(to (next-window)))
(if (or sunrise-traditional-other-window
(not (memq to (list sunrise-left-window sunrise-right-window)))
(memq from (list sunrise-left-window sunrise-right-window)))
ad-do-it
(sunrise-select-window sunrise-selected-window))))
(sunrise-detect-switch))
(ad-activate 'other-window)
(defadvice use-hard-newlines
(around sunrise-advice-use-hard-newlines (&optional arg insert))
"Stop asking if I want hard lines the in Sunrise Commander, just guess."
(if (memq major-mode '(sunrise-mode sunrise-virtual-mode))
(let ((inhibit-read-only t))
(setq insert 'guess)
ad-do-it)
ad-do-it))
(ad-activate 'use-hard-newlines)
(defadvice dired-insert-set-properties
(around sunrise-advice-dired-insert-set-properties (beg end))
"Manage hidden attributes in files added externally to Sunrise.
E.g. from `find-dired'."
(if (not (memq major-mode '(sunrise-mode sunrise-virtual-mode)))
ad-do-it
(with-no-warnings
(sunrise-display-attributes beg end sunrise-show-file-attributes))))
(ad-activate 'dired-insert-set-properties)
;;; ============================================================================
;;; Sunrise Commander keybindings:
(define-key sunrise-mode-map "\C-m" 'sunrise-advertised-find-file)
(define-key sunrise-mode-map "f" 'sunrise-advertised-find-file)
(define-key sunrise-mode-map "X" 'sunrise-advertised-execute-file)
(define-key sunrise-mode-map "o" 'sunrise-quick-view)
(define-key sunrise-mode-map "v" 'sunrise-quick-view)
(define-key sunrise-mode-map "/" 'sunrise-goto-dir)
(define-key sunrise-mode-map "j" 'sunrise-goto-dir)
(define-key sunrise-mode-map "^" 'sunrise-dired-prev-subdir)
(define-key sunrise-mode-map "J" 'sunrise-dired-prev-subdir)
(define-key sunrise-mode-map ";" 'sunrise-follow-file)
(define-key sunrise-mode-map "\M-t" 'sunrise-transpose-panes)
(define-key sunrise-mode-map "\M-o" 'sunrise-synchronize-panes)
(define-key sunrise-mode-map "\C-\M-o" 'sunrise-project-path)
(define-key sunrise-mode-map "\M-y" 'sunrise-history-prev)
(define-key sunrise-mode-map "\M-u" 'sunrise-history-next)
(define-key sunrise-mode-map "\C-c>" 'sunrise-checkpoint-save)
(define-key sunrise-mode-map "\C-c." 'sunrise-checkpoint-restore)
(define-key sunrise-mode-map "\C-c\C-z" 'sunrise-sync)
(define-key sunrise-mode-map "\C-c\C-c" 'revert-buffer)
(define-key sunrise-mode-map "\t" 'sunrise-change-window)
(define-key sunrise-mode-map "\C-c\t" 'sunrise-select-viewer-window)
(define-key sunrise-mode-map "\M-a" 'sunrise-beginning-of-buffer)
(define-key sunrise-mode-map "\M-e" 'sunrise-end-of-buffer)
(define-key sunrise-mode-map "\C-c\C-s" 'sunrise-split-toggle)
(define-key sunrise-mode-map "]" 'sunrise-enlarge-left-pane)
(define-key sunrise-mode-map "[" 'sunrise-enlarge-right-pane)
(define-key sunrise-mode-map "}" 'sunrise-enlarge-panes)
(define-key sunrise-mode-map "{" 'sunrise-shrink-panes)
(define-key sunrise-mode-map "\\" 'sunrise-lock-panes)
(define-key sunrise-mode-map "\C-c}" 'sunrise-max-lock-panes)
(define-key sunrise-mode-map "\C-c{" 'sunrise-min-lock-panes)
(define-key sunrise-mode-map "\C-o" 'dired-omit-mode)
(define-key sunrise-mode-map "b" 'sunrise-browse-file)
(define-key sunrise-mode-map "\C-c\C-w" 'sunrise-browse-pane)
(define-key sunrise-mode-map "\C-c\d" 'sunrise-toggle-attributes)
(define-key sunrise-mode-map "\M-l" 'sunrise-toggle-truncate-lines)
(define-key sunrise-mode-map "s" 'sunrise-interactive-sort)
(define-key sunrise-mode-map "r" 'sunrise-reverse-pane)
(define-key sunrise-mode-map "\C-e" 'sunrise-scroll-up)
(define-key sunrise-mode-map "\C-y" 'sunrise-scroll-down)
(define-key sunrise-mode-map " " 'sunrise-scroll-quick-view)
(define-key sunrise-mode-map "\M- " 'sunrise-scroll-quick-view-down)
(define-key sunrise-mode-map [?\S- ] 'sunrise-scroll-quick-view-down)
(define-key sunrise-mode-map "C" 'sunrise-do-copy)
(define-key sunrise-mode-map "K" 'sunrise-do-clone)
(define-key sunrise-mode-map "R" 'sunrise-do-rename)
(define-key sunrise-mode-map "D" 'sunrise-do-delete)
(define-key sunrise-mode-map "x" 'sunrise-do-flagged-delete)
(define-key sunrise-mode-map "S" 'sunrise-do-symlink)
(define-key sunrise-mode-map "Y" 'sunrise-do-relsymlink)
(define-key sunrise-mode-map "H" 'sunrise-do-hardlink)
(define-key sunrise-mode-map "N" 'sunrise-inplace)
(define-key sunrise-mode-map "\M-C" 'dired-do-copy)
(define-key sunrise-mode-map "\M-R" 'dired-do-rename)
(define-key sunrise-mode-map "\M-D" 'dired-do-delete)
(define-key sunrise-mode-map "\M-S" 'dired-do-symlink)
(define-key sunrise-mode-map "\M-Y" 'dired-do-relsymlink)
(define-key sunrise-mode-map "\M-H" 'dired-do-hardlink)
(define-key sunrise-mode-map "\C-x\C-q" 'sunrise-editable-pane)
(define-key sunrise-mode-map "@" 'sunrise-fast-backup-files)
(define-key sunrise-mode-map "\M-+" 'sunrise-create-files)
(define-key sunrise-mode-map "=" 'sunrise-diff)
(define-key sunrise-mode-map "\C-c=" 'sunrise-ediff)
(define-key sunrise-mode-map "\C-x=" 'sunrise-compare-panes)
(define-key sunrise-mode-map "\C-c\C-f" 'sunrise-find)
(define-key sunrise-mode-map "\C-c\C-n" 'sunrise-find-name)
(define-key sunrise-mode-map "\C-c\C-g" 'sunrise-grep)
(define-key sunrise-mode-map "\C-cb" 'sunrise-flatten-branch)
(define-key sunrise-mode-map "\C-cp" 'sunrise-prune-paths)
(define-key sunrise-mode-map "\C-c\C-l" 'sunrise-locate)
(define-key sunrise-mode-map "\C-c/" 'sunrise-fuzzy-narrow)
(define-key sunrise-mode-map "\C-c\C-r" 'sunrise-recent-files)
(define-key sunrise-mode-map "\C-c\C-d" 'sunrise-recent-directories)
(define-key sunrise-mode-map "\C-cv" 'sunrise-virtualize-pane)
(define-key sunrise-mode-map "\C-c\C-v" 'sunrise-pure-virtual)
(define-key sunrise-mode-map "Q" 'sunrise-do-query-replace-regexp)
(define-key sunrise-mode-map "\C-q" 'sunrise-multi-occur)
(define-key sunrise-mode-map "F" 'sunrise-do-find-marked-files)
(define-key sunrise-mode-map "A" 'sunrise-do-search)
(define-key sunrise-mode-map "\C-cs" 'sunrise-sticky-isearch-forward)
(define-key sunrise-mode-map "\C-cr" 'sunrise-sticky-isearch-backward)
(define-key sunrise-mode-map "\C-x\C-f" 'sunrise-find-file)
(define-key sunrise-mode-map "y" 'sunrise-show-files-info)
(define-key sunrise-mode-map "\M-n" 'sunrise-next-line-other)
(define-key sunrise-mode-map [M-down] 'sunrise-next-line-other)
(define-key sunrise-mode-map [A-down] 'sunrise-next-line-other)
(define-key sunrise-mode-map "\M-p" 'sunrise-prev-line-other)
(define-key sunrise-mode-map [M-up] 'sunrise-prev-line-other)
(define-key sunrise-mode-map [A-up] 'sunrise-prev-line-other)
(define-key sunrise-mode-map "\M-j" 'sunrise-goto-dir-other)
(define-key sunrise-mode-map "\M-\C-m" 'sunrise-advertised-find-file-other)
(define-key sunrise-mode-map "\M-f" 'sunrise-advertised-find-file-other)
(define-key sunrise-mode-map "\C-c\C-m" 'sunrise-advertised-find-file-other)
(define-key sunrise-mode-map "\M-^" 'sunrise-prev-subdir-other)
(define-key sunrise-mode-map "\M-J" 'sunrise-prev-subdir-other)
(define-key sunrise-mode-map "\M-m" 'sunrise-mark-other)
(define-key sunrise-mode-map "\M-M" 'sunrise-unmark-backward-other)
(define-key sunrise-mode-map "\M-U" 'sunrise-unmark-all-marks-other)
(define-key sunrise-mode-map "\M-;" 'sunrise-follow-file-other)
(define-key sunrise-mode-map "\C-\M-y" 'sunrise-history-prev-other)
(define-key sunrise-mode-map "\C-\M-u" 'sunrise-history-next-other)
(define-key sunrise-mode-map "\C-ct" 'sunrise-term)
(define-key sunrise-mode-map "\C-cT" 'sunrise-term-cd)
(define-key sunrise-mode-map "\C-c\C-t" 'sunrise-term-cd-newterm)
(define-key sunrise-mode-map "\C-c\M-t" 'sunrise-term-cd-program)
(define-key sunrise-mode-map "\C-c;" 'sunrise-follow-viewer)
(define-key sunrise-mode-map "q" 'sunrise-quit)
(define-key sunrise-mode-map "\C-xk" 'sunrise-kill-pane-buffer)
(define-key sunrise-mode-map "\M-q" 'sunrise-cd)
(define-key sunrise-mode-map "h" 'sunrise-describe-mode)
(define-key sunrise-mode-map "?" 'sunrise-summary)
(define-key sunrise-mode-map "k" 'dired-do-kill-lines)
(define-key sunrise-mode-map [remap undo] 'sunrise-undo)
(define-key sunrise-mode-map [remap undo-only] 'sunrise-undo)
(define-key sunrise-mode-map [backspace] 'dired-unmark-backward)
(define-key sunrise-mode-map [mouse-1] 'sunrise-mouse-advertised-find-file)
(define-key sunrise-mode-map [mouse-2] 'sunrise-mouse-change-window)
(define-key sunrise-mode-map [mouse-movement] 'sunrise-mouse-move-cursor)
(define-key sunrise-mode-map [(control >)] 'sunrise-checkpoint-save)
(define-key sunrise-mode-map [(control .)] 'sunrise-checkpoint-restore)
(define-key sunrise-mode-map [(control tab)] 'sunrise-select-viewer-window)
(define-key sunrise-mode-map [(control backspace)] 'sunrise-toggle-attributes)
(define-key sunrise-mode-map [(control ?\=)] 'sunrise-ediff)
(define-key sunrise-mode-map [(control meta ?\=)] 'sunrise-compare-panes)
(define-key sunrise-mode-map [(control })] 'sunrise-max-lock-panes)
(define-key sunrise-mode-map [(control {)] 'sunrise-min-lock-panes)
(defvar sunrise-commander-keys
'(([(f2)] . sunrise-goto-dir)
([(f3)] . sunrise-quick-view)
([(f4)] . sunrise-advertised-find-file)
([(f5)] . sunrise-do-copy)
([(f6)] . sunrise-do-rename)
([(f7)] . dired-create-directory)
([(f8)] . sunrise-do-delete)
([(f10)] . sunrise-quit)
([(control f3)] . sunrise-sort-by-name)
([(control f4)] . sunrise-sort-by-extension)
([(control f5)] . sunrise-sort-by-time)
([(control f6)] . sunrise-sort-by-size)
([(control f7)] . sunrise-sort-by-number)
([(shift f7)] . sunrise-do-symlink)
([(insert)] . sunrise-mark-toggle)
([(control prior)] . sunrise-dired-prev-subdir))
"Traditional commander-style keybindings for the Sunrise Commander.")
(defun sunrise-set-use-commander-keys (symbol value)
"Helper for `sunrise-use-commander-keys' custom option.
Set SYMBOL to VALUE whenever the option is set."
(if value
(mapc (lambda (x)
(define-key sunrise-mode-map (car x) (cdr x)))
sunrise-commander-keys)
(mapc (lambda (x)
(define-key sunrise-mode-map (car x) nil))
sunrise-commander-keys))
(set-default symbol value))
(defcustom sunrise-use-commander-keys t
"If non-nil, enable traditional Commander function keys: F5 = copy, etc."
:group 'sunrise
:type 'boolean
:set 'sunrise-set-use-commander-keys)
;;; ============================================================================
;;; Initialization and finalization functions:
;;;###autoload
(defun sunrise (&optional left-directory right-directory filename)
"Toggle the Sunrise Commander file manager.
If LEFT-DIRECTORY is given, the left window will display that
directory (same for RIGHT-DIRECTORY). Specifying nil for either
of these values uses the default, ie. $HOME.
If FILENAME is non-nil, it is the basename of a file to focus."
(interactive)
(message "Starting Sunrise Commander...")
(if (not sunrise-running)
(let ((welcome sunrise-start-message))
(when left-directory
(setq sunrise-left-directory left-directory))
(when right-directory
(setq sunrise-right-directory right-directory))
(sunrise-switch-to-nonpane-buffer)
(setq sunrise-restore-buffer (current-buffer)
sunrise-current-frame (window-frame (selected-window))
sunrise-prior-window-configuration (current-window-configuration))
(sunrise-setup-windows)
(when filename
(condition-case description
(sunrise-focus-filename (file-name-nondirectory filename))
(error (setq welcome (cadr description)))))
(setq sunrise-this-directory default-directory)
(sunrise-highlight) ;;<-- W32Emacs needs this
(hl-line-mode 1)
(message "%s" welcome)
(setq sunrise-running t))
(let ((my-frame (window-frame (selected-window))))
(sunrise-quit)
(message "All life leaps out to greet the light...")
(unless (eq my-frame (window-frame (selected-window)))
(select-frame my-frame)
(sunrise left-directory right-directory filename)))))
;;;###autoload
(defun sunrise-dired (&optional target switches)
"Visit the given TARGET (file or directory) in `sunrise-mode'.
If provided, use SWITCHES instead of `sunrise-listing-switches'."
(interactive
(list
(read-file-name "Visit (file or directory): " nil nil nil)))
(let* ((target (expand-file-name (or target default-directory)))
(file (if (file-directory-p target) nil target))
(directory (if file (file-name-directory target) target))
(dired-omit-mode (if sunrise-show-hidden-files -1 1))
(sunrise-listing-switches (or switches sunrise-listing-switches)))
(unless (file-readable-p directory)
(error "%s is not readable!" (sunrise-directory-name-proper directory)))
(unless (and sunrise-running (eq (selected-frame) sunrise-current-frame)) (sunrise))
(sunrise-select-window sunrise-selected-window)
(if file
(sunrise-follow-file file)
(sunrise-goto-dir directory))
(hl-line-mode 1)
(sunrise-display-attributes (point-min) (point-max) sunrise-show-file-attributes)
(sunrise-this 'buffer)))
(defun sunrise-choose-cd-target ()
"Select a suitable target directory for cd operations."
(if (and sunrise-running (eq (selected-frame) sunrise-current-frame))
sunrise-this-directory
default-directory))
;;;###autoload
(defun sunrise-cd ()
"Toggle the Sunrise Commander FM keeping the current file in focus.
If Sunrise is off, enable it and focus the file displayed in the current buffer.
If Sunrise is on, disable it and switch to the buffer currently displayed in the
viewer window."
(interactive)
(cond
((not (and sunrise-running
(eq (window-frame sunrise-left-window) (selected-frame))))
(sunrise-dired (or (buffer-file-name) (sunrise-choose-cd-target))))
(t
(sunrise-quit t)
(message
"Hast thou a charm to stay the morning-star in his steep course?"))))
(defun sunrise-this (&optional type)
"Return object of type TYPE corresponding to the active side of the manager.
If TYPE is not specified (nil), returns a symbol (`left' or `right').
If TYPE is `buffer' or `window', returns the corresponding buffer
or window."
(if type
(symbol-value (sunrise-symbol sunrise-selected-window type))
sunrise-selected-window))
(defun sunrise-other (&optional type)
"Return object of type TYPE corresponding to the passive side of the manager.
If TYPE is not specified (nil), returns a symbol (`left' or `right').
If TYPE is `buffer' or `window', returns the corresponding
buffer or window."
(let ((side (cdr (assq sunrise-selected-window sunrise-side-lookup))))
(if type
(symbol-value (sunrise-symbol side type))
side)))
;;; ============================================================================
;;; Window management functions:
(defmacro sunrise-setup-pane (side)
"Helper macro for the function `sunrise-setup-windows'.
SIDE is one of the symbols left or right."
`(let ((sunrise-selected-window ',side))
(setq ,(sunrise-symbol side 'window) (selected-window))
(if (buffer-live-p ,(sunrise-symbol side 'buffer))
(progn
(switch-to-buffer ,(sunrise-symbol side 'buffer))
(setq ,(sunrise-symbol side 'directory) default-directory))
(let ((sunrise-running t))
(sunrise-dired ,(sunrise-symbol side 'directory))))))
(defun sunrise-setup-visible-panes ()
"Set up sunrise on all visible panes."
(sunrise-setup-pane left)
(unless (eq sunrise-window-split-style 'top)
(other-window 1)
(sunrise-setup-pane right)))
(defun sunrise-setup-windows()
"Set up the Sunrise window configuration (two windows in `sunrise-mode')."
(run-hooks 'sunrise-init-hook)
;;get rid of all windows except one (not any of the panes!)
(sunrise-select-viewer-window)
(delete-other-windows)
(if (buffer-live-p other-window-scroll-buffer)
(switch-to-buffer other-window-scroll-buffer)
(sunrise-switch-to-nonpane-buffer))
;;now create the viewer window
(unless (and sunrise-panes-height (< sunrise-panes-height (frame-height)))
(setq sunrise-panes-height (sunrise-get-panes-size)))
(when (and (<= sunrise-panes-height (* 2 window-min-height))
(eq sunrise-window-split-style 'vertical))
(setq sunrise-panes-height (* 2 window-min-height)))
(split-window (selected-window) sunrise-panes-height)
(cl-case sunrise-window-split-style
(horizontal (split-window-horizontally))
(vertical (split-window-vertically))
(top (ignore))
(t (error "Unrecognised `sunrise-window-split-style' value: %s"
sunrise-window-split-style)))
(sunrise-setup-visible-panes)
;;select the correct window
(sunrise-select-window sunrise-selected-window)
(sunrise-restore-panes-width)
(run-hooks 'sunrise-start-hook))
(defun sunrise-switch-to-nonpane-buffer ()
"Try to switch to a buffer that is *not* a Sunrise pane."
(let ((start (current-buffer)))
(while (and
start
(or (memq major-mode '(sunrise-mode sunrise-virtual-mode sunrise-tree-mode))
(memq (current-buffer) (list sunrise-left-buffer sunrise-right-buffer))))
(bury-buffer)
(when (eq start (current-buffer))
(setq start nil)))))
(defun sunrise-restore-prior-configuration ()
"Restore configuration (if any) from `sunrise-prior-window-configuration'.
Return t if a configuration to restore could be found, nil otherwise."
(when sunrise-prior-window-configuration
(set-window-configuration sunrise-prior-window-configuration)
(when (buffer-live-p sunrise-restore-buffer)
(set-buffer sunrise-restore-buffer))
t))
(defun sunrise-lock-window (_frame)
"Resize the left Sunrise pane to have the \"right\" size."
(when sunrise-running
(if (not (window-live-p sunrise-left-window))
(setq sunrise-running nil)
(let ((sunrise-windows-locked sunrise-windows-locked))
(when (> window-min-height (- (frame-height)
(window-height sunrise-left-window)))
(setq sunrise-windows-locked nil))
(and sunrise-windows-locked
(not sunrise-ediff-on)
(not (eq sunrise-window-split-style 'vertical))
(window-live-p sunrise-left-window)
(sunrise-save-selected-window
(select-window sunrise-left-window)
(let* ((sunrise-panes-height (or sunrise-panes-height (window-height)))
(my-delta (- sunrise-panes-height (window-height))))
(enlarge-window my-delta))
(scroll-right)
(when (window-live-p sunrise-right-window)
(select-window sunrise-right-window)
(scroll-right))))))))
;; This keeps the size of the Sunrise panes constant:
(add-hook 'window-size-change-functions 'sunrise-lock-window)
(defun sunrise-highlight(&optional face)
"Set up the path line in the current buffer.
With optional FACE, register this face as the current face to display the active
path line."
(when (and (memq major-mode '(sunrise-mode sunrise-virtual-mode sunrise-tree-mode))
(not sunrise-inhibit-highlight))
(let ((inhibit-read-only t))
(save-excursion
(goto-char (point-min))
(sunrise-hide-avfs-root)
(sunrise-highlight-broken-links)
(sunrise-graphical-highlight face)
(sunrise-force-passive-highlight)
(run-hooks 'sunrise-refresh-hook)))))
(defun sunrise-unhighlight (face)
"Remove FACE from the list of faces of the active path line."
(when face
(setq sunrise-current-path-faces (delq face sunrise-current-path-faces))
(overlay-put sunrise-current-window-overlay 'face
(or (car sunrise-current-path-faces) 'sunrise-active-path-face))))
(defun sunrise-hide-avfs-root ()
"Hide the AVFS virtual filesystem root (if any) on the path line."
(when sunrise-avfs-root
(let ((start nil) (end nil)
(next (search-forward sunrise-avfs-root (point-at-eol) t)))
(when next
(setq start (- next (length sunrise-avfs-root))))
(while next
(setq end (point)
next (search-forward sunrise-avfs-root (point-at-eol) t)))
(when end
(put-text-property start end 'invisible 'sunrise)))))
(defun sunrise-highlight-broken-links ()
"Mark broken symlinks with an exclamation mark."
(let ((dired-marker-char ?!))
(while (search-forward-regexp dired-re-sym nil t)
(unless (or (not (eq 32 (char-after (line-beginning-position))))
(file-exists-p (dired-get-filename)))
(dired-mark 1)))))
(defsubst sunrise-invalid-overlayp ()
"Test for invalidity of the current buffer's graphical path line overlay.
Returns t if the overlay is no longer valid and should be replaced."
(or (not (overlayp sunrise-current-window-overlay))
(eq (overlay-start sunrise-current-window-overlay)
(overlay-end sunrise-current-window-overlay))))
(defun sunrise-graphical-highlight (&optional face)
"Set up the graphical path line in the current buffer.
\(Fancy fonts and clickable path.)
If FACE is non-nil, it is added to `sunrise-current-path-faces'."
(let ((begin) (end) (inhibit-read-only t))
(when (sunrise-invalid-overlayp)
;;determine begining and end
(save-excursion
(goto-char (point-min))
(search-forward-regexp "\\S " nil t)
(setq begin (1- (point)))
(end-of-line)
(setq end (1- (point))))
;;build overlay
(when sunrise-current-window-overlay
(delete-overlay sunrise-current-window-overlay))
(set (make-local-variable 'sunrise-current-window-overlay)
(make-overlay begin end))
;;path line hover effect:
(put-text-property begin end 'mouse-face 'sunrise-highlight-path-face)
(put-text-property begin end 'help-echo "click to move up"))
(when face
(setq sunrise-current-path-faces (cons face sunrise-current-path-faces)))
(overlay-put sunrise-current-window-overlay 'face
(or (car sunrise-current-path-faces) 'sunrise-active-path-face))
(overlay-put sunrise-current-window-overlay 'window (selected-window))))
(defun sunrise-force-passive-highlight (&optional revert)
"Set up the graphical path line in the passive pane.
With optional argument REVERT, executes `revert-buffer' on the passive buffer."
(unless (or (not (buffer-live-p (sunrise-other 'buffer)))
(eq sunrise-left-buffer sunrise-right-buffer))
(with-current-buffer (sunrise-other 'buffer)
(when sunrise-current-window-overlay
(delete-overlay sunrise-current-window-overlay))
(when (and revert
(memq major-mode '(sunrise-mode sunrise-virtual-mode sunrise-tree-mode)))
(revert-buffer)))))
(defun sunrise-quit (&optional norestore)
"Quit Sunrise and restore Emacs to the previous state.
If NORESTORE is nil, restore the Emacs window configuration to
the state it was in before Sunrise was entered. Otherwise put the
Emacs window configuration into a default state."
(interactive)
(if (not sunrise-running)
(bury-buffer)
(let ((buffer-read-only nil))
(setq sunrise-running nil
sunrise-current-frame nil)
(sunrise-save-directories)
(sunrise-save-panes-width)
(when (or norestore (not (sunrise-restore-prior-configuration)))
(sunrise-select-viewer-window)
(delete-other-windows))
(sunrise-bury-panes)
(run-hooks 'sunrise-quit-hook))))
(add-hook 'delete-frame-functions
(lambda (frame)
(when (and sunrise-running (eq frame sunrise-current-frame))
(sunrise-quit))))
(defun sunrise-save-directories ()
"Save current directories in the panes to use them at the next startup."
(save-current-buffer
(when (window-live-p sunrise-left-window)
(set-buffer (window-buffer sunrise-left-window))
(when (memq major-mode '(sunrise-mode sunrise-tree-mode))
(setq sunrise-left-directory default-directory)
(setq sunrise-left-buffer (current-buffer))))
(when (window-live-p sunrise-right-window)
(set-buffer (window-buffer sunrise-right-window))
(when (memq major-mode '(sunrise-mode sunrise-tree-mode))
(setq sunrise-right-directory default-directory)
(setq sunrise-right-buffer (current-buffer))))))
(defun sunrise-bury-panes ()
"Send both pane buffers to the end of the `buffer-list'."
(mapc (lambda (x)
(bury-buffer (symbol-value (sunrise-symbol x 'buffer))))
'(left right)))
(defun sunrise-save-panes-width ()
"Save the width of the panes to use them at the next startup."
(unless sunrise-selected-window-width
(setq sunrise-selected-window-width
(if (and (window-live-p sunrise-left-window)
(window-live-p sunrise-right-window))
(window-width
(symbol-value
(sunrise-symbol sunrise-selected-window 'window)))
t))))
(defun sunrise-restore-panes-width ()
"Restore the last registered pane width."
(when (and (eq sunrise-window-split-style 'horizontal)
(numberp sunrise-selected-window-width))
(enlarge-window-horizontally
(min (- sunrise-selected-window-width (window-width))
(- (frame-width) (window-width) window-min-width)))))
(defun sunrise-resize-panes (&optional reverse)
"Enlarge (or shrink, if REVERSE is t) the left pane by 5 columns."
(when (and (window-live-p sunrise-left-window)
(window-live-p sunrise-right-window))
(let ((direction (or (and reverse -1) 1)))
(sunrise-save-selected-window
(select-window sunrise-left-window)
(enlarge-window-horizontally (* 5 direction))))
(setq sunrise-selected-window-width nil)))
(defun sunrise-enlarge-left-pane ()
"Enlarge the left pane by 5 columns."
(interactive)
(when (< (1+ window-min-width) (window-width sunrise-right-window))
(sunrise-resize-panes)
(sunrise-save-panes-width)))
(defun sunrise-enlarge-right-pane ()
"Enlarge the right pane by 5 columns."
(interactive)
(when (< (1+ window-min-width) (window-width sunrise-left-window))
(sunrise-resize-panes t)
(sunrise-save-panes-width)))
(defun sunrise-get-panes-size (&optional size)
"Tell what the maximal, minimal and normal pane sizes should be.
SIZE is one of the symbols max, min or t."
(let ((frame (frame-height)))
(cl-case size
(max (max (- frame window-min-height 1) 5))
(min (min (1+ window-min-height) 5))
(t (/ (* sunrise-windows-default-ratio (frame-height)) 100)))))
(defun sunrise-enlarge-panes ()
"Enlarge both panes vertically."
(interactive)
(let ((sunrise-windows-locked nil)
(max (sunrise-get-panes-size 'max))
(ratio 1)
delta)
(sunrise-save-selected-window
(when (eq sunrise-window-split-style 'vertical)
(select-window sunrise-right-window)
(setq ratio 2)
(setq delta (- max (window-height)))
(when (> (/ max ratio) (window-height))
(shrink-window (if (< 2 delta) -2 -1))))
(select-window sunrise-left-window)
(when (> (/ max ratio) (window-height))
(shrink-window -1))
(setq sunrise-panes-height (* (window-height) ratio)))))
(defun sunrise-shrink-panes ()
"Shink both panes vertically."
(interactive)
(let ((sunrise-windows-locked nil)
(min (sunrise-get-panes-size 'min))
(ratio 1)
delta)
(sunrise-save-selected-window
(when (eq sunrise-window-split-style 'vertical)
(select-window sunrise-right-window)
(setq ratio 2)
(setq delta (- (window-height) min))
(when (< min (window-height))
(shrink-window (if (< 2 delta) 2 1))))
(select-window sunrise-left-window)
(when (< min (window-height))
(shrink-window 1))
(setq sunrise-panes-height (* (window-height) ratio)))))
(defun sunrise-lock-panes (&optional height)
"Resize and lock the panes at some vertical position.
HEIGHT is the height to lock the panes at. Valid values are `min'
and `max'; given any other value, locks the panes at normal
position."
(interactive)
(cond ((not sunrise-running)
(sunrise))
((not (and (window-live-p sunrise-left-window)
(or (window-live-p sunrise-right-window)
(eq sunrise-window-split-style 'top))))
(sunrise-setup-windows))
(t
(setq sunrise-panes-height (sunrise-get-panes-size height))
(let ((locked sunrise-windows-locked))
(setq sunrise-windows-locked t)
(cond (height
(shrink-window 1))
(t
(setq sunrise-selected-window-width t)
(balance-windows)))
(unless locked
(sit-for 0.1)
(setq sunrise-windows-locked nil))))))
(defun sunrise-max-lock-panes ()
(interactive)
(sunrise-save-panes-width)
(sunrise-lock-panes 'max))
(defun sunrise-min-lock-panes ()
(interactive)
(sunrise-save-panes-width)
(sunrise-lock-panes 'min))
(defun sunrise-mouse-disown-cursor ()
"Reset the Sunrise mouse movement event counter.
This is used to implement the `sunrise-cursor-follows-mouse'
feature."
(setq sunrise-mouse-events-count 0))
(add-hook 'sunrise-init-hook 'sunrise-mouse-disown-cursor)
;;; ============================================================================
;;; File system navigation functions:
(defun sunrise-advertised-find-file (&optional filename)
"Handle accesses to file system objects through the user interface.
Includes cases when the user presses return, f or clicks on the path line."
(interactive)
(unless filename
(if (eq 1 (line-number-at-pos)) ;; <- Click or Enter on path line.
(let* ((path (buffer-substring (point) (point-at-eol)))
(levels (1- (length (split-string path "/")))))
(if (< 0 levels)
(sunrise-dired-prev-subdir levels)
(sunrise-beginning-of-buffer)))
(setq filename (dired-get-filename nil t)
filename (and filename (expand-file-name filename)))))
(when filename
(if (file-exists-p filename)
(sunrise-find-file filename)
(error "Sunrise: nonexistent target"))))
(defun sunrise-advertised-execute-file (&optional prefix)
"Execute the currently selected file in a new subprocess."
(interactive "P")
(let ((path (dired-get-filename nil t)) (label) (args))
(if path
(setq label (file-name-nondirectory path))
(error "Sunrise: no executable file on this line"))
(unless (and (not (file-directory-p path)) (file-executable-p path))
(error "Sunrise: \"%s\" is not an executable file" label))
(when prefix
(setq args (read-string (format "arguments for \"%s\": " label))
label (format "%s %s" label args)))
(message "Sunrise: executing \"%s\" in new process" label)
(if args
(apply #'start-process (append (list "Sunrise Subprocess" nil path)
(split-string args)))
(start-process "Sunrise Subprocess" nil path))))
(defun sunrise-find-file (filename &optional wildcards)
"Determine the proper way of handling an object in the file system.
FILENAME can be either a regular file, a regular directory, a
Sunrise VIRTUAL directory, or a virtual directory served by
AVFS."
(interactive (find-file-read-args "Find file or directory: " nil))
(cond ((file-directory-p filename) (sunrise-find-regular-directory filename))
((and (sunrise-avfs-directory-p filename) (sunrise-avfs-dir filename))
(sunrise-find-regular-directory (sunrise-avfs-dir filename)))
((sunrise-virtual-directory-p filename) (sunrise-find-virtual-directory filename))
(t (sunrise-find-regular-file filename wildcards))))
(defun sunrise-virtual-directory-p (filename)
"Tell whether FILENAME is the path to a Sunrise VIRTUAL directory."
(eq 'sunrise-virtual-mode (assoc-default filename auto-mode-alist 'string-match)))
(defun sunrise-avfs-directory-p (filename)
"Tell whether FILENAME can be seen as the root of an AVFS virtual directory."
(let ((mode (assoc-default filename auto-mode-alist 'string-match)))
(and sunrise-avfs-root
(or (eq 'archive-mode mode)
(eq 'tar-mode mode)
(and (listp mode) (eq 'jka-compr (cadr mode)))
(not (equal "." (sunrise-assoc-key filename
sunrise-avfs-handlers-alist
'string-match)))))))
(defun sunrise-find-regular-directory (directory)
"Visit the given regular directory in the active pane."
(setq directory (file-name-as-directory directory))
(let ((parent (expand-file-name "../")))
(if (and (not (sunrise-equal-dirs parent default-directory))
(sunrise-equal-dirs directory parent))
(sunrise-dired-prev-subdir)
(sunrise-goto-dir directory))))
(defun sunrise-find-virtual-directory (sunrise-virtual-dir)
"Visit the given Sunrise VIRTUAL directory in the active pane."
(sunrise-save-aspect
(sunrise-alternate-buffer (find-file sunrise-virtual-dir)))
(sunrise-history-push sunrise-virtual-dir)
(set-visited-file-name nil t)
(sunrise-keep-buffer)
(sunrise-backup-buffer))
(defun sunrise-find-regular-file (filename &optional wildcards)
"Visit FILENAME as a regular file with WILDCARDS.
\(See `find-file' for more details on wildcard expansion.)"
(condition-case description
(let ((buffer (find-file-noselect filename nil nil wildcards)))
(funcall sunrise-visit-buffer-function buffer))
(error (message "%s" (cadr description)))))
(defun sunrise-visit-buffer-in-current-frame (buffer)
"Deactivate Sunrise and display the given buffer in the current frame."
(sunrise-save-panes-width)
(sunrise-quit)
(set-window-configuration sunrise-prior-window-configuration)
(switch-to-buffer buffer))
(defun sunrise-avfs-dir (filename)
"Return the virtual path for accessing FILENAME through AVFS.
Returns nil if AVFS cannot manage this kind of file."
(let* ((handler (assoc-default filename sunrise-avfs-handlers-alist 'string-match))
(vdir (concat filename handler)))
(unless (sunrise-overlapping-paths-p sunrise-avfs-root vdir)
(setq vdir (concat sunrise-avfs-root vdir)))
(if (file-attributes vdir) vdir nil)))
(defun sunrise-goto-dir (dir)
"Change the current directory in the active pane to the given one."
(interactive "DChange directory (file or pattern): ")
(if sunrise-goto-dir-function
(funcall sunrise-goto-dir-function dir)
(unless (and (eq major-mode 'sunrise-mode) (sunrise-equal-dirs dir default-directory))
(when (and sunrise-avfs-root
(null (posix-string-match "#" dir)))
(setq dir
(replace-regexp-in-string
(directory-file-name (expand-file-name sunrise-avfs-root)) "" dir)))
(sunrise-save-aspect
(sunrise-within dir (sunrise-alternate-buffer (dired dir))))
(sunrise-history-push default-directory)
(sunrise-beginning-of-buffer))))
(defun sunrise-dired-prev-subdir (&optional count)
"Go to the parent directory, or COUNT subdirectories upwards."
(interactive "P")
(unless (sunrise-equal-dirs default-directory "/")
(let* ((count (or count 1))
(to (replace-regexp-in-string "x" "../" (make-string count ?x)))
(from (expand-file-name (substring to 1)))
(from (sunrise-directory-name-proper from))
(from (replace-regexp-in-string "\\(?:#.*/?$\\|/$\\)" "" from))
(to (replace-regexp-in-string "\\.\\./$" "" (expand-file-name to))))
(sunrise-goto-dir to)
(unless (sunrise-equal-dirs from to)
(sunrise-focus-filename from)))))
(defun sunrise-follow-file (&optional target-path)
"Go to the same directory where the selected file is.
Very useful inside Sunrise VIRTUAL buffers."
(interactive)
(unless target-path
(setq target-path (dired-get-filename nil t)))
(let ((target-dir (file-name-directory target-path))
(target-symlink (file-symlink-p target-path))
(target-file))
;; if the target is a symlink and there's nothing more interesting to do
;; then follow the symlink:
(when (and target-symlink
(string= target-dir (dired-current-directory))
(not (eq major-mode 'sunrise-virtual-mode)))
(unless (file-exists-p target-symlink)
(error "Sunrise: file is a symlink to a nonexistent target"))
(setq target-path target-symlink)
(setq target-dir (file-name-directory target-symlink)))
(setq target-file (file-name-nondirectory target-path))
(when target-dir ;; <-- nil in symlinks to other files in same directory:
(setq target-dir (sunrise-chop ?/ target-dir))
(sunrise-goto-dir target-dir))
(sunrise-focus-filename target-file)))
(defun sunrise-follow-viewer ()
"Go to the directory of the file displayed in the viewer window."
(interactive)
(when sunrise-running
(let* ((viewer (sunrise-viewer-window))
(viewer-buffer (when viewer (window-buffer viewer)))
(target-dir) (target-file))
(when viewer-buffer
(with-current-buffer viewer-buffer
(setq target-dir default-directory
target-file (sunrise-directory-name-proper (buffer-file-name)))))
(sunrise-select-window sunrise-selected-window)
(when target-dir (sunrise-goto-dir target-dir))
(when target-file (sunrise-focus-filename target-file)))))
(defun sunrise-project-path ()
"Find projections of the active directory over the passive one.
Locates interactively all descendants of the directory in the passive pane that
have a path similar to the directory in the active pane.
For instance, if the active pane is displaying directory /a/b/c and the passive
one is displaying /x/y, this command will check for the existence of any of the
following: /x/y/a/b/c, /x/y/b/c, /x/y/c and /x/y. Each (existing) directory
located according to this schema will be known hereafter as a 'projection of the
directory /a/b/c over /x/y'.
If many projections of the active directory over the passive one exist, one can
rotate among all of them by invoking `sunrise-project-path' repeatedly : they will be
visited in order, from longest path to shortest."
(interactive)
(let* ((sunrise-synchronized nil)
(path (sunrise-chop ?/ (expand-file-name (dired-current-directory))))
(pos (when (< 0 (length path)) 1))
(candidate)
(next-key))
(while pos
(setq candidate (concat sunrise-other-directory (substring path pos))
pos (string-match "/" path (1+ pos))
pos (when pos (1+ pos)))
(when (and (file-directory-p candidate)
(not (sunrise-equal-dirs sunrise-this-directory candidate)))
(sunrise-goto-dir-other candidate)
(setq next-key (read-key-sequence "(press C-M-o again for more)"))
(if (eq (lookup-key sunrise-mode-map next-key) 'sunrise-project-path)
(sunrise-history-prev-other)
(setq unread-command-events (listify-key-sequence next-key)
pos nil))))
(unless next-key
(message "Sunrise: sorry, no suitable projections found"))))
(defun sunrise-history-push (element)
"Push a new path into the history stack of the current pane."
(let ((type (sunrise-history-entry-type element)))
(when type
(let* ((pane (assoc sunrise-selected-window sunrise-history-registry))
(hist (cdr pane))
(len (length hist)))
(when (>= len sunrise-history-length)
(nbutlast hist (- len sunrise-history-length)))
(when (eq 'local type)
(setq element (abbreviate-file-name (sunrise-chop ?/ element))))
(setq hist (delete element hist))
(push element hist)
(setcdr pane hist))
(sunrise-history-stack-reset))))
(defun sunrise-history-next ()
"Navigate forward in the history of the active pane."
(interactive)
(let ((side (assoc sunrise-selected-window sunrise-history-stack)))
(unless (zerop (cadr side))
(sunrise-history-move -1))
(when (zerop (cadr side))
(sunrise-history-stack-reset))))
(defun sunrise-history-prev ()
"Navigate backwards in the history of the active pane."
(interactive)
(let ((history (cdr (assoc sunrise-selected-window sunrise-history-registry)))
(stack (cdr (assoc sunrise-selected-window sunrise-history-stack))))
(when (< (abs (cdr stack)) (1- (length history)))
(sunrise-history-move 1))))
(defun sunrise-history-move (step)
"Traverse the history of the active pane in a stack-like fashion.
This function re-arranges the history list of the current pane so as to make it
simulate a stack of directories, from which one can 'pop' the current directory
and 'push' it back, keeping the most recently visited entries always near the
top of the stack."
(let* ((side (assoc sunrise-selected-window sunrise-history-stack))
(depth (cadr side)) (goal) (target-dir))
(when (> 0 (* step depth))
(sunrise-history-stack-reset))
(setq goal (1+ (cddr side))
depth (* step (+ (abs depth) step))
target-dir (sunrise-history-pick goal))
(when target-dir
(sunrise-goto-dir target-dir)
(setcdr side (cons depth goal)))))
(defun sunrise-history-stack-reset ()
"Reset the current history stack counter."
(let ((side (assoc sunrise-selected-window sunrise-history-stack)))
(setcdr side '(0 . 0))))
(defun sunrise-history-pick (position)
"Return directory at POSITION in current history.
If the entry was removed or made inaccessible since our last visit, remove it
from the history list and check among the previous ones until an accessible
directory is found, or the list runs out of entries."
(let* ((history (cdr (assoc sunrise-selected-window sunrise-history-registry)))
(target (nth position history)))
(while (not (sunrise-history-entry-type target))
(delete target history)
(setq target (nth position history)))
target))
(defun sunrise-history-entry-type (entry)
"Determine the type of the given history ENTRY.
Evaluate to: 'tramp if the entry is a valid remote entry, 'local
if the entry represents a directory in the local file system, or
nil if the argument is not a valid history entry."
(when entry
(cond ((string-match tramp-file-name-regexp entry)
'tramp)
((file-accessible-directory-p entry)
'local)
(t nil))))
(defun sunrise-history-purge-remote()
"Remove all remote entries from the history of directories."
(interactive)
(mapc
(lambda (side)
(let ((pane (assoc side sunrise-history-registry))
(regex tramp-file-name-regexp))
(setcdr pane (delq nil (mapcar (lambda (x)
(and (not (string-match regex x)) x))
(cdr pane))))))
'(left right)))
(defun sunrise-require-checkpoint-extension (&optional noerror)
"Bootstrap code for checkpoint support.
Just tries to require the appropriate checkpoints extension
depending on the version of bookmark.el being used."
(require 'bookmark nil t)
(or (not (featurep 'sunrise))
(require 'sunrise-checkpoint nil t)
noerror
(error "Feature `sunrise-checkpoint' not found!\
For checkpoints to work, add sunrise-checkpoint.el to your `load-path'")))
(defmacro sunrise-define-checkpoint-command (function-name)
`(defun ,function-name (&optional arg)
(interactive)
(sunrise-require-checkpoint-extension)
(if (commandp #',function-name)
(call-interactively #',function-name)
(funcall #',function-name arg))))
(sunrise-define-checkpoint-command sunrise-checkpoint-save)
(sunrise-define-checkpoint-command sunrise-checkpoint-restore)
(sunrise-define-checkpoint-command sunrise-checkpoint-handler)
;;;###autoload (autoload 'sunrise-checkpoint-handler "sunrise" "" t)
(defun sunrise-do-find-marked-files (&optional noselect)
"Sunrise replacement for `dired-do-find-marked-files'."
(interactive "P")
(let* ((files (delq nil (mapcar (lambda (x)
(and (file-regular-p x) x))
(dired-get-marked-files)))))
(unless files
(error "Sunrise: no regular files to open"))
(unless noselect (sunrise-quit))
(dired-simultaneous-find-file files noselect)))
;;; ============================================================================
;;; Graphical interface interaction functions:
(defun sunrise-detect-switch ()
"Detect Sunrise pane switches and update tracking state accordingly."
(when (and sunrise-running
(not sunrise-inhibit-switch)
(eq (selected-window) (sunrise-other 'window)))
(let ((there sunrise-this-directory))
(setq sunrise-selected-window (sunrise-other)
sunrise-selected-window-width nil
sunrise-this-directory default-directory
sunrise-other-directory there)
(sunrise-save-panes-width)
(sunrise-highlight))))
(defun sunrise-change-window()
"Change to the other Sunrise pane."
(interactive)
(sunrise-select-window (sunrise-other))
(setq sunrise-selected-window-width nil))
(defun sunrise-mouse-change-window (e)
"Change to the Sunrise pane clicked in by the mouse."
(interactive "e")
(mouse-set-point e))
(defun sunrise-mouse-move-cursor (event)
"Move the cursor to the current mouse position.
This function is called only if the `sunrise-cursor-follows-mouse' custom variable
\(which see) has not been set to nil."
(interactive "e")
(if (< sunrise-mouse-events-count sunrise-mouse-events-threshold)
(setq sunrise-mouse-events-count (1+ sunrise-mouse-events-count))
(when (mouse-movement-p event)
(let ((mouse-pos (cadadr event))
(mouse-win (caadr event)))
(when (eq mouse-win (sunrise-other 'window))
(sunrise-change-window))
(when (numberp mouse-pos)
(goto-char mouse-pos))))))
(defun sunrise-select-window (side)
"Select/highlight the given Sunrise window (right or left)."
(select-window (symbol-value (sunrise-symbol side 'window))))
(defun sunrise-viewer-window ()
"Return an active window that can be used as the viewer."
(if (or (memq major-mode '(sunrise-mode sunrise-virtual-mode sunrise-tree-mode))
(memq (current-buffer) (list sunrise-left-buffer sunrise-right-buffer)))
(let ((current-window (selected-window)) (target-window))
(dotimes (_times 2)
(setq current-window (next-window current-window))
(unless (memq current-window (list sunrise-left-window sunrise-right-window))
(setq target-window current-window)))
target-window)
(selected-window)))
(defun sunrise-select-viewer-window (&optional force-setup)
"Select a window that is not a Sunrise pane.
If no suitable active window can be found and FORCE-SETUP is set,
calls the function `sunrise-setup-windows' and tries once again."
(interactive "p")
(let ((selected sunrise-selected-window)
(viewer (sunrise-viewer-window)))
(when (memq major-mode '(sunrise-mode
sunrise-tree-mode
sunrise-virtual-mode))
(hl-line-mode 1))
(cond (viewer
(select-window viewer))
(force-setup
(sunrise-setup-windows)
(select-window (sunrise-viewer-window))))
(setq sunrise-selected-window selected)))
(defun sunrise-beginning-of-buffer()
"Go to the first directory/file in Dired."
(interactive)
(goto-char (point-min))
(when (re-search-forward directory-listing-before-filename-regexp nil t)
(dotimes (_times 2)
(when (looking-at "\.\.?/?$")
(dired-next-line 1)))))
(defun sunrise-end-of-buffer()
"Go to the last directory/file in Dired."
(interactive)
(goto-char (point-max))
(re-search-backward directory-listing-before-filename-regexp)
(dired-next-line 0))
(defun sunrise-focus-filename (filename)
"Try to select FILENAME in the current buffer."
(when (and dired-omit-mode
(string-match (dired-omit-regexp) filename))
(dired-omit-mode -1))
(let ((sunrise-inhibit-highlight t)
(expr (sunrise-chop ?/ filename)))
(cond ((file-symlink-p filename)
(setq expr (concat (regexp-quote expr) " ->")))
((file-directory-p filename)
(setq expr (concat (regexp-quote expr) "\\(?:/\\|$\\)")))
((file-regular-p filename)
(setq expr (concat (regexp-quote expr) "$"))))
(setq expr (concat "[0-9] +" expr))
(beginning-of-line)
(unless (re-search-forward expr nil t)
(re-search-backward expr nil t)))
(beginning-of-line)
(re-search-forward directory-listing-before-filename-regexp nil t))
(defun sunrise-split-toggle()
"Change Sunrise window layout from horizontal to vertical to top and so on."
(interactive)
(cl-case sunrise-window-split-style
(horizontal (sunrise-split-setup 'vertical))
(vertical (sunrise-split-setup 'top))
(top (progn
(sunrise-split-setup 'horizontal)
(sunrise-in-other (revert-buffer))))
(t (sunrise-split-setup 'horizontal))))
(defun sunrise-split-setup(split-type)
(setq sunrise-window-split-style split-type)
(when sunrise-running
(when (eq sunrise-window-split-style 'top)
(sunrise-select-window 'left)
(delete-window sunrise-right-window)
(setq sunrise-panes-height (window-height)))
(sunrise-setup-windows))
(message "Sunrise: split style changed to \"%s\"" (symbol-name split-type)))
(defun sunrise-transpose-panes ()
"Change the order of the panes."
(interactive)
(unless (eq sunrise-left-buffer sunrise-right-buffer)
(mapc (lambda (x)
(let ((left (sunrise-symbol 'left x)) (right (sunrise-symbol 'right x)) (tmp))
(setq tmp (symbol-value left))
(set left (symbol-value right))
(set right tmp)))
'(directory buffer window))
(let ((tmp sunrise-this-directory))
(setq sunrise-this-directory sunrise-other-directory
sunrise-other-directory tmp))
(let ((here sunrise-selected-window))
(select-window sunrise-right-window)
(sunrise-setup-visible-panes)
(sunrise-select-window here))))
(defun sunrise-synchronize-panes (&optional reverse)
"Change the directory in the other pane to that in the current one.
If the optional parameter REVERSE is non-nil, performs the
opposite operation, ie. changes the directory in the current pane
to that in the other one."
(interactive "P")
(sunrise-assert-other)
(let ((target (current-buffer)) (sunrise-inhibit-highlight t))
(sunrise-change-window)
(cond (reverse
(setq target (current-buffer)))
(t
(sunrise-alternate-buffer (switch-to-buffer target))
(sunrise-history-push default-directory)))
(sunrise-change-window)
(when reverse
(sunrise-alternate-buffer (switch-to-buffer target))
(sunrise-history-push default-directory)
(revert-buffer)))
(sunrise-highlight))
(defun sunrise-browse-pane ()
"Browse the directory in the active pane."
(interactive)
(if (not (featurep 'browse-url))
(error "Sunrise: feature `browse-url' not available!")
(let ((url (concat "file://" (expand-file-name default-directory))))
(message "Browsing directory %s " default-directory)
(if (featurep 'w3m)
(eval '(w3m-goto-url url))
(browse-url url)))))
(defun sunrise-browse-file (&optional file)
"Display the selected file in the default web browser."
(interactive)
(unless (featurep 'browse-url)
(error "ERROR: Feature browse-url not available!"))
(setq file (or file (dired-get-filename)))
(sunrise-save-selected-window
(sunrise-select-viewer-window)
(let ((buff (current-buffer)))
(browse-url (concat "file://" file))
(unless (eq buff (current-buffer))
(sunrise-scrollable-viewer (current-buffer)))))
(message "Browsing \"%s\" in web browser" file))
(defun sunrise-revert-buffer (&optional _ignore-auto _no-confirm)
"Revert the current pane using the contents of the backup buffer (if any).
If the buffer is non-virtual the backup buffer is killed."
(interactive)
(if (buffer-live-p sunrise-backup-buffer)
(let ((marks (dired-remember-marks (point-min) (point-max)))
(focus (dired-get-filename 'verbatim t))
(inhibit-read-only t))
(erase-buffer)
(insert-buffer-substring sunrise-backup-buffer)
(sunrise-beginning-of-buffer)
(dired-mark-remembered marks)
(when focus
(sunrise-focus-filename focus))
(dired-change-marks ?\t ?*)
(when (eq 'sunrise-mode major-mode)
(sunrise-kill-backup-buffer)))
(unless (or (eq major-mode 'sunrise-virtual-mode)
(local-variable-p 'sunrise-virtual-buffer))
(dired-revert)
(cond ((string= "NUMBER" (get sunrise-selected-window 'sorting-order))
(sunrise-sort-by-number t))
((get sunrise-selected-window 'sorting-reverse)
(sunrise-reverse-pane)))))
(sunrise-display-attributes
(point-min) (point-max) sunrise-show-file-attributes)
(sunrise-highlight))
(defun sunrise-kill-pane-buffer ()
"Kill the buffer currently displayed in the active pane, or quit Sunrise.
Custom variable `sunrise-kill-unused-buffers' controls whether unused buffers are
killed automatically by Sunrise when the user navigates away from the directory
they contain. When this flag is set, all requests to kill the current buffer are
managed by just calling `sunrise-quit'."
(interactive)
(cond (sunrise-kill-unused-buffers
(sunrise-quit))
(t
(kill-buffer (current-buffer))
(let ((_x (pop (cdr (assoc sunrise-selected-window
sunrise-history-registry)))))
(sunrise-history-stack-reset)))))
(defun sunrise-quick-view (&optional arg)
"Quickly view the currently selected item.
On regular files, opens the file in quick-view mode (see `sunrise-quick-view-file'
for more details), on directories, visits the selected directory in the passive
pane, and on symlinks follows the file the link points to in the passive pane.
With optional argument kills the last quickly viewed file without opening a new
buffer."
(interactive "P")
(if arg
(sunrise-quick-view-kill)
(let ((name (dired-get-filename nil t)))
(cond ((file-directory-p name) (sunrise-quick-view-directory name))
((file-symlink-p name) (sunrise-quick-view-symlink name))
(t (sunrise-quick-view-file))))))
(defun sunrise-quick-view-kill ()
"Kill the last buffer opened using quick view (if any)."
(let ((buf other-window-scroll-buffer))
(when (and (buffer-live-p buf)
(or (not sunrise-confirm-kill-viewer)
(y-or-n-p (format "Kill buffer %s? " (buffer-name buf)))))
(setq other-window-scroll-buffer nil)
(save-window-excursion (kill-buffer buf)))))
(defun sunrise-quick-view-directory (name)
"Open the directory NAME in the passive pane."
(let ((name (expand-file-name name)))
(sunrise-in-other (sunrise-advertised-find-file name))))
(defun sunrise-quick-view-symlink (name)
"Follow the target of the symlink NAME in the passive pane."
(let ((name (expand-file-name (file-symlink-p name))))
(if (file-exists-p name)
(sunrise-in-other (sunrise-follow-file name))
(error "Sunrise: file is a symlink to a nonexistent target"))))
(defun sunrise-quick-view-file ()
"Open the selected file on the viewer window without selecting it.
Kills any other buffer opened previously the same way."
(let ((split-width-threshold (* 10 (window-width)))
(filename (expand-file-name (dired-get-filename nil t))))
(sunrise-save-selected-window
(condition-case description
(progn
(sunrise-select-viewer-window)
(find-file filename)
(when (and sunrise-kill-quick-view-buffers
(not (eq (current-buffer) other-window-scroll-buffer))
(buffer-live-p other-window-scroll-buffer))
(kill-buffer other-window-scroll-buffer))
(sunrise-scrollable-viewer (current-buffer)))
(error (message "%s" (cadr description)))))))
(defun sunrise-quit-function ()
(setq other-window-scroll-buffer nil))
(defun sunrise-kill-viewer-function ()
(when (eq (current-buffer) other-window-scroll-buffer)
(setq other-window-scroll-buffer nil)))
;; These clean up after a quick view:
(add-hook 'sunrise-quit-hook 'sunrise-quit-function)
(add-hook 'kill-buffer-hook 'sunrise-kill-viewer-function)
(defun sunrise-mask-attributes (beg end)
"Manage the hiding of attributes in region from BEG to END.
Selective hiding of specific attributes can be controlled by customizing the
`sunrise-attributes-display-mask' variable."
(let ((cursor beg))
(cl-labels ((sunrise-make-display-props
(display-function-or-flag)
(cond ((functionp display-function-or-flag)
`(display
,(apply display-function-or-flag
(list (buffer-substring cursor (1- (point)))))))
((null display-function-or-flag)
'(invisible sunrise))
(t nil))))
(if sunrise-attributes-display-mask
(cl-block block
(mapc (lambda (do-display)
(search-forward-regexp "\\w")
(search-forward-regexp "\\s-")
(forward-char -1)
(add-text-properties
cursor (point) (sunrise-make-display-props do-display))
(setq cursor (point))
(when (>= (point) end)
(cl-return-from block)))
sunrise-attributes-display-mask))
(unless (>= cursor end)
(put-text-property cursor (1- end) 'invisible 'sunrise))))))
(defun sunrise-display-attributes (beg end visiblep)
"Manage the display of file attributes in the region from BEG to END.
if VISIBLEP is nil then shows file attributes in region, otherwise hides them."
(let ((inhibit-read-only t) (next))
(save-excursion
(goto-char beg)
(forward-line -1)
(while (and (null next) (< (point) end))
(forward-line 1)
(setq next (dired-move-to-filename)))
(while (and next (< next end))
(beginning-of-line)
(forward-char 1)
(cond ((not visiblep)
(sunrise-mask-attributes (point) next))
(t
(remove-text-properties (point) next '(invisible sunrise))
(remove-text-properties (point) next '(display))))
(forward-line 1)
(setq next (dired-move-to-filename))))))
(defun sunrise-toggle-attributes ()
"Hide/Show the attributes of all files in the active pane."
(interactive)
(setq sunrise-show-file-attributes (not sunrise-show-file-attributes))
(sunrise-display-attributes (point-min) (point-max) sunrise-show-file-attributes))
(defun sunrise-toggle-truncate-lines ()
"Enable/Disable truncation of long lines in the active pane."
(interactive)
(cond ((sunrise-truncate-p)
(setq truncate-partial-width-windows (sunrise-truncate-v nil))
(message "Sunrise: wrapping long lines"))
(t
(setq truncate-partial-width-windows (sunrise-truncate-v t))
(message "Sunrise: truncating long lines")))
(sunrise-silently (dired-do-redisplay)))
(defun sunrise-truncate-p ()
"Return non-nil if `truncate-partial-width-windows' affects the current pane.
Used by `sunrise-toggle-truncate-lines'."
(if (numberp truncate-partial-width-windows)
(< 0 truncate-partial-width-windows)
truncate-partial-width-windows))
(defun sunrise-truncate-v (active)
"Return the appropriate value for `truncate-partial-width-widows'.
Depends on the Emacs version being used. Used by
`sunrise-toggle-truncate-lines'."
(or (and (version<= "23" emacs-version)
(or (and active 3000) 0))
active))
(defun sunrise-sort-order (label option)
"Change the sorting order of the active pane.
Appends additional options to `dired-listing-switches' and
reverts the buffer."
(if (eq major-mode 'sunrise-virtual-mode)
(sunrise-sort-virtual option)
(let ((option (if (= 0 (length option)) option (concat " -" option))))
(put sunrise-selected-window 'sorting-order label)
(put sunrise-selected-window 'sorting-options option)
(let ((dired-listing-switches dired-listing-switches))
(unless (string-match "^/ftp:" default-directory)
(setq dired-listing-switches sunrise-listing-switches))
(dired-sort-other (concat dired-listing-switches option) t))
(revert-buffer)))
(message "Sunrise: sorting entries by %s" label))
(defmacro sunrise-define-sort-by-function (postfix options)
"Helper macro for defining `sunrise-sort-by-xxx' functions."
`(defun ,(intern (format "sunrise-sort-by-%s" postfix)) ()
,(format "Sorts the contents of the current Sunrise pane by %s." postfix)
(interactive)
(sunrise-sort-order ,(upcase postfix) ,options)))
(sunrise-define-sort-by-function "name" "")
(sunrise-define-sort-by-function "extension" "X")
(sunrise-define-sort-by-function "time" "t")
(sunrise-define-sort-by-function "size" "S")
(defun sunrise-sort-by-number (&optional inhibit-label)
"Sort the contents of the current Sunrise pane numerically.
Displays entries containing unpadded numbers in a more logical
order than when sorted alphabetically by name."
(interactive)
(sunrise-sort-by-operation 'sunrise-numerical-sort-op (unless inhibit-label "NUMBER"))
(when (get sunrise-selected-window 'sorting-reverse)
(sunrise-reverse-pane)))
(defun sunrise-interactive-sort (order)
"Prompt for a new sorting order for the active pane and apply it."
(interactive "cSort by (n)ame, n(u)mber, (s)ize, (t)ime or e(x)tension? ")
(when (>= order 97)
(setq order (- order 32)))
(cl-case order
(?U (sunrise-sort-by-number))
(?T (sunrise-sort-by-time))
(?S (sunrise-sort-by-size))
(?X (sunrise-sort-by-extension))
(t (sunrise-sort-by-name))))
(defun sunrise-reverse-pane (&optional interactively)
"Reverse the contents of the active pane."
(interactive "p")
(let ((line (line-number-at-pos))
(reverse (get sunrise-selected-window 'sorting-reverse)))
(sunrise-sort-by-operation 'identity)
(when interactively
(put sunrise-selected-window 'sorting-reverse (not reverse))
(goto-char (point-min)) (forward-line (1- line))
(re-search-forward directory-listing-before-filename-regexp nil t))))
(defun sunrise-sort-virtual (option)
"Manage sorting of buffers in Sunrise VIRTUAL mode."
(let ((opt (string-to-char option)) (inhibit-read-only t) (beg) (end))
(cl-case opt
(?X (sunrise-end-of-buffer)
(setq end (point-at-eol))
(sunrise-beginning-of-buffer)
(setq beg (point-at-bol))
(sort-regexp-fields nil "^.*$" "[/.][^/.]+$" beg end))
(?t (sunrise-sort-by-operation
(lambda (x) (sunrise-attribute-sort-op 5 t x)) "TIME"))
(?S (sunrise-sort-by-operation
(lambda (x) (sunrise-attribute-sort-op 7 t x)) "SIZE"))
(t (sunrise-sort-by-operation
(lambda (x) (sunrise-attribute-sort-op -1 nil x)) "NAME")))))
(defun sunrise-sort-by-operation (operation &optional label)
"General function for reordering the contents of a Sunrise pane.
OPERATION is a function that receives a list produced by
`sunrise-build-sort-lists', reorders it in some way, transforming it
into a list that can be passed to `sort-reorder', so the records
in the current buffer are reordered accordingly. The LABEL is a
string that will be used to set the sorting order of the current
pane and then displayed in the minibuffer; if it's not provided
or its value is nil then the ordering enforced by this function
is transient and can be undone by reverting the pane, or by
moving it to a different directory. See `sunrise-numerical-sort-op'
and `sunrise-attribute-sort-op' for examples of OPERATIONs."
(interactive)
(let ((messages (> (- (point-max) (point-min)) 50000))
(focus (dired-get-filename 'verbatim t))
(inhibit-read-only t))
(when messages (message "Finding sort keys..."))
(let* ((sort-lists (sunrise-build-sort-lists))
(old (reverse sort-lists))
(beg) (end))
(when messages (message "Sorting records..."))
(setq sort-lists (apply operation (list sort-lists)))
(when messages (message "Reordering buffer..."))
(save-excursion
(save-restriction
(sunrise-end-of-buffer)
(setq end (point-at-eol))
(sunrise-beginning-of-buffer)
(setq beg (point-at-bol))
(narrow-to-region beg end)
(sort-reorder-buffer sort-lists old)))
(when messages (message "Reordering buffer... Done")))
(sunrise-highlight)
(when focus (sunrise-focus-filename focus))
(when label
(put sunrise-selected-window 'sorting-order label)
(message "Sunrise: sorting entries by %s" label)))
nil)
(defun sunrise-numerical-sort-op (sort-lists)
"Strategy used to numerically sort contents of a Sunrise pane.
Used by `sunrise-sort-by-operation'. See `sunrise-sort-by-number' for more
on this kind of sorting."
(mapcar
'cddr
(sort
(sort
(mapcar
(lambda (x)
(let ((key (buffer-substring-no-properties (car x) (cddr x))))
(append
(list key
(string-to-number (replace-regexp-in-string "^[^0-9]*" "" key))
(cdr x))
(cdr x))))
sort-lists)
(lambda (a b) (string< (car a) (car b))))
(lambda (a b) (< (cadr a) (cadr b))))))
(defun sunrise-attribute-sort-op (nth-attr as-number sort-lists)
"Strategy used to sort contents of a Sunrise pane according to file attributes.
Used by `sunrise-sort-by-operation'. See `file-attributes' for a list
of supported attributes and their positions. Directories are
forced to remain always on top. NTH-ATTR is the position of the
attribute to use for sorting, or -1 for the name of the file.
AS-NUMBER determines whether comparisons will be numeric or
alphabetical. SORT-LISTS is a list of positions obtained from
`sunrise-build-sort-lists'."
(let ((attributes (sunrise-files-attributes))
(zero (if as-number 0 "")))
(mapcar
'cddr
(sort
(sort
(mapcar
(lambda (x)
(let* ((key (buffer-substring-no-properties (car x) (cddr x)))
(key (sunrise-chop ?/ (replace-regexp-in-string " -> .*$" "" key)))
(attrs (assoc-default key attributes))
(index))
(when attrs
(setq attrs (apply 'cons attrs)
index (or (nth (1+ nth-attr) attrs) zero))
(append (list (cadr attrs) index (cdr x)) (cdr x)))))
sort-lists)
(lambda (a b) (sunrise-compare nth-attr (cadr b) (cadr a))))
(lambda (a b)
(if (and (car a) (car b))
(sunrise-compare nth-attr (cadr b) (cadr a))
(and (car a) (not (stringp (car a))))))))))
(defun sunrise-build-sort-lists ()
"Analyse contents of the current Sunrise pane for `sunrise-sort-by-operation'.
Builds a list of dotted lists of the form (a b . c) -- where 'a'
is the position at the start of the file name in an entry, while
'b' and 'c' are the start and end positions of the whole entry.
These lists are used by `sunrise-sort-by-operation' to sort the
contents of the pane in arbitrary ways."
(delq nil
(mapcar
(lambda (x) (and (atom (car x)) x))
(save-excursion
(sunrise-beginning-of-buffer)
(beginning-of-line)
(sort-build-lists 'forward-line 'end-of-line 'dired-move-to-filename
nil)))))
(defun sunrise-compare (mode a b)
"General comparison function, used to sort files in VIRTUAL buffers.
MODE must be a number; if it is less than 0, the direction of the
comparison is inverted: (sunrise-compare -1 a b) === (sunrise-compare 1
b a). Compares numbers using `<', strings case-insensitively
using `string<' and lists recursively until the first two
elements that are non-equal are found."
(when (< mode 0)
(setq mode (abs mode))
(let ((olda a))
(setq a b)
(setq b olda)))
(cond ((or (null a) (null b)) nil)
((and (listp a) (listp b)) (if (= (car a) (car b))
(sunrise-compare mode (cdr a) (cdr b))
(sunrise-compare mode (car a) (car b))))
((and (stringp a) (stringp b)) (string< (downcase a) (downcase b)))
((and (numberp a) (numberp b)) (< a b))
(t nil)))
(defun sunrise-scroll-up ()
"Scroll the current pane or (if active) the viewer pane 1 line up."
(interactive)
(if (buffer-live-p other-window-scroll-buffer)
(sunrise-save-selected-window
(sunrise-select-viewer-window)
(scroll-up 1))
(scroll-up 1)))
(defun sunrise-scroll-down ()
"Scroll the current pane or (if active) the viewer pane 1 line down."
(interactive)
(if (buffer-live-p other-window-scroll-buffer)
(sunrise-save-selected-window
(sunrise-select-viewer-window)
(scroll-down 1))
(scroll-down 1)))
(defun sunrise-scroll-quick-view ()
"Scroll down the viewer window during a quick view."
(interactive)
(when other-window-scroll-buffer
(scroll-other-window)))
(defun sunrise-scroll-quick-view-down ()
"Scroll down the viewer window during a quick view."
(interactive)
(when other-window-scroll-buffer
(scroll-other-window-down nil)))
(defun sunrise-undo ()
"Restore selection as it was before the last file operation."
(interactive)
(dired-undo)
(sunrise-highlight))
;;; ============================================================================
;;; Passive & synchronized navigation functions:
(defun sunrise-sync ()
"Toggle the Sunrise synchronized navigation feature."
(interactive)
(setq sunrise-synchronized (not sunrise-synchronized))
(mapc 'sunrise-mark-sync (list sunrise-left-buffer sunrise-right-buffer))
(message "Sunrise: sync navigation is now %s"
(if sunrise-synchronized "ON" "OFF"))
(run-hooks 'sunrise-refresh-hook)
(sunrise-in-other (run-hooks 'sunrise-refresh-hook)))
(defun sunrise-mark-sync (&optional buffer)
"Change `mode-name' depending on whether synchronized navigation is enabled."
(save-window-excursion
(if buffer
(switch-to-buffer buffer))
(setq mode-name
(concat "Sunrise "
(if sunrise-synchronized "SYNC-NAV" "Commander")))))
;; This advertises synchronized navigation in all new buffers:
(add-hook 'sunrise-mode-hook 'sunrise-mark-sync)
(defun sunrise-next-line-other ()
"Move the cursor down in the passive pane."
(interactive)
(sunrise-in-other (dired-next-line 1)))
(defun sunrise-prev-line-other ()
"Move the cursor up in the passive pane."
(interactive)
(sunrise-in-other (dired-next-line -1)))
(defun sunrise-goto-dir-other (dir)
"Change the current directory in the passive pane to the given one."
(interactive (list (read-directory-name
"Change directory in PASSIVE pane (file or pattern): "
sunrise-other-directory)))
(sunrise-in-other (sunrise-goto-dir dir)))
(defun sunrise-advertised-find-file-other ()
"Open the file/directory selected in the passive pane."
(interactive)
(when sunrise-synchronized
(let ((target (sunrise-directory-name-proper (dired-get-filename))))
(sunrise-change-window)
(cond ((file-directory-p target)
(sunrise-goto-dir (expand-file-name target)))
((y-or-n-p "Unable to synchronize. Disable sync navigation? ")
(sunrise-sync)))
(sunrise-change-window)
(sunrise-advertised-find-file))
(sunrise-in-other (sunrise-advertised-find-file))))
(defun sunrise-mouse-advertised-find-file (_e)
"Open the file/directory pointed to by the mouse."
(interactive "e")
(sunrise-advertised-find-file))
(defun sunrise-prev-subdir-other (&optional count)
"Go to the previous subdirectory in the passive pane."
(interactive "P")
(let ((count (or count 1)))
(sunrise-in-other (sunrise-dired-prev-subdir count))))
(defun sunrise-follow-file-other ()
"Go to the directory of the selected file, but in the passive pane."
(interactive)
(let ((filename (dired-get-filename nil t)))
(sunrise-in-other (sunrise-follow-file filename))))
(defun sunrise-history-prev-other ()
"Change to previous directory (if any) in the passive pane's history list."
(interactive)
(sunrise-in-other (sunrise-history-prev)))
(defun sunrise-history-next-other ()
"Change to the next directory (if any) in the passive pane's history list."
(interactive)
(sunrise-in-other (sunrise-history-next)))
(defun sunrise-mark-other (arg)
"Mark the current (or next ARG) files in the passive pane."
(interactive "P")
(setq arg (or arg 1))
(sunrise-in-other (dired-mark arg)))
(defun sunrise-unmark-backward-other (arg)
(interactive "p")
(sunrise-in-other (dired-unmark-backward arg)))
(defun sunrise-unmark-all-marks-other ()
"Remove all marks from the passive pane."
(interactive)
(sunrise-in-other (dired-unmark-all-marks)))
;;; ============================================================================
;;; Progress feedback functions:
(defun sunrise-progress-prompt (op-name)
"Build the default progress feedback message."
(concat "Sunrise: " op-name "... "))
(defun sunrise-make-progress-reporter (op-name totalsize)
"Make a new Sunrise progress reporter.
Prepends two integers (accumulator and scale) to a standard
progress reporter (built using `make-progress-reporter' from
subr.el): accumulator keeps the current state of the reporter,
and scale is used when the absolute value of 100% is bigger than
`most-positive-fixnum'."
(let ((accumulator 0) (scale 1) (maxval totalsize))
(when (> totalsize most-positive-fixnum)
(setq scale (/ totalsize most-positive-fixnum))
(setq maxval most-positive-fixnum))
(list accumulator scale
(make-progress-reporter
(sunrise-progress-prompt op-name) 0 maxval 0 1 0.5))))
(defun sunrise-progress-reporter-update (reporter size)
"Update REPORTER (a Sunrise progress reporter) by adding SIZE to its state."
(let ((scale (cadr reporter)))
(setcar reporter (+ (truncate (/ size scale)) (car reporter)))
(progress-reporter-update (car (cddr reporter)) (car reporter))))
(defun sunrise-progress-reporter-done (reporter)
"Print REPORTER's feedback message followed by \"done\" in echo area."
(progress-reporter-done (car (cddr reporter))))
;;; ============================================================================
;;; File manipulation functions:
(defun sunrise-create-files (&optional qty)
"Interactively create empty file(s) with the given name or template.
Optional prefix argument specifies the number of files to create.
*NEVER* overwrites existing files. A template may contain one
%-sequence like those used by `format', but the only supported
specifiers are: d (decimal), x (hex) or o (octal)."
(interactive "p")
(let* ((qty (or (and (integerp qty) (< 0 qty) qty) 1))
(prompt (if (>= 1 qty) "Create file: "
(format "Create %d files using template: " qty)))
(filename (read-file-name prompt)) (name))
(with-temp-buffer
(if (>= 1 qty)
(unless (file-exists-p filename)
(write-file filename))
(unless (string-match "%[0-9]*[dox]" filename)
(setq filename (concat filename ".%d")))
(setq filename (replace-regexp-in-string "%\\([^%]\\)" "%%\\1" filename)
filename (replace-regexp-in-string
"%%\\([0-9]*[dox]\\)" "%\\1" filename))
(dotimes (n qty)
(setq name (format filename (1+ n)))
(unless (file-exists-p name)
(write-file name)))))
(sunrise-revert-buffer)))
(defun sunrise-editable-pane ()
"Put the current pane in File Names Editing mode (`wdired-mode')."
(interactive)
(sunrise-graphical-highlight 'sunrise-editing-path-face)
(let* ((was-virtual (eq major-mode 'sunrise-virtual-mode))
(major-mode 'dired-mode))
(wdired-change-to-wdired-mode)
(when was-virtual
(set (make-local-variable 'sunrise-virtual-buffer) t)))
(run-hooks 'sunrise-refresh-hook))
(defun sunrise-readonly-pane (as-virtual)
"Put the current pane back in Sunrise mode."
(when as-virtual
(sunrise-virtual-mode)
(sunrise-force-passive-highlight t))
(dired-build-subdir-alist)
(sunrise-revert-buffer))
(defmacro sunrise-protect-terminate-wdired (&rest body)
"Compile the `cl-letf' forms used in `sunrise-terminate-wdired'.
This macro allows interpreted code to work without requiring
cl-macs at runtime."
`(cl-letf (((symbol-function 'yes-or-no-p) (lambda (prompt) (ignore)))
((symbol-function 'revert-buffer)
(lambda (&optional ignore-auto noconfirm preserve-modes))
(ignore)))
,@body))
(defun sunrise-terminate-wdired (fun)
"Restore the current pane's original mode after editing with WDired."
(ad-add-advice
fun
(ad-make-advice
(intern (concat "sunrise-advice-" (symbol-name fun))) nil t
`(advice
lambda ()
(if (not sunrise-running)
ad-do-it
(let ((was-virtual (local-variable-p 'sunrise-virtual-buffer))
(saved-point (point)))
(sunrise-save-aspect
(setq major-mode 'wdired-mode)
(sunrise-protect-terminate-wdired ad-do-it)
(sunrise-readonly-pane was-virtual)
(goto-char saved-point))
(sunrise-unhighlight 'sunrise-editing-path-face)))))
'around 'last)
(ad-activate fun nil))
(sunrise-terminate-wdired 'wdired-finish-edit)
(sunrise-terminate-wdired 'wdired-abort-changes)
(defun sunrise-do-copy ()
"Copy selected files and directories recursively to the passive pane."
(interactive)
(let* ((items (dired-get-marked-files nil))
(vtarget (sunrise-virtual-target))
(target (or vtarget sunrise-other-directory))
(progress))
(if (and (not vtarget)
(sunrise-equal-dirs default-directory sunrise-other-directory))
(dired-do-copy)
(when (sunrise-ask "Copy" target items #'y-or-n-p)
(cond (vtarget
(sunrise-copy-virtual)
(message "Done: %d items(s) copied" (length items)))
(t
(setq progress (sunrise-make-progress-reporter
"copying" (sunrise-files-size items)))
(sunrise-clone items target #'copy-file progress ?C)
(sunrise-progress-reporter-done progress)))
(sunrise-silently (dired-unmark-all-marks))))))
(defun sunrise-do-symlink ()
"Symlink selected files or directories from one pane to the other."
(interactive)
(if (sunrise-equal-dirs default-directory sunrise-other-directory)
(dired-do-symlink)
(sunrise-link #'make-symbolic-link "Symlink" dired-keep-marker-symlink)))
(defun sunrise-do-relsymlink ()
"Symlink selected files or directories from one pane to the other relatively.
See `dired-make-relative-symlink'."
(interactive)
(if (sunrise-equal-dirs default-directory sunrise-other-directory)
(dired-do-relsymlink)
(sunrise-link #'dired-make-relative-symlink
"RelSymLink"
dired-keep-marker-relsymlink)))
(defun sunrise-do-hardlink ()
"Same as `dired-do-hardlink', but refuse to hardlink files to VIRTUAL buffers."
(interactive)
(if (sunrise-virtual-target)
(error "Cannot hardlink files to a VIRTUAL buffer, try (C)opying instead")
(dired-do-hardlink)))
(defun sunrise-do-rename ()
"Move selected files and directories recursively from one pane to the other."
(interactive)
(when (sunrise-virtual-target)
(error "Cannot move files to a VIRTUAL buffer, try (C)opying instead"))
(if (sunrise-equal-dirs default-directory sunrise-other-directory)
(dired-do-rename)
(let ((marked (dired-get-marked-files)))
(when (sunrise-ask "Move" sunrise-other-directory marked #'y-or-n-p)
(let ((names (mapcar #'file-name-nondirectory marked))
(progress (sunrise-make-progress-reporter "renaming" (length marked)))
(inhibit-read-only t))
(sunrise-in-other
(progn
(sunrise-move-files marked default-directory progress)
(revert-buffer)
(when (eq major-mode 'sunrise-mode)
(dired-mark-remembered
(mapcar (lambda (x) (cons (expand-file-name x) ?R)) names))
(sunrise-focus-filename (car names)))))
(sunrise-progress-reporter-done progress))
(sunrise-silently (revert-buffer))))))
(defun sunrise-do-delete ()
"Remove selected files from the file system."
(interactive)
(let* ((files (dired-get-marked-files))
(mode (sunrise-ask "Delete" nil files #'sunrise-y-n-or-a-p))
(deletion-mode (cond ((eq mode 'ALWAYS) 'always)
(mode 'top)
(t (error "(No deletions performed)")))))
(mapc (lambda (x)
(message "Deleting %s" x)
(dired-delete-file x deletion-mode delete-by-moving-to-trash))
files)
(if (eq major-mode 'sunrise-virtual-mode)
(dired-do-kill-lines)
(revert-buffer))))
(defun sunrise-do-flagged-delete ()
"Remove flagged files from the file system."
(interactive)
(let* ((dired-marker-char dired-del-marker)
(regexp (dired-marker-regexp)) )
(if (save-excursion (goto-char (point-min))
(re-search-forward regexp nil t))
(sunrise-do-delete)
(message "(No deletions requested)"))))
(defun sunrise-do-clone-prompt (&optional is-fs)
"Prompt for the criteria to use when performing a clone operation."
(let* ((menu "(D)irectories only, (C)opies, (H)ardlinks, (S)ymlinks or (R)elative symlinks? ")
(maybe-fs (and (sunrise-virtual-source) (not (sunrise-virtual-target))))
(prompt (cond (is-fs (concat "Clone as file system of: " menu))
(maybe-fs (concat "Clone as: (F)ile System of: " menu))
(t (concat "Clone as: " menu))))
(resp (read-event prompt)))
(cond ((and maybe-fs (memq resp '(?f ?F))) (sunrise-do-clone-prompt t))
((not (memq resp '(?d ?D ?c ?C ?h ?H ?s ?S ?r ?R))) (sunrise-do-clone-prompt))
(is-fs (list resp ?t))
(t (list resp)))))
(defun sunrise-do-clone (&optional mode is-fs)
"Clone all selected items recursively into the passive pane."
(interactive (sunrise-do-clone-prompt))
(when (sunrise-virtual-target)
(error "Cannot clone into a VIRTUAL buffer, try (C)opying instead"))
(when (sunrise-equal-dirs default-directory sunrise-other-directory)
(error "Cannot clone inside one single directory, please select a\
different one in the passive pane"))
(let ((target sunrise-other-directory) clone-op items progress)
(when (and mode (>= mode 97))
(setq mode (- mode 32)))
(setq clone-op
(cl-case mode
(?D nil)
(?C #'copy-file)
(?H #'add-name-to-file)
(?S #'make-symbolic-link)
(?R #'dired-make-relative-symlink)
(t (error "Invalid cloning mode: %c" mode))))
(setq items (dired-get-marked-files nil))
(setq progress (sunrise-make-progress-reporter
"cloning" (sunrise-files-size items)))
(if is-fs
(sunrise-clone-fs (dired-get-marked-files t) target clone-op progress)
(sunrise-clone (dired-get-marked-files nil) target clone-op progress ?K))
(dired-unmark-all-marks)
(message "Done: %d items(s) dispatched" (length items))))
(defun sunrise-fast-backup-files ()
"Make backup copies of all marked files inside the same directory.
The extension to append to each filename can be controlled by
setting the value of the `sunrise-fast-backup-extension' custom
variable. Directories are not copied."
(interactive)
(dired-do-copy-regexp
"$" (if (listp sunrise-fast-backup-extension)
(eval sunrise-fast-backup-extension)
sunrise-fast-backup-extension))
(revert-buffer))
(defun sunrise-clone-fs (items target clone-op progress)
"Clone all the given ITEMS (paths to files and/or directories)
recursively to TARGET (a directory), but keeping the directory
structure given by every path in ITEMS. CLONE-OP is the cloning
operation and PROGRESS is the progress monitor."
(mapc (lambda (i)
(let* ((from (expand-file-name i))
(to (concat (directory-file-name target) "/"
(or (file-name-directory i) ""))))
(unless (file-exists-p to)
(make-directory to t))
(sunrise-clone (list from) to clone-op progress nil)))
items))
(defun sunrise-clone (items target clone-op progress mark-char)
"Clone all the given ITEMS (files and directories) recursively
to TARGET (a directory) using CLONE-OP as the cloning operation
and reporting progress to the given PROGRESS monitor. Finally,
mark all resulting artifacts with the MARK-CHAR mark."
(let ((names (mapcar #'file-name-nondirectory items))
(inhibit-read-only t))
(with-current-buffer (sunrise-other 'buffer)
(sunrise-clone-files items target clone-op progress))
(when (window-live-p (sunrise-other 'window))
(sunrise-in-other
(progn
(revert-buffer)
(when (and mark-char (memq major-mode '(sunrise-mode sunrise-virtual-mode)))
(dired-mark-remembered
(mapcar (lambda (x) (cons (expand-file-name x) mark-char)) names))
(sunrise-focus-filename (car names))))))))
(defun sunrise-clone-files (file-paths target-dir clone-op progress
&optional do-overwrite)
"Clone all files in FILE-PATHS to TARGET-DIR using CLONE-OP to
clone the files. FILE-PATHS should be a list of absolute paths."
(setq target-dir (replace-regexp-in-string "/?$" "/" target-dir))
(mapc
(function
(lambda (f)
(sunrise-progress-reporter-update progress (nth 7 (file-attributes f)))
(let* ((name (file-name-nondirectory f))
(target-file (concat target-dir name))
(symlink-to (file-symlink-p (sunrise-chop ?/ f)))
(clone-args (list f target-file t)))
(cond
(symlink-to
(progn
(when (file-exists-p symlink-to)
(setq symlink-to (expand-file-name symlink-to)))
(make-symbolic-link symlink-to target-file do-overwrite)))
((file-directory-p f)
(let ((initial-path (file-name-directory f)))
(unless (file-symlink-p initial-path)
(sunrise-clone-directory
initial-path name target-dir clone-op progress do-overwrite))))
(clone-op
;; (message "[[Cloning: %s => %s]]" f target-file)
(when (eq clone-op 'copy-file)
(setq clone-args
(append clone-args (list dired-copy-preserve-time))))
(if (file-exists-p target-file)
(if (or (eq do-overwrite 'ALWAYS)
(setq do-overwrite (sunrise-ask-overwrite target-file)))
(apply clone-op clone-args))
(apply clone-op clone-args)))))))
file-paths))
(defun sunrise-clone-directory (in-dir d to-dir clone-op progress do-overwrite)
"Clone directory IN-DIR/D and all its files recursively to TO-DIR.
IN-DIR/D => TO-DIR/D using CLONE-OP to clone the files."
(setq d (replace-regexp-in-string "/?$" "/" d))
(when (string= "" d)
(setq to-dir (concat to-dir (sunrise-directory-name-proper in-dir))))
(let* ((files-in-d (sunrise-list-of-contents (concat in-dir d)))
(file-paths-in-d
(mapcar (lambda (f) (concat in-dir d f)) files-in-d)))
(unless (file-exists-p (concat to-dir d))
(make-directory (concat to-dir d)))
(sunrise-clone-files file-paths-in-d (concat to-dir d) clone-op progress do-overwrite)))
(defsubst sunrise-move-op (file target-dir progress do-overwrite)
"Helper function used by `sunrise-move-files' to rename files and directories."
(condition-case nil
(dired-rename-file file target-dir do-overwrite)
(error
(sunrise-clone-directory file "" target-dir 'copy-file progress do-overwrite)
(dired-delete-file file 'always))))
(defun sunrise-move-files (file-path-list target-dir progress &optional do-overwrite)
"Move all files in FILE-PATH-LIST (list of full paths) to TARGET-DIR."
(mapc
(function
(lambda (f)
(if (file-directory-p f)
(progn
(setq f (replace-regexp-in-string "/?$" "/" f))
(sunrise-progress-reporter-update progress 1)
(sunrise-move-op f target-dir progress do-overwrite))
(let* ((name (file-name-nondirectory f))
(target-file (concat target-dir name)))
;; (message "Renaming: %s => %s" f target-file)
(sunrise-progress-reporter-update progress 1)
(if (file-exists-p target-file)
(if (or (eq do-overwrite 'ALWAYS)
(setq do-overwrite (sunrise-ask-overwrite target-file)))
(dired-rename-file f target-file t))
(dired-rename-file f target-file t)) ))))
file-path-list))
(defun sunrise-link (creator action marker)
"Helper function for implementing `sunrise-do-symlink' and `sunrise-do-relsymlink'."
(if (sunrise-virtual-target)
(error "Cannot link files to a VIRTUAL buffer, try (C)opying instead.")
(dired-create-files creator action (dired-get-marked-files nil)
(lambda (from)
(setq from (sunrise-chop ?/ from))
(if (file-directory-p from)
(setq from (sunrise-directory-name-proper from))
(setq from (file-name-nondirectory from)))
(expand-file-name from sunrise-other-directory))
marker)))
(defun sunrise-inplace ()
"Allow to select an in-place operation and execute it.
In-place operations are file operations that are executed in the
context of the current pane, totally ignoring the other one."
(interactive)
(let ((mode (read-char "In-place: (C)opy, (R)ename, (H)ardlink, (S)ymlink")))
(if (and mode (>= mode 97)) (setq mode (- mode 32)))
(cl-case mode
(?C (sunrise-inplace-do #'copy-file "Copy in place to"))
(?R (sunrise-inplace-do #'rename-file "Rename in place to"))
(?H (sunrise-inplace-do #'add-name-to-file "Add name in place"))
(?S (sunrise-inplace-do #'make-symbolic-link "Link in place to"))
(t (sunrise-inplace)))))
(defun sunrise-inplace-do (action prompt)
"Perform the given ACTION in the context of the current pane.
The given PROMPT will be displayed to the user interactively."
(let* ((marked (dired-get-marked-files))
(prompt (concat prompt ": "))
(target
(if (cdr marked)
(read-directory-name prompt)
(read-file-name
prompt nil nil nil (file-name-nondirectory (car marked)))))
(progress (sunrise-make-progress-reporter "working" (length marked)))
(inhibit-read-only t))
(when (< 1 (length marked))
(if (file-exists-p target)
(unless (file-directory-p target)
(error "Sunrise: Multiple selection, but target is not a directory"))
(if (y-or-n-p (format "Directory %s does not exit. Create? " target))
(make-directory target t)
(error "Sunrise: Unable to proceed - aborting"))))
(mapc (lambda (x)
(if (and (not (equal (expand-file-name x) (expand-file-name target)))
(or (not (file-exists-p target))
(file-directory-p target)
(y-or-n-p (format "File %s exists. OK to overwrite? "
target))))
(funcall action x target t)))
marked)
(revert-buffer)
(sunrise-progress-reporter-done progress)))
(defun sunrise-virtual-source ()
"if the active pane is in VIRTUAL mode, return its name as a string.
Otherwise return nil."
(if (eq major-mode 'sunrise-virtual-mode)
(or (buffer-file-name) "Sunrise VIRTUAL buffer")
nil))
(defun sunrise-virtual-target ()
"If the passive pane is in VIRTUAL mode, return its name as a string.
Otherwise return nil."
(save-window-excursion
(switch-to-buffer (sunrise-other 'buffer))
(sunrise-virtual-source)))
(defun sunrise-copy-virtual ()
"Manage copying of files or directories to buffers in VIRTUAL mode."
(let ((fileset (dired-get-marked-files nil))
(inhibit-read-only t) (beg))
(sunrise-change-window)
(goto-char (point-max))
(setq beg (point))
(mapc (lambda (file)
(insert-char 32 2)
(setq file (dired-make-relative file default-directory)
file (sunrise-chop ?/ file))
(insert-directory file sunrise-virtual-listing-switches))
fileset)
(sunrise-display-attributes beg (point-at-eol) sunrise-show-file-attributes)
(unwind-protect
(delete-region (point) (line-end-position))
(progn
(sunrise-change-window)
(dired-unmark-all-marks)))))
(defun sunrise-ask (prompt target files function)
"Use FUNCTION to ask whether to do PROMPT on FILES with TARGET as destination."
(if (and files (listp files))
(let* ((len (length files))
(msg (if (< 1 len)
(format "* [%d items]" len)
(file-name-nondirectory (car files)))))
(if target
(setq msg (format "%s to %s" msg target)))
(funcall function (format "%s %s? " prompt msg)))))
(defun sunrise-ask-overwrite (file-name)
"Ask whether to overwrite the given FILE-NAME."
(sunrise-y-n-or-a-p (format "File %s exists. OK to overwrite? " file-name)))
(defun sunrise-y-n-or-a-p (prompt)
"Ask the user with PROMPT for an answer y/n/a ('a' stands for 'always').
Returns t if the answer is y/Y, nil if the answer is n/N or the
symbol `ALWAYS' if the answer is a/A."
(setq prompt (concat prompt "([y]es, [n]o or [a]lways)"))
(let ((resp -1))
(while (not (memq resp '(?y ?Y ?n ?N ?a ?A)))
(setq resp (read-event prompt))
(setq prompt "Please answer [y]es, [n]o or [a]lways "))
(if (>= resp 97)
(setq resp (- resp 32)))
(cl-case resp
(?Y t)
(?A 'ALWAYS)
(t nil))))
(defun sunrise-overlapping-paths-p (dir1 dir2)
"Return non-nil if directory DIR2 is located inside directory DIR1."
(when (and dir1 dir2)
(setq dir1 (expand-file-name (file-name-as-directory dir1))
dir2 (expand-file-name dir2))
(if (>= (length dir2) (length dir1))
(equal (substring dir2 0 (length dir1)) dir1)
nil)))
(defun sunrise-list-of-contents (dir)
"Return the list of all files in DIR as a list of strings."
(sunrise-filter (function (lambda (x) (not (string-match "\\.\\.?/?$" x))))
(directory-files dir)))
(defun sunrise-list-of-directories (dir)
"Return the list of directories in DIR as a list of strings.
The list does not include the current directory and the parent directory."
(let ((result (sunrise-filter (function (lambda (x)
(file-directory-p (concat dir "/" x))))
(sunrise-list-of-contents dir))))
(mapcar (lambda (x) (concat x "/")) result)))
(defun sunrise-list-of-files (dir)
"Return the list of regular files in DIR as a list of strings.
Broken links are *not* considered regular files."
(sunrise-filter
(function (lambda (x) (file-regular-p (concat dir "/" x))))
(sunrise-list-of-contents dir)))
(defun sunrise-filter (p x)
"Return the elements of the list X that satisfy the predicate P."
(let ((res-list nil))
(while x
(if (apply p (list (car x)))
(setq res-list (cons (car x) res-list)))
(setq x (cdr x)))
(reverse res-list)))
(defun sunrise-directory-name-proper (file-path)
"Return the proper name of the directory FILE-PATH, without initial path."
(if file-path
(let (
(file-path-1 (substring file-path 0 (- (length file-path) 1)))
(lastchar (substring file-path (- (length file-path) 1)))
)
(concat (file-name-nondirectory file-path-1) lastchar))))
;;; ============================================================================
;;; Directory and file comparison functions:
(defun sunrise-compare-panes ()
"Compare the contents of Sunrise panes."
(interactive)
(let* ((file-alist1 (sunrise-files-attributes))
(other (sunrise-other 'buffer))
(file-alist2 (with-current-buffer other (sunrise-files-attributes)))
(progress
(sunrise-make-progress-reporter
"comparing" (+ (length file-alist1) (length file-alist2))))
(predicate `(prog1 ,(sunrise-ask-compare-panes-predicate)
(sunrise-progress-reporter-update ',progress 1)))
(file-list1 (mapcar 'cadr (dired-file-set-difference
file-alist1 file-alist2 predicate)))
(file-list2 (mapcar 'cadr (dired-file-set-difference
file-alist2 file-alist1 predicate))))
(sunrise-md5 nil)
(dired-mark-if (member (dired-get-filename nil t) file-list1) nil)
(with-current-buffer other
(dired-mark-if (member (dired-get-filename nil t) file-list2) nil))
(message "Marked in pane1: %s files, in pane2: %s files"
(length file-list1)
(length file-list2))
(sit-for 0.2)))
(defun sunrise-ask-compare-panes-predicate ()
"Prompt for the criterion to use for comparing the contents of the panes."
(let ((prompt "Compare by (d)ate, (s)ize, date_(a)nd_size, (n)ame \
or (c)ontents? ")
(response -1))
(while (not (memq response '(?d ?D ?s ?S ?a ?A ?n ?N ?c ?C)))
(setq response (read-event prompt))
(setq prompt "Please select: Compare by (d)ate, (s)ize, date_(a)nd_size,\
(n)ame or (c)ontents? "))
(if (>= response 97)
(setq response (- response 32)))
(cl-case response
(?D `(not (= mtime1 mtime2)))
(?S `(not (= size1 size2)))
(?N nil)
(?C `(not (string= (sunrise-md5 file1 t) (sunrise-md5 file2 t))))
(t `(or (not (= mtime1 mtime2)) (not (= size1 size2)))))))
(defun sunrise-files-attributes ()
"Return a list of all file names and attributes in the current pane.
The list has the same form as the one returned by
`dired-files-attributes', but contains all the files currently
displayed in VIRTUAL panes."
(delq
nil
(mapcar
(lambda (file-name)
(unless (member file-name '("." ".."))
(let ((full-file-name (expand-file-name file-name default-directory)))
(list file-name full-file-name (file-attributes full-file-name)))))
(sunrise-pane-files))))
(defun sunrise-pane-files ()
"Return the list of files in the current pane.
For VIRTUAL panes, returns the list of all files being currently
displayed."
(delq
nil
(if (eq major-mode 'sunrise-virtual-mode)
(sunrise-buffer-files (current-buffer))
(directory-files default-directory))))
(defvar sunrise-md5-cache '(nil)
"Memoization cache for the sunrise-md5 function.")
(defun sunrise-md5 (file-alist &optional memoize)
"Build and execute a shell command to calculate the MD5 checksum of a file.
Second element of FILE-ALIST is the absolute path of the file. If
MEMOIZE is non-nil, save the result into the `sunrise-md5-cache' alist so it
can be reused the next time this function is called with the same
path. This cache can be cleared later calling `sunrise-md5' with nil
as its first argument."
(if (null file-alist)
(setq sunrise-md5-cache '(nil))
(let* ((filename (cadr file-alist))
(md5-digest (cdr (assoc filename sunrise-md5-cache)))
(md5-command))
(unless md5-digest
(setq md5-command
(replace-regexp-in-string
"%f" (format "\"%s\"" filename) sunrise-md5-shell-command))
(setq md5-digest (shell-command-to-string md5-command))
(if memoize
(push (cons filename md5-digest) sunrise-md5-cache)))
md5-digest)))
(defun sunrise-diff ()
"Run `diff' on the top two marked files in both panes."
(interactive)
(eval (sunrise-diff-form 'diff))
(sunrise-scrollable-viewer (get-buffer "*Diff*")))
(defun sunrise-ediff ()
"Run `ediff' on the two top marked files in both panes."
(interactive)
(eval (sunrise-diff-form 'ediff)))
(defun sunrise-ediff-before-setup-windows-function ()
(setq sunrise-ediff-on t))
(defun sunrise-ediff-quit-function ()
(setq sunrise-ediff-on nil)
(when sunrise-running
(if (buffer-live-p sunrise-restore-buffer)
(switch-to-buffer sunrise-restore-buffer))
(delete-other-windows)
(sunrise-setup-windows)
(sunrise-graphical-highlight)))
(add-hook 'ediff-before-setup-windows-hook
'sunrise-ediff-before-setup-windows-function)
(add-hook 'ediff-quit-hook
'sunrise-ediff-quit-function)
(defun sunrise-diff-form (fun)
"Return the appropriate form to evaluate for comparing files using FUN."
(let ((this (sunrise-pop-mark)) (other nil))
(unless this
(setq this (car (dired-get-marked-files t))))
(if (sunrise-equal-dirs default-directory sunrise-other-directory)
(setq other (sunrise-pop-mark))
(progn
(sunrise-change-window)
(setq other (sunrise-pop-mark))
(sunrise-change-window)
(setq other (or other
(if (file-exists-p (concat sunrise-other-directory this))
this
(file-name-nondirectory this))))))
(setq this (concat default-directory this)
other (concat sunrise-other-directory other))
(list fun this other)))
(defun sunrise-pop-mark ()
"Pop the first mark in the current Dired buffer."
(let ((result nil))
(condition-case description
(save-excursion
(goto-char (point-min))
(dired-next-marked-file 1)
(setq result (dired-get-filename t t))
(dired-unmark 1))
(error (message (cadr description))))
result))
;;; ============================================================================
;;; File search & analysis functions:
(defun sunrise-process-kill ()
"Kill the process running in the current buffer (if any)."
(interactive)
(let ((proc (get-buffer-process (current-buffer))))
(and proc (eq (process-status proc) 'run)
(condition-case nil
(delete-process proc)
(error nil)))))
(defvar sunrise-process-map (let ((map (make-sparse-keymap)))
(set-keymap-parent map sunrise-virtual-mode-map)
(define-key map "\C-c\C-k" 'sunrise-process-kill)
map)
"Local map used in Sunrise panes during find and locate operations.")
(defun sunrise-find-decorate-buffer (find-items)
"Provide details on `sunrise-find' execution in the current buffer.
If the current find operation is done only in selected files and directories,
modify the info line of the buffer to reflect this. Additionally, display an
appropriate message in the minibuffer."
(rename-uniquely)
(when find-items
(let ((items-len (length find-items))
(max-items-len (window-width))
(inhibit-read-only t))
(goto-char (point-min))
(forward-line 1)
(when (re-search-forward "find \." nil t)
(if (> items-len max-items-len)
(setq find-items
(concat (substring find-items 0 max-items-len) " ...")))
(replace-match (format "find %s" find-items)))))
(sunrise-beginning-of-buffer)
(sunrise-highlight)
(hl-line-mode 1)
(message (propertize "Sunrise find (C-c C-k to kill)"
'face 'minibuffer-prompt)))
(defun sunrise-find-apply (fun pattern)
"Helper function for functions `sunrise-find', `sunrise-find-name' and `sunrise-find-grep'."
(let* ((suffix (if (eq 'w32 window-system) " {} ;" " \\{\\} \\;"))
(find-ls-option
(cons
(concat "-exec ls -d " sunrise-virtual-listing-switches suffix)
"ls -ld"))
(sunrise-find-items (sunrise-quote-marked)) (dir))
(when sunrise-find-items
(if (not (y-or-n-p "Find in marked items only? "))
(setq sunrise-find-items nil)
(setq dir (directory-file-name (expand-file-name default-directory)))
(add-to-list 'file-name-handler-alist (cons dir 'sunrise-multifind-handler))))
(sunrise-save-aspect
(sunrise-alternate-buffer (apply fun (list default-directory pattern)))
(sunrise-virtual-mode)
(use-local-map sunrise-process-map)
(sunrise-keep-buffer))
(run-with-idle-timer 0.01 nil 'sunrise-find-decorate-buffer sunrise-find-items)))
(defun sunrise-find (pattern)
"Run `find-dired' passing the current directory as first parameter."
(interactive "sRun find (with args): ")
(sunrise-find-apply 'find-dired pattern))
(defun sunrise-find-name (pattern)
"Run `find-name-dired' passing the current directory as first parameter."
(interactive "sFind name pattern: ")
(sunrise-find-apply 'find-name-dired pattern))
(defun sunrise-find-grep (pattern)
"Run `find-grep-dired' passing the current directory as first
parameter. Called with prefix asks for additional grep options."
(interactive "sFind files containing pattern: ")
(let ((find-grep-options
(if current-prefix-arg
(concat find-grep-options
" "
(read-string "Additional Grep Options: "))
find-grep-options)))
(sunrise-find-apply 'find-grep-dired pattern)))
(defadvice find-dired-sentinel
(after sunrise-advice-find-dired-sentinel (proc state))
"If the current find operation was launched inside the Sunrise
Commander, create a new backup buffer on operation completion or
abort."
(with-current-buffer (process-buffer proc)
(when (eq 'sunrise-virtual-mode major-mode)
(sunrise-backup-buffer))))
(ad-activate 'find-dired-sentinel)
(defadvice find-dired-filter
(around sunrise-advice-find-dired-filter (proc string))
"Disable the \"non-foolproof\" padding mechanism in `find-dired-filter' that
breaks Dired when using ls options that omit some columns (like g or G). Defined
by the Sunrise Commander."
(if (and (eq 'sunrise-virtual-mode major-mode)
(or (string-match "g" sunrise-virtual-listing-switches)
(string-match "G" sunrise-virtual-listing-switches)))
(let ((find-ls-option nil)) ad-do-it)
ad-do-it))
(ad-activate 'find-dired-filter)
(defun sunrise-multifind-handler (operation &rest args)
"Magic file name handler for manipulating the command executed by `find-dired'
when the user requests to perform the find operation on all currently marked
items (as opposed to the current default directory). Removes itself from the
`inhibit-file-name-handlers' every time it's executed."
(let ((inhibit-file-name-handlers
(cons 'sunrise-multifind-handler
(and (eq inhibit-file-name-operation operation)
inhibit-file-name-handlers)))
(inhibit-file-name-operation operation))
(when (eq operation 'shell-command)
(setq file-name-handler-alist
(rassq-delete-all 'sunrise-multifind-handler file-name-handler-alist))
(when sunrise-find-items
(setcar args (replace-regexp-in-string
"find \." (format "find %s" sunrise-find-items) (car args)))))
(apply operation args)))
(defvar sunrise-as-pending nil
"Buffer-local variable used by async search operations to keep
partial process output between consecutive batches of data.")
(defun sunrise-as-filter (as-buffer &optional as-filter)
"Return a filter function for an async search process."
`(lambda (process output)
(let ((inhibit-read-only t)
(beg (point-max))
(as-filter (or (quote ,as-filter) #'identity))
(entries))
(setq output (concat sunrise-as-pending output)
entries (split-string output "[\r\n]" t))
(set (make-local-variable 'sunrise-as-pending) "")
(unless (string-match "[\r\n]$" output)
(setq sunrise-as-pending (car (last entries))))
(set-buffer ,as-buffer)
(save-excursion
(mapc (lambda (x)
(when (and (apply as-filter (list x))
(not (eq x sunrise-as-pending)))
(setq x (replace-regexp-in-string "\\./" "" x))
(goto-char (point-max))
(insert-char 32 2)
(insert-directory x sunrise-virtual-listing-switches nil nil)))
entries)
(sunrise-display-attributes beg (point-at-eol) sunrise-show-file-attributes)))))
(defun sunrise-as-sentinel (as-buffer as-command)
"Return a sentinel function for an async search process.
Used to notify about the termination status of the process."
`(lambda (process status)
(let ((inhibit-read-only t))
(set-buffer ,as-buffer)
(goto-char (point-max))
(insert "\n " ,as-command " " status)
(forward-char -1)
(insert " at " (substring (current-time-string) 0 19))
(forward-char 1))
(sunrise-beginning-of-buffer)
(sunrise-highlight)
(hl-line-mode 1)))
(defun sunrise-as-prompt (as-command)
"Display the message that appears when an async search process is launched."
(message (propertize (format "Sunrise %s (C-c C-k to kill)" as-command)
'face 'minibuffer-prompt)))
(defun sunrise-as-search (as-label as-command as-filter &rest as-args)
"Launch an asyncronous search operation.
AS-LABEL is a name to use for displaying in messages etc.
AS-COMMAND is the path to the search command to invoke.
AS-FILTER is an optional filter to test every entry returned by
the search process - only those entries for which this filter
returns non-nil will be included in the result.
AS-ARGS are all additional arguments needed to execute the
operation.
Please note that this facility executes its processes directly,
without the intermediation of a shell, so spaces as separators
are not supported in any of the arguments."
(let ((as-buffer (create-file-buffer (format "*Sunrise %s*" as-command)))
(as-process-args
(append (list (format "Async %s" as-label) nil as-command) as-args))
(as-process nil))
(sunrise-save-aspect
(sunrise-alternate-buffer (switch-to-buffer as-buffer))
(insert " " default-directory ":") (newline)
(insert (format " Results of: %s %s" as-command
(substring (format "%s" as-args) 1 -1)))
(newline)
(sunrise-virtual-mode)
(set-process-filter
(setq as-process (apply 'start-process as-process-args))
(sunrise-as-filter as-buffer as-filter))
(set-process-sentinel as-process (sunrise-as-sentinel as-buffer as-command))
(set-process-buffer as-process as-buffer)
(use-local-map sunrise-process-map)
(run-with-idle-timer 0.01 nil 'sunrise-as-prompt as-label))))
(defun sunrise-async-grep (as-input)
"Launch a grep asynchronous search operation. If any entries
have been explicitly selected in the current pane ask the user
whether to run the grep only for these entries, otherwise run it
in the current directory. If called with prefix ask for
additional grep options."
(interactive "sFind files containing: ")
(let* ((default-grep-options "-rl")
(opts (if current-prefix-arg
(concat default-grep-options " "
(read-string "Additional Grep Options: "))
default-grep-options))
(options (split-string opts " " t))
(marked (sunrise-get-marked-files))
(target
(if (and marked (y-or-n-p "Grep in marked items only? "))
marked
'("."))))
(cl-labels ((fl (&rest args) (sunrise-flatlist args)))
(apply 'sunrise-as-search
(fl "Grep" sunrise-grep-command nil options as-input target)))))
(defun sunrise-grep ()
"Run grep asynchronously and display the results in Sunrise virtual mode."
(interactive)
(if sunrise-recursive-grep-supported
(call-interactively 'sunrise-async-grep)
(call-interactively 'sunrise-find-grep)))
(defvar locate-command)
(autoload 'locate-prompt-for-search-string "locate")
(defun sunrise-locate (as-input &optional _filter _arg)
"Run locate asynchronously and display the results in Sunrise virtual mode."
(interactive
(list (locate-prompt-for-search-string) nil current-prefix-arg))
(sunrise-as-search "Locate" "locate" #'file-exists-p as-input))
(defun sunrise-multi-occur (string)
"Execute `multi-occur' on all marked files. Note this command needs to visit
first all the selected files."
(interactive "sSearch in selected files for occurrences of: ")
(let ((regular-files (delq nil (mapcar (lambda (x)
(and (file-regular-p x) x))
(dired-get-marked-files)))))
(if (not regular-files)
(error "Sunrise: no regular files to search")
(sunrise-quit)
(multi-occur (mapcar 'find-file regular-files) string)
(other-window 1))))
(defun sunrise-flatten-branch (&optional mode)
"Display a flat view of the items contained in the current directory and all
its subdirectories, sub-subdirectories and so on (recursively) in the active
pane."
(interactive "cFlatten branch showing: (E)verything, (D)irectories,\
(N)on-directories or (F)iles only?")
(if (and mode (>= mode 97)) (setq mode (- mode 32)))
(cl-case mode
(?E (sunrise-find-name "*"))
(?D (sunrise-find "-type d"))
(?N (sunrise-find "-not -type d"))
(?F (sunrise-find "-type f"))))
(defun sunrise-prune-paths (regexp)
"Kill all lines (only the lines) in the current pane matching REGEXP."
(interactive "sPrune paths matching: ")
(save-excursion
(sunrise-beginning-of-buffer)
(while (if (string-match regexp (dired-get-filename t))
(dired-kill-line)
(dired-next-line 1)))))
(defun sunrise-fuzzy-narrow ()
"Interactively narrow contents of the current pane using fuzzy matching:
* press Delete or Backspace to revert the buffer to its previous state
* press Return, C-n or C-p to exit and accept the current narrowed state
* press Esc or C-g to abort the operation and revert the buffer
* use ! to prefix characters that should NOT appear beyond a given position.
Once narrowed and accepted, you can restore the original contents of the pane
by pressing g (`revert-buffer')."
(interactive)
(cl-assert sunrise-running)
(sunrise-beginning-of-buffer)
(let ((stack nil) (filter "") (regex "") (next-char nil) (inhibit-quit t))
(cl-labels ((read-next (f) (read-char (concat "Fuzzy narrow: " f))))
(setq next-char (read-next filter))
(sunrise-backup-buffer)
(while next-char
(cl-case next-char
((?\e ?\C-g) (setq next-char nil) (sunrise-revert-buffer))
(?\C-n (setq next-char nil) (sunrise-beginning-of-buffer))
(?\C-p (setq next-char nil) (sunrise-end-of-buffer))
((?\n ?\r) (setq next-char nil))
((?\b ?\d)
(revert-buffer)
(setq stack (cdr stack) filter (caar stack) regex (cdar stack))
(unless stack (setq next-char nil)))
(t
(setq filter (concat filter (char-to-string next-char)))
(if (not (eq next-char sunrise-fuzzy-negation-character))
(setq next-char (char-to-string next-char)
regex (if (string= "" regex) ".*" regex)
regex (concat regex (regexp-quote next-char) ".*"))
(setq next-char (char-to-string (read-next filter))
filter (concat filter next-char)
regex (replace-regexp-in-string "\\.\\*\\'" "" regex)
regex (concat regex "[^"(regexp-quote next-char)"]*")
regex (replace-regexp-in-string "\\]\\*\\[\\^" "" regex)))
(setq stack (cons (cons filter regex) stack))))
(when next-char
(add-to-invisibility-spec 'sunrise-narrow)
(let ((inhibit-read-only t))
(save-excursion
(goto-char (point-min))
(while (not (eobp))
(let* ((start (dired-move-to-filename))
(end (and start (dired-move-to-end-of-filename t))))
(when (and start end)
(let ((old (get-text-property start 'invisible)))
(put-text-property
(point-at-bol) (1+ (point-at-eol)) 'invisible
(if (string-match-p
regex (buffer-substring-no-properties start end))
(cl-set-difference old '(sunrise-narrow))
(cl-union old '(sunrise-narrow)))))))
(goto-char (point-at-bol))
(forward-line 1))))
(setq next-char (read-next filter)))))))
(defun sunrise-recent-files ()
"Display the history of recent files in Sunrise virtual mode."
(interactive)
(if (not (featurep 'recentf))
(error "ERROR: Feature recentf not available!"))
(sunrise-save-aspect
(let ((dired-actual-switches dired-listing-switches))
(sunrise-switch-to-clean-buffer "*Recent Files*")
(insert "Recently Visited Files: \n")
(dolist (file recentf-list)
(condition-case nil
(insert-directory file sunrise-virtual-listing-switches nil nil)
(error (ignore))))
(sunrise-virtual-mode)
(sunrise-keep-buffer))))
(defun sunrise-recent-directories ()
"Display the history of directories recently visited in the current pane."
(interactive)
(sunrise-save-aspect
(let ((hist (cdr (assoc sunrise-selected-window sunrise-history-registry)))
(dired-actual-switches dired-listing-switches)
(pane-name (capitalize (symbol-name sunrise-selected-window)))
(switches))
(sunrise-switch-to-clean-buffer (format "*%s Pane History*" pane-name))
(insert (concat "Recent Directories in " pane-name " Pane: \n"))
(dolist (dir hist)
(condition-case nil
(cl-case (sunrise-history-entry-type dir)
(tramp
(insert (concat "d......... 0 0000-00-00 " dir))
(newline))
(local
(setq switches (concat sunrise-virtual-listing-switches " -d")
dir (sunrise-chop ?/ (expand-file-name dir)))
(insert-directory dir switches nil nil))
(t (ignore)))
(error (ignore))))
(sunrise-virtual-mode))))
(defun sunrise-switch-to-clean-buffer (name)
(sunrise-alternate-buffer (switch-to-buffer name))
(erase-buffer))
(defun sunrise-pure-virtual (&optional passive)
"Create a new empty buffer in Sunrise VIRTUAL mode.
If the optional argument PASSIVE is non-nil, creates the virtual
buffer in the passive pane."
(interactive "P")
(if passive
(progn
(sunrise-synchronize-panes)
(sunrise-in-other (sunrise-pure-virtual nil)))
(sunrise-save-aspect
(let* ((dir (directory-file-name (dired-current-directory)))
(buff (generate-new-buffer-name (buffer-name (current-buffer)))))
(sunrise-alternate-buffer (switch-to-buffer buff))
(goto-char (point-min))
(insert " " dir ":")(newline)
(insert " Pure VIRTUAL buffer: ")(newline)
(sunrise-virtual-mode)
(sunrise-keep-buffer)))))
(defun sunrise-dired-do-apply (dired-fun)
"Helper function for implementing `sunrise-do-query-replace-regexp' and Co."
(let ((buff (current-buffer)) (orig sunrise-restore-buffer))
(condition-case nil
(progn
(sunrise-quit)
(switch-to-buffer buff)
(call-interactively dired-fun)
(replace-buffer-in-windows buff)
(sunrise-bury-panes))
(quit
(when orig (switch-to-buffer orig))
(sunrise)))))
(defun sunrise-do-query-replace-regexp ()
"Force Sunrise to quit before executing `dired-do-query-replace-regexp'."
(interactive)
(sunrise-dired-do-apply 'dired-do-query-replace-regexp))
(defun sunrise-do-search ()
"Force Sunrise to quit before executing `dired-do-search'."
(interactive)
(sunrise-dired-do-apply 'dired-do-search))
(defun sunrise-sticky-isearch-prompt ()
"Display the message that appears when a sticky search is launched."
(message (propertize "Sunrise sticky I-search (C-g to exit): "
'face 'minibuffer-prompt)))
(defvar sunrise-sticky-isearch-commands
'(nil
("\C-o" . dired-omit-mode)
("\M-a" . sunrise-beginning-of-buffer)
("\M-e" . sunrise-end-of-buffer)
("\C-v" . scroll-up-command)
("\M-v" . (lambda () (interactive) (scroll-up-command '-)))
("\C-g" . (lambda () (interactive) (save-excursion (isearch-abort))))
) "Keybindings installed in `isearch-mode' during a sticky search.")
(defun sunrise-sticky-isearch-remap-commands (&optional restore)
"Remap `isearch-mode-map' commands using `sunrise-sticky-isearch-commands'.
Replace the bindings in our table with the previous ones from `isearch-mode-map'
so we can restore them when the current sticky search operation finishes."
(when (eq restore (car sunrise-sticky-isearch-commands))
(setcar sunrise-sticky-isearch-commands (not restore))
(mapc (lambda (entry)
(let* ((binding (car entry))
(old-command (lookup-key isearch-mode-map binding))
(new-command (cdr entry)))
(define-key isearch-mode-map binding new-command)
(setcdr entry old-command)))
(cdr sunrise-sticky-isearch-commands))))
(defun sunrise-sticky-isearch (&optional backward)
"Concatenate Isearch operations to allow fast file system navigation.
Search continues until C-g is pressed (to abort) or Return is
pressed on a regular file (to end the operation and visit that
file)."
(set (make-local-variable 'search-nonincremental-instead) nil)
(add-hook 'isearch-mode-end-hook 'sunrise-sticky-post-isearch)
(sunrise-sticky-isearch-remap-commands)
(if backward
(isearch-backward nil t)
(isearch-forward nil t))
(run-hooks 'sunrise-refresh-hook)
(run-with-idle-timer 0.01 nil 'sunrise-sticky-isearch-prompt))
(defun sunrise-sticky-isearch-forward ()
"Start a sticky forward search in the current pane."
(interactive)
(sunrise-sticky-isearch))
(defun sunrise-sticky-isearch-backward ()
"Start a sticky backward search in the current pane."
(interactive)
(sunrise-sticky-isearch t))
(defun sunrise-sticky-post-isearch ()
"`isearch-mode-end-hook' function for Sunrise sticky Isearch operations."
(and
(dired-get-filename nil t)
(let* ((filename (expand-file-name (dired-get-filename nil t)))
(is-dir (or (file-directory-p filename)
(sunrise-avfs-dir filename)
(sunrise-virtual-directory-p filename))))
(cond ((or isearch-mode-end-hook-quit (not is-dir))
(progn
(remove-hook 'isearch-mode-end-hook 'sunrise-sticky-post-isearch)
(kill-local-variable 'search-nonincremental-instead)
(sunrise-sticky-isearch-remap-commands t)
(isearch-done)
(if isearch-mode-end-hook-quit
(run-hooks 'sunrise-refresh-hook)
(sunrise-find-file filename))))
(t
(progn
(sunrise-find-file filename)
(set (make-local-variable 'search-nonincremental-instead) nil)
(isearch-forward nil t)
(run-with-idle-timer 0.01 nil 'sunrise-sticky-isearch-prompt)))))))
(defun sunrise-show-files-info (&optional deref-symlinks)
"Enhanced version of `dired-show-file-type' from dired-aux.
If at most one item is marked, print the filetype of the current
item according to the \"file\" command, including its size in bytes.
If more than one item is marked, print the total size in
bytes (calculated recursively) of all marked items."
(interactive "P")
(message "Calculating total size of selection... (C-g to abort)")
(let* ((selection (dired-get-marked-files t))
(size (sunrise-size-format (sunrise-files-size selection)))
(items (length selection)) (label) (regex))
(if (>= 1 items)
(progn
(setq selection (car selection)
label (file-name-nondirectory selection)
regex (concat "^.*" label "[:;]")
label (concat label ":"))
(dired-show-file-type selection deref-symlinks)
(message
"%s (%s bytes)"
(replace-regexp-in-string regex label (current-message)) size))
(message "%s bytes in %d selected items" size items))
(sit-for 0.5)))
(eval-when-compile
(defsubst sunrise-size-attr (file)
"Helper function for `sunrise-files-size'."
(float (or (nth 7 (file-attributes file)) 0))))
(defun sunrise-files-size (files)
"Recursively calculate the total size of all FILES.
FILES should be a list of paths."
(let ((result 0))
(mapc
(lambda (x) (setq result (+ x result)))
(mapcar (lambda (f) (cond ((string-match "\\.\\./?$" f) 0)
((string-match "\\./?$" f) (sunrise-size-attr f))
((file-symlink-p f) (sunrise-size-attr f))
((file-directory-p f) (sunrise-directory-size f))
(t (float (sunrise-size-attr f)))))
files))
result))
(defun sunrise-directory-size (directory)
"Recursively calculate the total size of the given DIRECTORY."
(sunrise-files-size (directory-files directory t nil t)))
(defun sunrise-size-format (size)
"Return integer representation of SIZE (a float) as a string.
Uses comma as the thousands separator."
(let* ((num (replace-regexp-in-string "\\..*$" "" (number-to-string size)))
(digits (reverse (split-string num "" t)))
result)
(dotimes (n (length digits))
(when (and (< 0 n) (zerop (% n 3)))
(setq result (concat "," result)))
(setq result (concat (pop digits) result)))
result))
;;; ============================================================================
;;; TI (Terminal Integration) and CLEX (Command Line EXpansion) functions:
;;;###autoload
(defun sunrise-term (&optional cd newterm program)
"Run terminal in a new buffer or switch to an existing one.
If the optional argument CD is non-nil, directory is changed to
the current one in the active pane. A non-nil NEWTERM argument
forces the creation of a new terminal. If PROGRAM is provided
and exists in `exec-path', then it will be used instead of the
default `sunrise-terminal-program'."
(interactive)
(let ((aterm (car sunrise-ti-openterms)))
(if (and (null program)
(or (eq major-mode 'eshell-mode)
(and (buffer-live-p aterm)
(with-current-buffer aterm
(eq major-mode 'eshell-mode)))))
(setq program "eshell")
(setq program (or program sunrise-terminal-program))))
(if (memq major-mode '(sunrise-mode sunrise-virtual-mode sunrise-tree-mode))
(hl-line-mode 1))
(if (string= program "eshell")
(sunrise-term-eshell cd newterm)
(sunrise-term-extern cd newterm program)))
;;;###autoload
(defun sunrise-term-cd ()
"Run terminal in a new buffer or switch to an existing one.
cd's to the current directory of the active pane."
(interactive)
(sunrise-term t))
;;;###autoload
(defun sunrise-term-cd-newterm ()
"Open a NEW terminal (don't switch to an existing one).
cd's to the current directory of the active pane."
(interactive)
(sunrise-term t t))
;;;###autoload
(defun sunrise-term-cd-program (&optional program)
"Open a NEW terminal using PROGRAM as the shell."
(interactive "sShell program to use: ")
(sunrise-term t t program))
(defmacro sunrise-term-excursion (cd newterm form &optional is-external)
"Take care of the common mechanics of launching or switching to a terminal.
Helper macro."
`(let* ((start-buffer (current-buffer))
(new-term (or (null sunrise-ti-openterms) ,newterm))
(next-buffer (or (cadr (memq start-buffer sunrise-ti-openterms))
(car sunrise-ti-openterms)))
(new-name) (is-line-mode))
(sunrise-select-viewer-window t)
(if (not new-term)
;;don't switch anywhere else if we're in a term and we want only to cd:
(unless (and ,cd (memq (current-buffer) sunrise-ti-openterms))
(switch-to-buffer next-buffer))
(when next-buffer
(with-current-buffer next-buffer
(setq is-line-mode (and (boundp 'sunrise-term-line-minor-mode)
(symbol-value 'sunrise-term-line-minor-mode)))))
,form
(if ,is-external (sunrise-term-char-mode))
(if is-line-mode (sunrise-term-line-mode))
(when (memq (current-buffer) sunrise-ti-openterms)
(rename-uniquely)
(setq new-name (buffer-name))
,form)
(when new-name
(message "Sunrise: previous terminal renamed to %s" new-name))
(push (current-buffer) sunrise-ti-openterms))))
(defun sunrise-term-line-mode ()
"Switch the current terminal to line mode.
Apply additional Sunrise keybindings for terminal integration."
(interactive)
(term-line-mode)
(sunrise-term-line-minor-mode 1))
(defun sunrise-term-char-mode ()
"Switch the current terminal to character mode.
Bind C-j and C-k to Sunrise terminal integration commands."
(interactive)
(term-char-mode)
(sunrise-term-line-minor-mode 0)
(sunrise-term-char-minor-mode 1))
(defun sunrise-term-extern (&optional cd newterm program)
"Implementation of `sunrise-term' for external terminal programs.
See `sunrise-term' for a description of the arguments."
(let* ((program (if program (executable-find program)))
(program (or program sunrise-terminal-program))
(dir (expand-file-name (sunrise-choose-cd-target)))
(aterm (car sunrise-ti-openterms))
(cd (or cd (null sunrise-ti-openterms)))
(line-mode (if (buffer-live-p aterm)
(with-current-buffer aterm (term-in-line-mode)))))
(sunrise-term-excursion cd newterm (term program) t)
(sunrise-term-char-mode)
(when (or line-mode (term-in-line-mode))
(sunrise-term-line-mode))
(when cd
(term-send-raw-string
(concat "cd " (shell-quote-wildcard-pattern dir) "
")))))
(defun sunrise-term-eshell (&optional cd newterm)
"Implementation of `sunrise-term' when using `eshell'."
(let ((dir (expand-file-name (sunrise-choose-cd-target)))
(cd (or cd (null sunrise-ti-openterms))))
(sunrise-term-excursion cd newterm (eshell))
(when cd
(insert (concat "cd " (shell-quote-wildcard-pattern dir)))
(eshell-send-input))
(sunrise-term-line-mode)))
(defmacro sunrise-ti (form)
"Evaluate FORM in the context of the selected pane.
Helper macro for implementing terminal integration in Sunrise."
`(when sunrise-running
(sunrise-select-window sunrise-selected-window)
(hl-line-unhighlight)
(unwind-protect
,form
(when sunrise-running
(sunrise-select-viewer-window)))))
(defun sunrise-ti-previous-line ()
"Move one line backward on active pane from the terminal window."
(interactive)
(sunrise-ti (forward-line -1)))
(defun sunrise-ti-next-line ()
"Move one line forward on active pane from the terminal window."
(interactive)
(sunrise-ti (forward-line 1)))
(defun sunrise-ti-select ()
"Run `dired-advertised-find-file' on active pane from the terminal window."
(interactive)
(sunrise-ti (sunrise-advertised-find-file)))
(defun sunrise-ti-mark ()
"Run `dired-mark' on active pane from the terminal window."
(interactive)
(sunrise-ti (dired-mark 1)))
(defun sunrise-ti-unmark ()
"Run `dired-unmark-backward' on active pane from the terminal window."
(interactive)
(sunrise-ti (dired-unmark-backward 1)))
(defun sunrise-ti-prev-subdir (&optional count)
"Run `dired-prev-subdir' on active pane from the terminal window."
(interactive "P")
(let ((count (or count 1)))
(sunrise-ti (sunrise-dired-prev-subdir count))))
(defun sunrise-ti-unmark-all-marks ()
"Remove all marks on active pane from the terminal window."
(interactive)
(sunrise-ti (dired-unmark-all-marks)))
(defun sunrise-ti-change-window ()
"Switch focus to the currently active pane."
(interactive)
(sunrise-select-window sunrise-selected-window))
(defun sunrise-ti-change-pane ()
"Change selection of active pane to passive one."
(interactive)
(sunrise-ti (sunrise-change-window)))
(defun sunrise-ti-cleanup-openterms ()
"Remove the current buffer from the list of open terminals."
(setq sunrise-ti-openterms (delete (current-buffer) sunrise-ti-openterms)))
(add-hook 'kill-buffer-hook 'sunrise-ti-cleanup-openterms)
(defun sunrise-ti-revert-buffer ()
"Refresh the currently active pane."
(interactive)
(let ((dir default-directory))
(if (not (sunrise-equal-dirs dir sunrise-this-directory))
(sunrise-ti (sunrise-goto-dir dir))
(sunrise-ti (sunrise-revert-buffer)))))
(defun sunrise-ti-lock-panes ()
"Resize and lock the panes at standard position from the command line."
(interactive)
(sunrise-ti (sunrise-lock-panes)))
(defun sunrise-ti-min-lock-panes ()
"Minimize the panes from the command line."
(interactive)
(sunrise-ti (sunrise-min-lock-panes)))
(defun sunrise-ti-max-lock-panes ()
"Maximize the panes from the command line."
(interactive)
(sunrise-ti (sunrise-max-lock-panes)))
(defmacro sunrise-clex (pane form)
"Evaluate FORM in the context of PANE.
Helper macro for implementing command line expansion in Sunrise."
`(progn
(setq pane (if (atom pane) pane (eval pane)))
(with-current-buffer (symbol-value (sunrise-symbol ,pane 'buffer))
,form)))
(defun sunrise-clex-marked (pane)
"Return a string containing the list of marked files in PANE."
(sunrise-clex
pane
(mapconcat 'shell-quote-wildcard-pattern (dired-get-marked-files) " ")))
(defun sunrise-clex-file (pane)
"Return the file currently selected in PANE."
(sunrise-clex
pane
(concat (shell-quote-wildcard-pattern (dired-get-filename)) " ")))
(defun sunrise-clex-marked-nodir (pane)
"Return a list of basenames of all the files currently marked in PANE."
(sunrise-clex
pane
(mapconcat 'shell-quote-wildcard-pattern
(dired-get-marked-files 'no-dir) " ")))
(defun sunrise-clex-dir (pane)
"Return the current directory of the given pane."
(sunrise-clex
pane
(concat (shell-quote-wildcard-pattern default-directory) " ")))
(defun sunrise-clex-start ()
"Start a new CLEX operation.
Puts `sunrise-clex-commit' into local `after-change-functions'."
(interactive)
(if sunrise-clex-on
(progn
(setq sunrise-clex-on nil)
(delete-overlay sunrise-clex-hotchar-overlay))
(insert-char ?% 1)
(when sunrise-running
(add-hook 'after-change-functions 'sunrise-clex-commit nil t)
(setq sunrise-clex-on t)
(setq sunrise-clex-hotchar-overlay (make-overlay (point) (1- (point))))
(overlay-put sunrise-clex-hotchar-overlay 'face 'sunrise-clex-hotchar-face)
(message
"Sunrise: CLEX is now ON for keys: m f n d a p M F N D A P %%"))))
(defun sunrise-clex-commit (&optional _beg _end _range)
"Commit the current CLEX operation (if any).
This function is added to the local `after-change-functions' list
by `sunrise-clex-start'."
(interactive)
(when sunrise-clex-on
(setq sunrise-clex-on nil)
(delete-overlay sunrise-clex-hotchar-overlay)
(let* ((xchar (char-before))
(expansion (cl-case xchar
(?m (sunrise-clex-marked 'left))
(?f (sunrise-clex-file 'left))
(?n (sunrise-clex-marked-nodir 'left))
(?d (sunrise-clex-dir 'left))
(?M (sunrise-clex-marked 'right))
(?F (sunrise-clex-file 'right))
(?N (sunrise-clex-marked-nodir 'right))
(?D (sunrise-clex-dir 'right))
(?a (sunrise-clex-marked '(sunrise-this)))
(?A (sunrise-clex-dir '(sunrise-this)))
(?p (sunrise-clex-marked '(sunrise-other)))
(?P (sunrise-clex-dir '(sunrise-other)))
(t nil))))
(when expansion
(delete-char -2)
(insert expansion)))))
(define-minor-mode sunrise-term-char-minor-mode
"Sunrise Commander terminal add-on for character (raw) mode."
nil nil
'(("\C-c\C-j" . sunrise-term-line-mode)
("\C-c\C-k" . sunrise-term-char-mode)
("\C-c\t" . sunrise-ti-change-window)
("\C-ct" . sunrise-term)
("\C-cT" . sunrise-term-cd)
("\C-c\C-t" . sunrise-term-cd-newterm)
("\C-c\M-t" . sunrise-term-cd-program)
("\C-c;" . sunrise-follow-viewer)
("\C-c\\" . sunrise-ti-lock-panes)
("\C-c{" . sunrise-ti-min-lock-panes)
("\C-c}" . sunrise-ti-max-lock-panes)))
(define-minor-mode sunrise-term-line-minor-mode
"Sunrise Commander terminal add-on for line (cooked) mode."
nil nil
'(([M-up] . sunrise-ti-previous-line)
([A-up] . sunrise-ti-previous-line)
("\M-P" . sunrise-ti-previous-line)
([M-down] . sunrise-ti-next-line)
([A-down] . sunrise-ti-next-line)
("\M-N" . sunrise-ti-next-line)
("\M-\C-m" . sunrise-ti-select)
("\C-\M-j" . sunrise-ti-select)
([M-return] . sunrise-ti-select)
([S-M-return] . sunrise-ti-select)
("\M-M" . sunrise-ti-mark)
([M-backspace] . sunrise-ti-unmark)
("\M-\d" . sunrise-ti-unmark)
("\M-J" . sunrise-ti-prev-subdir)
("\M-U" . sunrise-ti-unmark-all-marks)
([C-tab] . sunrise-ti-change-window)
([M-tab] . sunrise-ti-change-pane)
("\C-c\t" . sunrise-ti-change-window)
("\C-ct" . sunrise-term)
("\C-cT" . sunrise-term-cd)
("\C-c\C-t" . sunrise-term-cd-newterm)
("\C-c\M-t" . sunrise-term-cd-program)
("\C-c;" . sunrise-follow-viewer)
("\M-\S-g" . sunrise-ti-revert-buffer)
("%" . sunrise-clex-start)
("\t" . term-dynamic-complete)
("\C-c\\" . sunrise-ti-lock-panes)
("\C-c{" . sunrise-ti-min-lock-panes)
("\C-c}" . sunrise-ti-max-lock-panes))
:group 'sunrise)
(defadvice term-sentinel (around sunrise-advice-term-sentinel (proc msg) activate)
"Take care of killing Sunrise Commander terminal buffers on exit."
(if (and (or sunrise-term-char-minor-mode sunrise-term-line-minor-mode)
sunrise-terminal-kill-buffer-on-exit
(memq (process-status proc) '(signal exit)))
(let ((buffer (process-buffer proc)))
ad-do-it
(bury-buffer buffer)
(kill-buffer buffer))
ad-do-it))
;;; ============================================================================
;;; Desktop support:
(defun sunrise-pure-virtual-p (&optional buffer)
"Return t if BUFFER (or the current buffer if nil) is purely virtual.
Purely virtual means it is not attached to any directory or any
file in the file system."
(with-current-buffer (if (bufferp buffer) buffer (current-buffer))
(not (or (eq 'sunrise-mode major-mode)
(and (eq 'sunrise-virtual-mode major-mode)
buffer-file-truename
(file-exists-p buffer-file-truename))))))
(defun sunrise-desktop-save-buffer (desktop-dir)
"Return the additional data for saving a Sunrise buffer to a desktop file."
(unless (sunrise-pure-virtual-p)
(let* ((side (if (eq (current-buffer) sunrise-left-buffer) 'left 'right))
(sorting-order (or (get side 'sorting-order) "NAME"))
(sorting-reverse (get side 'sorting-reverse)))
(apply
'append
(delq nil
(list
(if (eq major-mode 'sunrise-virtual-mode)
(list 'dirs buffer-file-truename)
(cons 'dirs (dired-desktop-buffer-misc-data desktop-dir)))
(cons side t)
(if sorting-order (cons 'sorting-order sorting-order))
(if sorting-reverse (cons 'sorting-reverse sorting-reverse))
(if (eq major-mode 'sunrise-virtual-mode) (cons 'virtual t))))
(mapcar (lambda (fun)
(funcall fun desktop-dir))
sunrise-desktop-save-handlers)))))
(defun sunrise-desktop-restore-buffer (desktop-buffer-file-name
desktop-buffer-name
desktop-buffer-misc)
"Restore a Sunrise (normal or VIRTUAL) buffer from its desktop file data."
(let* ((sunrise-running t)
(misc-data (cdr (assoc 'dirs desktop-buffer-misc)))
(is-virtual (assoc 'virtual desktop-buffer-misc))
(buffer
(if (not is-virtual)
(with-current-buffer
(dired-restore-desktop-buffer desktop-buffer-file-name
desktop-buffer-name
misc-data)
(sunrise-mode)
(current-buffer))
(desktop-restore-file-buffer (car misc-data)
desktop-buffer-name
misc-data))))
(with-current-buffer buffer
(when is-virtual (set-visited-file-name nil t))
(mapc (lambda (side)
(when (cdr (assq side desktop-buffer-misc))
(set (sunrise-symbol side 'buffer) buffer)
(set (sunrise-symbol side 'directory) default-directory)
(sunrise-desktop-sort buffer side desktop-buffer-misc)))
'(left right))
(mapc (lambda (fun)
(funcall fun
desktop-buffer-file-name
desktop-buffer-name
desktop-buffer-misc))
sunrise-desktop-restore-handlers))
buffer))
(defun sunrise-desktop-sort (buffer side desktop-buffer-misc)
"Restore the sorting order in BUFFER to be displayed in SIDE.
Use the data in DESKTOP-BUFFER-MISC to obtain all pertinent
details."
(with-current-buffer buffer
(let ((sunrise-selected-window side)
(sorting-order (cdr (assoc 'sorting-order desktop-buffer-misc)))
(sorting-reverse (cdr (assoc 'sorting-reverse desktop-buffer-misc))))
(when sorting-order
(condition-case nil
(funcall (intern (format "sunrise-sort-by-%s" (downcase sorting-order))))
(error (ignore))))
(when sorting-reverse (sunrise-reverse-pane)))))
(defun sunrise-reset-state ()
"Reset some environment variables that control the Sunrise behavior.
Used for desktop support."
(setq sunrise-left-directory "~/" sunrise-right-directory "~/"
sunrise-this-directory "~/" sunrise-other-directory "~/")
(if sunrise-running (sunrise-quit))
nil)
(defun sunrise-desktop-after-read-function ()
(unless (assoc 'sunrise-running desktop-globals-to-clear)
(add-to-list 'desktop-globals-to-clear
'(sunrise-running . (sunrise-reset-state))))
(when (and (buffer-live-p sunrise-left-buffer)
(get-buffer-window sunrise-left-buffer))
(sunrise-setup-windows)
(sunrise-highlight)
(setq sunrise-current-frame (window-frame (selected-window))
sunrise-running t)))
;; This registers the previous functions in the desktop framework:
(add-to-list 'desktop-buffer-mode-handlers
'(sunrise-mode . sunrise-desktop-restore-buffer))
;; This initializes (and sometimes starts) Sunrise after desktop restoration:
(add-hook 'desktop-after-read-hook 'sunrise-desktop-after-read-function)
;;; ============================================================================
;;; Miscellaneous functions:
(defun sunrise-buffer-files (buffer-or-name)
"Return the list of all file names currently displayed in the given buffer."
(with-current-buffer buffer-or-name
(save-excursion
(let ((result nil))
(sunrise-beginning-of-buffer)
(while (not (eobp))
(setq result (cons (dired-get-filename t t) result))
(forward-line 1))
(reverse result)))))
(defun sunrise-keep-buffer (&optional side)
"Keep the currently displayed buffer in SIDE (left or right) window.
Keeps it there even if it does not belong to the panel's history
ring. If SIDE is nil, use the value of `sunrise-selected-window'
instead. Useful for maintaining the contents of the pane during
layout switching."
(let* ((side (or side sunrise-selected-window))
(window (symbol-value (sunrise-symbol side 'window))))
(set (sunrise-symbol side 'buffer) (window-buffer window))))
(defun sunrise-scrollable-viewer (buffer)
"Set the `other-window-scroll-buffer' variable to BUFFER.
Doing so allows to scroll the given buffer directly from the active pane."
(setq other-window-scroll-buffer buffer)
(if buffer
(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")))
(defun sunrise-describe-mode ()
"Call `describe-mode' and make the resulting buffer C-M-v scrollable."
(interactive)
(describe-mode)
(sunrise-scrollable-viewer (get-buffer "*Help*"))
(sunrise-select-window sunrise-selected-window))
(defun sunrise-equal-dirs (dir1 dir2)
"Return non-nil if the two paths DIR1 and DIR2 represent the same directory."
(string= (expand-file-name (concat (directory-file-name dir1) "/"))
(expand-file-name (concat (directory-file-name dir2) "/"))))
(defun sunrise-summary ()
"Summarize basic Sunrise commands and show recent Dired errors."
(interactive)
(dired-why)
(message "C-opy, R-ename, K-lone, D-elete, v-iew, e-X-ecute, Ff-ollow, \
Jj-ump, q-uit, m-ark, u-nmark, h-elp"))
(defun sunrise-restore-point-if-same-buffer ()
"Synchronize point position if the same buffer is displayed in both panes."
(let ((this-win)(other-win)(point))
(when (and (eq sunrise-left-buffer sunrise-right-buffer)
(window-live-p (setq other-win (sunrise-other 'window))))
(setq this-win (selected-window))
(setq point (point))
(select-window other-win)
(goto-char point)
(select-window this-win))))
(defun sunrise-mark-toggle ()
"Toggle the mark on the current file or directory."
(interactive)
(when (dired-get-filename t t)
(if (eq ? (char-after (line-beginning-position)))
(dired-mark 1)
(dired-unmark 1))))
(defun sunrise-assoc-key (name alist test)
"Return the key in ALIST matched by NAME according to TEST."
(let (head (tail alist) found)
(while (and tail (not found))
(setq head (caar tail)
found (and (apply test (list head name)) head)
tail (cdr tail)))
found))
(defun sunrise-get-marked-files ()
"Return current pane's *explicitly* selected entries, or nil if
no entries have been explicitly selected."
(let ((marked))
(condition-case err
(setq marked (dired-get-marked-files t nil nil t))
(error (unless (string= "No file on this line" (cadr err))
(signal (car err) (cdr err)))))
(unless (< (length marked) 2)
(if (eq t (car marked)) (setq marked (cdr marked)))
marked)))
(defun sunrise-quote-marked ()
"Return current pane's explicitly selected entries quoted and
space-separated as a string, or nil if no entries have been
explicitly selected."
(let ((marked (sunrise-get-marked-files)))
(when marked
(format "\"%s\"" (mapconcat 'identity marked "\" \"")))))
(defun sunrise-fix-listing-switches()
"Work around a bug in Dired that makes `dired-move-to-filename' misbehave
when any of the options -p or -F is used with ls."
(mapc (lambda (sym)
(let ((val (replace-regexp-in-string "\\(?:^\\| \\)-[pF]*\\(?: \\|$\\)" " " (symbol-value sym))))
(while (string-match "\\(?:^\\| \\)-[^- ]*[pF]" val)
(setq val (replace-regexp-in-string "\\(\\(?:^\\| \\)-[^- ]*\\)[pF]\\([^ ]*\\)" "\\1\\2" val)))
(set sym val)))
'(sunrise-listing-switches sunrise-virtual-listing-switches))
(remove-hook 'sunrise-init-hook 'sunrise-fix-listing-switches))
(add-hook 'sunrise-init-hook 'sunrise-fix-listing-switches)
(defun sunrise-chop (char path)
"Remove all trailing instances of character CHAR from the string PATH."
(while (and (< 1 (length path))
(eq (string-to-char (substring path -1)) char))
(setq path (substring path 0 -1)))
path)
(defun sunrise-flatlist (in &optional out rev)
"Flatten the nesting in an arbitrary list of values."
(cond
((and (null in) rev) out)
((null in) (nreverse out))
(t
(let ((head (car in)) (tail (cdr in)))
(if (atom head)
(sunrise-flatlist tail (cons head out) rev)
(sunrise-flatlist tail (append (sunrise-flatlist head nil t) out) rev))))))
;;; ============================================================================
;;; Advice
(defun sunrise-ad-enable (regexp &optional function)
"Put all or FUNCTION-specific advice matching REGEXP into effect.
If provided, only update FUNCTION itself, otherwise all functions
with advice matching REGEXP."
(cond ((not function)
(ad-enable-regexp regexp)
(ad-activate-regexp regexp))
(t
(ad-enable-advice function 'any regexp)
(ad-activate function))))
(defun sunrise-ad-disable (regexp &optional function)
"Stop all FUNCTION-specific advice matching REGEXP from taking effect.
If provided, only update FUNCTION itself, otherwise all functions
with advice matching REGEXP."
(cond ((not function)
(ad-disable-regexp regexp)
(ad-update-regexp regexp))
(t
(ad-disable-advice function 'any regexp)
(ad-update function))))
(defun sunrise-unload-function ()
(sunrise-ad-disable "^sunrise-advice-"))
;;; ============================================================================
;;; Font-Lock colors & styles:
(defmacro sunrise-define-rainbow-face (symbol spec regexp)
`(progn
(defface ,symbol
'((t ,spec)) "Sunrise rainbow face"
:group 'sunrise-faces)
,@(mapcar (lambda (m)
`(font-lock-add-keywords ',m '((,regexp 1 ',symbol))))
'(sunrise-mode sunrise-virtual-mode))))
(sunrise-define-rainbow-face
sunrise-html-face
(:foreground "DarkOliveGreen") "\\(^[^!].[^d].*\\.x?html?$\\)")
(sunrise-define-rainbow-face
sunrise-xml-face
(:foreground "DarkGreen")
"\\(^[^!].[^d].*\\.\\(xml\\|xsd\\|xslt?\\|wsdl\\)$\\)")
(sunrise-define-rainbow-face
sunrise-log-face
(:foreground "brown")
"\\(^[^!].[^d].*\\.log$\\)")
(sunrise-define-rainbow-face
sunrise-compressed-face
(:foreground "magenta")
"\\(^[^!].[^d].*\\.\\(zip\\|bz2\\|t?[gx]z\\|[zZ]\\|[jwers]?ar\\|xpi\\|apk\\|xz\\)$\\)")
(sunrise-define-rainbow-face
sunrise-packaged-face
(:foreground "DarkMagenta")
"\\(^[^!].[^d].*\\.\\(deb\\|rpm\\)$\\)")
(sunrise-define-rainbow-face
sunrise-encrypted-face
(:foreground "DarkOrange1")
"\\(^[^!].[^d].*\\.\\(gpg\\|pgp\\)$\\)")
(sunrise-define-rainbow-face
sunrise-directory-face
(:inherit dired-directory :bold t)
"\\(^[^!].d.*\\)")
(sunrise-define-rainbow-face
sunrise-symlink-face
(:inherit dired-symlink :italic t)
"\\(^[^!].l.*[^/]$\\)")
(sunrise-define-rainbow-face
sunrise-symlink-directory-face
(:inherit dired-directory :italic t)
"\\(^[^!].l.*/$\\)")
(sunrise-define-rainbow-face
sunrise-alt-marked-dir-face
(:foreground "DeepPink" :bold t)
"\\(^[^ *!D].d.*$\\)")
(sunrise-define-rainbow-face
sunrise-alt-marked-file-face
(:foreground "DeepPink")
"\\(^[^ *!D].[^d].*$\\)")
(sunrise-define-rainbow-face
sunrise-marked-dir-face
(:inherit dired-marked)
"\\(^[*!D].d.*$\\)")
(sunrise-define-rainbow-face
sunrise-marked-file-face
(:inherit dired-marked :bold nil)
"\\(^[*!D].[^d].*$\\)")
(sunrise-define-rainbow-face
sunrise-broken-link-face
(:inherit dired-warning :italic t)
"\\(^[!].l.*$\\)")
(provide 'sunrise)
;;; sunrise.el ends here
Reference in New Issue View Git Blame Copy Permalink