Find file
Fetching contributors…
Cannot retrieve contributors at this time
130 lines (107 sloc) 5.23 KB
;;; 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. <>
;; Štěpán Němec <>
;; Maintainer: José Alfredo Romero L. <>
;; Created: 29 Dec 2009
;; Version: 1
;; RCS Version: $Rev: 423 $
;; Keywords: sunrise commander, checkpoints, bookmarks
;; URL:
;; 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 <>.
;;; 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")
(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)
(progn (dired x) (sr-bookmark-jump))
(setq missing (cons sr-selected-window missing)))
(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)
(format "Relocate %s [%s] to: " name (symbol-name x))))
(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 (apply 'format "Sunrise Checkpoint: %s | %s" result)))
(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-activate 'bookmark-relocate)
(defun sunrise-x-checkpoints-unload-function ()
(sr-ad-disable "^sr-checkpoint-"))
(provide 'sunrise-x-checkpoints)
;;; sunrise-x-checkpoints.el ends here