rebol [ title: "VID inspect" author: "vpavlu" date: 19-dec-2002/12:14 home: http://plain.at/vpavlu ] vid-inspect: make object! [ styles: func [ "displays a list of all styles" /local list s base son dad act len max-len print-line ][ max-len: 0 list: copy [] s: system/view/vid/vid-styles forskip s 2 [ if max-len < len: length? form s/1 [ max-len: len ] repend list [s/1 to-block s/2/style] ] print-line: func [ base /local s][ s: form base/1 remove base s: tail s insert/dup s " " 2 + max-len - length? head s s: head s forall base [ repend s [" < " base/1] ] ;append s " < object!" print s ] print "VID-STYLES:" base: copy [] foreach [son dad] list [ clear base act: find list son while [ not none? act ][ append base act/1 act: find list act/2/1 ] print-line base ] ] style-tree: func [ "prints a hierarchical view of VID-styles" /local recurs-print-node list s pos ][ ;build block with "style [child1 ... childn]" elements of all styles list: copy [] s: system/view/vid/vid-styles forskip s 2 [ either none? pos: find list s/2/style [ repend list [ s/2/style reduce [s/1] ] ][ append first next pos s/1 ] ] ;function to recursively print a style and its children recurs-print-node: func [ prefix this follower /local desc i child ][ print rejoin [ prefix " +-" this ] if not none? desc: select list this [ append prefix pick [" " " | "] zero? follower i: length? desc foreach child desc [ recurs-print-node copy prefix child i: i - 1] remove/part skip tail prefix -3 3 ] ] ;go printing! print "VID-STYLES:" recurs-print-node "" 'face 0 unset 's ;so that nothing is returned ] ] style-tab: get in vid-inspect 'styles style-tree: get in vid-inspect 'style-tree style-tree halt