summaryrefslogtreecommitdiff
path: root/elisp
diff options
context:
space:
mode:
authorJose Antonio Ortega Ruiz <jao@gnu.org>2010-06-14 00:33:41 +0200
committerJose Antonio Ortega Ruiz <jao@gnu.org>2010-06-14 00:33:41 +0200
commita029a01b9b451647f206be50fd4cdf67bac9e38d (patch)
treea02f118b07b36d217d78840e23c7e46dadfdb31e /elisp
parent2daad50e9f20fd815ea3ac81786dc675b3b59a8d (diff)
downloadgeiser-chez-a029a01b9b451647f206be50fd4cdf67bac9e38d.tar.gz
geiser-chez-a029a01b9b451647f206be50fd4cdf67bac9e38d.tar.bz2
Generic support for menus.
Diffstat (limited to 'elisp')
-rw-r--r--elisp/geiser-impl.el2
-rw-r--r--elisp/geiser-menu.el157
-rw-r--r--elisp/geiser-reload.el1
3 files changed, 160 insertions, 0 deletions
diff --git a/elisp/geiser-impl.el b/elisp/geiser-impl.el
index 1c3347c..f84f90c 100644
--- a/elisp/geiser-impl.el
+++ b/elisp/geiser-impl.el
@@ -151,6 +151,7 @@ determine its scheme flavour."
(geiser-impl--define ,load-file-name ',name ',parent ',methods)
(geiser-impl--add-to-alist 'regexp ,impl-rx ',name t)
(require 'geiser-repl)
+ (require 'geiser-menu)
(defun ,runner ()
,runner-doc
(interactive)
@@ -159,6 +160,7 @@ determine its scheme flavour."
,switcher-doc
(interactive "P")
(switch-to-geiser ,ask ',name))
+ (geiser-menu--add-impl ',name ',runner ',switcher)
(provide ',(geiser-impl--feature name))))))
(defun geiser-impl--add-to-alist (kind what impl &optional append)
diff --git a/elisp/geiser-menu.el b/elisp/geiser-menu.el
new file mode 100644
index 0000000..25c4630
--- /dev/null
+++ b/elisp/geiser-menu.el
@@ -0,0 +1,157 @@
+;;; geiser-menu.el -- menu and keymaps definition
+
+;; Copyright (c) 2010 Jose Antonio Ortega Ruiz
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the Modified BSD License. You should
+;; have received a copy of the license along with this program. If
+;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>.
+
+;; Start date: Sat Jun 12, 2010 03:01
+
+
+(require 'geiser-custom)
+(require 'geiser-base)
+
+
+;;; Customization:
+
+(geiser-custom--defcustom geiser-global-menu-always-on-p nil
+ "Whether the Geiser menu is always visible."
+ :type 'boolean
+ :group 'geiser)
+
+
+;;; Visibility:
+
+(make-variable-buffer-local
+ (defvar geiser-menu--geiser-component-p nil))
+
+(defun geiser-menu--visible-p ()
+ (or geiser-global-menu-always-on-p geiser-menu--geiser-component-p))
+
+(defun geiser-menu--provide ()
+ (setq geiser-menu--geiser-component-p t))
+
+
+;;; Top-level menu
+
+(define-key global-map [menu-bar geiser]
+ `(menu-item "Geiser" ,(make-sparse-keymap "Geiser")
+ :visible (geiser-menu--visible-p)))
+
+(add-to-list 'menu-bar-final-items 'geiser)
+
+(defmacro geiser-menu--add-items-1 (ev keymap keys)
+ `(progn ,@(mapcar (lambda (kd)
+ (let* ((ev (if (listp ev) ev (list ev)))
+ (title (nth 0 kd))
+ (binding (nth 1 kd))
+ (cmd (nth 2 kd))
+ (hlp (nth 3 kd))
+ (item (make-symbol title))
+ (hlp (and (stringp hlp) (list :help hlp)))
+ (rest (or (and hlp (nthcdr 4 kd))
+ (nthcdr 3 kd)))
+ (binding (if (listp binding)
+ binding
+ (list binding))))
+ `(progn (define-key global-map
+ [menu-bar geiser ,@ev ,item]
+ '(menu-item ,title ,cmd ,@hlp ,@rest))
+ ,@(and binding
+ `((put ',cmd
+ :advertised-binding
+ ,(car binding))))
+ ,@(mapcar (lambda (b)
+ `(define-key ,keymap ,b ',cmd))
+ binding))))
+ keys)))
+
+(defmacro geiser-menu--add-items (keymap keys &optional visible)
+ (let ((keys (if visible
+ (mapcar (lambda (k) (append k `(:visible ,visible))) keys)
+ keys)))
+ `(geiser-menu--add-items-1 nil ,keymap ,(reverse keys))))
+
+(defmacro geiser-menu--add-submenu (name keymap visible keys)
+ (let ((ev (make-symbol name)))
+ `(progn
+ (define-key global-map [menu-bar geiser ,ev]
+ (list 'menu-item ,name ,keymap :visible ',visible))
+ (geiser-menu--add-items-1 ,ev ,keymap ,keys))))
+
+(put 'geiser-menu--add-submenu 'lisp-indent-function 3)
+(put 'geiser-menu--add-items 'lisp-indent-function 1)
+
+(defvar geiser-menu--line-counter 0)
+
+(defun geiser-menu--add-line ()
+ (let ((line (make-symbol (format "line%s"
+ (setq geiser-menu--line-counter
+ (1+ geiser-menu--line-counter))))))
+ (define-key global-map `[menu-bar geiser ,line]
+ `(menu-item "--single-line"))))
+
+(defmacro geiser-menu--add-custom (title group keymap visible)
+ `(geiser-menu--add-items ,keymap
+ ((,title nil (lambda () (interactive) (customize-group ',group))))
+ ,visible))
+
+(defmacro geiser-menu--defmenu (keymap visible &rest keys)
+ (let ((fs))
+ (dolist (kd keys)
+ (setq fs
+ (cons (cond ((eq 'line kd) '(geiser-menu--add-line))
+ ((stringp (car kd))
+ `(geiser-menu--add-items ,keymap
+ ,(list kd) ,visible))
+ ((eq 'menu (car kd))
+ `(geiser-menu--add-submenu ,(cadr kd) ,keymap
+ ,visible ,(cddr kd)))
+ ((eq 'custom (car kd))
+ `(geiser-menu--add-custom ,(nth 1 kd)
+ ,(nth 2 kd)
+ ,keymap
+ ,visible))
+ (t (error "Bad form: %s" kd)))
+ fs)))
+ `(progn ,@fs)))
+
+(put 'geiser-menu--defmenu 'lisp-indent-function 2)
+
+
+;;; Implementation support
+
+(define-key global-map [menu-bar geiser custom]
+ (cons "Customize" (make-sparse-keymap "Customize")))
+
+(defun geiser-menu--add-global-custom (title group)
+ (define-key global-map `[menu-bar geiser custom ,(make-symbol title)]
+ (cons title `(lambda () (interactive) (customize-group ',group)))))
+
+(defun geiser-menu--add-impl (name runner switcher)
+ (let ((title (capitalize (format "%s" name)))
+ (group (intern (format "geiser-%s" name))))
+ (define-key global-map `[menu-bar geiser run ,name] (cons title runner))
+ (define-key global-map `[menu-bar geiser switch ,name]
+ (cons title switcher))
+ (geiser-menu--add-global-custom title group)))
+
+
+;;; Permanent entries
+
+(geiser-menu--add-global-custom "Geiser" 'geiser)
+
+(define-key global-map [menu-bar geiser switch]
+ (cons "Switch to" (make-sparse-keymap "Switch to")))
+(define-key global-map [menu-bar geiser run]
+ (cons "Run" (make-sparse-keymap "Run")))
+
+(geiser-menu--add-line)
+
+
+
+(provide 'geiser-menu)
+;;; geiser-menu.el ends here
+
diff --git a/elisp/geiser-reload.el b/elisp/geiser-reload.el
index f01cacf..0e52083 100644
--- a/elisp/geiser-reload.el
+++ b/elisp/geiser-reload.el
@@ -37,6 +37,7 @@
geiser-connection
geiser-syntax
geiser-log
+ geiser-menu
geiser-custom
geiser-base
geiser-popup