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

..

Browse Source 
original commit: 3b75abebfbf22483d3c12c253fa9dcedf617a9f8
This commit is contained in:
Robby Findler 2002-05-21 16:37:32 +00:00
parent 79144f759e
commit 73fbf3b9fb
5 changed files with 235 additions and 101 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

45
collects/framework/framework.ss
View File

@ -182,6 +182,7 @@
() ()
"\\rawscm{(preferences:restore-defaults)} restores the users's configuration to the" "\\rawscm{(preferences:restore-defaults)} restores the users's configuration to the"
"default preferences.") "default preferences.")
(preferences:add-panel (preferences:add-panel
(string? (string?
((is-a?/c area-container-window<%>) . -> . (is-a?/c area-container-window<%>)) ((is-a?/c area-container-window<%>) . -> . (is-a?/c area-container-window<%>))
@ -195,14 +196,50 @@
"\\var{f} is expected to add a new child panel to it and add" "\\var{f} is expected to add a new child panel to it and add"
"whatever preferences configuration controls it wants to that" "whatever preferences configuration controls it wants to that"
"panel. Then, \\var{f}'s should return the panel it added.") "panel. Then, \\var{f}'s should return the panel it added.")
(preferences:add-editor-checkbox-panel
(-> void?)
()
"Adds a preferences panel for configuring options"
"related to editing.")
(preferences:add-misc-checkbox-panel
(-> void?)
()
"Adds a preferences panel for configuring"
"misc. options")
(preferences:add-scheme-checkbox-panel
(-> void?)
()
"Adds a preferences panel for configuring"
"options related to Scheme.")
(preferences:add-to-misc-checkbox-panel
(((is-a?/c vertical-panel%) . -> . void?) . -> . void?)
(proc)
"Saves \\var{proc} until the preferences panel is"
"created, when it is called with the Misc. panel to"
"add new children to the panel.")
(preferences:add-to-scheme-checkbox-panel
(((is-a?/c vertical-panel%) . -> . void?) . -> . void?)
(proc)
"Saves \\var{proc} until the preferences panel is "
"created, when it is called with the Scheme "
"preferences panel to "
"add new children to the panel.")
(preferences:add-to-editor-checkbox-panel
(((is-a?/c vertical-panel%) . -> . void?) . -> . void?)
(proc)
"Saves \\var{proc} until the preferences panel is "
"created, when it is called with the Echeme "
"preferences panel to "
"add new children to the panel.")
(preferences:add-font-panel (preferences:add-font-panel
(-> void?) (-> void?)
() ()
"Adds a font selection preferences panel to the preferences dialog.") "Adds a font selection preferences panel to the preferences dialog.")
(preferences:add-general-panel
(-> void?)
()
"Adds a general preferences panel to the preferences dialog.")
(preferences:show-dialog (preferences:show-dialog
(-> void?) (-> void?)
() ()

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

@ -1703,8 +1703,11 @@
(send find-edit get-text 0 (send find-edit last-position))))))) (send find-edit get-text 0 (send find-edit last-position)))))))
(define replace&search (define replace&search
(lambda () (lambda ()
(let ([text (get-text-to-search)])
(send text begin-edit-sequence)
(when (replace) (when (replace)
(search-again)))) (search-again))
(send text end-edit-sequence))))
(define replace-all (define replace-all
(lambda () (lambda ()
(let* ([replacee-edit (get-text-to-search)] (let* ([replacee-edit (get-text-to-search)]

66
collects/framework/private/panel.ss
View File

@ -189,26 +189,40 @@
;; type percentage : (make-percentage number) ;; type percentage : (make-percentage number)
(define-struct percentage (%)) (define-struct percentage (%))
(define vertical-dragable<%> (define dragable<%>
(interface ((class->interface vertical-panel%)) (interface ()
after-percentage-change after-percentage-change
set-percentages set-percentages
get-percentages)) get-percentages
get-vertical?))
(define vertical-dragable<%>
(interface (dragable<%>)))
(define horizontal-dragable<%> (define horizontal-dragable<%>
(interface ((class->interface horizontal-panel%)) (interface (dragable<%>)))
after-percentage-change
set-percentages
get-percentages))
(define (make-dragable-mixin vertical? (define dragable-mixin
panel% dragable<%>
min-extent
event-get-dim
get-cursor)
(mixin ((class->interface panel%)) (dragable<%>) (mixin ((class->interface panel%)) (dragable<%>)
(init parent) (init parent)
(define/public (get-vertical?)
(error 'get-vertical "abstract method"))
(define/private (min-extent child)
(if (get-vertical?)
(send child min-height)
(send child min-width)))
(define/private (event-get-dim evt)
(if (get-vertical?)
(send evt get-y)
(send evt get-x)))
(define/private (get-gap-cursor)
(if (get-vertical?)
(icon:get-up/down-cursor)
(icon:get-left/right-cursor)))
(super-instantiate (parent)) (super-instantiate (parent))
(inherit get-client-size container-flow-modified) (inherit get-client-size container-flow-modified)
(init-field [bar-thickness 5]) (init-field [bar-thickness 5])
@ -250,7 +264,7 @@
(define/private (get-available-extent) (define/private (get-available-extent)
(let-values ([(width height) (get-client-size)]) (let-values ([(width height) (get-client-size)])
(- (if vertical? height width) (- (if (get-vertical?) height width)
(* bar-thickness (- (length (get-children)) 1))))) (* bar-thickness (- (length (get-children)) 1)))))
(inherit get-children) (inherit get-children)
@ -282,7 +296,7 @@
(set-cursor (and (or gap (set-cursor (and (or gap
resizing-dim) resizing-dim)
(send (icon:get-up/down-cursor) ok?) (send (icon:get-up/down-cursor) ok?)
(get-cursor))) (get-gap-cursor)))
(cond (cond
[(and gap (send evt button-down? 'left)) [(and gap (send evt button-down? 'left))
(set! resizing-dim (event-get-dim evt)) (set! resizing-dim (event-get-dim evt))
@ -338,7 +352,7 @@
(when (null? children) (show-error 4)) (when (null? children) (show-error 4))
(unless (null? (cdr infos)) (show-error 5)) (unless (null? (cdr infos)) (show-error 5))
(unless (null? (cdr children)) (show-error 6)) (unless (null? (cdr children)) (show-error 6))
(if vertical? (if (get-vertical?)
(list (list 0 dim width (- height dim))) (list (list 0 dim width (- height dim)))
(list (list dim 0 (- width dim) height)))] (list (list dim 0 (- width dim) height)))]
[else [else
@ -356,7 +370,7 @@
(+ dim this-space bar-thickness) (+ dim this-space bar-thickness)
(cadr percentages)) (cadr percentages))
cursor-gaps)) cursor-gaps))
(cons (if vertical? (cons (if (get-vertical?)
(list 0 dim width this-space) (list 0 dim width this-space)
(list dim 0 this-space height)) (list dim 0 this-space height))
(loop (cdr percentages) (loop (cdr percentages)
@ -366,20 +380,16 @@
(define vertical-dragable-mixin (define vertical-dragable-mixin
(make-dragable-mixin #t (mixin (dragable<%>) (vertical-dragable<%>)
vertical-panel% vertical-dragable<%> (define/override (get-vertical?) #t)
(lambda (child) (send child min-height)) (super-instantiate ())))
(lambda (evt) (send evt get-y))
icon:get-up/down-cursor))
(define horizontal-dragable-mixin (define horizontal-dragable-mixin
(make-dragable-mixin #f (mixin (dragable<%>) (vertical-dragable<%>)
horizontal-panel% horizontal-dragable<%> (define/override (get-vertical?) #f)
(lambda (child) (send child min-width)) (super-instantiate ())))
(lambda (evt) (send evt get-x))
icon:get-left/right-cursor))
(define vertical-dragable% (vertical-dragable-mixin vertical-panel%)) (define vertical-dragable% (vertical-dragable-mixin (dragable-mixin vertical-panel%)))
(define horizontal-dragable% (horizontal-dragable-mixin horizontal-panel%))))) (define horizontal-dragable% (horizontal-dragable-mixin (dragable-mixin horizontal-panel%))))))

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

@ -331,13 +331,37 @@
(define ppanels null) (define ppanels null)
(define (local-add-general-panel) (define (add-to-scheme-checkbox-panel f)
(set! scheme-panel-procs
(let ([old scheme-panel-procs])
(lambda (parent) (old parent) (f parent)))))
(define (add-to-editor-checkbox-panel f)
(set! editor-panel-procs
(let ([old editor-panel-procs])
(lambda (parent) (old parent) (f parent)))))
(define (add-to-misc-checkbox-panel f)
(set! misc-panel-procs
(let ([old misc-panel-procs])
(lambda (parent) (old parent) (f parent)))))
(define scheme-panel-procs void)
(define editor-panel-procs void)
(define misc-panel-procs void)
(define (add-checkbox-panel label proc)
(add-panel (add-panel
(string-constant general-prefs-panel-label) label
(lambda (parent) (lambda (parent)
(let* ([main (make-object vertical-panel% parent)] (let* ([main (make-object vertical-panel% parent)])
[make-check (send main set-alignment 'left 'center)
(lambda (pref title bool->pref pref->bool) (proc main)
main))))
;; make-check : panel symbol string (boolean -> any) (any -> boolean)
;; adds a check box preference to `main'.
(define (make-check main pref title bool->pref pref->bool)
(let* ([callback (let* ([callback
(lambda (check-box _) (lambda (check-box _)
(set pref (bool->pref (send check-box get-value))))] (set pref (bool->pref (send check-box get-value))))]
@ -347,52 +371,100 @@
(send c set-value initial-value) (send c set-value initial-value)
(add-callback pref (add-callback pref
(lambda (p v) (lambda (p v)
(send c set-value (pref->bool v))))))] (send c set-value (pref->bool v))))))
[id (lambda (x) x)])
(send main set-alignment 'left 'center) (define (add-scheme-checkbox-panel)
(make-check 'framework:highlight-parens (string-constant highlight-parens) id id) (letrec ([add-scheme-checkbox-panel
(make-check 'framework:fixup-parens (string-constant fixup-parens) id id) (lambda ()
(make-check 'framework:paren-match (string-constant flash-paren-match) id id) (set! add-scheme-checkbox-panel void)
(make-check 'framework:autosaving-on? (string-constant auto-save-files) id id) (add-checkbox-panel
(make-check 'framework:backup-files? (string-constant backup-files) id id) (string-constant scheme-prefs-panel-label)
(make-check 'framework:delete-forward? (string-constant map-delete-to-backspace) (lambda (scheme-panel)
(make-check scheme-panel
'framework:highlight-parens
(string-constant highlight-parens)
values values)
(make-check scheme-panel
'framework:fixup-parens
(string-constant fixup-parens)
values values)
(make-check scheme-panel
'framework:paren-match
(string-constant flash-paren-match)
values values)
(scheme-panel-procs scheme-panel))))])
(add-scheme-checkbox-panel)))
(define (add-editor-checkbox-panel)
(letrec ([add-editor-checkbox-panel
(lambda ()
(set! add-editor-checkbox-panel void)
(add-checkbox-panel
(string-constant editor-prefs-panel-label)
(lambda (editor-panel)
(make-check editor-panel
'framework:autosaving-on?
(string-constant auto-save-files)
values values)
(make-check editor-panel 'framework:backup-files? (string-constant backup-files) values values)
(make-check editor-panel 'framework:delete-forward? (string-constant map-delete-to-backspace)
not not) not not)
(make-check 'framework:verify-exit (string-constant verify-exit) id id) (make-check editor-panel
(make-check 'framework:verify-change-format 'framework:verify-change-format
(string-constant ask-before-changing-format) (string-constant ask-before-changing-format)
id id) values values)
(make-check 'framework:auto-set-wrap? (string-constant wrap-words-in-editor-buffers) (make-check editor-panel 'framework:show-status-line (string-constant show-status-line) values values)
id id) (make-check editor-panel 'framework:line-offsets (string-constant count-from-one) values values)
(make-check editor-panel
(make-check 'framework:show-status-line (string-constant show-status-line) id id) 'framework:display-line-numbers
(make-check 'framework:line-offsets (string-constant count-from-one) id id)
(make-check 'framework:display-line-numbers
(string-constant display-line-numbers) (string-constant display-line-numbers)
id id) values values)
(make-check 'framework:menu-bindings (string-constant enable-keybindings-in-menus)
id id) (make-check editor-panel
'framework:auto-set-wrap?
(string-constant wrap-words-in-editor-buffers)
values values)
(make-check editor-panel
'framework:search-using-dialog?
(string-constant separate-dialog-for-searching)
values values)
(make-check editor-panel
'framework:open-here?
(string-constant reuse-existing-frames)
values values)
(editor-panel-procs editor-panel))))])
(add-editor-checkbox-panel)))
(define (add-misc-checkbox-panel)
(letrec ([add-misc-checkbox-panel
(lambda ()
(set! add-misc-checkbox-panel void)
(add-checkbox-panel
(string-constant misc-prefs-panel-label)
(lambda (misc-panel)
(make-check misc-panel
'framework:verify-exit
(string-constant verify-exit)
values values)
(make-check misc-panel
'framework:menu-bindings
(string-constant enable-keybindings-in-menus)
values values)
(unless (eq? (system-type) 'unix) (unless (eq? (system-type) 'unix)
(make-check 'framework:print-output-mode (make-check misc-panel
'framework:print-output-mode
(string-constant automatically-to-ps) (string-constant automatically-to-ps)
(lambda (b) (lambda (b)
(if b 'postscript 'standard)) (if b 'postscript 'standard))
(lambda (n) (eq? 'postscript n)))) (lambda (n) (eq? 'postscript n))))
'(when (eq? (system-type) 'windows) '(when (eq? (system-type) 'windows)
(make-check 'framework:windows-mdi (string-constant use-mdi) id id)) (make-check misc-panel
(make-check 'framework:search-using-dialog? 'framework:windows-mdi
(string-constant separate-dialog-for-searching) (string-constant use-mdi)
id id) values values))
(make-check 'framework:open-here? (misc-panel-procs misc-panel))))])
(string-constant reuse-existing-frames) (add-misc-checkbox-panel)))
id id)
main)))
(set! local-add-general-panel void))
(define (add-general-panel) (local-add-general-panel))
(define (local-add-font-panel) (define (local-add-font-panel)
(let* ([font-families-name/const (let* ([font-families-name/const

14
collects/framework/private/sig.ss
View File

@ -116,9 +116,13 @@
single-pane% single-pane%
;;multi-view% ;;multi-view%
dragable<%>
dragable-mixin
vertical-dragable<%> vertical-dragable<%>
vertical-dragable-mixin vertical-dragable-mixin
vertical-dragable% vertical-dragable%
horizontal-dragable<%> horizontal-dragable<%>
horizontal-dragable-mixin horizontal-dragable-mixin
horizontal-dragable%)) horizontal-dragable%))
@ -160,7 +164,15 @@
add-panel add-panel
add-font-panel add-font-panel
add-general-panel
add-editor-checkbox-panel
add-misc-checkbox-panel
add-scheme-checkbox-panel
add-to-editor-checkbox-panel
add-to-misc-checkbox-panel
add-to-scheme-checkbox-panel
show-dialog show-dialog
hide-dialog)) hide-dialog))
(define-signature framework:preferences^ (define-signature framework:preferences^