Friday, 12 April 2013

Menu system

Menu system is a library to make cool expanding menu in Rebol 2.

Here is the source:

REBOL [
    Title:   "Menu-System"
    Name:     'Menu-System
    File:     %menu-system.r
   
    Version: 0.2.0
    Date:     12-Jun-2005
       
    Author:   "Christian Ensel"
    Email:   christian.ensel@gmx.de
   
    Owner:   "Christian Ensel"
    Rights:   {
        Copyright (c) 2005 Christian Ensel
        All rights reserved.
        Redistribution and use in source and binary forms, with or without
        modification, are permitted provided that the following conditions
        are met:
        •   Redistributions of source code must retain the above copyright
          notice, this list of conditions and the following disclaimer.
        •   Redistributions in binary form must reproduce the above copyright
          notice, this list of conditions and the following disclaimer in the
          documentation and/or other materials provided with the distribution.
        •   Neither the name of the copyright holder nor the names its
          contributors may be used to endorse or promote products derived
          from this software without specific prior written permission.
        THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
        "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
        LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
        A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
        OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
        SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
        LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
        DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
        THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
        (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
        OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE."                                
    }
   
    Purpose: {
        Easy to use VID compatible REBOL menu system (early Beta).
        Have menus in your REBOL apps, finally.
    }
   
    Todo: {
        • The SCROLLER-ITEM stuff is actually more of a prove of concept,
          but it seems like integrating other VID-Styles should be possible.
          I'd really like to see FIELD-ITEM, or maybe even a generic VID-ITEM.
          Minor drawback: disabling SCROLLER-ITEM doesn't work, but that really
          shouldn't be too hard to accomplish.
        • Some functions like ADJUST-xy and LAYOUT-xy have to changed to
          methods in FEEL or ACCESS.
        • I'd like to get rid of MENU/ITEMS. Keeping it in sync with
          MENU/LIST/PANE is annoying, one simple loop thru the latter should
          do and won't be noticable slower.
        • There's a bug in closing windows: REBOL.exe remains, with all
          windows closed, waiting in the event loop. Looks like somewhere
          there's one WAIT. But *where*?
    }
   
    History: {
        0.2.0 • Mostly all code is now truly OOP due to leaving FACE/TYPE
                intact (now always is 'FACE for future VID compatibility)
                (hence the jump in the version number)
              • Rebolish default style inbuild
              • For the fun of it: Derived SLIDER-ITEM from MENU-ITEM,
                and - tada! - it works!
        0.1.8 • Further major code cleaning and more consistent OOP, way too
                much to list here.
              • Totally rewritten styling scheme, now uses flat PROPERTIES
              • Inserting new items to an existing menu is now possible thanks
                to "abusing" LAYOUT-MENU to create a single-item menu, whose
                item is then inserted by INSERT-ITEM.
                It's a bit odd though, because it doesn't inherit styles if none
                we're supllied.
              • For top-level menus (root-menus) it's now possible to refer
                to their items by index. This doesn't work for menu-bars though.
        0.1.7 • Menu-accessor method object added
              • Experimental removing and reinserting of items works.  
              • Global functions to menu-accessors added
              • Dialect is more consistent and allows specification of
                normal and hovered enabled and disabled states.
              • A couple of layout and style inheritence problems fixed.
              • Overall code cleaning.
        0.1.6 • Shortcut keys are now dialected as TAG! instead of ISSUE!,
                TAG! is way more flexible.
              • Styling with LAYOUT-MENU/STYLE works.
              • Styling MENU-BAR and DROP-MENU with MENU-STYLE works.
              • Correction of layout algorithm, still somewhat problematic.                
        0.1.5 • MENU-BAR style now with full keyboard support, but still
                "menubar" and "baritems" aren't configurable.
              • DROP-MENU now works again.
        0.1.4 • Experimental MENU-BAR VID style now works.
                It isn't configurable much and there are some really annoying bugs.
              • Drop-Menu is broken for now.
        0.1.3 • Experimental DROP-MENU VID-style.
        0.1.2 • Dialect changes.
        0.1.1 • Dialect changes.
        0.1.0 • Refactored earlier prototype.
    }
   
    Credits: {
        Originally this script evolved from trying to understand the inner
        workings of Cyphre's menu system sketch, without that I would by
        no means have come as far as shown here.
    }
   
    Library: [
        level:       'intermediate
        platform:   'all
        type: [module demo]
        code: 'module
        domain: [user-interface vid gui]
        tested-under: [view 1.2.119.3.1 on "WinXP"]
        support: none
        license: 'BSD
        see-also: none
    ]
]
ctx-menus: context [
    ;############################################# helper functions and alike ##
    ;

    shadow-image: use [reset image] [
        reset: system/options/binary-base
        system/options/binary-base: 64
        image: load 64#{
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABmJLR0QA/wD/AP+g
vaeTAAAACXBIWXMAAAsTAAALEwEAmpwYAAAAB3RJTUUH1QQUCzYGyPaalQAAAINJ
REFUeNrd0qEOwjAUBdADDIJDIYaZWPjJfSZuAo2bQiybKKZLmqUzRcE1TZO+U3Ef
P59DwUyHCwKGqgBocFou+wLghhptKVDjjGMpkOb6LeAPgCqzJE1SVS4vjJgR1sAj
WZJhAxgj8sS0Bvp4tkvPmcxxeEC/yzy4Lx1vAAFT/Oz9ASj/FhDibXHbAAAAAElF
TkSuQmCC
}

        system/options/binary-base: reset
        image
    ]
    cast: func [value cases] [switch type?/word :value cases]
    text-size?: func ["Returns a face's text size or 0x0." face [object!] /local size result] [
        size: face/size
        face/size: 10000x10000                                                  
        result: size-text face
        face/size: size
        result
    ]
   
    image-size?: func ["NONE-safe image/size shortcut" image [image! none!]] [
        any [all [image image/size] 0x0]
    ]
   
    instance-of: func [
        "Returns TRUE if entity is of required class (NONE otherwise)."
        entity [object! none!] class [word!]
    ][
        all [
            object? entity
            'face = get in entity 'type
            found? find any [get in entity 'class []] class
        ]
    ]
   
    ;############################################################# MENU-ITEMS ##
    ;
       
    ;============================================================= new-detail ==
    ;
    ;   Detail faces are the inner faces of menu-item, each item uses five
    ;   of them:
    ;
    ;       - MARK:     The radio- or check-mark
    ;       - ICON:     The item's icon image
    ;       - BODY:     The item's body text and/or image
    ;       - KEY:     The item's shortcut-key text
    ;       - ARROW:   The item's arrow (only for item's with sub-menu)  
    ;
   
    new-detail: func ["Returns an uninitilized item detail."] [
        make system/view/vid/vid-face [                                         ;-- Notice that details have no feel, all item actions are triggered by
            class: make block! [item-detail]                                         ;   item's feel/detect.
            edge: color: effect: effects: none                                      
            offset: size: 0x0
            feel: make face/feel [
                redraw: func [detail offset /local item] [
                    item: detail/parent-face
                    if detail/effects [
                        detail/effect: pick detail/effects item <> item/menu/actor
    ]   ]   ]   ]   ]
       
    ;============================================================== item-feel ==
    ;
    ;   The ITEM-FEEL is the central method object for all item related
    ;   functions.
    ;
   
    item-feel: make face/feel [
       
        detect: func [item event] [
            if within? event/offset win-offset? item item/size [
                item/menu/feel/visit item/menu item
                item/feel/enter item
                event
            ]
        ]
        redraw: func [
            "Draws an item."                                                     ;-- Cares for normal and hovered en- and disabled states.
            item [object!] offset [pair!]
        /local
            state color
        ][
            state:         pick [2 1] item = item/menu/actor
            state: state + pick [2 0] item/state    
           
            item/color:             item/properties/item.colors/:state
            item/icon/image:       item/properties/item.icon.images/:state
            item/icon/effect:       item/properties/item.icon.images/:state
            item/body/font:         item/properties/item.body.font
            item/body/font/color:   item/properties/item.body.font/colors/:state
            item/body/para:         item/properties/item.body.para
            item/key/font:         item/properties/item.key.font
            item/key/font/color:   item/properties/item.key.font/colors/:state
            item/key/para:         item/properties/item.key.para
            item/edge:             item/properties/item.edge
            item/edge/color:       item/properties/item.edge/colors/:state
            item/edge/effect:       item/properties/item.edge/effects/:state
            item/effect:           item/properties/item.effects/:state
           
            if not empty? item/properties/item.body.images [
                item/body/effect: compose/deep [
                    draw [
                        image                                           ;-- Images are left-aligned as well as texts are
                            (as-pair 0 item/body/size/y - (second image-size? item/properties/item.body.images/:state) / 2)
                            (item/properties/item.body.images/:state)
                    ]
                ]
            ]
           
            color: any [item/key/font/color item/body/font/color black]         ;-- Hardcoded default here?!?
           
            item/feel/draw-mark   item color                                     ;-- They know what they're doing
            item/feel/draw-arrow item color                                     ;
        ]
        draw-mark: func [item [object!] color [tuple!]] [
            item/mark/effect: all [
                item/mark/state
                case [
                    instance-of item/mark 'radio [
                        compose/deep [
                            draw [pen (color) fill-pen (color) circle 7x8 3]
                    ]   ]
                    instance-of item/mark 'check [
                        compose/deep [
                            draw [
                            pen (color) line-width 2 line-cap square line-join bevel
                            line 3x8 6x11 12x5
        ]   ]   ]   ]   ]   ]
   
        draw-arrow: func [item [object!] color [tuple!]] [
            item/arrow/effect: all [
                item/sub
                compose/deep [
                    draw [
                        pen (color) fill-pen (color) polygon
                            (as-pair item/arrow/size/x -   8 item/arrow/size/y / 2 - 1)
                            (as-pair item/arrow/size/x - 11 item/arrow/size/y / 2 - 4)
                            (as-pair item/arrow/size/x - 11 item/arrow/size/y / 2 + 2)
                            (as-pair item/arrow/size/x -   8 item/arrow/size/y / 2 - 1)
        ]   ]   ]   ]
       
        visit: func [;-- Show that we're visited
            "Visits item (draws it's hover state)." item [object!]
        ][show item ]
       
        enter: func [
            "Enters item (shows it's sub-menu)."
            item [object!]
        /new                                                                     ;-- NEW is used to differentiate between wandering through menus with  
            "Returns immediately from showing."                                 ;   mouse and keyboard. Whilst hovering items with sub-menus with the
                                                                                ;   mouse, sub-menus are opened immediatly, whereas when navigating a menu  
                                                                                ;   with the keyboard, that doesn't open sub-menus (to not steal the
                                                                                ;   keyboard focus).    
                                                                                ;
        ][
            if all [                                                             ;-- Show the own sub-menu, for enabled item's with sub-menus
                item/sub                                                         ;   not already popped up only
                not item/state
                none? find system/view/pop-list item/sub
            ][
                either new [
                    show-menu/new find-window item item/sub                     ;-- Keyboard entered sub-menu
                ][show-menu     find-window item item/sub                     ;-- Mouse opened sub-menu ]
            ]
        ]
       
        leave: func [
            "Leaves item (draws it's unhovered state and closes it's sub-menu)."      
            item [object!]                                                      
        ][
            all [item/sub item/sub/feel/close item/sub]
            show item
        ]
       
        engage-mark: func [item /local items] [
            case [
                instance-of item/mark 'radio [
                    if off = item/mark/state [
                        item/mark/state: true
                                       
                        items: item/menu/list/pane
                        foreach sibling items [
                            if all [
                                instance-of sibling 'menu-item
                                sibling <> item
                                item/mark/group = get in sibling/mark 'group
                            ][
                                sibling/mark/state: false
                                show sibling/mark
                ]   ]   ]   ]
                instance-of item/mark 'check [item/mark/state: not item/mark/state ]
        ]   ]
 
        engage: func [
            item action event
            /local root popup start end items state
        ][
            if all [action = 'up none? item/sub not item/state] [;-- We act only on 'UP events for nothing but enabled items without sub-menus.                                                    
               
                if any [
                    instance-of item/mark 'radio
                    instance-of item/mark 'check
                ][item/feel/engage-mark item ]
               
                either not event/shift [;-- SHIFT enables multi-selection, otherwise the whole menu closes.
                    root: item/menu/feel/root-of item/menu
                    root/feel/close root
                ][show item ]
               
                if item/properties/item.action [;-- Trigger the items action by doing an anonymous function build    
                    do func [item] bind item/properties/item.action in item 'self item   ;   from the item's action block. Should I allow for functions here, too?
                ]
            ]
            none
        ]
    ]
   
    ;=========================================================== baritem-feel ==
    ;
   
    baritem-feel: make item-feel [
        super: item-feel
        over: none
        engage: none
        redraw: func [item offset] [item/color: pick item/menu/colors item <> item/menu/actor ]
        detect: func [item event /local actor] [
            case [
                none? item/menu/actor [
                    item/menu/state: 'down-to-enter
                    item/menu/feel/visit item/menu item
                    focus/no-show item/menu
                ]
                'down-to-enter = item/menu/state [
                    item/menu/feel/visit item/menu item
                    focus/no-show item/menu
                    if 'down = event/type [
                        item/menu/state: 'hover-to-enter
                        item/feel/enter item
                    ]
                ]
                'hover-to-enter = item/menu/state [
                    if 'move = event/type [
                        item/menu/feel/visit item/menu item
                        item/feel/enter item
            ]   ]   ]
            none
        ]
        enter: func [
            "Enters item (shows it's sub-menu)."
            item [object!]
        /new
            "Returns immediately from showing."
        ][
            if all [                                                             ;-- Show the own sub-menu, if there's one and if it's not
                item/sub                                                         ;   popped up already
                none? find system/view/pop-list item/sub
            ][
                either new [
                    show-menu/offset/new find-window item/menu item/sub (win-offset? item) + (0x1 * item/size)                     ;-- Keyboard entered sub-menu
                ][show-menu/offset find-window item/menu item/sub (win-offset? item) + (0x1 * item/size)                     ;-- Mouse opened sub-menu ]   ]   ]   ]
   
    ;=============================================================== new-item ==
    ;
    new-item: func ["Returns a uninitialised menu item."] [;-- No deep copying required.
        make system/standard/face [
            class:   make block! [menu-item]
            item:   none                                                         ;-- ITEM is set to SELF, this makes client code easier (or harder ...)
            menu:   none                                                         ;-- MENU is always the menu the item belongs to, it is *not* the
                                                                                ;   sub-menu an item may have (thats in SUB).
            var:     none                                                         ;-- VAR holds the word by which we later refer to the item.
            text: font: image: state: none                                       ;-- All these are unused in favour of the detail faces.
                                                                                ;   (see comments to pane).
            edge: color: effect: none                                           ;-- All these are set depending on items properties and activation-states
                                                                                ;   away/over enabled/disabled  
            state: no                                                           ;-- The enabled/disabled state. There is no explicit OVER state, that is handled
                                                                                ;   in REDRAW dynamically.
            properties: none                                                     ;-- All the item related properties. ###### SHOULDN'T THEY BE INHERITED????? #######
            feel: item-feel                                                     ;-- See detailed comments on ITEM-FEEL.
            data: none                                                           ;-- The item's sub-menu's description, if any.
            sub: none                                                           ;-- The item's sub-menu object itself, if any.
            mark: icon: body: key: arrow: none                                   ;-- Just some shortcuts to the details in item's pane.
            pane: reduce [
                mark:   make new-detail [group: none]                             ;-- GROUP is used for mark-items. Each menu starts which one initial group,
                icon:   new-detail []                                             ;   implicit groups are set up by menu-dividers and additional, more complex
                body:   new-detail []                                             ;   groups can be explicitly specified in the setup dialect.
                key:   new-detail []            
                arrow: new-detail []                                      
    ]   ]   ]
   
    ;============================================================= build-item ==
    ;
    build-item: func [
        "Builds an item, together with all it's sub-faces."
        item [object!]     "a new item"
        menu [object!]     "the menu the item resides in"
        word [word! none!] "the item's identifier"
        desc [block!]       "the item's description"
    ][
        item/item: item/self
       
        item/menu: menu
        item/var:   word
        item/data: desc
       
        menu: menu/properties
        item/properties: make object! [
            item.action:       menu/item.action
            item.effects:       menu/item.effects  
            item.colors:       menu/item.colors  
            item.icon.images:   []
            item.icon.effects: []
            item.body.font:     menu/item.body.font
            item.body.para:     menu/item.body.para
            item.body.images:   []
            item.key.font:     menu/item.key.font
            item.key.para:     menu/item.key.para
            item.edge:         menu/item.edge    
        ]
        item/body/font: item/properties/item.body.font
        item/body/para: item/properties/item.body.para
        item/key/font:   item/properties/item.key.font
        item/key/para:   item/properties/item.key.para
        item/edge:       item/properties/item.edge
       
        item
    ]
   
   
    ;========================================================== build-divider ==
    ;
    ;   DIVIDER needs to be reworked, I guess. Currently, there are absolutely
    ;   no config properties.
    ;
    build-divider: func [
        "Builds a menu divider."        
        parent [object!] "the divider's parent menu"
    ][
        make face [
            class: make block! [menu-divider]
            var: none
            menu: parent
            properties: none
            color: 172.168.153                                                   ;-- Win XP Silver; hardcoded for now
            edge: make face/edge [;-- Ditto, look like Win XP Silver.
                size:   1x2
                color: image: effect: none
            ]
        ]
    ]

   
    ;=========================================================== layout-items ==
    ;
    set 'layout-items func [
        "Layouts items."
        menu [object!]
        desc [block!]
    /local
        value item properties
    ][
        parse desc [
            some [
                [   ['divider | 'bar | '---] (                                        
                        item: build-divider menu
                        menu/list/pane: insert menu/list/pane item
                        insert tail menu/items reduce [none item]
                        properties: item/properties
                    )
                |   set value opt set-word! (
                        value: all [:value to word! value]
                    )
                    ['item (
                            item: build-item new-item menu value desc
                            menu/list/pane: insert menu/list/pane item
                            insert tail menu/items reduce [item/var item]
                            properties: item/properties
                        )
                    |   'slider (
                            item: build-slider new-slider menu value desc
                            menu/list/pane: insert menu/list/pane item
                            insert tail menu/items reduce [item/var item]
                            properties: item/properties
                        )
                    ]
                   
                    any [
                        set value string! (
                            item/body/text: value
                        )
                    |   set value tag! (
                            item/key/text: to string! value
                        )
                    |   ['action set value block! | set value block!] (
                            properties/item.action: value
                        )
                    |   ['icon | 'icons] set value [image! | word! | file! | path! | block!] (
                            properties/item.icon.images: cast value [
                                word!   [get value]
                                file!   [load value]
                                image! [value]
                                path!   [do value]
                                block! [value]
                            ]
                            if not block? properties/item.icon.images [
                                properties/item.icon.images: compose [
                                    (properties/item.icon.images) (properties/item.icon.images)
                                    (properties/item.icon.images) (properties/item.icon.images)
                                ]
                            ]
                            properties/item.icon.images: reduce properties/item.icon.images
                            item/icon/image: properties/item.icon.images
                        )
                    |   ['image | 'images] set value [image! | file! | word! | path! | block!] (
                            properties/item.body.images: cast value [
                                file!   [load value]
                                word!   [get value]
                                path!   [do value]
                                image! [value]
                                block! [value]
                            ]
                            if not block? properties/item.body.images [
                                properties/item.body.images: compose [
                                    (properties/item.body.images) (properties/item.body.images)
                                    (properties/item.body.images) (properties/item.body.images)
                                ]
                            ]
                            properties/item.body.images: reduce properties/item.body.images    
                            item/body/image: properties/item.body.images/1
                        )
                    |   'colors set value ['none | none! | block!]   (
                            if any [none? value 'none = value] [value: []]
                            properties/item.colors: reduce value
                        )
                    |   'effects set value ['none | none! | block!] (
                            if any [none? value 'none = value] [value: []]
                            properties/item.effects: compose [(value)]
                        )
                    |   'font set value [block!] (
                            item/body/font: properties/item.body.font: make properties/item.body.font value
                            item/key/font:   properties/item.key.font:   make properties/item.key.font   value
                        )
                    |   'para set value [block!] (
                            item/body/para: properties/item.body.para: make properties/item.body.para value
                            item/key/para:   properties/item.key.para:   make properties/item.key.para   value
                        )
                    |   'body [
                            'font set value [block!] (
                                item/body/font: properties/item.body.font: make properties/item.body.font value
                            )
                        |   'para set value [block!] (
                                item/body/para: properties/item.body.para: make properties/item.body.para value
                            )
                        ]
                    |   'key [
                            'font set value [block!] (
                                item/key/font:   properties/item.key.font: make properties/item.key.font value
                            )
                        |   'para set value [block!] (
                                item/key/para:   properties/item.key.para: make properties/item.key.para value
                            )
                        ]
                    |   'edge set value ['none | none! | block!] (
                            if any [none? value 'none = value] [value: [size: 0x0]]
                            item/edge: properties/item.edge: make properties/item.edge value                      
                        )
                    |   set value ['radio | 'check] (
                            append item/class 'mutual-item
                            append item/mark/class value
                            item/mark/state: off
                        )
                        any [
                            'of [opt 'group] set value [lit-word!] (
                                item/mark/group: value
                            )
                        |   set value [
                                'on   | 'true   | 'yes | true |
                                'off | 'false | 'no   | false
                            ](
                                item/mark/state: do value
                            )
                        ]
                    |   'menu copy value block! (
                            item/data: first value                               ;-- Remember a sub-menu's description
                            item/sub: layout-menu/parent item/data item         ;-- And set up the sub-menu's faces
                        )
                    |   'effects set value ['none | none! | block!] (
                            if any [none? value 'none = value] [value: []]
                            properties/item.effects: compose [(value)]
                        )
                    |   set value ['disable | 'enable] (
                            item/state: value = 'disable
                        )            
                    ]
                ]
            ]
        ]
        menu
    ]
   
    ;=========================================================== adjust-items ==             ;-- This is more of a MENU function!
    ;
    ;   ADJUST-ITEMS' job is to establish consistent item sizes within one
    ;   menu. It makes all items the same width (which may be a fixed width
    ;   or the width of the widest item). It further aligns the details of
    ;   one item to be in column with the corresponding details of other items.
    ;
   
    adjust-items: func [
        "Adjust the menu-items widths and returns total size consumed by items."
        items [block!]
    /local
        item       mark       icon       body       key       arrow    
        item-size mark-size icon-size body-size key-size arrow-size size
    ][
        ;-- Measure the items to find the maximums
        ;
        ;   Two pass: First loop adjusts the height of items while collecting
        ;   information about their widths.
        ;   The second loop applies the maximas to align the detail faces.
        ;
        item-size: mark-size: icon-size: body-size: key-size: arrow-size: 0x0
        foreach item items [
            set [mark icon body key arrow] reduce bind [mark icon body key arrow] in item 'self  
            item-size/y: 0
            edge-size: edge-size? item
           
            if instance-of item 'menu-item [
                mark-size: 16x16
                icon-size: max   icon-size   icon/size: image-size? item/properties/item.icon.images/1                             ;-- Images need to be same size! I'm checking against icon image 1 only!
    ;             body-size: max   body-size   body/size: max 6x4 + text-size? body image-size? item/properties/item.body.images/1   ;-- Images need to be same size! I'm checking against body image 1 only!
   
                body-size: max   body-size   body/size:
                    max
                        either body/text [6x4 + text-size? body] [0x0]
                        either item/properties/item.body.images/1 [image-size? item/properties/item.body.images/1                       ;-- Images need to be same size! I'm checking against body image 1 only! ][0x0 ]
               
                key-size: max   key-size   key/size: either key/text [6x4 + text-size? key] [0x0]  
                arrow-size: 16x16
               
                item/size/y: body/size/y:
                key/size/y: first maximum-of reduce [icon/size/y body/size/y key/size/y ]
                mark/size/y: arrow/size/y: 16
                item-size: first maximum-of reduce [icon-size body-size key-size]
               
                mark/offset/y: max item/size/y -   mark/size/y / 2 0
                arrow/offset/y: max item/size/y - arrow/size/y / 2 0
                icon/offset/y: max item/size/y -   icon/size/y / 2 0
            ]
           
            if instance-of item 'menu-divider []                                                 ;-- For now, dividers are somewhat static, so currently this is a no-op.  
           
            if instance-of item 'slider-item [
                body/size: item/slider/size
                item-size: first maximum-of reduce [icon-size body-size key-size]
                body-size: max body-size 6x4 + item/slider/size
            ]
           
            item/size/y: item/size/y + second edge-size? item  
        ]
       
        ;-- Apply those maximums to the smaller ones
        ;
        item-offset: 0x0
        item-size/x: mark-size/x + icon-size/x + body-size/x + key-size/x + arrow-size/x + 2
        foreach item items [
            set [mark icon body key arrow] reduce bind [mark icon body key arrow] in item 'self  
            item/offset/y: item-offset/y
            item/size/x: item-size/x + first edge-size? item
           
            if instance-of item 'menu-item [
                mark/size/x: 16
                icon/size/x: icon-size/x
                body/size/x: body-size/x
                key/size/x:   key-size/x  
              arrow/size/x: 16
                         
                mark/offset/x: 0
                icon/offset/x:   mark/offset/x + mark/size/x
                body/offset/x:   icon/offset/x + icon/size/x
                key/offset/x:   body/offset/x + body/size/x
              arrow/offset/x:   key/offset/x +   key/size/x
               
                item/size/y: item/size/y + second edge-size? item  
            ]
            if instance-of item 'menu-divider [
                item/size/x: item-size/x
                item/size/y: 5                                               ;-- This will change with dividers become arrow configurable
            ]
            if instance-of item 'slider-item [
                item/slider/offset/x: item/body/offset/x + 3
                item/slider/offset/y: item/body/size/y - item/slider/size/y / 2
            ]
            item-offset/y: item/offset/y + item/size/y
        ]
        item-size  
    ]
   
    ;############################################################ SLIDER-ITEM ##
    ;
   
    new-slider: func ["Returns an uninitialized slider item." /local slider] [
        make new-item [
            class: append class 'slider-item
            pane:   append pane slider: use [sld] [layout/tight [sld: slider 120x18] sld]
        ]
    ]
   
    build-slider: func [
        "Builds a slider item."
        slider [object!]     "a new slider"
        menu   [object!]     "the menu the slider resides in"
        word   [word! none!] "the slider's identifier"
        desc   [block!]       "the slider's description"
    /local
        sld
    ][build-item slider menu word desc ]
   
    ;################################################################### MENU ##
    ;

    ;============================================================== draw-knob ==
    ;    
    draw-knob: func [menu dir /local knob color y] [
        knob: select reduce ['less menu/less 'more menu/more] dir
        color: menu/properties/item.key.font/colors/1
        y: pick [[5 8] [8 5]] dir = 'less
        knob/effect: compose/deep [
            draw [
                pen (color) fill-pen (color)
                polygon
                    (as-pair knob/size/x / 2     y/1)
                    (as-pair knob/size/x / 2 - 3 y/2)
                    (as-pair knob/size/x / 2 + 3 y/2)
                    (as-pair knob/size/x / 2     y/1)
            ]
        ]
    ]
   
    ;============================================================== knob-feel ==
    ;
    knob-feel: make face/feel [
        over: func [knob over? offset] [
            knob/rate: all [over? knob/parent-face/parent-face/properties/menu.rate]
            show knob                                                                                 ;************ Is this necessary? ***************
        ]
        engage: func [knob action event /local menu] [
            if event/type = 'time [
                menu: knob/parent-face/parent-face
                menu/feel/scroll menu knob
            ]
        ]
    ]
   
   
    ;============================================================ menu-access ==
    ;
   
    menu-access: make system/view/vid/vid-face/access [
   
        get-face: set-face: clear-face: reset-face: none                         ;-- I'd rather use these, but haven't the slightest idea of what
                                                                                ;   e.g. get-face menu should be used for. I therefore come with my own methods ...
                                                                               
        exec: func [                                                    
            "Sets or get item values (i.e. executes code in item's context)."  
            menu [object!]               "The menu to act on"
            path [path! word! integer!] "Path to an item anywhere down in the tree"  
            code [word! path! block!]   "Code executed in item's context"
        /local
            item
        ][
            if not block? code [code: reduce [code]]
            if       word? path [path: to path! path]
            if   integer? path [path: to path! path]
           
            item: first path: copy path
            item: either not error? try [to integer! item] [pick menu/list/pane to integer! item ][select menu/items to word! item ]
            either empty? head system/words/remove path [do bind :code in item 'self ][item/sub/access/exec item/sub path code ]
        ]
   
        insert: func [
            "Attaches an item into an existing menu."
            root   [object!]                     "The menu root"
            path   [path! word! integer! none!] "Path to an item to add to it's sub-menu"  
            entity [object!]                     "Menu or menu item already layouted"
        /head   "Add item at the head of the menu."
        /before "Inserts item before the specified successor." succ [word! object!]
        /after   "Inserts item after the specified predecessor" pred [word! object!]
        /tail   "Inserts item at the tail of the menu (default)."
        /as
            var   [word! none!] "Word by which to refer to the item."  
        /local
            new menu items virtual
        ][
            menu: either path [root/access/exec root path [self/sub]] [root]
           
            menu/list/pane: case [
                head   [                   menu/list/pane     ]
                before [find menu/list/pane succ: either object? succ [succ] [select menu/items succ]]
                after   [next find menu/list/pane pred: either object? pred [pred] [select menu/items pred]]
            /default
                      [system/words/tail menu/list/pane     ]
            ]
            menu/items: case [
                head   [                   menu/items     ]
                before [back find menu/items succ]    
                after   [next find menu/items pred]
            /default
                      [system/words/tail menu/items     ]
            ]
           
            case [
                object! = type? entity [
                    case [
                        any [
                            instance-of entity 'menu-item
                            instance-of entity 'menu-divider
                        ][
                            var: any [:var get in entity 'var]
                            system/words/insert menu/list/pane entity
                            system/words/insert menu/items reduce [var entity]
                            entity/menu: menu
                        ]
                        instance-of entity 'menu [
                            virtual: entity
                            entity: virtual/access/remove virtual 1
                           
                            var: any [:var get in entity 'var]
                            system/words/insert menu/list/pane entity
                            system/words/insert menu/items reduce [var entity]
                            entity/menu: menu
                        ]
                    ]
                ]
                block! = type? entity ["N/A" ]
            ]
           
            menu/list/pane: system/words/head menu/list/pane
            menu/items:     system/words/head menu/items
           
            adjust-menu menu
        ]
       
        remove: func [
            "Detaches an item from the menu and returns it."
            root [object!]               "The menu to remove from"
            path [path! word! integer!] "Path to an item anywhere down in the tree"  
        /local
            item
        ][
           
            item: root/access/exec root path [self]
            system/words/remove           find item/menu/list/pane item
            system/words/remove/part back find item/menu/items     item 2
            item/menu: none
            item
        ]
        set 'get-menu func [
            "Returns a value of menu item."
            root [object!]               "The menu to act on"
            path [path! word! integer!] "Path to an item anywhere down in the tree"  
            word [word! path! block!]   "Word in item"            
        ][root/access/exec root path word ]
       
        set 'set-menu func [
            "Returns a value of menu item."
            root [object!]               "The menu to act on"
            path [path! word! integer!] "Path to an item anywhere down in the tree"  
            code [block!]               "Word: Value"            
        ][root/access/exec root path code ]
       
        set 'remove-menu func [
            "Detaches an item from the menu and returns it."
            root [object!]               "The menu to remove from"
            path [path! word! integer!] "Path to an item anywhere down in the tree"  
        ][root/access/remove root path ]
           
        set 'insert-menu func [
            [catch]
            "Attaches an item into an existing menu."
            root [object!]                     "The menu root"
            path [path! word! integer! none!] "Path to an item to add to it's sub-menu"  
            item [object!]                     "Menu item already layouted"
        /head   "Add item at the head of the menu."
        /before "Inserts item before the specified successor." succ [word! object!]
        /after   "Inserts item after the specified predecessor" pred [word! object!]
        /tail   "Inserts item at the tail of the menu (default)."
        /as
            var   [word! none!] "Word by which to refer to the item."
        ][
            var: any [:var get in item 'var]
            case [
                head     [root/access/insert/head/as   root path item var]
                before   [root/access/insert/before/as root path item var]
                after   [root/access/insert/after/as   root path item var]
              /default [root/access/insert/as         root path item var]
            ]
        ]
       
    ]
   
    ;========================================================= menubar-access ==
    ;
   
    menubar-access: make menu-access [
        super: menu-access
        remove: func [                                                           ;-- This change in the methods signature is to reflect the fact, that
            "Detaches an item (sub-item only) from the menu and returns it."     ;   adding menubar-items currently isn't possible
            menubar [object!] "The menubar to remove from"
            path     [path!]
        ][menubar/access/super/remove menubar path ]
       
        insert: func [
            "Attaches an item into an existing menu."
            root [object!]                     "The menu root"
            path [path! word! integer! none!] "Path to an item to add to it's sub-menu"  
            item [object!]                     "Menu item already layouted"
        /head   "Add item at the head of the menu."
        /before "Inserts item before the specified successor." succ [word! object!]
        /after   "Inserts item after the specified predecessor" pred [word! object!]
        /tail   "Inserts item at the tail of the menu (default)."
        /as
            var   [word! none!] "Word by which to refer to the item."  
        /local
            new menu items virtual
        ][
            if none? path [
                throw make error! "Inserting top-level items to menubars isn't implemented yet!"
            ]
               
            var: any [:var get in item 'var]
            case [
                head     [root/access/super/insert/head/as   root path item var]
                before   [root/access/super/insert/before/as root path item var]
                after   [root/access/super/insert/after/as   root path item var]
              /default [root/access/super/insert/as         root path item var]
            ]
        ]
    ]
   
   
    ;============================================================== menu-feel ==
    ;
    ;   The MENU-FEEL is the central method object for all menu related
    ;   functions.
    ;
    ;   There are, for convience, some shorthands to them build directly into
    ;   menu objects. But users who use them should be aware of losing the
    ;   benefits of additional behaviour that comes with derived / overloaded
    ;   methods.
    ;
   
    menu-feel: make system/view/popface-feel-win-away [
       
        super: none
        redraw: func [
            "Draws a menu."
            menu [object!] offset [pair!]
        ][
            menu/panel/color:   menu/properties/menu.color
            menu/panel/effect:   menu/properties/menu.effect
            menu/panel/edge:     menu/properties/menu.edge
        ]
       
       
        inside-menu?: func [menu event] [within? event/offset win-offset? menu menu/size ]
       
        inside-menu-tree?: func [menu event] [
            any [
                menu/feel/inside-menu? menu event
                all [
                    menu/parent
                    menu/feel/inside-menu-tree? menu/parent/menu event
                ]
            ]
        ]
       
        pop-detect: func [menu event] [
            case [
                menu/feel/inside-menu-tree? menu event [
                    if find [down up move time key alt-down alt-up scroll-line] event/type [event ]
                ]
                true [
                    either not find [up move time scroll-line key] event/type [
                        menu: menu/feel/root-of menu
                        menu/feel/close menu
                    ][event ]
                ]
            ]
        ]
        close: func [;-- CLOSE actually impements a custom HIDE-POPUP, if you like, call it a hack.
            "Closes a menu (and all of it's items' sub-menus)."                 ;   I simply couldn't cope with that one.
            menu [object!]
        /local                                                                   ;-- NO-SHOW hinders multiple window refreshing closing nested menus.
            /no-show                                                             ;   Hidden, callers shouldn't have to care about that.                                                                    
        ][
            if all [menu/actor menu/actor/sub] [
                menu/actor/sub/feel/close/no-show menu/actor/sub                 ;-- MENU/ACTOR/SUB may have a different FEEL
                                                                                ;   (even though, for now, none are implemented).
            ]
            if find system/view/pop-list menu [
                unfocus menu                                                                                                     ;  
                remove find menu/parent-face/pane menu                           ;-- Most likely to be a window, but I hope it can also be another non-menu popup :-)    
                remove find system/view/pop-list menu
                menu/actor: none
                unless no-show [show menu/parent-face]
            ]
            if menu/parent [focus/no-show menu/parent/menu]
        ]
       
        visit: func [;-- Visiting items may require revealing these items, which definitly is
            "Visits menu item, making it the new actor."                         ;   a job under responsibility of menus.
            menu [object!] item [object!]                                       ;   Hence visiting items is implemented here instead on item level only.
        ][
            if menu/actor <> item [
                menu/feel/leave menu                                                    
                menu/feel/reveal menu item
                menu/actor: item
                item/feel/visit item
            ]
        ]
       
        leave: func ["Leaves menu actor, if any." menu [object!] /local item] [;-- Leaving an item should never be called explicitly, since it's done
            if item: menu/actor [                                               ;   implicitly by visiting another
                menu/actor: none
                item/feel/leave item                                             ;-- Only if there was an actor, there is a item to leave (and to redraw).
            ]
        ]
       
        root-of: func ["Returns menu's root menu." menu] [
            forever [
                if none? menu/parent [break/return menu]
                menu: menu/parent/menu
            ]
           
        ]
       
        first-of: func ["Returns first item." menu [object!]] [
            foreach item menu/list/pane [
                if instance-of item 'menu-item [break/return item]
            ]
        ]
        prev-page-of: func ["Returns previous item." menu [object!] /local extra other] [
           
            extra: any [menu/actor menu/feel/last-of menu]                          
           
            foreach item next find reverse copy menu/list/pane extra [;-- This results in other being the last visble item or
                if instance-of item 'menu-item [                                     ;   none, if extra itself is the last visible one.
                    if     menu/feel/visible? menu item [other: item]
                    if not menu/feel/visible? menu item [break/return other]
                ]
            ]
           
            either other [other                                                           ;-- Returns first item on page ][
                menu/actor: extra
                while [
                    all [
                        menu/actor <> menu/feel/first-of menu
                        menu/feel/visible? menu extra
                    ]
                ][menu/feel/visit   menu menu/feel/prev-of menu ]
                menu/actor
            ]                                            
        ]
       
        next-page-of: func ["Returns next item." menu [object!] /local extra other] [
           
            extra: any [menu/actor menu/feel/first-of menu]
           
            foreach item next find menu/list/pane extra [;-- This results in other being the last visble item or
                if instance-of item 'menu-item [                                     ;   none, if extra itself is the last visible one.
                    if     menu/feel/visible? menu item [other: item]
                    if not menu/feel/visible? menu item [break/return other]
                ]
            ]
           
            either other [other                                                           ;-- Returns last item on page ][
                menu/actor: extra
                while [
                    all [
                        menu/actor <> menu/feel/last-of menu
                        menu/feel/visible? menu extra
                    ]
                ][menu/feel/visit   menu menu/feel/next-of menu ]
                menu/actor
            ]
        ]
       
        prev-of: func ["Returns previous item." menu [object!] /wrap "Wrap at menu's top."] [
            either none? menu/actor [
                menu/feel/last-of menu
            ][
                any [
                    foreach item next find reverse copy menu/list/pane menu/actor [
                        if instance-of item 'menu-item [break/return item]
                    ]
                    either wrap [menu/feel/last-of menu] [menu/feel/first-of menu]
                ]
            ]
        ]
       
        next-of: func ["Returns next item." menu [object!] /wrap "Wrap at menu's top."] [
            either none? menu/actor [
                menu/feel/first-of menu
            ][
                any [
                    foreach item next find menu/list/pane menu/actor [
                        if instance-of item 'menu-item [break/return item]
                    ]
                    either wrap [menu/feel/first-of menu] [menu/feel/last-of menu]
                ]
            ]
        ]
        next-char-of: func [
            "Returns next item starting with char (or NONE)."
            menu [object!] char [char!] /local items
        ][
            items: either menu/actor [
                items: next find menu/list/pane menu/actor
                append copy items copy/part menu/list/pane items
            ][menu/list/pane ]
            foreach item items [
                if all [
                    instance-of item 'menu-item
                    item/body/text
                    equal? uppercase char uppercase item/body/text/1
                ][break/return item ]
            ]
        ]
       
        last-of: func ["Returns menu's last item." menu [object!]] [
            foreach item reverse copy menu/list/pane [
                if instance-of item 'menu-item [break/return item]
            ]
        ]
        visible?: func ["Returns TRUE if is fully visible." menu [object!] item [object!]] [
            not any [
                menu/list/offset/y + item/offset/y < 0                                   ;-- Item is (partially) above the clipping region
                menu/list/offset/y + item/offset/y + item/size/y > menu/clip/size/y     ;-- Item is (partially) below the clipping region
            ]
        ]
        show-less?: func [menu [object!]] [menu/list/offset/y < 0]
        show-more?: func [menu [object!]] [menu/list/offset/y + menu/list/size/y > menu/panel/size/y]
        hide-less?: func [menu [object!]] [menu/list/offset/y >= - menu/less/size/y]
        hide-more?: func [menu [object!]] [menu/list/offset/y + menu/list/size/y <= (menu/clip/size/y + menu/more/size/y)]
        show-less: func   [menu [object!]] [
            if not menu/less/show? [
                menu/clip/offset/y: menu/clip/offset/y + menu/less/size/y
                menu/clip/size/y:   menu/clip/size/y   - menu/less/size/y
                menu/list/offset/y: menu/list/offset/y - menu/less/size/y
                show menu/less
            ]
        ]
        show-more: func [menu [object!]] [
            if not menu/more/show? [
                menu/clip/size/y: menu/clip/size/y - menu/more/size/y
                show menu/more
            ]
        ]
        hide-less: func [menu [object!]] [
            if menu/less/show? [
                menu/clip/offset/y: menu/clip/offset/y - menu/less/size/y       ;-- Move clip to top and
                menu/clip/size/y:   menu/clip/size/y   + menu/less/size/y       ;   grow it.
                menu/less/rate: none
                hide menu/less
            ]
        ]
        hide-more: func [menu [object!]] [
            if menu/more/show? [
                menu/clip/size/y: menu/clip/size/y + menu/more/size/y           ;-- Grow clip.
                menu/list/offset/y: menu/list/offset/y + menu/more/size/y
                menu/more/rate: none
                hide menu/more
            ]
        ]
       
        scroll: func [menu [object!] knob [object!]] [
            case [
                menu/less = knob [
                    menu/list/offset/y: menu/list/offset/y + menu/steps
                    menu/feel/show-more menu
                    if menu/feel/hide-less? menu [menu/feel/hide-less menu]
                ]
                menu/more = knob [
                    menu/list/offset/y: menu/list/offset/y - menu/steps
                    menu/feel/show-less menu
                    if menu/feel/hide-more? menu [menu/feel/hide-more menu]
                ]
            ]                        
            show menu/panel
        ]
   
        reveal: func [
            "Reveals the item (by scrolling the smallest amount necessary)."
            menu [object!] item [object!]
        /no-show
            "Don't show the changes."
        /local
            delta clip list
        ][
            delta: 0x0 clip: menu/clip list: menu/list
           
            if any [
                if 0 > delta/y:   list/offset/y
                                + item/offset/y [                               ;-- Item is (maybe only partially) above the clipping region
                    menu/feel/show-more menu
                    list/offset/y: list/offset/y - delta/y
                    if menu/feel/hide-less? menu [menu/feel/hide-less menu]
                    true
                ]
                if 0 < delta/y:   list/offset/y
                                + item/offset/y
                                + item/size/y
                                - clip/size/y [;-- Item is (maybe onle partially) below the clipping region  
                    menu/feel/show-less menu
                    list/offset/y: list/offset/y - delta/y
                    if menu/feel/hide-more? menu [menu/feel/hide-more menu]
                    true
                ]
            ][
                if not no-show [show menu/panel]
            ]
        ]              
       
        map-key: func [
            "Returns mapped EVENT/KEY."
            menu [object!] event [event!] /local key
        ][
            key: event/key
            if event/control [
                key: any [select [up page-up home home down page-down end end] key key]   ;-- Control key increases key effect.
            ]
            key
        ]
           
        engage: func [menu action event /local actor item key] [
            if event/type = 'key [
                actor: menu/actor  
                key:   menu/feel/map-key menu event
               
                case [
                    'right = key [
                        if all [actor actor/sub] [
                            actor/feel/enter/new actor
                            item: actor/sub/feel/first-of actor/sub
                            item/menu/feel/visit item/menu item
                            wait []
                        ]
                    ]
                    #" "       = key   or
                  (#"^M"       = key) [
                        if actor [
                            either actor/sub [
                                actor/feel/enter actor
                            ][actor/feel/engage actor 'up event ]
                        ]
                    ]
                    escape     = key   or
                  ('left       = key) or
                  ('backspace = key) [menu/feel/close menu]
                    'home       = key   [menu/feel/visit menu menu/feel/first-of     menu]
                    'page-up   = key   [menu/feel/visit menu menu/feel/prev-page-of menu]
                    'up         = key   [menu/feel/visit menu menu/feel/prev-of/wrap menu]
                    'down       = key   [menu/feel/visit menu menu/feel/next-of/wrap menu]
                    'page-down = key   [menu/feel/visit menu menu/feel/next-page-of menu]
                    'end       = key   [menu/feel/visit menu menu/feel/last-of       menu]
                    /default [
                        use [item] [if item: menu/feel/next-char-of menu key [menu/feel/visit menu item]]
                    ]
                ]
            ]
        ]
    ]
   
   
    ;=========================================================== menubar-feel ==
    ;
    ;   The MENUBAR-FEEL remaps cursor keys a bit to adjust them to the needs
    ;   of horizontally layouted menubar-items.
    ;
   
    menubar-feel: make menu-feel [
        super: menu-feel
        detect: func [menubar event][menubar/feel/super/pop-detect menubar event ]
        redraw: none
        close: func [menubar] [
            if menubar/actor [
                if menubar/actor/sub [
                    menubar/actor/sub/feel/close menubar/actor/sub
                ]
                menubar/feel/leave menubar
                menubar/state: 'click-to-enter
                unfocus
            ]
        ]
        reveal: none
        next-page-of: :last-of
        prev-page-of: :first-of
        map-key: func [;** Overwriting feel/super/map-key, menubars behave different than menus. Hack?
            "Returns mapped EVENT/KEY."
            menu [object!] event [event!] /local key
        ][
            key: any [
                select [left up up right down right] event/key
                event/key
            ]
            if event/control [
                key: any [select [up page-up home home down page-down end end] key key]   ;-- Control key increases key effect.
            ]
            key
        ]
        pop-detect: none
        over: none
        reveal: none
    ]
    ;=============================================================== new-menu ==
    ;
    new-menu: func ["Returns an uninitilized menu."] [
        make system/view/vid/vid-face [
            class: make block! [menu]
            flags: [field]
            feel:   menu-feel
            access: menu-access
           
            color: edge: data: groups: properties: parent: actor: none
           
            steps: 4                                                             ;-- Dialect this!
                                                             
            items: make block! []                                               ;-- ITEMS holds the menu's items, the block consits
                                                                                ;   of ID / ITEM pairs for easy selection of items. Get rid of that!
           
            shadow: panel: less: clip: list: more: none                         ;-- Accessors for the various sub-faces of a menu.
                                                                                ;   The actual items are to be found in LIST's pane,
            pane: reduce [;   but clients should use ITEMS.  
                shadow: make face   [
                    color: edge: none
                    image: shadow-image
                    effect: [extend alphamul 32]
                ]
                panel: make face   [
                    color: none
                    edge: none
                    effect: none
                    pane: reduce [
                        less: make face [color: edge: none feel: knob-feel]
                        clip: make face [
                            color: edge: none
                            pane: reduce [
                                list: make face [color: edge: none pane: make block! []]
                            ]
                        ]
                        more: make face [color: edge: none feel: knob-feel]
    ]   ]   ]   ]   ]
   
    ;============================================================= build-menu ==
    ;
    build-menu: func [
        "Builds a menu and it's sub-faces."
        item [object! none!] "the menu's parent item or NONE"
        desc [block!]         "the menu description"
    /local
        menu parent
    ][
        menu:         new-menu
        menu/parent: item
        menu/data:   desc
       
        menu/properties: either parent: all [menu/parent menu/parent/menu/properties] [
            context [
                menu.image:         parent/menu.image    
                menu.effect:       parent/menu.effect  
                menu.spacing:       parent/menu.spacing  
                menu.edge:         parent/menu.edge    
                menu.rate:         parent/menu.rate    
                menu.color:         parent/menu.color        
                item.action:       parent/item.action  
                item.effects:       parent/item.effects  
                item.colors:       parent/item.colors  
                item.icon.images:   none                                         ;-- no inheritence
                item.icon.effects: none                                         ;
                item.body.images:   none                                         ;
                item.body.font:     parent/item.body.font
                item.key.font:     parent/item.key.font
                item.body.para:     parent/item.body.para
                item.key.para:     parent/item.key.para
                item.edge:         parent/item.edge    
            ]
        ][
            context [
                menu.image:         none
                menu.effect:       [gradient 1x1 white silver]
                menu.spacing:       2x2
                menu.edge:         make system/standard/face/edge [size: 2x2 color: silver effect: 'bevel]
                menu.rate:         64
                menu.color:         white
                item.action:       none
                item.effects:       reduce [none [gradient 1x1 white 255.64.64] none [gradient 1x1 white silver]]
                item.colors:       reduce [none silver none none]
                item.icon.images:   none
                item.icon.effects: none                              
                item.body.images:   none
                item.body.font:     make system/standard/face/font [offset: 2x0 align: 'left valign: 'center colors: reduce [black black gray gray] shadow: none]
                item.key.font:     make system/standard/face/font [offset: 2x0 align: 'left valign: 'center colors: reduce [black black gray gray] shadow: none]
                item.body.para:     make system/standard/face/para [origin: 5x2 margin: indent: 0x0 wrap?: no]
                item.key.para:     make system/standard/face/para [origin: 5x2 margin: indent: 0x0 wrap?: no]
                item.edge:         make system/standard/face/edge [size:   2x2 colors: reduce [none 255.192.192 none none] effects: reduce [none 'ibevel none 'ibevel]]
            ]
        ]
       
        menu
    ]
   
    ;============================================================ layout-menu ==
    ;
    set 'layout-menu func [
        "Returns a menu (face) built from style/content description dialect."
        desc [block!] "Dialect block of styles, attributes, and layouts"
    /parent
        "Bind menu to an item as it's sub-menu."
        item [object!] "A menu-item face"
    /style
        "Base menu on existing style sheet."
        sheet [block!] "A style sheet of menu and item styles."
    /local
        menu value properties        
        mark-size icon-size body-size key-size arrow-size
        item-offset item-size                          
    ][
        menu: build-menu item desc      
        properties: menu/properties
       
        if style [insert desc sheet]                               ;-- Include the stylesheet applied and then
                                                                          ;   go and look for style refinements      
       
        menu/panel/edge: menu/properties/menu.edge
        menu/panel/color: menu/properties/menu.color
        menu/panel/image: menu/properties/menu.image
       
        parse desc [
            any [
                'menu 'style some [
                    'color set value [word! | tuple!] (
                        properties/menu.color: cast value [
                            word!   [get value]
                            tuple! [value]
                        ]
                    )
                |   'spacing set value [integer! | pair!] (
                        properties/menu.spacing: to pair! value
                    )
                |   'edge set value ['none | none! | block!] (
                        if any [none? value 'none = value] [value: [size: 0x0]]
                        properties/menu.edge: make properties/menu.edge value
                    )
                |   ['backdrop | 'image] set value [word! | file! | image!] (
                        properties/menu.image: cast value [
                            word!   [get value]
                            file!   [load value]
                            image! [value]          
                        ]
                    )
                |   'effect set value ['none | none! | word! | lit-word! | block!] (
                        if any [none? value 'none = value] [value: none]
                        properties/menu.effect: all [value compose [(value)]]
                    )
                ]
            |   'item 'style some [
                    'colors set value ['none | none! | block!] (
                        if any [none? value 'none = value] [value: []]
                        properties/item.colors: reduce value
                    )
                |   'effects set value ['none | none! | block!] (
                        if any [none? value 'none = value] [value: []]
                        properties/item.effects: compose [(value)]
                    )
                |   'font set value [block!] (
                        properties/item.body.font: make properties/item.body.font value
                        properties/item.key.font:   make properties/item.key.font   value
                    )
                |   'para set value [block!] (
                        properties/item.body.para: make properties/item.body.para value
                        properties/item.key.para:   make properties/item.key.para   value
                    )
                |   'body [
                        'font set value [block!] (
                            properties/item.body.font: make properties/item.body.font value
                        )
                    |   'para set value [block!] (
                            properties/item.body.para: make properties/item.body.para value
                        )
                    ]
                |   'key [
                        'font set value [block!] (
                            properties/item.key.font: make properties/item.key.font value
                        )
                    |   'para set value [block!] (
                            properties/item.key.para: make properties/item.key.para value
                        )
                    ]
                |   'edge set value ['none | none! | block!] (
                        if any [none? value 'none = value] [value: [size: 0x0]]
                        properties/item.edge: make properties/item.edge value                      
                    )
                |   'action set value block! (
                        properties/item.action: value
                    )
                ]
            ]
            desc:
            to end
        ]
       
        layout-items menu desc
        menu/list/pane: head menu/list/pane
       
        menu
    ]        
   
   
    ;============================================================ adjust-menu ==
    ;
    ;   ADJUST-MENU calculates all values (offsets and such) that are subject
    ;   to change between to shows of the menu.
    ;
    ;   COMMENT: Currently, the responsibilities of ADJUST-MENU and SHOW-MENU aren't defined very clear,
    ;     here's room for improvements.
    ;
   
    adjust-menu: func ["Adjusts the menus size and returns its size." menu [object!]] [
        menu/panel/edge:   menu/properties/menu.edge
        menu/panel/image: menu/properties/menu.image
       
        adjust-items menu/list/pane
    ]
   
   
    ;############################################# PUBLIC INTERFACE FUNCTIONS ##
    ;
   
    ;============================================================== show-menu ==
    ;
    ;   The SHOW-MENU actually does all the work of showing a previously set up
    ;   menu. Client scripts that only use MENUBAR and/or DROP-MENU don't
    ;   need to call this, they just LAYOUT-MENU their menus and feed those
    ;   VID-Styles with them.
    ;
   
    set 'show-menu func [
        "Shows a menu."
        window [object!]
        menu [object!]
    /offset                                                                     ;-- This is of use only for top-level menus, positions of further nested
        "Prescribes where to open the menu."                                     ;   menu are calculated automatically depending of WIN-OFFSET of the parent item
        at [pair!]                                                               ;   they're bound to.
    /size
        "Restrict menu's size"
        max-size [pair!]
    /new
        "Opens a new window and returns immediately."                           ;-- Works like in VIEW.
    /local  
        value
        item divider item-offset menu-size shadow-size  
    ][
        shadow-size: 4x4                                                         ;-- For now, prescribe that shadows have to be 4x4 pixels wide!
          max-size: any [max-size window/size]  
          menu-size: adjust-menu menu
       
        menu/less/size: menu/more/size: 1x0 * menu-size/x + 0x12                 ;-- Preparation of the less- and more-knobs, we'll may need them.
        draw-knob menu 'less                                                     ;
        draw-knob menu 'more                                                     ;   This is somewhat strange, but may it be.
       
        menu/list/offset: 0x0                                                   ;-- Let's see how big the menu want's to be get.
        menu/list/size:   second span? menu/list/pane                           ;
        menu/clip/size/x: menu/list/size/x
        menu/panel/offset: menu/shadow/offset: 0x0
        menu/less/offset: menu/clip/offset: menu/more/offset: menu/properties/menu.spacing
       
        either menu/list/size/y                                                 ;-- If it's bigger than it's allowed to get,
            + (second edge-size? menu/panel)                                   ;   we need the more button            
            + (2 * menu/properties/menu.spacing/y)
            + shadow-size/y
            > max-size/y [
            menu/less/show?: not menu/more/show?: yes
            menu/clip/size/y:     max-size/y                                     ;-- of course this is only correct for offset/y = 0 and max-size/y = window/size/y
                              - (second edge-size? menu/panel)
                              - (2 * menu/properties/menu.spacing/y)
                              - shadow-size/y
        ][
            menu/less/show?: menu/more/show?: no
            menu/clip/size/y: menu/list/size/y
        ]  
        menu/more/offset/y: menu/clip/offset/y + menu/clip/size/y
       
        menu/panel/size: (2 * menu/properties/menu.spacing) + menu/clip/size + edge-size? menu/panel
        if menu/less/show?   [menu/panel/size/y: menu/panel/size/y + menu/less/size/y]
        if menu/more/show? [menu/panel/size/y: menu/panel/size/y + menu/more/size/y]
       
        menu/shadow/size: menu/panel/size + shadow-size                          
       
        at: any [;-- Calculating offset: Where are we supposed to open?
            at                                                                   ;    
            if menu/parent [                                                     ;   If caller made no suggestion, we position the menu at the right edge
                at: win-offset? menu/parent                                     ;   vertically centered with the actor.
                at/x: at/x + menu/parent/size/x                                 ;
                if menu/parent/menu/edge [                                      
                    at/x: at/x + menu/parent/menu/edge/size/x
                ]
                if menu/panel/edge [at/y: at/y - menu/panel/edge/size/y ]
                at/y: at/y + (menu/parent/size/y - menu/list/pane/1/size/y / 2)
                at/y: max 0 at/y
                at
            ]
            0x0
        ]
        menu/size: menu/shadow/size
       
        if at/x + menu/size/x > window/size/x [;-- Right border check --
            either menu/parent [
                at/x: max 0 at/x - menu/panel/size/x - menu/parent/size/x
            ][at/x: max 0 window/size/x - menu/size/x ]
        ]
        if at/y + menu/size/y > window/size/y [;-- Bottom border check --
            at/y: max 0 window/size/y - menu/size/y
        ]
        if at/y + menu/size/y > window/size/y [;-- Size check, again --
            menu/size/y: menu/shadow/size/y: window/size/y
            menu/panel/size/y: menu/size/y - 4
            menu/clip/size/y: menu/panel/size/y - 4 - menu/more/size/y
            menu/more/show?: yes
            menu/more/offset/y: menu/clip/size/y
        ]
        menu/offset: at
       
        show-popup/window/away menu window                                       ;-- Finally, let's start the show
        focus/no-show menu
        unless new [wait []]
    ]
   
    ;############################################################# VID-Styles ##
    ;

    ;=============================================================== MENU-BAR ==
    ;
    ;   The VID-style MENU-BAR. Supports easy integration of menus into a
    ;   VID layout.
    ;
    ;   Regarding customization: MENU-BAR is, by it's nature, available for
    ;   styling through the usual VID dialect.
    ;
    ;   Whereas menubar-items currently are not!
    ;
    ;   But doing the menubar/properties/menubar.foo
    ;   and           menuitem/properties/menuitem.bar thing here, too,
    ;   should work just fine.
   
    stylize/master [
        menu-bar: face with [
            flags: [field]
            class: make block! [menu-bar]
            parent: none
            data: none
            state: 'click-to-enter
            sheet: none
            list:   self                                                         ;-- To make all the menu/list/pane paths from menubar/feel/super/... work.
            set: get: func [;-- Updating e.g. text of menubar-items is problematic, but it would be useful for e.g. disabling these                                          
                "Set or get item values (executes code in item's context)."  
                path [path! word!]   "Path to an item anywhere down in the tree"  
                code [block!] "Code executed in item's context"
            /local
                item
            ][
                item: select items first path: to path! :path
                either empty? next path [
                    do bind :code in item 'self
                    show item
                ][item/sub/set next path :code ]
            ]
            colors: reduce [none 178.180.191]
            font: make font [name: "Tahoma" size: 11 color: black offset: space: 0x0 shadow: none]
            color: none edge: none actor: none items: none
            words: [
                menu       [new/data:   first next args next args]
                menu-style [new/sheet: first next args next args]
            ]
            init: [
                pane:   copy []
                list:   self                                                     ;** To make all the menu/list/pane paths from menubar/feel/super/... work. Hack?
                items: copy []
                feel:   ctx-menus/menubar-feel
                access: ctx-menus/menubar-access
                if all [sheet data] [insert data sheet]
                use [value menu-bar specs item item-offset actor specs] [
                    menu-bar: self
                    parse data [
                   
                        copy specs to set-word! (specs: any [specs copy []])
                       
                        some [
                            set value set-word! 'item (
                                insert tail pane item: make new-item [
                                    item:   self
                                    class:   append class 'menu-item
                                    menu:   menu-bar
                                    var:     to word! value
                                    font:   menu-bar/font
                                    para:   make system/standard/face/para [
                                        origin: 5x4 margin: none wrap?: no
                                    ]
                                    feel:   ctx-menus/baritem-feel
                                ]
                                insert tail menu-bar/items reduce [item/var item]
                            )
                       
                            any [
                                set value string! (
                                    item/text: value
                                )
                            |   'menu set value block! (
                                    item/data: insert value specs
                                    item/sub: layout-menu value
                                    item/sub/parent: item                       ;-- Is this hack potentially dangerous?
                                )
                            ]
                           
                        ]
                    ]
                   
                    item-offset: 0x0
                    foreach item pane [
                        item/size: add text-size? item edge-size? item
                        if all [item/para item/para/origin] [item/size: item/size + (2 * item/para/origin) ]
                        item-offset: item/size + item/offset: 1x0 * item-offset
                    ]
                   
                ]
                size: add second span? pane edge-size? self
            ]
            multi: make multi [
                file: func [face blk] [
                    if pick blk 1 [
                        face/data: load first blk
                    ]
                ]
            ]
        ]
    ]
     
    ;============================================================== DROP-MENU ==
    ;
    ;   Much like menu-bars, but different in that the DROP-MENU actually is
    ;   nothing but a shorthand for binding a menu to a button, with the
    ;   one speciality that it auto-inserts the chosen items body-text
    ;   into the containing field.
    ;
    ;   The insertion is done in the item's action block, hence, DROP-MENU
    ;   is currently still experimental, as it would be difficult if possible
    ;   for clients to modify that behaviour.
    ;
   
    stylize/master [
        drop-menu: field with [
            style: none
            size: 100x21
            font: make face/font [offset: 2x6 colors: reduce [black black] name: "Tahoma" size: 11 align: 'left]
            edge: make face/edge [size: 1x1 effect: none color: 178.180.191]
            para: make face/para [wrap?: no margin: 22x5]
            feel: make feel [
                redraw: func [face act pos] bind [
                    if all [in face 'colors block? face/colors] [face/color: pick face/colors face <> focal-face ]
                    if all [in face/font 'colors block? face/colors] [face/font/color: pick face/font/colors face <> focal-face ]
                ] in system/view 'self
                engage: func [face act event] bind [
                    switch act [
                        down [
                            either equal? face focal-face [unlight-text] [focus/no-show face]
                            caret: offset-to-caret face event/offset
                            show face
                        ]
                        over [
                            if not-equal? caret offset-to-caret face event/offset [
                                if not highlight-start [highlight-start: caret]
                                highlight-end: caret: offset-to-caret face event/offset
                                show face
                            ]
                        ]
                        key [
                            either event/key = 'down [
                                face/pane/action
                            ][ctx-text/edit-text face event get in face 'action ]
                        ]
                    ]
                ] in system/view 'self
            ]
            menu: none
            words: [
                menu [new/data: first next args next args]
                menu-style [new/style: first next args next args]
            ]
            init: [
                if all [style data] [insert data style]
                use [anchor parent] [
                   
                    parent: anchor: self
                    if not string? text [text: either text [form text] [copy ""]]
                    colors: reduce [white yellow + 64.64.64]
                    pane: make-face/spec 'btn [
                        effect: [extend 14 draw [pen 0.0.0 fill-pen 0.0.0 polygon 5x7 11x7 8x10]]
                        size: 17x17
                        offset: 1x0 * parent/size - 20x-1
                        set in parent 'menu layout-menu parent/data
                        action: [
                            unfocus
                            show-menu/offset find-window parent parent/menu (win-offset? parent) + (0x1 * parent/size) - 1x2
                        ]
                    ]
                ]
            ]
        ]
       
    ]
]

Here is the code of a demo and screenshots:

REBOL [
    Title:   "Menu-System Demo"
    Name:     'Menu-System-Demo
    File:     %menu-system-demo.r    
    Version: 0.2.0.1     ;-- Auto download %menu-system.r
    Date:     12-Jun-2005    
    Author:   "Christian Ensel"
    Email:   christian.ensel@gmx.de    
    Owner:   "Christian Ensel"
    Rights:   "Copyright (c)2005 Christian Ensel"                                    
    Purpose: "Demostration of features of menu-system.r"
    Comments: "Needs %menu-system.r to run."        
    Library: [
        level:     'beginner
        platform: 'all
        type: [demo]
        code: 'module
        domain: [user-interface vid gui]
        tested-under: [view 1.3.0.3.1 on "WinXP"]
        support: none
        license: none ;-- Not bothered with licensing stuff yet, but most likely BSD
        see-also: none
    ]
]
unless request/confirm {The Menu System Demo requires %menu-system.r to be downloaded from REBOL.org^/Click YES to continue, NO to abort.} [quit ]
demo:   copy/part form system/script/header/version 5
script: load-thru/check http://www.rebol.org/library/scripts/menu-system.r to tuple! demo
do script
icon-1.img: load 64#{
iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAYAAABWzo5XAAAAAXNSR0IArs4c6QAA
AARnQU1BAACxjwv8YQUAAAAgY0hSTQAAeiYAAICEAAD6AAAAgOgAAHUwAADqYAAA
OpgAABdwnLpRPAAAABh0RVh0U29mdHdhcmUAUGFpbnQuTkVUIHYyLjFiT2tyLwAA
A1pJREFUOE99lN1P23UYxVsuKFEQQrEEmkJDt9HRhJcEFVIoqPECR6lmZkvMLmRN
fF1Ysk3UP4CZGIxyo8ZETbS6xF3MdbhdmL0oUtY1XdkLVpoVMGXCCq2stQrd2o+/
57eAbBJ/yUnO95zznH4vnm+1Wq1Ws9W3trZGPp/XCOQrKChQodPpth6Qos3IZrPc
nD2P/8zznP26ljOfalUIF008yTw4d19JJpMhdOF1zn5ZzMzlJ0klXlNudVSFcNHE
k4xkN5dtFKVWlvjpeBPB0xb+zhwht3qQO6kXySadKoSLJp5kJCsz62UbRb7RPn74
1spk6A1mwr3cCHXzy0UHd2/vUiHnqQkHsRt9XL1ygFFPPeNe179FIyMj7NxRQ3l5
Ic7eetwv1bFntxGDvoiqioc4fNDCO0e2YakpprSkiF09lexXMnv32KirKcJofJTB
wUE0Q0NDlJTo8Hg+Y2BgAIfDQXt7O90OO/a2x+lyVNDXW0VhYSHekycYHh5WM3a7
Hbd7Lwblx/r7+9EEg0HaWh6mo8OG1WrFZDJhs9loaW7AbCrh5x+fIDbXxTZzsao1
NjYqtzCqWZerm1qjjkgkgiYcDvPuW49gNlfQ2WnB6bTR1GRSzmV88J6Z5FwD81fN
HPvEQL2lCOt2A85nrTzTXaMUlnHIXcri4iKa2dlZTn1RQfzWYZbiT3El9Bgz1xtY
mjKSnq4kHalk+ZqBm0EDC5cNzAcM+E7qmfNXk4zv4/w3BhKJBJp4PM6FY2YSy6+S
XrYzH6zmu4/1ZKJGVufu4a8ZI6lINSvT1Zz4SK+UVpH+zcbKrRfwHd9BMplEk0ql
8Hl7if3aRe7PHrKxWjzDeo4eKCXqM3JnvlaFcNHEk0wu00Ms3MnEqAvpUPcodPEr
Lp1WzOzL5Jaaufu7hQ/fLqdVr7kP779ZpnqSkazMhPwedZfUooWFBSZOuZgOtELu
FXLJVnKL9Uydk9sZVAgXTTzJSNanLKTMbhQJuX4tiN/boWxzM6uZ/bD6HPnb7eTj
1ntYaVM18cL+FjUrM/95IiJMTk4yPupWrrydWORp0n/sAw6pEC6aeJKR7JaPdl2M
RqOMn/tceUe7CXhbmPi+ToVw0cSTzP/+jWw2ZVsDgQBjY2MqhIv2YMH6+R/R3qE2
eoGY/AAAAABJRU5ErkJggg==
}

