1 ;; geiser-popup.el -- popup windows
3 ;; Copyright (C) 2009, 2010 Jose Antonio Ortega Ruiz
5 ;; This program is free software; you can redistribute it and/or
6 ;; modify it under the terms of the Modified BSD License. You should
7 ;; have received a copy of the license along with this program. If
8 ;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>.
10 ;; Start date: Sat Feb 07, 2009 14:05
15 ;;; Support for defining popup buffers and accessors:
17 (defvar geiser-popup--registry nil
)
19 (setq geiser-popup--overriding-map
20 (let ((map (make-sparse-keymap)))
21 (define-key map
"q" 'View-quit
)
24 (defun geiser-popup--setup-view-mode ()
26 (set (make-local-variable 'view-no-disable-on-exit
) t
)
27 (set (make-local-variable 'minor-mode-overriding-map-alist
)
28 (list (cons 'view-mode geiser-popup--overriding-map
)))
29 (setq view-exit-action
31 (with-current-buffer buffer
34 (defmacro geiser-popup--define
(base name mode
)
35 (let ((get-buff (intern (format "geiser-%s--buffer" base
)))
36 (pop-buff (intern (format "geiser-%s--pop-to-buffer" base
)))
37 (with-macro (intern (format "geiser-%s--with-buffer" base
)))
38 (method (make-symbol "method"))
39 (buffer (make-symbol "buffer")))
41 (add-to-list 'geiser-popup--registry
,name
)
43 (or (get-buffer ,name
)
44 (with-current-buffer (get-buffer-create ,name
)
46 (geiser-popup--setup-view-mode)
48 (defun ,pop-buff
(&optional
,method
)
49 (let ((,buffer
(funcall ',get-buff
)))
50 (unless (eq ,buffer
(current-buffer))
51 (cond ((eq ,method
'buffer
) (view-buffer ,buffer
))
52 ((eq ,method
'frame
) (view-buffer-other-frame ,buffer
))
53 (t (view-buffer-other-window ,buffer
))))))
54 (defmacro ,with-macro
(&rest body
)
55 (list 'with-current-buffer
(list ',get-buff
)
56 (cons 'let
(cons '((inhibit-read-only t
)) body
))))
57 (put ',with-macro
'lisp-indent-function
'defun
))))
59 (put 'geiser-popup--define
'lisp-indent-function
1)
64 (defun geiser-popup-unload-function ()
65 (dolist (name geiser-popup--registry
)
66 (when (buffer-live-p (get-buffer name
))
70 (provide 'geiser-popup
)
71 ;;; geiser-popup.el ends here