[climacs-cvs] CVS climacs

[crhodes]

Update of /project/climacs/cvsroot/climacs
In directory clnet:/tmp/cvs-serv25029

Modified Files:
	unicode-commands.lisp 
Log Message:
Make unicode-commands (really "latin1-commands") more useful.

:dead--acute and friends were apparently from an older, typoed version 
of mcclim; those keysyms had long since been replaced by :dead-acute.  
Rewrite the implementation of the dead-diacritic commands anyway, so 
that the next change is easier to make.  Now some of these dead commands 
work for me and others don't; this is the usual shifted/unshifted 
problem -- I get dead-circumflex by typing AltGr+', which is unshifted, 
whereas the implementation presumably works on those keyboards where you 
get dead-circumflex by hitting ^ (which is Shift+6?).

Bleeding-edge SBCL/CLX users can also type latin1 characters directly 
(depending on what they've got in their keymap); for instance, for 
me, AltGr+1 gives me a superscript 1; Shift+3 gives me a pound sign.


--- /project/climacs/cvsroot/climacs/unicode-commands.lisp	2005/11/12 09:38:32	1.1
+++ /project/climacs/cvsroot/climacs/unicode-commands.lisp	2006/03/14 14:45:43	1.2
@@ -28,79 +28,101 @@
 
 (in-package :climacs-gui)
 
-(define-command (com-insert-charcode :name t :command-table self-insert-table)
-    ((code 'integer :prompt "Code point"))
-  (insert-object (point (current-window)) (code-char code)))
+(do ((i 160 (+ i 1)))
+    ((> i 255))
+  (set-key `(com-self-insert ,*numeric-argument-marker*) 
+           'self-insert-table (list (code-char i))))
 
-(set-key '(com-insert-charcode 193) 'self-insert-table '((:dead--acute)(#\A)))
-(set-key '(com-insert-charcode 201) 'self-insert-table '((:dead--acute)(#\E)))
-(set-key '(com-insert-charcode 205) 'self-insert-table '((:dead--acute)(#\I)))
-(set-key '(com-insert-charcode 211) 'self-insert-table '((:dead--acute)(#\O)))
-(set-key '(com-insert-charcode 218) 'self-insert-table '((:dead--acute)(#\U)))
-(set-key '(com-insert-charcode 221) 'self-insert-table '((:dead--acute)(#\Y)))
-(set-key '(com-insert-charcode 225) 'self-insert-table '((:dead--acute)(#\a)))
-(set-key '(com-insert-charcode 233) 'self-insert-table '((:dead--acute)(#\e)))
-(set-key '(com-insert-charcode 237) 'self-insert-table '((:dead--acute)(#\i)))
-(set-key '(com-insert-charcode 243) 'self-insert-table '((:dead--acute)(#\o)))
-(set-key '(com-insert-charcode 250) 'self-insert-table '((:dead--acute)(#\u)))
-(set-key '(com-insert-charcode 253) 'self-insert-table '((:dead--acute)(#\y)))
-(set-key '(com-insert-charcode 199) 'self-insert-table '((:dead--acute)(#\C)))
-(set-key '(com-insert-charcode 231) 'self-insert-table '((:dead--acute)(#\c)))
-(set-key '(com-insert-charcode 215) 'self-insert-table '((:dead--acute)(#\x)))
-(set-key '(com-insert-charcode 247) 'self-insert-table '((:dead--acute)(#\-)))
-(set-key '(com-insert-charcode 222) 'self-insert-table '((:dead--acute)(#\T)))
-(set-key '(com-insert-charcode 254) 'self-insert-table '((:dead--acute)(#\t)))
-(set-key '(com-insert-charcode 223) 'self-insert-table '((:dead--acute)(#\s)))
-(set-key '(com-insert-charcode 39) 'self-insert-table '((:dead--acute)(#\Space)))
-
-(set-key '(com-insert-charcode 197) 'self-insert-table '((:dead--acute)(:dead--acute)(#\A)))
-(set-key '(com-insert-charcode 229) 'self-insert-table '((:dead--acute)(:dead--acute)(#\a)))
-
-(set-key '(com-insert-charcode 192) 'self-insert-table '((:dead--grave)(#\A)))
-(set-key '(com-insert-charcode 200) 'self-insert-table '((:dead--grave)(#\E)))
-(set-key '(com-insert-charcode 204) 'self-insert-table '((:dead--grave)(#\I)))
-(set-key '(com-insert-charcode 210) 'self-insert-table '((:dead--grave)(#\O)))
-(set-key '(com-insert-charcode 217) 'self-insert-table '((:dead--grave)(#\U)))
-(set-key '(com-insert-charcode 224) 'self-insert-table '((:dead--grave)(#\a)))
-(set-key '(com-insert-charcode 232) 'self-insert-table '((:dead--grave)(#\e)))
-(set-key '(com-insert-charcode 236) 'self-insert-table '((:dead--grave)(#\i)))
-(set-key '(com-insert-charcode 242) 'self-insert-table '((:dead--grave)(#\o)))
-(set-key '(com-insert-charcode 249) 'self-insert-table '((:dead--grave)(#\u)))
-(set-key '(com-insert-charcode 96) 'self-insert-table '((:dead--grave)(#\Space)))
-
-(set-key '(com-insert-charcode 196) 'self-insert-table '((:dead--diaeresis :shift)(#\A)))
-(set-key '(com-insert-charcode 203) 'self-insert-table '((:dead--diaeresis :shift)(#\E)))
-(set-key '(com-insert-charcode 207) 'self-insert-table '((:dead--diaeresis :shift)(#\I)))
-(set-key '(com-insert-charcode 214) 'self-insert-table '((:dead--diaeresis :shift)(#\O)))
-(set-key '(com-insert-charcode 220) 'self-insert-table '((:dead--diaeresis :shift)(#\U)))
-(set-key '(com-insert-charcode 228) 'self-insert-table '((:dead--diaeresis :shift)(#\a)))
-(set-key '(com-insert-charcode 235) 'self-insert-table '((:dead--diaeresis :shift)(#\e)))
-(set-key '(com-insert-charcode 239) 'self-insert-table '((:dead--diaeresis :shift)(#\i)))
-(set-key '(com-insert-charcode 246) 'self-insert-table '((:dead--diaeresis :shift)(#\o)))
-(set-key '(com-insert-charcode 252) 'self-insert-table '((:dead--diaeresis :shift)(#\u)))
-(set-key '(com-insert-charcode 255) 'self-insert-table '((:dead--diaeresis :shift)(#\y)))
-(set-key '(com-insert-charcode 34) 'self-insert-table '((:dead--diaeresis :shift)(#\Space)))
-
-(set-key '(com-insert-charcode 195) 'self-insert-table '((:dead--tilde :shift)(#\A)))
-(set-key '(com-insert-charcode 209) 'self-insert-table '((:dead--tilde :shift)(#\N)))
-(set-key '(com-insert-charcode 227) 'self-insert-table '((:dead--tilde :shift)(#\a)))
-(set-key '(com-insert-charcode 241) 'self-insert-table '((:dead--tilde :shift)(#\n)))
-(set-key '(com-insert-charcode 198) 'self-insert-table '((:dead--tilde :shift)(#\E)))
-(set-key '(com-insert-charcode 230) 'self-insert-table '((:dead--tilde :shift)(#\e)))
-(set-key '(com-insert-charcode 208) 'self-insert-table '((:dead--tilde :shift)(#\D)))
-(set-key '(com-insert-charcode 240) 'self-insert-table '((:dead--tilde :shift)(#\d)))
-(set-key '(com-insert-charcode 216) 'self-insert-table '((:dead--tilde :shift)(#\O)))
-(set-key '(com-insert-charcode 248) 'self-insert-table '((:dead--tilde :shift)(#\o)))
-(set-key '(com-insert-charcode 126) 'self-insert-table '((:dead--tilde :shift)(#\Space)))
-
-(set-key '(com-insert-charcode 194) 'self-insert-table '((:dead--circumflex :shift)(#\A)))
-(set-key '(com-insert-charcode 202) 'self-insert-table '((:dead--circumflex :shift)(#\E)))
-(set-key '(com-insert-charcode 206) 'self-insert-table '((:dead--circumflex :shift)(#\I)))
-(set-key '(com-insert-charcode 212) 'self-insert-table '((:dead--circumflex :shift)(#\O)))
-(set-key '(com-insert-charcode 219) 'self-insert-table '((:dead--circumflex :shift)(#\U)))
-(set-key '(com-insert-charcode 226) 'self-insert-table '((:dead--circumflex :shift)(#\a)))
-(set-key '(com-insert-charcode 234) 'self-insert-table '((:dead--circumflex :shift)(#\e)))
-(set-key '(com-insert-charcode 238) 'self-insert-table '((:dead--circumflex :shift)(#\i)))
-(set-key '(com-insert-charcode 244) 'self-insert-table '((:dead--circumflex :shift)(#\o)))
-(set-key '(com-insert-charcode 251) 'self-insert-table '((:dead--circumflex :shift)(#\u)))
-(set-key '(com-insert-charcode 94) 'self-insert-table '((:dead--circumflex :shift)(#\Space)))
+(define-command (com-insert-charcode :name t :command-table self-insert-table)
+    ((code 'integer :prompt "Code point") (count 'integer))
+  (let ((char (code-char code)))
+    (loop repeat count do (insert-character char))))
+
+(macrolet 
+    ((set-charcode-key (code sequence)
+       `(set-key 
+         `(com-insert-charcode ,',code ,*numeric-argument-marker*)
+         'self-insert-table
+         ',sequence))
+     (set-dead-acute-key (code &rest sequence)
+       `(set-charcode-key ,code ((:dead-acute) , at sequence)))
+     (set-dead-grave-key (code &rest sequence)
+       `(set-charcode-key ,code ((:dead-grave) , at sequence)))
+     (set-dead-diaresis-key (code &rest sequence)
+       `(set-charcode-key ,code ((:dead-diaresis :shift) , at sequence)))
+     (set-dead-tilde-key (code &rest sequence)
+       `(set-charcode-key ,code ((:dead-tilde :shift) , at sequence)))
+     (set-dead-circumflex-key (code &rest sequence)
+       `(set-charcode-key ,code ((:dead-circumflex :shift) , at sequence))))
+  (set-dead-acute-key 193 (#\A))
+  (set-dead-acute-key 201 (#\E)) 
+  (set-dead-acute-key 205 (#\I))
+  (set-dead-acute-key 211 (#\O))
+  (set-dead-acute-key 218 (#\U))
+  (set-dead-acute-key 221 (#\Y))
+  (set-dead-acute-key 225 (#\a))
+  (set-dead-acute-key 233 (#\e))
+  (set-dead-acute-key 237 (#\i))
+  (set-dead-acute-key 243 (#\o))
+  (set-dead-acute-key 250 (#\u))
+  (set-dead-acute-key 253 (#\y))
+  (set-dead-acute-key 199 (#\C))
+  (set-dead-acute-key 231 (#\c))
+  (set-dead-acute-key 215 (#\x))
+  (set-dead-acute-key 247 (#\-))
+  (set-dead-acute-key 222 (#\T))
+  (set-dead-acute-key 254 (#\t))
+  (set-dead-acute-key 223 (#\s))
+  (set-dead-acute-key 39 (#\Space))
+
+  (set-dead-acute-key 197 (:dead-acute) (#\A))
+  (set-dead-acute-key 229 (:dead-acute) (#\a))
+
+  (set-dead-grave-key 192 (#\A))
+  (set-dead-grave-key 200 (#\E))
+  (set-dead-grave-key 204 (#\I))
+  (set-dead-grave-key 210 (#\O))
+  (set-dead-grave-key 217 (#\U))
+  (set-dead-grave-key 224 (#\a))
+  (set-dead-grave-key 232 (#\e))
+  (set-dead-grave-key 236 (#\i))
+  (set-dead-grave-key 242 (#\o))
+  (set-dead-grave-key 249 (#\u))
+  (set-dead-grave-key 96 (#\Space))
+
+  (set-dead-diaresis-key 196 (#\A))
+  (set-dead-diaresis-key 203 (#\E))
+  (set-dead-diaresis-key 207 (#\I))
+  (set-dead-diaresis-key 214 (#\O))
+  (set-dead-diaresis-key 220 (#\U))
+  (set-dead-diaresis-key 228 (#\a))
+  (set-dead-diaresis-key 235 (#\e))
+  (set-dead-diaresis-key 239 (#\i))
+  (set-dead-diaresis-key 246 (#\o))
+  (set-dead-diaresis-key 252 (#\u))
+  (set-dead-diaresis-key 255 (#\y))
+  (set-dead-diaresis-key 34  (#\Space))
+
+  (set-dead-tilde-key 195 (#\A))
+  (set-dead-tilde-key 209 (#\N))
+  (set-dead-tilde-key 227 (#\a))
+  (set-dead-tilde-key 241 (#\n))
+
+  (set-dead-tilde-key 198 (#\E))
+  (set-dead-tilde-key 230 (#\e))
+  (set-dead-tilde-key 208 (#\D))
+  (set-dead-tilde-key 240 (#\d))
+  (set-dead-tilde-key 248 (#\o))
+  (set-dead-tilde-key 126 (#\Space))
+
+  (set-dead-circumflex-key 194 (#\A))
+  (set-dead-circumflex-key 202 (#\E))
+  (set-dead-circumflex-key 206 (#\I))
+  (set-dead-circumflex-key 212 (#\O))
+  (set-dead-circumflex-key 219 (#\U))
+  (set-dead-circumflex-key 226 (#\a))
+  (set-dead-circumflex-key 234 (#\e))
+  (set-dead-circumflex-key 238 (#\i))
+  (set-dead-circumflex-key 244 (#\o))
+  (set-dead-circumflex-key 251 (#\u))
+  (set-dead-circumflex-key 94 (#\Space)))