geiser-menu.el (5533B)
1 ;;; geiser-menu.el -- menu and keymaps definition 2 3 ;; Copyright (c) 2010, 2012 Jose Antonio Ortega Ruiz 4 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>. 9 10 ;; Start date: Sat Jun 12, 2010 03:01 11 12 13 ;;; Code: 14 15 (require 'geiser-custom) 16 (require 'geiser-base) 17 18 19 ;;; Customization: 20 21 (geiser-custom--defcustom geiser-global-menu-always-on-p nil 22 "Whether the Geiser menu is always visible." 23 :type 'boolean 24 :group 'geiser) 25 26 27 ;;; Top-level menu 28 29 (defmacro geiser-menu--add-item (keymap map kd) 30 (cond ((or (eq '-- kd) (eq 'line kd)) `(geiser-menu--add-line ,map)) 31 ((stringp (car kd)) `(geiser-menu--add-basic-item ,keymap ,map ,kd)) 32 ((eq 'menu (car kd)) `(geiser-menu--add-submenu ,(cadr kd) 33 ,keymap ,map ,(cddr kd))) 34 ((eq 'custom (car kd)) `(geiser-menu--add-custom ,(nth 1 kd) 35 ,(nth 2 kd) 36 ,keymap 37 ,map)) 38 ((eq 'mode (car kd)) `(geiser-menu--mode-toggle ,(nth 1 kd) 39 ,(nth 2 kd) 40 ,(nth 3 kd) 41 ,keymap 42 ,map)) 43 (t (error "Bad item form: %s" kd)))) 44 45 (defmacro geiser-menu--add-basic-item (keymap map kd) 46 (let* ((title (nth 0 kd)) 47 (binding (nth 1 kd)) 48 (cmd (nth 2 kd)) 49 (hlp (nth 3 kd)) 50 (item (make-symbol title)) 51 (hlp (and (stringp hlp) (list :help hlp))) 52 (rest (or (and hlp (nthcdr 4 kd)) 53 (nthcdr 3 kd))) 54 (binding (if (listp binding) 55 binding 56 (list binding)))) 57 `(progn (define-key ,map [,item] 58 '(menu-item ,title ,cmd ,@hlp ,@rest)) 59 ,@(and (car binding) 60 `((put ',cmd 61 :advertised-binding 62 ,(car binding)))) 63 ,@(mapcar (lambda (b) 64 `(define-key ,keymap ,b ',cmd)) 65 binding)))) 66 67 (defmacro geiser-menu--add-items (keymap map keys) 68 `(progn ,@(mapcar (lambda (k) (list 'geiser-menu--add-item keymap map k)) 69 (reverse keys)))) 70 71 (defmacro geiser-menu--add-submenu (name keymap map keys) 72 (let ((ev (make-symbol name)) 73 (map2 (make-symbol "map2"))) 74 `(progn 75 (let ((,map2 (make-sparse-keymap ,name))) 76 (define-key ,map [,ev] (cons ,name ,map2)) 77 (geiser-menu--add-items ,keymap ,map2 ,keys))))) 78 79 (defvar geiser-menu--line-counter 0) 80 81 (defun geiser-menu--add-line (&optional map) 82 (let ((line (make-symbol (format "line%s" 83 (setq geiser-menu--line-counter 84 (1+ geiser-menu--line-counter)))))) 85 (define-key (or map global-map) `[,line] 86 `(menu-item "--single-line")))) 87 88 (defmacro geiser-menu--add-custom (title group keymap map) 89 `(geiser-menu--add-item ,keymap ,map 90 (,title nil (lambda () (interactive) (customize-group ',group))))) 91 92 (defmacro geiser-menu--mode-toggle (title bindings mode keymap map) 93 `(geiser-menu--add-item ,keymap ,map 94 (,title ,bindings ,mode 95 :button (:toggle . (and (boundp ',mode) ,mode))))) 96 97 (defmacro geiser-menu--defmenu (name keymap &rest keys) 98 (let ((mmap (make-symbol "mmap"))) 99 `(progn 100 (let ((,mmap (make-sparse-keymap "Geiser"))) 101 (define-key ,keymap [menu-bar ,name] (cons "Geiser" ,mmap)) 102 (define-key ,mmap [customize] 103 (cons "Customize" geiser-menu--custom-customize)) 104 (define-key ,mmap [switch] 105 (cons "Switch to" geiser-menu--custom-switch)) 106 (define-key ,mmap [Run] (cons "Run" geiser-menu--custom-run)) 107 (geiser-menu--add-line ,mmap) 108 (geiser-menu--add-items ,keymap ,mmap ,keys) 109 ,mmap)))) 110 111 (put 'geiser-menu--defmenu 'lisp-indent-function 2) 112 113 114 ;;; Shared entries 115 116 (defvar geiser-menu--custom-map (make-sparse-keymap "Geiser")) 117 (defvar geiser-menu--custom-run (make-sparse-keymap "Run")) 118 (defvar geiser-menu--custom-switch (make-sparse-keymap "Switch")) 119 (defvar geiser-menu--custom-customize (make-sparse-keymap "Customize")) 120 121 (define-key geiser-menu--custom-map [customize] 122 (cons "Customize" geiser-menu--custom-customize)) 123 (define-key geiser-menu--custom-map [switch] 124 (cons "Switch to" geiser-menu--custom-switch)) 125 (define-key geiser-menu--custom-map [run] 126 (cons "Run" geiser-menu--custom-run)) 127 128 (defun geiser-menu--add-global-custom (title group) 129 (define-key geiser-menu--custom-customize `[,(make-symbol title)] 130 (cons title `(lambda () (interactive) (customize-group ',group))))) 131 132 (defun geiser-menu--add-impl (name runner switcher) 133 (let ((title (capitalize (format "%s" name))) 134 (group (intern (format "geiser-%s" name)))) 135 (define-key geiser-menu--custom-run `[,name] 136 `(menu-item ,title ,runner :enable (geiser-impl--active-p ',name))) 137 (define-key geiser-menu--custom-switch `[,name] 138 `(menu-item ,title ,switcher :enable (geiser-repl--repl/impl ',name))) 139 (geiser-menu--add-global-custom title group))) 140 141 (geiser-menu--add-global-custom "Geiser" 'geiser) 142 143 144 145 (provide 'geiser-menu)