doom, whatever
This commit is contained in:
parent
fb77c998d8
commit
d2d1b1b682
|
|
@ -0,0 +1,55 @@
|
|||
(TeX-add-style-hook
|
||||
"README"
|
||||
(lambda ()
|
||||
(TeX-add-to-alist 'LaTeX-provided-class-options
|
||||
'(("article" "11pt")))
|
||||
(TeX-add-to-alist 'LaTeX-provided-package-options
|
||||
'(("inputenc" "utf8") ("fontenc" "T1") ("ulem" "normalem")))
|
||||
(add-to-list 'LaTeX-verbatim-macros-with-braces-local "href")
|
||||
(add-to-list 'LaTeX-verbatim-macros-with-braces-local "hyperref")
|
||||
(add-to-list 'LaTeX-verbatim-macros-with-braces-local "hyperimage")
|
||||
(add-to-list 'LaTeX-verbatim-macros-with-braces-local "hyperbaseurl")
|
||||
(add-to-list 'LaTeX-verbatim-macros-with-braces-local "nolinkurl")
|
||||
(add-to-list 'LaTeX-verbatim-macros-with-braces-local "url")
|
||||
(add-to-list 'LaTeX-verbatim-macros-with-braces-local "path")
|
||||
(add-to-list 'LaTeX-verbatim-macros-with-delims-local "path")
|
||||
(TeX-run-style-hooks
|
||||
"latex2e"
|
||||
"article"
|
||||
"art11"
|
||||
"inputenc"
|
||||
"fontenc"
|
||||
"graphicx"
|
||||
"grffile"
|
||||
"longtable"
|
||||
"wrapfig"
|
||||
"rotating"
|
||||
"ulem"
|
||||
"amsmath"
|
||||
"textcomp"
|
||||
"amssymb"
|
||||
"capt-of"
|
||||
"hyperref")
|
||||
(LaTeX-add-labels
|
||||
"sec:org5353487"
|
||||
"sec:orgd6bd057"
|
||||
"sec:orgf9e85bd"
|
||||
"sec:org77e416c"
|
||||
"sec:orgdeecf62"
|
||||
"sec:org7503de0"
|
||||
"sec:org50def99"
|
||||
"sec:orgd580bdf"
|
||||
"sec:org9fa885d"
|
||||
"sec:org0b3b8d4"
|
||||
"sec:org6f2c868"
|
||||
"sec:org3a32ad2"
|
||||
"sec:org59d77af"
|
||||
"sec:org8e3b2e1"
|
||||
"sec:org55dfd9d"
|
||||
"sec:org18f354e"
|
||||
"sec:org7f4a24e"
|
||||
"sec:orgb0c6ce7"
|
||||
"sec:org7483384"
|
||||
"sec:orgfe99b0a"))
|
||||
:latex)
|
||||
|
||||
|
|
@ -1,5 +1,3 @@
|
|||
(setq user-full-name "inigoortega"
|
||||
user-mail-address "inigoortega@tutanota.com")
|
||||
;; -*- lexical-binding: t -*-
|
||||
(setq doom-font (font-spec :family "monospace" :width 'normal :size 17)
|
||||
doom-variable-pitch-font (font-spec :family "monospace"))
|
||||
|
|
@ -157,6 +155,32 @@
|
|||
(interactive)
|
||||
(if (string-match-p "^ " (buffer-name))
|
||||
(rename-buffer (concat " " (buffer-name)))))
|
||||
(defun dfeich/ansi-terminal (&optional path name)
|
||||
"Opens an ansi terminal at PATH. If no PATH is given, it uses
|
||||
the value of `default-directory'. PATH may be a tramp remote path.
|
||||
The ansi-term buffer is named based on `name' "
|
||||
(interactive)
|
||||
(unless path (setq path default-directory))
|
||||
(unless name (setq name "ansi-term"))
|
||||
(ansi-term "/bin/bash" name)
|
||||
(let ((path (replace-regexp-in-string "^file:" "" path))
|
||||
(cd-str
|
||||
"fn=%s; if test ! -d $fn; then fn=$(dirname $fn); fi; cd $fn;")
|
||||
(bufname (concat "*" name "*" )))
|
||||
(if (tramp-tramp-file-p path)
|
||||
(let ((tstruct (tramp-dissect-file-name path)))
|
||||
(cond
|
||||
((equal (tramp-file-name-method tstruct) "ssh")
|
||||
(process-send-string bufname (format
|
||||
(concat "ssh -t %s '"
|
||||
cd-str
|
||||
"exec bash'; exec bash; clear\n")
|
||||
(tramp-file-name-host tstruct)
|
||||
(tramp-file-name-localname tstruct))))
|
||||
(t (error "not implemented for method %s"
|
||||
(tramp-file-name-method tstruct)))))
|
||||
(process-send-string bufname (format (concat cd-str " exec bash;clear\n")
|
||||
path)))))
|
||||
(defun ins-mode (str)
|
||||
(interactive)
|
||||
(setq f (gethash major-mode insert-on-mode))
|
||||
|
|
@ -330,8 +354,17 @@ instead."
|
|||
(map! :n "SPC f z" #'counsel-fzf)
|
||||
(map! :n "SPC b j" #'ivy-switch-buffer)
|
||||
(map! :n "SPC j j" #'ivy-switch-buffer)
|
||||
(map! :n "SPC o s" #'ansi-term)
|
||||
(map! :map 'ranger-mode-map :g "SPC b j" #'ivy-switch-buffer)
|
||||
(map! :map 'ranger-mode-map :g "SPC j j" #'ivy-switch-buffer)
|
||||
(map! :n "SPC o c" #'calendar)
|
||||
(map! :n "SPC o s" #'ansi-term)
|
||||
|
||||
(map! :map 'ranger-mode-map :g "SPC o c" #'calendar)
|
||||
(map! :map 'ranger-mode-map :g "SPC o s"
|
||||
(lambda() (interactive)
|
||||
(if (file-remote-p default-directory)
|
||||
(dfeich/ansi-terminal)
|
||||
(ansi-term my-term-shell))))
|
||||
(map! :n "SPC j h" (lambda () (interactive) (ansi-term "htop")))
|
||||
(defun mark-real-user-buffer()
|
||||
(interactive)
|
||||
|
|
@ -469,6 +502,9 @@ instead."
|
|||
(calendar-set-date-style 'european)))
|
||||
(setq calendar-week-start-day 1)
|
||||
(setq flycheck-flake8-maximum-line-length 80)
|
||||
(add-to-list 'load-path "~/.doom.d/lisp/")
|
||||
(load "rate-sx")
|
||||
(load "sunrise")
|
||||
(after! haskell-mode
|
||||
(progn
|
||||
(setq
|
||||
|
|
@ -529,3 +565,9 @@ instead."
|
|||
(highlight-words-on-mode 'sh-mode sh-symbols)
|
||||
;; (add-to-list 'TeX-mode-hook #'TeX-fold-buffer)
|
||||
;; (add-hook! 'tex-mode-hook #'TeX-fold-buffer)
|
||||
(defun my-shell ()
|
||||
(interactive)
|
||||
(let ((default-directory "/ssh:initega@192.168.0.28:"))
|
||||
(eshell)))
|
||||
(setq user-full-name "inigoortega"
|
||||
user-mail-address "inigoortega@tutanota.com")
|
||||
|
|
|
|||
|
|
@ -223,6 +223,36 @@ Xah Lee, read .bashrc:
|
|||
(rename-buffer (concat " " (buffer-name)))))
|
||||
#+END_SRC
|
||||
|
||||
Ansi-term for TRAMP:
|
||||
#+BEGIN_SRC emacs-lisp
|
||||
(defun dfeich/ansi-terminal (&optional path name)
|
||||
"Opens an ansi terminal at PATH. If no PATH is given, it uses
|
||||
the value of `default-directory'. PATH may be a tramp remote path.
|
||||
The ansi-term buffer is named based on `name' "
|
||||
(interactive)
|
||||
(unless path (setq path default-directory))
|
||||
(unless name (setq name "ansi-term"))
|
||||
(ansi-term "/bin/bash" name)
|
||||
(let ((path (replace-regexp-in-string "^file:" "" path))
|
||||
(cd-str
|
||||
"fn=%s; if test ! -d $fn; then fn=$(dirname $fn); fi; cd $fn;")
|
||||
(bufname (concat "*" name "*" )))
|
||||
(if (tramp-tramp-file-p path)
|
||||
(let ((tstruct (tramp-dissect-file-name path)))
|
||||
(cond
|
||||
((equal (tramp-file-name-method tstruct) "ssh")
|
||||
(process-send-string bufname (format
|
||||
(concat "ssh -t %s '"
|
||||
cd-str
|
||||
"exec bash'; exec bash; clear\n")
|
||||
(tramp-file-name-host tstruct)
|
||||
(tramp-file-name-localname tstruct))))
|
||||
(t (error "not implemented for method %s"
|
||||
(tramp-file-name-method tstruct)))))
|
||||
(process-send-string bufname (format (concat cd-str " exec bash;clear\n")
|
||||
path)))))
|
||||
#+END_SRC
|
||||
|
||||
ii mode:
|
||||
#+BEGIN_SRC emacs-lisp
|
||||
(defun ins-mode (str)
|
||||
|
|
@ -424,11 +454,20 @@ zsh as ansi-term shell
|
|||
#+BEGIN_SRC emacs-lisp
|
||||
(map! :n "SPC b j" #'ivy-switch-buffer)
|
||||
(map! :n "SPC j j" #'ivy-switch-buffer)
|
||||
(map! :map 'ranger-mode-map :g "SPC b j" #'ivy-switch-buffer)
|
||||
(map! :map 'ranger-mode-map :g "SPC j j" #'ivy-switch-buffer)
|
||||
#+END_SRC
|
||||
|
||||
#+BEGIN_SRC emacs-lisp
|
||||
(map! :n "SPC o s" #'ansi-term)
|
||||
(map! :n "SPC o c" #'calendar)
|
||||
(map! :n "SPC o s" #'ansi-term)
|
||||
|
||||
(map! :map 'ranger-mode-map :g "SPC o c" #'calendar)
|
||||
(map! :map 'ranger-mode-map :g "SPC o s"
|
||||
(lambda() (interactive)
|
||||
(if (file-remote-p default-directory)
|
||||
(dfeich/ansi-terminal)
|
||||
(ansi-term my-term-shell))))
|
||||
#+END_SRC
|
||||
|
||||
Emacs powered window manager keybinding clones:
|
||||
|
|
@ -638,6 +677,12 @@ Interesting buffers filter:
|
|||
#+BEGIN_SRC emacs-lisp
|
||||
(setq flycheck-flake8-maximum-line-length 80)
|
||||
#+END_SRC
|
||||
** Personal packages
|
||||
#+BEGIN_SRC emacs-lisp
|
||||
(add-to-list 'load-path "~/.doom.d/lisp/")
|
||||
(load "rate-sx")
|
||||
(load "sunrise")
|
||||
#+END_SRC
|
||||
** Haskell
|
||||
Haskell-mode configs:
|
||||
# ;; Ancient code for hindent
|
||||
|
|
@ -745,6 +790,13 @@ Highlight predule:
|
|||
;; (add-to-list 'TeX-mode-hook #'TeX-fold-buffer)
|
||||
;; (add-hook! 'tex-mode-hook #'TeX-fold-buffer)
|
||||
#+END_SRC
|
||||
** TRAMP
|
||||
#+BEGIN_SRC emacs-lisp
|
||||
(defun my-shell ()
|
||||
(interactive)
|
||||
(let ((default-directory "/ssh:initega@192.168.0.28:"))
|
||||
(eshell)))
|
||||
#+END_SRC
|
||||
* Doom info
|
||||
Here are some additional functions/macros that could help you configure Doom:
|
||||
|
||||
|
|
|
|||
|
|
@ -0,0 +1,165 @@
|
|||
;;; rate-sx.el --- Show currency rates from rate.sx -*- lexical-binding: t -*-
|
||||
;; Copyright 2017-2018 by Dave Pearson <davep@davep.org>
|
||||
|
||||
;; Author: Dave Pearson <davep@davep.org>
|
||||
;; Version: 1.4
|
||||
;; Keywords: comm, currency, bitcoin, money
|
||||
;; URL: https://github.com/davep/rate-sx.el
|
||||
;; Package-Requires: ((emacs "24.4"))
|
||||
|
||||
;; 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 details.
|
||||
;;
|
||||
;; 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:
|
||||
;;
|
||||
;; `rate-sx.el' provides a main command, `rate-sx', which displays the
|
||||
;; output of http://rate.sx in a buffer.
|
||||
;;
|
||||
;; Other commands provide ways to quickly calculate currency totals, they
|
||||
;; include:
|
||||
;;
|
||||
;; `rate-sx-calc'
|
||||
;;
|
||||
;; Show the result of a currency calculation in the minibuffer. Calculations
|
||||
;; are things like "1BTC+12ETH" (would show the total value, in the base
|
||||
;; currency defined by `rate-sx-default-currency', of holding 1 BTC and 12
|
||||
;; ETH).
|
||||
;;
|
||||
;; `rate-sx-calc-region'
|
||||
;;
|
||||
;; Same as above but takes the input from the content of the marked region.
|
||||
;;
|
||||
;; `rate-sx-calc-maybe-region'
|
||||
;;
|
||||
;; Same as above again, but performs `rate-sx-calc-region' if there is an
|
||||
;; active mark, otherwise it performs `rate-sx-calc'.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'ansi-color)
|
||||
(require 'url-util)
|
||||
|
||||
(defconst rate-sx-url "http://%srate.sx/%s"
|
||||
"URL for rate.sx.")
|
||||
|
||||
(defconst rate-sx-user-agent "rate-sx.el (https://github.com/davep/rate-sx.el) (curl)"
|
||||
"User agent to send to the rate.sx server.")
|
||||
|
||||
(defconst rate-sx-buffer "*rate.sx*"
|
||||
"Name of the output buffer.")
|
||||
|
||||
(defvar rate-sx-currencies '(www btc eth)
|
||||
"List of currencies that rate.sx can convert to.
|
||||
|
||||
Don't use this directly. Use the function `rate-sx-currencies'
|
||||
instead.
|
||||
|
||||
See http://rate.sx/:help for more details.")
|
||||
|
||||
(defvar rate-sx-options '(btc@7d eth@7d btc eth btc@31d eth@31d btc@1y eth@1y)
|
||||
"List of options that rate.sx can convert to.
|
||||
|
||||
Don't use this directly. Use the function `rate-sx-currencies'
|
||||
instead.
|
||||
|
||||
See http://rate.sx/:help for more details.")
|
||||
|
||||
(defvar rate-sx-default-option nil
|
||||
"The default display option when calling rate.sx.
|
||||
|
||||
If nil the default option as used by rate.sx itself will be
|
||||
used")
|
||||
|
||||
(defvar rate-sx-default-currency nil
|
||||
"The default display currency when calling rate.sx.
|
||||
|
||||
If nil the default currency as used by rate.sx itself will be
|
||||
used. See function `rate-sx-currencies' or the help screen of rate.sx
|
||||
itself for more currency options.")
|
||||
|
||||
(defun rate-sx-get (&optional currency params)
|
||||
"Get the output from rate.sx.
|
||||
|
||||
Values will be acquired in CURRENCY, or the default currency of
|
||||
rate.sx will be used if one isn't supplied.
|
||||
|
||||
PARAMS will be added to the end of `rate-sx-url' if they are supplied."
|
||||
(let* ((url-mime-accept-string "text/plain")
|
||||
(url-request-extra-headers `(("User-Agent" . ,rate-sx-user-agent)))
|
||||
(url-show-status nil))
|
||||
(with-temp-buffer
|
||||
(url-insert-file-contents (format rate-sx-url
|
||||
(if currency
|
||||
(concat currency ".")
|
||||
"")
|
||||
(or params "")))
|
||||
(buffer-string))))
|
||||
|
||||
(defun rate-sx-currencies-to-alist (rates)
|
||||
"Convert RATES list from rate.sx into an assoc list."
|
||||
(let ((arates))
|
||||
(while rates
|
||||
(when (not (string= "" (car rates)))
|
||||
(setq arates (append arates (list (cons (car rates) (cadr rates))))))
|
||||
(setq rates (cddr rates)))
|
||||
arates))
|
||||
|
||||
(defun rate-sx-get-currencies ()
|
||||
"Get the currency list from the rate.sx site."
|
||||
(rate-sx-currencies-to-alist (split-string (rate-sx-get nil ":currencies") "\\( \\|\n\\)")))
|
||||
|
||||
(defun rate-sx-currencies ()
|
||||
"Return the list of (non-crypto) currencies."
|
||||
(or rate-sx-currencies (setq rate-sx-currencies (rate-sx-get-currencies))))
|
||||
|
||||
;;;###autoload
|
||||
(defun rate-sx (currency option)
|
||||
"Show the current output of rate.sx in a new buffer.
|
||||
|
||||
If CURRENCY is non-nil, this command will prompt for a display currency."
|
||||
(interactive
|
||||
(list (if current-prefix-arg
|
||||
(completing-read "Currency: " rate-sx-currencies nil t)
|
||||
rate-sx-default-currency)
|
||||
(if current-prefix-arg
|
||||
(completing-read "Option: " rate-sx-options nil t)
|
||||
rate-sx-default-option)))
|
||||
(with-help-window rate-sx-buffer
|
||||
(with-current-buffer rate-sx-buffer
|
||||
(insert (ansi-color-apply (rate-sx-get currency option))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun rate-sx-calc (calc)
|
||||
"Evaluate CALC via rate.sx.
|
||||
|
||||
The result is given in `rate-sx-default-currency'."
|
||||
(interactive "sCalc: ")
|
||||
(message "Result: %s" (string-trim (rate-sx-get rate-sx-default-currency (url-hexify-string calc)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun rate-sx-calc-region (start end)
|
||||
"Perform `rate-sx-calc' on text in region START to END."
|
||||
(interactive "r")
|
||||
(rate-sx-calc (buffer-substring-no-properties start end)))
|
||||
|
||||
;;;###autoload
|
||||
(defun rate-sx-calc-maybe-region ()
|
||||
"Perform a rate calculation on a region if one is active.
|
||||
|
||||
If one isn't active, prompt for the calculation."
|
||||
(interactive)
|
||||
(call-interactively (if mark-active #'rate-sx-calc-region #'rate-sx-calc)))
|
||||
|
||||
(provide 'rate-sx)
|
||||
|
||||
;;; rate-sx.el ends here
|
||||
|
|
@ -0,0 +1,610 @@
|
|||
;;; sunrise-mirror.el --- Compressed archive support for the Sunrise Commander -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2008-2012 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: 4 May 2008
|
||||
;; Version: 2
|
||||
;; Package-Requires: ((emacs "24.3") (cl-lib "0.5"))
|
||||
;; Keywords: files, sunrise commander, archives read/write
|
||||
;; 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:
|
||||
|
||||
;; This is an extension for the Sunrise Commander file manager (for more
|
||||
;; details visit http://www.emacswiki.org/emacs/Sunrise_Commander), that
|
||||
;; allows browsing compressed archives in full read-write mode. Sunrise does
|
||||
;; offer means for transparent browsing archives (using AVFS), but they just
|
||||
;; provide read-only navigation -- if you want to edit a file inside the
|
||||
;; virtual filesystem, copy, remove, or rename anything, you still have to
|
||||
;; uncompress the archive, do the stuff and compress it back yourself.
|
||||
|
||||
;; It uses one or unionfs-fuse or funionfs to create a writeable overlay on
|
||||
;; top of the read-only filesystem provided by AVFS. You can freely add,
|
||||
;; remove or modify anything inside the resulting union filesystem (a.k.a. the
|
||||
;; "mirror area"), and then commit all modifications (or not) to the original
|
||||
;; archive with a single keystroke. There is no preliminary uncompressing of
|
||||
;; the archive and nothing happens if you don't make changes (or if you don't
|
||||
;; commit them). On commit, the contents of the union fs are compressed to
|
||||
;; create an updated archive to replace the original one (optionally after
|
||||
;; making a backup copy of it, just in case).
|
||||
|
||||
;; Navigating outside a mirror area will automatically close it, so if you do
|
||||
;; it you may be asked whether to commit or not to the archive all your
|
||||
;; changes. In nested archives (e.g. a jar inside a zip inside a tgz), partial
|
||||
;; modifications are committed silently on the fly if moving out from a
|
||||
;; modified archive to one that contains it. Only if you leave the topmost
|
||||
;; mirror area you will be asked for confirmation whether to modify the
|
||||
;; resulting archive.
|
||||
|
||||
;; Be warned, though, that this method may be impractical for very large or
|
||||
;; very deeply nested archives with strong compression, since the
|
||||
;; uncompressing happens in the final stage and requires multiple access
|
||||
;; operations through AVFS. What this means is that probably you'll have to
|
||||
;; wait a looooong time if you try to commit changes to a tar.bz2 file with
|
||||
;; several hundreds of megabytes in size, or under five or six other layers of
|
||||
;; strong compression.
|
||||
|
||||
;; For this extension to work you must have:
|
||||
|
||||
;; 1) FUSE + AVFS support in your Sunrise Commander. If you can navigate
|
||||
;; (read- only) inside compressed archives you already have this.
|
||||
|
||||
;; 2) One of unionfs-fuse or funionfs. Debian squeeze (stable) offers a
|
||||
;; package for the first, which is currently the recommended implementation.
|
||||
|
||||
;; 3) Programs required for repacking archives -- at least zip and tar.
|
||||
|
||||
;; 4) Your AVFS mount point (and the value of variable `sunrise-avfs-root')
|
||||
;; must be in a directory where you have writing access.
|
||||
|
||||
;; All this means is that most probably this extension will work
|
||||
;; out-of-the-box on Linux (or MacOS, or other unices), but you'll have a hard
|
||||
;; time to make it work on Windows. It was written on GNU Emacs 23 on Linux
|
||||
;; and tested on GNU Emacs 22 and 23 for Linux.
|
||||
|
||||
;;; Installation and Usage:
|
||||
|
||||
;; 1) Put this file somewhere in your Emacs `load-path'.
|
||||
|
||||
;; 2) Add a (require 'sunrise-mirror) to your .emacs file, anywhere after the
|
||||
;; (require 'sunrise) sexp.
|
||||
|
||||
;; 3) Evaluate the new expression, or reload your .emacs file, or restart
|
||||
;; Emacs.
|
||||
|
||||
;; 4) Customize the variable `sunrise-mirror-unionfs-impl' and select your
|
||||
;; preferred unionfs implementation (either unionfs-fuse or funionfs).
|
||||
|
||||
;; 5) Run the Sunrise Commander (M-x sunrise), select (or navigate inside) any
|
||||
;; compressed directory in the active pane and press C-c C-b. This will
|
||||
;; automatically take you to the mirror area for the selected archive. You can
|
||||
;; make any modifications you want to the contents of the archive, or navigate
|
||||
;; inside directories or other compressed archives inside it. When you're
|
||||
;; done, press again C-c C-b anywhere inside the mirror area, or simply
|
||||
;; navigate out of it. If there are any changes to commit (*and* if you
|
||||
;; confirm) the original archive will be replaced with a new one with the
|
||||
;; contents of the mirror area you've just been working on. If you don't
|
||||
;; change the defaults, the original will be renamed with a ".bak" extension
|
||||
;; added.
|
||||
|
||||
;; 6) You can add support for new archive formats by adding new entries to the
|
||||
;; `sunrise-mirror-pack-commands-alist' custom variable, which contains a
|
||||
;; regular expression to match against the name of the archive and a string
|
||||
;; containing the shell command to execute for packing back the mirror area
|
||||
;; into a compressed archive.
|
||||
|
||||
;; 7) Once you've gained enough confidence using this extension you can reset
|
||||
;; the `sunrise-mirror-keep-backups' flag to get rid of all the backup copies
|
||||
;; produced by it.
|
||||
|
||||
;; 8) Enjoy ;)
|
||||
|
||||
;;; Code:
|
||||
|
||||
(eval-when-compile
|
||||
(require 'cl-lib))
|
||||
|
||||
(require 'sunrise)
|
||||
|
||||
(defcustom sunrise-mirror-keep-backups t
|
||||
"If non-nil, keep backup files when committing changes to read-only archives."
|
||||
:group 'sunrise
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom sunrise-mirror-pack-commands-alist
|
||||
'(
|
||||
("\\.\\(?:zip\\|xpi\\|apk\\)$" . "zip -r %f *")
|
||||
("\\.[jwesh]ar$" . "zip -r %f *")
|
||||
("\\.tar$" . "tar cvf %f *")
|
||||
("\\.\\(?:tar\\.gz\\|tgz\\)$" . "tar cvzf %f *")
|
||||
("\\.tar\\.bz2$" . "tar cvjf %f *")
|
||||
("\\.\\(?:tar\\.xz\\|txz\\)$" . "tar cvJf %f *")
|
||||
)
|
||||
"List of shell commands to repack particular archive contents.
|
||||
Used when repacking contents from a mirror area into a compressed
|
||||
archive of the appropriate type. Use %f as a placeholder for the
|
||||
name of the resulting archive. If no repacking command has been
|
||||
registered here for a file (usually a file extension), Sunrise
|
||||
will refuse to create a mirror area for it even if it is normally
|
||||
browseable through AVFS."
|
||||
:group 'sunrise
|
||||
:type 'alist)
|
||||
|
||||
(defcustom sunrise-mirror-unionfs-impl 'unionfs-fuse
|
||||
"Implementation of unionfs to use for creating mirror areas."
|
||||
:group 'sunrise
|
||||
:type '(choice (const :tag "unionfs-fuse" unionfs-fuse)
|
||||
(const :tag "funionfs" funionfs)))
|
||||
|
||||
(defface sunrise-mirror-path-face
|
||||
'((t (:background "blue" :foreground "yellow" :bold t :height 120)))
|
||||
"Face of the directory path inside mirror areas."
|
||||
:group 'sunrise)
|
||||
|
||||
(defvar sunrise-mirror-home nil
|
||||
"Root directory of all mirror areas.
|
||||
Set automatically by the function `sunrise-mirror-enable' and reset by
|
||||
`sunrise-mirror-disable' to keep the mirror home path, as well as to
|
||||
indicate mirroring support is on/off. Do not mess with it
|
||||
directly - if you need to change the name of your mirror home
|
||||
dir, modify `sunrise-mirror-enable'.")
|
||||
|
||||
(defvar sunrise-mirror-divert-goto-dir t
|
||||
"Internal variable used to avoid infinite recursion.
|
||||
Used when diverting `sunrise-goto-dir' calls to `sunrise-mirror-goto-dir'.
|
||||
Do not touch, or else.")
|
||||
|
||||
(if (boundp 'sunrise-mode-map)
|
||||
(define-key sunrise-mode-map "\C-c\C-b" 'sunrise-mirror-toggle))
|
||||
|
||||
(defun sunrise-mirror-enable ()
|
||||
"Enable Sunrise mirror support.
|
||||
|
||||
Sets the variable `sunrise-mirror-home' to a non-nil value and
|
||||
activates all advice necessary for mirror operations. This method
|
||||
is called every time a new mirror area is created."
|
||||
(unless sunrise-mirror-home
|
||||
(setq sunrise-mirror-home (concat sunrise-avfs-root "#mirror#/"))
|
||||
(ad-activate 'make-directory)
|
||||
(ad-activate 'save-buffer)
|
||||
(ad-activate 'sunrise-goto-dir)))
|
||||
|
||||
(defun sunrise-mirror-disable ()
|
||||
"Disable Sunrise mirror support.
|
||||
|
||||
Resets `sunrise-mirror-home' and deactivates all advice used in
|
||||
mirror operations. This method is called after the last mirror
|
||||
area in the current mirror home is closed."
|
||||
(when sunrise-mirror-home
|
||||
(setq sunrise-mirror-home nil)
|
||||
(ad-deactivate 'make-directory)
|
||||
(ad-deactivate 'save-buffer)
|
||||
(ad-deactivate 'sunrise-goto-dir)))
|
||||
|
||||
(defun sunrise-mirror-open ()
|
||||
"Set up a mirror area in the current pane.
|
||||
|
||||
Uses unionfs-fuse to create a writeable filesystem overlay over
|
||||
the AVFS virtual filesystem of the selected compressed archive
|
||||
and displays it in the current pane. The result is a mirror of
|
||||
the contents of the original archive that is fully writeable."
|
||||
(interactive)
|
||||
(let ((path (or (dired-get-filename nil t)
|
||||
(concat (expand-file-name (dired-current-directory)) "/.")))
|
||||
(sunrise-mirror-divert-goto-dir nil)
|
||||
(sunrise-avfs-root (expand-file-name sunrise-avfs-root))
|
||||
fname vpaths)
|
||||
(if (sunrise-overlapping-paths-p sunrise-avfs-root path)
|
||||
(unless (and sunrise-mirror-home
|
||||
(sunrise-overlapping-paths-p sunrise-mirror-home path))
|
||||
(setq path (substring path (length sunrise-avfs-root))
|
||||
vpaths (split-string path "#[^/]*/")
|
||||
path (car vpaths)
|
||||
vpaths (cdr vpaths))))
|
||||
(setq fname (file-name-nondirectory path))
|
||||
(if (null (assoc-default
|
||||
fname sunrise-mirror-pack-commands-alist 'string-match))
|
||||
(error (concat "Sunrise: sorry, no packer was registered for "
|
||||
fname)))
|
||||
(sunrise-mirror-enable)
|
||||
(unless (file-exists-p sunrise-mirror-home)
|
||||
(make-directory sunrise-mirror-home))
|
||||
(if vpaths
|
||||
(mapc (lambda (x)
|
||||
(let ((sunrise-mirror-divert-goto-dir nil))
|
||||
(sunrise-goto-dir (sunrise-mirror-mount path))
|
||||
(sunrise-follow-file x)
|
||||
(setq path (dired-get-filename))))
|
||||
vpaths)
|
||||
(sunrise-goto-dir (sunrise-mirror-mount path)))
|
||||
(sunrise-graphical-highlight 'sunrise-mirror-path-face)
|
||||
(add-hook 'kill-buffer-hook 'sunrise-mirror-on-kill-buffer)
|
||||
t ))
|
||||
|
||||
(defun sunrise-mirror-mount (path)
|
||||
"Create and mount (if necessary) all the directories needed to mirror PATH.
|
||||
|
||||
PATH identifies the compressed archive. Returns the path to the
|
||||
corresponding mirror area."
|
||||
(let* ((base (sunrise-mirror-mangle path))
|
||||
(virtual (sunrise-mirror-full-demangle path))
|
||||
(mirror (concat sunrise-mirror-home base))
|
||||
(overlay (concat sunrise-mirror-home "." base))
|
||||
(command
|
||||
(cl-case sunrise-mirror-unionfs-impl
|
||||
(unionfs-fuse
|
||||
(concat "cd ~; unionfs-fuse -o cow,kernel_cache -o allow_other "
|
||||
overlay "=RW:" virtual "=RO " mirror))
|
||||
|
||||
(funionfs
|
||||
(concat "cd ~; funionfs " overlay " " mirror
|
||||
" -o dirs=" virtual "=ro")))))
|
||||
(if (null virtual)
|
||||
(error (concat "Sunrise: sorry, don't know how to mirror " path)))
|
||||
(unless (file-directory-p mirror)
|
||||
(make-directory mirror)
|
||||
(make-directory overlay)
|
||||
(shell-command-to-string command))
|
||||
mirror))
|
||||
|
||||
(defun sunrise-mirror-close (&optional do-commit local-commit moving)
|
||||
"Destroy the current mirror area.
|
||||
|
||||
Unmounts and deletes the directories it was built upon. Tries to
|
||||
automatically repack the mirror and substitute the original
|
||||
archive with a new one containing the modifications made to the
|
||||
mirror.
|
||||
|
||||
If optional argument DO-COMMIT is set, then all changes made to
|
||||
the mirror are unconditionally committed to the archive. If
|
||||
LOCAL-COMMIT is set, then the commit is considered local (changes
|
||||
effect a mirror nested inside another mirror). MOVING means that
|
||||
this operation was triggered by the user moving outside of the
|
||||
current mirror area (the current buffer will be killed soon)."
|
||||
(interactive)
|
||||
(unless sunrise-mirror-home
|
||||
(error (concat "Sunrise: sorry, can't mirror " (dired-get-filename))))
|
||||
|
||||
(let ((here (dired-current-directory))
|
||||
(sunrise-mirror-divert-goto-dir nil)
|
||||
(pos) (mirror) (overlay) (vroot) (vpath) (committed))
|
||||
|
||||
(unless (sunrise-overlapping-paths-p sunrise-mirror-home here)
|
||||
(error (concat "Sunrise: sorry, that's not a mirror area: " here)))
|
||||
|
||||
(setq pos (string-match "\\(?:/\\|$\\)" here
|
||||
(length sunrise-mirror-home))
|
||||
mirror (substring here (length sunrise-mirror-home) pos)
|
||||
overlay (concat "." mirror )
|
||||
vpath (substring here (1+ pos))
|
||||
do-commit
|
||||
(and (sunrise-mirror-files (concat sunrise-mirror-home overlay))
|
||||
(or do-commit
|
||||
(y-or-n-p "Sunrise: commit changes in mirror? "))))
|
||||
|
||||
(unless local-commit
|
||||
(sunrise-unhighlight 'sunrise-mirror-path-face))
|
||||
|
||||
(remove-hook 'kill-buffer-hook 'sunrise-mirror-on-kill-buffer)
|
||||
(sunrise-follow-file (sunrise-mirror-demangle mirror))
|
||||
(setq vroot (dired-get-filename 'no-dir))
|
||||
|
||||
(if do-commit (setq committed (sunrise-mirror-commit mirror)))
|
||||
(sunrise-mirror-unmount mirror overlay)
|
||||
|
||||
(unless local-commit
|
||||
(if (sunrise-overlapping-paths-p
|
||||
sunrise-mirror-home (dired-current-directory))
|
||||
(sunrise-mirror-close committed))
|
||||
(unless moving
|
||||
(sunrise-find-file
|
||||
(expand-file-name (concat default-directory vroot)))
|
||||
(if (< 0 (length vpath)) (sunrise-goto-dir vpath)))))
|
||||
|
||||
(sunrise-highlight)
|
||||
(if (and sunrise-mirror-home
|
||||
(null (directory-files sunrise-mirror-home nil "^[^.]")))
|
||||
(sunrise-mirror-disable))
|
||||
t)
|
||||
|
||||
(defun sunrise-mirror-commit (mirror)
|
||||
"Commit all modifications made to MIRROR in directory OVERLAY.
|
||||
|
||||
Replaces the mirrored archive with a new one built with the
|
||||
current contents of the mirror. Keeps a backup of the original
|
||||
archive if the variable `sunrise-mirror-backup' is non-nil (the
|
||||
default)."
|
||||
(condition-case err
|
||||
(let ((repacked (sunrise-mirror-repack mirror))
|
||||
(target (dired-get-filename)))
|
||||
(if (and sunrise-mirror-keep-backups
|
||||
(not (sunrise-overlapping-paths-p
|
||||
sunrise-mirror-home target)))
|
||||
(rename-file target (concat target ".bak") 1)
|
||||
(delete-file target))
|
||||
(copy-file repacked (dired-current-directory) t nil nil)
|
||||
(delete-file repacked)
|
||||
t)
|
||||
(error (progn
|
||||
(setq err (cadr err))
|
||||
(if (not (yes-or-no-p (concat err ". OK to continue? ")))
|
||||
(error err))))))
|
||||
|
||||
(defun sunrise-mirror-unmount (mirror overlay)
|
||||
"Unmount and delete all directories used to mirror a compressed archive.
|
||||
|
||||
MIRROR is the union of the AVFS directory that holds the contents
|
||||
of the archive (read-only) with OVERLAY, which contains all the
|
||||
modifications made to the union in the current session."
|
||||
(let* ((command (concat "cd ~; fusermount -u " sunrise-mirror-home mirror))
|
||||
(err (shell-command-to-string command)))
|
||||
(if (or (null err) (string= err ""))
|
||||
(progn
|
||||
(dired-delete-file (concat sunrise-mirror-home mirror) 'always)
|
||||
(dired-delete-file (concat sunrise-mirror-home overlay) 'always)
|
||||
(revert-buffer))
|
||||
(error (concat "Sunrise: error unmounting mirror: " err)))))
|
||||
|
||||
(defun sunrise-mirror-toggle ()
|
||||
"Open new or destroy the current mirror area, depending on context."
|
||||
(interactive)
|
||||
(let ((open-ok) (close-ok) (err-msg))
|
||||
(condition-case err1
|
||||
(setq open-ok (sunrise-mirror-open))
|
||||
(error (condition-case err2
|
||||
(progn
|
||||
(setq close-ok (sunrise-mirror-close))
|
||||
(setq err-msg (cadr err1)))
|
||||
(error
|
||||
(setq err-msg (cadr err2))) )) )
|
||||
(if (and (not open-ok) (not close-ok))
|
||||
(error err-msg)
|
||||
(sunrise-highlight))))
|
||||
|
||||
(defun sunrise-mirror-repack (mirror)
|
||||
"Try to repack the given MIRROR.
|
||||
|
||||
On success, returns a string containing the full path to the
|
||||
newly packed archive, otherwise throws an error."
|
||||
(message "Sunrise: repacking mirror, please wait...")
|
||||
(let* ((target-home (concat sunrise-mirror-home ".repacked/"))
|
||||
(archive (replace-regexp-in-string "#[a-z0-9#]*$" "" mirror))
|
||||
(target (replace-regexp-in-string
|
||||
"/?$" ""
|
||||
(car (last (split-string archive "+")))))
|
||||
(command (assoc-default archive sunrise-mirror-pack-commands-alist
|
||||
'string-match)))
|
||||
|
||||
(if (null command)
|
||||
(error (concat "Sunrise: sorry, don't know how to repack " mirror)))
|
||||
|
||||
(if (not (file-exists-p target-home))
|
||||
(make-directory target-home))
|
||||
(setq target (concat target-home target))
|
||||
(setq command (replace-regexp-in-string "%f" target command))
|
||||
(setq command (concat "cd " sunrise-mirror-home mirror "; " command))
|
||||
(shell-command-to-string command)
|
||||
target))
|
||||
|
||||
(defun sunrise-mirror-mangle (path)
|
||||
"Transform PATH into a string naming a new mirror area."
|
||||
(let ((handler (assoc-default path sunrise-avfs-handlers-alist
|
||||
'string-match)))
|
||||
(if (eq ?/ (string-to-char path))
|
||||
(setq path (substring path 1)))
|
||||
(concat (replace-regexp-in-string
|
||||
"/" "+"
|
||||
(replace-regexp-in-string "\\+" "{+}" path)) handler)))
|
||||
|
||||
(defun sunrise-mirror-demangle (path)
|
||||
"Transform the given mirror area name into a regular filesystem path.
|
||||
|
||||
Opposite of `sunrise-mirror-mangle'."
|
||||
(concat "/"
|
||||
(replace-regexp-in-string
|
||||
"{\\+}" "+" (replace-regexp-in-string
|
||||
"\\+\\([^}]\\)" "/\\1" (replace-regexp-in-string
|
||||
"#[a-z0-9#]*$" "" path)))))
|
||||
|
||||
(defun sunrise-mirror-full-demangle (path)
|
||||
"Demangle PATH recursively to get the current path of the original archive.
|
||||
|
||||
This is necessary because reflecting an archive that is itself a
|
||||
reflection causes deadlocks in FUSE."
|
||||
(let ((reflected path)
|
||||
(home-len (length sunrise-mirror-home))
|
||||
(handler (assoc-default path sunrise-avfs-handlers-alist
|
||||
'string-match))
|
||||
(prev-path))
|
||||
(while (and (not (string= reflected prev-path))
|
||||
(sunrise-overlapping-paths-p sunrise-mirror-home reflected))
|
||||
(setq prev-path reflected)
|
||||
(setq reflected (substring reflected home-len)
|
||||
reflected (sunrise-mirror-demangle reflected)))
|
||||
(setq reflected (concat sunrise-avfs-root reflected handler))
|
||||
reflected))
|
||||
|
||||
(defun sunrise-mirror-files (directory)
|
||||
"Return list of pathnames constituting mirror modifications
|
||||
|
||||
inside overlay DIRECTORY."
|
||||
(if (not (file-directory-p directory))
|
||||
(ignore)
|
||||
(let ((files (directory-files directory)))
|
||||
(mapc (lambda (x) (setq files (delete x files)))
|
||||
'("." ".." "._funionfs_control~"))
|
||||
files)))
|
||||
|
||||
(defun sunrise-mirror-overlay-redir (dirname &optional force-root)
|
||||
"Adjust DIRNAME for use with a mirror filesystem.
|
||||
|
||||
Analyses the given directory path and rewrites it (if necessary)
|
||||
to play nicely with the mirror fs the given path belongs to. If
|
||||
the path is not inside any mirror fs, it is returned unmodified."
|
||||
(if (null sunrise-avfs-root)
|
||||
dirname
|
||||
(let ((xpdir (expand-file-name dirname))
|
||||
(mirror) (pos) (target))
|
||||
(if (sunrise-overlapping-paths-p sunrise-mirror-home xpdir)
|
||||
(progn
|
||||
(setq mirror (substring xpdir (length sunrise-mirror-home)))
|
||||
(setq pos (string-match "/\\|$" mirror))
|
||||
(if pos
|
||||
(progn
|
||||
(setq target (replace-regexp-in-string
|
||||
"^/" "" (substring mirror pos)))
|
||||
(setq mirror (substring mirror 0 pos))))
|
||||
(if (and target
|
||||
(or (> (length target) 0) force-root)
|
||||
(not (eq ?. (string-to-char mirror))))
|
||||
(concat sunrise-mirror-home "." mirror "/" target)
|
||||
dirname))
|
||||
dirname))))
|
||||
|
||||
(defun sunrise-mirror-surface (dir)
|
||||
"Return the topmost parent of DIR under `sunrise-mirror-home', if any."
|
||||
(if (and sunrise-mirror-home
|
||||
(sunrise-overlapping-paths-p sunrise-mirror-home dir)
|
||||
(not (sunrise-equal-dirs sunrise-mirror-home dir)))
|
||||
(let ((local-dir (dired-make-relative dir sunrise-mirror-home)))
|
||||
(string-match "^\\([^/]*\\)" local-dir)
|
||||
(match-string 1 local-dir))))
|
||||
|
||||
(defun sunrise-mirror-overlapping-p (mirror1 mirror2)
|
||||
"Return non-nil if MIRROR1 and MIRROR2 overlap.
|
||||
|
||||
Check whether the surface of MIRROR2 maps an archive nested
|
||||
inside the archive mapped by the surface of MIRROR1."
|
||||
(let ((surface1 (sunrise-mirror-surface mirror1))
|
||||
(surface2 (sunrise-mirror-surface mirror2))
|
||||
top)
|
||||
(when (and surface1 surface2)
|
||||
(setq top (sunrise-mirror-demangle surface1))
|
||||
(sunrise-overlapping-paths-p top (sunrise-mirror-demangle surface2)))))
|
||||
|
||||
(defun sunrise-mirror-goto-dir (target)
|
||||
"Enhance `sunrise-goto-dir' with transparent navigation inside mirror areas.
|
||||
|
||||
All calls to `sunrise-goto-dir' are diverted to this function."
|
||||
(let* ((here (expand-file-name default-directory))
|
||||
(target (expand-file-name (or target ".")))
|
||||
(surface-here (sunrise-mirror-surface here))
|
||||
(sunrise-mirror-divert-goto-dir nil)
|
||||
surface-target)
|
||||
(cond
|
||||
((null surface-here)
|
||||
(sunrise-goto-dir target))
|
||||
((sunrise-overlapping-paths-p sunrise-avfs-root target)
|
||||
(sunrise-mirror-open))
|
||||
(t
|
||||
(if (sunrise-equal-dirs target sunrise-mirror-home)
|
||||
(setq target
|
||||
(expand-file-name
|
||||
(concat (sunrise-mirror-demangle surface-here) "/.."))
|
||||
surface-target
|
||||
(sunrise-mirror-surface (sunrise-mirror-mangle target)))
|
||||
(setq surface-target (sunrise-mirror-surface target)))
|
||||
(unless (equal surface-here surface-target)
|
||||
(if (and surface-target
|
||||
(sunrise-overlapping-paths-p sunrise-mirror-home target)
|
||||
(sunrise-mirror-overlapping-p surface-target surface-here))
|
||||
(sunrise-mirror-close t t)
|
||||
(sunrise-mirror-close nil nil t)))
|
||||
(unless (or (not (file-directory-p target))
|
||||
(sunrise-equal-dirs target (dired-current-directory)))
|
||||
(sunrise-goto-dir target))))
|
||||
(sunrise-highlight)))
|
||||
|
||||
(defun sunrise-mirror-on-kill-buffer ()
|
||||
"Handle navigation out of a mirror area other than through `sunrise-goto-dir'.
|
||||
|
||||
This includes e.g. bookmark jumps and pane synchronizations."
|
||||
(when (and sunrise-mirror-home (eq major-mode 'sunrise-mode)
|
||||
(null (sunrise-mirror-surface sunrise-this-directory))
|
||||
(sunrise-mirror-surface (dired-current-directory)))
|
||||
(sunrise-mirror-goto-dir sunrise-this-directory)
|
||||
(sunrise-unhighlight 'sunrise-mirror-path-face)))
|
||||
|
||||
(defadvice sunrise-goto-dir
|
||||
(around sunrise-mirror-advice-goto-dir (dir))
|
||||
"Divert all `sunrise-goto-dir' calls to `sunrise-mirror-goto-dir'."
|
||||
(if sunrise-mirror-divert-goto-dir
|
||||
(sunrise-mirror-goto-dir dir)
|
||||
ad-do-it))
|
||||
|
||||
(defadvice sunrise-clone-files
|
||||
(around sunrise-mirror-advice-clone-files
|
||||
(file-path-list
|
||||
target-dir
|
||||
clone-op
|
||||
progress
|
||||
&optional do-overwrite))
|
||||
"Redirect all `sunrise-copy' operations to the right path under the
|
||||
overlay directory."
|
||||
(if (null sunrise-mirror-home)
|
||||
ad-do-it
|
||||
(let ((orig target-dir))
|
||||
(setq target-dir (sunrise-mirror-overlay-redir target-dir t))
|
||||
(if (> (length target-dir) (length orig))
|
||||
(make-directory target-dir))
|
||||
ad-do-it)))
|
||||
(ad-activate 'sunrise-clone-files)
|
||||
|
||||
(defadvice make-directory
|
||||
(around sunrise-mirror-advice-make-directory (dirname &optional parents))
|
||||
"Redirect directory creation operations to the right path under
|
||||
the overlay directory."
|
||||
(setq dirname (sunrise-mirror-overlay-redir dirname))
|
||||
(setq parents t)
|
||||
ad-do-it)
|
||||
|
||||
(defadvice save-buffer
|
||||
(around sunrise-mirror-advice-save-buffer (&optional args))
|
||||
"Create all the subdirectories (and set their permissions)
|
||||
needed for enabling the redirection of buffer saving operations
|
||||
to the right path under the overlay directory."
|
||||
(let* ((orig (buffer-file-name))
|
||||
(target (sunrise-mirror-overlay-redir orig)))
|
||||
(if (> (length target) (length orig))
|
||||
(let ((default-directory "~/")
|
||||
(target-dir (file-name-directory target)))
|
||||
(make-directory target-dir)
|
||||
(shell-command-to-string
|
||||
(concat dired-chmod-program " a+x " target-dir))
|
||||
(write-file target nil))
|
||||
ad-do-it)))
|
||||
|
||||
(defun sunrise-mirror-toggle-read-only ()
|
||||
"Toggle the read-only flag in all buffers opened inside a mirror area,
|
||||
so they are always writeable by default."
|
||||
(if sunrise-mirror-home
|
||||
(let* ((orig (buffer-file-name))
|
||||
(target (sunrise-mirror-overlay-redir orig)))
|
||||
(if (> (length target) (length orig))
|
||||
(setq buffer-read-only nil)))))
|
||||
(add-hook 'find-file-hook 'sunrise-mirror-toggle-read-only)
|
||||
|
||||
(defun sunrise-mirror-unload-function ()
|
||||
(sunrise-ad-disable "^sunrise-mirror-"))
|
||||
|
||||
(provide 'sunrise-mirror)
|
||||
|
||||
;;; sunrise-mirror.el ends here
|
||||
|
|
@ -0,0 +1,347 @@
|
|||
;;; sunrise-modeline.el --- Navigable mode line for the Sunrise Commander -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2009-2012 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: 10 Oct 2009
|
||||
;; Version: 2
|
||||
;; Package-Requires: ((emacs "24.3") (cl-lib "0.5"))
|
||||
;; Keywords: files, sunrise commander, modeline, path mode line
|
||||
;; 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:
|
||||
|
||||
;; This extension modifies the format of the mode lines under the Sunrise
|
||||
;; Commander panes so they display only the paths to the current directories
|
||||
;; (or the tail if the whole path is too long) and a row of three small icons.
|
||||
;; These icons are by default plain ASCII characters, but nicer semigraphical
|
||||
;; versions (in Unicode) can also be used by customizing the variable
|
||||
;; `sunrise-modeline-use-utf8-marks'.
|
||||
;;
|
||||
;; Here is the complete list of indicator icons (in ASCII and Unicode) and
|
||||
;; their respective meanings:
|
||||
;;
|
||||
;; (ascii) (unicode)
|
||||
;; 1. Pane modes: * ☼ Normal mode
|
||||
;; ! ⚡ Editable Pane mode
|
||||
;; @ ☯ Virtual Directory mode
|
||||
;; T ⚘ Tree View mode (with tree extension)
|
||||
;;
|
||||
;; 2. Navigation modes: & ⚓ Synchronized Navigation
|
||||
;; $ ♻ Sticky Search
|
||||
;;
|
||||
;; 3. Transient states: # ♥ Contents snapshot available
|
||||
;;
|
||||
;; (if you can't see the icons on the right, don't use utf8 marks)
|
||||
|
||||
;; The regular mode line format remains available: press C-c m to toggle
|
||||
;; between one format and the other.
|
||||
|
||||
;; The extension is provided as a minor mode, so you can enable / disable it
|
||||
;; totally by issuing the command `sunrise-modeline'.
|
||||
|
||||
;; It was written on GNU Emacs 24 on Linux, and tested on GNU Emacs 22 and 23
|
||||
;; for Linux and on EmacsW32 (version 22) for Windows.
|
||||
|
||||
;;; Installation and Usage:
|
||||
|
||||
;; 1) Put this file somewhere in your Emacs `load-path'.
|
||||
|
||||
;; 2) Add a (require 'sunrise-modeline) expression to your .emacs file
|
||||
;; somewhere after the (require 'sunrise) one.
|
||||
|
||||
;; 3) Evaluate the new expression, or reload your .emacs file, or restart
|
||||
;; Emacs.
|
||||
|
||||
;; 4) Enjoy ;-)
|
||||
|
||||
;;; Code:
|
||||
|
||||
(eval-when-compile
|
||||
(require 'cl-lib))
|
||||
|
||||
(require 'desktop)
|
||||
(require 'easymenu)
|
||||
|
||||
(require 'sunrise)
|
||||
|
||||
(defcustom sunrise-modeline-use-utf8-marks nil
|
||||
"Set to t to use fancy marks (using UTF-8 glyphs) in the mode line."
|
||||
:group 'sunrise
|
||||
:type 'boolean)
|
||||
|
||||
;; slot 0 -- pane modes:
|
||||
(defconst sunrise-modeline-norm-mark '("*" . "☼"))
|
||||
(defconst sunrise-modeline-edit-mark '("!" . "⚡"))
|
||||
(defconst sunrise-modeline-virt-mark '("@" . "☯"))
|
||||
(defconst sunrise-modeline-tree-mark '("T" . "⚘"))
|
||||
|
||||
;; slot 1 -- navigation modes:
|
||||
(defconst sunrise-modeline-sync-mark '("&" . "⚓"))
|
||||
(defconst sunrise-modeline-srch-mark '("$" . "♻"))
|
||||
|
||||
;; slot 2 -- transient states:
|
||||
(defconst sunrise-modeline-bkup-mark '("#" . "♥"))
|
||||
|
||||
(defface sunrise-modeline-separator-face
|
||||
'((t (:height 0.3)))
|
||||
"Face of the string used to separate the state indicators from one another."
|
||||
:group 'sunrise)
|
||||
|
||||
(defconst sunrise-modeline-sep
|
||||
#(" " 0 1 (face sunrise-modeline-separator-face))
|
||||
"Sunrise Modeline separator character.")
|
||||
|
||||
;;; ==========================================================================
|
||||
;;; Core functions:
|
||||
|
||||
(defvar sunrise-modeline-mark-map (make-sparse-keymap))
|
||||
(define-key sunrise-modeline-mark-map [mode-line mouse-1]
|
||||
'sunrise-modeline-popup-menu)
|
||||
(define-key sunrise-modeline-mark-map [mode-line mouse-2]
|
||||
'sunrise-modeline-popup-menu)
|
||||
|
||||
(defvar sunrise-modeline-path-map (make-sparse-keymap))
|
||||
(define-key sunrise-modeline-path-map [mode-line mouse-1]
|
||||
'sunrise-modeline-navigate-path)
|
||||
(define-key sunrise-modeline-path-map [mode-line mouse-2]
|
||||
'sunrise-modeline-navigate-path)
|
||||
|
||||
(defun sunrise-modeline-select-mark (mark &optional slot)
|
||||
"Select the right character for the given MARK in SLOT.
|
||||
Depends on whether UTF-8 has been enabled in the mode line via
|
||||
the variable `sunrise-modeline-use-utf8-marks'."
|
||||
(let ((select (if sunrise-modeline-use-utf8-marks #'cdr #'car))
|
||||
(slot (or slot 0)))
|
||||
(cl-case slot
|
||||
(0 (funcall select (cl-case mark
|
||||
(edit sunrise-modeline-edit-mark)
|
||||
(virt sunrise-modeline-virt-mark)
|
||||
(tree sunrise-modeline-tree-mark)
|
||||
(t sunrise-modeline-norm-mark))))
|
||||
(1 (cond ((or (memq 'sunrise-sticky-post-isearch isearch-mode-end-hook)
|
||||
(memq 'sunrise-tree-post-isearch isearch-mode-end-hook))
|
||||
(funcall select sunrise-modeline-srch-mark))
|
||||
(sunrise-synchronized
|
||||
(funcall select sunrise-modeline-sync-mark))
|
||||
(t " ")))
|
||||
(t (if (buffer-live-p sunrise-backup-buffer)
|
||||
(funcall select sunrise-modeline-bkup-mark)
|
||||
" ")))))
|
||||
|
||||
(defun sunrise-modeline-select-mode (mode)
|
||||
"Assemble the indicators section on the left of the modeline."
|
||||
(concat sunrise-modeline-sep (sunrise-modeline-select-mark mode 0)
|
||||
sunrise-modeline-sep (sunrise-modeline-select-mark mode 1)
|
||||
sunrise-modeline-sep (sunrise-modeline-select-mark mode 2)
|
||||
sunrise-modeline-sep))
|
||||
|
||||
(defun sunrise-modeline-setup ()
|
||||
"Determine the mode indicator (character) to display in the mode line.
|
||||
On success, sets the mode line format by calling
|
||||
`sunrise-modeline-set'."
|
||||
(let ((mode nil))
|
||||
(cl-case major-mode
|
||||
(sunrise-mode
|
||||
(setq mode (sunrise-modeline-select-mode
|
||||
(if buffer-read-only 'norm 'edit))))
|
||||
(sunrise-tree-mode
|
||||
(setq mode (sunrise-modeline-select-mode 'tree)))
|
||||
(sunrise-virtual-mode
|
||||
(setq mode (sunrise-modeline-select-mode 'virt))))
|
||||
(if mode (sunrise-modeline-set mode))))
|
||||
|
||||
(defun sunrise-modeline-set (mark)
|
||||
"Adjust the current mode line format.
|
||||
Uses the given mode indicator and the path to the current
|
||||
directory of the pane. Truncates the path if it is longer than
|
||||
the available width of the pane."
|
||||
(let ((path (expand-file-name default-directory))
|
||||
(path-length (length default-directory))
|
||||
(max-length (- (window-width) 12)))
|
||||
(if (< max-length path-length)
|
||||
(setq path
|
||||
(concat "..." (substring path (- path-length max-length)))))
|
||||
(eval
|
||||
`(setq mode-line-format
|
||||
'("%[" ,(sunrise-modeline-mark mark) "%] "
|
||||
,(sunrise-modeline-path path))))))
|
||||
|
||||
(defun sunrise-modeline-mark (marks-string)
|
||||
"Propertize MARKS-STRING for use in displaying the mode line indicators."
|
||||
(let ((mode-name "") (marks (split-string marks-string "|")))
|
||||
(setq mode-name
|
||||
(concat
|
||||
(cond ((member (sunrise-modeline-select-mark 'edit) marks)
|
||||
"Editable Pane Mode")
|
||||
((member (sunrise-modeline-select-mark 'virt) marks)
|
||||
"Virtual Directory Mode")
|
||||
((member (sunrise-modeline-select-mark 'tree) marks)
|
||||
"Tree View Mode")
|
||||
(t "Normal Mode"))
|
||||
(if sunrise-synchronized " | Synchronized Navigation" "")
|
||||
(if (or (memq 'sunrise-sticky-post-isearch isearch-mode-end-hook)
|
||||
(memq 'sunrise-tree-post-isearch isearch-mode-end-hook))
|
||||
" | Sticky Search"
|
||||
"")
|
||||
(if (buffer-live-p sunrise-backup-buffer)
|
||||
" | Snapshot Available" "")))
|
||||
(propertize marks-string
|
||||
'font 'bold
|
||||
'mouse-face 'mode-line-highlight
|
||||
'help-echo (format "Sunrise Commander: %s" mode-name)
|
||||
'local-map sunrise-modeline-mark-map)))
|
||||
|
||||
(defun sunrise-modeline-path (path)
|
||||
"Propertize the string PATH for use in the mode line format.
|
||||
PATH is the current directory in the file system."
|
||||
(propertize path
|
||||
'local-map sunrise-modeline-path-map
|
||||
'mouse-face 'mode-line-highlight
|
||||
'help-echo "Click to navigate directory path"
|
||||
'sunrise-selected-window sunrise-selected-window))
|
||||
|
||||
(defun sunrise-modeline-navigate-path ()
|
||||
"Handle click events occuring on the mode line directory path.
|
||||
Analyzes all click events detected on the directory path and
|
||||
modifies the current directory of the corresponding panel
|
||||
accordingly."
|
||||
(interactive)
|
||||
(let* ((event (caddr (cddadr last-input-event)))
|
||||
(path (car event)) (pos (cdr event)) (slash) (levels))
|
||||
(or (eq sunrise-selected-window
|
||||
(get-text-property 0 'sunrise-selected-window path))
|
||||
(sunrise-change-window))
|
||||
(setq slash (string-match "/" path pos)
|
||||
levels (- (length (split-string (substring path slash) "/")) 2))
|
||||
(if (< 0 levels)
|
||||
(sunrise-dired-prev-subdir levels)
|
||||
(sunrise-beginning-of-buffer))))
|
||||
|
||||
;;; ==========================================================================
|
||||
;;; Private interface:
|
||||
|
||||
(defvar sunrise-modeline)
|
||||
|
||||
(defun sunrise-modeline-refresh ()
|
||||
(setq sunrise-modeline t)
|
||||
(sunrise-modeline-setup))
|
||||
|
||||
(defun sunrise-modeline-engage ()
|
||||
"Activate and enforce the navigation mode line format."
|
||||
(add-hook 'sunrise-refresh-hook 'sunrise-modeline-refresh)
|
||||
(sunrise-modeline-setup)
|
||||
(sunrise-in-other (sunrise-modeline-setup)))
|
||||
|
||||
(defun sunrise-modeline-disengage ()
|
||||
"De-activate the navigation mode line format, restoring the default one."
|
||||
(remove-hook 'sunrise-refresh-hook 'sunrise-modeline-refresh)
|
||||
(setq mode-line-format (default-value 'mode-line-format))
|
||||
(sunrise-in-other
|
||||
(setq mode-line-format (default-value 'mode-line-format))))
|
||||
|
||||
(defun sunrise-modeline-toggle (&optional force)
|
||||
;; FIXME explain the argument
|
||||
"Toggle display of the navigation mode line format."
|
||||
(interactive)
|
||||
(cond ((and force (< 0 force)) (sunrise-modeline-engage))
|
||||
((and force (> 0 force)) (sunrise-modeline-disengage))
|
||||
(t
|
||||
(if (eq mode-line-format (default-value 'mode-line-format))
|
||||
(sunrise-modeline-engage)
|
||||
(sunrise-modeline-disengage)))))
|
||||
|
||||
;;; ==========================================================================
|
||||
;;; User interface:
|
||||
|
||||
(defvar sunrise-modeline-map (make-sparse-keymap))
|
||||
(define-key sunrise-modeline-map "\C-cm" 'sunrise-modeline-toggle)
|
||||
|
||||
(define-minor-mode sunrise-modeline
|
||||
"Provide navigable mode line for the Sunrise Commander.
|
||||
This is a minor mode that provides a single keybinding:
|
||||
|
||||
C-c m .............. Toggle between navigation and default mode line formats
|
||||
|
||||
To totally disable this extension do: M-x sunrise-modeline <RET>"
|
||||
|
||||
nil (sunrise-modeline-select-mode 'norm) sunrise-modeline-map
|
||||
(unless (memq major-mode
|
||||
'(sunrise-mode sunrise-virtual-mode sunrise-tree-mode))
|
||||
(setq sunrise-modeline nil)
|
||||
(error "Sorry, this mode can be used only within the Sunrise Commander"))
|
||||
(sunrise-modeline-toggle 1))
|
||||
|
||||
(defvar sunrise-modeline-menu
|
||||
(easy-menu-create-menu
|
||||
"Mode Line"
|
||||
'(["Toggle navigation mode line" sunrise-modeline-toggle t]
|
||||
["Navigation mode line help"
|
||||
(lambda ()
|
||||
(interactive)
|
||||
(describe-function 'sunrise-modeline))])))
|
||||
|
||||
(defun sunrise-modeline-popup-menu ()
|
||||
(interactive)
|
||||
(popup-menu sunrise-modeline-menu))
|
||||
|
||||
;;; ==========================================================================
|
||||
;;; Bootstrap:
|
||||
|
||||
(defun sunrise-modeline-menu-init ()
|
||||
"Initialize the Sunrise Mode Line extension menu."
|
||||
(unless (lookup-key sunrise-mode-map [menu-bar Sunrise])
|
||||
(define-key sunrise-mode-map [menu-bar Sunrise]
|
||||
(cons "Sunrise" (make-sparse-keymap))))
|
||||
(let ((menu-map (make-sparse-keymap "Mode Line")))
|
||||
(define-key sunrise-mode-map [menu-bar Sunrise mode-line]
|
||||
(cons "Mode Line" menu-map))
|
||||
(define-key menu-map [help]
|
||||
'("Help" . (lambda ()
|
||||
(interactive)
|
||||
(describe-function 'sunrise-modeline))))
|
||||
(define-key menu-map [disable]
|
||||
'("Toggle" . sunrise-modeline-toggle))))
|
||||
|
||||
(defun sunrise-modeline-start-once ()
|
||||
"Bootstrap the navigation mode line on the first execution of
|
||||
the Sunrise Commander, after module installation."
|
||||
(sunrise-modeline t)
|
||||
(sunrise-modeline-menu-init)
|
||||
(remove-hook 'sunrise-start-hook 'sunrise-modeline-start-once)
|
||||
(unintern 'sunrise-modeline-menu-init obarray)
|
||||
(unintern 'sunrise-modeline-start-once obarray))
|
||||
(add-hook 'sunrise-start-hook 'sunrise-modeline-start-once)
|
||||
|
||||
;;; ==========================================================================
|
||||
;;; Desktop support:
|
||||
|
||||
(add-to-list 'desktop-minor-mode-table '(sunrise-modeline nil))
|
||||
|
||||
(defun sunrise-modeline-desktop-restore-function (&rest _)
|
||||
"Call this instead of `sunrise-modeline' when restoring a desktop."
|
||||
(sunrise-modeline-refresh))
|
||||
|
||||
(add-to-list 'desktop-minor-mode-handlers
|
||||
'(sunrise-modeline . sunrise-modeline-desktop-restore-function))
|
||||
|
||||
(provide 'sunrise-modeline)
|
||||
|
||||
;;; sunrise-modeline.el ends here
|
||||
|
|
@ -0,0 +1,746 @@
|
|||
;;; sunrise-tabs.el --- Tabs for the Sunrise Commander -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2009-2012 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 Oct 2009
|
||||
;; Version: 1
|
||||
;; Package-Requires: ((emacs "24.3") (cl-lib "0.5"))
|
||||
;; Keywords: files, sunrise commander, tabs
|
||||
;; 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:
|
||||
|
||||
;; This extension brings tab-based navigation to the Sunrise Commander. It
|
||||
;; adds to the list of optional mechanisms already available in Sunrise for
|
||||
;; moving around the file system (like regular bookmarks, checkpoints, history
|
||||
;; rings, materialized virtual buffers, navigable paths and file-following)
|
||||
;; another way to maintain a list of selected locations one wants to return
|
||||
;; later on, or to compose "breadcrumb trails" for complex repetitive
|
||||
;; operations.
|
||||
|
||||
;; The main difference between tabs and other mechanisms is that once a buffer
|
||||
;; has been assigned to a tab, it will not be killed automatically by Sunrise,
|
||||
;; so it's possible to keep it around as long as necessary with all its marks
|
||||
;; and state untouched. Tabs can be persisted across sessions using the
|
||||
;; DeskTop feature.
|
||||
|
||||
;; Creating, using and destroying tabs are fast and easy operations, either
|
||||
;; with mouse or keyboard:
|
||||
|
||||
;; * Press C-j (or select Sunrise > Tabs > Add Tab in the menu) to create a
|
||||
;; new tab or to rename an already existing tab.
|
||||
|
||||
;; * Press C-k (or right-click the tab) to kill an existing tab. Combine with
|
||||
;; M- (M-C-k) to kill the tab on the passive pane. Prefix with a digit to kill
|
||||
;; tabs by relative order (e.g. 2 C-k kills the second tab in the current
|
||||
;; pane, while 4 M-C-k kills the fourth tab in the passive pane).
|
||||
|
||||
;; * Press C-n and C-p to move from tab to tab ("Next", "Previous"), or simply
|
||||
;; left-click on the tab to focus its assigned buffer. These two keybindings
|
||||
;; can be prefixed with an integer to move faster.
|
||||
|
||||
;; * The last four bindings can be combined with Meta (i.e. M-C-j, M-C-k,
|
||||
;; M-C-n and M-C-p) to perform the equivalent operation on the passive pane or
|
||||
;; (when in synchronized navigation mode) on both panes simultaneously.
|
||||
|
||||
;; * Press * C-k to kill in one go all the tabs in the current pane.
|
||||
;; Similarly, press * M-C-k to wipe all the tabs off the passive pane or (when
|
||||
;; synchronized mode is active) on both panes simultaneously.
|
||||
|
||||
;; * Killing the current buffer with C-x k automatically switches to the one
|
||||
;; assigned to the first available tab (if any).
|
||||
|
||||
;; The extension is provided as a minor mode, so you can enable / disable it
|
||||
;; totally by using the command `sunrise-tabs-mode'.
|
||||
|
||||
;; It does *not* pretend to be a generic solution for tabs in Emacs. If you
|
||||
;; need one, have a look at TabBar mode
|
||||
;; (http://www.emacswiki.org/emacs/TabBarMode) by David Ponce. I wrote this
|
||||
;; just because it turned out to be easier to write this than to customize
|
||||
;; tabbar to behave exactly like I wanted inside the Sunrise panes. It's meant
|
||||
;; to be simple and to work nicely with Sunrise with just a few tabs (up to
|
||||
;; 10-15 per pane, maybe).
|
||||
|
||||
;; It was written on GNU Emacs 23 on Linux, and tested on GNU Emacs 22 and 23
|
||||
;; for Linux and on EmacsW32 (version 23) for Windows.
|
||||
|
||||
;;; Installation and Usage:
|
||||
|
||||
;; 1) Put this file somewhere in your Emacs `load-path'.
|
||||
|
||||
;; 2) Add a (require 'sunrise-tabs) expression to your .emacs file somewhere
|
||||
;; after the (require 'sunrise) one.
|
||||
|
||||
;; 3) Evaluate the new expression, or reload your .emacs file, or restart
|
||||
;; Emacs.
|
||||
|
||||
;; 4) Enjoy ;-)
|
||||
|
||||
;;; Code:
|
||||
|
||||
(eval-when-compile
|
||||
(require 'cl-lib)
|
||||
(require 'desktop))
|
||||
|
||||
(require 'sunrise)
|
||||
|
||||
(defcustom sunrise-tabs-follow-panes t
|
||||
"Whether tabs should be swapped too when transposing the Sunrise panes."
|
||||
:group 'sunrise
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom sunrise-tabs-max-tabsize 10
|
||||
"Maximum width of a Sunrise Commander tab."
|
||||
:group 'sunrise
|
||||
:type 'integer)
|
||||
|
||||
(defcustom sunrise-tabs-truncation-style 'right
|
||||
"On which side should we truncate the tag a of new tab if it
|
||||
happens to be longer than `sunrise-tabs-max-tabsize`."
|
||||
:group 'sunrise
|
||||
:type '(choice
|
||||
(const :tag "Truncate from the right" right)
|
||||
(const :tag "Truncate from the left" left)))
|
||||
|
||||
(defcustom sunrise-tabs-tag-provider
|
||||
(defun sunrise-tabs-tag-provider-default (buffer-name)
|
||||
"Default provider of tags based on the buffer name of a pane."
|
||||
buffer-name)
|
||||
"Function to use to determine the tag to use when creating a new tab.
|
||||
It should take one argument which is to be interpreted as the
|
||||
name of the buffer that contains the pane to be assigned to the
|
||||
tab."
|
||||
:group 'sunrise
|
||||
:type 'function)
|
||||
|
||||
(defface sunrise-tabs-active-face
|
||||
'((((type tty) (class color) (min-colors 88))
|
||||
:background "white")
|
||||
(((type tty) (class color) (min-colors 8))
|
||||
:background "green" :foreground "yellow" :bold t)
|
||||
(((type tty) (class mono)) :inverse-video t)
|
||||
(t
|
||||
:inherit variable-pitch :bold t :background "white" :height 0.9))
|
||||
"Face of the currently selected tab in any of the Sunrise panes."
|
||||
:group 'sunrise)
|
||||
|
||||
(defface sunrise-tabs-inactive-face
|
||||
'((((type tty) (class color) (min-colors 88))
|
||||
:background "color-84" :foreground "white")
|
||||
(((type tty) (class color) (min-colors 8))
|
||||
:background "white" :foreground "cyan")
|
||||
(t
|
||||
:inherit variable-pitch :background "gray95" :height 0.9))
|
||||
"Face of all non-selected tabs in both Sunrise panes."
|
||||
:group 'sunrise)
|
||||
|
||||
(defface sunrise-tabs-separator-face
|
||||
'((t (:height 0.3)))
|
||||
"Face of the string used to separate the Sunrise tabs from one another."
|
||||
:group 'sunrise)
|
||||
|
||||
(defconst sunrise-tabs-sep
|
||||
#(" " 0 1 (face sunrise-tabs-separator-face))
|
||||
"Sunrise Tabs separator character.")
|
||||
|
||||
(defconst sunrise-tabs-ligature
|
||||
#(" ║" 0 1 (face sunrise-tabs-separator-face))
|
||||
"Sunrise Tabs line separator string.")
|
||||
|
||||
(defconst sunrise-tabs-max-cache-length
|
||||
30
|
||||
"Max number of tab labels cached for reuse.")
|
||||
|
||||
(defvar sunrise-tabs
|
||||
'((left) (right)))
|
||||
|
||||
(defvar sunrise-tabs-labels-cache
|
||||
'((left) (right)))
|
||||
|
||||
(defvar sunrise-tabs-line-cache
|
||||
'((left) (right)))
|
||||
|
||||
(defvar sunrise-tabs-mode
|
||||
nil)
|
||||
|
||||
(defvar sunrise-tabs-on
|
||||
nil)
|
||||
|
||||
;;; ==========================================================================
|
||||
;;; Core functions:
|
||||
|
||||
(defun sunrise-tabs-add ()
|
||||
"Assign the current buffer to exactly one tab in the active pane.
|
||||
If a tab for the current buffer already exists, invoke `sunrise-tabs-rename'."
|
||||
(interactive)
|
||||
(let ((tab-name (buffer-name))
|
||||
(tab-set (assq sunrise-selected-window sunrise-tabs)))
|
||||
(if (member tab-name (cdr tab-set))
|
||||
(call-interactively 'sunrise-tabs-rename)
|
||||
(setcdr tab-set (cons tab-name (cdr tab-set)))))
|
||||
(sunrise-tabs-refresh))
|
||||
|
||||
(defun sunrise-tabs-remove (&optional tab-buffer side)
|
||||
"Remove the tab to which TAB-BUFFER is assigned in the active pane.
|
||||
If TAB-BUFFER is nil, removes the tab to which the current buffer
|
||||
is assigned, if any."
|
||||
(interactive "P")
|
||||
(let* ((side (or side sunrise-selected-window))
|
||||
(tab-name (if (integerp tab-buffer)
|
||||
(nth tab-buffer (assoc side sunrise-tabs))
|
||||
(buffer-name tab-buffer)))
|
||||
(tab-buffer (and tab-name (get-buffer tab-name)))
|
||||
(tab-set (assq side sunrise-tabs)))
|
||||
(setcdr tab-set (delete tab-name (cdr tab-set)))
|
||||
(unless (or (null tab-buffer)
|
||||
(eq tab-buffer (current-buffer))
|
||||
(eq tab-buffer (sunrise-other 'buffer)))
|
||||
(kill-buffer (get-buffer tab-name))))
|
||||
(sunrise-tabs-refresh))
|
||||
|
||||
(defun sunrise-tabs-clean ()
|
||||
"Remove all tabs from the current pane."
|
||||
(interactive)
|
||||
(while (nth 1 (assoc sunrise-selected-window sunrise-tabs))
|
||||
(sunrise-tabs-remove 1)))
|
||||
|
||||
(defun sunrise-tabs-kill (&optional name side)
|
||||
"Remove the tab named NAME from the active pane and kill its buffer.
|
||||
The buffer is not killed when currently visible or assigned to
|
||||
another tab."
|
||||
(interactive)
|
||||
(let ((to-kill (or (and name (get-buffer name)) (current-buffer)))
|
||||
(side (or side sunrise-selected-window)))
|
||||
(sunrise-tabs-remove to-kill side)
|
||||
(if (and (not (memq to-kill
|
||||
(list sunrise-left-buffer sunrise-right-buffer)))
|
||||
(not (member to-kill
|
||||
(apply 'append (mapcar 'cdr sunrise-tabs)))))
|
||||
(kill-buffer to-kill))
|
||||
(sunrise-tabs-refresh)))
|
||||
|
||||
(defun sunrise-tabs-next (&optional n)
|
||||
"Move focus to the next tab (left to right) in the active pane.
|
||||
With a prefix argument N, moves focus to the tab N places ahead,
|
||||
or to the last one if there are fewer tabs than requested."
|
||||
(interactive "p")
|
||||
(sunrise-tabs-step n))
|
||||
|
||||
(defun sunrise-tabs-prev (&optional n)
|
||||
"Move focus to the previous tab (right to left) in the active pane.
|
||||
With a prefix argument N, moves focus to the tab N places behind,
|
||||
or to the first one if there are fewer tabs than requested."
|
||||
(interactive "p")
|
||||
(sunrise-tabs-step n t))
|
||||
|
||||
(defun sunrise-tabs-step (count &optional back)
|
||||
"Move focus from the current tab to the one COUNT places ahead or behind.
|
||||
The direction depends on the value of BACK."
|
||||
(let* ((stack (cdr (assq sunrise-selected-window sunrise-tabs)))
|
||||
(stack (if back (reverse stack) stack))
|
||||
(target (member (buffer-name) stack)))
|
||||
(unless (null stack)
|
||||
(if (or (null count) (zerop count))
|
||||
(setq count 1))
|
||||
(if (< 1 (length target))
|
||||
(sunrise-tabs-switch-to-buffer
|
||||
(or (nth count target) (car (last target))))
|
||||
(sunrise-tabs-switch-to-buffer (car stack))))))
|
||||
|
||||
(defun sunrise-tabs-switch-to-buffer (to-buffer)
|
||||
"Change context of the active Sunrise pane when switching buffers."
|
||||
(let ((from-buffer (current-buffer))
|
||||
(sunrise-current-path-faces
|
||||
(with-current-buffer to-buffer sunrise-current-path-faces)))
|
||||
(unless (eq from-buffer to-buffer)
|
||||
(sunrise-save-aspect (switch-to-buffer to-buffer))
|
||||
(setq sunrise-this-directory default-directory)
|
||||
(set (sunrise-symbol sunrise-selected-window 'buffer)
|
||||
(current-buffer))
|
||||
(set (sunrise-symbol sunrise-selected-window 'directory)
|
||||
default-directory)
|
||||
(unless (eq from-buffer (sunrise-other 'buffer))
|
||||
(with-current-buffer from-buffer
|
||||
(set-buffer-modified-p nil)
|
||||
(kill-buffer (current-buffer))))
|
||||
(condition-case nil
|
||||
(revert-buffer t t)
|
||||
(error (ignore)))
|
||||
(sunrise-history-push default-directory))
|
||||
(sunrise-tabs-refresh)))
|
||||
|
||||
(defun sunrise-tabs-focus (name side)
|
||||
"Give focus to the tab with name NAME in SIDE pane."
|
||||
(unless (eq side sunrise-selected-window)
|
||||
(sunrise-change-window))
|
||||
(sunrise-tabs-switch-to-buffer name))
|
||||
|
||||
(defun sunrise-tabs-kill-and-go ()
|
||||
"Kill the current Sunrise buffer and move to the next one.
|
||||
This kills the buffer, removes its assigned tab (if any) and
|
||||
moves to the next buffer tabbed in the active pane, unless there
|
||||
are no more tabbed buffers to fall back to, in which case just
|
||||
removes the tab."
|
||||
(interactive)
|
||||
(let ((to-kill (current-buffer))
|
||||
(stack (cdr (assq sunrise-selected-window sunrise-tabs))))
|
||||
(if (null stack)
|
||||
(sunrise-kill-pane-buffer)
|
||||
(sunrise-tabs-kill)
|
||||
(setq stack (cdr stack))
|
||||
(sunrise-tabs-next)
|
||||
(unless (or (null stack)
|
||||
(eq to-kill (current-buffer))
|
||||
(eq to-kill (sunrise-other 'buffer)))
|
||||
(kill-buffer to-kill)))))
|
||||
|
||||
(defun sunrise-tabs-rename (&optional new-name)
|
||||
(interactive "sRename current tab to: ")
|
||||
(let* ((key (buffer-name))
|
||||
(cache (assq sunrise-selected-window sunrise-tabs-labels-cache))
|
||||
(label (cadr cache)))
|
||||
(if label
|
||||
(sunrise-tabs-redefine-label key new-name))))
|
||||
|
||||
(defun sunrise-tabs-transpose ()
|
||||
"Swap the sets of tabs from one pane to the other."
|
||||
(interactive)
|
||||
(cl-labels ((flip (side) (setcar side (cdr (assq (car side)
|
||||
sunrise-side-lookup)))))
|
||||
(dolist (registry (list sunrise-tabs sunrise-tabs-labels-cache))
|
||||
(mapc #'flip registry)))
|
||||
(sunrise-in-other (sunrise-tabs-refresh))
|
||||
(sunrise-tabs-refresh))
|
||||
|
||||
(defadvice sunrise-transpose-panes
|
||||
(after sunrise-tabs-advice-transpose-panes ())
|
||||
"Synchronize the tabs with the panes if so required.
|
||||
|
||||
See the variable `sunrise-tabs-follow-panes'. Activated in the
|
||||
function `sunrise-tabs-engage'."
|
||||
(if sunrise-tabs-follow-panes (sunrise-tabs-transpose)))
|
||||
|
||||
;;; ==========================================================================
|
||||
;;; Graphical interface:
|
||||
|
||||
(defun sunrise-tabs-focus-cmd (name side)
|
||||
"Return a function to give focus to the named NAME in the SIDE pane."
|
||||
(let ((selector (if (eq side (caar sunrise-tabs)) #'caar #'caadr)))
|
||||
`(lambda ()
|
||||
(interactive)
|
||||
(sunrise-tabs-focus ,name (funcall ',selector sunrise-tabs)))))
|
||||
|
||||
(defun sunrise-tabs-rename-cmd (name)
|
||||
"Return a function to rename the tab named NAME in both panes."
|
||||
`(lambda (&optional new-name)
|
||||
(interactive "sRename tab to: ")
|
||||
(sunrise-tabs-redefine-label ,name new-name)))
|
||||
|
||||
(defun sunrise-tabs-kill-cmd (name side)
|
||||
"Return a function to delete the tab named NAME in the SIDE pane."
|
||||
(let ((selector (if (eq side (caar sunrise-tabs)) #'caar #'caadr)))
|
||||
`(lambda ()
|
||||
(interactive)
|
||||
(if (eq sunrise-selected-window (funcall ',selector sunrise-tabs))
|
||||
(sunrise-tabs-kill ,name)
|
||||
(sunrise-in-other
|
||||
(sunrise-tabs-kill ,name))))))
|
||||
|
||||
(defsubst sunrise-tabs-propertize-tag (string face keymap)
|
||||
"Propertize STRING with FACE and KEYMAP so it can be used as a tab tag."
|
||||
(propertize string
|
||||
'face face
|
||||
'help-echo
|
||||
"mouse-1: select tab\n\mouse-2: rename tab\n\mouse-3: kill tab"
|
||||
'local-map keymap))
|
||||
|
||||
(defun sunrise-tabs-make-tag (name as-active &optional tag)
|
||||
"Return a propertized string for decorating a tab named NAME.
|
||||
AS-ACTIVE determines whether to propertize it as an active or a
|
||||
passive tab (nil = passive, t = active). The optional argument
|
||||
TAG allows to provide a pretty name to label the tab."
|
||||
(let ((tag (sunrise-tabs-truncate (or tag name)))
|
||||
(side sunrise-selected-window)
|
||||
(keymap (make-sparse-keymap)))
|
||||
(setq tag (concat sunrise-tabs-sep tag sunrise-tabs-sep))
|
||||
(define-key keymap [header-line mouse-1]
|
||||
(sunrise-tabs-focus-cmd name side))
|
||||
(define-key keymap [header-line mouse-2]
|
||||
(sunrise-tabs-rename-cmd name))
|
||||
(define-key keymap [header-line mouse-3]
|
||||
(sunrise-tabs-kill-cmd name side))
|
||||
(if as-active
|
||||
(sunrise-tabs-propertize-tag tag 'sunrise-tabs-active-face keymap)
|
||||
(sunrise-tabs-propertize-tag tag 'sunrise-tabs-inactive-face keymap))))
|
||||
|
||||
(defun sunrise-tabs-truncate (tag)
|
||||
"Truncate and add an ellipsis mark to the given tag if necessary."
|
||||
(if (>= sunrise-tabs-max-tabsize (length tag))
|
||||
tag
|
||||
(cl-case sunrise-tabs-truncation-style
|
||||
(right (concat (substring tag 0 sunrise-tabs-max-tabsize) "…"))
|
||||
(left (concat "…" (substring tag (* -1 sunrise-tabs-max-tabsize))))
|
||||
(t (ignore)))))
|
||||
|
||||
(defun sunrise-tabs-make-label (name &optional alias)
|
||||
"Return a new label for decorating a tab named NAME.
|
||||
A label is a dotted pair of tags, for active and passive state.
|
||||
The new label is put in cache for later reuse. The optional
|
||||
argument ALIAS allows to provide a pretty name to label the tab."
|
||||
(let* ((alias (or alias (apply sunrise-tabs-tag-provider (list name))))
|
||||
(label (cons (sunrise-tabs-make-tag name t alias)
|
||||
(sunrise-tabs-make-tag name nil alias)))
|
||||
(entry (list (cons name label)))
|
||||
(cache (assq sunrise-selected-window sunrise-tabs-labels-cache)))
|
||||
(setcdr cache (append (cdr cache) entry))
|
||||
label))
|
||||
|
||||
(defun sunrise-tabs-trim-label (label)
|
||||
"Remove all properties and trailing whitespace from the given string."
|
||||
(replace-regexp-in-string "^\\s-+\\|\\s-+$"
|
||||
""
|
||||
(substring-no-properties label)))
|
||||
|
||||
(defun sunrise-tabs-redefine-label (name alias)
|
||||
"Change the name displayed on the tab with assigned buffer NAME to ALIAS.
|
||||
By default, a tab is named after its assigned buffer. This function allows to
|
||||
give tabs names that are more readable or simply easier to remember."
|
||||
(let* ((alias (sunrise-tabs-trim-label (or alias ""))) (cache))
|
||||
(when (string= "" alias)
|
||||
(setq alias (buffer-name)))
|
||||
(setq cache (assq sunrise-selected-window sunrise-tabs-labels-cache))
|
||||
(setcdr cache (delq nil
|
||||
(mapcar (lambda(x)
|
||||
(and (not (equal (car x) name)) x))
|
||||
(cdr cache))))
|
||||
(sunrise-tabs-make-label name alias)
|
||||
(sunrise-tabs-refresh)))
|
||||
|
||||
(defun sunrise-tabs-get-tag (name is-active)
|
||||
"Retrieve the cached tag for the tab named NAME in state IS-ACTIVE.
|
||||
nil = inactive, t = active. Creates new labels when needed."
|
||||
(let* ((cache (assq sunrise-selected-window sunrise-tabs-labels-cache))
|
||||
(label (cdr (assoc name (cdr cache)))))
|
||||
(if (null label)
|
||||
(setq label (sunrise-tabs-make-label name)))
|
||||
(if (< sunrise-tabs-max-cache-length (length (cdr cache)))
|
||||
(setcdr cache (cddr cache)))
|
||||
(if is-active (car label) (cdr label))))
|
||||
|
||||
(defun sunrise-tabs-make-line ()
|
||||
"Assemble a new tab line from cached tags and put it in the line cache."
|
||||
(if (memq major-mode '(sunrise-mode sunrise-virtual-mode sunrise-tree-mode))
|
||||
(let ((tab-set (cdr (assq sunrise-selected-window sunrise-tabs)))
|
||||
(tab-line (if (or (cdar sunrise-tabs)
|
||||
(cdr (cadr sunrise-tabs))) "" nil))
|
||||
(current-name (buffer-name)))
|
||||
(mapc (lambda (x)
|
||||
(let ((is-current (equal current-name x)))
|
||||
(setq tab-line
|
||||
(concat tab-line sunrise-tabs-sep
|
||||
(sunrise-tabs-get-tag x is-current)))))
|
||||
tab-set)
|
||||
(setcdr (assq sunrise-selected-window sunrise-tabs-line-cache)
|
||||
tab-line)
|
||||
tab-line)
|
||||
nil))
|
||||
|
||||
(defsubst sunrise-tabs-empty-p (line)
|
||||
(or (null line) (string= "" line)))
|
||||
|
||||
(defsubst sunrise-tabs-empty-mask (line)
|
||||
(or (and (null line) "") line))
|
||||
|
||||
(defsubst sunrise-tabs-empty-null (line)
|
||||
(if (sunrise-tabs-empty-p line) nil line))
|
||||
|
||||
(defun sunrise-tabs-nonempty-p (line-list)
|
||||
"Return non-nil if LINE-LIST contains at least one non-nil element."
|
||||
(or (not (sunrise-tabs-empty-p (car line-list)))
|
||||
(and (cdr line-list) (sunrise-tabs-nonempty-p (cdr line-list)))))
|
||||
|
||||
(defun sunrise-tabs-xor (list1 list2)
|
||||
"Replacement for function `set-exclusive-or'.
|
||||
Used to avoid dependency on cl-seq.el."
|
||||
(cond ((null list1) list2)
|
||||
((null list2) list1)
|
||||
((equal list1 list2) nil)
|
||||
(t
|
||||
(let (result)
|
||||
(mapc (lambda (element)
|
||||
(if (member element result)
|
||||
(setq result (delete element result))
|
||||
(setq result (cons element result))))
|
||||
(append list1 list2))
|
||||
result))))
|
||||
|
||||
(defun sunrise-tabs-refresh ()
|
||||
"Update `header-line-format' in both panes.
|
||||
Uses the line cache for the passive one, and assembles a new tab
|
||||
line for the active one. In the (corner) case when both panes
|
||||
contain the same buffer, glues together the tab lines with a
|
||||
``double bar'' separator."
|
||||
(setq sunrise-tabs-mode sunrise-tabs-on)
|
||||
(sunrise-tabs-make-line)
|
||||
(let ((line-list (mapcar 'cdr sunrise-tabs-line-cache))
|
||||
(same-buffer (eq sunrise-left-buffer sunrise-right-buffer)))
|
||||
(if same-buffer
|
||||
(setq header-line-format
|
||||
(and (sunrise-tabs-nonempty-p line-list)
|
||||
(mapconcat 'concat line-list sunrise-tabs-ligature)))
|
||||
(let ((other-buffer (sunrise-other 'buffer)))
|
||||
(if (eq 'right sunrise-selected-window)
|
||||
(setq line-list (nreverse line-list)))
|
||||
(if (apply 'sunrise-tabs-xor (mapcar 'sunrise-tabs-empty-p line-list))
|
||||
(setq line-list (mapcar 'sunrise-tabs-empty-mask line-list))
|
||||
(setq line-list (mapcar 'sunrise-tabs-empty-null line-list)))
|
||||
|
||||
(setq header-line-format (car line-list))
|
||||
|
||||
(when (buffer-live-p other-buffer)
|
||||
(with-current-buffer other-buffer
|
||||
(setq header-line-format (cadr line-list)))))))
|
||||
(force-window-update))
|
||||
|
||||
;;; ==========================================================================
|
||||
;;; Private interface:
|
||||
|
||||
(defun sunrise-tabs-bury-all ()
|
||||
"Bury all currently tabbed buffers."
|
||||
(let ((all-buffers (apply 'append (mapcar 'cdr sunrise-tabs))))
|
||||
(if all-buffers
|
||||
(mapc 'bury-buffer all-buffers))))
|
||||
|
||||
(defun sunrise-tabs-protect-buffer ()
|
||||
"Protect the current buffer from being automatically disposed
|
||||
by Sunrise when moving to another directory (called from
|
||||
`kill-buffer-query-functions' hook.)"
|
||||
(let ((tab-name (buffer-name)))
|
||||
(not (or (member tab-name (car sunrise-tabs))
|
||||
(member tab-name (cadr sunrise-tabs))))))
|
||||
|
||||
(defun sunrise-tabs-engage ()
|
||||
"Enable the Sunrise Tabs extension."
|
||||
(setq sunrise-tabs-on t)
|
||||
(add-hook 'sunrise-refresh-hook 'sunrise-tabs-refresh)
|
||||
(add-hook 'sunrise-quit-hook 'sunrise-tabs-bury-all)
|
||||
(add-hook 'kill-buffer-query-functions 'sunrise-tabs-protect-buffer)
|
||||
(ad-activate 'sunrise-transpose-panes)
|
||||
(ad-activate 'sunrise-editable-pane)
|
||||
(sunrise-tabs-refresh))
|
||||
|
||||
(defun sunrise-tabs-disengage ()
|
||||
"Disable the Sunrise Tabs extension."
|
||||
(setq sunrise-tabs-on nil)
|
||||
(remove-hook 'sunrise-refresh-hook 'sunrise-tabs-refresh)
|
||||
(remove-hook 'sunrise-quit-hook 'sunrise-tabs-bury-all)
|
||||
(remove-hook 'kill-buffer-query-functions 'sunrise-tabs-protect-buffer)
|
||||
(ad-deactivate 'sunrise-transpose-panes)
|
||||
(ad-deactivate 'sunrise-editable-pane)
|
||||
(setq header-line-format (default-value 'header-line-format))
|
||||
(sunrise-in-other
|
||||
(setq header-line-format (default-value 'header-line-format))))
|
||||
|
||||
;;; ==========================================================================
|
||||
;;; User interface:
|
||||
|
||||
(defvar sunrise-tabs-mode-map (make-sparse-keymap))
|
||||
(define-key sunrise-tabs-mode-map [(control ?j)] 'sunrise-tabs-add)
|
||||
(define-key sunrise-tabs-mode-map [(control ?k)] 'sunrise-tabs-remove)
|
||||
(define-key sunrise-tabs-mode-map "*\C-k" 'sunrise-tabs-clean)
|
||||
(define-key sunrise-tabs-mode-map [(control ?p)] 'sunrise-tabs-prev)
|
||||
(define-key sunrise-tabs-mode-map [(control ?n)] 'sunrise-tabs-next)
|
||||
(define-key sunrise-tabs-mode-map [(meta tab)] 'sunrise-tabs-next)
|
||||
|
||||
(define-key sunrise-tabs-mode-map [(control meta ?j)]
|
||||
(lambda ()
|
||||
(interactive)
|
||||
(sunrise-in-other (sunrise-tabs-add))))
|
||||
|
||||
(define-key sunrise-tabs-mode-map [(control meta ?k)]
|
||||
(lambda ()
|
||||
(interactive)
|
||||
(sunrise-in-other (call-interactively 'sunrise-tabs-remove))))
|
||||
|
||||
(define-key sunrise-tabs-mode-map [(control meta ?p)]
|
||||
(lambda ()
|
||||
(interactive)
|
||||
(sunrise-in-other (sunrise-tabs-prev))))
|
||||
|
||||
(define-key sunrise-tabs-mode-map [(control meta ?n)]
|
||||
(lambda ()
|
||||
(interactive)
|
||||
(sunrise-in-other (sunrise-tabs-next))))
|
||||
|
||||
(define-key sunrise-tabs-mode-map [(control meta tab)]
|
||||
(lambda ()
|
||||
(interactive)
|
||||
(sunrise-in-other (sunrise-tabs-next))))
|
||||
|
||||
(define-key sunrise-tabs-mode-map "*\C-\M-k"
|
||||
(lambda ()
|
||||
(interactive)
|
||||
(sunrise-in-other (sunrise-tabs-clean))))
|
||||
|
||||
(define-key sunrise-tabs-mode-map "\C-xk" 'sunrise-tabs-kill-and-go)
|
||||
(define-key sunrise-tabs-mode-map "\M-T" 'sunrise-tabs-transpose)
|
||||
|
||||
(define-minor-mode sunrise-tabs-mode
|
||||
"Tabs support for the Sunrise Commander file manager.
|
||||
This minor mode provides the following keybindings:
|
||||
|
||||
C-j ........... Create new tab (or rename existing tab) in active pane.
|
||||
C-k ........... Kill the tab of the current buffer in the active pane.
|
||||
C-n ........... Move to the next tab in the active pane.
|
||||
C-p ........... Move to the previous tab in the active pane.
|
||||
|
||||
C-M-j ......... Assign the current buffer to a tab in the passive pane.
|
||||
C-M-k ......... Kill the tab of the current buffer in the passive pane.
|
||||
C-M-n ......... Move to the next tab in the passive pane.
|
||||
C-M-p ......... Move to the previous tab in the passive pane.
|
||||
|
||||
C-x k ......... Kill buffer and move to the next tabbed one (if any).
|
||||
"
|
||||
nil nil sunrise-tabs-mode-map
|
||||
(unless (memq major-mode
|
||||
'(sunrise-mode sunrise-virtual-mode sunrise-tree-mode))
|
||||
(setq sunrise-tabs-mode nil)
|
||||
(error "Sorry, this mode can be used only within the Sunrise Commander."))
|
||||
(if sunrise-tabs-mode
|
||||
(sunrise-tabs-engage)
|
||||
(sunrise-tabs-disengage)))
|
||||
|
||||
(defvar sunrise-tabs-editable-dired-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(set-keymap-parent map sunrise-tabs-mode-map)
|
||||
(define-key map "\C-n" 'dired-next-line)
|
||||
(define-key map "\C-p" 'dired-previous-line)
|
||||
(define-key map "\C-tn" 'sunrise-tabs-next)
|
||||
(define-key map "\C-tp" 'sunrise-tabs-prev)
|
||||
map)
|
||||
"Keymap for managing tabs inside Editable Dired mode panes.")
|
||||
|
||||
(defadvice sunrise-editable-pane (after sunrise-tabs-advice-editable-pane ())
|
||||
"Install `sunrise-tabs-editable-dired-map' when in Editable Dired mode."
|
||||
(add-to-list 'minor-mode-overriding-map-alist
|
||||
`(sunrise-tabs-mode . ,sunrise-tabs-editable-dired-map)))
|
||||
|
||||
;;; ==========================================================================
|
||||
;;; Bootstrap:
|
||||
|
||||
(defun sunrise-tabs-menu-init ()
|
||||
"Initialize the Sunrise Tabs extension menu."
|
||||
(unless (lookup-key sunrise-mode-map [menu-bar Sunrise])
|
||||
(define-key sunrise-mode-map [menu-bar Sunrise]
|
||||
(cons "Sunrise" (make-sparse-keymap))))
|
||||
(let ((menu-map (make-sparse-keymap "Tabs")))
|
||||
(define-key sunrise-mode-map [menu-bar Sunrise tabs]
|
||||
(cons "Tabs" menu-map))
|
||||
(define-key menu-map [help]
|
||||
'("Help" . (lambda ()
|
||||
(interactive)
|
||||
(describe-function 'sunrise-tabs-mode))))
|
||||
(define-key menu-map [transpose]
|
||||
'("Transpose" . sunrise-tabs-transpose))
|
||||
(define-key menu-map [kill]
|
||||
'("Kill and go to next" . sunrise-tabs-kill-and-go))
|
||||
(define-key menu-map [next]
|
||||
'("Next" . sunrise-tabs-next))
|
||||
(define-key menu-map [prev]
|
||||
'("Previous" . sunrise-tabs-prev))
|
||||
(define-key menu-map [remove]
|
||||
'("Remove" . sunrise-tabs-remove))
|
||||
(define-key menu-map [add]
|
||||
'("Add/Rename" . sunrise-tabs-add))))
|
||||
|
||||
(defun sunrise-tabs-start-once ()
|
||||
"Bootstrap the tabs mode on the first execution of the Sunrise Commander,
|
||||
after module installation."
|
||||
(sunrise-tabs-mode t)
|
||||
(sunrise-tabs-menu-init)
|
||||
(remove-hook 'sunrise-start-hook 'sunrise-tabs-start-once)
|
||||
(unintern 'sunrise-tabs-menu-init obarray)
|
||||
(unintern 'sunrise-tabs-start-once obarray))
|
||||
(add-hook 'sunrise-start-hook 'sunrise-tabs-start-once)
|
||||
|
||||
;;; ==========================================================================
|
||||
;;; Desktop support:
|
||||
|
||||
(defun sunrise-tabs-desktop-save-buffer (_desktop-dir)
|
||||
"Return additional desktop data to save tabs of the current Sunrise buffer."
|
||||
(let* ((left-tab (car (member (buffer-name) (assoc 'left sunrise-tabs))))
|
||||
(left-cache (cdr (assq 'left sunrise-tabs-labels-cache)))
|
||||
(left-label (cadr (assoc left-tab left-cache)))
|
||||
(right-tab (car (member (buffer-name) (assoc 'right sunrise-tabs))))
|
||||
(right-cache (cdr (assq 'right sunrise-tabs-labels-cache)))
|
||||
(right-label (cadr (assoc right-tab right-cache))))
|
||||
(delq
|
||||
nil
|
||||
(list
|
||||
(and left-label
|
||||
(cons 'left-tab (sunrise-tabs-trim-label left-label)))
|
||||
(and right-label
|
||||
(cons 'right-tab (sunrise-tabs-trim-label right-label)))))))
|
||||
|
||||
(defun sunrise-tabs-desktop-restore-buffer (_desktop-buffer-file-name
|
||||
_desktop-buffer-name
|
||||
desktop-buffer-misc)
|
||||
"Restore all tabs in a Sunrise (normal or VIRTUAL) buffer from a desktop file."
|
||||
(mapc (lambda (side)
|
||||
(let* ((sunrise-selected-window side)
|
||||
(tab-symbol (intern (concat (symbol-name side) "-tab")))
|
||||
(name (buffer-name))
|
||||
(label (cdr (assq tab-symbol desktop-buffer-misc)))
|
||||
(tab-set (assq side sunrise-tabs)))
|
||||
(when label
|
||||
(setcdr tab-set (cons name (cdr tab-set)))
|
||||
(sunrise-tabs-make-label name label))))
|
||||
'(left right))
|
||||
(unless sunrise-tabs-on
|
||||
(sunrise-tabs-engage)))
|
||||
|
||||
(defun sunrise-tabs-reset-state ()
|
||||
"Reset some environment variables that control the behavior of
|
||||
tabs in the Sunrise Commander (used for desktop support)."
|
||||
(mapc (lambda (x) (setcdr x nil)) sunrise-tabs-labels-cache)
|
||||
(mapc (lambda (x) (setcdr x nil)) sunrise-tabs)
|
||||
nil)
|
||||
|
||||
;; Append the previous functions to the generic desktop support in Sunrise:
|
||||
(add-to-list 'sunrise-desktop-save-handlers
|
||||
'sunrise-tabs-desktop-save-buffer)
|
||||
(add-to-list 'sunrise-desktop-restore-handlers
|
||||
'sunrise-tabs-desktop-restore-buffer)
|
||||
|
||||
;; Activate tabs support after desktop restoration:
|
||||
(add-hook
|
||||
'desktop-after-read-hook
|
||||
(defun sunrise-tabs-desktop-after-read-function ()
|
||||
(unless (assq 'sunrise-tabs-on desktop-globals-to-clear)
|
||||
(add-to-list 'desktop-globals-to-clear
|
||||
'(sunrise-tabs-on . (sunrise-tabs-reset-state))))))
|
||||
|
||||
(defun sunrise-tabs-unload-function ()
|
||||
(sunrise-ad-disable "^sunrise-tabs-"))
|
||||
|
||||
(provide 'sunrise-tabs)
|
||||
|
||||
;;; sunrise-tabs.el ends here
|
||||
File diff suppressed because it is too large
Load Diff
|
|
@ -55,5 +55,7 @@
|
|||
(package! highlight)
|
||||
(package! yafolding)
|
||||
(package! dired-quick-sort)
|
||||
(package! fish-mode)
|
||||
;; (package! image-dired+)
|
||||
(package! ido-vertical-mode) ; not being used
|
||||
(package! tramp-term)
|
||||
|
|
|
|||
Loading…
Reference in New Issue