changelog shortlog graph tags branches changeset files revisions annotate raw help

Mercurial > core / lisp/lib/skel/core/print.lisp

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