Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Merge branch 'master' of https://github.com/Metaxal/MrEd-Designer

  • Loading branch information...
commit 2b3dcb5f6fe3e929d4e30c3ec70b71f49efad5a0 2 parents 75c44e7 + 6149d9e
@khardy khardy authored
View
8 Changelog
@@ -1,3 +1,10 @@
+Version 3.9
+ Laurent Orseau, Kieron Hardy, 2012-??-??
+- added: editor-canvas widget (Kieron Hardy)
+- changed: Scheme->racket
+- changed: output to frame instead of to console
+- fix: tab-panel crash and removed need for single-panel
+
Version 3.8
Laurent Orseau, 2012-02-04
- added: can now take projects as command line arguments
@@ -8,7 +15,6 @@ Version 3.8
- fixed: tooltip.ss was not always removing tooltip on windows
- fixed: mreddesigner.bat : small DOS issues
-
Version 3.7
Laurent Orseau, 2010-07-26
- changed: images (files) are *always* relative to project base directory,
View
2  code-generation.ss
@@ -59,7 +59,7 @@
(define (module-header)
(string-append "\
-#lang scheme/gui
+#lang racket/gui
;;==========================================================================
;;=== Code generated with MrEd Designer " application-version
View
39 controller.ss
@@ -357,10 +357,9 @@
parent-frame
base-path
dft-name
- "*.ss"
+ "*.rkt"
'()
- '(("Scheme (.ss)" "*.ss")
- ("Scheme (.scm)" "*.scm")
+ '(("Racket (.rkt)" "*.rkt")
("Any" "*.*")))])
(and file
(path->string file)
@@ -378,10 +377,36 @@
; (path->string file))
)))
-(define/provide (controller-generate-code-to-console [mid (get-current-mred-id)])
+;; Like frame:text% but without exiting the app when closing the window
+(define no-exit-frame:text%
+ (class frame:text%
+ (super-new)
+ (define/override (on-exit)
+ ;(printf "on-exit\n")
+ (void))
+ (define/override (can-exit?)
+ ;(printf "can-exit?\n")
+ #f)
+ (define/augment (on-close)
+ ;(printf "on-close\n")
+ (void))
+ (define/augment (can-close?)
+ ;(printf "can-close?\n")
+ (send this show #f)
+ #f)
+ ))
+
+(define/provide (controller-generate-code-to-frame [mid (get-current-mred-id)])
(when mid
- (let ([project-mid (send mid get-top-mred-parent)])
- (generate-module project-mid))))
+ (define project-mid (send mid get-top-mred-parent))
+ (define f (new no-exit-frame:text%
+ [min-height 500]))
+ (send f set-label (->string (send project-mid get-id)))
+ (define txt (send f get-editor))
+ (send txt insert
+ (with-output-to-string (λ _ (generate-module project-mid))))
+ (send f show #t)
+ ))
(define/provide (controller-generate-code [mid (get-current-mred-id)]
#:ask [ask-user? #t])
@@ -389,7 +414,7 @@
(let* ([project-mid (send mid get-top-mred-parent)]
;[proj-file (send project-mid get-property-value 'file)]
[base-dir (send project-mid get-project-dir)]; (and proj-file (path-only (string->path proj-file)))]
- [dft-file (string-append (->string (send project-mid get-id)) ".ss")]
+ [dft-file (string-append (->string (send project-mid get-id)) ".rkt")]
[file (if ask-user?
(choose-code-file dft-file base-dir toolbox-frame)
dft-file)]
View
2  main.ss
@@ -95,7 +95,7 @@
#:exit-application-callback controller-exit-application
#:plugin-button-callback controller-create-mred-id
#:generate-code-callback controller-generate-code
- #:generate-code-to-console-callback controller-generate-code-to-console
+ #:generate-code-to-console-callback controller-generate-code-to-frame
#:new-project-callback controller-new-project
#:load-project-callback controller-load-project
#:save-project-callback controller-save-project
View
2  mreddesigner-misc.ss
@@ -43,7 +43,7 @@
;; Current version of MrEd Designer
(define/provide application-version-maj 3)
-(define/provide application-version-min 8)
+(define/provide application-version-min 9)
(define/provide application-version (format "~a.~a" application-version-maj application-version-min))
(define/provide application-name "MrEd Designer")
(define/provide application-name-version
View
609 toolbox-frame.ss
@@ -1,302 +1,307 @@
-#lang scheme/gui
-
-;; ##################################################################################
-;; # ============================================================================== #
-;; # MrEd Designer - toolbox-frame.ss #
-;; # http://mreddesigner.lozi.org #
-;; # Copyright (C) Lozi Jean-Pierre, 2004 - mailto:jean-pierre@lozi.org #
-;; # Copyright (C) Peter Ivanyi, 2007 #
-;; # Copyright (C) Laurent Orseau, 2010 #
-;; # ============================================================================== #
-;; # #
-;; # This program is free software; you can redistribute it and/or #
-;; # modify it under the terms of the GNU General Public License #
-;; # as published by the Free Software Foundation; either version 2 #
-;; # of the License, or (at your option) any later version. #
-;; # #
-;; # This program is distributed in the hope that it will be useful, #
-;; # but WITHOUT ANY WARRANTY; without even the implied warranty of #
-;; # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the #
-;; # GNU General Public License for more details. #
-;; # #
-;; # You should have received a copy of the GNU General Public License #
-;; # along with this program; if not, write to the Free Software #
-;; # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. #
-;; # #
-;; ##################################################################################
-
-
-(require "mred-plugin.ss"
- "plugin.ss"
- "mreddesigner-misc.ss"
- "mreddesigner-help.ss"
- "tooltip.ss"
- "templates.ss"
- )
-
-(define/provide toolbox-frame #f)
-(define toolbox-frame-vertical-pane #f)
-(define toolbox-plugin-button-callback #f)
-(define lb-templates #f)
-
-(define toolbox-frame%
- (class frame%
- (init-field on-close-callback)
- (super-new)
-
- (define closing? #f)
- (define/augment (on-close)
- (debug-printf "toolbox-frame%: on-close: closing:~a~n" closing?)
- (unless closing?
- (set! closing? #t)
- (on-close-callback)))
- ))
-
-(define/provide (make-toolbox-frame
- ; we could use global parameters instead!
- ; that would avoid a lot of id rewrite!
- #:exit-application-callback exit-application-callback
- #:plugin-button-callback plugin-button-callback
- #:generate-code-callback generate-code-callback
- #:generate-code-to-console-callback generate-code-to-console-callback
- #:new-project-callback new-project-callback
- #:load-project-callback load-project-callback
- #:save-project-callback save-project-callback
- #:close-project-callback close-project-callback
- #:add-template-callback add-template-callback
- #:save-template-callback save-template-callback
- #:replace-template-callback replace-template-callback
- #:delete-template-callback delete-template-callback
- #:show-properties-callback show-properties-callback
- #:show-hierarchy-callback show-hierarchy-callback
- #:cut-callback cut-callback
- #:copy-callback copy-callback
- #:paste-callback paste-callback
- [parent #f])
- (set! toolbox-plugin-button-callback
- plugin-button-callback)
- (set! toolbox-frame
- (new toolbox-frame%
- [label application-name];"Toolbox"]
- [min-width 200]
- [parent parent]
- [x 5]
- [y 5]
- [on-close-callback exit-application-callback]
- ))
-
- (let* ([menu (new menu-bar% [parent toolbox-frame])]
- [make-menu (λ (label [help-str #f])
- (new menu%
- [parent menu]
- [label label]
- [help-string help-str]))]
- [menu-file (make-menu "File")]
- [menu-edit (make-menu "Edit")]
- [menu-windows (make-menu "Windows")]
- [menu-help (make-menu "Help")]
- [current-menu (make-parameter menu-file)]
- [make-menu-item (λ (label shortcut callback)
- (new menu-item%
- [parent (current-menu)]
- [label label]
- [shortcut shortcut]
- [callback (λ _ (callback))]))]
- [make-separator (λ ()
- (new separator-menu-item%
- [parent (current-menu)]))]
- )
- (current-menu menu-file)
- (make-menu-item "&New Project" #\N new-project-callback)
- (make-menu-item "&Open Project..." #\O load-project-callback)
- (make-menu-item "&Save Project" #\S save-project-callback)
- (make-menu-item "S&ave Project as..." 'f12 (λ _ (save-project-callback #t)))
- (make-separator)
- (make-menu-item "&Generate Scheme File..." 'f5 generate-code-callback)
- (make-separator)
- (make-menu-item "&Close Project" #\W close-project-callback)
- (make-separator)
- (make-menu-item "E&xit" #\Q exit-application-callback)
-
- (current-menu menu-edit)
- ; insert template from a file
- ;(make-menu-item "&Insert Template..." #f load-template)
- ; save template to a user-selected file
- ;(make-menu-item "&Save Template as File..." #f save-template-as)
- ;(make-separator)
- (make-menu-item "C&ut" #\X cut-callback)
- (make-menu-item "&Copy" #\C copy-callback)
- (make-menu-item "&Paste" #\V paste-callback)
-
- (current-menu menu-windows)
- (make-menu-item "Show/Hide &Properties" #f show-properties-callback)
- (make-menu-item "Show/Hide &Hierarchy" #f show-hierarchy-callback)
-
- (current-menu menu-help)
- (make-menu-item "&Online Help" 'f1 help-online-help)
- (make-menu-item "&PLT MrEd Help" #f help-mred-help)
- (make-menu-item "&About MrEd Designer..." #f help-about-dialog)
- )
-
- (set! toolbox-frame-vertical-pane
- (new vertical-pane%
- [parent toolbox-frame]
- [alignment '(right top)]
- [border 3]))
-
- ; Add the plugin buttons:
- (toolbox-frame-make-plugin-buttons)
-
- ;; Templates:
- (let* ([gb (new group-box-panel%
- [label "Templates"]
- [parent toolbox-frame-vertical-pane])]
- [hp (new horizontal-panel% [parent gb]
- [alignment '(center center)]
- )]
- [hp2 (new horizontal-panel% [parent gb]
- [alignment '(center center)]
- [stretchable-width #t]
- )]
- [hp3 (new horizontal-panel% [parent gb]
- [alignment '(center center)]
- [stretchable-width #t]
- )]
- )
- ; the list of templates
- (set! lb-templates
- (new choice%
- [parent hp]
- [label #f]
- [min-width 250]
- [stretchable-width #t]
- [choices '()]))
- (toolbox-update-template-choices)
- ; a button to add a template.
- ; The callback is applied to the file of the selected template.
- (new button%
- [parent hp]
- [label "Insert"]
- [callback (λ _ (add-template-callback (get-selected-template)))]
- )
- (new button%
- [parent hp2]
- [label "Save"]
- [callback (λ _ (save-template-callback
- (get-text-from-user "Saving Template ..."
- "Enter a name for the new template:")))]
- )
- (new button%
- [parent hp2]
- [label "Replace"]
- [callback (λ _ (when (eq? 'yes (message-box "Replace?"
- "Are you sure you want to replace the current template?"
- #f '(yes-no)))
- (replace-template-callback (get-selected-template))))]
- )
- (new button%
- [parent hp2]
- [label "Delete"]
- [callback (λ _ (when (eq? 'yes (message-box "Delete?"
- "Are you sure you want to delete the current template?"
- #f '(yes-no)))
- (delete-template-callback (get-selected-template))))]
- )
- ; rename also !
- )
-
- ; Project:
- (let* ([gbp (new group-box-panel%
- [parent toolbox-frame-vertical-pane]
- [label "Generate code..."])]
- [hp (new horizontal-panel%
- [parent gbp]
- [alignment '(center center)]
- )]
- )
- (new button%
- [label "To console"]
- [parent hp]
- [min-width 110]
- [callback (λ _ (generate-code-to-console-callback))])
- (new button%
- [label "To <project-id>.ss"]
- [parent hp]
- [min-width 110]
- [callback (λ _ (generate-code-callback #:ask #f))])
- )
-
- ; Enable/disable the toolbar buttons if they can be instantiated with no parent
- (update-toolbox-frame #f)
- )
-
-(define/provide (show-toolbox-frame)
- (send toolbox-frame show #t))
-
-;; Returns the template file that is selected in the list-box (or choice%)
-(define (get-selected-template)
- (let ([sel (send lb-templates get-selection)])
- (and sel (car (list-ref template-dict sel)))))
-
-;; Updates the list of templates
-(define/provide (toolbox-update-template-choices)
- (send lb-templates clear)
- ; add the actual templates with the filenames
- (dict-for-each template-dict
- (λ (k v)
- (if v
- (send lb-templates append v)
- (printf "Warning: File ~a has a wrong format!\n" k)
- )
- ))
- (send lb-templates refresh)
- )
-
-; Holds all the plugin panels
-(define plugin-panels (make-hash))
-
-(define (new-plugin-panel label)
- (let ([gbp (new group-box-panel%
- (label label)
- (parent toolbox-frame-vertical-pane))])
- (new horizontal-pane%
- (parent gbp))))
-
-;; Returns the button panel to which the plugin belongs.
-(define (get-button-panel plugin panel-name)
- (hash-ref! plugin-panels panel-name
- ; if none found, add a new one
- (λ () (new-plugin-panel panel-name))))
-
-(define (add-plugin-button plugin)
- (let ([button-group (send plugin get-button-group)])
- (when button-group
- (let ([pl-panel (get-button-panel plugin button-group)])
- (new tooltip-button%
- [label (make-object bitmap%
- (build-path widget-plugins-path
- (send plugin get-dir-name)
- widget-icons-dir "24x24.png")
- 'png
- (send the-color-database find-color "white"))]
- [tooltip-text (send plugin get-tooltip)]
- [parent pl-panel]
- [style '(border)]
- [callback (λ (b e) (toolbox-plugin-button-callback plugin))]
- )))))
-
-;; We fill it
-(define plugins-buttons '())
-(define (toolbox-frame-make-plugin-buttons)
- (set! plugins-buttons
- (map (λ (p) (cons p (add-plugin-button p)))
- (get-widget-plugins))))
-
-;; Enable or disble the toolbar buttons based on whether the represented item can be instantiated
-;; for the current parent.
-(define/provide (update-toolbox-frame mid)
- (dict-for-each plugins-buttons
- (λ (p b)
- (when (send p get-button-group) ; is there a button ?
- (send b enable (send p can-instantiate? mid))))
- ))
+#lang scheme/gui
+
+;; ##################################################################################
+;; # ============================================================================== #
+;; # MrEd Designer - toolbox-frame.ss #
+;; # http://mreddesigner.lozi.org #
+;; # Copyright (C) Lozi Jean-Pierre, 2004 - mailto:jean-pierre@lozi.org #
+;; # Copyright (C) Peter Ivanyi, 2007 #
+;; # Copyright (C) Laurent Orseau, 2010 #
+;; # ============================================================================== #
+;; # #
+;; # This program is free software; you can redistribute it and/or #
+;; # modify it under the terms of the GNU General Public License #
+;; # as published by the Free Software Foundation; either version 2 #
+;; # of the License, or (at your option) any later version. #
+;; # #
+;; # This program is distributed in the hope that it will be useful, #
+;; # but WITHOUT ANY WARRANTY; without even the implied warranty of #
+;; # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the #
+;; # GNU General Public License for more details. #
+;; # #
+;; # You should have received a copy of the GNU General Public License #
+;; # along with this program; if not, write to the Free Software #
+;; # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. #
+;; # #
+;; ##################################################################################
+
+
+(require "mred-plugin.ss"
+ "plugin.ss"
+ "mreddesigner-misc.ss"
+ "mreddesigner-help.ss"
+ "tooltip.ss"
+ "templates.ss"
+ )
+
+(define/provide toolbox-frame #f)
+(define toolbox-frame-vertical-pane #f)
+(define toolbox-plugin-button-callback #f)
+(define lb-templates #f)
+
+(define toolbox-frame%
+ (class frame%
+ (init-field on-close-callback)
+ (super-new)
+
+ (define closing? #f)
+ (define/augment (on-close)
+ (debug-printf "toolbox-frame%: on-close: closing:~a~n" closing?)
+ (unless closing?
+ (set! closing? #t)
+ (on-close-callback)))
+ ))
+
+(define/provide (make-toolbox-frame
+ ; we could use global parameters instead!
+ ; that would avoid a lot of id rewrite!
+ #:exit-application-callback exit-application-callback
+ #:plugin-button-callback plugin-button-callback
+ #:generate-code-callback generate-code-callback
+ #:generate-code-to-console-callback generate-code-to-frame-callback
+ #:new-project-callback new-project-callback
+ #:load-project-callback load-project-callback
+ #:save-project-callback save-project-callback
+ #:close-project-callback close-project-callback
+ #:add-template-callback add-template-callback
+ #:save-template-callback save-template-callback
+ #:replace-template-callback replace-template-callback
+ #:delete-template-callback delete-template-callback
+ #:show-properties-callback show-properties-callback
+ #:show-hierarchy-callback show-hierarchy-callback
+ #:cut-callback cut-callback
+ #:copy-callback copy-callback
+ #:paste-callback paste-callback
+ [parent #f])
+ (set! toolbox-plugin-button-callback
+ plugin-button-callback)
+ (set! toolbox-frame
+ (new toolbox-frame%
+ [label application-name];"Toolbox"]
+ [min-width 200]
+ [parent parent]
+ [x 5]
+ [y 5]
+ [on-close-callback exit-application-callback]
+ ))
+
+ (let* ([menu (new menu-bar% [parent toolbox-frame])]
+ [make-menu (λ (label [help-str #f])
+ (new menu%
+ [parent menu]
+ [label label]
+ [help-string help-str]))]
+ [menu-file (make-menu "File")]
+ [menu-edit (make-menu "Edit")]
+ [menu-windows (make-menu "Windows")]
+ [menu-help (make-menu "Help")]
+ [current-menu (make-parameter menu-file)]
+ [make-menu-item (λ (label shortcut callback)
+ (new menu-item%
+ [parent (current-menu)]
+ [label label]
+ [shortcut shortcut]
+ [callback (λ _ (callback))]))]
+ [make-separator (λ ()
+ (new separator-menu-item%
+ [parent (current-menu)]))]
+ )
+ (current-menu menu-file)
+ (make-menu-item "&New Project" #\N new-project-callback)
+ (make-menu-item "&Open Project..." #\O load-project-callback)
+ (make-menu-item "&Save Project" #\S save-project-callback)
+ (make-menu-item "S&ave Project as..." 'f12 (λ _ (save-project-callback #t)))
+ (make-separator)
+ (make-menu-item "&Generate Scheme File..." 'f5 generate-code-callback)
+ (make-separator)
+ (make-menu-item "&Close Project" #\W close-project-callback)
+ (make-separator)
+ (make-menu-item "E&xit" #\Q exit-application-callback)
+
+ (current-menu menu-edit)
+ ; insert template from a file
+ ;(make-menu-item "&Insert Template..." #f load-template)
+ ; save template to a user-selected file
+ ;(make-menu-item "&Save Template as File..." #f save-template-as)
+ ;(make-separator)
+ (make-menu-item "C&ut" #\X cut-callback)
+ (make-menu-item "&Copy" #\C copy-callback)
+ (make-menu-item "&Paste" #\V paste-callback)
+
+ (current-menu menu-windows)
+ (make-menu-item "Show/Hide &Properties" #f show-properties-callback)
+ (make-menu-item "Show/Hide &Hierarchy" #f show-hierarchy-callback)
+
+ (current-menu menu-help)
+ (make-menu-item "&Online Help" 'f1 help-online-help)
+ (make-menu-item "&PLT MrEd Help" #f help-mred-help)
+ (make-menu-item "&About MrEd Designer..." #f help-about-dialog)
+ )
+
+ (set! toolbox-frame-vertical-pane
+ (new vertical-pane%
+ [parent toolbox-frame]
+ [alignment '(right top)]
+ [border 3]))
+
+ ; Add the plugin buttons:
+ (toolbox-frame-make-plugin-buttons)
+
+ ;; Templates:
+ (let* ([gb (new group-box-panel%
+ [label "Templates"]
+ [parent toolbox-frame-vertical-pane])]
+ [hp (new horizontal-panel% [parent gb]
+ [alignment '(center center)]
+ )]
+ [hp2 (new horizontal-panel% [parent gb]
+ [alignment '(center center)]
+ [stretchable-width #t]
+ )]
+ [hp3 (new horizontal-panel% [parent gb]
+ [alignment '(center center)]
+ [stretchable-width #t]
+ )]
+ )
+ ; the list of templates
+ (set! lb-templates
+ (new choice%
+ [parent hp]
+ [label #f]
+ [min-width 250]
+ [stretchable-width #t]
+ [choices '()]))
+ (toolbox-update-template-choices)
+ ; a button to add a template.
+ ; The callback is applied to the file of the selected template.
+ (new button%
+ [parent hp]
+ [label "Insert"]
+ [callback (λ _ (add-template-callback (get-selected-template)))]
+ )
+ (new button%
+ [parent hp2]
+ [label "Save"]
+ [callback (λ _ (save-template-callback
+ (get-text-from-user "Saving Template ..."
+ "Enter a name for the new template:")))]
+ )
+ (new button%
+ [parent hp2]
+ [label "Replace"]
+ [callback (λ _ (when (eq? 'yes (message-box "Replace?"
+ "Are you sure you want to replace the current template?"
+ #f '(yes-no)))
+ (replace-template-callback (get-selected-template))))]
+ )
+ (new button%
+ [parent hp2]
+ [label "Delete"]
+ [callback (λ _ (when (eq? 'yes (message-box "Delete?"
+ "Are you sure you want to delete the current template?"
+ #f '(yes-no)))
+ (delete-template-callback (get-selected-template))))]
+ )
+ ; rename also !
+ )
+
+ ; Project:
+ (let* ([gbp (new group-box-panel%
+ [parent toolbox-frame-vertical-pane]
+ [label "Generate code..."])]
+ [hp (new horizontal-panel%
+ [parent gbp]
+ [alignment '(center center)]
+ )]
+ )
+ (new button%
+ [label "To frame"]
+ [parent hp]
+ [min-width 110]
+ [callback (λ _ (generate-code-to-frame-callback))])
+ (new button%
+ [label "To <project-id>.rkt"]
+ [parent hp]
+ [min-width 110]
+ [callback (λ _ (generate-code-callback #:ask #f))])
+ (new button%
+ [label "Save Project"]
+ [parent hp]
+ [min-width 110]
+ [callback (λ _ (save-project-callback))])
+ )
+
+ ; Enable/disable the toolbar buttons if they can be instantiated with no parent
+ (update-toolbox-frame #f)
+ )
+
+(define/provide (show-toolbox-frame)
+ (send toolbox-frame show #t))
+
+;; Returns the template file that is selected in the list-box (or choice%)
+(define (get-selected-template)
+ (let ([sel (send lb-templates get-selection)])
+ (and sel (car (list-ref template-dict sel)))))
+
+;; Updates the list of templates
+(define/provide (toolbox-update-template-choices)
+ (send lb-templates clear)
+ ; add the actual templates with the filenames
+ (dict-for-each template-dict
+ (λ (k v)
+ (if v
+ (send lb-templates append v)
+ (printf "Warning: File ~a has a wrong format!\n" k)
+ )
+ ))
+ (send lb-templates refresh)
+ )
+
+; Holds all the plugin panels
+(define plugin-panels (make-hash))
+
+(define (new-plugin-panel label)
+ (let ([gbp (new group-box-panel%
+ (label label)
+ (parent toolbox-frame-vertical-pane))])
+ (new horizontal-pane%
+ (parent gbp))))
+
+;; Returns the button panel to which the plugin belongs.
+(define (get-button-panel plugin panel-name)
+ (hash-ref! plugin-panels panel-name
+ ; if none found, add a new one
+ (λ () (new-plugin-panel panel-name))))
+
+(define (add-plugin-button plugin)
+ (let ([button-group (send plugin get-button-group)])
+ (when button-group
+ (let ([pl-panel (get-button-panel plugin button-group)])
+ (new tooltip-button%
+ [label (make-object bitmap%
+ (build-path widget-plugins-path
+ (send plugin get-dir-name)
+ widget-icons-dir "24x24.png")
+ 'png
+ (send the-color-database find-color "white"))]
+ [tooltip-text (send plugin get-tooltip)]
+ [parent pl-panel]
+ [style '(border)]
+ [callback (λ (b e) (toolbox-plugin-button-callback plugin))]
+ )))))
+
+;; We fill it
+(define plugins-buttons '())
+(define (toolbox-frame-make-plugin-buttons)
+ (set! plugins-buttons
+ (map (λ (p) (cons p (add-plugin-button p)))
+ (get-widget-plugins))))
+
+;; Enable or disble the toolbar buttons based on whether the represented item can be instantiated
+;; for the current parent.
+(define/provide (update-toolbox-frame mid)
+ (dict-for-each plugins-buttons
+ (λ (p b)
+ (when (send p get-button-group) ; is there a button ?
+ (send b enable (send p can-instantiate? mid))))
+ ))
Please sign in to comment.
Something went wrong with that request. Please try again.