Re: changing text color
- From: vanekl <vanek@xxxxxxx>
- Date: Sat, 5 Jan 2008 13:23:31 -0800 (PST)
On Jan 5, 9:17 am, mathrick <mathr...@xxxxxxxxx> wrote:
On Jan 1, 11:47 pm, vanekl <va...@xxxxxxx> wrote:
This works with the color xterm I use:
(defmacro cmsg (fmt &optional (c 33) (skip 0) (stream t))
`(let ((color ,c))
*BZZZZZT* You just captured COLOR here. Which has a very good chance
of being bound in code that concerns itself with printing something in
colour. You *must* use WITH-GENSYMS or equivalent to avoid doing that,
else there will be very nasty and hard to debug problems at seemingly
random moments.
Good call.
Consider this:
CL-USER> (defun print-warning (text &optional (color "red"))
(cmsg text)
(format t "~&~%;; Printed warning message in ~A" color))
; in: lambda nil
; (CMSG TEXT)
[snip]
;
; caught warning:
; undefined variable: in
;
; caught warning:
; undefined variable: princ
;
; caught warning:
; These variables are undefined:
; in princ
CL-USER> (print-warning "NUCLEAR STRIKE APPROACHING")
NUCLEAR STRIKE APPROACHING
=============================
The variable in is unbound.
[Condition of type unbound-variable]
Restarts:
0: [abort] Return to SLIME's top level.
1: [terminate-thread] Terminate this thread (#<thread "repl-
thread" {AFDA9A1}>)
Backtrace:
0: (print-warning "NUCLEAR STRIKE APPROACHING" "red")
---...---
(if (stringp color)
(setf color (cond ((equalp "Black" color) 30)
((equalp "Red" color) 31)
((equalp "Green" color) 32)
((equalp "Yellow" color) 33)
((equalp "Blue" color) 34)
((equalp "Magenta" color) 35)
((equalp "Cyan" color) 36)
((equalp "White" color) 37)
(t 0))))
This is long enough a COND to warrant writing CASE* for it.
I just stumbled upon defenumeration.lisp the other day, and that looks
to be even more efficient.
(let ((fmts (format nil "~A[0;~Dm" (code-char #x1b) color))
(fmte (format nil "~A[0m" (code-char #x1b))))
(if ,skip
(dotimes (i ,skip)
(format ,stream "~%")))
What exactly is SKIP? You never explain it, and I assumed it meant
"don't colour SKIP first chars", but that's seemingly not the case.
You need to document parameters like that better, perhaps by naming it
SKIP-LINES.
I didn't intend this func to be used by anybody but myself when I
wrote it, thus explaining the naming convention/documentation (or lack
thereof).
; Should use princ here instead of format because function
'format'
; sometimes gets confused when it thinks it sees control codes
; mixed in with the format statement and no arguments are
; supplied for the control codes.
(princ fmts ,stream)
(princ ,fmt ,stream)
;(princ (concatenate 'string fmts ,fmt fmte) ,stream)
;warning: sbcl may insert warning messages here if there is a CR
in "fmt".
(princ fmte ,stream)
)))
In general, your naming leaves a lot to be desired. FMT, and C are not
good names for public API parameters. Consider someone trying to
decipher what a "cmsg" does looking at SLIME-provided arglist. C and
FMT tell _nothing_. Same with FMTS and FMTE. They're not packed in
long lines where brievity could matter, they're the sole params used
on separate lines. OTOH, PRINCing something in sequence is not
immediately obvious, so naming them better makes the code much
clearer.
Additionally, FMT suggests your macro takes FORMAT-style formatting
directives, which it doesn't. So you're confusing people even further
with bad naming.
Here's a version that fixes the problems I outlined:
;;; Just the usual stuff. Everyone should have a WITH-GENSYMS or
;;; WITH-UNIQUE-NAMES in their toolbox.
(defmacro with-gensyms ((&rest names) &body body)
`(let (,@(loop for name in names collect `(,name (gensym))))
,@body))
(defmacro case* (key-form-or-list &body cases)
"Like CASE, but lets you specify an optional equality predicate:
(case (foo 'equal)
(\"asd\" (bar)))"
(if (listp key-form-or-list)
(destructuring-bind (keyform &optional (test ''eql)) key-form-or-
list
(let ((keyval (gensym)))
(flet ((make-case (casedef)
(if (eq t (car casedef))
casedef
`((funcall ,test ,keyval ,(car casedef))
,@(cdr casedef)))))
`(let ((,keyval ,keyform))
(cond
,@(loop for case in cases collecting (make-case
case)))))))
`(case ,key-form-or-list ,@cases)))
(defmacro cmsg (message &optional (colour 33) (skip-lines 0) (stream
t))
(with-gensyms (col)
`(let ((,col ,colour))
(if (stringp ,col)
(setf ,col (case* (,col 'equalp)
("Black" 30)
("Red" 31)
("Green" 32)
("Yellow" 33)
("Blue" 34)
("Magenta" 35)
("Cyan" 36)
("White" 37)
(t 0))))
(let ((format-start (format nil "~A[0;~Dm" (code-char
#x1b) ,col))
(format-end (format nil "~A[0m" (code-char #x1b))))
(if ,skip-lines
(dotimes (i ,skip-lines)
(format ,stream "~%")))
;; Should use princ here instead of format because function
;; 'format' sometimes gets confused when it thinks it sees
;; control codes mixed in with the format statement and no
;; arguments are supplied for the control codes.
(princ format-start ,stream)
(princ ,message ,stream)
;; (princ (concatenate 'string formats ,format formate)
;; ,stream) warning: sbcl may insert warning messages here if
;; there is a CR in "format".
(princ format-end ,stream)))))
Oh, and last thing: why exactly did you make it a macro? There's
absolutely nothing about CMSG that would need macros. It'd be at least
understandable if you wanted to shift the string computation to
compile time and only returned static strings. But you don't do that.
The first rule of writing macros is not to write macros where a
function will do.
I got errors when I first wrote this as a plain function (don't
remember what they were). When I turned it into a macro the errors
went away, so that's the way it stayed. I aint a Lisp wizard, nor do I
claim to be.
Cheers,
Maciej
Thanks for the tips.
This was meant to be used only by me, so no time was spent on cleaning
up the api. Just trying to give the OP something to work with.
.
- Follow-Ups:
- Re: changing text color
- From: Pascal Bourguignon
- Re: changing text color
- References:
- changing text color
- From: obouslama86
- Re: changing text color
- From: vanekl
- Re: changing text color
- From: mathrick
- changing text color
- Prev by Date: Re: A Question about DEFPACKAGE syntax
- Next by Date: Re: Anybody willing to share their cl-ppcre regex for validating email address
- Previous by thread: Re: changing text color
- Next by thread: Re: changing text color
- Index(es):
Relevant Pages
|