REBOL [
    Title: "Vid Tools" 
    Date: 27-Dec-2001
    File: %vid-tools.r 
    Author: "Brett Handley"
    Email: brett@codeconscious.com 
    Purpose: "Provides a few functions related to VID"
]
    
style-definition?: function [
    "Given a style name, returns the style definition."
    name [word!]
    /styles ss "Stylesheet"
][style-obj][
    if none? styles [ss: system/view/vid/vid-styles]
    if style-obj: select ss name [
        compose [
            (to-set-word name)
            (get in style-obj: get-style name 'style)
            (get in style-obj 'facets)
        ]
    ]
]

stylesheet-definition?: function [
    "Given a stylesheet, returns the stylesheet definition."
    styls [block! none!] "An existing stylesheet - use none for master stylesheet."
][result stylesheet ordered-styles dependencies][
    do load-thru http://www.codeconscious.com/rebsite/rebol-library/graph-functions.r
    if none? stylesheet: styls [
        stylesheet: system/view/vid/vid-styles
    ]
    dependencies: copy []
    foreach [s f] stylesheet [
        append dependencies s
        append/only dependencies reduce [f/style]
    ]
    ordered-styles: graph-topological-sort dependencies
    result: copy []
    foreach [style-name] ordered-styles [
        if all [style-name get-style/styles style-name stylesheet] [
            append result style-definition?/styles probe style-name stylesheet
        ]
    ]
    result
]

find-object-field: function [
    "Search an object for a value, return the name of the field if found."
    object [object!]
    value [any-type!]
][result feel-parent][
    foreach w next first object [
        if same? :value get in object w [
            RETURN w
        ]
    ]
    none
]

identify-feel-object: function [
    "Returns a path to the feel object if it can."
    feel-object [object!]
][w cobj][
    candidate: [
        system/view/vid/vid-feel
        ctx-text
        system/standard/face/feel
    ]
    cobj: reduce candidate
    repeat i length? candidate [
        if w: find-object-field cobj/:i feel-object [
            RETURN to-path join to-block candidate/:i w
        ]
    ]
    none
]

;
; Gathers up set-word!s within a script.
;
set-words?: function [
    script [block!]
] [swr result sw] [
    swr: [
        any [
            into [swr] |
            copy sw set-word! (append result to-word first sw) |
            skip
        ]
    ]
    result: copy []
    return either parse script swr [unique result] [none]
]

;
; I'm not sure that the following two functions have any practical use
; but they are interesting.
;
style-set-words?: function [
    "Returns a block words that were set in the WITH block."
    style-object [object!]
][f wb][
    either all [
        f: style-object/facets
        block? f
        wb: select f 'with
    ] [
        set-words? wb
    ][copy []]
]

all-style-set-words?: has[result][
    result: []
    foreach [
        style-name styledef
    ] system/view/vid/vid-styles [
        append result style-set-words? styledef
    ]
    return unique result
]