[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[nongnu] elpa/geiser-chez 52fbf028e5 04/15: fixes for the above in the f
From: |
ELPA Syncer |
Subject: |
[nongnu] elpa/geiser-chez 52fbf028e5 04/15: fixes for the above in the face of non-continuable conditions |
Date: |
Tue, 11 Oct 2022 13:58:54 -0400 (EDT) |
branch: elpa/geiser-chez
commit 52fbf028e5cee83453a011e43daeab524a2fd9e6
Author: jao <jao@gnu.org>
Commit: jao <jao@gnu.org>
fixes for the above in the face of non-continuable conditions
---
src/geiser/geiser.ss | 32 +++++++++++++++++++++++---------
1 file changed, 23 insertions(+), 9 deletions(-)
diff --git a/src/geiser/geiser.ss b/src/geiser/geiser.ss
index f20434b9cc..3a5fc9fc37 100644
--- a/src/geiser/geiser.ss
+++ b/src/geiser/geiser.ss
@@ -71,9 +71,7 @@
(environment-symbols (interaction-environment))))))
(define (write-to-string x)
- (with-output-to-string
- (lambda ()
- (write x))))
+ (with-output-to-string (lambda () (write x))))
(define (geiser:eval module form)
(call-with-result
@@ -97,12 +95,13 @@
(define (arity->parameter-list p)
(define (nparams n)
(map (lambda (n) (string->symbol (format "x~a" n))) (iota n)))
+ (define (add-opt pl)
+ (cons (append (if (null? pl) '() (car pl)) '(...)) pl))
(let* ((m (procedure-arity-mask p))
(pm (if (< m 0) (+ 1 (lognot m)) m))
(n (if (> pm 0) (/ (log pm) (log 2)) 0)))
(let loop ((k 1) (pl '()))
- (cond ((> k n)
- (reverse (if (< m 0) (cons (append (car pl) '(...)) pl) pl)))
+ (cond ((> k n) (reverse (if (< m 0) (add-opt pl) pl)))
((logbit? k pm) (loop (+ k 1) (cons (nparams k) pl)))
(else (loop (+ k 1) pl))))))
@@ -129,6 +128,22 @@
(list (vector->list (record-type-field-names rtd))))]
[else #f]))))
+ (define (value->string x)
+ (define max-len 80)
+ (define sub-str "...")
+ (define sub-len (- max-len (string-length sub-str)))
+ (let* ((s (write-to-string x))
+ (l (string-length s)))
+ (if (<= l max-len) s (string-append (substring s 0 sub-len) sub-str))))
+
+ (define not-found (gensym))
+
+ (define (try-eval sym)
+ (call/cc
+ (lambda (k)
+ (with-exception-handler (lambda (e) (k not-found))
+ (lambda () (eval sym))))))
+
(define (operator-arglist operator)
(define (procedure-parameter-list p)
(and (procedure? p)
@@ -140,13 +155,12 @@
(else `(("required" . ,(reverse req))
("optional" ,args)))))
(define (autodoc-arglist arglist) (autodoc-arglist* arglist '()))
- (let ([binding (with-exception-handler (lambda (e) #f)
- (lambda () (eval operator)))])
- (if binding
+ (let ([binding (try-eval operator)])
+ (if (not (eq? binding not-found))
(let ([arglists (procedure-parameter-list binding)])
(if arglists
`(,operator ("args" ,@(map autodoc-arglist arglists)))
- `(,operator ("value" . ,(write-to-string binding)))))
+ `(,operator ("value" . ,(value->string binding)))))
'())))
(define (geiser:autodoc ids . rest)
- [nongnu] elpa/geiser-chez updated (48427d4aec -> 53b7279550), ELPA Syncer, 2022/10/11
- [nongnu] elpa/geiser-chez db4d645996 01/15: better display of evaluation results (dups, spurious compile msgs), ELPA Syncer, 2022/10/11
- [nongnu] elpa/geiser-chez 52fbf028e5 04/15: fixes for the above in the face of non-continuable conditions,
ELPA Syncer <=
- [nongnu] elpa/geiser-chez e80f797a5c 10/15: autodoc: fix for arity 0 functions, ELPA Syncer, 2022/10/11
- [nongnu] elpa/geiser-chez 3bfa85afb9 05/15: following the error reporting protocol now that geiser does too, ELPA Syncer, 2022/10/11
- [nongnu] elpa/geiser-chez 7f12bcfe8b 13/15: initial implementation of symbol-location and module-location, ELPA Syncer, 2022/10/11
- [nongnu] elpa/geiser-chez 00ab1e6c7a 12/15: 'module' recognised as a keyword in chez, ELPA Syncer, 2022/10/11
- [nongnu] elpa/geiser-chez 3996898343 14/15: add-to-load-path, ELPA Syncer, 2022/10/11
- [nongnu] elpa/geiser-chez 2d8cd83c64 08/15: wee refactoring, ELPA Syncer, 2022/10/11
- [nongnu] elpa/geiser-chez 501fa22da4 06/15: whitespace and spurious rest arg, ELPA Syncer, 2022/10/11
- [nongnu] elpa/geiser-chez a70c47c557 07/15: unit test fixes, ELPA Syncer, 2022/10/11
- [nongnu] elpa/geiser-chez 21d35aa8d6 02/15: autodoc improvements (signatures from arities, values), ELPA Syncer, 2022/10/11
- [nongnu] elpa/geiser-chez 0cd37833ab 03/15: geiser-chez-debug-on-exception-p -> geiser-chez-debug-on-exception, ELPA Syncer, 2022/10/11