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

...

Browse Source 
original commit: 87e5573d77e7d732757125b30e88c9f11154fb2a
This commit is contained in:
Robby Findler 1999-03-23 04:33:33 +00:00
parent 4a109b9ff1
commit c314dc44cd
5 changed files with 22 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
collects/framework/frame.ss
View File

@ -753,6 +753,7 @@
(rename [super-on-close on-close]) (rename [super-on-close on-close])
(private (private
[outer-info-panel 'top-info-panel-uninitialized]
[close-panel-callback [close-panel-callback
(preferences:add-callback (preferences:add-callback
'framework:show-status-line 'framework:show-status-line
@ -763,7 +764,7 @@
(send super-root change-children (send super-root change-children
(lambda (l) (lambda (l)
(if v (if v
(list rest-panel (get-info-panel)) (list rest-panel outer-info-panel)
(list rest-panel))))))]) (list rest-panel))))))])
(override (override
[on-close [on-close
@ -808,12 +809,13 @@
(public (public
[get-info-panel [get-info-panel
(let* ([outer-info-panel (make-object horizontal-panel% super-root)] (begin
[info-panel (make-object horizontal-panel% outer-info-panel)] (set! outer-info-panel (make-object horizontal-panel% super-root))
[spacer (make-object grow-box-spacer-pane% outer-info-panel)]) (let ([info-panel (make-object horizontal-panel% outer-info-panel)]
(lambda () [spacer (make-object grow-box-spacer-pane% outer-info-panel)])
(send outer-info-panel stretchable-height #f) (lambda ()
info-panel))]) (send outer-info-panel stretchable-height #f)
info-panel)))])
(private (private
[lock-message (make-object message% [lock-message (make-object message%
(let ([b (icon:get-unlock-bitmap)]) (let ([b (icon:get-unlock-bitmap)])

4
collects/framework/group.ss
View File

@ -2,6 +2,7 @@
(import mred-interfaces^ (import mred-interfaces^
[application : framework:application^] [application : framework:application^]
[frame : framework:frame^] [frame : framework:frame^]
[preferences : framework:preferences^]
[mzlib:function : mzlib:function^] [mzlib:function : mzlib:function^]
[mzlib:file : mzlib:file^]) [mzlib:file : mzlib:file^])
@ -99,7 +100,8 @@
[get-mdi-parent [get-mdi-parent
(lambda () (lambda ()
(if (eq? (system-type) 'windows) (if (and (eq? (system-type) 'windows)
(preferences:get 'framework:windows-mdi))
(begin (begin
(set! get-mdi-parent (lambda () mdi-parent)) (set! get-mdi-parent (lambda () mdi-parent))
(set! mdi-parent (make-object frame% (application:current-app-name) (set! mdi-parent (make-object frame% (application:current-app-name)

2
collects/framework/main.ss
View File

@ -7,6 +7,8 @@
;; preferences ;; preferences
(preferences:set-default 'framework:windows-mdi #t boolean?)
(preferences:set-default 'framework:menu-bindings #t boolean?) (preferences:set-default 'framework:menu-bindings #t boolean?)
(preferences:set-default 'framework:verify-change-format #f boolean?) (preferences:set-default 'framework:verify-change-format #f boolean?)

26
collects/framework/prefs.ss
View File

@ -55,11 +55,7 @@
(format (format
"no default for ~a" "no default for ~a"
p)) p))
(raise (exn:make-during-preferences (raise exn)))))))))
(if (exn? exn)
(exn-message exn)
(format "~s" exn))
((debug-info-handler))))))))))))
(define get-callbacks (define get-callbacks
(lambda (p) (lambda (p)
@ -82,12 +78,7 @@
(andmap (lambda (x) (andmap (lambda (x)
(guard "calling callback" p value (guard "calling callback" p value
(lambda () (x p value)) (lambda () (x p value))
(lambda (exn) raise))
(raise (exn:make-during-preferences
(if (exn? exn)
(exn-message exn)
(format "~s" exn))
((debug-info-handler)))))))
(get-callbacks p)))) (get-callbacks p))))
(define get (define get
@ -173,12 +164,7 @@
(lambda () (lambda ()
(k value)))) (k value))))
value)) value))
(lambda (exn) raise))])
(raise (exn:make-during-preferences
(if (exn? exn)
(exn-message exn)
(format "~s" exn))
((debug-info-handler)))))))])
(list p marshalled))] (list p marshalled))]
[else (error 'prefs.ss "robby error.2: ~a" ht-value)]))]) [else (error 'prefs.ss "robby error.2: ~a" ht-value)]))])
(lambda () (lambda ()
@ -340,8 +326,8 @@
[make-check [make-check
(lambda (pref title bool->pref pref->bool) (lambda (pref title bool->pref pref->bool)
(let* ([callback (let* ([callback
(lambda (_ command) (lambda (check-box _)
(set pref (bool->pref (send command checked?))))] (set pref (bool->pref (send check-box get-value))))]
[pref-value (get pref)] [pref-value (get pref)]
[initial-value (pref->bool pref-value)] [initial-value (pref->bool pref-value)]
[c (make-object check-box% title main callback)]) [c (make-object check-box% title main callback)])
@ -375,6 +361,8 @@
(make-check 'framework:display-line-numbers "Display line numbers in buffer; not character offsets" id id) (make-check 'framework:display-line-numbers "Display line numbers in buffer; not character offsets" id id)
(when (eq? (system-type) 'windows)
(make-check 'framework:windows-mdi "Use MDI Windows" id id))
main)) main))
#f) #f)

1
collects/framework/scheme.ss
View File

@ -156,6 +156,7 @@
[after-insert [after-insert
(lambda (start size) (lambda (start size)
(send backward-cache invalidate start) (send backward-cache invalidate start)
(send forward-cache forward-invalidate start size)
(highlight-parens) (highlight-parens)
(super-after-insert start size))] (super-after-insert start size))]
[after-delete [after-delete