diff --git a/collects/framework/private/keymap.rkt b/collects/framework/private/keymap.rkt index bca0f24024..f588156d92 100644 --- a/collects/framework/private/keymap.rkt +++ b/collects/framework/private/keymap.rkt @@ -1,16 +1,18 @@ -#lang scheme/unit +#lang racket/base (require string-constants - mzlib/class - mzlib/list + racket/class + racket/match + racket/list mred/mred-sig - mzlib/match "../preferences.rkt" mrlib/tex-table (only-in srfi/13 string-prefix? string-prefix-length) - "sig.rkt") - + "sig.rkt" + racket/unit) +(provide keymap@) +(define-unit keymap@ (import mred^ [prefix finder: framework:finder^] [prefix handler: framework:handler^] @@ -38,8 +40,7 @@ (parameterize ([read-accept-reader #t]) (call-with-input-file path read)))]) (match sexp - [`(module ,name ,lang - ,@(x ...)) + [`(module ,name ,lang ,x ...) (cond [(valid-keybindings-lang? lang) (let ([km (dynamic-require spec '#%keymap)]) @@ -1010,7 +1011,15 @@ (λ (txt event) (define pos (find-beginning-of-line txt)) (when pos - (send txt extend-position pos)))]) + (send txt extend-position pos)))] + + + [unicode-ascii-art-boxes + (λ (txt evt) + (define start (send txt get-start-position)) + (when (= start (send txt get-end-position)) + (do-unicode-ascii-art-boxes txt start) + (send txt set-position start)))]) (λ (kmap) (let* ([map (λ (key func) @@ -1031,6 +1040,8 @@ (λ (txt evt) (send txt insert c))))) (string->list (string-append greek-letters Greek-letters))) + (add "unicode-ascii-art-boxes" unicode-ascii-art-boxes) + (add "shift-focus" (shift-focus values)) (add "shift-focus-backwards" (shift-focus reverse)) @@ -1125,6 +1136,8 @@ (setup-mappings greek-letters #f) (setup-mappings Greek-letters #t)) + (map "c:x;r;a" "unicode-ascii-art-boxes") + (map "~m:c:\\" "TeX compress") (map "~c:m:\\" "TeX compress") (map "c:x;t" "TeX compress") @@ -1476,4 +1489,102 @@ (define eol (unbox eol-box)) (if (< start-pos click-pos) (f click-pos eol start-pos click-pos) - (f click-pos eol click-pos end-pos)))) + (f click-pos eol click-pos end-pos))))) + + +(define (do-unicode-ascii-art-boxes t pos) + (define visited (make-hash)) + (when (i? t pos) + (send t begin-edit-sequence) + (let loop ([pos pos]) + (unless (hash-ref visited pos #f) + (hash-set! visited pos #t) + (define-values (x y) (pos->xy t pos)) + (define up (xy->pos t x (- y 1))) + (define dn (xy->pos t x (+ y 1))) + (define lt (xy->pos t (- x 1) y)) + (define rt (xy->pos t (+ x 1) y)) + (define i-up? (i? t up)) + (define i-dn? (i? t dn)) + (define i-lt? (i? t lt)) + (define i-rt? (i? t rt)) + (cond + [(and i-up? i-dn? i-lt? i-rt?) (set t pos "╬")] + [(and i-dn? i-lt? i-rt?) (set t pos "╦")] + [(and i-up? i-lt? i-rt?) (set t pos "╩")] + [(and i-up? i-dn? i-rt?) (set t pos "╠")] + [(and i-up? i-dn? i-lt?) (set t pos "╣")] + [(and i-up? i-lt?) (set t pos "╝")] + [(and i-up? i-rt?) (set t pos "╚")] + [(and i-dn? i-lt?) (set t pos "╗")] + [(and i-dn? i-rt?) (set t pos "╔")] + [(or i-up? i-dn?) (set t pos "║")] + [else (set t pos "═")]) + (when i-up? (loop up)) + (when i-dn? (loop dn)) + (when i-lt? (loop lt)) + (when i-rt? (loop rt)))) + (send t end-edit-sequence))) + +(define (i? t pos) + (and pos + (member (send t get-character pos) + adjustable-chars))) +(define (set t pos s) + (send t delete pos (+ pos 1)) + (send t insert s pos pos)) + +(define (pos->xy text pos) + (define para (send text position-paragraph pos)) + (define start (send text paragraph-start-position para)) + (values (- pos start) para)) + +(define adjustable-chars + '(#\╬ + #\╩ #\╦ #\╣ #\╠ + #\╝ #\╗ #\╔ #\╚ + #\═ #\║ + #\+ #\- #\|)) + + +(define (xy->pos text x y) + (cond + [(and (<= 0 x) (<= 0 y (send text last-paragraph))) + (define para-start (send text paragraph-start-position y)) + (define para-end (send text paragraph-end-position y)) + (define pos (+ para-start x)) + (and (< pos para-end) + ;; the newline at the end of the + ;; line is not on the line, so use this guard + pos)] + [else #f])) + +(module+ test + (require rackunit + racket/gui/base) + (define sa string-append) + + (let ([t (new text%)]) + (send t insert (sa "abc\n" + "d\n" + "ghi\n")) + (check-equal? (xy->pos t 0 0) 0) + (check-equal? (xy->pos t 1 0) 1) + (check-equal? (xy->pos t 0 1) 4) + (check-equal? (xy->pos t 3 0) #f) + (check-equal? (xy->pos t 0 3) #f) + (check-equal? (xy->pos t 1 1) #f) + (check-equal? (xy->pos t 2 1) #f) + (check-equal? (xy->pos t 0 2) 6) + (check-equal? (xy->pos t 1 2) 7) + (check-equal? (xy->pos t 2 -1) #f) + (check-equal? (xy->pos t -1 0) #f) + (check-equal? (xy->pos t 2 2) 8) + (check-equal? (xy->pos t 2 3) #f)) + + (let ([t (new text%)]) + (send t insert (sa "abc\n" + "d\n" + "ghi")) + (check-equal? (xy->pos t 2 2) 8) + (check-equal? (xy->pos t 2 3) #f))) diff --git a/collects/scribblings/drracket/keybindings.scrbl b/collects/scribblings/drracket/keybindings.scrbl index de0ac712f3..1cb045b26a 100644 --- a/collects/scribblings/drracket/keybindings.scrbl +++ b/collects/scribblings/drracket/keybindings.scrbl @@ -142,7 +142,7 @@ selected. @keybinding["M-["]{wrap selection in square brackets} @keybinding["M-{"]{wrap selection in curly brackets} @keybinding["M-S-L"]{wrap selection in @litchar{(lambda () }...@litchar{)} - and put the insertion point in the arglist of the lambda} + and put the insertion point in the argument list of the lambda} @keybinding["C-c C-o"]{the sexpression following the insertion point is put in place of its containing sexpression} @@ -152,8 +152,24 @@ selected. sexpression following the insertion point and puts a printf in at that point (useful for debugging).} - @keybinding["M-o"]{toggle @as-index{overwrite mode}} + +@keybinding["C-x r a"]{Adjust nearby ASCII art rectangles + (that use @litchar{+}, @litchar{-}, or @litchar{|}) + to use Unicode characters. + + For example, if the insertion point is next to this rectangle: + @tabular[(list (list @litchar{+-+}) + (list @litchar{| |}) + (list @litchar{+-+}))] + then the keystroke will turn it into this one: + @tabular[(list (list @litchar{╔═╗}) + (list @litchar{║ ║}) + (list @litchar{╚═╝}))] + Similarly, if the rectangle near the insertion point has + mixed Unicode and ASCII, it will all be converted to + the Unicode characters. + } ] @section{File Operations} diff --git a/collects/tests/framework/keys.rkt b/collects/tests/framework/keys.rkt index ef15679a60..0dd91a0958 100644 --- a/collects/tests/framework/keys.rkt +++ b/collects/tests/framework/keys.rkt @@ -153,6 +153,11 @@ (list (list (list #\[))) (list (list (list #\[))))) + (define (ascii-art-box-spec before after) + (make-key-spec/allplatforms (make-buff-spec before 0 0) + (make-buff-spec after 0 0) + (list '((#\x control) (#\r) (#\a))))) + ;; the keybindings test cases applied to racket:text% editors (define scheme-specs (list @@ -273,7 +278,28 @@ (make-key-spec/allplatforms (make-buff-spec "[a]" 3 3) (make-buff-spec "[a]" 3 3) - (list '((#\c control) (#\[ control)))))) + (list '((#\c control) (#\[ control)))) + + (ascii-art-box-spec "+" "═") + (ascii-art-box-spec "x" "x") + (ascii-art-box-spec "+-+" "═══") + (ascii-art-box-spec "+\n|\n+\n" "║\n║\n║\n") + (ascii-art-box-spec (string-append "+-+\n" + "| |\n" + "+-+\n") + (string-append "╔═╗\n" + "║ ║\n" + "╚═╝\n")) + (ascii-art-box-spec (string-append "+-+-+\n" + "| | |\n" + "+-+-+\n" + "| | |\n" + "+-+-+\n") + (string-append "╔═╦═╗\n" + "║ ║ ║\n" + "╠═╬═╣\n" + "║ ║ ║\n" + "╚═╩═╝\n")))) (define automatic-scheme-specs (list (make-key-spec/allplatforms (make-buff-spec "" 0 0)