From 040fd88d1e58e7aff82b1d3a380f3034b5e3475e Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Mon, 14 Jun 2010 04:17:54 +0200 Subject: Better menus. --- elisp/geiser-doc.el | 10 ++-- elisp/geiser-menu.el | 127 +++++++++++++++++++++++---------------------------- elisp/geiser-repl.el | 21 +++++---- 3 files changed, 72 insertions(+), 86 deletions(-) (limited to 'elisp') 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 @@ -21,31 +21,12 @@ :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) +(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 "") '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)) -- cgit v1.2.3