summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--elisp/geiser-autodoc.el14
-rw-r--r--elisp/geiser-doc.el16
-rw-r--r--elisp/geiser-edit.el10
-rw-r--r--elisp/geiser-syntax.el9
-rw-r--r--elisp/geiser-xref.el16
-rw-r--r--scheme/guile/geiser/doc.scm29
-rw-r--r--scheme/guile/geiser/utils.scm4
-rw-r--r--scheme/guile/geiser/xref.scm8
-rw-r--r--scheme/racket/geiser/autodoc.rkt36
-rw-r--r--scheme/racket/geiser/locations.rkt6
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)]
generated by cgit v1.2.3 (git 2.39.1) at 2024-06-29 18:28:11 +0000