/[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.5 - (hide annotations) (vendor branch)
Tue Jun 4 15:07:19 1991 UTC (22 years, 10 months ago) by chiles
Changes since 1.1.1.4: +4 -6 lines
Fixed some syntax constants to make 8-bit chars work for Eric (our friend!).
1 ram 1.1 ;;; -*- Log: hemlock.log; Package: Hemlock-Internals -*-
2     ;;;
3     ;;; **********************************************************************
4 ram 1.1.1.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 chiles 1.1.1.5 "$Header: /tiger/var/lib/cvsroots/cmucl/src/hemlock/charmacs.lisp,v 1.1.1.5 1991/06/04 15:07:19 chiles Exp $")
11 ram 1.1.1.4 ;;;
12 ram 1.1 ;;; **********************************************************************
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 ram 1.1.1.2
39 ram 1.1 ;;;; Stuff for the Syntax table functions (syntax)
40 ram 1.1.1.2
41 chiles 1.1.1.5 (defconstant syntax-char-code-limit char-code-limit
42 ram 1.1 "The highest char-code which a character argument to the syntax
43     table functions may have.")
44 chiles 1.1.1.5
45 ram 1.1 (defmacro syntax-char-code (char)
46 chiles 1.1.1.5 `(char-code ,char))
47 ram 1.1
48     ;;;; Stuff for the command interpreter (interp)
49     ;;;
50     ;;; On the Perq we have bits for command bindings, on the VAX there
51     ;;; aren't. The code to interpret them is conditionally compiled
52     ;;; so that the VAX isnt't slowed down.
53     ;;;
54     ;;; Make command-char-code-limit 256 instead of 128 for X keyboard scan-codes.
55     (defconstant command-char-code-limit 256
56     "The upper bound on character codes supported for key bindings.")
57     (defconstant command-char-bits-limit 16
58     "The maximum value of character bits supported for key bindings.")
59     (defmacro key-char-bits (char)
60 ram 1.1.1.1 `(logand (char-bits ,char) #xF))
61 ram 1.1 (defmacro key-char-code (char)
62     `(char-code ,char))
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 ram 1.1.1.1 `(logand (char-code ,ch) #x+7F))
71 ram 1.1 ;;;
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 ram 1.1.1.1 `(logand (char-code ,ch) #x+5F))
80 ram 1.1
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 wlott 1.1.1.3 `(char-upcase (the base-character ,ch)))
85 ram 1.1
86    
87 ram 1.1.1.2
88     ;;;; DO-ALPHA-CHARS.
89 ram 1.1
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