...
original commit: 4c7ada17b2135c1f987c9bdf0df37c2aa95ac695
This commit is contained in:
Robby Findler
parent
ada73b4de9
commit
758a31663b
|
|
@ -27,9 +27,8 @@
|
||||||
(lambda (m)
|
(lambda (m)
|
||||||
(super-set-editor m)
|
(super-set-editor m)
|
||||||
(let ([tlw (get-top-level-window)])
|
(let ([tlw (get-top-level-window)])
|
||||||
(cond
|
(when (eq? this (send tlw get-info-canvas))
|
||||||
[(eq? this (send tlw get-info-canvas))
|
(send tlw update-info))))])
|
||||||
(send tlw update-info)])))])
|
|
||||||
(sequence
|
(sequence
|
||||||
(apply super-init parent editor args)
|
(apply super-init parent editor args)
|
||||||
(unless (is-a? (get-top-level-window) frame:info<%>)
|
(unless (is-a? (get-top-level-window) frame:info<%>)
|
||||||
|
|
|
||||||
|
|
@ -171,8 +171,7 @@
|
||||||
[on-close
|
[on-close
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(super-on-close)
|
(super-on-close)
|
||||||
(send (get-editor) on-close))]
|
(send (get-editor) on-close))])
|
||||||
[get-area-container% (lambda () panel:vertical-editor%)])
|
|
||||||
(private
|
(private
|
||||||
[label (if file-name
|
[label (if file-name
|
||||||
(let-values ([(base name dir?) (split-path file-name)])
|
(let-values ([(base name dir?) (split-path file-name)])
|
||||||
|
|
@ -211,8 +210,8 @@
|
||||||
(set! label t)
|
(set! label t)
|
||||||
(do-label)))])
|
(do-label)))])
|
||||||
(public
|
(public
|
||||||
[get-canvas% (lambda () editor-canvas<%>)]
|
[get-canvas% (lambda () editor-canvas%)]
|
||||||
[get-canvas<%> (lambda () editor-canvas%)]
|
[get-canvas<%> (lambda () editor-canvas<%>)]
|
||||||
[make-canvas (lambda ()
|
[make-canvas (lambda ()
|
||||||
(let ([% (get-canvas%)]
|
(let ([% (get-canvas%)]
|
||||||
[<%> (get-canvas<%>)])
|
[<%> (get-canvas<%>)])
|
||||||
|
|
@ -273,24 +272,6 @@
|
||||||
(send (get-editor) save-file)
|
(send (get-editor) save-file)
|
||||||
#t)]
|
#t)]
|
||||||
[file-menu:save-as (lambda (item control) (save-as) #t)]
|
[file-menu:save-as (lambda (item control) (save-as) #t)]
|
||||||
[file-menu:between-print-and-close
|
|
||||||
(lambda (file-menu)
|
|
||||||
(make-object separator-menu-item% file-menu)
|
|
||||||
(let ([split
|
|
||||||
(lambda (panel%)
|
|
||||||
(lambda (item control)
|
|
||||||
(let ([win (get-edit-target-object)])
|
|
||||||
(when (and win
|
|
||||||
(is-a? win canvas<%>))
|
|
||||||
(send (get-area-container) split win panel%)))))])
|
|
||||||
(make-object (get-menu-item%) "Split Horizontally" file-menu (split horizontal-panel%))
|
|
||||||
(make-object (get-menu-item%) "Split Vertically" file-menu (split vertical-panel%))
|
|
||||||
(make-object (get-menu-item%) "Collapse" file-menu
|
|
||||||
(lambda (item control)
|
|
||||||
(let ([canvas (get-edit-target-window)])
|
|
||||||
(when canvas
|
|
||||||
(send (get-area-container) collapse canvas))))))
|
|
||||||
(make-object separator-menu-item% file-menu))]
|
|
||||||
[file-menu:print (lambda (item control)
|
[file-menu:print (lambda (item control)
|
||||||
(send (get-editor) print
|
(send (get-editor) print
|
||||||
#t
|
#t
|
||||||
|
|
|
||||||
|
|
@ -21,12 +21,7 @@
|
||||||
single-window<%>
|
single-window<%>
|
||||||
single-window-mixin
|
single-window-mixin
|
||||||
single%
|
single%
|
||||||
single-pane%
|
single-pane%))
|
||||||
|
|
||||||
editor-mixin
|
|
||||||
editor<%>
|
|
||||||
horizontal-editor%
|
|
||||||
vertical-editor%))
|
|
||||||
|
|
||||||
(define-signature framework:exn^
|
(define-signature framework:exn^
|
||||||
((struct exn ())
|
((struct exn ())
|
||||||
|
|
@ -48,6 +43,8 @@
|
||||||
restore-defaults
|
restore-defaults
|
||||||
|
|
||||||
add-panel
|
add-panel
|
||||||
|
add-font-panel
|
||||||
|
add-general-panel
|
||||||
show-dialog
|
show-dialog
|
||||||
hide-dialog))
|
hide-dialog))
|
||||||
|
|
||||||
|
|
@ -202,10 +199,7 @@
|
||||||
open-file))
|
open-file))
|
||||||
|
|
||||||
(define-signature framework:icon^
|
(define-signature framework:icon^
|
||||||
(get
|
(get-paren-highlight-bitmap
|
||||||
get-mask
|
|
||||||
|
|
||||||
get-paren-highlight-bitmap
|
|
||||||
get-autowrap-bitmap
|
get-autowrap-bitmap
|
||||||
|
|
||||||
get-lock-bitmap
|
get-lock-bitmap
|
||||||
|
|
@ -247,7 +241,8 @@
|
||||||
setup-keymap
|
setup-keymap
|
||||||
text-mixin
|
text-mixin
|
||||||
text<%>
|
text<%>
|
||||||
text%))
|
text%
|
||||||
|
add-preferences-panel))
|
||||||
|
|
||||||
(define-signature framework:paren^
|
(define-signature framework:paren^
|
||||||
(balanced?
|
(balanced?
|
||||||
|
|
|
||||||
|
|
@ -47,8 +47,8 @@
|
||||||
(set! icon (make-object bitmap% p type))
|
(set! icon (make-object bitmap% p type))
|
||||||
icon)))))
|
icon)))))
|
||||||
|
|
||||||
(define get (make-get/mask "plt16x16.bmp" 'bmp))
|
;(define get (make-get/mask "plt16x16.bmp" 'bmp))
|
||||||
(define get-mask (make-get/mask "dot16x16.xbm" 'xbm))
|
;(define get-mask (make-get/mask "dot16x16.xbm" 'xbm))
|
||||||
|
|
||||||
(define gc-on-bitmap #f)
|
(define gc-on-bitmap #f)
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -2,8 +2,7 @@
|
||||||
(import mred-interfaces^
|
(import mred-interfaces^
|
||||||
[preferences : framework:preferences^]
|
[preferences : framework:preferences^]
|
||||||
[exit : framework:exit^]
|
[exit : framework:exit^]
|
||||||
[group : framework:group^]
|
[group : framework:group^])
|
||||||
[mzlib:function : mzlib:function^])
|
|
||||||
|
|
||||||
;; preferences
|
;; preferences
|
||||||
|
|
||||||
|
|
@ -83,83 +82,6 @@
|
||||||
(or (eq? x 'common)
|
(or (eq? x 'common)
|
||||||
(eq? x 'std))))
|
(eq? x 'std))))
|
||||||
|
|
||||||
(preferences:add-panel
|
|
||||||
"Indenting"
|
|
||||||
(lambda (p)
|
|
||||||
(let*-values
|
|
||||||
([(get-keywords)
|
|
||||||
(lambda (hash-table)
|
|
||||||
(letrec ([all-keywords (hash-table-map hash-table list)]
|
|
||||||
[pick-out (lambda (wanted in out)
|
|
||||||
(cond
|
|
||||||
[(null? in) (mzlib:function:quicksort out string<=?)]
|
|
||||||
[else (if (eq? wanted (cadr (car in)))
|
|
||||||
(pick-out wanted (cdr in) (cons (symbol->string (car (car in))) out))
|
|
||||||
(pick-out wanted (cdr in) out))]))])
|
|
||||||
(values (pick-out 'begin all-keywords null)
|
|
||||||
(pick-out 'define all-keywords null)
|
|
||||||
(pick-out 'lambda all-keywords null))))]
|
|
||||||
[(begin-keywords define-keywords lambda-keywords)
|
|
||||||
(get-keywords (preferences:get 'framework:tabify))])
|
|
||||||
(let* ([add-callback
|
|
||||||
(lambda (keyword-type keyword-symbol list-box)
|
|
||||||
(lambda (button command)
|
|
||||||
(let ([new-one (get-text-from-user
|
|
||||||
(string-append "Enter new " keyword-type "-like keyword:")
|
|
||||||
(string-append keyword-type " Keyword"))])
|
|
||||||
(when new-one
|
|
||||||
(let ([parsed (with-handlers ((exn:read? (lambda (x) #f)))
|
|
||||||
(read (open-input-string new-one)))])
|
|
||||||
(cond
|
|
||||||
[(and (symbol? parsed)
|
|
||||||
(hash-table-get (preferences:get 'framework:tabify)
|
|
||||||
parsed
|
|
||||||
(lambda () #f)))
|
|
||||||
(message-box "Error"
|
|
||||||
(format "\"~a\" is already a specially indented keyword" parsed))]
|
|
||||||
[(symbol? parsed)
|
|
||||||
(hash-table-put! (preferences:get 'framework:tabify)
|
|
||||||
parsed keyword-symbol)
|
|
||||||
(send list-box append (symbol->string parsed))]
|
|
||||||
[else (message-box "Error" (format "expected a symbol, found: ~a" new-one))]))))))]
|
|
||||||
[delete-callback
|
|
||||||
(lambda (list-box)
|
|
||||||
(lambda (button command)
|
|
||||||
(let* ([selections (send list-box get-selections)]
|
|
||||||
[symbols (map (lambda (x) (string->symbol (send list-box get-string x))) selections)])
|
|
||||||
(for-each (lambda (x) (send list-box delete x)) (reverse selections))
|
|
||||||
(let ([ht (preferences:get 'framework:tabify)])
|
|
||||||
(for-each (lambda (x) (hash-table-remove! ht x)) symbols)))))]
|
|
||||||
[main-panel (make-object horizontal-panel% p)]
|
|
||||||
[make-column
|
|
||||||
(lambda (string symbol keywords)
|
|
||||||
(let* ([vert (make-object vertical-panel% main-panel)]
|
|
||||||
[_ (make-object message% (string-append string "-like Keywords") vert)]
|
|
||||||
[box (make-object list-box% #f keywords vert void '(multiple))]
|
|
||||||
[button-panel (make-object horizontal-panel% vert)]
|
|
||||||
[add-button (make-object button% "Add" button-panel (add-callback string symbol box))]
|
|
||||||
[delete-button (make-object button% "Remove" button-panel (delete-callback box))])
|
|
||||||
(send* button-panel
|
|
||||||
(set-alignment 'center 'center)
|
|
||||||
(stretchable-height #f))
|
|
||||||
(send add-button min-width (send delete-button get-width))
|
|
||||||
box))]
|
|
||||||
[begin-list-box (make-column "Begin" 'begin begin-keywords)]
|
|
||||||
[define-list-box (make-column "Define" 'define define-keywords)]
|
|
||||||
[lambda-list-box (make-column "Lambda" 'lambda lambda-keywords)]
|
|
||||||
[update-list-boxes
|
|
||||||
(lambda (hash-table)
|
|
||||||
(let-values ([(begin-keywords define-keywords lambda-keywords) (get-keywords hash-table)]
|
|
||||||
[(reset) (lambda (list-box keywords)
|
|
||||||
(send list-box clear)
|
|
||||||
(for-each (lambda (x) (send list-box append x)) keywords))])
|
|
||||||
(reset begin-list-box begin-keywords)
|
|
||||||
(reset define-list-box define-keywords)
|
|
||||||
(reset lambda-list-box lambda-keywords)
|
|
||||||
#t))])
|
|
||||||
(preferences:add-callback 'framework:tabify (lambda (p v) (update-list-boxes v)))
|
|
||||||
main-panel))))
|
|
||||||
|
|
||||||
;; groups
|
;; groups
|
||||||
|
|
||||||
(preferences:set-default 'framework:exit-when-no-frames #t boolean?)
|
(preferences:set-default 'framework:exit-when-no-frames #t boolean?)
|
||||||
|
|
|
||||||
|
|
@ -79,88 +79,4 @@
|
||||||
(apply super-init args))))
|
(apply super-init args))))
|
||||||
|
|
||||||
(define single% (single-window-mixin (single-mixin panel%)))
|
(define single% (single-window-mixin (single-mixin panel%)))
|
||||||
(define single-pane% (single-mixin pane%))
|
(define single-pane% (single-mixin pane%)))
|
||||||
|
|
||||||
(define -editor<%>
|
|
||||||
(interface ()
|
|
||||||
get-canvas%
|
|
||||||
collapse
|
|
||||||
split))
|
|
||||||
|
|
||||||
(define editor-mixin
|
|
||||||
(mixin (panel<%>) (-editor<%>) args
|
|
||||||
(rename [super-change-children change-children])
|
|
||||||
(inherit get-parent change-children get-children)
|
|
||||||
(public [get-canvas% (lambda () editor-canvas%)])
|
|
||||||
(private
|
|
||||||
[split-edits null])
|
|
||||||
(public
|
|
||||||
[collapse
|
|
||||||
(lambda (canvas)
|
|
||||||
(let ([media (send canvas get-media)])
|
|
||||||
(if (memq media split-edits)
|
|
||||||
(letrec ([helper
|
|
||||||
(lambda (canvas/panel)
|
|
||||||
(if (eq? canvas/panel this)
|
|
||||||
(let ([children (get-children)])
|
|
||||||
(cond
|
|
||||||
[(and (= (length children) 1)
|
|
||||||
(eq? canvas (car children)))
|
|
||||||
(void)]
|
|
||||||
[(member canvas children)
|
|
||||||
(change-children (lambda (l) (list canvas)))]
|
|
||||||
[else
|
|
||||||
(change-children
|
|
||||||
(lambda (l)
|
|
||||||
(let ([c (make-object (object-class canvas) this)])
|
|
||||||
(send c set-media media)
|
|
||||||
(list c))))])
|
|
||||||
(bell))
|
|
||||||
(let* ([parent (send canvas/panel get-parent)]
|
|
||||||
[parents-children (send parent get-children)]
|
|
||||||
[num-children (length parents-children)])
|
|
||||||
(if (<= num-children 1)
|
|
||||||
(helper parent)
|
|
||||||
(begin (send parent delete-child canvas/panel)
|
|
||||||
(send (car (send parent get-children)) focus))))))])
|
|
||||||
(send media remove-canvas canvas)
|
|
||||||
(helper canvas))
|
|
||||||
(bell))))]
|
|
||||||
[split
|
|
||||||
(opt-lambda (canvas [panel% horizontal-panel%])
|
|
||||||
(let* ([frame (ivar canvas frame)]
|
|
||||||
[media (send canvas get-media)]
|
|
||||||
[canvas% (object-class canvas)]
|
|
||||||
[parent (send canvas get-parent)]
|
|
||||||
[new-panel #f]
|
|
||||||
[left-split #f]
|
|
||||||
[right-split #f]
|
|
||||||
[before #t])
|
|
||||||
(set! split-edits (cons media split-edits))
|
|
||||||
(dynamic-wind
|
|
||||||
(lambda ()
|
|
||||||
(set! before (send frame delay-updates))
|
|
||||||
(send frame delay-updates #t))
|
|
||||||
(lambda ()
|
|
||||||
(set! new-panel (make-object panel% parent))
|
|
||||||
(set! left-split (make-object canvas% new-panel))
|
|
||||||
(set! right-split (make-object canvas% new-panel))
|
|
||||||
(send parent change-children
|
|
||||||
(lambda (l)
|
|
||||||
(let ([before (mzlib:function:remq new-panel l)])
|
|
||||||
(map (lambda (x) (if (eq? x canvas)
|
|
||||||
new-panel
|
|
||||||
x))
|
|
||||||
before)))))
|
|
||||||
(lambda () (send frame delay-updates before)))
|
|
||||||
(send* media (remove-canvas canvas)
|
|
||||||
(add-canvas left-split)
|
|
||||||
(add-canvas right-split))
|
|
||||||
(send* left-split (set-media media) (focus))
|
|
||||||
(send* right-split (set-media media))))])
|
|
||||||
(sequence (apply super-init args))))
|
|
||||||
|
|
||||||
(define horizontal-editor%
|
|
||||||
(editor-mixin horizontal-panel%))
|
|
||||||
(define vertical-editor%
|
|
||||||
(editor-mixin vertical-panel%)))
|
|
||||||
|
|
@ -254,291 +254,271 @@
|
||||||
[else (err input "expected a pair")])))))))))
|
[else (err input "expected a pair")])))))))))
|
||||||
|
|
||||||
(define-struct ppanel (title container panel))
|
(define-struct ppanel (title container panel))
|
||||||
|
|
||||||
(define font-families-name/const
|
|
||||||
(list (list "Default" 'default)
|
|
||||||
(list "Decorative" 'decorative)
|
|
||||||
(list "Roman" 'roman)
|
|
||||||
(list "Decorative" 'script)
|
|
||||||
(list "Swiss" 'swiss)
|
|
||||||
(list "Modern" 'modern)))
|
|
||||||
|
|
||||||
(define font-families (map car font-families-name/const))
|
|
||||||
|
|
||||||
(define font-size-entry "defaultFontSize")
|
(define ppanels null)
|
||||||
(define font-default-string "Default Value")
|
|
||||||
(define font-default-size 12)
|
|
||||||
(define font-section "mred")
|
|
||||||
(define build-font-entry (lambda (x) (string-append "Screen" x "__")))
|
|
||||||
(define font-file (find-graphical-system-path 'setup-file))
|
|
||||||
(define (build-font-preference-symbol family)
|
|
||||||
(string->symbol (string-append "framework:" family)))
|
|
||||||
|
|
||||||
(let ([set-default
|
|
||||||
(lambda (build-font-entry default pred)
|
|
||||||
(lambda (family)
|
|
||||||
(let ([name (build-font-preference-symbol family)]
|
|
||||||
[font-entry (build-font-entry family)])
|
|
||||||
(set-default name
|
|
||||||
default
|
|
||||||
(cond
|
|
||||||
[(string? default) string?]
|
|
||||||
[(number? default) number?]
|
|
||||||
[else (error 'internal-error.set-default "unrecognized default: ~a~n" default)]))
|
|
||||||
(add-callback
|
|
||||||
name
|
|
||||||
(lambda (p new-value)
|
|
||||||
(write-resource
|
|
||||||
font-section
|
|
||||||
font-entry
|
|
||||||
(if (and (string? new-value)
|
|
||||||
(string=? font-default-string new-value))
|
|
||||||
""
|
|
||||||
new-value)
|
|
||||||
font-file))))))])
|
|
||||||
(for-each (set-default build-font-entry font-default-string string?)
|
|
||||||
font-families)
|
|
||||||
((set-default (lambda (x) x)
|
|
||||||
font-default-size
|
|
||||||
number?)
|
|
||||||
font-size-entry))
|
|
||||||
|
|
||||||
(define ppanels
|
|
||||||
(list
|
|
||||||
(make-ppanel
|
|
||||||
"General"
|
|
||||||
(lambda (parent)
|
|
||||||
(let* ([main (make-object vertical-panel% parent)]
|
|
||||||
[make-check
|
|
||||||
(lambda (pref title bool->pref pref->bool)
|
|
||||||
(let* ([callback
|
|
||||||
(lambda (check-box _)
|
|
||||||
(set pref (bool->pref (send check-box get-value))))]
|
|
||||||
[pref-value (get pref)]
|
|
||||||
[initial-value (pref->bool pref-value)]
|
|
||||||
[c (make-object check-box% title main callback)])
|
|
||||||
(send c set-value initial-value)
|
|
||||||
(add-callback pref
|
|
||||||
(lambda (p v)
|
|
||||||
(send c set-value (pref->bool v))))))]
|
|
||||||
[id (lambda (x) x)])
|
|
||||||
(send main set-alignment 'left 'center)
|
|
||||||
(make-check 'framework:highlight-parens "Highlight between matching parens" id id)
|
|
||||||
(make-check 'framework:fixup-parens "Correct parens" id id)
|
|
||||||
(make-check 'framework:paren-match "Flash paren match" id id)
|
|
||||||
(make-check 'framework:autosaving-on? "Auto-save files" id id)
|
|
||||||
(make-check 'framework:delete-forward? "Map delete to backspace" not not)
|
|
||||||
(make-check 'framework:file-dialogs "Use platform-specific file dialogs"
|
|
||||||
(lambda (x) (if x 'std 'common))
|
|
||||||
(lambda (x) (eq? x 'std)))
|
|
||||||
|
|
||||||
(make-check 'framework:verify-exit "Verify exit" id id)
|
|
||||||
(make-check 'framework:verify-change-format "Ask before changing save format" id id)
|
|
||||||
(make-check 'framework:auto-set-wrap? "Wordwrap editor buffers" id id)
|
|
||||||
|
|
||||||
(make-check 'framework:show-status-line "Show status-line" id id)
|
|
||||||
(make-check 'framework:line-offsets "Count line and column numbers from one" id id)
|
|
||||||
(make-check 'framework:menu-bindings "Enable keybindings in menus" id id)
|
|
||||||
(unless (eq? (system-type) 'unix)
|
|
||||||
(make-check 'framework:print-output-mode "Automatically print to postscript file"
|
|
||||||
(lambda (b)
|
|
||||||
(if b 'postscript 'standard))
|
|
||||||
(lambda (n) (eq? 'postscript n))))
|
|
||||||
|
|
||||||
|
(define (add-general-panel)
|
||||||
(make-check 'framework:display-line-numbers "Display line numbers in buffer; not character offsets" id id)
|
(add-panel
|
||||||
'(when (eq? (system-type) 'windows)
|
"General"
|
||||||
|
(lambda (parent)
|
||||||
|
(let* ([main (make-object vertical-panel% parent)]
|
||||||
|
[make-check
|
||||||
|
(lambda (pref title bool->pref pref->bool)
|
||||||
|
(let* ([callback
|
||||||
|
(lambda (check-box _)
|
||||||
|
(set pref (bool->pref (send check-box get-value))))]
|
||||||
|
[pref-value (get pref)]
|
||||||
|
[initial-value (pref->bool pref-value)]
|
||||||
|
[c (make-object check-box% title main callback)])
|
||||||
|
(send c set-value initial-value)
|
||||||
|
(add-callback pref
|
||||||
|
(lambda (p v)
|
||||||
|
(send c set-value (pref->bool v))))))]
|
||||||
|
[id (lambda (x) x)])
|
||||||
|
(send main set-alignment 'left 'center)
|
||||||
|
(make-check 'framework:highlight-parens "Highlight between matching parens" id id)
|
||||||
|
(make-check 'framework:fixup-parens "Correct parens" id id)
|
||||||
|
(make-check 'framework:paren-match "Flash paren match" id id)
|
||||||
|
(make-check 'framework:autosaving-on? "Auto-save files" id id)
|
||||||
|
(make-check 'framework:delete-forward? "Map delete to backspace" not not)
|
||||||
|
(make-check 'framework:file-dialogs "Use platform-specific file dialogs"
|
||||||
|
(lambda (x) (if x 'std 'common))
|
||||||
|
(lambda (x) (eq? x 'std)))
|
||||||
|
|
||||||
|
(make-check 'framework:verify-exit "Verify exit" id id)
|
||||||
|
(make-check 'framework:verify-change-format "Ask before changing save format" id id)
|
||||||
|
(make-check 'framework:auto-set-wrap? "Wordwrap editor buffers" id id)
|
||||||
|
|
||||||
|
(make-check 'framework:show-status-line "Show status-line" id id)
|
||||||
|
(make-check 'framework:line-offsets "Count line and column numbers from one" id id)
|
||||||
|
(make-check 'framework:menu-bindings "Enable keybindings in menus" id id)
|
||||||
|
(unless (eq? (system-type) 'unix)
|
||||||
|
(make-check 'framework:print-output-mode "Automatically print to postscript file"
|
||||||
|
(lambda (b)
|
||||||
|
(if b 'postscript 'standard))
|
||||||
|
(lambda (n) (eq? 'postscript n))))
|
||||||
|
|
||||||
|
|
||||||
|
(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))
|
(make-check 'framework:windows-mdi "Use MDI Windows" id id))
|
||||||
|
|
||||||
main))
|
main))))
|
||||||
#f)
|
|
||||||
(make-ppanel
|
(define (add-font-panel)
|
||||||
"Default Fonts"
|
(let* ([font-families-name/const
|
||||||
(lambda (parent)
|
(list (list "Default" 'default)
|
||||||
(letrec ([font-size-pref-sym (build-font-preference-symbol font-size-entry)]
|
(list "Decorative" 'decorative)
|
||||||
[ex-string "The quick brown fox jumped over the lazy dogs."]
|
(list "Modern" 'modern)
|
||||||
[main (make-object vertical-panel% parent)]
|
(list "Roman" 'roman)
|
||||||
[fonts (cons font-default-string (get-face-list))]
|
(list "Swiss" 'swiss))]
|
||||||
[make-family-panel
|
|
||||||
(lambda (name)
|
[font-families (map car font-families-name/const)]
|
||||||
(let* ([pref-sym (build-font-preference-symbol name)]
|
|
||||||
[family-const-pair (assoc name font-families-name/const)]
|
[font-size-entry "defaultFontSize"]
|
||||||
|
[font-default-string "Default Value"]
|
||||||
[edit (make-object text%)]
|
[font-default-size 12]
|
||||||
[_ (send edit insert ex-string)]
|
[font-section "mred"]
|
||||||
[set-edit-font
|
[build-font-entry (lambda (x) (string-append "Screen" x "__"))]
|
||||||
(lambda (size)
|
[font-file (find-graphical-system-path 'setup-file)]
|
||||||
(let ([delta (make-object style-delta% 'change-size size)]
|
[build-font-preference-symbol
|
||||||
[face (get pref-sym)])
|
(lambda (family)
|
||||||
(if (and (string=? face font-default-string)
|
(string->symbol (string-append "framework:" family)))]
|
||||||
family-const-pair)
|
|
||||||
(send delta set-family (cadr family-const-pair))
|
[set-default
|
||||||
(send delta set-delta-face (get pref-sym)))
|
(lambda (build-font-entry default pred)
|
||||||
|
(lambda (family)
|
||||||
(send edit change-style delta 0 (send edit last-position))))]
|
(let ([name (build-font-preference-symbol family)]
|
||||||
|
[font-entry (build-font-entry family)])
|
||||||
[horiz (make-object horizontal-panel% main '(border))]
|
(set-default name
|
||||||
[label (make-object message% name horiz)]
|
default
|
||||||
|
(cond
|
||||||
[message (make-object message%
|
[(string? default) string?]
|
||||||
(let ([b (box "")])
|
[(number? default) number?]
|
||||||
(if (and (get-resource
|
[else (error 'internal-error.set-default "unrecognized default: ~a~n" default)]))
|
||||||
font-section
|
(add-callback
|
||||||
(build-font-entry name)
|
name
|
||||||
b)
|
(lambda (p new-value)
|
||||||
(not (string=? (unbox b)
|
(write-resource
|
||||||
"")))
|
font-section
|
||||||
(unbox b)
|
font-entry
|
||||||
font-default-string))
|
(if (and (string? new-value)
|
||||||
horiz)]
|
(string=? font-default-string new-value))
|
||||||
[button
|
""
|
||||||
(make-object button%
|
new-value)
|
||||||
"Change"
|
font-file))))))])
|
||||||
horiz
|
|
||||||
(lambda (button evt)
|
(for-each (set-default build-font-entry font-default-string string?)
|
||||||
(let ([new-value
|
font-families)
|
||||||
(get-choices-from-user
|
((set-default (lambda (x) x)
|
||||||
"Fonts"
|
font-default-size
|
||||||
(format "Please choose a new ~a font"
|
number?)
|
||||||
name)
|
font-size-entry)
|
||||||
fonts)])
|
(add-panel
|
||||||
(when new-value
|
"Default Fonts"
|
||||||
(set pref-sym (list-ref fonts (car new-value)))
|
(lambda (parent)
|
||||||
(set-edit-font (get font-size-pref-sym))))))]
|
(letrec ([font-size-pref-sym (build-font-preference-symbol font-size-entry)]
|
||||||
[canvas (make-object editor-canvas% horiz
|
[ex-string "The quick brown fox jumped over the lazy dogs."]
|
||||||
edit
|
[main (make-object vertical-panel% parent)]
|
||||||
(list 'hide-hscroll
|
[fonts (cons font-default-string (get-face-list))]
|
||||||
'hide-vscroll))])
|
[make-family-panel
|
||||||
(set-edit-font (get font-size-pref-sym))
|
(lambda (name)
|
||||||
(add-callback
|
(let* ([pref-sym (build-font-preference-symbol name)]
|
||||||
pref-sym
|
[family-const-pair (assoc name font-families-name/const)]
|
||||||
(lambda (p new-value)
|
|
||||||
(send horiz change-children
|
[edit (make-object text%)]
|
||||||
(lambda (l)
|
[_ (send edit insert ex-string)]
|
||||||
(let ([new-message (make-object message%
|
[set-edit-font
|
||||||
new-value
|
(lambda (size)
|
||||||
horiz)])
|
(let ([delta (make-object style-delta% 'change-size size)]
|
||||||
(set! message new-message)
|
[face (get pref-sym)])
|
||||||
(update-message-sizes font-message-get-widths
|
(if (and (string=? face font-default-string)
|
||||||
font-message-user-min-sizes)
|
family-const-pair)
|
||||||
(list label
|
(send delta set-family (cadr family-const-pair))
|
||||||
new-message
|
(send delta set-delta-face (get pref-sym)))
|
||||||
button
|
|
||||||
canvas))))))
|
(send edit change-style delta 0 (send edit last-position))))]
|
||||||
(send canvas set-line-count 1)
|
|
||||||
(vector set-edit-font
|
[horiz (make-object horizontal-panel% main '(border))]
|
||||||
(lambda () (send message get-width))
|
[label (make-object message% name horiz)]
|
||||||
(lambda (width) (send message min-width width))
|
|
||||||
(lambda () (send label get-width))
|
[message (make-object message%
|
||||||
(lambda (width) (send label min-width width)))))]
|
(let ([b (box "")])
|
||||||
[set-edit-fonts/messages (map make-family-panel font-families)]
|
(if (and (get-resource
|
||||||
[collect (lambda (n) (map (lambda (x) (vector-ref x n))
|
font-section
|
||||||
set-edit-fonts/messages))]
|
(build-font-entry name)
|
||||||
[set-edit-fonts (collect 0)]
|
b)
|
||||||
[font-message-get-widths (collect 1)]
|
(not (string=? (unbox b)
|
||||||
[font-message-user-min-sizes (collect 2)]
|
"")))
|
||||||
[category-message-get-widths (collect 3)]
|
(unbox b)
|
||||||
[category-message-user-min-sizes (collect 4)]
|
font-default-string))
|
||||||
[update-message-sizes
|
horiz)]
|
||||||
(lambda (gets sets)
|
[button
|
||||||
(let ([width (mzlib:function:foldl (lambda (x l) (max l (x))) 0 gets)])
|
(make-object button%
|
||||||
(for-each (lambda (set) (set width)) sets)))]
|
"Change"
|
||||||
[size-panel (make-object horizontal-panel% main '(border))]
|
horiz
|
||||||
[initial-font-size
|
(lambda (button evt)
|
||||||
(let ([b (box 0)])
|
(let ([new-value
|
||||||
(if (get-resource font-section
|
(get-choices-from-user
|
||||||
font-size-entry
|
"Fonts"
|
||||||
b)
|
(format "Please choose a new ~a font"
|
||||||
(unbox b)
|
name)
|
||||||
font-default-size))]
|
fonts)])
|
||||||
[size-slider
|
(when new-value
|
||||||
(make-object slider%
|
(set pref-sym (list-ref fonts (car new-value)))
|
||||||
"Size"
|
(set-edit-font (get font-size-pref-sym))))))]
|
||||||
1 127
|
[canvas (make-object editor-canvas% horiz
|
||||||
size-panel
|
edit
|
||||||
(lambda (slider evt)
|
(list 'hide-hscroll
|
||||||
(set font-size-pref-sym (send slider get-value)))
|
'hide-vscroll))])
|
||||||
initial-font-size)])
|
(set-edit-font (get font-size-pref-sym))
|
||||||
(update-message-sizes font-message-get-widths font-message-user-min-sizes)
|
(add-callback
|
||||||
(update-message-sizes category-message-get-widths category-message-user-min-sizes)
|
pref-sym
|
||||||
(add-callback
|
(lambda (p new-value)
|
||||||
font-size-pref-sym
|
(send horiz change-children
|
||||||
(lambda (p value)
|
(lambda (l)
|
||||||
(for-each (lambda (f) (f value)) set-edit-fonts)
|
(let ([new-message (make-object message%
|
||||||
(unless (= value (send size-slider get-value))
|
new-value
|
||||||
(send size-slider set-value value))
|
horiz)])
|
||||||
#t))
|
(set! message new-message)
|
||||||
(for-each (lambda (f) (f initial-font-size)) set-edit-fonts)
|
(update-message-sizes font-message-get-widths
|
||||||
(make-object message% "Restart to see font changes" main)
|
font-message-user-min-sizes)
|
||||||
main))
|
(list label
|
||||||
#f)))
|
new-message
|
||||||
|
button
|
||||||
(define make-run-once
|
canvas))))))
|
||||||
(lambda ()
|
(send canvas set-line-count 1)
|
||||||
(let ([semaphore (make-semaphore 1)])
|
(vector set-edit-font
|
||||||
(lambda (t)
|
(lambda () (send message get-width))
|
||||||
(dynamic-wind (lambda () (semaphore-wait semaphore))
|
(lambda (width) (send message min-width width))
|
||||||
t
|
(lambda () (send label get-width))
|
||||||
(lambda () (semaphore-post semaphore)))))))
|
(lambda (width) (send label min-width width)))))]
|
||||||
|
[set-edit-fonts/messages (map make-family-panel font-families)]
|
||||||
(define run-once (make-run-once))
|
[collect (lambda (n) (map (lambda (x) (vector-ref x n))
|
||||||
|
set-edit-fonts/messages))]
|
||||||
|
[set-edit-fonts (collect 0)]
|
||||||
|
[font-message-get-widths (collect 1)]
|
||||||
|
[font-message-user-min-sizes (collect 2)]
|
||||||
|
[category-message-get-widths (collect 3)]
|
||||||
|
[category-message-user-min-sizes (collect 4)]
|
||||||
|
[update-message-sizes
|
||||||
|
(lambda (gets sets)
|
||||||
|
(let ([width (mzlib:function:foldl (lambda (x l) (max l (x))) 0 gets)])
|
||||||
|
(for-each (lambda (set) (set width)) sets)))]
|
||||||
|
[size-panel (make-object horizontal-panel% main '(border))]
|
||||||
|
[initial-font-size
|
||||||
|
(let ([b (box 0)])
|
||||||
|
(if (get-resource font-section
|
||||||
|
font-size-entry
|
||||||
|
b)
|
||||||
|
(unbox b)
|
||||||
|
font-default-size))]
|
||||||
|
[size-slider
|
||||||
|
(make-object slider%
|
||||||
|
"Size"
|
||||||
|
1 127
|
||||||
|
size-panel
|
||||||
|
(lambda (slider evt)
|
||||||
|
(set font-size-pref-sym (send slider get-value)))
|
||||||
|
initial-font-size)])
|
||||||
|
(update-message-sizes font-message-get-widths font-message-user-min-sizes)
|
||||||
|
(update-message-sizes category-message-get-widths category-message-user-min-sizes)
|
||||||
|
(add-callback
|
||||||
|
font-size-pref-sym
|
||||||
|
(lambda (p value)
|
||||||
|
(for-each (lambda (f) (f value)) set-edit-fonts)
|
||||||
|
(unless (= value (send size-slider get-value))
|
||||||
|
(send size-slider set-value value))
|
||||||
|
#t))
|
||||||
|
(for-each (lambda (f) (f initial-font-size)) set-edit-fonts)
|
||||||
|
(make-object message% "Restart to see font changes" main)
|
||||||
|
main)))))
|
||||||
|
|
||||||
(define preferences-dialog #f)
|
(define preferences-dialog #f)
|
||||||
|
|
||||||
(define add-panel
|
(define add-panel
|
||||||
(lambda (title container)
|
(lambda (title container)
|
||||||
(run-once
|
(set! ppanels
|
||||||
(lambda ()
|
(append ppanels (list (make-ppanel title container #f))))
|
||||||
(let ([new-ppanel (make-ppanel title container #f)])
|
(when preferences-dialog
|
||||||
(set! ppanels
|
(send preferences-dialog added-pane))))
|
||||||
(let loop ([ppanels ppanels])
|
|
||||||
(cond
|
|
||||||
[(null? ppanels) (list new-ppanel)]
|
|
||||||
[(string=? (ppanel-title (car ppanels))
|
|
||||||
title)
|
|
||||||
(loop (cdr ppanels))]
|
|
||||||
[else (cons (car ppanels)
|
|
||||||
(loop (cdr ppanels)))])))
|
|
||||||
(when preferences-dialog
|
|
||||||
(send preferences-dialog added-pane)))))))
|
|
||||||
|
|
||||||
(define hide-dialog
|
(define hide-dialog
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(run-once
|
(when preferences-dialog
|
||||||
(lambda ()
|
(send preferences-dialog show #f))))
|
||||||
(when preferences-dialog
|
|
||||||
(send preferences-dialog show #f))))))
|
|
||||||
|
|
||||||
(define show-dialog
|
(define show-dialog
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(run-once
|
(save)
|
||||||
(lambda ()
|
(if preferences-dialog
|
||||||
(save)
|
(send preferences-dialog show #t)
|
||||||
(if preferences-dialog
|
(set! preferences-dialog
|
||||||
(send preferences-dialog show #t)
|
(make-preferences-dialog)))))
|
||||||
(set! preferences-dialog
|
|
||||||
(make-preferences-dialog)))))))
|
|
||||||
|
|
||||||
(define make-preferences-dialog
|
(define make-preferences-dialog
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(letrec ([frame
|
(letrec ([frame
|
||||||
(make-object (class-asi frame%
|
(make-object (class-asi frame%
|
||||||
(public [added-pane
|
(public
|
||||||
(lambda ()
|
[added-pane
|
||||||
(ensure-constructed)
|
(lambda ()
|
||||||
(refresh-menu)
|
(ensure-constructed)
|
||||||
(send popup-menu set-selection (sub1 (length ppanels)))
|
(refresh-menu)
|
||||||
(send single-panel active-child
|
(unless (null? ppanels)
|
||||||
(ppanel-panel
|
(send popup-menu set-selection (sub1 (length ppanels)))
|
||||||
(car
|
(send single-panel active-child
|
||||||
(list-tail ppanels
|
(ppanel-panel
|
||||||
(sub1 (length ppanels)))))))]))
|
(car
|
||||||
|
(list-tail ppanels
|
||||||
|
(sub1 (length ppanels))))))))]))
|
||||||
"Preferences")]
|
"Preferences")]
|
||||||
[panel (make-object vertical-panel% frame)]
|
[panel (make-object vertical-panel% frame)]
|
||||||
[popup-callback
|
[popup-callback
|
||||||
(lambda (choice command-event)
|
(lambda (choice command-event)
|
||||||
(send single-panel active-child
|
(unless (null? ppanels)
|
||||||
(ppanel-panel (list-ref ppanels (send choice get-selection)))))]
|
(send single-panel active-child
|
||||||
|
(ppanel-panel (list-ref ppanels (send choice get-selection))))))]
|
||||||
[make-popup-menu
|
[make-popup-menu
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(let ([menu (make-object choice% "Category"
|
(let ([menu (make-object choice% "Category"
|
||||||
|
|
@ -563,11 +543,14 @@
|
||||||
(set-ppanel-panel! ppanel panel))))
|
(set-ppanel-panel! ppanel panel))))
|
||||||
ppanels)
|
ppanels)
|
||||||
(send single-panel change-children (lambda (l) (map ppanel-panel ppanels)))
|
(send single-panel change-children (lambda (l) (map ppanel-panel ppanels)))
|
||||||
(send single-panel active-child (ppanel-panel (car ppanels))))]
|
(unless (null? ppanels)
|
||||||
|
(send single-panel active-child (ppanel-panel (car ppanels)))))]
|
||||||
[refresh-menu
|
[refresh-menu
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(let ([new-popup (make-popup-menu)])
|
(let ([new-popup (make-popup-menu)]
|
||||||
(send new-popup set-selection (send popup-menu get-selection))
|
[old-selection (send popup-menu get-selection)])
|
||||||
|
(when old-selection
|
||||||
|
(send new-popup set-selection old-selection))
|
||||||
(set! popup-menu new-popup)
|
(set! popup-menu new-popup)
|
||||||
(send panel change-children
|
(send panel change-children
|
||||||
(lambda (l) (list new-popup
|
(lambda (l) (list new-popup
|
||||||
|
|
@ -587,6 +570,7 @@
|
||||||
(stretchable-height #f)
|
(stretchable-height #f)
|
||||||
(set-alignment 'right 'center))
|
(set-alignment 'right 'center))
|
||||||
(ensure-constructed)
|
(ensure-constructed)
|
||||||
(send popup-menu set-selection 0)
|
(unless (null? ppanels)
|
||||||
|
(send popup-menu set-selection 0))
|
||||||
(send frame show #t)
|
(send frame show #t)
|
||||||
frame))))
|
frame))))
|
||||||
|
|
|
||||||
|
|
@ -13,7 +13,8 @@
|
||||||
[keymap : framework:keymap^]
|
[keymap : framework:keymap^]
|
||||||
[text : framework:text^]
|
[text : framework:text^]
|
||||||
[frame : framework:frame^]
|
[frame : framework:frame^]
|
||||||
[mzlib:thread : mzlib:thread^])
|
[mzlib:thread : mzlib:thread^]
|
||||||
|
[mzlib:function : mzlib:function^])
|
||||||
|
|
||||||
(rename [-text% text%]
|
(rename [-text% text%]
|
||||||
[-text<%> text<%>])
|
[-text<%> text<%>])
|
||||||
|
|
@ -894,4 +895,84 @@
|
||||||
|
|
||||||
(define keymap (make-object keymap%))
|
(define keymap (make-object keymap%))
|
||||||
(setup-keymap keymap)
|
(setup-keymap keymap)
|
||||||
(define (get-keymap) keymap))
|
(define (get-keymap) keymap)
|
||||||
|
|
||||||
|
(define (add-preferences-panel)
|
||||||
|
(preferences:add-panel
|
||||||
|
"Indenting"
|
||||||
|
(lambda (p)
|
||||||
|
(let*-values
|
||||||
|
([(get-keywords)
|
||||||
|
(lambda (hash-table)
|
||||||
|
(letrec ([all-keywords (hash-table-map hash-table list)]
|
||||||
|
[pick-out (lambda (wanted in out)
|
||||||
|
(cond
|
||||||
|
[(null? in) (mzlib:function:quicksort out string<=?)]
|
||||||
|
[else (if (eq? wanted (cadr (car in)))
|
||||||
|
(pick-out wanted (cdr in) (cons (symbol->string (car (car in))) out))
|
||||||
|
(pick-out wanted (cdr in) out))]))])
|
||||||
|
(values (pick-out 'begin all-keywords null)
|
||||||
|
(pick-out 'define all-keywords null)
|
||||||
|
(pick-out 'lambda all-keywords null))))]
|
||||||
|
[(begin-keywords define-keywords lambda-keywords)
|
||||||
|
(get-keywords (preferences:get 'framework:tabify))])
|
||||||
|
(let* ([add-callback
|
||||||
|
(lambda (keyword-type keyword-symbol list-box)
|
||||||
|
(lambda (button command)
|
||||||
|
(let ([new-one (get-text-from-user
|
||||||
|
(string-append "Enter new " keyword-type "-like keyword:")
|
||||||
|
(string-append keyword-type " Keyword"))])
|
||||||
|
(when new-one
|
||||||
|
(let ([parsed (with-handlers ((exn:read? (lambda (x) #f)))
|
||||||
|
(read (open-input-string new-one)))])
|
||||||
|
(cond
|
||||||
|
[(and (symbol? parsed)
|
||||||
|
(hash-table-get (preferences:get 'framework:tabify)
|
||||||
|
parsed
|
||||||
|
(lambda () #f)))
|
||||||
|
(message-box "Error"
|
||||||
|
(format "\"~a\" is already a specially indented keyword" parsed))]
|
||||||
|
[(symbol? parsed)
|
||||||
|
(hash-table-put! (preferences:get 'framework:tabify)
|
||||||
|
parsed keyword-symbol)
|
||||||
|
(send list-box append (symbol->string parsed))]
|
||||||
|
[else (message-box "Error" (format "expected a symbol, found: ~a" new-one))]))))))]
|
||||||
|
[delete-callback
|
||||||
|
(lambda (list-box)
|
||||||
|
(lambda (button command)
|
||||||
|
(let* ([selections (send list-box get-selections)]
|
||||||
|
[symbols (map (lambda (x) (string->symbol (send list-box get-string x))) selections)])
|
||||||
|
(for-each (lambda (x) (send list-box delete x)) (reverse selections))
|
||||||
|
(let ([ht (preferences:get 'framework:tabify)])
|
||||||
|
(for-each (lambda (x) (hash-table-remove! ht x)) symbols)))))]
|
||||||
|
[main-panel (make-object horizontal-panel% p)]
|
||||||
|
[make-column
|
||||||
|
(lambda (string symbol keywords)
|
||||||
|
(let* ([vert (make-object vertical-panel% main-panel)]
|
||||||
|
[_ (make-object message% (string-append string "-like Keywords") vert)]
|
||||||
|
[box (make-object list-box% #f keywords vert void '(multiple))]
|
||||||
|
[button-panel (make-object horizontal-panel% vert)]
|
||||||
|
[add-button (make-object button% "Add" button-panel (add-callback string symbol box))]
|
||||||
|
[delete-button (make-object button% "Remove" button-panel (delete-callback box))])
|
||||||
|
(send* button-panel
|
||||||
|
(set-alignment 'center 'center)
|
||||||
|
(stretchable-height #f))
|
||||||
|
(send add-button min-width (send delete-button get-width))
|
||||||
|
box))]
|
||||||
|
[begin-list-box (make-column "Begin" 'begin begin-keywords)]
|
||||||
|
[define-list-box (make-column "Define" 'define define-keywords)]
|
||||||
|
[lambda-list-box (make-column "Lambda" 'lambda lambda-keywords)]
|
||||||
|
[update-list-boxes
|
||||||
|
(lambda (hash-table)
|
||||||
|
(let-values ([(begin-keywords define-keywords lambda-keywords) (get-keywords hash-table)]
|
||||||
|
[(reset) (lambda (list-box keywords)
|
||||||
|
(send list-box clear)
|
||||||
|
(for-each (lambda (x) (send list-box append x)) keywords))])
|
||||||
|
(reset begin-list-box begin-keywords)
|
||||||
|
(reset define-list-box define-keywords)
|
||||||
|
(reset lambda-list-box lambda-keywords)
|
||||||
|
#t))])
|
||||||
|
(preferences:add-callback 'framework:tabify (lambda (p v) (update-list-boxes v)))
|
||||||
|
main-panel)))))
|
||||||
|
|
||||||
|
)
|
||||||
|
|
|
||||||
|
|
@ -79,7 +79,6 @@
|
||||||
[height (- bottom top)])
|
[height (- bottom top)])
|
||||||
(when (and (> width 0)
|
(when (and (> width 0)
|
||||||
(> height 0))
|
(> height 0))
|
||||||
(printf "invalidating ~a ~a ~a ~a~n" left top width height)
|
|
||||||
(invalidate-bitmap-cache left top width height))))]
|
(invalidate-bitmap-cache left top width height))))]
|
||||||
[else (let* ([r (car rectangles)]
|
[else (let* ([r (car rectangles)]
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -1,4 +1,4 @@
|
||||||
(require-library "errortrace.ss" "errortrace") (error-print-width 80)
|
(require-library "errortrace.ss" "errortrace") (error-print-width 80) (error-context-display-depth 3)
|
||||||
|
|
||||||
(let* ([errs null]
|
(let* ([errs null]
|
||||||
[sema (make-semaphore 1)]
|
[sema (make-semaphore 1)]
|
||||||
|
|
|
||||||
|
|
@ -235,7 +235,8 @@
|
||||||
|
|
||||||
(define (wait-for-frame name)
|
(define (wait-for-frame name)
|
||||||
(wait-for `(let ([win (get-top-level-focus-window)])
|
(wait-for `(let ([win (get-top-level-focus-window)])
|
||||||
(and win (string=? (send win get-label) ,name)))))))
|
(and win
|
||||||
|
(string=? (send win get-label) ,name)))))))
|
||||||
|
|
||||||
(define Engine
|
(define Engine
|
||||||
(unit/sig Engine^
|
(unit/sig Engine^
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue
Block a user