diff --git a/code/char.lisp b/code/char.lisp index e8a584ecc6645523d76c85f83a7ab9dafed17bc3..bb8440bdcc0bd3d3f80fedf3e3c236c5f671e814 100644 --- a/code/char.lisp +++ b/code/char.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/char.lisp,v 1.9 1994/10/31 04:11:27 ram Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/char.lisp,v 1.10 1997/09/16 17:15:26 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -47,24 +47,51 @@ `(integer 0 (,char-code-limit))) -(defparameter char-name-alist - `(("NULL" . ,(code-char 0)) - ("BELL" . ,(code-char 7)) - ("BACKSPACE" . ,(code-char 8)) ("BS" . ,(code-char 8)) - ("TAB" . ,(code-char 9)) - ("NEWLINE" . ,(code-char 10)) ("NL" . ,(code-char 10)) - ("LINEFEED" . ,(code-char 10)) ("LF" . ,(code-char 10)) - ("VT" . ,(code-char 11)) - ("PAGE" . ,(code-char 12)) ("FORM" . ,(code-char 12)) - ("FORMFEED" . ,(code-char 12)) ("FF" . ,(code-char 12)) - ("RETURN" . ,(code-char 13)) ("CR" . ,(code-char 13)) - ("ESCAPE" . ,(code-char 27)) ("ESC" . ,(code-char 27)) - ("ALTMODE" . ,(code-char 27)) ("ALT" . ,(code-char 27)) - ("SPACE" . ,(code-char 32)) ("SP" . ,(code-char 32)) - ("DELETE" . ,(code-char 127)) ("RUBOUT" . ,(code-char 127))) - "This is the alist of (character-name . character) for characters - with long names. The first name in this list for a given character - is used on typeout and is the preferred form for input.") +(macrolet ((frob (char-names-list) + (collect ((results)) + (dolist (code char-names-list) + (destructuring-bind (ccode names) + code + (dolist (name names) + (results (cons name (code-char ccode)))))) + `(defparameter char-name-alist ',(results) + "This is the alist of (character-name . character) for characters with + long names. The first name in this list for a given character is used + on typeout and is the preferred form for input.")))) + (frob ((#x00 ("Null" "^@" "Nul")) + (#x01 ("^a" "Soh")) + (#x02 ("^b" "Stx")) + (#x03 ("^c" "Etx")) + (#x04 ("^d" "Eot")) + (#x05 ("^e" "Enq")) + (#x06 ("^f" "Ack")) + (#x07 ("Bell" "^g" "Bel")) + (#x08 ("Backspace" "^h" "Bs")) + (#x09 ("Tab" "^i" "Ht")) + (#x0A ("Linefeed" "Newline" "^j" "Lf" "Nl" )) + (#x0B ("Vt" "^k")) + (#x0C ("Page" "^l" "Form" "Formfeed" "Ff" "Np")) + (#x0D ("Return" "^m" "Cr")) + (#x0E ("^n" "So")) + (#x0F ("^o" "Si")) + (#x10 ("^p" "Dle")) + (#x11 ("^q" "Dc1")) + (#x12 ("^r" "Dc2")) + (#x13 ("^s" "Dc3")) + (#x14 ("^t" "Dc4")) + (#x15 ("^u" "Nak")) + (#x16 ("^v" "Syn")) + (#x17 ("^w" "Etb")) + (#x18 ("^x" "Can")) + (#x19 ("^y" "Em")) + (#x1A ("^z" "Sub")) + (#x1B ("Escape" "^[" "Altmode" "Esc" "Alt")) + (#x1C ("^\\" "Fs")) + (#x1D ("^]" "Gs")) + (#x1E ("^^" "Rs")) + (#x1F ("^_" "Us")) + (#x20 ("Space" "Sp")) + (#x7f ("Rubout" "Delete" "Del"))))) ;;;; Accessor functions: