[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Issue: LET-TOP-LEVEL (version 1)
- To: Pavel.pa@xerox.com
- Subject: Issue: LET-TOP-LEVEL (version 1)
- From: Eric Benson <edsel!eb@labrea.Stanford.EDU>
- Date: Thu, 3 Mar 88 14:19:49 PST
- Cc: Moon@stony-brook.scrc.symbolics.com, cl-cleanup@sail.stanford.edu
- In-reply-to: Pavel.pa@Xerox.COM's message of Thu, 3 Mar 88 12:15:58 PST <880303-121631-6583@Xerox>
I concur with Pavel. I have written code that does exactly this sort
of thing. (Say what you want about this style). This creates a
constant vector of character names, used by NAME-CHAR and CHAR-NAME.
The two functions share a single structure, which is not stored in a
global variable. Notice I ended up using SETF of MACRO-FUNCTION
because of problems with DEFMACRO.
(let ((char-name-table (make-array (1+ (char-code #\Space))
:initial-element nil)))
(flet ((add-char-name (code name)
"Enter a new name for this character code"
(let* ((old-entry (svref char-name-table code))
(new-entry (cond ((null old-entry) name)
((consp old-entry) (cons name old-entry))
(t (list name old-entry)))))
(setf (svref char-name-table code) new-entry))))
(flet ((add-char-names (code namelist)
"Add names for the character codes in sequence from this one"
(dolist (name namelist)
(add-char-name code name)
(incf code))))
;;The standard ASCII names
(add-char-names 0 '("NUL" "SOH" "STX" "ETX" "EOT" "ENQ" "ACK" "BEL"
"BS" "HT" "NL" "VT" "NP" "CR" "SO" "SI"
"DLE" "DC1" "DC2" "DC3" "DC4" "NAK" "SYN" "ETB"
"CAN" "EM" "SUB" "ESC" "FS" "GS" "RS" "US"
"SP"))
;;Other names for the same characters
;;The last name added is the one returned by CHAR-NAME
(add-char-names 7 '("Bell" "Backspace" "Tab" "Linefeed"))
(add-char-name 0 "Null")
(add-char-name 12 "Page")
(add-char-name 13 "Return")
(add-char-name 32 "Space")
(add-char-name 10 "Newline")))
;;Bug in Common Lisp definition makes this not work:
;;(defmacro char-name-table-ref (code) ...)
(setf (macro-function 'char-name-table-ref)
#'(lambda (form env)
(declare (ignore env))
(let ((code (second form)))
`(svref ',char-name-table ,code)))))