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

Last change on this file since 8428 was 8428, checked in by gz, 12 years ago

Merge of the 'event-ide' branch. Hemlock's thread model has been changed
so that Hemlock commands now run in the Cocoa event thread -- see the
Hemlock file view.lisp for an overview.

IDE compilation has also been reorganized. Hemlock is now more fully
integrated into the IDE and cannot be compiled separately, sorry.

The hemlock-ext package has been repurposed to contain all interfaces
to window-system specific functionality.

There are also many many assorted other changes, cleanups and fixes.

The Hemlock documentation (Hemlock Command Implementor's Manual) in
http://trac.clozure.com/openmcl/wiki now correctly reflects the
implementation, although it doesn't (yet) describe the integration
with Cocoa or the threading model.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 3.6 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  `(min (char-code ,char) 255))
42
43
44;;;; Stuff used by the searching primitives (search)
45;;;
46(defconstant search-char-code-limit 128
47  "The exclusive upper bound on significant char-codes for searching.")
48(defmacro search-char-code (ch)
49  `(logand (char-code ,ch) #x+7F))
50;;;
51;;;    search-hash-code must be a function with the following properties:
52;;; given any character it returns a number between 0 and
53;;; search-char-code-limit, and the same hash code must be returned
54;;; for the upper and lower case forms of each character.
55;;;    In ASCII this is can be done by ANDing out the 5'th bit.
56;;;
57(defmacro search-hash-code (ch)
58  `(logand (char-code ,ch) #x+5F))
59
60;;; Doesn't do anything special, but it should fast and not waste any time
61;;; checking type and whatnot.
62(defmacro search-char-upcase (ch)
63  `(char-upcase (the base-char ,ch)))
64
65
66
67;;;; DO-ALPHA-CHARS.
68
69;;; ALPHA-CHARS-LOOP loops from start-char through end-char binding var
70;;; to the alphabetic characters and executing body.  Note that the manual
71;;; guarantees lower and upper case char codes to be separately in order,
72;;; but other characters may be interspersed within that ordering.
73(defmacro alpha-chars-loop (var start-char end-char result body)
74  (let ((n (gensym))
75        (end-char-code (gensym)))
76    `(do ((,n (char-code ,start-char) (1+ ,n))
77          (,end-char-code (char-code ,end-char)))
78         ((> ,n ,end-char-code) ,result)
79       (let ((,var (code-char ,n)))
80         (when (alpha-char-p ,var)
81           ,@body)))))
82
83(defmacro do-alpha-chars ((var kind &optional result) &rest forms)
84  "(do-alpha-chars (var kind [result]) . body).  Kind is one of
85   :lower, :upper, or :both, and var is bound to each character in
86   order as specified under character relations in the manual.  When
87   :both is specified, lowercase letters are processed first."
88  (case kind
89    (:both
90     `(progn (alpha-chars-loop ,var #\a #\z nil ,forms)
91             (alpha-chars-loop ,var #\A #\Z ,result ,forms)))
92    (:lower
93     `(alpha-chars-loop ,var #\a #\z ,result ,forms))
94    (:upper
95     `(alpha-chars-loop ,var #\A #\Z ,result ,forms))
96    (t (error "Kind argument not one of :lower, :upper, or :both -- ~S."
97              kind))))
Note: See TracBrowser for help on using the repository browser.