mirror of
https://gitlab.com/vindarel/ciel.git
synced 2026-01-18 23:31:07 -08:00
pretty-print hash-tables. From Rutils.
This commit is contained in:
parent
bee5b71859
commit
2b63d644d7
2 changed files with 101 additions and 2 deletions
31
README.org
31
README.org
|
|
@ -207,11 +207,38 @@ https://github.com/ruricolist/serapeum/blob/master/REFERENCE.md#hash-tables
|
|||
:pairhash
|
||||
#+end_src
|
||||
|
||||
Here's how we can create a hash-table with keys and values:
|
||||
|
||||
#+BEGIN_SRC lisp
|
||||
;; create a hash-table:
|
||||
(dict :a 1 :b 2 :c 3)
|
||||
;; create a hash-table:
|
||||
(dict :a 1 :b 2 :c 3)
|
||||
;; =>
|
||||
#{EQUAL
|
||||
:A 1
|
||||
:B 2
|
||||
:C 3
|
||||
}
|
||||
#+end_src
|
||||
|
||||
As seen above, hash-tables are pretty-printed by default. In default
|
||||
Common Lisp, they are printed like so:
|
||||
|
||||
#<HASH-TABLE :TEST EQUAL :COUNT 3 {1006CE5613}>
|
||||
|
||||
However, our represetation has an important drawback: we (currently?) can't read
|
||||
the hash-table literal back in.
|
||||
|
||||
# although rutils does it with the #h notation, which we would like to avoid in favour of dict.
|
||||
|
||||
You can toggle the representation with =toggle-print-hash-table=, or
|
||||
by setting
|
||||
|
||||
#+BEGIN_SRC lisp
|
||||
(setf *pretty-print-hash-tables* nil)
|
||||
#+end_src
|
||||
|
||||
in your configuration file.
|
||||
|
||||
*** Sequences utilities (Alexandria, Serapeum)
|
||||
|
||||
From [[ https://github.com/ruricolist/serapeum/blob/master/REFERENCE.md#sequences][Serapeum]] we import:
|
||||
|
|
|
|||
|
|
@ -175,3 +175,75 @@
|
|||
(setf *print-lines* 1000)
|
||||
(setf *print-level* 20)
|
||||
(setf *print-length* 1000)
|
||||
|
||||
;TODO: pretty print hash-tables
|
||||
|
||||
;; Pretty-print hash-tables by default.
|
||||
;; Enable/disable with toggle-print-hash-table
|
||||
;; (stolen from rutils)
|
||||
|
||||
(defparameter *pretty-print-hash-tables* t "Pretty-print hash tables by default.")
|
||||
|
||||
(defun print-hash-table (ht &optional (stream *standard-output*))
|
||||
"Pretty print hash-table HT to STREAM.
|
||||
|
||||
CIEL note: copied from RUTILS."
|
||||
(let ((*print-pretty* t)
|
||||
(i 0))
|
||||
(pprint-logical-block (stream nil)
|
||||
(pprint-newline :fill stream)
|
||||
(princ "#{" stream)
|
||||
(unless (eq (hash-table-test ht) 'eql)
|
||||
(princ (hash-table-test ht) stream))
|
||||
(pprint-indent :block 2 stream)
|
||||
(block nil
|
||||
(maphash (lambda (k v)
|
||||
(pprint-newline :mandatory stream)
|
||||
(when (and *print-length* (> (incf i) *print-length*))
|
||||
(princ "..." stream)
|
||||
(return))
|
||||
(when (and k (listp k)) (princ #\' stream))
|
||||
(if (typep k 'hash-table)
|
||||
(print-hash-table k stream)
|
||||
(prin1 k stream))
|
||||
(princ " " stream)
|
||||
(when (and v (listp v)) (princ #\' stream))
|
||||
(if (typep v 'hash-table)
|
||||
(print-hash-table v stream)
|
||||
(prin1 v stream)))
|
||||
ht))
|
||||
(pprint-indent :block 1 stream)
|
||||
(pprint-newline :mandatory stream)
|
||||
(princ "} " stream)))
|
||||
ht)
|
||||
(defmethod print-hash-table ((object hash-table) stream)
|
||||
;; XXX: we can not read this back.
|
||||
;; we don't use rutils's pretty printing because we don't want the #h notaton
|
||||
(format stream "#HASH{~a, ~{~{~a: ~a~}~^, ~}}"
|
||||
(hash-table-test object)
|
||||
(loop for key being the hash-keys of object
|
||||
using (hash-value value)
|
||||
collect (list key value))))
|
||||
|
||||
(let ((default-method (ignore-errors (find-method
|
||||
#'print-object nil '(hash-table t))))
|
||||
toggled)
|
||||
(defun toggle-print-hash-table (&optional (on nil explicit))
|
||||
"Toggles printing hash-tables with PRINT-HASH-TABLE or with default method.
|
||||
If ON is set explicitly will turn on literal printing (T) or default (NIL).
|
||||
|
||||
CIEL note: this function comes from RUTILS (which is not installed by default)."
|
||||
(let ((off (if explicit on (not toggled))))
|
||||
(if off
|
||||
(progn
|
||||
(defmethod print-object ((obj hash-table) stream)
|
||||
(print-hash-table obj stream))
|
||||
(setf toggled t))
|
||||
(progn (remove-method #'print-object
|
||||
(find-method #'print-object nil '(hash-table t)))
|
||||
(unless (null default-method)
|
||||
(add-method #'print-object default-method))
|
||||
(setf toggled nil))))))
|
||||
|
||||
(when *pretty-print-hash-tables*
|
||||
(toggle-print-hash-table t))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue