diff options
| -rw-r--r-- | elisp/geiser-chicken.el | 19 | ||||
| -rw-r--r-- | scheme/chicken/geiser/emacs.scm | 33 |
2 files changed, 34 insertions, 18 deletions
diff --git a/elisp/geiser-chicken.el b/elisp/geiser-chicken.el index 12ca006..8c10908 100644 --- a/elisp/geiser-chicken.el +++ b/elisp/geiser-chicken.el @@ -104,6 +104,11 @@ this variable to t." :type 'boolean :group 'geiser-chicken) +(geiser-custom--defcustom geiser-chicken-match-limit 20 + "The limit on the number of matching symbols that Chicken will provide to Geiser." + :type 'integer + :group 'geiser-chicken) + (defvar geiser-chicken--required-modules (list "chicken-doc" "apropos" "data-structures" "extras" "ports" "posix" "srfi-1" "srfi-13" "srfi-14" "srfi-18" "srfi-69" "tcp" "utils")) @@ -277,17 +282,19 @@ This function uses `geiser-chicken-init-file' if it exists." (suppression-prefix "(define geiser-stdout (current-output-port))(current-output-port (make-output-port (lambda a #f) (lambda a #f)))") (suppression-postfix - "(current-output-port geiser-stdout)")) + "(current-output-port geiser-stdout)") + (match-limit-set + (format "(geiser-chicken-symbol-match-limit %s)" geiser-chicken-match-limit))) (let ((load-sequence (cond (force-load - (format "(load \"%s\")\n(import geiser)\n" source)) + (format "(load \"%s\")\n(import geiser)%s\n" source match-limit-set)) ((file-exists-p target) - (format "%s(load \"%s\")(import geiser)%s\n" - suppression-prefix target suppression-postfix)) + (format "%s(load \"%s\")(import geiser)%s%s\n" + suppression-prefix target match-limit-set suppression-postfix)) (t - (format "%s(use utils)(compile-file \"%s\" options: '(\"-O3\" \"-s\") output-file: \"%s\" load: #t)(import geiser)%s\n" - suppression-prefix source target suppression-postfix))))) + (format "%s(use utils)(compile-file \"%s\" options: '(\"-O3\" \"-s\") output-file: \"%s\" load: #t)(import geiser)%s%s\n" + suppression-prefix source target match-limit-set suppression-postfix))))) (geiser-eval--send/wait load-sequence)))) (defun geiser-chicken--startup (remote) diff --git a/scheme/chicken/geiser/emacs.scm b/scheme/chicken/geiser/emacs.scm index 6b7124f..d31d801 100644 --- a/scheme/chicken/geiser/emacs.scm +++ b/scheme/chicken/geiser/emacs.scm @@ -27,8 +27,9 @@ geiser-module-location geiser-module-completions geiser-macroexpand - geiser-use-debug-log - geiser-load-paths) + geiser-chicken-use-debug-log + geiser-chicken-load-paths + geiser-chicken-symbol-match-limit) (import chicken scheme) (use @@ -51,6 +52,9 @@ ;; Symbol lists ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (define geiser-chicken-symbol-match-limit + (make-parameter 20)) + (define geiser-r4rs-symbols (make-parameter '(not boolean? eq? eqv? equal? pair? cons car cdr caar cadr cdar cddr @@ -213,7 +217,7 @@ ;; Utilities ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - (define geiser-use-debug-log (make-parameter #f)) + (define geiser-chicken-use-debug-log (make-parameter #f)) (define find-module ##sys#find-module) (define current-module ##sys#current-module) @@ -245,13 +249,18 @@ (apropos-information-list "" #:macros? #t))))) (define (find-symbol-information prefix) + (define (filter/limit pred? limit lst) + (cond + ((<= limit 0) '()) + ((or (null? lst) (not (list? lst))) '()) + ((pred? (car lst)) (cons (car lst) (filter/limit pred? (- limit 1) (cdr lst)))) + (else (filter/limit pred? limit (cdr lst))))) (define (find-symbol-information* prefix skipped) - (let ((found (filter + (let ((found (filter/limit (lambda (info) (string-has-prefix? (car info) prefix)) - (symbol-information-list)))) - ;; (if (and (null? found) (< 1 (string-length prefix))) - ;; (find-symbol-information* (substring/shared prefix 1) (string-append skipped (substring prefix 0 1)))) + (geiser-chicken-symbol-match-limit) + (symbol-information-list)))) (cons found skipped))) (memoize `(find-symbol-information ,prefix) @@ -260,7 +269,7 @@ (define debug-log (make-parameter #f)) (define (write-to-log form) - (when (geiser-use-debug-log) + (when (geiser-chicken-use-debug-log) (when (not (debug-log)) (debug-log (file-open "geiser.log" (+ open/wronly open/append open/text open/creat))) (set-file-position! (debug-log) 0 seek/end)) @@ -508,7 +517,7 @@ geiser-autodoc geiser-object-signature geiser-symbol-location geiser-symbol-documentation geiser-module-exports geiser-module-path geiser-module-location - geiser-module-completions geiser-use-debug-log))) + geiser-module-completions geiser-chicken-use-debug-log))) (define (form-has-any-geiser? form) (string-has-prefix? (->string (car form)) "geiser-")) @@ -637,11 +646,11 @@ ;; File and Buffer Operations ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - (define geiser-load-paths (make-parameter '("" "."))) + (define geiser-chicken-load-paths (make-parameter '("" "."))) (define (geiser-find-file file . rest) (when file - (let ((paths (geiser-load-paths))) + (let ((paths (geiser-chicken-load-paths))) (define (try-find file paths) (cond ((null? paths) #f) @@ -660,7 +669,7 @@ (call-with-result #f (lambda () (when (directory-exists? directory) - (geiser-load-paths (cons directory (geiser-load-paths)))))))) + (geiser-chicken-load-paths (cons directory (geiser-chicken-load-paths)))))))) (define (geiser-compile-file file . rest) (let* ((file (if (symbol? file) (symbol->string file) file)) |