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

collects/framework/private/keymap.rkt

@@ -1,16 +1,18 @@
-#lang scheme/unit
+#lang racket/base
 
 (require string-constants
-         mzlib/class
+         racket/class
-         mzlib/list
+         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
+           [`(module ,name ,lang ,x ...)
-               ,@(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)))

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}

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)