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

...

Browse Source 
original commit: dc7fe7e75f1db118f0e6b59337d640909bbe9fa3
This commit is contained in:
Robby Findler 1999-07-28 19:00:07 +00:00
parent 96180a5809
commit 19bcb895ee
9 changed files with 147 additions and 91 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
collects/framework/editor.ss
View File

@ -321,7 +321,8 @@
[remove-autosave
(lambda ()
(when auto-saved-name
(delete-file auto-saved-name)
(when (file-exists? auto-saved-name)
(delete-file auto-saved-name))
(set! auto-saved-name #f)))])
(sequence
(apply super-init args)

5
collects/framework/finder.ss
View File

@ -6,6 +6,7 @@
(import mred^
[preferences : framework:preferences^]
[gui-utils : framework:gui-utils^]
[keymap : framework:keymap^]
[mzlib:string : mzlib:string^]
[mzlib:function : mzlib:function^]
[mzlib:file : mzlib:file^])
@ -456,12 +457,14 @@
[bottom-panel (make-object horizontal-panel% main-panel)]
[directory-field
(keymap:call/text-keymap-initializer
(lambda ()
(make-object text-field%
"Full pathname"
directory-panel
(lambda (txt evt)
(when (eq? (send evt get-event-type) 'text-field-enter)
(do-ok))))]
(do-ok))))))]
[result-list
(when multi-mode?

4
collects/framework/frame.ss
View File

@ -364,6 +364,8 @@
(define (search-dialog frame)
(init-find/replace-edits)
(keymap:call/text-keymap-initializer
(lambda ()
(let* ([to-be-searched-text (send frame get-text-to-search)]
[to-be-searched-canvas (send to-be-searched-text get-canvas)]
@ -441,7 +443,7 @@
(send button-panel set-alignment 'right 'center)
(send dialog center 'both)
(send to-be-searched-canvas force-display-focus #t)
(send dialog show #t)))
(send dialog show #t)))))
(define searchable<%> (interface (text<%>)
get-text-to-search

4
collects/framework/frameworks.ss
View File

@ -218,7 +218,9 @@
get-global
get-search
get-file))
get-file
call/text-keymap-initializer))
(define-signature framework:match-cache^
(%))

38
collects/framework/keymap.ss
View File

@ -374,9 +374,12 @@
[goto-line
(lambda (edit event)
(let ([num-str (get-text-from-user
(let ([num-str
(call/text-keymap-initializer
(lambda ()
(get-text-from-user
"Goto Line"
"Goto Line:")])
"Goto Line:")))])
(if (string? num-str)
(let ([line-num (string->number num-str)])
(if line-num
@ -386,9 +389,12 @@
#t)]
[goto-position
(lambda (edit event)
(let ([num-str (get-text-from-user
(let ([num-str
(call/text-keymap-initializer
(lambda ()
(get-text-from-user
"Goto Position"
"Goto Position:")])
"Goto Position:")))])
(if (string? num-str)
(let ([pos (string->number num-str)])
(if pos
@ -516,6 +522,16 @@
"delete-next-character"
"delete-previous-character")
edit event #t)))]
[cut-to-end-of-paragraph
(lambda (text event)
(let* ([start (send text get-start-position)]
[para (send text position-paragraph start)]
[end (send text paragraph-end-position para)])
(if (= start end)
(send text cut #f (send event get-time-stamp) start (+ start 1))
(send text cut #f (send event get-time-stamp) start end))))]
[toggle-overwrite
(lambda (edit event)
(send edit set-overwrite-mode
@ -583,6 +599,8 @@
(add "delete-key" delete-key)
(add "cut-to-end-of-paragraph" cut-to-end-of-paragraph)
; Map keys to functions
(map "c:g" "ring-bell")
(map-meta "c:g" "ring-bell")
@ -689,7 +707,7 @@
(map "c:l" "center-view-on-line")
(map "c:k" "delete-to-end-of-line")
(map "c:k" "cut-to-end-of-paragraph")
(map "c:y" "paste-clipboard")
(map-meta "y" "paste-next")
(map "a:v" "paste-clipboard")
@ -855,4 +873,12 @@
(define search (make-object keymap%))
(generic-setup search)
(setup-search search)
(define (get-search) search))
(define (get-search) search)
(define (call/text-keymap-initializer thunk)
(let ([ctki (current-text-keymap-initializer)])
(parameterize ([current-text-keymap-initializer
(lambda (keymap)
(send keymap chain-to-keymap global #t)
(ctki keymap))])
(thunk)))))

2
collects/framework/main.ss
View File

@ -14,7 +14,7 @@
(preferences:set-default 'framework:verify-change-format #f boolean?)
(preferences:set-default 'framework:auto-set-wrap? #f boolean?)
(preferences:set-default 'framework:auto-set-wrap? #t boolean?)
(preferences:set-default 'framework:display-line-numbers #t boolean?)

4
collects/framework/prefs.ss
View File

@ -321,7 +321,9 @@
[font-size-entry "defaultFontSize"]
[font-default-string "Default Value"]
[font-default-size 12]
[font-default-size (case (system-type)
[(windows) 10]
[else 12])]
[font-section "mred"]
[build-font-entry (lambda (x) (string-append "Screen" x "__"))]
[font-file (find-graphical-system-path 'setup-file)]

7
collects/framework/scheme.ss
View File

@ -920,9 +920,12 @@
(let* ([add-callback
(lambda (keyword-type keyword-symbol list-box)
(lambda (button command)
(let ([new-one (get-text-from-user
(let ([new-one
(keymap:call/text-keymap-initializer
(lambda ()
(get-text-from-user
(string-append "Enter new " keyword-type "-like keyword:")
(string-append keyword-type " Keyword"))])
(string-append keyword-type " Keyword"))))])
(when new-one
(let ([parsed (with-handlers ((exn:read? (lambda (x) #f)))
(read (open-input-string new-one)))])

19
collects/framework/text.ss
View File

@ -310,9 +310,26 @@
(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)))))
(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?)))))
(define searching<%> (interface (editor:keymap<%> basic<%>)))
(define searching-mixin