icon-2.img: load 64#{
iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAYAAABWzo5XAAAAAXNSR0IArs4c6QAA
AARnQU1BAACxjwv8YQUAAAAgY0hSTQAAeiYAAICEAAD6AAAAgOgAAHUwAADqYAAA
OpgAABdwnLpRPAAAABh0RVh0U29mdHdhcmUAUGFpbnQuTkVUIHYyLjFiT2tyLwAA
AwZJREFUOE99VGtIU2EY3vzjH6MoU0JypRhEzBLsn5UW1KLLEMEwJEhDqcwijNIw
0sD0R/TDQCsI8gKaRrF0iqSmw8tc6kxzutxKhxnYlm5OzzbPnr73k5nXPngO7+V5
nvN+53znSKVSqWSj5XK54PV6JQRafn5+HP7+/hsLyGgl3G43Jr+3QtsQj+ZKGRpe
SDkophr1iLNWt8rE6XSi/9M1NJcFwNwXB7v1KpuqgINiqlGPOMRdabZsZJ+ZRnvN
QfSqw7HgzIIo3ITHfhFu2zkOiqlGPeIQlzQ+M24kCAIbW4kvrXLAmw9x7gLG+mMx
3H0Ui7NnOHw59YhD3O76eJCWP2e6jI/Wo61qG0RPLsT5BIiO08hODcGNxGAer8uJ
w7ikGf/WuGREjt3qeFhGT8K7mAFxQcGRdj4QSbFbN82JSxqtOoFPJbHb7WivlsHp
yGBGifB6TnEU3JEhJz1k05y4pGmv3gPykNhsNnyq2g5RfAivqGBgkzE47Mcx8zMa
HqscwmQ4bIZQTA+FYH4sCMKEDIIlDIvuNLRXBYE8JFarFW01O7HouY/fv+JgHDqM
aTMTT+yGYApeB8doMIaadsDSs4u9xcvQvAkCefCJOmv38jG1HyORl5mEksd3UVp4
D09zU/GyMJmjOC+F154XZePRrWRo3sdgzpaIrtp9SxPR/jpVZ2EZOQaPQ4EHV7ag
9nUpDAO9aFLXwWw0cNS9q+W1+ppyZF8KgGtWAYvhCLrqlEvPiF5df3c5etQyiGzP
VqMc+dcjYBr5ir7ez/Atii0/TMhKlsOs28+5pOnXVvw7R1NTU+j6oMSoLhoQ0zE1
HImCzFC8LXvGDAc5KkqK2A1CYRlgh5ZxiNupUoK0yweSgqHBXmhVMew0H4LgTIHo
VELbeADFOYGofBIMfYuc16hn0EZxLmlWfSK+RK/Xo6MulY0cAYvxBBx/ktnObnNQ
TDXqEYe4G360vqLJZEJHyyt0qBKgU0Whqz6Mg2KqUY84//2NrGwajUbodDpoNBoO
iqm21sCX/wXLiv7FJqqnqwAAAABJRU5ErkJggg==
}

