rebol [ Title: "Style Gallery" File: %style-gallery.r Date: 28-Aug-2008 Version: 1.2.8 Progress: 0.45 Status: "working, most eligible styles added" Needs: [View] Author: "Anton Rolls" Language: "English" Purpose: {Gallery of styles} Usage: { Use this code to check the internet for newer versions of style-gallery.r (and all the software used by it), update your local disk cache with any of these newer files, and finally run the style-gallery.r program: head clear find site: select load-thru/update http://www.rebol.net/reb/index.r [folder "Anton"] %index.r do do-thru/update/args site/do.r [update "gui/style-gallery.r"] Use the code below when you want to run style-gallery.r using only the files you already have cached on your local disk (ie. if you already have the files cached, there will be no network access): head clear find site: select load-thru http://www.rebol.net/reb/index.r [folder "Anton"] %index.r do do-thru/args site/do.r [cache-only "gui/style-gallery.r"] (Note: you can do %style-gallery.r directly, but it is not the preferred method, because it uses the older include system.) } History: [ 1.0.0 [23-Jul-2006 {First version, added most of gui/ directory, lists / scroll-table shows each file, progress, status and available styles/funcs} "Anton"] 1.0.1 [24-Jul-2006 {fixed bug clicking the "lists" tab for a second time when header-group had an actions block, the bug was caused because header-group modified the actions block} "Anton"] 1.0.2 [25-Jul-2006 {added all styles to master stylesheet (svv/vid-styles) so all those global -style words are not set, fixed scroll-table and image-editor which had problems with this} "Anton"] 1.0.3 [28-Jul-2006 {added pop-menu and colour-box, started adding global colours, also fixed directory-selector which had problems with the stylize/master of scroll-table} "Anton"] 1.0.4 [4-Aug-2006 {started dividing "Global options" panel into subpanels} "Anton"] 1.0.5 [6-Aug-2006 {fixed up main-panel/global-options-panel resizing} "Anton"] 1.0.6 [8-Aug-2006 {added scroll-wheel-handler} "Anton"] 1.0.7 [12-Aug-2006 {added ctx-text-next-field-patch.r} "Anton"] 1.0.8 [16-Aug-2006 {added solo-tab-key-handler.r} "Anton"] 1.0.9 [20-Aug-2006 {moved the handlers into Global Options, added focus-system-patch.r} "Anton"] 1.1.0 [27-Aug-2006 {tabbing to a face that is only partially or not visible in a scroll-panel scrolls to it, improved scroll-panel to allow resetting main-panel scrollers to 0 when changing subfaces and to maintain the reflection of scroll offset with scrollers DATA facet during scroll-panel/resize} "Anton"] 1.1.1 [9-Sep-2006 {added patched button-style, added patch/vid-colors.r and started adding support for extended named colours, focal-highlight is working with colour-box and button so far} "Anton"] 1.1.2 [11-Sep-2006 {implemented a few more default named colours} "Anton"] 1.1.3 [11-Oct-2006 {added ami-scroller} "Anton"] 1.1.4 [19-Oct-2006 {migrated to new do.r include system} "Anton"] 1.1.5 [4-Nov-2006 {%do.r now supports DOing a script directly (kind of backward compatible, handles the most common usage accident) so reworked the including to support DO %style-gallery.r, added Alt-Init and Do-Init to the script header in line to enable that functionality} "Anton"] 1.1.6 [20-Nov-2006 {added divider-bar, added global option to toggle ami-scroller as default scroller} "Anton"] 1.1.7 [30-Nov-2006 {added agg-button} "Anton"] 1.1.8 [27-Dec-2006 {added request-color} "Anton"] 1.1.9 [4-Jan-2007 {added font-table} "Anton"] 1.2.0 [20-Jan-2007 {added ANIM, ACTIVITY-ANIM} "Anton"] 1.2.1 [30-Jan-2007 {added FOCUS-ON-DOWN-EVENT-HANDLER} "Anton"] 1.2.2 [31-Jan-2007 {event handlers can now be dynamically insert/removed using new style HANDLER-BUTTON} "Anton"] 1.2.3 [1-Feb-2007 {implemented modifying a few more default svvc colours} "Anton"] 1.2.4 [3-Feb-2007 {added DIRECTION-BOX which has been cleaned up, and which is needed by the new FONT-TABLE} "Anton"] 1.2.5 [1-Mar-2007 {changed old POP-MENU to new POP-MENU-BTN, and added ALL-WINDOWS-INACTIVE-HANDLER} "Anton"] 1.2.6 [23-Apr-2007 {updated for changes to menu} "Anton"] 1.2.7 [8-May-2007 {implementing svvc/styles and named-colours, save and load colour-prefs, added extended-colour-table} "Anton"] 1.2.8 [28-Aug-2008 {Added "check-boxes" tab, containing new CHECK, CHECK-LINE, CHECK-MARK styles} "Anton"] ] ToDo: { - Fix bug: tabbing to SCROLL-AREA causes it to be FOCUSed, which sets the caret to the tail of the string. If the caret is not currently visible, the scroll-area should scroll to make it visible, but it does not. - Actually, each editable area should remember its caret position. - patch focus-system-patch.r to look for a new CARET facet ? - Fix directory-selector key control issues: the popup windows don't close on Escape. Not focused? Because new window doesn't receive 'active event on open in linux ? - standardise focusing for fields so that edge is highlighted - FOCUS-ON-DOWN-EVENT-HANDLER: Fixed interaction bug with ALERT dialogs by passing the event through if there is a popface. - verify if that is the correct fix. pop-faces may have focusable areas too. - check if other handlers also suffer in the same way - Do-Init is buggy. See do.r. - Window resizing as seen in KDE, maybe by ctrl-shift right click drag near a window border. - implement svvc/field and svvc/field-select for other field-based styles (eg. area, info(?), scroll-area, pair/integer/decimal-edit, limited-field ..) (maybe field should be patched, area and info styles may inherit behaviour ?) - Graham's list of stuff Rebgui supplies him with: - automatic resizing (check out GORM) - font resizing - drop-list & edit-list, better colour selector. <-- note the built-in DROP-DOWN style - See Quilt on Qtask for a list of widgets - add tab-key handling to image-editor, scroller, list-sort-button(?) radio, radio-line, toggle, rotary, choice, drop-down, icon - other styles should be focusable, handle tab key and Ctrl-C, but not participate in tab key cycling by default. ie. you have to click on them to gain the focus. - this needs a face flag, named "NO-KEY-FOCUS" ? When flag-face? face no-key-focus, then focusing by key will be skipped. - If the user focuses such a face, then tabs aways, then the face might deflag itself - probably also need to patch in ctx-text 'next-field/back-field to know which event/type caused the focus (if it was an event ...) - Add a refinement to next-field/back-field to pass the event so other people's code doesn't break. Then next-field/back-field can determine the next focal-face skipping any faces with the NO-KEY-FOCUS flag and when NOT NONE? EVENT/KEY - agg-button.r introduces the idea of dividing the focused state into two: - (1) key-focused (focus gained when user pressed a key, eg tab key) This flag toggles the display of the key focus rectangle. - (2) focused (by mouse click or other means, not by key) This is just face = system/view/focal-face and not face/key-focused - but this should really be a "default button" state <----- - system/view/default-button ? or - window/default-button ? <-- Each (button) face will check its window to see if there is a default button ? - Implement GHOSTED and GHOSTABLE face flags for other styles than agg-button.r The GHOST and UNGHOST functions (in ghost.r) check the face for the GHOSTABLE flag. All faces which implement their own ghosted state (via the GHOSTED flag), should also set the GHOSTABLE flag so that the GHOST/UNGHOST functions know not to interfere. - btn: show focused state better --> don't worry so much anymore, now use %agg-button.r - see button-design.r - some of Henrik's styles: - http://hmkdesign.dk/rebol/cool/cool-widgets.r ; mock up (can be made functional, though) - http://hmkdesign.dk/rebol/toolbar/toolbar-demo.r - http://www.hmkdesign.dk/rebol/tab-view/tab-view.r (the btn used in directory-selector file-selector automatically inherits) - same for btn-enter, btn-cancel, btn-help, self-hider-btn - patch requestors to have key control - "OK" button (or equivalent) focused by default - ESC key closes requestor - someone already did this, check rebol.org - rebol.org: - request-list-enhanced.r - request-date - tooltips: extract from rotate-knob and generalise (should be fairly easy) - then add tooltip support to some other style (using HELP facet ?)(leave rotate-knob alone for the moment) - magnifier style - add an event handler to capture an image around the mouse and send to a zoom-image ? - enable/disable the event handler in global options - the zoom-image should appear in a separate window ? - (see magnifier-window.r) - a "stacked" panel style, which allows multiple messages (panels) to be stacked on top of each other with some arrow buttons to cycle through each of them and a button to discard the currently viewed one. This would, for example, allow multiple error messages to stack up and be examined at leisure. - implement svvc/focal-highlight on other styles than colour-box, button, scroll-panel, scroll-table, tab-bar, link, rotate-knob, tick-box, zoom-radio (eg. field (?)) - this is a common aspect, usually implemented the same way - could be a global function called by feel/redraw - also needs face/old-edge-color, so it couldn't be simply a common feel - maybe scroll-panel and scroll-table should only be focusable when they are scrollable ? (Saves the user focusing it without then being able to scroll it.) - add arrow-key handling to certain styles like tick-box and zoom-radio This will tab to the nearest tabbed face in the direction of the arrow key - or maybe arrow keys should fall through to the first containing scroll-panel that's able to scroll, when the focal-face has no arrow key handling ? (ENGAGE should return a value depending on whether it's able to handle those events or not ?, or use a face-flag ?) - latest little problem was including pop-menu-style and open-menu (open-menu being a function, not a style) - bug: ghosted button can still be focused - and pressing space can open multiple modal dialogs, with no task bar icon !!! <-- investigate this could be useful for menues - go away and modify util/edit-font/demo-edit-font.r and demo-edit-para.r to optionally highlight the text using a generic function for determining the rectangle given a face. This rectangle (two pairs in a block) could be used in a draw block (as in tab-bar.r debug code) - text style (paragraph-style ?) which auto-resizes to support wrapping and flowing text The default text style wraps by default, all that is needed is resizing to the available space... - this is another thing needing a resizing system - use stylize/master to add all the styles to master stylesheet, eg: stylize/master select last load %pop-menu.r [pop-menu-style: stylize] - this could miss evaluating other stuff in the context, although there usually ought not be anything there. - incorporate solo-tab-key-handler functionality into tab-key-handler - resizing & scaling system Some ideas: - abs-min-size: the absolute minimum size this face will be resized to, default 0x0 - min-size: the minimum size this face will be resized to, default is set to initial size - max-size: the maximum size this face will be resized to, default NONE (no limit) The face size will usually vary between min-size and max-size, but when all "flexible" space has been taken and all faces are at min-size or below, then size will shrink towards abs-min-size. - weights - padding --- (see grid.r) --- (see http://www.colellachiara.com/soft/Misc/r3-gui.html) - persistent window size and position - global options: - colours - see menu.r, which sees things from a different point of view, supplying a named-colours object - ("use system colours" option ?) - focal highlight colour (defaults to 0.50.190) - extending svvc with my colours (see patch/vid-colours.r) - check the impact of remaking svvc (is the svvc object referred to directly anywhere in system ?) - add a STYLES block, to contain the *same* NAMED-COLOURS objects from each style - add a DEFAULT block - add a STYLES block, to contain a *clone* of the NAMED-COLOURS objects from each style - defaults for the legacy VID colors - these blocks probably need a TREE style, to fold away so many colours - add a SET-STYLE-COLOR function which accepts a lit-path to a named colour in svvc - eg: set-style-color 'styles/button/edge blue set-style-color 'styles/menu/background blue - this can allow named colours to be a path which resolves to a colour or a block, or a block of paths which resolve to a colour or a block, eg: svvc/styles/ button: [edge: 'svv/vid-styles/button/edge/color ] scroller: [ color: 'svv/vid-styles/scroller/color ;arrow: 'svv/vid-styles/arrow/colors ;== NONE ; <-- the actual value is set in INIT... arrow: 'svv/vid-styles/scroller/init/reduce/7/10 ; arrow colors == [128.128.128 200.200.200] dragger: 'svv/vid-styles/scroller/dragger/color dragger-edge: 'svv/vid-styles/scroller/dragger/edge/color ] menu: make object! [ ; <- the named-colours object background: silver item-text: black selected-item-text: white ... ] - when changing colours, need to see an example of the effect, eg. when the color requester for svvc/scroller is open and the user changes the color, there should be an example scroller changing colour dynamically. - sharing/cloning issues: how to change global colors and update all faces which use it ? - All the styles could refer directly to svvc during redraw - that would make them more complex and probably a tiny bit slower (but ensure they are dynamic) - some flags to control sharing/cloning of font/para/edge objects - fonts - finish font-table - look for any font objects around the system that are not in svv/vid-styles faces - font-control needs to be more space efficient (see the new FONT-CONTROL-ROW, which solves this problem) - evaluate all styles and see how fonts are shared/cloned in init etc. (new script for this.) - see if svv/vid-styles/(style)/font is same as any of its ancestors - see if the font is the same after init in a layout - ancestry (see http://www.codeconscious.com/rebsite/vid-ancestry.r) - could benefit from hierarchical/expanding list - show/hide/highlight my styles/VID built-in styles - graph style, to plot View memory use (see bugs/vid-stylize-mem-use.r) - hold (key) delay & repeat rate (<-- I don't think rebol has control of this) - check for other nice functions to show off in other directories than gui/ - util/preview-mail/preview-mail.r has DEPRESS-FACE RELEASE-FACE CLICK-FACE RESTORE-FACE - util/view-table.r, (view-code a bit rudimentary at the moment) - investigate and document face/show?: none (vs false) - implications for self-hider-btn and tabbing to any hidden faces - face/show? seems to have no bearing on window faces (at least in Windows XP) By design, I think. - idea: overlayout function, takes a layout spec and a face which is the result of a layout from that spec, then relayouts all the existing faces (not creating any new faces). - may have to make use of over-init, a new facet block similar to init, but which takes care not recreate sub-faces. Some styles will have to be patched to add over-init. - idea: arranger style, uses arrange function - or enhance SCROLL-PANEL with rearrangement rules, eg. vertical/horizontal layout, grid layout, and padding etc. - so a VPANEL could be styled from SCROLL-PANEL with vertical layout by default - Compliance of various aspects: - add intended/implemented progress to every style's script header, eg: Supports: [resizeable 0.0 key-control 1.0 ghostable 0.5 ...] ; (resizeability intended, GHOSTABLE only half implemented) so it can be extracted and formatted in a table for documentation. Aspects: - resizeable - key control - field styles: [Enter] key tabs to next face like [Tab] - shows key focus - shows when linked as "default enter key" - ghostable - uses abstracted (global) colors (NAMED-COLOURS object) - doc and access objects - VID-based or just View face based (based on svv/vid-face or another style, or based on standard View FACE) - see doc/vid-styling.txt } Notes: { style-includes, function-includes -> styles, styles-data (as well as being DOne and LOADed) A couple of styles had problems as a result of moving all styles into the master stylesheet: - scroll-table -> header-group -> list-sort-button (header-group-style and list-sort-button-style were expected) - image-editor -> zoom-image (zoom-image-style was expected) - directory-selector - view-message An issue that makes resizing more difficult came up again: faces do not have a parent-face after LAYOUT. parent-face is only set after SHOW (or VIEW). } Requires: [ "gui/tab-bar.r" [tab-bar-style] "gui/scroll-panel.r" [scroll-panel-style] "gui/ami-scroller.r" [ami-scroller-style] "gui/activity-anim.r" [activity-anim-style] "gui/analog-clock.r" [analog-clock-style] "gui/anim.r" [anim-style] "gui/arrow360.r" [arrow360-style] "gui/btn.r" [btn-style] "gui/arrow-buttons.r" [arrow-button-styles] ; <- this does not inherit patched BTN features, even though it is after btn-style patch "gui/button.r" [button-style] "gui/agg-button.r" [agg-button-style] "gui/check.r" [check-style] ; <- overrides VID's built-in check "gui/check-label.r" [check-label-style] ; <- obsoleted by VID's and my check-line, but still used by font-control.r "gui/check-line.r" [check-line-style] ; <- overrides VID's built-in check-line "gui/check-mark.r" [check-mark-style] ; (currently) required by check-line <- overrides VID's built-in check-mark "gui/colour-box.r" [colour-box-style] "gui/direction-box.r" [direction-box-style] ;direction-pointer ; needs cleaning up "gui/directory-selector.r" [directory-selector-style] ; needs request-dir "gui/divider-bar.r" [divider-bar-style] "gui/extended-colour-table.r" [extended-colour-table-style] "gui/font-table.r" [font-table-style] "gui/scroll-table.r" [scroll-table-style] ; needed by request-dir "gui/file-selector.r" [file-selector-style] "gui/font-control.r" [font-control-style] ; <- probably being phased out in favour of font-table "gui/grid.r" [grid-style] ;<-- "gui/group-box.r" [group-box-style] "gui/header-group.r" [header-group-style] ; used by scroll-table ; <-- has those weird post-init issues... ;highlight-button.r ; <-- more of a grid application example "gui/image-editor.r" [image-editor-style] ; <- needs work (click should focus) "gui/zoom-image.r" [zoom-image-style] ; needed by image-editor-style ;"gui/image-progress.r" [image-progress-style] ; <- not implemented yet "gui/integer-edit.r" [integer-edit-style] "gui/level-meter.r" [level-meter-style] "gui/limited-field.r" [limited-field-style] "gui/link.r" [link-style] ;list.r ; <--- old idea never really took off "gui/list-sort-button.r" [list-sort-button-style] ; needed by header-group "gui/menu.r" [menu-style open-menu] ; needed by pop-menu-btn ;"gui/multi-progress.r [multi-progress-style] ; <- not implemented yet "gui/pair-edit.r" [pair-edit-style] "gui/percent-progress.r" [percent-progress-style] "gui/pop-menu-btn.r" [pop-menu-btn-style] ;radio-label ; <- obsoleted by radio-line "gui/request-color.r" [request-color] ; overrides built-in function ;"gui/resize-button-style.r" ; <-- needs work (to be includeable, filename to be consistent) "gui/rotate-knob.r" [rotate-knob-style] "gui/sample-editor-buttons.r" [sample-editor-buttons-styles] ;script-button.r" ; <- this not very useful ? "gui/scroll-area.r" [scroll-area-style] "gui/scroll-panel.r" [scroll-panel-style] ;scroll-table ; (included above) ;scroller.r ; <- obsoleted by builtin scroller "gui/self-hider-btn.r" [self-hider-btn-style] ;"gui/shell-list.r" [] ; <- needs lots of work ;sizing-brace.r ;<---- demo-sizing-brace.r broken ;spectrum-display.r ;<-- this needs a demo ;squiggley-progress.r ; <-- mockup, needs to be implemented properly as a style ;"gui/tab-bar.r" [tab-bar-style] ; already included above "gui/tab-btn.r" [tab-btn-style] "gui/tick-box.r" [tick-box-style] "gui/title-panel.r" [title-panel-style] ;"gui/scroll-area.r" [scroll-area-style] ; needed by view-message (already included) "gui/zoom-radio.r" [zoom-radio-style] "patch/ctx-text-next-field-patch.r" [next-field back-field] "patch/vid-colors.r" [vid-colors svvc] ] Includes: [ "site.r" [site] "library/include.r" [] ; an empty words block will DO the file (include.r is just a normal script, not an include file) "gui/ghost.r" [ghost unghost] "util/request-dir.r" [request-dir] ; needed by directory-selector "gui/view-message.r" [view-message] "gui/scroll-wheel-handler.r" [scroll-wheel-handler] "library/window.r" [find-face-deep sum-face-offsets] ; needed by scroll-wheel-handler, for focus-on-down-event-handler "gui/solo-tab-key-handler.r" [solo-tab-key-handler] "gui/tab-key-handler.r" [tab-key-handler] "gui/focus-on-down-event-handler.r" [focus-on-down-event-handler] ; improves behaviour of SCROLL-PANEL, SCROLL-TABLE "patch/focus-system-patch.r" [focus unfocus no-caret-key-handler scroll-to-face] ; SCROLL-TO-FACE needed by tab-key-handler "gui/all-windows-inactive-handler.r" [init-all-windows-inactive-handler] ; needed by pop-menu-btn (improves interaction with non-rebol apps ... usually) ] Alt-Init: [ ; do the stylizing etc. from the right location ; MODES and ALL-INCLUDES are passed in here, so we know where the files were located dependencies: copy all-files ; [file words location script data] print ["deps:" length? dependencies] ] Do-Init: [ use [site includes][ site: head clear find select load-thru http://www.rebol.net/reb/index.r [folder "Anton"] %index.r do load-thru site/library/include.r ; define the INCLUDE function ; Let's include the dependencies in Requires: and Includes: includes: copy [] foreach [file block] append copy system/script/header/Requires system/script/header/Includes [ if not empty? block [repend includes [site/:file block]] ] include includes include/target [ ; patch ctx-text/next-field & back-field to visit all subfaces/parent-faces site/patch/ctx-text-next-field-patch.r [next-field back-field] ; <- also in Requires: ] ctx-text ; patch system/view/vid/vid-colors to add some named colours (eg. focal-highlight) ;include/target [ ; site/patch/vid-colors.r [vid-colors svvc] ; <- also in Requires: ;] system/view/vid ] print "---------- cleared ------------" dependencies: [] ] ] do system/script/header/Do-Init print ["deps:" length? dependencies] style-includes: copy [] function-includes: copy [] styles: copy [] ; style names to be used as example data foreach [file blk] system/script/header/Requires [ ; extract only those with a "-style" and "-styles" foreach name blk [ if find ["" "s"] find/last/tail mold name "-style" [ if not find style-includes file [repend style-includes [file blk]] append styles name ] ] if not find style-includes file [repend function-includes [file blk]] ; if it was not added to style-includes, it's not a style ] new-line/all styles on append function-includes system/script/header/Includes ; add all the styles to master stylesheet (like stylize/master) so we don't need to use the STYLES keyword. use [ctx value old][ foreach [file blk] style-includes [ ctx: either find dependencies file [ do pick find dependencies file 3 ; 3 = location <- use the location as determined by %do.r ][ do-thru site/:file ; <- compatible with DO (caches files whether the user asked for it or not) ] foreach style blk [ either style = 'open-menu [ ; handle specially because it's really a function, not a style open-menu: get in ctx 'open-menu ][ value: get in ctx style foreach [name face] value [ ; this is essentially what stylize/master does either old: find svv/vid-styles name [change next old face][repend svv/vid-styles [name face]] ] ] ] ] ] ;------------ Colours --------------------------------------------------- colour-prefs-file: %colour-prefs-for-style-gallery.r ; patch system/view/vid/vid-colors to add some named colours (eg. focal-highlight) use [ctx][ ctx: do-thru site/patch/vid-colors.r set in svv 'vid-colors get in ctx 'vid-colors svvc: get in ctx 'svvc ctx/extract-named-colours-from-styles ] {; Ensure svvc/styles has all the named-colours objects of each style ; <-- this should probably be an exported function of patch/vid-colors.r foreach [style face] svv/vid-styles [ if in face 'named-colours [ ; if this style has a named-colours object either find svvc/styles style [ ; was this style's colours already added ? ; replace existing svvc/styles/:style: face/named-colours ; put a direct reference to NAMED-COLOURS in STYLES block foreach word [previous prefs default][ ; put a clone of NAMED-COLOURS in PREVIOUS PREFS and DEFAULT svvc/:word/styles/:style: make face/named-colours [] ] ][ ; add new repend svvc/styles [style face/named-colours] ; put a direct reference to NAMED-COLOURS in STYLES block foreach word [previous prefs default][ ; populate PREVIOUS PREFS and DEFAULT with clones of NAMED-COLOURS repend svvc/:word/styles [style make face/named-colours []] ] ] ] if in face 'colour-descriptions [ ; if this style has a colour-descriptions object either find svvc/descriptions/styles style [ ; was this styles's colour descriptions already added ? ; replace existing svvc/descriptions/styles/:style: face/colour-descriptions ; put a direct reference to COLOUR-DESCRIPTIONS in DESCRIPTIONS/STYLES block ][ ; add new repend svvc/descriptions/styles [style face/colour-descriptions] ; put a direct reference to COLOUR-DESCRIPTIONS in DESCRIPTIONS/STYLES block ] ] ]} ; Load prefs ; Load colour prefs from prefs file into svvc/prefs if exists? colour-prefs-file [ use [colour-prefs styles set-object-intersection][ colour-prefs: do colour-prefs-file styles: colour-prefs/styles forskip styles 4 [ styles/1: to-lit-word styles/1 ] colour-prefs/styles: reduce styles ; merge the identifiable colours into svvc/prefs set-object-intersection: func [ "Set attributes of A which occur in B to the corresponding values in B." a [object!] b [object!] ][ foreach word exclude intersect first a first b [self][ set in a word either function? get in b word [ func third get in b word bind second get in b word a ; clone the function, binding its body to A ][ get in b word ] ] ] foreach word exclude first colour-prefs [self prefs default descriptions colour-changes][ either word = 'styles [ if block? colour-prefs/styles [ ; has a styles block ? ; merge styles block into svvc/styles foreach [style obj] colour-prefs/styles [ either find svvc/styles style [ ; replace existing ; only copy named colours that exist already set-object-intersection svvc/styles/:style colour-prefs/styles/:style ][ ; add new <--- ? ] ] ] ][ if in svvc word [set in svvc word get in colour-prefs word] ] ] ] ] ; Copy Prefs to Active colours ; Copy colour prefs from svvc/prefs to Active colours in svvc ; <--- ; Build layout to edit colours {styles-with-named-colours-spec: [style uname uname 210 style colour-preset-btn box edge [size: 1x1 color: black]] use [colours-blk][ foreach [style named-colours] svvc/styles [ colours-blk: copy [] foreach colour exclude first named-colours [self][ append colours-blk compose/deep [ uname (form colour) colour-box get in ('named-colours) (to-lit-word colour) [set in (named-colours) (to-lit-word colour) face/color] left-arrow-button "Previous" colour-preset-btn 30x30 effect [cross] left-arrow-button "Prefs at load" colour-preset-btn 30x30 effect [cross] left-arrow-button "Default" colour-preset-btn 30x30 get in (svvc/default/styles/:style) (to-lit-word colour) return ;uname "background" colour-box left-arrow-button "set to default" colour-box 30x30 left-arrow-button "set to previous" colour-box 30x30 return ;uname "item-text" colour-box button 100x30 "set to default" colour-box 30x30 button 100x30 "set to previous" colour-box 30x30 ] ] new-line/all/skip colours-blk on 12 append styles-with-named-colours-spec compose/deep [ group-box (form style) data [ across origin 12 (colours-blk) ] ] ] ]} ;------------------------------------------------------------- ; derive STYLES-DATA from STYLE-INCLUDES for the scroll-table as example data styles-data: copy [] use [cache-file header progress status][ foreach [file words] append copy style-includes function-includes [ ;?? file either find dependencies file [ header: pick find dependencies file 4 ; 4 = script <- use the script header as previously LOADed by %do.r ][ ; load the file ourselves to be compatible with DO cache-file: path-thru site/:file ; (assumes files are cached, which should have been done by INCLUDE) header: first load/header cache-file ] progress: get in header 'progress status: get in header 'status repend/only styles-data [file words progress status] ] ] default-scroller: svv/vid-styles/scroller ; keep default scroller so we can toggle it with ami-scroller ; build a block of font objects (with accompanying descriptions) for the FONT-TABLE font-table-data: copy [] foreach [style face] svv/vid-styles [ if face/font [ either find font-table-data face/font [ append select font-table-data face/font style ][ repend font-table-data [face/font reduce [style]] ] ] ] ; reprocess to put font and associated block of style names into a block forall font-table-data [change/part/only font-table-data reduce [font-table-data/1 form font-table-data/2] 2] ; description text is list of styles which have this font {global-options-panels: [ "Colours" [ origin 10x20 across h1 "SVVC" code -1x30 middle "( = system/view/vid/vid-colors = svv/vid-colors)" return below text "(this section only partially implemented)" h3 "Legacy VID named colors" across ;style name code 100 right style name h3 140x30 right middle font-name font-fixed style uname name gray ; <-- unimplemented colours style text text -1x30 middle uname "font" colour-box (svvc/font/1) colour-box (svvc/font/2) return ; <-- this is a block of two colors uname "body" colour-box (svvc/body/1) colour-box (svvc/body/2) return ; <-- this is a block of two colors name "button" colour-box (svvc/button) [ svvc/button: face/color ; demonstrate the change view/new center-face layout [ button "button" button "effects none" with [append init [effects: none]] ; or just EFFECTS [] field "field" rotary "rotary" "hello" choice "choice" "hello" ] ] text "Used by built-in BUTTON TOGGLE ROTARY CHOICE" return name "bevel" colour-box (svvc/bevel) [ svvc/bevel: svv/vid-styles/button/edge/color: svv/vid-styles/field/edge/color: face/color ] text "Used by built-in BUTTON and FIELD edge" return name "title" colour-box (svvc/title) [ svvc/title: face/color ] text "(Appears not to be used by built-in VID styles)" return name "field" colour-box (svvc/field) [ svvc/field: svv/vid-styles/field/colors/1: face/color ; <- only takes effect during FIELD init (non-dynamic) ] text "Used by built-in FIELD as background color." return name "field-select" colour-box (svvc/field-select) [ svvc/field-select: svv/vid-styles/field/colors/2: face/color ] text "Used by built-in FIELD as background color when focused." return name "field-font" colour-box (svvc/field-font) [ svvc/field-font: svv/vid-styles/field/font/color: face/color ] text "Used by built-in FIELD as text color. (The system caret uses the same color.)" return ;... ;btn "set to defaults" ;btn "save as.." below ;bar 370x1 effect [merge luma -20] ; simple fixed-width divider style light-divider bar 20x1 effect [merge luma -20] feel [ ; auto-sizing divider ; auto-resize to fit space in containing face redraw: func [face action position][face/size/x: face/parent-face/size/x - (face/offset/x * 2)] ] light-divider h3 "Anton's extended named colours" pad 10x0 panel [ across ;style name code 100 right name "focal-highlight" colour-box svvc/focal-highlight [svvc/focal-highlight: face/color] ; <- needs global refresh return below light-divider h4 "Styles using NAMED-COLOURS" style group-box group-box bold effect [merge luma 8] ; <-- this should be populated from svvc/styles ; eg: panel (styles-with-named-colours-spec) ] ]} global-options-panels: [ "Colours" [ extended-colour-table feel [ append second :redraw bind [ if face/size <> face/old-size [ face/old-size: face/size ;print "size changed" global-options-panel/pane/size: face/size + (2 * face/offset) resize show window ] ] second third second :redraw] ] "Fonts" [ text "(this section only partially implemented)" guide ;code "system/standard/face/font (= face/font)" ;font-control set-font (system/standard/face/font) ;return ;code "svv/vid-face/font (= svv/vid-styles/face/font)" ;font-control set-font (svv/vid-face/font) ;;svv/vid-styles/blank-face/font (= none) font-table data (font-table-data) ] "Handlers" [ ;style handler-box box 100x30 with [handler: none] feel [ ; redraw: func [face action position /local found][ ; found: find system/view/screen-face/feel/event-funcs get in face 'handler ; face/color: either found [leaf][maroon] ; face/text: either found ["active"]["inactive"] ; ] ;] style handler-button button 100x30 with [handler: none] font-size 16 feel [ redraw: func [face action position /local found][ found: find system/view/screen-face/feel/event-funcs get in face 'handler face/color: (either found [leaf][maroon]) * either face/state [0.7][1.0] face/text: either found ["active"]["inactive"] if face/edge [face/edge/effect: pick [ibevel bevel] face/state] if all [ face/edge any [face/edge/size/x > 0 face/edge/size/y > 0] ][ if none? face/old-edge-color [face/old-edge-color: face/edge/color] face/edge/color: either face = system/view/focal-face [ any [all [in svvc 'focal-highlight svvc/focal-highlight] 0.50.190] ][face/old-edge-color] ] ] ][ ; action either find system/view/screen-face/feel/event-funcs get in face 'handler [ remove-event-func get in face 'handler ][ insert-event-func get in face 'handler ] ] h3 "Scroll-wheel handler" ;handler-box with [handler: :scroll-wheel-handler] handler-button with [handler: :scroll-wheel-handler] text 500 {Allows the use of scroll-wheel when the mouse is over a face (at any depth) which is flagged with 'scroll-wheel. The face does not need to be focused when it is sent the events, and it can handle the events any way it likes.} pad 0x20 h3 "Next-field & Back-field patch" text "ctx-text-next-field-patch.r" box leaf 100x30 "active" ; <-- text 500 {Patches the NEXT-FIELD and BACK-FIELD functions in the CTX-TEXT object. Allows tabbing into and back out sub-faces. Tabbing cycles correctly in both directions.} pad 0x20 h3 "Solo tab key handler" handler-button with [handler: :solo-tab-key-handler] text 500 {After tabbing away from a 'tabbed' face that was the only focusable face, it leaves no faces at all focused. The solo tab key handler handles the situation where focal-face = none and tab key is pressed, by focusing the first 'tabbed' face again.} text "Works with or without the tab key handler." pad 0x20 h3 "Tab key handler" handler-button with [handler: :tab-key-handler] text "Handles tab key cycling. Scrolls to the newly focused face if necessary." pad 0x20 h3 "Focus on down event handler" handler-button with [handler: :focus-on-down-event-handler] text 500 {Traps and handles down events. If, after handling the event, the focused face did not change, then this bubbles up looking for a face which is flagged FOCUS-ON-DOWN and focuses that. Eg. Clicking on a non-focusable face in a SCROLL-PANEL will cause the SCROLL-PANEL to be focused.} pad 0x20 h2 "Focus system patch" pad 20x0 h3 "Focus" box 100x30 (either find first third :focus "patch" [leaf][maroon]) (either find first third :focus "patch" ["patched"]["unpatched"]) h3 "Unfocus" box 100x30 (either find first third :unfocus "patch" [leaf][maroon]) (either find first third :unfocus "patch" ["patched"]["unpatched"]) h3 "No caret key handler" handler-button with [handler: :no-caret-key-handler] pad -20x20 h3 "All windows inactive handler" handler-button with [handler: :all-windows-inactive-handler] text 500 {This is used by POP-MENU-BTN to detect when all windows (of this rebol process) are deactivated, as might happen when a completely different application window is activated. Note, this handler is likely to become unreliable (more than it is already..) if deactivated and reactivated.} ] "Scrollers" [ check-line "Replace default scroller style with ami-scroller" (svv/vid-styles/scroller = ami-scroller-style/ami-scroller) [ either value [ if svv/vid-styles/scroller = default-scroller [ svv/vid-styles/scroller: ami-scroller-style/ami-scroller ; change to ami-scroller ] ][ if svv/vid-styles/scroller = ami-scroller-style/ami-scroller [ svv/vid-styles/scroller: default-scroller ; change back to default ] ] ] ] ] main-panels: [ "Usage" [ h3 "How to run style-gallery.r" text "" as-is ; <- the script header Usage: is appended to this string ] "Global options" [ space 0 global-options-tab-bar: tab-bar data (extract global-options-panels 2)[ ;VALUE = the tab-btn face global-options-panel/pane: layout/offset (select global-options-panels value/text) 0x0 global-options-panel/size: global-options-panel/pane/size + (2 * global-options-panel/edge/size) resize show window ] global-options-panel: box edge [size: 1x1 color: black] ( main-panel/size - (global-options-tab-bar/offset + (global-options-tab-bar/size * 0x1) * 2x1) - 0x20 ) do [ do-face global-options-tab-bar last global-options-tab-bar/tabs-face/pane ; do action as of current tab ] ] "grouping/panels" [ ;styles grid-style ;grid 400x400 ; <---- this example will be complex h3 "scroll-panel" ;styles scroll-panel-style grp-scroll-panel: scroll-panel edge [size: 1x1 color: black] max-initial-size 200x100 subface [ text as-is "This is a scroll-panel.^/It responds to scroll-wheel,^/is focusable, and,^/when focused, scrolls on arrow keys and^/page-up/down keys." image 200x50 logo.gif effect [tile gradmul] ] pad 0x20 panel [ space 20x10 h3 "group-box" ;styles group-box-style group-box: group-box "some of the built-in images" font-size 14 data [ origin 10x10 pad 0x20 ; <-- leave space for title text, working around problem with group-box across style label label 120 ;label "logo.gif" image logo.gif return label "info.gif" image info.gif return label "help.gif" image help.gif return label "stop.gif" image stop.gif return label "exclamation.gif" image exclamation.gif return ;text "(see more in svv/image-stock)" ] return h3 "title-panel" ;styles title-panel-style title-panel: title-panel "title text" auto-clasp 0x-1 data [ origin 10x10 across text "font margin:" ;styles integer-edit-style integer-edit (form svv/vid-styles/text/para/margin/x) with [drag-divisor: 8x8][title-panel/para/margin/x: face/data show title-panel] return below box 200x20 effect [merge luma 20] label "set title text:" field "title text" [title-panel/text: face/text show title-panel] label "font size:" scroller 200x20 with [data: svv/vid-styles/text/font/size / 48][title-panel/font/size: to-integer 48 * value show title-panel] ] ] pad 0x20 h3 "divider-bar" panel edge [size: 1x1][ origin 8x8 space 0 banner 400x80 "previous face" wheat effect [gradient 0x1 sky navy] divider-bar 100 scroll-area 400x100 "The divider-bar is quite simple at the moment.^/It just resizes the previous and next faces.^/Can be horizontal or vertical." ] pad 0x20 h3 "tab-btn" ;styles tab-btn-style across space 0x0 tab-btn "Option 1" (red + 0.130.130) default pad -10 tab-btn "Option 2" (green + 130.0.130) pad -10 tab-btn "Option 3" (blue + 130.130.0) pad -10 tab-btn "Option 4" (180.180.50) return box 400x150 navy effect [gradient beige linen grid 7x7 7x7 khaki] edge [size: 1x1 color: black] ] "menu" [ h3 "pop-menu-btn" ; styles pop-menu-btn-style across text "result:" menu-result-txt: text 200 effect [merge luma 20] return text "help-text:" help-txt: text 400 effect [merge luma 20] return pop-menu-btn "Edit" items [ "Undo" hotkey "Ctrl+Z" help-text "Undo the last action" "Redo" hotkey "Ctrl+Y" help-text "Redo the previously undone action" --- tick "Line numbers" tick "Spell check" --- "Cut" hotkey "Ctrl+X" [set-face menu-result-txt "Cut"] "Copy" hotkey "Ctrl+C" [set-face menu-result-txt "Copy"] ghosted "Paste" hotkey "Ctrl+V" [set-face menu-result-txt "Paste"] --- "_Select" items [ tick "Select All" hotkey "Ctrl+A" [set-face menu-result-txt "Select all"] "Select Line" ghosted "Select Word" ] --- "submenu" items [ "item 1" "item 2" "item 3" --- "submenu" items [ "A" "B" "C" ] ] ][ ; copy the menu-item's help text to the help-txt face above set-face help-txt all [value/1 = 'select-menu-item value/2 value/2/selected-help-text] set-face menu-result-txt all [value/1 = 'activate-menu-item value/2 value/2/selected-item-text] ] ] "scrollers" [ h3 "ami-scroller" ami-scroller: ami-scroller 200x18 check-line "arrows together" on [ do pick [flag-face deflag-face] value ami-scroller arrows-together ami-scroller/resize ami-scroller/size show ami-scroller ] ] "areas" [ h3 "scroll-area" ;styles scroll-area-style areas-scroll-area: scroll-area (join "This is a scroll-area.^/Scroll up & down with scroll-wheel.^/Change font size with ctrl+scroll-wheel.^/Scrolls as you type.^/" mold styles) ] "fields" [ h3 "integer-edit" ;styles integer-edit-style across integer-edit text "click & drag or double-click to enter keyboard entry mode" return below pad 0x20 h3 "pair-edit" ;styles pair-edit-style pair-edit pad 0x20 h3 "limited-field" ;styles limited-field-style across limited-field "Default limit is 30 characters" code "limited-field" return limited-field "max" with [max-length: 3] code "limited-field with [max-length: 3]" return limited-field "max-length" with [max-length: 10] code "limited-field with [max-length: 10]" return below pad 0x20 h3 "link" ;styles link-style link "rebol.com" ] "buttons" [ h3 "agg-button" agg-button "agg-button" text "A reengineered button style using AGG DRAW dialect." h3 "button" button "button" text "The built-in BUTTON style is patched to support keyboard control and participate in tab-key cycling." pad 0x20 h3 "btn" btn "btn" text "Patched similarly to button." pad 0x20 ;btn-enter "btn-enter" ;btn-cancel "btn-cancel" ;btn-help "btn-help" ;tog "tog" h3 "arrow-button-styles" ;styles arrow-button-styles right-arrow-button "right-arrow-button" left-arrow-button "left-arrow-button" left-arrow-button "orange" orange pad 0x20 h3 "sample-editor-buttons" ;styles sample-editor-buttons-styles text "These now rescale automatically when resized." across btn-play-reverse btn-stop btn-play btn-pause btn-play-to-end btn-play-looped return btn-previous btn-rewind btn-fast-forward btn-next btn-record btn-next 33x33 below pad 0x20 h3 "self-hider-btn" ;styles self-hider-btn-style self-hider-btn "Hide self" [hide face] ; This action always hides the btn text 500 {I used this in a wizard GUI long ago, the "Next" button disappears on the last panel. These days I would probably just ghost the button. Now BTN and BUTTON have the same ability to hide themselves, so self-hider-btn is probably redundant...} ] "check-boxes" [ h3 "check" check on check 25x25 text "This overrides VID's built-in check style." pad 0x20 h3 "check-mark" check-mark on check-mark 25x25 text "This overrides VID's built-in check-mark style." pad 0x20 h3 "check-line" check-line on "check-line" check-line "check-line" text "This overrides VID's built-in check-line style." pad 0x20 h3 "tick-box" ;styles tick-box-style tick-box on tick-box 25x25 text "This is a bit older, probably obsoleted by check-mark." pad 0x20 ] "radio-buttons" [ h3 "zoom-radio" ;;styles zoom-radio-style zoom-radio zoom-radio 24x24 pad 0x20 ] "knobs" [ pad 0x20 h3 "rotate-knob" pad 20x0 ;styles rotate-knob-style h5 "rotate-knob" rotate-knob h5 "absolute-knob" absolute-knob h5 "relative-knob" relative-knob h5 "panning-knob" panning-knob ] "requestors" [ h3 "directory-selector" ;styles directory-selector-style directory-selector ;[alert reform ["Selected directory:" mold face/field/text]] h3 "file-selector" ;styles file-selector-style file-selector h3 "colour-box" ;styles colour-box-style colour-box orange [ ; refresh ;my-box/color: face/color ;show my-box ] text "COLOR-BOX now uses patched REQUEST-COLOR based on Oldes' COLOR-LAB" ] "indicators" [ h3 "level-meter" ;styles level-meter-style level-meter: level-meter with [data: 0.9] pad 0x20 h3 "percent-progress" ;styles percent-progress-style percent-progress: percent-progress with [data: 0.9] pad 0x20 scroller 200x20 with [data: 0.9] [set-face level-meter face/data set-face percent-progress face/data] pad 0x20 h3 "anim" text "The ANIM style has been patched to allow direct specification of images, and also allows *zero* initial frames." pad 0x20 h3 "activity-anim" across my-activity-anim: activity-anim btn "start" [my-activity-anim/start] btn "stop" [my-activity-anim/stop] return below pad 0x20 h3 "analog-clock" analog-clock ] "diagram/gfx" [ h3 "zoom-image" ;styles zoom-image-style zi: zoom-image logo.gif edge [size: 1x1 color: 50.0.110] ;with [focus self] text "Use Ctrl + scroll-wheel to zoom, arrow keys to move/nudge the image." across btn "zoom in" [zi/zoom-in zi] ; <- this interface might change btn "zoom out" [zi/zoom-out zi] return below pad 0x20 h3 "arrow360" ;styles arrow360-style arrow360 arrow360 150x100 black gold with [ append init [ insert find/tail effect 'merge [luma -8] base: offset + 20x60 tip: base + 300x-40 ] shaft-diameter: 3 ;arrow-diameter: 20 ;arrow-length: 20 ;barb-sharpness: 0.6 ] text 500 {Now has nicer characteristics than AGG DRAW dialect ARROW + LINE. The TIP facet specifies the position right at the tip of the arrow (not the middle of the arrowhead). Various parameters are available for controlling the shape of the arrowhead. } pad 0x20 h3 "image-editor" ;styles image-editor-style ;styles zoom-image-style image-editor copy help.gif ;load %../images/alien-invader.png text "Image-editor encapsulates a zoom-image and it is planned to have a more capable toolbar." ] "lists" [ h3 "list-sort-button" ;styles list-sort-button-style across list-sort-button "sort" list-sort-button "sort" right delay return below pad 0x20 h3 "header-group" ;styles header-group-style header-group edge [size: 2x2] data ["file" 100 "size" 80 "date" 120] actions [ ;[print value][print [value face/style]][print [value face/offset]] ; <- bug [print value][print value][print value] ; <- also bug ] pad 0x20 h3 "scroll-table" ;styles scroll-table-style ;scroll-table data multi-data selection-mode [multi cell] lists-scroll-table: scroll-table edge [size: 1x1 color: black] data styles-data headers ["file" "includeable styles/funcs" "progress" "status"] ] "support functions" [ h3 "ghost / unghost" across test-button: button "test" [alert {You pressed "test"}] btn "Ghost" [ghost test-button] btn "Unghost" [unghost test-button] return text 600 (rejoin [ {GHOST and UNGHOST place a "ghost-face" over the top of your face, blocking user interface events to it and } {dimming its appearance. This should work for any face that does not move around. It is preferred that all } {styles implement their own ghosted state using the GHOSTED face flag themselves, but until then we have these functions.} ]) return below pad 0x20 h3 "view-message" btn "view-message" [view-message/new/title {This is some text displayed by view-message, which uses a scroll-area in a resizeable window.} "view-message window title"] ] ] append select select main-panels "Usage" [text] system/script/header/Usage ; derive main-tab-bar-data from main-panels main-tab-bar-data: copy [] foreach [title spec] main-panels [append main-tab-bar-data title] ; create multi-data, a block of data used for the scroll-table multi-data: clear [] use [dir][ foreach file read dir: join view-root %"" [ append/only multi-data reduce [file size? dir/:file modified? dir/:file] ] ] resize: does [ main-tab-bar/size/x: window/size/x main-panel/size/x: window/size/x main-panel/size/y: window/size/y - main-panel/offset/y window/pane/1/size/x: window/size/x ; <- H1 title ;switch main-tab-bar/current-tab/text [ ; <- this is what I want to write switch get in last main-tab-bar/tabs-face/pane 'text [ "Global options" [ global-options-panel/size: global-options-panel/pane/size + (2 * global-options-panel/edge/size) main-panel/subface/size: (global-options-tab-bar/offset * 2) + (global-options-tab-bar/size * 0x1) + global-options-panel/size main-panel/resize ;global-options-tab-bar/size/x: main-panel/size/x - (2 * global-options-tab-bar/offset/x) - (2 * global-options-tab-bar/edge/size/x) ] "grouping/panels" [ ;grp-scroll-panel/size: main-panel/subface/size - (2x1 * grp-scroll-panel/offset) - (0x1 * grp-scroll-panel/offset/x) ] "areas" [ areas-scroll-area/size: main-panel/subface/size - (2x1 * areas-scroll-area/offset) - (0x1 * areas-scroll-area/offset/x) ] "lists" [ main-panel/subface/size: main-panel/size lists-scroll-table/size: main-panel/size - (2x1 * lists-scroll-table/offset) - (0x1 * lists-scroll-table/offset/x) ] ] ] ; This must be done before opening any windows (to help pop-menu-btn-style) all-windows-inactive-handler: init-all-windows-inactive-handler [ ;print "all windows inactive!!" ; search for a menu and close-menu foreach window system/view/screen-face/pane [ if all [ in window 'style window/style = 'menu ][ window/ctx/close-menu break ] ] ] view/new/options window: center-face layout [ origin 0 space 0 h1 800 "Anton's VID-based Style Gallery" center main-tab-bar: tab-bar 800x32 font-size 16 data main-tab-bar-data [ ; VALUE = the current tab face ;main-panel/resubface layout/offset (select main-panels value/text) 0x0 main-panel/subface: layout/offset (select main-panels value/text) 0x0 ; <- resubface should be done automatically main-panel/access/set-scroll-offset/no-show main-panel 0x0 ; reset the scroll-panel scrollbars ;show window resize show window ] main-panel: scroll-panel edge [size: 1x1] 800x500 ;subface (main-panels/2) ; manually specify initial subface ] 'resize do-face main-tab-bar last main-tab-bar/tabs-face/pane ; do action as of current tab focus main-tab-bar window/feel: make window/feel [ detect: func [face event][ if event/type = 'resize [ resize show window ] event ] ] insert-event-func :no-caret-key-handler insert-event-func :solo-tab-key-handler insert-event-func :tab-key-handler insert-event-func :scroll-wheel-handler insert-event-func :focus-on-down-event-handler if error? set/any 'error try [ do-events ][ print mold disarm error ] remove-event-func :focus-on-down-event-handler remove-event-func :scroll-wheel-handler remove-event-func :tab-key-handler remove-event-func :solo-tab-key-handler remove-event-func :no-caret-key-handler remove-event-func :all-windows-inactive-handler if svv/vid-styles/scroller = ami-scroller-style/ami-scroller [ svv/vid-styles/scroller: default-scroller ] ; Save prefs use [rebol-header colour-prefs spec values][ rebol-header: compose [ Title: "Colour Prefs" Date: (now/date) Generated-By: (system/script/header/file) Purpose: "To maintain user colour preference settings between runtimes" Note: "Automatically generated and saved between runtimes" ] ; clone svvc without PREVIOUS, PREFS or DEFAULT colour-prefs: make svvc [previous: prefs: default: none] spec: exclude first colour-prefs [self previous prefs default] ;values: reduce bind spec colour-prefs ; <- doesn't work (function values are evaluated) values: copy/part next second colour-prefs length? spec forall spec [spec/1: to-set-word spec/1] append spec 'none ; convert spec to set-words set colour-prefs: make object! spec values save/header colour-prefs-file colour-prefs rebol-header ] ()