suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

add an ASCII art rectangle => unicode rectangle keybinding to drracket

Browse Source
This commit is contained in:
Robby Findler 2012-12-24 11:28:30 -06:00
parent 4a57db4448
commit 042bbbefe7
3 changed files with 166 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

131
collects/framework/private/keymap.rkt
View File

@ -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)))

20
collects/scribblings/drracket/keybindings.scrbl
View File

@ -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}

28
collects/tests/framework/keys.rkt
View File

@ -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)