Created
August 13, 2021 13:27
-
-
Save christophejunke/336c45091a17f8ea1b98be712dca2ece to your computer and use it in GitHub Desktop.
colored symbols
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
(defpackage :col (:use :cl)) | |
(in-package :col) | |
(ql:quickload :cl-ansi-text) | |
(defparameter *print-color* t) | |
;; Attach a color attribute to symbols | |
(defun color (symbol) | |
(get symbol 'color)) | |
(defun (setf color) (color symbol) | |
(assert (find color cl-ansi-text::+term-colors+)) | |
(setf (get symbol 'color) color)) | |
;; Defining a COLORED-SYMBOL type | |
(defun colored-symbol-p (symbol) | |
(and *print-color* (symbolp symbol) (color symbol))) | |
(eval-when (:compile-toplevel :load-toplevel :execute) | |
(deftype colored-symbol () | |
'(and symbol (satisfies colored-symbol-p)))) | |
;; Compute ansi string for a given symbol and a color | |
(defun colored-symbol-as-string (symbol &aux (color (color symbol))) | |
(with-output-to-string (s) | |
(cl-ansi-text:with-color (color :stream s) | |
(let ((*print-color* nil)) | |
(princ symbol s))))) | |
;; Dedicated pretty-printer for COLORED-SYMBOL type | |
(set-pprint-dispatch 'colored-symbol | |
(lambda (stream symbol) | |
(princ (colored-symbol-as-string symbol) | |
stream))) | |
(setf (color 'stream) :red) | |
(setf (color 'block) :blue) | |
(setf (color 'lambda) :yellow) | |
;; Example | |
(defun read-one-line (file) | |
(with-open-file (stream file) | |
(read-line stream))) | |
;; Print it to a terminal (tested with SBCL) | |
(function-lambda-expression #'read-one-line) | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment