diff options
Diffstat (limited to 'elisp')
| -rw-r--r-- | elisp/geiser-doc.el | 10 | ||||
| -rw-r--r-- | elisp/geiser-menu.el | 127 | ||||
| -rw-r--r-- | elisp/geiser-repl.el | 21 | 
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)) | 
