root/rebgui.r

REBOL[version: 118]
if system/version < 1.3.2[make error! "RebGUI requires View 1.3.2 or greater"]
unless value? 'viewed?[
find-window: make function![
"Find a face's window face." 
face[object!]
][
while[face/parent-face][face: face/parent-face]
face
]
viewed?: make function![
"Returns TRUE if face is displayed." 
face[object!]
][
found? find system/view/screen-face/pane find-window face
]
]
system/locale: make system/locale[
colors:[black navy blue violet forest maroon coffee purple reblue coal oldrab red brick crimson leaf brown aqua teal magenta sienna water olive papaya mint gray rebolor green orange pewter base-color khaki cyan tan silver pink sky gold wheat yellow yello beige snow linen ivory white]
words:[]
language: "English" 
dictionary: none 
dict: none
]
ctx-rebgui: make object![
build: 118 
view*: system/view 
locale*: system/locale 
find-face: make function![pnt[pair!]f[object! block!]/local p result][
all[
object? :f 
f/show? 
within? pnt win-offset? f f/size 
return f
]
p: either object? :f[get in f 'pane][:f]
either block? :p[
result: none 
foreach face head reverse copy p[
if all[object? :face face/show? face: find-face pnt face][
result: face 
break
]
]
result
][
all[object? :p find-face pnt :p]
]
]
subface: make system/standard/face[
color: edge: font: para: feel: none
]
all-chars: make string! 256 
repeat i 256[insert tail all-chars to char! i - 1]
font?: make function![
font-name[string!]
][
all[font-name = font-sans-serif return true]
(size-text make subface[text: all-chars font: make view*/screen-face/font[name: font-sans-serif]]) <> 
(size-text make subface[text: all-chars font: make view*/screen-face/font[name: font-name]])
]
gui-error: make function![
error[string!]
/continue
][
write/append/lines %rebgui.log reform[now/date now/time error]
unless continue[make error! error]
]
span-resize: make function![face[object!]delta[pair!]][
if face/span[
face/old-size: face/size 
all[find face/span #X face/offset/x: face/offset/x + delta/x]
all[find face/span #Y face/offset/y: face/offset/y + delta/y]
all[find face/span #W face/size/x: face/size/x + delta/x]
all[find face/span #H face/size/y: face/size/y + delta/y]
all[face/old-size <> face/size object? get in face 'action face/action/on-resize face]
]
any[
if block? get in face 'pane[foreach f face/pane[span-resize f delta]]
if object? get in face 'pane[span-resize face/pane delta]
]
]
span-size: make function![face[object!]size[pair!]margin[pair!]][
if face/span[
all[
find face/span #L 
face/size/x: size/x - face/offset/x - margin/x 
all[find[drop-list edit-list]face/type face/pane/offset/x: face/size/x - sizes/line + 1]
]
all[find face/span #V face/size/y: size/y - face/offset/y - margin/y]
all[face/old-size <> face/size object? get in face 'action face/action/on-resize face]
if find face/span #O[
face/offset/x: either any[zero? face/offset/y size/y = (face/offset/y + face/size/y)][
size/x - face/size/x
][
size/x - face/size/x - margin/x
]
]
]
if block? get in face 'pane[
either face/type = 'tab-panel[
foreach f face/pane[span-size f face/size 0x0]
][
foreach f face/pane[span-size f face/size face/pane/1/offset]
]
]
if object? get in face 'pane[span-size face/pane face/size face/pane/offset]
]
unview-keep: make function![num[integer!]/local pane][
pane: head view*/screen-face/pane 
while[(length? pane) > num][remove back tail pane]
show view*/screen-face
]
words:[after at bold button-size data do edge effect feel field-size font indent italic label-size margin on on-alt-click on-away on-click on-dbl-click on-edit on-focus on-key on-over on-resize on-scroll on-unfocus options pad para rate return reverse space text-color text-size tight tip underline]
select-face: make function![face][
face/color: colors/state-light 
face/font/color: colors/page 
show face
]
deselect-face: make function![face /fill][
face/color: either fill[colors/page][none]
face/font/color: colors/text 
show face
]
colors: construct/with either exists? %ui.dat[pick load %ui.dat 3][[]]make object![
page: ivory 
text: coal 
theme-light: 195.221.127 
theme-dark: 136.187.0 
state-light: 255.204.127 
state-dark: 255.153.0 
outline-light: 204.204.204 
outline-dark: 136.136.136
]
sizes: construct/with either exists? %ui.dat[pick load %ui.dat 6][[]]make object![
cell: 4 
edge: 1 
font: 12 
font-height: none 
gap: 2 
line: cell * 5 
margin: 4 
slider: cell * 4
]
behaviors: construct/with either exists? %ui.dat[pick load %ui.dat 9][[]]make object![
action-on-enter:[drop-list edit-list field password spinner]
action-on-tab:[field]
caret-on-focus:[area]
cyclic:[group-box panel sheet tab-panel]
hilight-on-focus:[edit-list field password spinner]
tabbed:[area button drop-list drop-tree edit-list field grid password spinner]
]
effects: construct/with either exists? %ui.dat[pick load %ui.dat 12][[]]make object![
arrows-together: false 
radius: 5 
font: either font? "arial"["verdana"][font-sans-serif]
fonts: sort reduce[font-sans-serif font-fixed font-serif "verdana"]
splash-delay: 1 
tooltip-delay: 0:00:01 
webdings: font? "webdings" 
window: none
]
on-fkey: make object![
f1: f2: f3: f4: f5: f6: f7: f8: f9: f10: f11: f12: none
]
edit: make object![
siblings: none 
caret: none 
letter: make bitset![#"A" - #"Z" #"a" - #"z" #"'"]
capital: make bitset![#"A" - #"Z"]
other: negate letter 
edits: make function![
words[block!]
/local result ln w
][
result: copy[]
foreach word words[
repeat n ln: length? word[
insert tail result head remove at copy word n
]
repeat n ln - 1[
insert tail result head change change at copy word n pick word n + 1 pick word n
]
foreach ch "abcdefghijklmnopqrstuvwxyz"[
repeat n ln[
poke w: copy word n ch 
insert tail result w
]
repeat n ln + 1[
insert tail result head insert at copy word n ch
]
]
]
result
]
lookup-word: make function![
word[string!]
/local result
][
any[
not empty? result: intersect locale*/dict make hash! word: reduce[word]
not empty? result: intersect locale*/dict make hash! edits word 
result: word
]
sort result
]
insert?: true 
keymap:[
#"^H" back-char 
#"^~" del-char 
#"^M" enter 
#"^A" all-text 
#"^C" copy-text 
#"^X" cut-text 
#"^V" paste-text 
#"^T" clear-tail 
#"^Z" undo 
#"^Y" redo 
#"^[" undo-all 
#"^S" spellcheck 
#"^/" ctrl-enter
]
hilight-text: make function![start end][
view*/highlight-start: start 
view*/highlight-end: end
]
hilight-all: make function![face][
either empty? face/text[unlight-text][
view*/highlight-start: head face/text 
view*/highlight-end: tail face/text
]
]
unlight-text: make function![][
view*/highlight-start: view*/highlight-end: none
]
hilight?: make function![][
all[
object? view*/focal-face 
string? view*/highlight-start 
string? view*/highlight-end 
not zero? offset? view*/highlight-end view*/highlight-start
]
]
hilight-range?: make function![/local start end][
start: view*/highlight-start 
end: view*/highlight-end 
if negative? offset? start end[start: end end: view*/highlight-start]
reduce[start end]
]
tabbed?: make function![
face[object!]
][
all[
face/show? 
find behaviors/tabbed face/type 
not find face/options 'info 
face
]
]
cyclic?: make function![
face[object!]
][
all[find behaviors/cyclic face/type face]
]
unfocus: make function![/local face][
if face: view*/focal-face[
if all[face/type <> 'face get in face/action 'on-unfocus][
unless face/action/on-unfocus face[return false]
]
all[
view*/caret 
in face 'caret 
face/caret: index? view*/caret
]
all[
face/type = 'button 
face/feel/over face false none
]
]
view*/focal-face: view*/caret: none 
unlight-text 
all[face show face]
true
]
copy-selected-text: make function![/local start end][
if hilight?[
set[start end]hilight-range? 
write clipboard:// copy/part start end 
true
]
]
delete-selected-text: make function![/local start end][
if hilight?[
set[start end]hilight-range? 
remove/part start end 
view*/caret: start 
view*/focal-face/line-list: none 
unlight-text 
true
]
]
cut-text: make function![][
undo-add face 
copy-selected-text face 
delete-selected-text
]
paste-text: make function![][
undo-add face 
delete-selected-text 
face/line-list: none 
view*/caret: insert view*/caret read clipboard://
]
undo-max: 20 
undo-add: make function![face][
if in face 'undo[
insert clear face/undo at copy face/text index? view*/caret 
if all[undo-max undo-max < length? head face/undo][remove head face/undo]
face/undo: tail face/undo
]
]
undo-get: make function![face][
face/text: head view*/caret: first face/undo 
face/line-list: none 
remove face/undo
]
word-limits: make bitset! { 
^-^M/[](){}"} 
word-limits: reduce[word-limits complement word-limits]
current-word: make function![str /local s ns][
unless string? str[gui-error/continue reform["Current word trap" type? str str]exit]
set[s]word-limits 
s: any[all[s: find/reverse str s next s]head str]
set[ns]word-limits 
ns: any[find str ns tail str]
hilight-text s ns 
show view*/focal-face
]
next-word: make function![str /local s ns][
set[s ns]word-limits 
any[all[s: find str s find s ns]tail str]
]
back-word: make function![str /local s ns][
set[s ns]word-limits 
any[all[ns: find/reverse str ns ns: find/reverse ns s next ns]head str]
]
end-of-line: make function![str][
any[find str "^/" tail str]
]
beg-of-line: make function![str /local nstr][
either nstr: find/reverse str "^/"[next nstr][head str]
]
next-field: make function![face /wrap][
unless face/parent-face[return none]
unless find[object! block!]type?/word get in face/parent-face 'pane[
return none
]
siblings: compose[(face/parent-face/pane)]
unless wrap[siblings: find/tail siblings face]
foreach sibling siblings[
if target: any[
tabbed? sibling 
into-widget/forwards sibling
][
return target
]
]
all[
not cyclic? face/parent-face 
target: next-field face/parent-face 
return target
]
all[
target: next-field/wrap face 
return target
]
]
back-field: make function![face /wrap][
unless face/parent-face[return none]
unless find[object! block!]type?/word get in face/parent-face 'pane[
return none
]
siblings: reverse compose[(face/parent-face/pane)]
unless wrap[siblings: find/tail siblings face]
foreach sibling siblings[
if target: any[
tabbed? sibling 
into-widget/backwards sibling
][
return target
]
]
all[
not cyclic? face/parent-face 
target: back-field face/parent-face 
return target
]
all[
target: back-field/wrap face 
return target
]
]
into-widget: make function![
{Recursivly returns the first tabbable face in parent's face pane tree.} 
face[object!]
/forwards 
/backwards 
/local 
target children
][
unless find[object! block!]type?/word get in face 'pane[
return none
]
unless face/show?[
return none
]
children: compose[(face/pane)]
catch[
foreach child either backwards[reverse children][children][
if target: any[
tabbed? child 
either backwards[
into-widget/backwards child
][
into-widget child
]
][
throw target
]
]
]
]
keys-to-insert: make bitset! #{
01000000FFFFFFFFFFFFFFFFFFFFFF7FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
} 
insert-char: make function![face char][
delete-selected-text 
unless any[insert? tail? view*/caret "^/" = first view*/caret][remove view*/caret]
insert view*/caret char 
view*/caret: next view*/caret
]
move: make function![event ctrl plain][
either event/shift[
any[view*/highlight-start view*/highlight-start: view*/caret]
][unlight-text]
view*/caret: either event/control ctrl plain 
if event/shift[
either view*/caret = view*/highlight-start[unlight-text][view*/highlight-end: view*/caret]
]
]
move-y: make function![face delta /local pos tmp tmp2][
tmp: offset-to-caret face 0x2 + delta + pos: caret-to-offset face view*/caret 
tmp2: caret-to-offset face tmp 
either tmp2/y <> pos/y[tmp][view*/caret]
]
edit-text: make function![
face event 
/local key edge para caret scroll page-up page-down face-size
][
face-size: face/size - either face/edge[2 * face/edge/size][0]
key: event/key 
if char? key[
either find keys-to-insert key[
undo-add face 
insert-char face key
][key: select keymap key]
]
if word? key[
page-up:[move-y face face-size - sizes/font-height - sizes/font-height * 0x-1]
page-down:[move-y face face-size - sizes/font-height * 0x1]
do select[
left[move event[back-word view*/caret][back view*/caret]]
right[move event[next-word view*/caret][next view*/caret]]
up[move event page-up[move-y face sizes/font-height * 0x-1]]
down[move event page-down[move-y face sizes/font-height * 0x1]]
page-up[move event[head view*/caret]page-up]
page-down[move event[tail view*/caret]page-down]
home[move event[head view*/caret][beg-of-line view*/caret]]
end[move event[tail view*/caret][end-of-line view*/caret]]
insert[either event/shift[paste-text][insert?: complement insert?]]
back-char[
undo-add face 
any[
delete-selected-text 
head? view*/caret 
either event/control[
tmp: view*/caret 
remove/part view*/caret: back-word tmp tmp
][remove view*/caret: back view*/caret]
]
]
del-char[
undo-add face 
either event/shift[unless face/type = 'password[cut-text]][
any[
delete-selected-text 
tail? view*/caret 
either event/control[
remove/part view*/caret back next-word view*/caret 
if tail? next view*/caret[remove back tail view*/caret]
][remove view*/caret]
]
]
]
enter[
either find behaviors/action-on-enter face/type[
all[face/type = 'spinner face/action/on-unfocus face]
set-focus face 
face/action/on-click face
][
undo-add face 
insert-char face "^/"
]
]
ctrl-enter[undo-add face insert-char face tab]
all-text[hilight-all face]
copy-text[unless face/type = 'password[copy-selected-text face unlight-text]]
cut-text[unless face/type = 'password[cut-text]]
paste-text[paste-text]
clear-tail[
undo-add face 
remove/part view*/caret end-of-line view*/caret
]
undo[
if all[in face 'undo not head? face/undo][
insert face/undo at copy face/text index? view*/caret 
face/undo: back face/undo 
undo-get face
]
]
redo[
if all[in face 'undo not tail? face/undo][
face/undo: insert face/undo at copy face/text index? view*/caret 
undo-get face
]
]
undo-all[
if in face 'esc[
clear face/text 
all[in face 'undo clear face/undo]
all[string? face/esc insert face/text face/esc]
view*/caret: tail face/text
]
]
spellcheck[
request-spellcheck face
]
]key
]
edge: face/edge 
para: face/para 
scroll: face/para/scroll 
if error? try[
caret: caret-to-offset face view*/caret 
if caret/y < (edge/size/y + para/origin/y + para/indent/y)[
scroll/y: round/to scroll/y - caret/y sizes/font-height
]
if caret/y > (face-size/y - sizes/font-height)[
scroll/y: round/to (scroll/y + ((face-size/y - sizes/font-height) - caret/y)) sizes/font-height
]
unless para/wrap?[
if caret/x < (edge/size/x + para/origin/x + para/indent/x)[
scroll/x: scroll/x - caret/x + (edge/size/x + para/origin/x + para/indent/x)
]
if caret/x > (face-size/x - para/margin/x)[
scroll/x: scroll/x + (face-size/x - para/margin/x - caret/x)
]
]
if scroll <> face/para/scroll[
face/para/scroll: scroll 
if face/type = 'area[face/key-scroll?: true]
]
][gui-error/continue reform["Caret trap" face/type face/para]]
show face
]
feel: make object![
redraw: detect: over: none 
engage: func[face act event /local txt][
do select[
key[
unless all[get in face/action 'on-key not face/action/on-key face event][
txt: copy face/text 
edit-text face event 
all[
get in face/action 'on-edit 
strict-not-equal? txt face/text 
face/action/on-edit face
]
]
]
down[
either event/double-click[
all[view*/caret not empty? view*/caret current-word view*/caret]
][
either face = view*/focal-face[
unlight-text 
view*/caret: offset-to-caret face event/offset 
show face
][
caret: offset-to-caret face event/offset 
set-focus face
]
]
]
over[
unless view*/caret = offset-to-caret face event/offset[
unless view*/highlight-start[view*/highlight-start: view*/caret]
view*/highlight-end: view*/caret: offset-to-caret face event/offset 
show face
]
]
alt-up[face/action/on-alt-click face]
scroll-line[face/action/on-scroll face event/offset]
scroll-page[face/action/on-scroll/page face event/offset]
]act
]
]
]
widgets: make object![
rebind: make function![][
default-edge/color: colors/text 
default-edge/size: as-pair sizes/edge sizes/edge 
theme-edge/color: colors/theme-dark 
theme-edge/size: default-edge/size 
outline-edge/color: colors/outline-light 
outline-edge/size: default-edge/size 
default-font/size: sizes/font 
default-font/name: effects/font 
default-font-bold: make default-font[style: 'bold]
default-font-heading: make default-font[style: 'bold color: colors/page align: 'center shadow: 1x1]
default-font-large: make default-font[size: sizes/font * 2]
default-font-right: make default-font[align: 'right]
default-font-top: make default-font[valign: 'top]
default-para-indented/origin/x: sizes/line 
default-text/text: copy "" 
sizes/font-height: second size-text default-text 
foreach w next find first self 'choose[
widgets/:w/rebind
]
]
default-edge: make object![
color: colors/text 
image: none 
effect: none 
size: as-pair sizes/edge sizes/edge
]
theme-edge: make default-edge[
color: colors/theme-dark
]
outline-edge: make default-edge[
color: colors/outline-light
]
default-font: make object![
name: effects/font 
style: none 
size: sizes/font 
color: colors/text 
offset: 0x0 
space: 0x0 
align: 'left 
valign: 'middle 
shadow: none
]
default-font-bold: make default-font[
style: 'bold
]
default-font-heading: make default-font[
style: 'bold 
color: colors/page 
align: 'center 
shadow: 1x1
]
default-font-large: make default-font[
size: sizes/font * 2
]
default-font-right: make default-font[
align: 'right
]
default-font-top: make default-font[
valign: 'top
]
default-para: make object![
origin: 2x2 
margin: 2x2 
indent: 0x0 
tabs: 0 
wrap?: false 
scroll: 0x0
]
default-para-wrap: make default-para[
origin: 2x0 
indent: 0x0 
wrap?: true
]
default-para-indented: make default-para[
origin: as-pair sizes/line 2
]
default-feel: make object![
redraw: 
detect: 
over: 
engage: none
]
default-action: make object![
on-alt-click: 
on-away: 
on-click: 
on-dbl-click: 
on-edit: 
on-focus: 
on-key: 
on-over: 
on-resize: 
on-scroll: 
on-unfocus: none
]
set 'rebface make subface[
feel: default-feel 
action: default-action 
options:[]
rebind: init: tip: none
]
default-text: make rebface[
size: 10000x10000 
text: "" 
font: default-font 
para: default-para
]
sizes/font-height: second size-text default-text 
date-spec:[
tight 
symbol 9x6 data 'rewind[face/parent-face/data/year: face/parent-face/data/year - 1 show face/parent-face]
symbol 9x6 data 'left[face/parent-face/data/month: face/parent-face/data/month - 1 show face/parent-face]
symbol 34x6[set-data face/parent-face first face/parent-face/options]
symbol 9x6 data 'right[face/parent-face/data/month: face/parent-face/data/month + 1 show face/parent-face]
symbol 9x6 data 'forward[face/parent-face/data/year: face/parent-face/data/year + 1 show face/parent-face]
return
]
foreach day locale*/days[
insert tail date-spec compose[label 10 (copy/part day 3) font[align: 'center]]
]
insert tail date-spec[return bar]
loop 6[
insert tail date-spec 'return 
loop 7[
insert tail date-spec[
box 10x6 font[align: 'center valign: 'middle]edge[size: 0x0 color: colors/state-dark]feel[
over: make function![face act pos][
either all[act face/text][
face/parent-face/data/day: to integer! face/text 
set-title face/parent-face form face/parent-face/data 
select-face face
][deselect-face face]
]
engage: make function![face act event][
all[
act = 'down 
face/text 
face/parent-face/data/day: to integer! face/text 
poke face/parent-face/options 1 face/parent-face/data 
face/parent-face/action/on-click face/parent-face
]
all[
find[up alt-up]act 
face/feel/over face false none
]
]
]
]
]
]
face-iterator: make rebface[
type: 'face-iterator 
pane:[]
data:[]
timeout: now/time/precise 
feel: make default-feel[
redraw: make function![face act pos][
if all[act = 'show face/size <> face/old-size][face/resize]
]
engage: make function![face act event /local i][
if act = 'time[
if (now/time/precise - face/timeout) > 0:00:00.2[
face/action face 
face/rate: none 
show face
]
]
if act = 'key[
do select[
#"^A"[
if find face/options 'multi[
clear face/picked 
repeat i face/rows[insert tail face/picked i]
face/action face
]
]
down[
i: 1 + last face/picked 
if i <= face/rows[
i: min face/rows i 
insert clear face/picked i 
if find[table text-list]face/parent-face/type[
face/timeout: now/time/precise 
face/rate: 60 
if i > (face/scroll + face/lines)[
face/pane/2/data: 1 / (face/rows - face/lines) * ((min (face/rows - face/lines + 1) (i - face/lines + 1)) - 1) 
face/scroll: face/scroll + 1
]
]
]
]
up[
i: -1 + last face/picked 
if i > 0[
i: max 1 i 
insert clear face/picked i 
if find[table text-list]face/parent-face/type[
face/timeout: now/time/precise 
face/rate: 60 
if i = face/scroll[
face/pane/2/data: 1 / (face/rows - face/lines) * ((min (face/rows - face/lines + 1) i) - 1) 
face/scroll: face/scroll - 1
]
]
]
]
#"^M"[
all[find[table text-list]face/parent-face/type face/action face]
]
]event/key 
show face
]
]
]
lines: none 
rows: none 
cols: 1 
widths: none 
aligns: none 
picked:[]
scroll: 0 
resize: make function![][
lines: to integer! size/y / sizes/line 
pane/2/show?: either rows > lines[
scroll: max 0 min scroll rows - lines 
true
][
scroll: 0 
false
]
]
redraw: make function![][
clear picked 
rows: either empty? data[0][(length? data) / cols]
resize 
pane/2/ratio: either zero? rows[1][lines / rows]
show self
]
selected: make function![/local blk][
if empty? picked[return none]
either any[find options 'multi parent-face/type = 'table][
all[rows = length? picked return data]
blk: copy[]
either cols = 1[
foreach row picked[insert tail blk pick data row]
][
foreach row picked[
repeat col cols[
insert tail blk pick data -1 + row * cols + col
]
]
]
blk
][
blk: pick data first picked
]
]
init: make function![/local p][
attempt[remove find span #X]
attempt[remove find span #Y]
lines: to integer! size/y / sizes/line 
rows: (length? data) / cols 
clear pane 
p: self 
insert pane make subface[
size: p/size 
span: p/span 
pane: make function![face index /local col-offset clr][
either integer? index[
if index <= min lines rows[
line/offset/y: index - 1 * sizes/line 
line/size/x: size/x 
index: index + scroll 
either p/parent-face/type = 'table[
col-offset: 0 
repeat i p/cols[
line/pane/:i/offset/x: col-offset 
line/pane/:i/size/x: p/widths/:i - sizes/cell 
all[
p/pane/2/show? 
i = p/cols 
line/pane/:i/size/x: line/pane/:i/size/x + (p/size/x - p/pane/2/size/x - (line/pane/:i/offset/x + line/pane/:i/size/x))
]
line/pane/:i/text: replace/all form pick p/data index - 1 * cols + i "^/" "¶" 
line/pane/:i/font/color: either find p/options 'no-action[
colors/text
][
either find picked index[colors/page][colors/text]
]
col-offset: col-offset + pick widths i
]
][
line/text: replace/all form pick face/parent-face/data index "^/" "¶" 
line/font/color: either find p/options 'no-action[
colors/text
][
either find picked index[colors/page][colors/text]
]
]
line/color: either find p/options 'no-action[none][if find picked index[colors/theme-light]]
if all[
line/color = colors/theme-light 
face/parent-face/type = 'choose
][face/parent-face/auto: pick face/parent-face/data index]
line/data: index 
line
]
][to integer! index/y / sizes/line + 1]
]
text: "" 
line: make rebface[
size: as-pair 0 sizes/line 
font: make default-font[]
feel: make default-feel[
over: make function![face into pos][
if find face/parent-face/parent-face/options 'over[
either into[insert clear picked data][clear picked]
show face
]
]
engage: make function![face act event /local p a b][
p: face/parent-face 
either event/double-click[
all[act = 'down p/parent-face/dbl-action p/parent-face]
][
if find[up alt-up]act[
view*/focal-face: p 
view*/caret: tail p/text 
either find p/parent-face/options 'multi[
unless any[event/control event/shift][clear picked]
either all[event/control find picked data][
remove find picked data
][
unless find picked data[insert tail picked data]
]
if all[event/shift 1 < length? picked][
clear next picked 
repeat i (max data first picked) - (a: min data first picked) + 1[
b: i + a - 1 
all[b <> first picked insert tail picked b]
]
]
][insert clear picked data]
show p 
unless find p/parent-face/options 'no-action[
either act = 'up[
p/parent-face/action p/parent-face
][
p/parent-face/alt-action p/parent-face
]
]
]
]
]
]
]
]
if find options 'table[
pane/1/line/pane: copy[]
repeat i cols[
insert tail pane/1/line/pane make subface[
size: as-pair 0 sizes/line 
font: make default-font[align: aligns/:i]
]
]
]
insert tail pane make slider[
tip: none 
offset: as-pair p/size/x - sizes/slider 0 
size: as-pair sizes/slider p/size/y 
span: case[
none? p/span[none]
all[find p/span #H find p/span #W][#XH]
find p/span #H[#H]
find p/span #W[#X]
]
options:[arrows]
show?: either rows > lines[true][false]
action: make default-action[
on-click: make function![face][
scroll: to integer! rows - lines * data 
show face/parent-face
]
]
ratio: either rows > 0[lines / rows][1]
]
pane/2/init
]
]
choose: make function![
parent[object!]"Widget to appear in relation to" 
width[integer!]"Width in pixels" 
xy[pair!]"Offset of choice box" 
items[block!]"Block of items to display" 
/local popup result
][
result: none 
popup: make face-iterator[
type: 'choose 
offset: xy 
size: as-pair width sizes/line * min length? items to-integer parent/parent-face/size/y - xy/y / sizes/line 
color: colors/page 
data: items 
edge: outline-edge 
feel: system/words/face/feel 
options:[over]
action: make function![face][result: pick data first picked hide-popup]
alt-action: none 
dbl-action: none 
auto: none
]
popup/init 
show-popup/window/away popup parent/parent-face 
do-events 
either parent/type = 'edit-list[popup/auto][result]
]
anim: make rebface[
tip:{USAGE:
anim data[%images/go-previous.png %images/go-next.png]
anim data[img1 img2 img3]rate 2
DESCRIPTION:
Cycles a set of images at a specified rate.}
size: -1x-1 
effect: 'fit 
feel: make default-feel[
engage: make function![face act event][
all[
act = 'time 
face/image: first face/data 
face/data: either tail? next face/data[head face/data][next face/data]
show face
]
]
]
rate: 1 
init: make function![][
repeat i length? data: reduce data[
all[file? pick data i poke data i load pick data i]
]
image: first data 
data: next data 
all[negative? size/x size/x: image/size/x]
all[negative? size/y size/y: image/size/y]
]
]
pill: make rebface[
tip:{USAGE:
pill red
DESCRIPTION:
A rectangular area with rounded corners.}
size: 10x10 
effect:[draw[pen none line-width sizes/edge fill-pen linear 0x0 0 0 90 1 1 none none none box 0x0 0x0 effects/radius]]
pen: none 
fill: make function![][effect/draw/fill-pen]
feel: make default-feel[
redraw: make function![face act pos][
if act = 'show[
all[
face/color 
poke face/effect/draw 13 face/color + 0.0.0.64 
poke face/effect/draw 14 face/color + 0.0.0.32 
poke face/effect/draw 15 face/color 
face/color: none
]
]
]
]
action: make default-action[
on-resize: make function![face][
poke face/effect/draw 8 to integer! face/size/y * 0.25 
poke face/effect/draw 9 to integer! face/size/y * 0.75 
poke face/effect/draw 18 face/size - 1x1 
poke face/effect/draw 19 either all[face/size/x > sizes/line face/size/y > sizes/line][effects/radius * 2][effects/radius]
]
]
init: make function![][
action/on-resize self
]
]
area: make rebface[
tip:{USAGE:
area
area "Text" -1
area "Text" 50x-1
DESCRIPTION:
Editable text area with wrapping and scroller.
OPTIONS:
'info specifies read-only}
size: 50x25 
text: "" 
color: colors/page 
edge: theme-edge 
font: default-font-top 
para: make default-para-wrap[margin: as-pair sizes/slider + 2 2]
feel: make edit/feel[
redraw: func[face act pos /local height total visible][
if act = 'show[
if face/size <> face/old-size[
face/pane/offset/x: max 0 face/size/x - face/pane/size/x 
face/pane/size/y: face/size/y
]
if any[
face/text-y <> height: second size-text face 
face/size <> face/old-size
][
face/text-y: height 
total: face/text-y 
visible: face/size/y - (edge/size/y * 2) - para/origin/y - para/indent/y 
face/pane/ratio: either total > 0[min 1 (visible / total)][1]
face/pane/step: either visible < total[min 1 (sizes/font-height / (total - visible))][0]
]
if all[face/pane/ratio < 1 face/key-scroll?][
do bind[
total: text-y 
visible: size/y - (edge/size/y * 2) - para/origin/y - para/indent/y 
pane/data: - para/scroll/y / (total - visible)
]face 
face/key-scroll?: false
]
]
]
]
esc: none 
caret: none 
undo: copy[]
text-y: none 
key-scroll?: false 
action: make default-action[
on-scroll: make function![face scroll /page /local total visible][
total: second size-text face 
visible: face/size/y - (face/edge/size/y * 2) - face/para/origin/y - face/para/indent/y 
face/para/scroll/y: either page[
min max face/para/scroll/y - (visible * sign? scroll/y) (visible - total) 0
][
min max face/para/scroll/y - (scroll/y * sizes/font-height) (visible - total) 0
]
all[face/pane/data: - face/para/scroll/y / (total - visible)]
show face
]
]
rebind: make function![][
color: colors/page 
para/margin/x: sizes/slider + 2
]
init: make function![/local p][
if find options 'info[
feel: make feel[engage: none]
all[color = colors/page color: colors/outline-light]
]
para: make para[]
p: self 
text-y: second size-text self 
all[negative? size/x size/x: 10000 size/x: 4 + first size-text self]
all[negative? size/y size/y: 10000 size/y: 8 + text-y]
pane: make slider[
tip: none 
offset: as-pair p/size/x - sizes/slider 0 
size: as-pair sizes/slider p/size/y 
span: case[
none? p/span[none]
all[find p/span #H find p/span #W][#XH]
find p/span #W[#X]
find p/span #H[#H]
true[none]
]
options:[arrows]
action: make default-action[
on-click: make function![face /local visible][
unless parent-face/key-scroll?[
visible: (parent-face/size/y - (parent-face/edge/size/y * 2) - parent-face/para/origin/y - parent-face/para/indent/y) 
parent-face/para/scroll/y: negate parent-face/text-y - visible * data 
if all[
view*/caret 
parent-face = view*/focal-face
][
]
show parent-face
]
parent-face/key-scroll?: false
]
]
ratio: p/size/y - 4 / text-y
]
pane/init
]
]
arrow: make rebface[
tip:{USAGE:
arrow
arrow 10
arrow data 'up
arrow data 'down
arrow data 'left
arrow data 'right
DESCRIPTION:
An arrow (default down) on a square button face with height set to width.}
size: 5x-1 
data: 'down 
feel: make default-feel[
redraw: make function![face act pos][
all[act = 'show face/color: either face/data[colors/state-light][colors/theme-light]]
]
engage: make function![face act event][
do select[
time[all[face/data face/action/on-click face]]
down[face/data: on]
up[face/data: off face/action/on-click face]
over[face/data: on]
away[face/data: off]
]act 
show face
]
]
effect: reduce['arrow colors/page 'rotate 0]
rebind: make function![][effect/arrow: colors/page]
init: make function![][
all[negative? size/y size/y: size/x]
effect/rotate: select[up 0 right 90 down 180 left 270]data 
data: off
]
]
bar: make rebface[
tip:{USAGE:
bar 100
DESCRIPTION:
A thin 3D bar used to separate widgets.
Defaults to maximum display width.}
size: -1x1 
color: colors/outline-light 
edge: make outline-edge[effect: 'bevel]
rebind: make function![][color: edge/color: colors/outline-light]
]
box: make rebface[
tip:{USAGE:
box red
DESCRIPTION:
The most basic of widgets, a rectangular area.}
size: 25x25
]
button: make pill[
tip:{USAGE:
button "Hello"
button -1 "Go!"
button "Click me!"[print "click"]
DESCRIPTION:
Performs action when clicked.
OPTIONS:
'info specifies read-only}
size: 15x5 
text: "" 
color: colors/theme-dark 
data: color 
font: default-font-heading 
feel: make feel[
over: make function![face act pos][
set-color face either all[act not find face/options 'info][colors/theme-light][face/data]
]
engage: make function![face act event /local f][
unless find face/options 'info[
do select[
down[set-color face colors/state-light]
alt-down[set-color face colors/state-light]
up[set-color face colors/theme-dark face/action/on-click face]
alt-up[set-color face colors/theme-dark face/action/on-alt-click face]
away[set-color face face/data]
]act
]
]
]
rebind: make function![][
color: colors/theme-dark
]
init: make function![][
all[negative? size/x size/x: 10000 size/x: 8 + first size-text self]
all[find options 'info color = colors/theme-dark color: colors/outline-light]
data: color 
action/on-resize self
]
]
calendar: make rebface[
tip:{USAGE:
calendar
calendar data 1-Jan-2000
DESCRIPTION:
Used to select a date, with face/data set to current selection.
Default selection is now/date.}
size: 70x48 
feel: make default-feel[
redraw: make function![face act pos /local date month][
if act = 'show[
date: face/data 
month: date/month 
date/day: 1 
date: date - date/weekday + 1 
foreach sub-face skip face/pane 13[
sub-face/edge/size: 0x0 
sub-face/text: either date/month = month[
all[date = first face/options sub-face/edge/size: 2x2]
form date/day
][none]
date: date + 1
]
face/pane/3/text: reform[pick locale*/months face/data/month face/data/year]
]
]
]
init: make function![][
insert options any[data now/date]
data: layout/only date-spec 
pane: data/pane 
size: data/size 
data: first options
]
]
chat: make rebface[
tip:{USAGE:
chat 120 data["Bob" blue "My comment." yello 14-Apr-2007/10:58]
DESCRIPTION:
Three column chat display as found in IM apps such as AltME.
Messages are appended, with those exceeding 'limit not shown.
OPTIONS:
[limit n]where n specifies number of messages to show (default 100)
[id n]where n specifies id column width (default 10)
[user n]where n specifies user column width (default 15)
[date n]where n specifies date column width (default 25)}
size: 200x100 
pane:[]
data:[]
edge: outline-edge 
action: make default-action[
on-resize: make function![face][
poke face/pane/2/para/tabs 3 face/pane/1/size/x - (sizes/cell * any[select face/options 'date 25]) 
face/redraw/no-show
]
]
height: 0 
rows: 0 
limit: none 
append-message: make function![
user[string!]
user-color[tuple! word! none!]
msg[string!]
msg-color[tuple! word! none!]
date[date!]
/no-show row 
/local p y t1 t2 t3
][
t1: pick pane/2/para/tabs 1 
t2: pick pane/2/para/tabs 2 
t3: pick pane/2/para/tabs 3 
y: max sizes/line 4 + second size-text make subface[
size: as-pair t3 - t2 10000 
text: msg 
font: default-font 
para: default-para-wrap
]
p: self 
insert tail pane/1/pane reduce[
make subface[
offset: as-pair 0 height 
size: as-pair t1 y 
text: form any[row rows: rows + 1]
color: colors/theme-dark 
edge: make outline-edge[size: 0x1]
font: default-font-heading
]
make subface[
offset: as-pair t1 height 
size: as-pair t2 - t1 y 
text: user 
edge: make outline-edge[size: 0x1]
font: make default-font-top[color: either word? user-color[get user-color][user-color]style: 'bold]
]
make subface[
offset: as-pair t2 height 
size: as-pair t3 - t2 y 
span: all[p/span find p/span #W #W]
text: form msg 
color: either word? msg-color[get msg-color][msg-color]
edge: make outline-edge[size: 0x1]
font: default-font 
para: default-para-wrap
]
make subface[
offset: as-pair t3 height 
size: as-pair p/size/x - t3 - sizes/slider y 
span: all[p/span find p/span #W #X]
text: form either now/date = date/date[date/time][date/date]
edge: make outline-edge[size: 0x1]
font: default-font-top
]
]
height: height + y - 1 
if ((length? pane/1/pane) / 4) > limit[
y: pane/1/pane/1/size/y - 1 
remove/part pane/1/pane 4 
foreach[i u m d]pane/1/pane[
i/offset/y: u/offset/y: m/offset/y: d/offset/y: i/offset/y - y
]
height: height - y
]
unless no-show[
insert tail data reduce[user user-color msg msg-color date]
pane/1/size/y: height 
pane/3/ratio: pane/3/size/y / height 
show p
]
show pane/1
]
set-user-color: make function![id[integer!]color[tuple! word! none!]/local idx][
if any[zero? id id > rows][exit]
poke data id * 5 - 3 color 
if limit > (rows - id)[
idx: either rows > limit[(id + limit - rows) * 4 - 2][id * 4 - 2]
pane/1/pane/:idx/font/color: either word? color[get color][color]
show pane/1/pane/:idx
]
]
set-message-text: make function![id[integer!]string[string!]/local idx][
if any[zero? id id > rows][exit]
poke data id * 5 - 2 string 
if limit > (rows - id)[
idx: either rows > limit[(id + limit - rows) * 4 - 1][id * 4 - 1]
insert clear pane/1/pane/:idx/text string 
redraw
]
]
set-message-color: make function![id[integer!]color[tuple! word! none!]/local idx][
if any[zero? id id > rows][exit]
poke data id * 5 - 1 color 
if limit > (rows - id)[
idx: either rows > limit[(id + limit - rows) * 4 - 1][id * 4 - 1]
pane/1/pane/:idx/color: either word? color[get color][color]
show pane/1/pane/:idx
]
]
redraw: make function![/no-show /local row][
clear pane/1/pane 
height: 0 
rows: (length? data) / 5 
row: max 0 rows - limit: any[select options 'limit 100]
foreach[user user-color msg msg-color date]skip data row * 5[
append-message/no-show user user-color msg msg-color date row: row + 1
]
pane/1/size/y: height 
pane/3/ratio: either zero? height[1][pane/3/size/y / height]