From 245e681f8ebd0f9304ae87815bf1d49a05241162 Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Sun, 15 Feb 2009 17:35:17 +0100 Subject: Initial support for module name completion. --- README | 2 + elisp/geiser-completion.el | 90 ++++++++++++++++------------------- elisp/geiser-repl.el | 2 + scheme/guile/geiser/emacs.scm | 3 +- scheme/guile/geiser/introspection.scm | 69 +++++++++++++++++++++++++-- 5 files changed, 113 insertions(+), 53 deletions(-) diff --git a/README b/README index ac23b60..b489e37 100644 --- a/README +++ b/README @@ -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 @@ -28,48 +28,6 @@ (require 'geiser-log) (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: @@ -166,17 +124,36 @@ terminates a current completion." (select-window window) (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)) + stringstring 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 -- cgit v1.2.3