icon-3.img: load 64#{
iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAYAAABWzo5XAAAAAXNSR0IArs4c6QAA
AARnQU1BAACxjwv8YQUAAAAgY0hSTQAAeiYAAICEAAD6AAAAgOgAAHUwAADqYAAA
OpgAABdwnLpRPAAAABh0RVh0U29mdHdhcmUAUGFpbnQuTkVUIHYyLjFiT2tyLwAA
AtBJREFUOE91VF1IU2EY3rzxJlC0JjRqpfRzIynsoiDLCkrpZ4lgFN2UoBRGEAn9
EEQXXhV0XdBFGWh6tXR249+G+2nYpDRzOcOWP6Sbc3N65nbO0/d8Q8ucB57D+77P
8z685zvf9+n1er0u05NIJKBpmo7gk5WVJZGdnZ25gUb/Y+pHLzxdVeh+a0LXC70E
Y9bIZerZYBKPx+Hru4nu19sw8ekEoqEbYqomCcaskaOG2n8N142ikTnY2w5h0FaE
lfhdqMptJKNXsBo+L8GYNXLUUMueNTNppCiKGNuCz73FgPYE6tIljPvK8dV9DKnF
sxJrOTlqqHV3VoG9cp35mhzrRH9LLtTkI6jL1VBjlbhfa8StmgIZb8qpEVr2TH7/
kDaio9tWheDYaWipBqgrFRJ1F7bjcnnOljm17PHYquVUumg0CnurCfFYgzCqgZY8
I9HUaMKDeuOWObXssbfuAT104XAYfS15UNXH0NQKATGZQCx6EpFpM5KhYihTRQiP
7sbcsBHL4wYoP01QgoVIrdbB3mIAPXShUAj9bTuQSj4Ui1iB5ZhY4EiJEO+CEijI
iIURYTZhFH/xGhzvDKCHnMjZvleOqS6VITRihO1lPhKTxowgFxreieRsMZbCNXC1
709PxO9zWs8h+O041Hglkr9MaH6aj6aGHAScRpkTjFkjx5za4GgZXB2W9Brx1/nc
b/DRJkjxzepcCVLTRXh+Lw/mfN0GPGvMlRw11LLH52n+u49mZmbgem/BmNcMqPVQ
w2aoswcw0sPpDBKMWSNHDbVOqwXsXd+QDIa/DMJjPSp2s1jo+HVAuQht8Qi03wfT
iByWNXKjnlKpZc+GI8IkFothaGgIAx21YuR9CPpPIbZwFcAdCcaskaOGWvZsMmKB
JzoQCGCg5xUGrNXwWkvh6iyUYMwaOWq2PP3/Xgnz8/Pw+/3wer1wOBwSjFkjl+k+
+gNGzgdGk6oIXwAAAABJRU5ErkJggg==
}

