..
original commit: 3b75abebfbf22483d3c12c253fa9dcedf617a9f8
This commit is contained in:
Robby Findler
parent
79144f759e
commit
73fbf3b9fb
|
|
@ -182,6 +182,7 @@
|
|||
()
|
||||
"\\rawscm{(preferences:restore-defaults)} restores the users's configuration to the"
|
||||
"default preferences.")
|
||||
|
||||
(preferences:add-panel
|
||||
(string?
|
||||
((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"
|
||||
"whatever preferences configuration controls it wants to that"
|
||||
"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
|
||||
(-> void?)
|
||||
()
|
||||
"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
|
||||
(-> void?)
|
||||
()
|
||||
|
|
|
|||
|
|
@ -1703,8 +1703,11 @@
|
|||
(send find-edit get-text 0 (send find-edit last-position)))))))
|
||||
(define replace&search
|
||||
(lambda ()
|
||||
(when (replace)
|
||||
(search-again))))
|
||||
(let ([text (get-text-to-search)])
|
||||
(send text begin-edit-sequence)
|
||||
(when (replace)
|
||||
(search-again))
|
||||
(send text end-edit-sequence))))
|
||||
(define replace-all
|
||||
(lambda ()
|
||||
(let* ([replacee-edit (get-text-to-search)]
|
||||
|
|
|
|||
|
|
@ -189,27 +189,41 @@
|
|||
;; type percentage : (make-percentage number)
|
||||
(define-struct percentage (%))
|
||||
|
||||
(define vertical-dragable<%>
|
||||
(interface ((class->interface vertical-panel%))
|
||||
(define dragable<%>
|
||||
(interface ()
|
||||
after-percentage-change
|
||||
set-percentages
|
||||
get-percentages))
|
||||
get-percentages
|
||||
get-vertical?))
|
||||
|
||||
(define vertical-dragable<%>
|
||||
(interface (dragable<%>)))
|
||||
|
||||
(define horizontal-dragable<%>
|
||||
(interface ((class->interface horizontal-panel%))
|
||||
after-percentage-change
|
||||
set-percentages
|
||||
get-percentages))
|
||||
(interface (dragable<%>)))
|
||||
|
||||
(define (make-dragable-mixin vertical?
|
||||
panel% dragable<%>
|
||||
min-extent
|
||||
event-get-dim
|
||||
get-cursor)
|
||||
(define dragable-mixin
|
||||
(mixin ((class->interface panel%)) (dragable<%>)
|
||||
(init parent)
|
||||
(super-instantiate (parent))
|
||||
(inherit get-client-size container-flow-modified)
|
||||
(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))
|
||||
|
||||
(inherit get-client-size container-flow-modified)
|
||||
|
||||
(init-field [bar-thickness 5])
|
||||
|
||||
|
|
@ -250,7 +264,7 @@
|
|||
|
||||
(define/private (get-available-extent)
|
||||
(let-values ([(width height) (get-client-size)])
|
||||
(- (if vertical? height width)
|
||||
(- (if (get-vertical?) height width)
|
||||
(* bar-thickness (- (length (get-children)) 1)))))
|
||||
|
||||
(inherit get-children)
|
||||
|
|
@ -282,7 +296,7 @@
|
|||
(set-cursor (and (or gap
|
||||
resizing-dim)
|
||||
(send (icon:get-up/down-cursor) ok?)
|
||||
(get-cursor)))
|
||||
(get-gap-cursor)))
|
||||
(cond
|
||||
[(and gap (send evt button-down? 'left))
|
||||
(set! resizing-dim (event-get-dim evt))
|
||||
|
|
@ -338,7 +352,7 @@
|
|||
(when (null? children) (show-error 4))
|
||||
(unless (null? (cdr infos)) (show-error 5))
|
||||
(unless (null? (cdr children)) (show-error 6))
|
||||
(if vertical?
|
||||
(if (get-vertical?)
|
||||
(list (list 0 dim width (- height dim)))
|
||||
(list (list dim 0 (- width dim) height)))]
|
||||
[else
|
||||
|
|
@ -356,7 +370,7 @@
|
|||
(+ dim this-space bar-thickness)
|
||||
(cadr percentages))
|
||||
cursor-gaps))
|
||||
(cons (if vertical?
|
||||
(cons (if (get-vertical?)
|
||||
(list 0 dim width this-space)
|
||||
(list dim 0 this-space height))
|
||||
(loop (cdr percentages)
|
||||
|
|
@ -365,21 +379,17 @@
|
|||
(+ dim this-space bar-thickness))))])))]))))
|
||||
|
||||
|
||||
(define vertical-dragable-mixin
|
||||
(make-dragable-mixin #t
|
||||
vertical-panel% vertical-dragable<%>
|
||||
(lambda (child) (send child min-height))
|
||||
(lambda (evt) (send evt get-y))
|
||||
icon:get-up/down-cursor))
|
||||
(define vertical-dragable-mixin
|
||||
(mixin (dragable<%>) (vertical-dragable<%>)
|
||||
(define/override (get-vertical?) #t)
|
||||
(super-instantiate ())))
|
||||
|
||||
(define horizontal-dragable-mixin
|
||||
(make-dragable-mixin #f
|
||||
horizontal-panel% horizontal-dragable<%>
|
||||
(lambda (child) (send child min-width))
|
||||
(lambda (evt) (send evt get-x))
|
||||
icon:get-left/right-cursor))
|
||||
(define horizontal-dragable-mixin
|
||||
(mixin (dragable<%>) (vertical-dragable<%>)
|
||||
(define/override (get-vertical?) #f)
|
||||
(super-instantiate ())))
|
||||
|
||||
(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%))))))
|
||||
|
||||
|
|
|
|||
|
|
@ -331,68 +331,140 @@
|
|||
|
||||
(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
|
||||
(string-constant general-prefs-panel-label)
|
||||
label
|
||||
(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)])
|
||||
(let* ([main (make-object vertical-panel% parent)])
|
||||
(send main set-alignment 'left 'center)
|
||||
(make-check 'framework:highlight-parens (string-constant highlight-parens) id id)
|
||||
(make-check 'framework:fixup-parens (string-constant fixup-parens) id id)
|
||||
(make-check 'framework:paren-match (string-constant flash-paren-match) id id)
|
||||
(make-check 'framework:autosaving-on? (string-constant auto-save-files) id id)
|
||||
(make-check 'framework:backup-files? (string-constant backup-files) id id)
|
||||
(make-check 'framework:delete-forward? (string-constant map-delete-to-backspace)
|
||||
not not)
|
||||
(proc main)
|
||||
main))))
|
||||
|
||||
(make-check 'framework:verify-exit (string-constant verify-exit) id id)
|
||||
(make-check 'framework:verify-change-format
|
||||
(string-constant ask-before-changing-format)
|
||||
id id)
|
||||
(make-check 'framework:auto-set-wrap? (string-constant wrap-words-in-editor-buffers)
|
||||
id id)
|
||||
;; 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
|
||||
(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))))))
|
||||
|
||||
(make-check 'framework:show-status-line (string-constant show-status-line) id id)
|
||||
(make-check 'framework:line-offsets (string-constant count-from-one) id id)
|
||||
(make-check 'framework:display-line-numbers
|
||||
(string-constant display-line-numbers)
|
||||
id id)
|
||||
(make-check 'framework:menu-bindings (string-constant enable-keybindings-in-menus)
|
||||
id id)
|
||||
(unless (eq? (system-type) 'unix)
|
||||
(make-check 'framework:print-output-mode
|
||||
(string-constant automatically-to-ps)
|
||||
(lambda (b)
|
||||
(if b 'postscript 'standard))
|
||||
(lambda (n) (eq? 'postscript n))))
|
||||
(define (add-scheme-checkbox-panel)
|
||||
(letrec ([add-scheme-checkbox-panel
|
||||
(lambda ()
|
||||
(set! add-scheme-checkbox-panel void)
|
||||
(add-checkbox-panel
|
||||
(string-constant scheme-prefs-panel-label)
|
||||
(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)
|
||||
|
||||
'(when (eq? (system-type) 'windows)
|
||||
(make-check 'framework:windows-mdi (string-constant use-mdi) id id))
|
||||
(make-check 'framework:search-using-dialog?
|
||||
(string-constant separate-dialog-for-searching)
|
||||
id id)
|
||||
(make-check 'framework:open-here?
|
||||
(string-constant reuse-existing-frames)
|
||||
id id)
|
||||
(make-check editor-panel
|
||||
'framework:verify-change-format
|
||||
(string-constant ask-before-changing-format)
|
||||
values values)
|
||||
(make-check editor-panel 'framework:show-status-line (string-constant show-status-line) values values)
|
||||
(make-check editor-panel 'framework:line-offsets (string-constant count-from-one) values values)
|
||||
(make-check editor-panel
|
||||
'framework:display-line-numbers
|
||||
(string-constant display-line-numbers)
|
||||
values values)
|
||||
|
||||
main)))
|
||||
(set! local-add-general-panel void))
|
||||
(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-general-panel) (local-add-general-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)
|
||||
(make-check misc-panel
|
||||
'framework:print-output-mode
|
||||
(string-constant automatically-to-ps)
|
||||
(lambda (b)
|
||||
(if b 'postscript 'standard))
|
||||
(lambda (n) (eq? 'postscript n))))
|
||||
'(when (eq? (system-type) 'windows)
|
||||
(make-check misc-panel
|
||||
'framework:windows-mdi
|
||||
(string-constant use-mdi)
|
||||
values values))
|
||||
(misc-panel-procs misc-panel))))])
|
||||
(add-misc-checkbox-panel)))
|
||||
|
||||
(define (local-add-font-panel)
|
||||
(let* ([font-families-name/const
|
||||
|
|
|
|||
|
|
@ -116,9 +116,13 @@
|
|||
single-pane%
|
||||
;;multi-view%
|
||||
|
||||
dragable<%>
|
||||
dragable-mixin
|
||||
|
||||
vertical-dragable<%>
|
||||
vertical-dragable-mixin
|
||||
vertical-dragable%
|
||||
|
||||
horizontal-dragable<%>
|
||||
horizontal-dragable-mixin
|
||||
horizontal-dragable%))
|
||||
|
|
@ -160,7 +164,15 @@
|
|||
|
||||
add-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
|
||||
hide-dialog))
|
||||
(define-signature framework:preferences^
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user