Rebol [
    Title: "AnaMonitor"
    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
    Version: 3.0.0
    Date: 06/06/2005
    History: [
        [3.0.0 06/06/2005 "Adapted to 1.3 - minor changes"]
        [2.0.0 27-Feb-2003 "Second major public release"]
        [1.1.0 2-Nov-2001 "First public release"]
    ]
    Category: [vid view utils 2]
    Purpose: {
^-^-A debugging tool to visually examine Rebol values.
^-}
]

anamonitor-ctx: context [
    orig-site: http://www.rebol.it/~romano
    gnu-site: http://www.gnu.org/licenses
    dict-site: http://www.rebol.com/docs/dictionary.html
    libr-site: http://www.rebol.org/cgi-bin/cgiwrap/rebol/script-index.r
    old-libr-site: http://www.reboltech.com/library/library.html
    docs-site: http://www.rebol.com/docs.html
    rambo-site: http://www.rebol.net/cgi-bin/rambo.r
    window-mins: [subface 300x100 ly-exe 300x200 ly 600x430]
    basecol: 0.137.179 ;0.156.179 ;131.140.189
    backcol: pewter + 10.10.10
    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: btn 44 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: tog 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 [none! string!] pos "start position" case
    ] [
        if all [search 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 "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? orig-site/gpl.txt read-thru orig-site/gpl.txt]
                                request-download orig-site/gpl.txt
                                all [exists-thru? gnu-site/gpl.txt read-thru gnu-site/gpl.txt]
                                request-download gnu-site/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 10x0
                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
                        as-string load ar/text
                    ] [
                        append ar/user-data 'binary
                        mold/only as-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 "Edit" "^^t" keycode [#"^E"] [editor ar/text]
                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] [
            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 "/"
            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 [
                    styles my-styles
                    origin 10x10
                    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 papaya "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/resize/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 10x0
            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" feel [engage: none] font []
                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" feel [engage: none] font []
                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
                ] font []
                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 22x22 [go-back]
            arrow right basecol white 22x22 [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 dict-site]
            "Browse Library" <library> [browse libr-site]
            "Browse oldLibrary" <library> [browse old-libr-site]
            "Browse Docs" <docs> [browse docs-site]
            "Browse Bugs" <docs> [browse rambo-site]
            "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]
]