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

Contents of /src/hemlock/charmacs.lisp

Parent Directory Parent Directory | Revision Log Revision Log


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

  ViewVC Help
Powered by ViewVC 1.1.5