bookmark-add.el

Download

;;; bookmark-add.el --- creates the buffer for work with bookmarks
;;
;; $Id$
;;
;; Time-stamp: <28-10-2004 00:25:00>
;;
;; Copyright (C) 2004 Eugene V. Markov

;; Author: Eugene V. Markov
;; Version: $Revision$
;; Keywords: bookmarks, placeholders, annotations

;; 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 2, 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; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;; `bookmark-open-in-symply-buffer' will generate buffer named
;; *Bookmark list*, which shows bookmarks from .emacs.bmk.
;; It has possibilities for deleting bookmarks from list,
;; saveing bookmarks list to file and loading  bookmarks list
;; from file.
;;
;; Install.
;;
;; (load "bookmark-add")
;; (global-set-key [?\C-c ?b ?l] 'bookmark-open-in-simply-buffer)
;; (global-set-key [?\C-c ?b ?m] 'bookmark-set-add)
;; (global-set-key [?\C-.] 'bookmark-jump-next-cyclic)
;; (global-set-key [?\C-,] 'bookmark-jump-prev-cyclic)
;; (global-set-key [?\C-'] 'bookmark-jump-backwards)
;;
;; More commentary:
;;
;; `bookmark-open-in-simply-buffer' - switch to buffer named
;; *Bookmark list*. If to hit key Enter on bookmark region will
;; pass on a corresponding file. If to hit key Delete (or Ctrl-d) on
;; bookmark region remove this bookmark from bookmarks list.
;; If to hit key 'q' the buffer will be closed.
;; `bookmark-set-add' - add this bookmark to bookmarks list.
;; To use history, it is necessary to press buttons Up and Down.
;; The first pressing Up inserts expression which is near to a point.
;; `bookmark-jump-next-cyclic' - cyclic moving on bookmarks forward.
;; `bookmark-jump-prev-cyclic' - cyclic moving on bookmarks backward.
;; `bookmark-jump-backwards' - will move to last cursor position right
;;  after uses of commands `bookmark-jump-next-cyclic' and
;; `bookmark-jump-prev-cyclic'.