icon-folder.img: load 64#{
iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAYAAABWzo5XAAAAAXNSR0IArs4c6QAA
AARnQU1BAACxjwv8YQUAAAAgY0hSTQAAeiYAAICEAAD6AAAAgOgAAHUwAADqYAAA
OpgAABdwnLpRPAAAABh0RVh0U29mdHdhcmUAUGFpbnQuTkVUIHYyLjFiT2tyLwAA
AZxJREFUOE+tlE8oBGEYxneSlJRSUohEpCRxc3VYF1dXt1mbSEppt63VbBv5E0lG
0pYUKakl0m42tWnZlF2cHJw2olwUt+81z7vZmdndpjnM1HP4vt75zfM+7/eNJEmS
y5EHICfkCIS7MrpJqwN0t9VPqc0+utnopUz2md7eP8mO4wIIECGESder3RSLJ2zB
GKRDVA1klKD4YgddhtvoXGmhs/lmigYb6STQwG6NThmEdsTPGonvlVIVuYTrY389
KUqYHjJPBRiDkIn4CJHIBSm53lNWieUuii2000WolU6DTewM+nfGIAQrXn0MKM6p
7Fr7IPb3pqvZWWFqDHiconxWxTmVrn+TY1wXmawij8ergzAdkZZ59AxCXhb6io1y
3e5EJcnyuA5C/wDlW9NAyMtCuegI1+14K8wgjBigq6XOPEjLy0ovh0Nct+2RzCCc
E4AwEQZpeVkpGxnkOlV2mTPCCI2HDefkaK6ODmZraX+mhqeDYJEJ2oETQNzuYfL5
A3pGGB+uAjYRnl2hHu+VXFo4S93e25bxmjj2G/kDJoZaD/c+jjgAAAAASUVORK5C
YII=
}

