Commits

Jim Ursetto committed b0358a6 Draft

hook ,d ; limit slot display by describe-sequence-limit

Comments (0)

Files changed (1)

describe-coops-mod.scm

-;; TODO: hook ,d with new describe call
 ;; TODO: respect sequence limit when displaying slots
 
 (use coops)
 (use (only srfi-1 fold))
 (use (only srfi-13 string-pad))
-;;(use (prefix describe describe:))
-;;(define describe:describe describe)
+(use (prefix describe describe:))
 
 (define-inline (symbol-length sym) (string-length (symbol->string sym)))
 (define-inline (class-slots class) (slot-value class 'slots))
      ((subclass? (class-of class) <standard-class>)
       (fprintf out "coops instance of class ~A:~%" (class-name class))
       (let* ((slots (class-slots class))
-             (maxlen (fold (lambda (slot len) (fxmax (symbol-length slot) len)) 0 slots)) )
-        (for-each
-         (lambda (slot)
-           (display "  ")
-           (display (string-pad (symbol->string slot) maxlen) out)
-           (display " : " out)
-           (if (slot-initialized? obj slot) (write (slot-value obj slot) out)
-               (display "#<uninitialized>" out) )
-           (newline out) )
-         slots)))
+             (maxlen (fold (lambda (slot len) (fxmax (symbol-length slot) len)) 0 slots))
+             (lim (describe:describe-sequence-limit)))
+        (let lp ((idx 0) (slots slots))
+          (cond ((null? slots))
+                ((< idx lim)
+                 (let ((slot (car slots)))
+                   (display "  ")
+                   (display (string-pad (symbol->string slot) maxlen) out)
+                   (display " : " out)
+                   (if (slot-initialized? obj slot) (write (slot-value obj slot) out)
+                       (display "#<uninitialized>" out) )
+                   (newline out)
+                   (lp (+ idx 1) (cdr slots))))
+                (else
+                 (fprintf out " (~A slots omitted)~%" (length slots)))))))
      (else
       ;; Handle case where metaclass is not a subclass of <standard-class>.
       ;; Although it's possible to create such a class, it has to have all the
 
 (define (describe obj #!optional (out (current-output-port)))
   (describe-object obj out))
+
+
+;;; REPL
+
+
+
+(when (feature? 'csi)
+  (toplevel-command 'd
+                    (lambda ()
+                      (let* ([e (read)])
+                        (describe (eval e))))
+                    ",d EXP            (describe) Describe result of evaluated EXP"))
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.