diff options
| -rw-r--r-- | elisp/geiser-autodoc.el | 14 | ||||
| -rw-r--r-- | elisp/geiser-doc.el | 16 | ||||
| -rw-r--r-- | elisp/geiser-edit.el | 10 | ||||
| -rw-r--r-- | elisp/geiser-syntax.el | 9 | ||||
| -rw-r--r-- | elisp/geiser-xref.el | 16 | ||||
| -rw-r--r-- | scheme/guile/geiser/doc.scm | 29 | ||||
| -rw-r--r-- | scheme/guile/geiser/utils.scm | 4 | ||||
| -rw-r--r-- | scheme/guile/geiser/xref.scm | 8 | ||||
| -rw-r--r-- | scheme/racket/geiser/autodoc.rkt | 36 | ||||
| -rw-r--r-- | scheme/racket/geiser/locations.rkt | 6 |
10 files changed, 75 insertions, 73 deletions
diff --git a/elisp/geiser-autodoc.el b/elisp/geiser-autodoc.el index 7c61b33..8222e0b 100644 --- a/elisp/geiser-autodoc.el +++ b/elisp/geiser-autodoc.el @@ -59,7 +59,7 @@ when `geiser-autodoc-display-module-p' is on." (defun geiser-autodoc--get-signatures (funs &optional keep-cached) (when funs - (let ((fs (assq (car funs) geiser-autodoc--cached-signatures))) + (let ((fs (assoc (car funs) geiser-autodoc--cached-signatures))) (unless fs (let ((missing) (cached)) (if (not geiser-autodoc--cached-signatures) @@ -127,11 +127,11 @@ when `geiser-autodoc-display-module-p' is on." (defun geiser-autodoc--insert-args (args pos prev) (let ((cpos 1) - (reqs (cdr (assoc 'required args))) + (reqs (cdr (assoc "required" args))) (opts (mapcar (lambda (a) (if (and (symbolp a) (not (eq a '...))) (list a) a)) - (cdr (assoc 'optional args)))) - (keys (cdr (assoc 'key args)))) + (cdr (assoc "optional" args)))) + (keys (cdr (assoc "key" args)))) (setq cpos (geiser-autodoc--insert-arg-group reqs cpos @@ -155,10 +155,10 @@ when `geiser-autodoc-display-module-p' is on." (defun geiser-autodoc--str (desc signature) (let ((proc (car desc)) - (args (cdr (assoc 'args signature))) - (module (cdr (assoc 'module signature)))) + (args (cdr (assoc "args" signature))) + (module (cdr (assoc "module" signature)))) (if (not args) - (geiser-autodoc--value-str proc module (cdr (assoc 'value signature))) + (geiser-autodoc--value-str proc module (cdr (assoc "value" signature))) (save-current-buffer (set-buffer (geiser-syntax--font-lock-buffer)) (erase-buffer) diff --git a/elisp/geiser-doc.el b/elisp/geiser-doc.el index e975484..9182bab 100644 --- a/elisp/geiser-doc.el +++ b/elisp/geiser-doc.el @@ -236,8 +236,8 @@ help (e.g. browse an HTML page) implementing this method.") (newline) (dolist (w lst) (let ((name (car w)) - (signature (cdr (assoc 'signature w))) - (info (cdr (assoc 'info w)))) + (signature (cdr (assoc "signature" w))) + (info (cdr (assoc "info" w)))) (insert "\t- ") (if module (geiser-doc--insert-button name module impl signature) @@ -294,9 +294,9 @@ help (e.g. browse an HTML page) implementing this method.") (geiser-doc--with-buffer (erase-buffer) (geiser-doc--insert-title - (geiser-autodoc--str* (cdr (assoc 'signature ds)))) + (geiser-autodoc--str* (cdr (assoc "signature" ds)))) (newline) - (insert (or (cdr (assoc 'docstring ds)) "")) + (insert (or (cdr (assoc "docstring" ds)) "")) (geiser-doc--buttonize-modules impl) (setq geiser-doc--buffer-link (geiser-doc--history-push (geiser-doc--make-link symbol @@ -327,10 +327,10 @@ With prefix argument, ask for the lookup symbol (with completion)." symbol (geiser-eval--get-module)))) -(defconst geiser-doc--sections '(("Procedures:" procs) - ("Syntax:" syntax) - ("Variables:" vars) - ("Submodules:" modules t))) +(defconst geiser-doc--sections '(("Procedures:" "procs") + ("Syntax:" "syntax") + ("Variables:" "vars") + ("Submodules:" "modules" t))) (defconst geiser-doc--sections-re (format "^%s\n" (regexp-opt (mapcar 'car geiser-doc--sections)))) diff --git a/elisp/geiser-edit.el b/elisp/geiser-edit.el index 8fa979f..0fd3b89 100644 --- a/elisp/geiser-edit.el +++ b/elisp/geiser-edit.el @@ -47,23 +47,23 @@ or following links in error buffers.") (t (find-file file)))) (defsubst geiser-edit--location-name (loc) - (cdr (assoc 'name loc))) + (cdr (assoc "name" loc))) (defsubst geiser-edit--location-file (loc) - (cdr (assoc 'file loc))) + (cdr (assoc "file" loc))) (defsubst geiser-edit--to-number (x) (cond ((numberp x) x) ((stringp x) (string-to-number x)))) (defsubst geiser-edit--location-line (loc) - (geiser-edit--to-number (cdr (assoc 'line loc)))) + (geiser-edit--to-number (cdr (assoc "line" loc)))) (defsubst geiser-edit--location-column (loc) - (geiser-edit--to-number (cdr (assoc 'column loc)))) + (geiser-edit--to-number (cdr (assoc "column" loc)))) (defsubst geiser-edit--make-location (name file line column) - `((name . ,name) (file . ,file) (line . ,line) (column . ,column))) + `(("name" . ,name) ("file" . ,file) ("line" . ,line) ("column" . ,column))) (defconst geiser-edit--def-re (regexp-opt '("define" diff --git a/elisp/geiser-syntax.el b/elisp/geiser-syntax.el index ae1c3dd..17e0999 100644 --- a/elisp/geiser-syntax.el +++ b/elisp/geiser-syntax.el @@ -122,6 +122,11 @@ implementation-specific entries for font-lock-keywords.") (defsubst geiser-syntax--read/elisp () (ignore-errors (read (current-buffer)))) +(defun geiser-syntax--read/symbol () + (with-syntax-table scheme-mode-syntax-table + (when (re-search-forward "\\(\\sw\\|\\s_\\)+" nil t) + (make-symbol (match-string 0))))) + (defun geiser-syntax--read/matching (open close) (let ((count 1) (p (1+ (point)))) @@ -160,7 +165,7 @@ implementation-specific entries for font-lock-keywords.") (?\( (geiser-syntax--read/token 'vectorb)) (?\< (geiser-syntax--read/unprintable)) ((?' ?` ?,) (geiser-syntax--read/next-token)) - (t (let ((tok (geiser-syntax--read/elisp))) + (t (let ((tok (geiser-syntax--read/symbol))) (if tok (cons 'atom (intern (format "#%s" tok))) (geiser-syntax--read/next-token)))))) (?\' (geiser-syntax--read/token '(quote . quote))) @@ -171,7 +176,7 @@ implementation-specific entries for font-lock-keywords.") `(splice . ,backquote-splice-symbol)) `(unquote . ,backquote-unquote-symbol))) (?\" (cons 'string (geiser-syntax--read/elisp))) - (t (cons 'atom (geiser-syntax--read/elisp)))))) + (t (cons 'atom (geiser-syntax--read/symbol)))))) (defsubst geiser-syntax--read/match (&rest tks) (let ((token (geiser-syntax--read/next-token))) diff --git a/elisp/geiser-xref.el b/elisp/geiser-xref.el index 661c625..d8b46d0 100644 --- a/elisp/geiser-xref.el +++ b/elisp/geiser-xref.el @@ -54,12 +54,12 @@ geiser-xref-follow-link-method)))) (defun geiser-xref--insert-button (xref) - (let* ((location (cdr (assoc 'location xref))) + (let* ((location (cdr (assoc "location" xref))) (file (geiser-edit--location-file location)) - (signature (cdr (assoc 'signature xref))) + (signature (cdr (assoc "signature" xref))) (signature-txt (and signature (geiser-autodoc--str* signature))) - (module (cdr (assoc 'module xref))) + (module (cdr (assoc "module" xref))) (p (point))) (when signature (insert " - ") @@ -76,11 +76,11 @@ (newline)))) (defun geiser-xref--module< (xr1 xr2) - (let ((m1 (cdr (assoc 'module xr1))) - (m2 (cdr (assoc 'module xr2)))) + (let ((m1 (cdr (assoc "module" xr1))) + (m2 (cdr (assoc "module" xr2)))) (cond ((equal m1 m2) - (string< (format "%s" (cdr (assoc 'signature xr1))) - (format "%s" (cdr (assoc 'signature xr2))))) + (string< (format "%s" (cdr (assoc "signature" xr1))) + (format "%s" (cdr (assoc "signature" xr2))))) ((null m1) (not m2)) ((null m2)) (t (string< (format "%s" m1) (format "%s" m2)))))) @@ -92,7 +92,7 @@ (newline) (let ((last-module)) (dolist (xref (sort xrefs 'geiser-xref--module<)) - (let ((module (cdr (assoc 'module xref)))) + (let ((module (cdr (assoc "module" xref)))) (when (not (equal module last-module)) (insert "\n In module ") (geiser--insert-with-face (format "%s" module) diff --git a/scheme/guile/geiser/doc.scm b/scheme/guile/geiser/doc.scm index 640f4ad..ebb8e1d 100644 --- a/scheme/guile/geiser/doc.scm +++ b/scheme/guile/geiser/doc.scm @@ -33,7 +33,7 @@ (let ((args (obj-args (symbol->object id)))) (and args `(,@(signature id args) - (module . ,(symbol-module id)))))) + ("module" . ,(symbol-module id)))))) (define (object-signature name obj) (let ((args (obj-args obj))) @@ -49,15 +49,14 @@ ((list? args) args) (else (list args))))) (define (mkargs as) - `((required ,@(arglst as 'required)) - (optional ,@(arglst as 'optional) - ,@(let ((rest (assq-ref as 'rest))) - (if rest (list "...") '()))) - (key ,@(arglst as 'keyword)))) + `(("required" ,@(arglst as 'required)) + ("optional" ,@(arglst as 'optional) + ,@(if (assq-ref as 'rest) (list "...") '())) + ("key" ,@(arglst as 'keyword)))) (let* ((args-list (map mkargs (if (list? args-list) args-list '()))) (value (and (and detail (null? args-list)) (value-str (symbol->object id))))) - `(,id (args ,@args-list) ,@(if value `((value . ,value)) '())))) + `(,id ("args" ,@args-list) ,@(if value `(("value" . ,value)) '())))) (define default-macro-args '(((required ...)))) @@ -186,8 +185,8 @@ (define (symbol-documentation sym) (let ((obj (symbol->object sym))) (if obj - `((signature . ,(or (obj-signature sym obj #f) sym)) - (docstring . ,(docstring sym obj)))))) + `(("signature" . ,(or (obj-signature sym obj #f) sym)) + ("docstring" . ,(docstring sym obj)))))) (define (docstring sym obj) (define (valuable?) @@ -229,23 +228,23 @@ (elts (map elt-sort elts)) (subs (map (lambda (m) (list (module-name m))) (submodules (resolve-module mod-name #f))))) - (list (cons 'modules subs) - (cons 'procs (car elts)) - (cons 'syntax (cadr elts)) - (cons 'vars (caddr elts))))) + (list (cons "modules" subs) + (cons "procs" (car elts)) + (cons "syntax" (cadr elts)) + (cons "vars" (caddr elts))))) (define (classify-module-object name var elts) (let ((obj (and (variable-bound? var) (variable-ref var)))) (cond ((or (not obj) (module? obj)) elts) ((or (procedure? obj) (program? obj)) - (list (cons (list name `(signature . ,(obj-signature name obj))) + (list (cons (list name `("signature" . ,(obj-signature name obj))) (car elts)) (cadr elts) (caddr elts))) ((macro? obj) (list (car elts) - (cons (list name `(signature . ,(obj-signature name obj))) + (cons (list name `("signature" . ,(obj-signature name obj))) (cadr elts)) (caddr elts))) (else (list (car elts) diff --git a/scheme/guile/geiser/utils.scm b/scheme/guile/geiser/utils.scm index 632fe76..654cae8 100644 --- a/scheme/guile/geiser/utils.scm +++ b/scheme/guile/geiser/utils.scm @@ -30,8 +30,8 @@ (else (loop (cdr d) (cons (car d) s)))))) (define (make-location file line) - (list (cons 'file (if (string? file) file '())) - (cons 'line (if (number? line) (+ 1 line) '())))) + (list (cons "file" (if (string? file) file '())) + (cons "line" (if (number? line) (+ 1 line) '())))) (define (sort-symbols! syms) (let ((cmp (lambda (l r) diff --git a/scheme/guile/geiser/xref.scm b/scheme/guile/geiser/xref.scm index 7dfa8af..ba509e7 100644 --- a/scheme/guile/geiser/xref.scm +++ b/scheme/guile/geiser/xref.scm @@ -40,9 +40,9 @@ (define (make-xref proc name module) (and proc - `((location . ,(or (program-location proc) (symbol-location name))) - (signature . ,(object-signature name proc)) - (module . ,(or module '()))))) + `(("location" . ,(or (program-location proc) (symbol-location name))) + ("signature" . ,(object-signature name proc)) + ("module" . ,(or module '()))))) (define (program-location p) (cond ((not (program? p)) #f) @@ -82,5 +82,3 @@ (if (null? dirs) #f (let ((candidate (string-append (car dirs) "/" path))) (if (file-exists? candidate) candidate (loop (cdr dirs))))))) - -;;; xref.scm ends here diff --git a/scheme/racket/geiser/autodoc.rkt b/scheme/racket/geiser/autodoc.rkt index dea8f43..6e73271 100644 --- a/scheme/racket/geiser/autodoc.rkt +++ b/scheme/racket/geiser/autodoc.rkt @@ -40,11 +40,11 @@ (let* ([val (value sym (symbol-module sym))] [sign (autodoc* sym)]) (and sign - (list (cons 'signature (autodoc* sym #f)) - (cons 'docstring (docstring sym val sign)))))) + (list (cons "signature" (autodoc* sym #f)) + (cons "docstring" (docstring sym val sign)))))) (define (docstring sym val sign) - (let* ([mod (assoc 'module (cdr sign))] + (let* ([mod (assoc "module" (cdr sign))] [mod (if mod (cdr mod) "<unknown>")] [id (namespace-symbol->identifier sym)] [desc (if (identifier? id) (format "~%~%~a" (describe id sym)) "")]) @@ -118,26 +118,26 @@ [path (cdr loc)] [sgns (and path (find-signatures path name id))] [value (if (and extra sgns (not (list? sgns))) - (list (cons 'value (val))) + (list (cons "value" (val))) '())] [mod (if (and extra sgns path) - (list (cons 'module + (list (cons "module" (module-path-name->name path))) '())]) (and sgns `(,id - (name . ,name) - (args ,@(if (list? sgns) (map format-signature sgns) '())) + ("name" . ,name) + ("args" ,@(if (list? sgns) (map format-signature sgns) '())) ,@value ,@mod))))) (define (format-signature sign) (if (signature? sign) - `((required ,@(signature-required sign)) - (optional ,@(signature-optional sign) - ,@(let ((rest (signature-rest sign))) - (if rest (list "...") '()))) - (key ,@(signature-keys sign))) + `(("required" ,@(signature-required sign)) + ("optional" ,@(signature-optional sign) + ,@(let ((rest (signature-rest sign))) + (if rest (list "...") '()))) + ("key" ,@(signature-keys sign))) '())) (define signatures (make-hash)) @@ -281,21 +281,21 @@ (define (contracted id) (let ([v (value id mod)]) (if (has-contract? v) - (list id (cons 'info (contract-name (value-contract v)))) + (list id (cons "info" (contract-name (value-contract v)))) (entry id)))) (define (entry id) (let ((sign (eval `(,autodoc* ',id #f) (module-spec->namespace mod #f #f)))) - (if sign (list id (cons 'signature sign)) (list id)))) + (if sign (list id (cons "signature" sign)) (list id)))) (define (classify-ids ids) (let loop ([ids ids] [procs '()] [vars '()]) (cond [(null? ids) - `((procs ,@(map entry (reverse procs))) - (vars ,@(map list (reverse vars))))] + `(("procs" ,@(map entry (reverse procs))) + ("vars" ,@(map list (reverse vars))))] [(procedure? (value (car ids) mod)) (loop (cdr ids) (cons (car ids) procs) vars)] [else (loop (cdr ids) procs (cons (car ids) vars))]))) (let-values ([(ids syn) (module-identifiers mod)]) `(,@(classify-ids ids) - (syntax ,@(map contracted syn)) - (modules ,@(map list (or (submodules mod) '())))))) + ("syntax" ,@(map contracted syn)) + ("modules" ,@(map list (or (submodules mod) '())))))) diff --git a/scheme/racket/geiser/locations.rkt b/scheme/racket/geiser/locations.rkt index 4715b8f..1ed4534 100644 --- a/scheme/racket/geiser/locations.rkt +++ b/scheme/racket/geiser/locations.rkt @@ -30,9 +30,9 @@ (cons sym #f)))) (define (make-location name path line) - (list (cons 'name name) - (cons 'file (if (path? path) (path->string path) '())) - (cons 'line (or line '())))) + (list (cons "name" name) + (cons "file" (if (path? path) (path->string path) '())) + (cons "line" (or line '())))) (define (symbol-location sym) (let* ([loc (symbol-location* sym)] |