icon-file.img: load 64#{
iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAYAAABWzo5XAAAAAXNSR0IArs4c6QAA
AARnQU1BAACxjwv8YQUAAAAgY0hSTQAAeiYAAICEAAD6AAAAgOgAAHUwAADqYAAA
OpgAABdwnLpRPAAAABh0RVh0U29mdHdhcmUAUGFpbnQuTkVUIHYyLjFiT2tyLwAA
AkZJREFUOE+tlP1PUlEYx+MP7If+jDRKy0qLnNVWc7pyprSsmev6htRgIF7xBTHU
itxNXrqhkATuesVJOCWcNvl0uM6mIbG2nu3Z3Tnnns/9Pt/z3GMymUzn/kuUQMf5
dHYb6/QWVu863aMpuhwrdNmjdA4qdEpBamqf4/FH0DSNk/sMMScn+qbSaDuUxcEh
7OxjgJqHVumRZBKJxClYGSidPTgFOizCroBkC0eg47TZbKeUlYFWM2KHiOm5BJJX
5cX4Cs+cMQKfdPxLu/T273CrbQaLxUIoFPqtqgwUX98lGNFZjGWI6AXkjSLuVIEn
ryMEojner0BT6zRms5lgMFgZFEvncCykmBcQfw4+ikrDwiOvGL90fmZRg5sPJqqD
osktBibjuLUi8z9AF2VuiVz6WcQqTm8uBdfvy9VByrLO4Fgcea1AUJhcgghBBL7o
4gMpfEm41uKqDlI/OPHY7XTZFCa1AjFxbIood2DiK+5QHo/wqN7i+Dso6pdIWi/w
6u5jRt8mkVwqPcNhQ8mogIzHwbUMdY32yqD9VZlv3eeRWtpwyXGiGQxjF9IwI8o5
hgxHwNwwdDZob2+P0OAd+psf4nQuoW4eQd6tlUMGwlBbL1UG+Xw+bj+aZUSYMB7Y
Rp79jnsmi0v8e47JTd54NxkZ22DYo1Nzua8yKJPJ0Ng6ZXRtk3iWeuXGPZmGFjdX
hblXmkaMkmrrJC5e6q3sUT6fR1EU2tvbjZeqZUdHB6qqnt3Z2WzWWCy1frU8CSm7
Rv68Y/5l/AtQNK4vo4Bc1AAAAABJRU5ErkJggg==
}

