diff options
| -rw-r--r-- | README | 2 | ||||
| -rw-r--r-- | elisp/geiser-completion.el | 90 | ||||
| -rw-r--r-- | elisp/geiser-repl.el | 2 | ||||
| -rw-r--r-- | scheme/guile/geiser/emacs.scm | 3 | ||||
| -rw-r--r-- | scheme/guile/geiser/introspection.scm | 69 |
5 files changed, 113 insertions, 53 deletions
@@ -20,6 +20,7 @@ | M-. | Edit symbol at point | | M-, | Go back to where M-. was last invoked | | M-TAB | Complete symbol at point | + | C-uM-TAB | Complete module name at point | |---------------+-------------------------------------------------| | C-M-x, C-cC-e | Eval definition around point | | C-cMe | Eval definition around point and switch to REPL | @@ -41,6 +42,7 @@ |--------------+-----------------------------------------| | M-. | Edit symbol at point | | TAB | Complete symbol at point | + | M-TAB | Complete module name at point | |--------------+-----------------------------------------| | M-p, M-n | Prompt history, matching current prefix | |--------------+-----------------------------------------| diff --git a/elisp/geiser-completion.el b/elisp/geiser-completion.el index 3a36187..2f1aa36 100644 --- a/elisp/geiser-completion.el +++ b/elisp/geiser-completion.el @@ -29,48 +29,6 @@ (require 'geiser-base) -;;; Minibuffer map: - -(defvar geiser-completion--minibuffer-map - (let ((map (make-keymap))) - (set-keymap-parent map minibuffer-local-completion-map) - (define-key map "?" 'self-insert-command) - map)) - - -;;; Modules dictionary: - -;; (defvar geiser-completion--modules nil) - -;; (defun geiser-completion--modules (&optional reload) -;; (when (or reload (not geiser-completion--modules)) -;; (geiser--respecting-message "Retrieving modules list") -;; (let ((geiser-log--inhibit-p t)) -;; (setq geiser-completion--modules -;; (geiser-eval--retort-result -;; (geiser-eval--send/wait '(:gs (:ge (module-list :t))))))) -;; geiser-completion--modules) - -;; (defun geiser-completion--read-module (&optional reload init-input history) -;; (let ((minibuffer-local-completion-map geiser-completion--minibuffer-map) -;; (modules (geiser-completion--modules reload))) -;; (completing-read "Module name: " modules nil nil init-input history))) - -;; (defsubst geiser-completion--module-list (prefix) -;; (geiser-eval--retort-result -;; (geiser-eval--send/wait `(:gs (:ge (module-list ,prefix)))))) - -;; (defvar geiser-completion--module-history nil) - -;; (defun geiser-completion--read-module (refresh) -;; (let ((minibuffer-local-completion-map geiser-completion--minibuffer-map) -;; (modules (geiser-completion--modules refresh)) -;; (prompt "Module name: ")) -;; (if modules -;; (completing-read prompt modules nil nil nil geiser-completion--module-history) -;; (read-string prompt nil geiser-completion--module-history)))) - - ;;; Completions window handling, heavily inspired in slime's: (defvar geiser-completion--comp-buffer "*Completions*") @@ -167,16 +125,35 @@ terminates a current completion." (scroll-up)))))) +;;; Minibuffer maps: + +(defvar geiser-completion--minibuffer-map + (let ((map (make-keymap))) + (set-keymap-parent map minibuffer-local-completion-map) + (define-key map "?" 'self-insert-command) + map)) + +(defvar geiser-completion--module-minibuffer-map + (let ((map (make-keymap))) + (set-keymap-parent map minibuffer-local-completion-map) + (define-key map " " 'self-insert-command) + (define-key map "?" 'self-insert-command) + map)) + + ;;; Completion functionality: (defsubst geiser-completion--symbol-list (prefix) (geiser-eval--send/result `(:gs ((:ge completions) ,prefix)))) +(defsubst geiser-completion--module-list () + (geiser-eval--send/result '(:gs ((:ge all-modules))))) + (defvar geiser-completion--symbol-list-func (completion-table-dynamic 'geiser-completion--symbol-list)) (defun geiser-completion--complete (prefix modules) - (let* ((symbols (if modules nil ;; (geiser-completion--modules) + (let* ((symbols (if modules (geiser-completion--module-list) (geiser-completion--symbol-list prefix))) (completions (all-completions prefix symbols)) (partial (try-completion prefix symbols)) @@ -193,6 +170,16 @@ terminates a current completion." (or history geiser-completion--symbol-history) (or default (symbol-at-point))))) +(defvar geiser-completion--module-history nil) + +(defun geiser-completion--read-module () + (let ((minibuffer-local-completion-map geiser-completion--module-minibuffer-map) + (modules (geiser-completion--module-list)) + (prompt "Module name: ")) + (if modules + (completing-read prompt modules nil nil nil geiser-completion--module-history) + (read-string prompt nil geiser-completion--module-history)))) + (defun geiser--respecting-message (format &rest format-args) "Display TEXT as a message, without hiding any minibuffer contents." (let ((text (format " [%s]" (apply #'format format format-args)))) @@ -200,14 +187,21 @@ terminates a current completion." (minibuffer-message text) (message "%s" text)))) -(defun geiser-completion--complete-symbol () +(defsubst geiser-completion--beg-pos (module) + (if module + (max (save-excursion (beginning-of-line) (point)) + (save-excursion (skip-syntax-backward "^(") (1- (point)))) + (save-excursion (skip-syntax-backward "^-()") (point)))) + +(defun geiser-completion--complete-symbol (&optional arg) "Complete the symbol at point. -Perform completion similar to Emacs' complete-symbol." - (interactive) +Perform completion similar to Emacs' complete-symbol. +With prefix, complete module name." + (interactive "P") (let* ((end (point)) - (beg (save-excursion (skip-syntax-backward "^-()") (point))) + (beg (geiser-completion--beg-pos arg)) (prefix (buffer-substring-no-properties beg end)) - (result (geiser-completion--complete prefix nil)) + (result (geiser-completion--complete prefix arg)) (completions (car result)) (partial (cdr result))) (cond ((null completions) diff --git a/elisp/geiser-repl.el b/elisp/geiser-repl.el index 508525a..e9a0eb0 100644 --- a/elisp/geiser-repl.el +++ b/elisp/geiser-repl.el @@ -156,6 +156,8 @@ REPL buffer." (define-key geiser-repl-mode-map "\C-c\M-n" 'comint-next-input) (define-key geiser-repl-mode-map (kbd "TAB") 'geiser-completion--complete-symbol) +(define-key geiser-repl-mode-map (kbd "M-TAB") + '(lambda () (interactive) (geiser-completion--complete-symbol t))) (define-key geiser-repl-mode-map "\M-." 'geiser-edit-symbol-at-point) (define-key geiser-repl-mode-map "\M-," 'geiser-edit-pop-edit-symbol-stack) diff --git a/scheme/guile/geiser/emacs.scm b/scheme/guile/geiser/emacs.scm index 1458c73..3f2116a 100644 --- a/scheme/guile/geiser/emacs.scm +++ b/scheme/guile/geiser/emacs.scm @@ -30,7 +30,8 @@ ge:symbol-location ge:compile-file ge:load-file - ge:docstring) + ge:docstring + ge:all-modules) #:use-module ((geiser introspection) :renamer (symbol-prefix-proc 'ge:)) #:use-module ((geiser eval) diff --git a/scheme/guile/geiser/introspection.scm b/scheme/guile/geiser/introspection.scm index 19ea2df..110ab01 100644 --- a/scheme/guile/geiser/introspection.scm +++ b/scheme/guile/geiser/introspection.scm @@ -25,7 +25,12 @@ ;;; Code: (define-module (geiser introspection) - #:export (arguments completions symbol-location docstring) + #:export (arguments + completions + symbol-location + docstring + all-modules + module-children) #:use-module (system vm program) #:use-module (ice-9 session) #:use-module (ice-9 documentation) @@ -140,13 +145,69 @@ (display signature) (newline) (display type) - (if modname (begin (display " in module ") - (display modname))) + (if modname + (begin + (display " in module ") + (display modname))) (newline) - (if doc (begin (display doc))))))) + (if doc (display doc)))))) (define (docstring sym) (with-output-to-string (lambda () (display-docstring sym)))) +(define (all-modules) + (let ((roots ((@@ (ice-9 session) root-modules)))) + (sort! (map (lambda (m) + (format "~A" (module-name m))) + (fold (lambda (m all) + (append (all-child-modules m) all)) + roots + roots)) + string<?))) + +(define (child-modules mod) + (delq mod ((@@ (ice-9 session) submodules) mod))) + +(define (all-child-modules mod) + (let ((children (child-modules mod))) + (fold (lambda (m all) + (append (all-child-modules m) all)) + children children))) + +(define (module-children mod-name) + (let* ((elts (hash-fold classify-module-object + (list '() '() '()) + (module-obarray (maybe-module-interface mod-name)))) + (elts (map sort-symbols! elts))) + (list (cons 'modules (map (lambda (m) `(,@mod-name ,m)) (car elts))) + (cons 'procs (cadr elts)) + (cons 'vars (caddr elts))))) + +(define (sort-symbols! syms) + (let ((cmp (lambda (l r) + (string<? (symbol->string l) (symbol->string r))))) + (sort! syms cmp))) + +(define (maybe-module-interface mod-name) + (catch #t + (lambda () (resolve-interface mod-name)) + (lambda args (resolve-module mod-name)))) + +(define (classify-module-object name var elts) + (let ((obj (and (variable-bound? var) + (variable-ref var)))) + (cond ((not obj) elts) + ((and (module? obj) (eq? (module-kind obj) 'directory)) + (list (cons name (car elts)) + (cadr elts) + (caddr elts))) + ((or (procedure? obj) (program? obj) (macro? obj)) + (list (car elts) + (cons name (cadr elts)) + (caddr elts))) + (else (list (car elts) + (cadr elts) + (cons name (caddr elts))))))) + ;;; introspection.scm ends here |