| 1 |
examine: make function! [ |
|---|
| 2 |
"Prints information about widgets and attributes." |
|---|
| 3 |
'widget |
|---|
| 4 |
/indent "Indent output as an MD2 ready string" |
|---|
| 5 |
/no-print "Do not print output to console" |
|---|
| 6 |
/local string tmp blk funcs |
|---|
| 7 |
][ |
|---|
| 8 |
unless word? widget [widget: to word! widget] |
|---|
| 9 |
unless find tmp: next find first widgets 'choose widget [ |
|---|
| 10 |
print "Unknown widget. Supported widgets are:^/" |
|---|
| 11 |
foreach widget tmp [print join "^-" widget] |
|---|
| 12 |
exit |
|---|
| 13 |
] |
|---|
| 14 |
widget: widgets/:widget |
|---|
| 15 |
; usage & description |
|---|
| 16 |
string: replace/all copy widget/tip "^/" "^/^-" |
|---|
| 17 |
replace/all string "[" join " " "[" |
|---|
| 18 |
replace/all string "]" join "]" " " |
|---|
| 19 |
replace/all string "^- " "^-" |
|---|
| 20 |
replace/all string " ^/" "^/" |
|---|
| 21 |
replace string "^-DESCRIPTION:" "^/DESCRIPTION:" |
|---|
| 22 |
replace string "^-OPTIONS:" "^/OPTIONS:" |
|---|
| 23 |
; standard attributes |
|---|
| 24 |
insert tail string "^/^/^/ATTRIBUTES:" |
|---|
| 25 |
foreach attribute skip first rebface 3 [ |
|---|
| 26 |
if all [ |
|---|
| 27 |
not find [show? face-flags feel action tip] attribute |
|---|
| 28 |
get tmp: in widget attribute |
|---|
| 29 |
][ |
|---|
| 30 |
tmp: either find ["function" "object" "block" "bitset"] form type? get tmp [join type? get tmp "!"] [mold get tmp] |
|---|
| 31 |
insert tail string rejoin [ |
|---|
| 32 |
"^/^-" |
|---|
| 33 |
head insert/dup tail form attribute " " 16 - length? form attribute |
|---|
| 34 |
tmp |
|---|
| 35 |
] |
|---|
| 36 |
] |
|---|
| 37 |
] |
|---|
| 38 |
; feels |
|---|
| 39 |
unless widget/feel = widgets/default-feel [ |
|---|
| 40 |
insert tail string "^/^/PREDEFINED FEELS:" |
|---|
| 41 |
foreach attribute next first widgets/default-feel [ |
|---|
| 42 |
if get in widget/feel attribute [ |
|---|
| 43 |
insert tail string join "^/^-" attribute |
|---|
| 44 |
] |
|---|
| 45 |
] |
|---|
| 46 |
] |
|---|
| 47 |
; actions |
|---|
| 48 |
unless widget/action = widgets/default-action [ |
|---|
| 49 |
insert tail string "^/^/PREDEFINED ACTIONS:" |
|---|
| 50 |
foreach attribute next first widgets/default-action [ |
|---|
| 51 |
if get in widget/action attribute [ |
|---|
| 52 |
insert tail string join "^/^-" attribute |
|---|
| 53 |
] |
|---|
| 54 |
] |
|---|
| 55 |
] |
|---|
| 56 |
; extended attributes |
|---|
| 57 |
funcs: copy [] |
|---|
| 58 |
unless empty? blk: difference first rebface first widget [ |
|---|
| 59 |
insert tail string "^/^/EXTENDED ATTRIBUTES:" |
|---|
| 60 |
foreach attribute blk [ |
|---|
| 61 |
if tmp: in widget attribute [ |
|---|
| 62 |
either function? get tmp [ |
|---|
| 63 |
insert tail funcs attribute |
|---|
| 64 |
][ |
|---|
| 65 |
tmp: either find ["object" "block" "bitset"] form type? get tmp [join type? get tmp "!"] [mold get tmp] |
|---|
| 66 |
insert tail string rejoin ["^/^-" head insert/dup tail form attribute " " 16 - length? form attribute tmp] |
|---|
| 67 |
] |
|---|
| 68 |
] |
|---|
| 69 |
] |
|---|
| 70 |
] |
|---|
| 71 |
; accessor functions |
|---|
| 72 |
unless empty? funcs [ |
|---|
| 73 |
insert tail string "^/^/ACCESSOR FUNCTIONS:" |
|---|
| 74 |
foreach attribute funcs [ |
|---|
| 75 |
tmp: copy "" |
|---|
| 76 |
foreach w third get in widget attribute [ |
|---|
| 77 |
all [word? w insert tail tmp join " " w] |
|---|
| 78 |
if refinement? w [ |
|---|
| 79 |
either w = /local [break] [insert tail tmp join " /" w] |
|---|
| 80 |
] |
|---|
| 81 |
] |
|---|
| 82 |
insert tail string rejoin ["^/^-" uppercase form attribute tmp] |
|---|
| 83 |
] |
|---|
| 84 |
] |
|---|
| 85 |
if indent [ |
|---|
| 86 |
replace/all string "^/" "^/^-" |
|---|
| 87 |
replace/all string "^-^/" "^/" |
|---|
| 88 |
insert string "^-" |
|---|
| 89 |
] |
|---|
| 90 |
if no-print [ |
|---|
| 91 |
replace/all string "^-" " " |
|---|
| 92 |
] |
|---|
| 93 |
either any [indent no-print] [string] [print string] |
|---|
| 94 |
] |
|---|