rebol-logo.img: load 64#{
R0lGODlhsAAsAOYAAAICAoGDe0hBPsTEwCYnIailnmBiW+Ph3DQ2M7m3sXNwaU1T
TJqWktTRzBYWFvLx746NhC8tKqupp2VmYjk+Ob65tFxaVQ8QDtbW1uzr6ElMR8zO
yXZ3b/7+/iIhH1ZbVrOxq5eXjoF+eKGhocvJxeXl49jX0m1vZomMhDs5NLi6t5KR
i3p8eaCfmB4gG0A+OlRUTlBMRgoKCigqJ6uqonJycPf28zEyLa6vp2tpZMK/uNzb
14eFfmZkXEBDP0dGQQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAACwAAAAAsAAsAAAH/4AdgoOEhYaHiImKi4yNjo+QkZKTlJWW
l5iZmpucnZ6foKGio6SlpqeoqZk2KhMuMrCxsrO0tba3uLm6u7EAFz4gkxk8BDIA
vMizFy8rB4sZEggA09TV1tfY2drb3N3e1hEQOzaUDzoWxt/q2DkliiMw6/Lz9PXX
HivuljY6P/brDoIlQnDhn8GDCAF4CEEu04AXCblNUBSxosVuDiA01JQgxcVrCCh+
HPlRRo8Mngq4IDnNg8htF2bciECzZs0ZHgp6u3DjxUybNnvO4OYAqFEH6bil0LHI
xgESKkAk2FBiI6IMNbRdIPAzgoek6ma81EahgI4EaNOmBUEDggad2/98TK0gVW1a
HSR4ONDmQEGFs3YT0G1xYug2BwGsFnqwIYQBChEIzPAxocU4RSQ8YkPQ4myFCjxW
yhObqBsMfYt2cICbzYBiRDoiaIuQgJGNBBrAWvOxIZGJAASxOfjRLJENFKypLUDd
QYfhdaQRdePtqMQE3dY+ME8EQna2GwIZ6biRzcGKRCTicbtggESiDdKuacBACASB
edEPdaPgflCGDSqoMABKhFRAnjbaEZJBAww2aEIDKHgwGw2EPECCVBs8QIgNJ2AH
AAK9HdKAet7AsMNVE2AzX333jTZWNtQJwg8MN/QEAYGCNKDBNgkOokMPAsQgZAww
xBCBh9NEgAP/ISRYMMNkLWg4CHLXmCRlIQekqI4MKFy5IQTYrTiIffi9iE2MHdhA
A1y0EbKBPwgyR8Ne8ihZn2gAwGDCIA90eM0FIhxiQwt4UiPDDAgUSg0CAyBSAJ3V
iCkImS6Wxg2aNuBApwwv1DbImzwylwACDsxAk6kzQIqNnYMM4MMFF/R1oiAbaGbN
BRAcUkIO1zhggFkt5HZrYocMcGCk9I3ZInRmXoPpAAYgoIECIHjZXaiEHFDACjTg
4C0IEpygKjhL+ldAADy00EBDO+SQ3DQOtHDIBj5YI8MEewpCwo7WGIAjITssIF+y
ky4bVrO7hSjIAyYMQBWWPSA5TY8bGmLg/2zlDmLDA1bZAMG708ygQrG2ToPAyITQ
YDAAMRBMyK4Ds1impXEpnEgJOuQw7jUUY1YyubbRICxI/RUywM/tFGICBdYI0MAh
GSigm6QdUMoszdqgmaZiD7Rwg8TU9GzDDiRswOAGJuzQwnPXsCoj2SSQ4IyMDRjw
LgJFE6JDfNQkTUgDfE/jNNQKxKzszNJdqrANDTAAwkY2FOAdNz03cIIPPwipAQwG
vIrx3xz44MMLPTTa6s8AiFxs4B9WUEgL48IwN5YWGF4w4voprjEOBESA8sI0HBsn
ITgo6o3bHSRgsAI4ZmBAr/IaYgKJ08hgQL4duGrvCV4OggG/yBJvfP83+Rky3eKa
AmDB7GmuAHI1PRfw/jbIgyBh9SLg2KduFwRwyAM8SM4FLNACEISgXtZwAEPmxTRr
UI0GojEGLMiHsGpgikwOYEAhdkA9bPRsABZ4wQJgQEISfu1zg2gAB37wAxjw4Gn+
qZ29FPCaDpAAIvZyQQR2xjIYGqJ4trMhBwyQgxycIAAnmFw2yleI/SyOUj/woSBU
gi0+NYAEaTNBFlcwviRRSGMHeJAJumcsbCxHUCHg4RIfJygeqMhlTjmAHEvwgB3I
UBtMJIQTCaE8ePHASwe4owe3g4gEKBEc4XnGdbAxA08Z4gBS84YLFniIHYAvfIpw
HtjyOIhunLH/Vc9BgCMF8RBtGKB7sBGeNW7AFEaYgANqvAAHatiBHYjgfrNZASrH
NL5PJiIDPeAGJwXRDQ1kqAQZKEEBlmW9BjygBFXZwfOyYaIOJDMD2MwmNh/wgGVq
gwABiEoLWlCAcnqLBgwIAQQWMD8ALOWXNLAAAVgjAwfcYAIJ2OXCCoeNKG7NBgAN
KDmmJ8wKUsMFH8hBDxb6A9Y4AAYK7YECJqDKanjgBDzgwAk2ylGOcoADQ8OGDLgS
mSeZNAIzcIED1FgNWdIyTTsAAQo4oICNciAEKmDfISpwyINOAAUBEIFQhyoCHqAg
Byu7xjA74A0ZXEAW2HiqU8HmCwfA6qpYtL0qVSPCSkY8IJkHQKY+FRRMraz0rGhd
aTtbYlCWuHUdMlhfJ2yQRre6BGtvzSs9ZPkvTICgoheJgCJYqtfCHoYFfa2EDlD3
EQsoogY9Naxk+YJYTAxAAHm9wAgUUYIRRHayoG0pDEwnjBUk9SMXqOwiNsACUqX1
tbCNrWxnS9va2ra2sEqBBF76ywC4AFa3DS5aL+CBD0hgrKpIrnKXy9zmOve50I2u
dKdL3epa97rY3UQgAAA7
}

mac-backdrop.img: load 64#{
iVBORw0KGgoAAAANSUhEUgAAAAEAAAAECAYAAABP2FU6AAAAG0lEQVR42gXBAQ0A
AAzDoOb+xc4Bh+C2FVzVA4hoCs1lccrMAAAAAElFTkSuQmCC
}

