/[cmucl]/src/hemlock/charmacs.lisp
ViewVC logotype

Contents of /src/hemlock/charmacs.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1.1.4 - (show annotations) (vendor branch)
Fri Feb 8 16:33:15 1991 UTC (23 years, 2 months ago) by ram
Changes since 1.1.1.3: +8 -5 lines
Added new header with RCS FILE-COMMENT.
1 ;;; -*- Log: hemlock.log; Package: Hemlock-Internals -*-
2 ;;;
3 ;;; **********************************************************************
4 ;;; This code was written as part of the CMU Common Lisp project at
5 ;;; Carnegie Mellon University, and has been placed in the public domain.
6 ;;; If you want to use this code or any part of CMU Common Lisp, please contact
7 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
8 ;;;
9 (ext:file-comment
10 "$Header: /tiger/var/lib/cvsroots/cmucl/src/hemlock/charmacs.lisp,v 1.1.1.4 1991/02/08 16:33:15 ram Exp $")
11 ;;;
12 ;;; **********************************************************************
13 ;;;
14 ;;; Implementation specific character-hacking macros and constants.
15 ;;;
16 (in-package 'hemlock-internals)
17 (export ' (syntax-char-code-limit command-char-bits-limit
18 command-char-code-limit search-char-code-limit
19 do-alpha-chars))
20
21 ;;; This file contains various constants and macros which are
22 ;;; implementation or ASCII dependant. In particular it contains
23 ;;; all the character implementation parameters such as
24 ;;; Command-Char-Bits-Limit, and contains various versions
25 ;;; of char-code which don't check types and omit the top bit
26 ;;; so that various structures can be allocated 128 long instead
27 ;;; of 256, and we don't get errors if a loser visits a binary file.
28
29 ;;; There are so many different constants and macros that do the same
30 ;;; thing because in principle the char-code-limit for the syntax
31 ;;; functions is independant of that for the searching functions, etc.
32
33 ;;; This file also contains code which adds any implementation specific
34 ;;; character names to the char file's Char-Name-Alist so that there
35 ;;; is a reasonable read-syntax and print-representation for all
36 ;;; characters a user might run across.
37
38
39 ;;;; Stuff for the Syntax table functions (syntax)
40
41 (defconstant syntax-char-code-limit 128
42 "The highest char-code which a character argument to the syntax
43 table functions may have.")
44 (defconstant syntax-char-code-mask #x+7f
45 "Mask we AND with characters given to syntax table functions to blow away
46 bits we don't want.")
47 (defmacro syntax-char-code (char)
48 `(logand syntax-char-code-mask (char-code ,char)))
49
50 ;;;; Stuff for the command interpreter (interp)
51 ;;;
52 ;;; On the Perq we have bits for command bindings, on the VAX there
53 ;;; aren't. The code to interpret them is conditionally compiled
54 ;;; so that the VAX isnt't slowed down.
55 ;;;
56 ;;; Make command-char-code-limit 256 instead of 128 for X keyboard scan-codes.
57 (defconstant command-char-code-limit 256
58 "The upper bound on character codes supported for key bindings.")
59 (defconstant command-char-bits-limit 16
60 "The maximum value of character bits supported for key bindings.")
61 (defmacro key-char-bits (char)
62 `(logand (char-bits ,char) #xF))
63 (defmacro key-char-code (char)
64 `(char-code ,char))
65
66
67 ;;;; Stuff used by the searching primitives (search)
68 ;;;
69 (defconstant search-char-code-limit 128
70 "The exclusive upper bound on significant char-codes for searching.")
71 (defmacro search-char-code (ch)
72 `(logand (char-code ,ch) #x+7F))
73 ;;;
74 ;;; search-hash-code must be a function with the following properties:
75 ;;; given any character it returns a number between 0 and
76 ;;; search-char-code-limit, and the same hash code must be returned
77 ;;; for the upper and lower case forms of each character.
78 ;;; In ASCII this is can be done by ANDing out the 5'th bit.
79 ;;;
80 (defmacro search-hash-code (ch)
81 `(logand (char-code ,ch) #x+5F))
82
83 ;;; Doesn't do anything special, but it should fast and not waste any time
84 ;;; checking type and whatnot.
85 (defmacro search-char-upcase (ch)
86 `(char-upcase (the base-character ,ch)))
87
88
89
90 ;;;; DO-ALPHA-CHARS.
91
92 ;;; ALPHA-CHARS-LOOP loops from start-char through end-char binding var
93 ;;; to the alphabetic characters and executing body. Note that the manual
94 ;;; guarantees lower and upper case char codes to be separately in order,
95 ;;; but other characters may be interspersed within that ordering.
96 (defmacro alpha-chars-loop (var start-char end-char result body)
97 (let ((n (gensym))
98 (end-char-code (gensym)))
99 `(do ((,n (char-code ,start-char) (1+ ,n))
100 (,end-char-code (char-code ,end-char)))
101 ((> ,n ,end-char-code) ,result)
102 (let ((,var (code-char ,n)))
103 (when (alpha-char-p ,var)
104 ,@body)))))
105
106 (defmacro do-alpha-chars ((var kind &optional result) &rest forms)
107 "(do-alpha-chars (var kind [result]) . body). Kind is one of
108 :lower, :upper, or :both, and var is bound to each character in
109 order as specified under character relations in the manual. When
110 :both is specified, lowercase letters are processed first."
111 (case kind
112 (:both
113 `(progn (alpha-chars-loop ,var #\a #\z nil ,forms)
114 (alpha-chars-loop ,var #\A #\Z ,result ,forms)))
115 (:lower
116 `(alpha-chars-loop ,var #\a #\z ,result ,forms))
117 (:upper
118 `(alpha-chars-loop ,var #\A #\Z ,result ,forms))
119 (t (error "Kind argument not one of :lower, :upper, or :both -- ~S."
120 kind))))

  ViewVC Help
Powered by ViewVC 1.1.5