Better menus.

3 files changed, 72 insertions, 86 deletions

diff --git a/elisp/geiser-doc.el b/elisp/geiser-doc.el
index 33d2c1a..6bb4ba5 100644
--- a/elisp/geiser-doc.el
+++ b/elisp/geiser-doc.el
@@ -352,15 +352,16 @@ With prefix, the current page is deleted from history."
 
 (defun geiser-doc--visible-p () )
 
-(geiser-menu--defmenu geiser-doc-mode-map (eq major-mode 'geiser-doc-mode)
+(geiser-menu--defmenu doc geiser-doc-mode-map
   ("Next" "\C-c\C-f" geiser-doc-next "Next item"
    :enable (geiser-doc--history-next-p))
   ("Previous" "\C-c\C-b" geiser-doc-previous "Previous item"
    :enable (geiser-doc--history-previous-p))
   ("Refresh" "\C-c\C-r" geiser-doc-refresh "Refresh current page")
-  (menu "Manage history"
-        ("Kill item" "\C-c\C-k" geiser-doc-kill-page "Kill this page")
-        ("Clean history" "\C-c\C-c" geiser-doc-clean-history))
+  line
+  ("Kill item" "\C-c\C-k" geiser-doc-kill-page "Kill this page")
+  ("Clean history" "\C-c\C-c" geiser-doc-clean-history)
+  line
   (custom "Browser options" geiser-doc))
 
 (defun geiser-doc-mode ()
@@ -373,7 +374,6 @@ With prefix, the current page is deleted from history."
   (set-syntax-table scheme-mode-syntax-table)
   (setq mode-name "Geiser Doc")
   (setq major-mode 'geiser-doc-mode)
-  (geiser-menu--provide)
   (setq buffer-read-only t))
 
 (geiser-popup--define doc "*Geiser documentation*" geiser-doc-mode)
diff --git a/elisp/geiser-menu.el b/elisp/geiser-menu.el
index b279de2..b332005 100644
--- a/elisp/geiser-menu.el
+++ b/elisp/geiser-menu.el
@@ -22,30 +22,11 @@
    :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)
+(defmacro geiser-menu--add-items-1 (keymap map keys)
   `(progn ,@(mapcar (lambda (kd)
-                      (let* ((ev (if (listp ev) ev (list ev)))
-                             (title (nth 0 kd))
+                      (let* ((title (nth 0 kd))
                              (binding (nth 1 kd))
                              (cmd (nth 2 kd))
                              (hlp (nth 3 kd))
@@ -56,8 +37,7 @@
                              (binding (if (listp binding)
                                           binding
                                         (list binding))))
-                        `(progn (define-key global-map
-                                  [menu-bar geiser ,@ev ,item]
+                        `(progn (define-key ,map [,item]
                                   '(menu-item ,title ,cmd ,@hlp ,@rest))
                                 ,@(and binding
                                        `((put ',cmd
@@ -68,99 +48,104 @@
                                           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-items (keymap map keys)
+  `(geiser-menu--add-items-1 ,keymap ,map ,(reverse keys)))
 
-(defmacro geiser-menu--add-submenu (name keymap visible keys)
-  (let ((ev (make-symbol name)))
+(defmacro geiser-menu--add-submenu (name keymap map keys)
+  (let ((ev (make-symbol name))
+        (map2 (make-symbol "map2")))
     `(progn
-       (define-key global-map [menu-bar geiser ,ev]
-         (list 'menu-item ,name ,keymap :visible ',visible))
-       (geiser-menu--add-items-1 ,ev ,keymap ,keys))))
+       (let ((,map2 (make-sparse-keymap ,name)))
+         (define-key ,map [,ev] (cons ,name ,map2))
+         (geiser-menu--add-items-1 ,keymap ,map2 ,keys)))))
 
-(put 'geiser-menu--add-submenu 'lisp-indent-function 3)
+(put 'geiser-menu--add-submenu 'lisp-indent-function 1)
 (put 'geiser-menu--add-items 'lisp-indent-function 1)
 
 (defvar geiser-menu--line-counter 0)
 
-(defun geiser-menu--add-line ()
+(defun geiser-menu--add-line (&optional keymap)
   (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]
+    (define-key (or keymap global-map) `[,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--add-custom (title group keymap map)
+  `(geiser-menu--add-items ,keymap ,map
+     ((,title nil (lambda () (interactive) (customize-group ',group))))))
 
-(defmacro geiser-menu--mode-toggle (title bindings mode keymap visible)
-  `(geiser-menu--add-items ,keymap
-     ((,title ,bindings ,mode :button (:toggle . (and (boundp ',mode) ,mode))))
-     ,visible))
+(defmacro geiser-menu--mode-toggle (title bindings mode keymap map)
+  `(geiser-menu--add-items ,keymap ,map
+     ((,title ,bindings ,mode
+              :button (:toggle . (and (boundp ',mode) ,mode))))))
 
-(defmacro geiser-menu--defmenu (keymap visible &rest keys)
-  (let ((fs))
+(defmacro geiser-menu--defmenu (e keymap &rest keys)
+  (let* ((fs)
+         (name (format "Geiser %s" e))
+         (mmap (make-symbol "mmap")))
     (dolist (kd keys)
       (setq fs
-            (cons (cond ((eq 'line kd) '(geiser-menu--add-line))
+            (cons (cond ((eq 'line kd) `(geiser-menu--add-line ,mmap))
                         ((stringp (car kd))
-                         `(geiser-menu--add-items ,keymap
-                            ,(list kd) ,visible))
+                         `(geiser-menu--add-items ,keymap ,mmap ,(list kd)))
                         ((eq 'menu (car kd))
-                         `(geiser-menu--add-submenu ,(cadr kd) ,keymap
-                                                    ,visible ,(cddr kd)))
+                         `(geiser-menu--add-submenu ,(cadr kd)
+                            ,keymap ,mmap ,(cddr kd)))
                         ((eq 'custom (car kd))
                          `(geiser-menu--add-custom ,(nth 1 kd)
                                                    ,(nth 2 kd)
                                                    ,keymap
-                                                   ,visible))
+                                                   ,mmap))
                         ((eq 'mode (car kd))
                          `(geiser-menu--mode-toggle ,(nth 1 kd)
                                                     ,(nth 2 kd)
                                                     ,(nth 3 kd)
                                                     ,keymap
-                                                    ,visible))
+                                                    ,mmap))
                         (t (error "Bad form: %s" kd)))
                   fs)))
-    `(progn ,@fs)))
+    `(progn
+       (let ((,mmap (make-sparse-keymap ,name)))
+         (define-key ,keymap [menu-bar ,e] (cons ,name ,mmap))
+         (define-key ,mmap [customize]
+           (cons "Customize" geiser-menu--custom-customize))
+         (define-key ,mmap [switch]
+           (cons "Switch to" geiser-menu--custom-switch))
+         (define-key ,mmap [Run] (cons "Run" geiser-menu--custom-run))
+         (geiser-menu--add-line ,mmap)
+         ,@fs))))
 
 (put 'geiser-menu--defmenu 'lisp-indent-function 2)
 
 
-;;; Implementation support
+;;; Shared entries
+
+(defvar geiser-menu--custom-map (make-sparse-keymap "Geiser"))
+(defvar geiser-menu--custom-run (make-sparse-keymap "Run"))
+(defvar geiser-menu--custom-switch (make-sparse-keymap "Switch"))
+(defvar geiser-menu--custom-customize (make-sparse-keymap "Customize"))
 
-(define-key global-map [menu-bar geiser custom]
-  (cons "Customize" (make-sparse-keymap "Customize")))
+(define-key geiser-menu--custom-map [customize]
+  (cons "Customize" geiser-menu--custom-customize))
+(define-key geiser-menu--custom-map [switch]
+  (cons "Switch to" geiser-menu--custom-switch))
+(define-key geiser-menu--custom-map [run]
+  (cons "Run" geiser-menu--custom-run))
 
 (defun geiser-menu--add-global-custom (title group)
-  (define-key global-map `[menu-bar geiser custom ,(make-symbol title)]
+  (define-key geiser-menu--custom-customize `[,(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))
+    (define-key geiser-menu--custom-run `[,name] (cons title runner))
+    (define-key geiser-menu--custom-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)
diff --git a/elisp/geiser-repl.el b/elisp/geiser-repl.el
index c3ce86f..6fc820a 100644
--- a/elisp/geiser-repl.el
+++ b/elisp/geiser-repl.el
@@ -371,7 +371,6 @@ module command as a string")
   (setq geiser-autodoc--inhibit-function 'geiser-con--is-debugging)
   (geiser-company--setup geiser-repl-company-p)
   (setq geiser-smart-tab-mode-string "")
-  (geiser-menu--provide)
   ;; enabling compilation-shell-minor-mode without the annoying highlighter
   (compilation-setup t))
 
@@ -383,32 +382,34 @@ module command as a string")
 (define-key geiser-repl-mode-map "\C-a" 'geiser-repl--bol)
 (define-key geiser-repl-mode-map (kbd "<home>") 'geiser-repl--bol)
 
-(geiser-menu--defmenu geiser-repl-mode-map (eq major-mode 'geiser-repl-mode)
+(geiser-menu--defmenu repl geiser-repl-mode-map
   ("Complete symbol" ((kbd "TAB") (kbd "M-TAB"))
    geiser-completion--complete-symbol :enable (symbol-at-point))
   ("Complete module name" ((kbd "C-.") (kbd "M-`"))
    geiser-completion--complete-module :enable (symbol-at-point))
   ("Edit symbol" "\M-." geiser-edit--symbol-at-point
    :enable (symbol-at-point))
-  (menu "Navigation"
-        ("Previous matching input" "\M-p"
-         comint-previous-matching-input-from-input
-         "Previous input matching current")
-        ("Next matching input" "\M-n" comint-next-matching-input-from-input
-         "Next input matching current")
-        ("Previous input" "\C-c\M-p" comint-previous-input)
-        ("Next input" "\C-c\M-n" comint-next-input))
+  line
+  ("Previous matching input" "\M-p" comint-previous-matching-input-from-input
+   "Previous input matching current")
+  ("Next matching input" "\M-n" comint-next-matching-input-from-input
+   "Next input matching current")
+  ("Previous input" "\C-c\M-p" comint-previous-input)
+  ("Next input" "\C-c\M-n" comint-next-input)
+  line
   (mode "Autodoc mode" "\C-ca" geiser-autodoc-mode)
   ("Symbol documentation" "\C-cd" geiser-doc-symbol-at-point
    "Documentation for symbol at point" :enable (symbol-at-point))
   ("Module documentation" "\C-cm" geiser-repl--doc-module
    "Documentation for module at point" :enable (symbol-at-point))
   ("Load module" "\C-cl" geiser-load-file)
+  line
   ("Restart" ("\C-cz" "\C-c\C-z") switch-to-geiser
    :enable (not (geiser-repl--this-buffer-repl)))
   ("Revive REPL" ("\C-ck" "\C-c\C-k") geiser-repl-nuke
    "Use this command if the REPL becomes irresponsive"
    :enable (not (geiser-repl--this-buffer-repl)))
+  line
   (custom "REPL options" geiser-repl))