che-logo.img: load 64#{
iVBORw0KGgoAAAANSUhEUgAAAFQAAABUCAYAAAAcaxDBAAALNklEQVR42u2df0yT
dx7H35gn5pHVW/XAlJ27sztN7ELNIGMKg5mVk8UaYRbnZlE2rZqxyjWusp7XLYyJ
81f1hHSYubJzxDKOULcZa6K31jPqw5wLJFtuZXOx3mmGuTFoTiJPRm+f+6M8pZW2
/BAQl+87aWwfnu/3+Tyvfn88n0+/348AExNTDJ38+CQtTF9IGVkZFHm8zFhGDe83
ECM0SmUvySYApFAowvDsdXYCQACo+q1qBnW0qt5XTap0VRS4jMczyLDZwGCOVZEt
FAB4GX9fw5x2rw0wbDDAts8WhiiXycGAjlH6tXpKS02Ds9EZGgLeqqbMrEzWbccq
5TwlyeVyAkDOBifJU+QU2VpZCx0tUKUS21/bDuU8JUpKSxDoCkAURWQ8nkHuU+7v
7xeIRJQU+e89kfuEm5TzlOQ546G+W31U/VY1GTcbyX3CTeYKM91PMAde04iIn3QD
jOVGGpjJSb9eT3dKOC+Q7jkde2waTuYKM/E8T9lLsslea6ervqtDYF69cpU0yzQM
ZsKH97eriZfxpFulo6tXQhDdp9xkr7VHwey83kna5VoGM+FD+1wFASDrDuuQbm0/
aI+CqZqvIttBGwMaT67jrrBf7qhzEBFRX18ftbW3RXdz31WSwDved9z3QCfssYnn
QhOeKl2FkvUlAADnh07UH6kPn9P410ZkZmfi5o2bAABRFFlLTAiV58mw2UA9PT3k
anaRQqEIdfdaOynnK0MtmEO4JdsP2lmXTyTHEYcUnot6SZOUx+up06/Xh4+zMXQU
8ng9dcJ5QT/En48A+ktoodxkXShfk/9KrOMzMCP8XsT9P4be8/BdH/oGx1zwDOjd
irXQcVY/+iPGH44B/QVY8Avr8vwMBnRcHzOmcwwoEwPKgDKgTAwoA8qAMqBMDCgD
yoAyMaAMKAPKxIAyoAzo3SmIIAM6nmI/0jExoAwoA3pvdOmzSwunxjwwTnKfdAdu
3b71YO+t3vCx1F+noujZohHv3eGmcXFhdXV3efEzklNSUpYsXrK4485zLn9+2bdn
9x503uxETU1Nwmue+8e5P3V+37m7ty9kq2ymDMrfKlWx6p1UoC0tLdTe3g7f1z7Y
bDZwPAf/NT/E26E1SqmzU1G4spDUi9TYtWvXsGA5PtqcpqYmam1tRVVVFX748Qfg
ZyA1NdVnqbBAu1JrWvrU0lrpXFEU4frIhVu3b+H0ydMB2WzZmidznjwTVV9zE531
nEV9fT1myWeB4zkEfwqiJ9CDQHfAZ7VaR2TnhKiyspLU6WriZTzp1+pp//795Kh3
0O69u6l0fSnxyXx43Sc3nSP9Wn3MtZ/GcuPgWvyINfYmk4kyMjNIna4m9SI1LZi/
gDiOC507DaTJ14R3250+c9pb8EwBcdM5mjd/HpnKTfTJiU+irrezaiep0lWkK9KR
4z0HXRQuroroXWTeZib5bDmteW4NXbxw8dlJhbnxxY3EJ/PEcVzcXW8Wi4VSUlKi
oI4E6KXPLi3UFeuosKiQdu/dTS0tLdRyvIWOHTtGVquV1Onq8PlZT2SRucJMFouF
Nho2UumGUrLssNCxxmNR1zKZTCSTyahwVWHCBb2l60sJABU8UzB5C38tOyzETQu1
lOH2FR06cIjycvNI+YiS1qxdMyxQc4WZdKt0ZDQa6aJwkY41HqPKykpyvOeg7h+7
kyqrKmln1U5SPDS4zLywsJA8n3qOxrPBbrcTz/OkfEQ5LKS2L9qSpR6wZ8+eiYd6
7tNzR+Wz5eEWd857zjZcGc+nnqNHG47GNS4SqOpRFZnKTfTtN99Sf3//jI2bNxIA
ysvNI/dJt49P5klfoqctm7eEy8QbSiQtmL+AAJDFYhkpIAJAA+UmdlKqeafmxUB3
AACgTldjqWbp9uHK5P8h/yUAL42kfsUcBQqWFeDdI+9CtVBlKVpRhOBPQSxSL0Ln
fzoXps1Jg3BJQPWb1Tjy3hEAgO8bX9z6bAdttP3VkInibRGO+sExure3F/3Bfoi3
RQSDQYiiiOv/vo7GDxsBAFe+uzLxs/wZz+CkWZBfgPa29nHtAUUri/DlP7/EgQMH
MHfu3MrmpuZVDR80fNzU1ETiTyIq36xE8H9BrFu3LmmgJSEQCMSt74OjHwAAUuak
gE/m4b/mRzygQGgloKncFH46r6mpmTigLS0ttHr16vBntVo97kNK2m/S0NPTAwAI
dAfAcVyHbb+N3rG/g5kPzsQp96mk0QRUfF+HWq96kRp79+6dlMehEQO9ciW6C6TO
Sb007sZM5/By2ctJlZWVJEuW4YklT3RkL8lG62etkMlkccvEkqvFRcWri0NfVFra
1POUurq7ogtyXMdEGVVVVRVuTcatRjz8u4eRlZmFCkvF0BvgYt9CZPeWHI0pBVT+
q+hsNb3/7X1xpJPN3WhgvETz35pHd2MRbuz1f12fesGRBb9fED0++XxTIigSr8sr
HlIMDldjnLEnFOgL+heSeH5wY5b3rHfcjekT+0ZdJtKmSCnnKVXS+0AggEO1h2hK
AZVmS0mff/H5uBszlu3d8YAuXrK4I7KV1jvqp1481PRHU/gGAoGAtPH1nmrmAzPj
/u35558Pv//qy68kr2zE4cixpDoaFdB169ZFdfvjHx0fcVnPGc9J9wn3uH8B8WZ5
AHgq76moz84PnWi73JY8knpPuU896D3rnfjnLccRR9Ted4VCQcMZORCRolhA44Xv
Rupz61YlTkk08PeovfqJtpEL5wW9Kl1FdyY5nFBJgMIvDmTYbIjKBuY55fnOvM1M
8pRQMMVeG/smIvfL61bpSGgVckfS2qUy2pXDZ9IZSKk5BKx2uZaM5UayvmElY7lR
Sr1JGY9lTP5QZq+zhxNaJXop5ymHpF1zNjjJvM1MUlLWWDerWaYZUs62z0aaZZoh
11XOVZJ+rT5hCzeWG6PSccR6yeXyu04Ee9f+rW2fjZzNTviv+RHoCgUqFHMVyMnK
gXa5Fpu2bBpyjUQ3Pks2C/IU+WFgaNIC6xtWmjFjBhQKxZByN2/cRF9/H3btTPwT
hrHcSN6/e9HZ1YlAVwByuRyqhSqUrCnB1le33rvcdUxMTExMTExMTAnVdrkt2eP1
1MU6HsuNi+nTJwg6RNYTy1UVWoXcRDGBWLZ5vJ66O6/pPuGO8spilZtwSf8DgrPB
SR6vp27ArwcQTm8JANCu1JK5wkzmbaFVJZLvLHkhjvcdYb/esCFUp+tEqLyhLPRZ
yhYu+ermCjPp1+tJaBVyzdvMMb0iaRWLlEPPsMFAxnIjCa1CrmGDgQZcVhjLjERE
JNkv2elsdJJwXtA7G5xj9pZGHG0SWoVcKYVlSWlJUr4m/xWxVwzD9XUMRvBLnitB
ZkYmDvzlQNIdPjWyn86mR1WP5q0oXJEEDMYziwuLQ58Hsottf217EjAYI9Uu1x7W
PK1BTnbOhWJ9cZ7f74+yz9Xsolmps+DxeuoyHss4DACapzWQyuhW6uC/4V8BAGkP
p6F4TTE2bdmUJFwWckWI8Hg9dQqF4nBOXk7jXUW/RnNyZ1fnkGMlpSVJAy20LPJ4
rMBvsS4Erfrtagq7vVxsi+x1dtr6ytakWBbmZOVcsL5hHVouGD/HXmTWstf//HoS
AGhyNcSDfwBi/HIT1kJzsnMuIAjYa+3kanaR0CrkisFBI8VeMTwO+W/4EdliO3s6
0Xa5LVnqxob1hqhykerpCv0uL5wV4PF66np+6IFwXtD7O/xl7e2hhRXORidF/qop
fVmu4y5Uv10dHg781wbt8F/zo/2rUHnrDisBgFanRWZW5m3fdz5Yd1hJ6uo9XT2Q
xtwpn3VXuDx8eO6u6m8dWf13TpgTbRfTGPV/zG/zrO81GWkAAAAASUVORK5CYII=
}

shadow-normal.img: load 64#{
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABmJLR0QA/wD/AP+g
vaeTAAAACXBIWXMAAAsTAAALEwEAmpwYAAAAB3RJTUUH1QQUCzYGyPaalQAAAINJ
REFUeNrd0qEOwjAUBdADDIJDIYaZWPjJfSZuAo2bQiybKKZLmqUzRcE1TZO+U3Ef
P59DwUyHCwKGqgBocFou+wLghhptKVDjjGMpkOb6LeAPgCqzJE1SVS4vjJgR1sAj
WZJhAxgj8sS0Bvp4tkvPmcxxeEC/yzy4Lx1vAAFT/Oz9ASj/FhDibXHbAAAAAElF
TkSuQmCC
}

shadow-round.img: load 64#{
iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABGdBTUEAALGPC/xh
BQAAAAd0SU1FB9UEFAs2Bsj2mpUAAAAYdEVYdFNvZnR3YXJlAFBhaW50Lk5FVCB2
Mi4xYk9rci8AAADFSURBVDhPlZLBEYJADEV3xwI4WINXK7EXLp480YZHa7ANarEF
zWMMZrPBCZn5DLD8l78bDrXW4lV+dZfbs2gQvUVH0cusl8bcLLQPgG6ii+gUAv6Y
dekZQoi/o/okOwGkADKF20kmUcjYnUcSMMt3D9FVAUTKFqPsAIwnW968jJTZZlJE
3RcAF1JwOFvlzbr/FUAKICSxIDVqdD28BqApPARTZMS8TsBGJg6Q6ZuEbrajGrvu
EYSfxHYC7rV5YNHH9l1j/AAM0TR5BZM1PAAAAABJRU5ErkJggg==
}

edge-round.img: load 64#{
iVBORw0KGgoAAAANSUhEUgAAABoAAABDCAQAAAAowt16AAACNUlEQVR42u3XQUsb
YRDG8d+72cSoEVtKIKEHPUlvHgqlYA/pud76gdp8kIJfwJv35qAghR68eigBsa3Y
QsG0SpLN9pAYN2ptkoIIdW67vP99ZnaG2X1Cqh87NTVvXBuxVFLXWGv0r0OaAZb9
OZowAONzZBlVqUgiiPSEIZDK9cE37DTXmjF9pIKfNyg91htg3obtmvfLKn75WxTM
ONTkZaxmzGgPklQL2+l4OlDSduBIZIJoieWYDKJrdnIoCJNDpHcbmqomt5ReOo1S
uMWa7qF/heKr/U50nWihpCQ/euQqRM6ZU1+damFBUVVRQTqY7yGUZIbklyPf7duz
jeee+qmsbC5z6pJS27FP9mwij1271j3TU5UfhcJw05w59sGWgiAnyOnZMmPRA1Hm
+Rmlji/2bSkMthuRBJsq5i1ljkYXSi1nPiI6X7/ICdhz6uT6PrWc2JXPIH0sb1tL
63qoZMFznZH3RKLjhZLSKJQOoaKn6GWwRIpVsxauV8qrWrGurast0dPR1fbaispI
b+ILpVhR2TMzwz51sG7VI7Mjlcaj37qynkWVzESsKCsrXp6IXGZg51Q9MO+JVyOz
l9w0sIm8yNKVKQ9/hsLgVr+6+8Xyn0HpNJ/PMF16d/qXYMr0bguaqk+x00mhkq4E
kXrTV3NjQYlvjqhHGuPqFM63UCP3rnkQftRiD+V1bkAWRD5rUl/biNEYGI8bXc1h
3w7VbRCz1tg59yvj+KfmwHT93al1h4YLfgMuDa/Ykl2CzQAAAABJRU5ErkJggg==
}

