forked from sunrise-commander/sunrise-commander
-
Notifications
You must be signed in to change notification settings - Fork 0
/
sunrise-x-checkpoints.el
129 lines (107 loc) · 5.24 KB
/
sunrise-x-checkpoints.el
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
;;; sunrise-x-checkpoints.el --- checkpoint bookmarks for the Sunrise Commander File Manager -*- lexical-binding: t -*-
;; Copyright (C) 2009-2012 José Alfredo Romero Latouche.
;; Author: José Alfredo Romero L. <escherdragon@gmail.com>
;; Štěpán Němec <stepnem@gmail.com>
;; Maintainer: José Alfredo Romero L. <escherdragon@gmail.com>
;; Created: 29 Dec 2009
;; Version: 1
;; RCS Version: $Rev: 425 $
;; Keywords: sunrise commander, checkpoints, bookmarks
;; URL: http://www.emacswiki.org/emacs/sunrise-x-checkpoints.el
;; Compatibility: GNU Emacs 23+
;; 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:
;; Beginning with version 4 of the Sunrise Commander, checkpoints were redefined
;; to be a special form of bookmarks. Unfortunately, the differences between the
;; bookmarks frameworks in Emacs 22 and Emacs 23 are so big that including this
;; code directly in the sunrise-commander script would make it incompatible with
;; Emacs 22. For this reason both versions of checkpoints are now provided as
;; dynamically loaded extensions, so that you can decide which of them to use.
;; To be sure, this is the version I intend to further develop, as it has a
;; richer set of functions and integrates more nicely to the rest of Emacs. The
;; other one is deprecated and will eventually disappear once Emacs 23+ becomes
;; the "stable" release.
;; This extension was written and tested on GNU Emacs 23 on Linux.
;;; Installation and Usage:
;; 1) Put this file somewhere in your Emacs `load-path'. (Optionally) compile
;; it.
;; 2) Enjoy ;-) -- Sunrise should pick the correct extension automatically. On
;; Emacs 23 it will look for sunrise-x-checkpoints, while on Emacs 22 it'll try
;; to load sunrise-x-old-checkpoints. Only if you *really* want to use the old
;; extensions on Emacs 23 you may add a new (require 'sunrise-x-old-checkpoints)
;; expression to your .emacs file somewhere after (require 'sunrise-commander).
;;; Code:
(eval-when-compile (require 'bookmark)
(require 'cl)
(require 'sunrise-commander))
(defun sr-checkpoint-save (&optional _arg)
"Create a new checkpoint bookmark to save the location of both panes."
(interactive "p")
(sr-save-directories)
(let ((bookmark-make-record-function 'sr-make-checkpoint-record))
(call-interactively 'bookmark-set)))
(defun sr-checkpoint-restore (&optional _arg)
"Call `bookmark-jump' interactively."
(interactive "p")
(call-interactively 'bookmark-jump)
(sr-history-push default-directory)
(sr-in-other (sr-history-push default-directory)))
(defun sr-make-checkpoint-record ()
"Generate a the bookmark record for a new checkpoint."
`((filename . ,(format "Sunrise Checkpoint: %s | %s"
sr-left-directory sr-right-directory))
(sr-directories . (,sr-left-directory ,sr-right-directory))
(handler . sr-checkpoint-handler)))
(defun sr-checkpoint-handler (&optional bookmark)
"Handler for checkpoint bookmarks."
(or sr-running (sunrise))
(sr-select-window 'left)
(let ((dirs (cdr (assq 'sr-directories (cdr bookmark)))) (missing))
(mapc (lambda (x)
(if (file-directory-p x)
(sr-save-aspect (dired x) (sr-bookmark-jump))
(setq missing (cons sr-selected-window missing)))
(sr-change-window))
dirs)
(if missing (sr-checkpoint-relocate bookmark (reverse missing)))))
(defun sr-checkpoint-relocate (bookmark &optional sides)
"Handle relocation of checkpoint bookmarks."
(interactive (list (bookmark-completing-read "Bookmark to relocate")))
(let* ((sides (or sides '(left right)))
(name (car bookmark))
(dirs (assq 'sr-directories (cdr bookmark)))
(relocs (mapcar
(lambda (x)
(read-directory-name
(format "Relocate %s [%s] to: " name (symbol-name x))))
sides))
(result (cond ((< 1 (length relocs)) relocs)
((eq 'right (car sides)) (list (cadr dirs) (car relocs)))
(t (list (car relocs) (caddr dirs))))))
(setcdr dirs result)
(bookmark-set-filename
bookmark (apply 'format "Sunrise Checkpoint: %s | %s" result)))
(bookmark-save)
(sr-checkpoint-handler bookmark))
(defadvice bookmark-relocate
(around sr-checkpoint-advice-bookmark-relocate (bookmark))
(let ((bmk (bookmark-get-bookmark bookmark)))
(if (assq 'sr-directories bmk)
(sr-checkpoint-relocate bmk)
ad-do-it)))
(ad-activate 'bookmark-relocate)
(defun sunrise-x-checkpoints-unload-function ()
(sr-ad-disable "^sr-checkpoint-"))
(provide 'sunrise-x-checkpoints)
;;; sunrise-x-checkpoints.el ends here