[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Issue: LET-TOP-LEVEL (version 1)

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"
      ;;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)))))