REBOL [ Title: "Dump-Style" Date: 11-Jun-2002 Version: 1.0.0 File: %dump-style.r Author: "Romano Paolo Tenca" Purpose: {Dump style facets and returns a block which can be passed to stylize to create a clone of the style. } History: { ^-^-1.0.0 11/06/02 first public release ^-} Email: %rotenca--libero--it Web: http://web.tiscali.it/anarkick/index.r Note: { ^-^-It is based on undocumented features and can fail in future Rebol versions ^-^-or with some custom styles ^-} library: [ level: 'intermediate platform: [] type: 'tool domain: [GUI debug] tested-under: none support: none license: none see-also: none ] ] dump-style: func [ style [word!] /quiet "Do not print the style" /clip "Copy the style to the clipboard" /name "Use this name for the cloned style" new [word!] /styles ss "Stylesheet" /local facets h ][ if none? styles [ss: svv/vid-styles] if not name [new: style] if ss: select ss style [ 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 ] ] ] ] ] ss: compose [ (to-set-word new) (ss/style) (facets) ] if not quiet [ print mold/only ss ] if clip [ write clipboard:// mold/only ss ] ss ][ print ["Facets not found. Base style: " ss/style] ss/style ] ] ] ;this can be cancelled or commented out if system/user/name <> "Romano Paolo Tenca" [ print "First example: dump of the 'field style:^/" dump-style 'field print "^/Second example: code which creates a 'text-list clone:" do probe [ x: dump-style/quiet/name 'text-list 'text-list-clone comment {Vid styles are bound to svv} x: bind x in svv 'self my-styles: stylize x view center-face layout [ backcolor silver styles my-styles text-list-clone 300x100 data [ "This is the style:" "'text-list-clone" "in the stylesheet" "'my-styles" ] ] ] halt ]