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

...

Browse Source 
original commit: b16379321a741c207f7728bd4944c0fb2d1015d0
This commit is contained in:
Robby Findler 1999-09-20 20:25:45 +00:00
parent 52f16a3712
commit 053b5eb67c
4 changed files with 65 additions and 67 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
collects/framework/editor.ss
View File

@ -17,7 +17,6 @@
editing-this-file?
local-edit-sequence?
run-after-edit-sequence
default-auto-wrap?
get-top-level-window
locked?
on-close))
@ -172,12 +171,10 @@
(get-top-level-window)])
(finder:put-file f d)))])
(public
[default-auto-wrap? (lambda () #t)])
(inherit auto-wrap)
(sequence
(apply super-init args)
(auto-wrap (default-auto-wrap?)))))
(apply super-init args))))
(define -keymap<%> (interface (basic<%>) get-keymaps))
(define keymap-mixin
@ -193,6 +190,30 @@
(for-each (lambda (k) (send keymap chain-to-keymap k #f))
(get-keymaps))))))
(define autowrap<%> (interface (basic<%>) default-auto-wrap?))
(define autowrap-mixin
(mixin (basic<%>) (autowrap<%>) args
(public
[default-auto-wrap? (lambda () #t)])
(rename [super-on-close on-close])
(override
[on-close
(lambda ()
(remove-callback)
(super-on-close))])
(inherit auto-wrap)
(sequence
(apply super-init args)
(auto-wrap (default-auto-wrap?)))
(private
[remove-callback
(preferences:add-callback
'framework:auto-set-wrap?
(lambda (p v)
(auto-wrap v)))])))
(define file<%> (interface (-keymap<%>)))
(define file-mixin
(mixin (-keymap<%>) (file<%>) args

2
collects/framework/frameworks.ss
View File

@ -87,12 +87,14 @@
(define-signature framework:editor^
(basic<%>
keymap<%>
autowrap<%>
info<%>
file<%>
backup-autosave<%>
basic-mixin
keymap-mixin
autowrap-mixin
info-mixin
file-mixin
backup-autosave-mixin))

75
collects/framework/keymap.ss
View File

@ -64,52 +64,43 @@
(letrec ([end-pos (send edit last-position)]
[find-nonwhite
(lambda (pos d)
(let ([c (send edit get-character pos)])
(cond
[(char=? #\newline c) pos]
[(or (and (< pos 0) (= d -1))
(and (> pos end-pos) (= d 1)))
(if (= d -1)
-1
end-pos)]
[(char-whitespace? c)
(find-nonwhite (+ pos d) d)]
[else pos])))])
(let loop ([pos pos])
(if (or (and (= d -1)
(= pos 0))
(and (= pos end-pos)
(= d 1)))
pos
(let ([c (send edit get-character pos)])
(cond
[(char=? #\newline c) pos]
[(char-whitespace? c) (loop (+ pos d))]
[else pos])))))])
(let ([sel-start (send edit get-start-position)]
[sel-end (send edit get-end-position)])
(when (= sel-start sel-end)
(let ([start (+ (find-nonwhite (- sel-start 1) -1)
(if leave-one? 2 1))]
(let ([start
(if (= sel-start 0)
0
(+ (find-nonwhite (- sel-start 1) -1) 1))]
[end (find-nonwhite sel-start 1)])
(if (< start end)
(begin
(send edit begin-edit-sequence)
(send edit delete start end)
(if (and leave-one?
(not (char=? #\space
(send edit get-character
(sub1 start)))))
(send edit insert " " (sub1 start) start))
(send edit set-position start)
(send edit end-edit-sequence))
(when leave-one?
(let ([at-start
(send edit get-character sel-start)]
[after-start
(send edit get-character
(sub1 sel-start))])
(cond
[(char-whitespace? at-start)
(if (not (char=? at-start #\space))
(send edit insert " " sel-start
(add1 sel-start)))
(send edit set-position (add1 sel-start))]
[(char-whitespace? after-start)
(if (not (char=? after-start #\space))
(send edit insert " " (sub1 sel-start)
sel-start))]
[else
(send edit insert " ")])))))))))]
(send edit begin-edit-sequence)
(cond
;; funny case when to delete the newline
[(and leave-one?
(= (+ start 1) end)
(< end end-pos)
(char=? #\space (send edit get-character start))
(char=? #\newline (send edit get-character end)))
(send edit delete end (+ end 1))]
[else
(send edit delete start end)
(cond
[leave-one?
(send edit insert #\space start)
(send edit set-position (+ start 1))]
[else
(send edit set-position start)])])
(send edit end-edit-sequence))))))]
[collapse-space
(lambda (edit event)

22
collects/framework/text.ss
View File

@ -310,26 +310,9 @@
(public
[initial-autowrap-bitmap (lambda () (icon:get-autowrap-bitmap))])
(rename [super-on-close on-close])
(override
[on-close
(lambda ()
(remove-callback)
(super-on-close))])
(sequence
(apply super-init args)
(set-autowrap-bitmap (initial-autowrap-bitmap)))
(private
[remove-callback
(preferences:add-callback
'framework:auto-set-wrap?
(lambda (p v)
(auto-wrap v)))])
(inherit auto-wrap)
(sequence
(auto-wrap (preferences:get 'framework:auto-set-wrap?)))))
(set-autowrap-bitmap (initial-autowrap-bitmap)))))
(define searching<%> (interface (editor:keymap<%> basic<%>)))
(define searching-mixin
@ -470,7 +453,8 @@
(define basic% (basic-mixin (editor:basic-mixin text%)))
(define -keymap% (editor:keymap-mixin basic%))
(define return% (return-mixin -keymap%))
(define file% (editor:file-mixin -keymap%))
(define autowrap% (editor:autowrap-mixin -keymap%))
(define file% (editor:file-mixin autowrap%))
(define clever-file-format% (clever-file-format-mixin file%))
(define backup-autosave% (editor:backup-autosave-mixin clever-file-format%))
(define searching% (searching-mixin backup-autosave%))