red-image:       to image! layout/tight [box 96x16 edge [size: 1x1 color: red     effect: 'ibevel] effect reduce ['gradient 1x1 white red   ]]
blue-image:     to image! layout/tight [box 96x16 edge [size: 1x1 color: blue   effect: 'ibevel] effect reduce ['gradient 1x1 white blue   ]]
green-image:     to image! layout/tight [box 96x16 edge [size: 1x1 color: green   effect: 'ibevel] effect reduce ['gradient 1x1 white green ]]
yellow-image:   to image! layout/tight [box 96x16 edge [size: 1x1 color: yellow effect: 'ibevel] effect reduce ['gradient 1x1 white yellow]]
menu-data: [
    file: item "File"
          menu [
              new:     item <Ctrl-N> "new"   icons [icon-1.img icon-2.img]
              open:     item <Ctrl-O> "open" icons [icon-2.img icon-3.img]
              recent:   item "open recent"   icon icon-3.img disable
                      menu [
                          item "Fugu"       icon icon-1.img
                          item "Starimbiss" icon icon-2.img disable
                          item "Nexte Lied" icon icon-3.img disable
                          item "So Blau"     icon icon-1.img disable
                      ]
                      ---
              save:     item <Ctrl-S> "save"     icons [icon-3.img icon-1.img]
              save-as: item <Ctrl-A> "save as" icons [icon-1.img icon-2.img]
                      ---
              close:   item <Ctrl-W> "close"   icons [icon-2.img icon-3.img]
                      ---
              exit:     item <Ctrl-Q> "exit"     icons [icon-3.img icon-1.img]
          ]
    edit: item "Edit"
          menu [
              item "undo" icon icon-3.img
              item "redo" icon icon-1.img
              ---
              item "cut" icon icon-2.img
              item "copy" icon icon-3.img
              item "paste" icon icon-1.img
          ]
    more: item "More"
          menu [
              a: item "Drive A:" icon icon-2.img
                menu [
                    item "Files" icon icon-3.img
                    menu [
                        item "A File" icon icon-2.img
                        item "This is a multi-line^/menu-item, which is^/unuasual but fun."
                    ]
                ]
              b: item "Drive B:" icon icon-2.img
                menu [item "(no such drive)" disable ]
              c: item "Drive C:" icon icon-2.img
                menu [
                    item "I368"     icon icon-3.img
                    item "SUPPORT"   icon icon-3.img
                    item "VALUEADD" icon icon-3.img
                    item "WINDOWS"   icon icon-3.img
                ]
              d: item "Drive D:" icon icon-3.img
                menu [
                    item "The Very Best of $MYFAVOURITEARTIST" icon icon-1.img
                    menu [
                        item "Greatest Song Ever" icon icon-2.img
                        item "Another great song" icon icon-3.img
                    ]
                ]
              e: item "Drive E:" icon icon-2.img
                menu [
                    item <1> "This"       icon icon-1.img radio of 'Teamleitung on
                    ---  
                    item <2> "is"       icon icon-2.img radio of 'A on
                    item <3>   "an"     icon icon-3.img radio of 'A
                    ---
                    item <4>   "example" icon icon-1.img check   ; oh, check and radio in one group aren't possible yet!
                    item <5>   "of"       icon icon-2.img check ;radio                  
                    ---
                    item <6> "radio"   icon icon-2.img radio of 'B  
                    item <7> "and"     icon icon-3.img radio of 'B
                    item <8> "check"   icon icon-1.img radio of 'C
                    item <9> "items"   icon icon-1.img radio of 'C
                    ---
                    item <A> "Hold"       icon icon-2.img check
                    item <B> "SHIFT-Key"   icon icon-3.img check on
                    item <C> "down"       icon icon-1.img check
                    item <D> "to"         icon icon-2.img check  
                    item <E> "toggle"     icon icon-3.img check on  
                    item <F> "multiple"   icon icon-1.img check on
                    item <G> "items"       icon icon-2.img check
                    item <H> "at"         icon icon-3.img check
                    item <I> "once"       icon icon-1.img check
                ]
          ]
    again: item "Even more" menu [
        undo:     item "undo"   <Ctrl-Z> icon icon-1.img
        redo:     item "redo"   <Ctrl-Y> icon icon-2.img
        bar
        cut:     item "cut"   <Ctrl-X> icon icon-3.img
        copy:     item "copy"   <Ctrl-C> icon icon-1.img
        paste:   item "paste" <Ctrl-V> icon icon-2.img
        bar
        red:     item image red-image     <Ctrl-F1> check on   of 'Colors
        green:   item image green-image   <Ctrl-F2> check off of 'Colors
        blue:     item image blue-image   <Ctrl-F3> check on   of 'Colors
        yellow:   item image yellow-image <Ctrl-F4> check off of 'Colors
        bar
        red:     item "red"     <F1> body font [colors: reduce [red     black]] colors [none red   ] radio on of 'Colors edge [color: 0.0.0]
        green:   item "green"   <F2> body font [colors: reduce [green   black]] colors [none green ] radio     of 'Colors edge [color: 0.0.0]
        blue:     item "blue"   <F3> body font [colors: reduce [blue   black]] colors [none blue   ] radio     of 'Colors edge [color: 0.0.0]
        yellow:   item "yellow" <F4> body font [colors: reduce [yellow black]] colors [none yellow] radio     of 'Colors edge [color: 0.0.0]
        bar
        small:   item "small"   body font [size:   9] radio of 'Size
        normal:   item "normal" body font [size: 11] radio of 'Size on
        big:     item "big"     body font [size: 14] radio of 'Size
        huge:     item "huge"   body font [size: 21] radio of 'Size
        bar
        rebol:   item image rebol-logo.img <Ctrl-F> icon icon-1.img
        bar
        che: item <?> "When?" body font [style: 'bold] icon icon-3.img menu [
            month: item "Month" icon icon-2.img menu [
                jan: item radio     "Januar"
                feb: item radio     "Februar"
                mär: item radio     "March"
                apr: item radio on "April" font [color: 0.0.255] action [print [item/body/text ", " item/body/text ", der macht, was er will."]]
                mai: item radio     "May"
                jun: item radio     "June"
                jul: item radio     "July"
                aug: item radio     "August"
                sep: item radio     "September" menu [.: item "Radio items with sub-menus? What's that?"]
                okt: item radio     "October"
                nov: item radio     "November"
                dez: item radio     "December"
            ]
            week:   item "Week" icon icon-1.img
            day:   item "Day"   icon icon-1.img
            bar
            properties: item "Properties" icon icon-2.img
        ]
        ha:   item "When?"         icon icon-1.img menu [
            month: item "month" icon icon-2.img
            week:   item "week" icon icon-1.img
            day:   item "day"   icon icon-3.img
            bar
            properties: item "Properties" icon icon-2.img
        ]
        ---
        delete:   item "delete"           <Ctrl-D> icon icon-1.img
    ]
    about: item "About" menu [
        author: item "Author" icon icon-1.img
                menu [
                    logo: item image che-logo.img icon icon-2.img
                ]
                ---
        script: item icon icon-2.img {This is my first attempt^/of implementing a full-fledged^/skinnable REBOL menu-system^/which allows for menus looking^/and behaving pretty much like^/native OS menus.}
                ---
        wish:   item "Hope you'll like it!" icon icon-2.img
    ]
]
cool-menu: layout-menu/style copy menu-data cool-style: [
    menu style edge [color: none size: 13x33 image: edge-round.img effect: [extend 13x33]]
              color 60.60.60
              effect none
              spacing 0x0
    item style font [name: "Trebuchet MS" size: 16 style: 'bold colors: reduce [white black]]
              edge none
              colors [none silver]
              effects none
              action [print ["Selected item" item/var]]
]
wierd-menu: layout-menu/style copy menu-data wierd-style: [
    menu style edge     [color: none size: 2x2 effect: [merge alphamul 75 colorize pink]]
              effect   [merge alphamul 75 colorize yellow]
              spacing 2x2
              color   none
    item style font     [name: "Comic Sans MS" size: 12 style: 'bold colors: reduce [reblue yellow] shadow: none]
              effects [
                    [merge alphamul 75 colorize orange]                         ; enabled normal
                    [merge alphamul 75 colorize violet]                         ; enabled hovered
                    [merge alphamul 75]                                         ; disabled normal
                    [merge alphamul 75]                                         ; disabled hovered
              ]
              edge     [color: none size: 2x2 effect: 'invert]
              colors   none
]
winxp-menu: layout-menu/style copy menu-data winxp-style: [
    menu style edge [size: 1x1 color: 178.180.191 effect: none]
              color white
              spacing 2x2
              effect none
    item style font [name: "Tahoma" size: 11 colors: reduce [black black silver silver]]
              colors [none 187.183.199]
              effects none
              edge [size: 1x1 colors: reduce [none 178.180.191] effects: []]
              action [print item/body/text]
]
mac-menu: layout-menu/style copy menu-data mac-style: [
    menu style edge [size: 1x1 color: black effect: none]
              image mac-backdrop.img
              effect 'tile color none
              spacing 2x2
    item style font [name: "Haettenschweiler" size: 18 style: none colors: reduce [black white]]
              colors none
              edge none
              effects [none [merge colorize blue] none [merge colorize silver]]
              action [print ["Item" item/var "chosen."]]
]
rebol-menu: layout-menu copy menu-data                                           ;-- unstyled default

menu-from-dir: func [dir [file!] /local entries menu dirs m] [
    entries: try [sort read dir]
    menu: copy [item style action [drop-file/text: item/body/text show drop-file focus drop-file]]
    dirs: make block! []
    foreach entry entries [
        either #"/" = last entry [
            insert tail dirs compose [item (to string! head remove back tail copy entry)]
            if not empty? m: menu-from-dir dir/:entry [
                insert tail dirs reduce ['icon 'icon-folder.img 'menu (m)]
            ]
        ][
            insert tail dirs compose [item (to string! entry) icon icon-file.img]
        ]
    ]
    if empty? dirs [dirs: [item "(empty)" disable]]
    append menu dirs
]
dir-data: menu-from-dir dirize system/options/home
slider-menu: layout-menu/style [
    r: slider <Red>       icon [icon-3.img icon-2.img] check
      menu [
          item "red"     <255> [set-menu slider-menu 'r [slider/data: 255]] colors [none red]
          item "maroon" <128> [set-menu slider-menu 'r [slider/data: 128]] colors [none maroon]
          item "black"   <000> [set-menu slider-menu 'r [slider/data:   0]] colors [none black] font [colors: reduce [black white]]
      ]
    g: slider <Green>     icon [icon-3.img icon-2.img] check
      menu [
            item "green"   <255> [set-menu slider-menu 'g [slider/data: 255]] colors [none green]
            item "leaf"   <128> [set-menu slider-menu 'g [slider/data: 128]] colors [none leaf]
            item "black"   <000> [set-menu slider-menu 'g [slider/data:   0]] colors [none black] font [colors: reduce [black white]]
      ]
    b: slider <Blue>       icon [icon-3.img icon-2.img] check disable
      menu [
            item "blue"   <255> [set-menu slider-menu 'b [slider/data: 255]] colors [none blue]
            item "navy"   <128> [set-menu slider-menu 'b [slider/data: 128]] colors [none navy]
            item "black"   <000> [set-menu slider-menu 'b [slider/data:   0]] colors [none black] font [colors: reduce [black white]]
      ]
      ---
    w: slider <Greyscale>     icon [icon-3.img icon-2.img] check off
      ---
    h: slider <Hue>           icon [icon-3.img icon-2.img] check on
    s: slider <Saturation>   icon [icon-3.img icon-2.img] check on
    v: slider <Value>         icon [icon-3.img icon-2.img] check on
      ---
    b: slider <Transparency> icon [icon-3.img icon-2.img] check on
] winxp-style
slider-menu-text: {slider-menu-data: [
    r: slider <Red>       icon [icon-3.img icon-2.img] check
      menu [
          item "red"     <255> [set-menu slider-menu 'r [slider/data: 255]] colors [none red]
          item "maroon" <128> [set-menu slider-menu 'r [slider/data: 128]] colors [none maroon]
          item "black"   <000> [set-menu slider-menu 'r [slider/data:   0]] colors [none black] font [colors: reduce [black white]]
      ]
    g: slider <Green>     icon [icon-3.img icon-2.img] check
      menu [
            item "green"   <255> [set-menu slider-menu 'g [slider/data: 255]] colors [none green]
            item "leaf"   <128> [set-menu slider-menu 'g [slider/data: 128]] colors [none leaf]
            item "black"   <000> [set-menu slider-menu 'g [slider/data:   0]] colors [none black] font [colors: reduce [black white]]
      ]
    b: slider <Blue>       icon [icon-3.img icon-2.img] check disable
      menu [
            item "blue"   <255> [set-menu slider-menu 'b [slider/data: 255]] colors [none blue]
            item "navy"   <128> [set-menu slider-menu 'b [slider/data: 128]] colors [none navy]
            item "black"   <000> [set-menu slider-menu 'b [slider/data:   0]] colors [none black] font [colors: reduce [black white]]
      ]
      ---
    w: slider <Greyscale>     icon [icon-3.img icon-2.img] check off
      ---
    h: slider <Hue>           icon [icon-3.img icon-2.img] check on
    s: slider <Saturation>   icon [icon-3.img icon-2.img] check on
    v: slider <Value>         icon [icon-3.img icon-2.img] check on
      ---
    b: slider <Transparency> icon [icon-3.img icon-2.img] check on
]
slider-menu: layout-menu/style slider-menu-data winxp-style
}

version: rejoin ["Version: " system/script/header/version " " system/script/header/date]
window: center-face layout/size [
    style text text font [name: "Tahoma" size: 11]
    backcolor white across
   
    at 0x0 sensor 800x600 feel [engage: func [face action event] [if action = 'alt-up [show-menu/offset window menus/context-menu event/offset]]]
    at 600x2 text 190x22 version as-is effect [gradient 1x0 255.255.255 255.128.128]
    at 2x2 app-menu: menu-bar menu menu-data menu-style winxp-style snow
    at 2x30
    pad 18 text "Above you see the VID-Style MENU-BAR with a WinXP styled menu." gray
   
    across origin 20x60 pad -18
    text "Here are some examples on skinning / styling menus:" underline return
   
    btn "WinXP"           [show-menu/offset window   winxp-menu 0x1 * face/size + face/offset - 1x0]
    btn "Mac"             [show-menu/offset window     mac-menu 0x1 * face/size + face/offset - 1x0]
    btn "REBOL (default)" [show-menu/offset window   rebol-menu 0x1 * face/size + face/offset - 1x0]
    btn "Cool"             [show-menu/offset window   cool-menu 0x1 * face/size + face/offset - 1x0]
    btn "Wierd"           [show-menu/offset window   wierd-menu 0x1 * face/size + face/offset - 1x0]
    btn "Slideshow"       [show-menu/offset window slider-menu 0x1 * face/size + face/offset - 1x0] pad -8
    box 22x22 effect [arrow red rotate 270] pad -14
    text 200x22 "This one is fun!" left middle effect [gradient 1x0 255.0.0 255.255.255] pad -120x2
    btn 100x18 "See the code ..." [view/new/title center-face layout [style text text font [name: "Courier New" size: 11] backdrop white text slider-menu-text as-is] "All in all, not too complicated"]
    return
    text gray {All these menus are created from the same data with different style sheets^/and are bound to the buttons in their action block}
    return
   
    pad -18
    text "Noticed that you can navigate through the menus using the keyboard, too?" underline return
    text as-is gray {Use UP, DOWN, PAGE-UP, PAGE-DOWN, HOME, END an LEFT (ESCAPE, BACKSPACE), RIGHT to navigate, SPACE to toggle checkable or radio items and RETURN or ENTER to select an item.
Hold SHIFT while selecting or toggling to engage multiple items before menu closes.
And since we don't have TMD (rich text support) yet to support selecting items by typing their underlined letter, you instead can select items by typing their first letter. If multiple items start with the same letter, repeatedly entering that jumps between the items.
}
 
    return
   
    pad -18
    text "Example of a DROP-MENU VID-style" underline return
    text gray 90 "Select file:" drop-file: drop-menu 320 menu dir-data menu-style winxp-style return
   
    pad -18
    text "Dynamic modification of menus" underline return
    text gray 90 "Item value get:" btn 200 "Query Menu-Bar/About/Wish" [
        use [info] [
            info: layout/tight/offset compose [
                style text text font [name: "Tahoma" size: 11]
                backcolor white across space 2x2
                image 400x200 ctx-menus/shadow-image effect 'extend
                at 0x0 box white 396x196 black white edge [size: 1x1 color: black 178.180.191 effect: none]
                origin 20x20 below
                text "Querying a menu:" underline
                pad 8
                text ">>   get-menu app-menu 'about/wish 'body/text" gray
                text (join "== " mold get-menu app-menu 'about/wish 'body/text) gray
                at 340x160 btn "okay" [hide-popup/timeout]
            ] 200x200
            info/color:   none
            info/effect: [merge alphamul 128]
            show-popup/window info window
        ]
    ]
    text gray {get-menu app-menu 3 'body/text}
    return
    text gray 90 "Item value set:" btn 200 "Toggle Menu-Bar/File/Recent" [
        set-menu app-menu 'file/recent [state: not state]    
    ]
    text gray {set-menu app-menu 'file/recent [state: not state]}
    return
    text gray 90 "Item removal:" hide-remove: at remove-btn: btn 200 "Remove Menu-Bar/About/Author" [
        item: remove-menu app-menu 'about/author
        bar:   remove-menu app-menu 'about/1
        show hide-remove hide/show hide-insert show insert-btn
    ]
    at hide-remove hide-remove: box 200x22 white with [show?: no]
    text gray as-is {item: remove-menu app-menu 'about/author
bar: remove-menu app-menu 'about/1}
return
    text gray 90 "Reinserting:" hide-insert: at insert-btn: btn 200 "Insert Menu-Bar/About Author" with [show?: no] [
        insert-menu/head app-menu 'about bar
        insert-menu/head app-menu 'about item    
        show hide-insert hide/show hide-remove show remove-btn
    ]
    at hide-insert hide-insert: box 200x22 white
    text gray as-is {insert-menu/head app-menu 'about bar
insert-menu/head app-menu 'about item}
return
    text gray 90 "Fun stuff:"   btn 200 "mess up menus" [
        win:   remove-menu winxp-menu 'about
        reb:   remove-menu rebol-menu 'about
        cool: remove-menu   cool-menu 'about
        wrd:   remove-menu wierd-menu 'about
        mac:   remove-menu   mac-menu 'about
        rnd: random reduce [win reb cool wrd mac]
        insert-menu winxp-menu none rnd/1
        insert-menu rebol-menu none rnd/2
        insert-menu   cool-menu none rnd/3
        insert-menu wierd-menu none rnd/4
        insert-menu   mac-menu none rnd/5  
    ]
    return
   
    text gray 90 "Item creation:" btn 200 "Insert Menu-Bar/About License" [
        insert-menu app-menu 'about layout-menu/style [license: item "License" menu [bsd: item "BSD licensed"]] winxp-style
    ]
    text gray {insert-menu app-menu 'about layout-menu/style [license: item "License" menu [bsd: item "BSD licensed"]] winxp-style}
    at 770x2   btn "X" red font [color: white style: 'bold] [quit]
    at 600x26   text 192 right as-is "close window here " effect [gradient 1x0 255.255.255 128.128.255] black
    at 710x500 image che-logo.img
] 800x600
window/edge: make face/edge [size: 1x1 color: black style: none]
view/options window [no-title no-border]
unview/all
halt

1 comment: