Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 198 lines (169 sloc) 10.023 kb
a067608 added divascheme from gmarceau's tree (r603) into plt subversion server
dyoo authored
1 (module command-keymap mzscheme
2 (require (lib "etc.ss")
3 (lib "class.ss")
4 (lib "framework.ss" "framework")
4a325b0 keyboard shortcuts for the orbiTouch
gmarceau authored
5 (lib "mred.ss" "mred")
ef0389f pushing command keymap configuration data into diva-preferences.ss in pr...
dyoo authored
6 (lib "list.ss")
aae862a Moving files.
Danny Yoo authored
7 "gui/choose-paren.ss"
ef0389f pushing command keymap configuration data into diva-preferences.ss in pr...
dyoo authored
8 "structures.ss"
f21b223 mouse click now select the expression
gmarceau authored
9 "utilities.ss"
ef0389f pushing command keymap configuration data into diva-preferences.ss in pr...
dyoo authored
10 (prefix preferences: "diva-preferences.ss"))
4a325b0 keyboard shortcuts for the orbiTouch
gmarceau authored
11
a067608 added divascheme from gmarceau's tree (r603) into plt subversion server
dyoo authored
12 (provide make-command-keymap)
13
4a325b0 keyboard shortcuts for the orbiTouch
gmarceau authored
14
b5e19b0 refactoring to make intent clearer
dyoo authored
15 ;; A grab-key-function that looks at unmapped keys that look like
16 ;; capslock is on, and tries to remap to keys that aren't caps-locked.
a6ddf18 pushed up the ignores-capslock code up a bit
dyoo authored
17 (define (ignores-caps-lock-grab-key-function str km editor event)
b5e19b0 refactoring to make intent clearer
dyoo authored
18 (define (caps-lock-on?)
19 (and (not str)
20 (is-a? event key-event%)
21 (char? (send event get-key-code))
22 (char-upper-case? (send event get-key-code))
23 (not (send event get-shift-down))))
24 (define (copy-key/downcase)
25 (let ([key-event
26 (new key-event%
27 [key-code (char-downcase (send event get-key-code))]
28 [shift-down #f]
29 [control-down (send event get-control-down)]
30 [meta-down (send event get-meta-down)]
31 [alt-down (send event get-alt-down)]
32 [x (send event get-x)]
33 [y (send event get-y)]
34 [time-stamp (send event get-time-stamp)])])
35 (send key-event set-other-altgr-key-code
36 (send key-event get-other-altgr-key-code))
37 (send key-event set-other-shift-altgr-key-code
38 (send key-event get-other-shift-altgr-key-code))
39 (send key-event set-other-shift-key-code
40 (send key-event get-other-shift-key-code))
41 key-event))
42 (if (caps-lock-on?)
43 (send km handle-key-event editor
44 (copy-key/downcase))
a6ddf18 pushed up the ignores-capslock code up a bit
dyoo authored
45 #f))
46
47
48
a067608 added divascheme from gmarceau's tree (r603) into plt subversion server
dyoo authored
49 (define make-command-keymap
d4d30bb trying to generalize code to add preference subpanel for insert mode too
dyoo authored
50 (lambda (window-text to-insert-mode to-insert-mode/cmd diva-message diva-question interpreter)
a067608 added divascheme from gmarceau's tree (r603) into plt subversion server
dyoo authored
51 (let ([command-keymap (make-object keymap:aug-keymap%)])
4a325b0 keyboard shortcuts for the orbiTouch
gmarceau authored
52
a067608 added divascheme from gmarceau's tree (r603) into plt subversion server
dyoo authored
53 (define (make-command-to-argument-mode command title)
54 (let ([default ""])
55 (lambda ()
56 (diva-question title
57 default
58 argument-to-command-mode
59 (lambda (text)
60 (set! default text)
736eef8 renamed stags to generate-stags. Also changed so that generate-stags is...
dyoo authored
61 (interpreter (make-Verb (make-Command command)
62 false
63 (make-WhatN (make-Symbol-Noun
64 (string->symbol text)))))
a067608 added divascheme from gmarceau's tree (r603) into plt subversion server
dyoo authored
65 (argument-to-command-mode))))))
736eef8 renamed stags to generate-stags. Also changed so that generate-stags is...
dyoo authored
66
a067608 added divascheme from gmarceau's tree (r603) into plt subversion server
dyoo authored
67 (define (argument-to-command-mode)
91bdb51 added check just in case we're no longer the active text%, which happens...
dyoo authored
68 (let [(canvas (send window-text get-canvas))]
69 (when canvas
70 (send canvas focus))))
a067608 added divascheme from gmarceau's tree (r603) into plt subversion server
dyoo authored
71
72 (define (command command)
73 (lambda (any event)
74 (interpreter (make-Verb (make-Command command) false false))))
736eef8 renamed stags to generate-stags. Also changed so that generate-stags is...
dyoo authored
75
a067608 added divascheme from gmarceau's tree (r603) into plt subversion server
dyoo authored
76 (define insert-before-ast
77 (make-Verb (make-Command 'Insert) (make-Loc (make-Before) false) false))
78 (define insert-after-ast
79 (make-Verb (make-Command 'Insert) (make-Loc (make-After) false) false))
91bdb51 added check just in case we're no longer the active text%, which happens...
dyoo authored
80
81
a067608 added divascheme from gmarceau's tree (r603) into plt subversion server
dyoo authored
82 (define (insert ast/false edit?)
83 (lambda (any event)
84 (when ast/false
85 (interpreter ast/false))
86 (to-insert-mode edit?)))
87
88 (define (insert/cmd cmd edit?)
89 (lambda (any event)
90 (to-insert-mode/cmd edit? cmd)))
1d7d7f3 added integration for scheme's automatic paren shape selection on comman...
dyoo authored
91
92
7f0bdfc introduced alternative keybinding command diva:open-square/contextual to...
dyoo authored
93 (define (insert-contextual-open/cmd cmd edit?)
1d7d7f3 added integration for scheme's automatic paren shape selection on comman...
dyoo authored
94 (lambda (editor event)
7f0bdfc introduced alternative keybinding command diva:open-square/contextual to...
dyoo authored
95 (to-insert-mode/cmd edit? (get-contextual-open-cmd editor cmd))))
1d7d7f3 added integration for scheme's automatic paren shape selection on comman...
dyoo authored
96
97
f21b223 mouse click now select the expression
gmarceau authored
98 (define (command-mouse cmd)
99 (lambda (edit event)
100 (let ([x-box (box (send event get-x))]
101 [y-box (box (send event get-y))]
102 [eol-box (box #f)])
103 (send edit global-to-local x-box y-box)
104 (let ([click-pos (send edit find-position
105 (unbox x-box)
106 (unbox y-box)
107 eol-box)])
108 (let ([eol (unbox eol-box)])
109 (interpreter (make-Verb (make-Command cmd)
110 (make-Pos (index->syntax-pos click-pos) eol)
111 false)))))))
112
a067608 added divascheme from gmarceau's tree (r603) into plt subversion server
dyoo authored
113 (define (argument command title)
114 (let ([command/default (make-command-to-argument-mode command title)])
115 (lambda (any event)
116 (command/default))))
4a325b0 keyboard shortcuts for the orbiTouch
gmarceau authored
117
118 (add-text-keymap-functions command-keymap)
119
ef0389f pushing command keymap configuration data into diva-preferences.ss in pr...
dyoo authored
120 (send command-keymap add-function "diva:enter" (command 'Enter))
a067608 added divascheme from gmarceau's tree (r603) into plt subversion server
dyoo authored
121 (send command-keymap add-function "diva:indent" (command 'Indent))
122 (send command-keymap add-function "diva:before-this" (insert insert-before-ast false))
123 (send command-keymap add-function "diva:after-this" (insert insert-after-ast false))
124 (send command-keymap add-function "diva:insert" (insert false false))
125 (send command-keymap add-function "diva:up" (command 'Up))
126 (send command-keymap add-function "diva:down" (command 'Down))
127 (send command-keymap add-function "diva:out" (command 'Out))
128 (send command-keymap add-function "diva:backward" (command 'Backward))
129 (send command-keymap add-function "diva:forward" (command 'Forward))
130 (send command-keymap add-function "diva:next" (command 'Next))
131 (send command-keymap add-function "diva:previous" (command 'Previous))
132 (send command-keymap add-function "diva:select" (argument 'Select "select"))
133 (send command-keymap add-function "diva:search-forward" (argument 'Search-Forward "search forward"))
134 (send command-keymap add-function "diva:search-backward" (argument 'Search-Backward "search backward"))
135 (send command-keymap add-function "diva:copy" (command 'Copy))
136 (send command-keymap add-function "diva:cut" (command 'Cut))
137 (send command-keymap add-function "diva:paste" (command 'Paste))
138 (send command-keymap add-function "diva:undo" (command 'Undo))
139 (send command-keymap add-function "diva:cancel" (command 'Cancel))
140 (send command-keymap add-function "diva:redo" (command 'Redo))
141 (send command-keymap add-function "diva:delete" (command 'Delete))
142 (send command-keymap add-function "diva:push" (command 'Push))
143 (send command-keymap add-function "diva:bring" (command 'Bring))
144 (send command-keymap add-function "diva:exchange" (command 'Exchange))
145 (send command-keymap add-function "diva:mark" (command 'Mark))
146 (send command-keymap add-function "diva:holder" (command 'Holder))
147 (send command-keymap add-function "diva:transpose" (command 'Transpose))
148 (send command-keymap add-function "diva:find-tag" (argument 'Tag "Find tag"))
149 (send command-keymap add-function "diva:magic" (command 'Magic))
150 (send command-keymap add-function "diva:join" (command 'Join))
151 (send command-keymap add-function "diva:unmark" (command 'UnMark))
7f0bdfc introduced alternative keybinding command diva:open-square/contextual to...
dyoo authored
152
153 (send command-keymap add-function "diva:open" (insert/cmd 'Open false))
154 (send command-keymap add-function "diva:open-square/contextual" (insert-contextual-open/cmd 'Open-Square false))
155 (send command-keymap add-function "diva:open-square" (insert/cmd 'Open-Square false))
156
a067608 added divascheme from gmarceau's tree (r603) into plt subversion server
dyoo authored
157 (send command-keymap add-function "diva:close" (command 'Close))
158 (send command-keymap add-function "diva:search-top" (argument 'Search-Top "search top" ))
159 (send command-keymap add-function "diva:search-bottom" (argument 'Search-Bottom "search bottom"))
160 (send command-keymap add-function "diva:definition" (argument 'Definition "definition"))
161 (send command-keymap add-function "diva:usage" (argument 'Usage "usage"))
162 (send command-keymap add-function "diva:younger" (command 'Younger))
163 (send command-keymap add-function "diva:older" (command 'Older))
164 (send command-keymap add-function "diva:first" (command 'First))
165 (send command-keymap add-function "diva:last" (command 'Last))
166 (send command-keymap add-function "diva:extend-selection" (command 'Extend-Selection))
0310433 bug fix to extend selection
gmarceau authored
167 (send command-keymap add-function "diva:stop-extend-selection" (command 'Stop-Extend-Selection))
a067608 added divascheme from gmarceau's tree (r603) into plt subversion server
dyoo authored
168 (send command-keymap add-function "diva:edit-symbol" (insert false true))
169 (send command-keymap add-function "diva:disabled" void)
f21b223 mouse click now select the expression
gmarceau authored
170 (send command-keymap add-function "diva:non-blank-out" (command-mouse 'Non-blank-out))
171 (send command-keymap map-function "leftbutton" "diva:non-blank-out")
6386caa trying to trace weird unsetting bug with keymap preferences
dyoo authored
172 (for-each
a067608 added divascheme from gmarceau's tree (r603) into plt subversion server
dyoo authored
173 (lambda (key) (send command-keymap map-function key "diva:disabled"))
174 `("1" "2" "3" "4" "5" "6" "7" "8" "9" "0"
175 "!" "@" "#" "$" "%" "^" "&" "*"
176 "_" "-" "=" "+"
177 "backspace" "delete" "|"
766f9c3 added preference panel for editing keybindings
dyoo authored
178 "`" "\"" "," "'" "<" ">" "/" "\\" "?"
d91f6e5 renabled escape in the command keymap to allow meta commands
dyoo authored
179 "insert" "colon"
a067608 added divascheme from gmarceau's tree (r603) into plt subversion server
dyoo authored
180 ,@(map (lambda (ch) (format "s:~a" ch))
dadf7c3 attacking screwy issue with keymaps and CAPS LOCK. Yikes.
dyoo authored
181 (string->list "abcdefghijklmnopqrstuvwxyz"))
a067608 added divascheme from gmarceau's tree (r603) into plt subversion server
dyoo authored
182 ,@(map string
183 (string->list "abcdefghijklmnopqrstuvwxyz"))))
4a325b0 keyboard shortcuts for the orbiTouch
gmarceau authored
184
dadf7c3 attacking screwy issue with keymaps and CAPS LOCK. Yikes.
dyoo authored
185
186 ;; When caps lock is on, it appears that something screwy happens with
187 ;; key lookup. I may want to refactor this out or ask on the PLT list
188 ;; what the right thing to do here is.
a6ddf18 pushed up the ignores-capslock code up a bit
dyoo authored
189 ;; The following tries to ignore caps lock.
26771c0 added check for what text mode we're running under; if it's not Scheme, ...
dyoo authored
190 (send command-keymap set-grab-key-function
191 ignores-caps-lock-grab-key-function)
dadf7c3 attacking screwy issue with keymaps and CAPS LOCK. Yikes.
dyoo authored
192
193
6386caa trying to trace weird unsetting bug with keymap preferences
dyoo authored
194 (preferences:install-command-mode-bindings command-keymap)
4a325b0 keyboard shortcuts for the orbiTouch
gmarceau authored
195
196
a067608 added divascheme from gmarceau's tree (r603) into plt subversion server
dyoo authored
197 command-keymap))))
Something went wrong with that request. Please try again.