(require 'bookmark)
(require 'wid-edit)

(defvar bookmark-add-version "$Revision$"
  "The version of bookmark-add currently loaded")

(defgroup bookmark-add nil
  "Setting, annotation and jumping to bookmarks."
  :group 'bookmark)

(defcustom bookmark-add-default-file-name
  ".emacs.bmk"
  ""
  :type 'file
  :group 'bookmark-add)


(defface bookmark-simply-buffer-face
  '((t (:background "light grey" :foreground "red" :bold t)))
  ""
  :group 'bookmark-add)

(defvar evm-current-bookmark-path nil
  "Path to current bookmark file."
  )


(defun bookmark-open-in-simply-buffer ()
  "Allow to open bookmark list in simply buffer."
  (interactive)
  (if (bookmark-alist-exists-p)
      (if (and (get-buffer "*Bookmark list*")
               (get-buffer-window (get-buffer "*Bookmark list*")))
          (select-window (get-buffer-window (get-buffer "*Bookmark list*")))
	  (setq bookmark-windows-configure (current-window-configuration))
	  (split-window-vertically)
	  (other-window 1)
	  (with-current-buffer (get-buffer-create "*Bookmark list*")
	    (switch-to-buffer (current-buffer))
	    (kill-all-local-variables)
	    (setq truncate-lines t)
	    (let ((inhibit-read-only t))
		(erase-buffer))
	    (let ((all (overlay-lists)))
		;; Delete all the overlays.
		(mapcar 'delete-overlay (car all))
		(mapcar 'delete-overlay (cdr all)))
	    ;; Insert the dialog header
	    (widget-insert "Click on a text to open it or on Cancel to quit.\n\n")
	    ;; Insert the list of texts as buttons
	    (setq bookmark-max-fnl (let ((l bookmark-alist )(nl 0)(str))
					     (while
						   (setq str (cdr (assoc 'front-context-string
										 (cadr (car l)))))
						 (if (> (length str) nl)
						     (setq nl (length str)))
						 (setq l (cdr l))
						 )
					     (symbol-value 'nl)))
	    (setq bookmark-max-fnl (+ bookmark-max-fnl 2))
	    (mapcar '(lambda (menu-element)
			   (let ((menu-item1 (cdr (assoc 'front-context-string (cadr menu-element))))
				   (menu-item2 (cdr (assoc 'rear-context-string (cadr menu-element))))
				   (file-path (copy-sequence
						   (cdr (assoc 'filename (cadr menu-element)))))
				   (name (copy-sequence (car menu-element)))
                           bp ep ovl)
                       (setq bp (point))
			     (widget-insert " Bookmark ")
                       (let (bp ep ovl)
                         (setq bp (point))
                         (widget-insert name)
                         (setq ep (point))
                         (setq ovl (make-overlay bp ep))
                         (overlay-put ovl 'face font-lock-function-name-face))
			     (widget-insert " from file\n")
			     (widget-insert " ")
                       (let (bp ep ovl)
                         (setq bp (point))
                         (widget-insert file-path)
                         (setq ep (point))
                         (setq ovl (make-overlay bp ep))
                         (overlay-put ovl 'face font-lock-keyword-face))
			     (widget-insert "\n")
			     (widget-create 'push-button
						  :button-face 'bookmark-simply-buffer-face
						  :tag (concat " " menu-item2 menu-item1 "\n")
						  :help-echo (concat "Open bookmark " name)
						  :format "%[%t%]"
						  :notify 'bookmark-open-in-simply-buffer-action
						  menu-element)
			     (widget-insert "\n")
                       (setq ep (point))
                       (setq ovl (make-overlay bp ep))
                       (overlay-put ovl 'bookmark-add-item-region t)
			     ))
			bookmark-alist)
	    (widget-insert "\n")
	    ;; Insert the Cancel button
	    (widget-create 'push-button
				 :notify 'bookmark-open-in-simply-buffer-cancel
				 :help-echo "Quit from this buffer."
				 "Cancel")
	    (widget-insert " ")
	    ;; Insert the Save button
	    (widget-create 'push-button
				 :notify 'bookmark-save-wrapper
				 :help-echo "Save bookmark list to file."
				 "Save")
	    (widget-insert " ")
	    ;; Insert the Load button
	    (widget-create 'push-button
				 :notify 'bookmark-load-wrapper
				 :help-echo "Load bookmark list from file."
				 "Load")
	    (widget-insert " ")
	    ;; Insert the Bookmark path button
	    (widget-create 'push-button
				 :notify 'evm-bookmark-path-to-current
				 :help-echo "Path to bookmark file."
				 "Bookmark path")
	    (let ((map (copy-keymap widget-keymap)))
; 		(define-key map [up] 'widget-backward)
; 		(define-key map [down] 'widget-forward)
		(define-key map [delete] 'bookmark-delete-wrapper)
		(define-key map [?\C-d] 'bookmark-delete-wrapper)
		(define-key map [?q] 'bookmark-open-in-simply-buffer-cancel)
		(define-key map "\e\e" 'bookmark-open-in-simply-buffer-cancel)
		(use-local-map map))
	    (widget-setup)
	    (goto-char (point-min))))))


(defun bookmark-delete-wrapper ()
  (interactive)
  (let ((ovls (overlays-at (point)))
        (inhibit-read-only t))
    (while ovls
      (if (and (overlay-get (car ovls) 'bookmark-add-item-region)
               (widget-tabable-at))
          (progn
            (bookmark-delete (car (widget-value (widget-tabable-at))))
            (delete-region (overlay-start (car ovls))
                           (overlay-end (car ovls)))
            (setq ovls nil)))
      (setq ovls (cdr ovls)))))


(defun evm-bookmark-path-to-current  (&rest ignore)
  (interactive)
  (message "%s" evm-current-bookmark-path))


(defun bookmark-open-in-simply-buffer-action (widget &rest ignore)
   (kill-buffer (current-buffer))
   (set-window-configuration bookmark-windows-configure)
   (bookmark-delete (car (widget-value widget)))
   (setq bookmark-alist (cons (widget-value widget) bookmark-alist))
   (bookmark-jump (car (widget-value widget)))
  )

(defun bookmark-open-in-simply-buffer-cancel (&rest ignore)
  (interactive)
  (kill-buffer (current-buffer))
  (set-window-configuration bookmark-windows-configure)
  (message "Command canceled."))


(defun bookmark-alist-exists-p ()
  ;; это для загрузки с проверкой, а не для проверки.
  (if (and (boundp 'bookmark-alist)
           (not evm-current-bookmark-path))
	(if (and (boundp 'desktop-dirname)
		   desktop-dirname
		   (file-exists-p (concat desktop-dirname ".emacs.bmk")))
	    (progn
		(bookmark-load (concat desktop-dirname ".emacs.bmk") t)
            (setq evm-current-bookmark-path
                  (concat desktop-dirname ".emacs.bmk"))
		t)
	  (if (file-exists-p (expand-file-name "~/.emacs.bmk"))
		(progn
		  (bookmark-load (expand-file-name "~/.emacs.bmk") t)
              (setq evm-current-bookmark-path
                    (expand-file-name "~/.emacs.bmk"))
		  t)
	    nil))
    t))


(defun bookmark-set-add ()
  (interactive)
  (if (bookmark-alist-exists-p)
	(let ((l bookmark-alist) (s) (sxp))
	  (while l
	    (setq s (nconc s (list (caar l))))
	    (setq l (cdr l)))
	  (setq l minibuffer-history)
	  (if (setq sxp (thing-at-point 'sexp))
		(setq s (nconc (list sxp) s)))
	  (setq minibuffer-history s)
	  (unwind-protect
		(bookmark-set)
	    (setq minibuffer-history l))
	  )))

(defun bookmark-jump-next-cyclic()
  (interactive)
  (if (bookmark-alist-exists-p)
	(let* ((keys (recent-keys))
		 (len (length keys))
		 (key1 (if (> len 0) (elt keys (- len 1)) nil))
		 (key2 (if (> len 1) (elt keys (- len 2)) nil))
		 n)
	  (if (eq key1 key2)
		(progn
		  (setq n (length bookmark-alist))
		  (nconc bookmark-alist bookmark-alist)
		  (setq bookmark-alist (cdr bookmark-alist))
		  (setcdr (nthcdr (- n 1) bookmark-alist) nil)
		  (bookmark-jump (car (car bookmark-alist)))
		  )
	    (progn
		(if (not (equal key2
				    (elt (car (where-is-internal 'bookmark-jump-prev-cyclic)) 0)))
		    (progn
			(setq bookmark-windows-configure
				(cons (current-window-configuration) (point)))))
		(bookmark-jump (car (car bookmark-alist))))))))


(defun bookmark-jump-prev-cyclic()
  (interactive)
  (if (bookmark-alist-exists-p)
	(let* ((keys (recent-keys))
		 (len (length keys))
		 (key1 (if (> len 0) (elt keys (- len 1)) nil))
		 (key2 (if (> len 1) (elt keys (- len 2)) nil))
		 n)
	  (if (eq key1 key2)
		(progn
		  (setq n (length bookmark-alist))
		  (setq bookmark-alist (reverse bookmark-alist))
		  (nconc bookmark-alist bookmark-alist)
		  (setq bookmark-alist (cdr bookmark-alist))
		  (setcdr (nthcdr (- n 1) bookmark-alist) nil)
		  (bookmark-jump (car (car bookmark-alist)))
		  (setq bookmark-alist (reverse bookmark-alist))
		  )
	    (progn
		(if (not (equal key2
				    (elt (car (where-is-internal 'bookmark-jump-next-cyclic)) 0)))
		    (progn
			(setq bookmark-windows-configure
				(cons (current-window-configuration) (point)))))
		(bookmark-jump (car (car (reverse bookmark-alist)))))))))


(defun bookmark-jump-backwards()
  (interactive)
  (let* ((keys (recent-keys))
	   (key (if (> (length keys) 1) (elt keys (- (length keys) 2)) nil)))
    (if (or (eq key
		    (elt (car (where-is-internal 'bookmark-jump-prev-cyclic)) 0))
		(eq key
		    (elt (car (where-is-internal 'bookmark-jump-next-cyclic)) 0)))
	  (progn
	    (set-window-configuration (car bookmark-windows-configure))
	    (goto-char (cdr bookmark-windows-configure))))))


(defadvice bookmark-jump (after bookmark-jump-folding-mode activate)
  (if (and (boundp 'folding-mode) folding-mode)
	(progn
	  (let ((p (point)))
		  (folding-show-current-entry nil t)
		  (goto-char p)))))



(defun bookmark-save-wrapper  (&rest ignore)
  ""
  (interactive)
  (cond
   ((featurep 'evm-dired-ch)
    (evm-pcompleting-minibuffer-file-dired
       "Path to bookmarks file (Save): "
       'bookmark-save-wrapper-fn
       evm-current-bookmark-path))
   ((featurep 'evm-pcomplete)
    (bookmark-save-wrapper-fn
     (evm-pcompleting-minibuffer-dir "Path to bookmarks file (Save): "
                                     evm-current-bookmark-path)))
   (t
    (bookmark-add-default-file-name
     (file (read-file-name "Path to bookmarks file (Save): "
                           evm-current-bookmark-path nil nil
                           ))))))


(defun bookmark-save-wrapper-fn  (path)
  ""
  (when (listp path)
    (setq path (car path)))
  ;;
  (if (and path (not (= (length path) 0)))
      (progn
        (setq path (expand-file-name path))
        (bookmark-save nil path))))


(defun bookmark-load-wrapper  (&rest ignore)
  ""
  (interactive)
  (cond
   ((featurep 'evm-dired-ch)
    (evm-pcompleting-minibuffer-file-dired*
       "Path to bookmarks file (Load): "
       'bookmark-load-wrapper-fn
       evm-current-bookmark-path))
   ((featurep 'evm-pcomplete)
    (bookmark-load-wrapper-fn
     (evm-pcompleting-minibuffer-dir "Path to bookmarks file (Load): "
                                     evm-current-bookmark-path)))
   (t
    (bookmark-add-default-file-name
     (file (read-file-name "Path to bookmarks file (Load): "
                           evm-current-bookmark-path nil nil
                           ))))))


(defun bookmark-load-wrapper-fn  (path)
  ""
  (when (listp path)
    (setq path (car path)))
  ;;
  (if (and path (not (= (length path) 0)))
      (progn
        (setq path (expand-file-name path))
        (bookmark-load path t)
        (setq evm-bookmark-path-to-current path)
        (kill-buffer (current-buffer))
        (set-window-configuration bookmark-windows-configure)
        (bookmark-open-in-simply-buffer))))


(provide 'bookmark-add)

;;; bookmark-add.el ends here.