Hi Andrew,
You can do Patch_to-func a lot more easily if you use the latest version
of HUH (not yet available on rebol.org).
>> patch_to-func
Can't convert to-bin
Can't convert to-bin2
Can't convert to-bits
Can't convert to-idate
Can't convert to-matrix
Can't convert to-native ; this isn't what you think!
>> source to-paren
to-paren: func ["Converts to paren value." value "Value to convert"]
[to paren! :value]
>> source to-money
to-money: func ["Converts to money value." value "Value to convert"]
[to money! :value]
See you,
Eric
==========
Patch_to-func: function [][Old_to-Func][
foreach to-type huh/ret "to-*" function? [
Old_to-Func: get to-type
either 'value = last second :Old_to-func [
do reduce [
to set-word! to-type
'func
copy third :Old_to-func
head change back tail copy second :Old_to-func first
[:value]
]
][print ["Can't convert" to-type]]
]
]
; new HUH (actually it's old - never got around to posting it)
; /verbose and /ret refinements not available in the one on rebol.org
; /verbose can be very very verbose!
huh: func [
{Print a list of globally defined words classified by datatype}
'pattern [word! string! unset!] "matching pattern (. and * wild)"
'type [word! unset!] "datatype test function (eg series?)"
/any {displays words containing any type of value, even unset}
/verbose {display help for all words}
/wc {use ? and + for wild cards}
/ret {return the block of words}
/local tester word-array this-type ret-block
][
either value? 'type [
if unset? get/any type [
print [type "has no value"]
exit
]
tester: get type
if datatype! = type? :tester [
tester: get to-word head change back tail mold tester "?"
]
if not type-tester? :tester [
print [type "is not a datatype test function"]
exit
]
if do [tester] [any: true] ; if tester is UNSET? or ANY-TYPE?
][ tester: none ]
either wc [wc: "?+"][wc: ".*"]
either value? 'pattern
[pattern: to-string pattern]
[pattern: to-string last wc] ; assign wildcard to match any string
word-array: copy [] ; to hold matching words
foreach word first system/words [
this-type: mold type? get/any word: in system/words word
if all [
system/words/any [
this-type <> "unset!" ; ignore unset values
any ; unless we got the /any refinement
]
system/words/any [
not :tester ; unless we aren't using tester,
tester get/any word ; check with datatype test function
]
"" = find/match/with word: mold word pattern wc
][
either find word-array this-type
[append select word-array this-type word]
[append word-array reduce [this-type reduce [word]]]
]
]
either tail? word-array [
print "no matching words found"
][
if ret [
ret-block: copy []
foreach [this-type word-block] word-array [
foreach word sort word-block [
insert tail ret-block in system/words to-word
word
]
]
return ret-block
]
foreach [this-type word-block] sort/skip word-array 2 [
print join newline ["@@ " this-type]
either verbose [
foreach word sort word-block [
prin join ">> " [word ": "]
either any-function? get/any to-word word [
do join "help " word
print ""
][
either this-type = "unset!" [
print "has no value"
][
either this-type = "error!" [
print mold disarm get
to-word word
][
word: get to-word word
either this-type = "object!" [
print ""
qt first word
][
print mold word
]
]
]
]
]
][
qt sort word-block ; qt defined in %format.r
]
]
]
]
; useful for debugging with HUH - see if any words that should be local
; are "leaking" through
data?: func [
{returns TRUE for all data types except unset, any-function and datatype}
value [any-type!]
][
either any [
not value? 'value
any-function? :value
datatype? :value
][false][true]
]
not?: func [
{returns TRUE for NONE and FALSE - returns FALSE for all other values}
value [any-type!]
][
either any [
not value? 'value
error? :value
:value
][false][true]
]
type-tester?: func [
{Returns TRUE if VALUE is a datatype test function}
value [any-type!]
][
either any [
not value? 'value
not any-function? :value
not find/only third :value reduce [any-type!]
find third :value lit-word!
not string? first third :value
not find first third :value "Returns TRUE"
][false][true]
]
; abbreviated version of QT in format.r
; handy for lots of things, such as seeing what words are defined in
; an object.
qt: func [
{Quick table: prints out a simple block in aligned columns}
b [any-block! object!]
/width max [integer!]
/local s rm
][
; RIGHT-MARGIN may be globally set to control the length of each line
; print out.
; If B contains nested blocks, each nested block will be individually
; print out.
; QT will try to guess if decimals should be printed out as decimals or
; as integers, but it won't always guess right.
if object? b [
b: first b
]
no-decimal: true
rm: either value? 'right-margin [right-margin][77]
if not width [
max: 0
foreach a b [
if all [not object? a not any-block? a] [
max: maximum max length? form a
]
]
max: max + 2
]
s: 0
foreach a b [
either any [any-block? a object? a ][
print "^/(nested)"
qt a
s: 0
][
s: s + max
if s > rm [
print ""
s: max
]
a: form a
prin head insert/dup tail a " " (max - length? a)
]
]
print ""
exit
]
