diff --git a/collects/framework/editor.ss b/collects/framework/editor.ss index 7221f467..3f2eb683 100644 --- a/collects/framework/editor.ss +++ b/collects/framework/editor.ss @@ -162,7 +162,7 @@ (apply super-init args) (auto-wrap (default-auto-wrap?))))) - (define -keymap<%> (interface (basic<%>))) + (define -keymap<%> (interface (basic<%>) get-keymaps)) (define keymap-mixin (mixin (basic<%>) (-keymap<%>) args (public @@ -179,18 +179,20 @@ (add-text-keymap-functions keymap) (add-pasteboard-keymap-functions keymap) (for-each (lambda (k) + (keymap:set-keymap-error-handler k) + (keymap:set-keymap-implied-shifts k) (send keymap chain-to-keymap k #f)) (get-keymaps)))))) - (define file<%> (interface (basic<%>))) - (define file-mixin ;; wx - should come from -keymap<%> - (mixin (basic<%>) (file<%>) args - (inherit get-keymap - get-filename lock get-style-list + (define file<%> (interface (-keymap<%>))) + (define file-mixin + (mixin (-keymap<%>) (file<%>) args + (inherit get-filename lock get-style-list is-modified? change-style set-modified get-top-level-window) (rename [super-after-save-file after-save-file] - [super-after-load-file after-load-file]) + [super-after-load-file after-load-file] + [super-get-keymaps get-keymaps]) (override [editing-this-file? (lambda () #t)]) (private @@ -215,11 +217,12 @@ (lambda (sucessful?) (when sucessful? (check-lock)) - (super-after-load-file sucessful?))]) + (super-after-load-file sucessful?))] + [get-keymaps + (lambda () + (cons (keymap:get-file) (super-get-keymaps)))]) (sequence - (apply super-init args) - (let ([keymap (get-keymap)]) - (send keymap chain-to-keymap (keymap:get-file) #f))))) + (apply super-init args)))) (define backup-autosave<%> (interface (basic<%>) diff --git a/collects/framework/frameworks.ss b/collects/framework/frameworks.ss index ab74bbf7..d459b48b 100644 --- a/collects/framework/frameworks.ss +++ b/collects/framework/frameworks.ss @@ -88,11 +88,13 @@ (define-signature framework:editor^ (basic<%> + keymap<%> info<%> file<%> backup-autosave<%> basic-mixin + keymap-mixin info-mixin file-mixin backup-autosave-mixin)) diff --git a/collects/framework/keymap.ss b/collects/framework/keymap.ss index 55fdb3d3..0db2fcc8 100644 --- a/collects/framework/keymap.ss +++ b/collects/framework/keymap.ss @@ -9,10 +9,6 @@ (rename [-get-file get-file]) - ; This is a list of keys that are typed with the SHIFT key, but - ; are not normally thought of as shifted. It will have to be - ; changed for different keyboards. - (define keyerr (lambda (str) (display str (current-error-port)) diff --git a/collects/framework/main.ss b/collects/framework/main.ss index 83b30e15..1441f3e8 100644 --- a/collects/framework/main.ss +++ b/collects/framework/main.ss @@ -35,11 +35,8 @@ '(cond begin begin0 delay unit compound-unit compound-unit/sig - public private - inherit inherit-from - rename rename-from - share share-from - sequence)) + public private override + inherit sequence)) (for-each (lambda (x) (hash-table-put! hash-table x 'lambda)) '(lambda let let* letrec recur let/cc let/ec letcc catch diff --git a/collects/framework/pasteboard.ss b/collects/framework/pasteboard.ss index 52155b1a..94279ec6 100644 --- a/collects/framework/pasteboard.ss +++ b/collects/framework/pasteboard.ss @@ -2,7 +2,7 @@ (import mred-interfaces^ [editor : framework:editor^]) - (define basic% (editor:basic-mixin pasteboard%)) + (define basic% (editor:keymap-mixin (editor:basic-mixin pasteboard%))) (define file% (editor:file-mixin basic%)) (define backup-autosave% (editor:backup-autosave-mixin file%)) (define info% (editor:info-mixin backup-autosave%))) \ No newline at end of file diff --git a/collects/framework/scheme.ss b/collects/framework/scheme.ss index 8828a70e..ae4d15c1 100644 --- a/collects/framework/scheme.ss +++ b/collects/framework/scheme.ss @@ -184,20 +184,23 @@ (lambda (pos) (let loop ([pos pos]) (let ([paren-pos - (apply max (map (lambda (pair) - (find-string - (car pair) - 'backward - pos - 'eof - #f)) - (scheme-paren:get-paren-pairs)))]) + (let loop ([pairs (scheme-paren:get-paren-pairs)] + [curr-max #f]) + (cond + [(null? pairs) curr-max] + [else (let* ([pair (car pairs)] + [fnd (find-string (car pair) 'backward pos 'eof #f)]) + (if (and fnd curr-max) + (loop (cdr pairs) + (max fnd curr-max)) + (loop (cdr pairs) + (or fnd curr-max))))]))]) (cond - [(= -1 paren-pos) #f] + [(not paren-pos) #f] [else (let ([semi-pos (find-string ";" 'backward paren-pos)]) (cond - [(or (= -1 semi-pos) + [(or (not semi-pos) (< semi-pos (paragraph-start-position (position-paragraph paren-pos)))) paren-pos] @@ -282,9 +285,8 @@ [balance-quotes (lambda (key) - (let* ([code (send key get-key-code)] ;; must be a character because of the mapping setup - ;; this function is only bound to ascii-returning keys - [char (integer->char code)]) + (let* ([char (send key get-key-code)]) ;; must be a character because of the mapping setup + ;; this function is only bound to ascii-returning keys (insert char) (let* ([start-pos (get-start-position)] [limit (get-limit start-pos)] @@ -376,15 +378,16 @@ [visual-offset (lambda (pos) (let loop ([p (sub1 pos)]) - (let ([c (get-character p)]) - (cond - [(= p -1) 0] - [(char=? c #\null) 0] - [(char=? c #\tab) - (let ([o (loop (sub1 p))]) - (+ o (- 8 (modulo o 8))))] - [(char=? c #\newline) 0] - [else (add1 (loop (sub1 p)))]))))] + (if (= p -1) + 0 + (let ([c (get-character p)]) + (cond + [(char=? c #\null) 0] + [(char=? c #\tab) + (let ([o (loop (sub1 p))]) + (+ o (- 8 (modulo o 8))))] + [(char=? c #\newline) 0] + [else (add1 (loop (sub1 p)))])))))] [do-indent (lambda (amt) (let* ([pos-start end] @@ -446,7 +449,7 @@ #f)) => (lambda (x) (set-position x))] [(= para 0) (do-indent 0)] - [(or (not contains) (= contains -1)) + [(not contains) (do-indent 0)] [(not last) ;; search backwards for the opening parenthesis, and use it to align this line (let ([enclosing (find-enclosing-paren pos)]) @@ -487,7 +490,7 @@ (loop (add1 para)))) (when (and (>= (position-paragraph start-pos) end-para) (<= (paren:skip-whitespace - this (get-start-position) -1) + this (get-start-position) 'backward) (paragraph-start-position first-para))) (set-position (let loop ([new-pos (get-start-position)]) @@ -544,7 +547,7 @@ (paren:skip-whitespace this (paragraph-start-position curr-para) - 1)]) + 'forward)]) (delete first-on-para (+ first-on-para (let char-loop ([n 0]) @@ -666,7 +669,7 @@ #t))] [remove-parens-forward (lambda (start-pos) - (let* ([pos (paren:skip-whitespace this start-pos 1)] + (let* ([pos (paren:skip-whitespace this start-pos 'forward)] [first-char (get-character pos)] [paren? (or (char=? first-char #\( ) (char=? first-char #\[ ))] @@ -741,11 +744,11 @@ (set-tabs null tab-size #f) (set-style-list style-list) (set-styles-fixed #t) - (let ([keymap (or (get-keymap) - (let ([k (make-object keymap%)]) - (set-keymap k) - k))]) - (send keymap chain-to-keymap keymap #t))))) + (let ([k (or (get-keymap) + (let ([k (make-object keymap%)]) + (set-keymap k) + k))]) + (send k chain-to-keymap keymap #t))))) (define -text% (text-mixin text:info%)) diff --git a/collects/framework/text.ss b/collects/framework/text.ss index 6189a5aa..eb7cc20b 100644 --- a/collects/framework/text.ss +++ b/collects/framework/text.ss @@ -13,7 +13,7 @@ ;; unless matthew makes it primitive (define basic<%> - (interface (editor:basic<%> text<%>) + (interface (editor:keymap<%> text<%>) highlight-range get-styles-fixed set-styles-fixed @@ -21,10 +21,10 @@ initial-autowrap-bitmap)) (define basic-mixin - (mixin (editor:basic<%> text<%>) (basic<%>) args + (mixin (editor:keymap<%> text<%>) (basic<%>) args (inherit get-canvases get-admin split-snip get-snip-position delete find-snip invalidate-bitmap-cache - set-autowrap-bitmap get-keymap + set-autowrap-bitmap set-file-format get-file-format get-style-list is-modified? change-style set-modified position-location get-extent) @@ -296,22 +296,24 @@ (public [initial-autowrap-bitmap (lambda () #f)]) + + (rename [super-get-keymaps get-keymaps]) + (override + [get-keymaps + (lambda () + (cons (keymap:get-global) (super-get-keymaps)))]) + (sequence (apply super-init args) - (set-autowrap-bitmap (initial-autowrap-bitmap)) - (let ([keymap (get-keymap)]) - (keymap:set-keymap-error-handler keymap) - (keymap:set-keymap-implied-shifts keymap) - (send keymap chain-to-keymap (keymap:get-global) #f))))) + (set-autowrap-bitmap (initial-autowrap-bitmap))))) (define searching<%> (interface () find-string-embedded)) (define searching-mixin - (mixin (editor:basic<%> text<%>) (searching<%>) args + (mixin (basic<%>) (searching<%>) args (inherit get-end-position get-start-position last-position - find-string get-snip-position get-admin find-snip - get-keymap) + find-string get-snip-position get-admin find-snip) (public [find-string-embedded (opt-lambda (str [direction 1] [start -1] @@ -390,12 +392,15 @@ (next-loop) (values embedded embedded-pos)))] [else (next-loop)]))))))]) + + (rename [super-get-keymaps get-keymaps]) + (override + [get-keymaps + (lambda () + (cons (keymap:get-search) (super-get-keymaps)))]) + (sequence - (apply super-init args) - (let ([keymap (get-keymap)]) - (keymap:set-keymap-error-handler keymap) - (keymap:set-keymap-implied-shifts keymap) - (send keymap chain-to-keymap (keymap:get-search) #f))))) + (apply super-init args)))) (define return<%> (interface (text<%>))) @@ -516,7 +521,7 @@ #f))))]) (sequence (apply super-init args)))) - (define basic% (basic-mixin (editor:basic-mixin text%))) + (define basic% (basic-mixin (editor:keymap-mixin (editor:basic-mixin text%)))) (define return% (return-mixin basic%)) (define file% (editor:file-mixin basic%)) (define clever-file-format% (clever-file-format-mixin file%))