REBOL

 

AnaMonitor Browser - Source Code

A REBOL object and block browser.
Author: Romano Paolo Tenca
File size: 73K
Return to index

 

REBOL [
    Title: "AnaMonitor" 
    Version: 2.0.0
    File: %AnaMonitor.r 
    Email: rotenca@libero.it 
    Author: "Romano Paolo Tenca" 
    Copyright: {GNU General Public License - Copyright (C) Romano Paolo Tenca 2001-2003} 
    Web: http://www.rebol.it/~romano 
    Rights: {
 This program is free software; you can redistribute it and/or
 modify it under the terms of the GNU General Public License
 as published by the Free Software Foundation; either version 2
 of the License, or (at your option) any later version.

 This program is distributed in the hope that it will be useful,
 but WITHOUT ANY WARRANTY; without even the implied warranty of
 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 GNU General Public License for more details.

 You should have received a copy of the GNU General Public License
 along with this program; if not, write to the Free Software Foundation
 Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.

} 
    Aknowledgments: {Thanks to Gabriele Santilli for its beta testing and its support} 
    Beta: false 
    History: [
        [2.0.0 27-Feb-2003 "Second major public release"] 
        [1.1.0 2-Nov-2001 "First public release"]
    ] 
    Date: none 
    Category: [vid view utils 2] 
    Purpose: {
^-^-A debugging tool to visually examine Rebol values.
^-}
] 
context [
    set 'win-offset? func [
        {Given any face, returns its window offset. Patched by Romano Paolo Tenca} 
        face [object!] 
        /local xy
    ] [
        xy: 0x0 
        if face/parent-face [
            xy: face/offset 
            while [face: face/parent-face] [
                if face/parent-face [
                    xy: xy + face/offset + either object? face/edge [face/edge/size] [0]
                ]
            ]
        ] 
        xy
    ] 
    system/view/wake-event: func [port /local event no-btn p-f] bind [
        event: pick port 1 
        if none? event [
            if debug [print "Event port awoke, but no event was present."] 
            return false
        ] 
        awake event
    ] in system/view 'self 
    awake: func [event /local no-btn p-f] bind [
        either not p-f: pop-face [
            do event 
            empty? screen-face/pane
        ] [
            either all [
                event/type = 'key 
                event/key = escape
            ] [hide-popup] [
                either any [
                    p-f = event/face 
                    all [
                        event/face 
                        same? p-f/parent-face find-window event/face 
                        within? event/offset win-offset? p-f p-f/size
                    ]
                ] [
                    no-btn: false 
                    if block? get in p-f 'pane [
                        no-btn: foreach item p-f/pane [if get in item 'action [break/return false] true]
                    ] 
                    if any [all [event/type = 'up no-btn] event/type = 'close] [hide-popup] 
                    do event
                ] [
                    either p-f/action [
                        if not find [move time inactive] event/type [
                            hide-popup
                        ] 
                        if find [time inactive resize close] event/type [do event]
                    ] [
                        if find [resize offset time] event/type [do event]
                    ]
                ] 
                none? find pop-list p-f
            ]
        ]
    ] in system/view 'self 
    free: true 
    set 'eat func [/only blk [block!]] [
        if free [
            free: false 
            any [only blk: [move]] 
            until [
                only: pick system/view/event-port 1 
                not all [only find blk only/type]
            ] 
            if only [awake only] 
            free: true
        ]
    ]
] 
anamonitor-ctx: context [
    window-mins: [subface 300x100 ly-exe 300x200 ly 600x430] 
    basecol: aqua 
    backcol: pewter 
    view*: system/view 
    wnum: 0 
    stopmode: false 
    h: none 
    out-range: "(out-of-range)" 
    clickme: "(click me)" 
    header: make system/script/header [
        set [Version Date] first history 
        license: none
    ] 
    find-into: func [
        "Find inside a block" 
        series value /part range /only /case /any /with wild /skip size /match /tail /last /reverse /local f
    ] [
        f: refine [find first series value] [[part range] only case any [with wild] [skip size] match tail last reverse] [return tmp] 
        while [not tail? series] [
            if do f [return index? series] 
            series: next series
        ] 
        none
    ] 
    switch-m: func [
        {Selects a choice and evaluates the first block! which follows it.} 
        [throw] 
        value "Value to search for." 
        cases [block!] "Block of cases to search." 
        /default case "Default case if no others are found."
    ] [
        either value: find cases value [
            until [block? first value: next value] 
            do first value
        ] [either default [do case] [none]]
    ] 
    rejoin: func [
        "Reduces and joins a block of values." 
        block [block!] "Values to reduce and join" 
        /with value
    ] [
        if empty? block: reduce block [return block] 
        if with [parse/all block [any [skip with: skip (insert with :value)]]] 
        head insert tail either series? first block [copy first block] [form first block] next block
    ] 
    rig: func [data num [integer!]] [
        data: to string! data 
        head insert/dup data " " max 0 num - length? data
    ] 
    lef: func [[catch] data num [integer!]] [
        data: to string! data 
        head insert/dup tail data " " max 0 num - length? data
    ] 
    as-pair: func [blk] [to pair! reduce blk] 
    set 'find-ref func ["Search references to/thru a given value" 
        [catch] 
        target "Value to find" 
        /cont {Start the search from this object (default: system/words)} ctx [object!] 
        /circ "Print also circular references" 
        /only "Return only the first path found" 
        /body "Search also in function body" 
        /result "Return result in a block" 
        /exclude "Exclude from search" custom [block!] 
        /local delayed delayedp past pastn print inof form-path same? visited res
    ] [
        print: func [x] [all [not result system/words/print :x]] 
        form-path: func [x] [replace/all form :x " " "/"] 
        same?: func [a [any-type!] b [any-type!]] [
            if all [error? :a error? :b] [return (disarm :a) = disarm :b] 
            if any [error? :a error? :b] [return false] 
            not error? try [return system/words/same? :a :b]
        ] 
        inof: func [
            item [object! block! paren! function!] name [string!] target 
            /local names values fin fiv ret trovati tmp
        ] [
            if find/only visited :item [return false] 
            insert/only tail visited :item 
            either object? :item [
                names: next first :item 
                values: next second :item
            ] [
                if function? :item [item: second :item] 
                if error? try [names: make block! length? :item] [return false] 
                repeat i length? :item [insert tail names i] 
                values: :item
            ] 
            insert/only tail past :item 
            insert tail pastn name 
            trovati: copy [] 
            while [not tail? :names] [
                if not unset? first :values [
                    fin: form first :names 
                    error? fiv: first :values 
                    if any [
                        all [
                            any-word? :target 
                            object? :item 
                            same? in :item first names :target
                        ] 
                        same? :fiv :target 
                        either any-word? :fiv [
                            all [
                                value? :fiv 
                                same? get/any :fiv :target
                            ]
                        ] [
                            all [
                                any-path? :fiv 
                                any [
                                    all [
                                        any-word? :target 
                                        same? first :fiv :target
                                    ] 
                                    all [
                                        any-path? :target 
                                        (length? :fiv) >= length? :target 
                                        equal? copy/part :fiv length? :target :target 
                                        same? first :fiv first :target
                                    ] 
                                    all [
                                        value? first :fiv 
                                        same? get/any first :fiv :target
                                    ]
                                ]
                            ]
                        ]
                    ] [
                        insert tail trovati reduce [copy past copy head insert tail pastn fin] 
                        print tmp: form-path next pastn 
                        remove back tail pastn 
                        insert tail res tmp 
                        if only [return true]
                    ] 
                    if any [
                        block? :fiv 
                        object? :fiv 
                        paren? :fiv 
                        all [body function? :fiv fin: join fin "/[BODY]"]
                    ] [
                        either find past :fiv [
                            if circ [
                                insert/only tail delayed :fiv 
                                insert/only tail delayedp join pastn fin
                            ]
                        ] [
                            all [ret: inof :fiv fin :target only return true]
                        ]
                    ]
                ] 
                names: next :names 
                values: next :values
            ] 
            remove back tail pastn 
            remove back tail past 
            if circ [
                foreach [past pastn] trovati [
                    if not empty? past [
                        repeat i length? delayed [
                            if tmp: find past delayed/:i [
                                insert tail res tmp: form-path next join delayedp/:i skip pastn index? tmp 
                                print ["^-" tmp]
                            ]
                        ]
                    ]
                ]
            ] 
            :ret
        ] 
        custom: head insert tail copy [self cb :find-ref] any [custom []] 
        if all [only any [result circ]] [throw make error! "Invalid Refinements"] 
        insert insert tail visited: make block! 10000 reduce custom reduce [
            visited past: make block! 25 pastn: make block! 25 res: make block! 100
        ] 
        if circ [insert insert tail visited delayed: make block! 100 delayedp: make block! 100] 
        any [cont ctx: system/words] 
        inof ctx either cont ["Context"] ["system/words"] :target 
        visited: pastn: custom: delayed: delayedp: none 
        either only [first res] [either result [:res] [none]]
    ] 
    set 'find-global func [f [function!] /local w out code] [
        out: copy [] 
        code: [if global? :w [if value? :w [if any-function? get :w [return]] insert tail out to-word :w]] 
        parse second :f r: [
            any [
                into r | 
                set w [word! | get-word! | set-word! | set-word!] (do code) | 
                set w [path! | set-path! | lit-path!] (w: first :w do code) | 
                skip
            ]
        ] 
        out
    ] 
    test-value: func [x [any-type!]] [
        if not value? 'x [return -2] 
        if error? :x [return 0] 
        if all [any-block? :x error? try [tail? :x]] [return -1] 
        1
    ] 
    get-all: func [
        "Get any value of a path or of a word" 
        w [path! set-path! lit-path! any-word!]
    ] [
        either error? set/any 'w either any-word? :w [get/any :w] [get-path/anyv/ignore :w] [return :w] [:w]
    ] 
    get-path: func [
        "Get the value of a path of a word" 
        path [path! set-path! lit-path!] 
        /anyv "Like /any in get/any" 
        /ignore "Ignore functions refinements" 
        /local b e get-in res
    ] [
        get-in: func [p w [word! get-word! integer!]] [
            if get-word? :w [
                if error? try [w: get :w] [make error! reduce ['script 'no-value :w]]
            ] 
            any [
                if all [integer? :w any-block? :p] [
                    if error? try [error? set/any 'res pick :p :w] [make error! reduce ['script 'out-of-range :w]] 
                    true
                ] 
                if all [word? :w object? :p] [
                    if error? try [error? set/any 'res get/any in :p :w] [make error! reduce ['script 'invalid-path :w]] 
                    true
                ] 
                if any [block? :p hash? :p] [
                    all [set-word? :w w: to-word :w] 
                    if any [
                        not p: find :p :w 
                        error? try [error? set/any 'res select :p :w]
                    ] [make error! reduce ['script 'invalid-path :w]] 
                    true
                ] 
                if any-function? :p [if ignore [return :p] false] 
                if find [pair! file! url! date! time! tuple! email! event! money! image! struct!] type?/word :p [
                    if error? try [return p/:w] [make error! reduce ['script 'invalid-path :w]] 
                    true
                ] 
                make error! reduce ['script 'invalid-path :w]
            ] 
            if error? get/any 'res [return get/any 'res] 
            get/any 'res
        ] 
        b: first head insert/only copy [] :path 
        if error? try [error? e: get first :b] [make error! reduce ['script 'no-value first :b]] 
        while [b: next :b not tail? :b] [error? set/any 'e get-in :e first :b] 
        if all [not value? 'e not anyv] [make error! reduce ['script 'no-value :path]] 
        if error? get/any 'e [return get/any 'e] 
        get/any 'e
    ] 
    any-path?: func [x [any-type!]] [any [path? :x set-path? :x lit-path? :x]] 
    v-c: func [
        x [any-word! path! lit-path! set-path!] 
        /local res b-x t
    ] [
        res: copy [] 
        if any-path? :x [
            if empty? x: head :x [return res] 
            x: first :x
        ] 
        t: third :bind 
        change t/words reduce [block! any-word!] 
        change t/known-word reduce [any-word!] 
        foreach y first system/words [if not same? y b-x: bind y :x [insert tail res b-x]] 
        change t/words reduce [block! word!] 
        change t/known-word reduce [word!] 
        res
    ] 
    bindall: func [
        "Binds words to a specified context." 
        words [block! any-word!] "A block of words or single word." 
        known-word [any-word!] "A sample word from the target context." 
        /copy "Deep copies block before binding it." 
        /local t res
    ] [
        t: third :bind 
        change t/words reduce [block! any-word!] 
        change t/known-word reduce [any-word!] 
        res: either copy [bind/copy :words :known-word] [bind :words :known-word] 
        change t/words reduce [block! word!] 
        change t/known-word reduce [word!] 
        :res
    ] 
    inall: func [
        "Returns the word in the object's context." 
        object [object!] 
        word [any-word!] 
        /local t res
    ] [
        t: third :in 
        change t/word reduce [any-word!] 
        res: in object :word 
        change t/word reduce [word!] 
        :res
    ] 
    undefined?: func [x [any-word! set-path! lit-path! path!]] [
        if any-path? :x [
            if empty? x: head :x [return true] 
            x: first :x
        ] 
        error? try [error? get/any :x]
    ] 
    global?: func [x [any-word! set-path! lit-path! path!]] [
        if any-path? :x [
            if empty? x: head :x [return false] 
            x: first :x
        ] 
        same? :x first bind use reduce [:x] reduce [reduce [:x]] 'system
    ] 
    context?: func [x [any-word! set-path! lit-path! path!]] [
        any [
            if undefined? :x ["Undefined"] 
            if global? :x ["Global"] 
            "Local"
        ]
    ] 
    same-any?: func [x [any-type!] y [any-type!]] [
        found? any [
            all [not value? 'x not value? 'y] 
            all [
                value? 'x 
                value? 'y 
                same? :x :y
            ]
        ]
    ] 
    equal-bc?: func [x y] [
        if all [
            equal? type? x type? y 
            equal? length? x: head x length? y: head y
        ] [
            while [not tail? x] [
                if not same-any? first x first y [return false] 
                x: next x 
                y: next y
            ] 
            if tail? y [return true]
        ] 
        false
    ] 
    type-any?: func ['x [word!] /word] [
        either word [type?/word get/any :x] [type? get/any :x]
    ] 
    try-err: func [[throw] blk /local err] [
        either error? set/any 'err try blk [
            err: disarm err 
            print ["** Error: " reduce bind compose [(get err/id)] in err 'id] 
            print ["** Near: " err/near] 
            err
        ] [none]
    ] 
    confine: func [blk /local interrupt] [
        interrupt: on 
        error? do does [error? loop 1 [error? catch [do blk interrupt: off]]] 
        interrupt
    ] 
    dump-as-style: func [
        ss "Face to dump as style" 
        /name new [word!] "Use this name for the cloned style" 
        /local facets h
    ] [
        if not name [new: 's] 
        either ss/facets [
            parse/all facets: copy/deep ss/facets [
                thru 'with into [
                    any [
                        thru words: into [
                            any [
                                h: function! (change/only h second first h) 
                                | skip
                            ]
                        ]
                    ]
                ]
            ] 
            compose [(ss/style) (facets)]
        ] [reduce [ss/style]]
    ] 
    charset-to-char: func [
        "Converts charset to a block of commented chars" 
        data [bitset!] 
        /block "Return a block" 
        /local out
    ] [
        out: make string! 1000 
        for i 0 255 1 [if find data i [insert tail out rejoin [mold to char! i " ; " i "^/"]]] 
        either block [to-block out] [out]
    ] 
    sub-set?: func [a b] [equal? a intersect a b] 
    charset-analyzer: func [
        "" 
        data [bitset!] 
        /local out print alpha num alphanum notalphanum ascii notascii
    ] [
        out: make string! 1000 
        print: func [x] [insert tail out join x "^/"] 
        alpha: make bitset! [#"a" - #"z" #"A" - #"Z"] 
        num: make bitset! [#"0" - #"9"] 
        alphanum: union alpha num 
        notalphanum: complement alphanum 
        ascii: charset [#"^@" - #"^~"] 
        notascii: complement ascii 
        print either (length? charset-to-char/block data) < (- 24 + length? charset-to-char/block complement data) ["Charset include:"] [data: complement data "Charset exclude:"] 
        if sub-set? ascii data [data: difference data ascii print "^-All ASCII chars"] 
        if sub-set? notascii data [data: difference data notascii print "^-All not ASCII chars"] 
        either sub-set? alphanum data [print "^-Alphanum" data: difference data alphanum] [
            if sub-set? alpha data [data: difference data alpha print "^-Alpha"] 
            if sub-set? num data [data: difference data num print "^-Num"]
        ] 
        if not equal? data charset "" [
            print "^-Single chars: [" 
            print rejoin [charset-to-char data "]"]
        ] 
        out
    ] 
    my-styles: stylize [
        btn: button 44 basecol edge [size: 1x1] with [
            append init [
                color: basecol 
                if :action [
                    action: func [f v /local x] compose [
                        all [x: not f/state f/state: on show f] 
                        (:action) f v 
                        eat/only [key] 
                        if x [f/state: off show f]
                    ]
                ] 
                if :alt-action [
                    alt-action: func [f v /local x] compose [
                        all [x: not f/state f/state: on show f] 
                        (:alt-action) f v 
                        eat/only [key] 
                        if x [f/state: off show f]
                    ]
                ]
            ]
        ] 
        tgl: toggle basecol edge [size: 1x1] with [
            append init [
                color: basecol 
                if :action [action: func [f v] compose [(:action) f v eat/only [key]]]
            ]
        ] 
        check: check feel [
            o-e: :engage 
            engage: func [f a e /oc] [
                oc: f/color 
                f/color: red 
                show f 
                o-e f a e 
                f/color: oc 
                show f
            ]
        ] with [
            append init [
                if :action [action: func [f v] compose [(:action) f v eat/only [key]]]
            ]
        ] 
        auto-panel: IMAGE with [
            feel: none 
            size: -1x-1 
            append init [
                insert action: second :action [origin 0x0] 
                pane: layout/parent/styles action self styles 
                if negative? size/x [size/x: pane/size/x + either edge [edge/size/x * 2] [0]] 
                if negative? size/y [size/y: pane/size/y + either edge [edge/size/y * 2] [0]] 
                pane: pane/pane
            ]
        ] 
        area-scroll: area edge [size: 1x1] with [
            ar: sld: none 
            redrag: does [sld/state: none sld/redrag min 1 (second page-size) / second size-text ar] 
            page-size: does [ar/size - either ar/edge [2 * ar/edge/size] [0]] 
            resize: func [newsize /local delta] [
                delta: newsize - size 
                size: newsize 
                ar/size: ar/size + delta 
                sld/offset: delta * 1x0 + sld/offset 
                either in sld 'resize [sld/resize delta * 0x1 + sld/size] [
                    sld/size: delta * 0x1 + sld/size 
                    redrag
                ]
            ] 
            update: func [/text txt] [
                if text [self/text: ar/text: txt] 
                ar/user-data: none 
                ar/line-list: none 
                sld/data: 0 
                ar/para/scroll: 0x0 
                redrag 
                show [ar sld]
            ] 
            append init [
                self/init: [] 
                para: make para [] 
                pane: reduce [
                    ar: make-face/size/offset self size - 16x0 0x0 
                    sld: make-face/size/offset/spec 
                    either find styles 'scroller ['scroller] ['slider] 16x0 + (size * 0x1) ar/size * 1x0 [
                        action: func [face action] [scroll-para ar face] 
                        effect: [gradient 200.200.200 230.230.230]
                    ]
                ] 
                feel: make ar/feel [
                    old-e: :engage 
                    detect: func [f e] [if e/type = 'down [view*/focal-face: ar/parent-face] e] 
                    engage: func [face act event] [
                        either find [scroll-line scroll-page] act [
                            sld/data: min 1 max 0 sld/data + min 1 
                            (either act = 'scroll-line [ar/font/size] [second page-size]) 
                            * (second event/offset) / second (size-text ar) 
                            scroll-para ar sld 
                            show sld
                        ] [
                            view*/caret: either ar/user-data [ar/user-data] [ar/text] 
                            view*/focal-face: ar 
                            old-e ar act event 
                            if view*/focal-face = ar [
                                ar/user-data: view*/caret 
                                sld/data: (abs second caret-to-offset ar ar/text) / max 1 (second size-text ar) - (second page-size) 
                                redrag 
                                show sld 
                                view*/focal-face: ar/parent-face
                            ]
                        ]
                    ]
                ] 
                ar/feel: none 
                flags: exclude flags [font para] 
                image: edge: effect: none 
                update
            ]
        ]
    ] 
    port2ob: func [port [port!] /local x x2 nuovalinea before err line h value tmp tmp2 new] [
        tmp: port/state/inbuffer 
        tmp2: port/state/outbuffer 
        port/state/inbuffer: port/state/outbuffer: none 
        x: mold port 
        port/state/inbuffer: tmp 
        port/state/outbuffer: tmp2 
        while [error? err: try [load x]] [
            xl: parse/all x "^/" 
            err: disarm err 
            parse/all err/near ["(line " thru ") " copy line to end] 
            parse line [copy before thru ": " copy value to end] 
            either value [
                nuovalinea: rejoin [before {"} "*** CHANGED WAS: " to-string value {"}] 
                x2: find x line 
                remove/part x2 length? line 
                insert x2 nuovalinea
            ] [make error! "can't list this port"]
        ] 
        parse/all x [
            any [
                set-word! h: " unset" (h: change/part h {"*** CHANGED WAS: unset"} 6) :h 
                | h: "make object! [...]" (h: change/part h "self" 18) :h 
                | skip
            ]
        ] 
        new: do x 
        new/state/inbuffer: either string? port/state/inbuffer [form port/state/inbuffer] [port/state/inbuffer] 
        new/state/outbuffer: either string? port/state/outbuffer [form port/state/outbuffer] [port/state/outbuffer] 
        new
    ] 
    get-item: func [item [object!] name [string!] /local ob x tmp] [
        either item/expandblk [
            if error? set/any 'tmp get-path/anyv/ignore first bind to-block head insert copy name "item/ob/" 'item [return :tmp] 
            get/any 'tmp
        ] [
            ob: item/ob 
            if error? ob [ob: disarm ob] 
            either object? ob [
                if error? set/any 'x get/any in ob first to-block name [x: disarm x] 
                get/any 'x
            ] [
                either event? ob [
                    get-path/anyv/ignore head change back tail 'ob/fake first to-block name
                ] [
                    if error? set/any 'x pick ob to-integer name [x: disarm x] 
                    get/any 'x
                ]
            ]
        ]
    ] 
    pathstr: func [item [object!]] [rejoin [item/pathto either item/pathto <> "" ["/"] [""] item/obname]] 
    intest: func [linea] [linea: parse linea none rejoin [linea/1 " " linea/2]] 
    clip: func [data /local ritorno] [
        ritorno: copy "" 
        foreach item data [insert tail ritorno join item "^/"] 
        write clipboard:// ritorno
    ] 
    clipname: func [ctx /local value] [
        value: either string? ctx/f-lista/picked/1 [value: first parse ctx/f-lista/picked/1 none] [""] 
        value: rejoin [pathstr ctx/f-lista/actual-item "/" value] 
        write clipboard:// value
    ] 
    alerta: func [testo face [object!] /local old] [
        old: face/text 
        face/text: rejoin ["ATTENTION:  " testo "  !!"] 
        face/color: red 
        show face 
        face/color: pewter 
        face/text: old
    ] 
    change-sn: func [
        {Change the first item displayed in a text-list and redrag the slider} 
        face whe /local len
    ] [
        len: length? face/texts 
        if face/sn >= whe [face/sn: max 0 min len - face/lc whe - 1] 
        if face/sn <= (whe - face/lc) [face/sn: max 0 (whe - face/lc)] 
        face/sld/state: none 
        face/sld/data: face/sn / max 1 (len - face/lc) 
        face/sld/redrag min 1 face/lc / max 1 len
    ] 
    where?: func [
        "Find the position of the first picked item if any" 
        lista [object!]
    ] [
        either lista: find lista/texts lista/picked/1 [index? lista] [1]
    ] 
    move-to: func [lista [object!] where [integer! none!]] [
        if where [
            insert clear lista/picked pick lista/texts where 
            change-sn lista where 
            show lista
        ]
    ] 
    find-parse-list: func [lista [object!] value [string!] offset [integer!]] [
        repeat x length? lista/texts [
            if value = pick parse pick lista/texts x none offset [move-to lista x exit]
        ]
    ] 
    find-into-list: func [
        "Find/match a text-list" 
        lista [object!] search [string!] pos [integer!]
    ] [
        move-to lista pos: find-into at lista/texts pos + 1 search 
        pos
    ] 
    scroll-to: func [
        "Scroll an area with slider and show them" 
        area slider text
    ] [
        text: (caret-to-offset area text) - area/para/scroll 
        area/para/scroll: min 0x0 area/size / 2 - text 
        slider/data: (second text) / max 1 second size-text area 
        show [slider area]
    ] 
    find-area: func [
        {Find text in an area-scroll, highlight, scroll and focus, return the new position} 
        area search [string!] pos "start position" case
    ] [
        if not empty? search [
            focus area/ar 
            pos: any [pos view*/caret head area/text] 
            if pos: refine-do [find pos search] [case] [
                view*/highlight-start: view*/caret: pos 
                view*/highlight-end: pos: find/tail pos search 
                scroll-to area/ar area/sld pos
            ]
        ] 
        pos
    ] 
    viewcolors: has [out x n] [
        out: copy [] 
        parse second system/words [
            any [
                to tuple! x: (
                    if all [tuple? x/1 3 = length? x/1] [
                        insert insert tail out pick first system/words index? x x/1
                    ]
                ) skip
            ]
        ] 
        sort/skip/compare out 2 [2] 
        n: 0 
        x: copy [across origin 5x5 space 1x1 styles my-styles style box box 75x55 font-size 11] 
        foreach [name color] out [
            insert tail x compose [box as-is (rejoin [form name newline color]) (color)] 
            n: n + 1 
            if (n // 7) = 0 [insert tail x 'return]
        ] 
        insert tail x [return btn "Close" [munview/only x]] 
        mview/new x: layout x
    ] 
    refine: func [command [block!] refinement [block!] /with "Ignore refinement value" /local path] [
        command: head change/only copy command path: to path! first command 
        foreach item refinement [
            either block? item [
                if any [with get first item] [
                    insert tail :path first item 
                    insert tail command next item
                ]
            ] [
                if any [with get item] [insert tail :path item]
            ]
        ] 
        command
    ] 
    refine-do: func [command [block!] refinement [block!]] [do refine command refinement] 
    do-key-face: func [event /local face] [
        if face: find-key-face event/face event/key [
            if get in face 'action [do-face face event/key] 
            return none
        ] 
        event
    ] 
    window-feel: make object! [
        redraw: none 
        detect: func [face event /user-data] [
            all [
                object? user-data: event/face/user-data 
                find [key resize close scroll-line] event/type 
                in user-data event/type 
                return do refine/with [user-data event] reduce [event/type]
            ] 
            either event/type = 'key [do-key-face event] [event]
        ] 
        over: none 
        engage: none
    ] 
    mview: func [panel [object!] /new /offset xy /title text /options opts] [
        either stopmode [
            panel/feel: window-feel 
            panel/text: either title [text] [copy "AnaMonitor-Stop"] 
            panel/offset: either offset [xy] [view*/screen-face/size - panel/size / 2] 
            all [options panel/options: append any [panel/options copy []] opts] 
            show-popup panel 
            do-events
        ] [
            refine-do [view/new panel] [[offset xy] [title text] [options opts]] 
            panel/feel: window-feel 
            any [new do-events]
        ]
    ] 
    munview: func [/only face] [
        all [only not object? face exit] 
        if all [any [view*/pop-face stopmode] only face <> view*/pop-face] [exit] 
        either stopmode [hide-popup] [refine-do [unview] [[only face]]]
    ] 
    anahelp: func [ctx /local ar sld] [
        munview/only ctx/helpface 
        ctx/helpface: layout [
            origin 10x10 styles my-styles backcolor backcol 
            space 2 
            across 
            ar: area-scroll 600x370 - 16x0 203.204.205 203.204.205 help-string 
            bold font-name font-fixed wrap feel [engage: none] 
            keycode [f1 #"^["] [munview/only ctx/helpface] 
            return 
            tgl 120 basecol "License" "Help" [
                either not value [ar/update/text help-string] [
                    header/license: any [
                        header/license 
                        all [
                            any [
                                all [exists? %gpl.txt read %gpl.txt] 
                                all [exists-thru? http://www.rebol.it/~romano/gpl.txt read-thru http://www.rebol.it/~romano/gpl.txt] 
                                request-download http://www.rebol.it/~romano/gpl.txt 
                                all [exists-thru? http://www.gnu.org/licenses/gpl.txt read-thru http://www.gnu.org/licenses/gpl.txt] 
                                request-download http://www.gnu.org/licenses/gpl.txt 
                                header/rights
                            ]
                        ]
                    ] 
                    ar/update/text either none? header/license [header/rights] [to string! header/license]
                ] 
                focus ar
            ] 
            do [focus ar]
        ] 
        mview/new/offset ctx/helpface ctx/ly/offset + 13x25
    ] 
    my-choose: func [texts f panel offset size ali /local old old-e] [
        size: size - 0x4 
        old: get in svvf/choice-iterator 'engage 
        svvf/choice-iterator/engage: func [face act event] [
            either event/type = 'down [
                either all [face/selected face/selectable] [act: face/pane-parent hide-popup do-face face act] [hide-popup] 
                svvf/choice-iterator/engage: :old
            ] [show face]
        ] 
        offset: max 0x0 min offset panel/size - (size * 1x0) - (size * 0x1 * length? texts) 
        old-e: svv/choice-face/edge 
        svv/choice-face/edge: make panel/edge [effect: 'bevel size: 1x1] 
        choose/window/offset/style texts :f panel offset 
        make-face/size/spec/clone 'button size compose/deep [
            colors: [(basecol) (orange - 20.20.20)] 
            font: make font [shadow: none align: (to-lit-word ali) size: 11] 
            para: make para [wrap?: false] 
            edge: none
        ] 
        svv/choice-face/edge: old-e
    ] 
    preferences: func [ctx /local sv useprefs prefs ly-pref-b h] [
        useprefs: has [ly-old actual-item] [
            basecol: prefs/base-color 
            backcol: prefs/back-color 
            ly-old: ctx/ly 
            actual-item: ctx/f-lista/actual-item 
            ctx/make-ly 
            ctx/f-lista/actual-item: actual-item 
            ctx/refresh 
            munview/only ly-old 
            mview/new/options/offset/title ctx/ly 'resize ly-old/offset ctx/title 
            munview/only ctx/ly-pref
        ] 
        prefs: ctx/prefs 
        sv: make prefs [] 
        ly-pref-b: [
            styles my-styles 
            backcolor backcol 
            across 
            check prefs/dbcl [prefs/dbcl: value] h4 "Double-click" return 
            check prefs/novalue [prefs/novalue: value] h4 "Show values of words" return 
            check prefs/nounset [prefs/nounset: value] h4 "Hide unset" return 
            check prefs/sort [prefs/sort: value] h4 "Sort list by" 
            h: at 
            h4 45 white backcol middle center pewter prefs/sortby [
                my-choose 
                ["Name" "Type"] 
                func [f b] [face/text: prefs/sortby: copy f/text] 
                ctx/ly-pref 
                h + 0x18 
                45x20 
                'center
            ] 
            return 
            check prefs/expandblk [prefs/expandblk: value] h4 "Expand nested blocks" return 
            h4 150 "Indent expanded blocks:" 
            field 40x21 form prefs/ind [
                error? try [prefs/ind: min 12 max 0 to-integer face/text] 
                face/text: form prefs/ind show face
            ] 
            return 
            h4 150 "List font size:" 
            field 40x21 form prefs/fontsize [
                error? try [prefs/fontsize: max 4 to-integer face/text] 
                face/text: form prefs/fontsize show face
            ] 
            return 
            h4 "When click on func:" 
            text "view" pad -4x2 
            check found? find prefs/on-function 'view [alter prefs/on-function 'view] 
            pad 0x-2 text "list" pad -4x2 
            check found? find prefs/on-function 'list [alter prefs/on-function 'list] 
            return 
            h4 "Back color" pad 0x-4 
            box backcol 25x25 edge [size: 1x1 color: black effect: none] [
                if value: request-color/color face/color [
                    face/color: prefs/back-color: value
                ]
            ] 
            pad 14x4 h4 "Base color" pad 0x-4 
            box basecol 25x25 edge [size: 1x1 color: black effect: none] [
                if value: request-color/color face/color [
                    face/color: prefs/base-color: value
                ]
            ] 
            return 
            pad 0x10 
            btn 50 "Save" [save ctx/fileprefs third prefs useprefs] 
            btn 50 "Use" [useprefs] 
            btn 50 "Cancel" #"^[" [ctx/prefs: sv munview/only ctx/ly-pref]
        ] 
        munview/only ctx/ly-pref 
        ctx/ly-pref: center-face/with layout ly-pref-b ctx/ly 
        mview/new/title ctx/ly-pref "Preferences"
    ] 
    help-string: rejoin [
        header/title join " by " header/author newline 
        "Version: " header/version " " header/date newline 
        "Report bugs and wish to : " header/email newline 
        header/copyright newline 
        {
Anamonitor can be started with:

^-do %anamonitor.r
or

^-do/args %anamonitor.r system/view

or you can put in user.r

^-do/args %anamonitor.r false ;to not show the window

and then you can use one of:

^-monitor
^-^-to list the system object
^-monitor <word/path>
^-^-to list <word/path> (object/block/function/port)
^-mon <arg>
^-^-to list the evaluated <arg> (object/block/function/port)
^-stop <arg>
^-^-to list the evaluated <arg> (object/block/function/port)
^-^-Stop works in Modal Mode, so can be called inside
^-^-the action of a face to stop event handling until Anamonitor
^-^-window is closed (esc key)
^-^-(Modal Mode is also activated when an user pop-face is displayed)

^-^-^-Buttons and Menu

^-*                  = menu with standard object
^-!                  = menu for the listed object
^-Menu               = global menu
^-right-click        = popup menu for the selected item
^-<      = left      = go back in the history
^->      = right     = go forward in the history
^-Pr/Vi  = F4 = ^^P   = probe or view the block/function/face...
^-exe    = F2 = ^^E   = edit and execute a command
^-new                = open a new window (right-click open a new shell)
^-prefs  = F8        = open preferences window
^-expand = ^^B        = expand nested blocks (and refresh)
^-unset  = ^^U        = hide the unset values (and refresh)
^-sort   = ^^S        = sort the list (and refresh)
^-help  = F1         = open the help window
^-find references    = find references to/thru item
^-find references (func) = search also in func body
^-ctrl-t             = tile windows

^-^-^-^-Others keys

^-F9 ^^R              = refresh the list
^-^^C                 = copy whole list to the clipboard
^-^^X                 = copy selected item's path to the clipboard
^-up down            = move up/down
^-page-down page-up  = move one page up/down
^-home end           = start or end of list
^-space return       = list the selected item
^-esc                = close the window (in stop mode also the main window)
^-shift-tab          = cycle window (not available in stopmode)

^-click item         = list or view the item
^-right-click item   = open a popup menu for the item

^-^-^-^-Notes

^-port! and event! are listed with a trick
^-error! are listed disarmed
^-Modal (awake-event) system is patched to correct some bugs.
^-Win-offset? is patched to correct some bugs.

^-^-^-^-Abbreviations used in names

^-get()  = get a word
^-getp() = get a path
^-fh()   = function header   (ex. third :source)
^-fb()   = function body     (ex. second :source)
^-fl()   = function locals   (ex. first :source)
^-hd()   = head of block
^-ctx()  = context of a word (show only standard loaded words)

^-^-^-^-Other utilities

^-Find-ref is a function to find references to a given value, use

^-^-help find-ref

^-from the console. Es.
^-
^-^-find-ref/body system/view
^-

^-^-^-^-Examples

^-do/args %anamonitor false
^-view layout ly: [
^-^-button "Stop" [
^-^-^-stop [ly face value]
^-^-]
^-^-button "Mon" [
^-^-^-mon [ly face value]
^-^-]
^-]
}
    ] 
    cb: [
        itemob: context [ob: trueob: obname: truename: pathto: type: sorted: sortby: nounset: refresh: listall: expandblk: engage-cases: none whe: 1 listanomi: copy []] 
        ly: ly-exe: ly-pref: helpface: subface: 
        f-lista: f-text: f-intest: f-sort: f-unset: f-panel: f-expand: 
        h: none 
        search: "" 
        case: false 
        sf-off: 40x40 
        linelen: 200 
        cntype: 10 cnname: 21 cnblock: 4 cnblock-expanded: 14 
        histem: copy [] 
        fileprefs: system/script/path/anampref.r 
        prefs: context [
            dbcl: true 
            sort: false 
            fontname: font-fixed 
            fontsize: 12 
            wsize: 630x435 
            woffset: 50x50 
            nounset: false 
            sortby: "Name" 
            novalue: false 
            expandblk: true 
            ind: 4 
            on-function: [list view] 
            base-color: navy 
            back-color: pewter 
            shortcut: [
                "Words" "system/words" 
                "System" "system" 
                "Options" "system/options" 
                "Script" "system/script" 
                "User" "system/user" 
                "Screen" "system/view/screen-face" 
                "Windows" "system/view/screen-face/pane" 
                "View" "system/view" 
                "Vid" "svv" 
                "Vid Colors" "svv/vid-colors" 
                "Vid Feel" "svvf" 
                "Vid Styles" "svv/vid-styles" 
                "Header" "header-rules" 
                "Net-utils" "net-utils" 
                "Mail-list-rules" "mail-list-rules"
            ]
        ] 
        wsize: prefs/wsize 
        sfsize: prefs/wsize - 25x25 
        ly-exesize: prefs/wsize - 100x150 
        listable: copy [
            object! 'oblist 
            port! 'portlist 
            block! 'blklist 
            paren! 'blklist 
            hash! 'blklist 
            list! 'blklist 
            event! 'evlist 
            function! 'none 
            action! 'none 
            op! 'none 
            native! 'none
        ] 
        listable?: func [x [any-type!]] [find listable type?/word get/any 'x] 
        listall: func [item [object!] /local x] [
            if x: select listable to-word mold item/type [
                item/listanomi: copy [] 
                item/sorted: item/nounset: item/expandblk: false 
                if x: do x item [item/listall: copy item/listanomi] 
                return x
            ]
        ] 
        portlist: func [item /local attrs tipo altro] [
            if not port? item/ob [item/ob: item/ob/self] 
            if error? try [item/ob: port2ob attrs: item/ob] [
                alerta "Can't list this port" f-intest 
                viewface/fixed pathstr item rejoin ["port " mold item/ob] 
                return false
            ] 
            item/ob/self: attrs 
            item/tipo: 'port! 
            attrs: next second item/ob 
            foreach el next first item/ob [
                tipo: type? first attrs 
                altro: blobval first attrs 
                insert tail item/listanomi rejoin [lef el cnname " " lef tipo cntype " : " altro] 
                attrs: next attrs
            ] 
            true
        ] 
        oblist: func [item /local attrs tipo altro] [
            attrs: second item/ob 
            foreach el first item/ob [
                tipo: type? first attrs 
                altro: blobval first attrs 
                insert tail item/listanomi rejoin [lef el cnname " " lef tipo cntype " : " altro] 
                attrs: next attrs
            ] 
            true
        ] 
        evlist: func [item /local attrs tipo altro] [
            evfield: [item/ob/type item/ob/time item/ob/face item/ob/offset item/ob/key item/ob/control item/ob/shift item/ob/double-click] 
            attrs: reduce evfield 
            foreach el evfield [
                tipo: type? first attrs 
                altro: either unset? first attrs ["unset"] [either tipo <> error! [blobval first attrs] [clickme]] 
                insert tail item/listanomi rejoin [lef last :el cnname " " lef tipo cntype " : " altro] 
                attrs: next attrs
            ] 
            true
        ] 
        expand-block: func [
            blk [block! paren! hash! list!] 
            name [string! none!] 
            dest [block! none!] 
            ind [string! none!] 
            /history hist [block! none!] 
            /local altro el save el-name s-index
        ] [
            save: does [
                insert/only tail dest rejoin [
                    lef el-name cnblock-expanded "  " lef type-any?/word el cntype ": " ind altro
                ]
            ] 
            dest: any [dest copy []] 
            name: any [name copy ""] 
            ind: any [ind copy ""] 
            hist: head any [hist copy []] 
            while [find/only hist :blk] [
                if same? head :blk head first hist [
                    el-name: join name 1 
                    el: :blk 
                    altro: "... (reflexion)" 
                    save 
                    return dest
                ] 
                hist: next hist
            ] 
            insert/only tail hist :blk 
            if error? try [s-index: subtract index? :blk 1] [
                el-name: join name 1 
                el: :blk 
                altro: out-range 
                return dest
            ] 
            while [not tail? :blk] [
                error? set/any 'el first :blk 
                el-name: join name subtract index? :blk s-index 
                either find [block! paren! hash! list!] type-any?/word el [
                    either error? try [tail? :el] [
                        altro: rejoin [either paren! = type-any? el [out-range] ["[out-of-range]"]] 
                        save
                    ] [
                        altro: rejoin [either paren! = type-any? el ["("] ["["]] 
                        save 
                        expand-block/history :el join el-name "/" dest join ind head insert/dup copy "" " " prefs/ind hist 
                        change altro either paren! = type-any? el [")"] ["]"] 
                        save
                    ]
                ] [
                    altro: either error? try [
                        set/any 'altro get/any 'el
                    ] [copy clickme] [copy blobval get/any 'altro] 
                    save
                ] 
                blk: next :blk
            ] 
            dest
        ] 
        blklist: func [item /local x] [
            if error? try [if 0 = length? item/ob [return false]] [return false] 
            either any [all [prefs/expandblk item/tipo <> 'references] item/tipo = 'funcbody item/tipo = 'funcheader] [
                item/listanomi: expand-block item/ob none none none 
                item/expandblk: true
            ] [
                x: 0 
                foreach el item/ob [
                    x: x + 1 
                    insert tail item/listanomi rejoin [
                        rig x cnblock "  " lef type-any?/word el cntype ": " blobval get/any 'el
                    ]
                ]
            ] 
            true
        ] 
        face?: func [x [any-type!]] [
            all [
                object? :x 
                empty? exclude first system/words/face first x 
                value? in x 'type 
                x/type = 'face
            ]
        ] 
        probable: [block! funcbody funcheader funclocals] 
        viewprobe: func [item] [
            if error? try [
                either find probable item/tipo [
                    either find [funcbody funcheader funclocals] item/tipo [
                        viewface/fixed pathstr item rejoin [
                            "func " mold third get-path 'item/trueob mold second get-path 'item/trueob
                        ]
                    ] [viewface/fixed pathstr item mold item/ob]
                ] [if face? item/ob [faceview item/ob pathstr item]]
            ] [alerta "Error while probing" f-intest]
        ] 
        viewable: copy [
            function! native! action! op! 'funcview 
            string! email! tag! issue! 'stringview 
            binary! 'binaryview 
            bitset! 'bitsetview 
            image! 'imageview 
            tuple! 'tupleview 
            pair! 'pairview 
            url! file! 'fileurlview
        ] 
        viewable?: func [x [word!]] [if parse viewable [to x to lit-word! set x to end] [x]] 
        viewall: func [el pname [string!] /local x] [
            either x: viewable? type?/word :el [do x :el pname] [
                either face? :el [faceview :el pname] [none]
            ]
        ] 
        face-start: does [
            if subface [
                sf-off: subface/offset 
                if any [not stopmode view*/pop-face = subface] [munview/only subface] 
                subface: none
            ]
        ] 
        viewface: func [
            name [string!] text-data [string!] /fixed /nowrap /binary 
            /local h pos search xf sld ar case
        ] [
            case: false 
            face-start 
            subface: layout [
                origin 10x10 styles my-styles backcolor backcol 
                size sfsize space 2 
                across 
                btn "Copy" [write clipboard:// ar/data] 
                btn "Wrap" "^^W" #"^W" [
                    ar/para/wrap?: ar/para/wrap? xor true 
                    ar/update
                ] 
                btn "Font" "^^F" #"^F" [
                    ar/font/name: either ar/font/name = font-fixed [font-sans-serif] [font-fixed] 
                    ar/update
                ] 
                btn "Bin" "^^B" #"^B" [
                    ar/update/text either find ar/user-data 'binary [
                        remove find ar/user-data 'binary 
                        to-string load ar/text
                    ] [
                        append ar/user-data 'binary 
                        mold/only to-binary ar/text
                    ]
                ] 
                btn "Find" "f3" keycode [f3 #"^S"] [
                    search: either all [view*/highlight-start view*/highlight-end] [
                        copy/part view*/highlight-start view*/highlight-end
                    ] [""] 
                    h: false 
                    inform layout [
                        styles my-styles 
                        backcolor backcol 
                        across 
                        check case [case: face/data] h4 "Case" return 
                        xf: field as-is search [search: value h: true hide-popup] return 
                        btn 50 "OK" [search: xf/text h: true hide-popup] 
                        btn 50 "Cancel" [hide-popup] 
                        do [focus xf]
                    ] 
                    focus ar 
                    if h [pos: find-area ar search pos case]
                ] 
                btn "Next" "f4" keycode [f4 #"^N"] [
                    pos: find-area ar search pos case
                ] 
                btn "Tile" "^^t" keycode [#"^T"] [tile] 
                btn "Close" escape [munview/only subface] 
                return 
                h: at 
                ar: area-scroll sfsize - h - 10x10 snow snow 
                para [wrap?: either nowrap [false] [true]] 
                font [size: prefs/fontsize name: either fixed [font-fixed] [font-sans-serif]] 
                text-data 
                user-data clear []
            ] 
            if binary [append ar/user-data 'binary] 
            subface/user-data: make object! [
                resize: :resize-subface 
                area: :ar 
                min-size: window-mins/subface 
                key: func [event /local face] [
                    if none? either all [event/key = #"^-" event/shift] [
                        next-window event/face
                    ] [do-key-face event] [return none] 
                    event
                ]
            ] 
            focus ar 
            mview/new/offset/title/options subface sf-off name 'resize
        ] 
        funcview: func [f name /local ritorno] [
            ritorno: rejoin [name ": "] 
            if function? :f [insert tail ritorno "func "] 
            insert tail ritorno mold third :f 
            if function? :f [insert tail ritorno mold second :f] 
            viewface/fixed name ritorno
        ] 
        stringview: func [el name] [viewface rejoin [name " - " length? el] form el] 
        binaryview: func [el name] [viewface/binary/fixed rejoin [name " - " length? el] form el] 
        helpdata: none 
        helpview: func [el name /local out __|_*__|_ data safe file] [
            file: http://www.rebol.com/view/docs/ref-data.r 
            out: copy "" 
            safe: reduce [:prin :print] 
            prin: func [v] [insert tail out reform v ()] 
            print: func [v] [insert insert tail out reform v #"^/" ()] 
            __|_*__|_: :el 
            help __|_*__|_ 
            set [prin print] safe 
            replace/all out "__|_*__|_" last parse/all name "/" 
            any [
                helpdata 
                not connected? 
                all [exists-thru? file help2data: to-block read-thru file] 
                help2data: to-block request-download file
            ] 
            if all [
                help2data 
                data: select help2data to-block last parse/all name "/"
            ] [
                append out rejoin ["^/-------------" data/3 "-------------^/See also: " data/2 "^/-------------^/From " mold find/tail file "://" " - Copyright 2003 REBOL Technologies"]
            ] 
            viewface/fixed name out
        ] 
        fileurlview: func [el name /local tmp] [
            viewface/fixed name rejoin [
                "Form   : " {"} form :el {"} 
                "^/^/Mold   : " {"} mold/only :el {"} 
                "^/^/Binary : " to binary! :el 
                either url? :el [join "^/^/Decode : " mold/only decode-url :el] [join "^/^/Split  : " either error? try [tmp: mold/only split-path :el] ["Invalid file"] [tmp]]
            ]
        ] 
        bitsetview: func [el name] [
            viewface/fixed name rejoin [
                el 
                "^/^/" charset-analyzer el 
                "^/= make bitset! [^/" charset-to-char el "]^/" 
                "^/= complement make bitset! [^/" charset-to-char complement el "]^/"
            ]
        ] 
        pairview: func [el name] [
            if not any [
                el/x <= 0 el/y <= 0 
                el/x > view*/screen-face/size/x 
                el/y > view*/screen-face/size/y
            ] [
                face-start 
                subface: layout [
                    origin 10x10 styles my-styles backcolor backcol 
                    h4 font-size prefs/fontsize rejoin [name " : " :el] 
                    box :el yellow 
                    key #"^[" [munview/only subface]
                ] 
                mview/new/offset/title subface sf-off "Pair"
            ]
        ] 
        tupleview: func [el name /local tmp] [
            if 3 = length? el [
                face-start 
                if tmp: find second system/words el [tmp: pick first system/words index? tmp] 
                subface: layout [
                    origin 10x10 styles my-styles backcolor backcol 
                    h4 font-size prefs/fontsize reform [name ":" :el either tmp [rejoin ["(" tmp ")"]] [""]] 
                    box 90x90 edge [color: coal size: 2x2] :el 
                    key #"^[" [munview/only subface]
                ] 
                mview/new/offset/title subface sf-off "Tuple"
            ]
        ] 
        imageview: func [el name] [
            face-start 
            subface: layout [
                origin 10x10 styles my-styles backcolor backcol 
                h4 font-size prefs/fontsize name 
                box :el/size + 2x2 edge [size: 1x1] effect none :el 
                key #"^[" [munview/only subface]
            ] 
            mview/new/offset/title subface sf-off "Image"
        ] 
        faceview: func [el name] [
            if all [face? :el el/size el/size <> 0x0] [
                if image? el: to-image :el [imageview :el join "Image of face: " name]
            ]
        ] 
        if-error: func [try-blk [block!] error-blk [block!] /local x] [
            either error? set/any 'x try try-blk error-blk [:x]
        ] 
        blobval: func [x [any-type!] /nr /local tmp tmp2 x1 x2 code get-type] [
            code: [
                copy/part rejoin [
                    lef mold :x 25 
                    " [" 
                    context? :x 
                    either not undefined? :x [
                        rejoin [
                            " - " 
                            do get-type 
                            either any [not prefs/novalue nr not value? :x] [""] [
                                join " : " blobval/nr get/any 'tmp
                            ]
                        ]
                    ] [""] 
                    "]"
                ] linelen
            ] 
            switch test-value get/any 'x [
                -2 [return "unset"] 
                -1 [return "(out-of-range)"]
            ] 
            x1: [set 'tmp2 rejoin ["[" length? :x " " index? :x "/" length? head :x "]"]] 
            x2: [set 'tmp2 copy/part trim/lines mold :x linelen] 
            switch-m/default type?/word :x [
                block! hash! list! [do x1] 
                object! [copy/part rejoin ["[" length? first :x "] " mold first :x] linelen] 
                port! error! [clickme] 
                function! action! native! op! [copy/part trim/lines mold third :x linelen] 
                word! lit-word! set-word! get-word! refinement! [
                    get-type: [type? set/any 'tmp get/any :x] 
                    do code
                ] 
                path! lit-path! set-path! [
                    get-type: [if-error [type? set/any 'tmp get-path/anyv/ignore :x] ["??"]] 
                    do code
                ] 
                string! url! file! binary! tag! email! issue! [
                    copy/part rejoin [do x1 "  " do x2] linelen
                ]
            ] [do x2]
        ] 
        changelista: func [item /local tmp offsort x y] [
            if not find [funcbody] item/tipo [
                if prefs/nounset <> item/nounset [
                    item/listanomi: either prefs/nounset [
                        while [not tail? item/listanomi] [
                            item/listanomi: either equal? second parse first item/listanomi " " "unset" [
                                remove item/listanomi
                            ] [next item/listanomi]
                        ] 
                        head item/listanomi
                    ] [item/listall] 
                    item/nounset: prefs/nounset 
                    item/whe: 1
                ] 
                if all [
                    not all [block? item/ob item/expandblk prefs/sortby = "Name"] 
                    any [prefs/sort <> item/sorted prefs/sortby <> item/sortby]
                ] [
                    offsort: either select reduce [block! hash! list!] item/type [
                        offsort: either item/expandblk [cnblock-expanded] [cnblock] 
                        select reduce ["Name" 0 "Type" offsort + 2 "Value" offsort + 2 + cntype] prefs/sortby
                    ] [
                        select reduce ["Name" 0 "Type" cnname + 1 "Value" cnname + 1 + cntype] prefs/sortby
                    ] 
                    either prefs/sort [
                        sort/compare item/listanomi func [a b] [lesser? skip a offsort skip b offsort]
                    ] [item/listanomi: item/listall] 
                    item/sorted: prefs/sort 
                    item/sortby: prefs/sortby
                ]
            ] 
            item/whe: 1 
            if item/refresh [
                remove find back tail y: copy item/refresh "/" 
                x: item/listanomi 
                while [not tail? x] [
                    if find/match first x y [item/whe: index? x break] 
                    x: next x
                ] 
                item/refresh: none
            ] 
            f-intest/text: rejoin [
                index? histem "/" length? head histem " - " pathstr item " (" item/type ")"
            ] 
            f-lista/actual-item: item 
            f-lista/texts: f-lista/lines: f-lista/data: item/listanomi 
            f-lista/picked: reduce [pick f-lista/texts item/whe] 
            change-sn f-lista item/whe 
            show [f-intest f-lista]
        ] 
        selec-alt: func [offset new /menu /local item vc ctx newp x x-word blk tmp append-vc func-sel] [
            func-sel: func [tipo [word!]] [
                either menu [
                    if item/tipo <> tipo [
                        newlist/parent-path item/truename :x item tipo item/pathto
                    ]
                ] [newlist/parent-path new :x item tipo pathstr item]
            ] 
            blk: [
                "List In New Window" [
                    if error? :x [x: disarm :x] 
                    error? try append/only copy either stopmode [
                        [system/words/stop]
                    ] [
                        [system/words/monitor]
                    ] either listable? :x [:x] [compose [(:x)]]
                ] 
                "View Rebol Help" [helpview :x form either x-word [x-word] [new]] 
                "Probe Block" [either menu [viewprobe item] [viewface/fixed newp mold :x]] 
                "Probe From Head" [viewface/fixed newp mold head :x] 
                "List From Head" [newlist new head :x item 'blockhead] 
                "Mold" [viewface/fixed newp mold :x] 
                "View From Head" [viewall head :x newp] 
                "Mold From Head" [viewface/fixed newp mold head :x] 
                "View Face" [faceview :x newp] 
                "List As Style" [newlist newp dump-as-style :x none 'none] 
                "View As Style" [viewface/fixed newp mold/only dump-as-style :x] 
                "View Source" [viewall :x newp] 
                "List Body" [func-sel 'funcbody] 
                "List Third" [func-sel 'funcheader] 
                "List First" [func-sel 'funclocals] 
                "Browse" [browse :x] 
                "Edit File/Show Dir" [
                    either exists? :x [
                        either dir? :x [
                            use [dir] [dir: what-dir change-dir :x request-file change-dir dir]
                        ] [try [editor :x]]
                    ] [alerta "Cannot find the file/dir" f-intest]
                ] 
                "Find references" [
                    alerta "wait....." f-intest 
                    viewface/fixed join "references to/thru " newp rejoin/with find-ref/result/exclude :x [self ly] newline 
                    show f-intest
                ] 
                "Find references (func)" [
                    alerta "wait....." f-intest 
                    viewface/fixed join "references to/thru " newp rejoin/with find-ref/body/result/exclude :x [self ly] newline 
                    show f-intest
                ]
            ] 
            append-vc: func [str] [
                foreach str str [if str: find blk str [insert tail vc copy/part str 2]]
            ] 
            item: first histem 
            if either menu [
                x: item/ob 
                if tmp: get in item 'trueob [x: :tmp] 
                new: item/obname 
                newp: pathstr item
            ] [
                new: first parse new none 
                newp: does [rejoin [pathstr item "/" new]] 
                if 0 > test-value set/any 'x get-item item new [return] 
                all [
                    not unset? set/any 'x get-item item new 
                    any [tmp: error? :x not error? try [tmp: not equal? :x item/ob]] 
                    found? tmp
                ]
            ] [
                vc: copy [] 
                append-vc ["List In New Window"] 
                any [
                    if all [
                        any [any-word? :x any-path? :x] 
                        not equal? "Undefined" ctx: context? :x
                    ] [
                        x-word: :x 
                        append vc reduce [
                            rejoin ["List " ctx " Context"] [
                                if any-path? :x-word [x-word: first :x-word] 
                                either ctx = "Global" [
                                    newlist "system/words" system/words none 'object! 
                                    find-parse-list f-lista form :x-word 1
                                ] [
                                    use [ctx selfc] [
                                        ctx: v-c :x-word 
                                        either all [
                                            selfc: find ctx 'self 
                                            selfc: first selfc 
                                            object? set/any 'selfc get/any selfc 
                                            same? :x-word inall selfc :x-word 
                                            not same? selfc item/ob
                                        ] [
                                            newlist new selfc item 'objectcontext 
                                            find-parse-list f-lista form :x-word 1
                                        ] [
                                            if not equal-bc? ctx item/ob [
                                                newlist new ctx item 'blockcontext 
                                                find-parse-list f-lista join "'" form :x-word 4
                                            ]
                                        ]
                                    ]
                                ]
                            ]
                        ] 
                        either value? :x [
                            new: rejoin [new "=" mold :x] 
                            either not error? try [error? set/any 'x get-all :x] [
                                append-vc ["View Rebol Help"] 
                                false
                            ] [true]
                        ] [true]
                    ] 
                    if find [block! paren! hash! list!] type?/word :x [
                        append-vc ["Find references" "Find references (func)" "Probe Block"] 
                        any [head? :x append-vc ["Probe From Head" "List From Head"]] 
                        all [menu append-vc ["Expand nested blocks"]]
                    ] 
                    if all [any-string? :x not error? try [index? :x]] [
                        append-vc ["Mold" "Find references" "Find references (func)"] 
                        any [head? :x append-vc ["View From Head" "Mold From Head"]] 
                        if url? :x [append-vc ["Browse"]] 
                        if file? :x [append-vc ["Edit File/Show Dir" "Browse"]]
                    ] 
                    if face? :x [append-vc ["Find references" "Find references (func)" "View Face" "List As Style" "View As Style"]] 
                    if any-function? :x [
                        if function? :x [append-vc ["Find references" "Find references (func)" "View Source" "List Body"]] 
                        append-vc ["List First" "List Third" "View Third" "View Rebol Help"]
                    ] 
                    if find [object! port! struct!] type?/word :x [
                        append-vc ["Find references" "Find references (func)"]
                    ]
                ] 
                my-choose extract vc 2 func [f b] [switch f/text vc] ly offset 140x22 'left
            ]
        ] 
        selec: func [value /local new newp tipo x item tmp] [
            item: first histem 
            tipo: item/type 
            new: first parse value none 
            newp: does [rejoin [pathstr item "/" new]] 
            if 0 > test-value set/any 'x get-item item new [return] 
            if all [
                not unset? set/any 'x get-item item new 
                any [tmp: error? :x not error? try [tmp: not equal? :x item/ob]] 
                tmp
            ] [
                either all [any-word? :x value? :x] [
                    new: rejoin ["GET(" new "=" mold :x ")"] 
                    if error? x: get :x [x: disarm :x]
                ] [
                    if all [
                        any-path? :x 
                        not error? try [error? set/any 'tmp get-path/anyv/ignore :x]
                    ] [
                        new: rejoin ["GETP(" new "=" mold :x ")"] 
                        x: either error? :tmp [x: disarm :tmp] [:tmp]
                    ]
                ] 
                if error? :x [x: disarm :x] 
                if any [error? try [equal? :x :item/ob]] [return] 
                any [
                    if any-function? :x [
                        either function? :x [
                            if find prefs/on-function 'list [newlist new :x item 'funcbody] 
                            if find prefs/on-function 'view [viewall :x newp]
                        ] [
                            if find prefs/on-function 'list [newlist new :x item 'funcheader] 
                            if find prefs/on-function 'view [viewall :x newp]
                        ] 
                        true
                    ] 
                    if listable? :x [newlist new :x item type?/word :x] 
                    if viewable? type?/word :x [viewall :x newp]
                ]
            ]
        ] 
        go-to: func [ind [integer!]] [
            if all [not tail? ind: skip head histem (ind - 1) ind <> histem] [
                histem/1/whe: where? f-lista 
                histem: ind 
                changelista histem/1
            ]
        ] 
        go-back: does [go-to -1 + index? histem] 
        go-forward: does [go-to 1 + index? histem] 
        refresh: has [item] [
            item: f-lista/actual-item 
            item/whe: where? f-lista 
            item/refresh: pick item/listanomi item/whe 
            listall item 
            changelista item 
            item/refresh: none
        ] 
        newstart: func [value [string!] /local start] [
            either any [
                value = "" 
                all [
                    error? try [start: get-path to-path load value] 
                    error? try [start: do value]
                ]
            ] [
                alerta "Invalid Value!" f-intest
            ] [
                any [restart value :start alerta "Invalid Type!" f-intest]
            ]
        ] 
        engage-tl: func [face action event /local len whe] [
            if action = 'key [
                len: length? face/texts 
                either not found? find face/texts face/picked/1 [
                    clear face/picked 
                    insert/only tail face/picked pick face/texts whe: 1
                ] [
                    whe: index? find face/texts face/picked/1 
                    whe: switch-m/default event/key [
                        up [max 1 whe - 1] 
                        down [min len whe + 1] 
                        home [1] 
                        end [len] 
                        page-up [max 1 whe - face/lc + 1] 
                        page-down [min len whe + face/lc - 1] 
                        right [go-forward -1] 
                        left #"^[" [go-back -1]
                    ] [switch-m/default event/key bind f-lista/actual-item/engage-cases 'face [whe]] 
                    if whe <> -1 [
                        clear face/picked 
                        face/picked: reduce [pick face/texts whe]
                    ]
                ] 
                if whe <> -1 [change-sn face whe] 
                show face 
                eat/only [key]
            ]
        ] 
        engage-iter: func [f a e] [
            switch a [
                down [
                    if cnt > length? head lines [exit] 
                    if not e/control [f/state: cnt clear picked] 
                    alter picked f/text 
                    if any [not prefs/dbcl e/double-click] [do :act slf f/text]
                ] 
                alt-down [
                    if cnt > length? head lines [exit] 
                    if not e/control [f/state: cnt clear picked] 
                    alter picked f/text 
                    do :alt-act f-lista/offset + f/offset + e/offset - 10x10 f/text
                ] 
                up [f/state: none] 
                alt-up [f/state: none]
            ] 
            show pane
        ] 
        newlist: func [
            name [string!] 
            start 
            parent 
            type2 [word!] 
            /parent-path pp [string!] 
            /select-item value 
            /local newitem
        ] [
            newitem: make itemob [
                truename: name 
                switch type2 [
                    funcbody [trueob: :start name: rejoin ["FB(" name ")"] start: second :start] 
                    funcheader [trueob: :start name: rejoin ["FH(" name ")"] start: third :start] 
                    funclocals [trueob: :start name: rejoin ["FL(" name ")"] start: first :start] 
                    blockhead [name: rejoin ["HD(" name ")"]] 
                    blockcontext [name: rejoin ["CTX(" name ")"]] 
                    objectcontext [name: rejoin ["CTX(" name ")"]]
                ] 
                ob: :start 
                obname: copy name 
                pathto: either parent-path [copy pp] [either none? parent [copy ""] [pathstr parent]] 
                type: type? :start 
                tipo: either 'none = type2 [type?/word :start] [type2] 
                expandblk: false 
                engage-cases: [#"^M" #" " [selec face/picked/1 -1]] 
                refresh: value
            ] 
            either listall newitem [
                if not empty? histem [histem/1/whe: where? f-lista] 
                clear next histem 
                histem: back insert next histem newitem 
                changelista newitem 
                true
            ] [
                newitem: none 
                false
            ]
        ] 
        hist-list: func [face /local hist hista] [
            hist: copy [] 
            hista: back tail histem 
            while [not 25 <= length? hist] [
                insert hist rejoin [rig index? hista 3 " - " pathstr first hista] 
                if head? hista [break] 
                hista: back hista
            ] 
            my-choose hist func [f] [
                go-to to-integer first parse f/text " "
            ] ly f-intest/size * 0x1 + face/offset f-intest/size 'left
        ] 
        exe: has [value result command ly-exeoff ex err h f-console probe-result ld] [
            probe-result: true 
            use [actual-item] [
                actual-item: f-lista/actual-item/ob 
                ld: function [] [file] [
                    if file: request-file/only [if file: read file [f-console/update/text file show f-console]]
                ] 
                ex: func [] [
                    if all [command: f-console/ar/text not empty? command] [
                        if confine [
                            if not try-err [
                                error? set/any 'result do bind load/all command 'actual-item
                            ] [
                                either value? 'result [
                                    try-err either all [not probe-result listable? :result] [
                                        [restart "exe-result" result]
                                    ] [
                                        [print ["==" copy/part mold :result 200]]
                                    ]
                                ] [print ""]
                            ]
                        ] [print ["** Error: invalid return/break/throw"]] 
                        refresh
                    ]
                ] 
                command: join "actual-item" either empty? f-lista/picked [""] [
                    join "/" first parse f-lista/picked/1 none
                ] 
                ly-exeoff: sf-off 
                if ly-exe [ly-exeoff: ly-exe/offset munview/only ly-exe] 
                ly-exe: layout [
                    origin 10x10 styles my-styles backcolor backcol 
                    space 4x4 size ly-exesize 
                    style btn btn 50 
                    across 
                    btn "Exe" "^^E F5" keycode [#"^E" f5] [ex] 
                    btn "Upd" "^^U F9" keycode [#"^U" f9] [
                        actual-item: f-lista/actual-item/ob loop 1000000 []
                    ] 
                    btn "Load" "^^L" keycode [#"^L"] [ld] 
                    tgl 50 basecol red "List" "Probe" probe-result [probe-result: value] 
                    btn "Tile" "^^t" keycode [#"^T"] [tile] 
                    btn "Close" "^^Q Esc" keycode [#"^Q" #"^["] [munview/only ly-exe focus f-lista] 
                    return 
                    text 480 as-is {- Actual-item is set to the listed object/block: click Upd or F9 or Ctrl-U to update it
- Click Exe or F5 or Ctlr-E to execute
- Esc to quit} 
                    return 
                    h: at 
                    f-console: area-scroll ly-exesize - h - 10x10 snow white font-name font-fixed 
                    font-size prefs/fontsize command []
                ] 
                deflag-face f-console/ar tabbed 
                ly-exe/user-data: make object! [
                    resize: :resize-ly-exe 
                    console: :f-console 
                    min-size: window-mins/ly-exe 
                    key: func [event /local len face] [
                        if none? either all [event/key = #"^-" event/shift] [
                            next-window event/face
                        ] [do-key-face event] [return none] 
                        event
                    ]
                ] 
                focus f-console 
                mview/new/offset/title/options ly-exe ly-exeoff "Command to execute" 'resize
            ]
        ] 
        resize-subface: func [event /local face] [
            face: event/face 
            face/old-size: face/size 
            face/size: max face/size face/user-data/min-size 
            if face/old-size = face/size [
                face/user-data/area/resize face/user-data/area/size + face/size - sfsize 
                sfsize: face/size
            ] 
            show face
        ] 
        resize-ly-exe: func [event /local face] [
            face: event/face 
            face/old-size: face/size 
            face/size: max face/size face/user-data/min-size 
            if face/old-size = face/size [
                face/user-data/console/resize face/user-data/console/size + face/size - ly-exesize 
                ly-exesize: face/size
            ] 
            show face
        ] 
        resize-ly: func [event /local face minsize delta] [
            face: event/face 
            minsize: face/user-data/min-size 
            delta: face/size 
            face/size: max face/size minsize 
            if face/size = delta [
                delta: face/size - wsize 
                cnname: to-integer cnname * face/size/x / wsize/x 
                wsize: face/size 
                f-intest/size/x: f-intest/size/x + delta/x 
                f-panel/offset/x: f-panel/offset/x + delta/x 
                f-lista/size: f-lista/size + delta 
                f-lista/pane/size: f-lista/pane/size + delta 
                f-lista/sub-area/size: f-lista/sub-area/size + delta 
                f-lista/iter/size/x: f-lista/iter/size/x + delta/x 
                f-lista/sld/offset/x: f-lista/sld/offset/x + delta/x 
                f-lista/sld/size/y: f-lista/sld/size/y + delta/y 
                f-lista/lc: to integer! f-lista/size/y / f-lista/sub-area/size/y 
                f-text/size/x: f-text/size/x + delta/x 
                refresh
            ] 
            show ly
        ] 
        next-window: func [face /local blk tmp] [
            if all [not stopmode blk: find reduce [ly ly-exe subface] face] [
                forever [
                    if tail? blk: next blk [blk: head blk] 
                    if face = tmp: first blk [break] 
                    if find view*/screen-face/pane tmp [
                        tmp/changes: 'activate 
                        show tmp 
                        break
                    ]
                ]
            ] 
            none
        ] 
        tile: func [] [tile-face subface 'below tile-face ly-exe 'across] 
        tile-face: func [face [object! none!] mode] [
            if face [
                switch mode [
                    below [
                        face/offset: max 0x0 min view*/screen-face/size - 20x20 as-pair [
                            ly/offset/x - view*/resize-border/x 
                            ly/offset/y + ly/size/y + view*/resize-border/y
                        ] 
                        face/size: max face/user-data/min-size as-pair [
                            ly/size/x 
                            view*/screen-face/size/y - face/offset/y - view*/title-size/y - view*/resize-border/y - 32
                        ]
                    ] 
                    across [
                        face/offset: max 0x0 min view*/screen-face/size - 20x20 as-pair [
                            ly/offset/x + ly/size/x + view*/resize-border/x 
                            ly/offset/y - view*/title-size/y - view*/resize-border/y
                        ] 
                        face/size: max face/user-data/min-size as-pair [
                            view*/screen-face/size/x - face/offset/x - (2 * view*/resize-border/x) 
                            ly/size/y
                        ]
                    ]
                ] 
                show face
            ]
        ] 
        lyb: copy/deep [
            origin 10x10 styles my-styles backcolor backcol 
            size wsize 
            style myh4 h4 white no-wrap center 
            across 
            space 5x1 
            f-intest: h4 white backcol first wsize - 218 bold para [wrap?: false] "" [hist-list face] 
            f-panel: auto-panel [
                origin 0x0 
                across 
                space 5x1 
                myh4 50 "Expand" basecol feel [engage: none] 
                f-expand: check #"^B" prefs/expandblk [
                    if char? value [face/data: face/data xor true show face] 
                    prefs/expandblk: face/data refresh
                ] 
                myh4 40 "Unset" basecol feel [engage: none] 
                f-unset: check #"^U" prefs/nounset [
                    if char? value [face/data: face/data xor true show face] 
                    prefs/nounset: face/data refresh
                ] 
                myh4 30 "Sort" [
                    my-choose ["None" "Name" "Type"] func [f b] [
                        prefs/sort: f-sort/data: either f/text = "None" [false] [
                            prefs/sortby: copy f/text true
                        ] 
                        f-sort/color: red show f-sort 
                        refresh 
                        f-sort/color: white show f-sort
                    ] face/parent-face/parent-face face/parent-face/offset + face/offset + 0x20 45x20 'center
                ] 
                f-sort: check #"^S" prefs/sort [
                    if char? value [face/data: face/data xor true show face] 
                    prefs/sort: face/data refresh
                ]
            ] 
            return 
            space 1 
            btn 12 "*" [
                my-choose extract prefs/shortcut 2 func [f b] [
                    newstart form select prefs/shortcut f/text
                ] ly 0x1 * face/size + face/offset 100x20 'left
            ] 
            btn 12 "!" [selec-alt/menu face/offset + (0x1 * face/size) ""] 
            btn "Menu" [
                my-choose extract com-list 3 func [f b] [
                    ana-exe f/text
                ] ly 0x1 * face/size + face/offset 200x20 'left
            ] 
            arrow left basecol white 24x24 [go-back] 
            arrow right basecol white 24x24 [go-forward] 
            btn "New" "F2 ^^w" keycode [f2 #"^W"] [ana-exe <new>] [ana-exe <console>] 
            btn "Fnd" keycode [f3 #"^F"] [
                show f-intest 
                inform layout [
                    styles my-styles 
                    backcolor backcol 
                    across 
                    check case [case: face/data] h4 "Case" return 
                    face: field as-is search [h: true hide-popup] return 
                    btn 50 "OK" [h: true hide-popup] 
                    btn 50 "Cancel" [hide-popup] 
                    do [focus face]
                ] 
                if h [any [find-into-list f-lista search: face/text 0 alerta "Not found" f-intest]]
            ] 
            btn "Nxt" keycode [f4 #"^N"] [
                show f-intest 
                if all [search not empty? search] [
                    any [find-into-list f-lista search where? f-lista alerta "Not found" f-intest]
                ]
            ] 
            key #"^T" [tile] 
            btn "Exe" "F5 ^^E" keycode [f5 #"^E"] [ana-exe <execute>] 
            btn "Pr/Vi" "F6" keycode [f6 #"^P"] [ana-exe <probeview>] 
            btn "Pref" "F8" keycode [f8] [ana-exe <prefs>] 
            space 2 
            btn "Help" "F1" keycode [f1] [ana-exe <help>] [ana-exe <console>] 
            space 5 
            h: at f-text: field wsize/x - h/x - 10 copy "Name or command" [newstart value] 
            return 
            f-lista: text-list wsize - 20x56 black font-name font-fixed font-size prefs/fontsize 
            no-wrap data "" [selec value] 
            with [actual-item: none alt-act: func [offset value] [selec-alt offset value]] 
            do [
                f-lista/feel: make f-lista/feel [engage: :engage-tl] 
                bind second :engage-iter in f-lista 'self 
                f-lista/iter/feel: make f-lista/iter/feel [engage: :engage-iter] 
                f-lista/sld/action: func [face value] append copy/deep second get in f-lista/sld 'action [eat] 
                f-lista/sld/effect: [gradient 200.200.200 230.230.230]
            ]
        ] 
        com-list: copy/deep [
            "Refresh^-^-- Ctrl-R F9" <refresh> [refresh] 
            "Copy List^-^-- Ctrl-C" <copylist> [clip f-lista/data] 
            "Copy Item Path^-- Ctrl-X" <copyitem> [clipname self] 
            "Probe/View^-^-- Ctrl-P F4" <probeview> [viewprobe f-lista/actual-item] 
            "Execute^-^-- Ctrl-E" <execute> [exe] 
            "New Window^-^-- Ctrl-N F2" <new> [do reduce ['system/words/monitor f-lista/actual-item/ob]] 
            "New Console" <console> [launch ""] 
            "View Global Colors" <colors> [viewcolors] 
            "Toggle Expand^-- Ctrl-B" <expand> [do-face f-expand #"a"] 
            "Toggle Unset^-^-- Ctrl-U" <unset> [do-face f-unset #"a"] 
            "Toggle Sort^-^-- Ctrl-S" <sort> [do-face f-sort #"a"] 
            "Tile windows^-^-- Ctrl-T" <tile> [tile] 
            "Preferences^-^-- F8" <prefs> [Preferences self] 
            "Browse Dictionary" <dictio> [browse http://www.rebol.com/docs/dictionary.html] 
            "Browse Library" <library> [browse http://www.reboltech.com/library/library.html] 
            "Browse Docs" <docs> [browse http://www.rebol.com/docs.html] 
            "Help/About^-^-- F1" <help> [anahelp self]
        ] 
        ana-exe: func [command [string! tag!]] [switch-m command com-list] 
        title: does [
            rejoin [
                header/title " - " header/version 
                either header/beta ["-Beta"] [""] 
                either stopmode [" - StopMode"] [""] 
                either awnum <> 1 [join " - " awnum] [""]
            ]
        ] 
        restart: func [name [string!] start /select-item value /local type2] [
            if error? :start [start: disarm :start] 
            refine-do [
                newlist name :start none either any-function? :start [
                    pick [funcbody funcheader] function? :start
                ] ['none]
            ] [[select-item value]]
        ] 
        make-ly: function [] [] [
            ly: layout lyb 
            ly/user-data: make object! [
                lista: :f-lista 
                text: :f-text 
                resize: :resize-ly 
                min-size: window-mins/ly 
                scroll-line: func [event /local len] [
                    len: length? lista/texts 
                    lista/sn: max 0 min len - lista/lc lista/sn + second event/offset 
                    lista/sld/data: lista/sn / max 1 len - lista/lc 
                    lista/sld/state: none 
                    lista/sld/redrag lista/lc / max 1 len 
                    show lista 
                    none
                ] 
                key: func [event] [
                    if none? either all [event/key = #"^-" event/shift] [
                        next-window event/face
                    ] [do-key-face event] [return none] 
                    if view*/focal-face <> lista [
                        either view*/focal-face = text [
                            if event/key = #"^[" [focus lista return none]
                        ] [focus lista]
                    ] 
                    event
                ]
            ]
        ] 
        awnum: set 'wnum wnum + 1 
        Monitor: func [
            "Visual monitor of objects/blocks" 'start [any-type!] 
            /stop 
            /async 
            /select-item value 
            /name string [string!] 
            /local startname ev
        ] [
            stopmode: stop 
            if not value? 'start [start: 'system] 
            name: either name [string] [either block? :start ["<block>"] [form :start]] 
            any [
                if path? :start [set/any 'start get-path :start true] 
                if any-word? :start [
                    if error? set/any 'start get/any :start [start: disarm get/any :start] 
                    true
                ]
            ] 
            if any [not value? 'start not listable? :start] [
                print ["Invalid argument. Not one of:" extract listable 2] 
                exit
            ] 
            if exists? fileprefs [prefs: make prefs load/all fileprefs] 
            use [v] [
                parse/all mold first system/words [
                    any [
                        to "ctx-" copy h to " " (
                            set/any 'v get/any load h 
                            if all [
                                value? 'v 
                                any [object? :v block? :v] 
                                not find prefs/shortcut h
                            ] [insert insert tail prefs/shortcut h h]
                        )
                    ]
                ]
            ] 
            backcol: prefs/back-color 
            basecol: prefs/base-color 
            wsize: prefs/wsize 
            sfsize: prefs/wsize - 25x25 
            ly-exesize: prefs/wsize - 100x150 
            make-ly 
            if refine-do [restart name :start] [[select-item value]] [
                focus f-lista 
                mview/new/options/offset/title ly 'resize prefs/woffset title 
                any [stopmode async do-events] 
                wnum: wnum - 1 
                none
            ]
        ]
    ] 
    cache: [] 
    set 'Monitor func ["Visual monitor of objects/blocks" 'start [any-type!] /stop /local s-m] [
        insert tail cache s-m: context cb 
        if view*/pop-face [stop = true] 
        any [value? 'start start: 'system] 
        refine-do [s-m/monitor :start] [stop] 
        remove back tail cache 
        none
    ] 
    set 'Mon func ["Monitor of objects/blocks" start] [monitor :start :start] 
    set 'Stop func ["Modal visual monitor of objects/blocks" start] [monitor/stop :start :start]
] 
either get in system/script 'args [
    monitor system/script/args
] [
    if false <> system/script/args [monitor]
]