source: trunk/source/cocoa-ide/hemlock/src/charmacs.lisp @ 12108

Last change on this file since 12108 was 12108, checked in by gb, 10 years ago

SYNTAX-CHAR-CODE: treat characters with codes >= 256 as if they were #\A.
(Not quite right: some are whitespace.)

SEARCH-CHAR-CODE-LIMIT: set to CHAR-CODE-LIMIT.

SEARCH-CHAR-CODE: just use CHAR-CODE.

SEARCH-HASH-CODE: handle non-ASCII chars.

DO-ALPHA-CHARS: execute loop for char-codes from that of #\A to 256.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 3.7 KB
Line 
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;;;
7#+CMU (ext:file-comment
8  "$Header$")
9;;;
10;;; **********************************************************************
11;;;
12;;; Implementation specific character-hacking macros and constants.
13;;;
14(in-package :hemlock-internals)
15
16;;; This file contains various constants and macros which are implementation or
17;;; ASCII dependant.  It contains some versions of CHAR-CODE which do not check
18;;; types and ignore the top bit so that various structures can be allocated
19;;; 128 long instead of 256, and we don't get errors if a loser visits a binary
20;;; file.
21;;;
22;;; There are so many different constants and macros implemented the same.
23;;; This is to separate various mechanisms; for example, in principle the
24;;; char-code-limit for the syntax functions is independant of that for the
25;;; searching functions
26;;;
27
28
29
30;;;; Stuff for the Syntax table functions (syntax)
31
32(defconstant syntax-char-code-limit hemlock-char-code-limit
33  "The highest char-code which a character argument to the syntax
34  table functions may have.")
35
36
37;;; This has the effect of treating all characters with code > 255
38;;; as if they were #\u+00ff.  Not quite right, but better than
39;;; flying off the end.
40(defmacro syntax-char-code (char)
41  (let* ((code (gensym)))
42    `(let* ((,code (char-code ,char)))
43      (declare (type (mod #x110000) ,code))
44      (if (< ,code 256)
45        ,code
46        (char-code #\A)))))
47
48
49;;;; Stuff used by the searching primitives (search)
50;;;
51(defconstant search-char-code-limit char-code-limit
52  "The exclusive upper bound on significant char-codes for searching.")
53(defmacro search-char-code (ch)
54  `(char-code ,ch))
55;;;
56;;;    search-hash-code must be a function with the following properties:
57;;; given any character it returns a number between 0 and
58;;; search-char-code-limit, and the same hash code must be returned
59;;; for the upper and lower case forms of each character.
60;;;    In ASCII this is can be done by ANDing out the 5'th bit.
61;;;
62(defmacro search-hash-code (ch)
63  `(char-code (char-upcase ,ch)))
64
65;;; Doesn't do anything special, but it should fast and not waste any time
66;;; checking type and whatnot.
67(defmacro search-char-upcase (ch)
68  `(char-upcase (the base-char ,ch)))
69
70
71
72;;;; DO-ALPHA-CHARS.
73
74;;; ALPHA-CHARS-LOOP loops from start-char through end-char binding var
75;;; to the alphabetic characters and executing body.  Note that the manual
76;;; guarantees lower and upper case char codes to be separately in order,
77;;; but other characters may be interspersed within that ordering.
78(defmacro alpha-chars-loop (var test result body)
79  (let ((n (gensym))
80        (end-char-code (gensym)))
81    `(do ((,n (char-code #\A) (1+ ,n))
82          (,end-char-code 255))
83         ((> ,n ,end-char-code) ,result)
84       (let ((,var (code-char ,n)))
85         (when (,test ,var)
86           ,@body)))))
87
88(defmacro do-alpha-chars ((var kind &optional result) &rest forms)
89  "(do-alpha-chars (var kind [result]) . body).  Kind is one of
90   :lower, :upper, or :both, and var is bound to each character in
91   order as specified under character relations in the manual.  When
92   :both is specified, lowercase letters are processed first."
93  (case kind
94    (:both
95     `(progn (alpha-chars-loop ,var lower-case-p nil ,forms)
96             (alpha-chars-loop ,var upper-case-p ,result ,forms)))
97    (:lower
98     `(alpha-chars-loop ,var lower-case-p ,result ,forms))
99    (:upper
100     `(alpha-chars-loop ,var upper-case-p ,result ,forms))
101    (t (error "Kind argument not one of :lower, :upper, or :both -- ~S."
102              kind))))
Note: See TracBrowser for help on using the repository browser.