changeset 663: | cc89b337384b |
parent: | 9e7d4393eac6 |
child: | 4d8451fe5423 |
author: | Richard Westhaver <ellis@rwest.io> |
date: | Sat, 21 Sep 2024 22:58:22 -0400 |
permissions: | -rw-r--r-- |
description: | skel upgrades, added skel/net |
574
9e7d4393eac6
add skel/core/print.lisp, wrap up obj/query init
Richard Westhaver <ellis@rwest.io>
parents:
diff
changeset
|
1 | ;;; print.lisp --- Skel Printer |
9e7d4393eac6
add skel/core/print.lisp, wrap up obj/query init
Richard Westhaver <ellis@rwest.io>
parents:
diff
changeset
|
2 | |
9e7d4393eac6
add skel/core/print.lisp, wrap up obj/query init
Richard Westhaver <ellis@rwest.io>
parents:
diff
changeset
|
3 | ;; SK-PRINT |
9e7d4393eac6
add skel/core/print.lisp, wrap up obj/query init
Richard Westhaver <ellis@rwest.io>
parents:
diff
changeset
|
4 | |
9e7d4393eac6
add skel/core/print.lisp, wrap up obj/query init
Richard Westhaver <ellis@rwest.io>
parents:
diff
changeset
|
5 | ;;; Commentary: |
9e7d4393eac6
add skel/core/print.lisp, wrap up obj/query init
Richard Westhaver <ellis@rwest.io>
parents:
diff
changeset
|
6 | |
9e7d4393eac6
add skel/core/print.lisp, wrap up obj/query init
Richard Westhaver <ellis@rwest.io>
parents:
diff
changeset
|
7 | ;; SK-PRINT is the top-level interface, and dispatches on all sorts of SKEL |
9e7d4393eac6
add skel/core/print.lisp, wrap up obj/query init
Richard Westhaver <ellis@rwest.io>
parents:
diff
changeset
|
8 | ;; objects. The output is different than the PRINT-OBJECT methods, which are |
9e7d4393eac6
add skel/core/print.lisp, wrap up obj/query init
Richard Westhaver <ellis@rwest.io>
parents:
diff
changeset
|
9 | ;; implemented in the SKEL/CORE/OBJ package. |
9e7d4393eac6
add skel/core/print.lisp, wrap up obj/query init
Richard Westhaver <ellis@rwest.io>
parents:
diff
changeset
|
10 | |
9e7d4393eac6
add skel/core/print.lisp, wrap up obj/query init
Richard Westhaver <ellis@rwest.io>
parents:
diff
changeset
|
11 | ;; SK-PRINT is the 'external print' representation, which is structured, akin |
9e7d4393eac6
add skel/core/print.lisp, wrap up obj/query init
Richard Westhaver <ellis@rwest.io>
parents:
diff
changeset
|
12 | ;; to PPRINT - while PRINT-OBJECT is the 'internal print' and unstructured |
9e7d4393eac6
add skel/core/print.lisp, wrap up obj/query init
Richard Westhaver <ellis@rwest.io>
parents:
diff
changeset
|
13 | ;; representation. |
9e7d4393eac6
add skel/core/print.lisp, wrap up obj/query init
Richard Westhaver <ellis@rwest.io>
parents:
diff
changeset
|
14 | |
9e7d4393eac6
add skel/core/print.lisp, wrap up obj/query init
Richard Westhaver <ellis@rwest.io>
parents:
diff
changeset
|
15 | ;; All printer parameters are dynamic and dispatch occurs in the same manner |
9e7d4393eac6
add skel/core/print.lisp, wrap up obj/query init
Richard Westhaver <ellis@rwest.io>
parents:
diff
changeset
|
16 | ;; as the standard Lisp Printer. Additional parameters may be provided in the |
9e7d4393eac6
add skel/core/print.lisp, wrap up obj/query init
Richard Westhaver <ellis@rwest.io>
parents:
diff
changeset
|
17 | ;; future. |
9e7d4393eac6
add skel/core/print.lisp, wrap up obj/query init
Richard Westhaver <ellis@rwest.io>
parents:
diff
changeset
|
18 | |
9e7d4393eac6
add skel/core/print.lisp, wrap up obj/query init
Richard Westhaver <ellis@rwest.io>
parents:
diff
changeset
|
19 | ;;; Code: |
9e7d4393eac6
add skel/core/print.lisp, wrap up obj/query init
Richard Westhaver <ellis@rwest.io>
parents:
diff
changeset
|
20 | (in-package :skel/core/print) |
9e7d4393eac6
add skel/core/print.lisp, wrap up obj/query init
Richard Westhaver <ellis@rwest.io>
parents:
diff
changeset
|
21 | |
9e7d4393eac6
add skel/core/print.lisp, wrap up obj/query init
Richard Westhaver <ellis@rwest.io>
parents:
diff
changeset
|
22 | ;; sb-pretty::*standard-pprint-dispatch-table* |
9e7d4393eac6
add skel/core/print.lisp, wrap up obj/query init
Richard Westhaver <ellis@rwest.io>
parents:
diff
changeset
|
23 | ;; *readtable* |
9e7d4393eac6
add skel/core/print.lisp, wrap up obj/query init
Richard Westhaver <ellis@rwest.io>
parents:
diff
changeset
|
24 | |
9e7d4393eac6
add skel/core/print.lisp, wrap up obj/query init
Richard Westhaver <ellis@rwest.io>
parents:
diff
changeset
|
25 | (sb-ext:defglobal *sk-print-dispatch-table* (sb-pretty::make-pprint-dispatch-table #() nil nil)) |
9e7d4393eac6
add skel/core/print.lisp, wrap up obj/query init
Richard Westhaver <ellis@rwest.io>
parents:
diff
changeset
|
26 | |
663
cc89b337384b
skel upgrades, added skel/net
Richard Westhaver <ellis@rwest.io>
parents:
574
diff
changeset
|
27 | (defmethod sk-print ((self skel) &key (stream t) (id t) &allow-other-keys) |
cc89b337384b
skel upgrades, added skel/net
Richard Westhaver <ellis@rwest.io>
parents:
574
diff
changeset
|
28 | (if id |
cc89b337384b
skel upgrades, added skel/net
Richard Westhaver <ellis@rwest.io>
parents:
574
diff
changeset
|
29 | (format stream "~S ~A~%" (keywordicate (class-name (class-of self))) (format-sxhash (obj/id:id self))) |
cc89b337384b
skel upgrades, added skel/net
Richard Westhaver <ellis@rwest.io>
parents:
574
diff
changeset
|
30 | (format stream "~S~%" (keywordicate (class-name (class-of self))))) |
cc89b337384b
skel upgrades, added skel/net
Richard Westhaver <ellis@rwest.io>
parents:
574
diff
changeset
|
31 | (mapcar |
cc89b337384b
skel upgrades, added skel/net
Richard Westhaver <ellis@rwest.io>
parents:
574
diff
changeset
|
32 | (lambda (slot) |
cc89b337384b
skel upgrades, added skel/net
Richard Westhaver <ellis@rwest.io>
parents:
574
diff
changeset
|
33 | (let ((name (sb-mop:slot-definition-name slot))) |
cc89b337384b
skel upgrades, added skel/net
Richard Westhaver <ellis@rwest.io>
parents:
574
diff
changeset
|
34 | (when (slot-boundp self name) |
cc89b337384b
skel upgrades, added skel/net
Richard Westhaver <ellis@rwest.io>
parents:
574
diff
changeset
|
35 | (when-let ((val (slot-value self name))) |
cc89b337384b
skel upgrades, added skel/net
Richard Westhaver <ellis@rwest.io>
parents:
574
diff
changeset
|
36 | (format stream ":~A ~A~%" name val))))) |
cc89b337384b
skel upgrades, added skel/net
Richard Westhaver <ellis@rwest.io>
parents:
574
diff
changeset
|
37 | (sb-mop:class-direct-slots (class-of self))) |
cc89b337384b
skel upgrades, added skel/net
Richard Westhaver <ellis@rwest.io>
parents:
574
diff
changeset
|
38 | self) |