diff options
| -rw-r--r-- | elisp/geiser-impl.el | 2 | ||||
| -rw-r--r-- | elisp/geiser-menu.el | 157 | ||||
| -rw-r--r-- | elisp/geiser-reload.el | 1 |
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 |