fixed a bug in preferences reading
svn: r5158
This commit is contained in:
parent
01a4a5c804
commit
41675aa2ec
|
@ -94,6 +94,7 @@
|
||||||
|
|
||||||
(define -put-file
|
(define -put-file
|
||||||
(λ args
|
(λ args
|
||||||
|
(printf "put-file ~s\n" (preferences:get 'framework:file-dialogs))
|
||||||
(apply (case (preferences:get 'framework:file-dialogs)
|
(apply (case (preferences:get 'framework:file-dialogs)
|
||||||
[(std) std-put-file]
|
[(std) std-put-file]
|
||||||
[(common) common-put-file])
|
[(common) common-put-file])
|
||||||
|
|
|
@ -377,8 +377,7 @@
|
||||||
(set-to-default)
|
(set-to-default)
|
||||||
(super-new))))
|
(super-new))))
|
||||||
|
|
||||||
(define open-file
|
(define (open-file)
|
||||||
(λ ()
|
|
||||||
(let* ([parent (and (or (not (eq? 'macosx (system-type)))
|
(let* ([parent (and (or (not (eq? 'macosx (system-type)))
|
||||||
(preferences:get 'framework:open-here?))
|
(preferences:get 'framework:open-here?))
|
||||||
(get-top-level-focus-window))]
|
(get-top-level-focus-window))]
|
||||||
|
@ -390,4 +389,4 @@
|
||||||
(send *open-directory*
|
(send *open-directory*
|
||||||
set-from-file! file))
|
set-from-file! file))
|
||||||
(and file
|
(and file
|
||||||
(edit-file file))))))
|
(edit-file file)))))
|
||||||
|
|
|
@ -101,7 +101,9 @@ the state transitions / contracts are:
|
||||||
|
|
||||||
;; unmarshall, if required
|
;; unmarshall, if required
|
||||||
(when (hash-table-bound? marshalled p)
|
(when (hash-table-bound? marshalled p)
|
||||||
(hash-table-put! preferences p (unmarshall-pref p (hash-table-get marshalled p)))
|
;; if `preferences' is already bound, that means the unmarshalled value isn't useful.
|
||||||
|
(unless (hash-table-bound? preferences p)
|
||||||
|
(hash-table-put! preferences p (unmarshall-pref p (hash-table-get marshalled p))))
|
||||||
(hash-table-remove! marshalled p))
|
(hash-table-remove! marshalled p))
|
||||||
|
|
||||||
;; if there is no value in the preferences table, but there is one
|
;; if there is no value in the preferences table, but there is one
|
||||||
|
|
|
@ -24,7 +24,8 @@ WARNING: printf is rebound in the body of the unit to always
|
||||||
[prefix color-model: framework:color-model^]
|
[prefix color-model: framework:color-model^]
|
||||||
[prefix frame: framework:frame^]
|
[prefix frame: framework:frame^]
|
||||||
[prefix scheme: framework:scheme^]
|
[prefix scheme: framework:scheme^]
|
||||||
[prefix number-snip: framework:number-snip^])
|
[prefix number-snip: framework:number-snip^]
|
||||||
|
[prefix finder: framework:finder^])
|
||||||
(export (rename framework:text^
|
(export (rename framework:text^
|
||||||
[-keymap% keymap%]))
|
[-keymap% keymap%]))
|
||||||
(init-depend framework:editor^)
|
(init-depend framework:editor^)
|
||||||
|
@ -52,7 +53,7 @@ WARNING: printf is rebound in the body of the unit to always
|
||||||
|
|
||||||
(define basic-mixin
|
(define basic-mixin
|
||||||
(mixin (editor:basic<%> (class->interface text%)) (basic<%>)
|
(mixin (editor:basic<%> (class->interface text%)) (basic<%>)
|
||||||
(inherit get-canvases get-admin split-snip get-snip-position
|
(inherit get-canvas get-canvases get-admin split-snip get-snip-position
|
||||||
begin-edit-sequence end-edit-sequence
|
begin-edit-sequence end-edit-sequence
|
||||||
set-autowrap-bitmap
|
set-autowrap-bitmap
|
||||||
delete find-snip invalidate-bitmap-cache
|
delete find-snip invalidate-bitmap-cache
|
||||||
|
@ -350,7 +351,18 @@ WARNING: printf is rebound in the body of the unit to always
|
||||||
(public initial-autowrap-bitmap)
|
(public initial-autowrap-bitmap)
|
||||||
(define (initial-autowrap-bitmap) (icon:get-autowrap-bitmap))
|
(define (initial-autowrap-bitmap) (icon:get-autowrap-bitmap))
|
||||||
|
|
||||||
(super-instantiate ())
|
(define/override (put-file directory default-name)
|
||||||
|
(let* ([canvas (get-canvas)]
|
||||||
|
[parent (and canvas (send canvas get-top-level-window))])
|
||||||
|
(finder:put-file default-name
|
||||||
|
directory
|
||||||
|
#f
|
||||||
|
(string-constant select-file)
|
||||||
|
#f
|
||||||
|
""
|
||||||
|
parent)))
|
||||||
|
|
||||||
|
(super-new)
|
||||||
(set-autowrap-bitmap (initial-autowrap-bitmap))))
|
(set-autowrap-bitmap (initial-autowrap-bitmap))))
|
||||||
|
|
||||||
(define foreground-color<%>
|
(define foreground-color<%>
|
||||||
|
|
Loading…
Reference in New Issue
Block a user