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

...

Browse Source 
original commit: 7503b43eb32f84ddf7fc9d433ae323e14117587b
This commit is contained in:
Robby Findler 2002-01-24 20:31:16 +00:00
parent f0c8234fa3
commit e69b11ffc0
3 changed files with 35 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
collects/framework/private/editor.ss
View File

@ -266,26 +266,11 @@
(define autowrap<%> (interface (basic<%>)))
(define autowrap-mixin
(mixin (basic<%>) (autowrap<%>)
(rename [super-on-close on-close])
(override on-close)
[define on-close
(lambda ()
(remove-callback)
(super-on-close))]
(inherit auto-wrap)
(super-instantiate ())
(auto-wrap
(preferences:get
'framework:auto-set-wrap?))
[define remove-callback
(preferences:add-callback
'framework:auto-set-wrap?
(let ([autowrap-mixin-pref-callback
(lambda (p v)
(auto-wrap v))])
autowrap-mixin-pref-callback))]))
'framework:auto-set-wrap?))))
(define file<%> (interface (-keymap<%>)))
(define file-mixin

4
collects/framework/private/frame.ss
View File

@ -814,7 +814,9 @@
(let ([edit (get-edit-target-object)])
(when (and edit
(is-a? edit editor<%>))
(send edit auto-wrap (not (send edit auto-wrap))))))])
(let ([new-pref (not (send edit auto-wrap))])
(preferences:set 'framework:auto-set-wrap? new-pref)
(send edit auto-wrap new-pref)))))])
(make-object c% (string-constant wrap-text-item)
edit-menu callback #f #f on-demand))

46
collects/framework/private/preferences.ss
View File

@ -269,8 +269,9 @@
(let loop ([input input])
(when (pair? input)
(let ([pre-pref (car input)])
(if (and (list? pre-pref)
(= 2 (length pre-pref)))
(if (and (pair? pre-pref)
(pair? (cdr pre-pref))
(null? (cddr pre-pref)))
(parse-pref (car pre-pref) (cadr pre-pref))
(begin (read-err input (string-constant expected-list-of-length2))
(k #f))))
@ -302,16 +303,30 @@
(define (-read)
(let/ec k
(let ([sexp (get-preference main-preferences-symbol (lambda () (k #f)))])
(for-each-pref-in-sexp
sexp
(lambda (p marshalled)
(add-raw-pref-to-ht preferences p marshalled))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; ;;;
;;; preferences dialog ;;;
;;; ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(install-stashed-preferences sexp))))
;; install-stashed-preferences : sexp -> void
;; ensure that `prefs' is actuall a well-formed preferences
;; table and installs them as the current preferences.
(define (install-stashed-preferences prefs)
(for-each-pref-in-sexp
prefs
(lambda (p marshalled)
(add-raw-pref-to-ht preferences p marshalled))))
;; ; ;;;
; ;
; ;
;;;; ;;; ;;;; ; ;;; ;;; ;
; ; ; ; ; ; ; ; ;
; ; ; ;;;; ; ; ; ; ;
; ; ; ; ; ; ; ; ; ;
; ; ; ; ; ; ; ; ; ;
;;; ; ;;;;; ;;; ; ;;;;;; ;;; ;;;;
;
;
;;;
(define-struct ppanel (title container panel))
@ -583,7 +598,8 @@
(define make-preferences-dialog
(lambda ()
(letrec ([frame
(letrec ([stashed-prefs (get-preference main-preferences-symbol (lambda () null))]
[frame
(make-object (class100 frame% args
(public
[added-pane
@ -648,9 +664,9 @@
(hide-dialog))]
[ok-button (make-object button% (string-constant ok)
bottom-panel ok-callback '(border))]
[cancel-callback (lambda args
[cancel-callback (lambda (_1 _2)
(hide-dialog)
(-read))]
(install-stashed-preferences stashed-prefs))]
[cancel-button (make-object button% (string-constant cancel)
bottom-panel cancel-callback)]
[grow-box-space (make-object grow-box-spacer-pane% bottom-panel)])