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

69
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)
(send edit last-position)
0)])
(let loop ([pos pos]) (let loop ([pos pos])
(if (= pos max) (cond
(escape pos) [(= pos done) (escape pos)]
(let ([c (send edit get-character (+ pos offset))]) [else
(define c (send edit get-character (+ pos offset)))
(cond (cond
[(char=? #\newline c) [(char=? #\newline c)
(loop (+ pos d)) (loop (+ pos d))
(escape pos)] (escape pos)]
[(char-whitespace? c) [(char-whitespace? c)
(loop (+ pos d))] (loop (+ pos d))]
[else pos])))))))]) [else pos])]))))
(let ([sel-start (send edit get-start-position)] (define sel-start (send edit get-start-position))
[sel-end (send edit get-end-position)]) (define sel-end (send edit get-end-position))
(when (= sel-start sel-end) (when (= sel-start sel-end)
(let* ([pos-line (send edit position-line sel-start #f)] (define pos-para (send edit position-paragraph sel-start #f))
[pos-line-start (send edit line-start-position pos-line)] (define pos-para-start (send edit paragraph-start-position pos-para))
[pos-line-end (send edit line-end-position pos-line)] (define pos-para-end (send edit paragraph-end-position pos-para))
[whiteline? (define whitepara?
(let loop ([pos pos-line-start]) (let loop ([pos pos-para-start])
(if (>= pos pos-line-end) (if (>= pos pos-para-end)
#t #t
(and (char-whitespace? (send edit get-character pos)) (and (char-whitespace? (send edit get-character pos))
(loop (add1 pos)))))] (loop (add1 pos))))))
[start (find-nonwhite pos-line-start -1 -1)] (define start (find-nonwhite pos-para-start -1 -1))
[end (find-nonwhite pos-line-end 1 0)] (define end (find-nonwhite pos-para-end 1 0))
[start-line (define start-para (send edit position-paragraph start #f))
(send edit position-line start #f)] (define start-para-start (send edit paragraph-start-position start-para))
[start-line-start (define end-para (send edit position-paragraph end #f))
(send edit line-start-position start-line)] (define end-para-start (send edit paragraph-start-position (add1 end-para)))
[end-line
(send edit position-line end #f)]
[end-line-start
(send edit line-start-position (add1 end-line))])
(cond (cond
[(and whiteline? [(and whitepara?
(= start-line pos-line) (= start-para pos-para)
(= end-line pos-line)) (= end-para pos-para))
; Special case: just delete this line ; Special case: just delete this para
(send edit delete pos-line-start (add1 pos-line-end))] (send edit delete pos-para-start (add1 pos-para-end))]
[(and whiteline? (< start-line pos-line)) [(and whitepara? (< start-para pos-para))
; Can delete before & after ; Can delete before & after
(send* edit (send* edit
(begin-edit-sequence) (begin-edit-sequence)
(delete (add1 pos-line-end) end-line-start) (delete (add1 pos-para-end) end-para-start)
(delete start-line-start pos-line-start) (delete start-para-start pos-para-start)
(end-edit-sequence))] (end-edit-sequence))]
[else [else
; Only delete after ; Only delete after
(send edit delete (add1 pos-line-end) (send edit delete (add1 pos-para-end) end-para-start)])))]
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)