/[mcclim]/mcclim/dead-keys.lisp
ViewVC logotype

Contents of /mcclim/dead-keys.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.3 - (hide annotations)
Thu May 1 07:48:45 2008 UTC (5 years, 11 months ago) by thenriksen
Branch: MAIN
Changes since 1.2: +10 -8 lines
Removed some code duplication in dead key handling.
1 thenriksen 1.1 ;;; -*- Mode: Lisp; Package: CLIM-INTERNALS -*-
2    
3     ;;; (c) copyright 2008 by
4     ;;; Troels Henriksen (athas@sigkill.dk)
5    
6     ;;; This library is free software; you can redistribute it and/or
7     ;;; modify it under the terms of the GNU Library General Public
8     ;;; License as published by the Free Software Foundation; either
9     ;;; version 2 of the License, or (at your option) any later version.
10     ;;;
11     ;;; This library is distributed in the hope that it will be useful,
12     ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
13     ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
14     ;;; Library General Public License for more details.
15     ;;;
16     ;;; You should have received a copy of the GNU Library General Public
17     ;;; License along with this library; if not, write to the
18     ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19     ;;; Boston, MA 02111-1307 USA.
20    
21     ;;; Define various dead keys - perhaps this should be more
22     ;;; backend-agnostic? Bah...
23    
24     (in-package :clim-internals)
25    
26     (defun set-dead-key-combination (character gestures table)
27     "Set `gestures' to result in `character' in the hash table
28     `table' (see `*dead-key-table*' for the format of the hash
29     table)."
30     (assert (not (null gestures)))
31     (if (null (rest gestures))
32     ;; Just add it directly to this table.
33     (setf (gethash (first gestures) table) character)
34     ;; Ensure that the subtable exists.
35     (let ((new-table (setf (gethash (first gestures) table)
36     (gethash (first gestures) table
37     (make-hash-table :test 'equal)))))
38     (set-dead-key-combination character (rest gestures) new-table))))
39    
40     (defmacro define-dead-key-combination (character (&rest gestures))
41     "Define a dead key combination that results in `character' when
42     `gestures' (either characters or key names) is entered."
43     (assert (>= (length gestures) 2))
44     `(set-dead-key-combination ,character ',gestures *dead-key-table*))
45    
46     (define-dead-key-combination (code-char 193) (:dead-acute #\a))
47     (define-dead-key-combination (code-char 201) (:dead-acute #\e))
48     (define-dead-key-combination (code-char 205) (:dead-acute #\i))
49     (define-dead-key-combination (code-char 211) (:dead-acute #\o))
50     (define-dead-key-combination (code-char 218) (:dead-acute #\u))
51     (define-dead-key-combination (code-char 221) (:dead-acute #\y))
52     (define-dead-key-combination (code-char 225) (:dead-acute #\a))
53     (define-dead-key-combination (code-char 233) (:dead-acute #\e))
54     (define-dead-key-combination (code-char 237) (:dead-acute #\i))
55     (define-dead-key-combination (code-char 243) (:dead-acute #\o))
56     (define-dead-key-combination (code-char 250) (:dead-acute #\u))
57     (define-dead-key-combination (code-char 253) (:dead-acute #\y))
58     (define-dead-key-combination (code-char 199) (:dead-acute #\c))
59     (define-dead-key-combination (code-char 231) (:dead-acute #\c))
60     (define-dead-key-combination (code-char 215) (:dead-acute #\x))
61     (define-dead-key-combination (code-char 247) (:dead-acute #\-))
62     (define-dead-key-combination (code-char 222) (:dead-acute #\t))
63     (define-dead-key-combination (code-char 254) (:dead-acute #\t))
64     (define-dead-key-combination (code-char 223) (:dead-acute #\s))
65     (define-dead-key-combination (code-char 39) (:dead-acute #\space))
66     (define-dead-key-combination (code-char 197) (:dead-acute :dead-acute #\a))
67     (define-dead-key-combination (code-char 229) (:dead-acute :dead-acute #\a))
68     (define-dead-key-combination (code-char 192) (:dead-grave #\a))
69     (define-dead-key-combination (code-char 200) (:dead-grave #\e))
70     (define-dead-key-combination (code-char 204) (:dead-grave #\i))
71     (define-dead-key-combination (code-char 210) (:dead-grave #\o))
72     (define-dead-key-combination (code-char 217) (:dead-grave #\u))
73     (define-dead-key-combination (code-char 224) (:dead-grave #\a))
74     (define-dead-key-combination (code-char 232) (:dead-grave #\e))
75     (define-dead-key-combination (code-char 236) (:dead-grave #\i))
76     (define-dead-key-combination (code-char 242) (:dead-grave #\o))
77     (define-dead-key-combination (code-char 249) (:dead-grave #\u))
78     (define-dead-key-combination (code-char 96) (:dead-grave #\space))
79     (define-dead-key-combination (code-char 96) (:dead-grave :dead-grave))
80     (define-dead-key-combination (code-char 196) (:dead-diaeresis #\a))
81     (define-dead-key-combination (code-char 203) (:dead-diaeresis #\e))
82     (define-dead-key-combination (code-char 207) (:dead-diaeresis #\i))
83     (define-dead-key-combination (code-char 214) (:dead-diaeresis #\o))
84     (define-dead-key-combination (code-char 220) (:dead-diaeresis #\u))
85     (define-dead-key-combination (code-char 228) (:dead-diaeresis #\a))
86     (define-dead-key-combination (code-char 235) (:dead-diaeresis #\e))
87     (define-dead-key-combination (code-char 239) (:dead-diaeresis #\i))
88     (define-dead-key-combination (code-char 246) (:dead-diaeresis #\o))
89     (define-dead-key-combination (code-char 252) (:dead-diaeresis #\u))
90     (define-dead-key-combination (code-char 255) (:dead-diaeresis #\y))
91     (define-dead-key-combination (code-char 168) (:dead-diaeresis #\space))
92     (define-dead-key-combination (code-char 168) (:dead-diaeresis :dead-diaeresis))
93     (define-dead-key-combination (code-char 195) (:dead-tilde #\a))
94     (define-dead-key-combination (code-char 209) (:dead-tilde #\n))
95     (define-dead-key-combination (code-char 227) (:dead-tilde #\a))
96     (define-dead-key-combination (code-char 241) (:dead-tilde #\n))
97     (define-dead-key-combination (code-char 198) (:dead-tilde #\e))
98     (define-dead-key-combination (code-char 230) (:dead-tilde #\e))
99     (define-dead-key-combination (code-char 208) (:dead-tilde #\d))
100     (define-dead-key-combination (code-char 240) (:dead-tilde #\d))
101     (define-dead-key-combination (code-char 245) (:dead-tilde #\o))
102     (define-dead-key-combination (code-char 126) (:dead-tilde #\space))
103     (define-dead-key-combination (code-char 126) (:dead-tilde :dead-tilde))
104     (define-dead-key-combination (code-char 194) (:dead-circumflex #\a))
105     (define-dead-key-combination (code-char 202) (:dead-circumflex #\e))
106     (define-dead-key-combination (code-char 206) (:dead-circumflex #\i))
107     (define-dead-key-combination (code-char 212) (:dead-circumflex #\o))
108     (define-dead-key-combination (code-char 219) (:dead-circumflex #\u))
109     (define-dead-key-combination (code-char 226) (:dead-circumflex #\a))
110     (define-dead-key-combination (code-char 234) (:dead-circumflex #\e))
111     (define-dead-key-combination (code-char 238) (:dead-circumflex #\i))
112     (define-dead-key-combination (code-char 244) (:dead-circumflex #\o))
113     (define-dead-key-combination (code-char 251) (:dead-circumflex #\u))
114     (define-dead-key-combination (code-char 94) (:dead-circumflex #\space))
115     (define-dead-key-combination (code-char 94) (:dead-circumflex :dead-circumflex))
116 thenriksen 1.2
117     (defmacro merging-dead-keys ((gesture state) &body body)
118     "Accumulate dead keys and subsequent characters. `Gesture'
119     should be a symbol bound to either a gesture or an input
120 thenriksen 1.3 event. `Body' will be evaluated either with the `gesture' binding
121     unchanged, or with `gesture' bound to the result of merging
122     preceding dead keys. `State' must be a place, initially NIL, that
123     will contain the state of dead-key handling, enabling
124     asynchronous use of the macro."
125 thenriksen 1.2 `(flet ((invoke-body (,gesture)
126     ,@body))
127     (when (null ,state)
128     (setf ,state *dead-key-table*))
129     (if (typep ,gesture '(or keyboard-event character))
130     (let ((value (gethash (if (characterp ,gesture)
131     ,gesture
132     (keyboard-event-key-name ,gesture))
133     ,state)))
134     (etypecase value
135     (null
136     (cond ((eq ,state *dead-key-table*)
137     (invoke-body ,gesture))
138     ((or (and (typep ,gesture 'keyboard-event)
139     (keyboard-event-character ,gesture))
140     (characterp ,gesture))
141     (setf ,state *dead-key-table*))))
142     (character
143 thenriksen 1.3 (setf ,state *dead-key-table*)
144 thenriksen 1.2 (invoke-body value))
145     (hash-table
146 thenriksen 1.3 (setf ,state value)
147     (invoke-body value))))
148     (progn (setf ,state *dead-key-table*)
149     (invoke-body ,gesture)))))

  ViewVC Help
Powered by ViewVC 1.1.5