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

Fix collapse-newline in the case that the insertion point

Browse Source 
is at the first position of the text.

closes PR 14043

Also, Rackety.

original commit: 88d61e096c37344747d3ead6dcbe3f36e2aa27e8
This commit is contained in:
Robby Findler 2013-10-12 09:54:10 -05:00
parent 3b456234fd
commit aeb68d32ab
2 changed files with 65 additions and 59 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

111
pkgs/gui-pkgs/gui-lib/framework/private/keymap.rkt
View File

@ -458,65 +458,58 @@
[collapse-newline [collapse-newline
(λ (edit event) (λ (edit event)
(letrec ([find-nonwhite (define (find-nonwhite pos d offset)
(λ (pos d offset) (define done (if (= offset -1) 0 (send edit last-position)))
(let/ec escape (let/ec escape
(let ([max (if (> offset 0) (let loop ([pos pos])
(send edit last-position) (cond
0)]) [(= pos done) (escape pos)]
(let loop ([pos pos]) [else
(if (= pos max) (define c (send edit get-character (+ pos offset)))
(escape pos) (cond
(let ([c (send edit get-character (+ pos offset))]) [(char=? #\newline c)
(cond (loop (+ pos d))
[(char=? #\newline c) (escape pos)]
(loop (+ pos d)) [(char-whitespace? c)
(escape pos)] (loop (+ pos d))]
[(char-whitespace? c) [else pos])]))))
(loop (+ pos d))] (define sel-start (send edit get-start-position))
[else pos])))))))]) (define sel-end (send edit get-end-position))
(let ([sel-start (send edit get-start-position)] (when (= sel-start sel-end)
[sel-end (send edit get-end-position)]) (define pos-para (send edit position-paragraph sel-start #f))
(when (= sel-start sel-end) (define pos-para-start (send edit paragraph-start-position pos-para))
(let* ([pos-line (send edit position-line sel-start #f)] (define pos-para-end (send edit paragraph-end-position pos-para))
[pos-line-start (send edit line-start-position pos-line)]
[pos-line-end (send edit line-end-position pos-line)] (define whitepara?
(let loop ([pos pos-para-start])
[whiteline? (if (>= pos pos-para-end)
(let loop ([pos pos-line-start]) #t
(if (>= pos pos-line-end) (and (char-whitespace? (send edit get-character pos))
#t (loop (add1 pos))))))
(and (char-whitespace? (send edit get-character pos))
(loop (add1 pos)))))] (define start (find-nonwhite pos-para-start -1 -1))
(define end (find-nonwhite pos-para-end 1 0))
[start (find-nonwhite pos-line-start -1 -1)]
[end (find-nonwhite pos-line-end 1 0)] (define start-para (send edit position-paragraph start #f))
(define start-para-start (send edit paragraph-start-position start-para))
[start-line (define end-para (send edit position-paragraph end #f))
(send edit position-line start #f)] (define end-para-start (send edit paragraph-start-position (add1 end-para)))
[start-line-start (cond
(send edit line-start-position start-line)] [(and whitepara?
[end-line (= start-para pos-para)
(send edit position-line end #f)] (= end-para pos-para))
[end-line-start ; Special case: just delete this para
(send edit line-start-position (add1 end-line))]) (send edit delete pos-para-start (add1 pos-para-end))]
(cond [(and whitepara? (< start-para pos-para))
[(and whiteline? ; Can delete before & after
(= start-line pos-line) (send* edit
(= end-line pos-line)) (begin-edit-sequence)
; Special case: just delete this line (delete (add1 pos-para-end) end-para-start)
(send edit delete pos-line-start (add1 pos-line-end))] (delete start-para-start pos-para-start)
[(and whiteline? (< start-line pos-line)) (end-edit-sequence))]
; Can delete before & after [else
(send* edit ; Only delete after
(begin-edit-sequence) (send edit delete (add1 pos-para-end) end-para-start)])))]
(delete (add1 pos-line-end) end-line-start)
(delete start-line-start pos-line-start)
(end-edit-sequence))]
[else
; Only delete after
(send edit delete (add1 pos-line-end)
end-line-start)]))))))]
[open-line [open-line
(λ (edit event) (λ (edit event)

13
pkgs/gui-pkgs/gui-test/framework/tests/keys.rkt
View File

@ -128,6 +128,19 @@
(list '((#\f control)) '((right))) (list '((#\f control)) '((right)))
(list '((#\f control)) '((right)))) (list '((#\f control)) '((right))))
(make-key-spec/allplatforms (build-buff-spec "\n\n\n\n" 2 2)
(build-buff-spec "\n" 0 0)
'(((#\x control) (#\o control))))
(make-key-spec/allplatforms (build-buff-spec " \n \n \n \n" 7 7)
(build-buff-spec " \n" 1 1)
'(((#\x control) (#\o control))))
(make-key-spec/allplatforms (build-buff-spec "\n\n\n\n" 0 0)
(build-buff-spec "\n" 0 0)
'(((#\x control) (#\o control))))
(make-key-spec/allplatforms (build-buff-spec "abcdef\n\n\n\nxyzpdq\n" 8 8)
(build-buff-spec "abcdef\n\nxyzpdq\n" 7 7)
'(((#\x control) (#\o control))))
;; TeX-compress tests ;; TeX-compress tests
(make-key-spec/allplatforms (make-key-spec/allplatforms
(build-buff-spec "\\ome" 4 4) (build-buff-spec "\\ome" 4 4)