summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJose Antonio Ortega Ruiz <jao@gnu.org>2010-06-14 04:17:54 +0200
committerJose Antonio Ortega Ruiz <jao@gnu.org>2010-06-14 04:17:54 +0200
commitd92baad9f8e9f205ca1dc642e7f763ddbcfec43b (patch)
tree49e4345c2abb4e92e4f78797817bbdef598406c1
parent61a0065711cde95ed7a20f183e871b4628a415b4 (diff)
downloadgeiser-chez-d92baad9f8e9f205ca1dc642e7f763ddbcfec43b.tar.gz
geiser-chez-d92baad9f8e9f205ca1dc642e7f763ddbcfec43b.tar.bz2
Better menus.
-rw-r--r--elisp/geiser-doc.el10
-rw-r--r--elisp/geiser-menu.el127
-rw-r--r--elisp/geiser-repl.el21
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))