From b1ecf8882adf42f8720412945c04f61a00ef465e Mon Sep 17 00:00:00 2001 From: Ubuntu Date: Wed, 22 Oct 2014 02:59:05 +0000 Subject: [PATCH 01/31] hooked dill up to shell; removed batz --- arvo/ames.hoon | 1 + arvo/batz.hoon | 4 +- arvo/clay.hoon | 3 +- arvo/dill.hoon | 236 +++++++++++++++++++------- arvo/eyre.hoon | 5 - arvo/gall.hoon | 5 +- arvo/hoon.hoon | 1 - main/app/shell/core.hook | 4 + main/app/solid/core.hook | 28 +-- main/app/terminal/core.hook | 71 +++++--- main/app/terminal/hymn/.script.js.swp | Bin 0 -> 12288 bytes main/app/terminal/hymn/script.js | 4 +- main/bin/solid.hoon | 1 - 13 files changed, 252 insertions(+), 111 deletions(-) create mode 100644 main/app/terminal/hymn/.script.js.swp diff --git a/arvo/ames.hoon b/arvo/ames.hoon index cdd9a101b5..b049e62eef 100644 --- a/arvo/ames.hoon +++ b/arvo/ames.hoon @@ -1668,6 +1668,7 @@ [hen [%slip %a %kick now]] [hen [%slip %e %init p.bon]] [hen [%slip %g %init p.bon]] + [hen [%slip %d %init p.bon]] :: must be after gall ~ == :: diff --git a/arvo/batz.hoon b/arvo/batz.hoon index aa1767fdb8..753b52e271 100644 --- a/arvo/batz.hoon +++ b/arvo/batz.hoon @@ -53,8 +53,8 @@ [%sith p=@p q=@uw r=?] :: [%want p=sock q=path r=*] :: == == :: - $: %b :: - $% [%hail ~] :: to %batz + $: %b :: to %batz + $% [%hail ~] :: [%line p=@t] :: == == :: $: %c :: to %clay diff --git a/arvo/clay.hoon b/arvo/clay.hoon index fbba67a672..e8f374b389 100644 --- a/arvo/clay.hoon +++ b/arvo/clay.hoon @@ -120,8 +120,7 @@ [%pass b %a %want [who c] [%q %re p.q.d (scot %ud p.d) ~] q.d] :: %+ turn (flop tag) - |= [a=duct b=path c=note] - [a %pass b c] + |=([a=duct b=path c=note] [a %pass b c]) == :: ++ aver :: read diff --git a/arvo/dill.hoon b/arvo/dill.hoon index cd7c1031f7..c15bc9a3ac 100644 --- a/arvo/dill.hoon +++ b/arvo/dill.hoon @@ -1,4 +1,4 @@ -:: +!: :: dill (4d), terminal handling :: |= pit=vase @@ -11,7 +11,7 @@ [%veer p=@ta q=path r=@t] :: install vane [%vega p=path] :: reboot by path [%verb ~] :: by %batz - == + == :: ++ kiss :: in request ->$ $% [%belt p=belt] :: terminal input [%blew p=blew] :: terminal config @@ -21,6 +21,7 @@ [%hail ~] :: terminal refresh [%hook ~] :: this term hung up [%harm ~] :: all terms hung up + [%init p=ship] :: after gall ready [%noop ~] :: no operation [%talk p=tank] :: [%text p=tape] :: @@ -29,42 +30,85 @@ $% [%crud p=@tas q=(list tank)] :: [%text p=tape] :: == :: +++ mess $% [%term-ctrl p=(hypo ,%hail)] :: + [%term-in p=(hypo term-in)] :: + == :: ++ move ,[p=duct q=(mold note gift)] :: local move ++ note :: out request $-> - $% $: %b :: to %batz - $% [%hail ~] :: - [%harm ~] :: - [%hook ~] :: - [%kill p=~] :: - [%line p=@t] :: - [%ling ~] :: - [%make p=(unit ,@t) q=@ud r=@ s=?] :: + $% $: %a :: + $% [%make p=(unit ,@t) q=@ud r=@ s=?] :: [%sith p=@p q=@uw r=?] :: == == :: + ::S $% $: %b :: to %batz + ::S $% [%hail ~] :: + ::S [%harm ~] :: + ::S [%hook ~] :: + ::S [%kill p=~] :: + ::S [%line p=@t] :: + ::S [%ling ~] :: + ::S [%make p=(unit ,@t) q=@ud r=@ s=?] :: + ::S [%sith p=@p q=@uw r=?] :: + ::S == == :: $: %d :: to %dill $% [%crud p=@tas q=(list tank)] :: [%text p=tape] :: + == == :: + $: %g :: + $% [%mess p=[p=ship q=path] q=ship r=mess] :: + [%show p=[p=ship q=path] q=ship r=path] :: + == == :: + $: %t :: + $% [%wait p=@da] :: == == == :: ++ sign :: in result $<- - $? $: %b :: by %batz - $% [%hail ~] :: - [%helo p=path q=prod] :: - [%logo p=@] :: - [%save p=path q=@] :: + $? + ::S $: %b :: by %batz + ::S $% [%hail ~] :: + ::S [%helo p=path q=prod] :: + ::S [%logo p=@] :: + ::S [%save p=path q=@] :: + ::S [%sage p=path q=*] :: + ::S [%talk p=tank] :: + ::S [%tell p=(list ,@t)] :: + ::S [%text p=tape] :: + ::S [%verb ~] :: + ::S [%veer p=@ta q=path r=@t] :: + ::S [%vega p=path] :: + ::S [%warn p=tape] :: + ::S == == :: + $: %g :: + $% [%mean p=ares] :: + [%nice ~] :: + $: %rush :: XX + $% [%term-line q=term-line] :: + [%hymn q=manx] :: + [%json q=json] :: + == == :: + $: %rust :: + $% [%term-line q=term-line] :: + [%hymn q=manx] :: + [%json q=json] :: + == == :: [%sage p=path q=*] :: - [%talk p=tank] :: - [%tell p=(list ,@t)] :: - [%text p=tape] :: - [%verb ~] :: [%veer p=@ta q=path r=@t] :: [%vega p=path] :: - [%warn p=tape] :: + == == :: + $: %t :: + $% [%wake ~] :: == == :: $: @tas :: by any $% [%crud p=@tas q=(list tank)] :: [%init p=@p] :: [%note p=@tD q=tank] :: == == == :: +++ term-in :: + $: pax=path :: + $= jof :: + $% [%line p=span] :: + [%res p=span] :: + [%cmd p=char] :: + == == :: +++ term-line ,[p=cord q=(list cord) r=(list tank)] :: :::::::: :: dill tiles ++ bein :: terminal control $: $: bul=@ud :: buffer length @@ -107,6 +151,16 @@ r=(list (list ,@c)) :: kills == :: ++ blur ,[p=@ud q=(unit bein) r=blot] :: columns, prompt +++ kyev :: + $: p=(set ?(%ctrl %shift %alt %meta)) :: + q=$|(cord [%act speck]) :: + == :: +++ speck :: + $? %ctrl %shift %alt %meta %entr %esc :: + %caps %uncap %pgup %pgdn %home %end :: + %baxp %del %ins %up %down %left :: + %right :: + == :: ++ yard :: terminal state $: p=? :: verbose q=blur :: display state @@ -267,53 +321,90 @@ ?~ q.+.sih +>.^$ (fume:$(q.+.sih t.q.+.sih) '!' `tank`i.q.+.sih) :: - %helo :: trigger prompt + ::S %helo :: trigger prompt + ::S %- edit + ::S =| bed=bein + ::S =+ ^= hyt ^- hist + ::S =+ hyt=(~(get by r.yar) p.+.sih) + ::S ?~(hyt *hist u.hyt) + ::S ?: &(?=(^ q.q.yar) =(p.+.sih hux.u.q.q.yar)) + ::S %= u.q.q.yar + ::S hyt [+(p.hyt) [%$ q.hyt]] + ::S pot q.q.+.sih + ::S pol (lent q.q.+.sih) + ::S buy p.q.+.sih + ::S == + ::S =+ zon=(tuba r.q.+.sih) + ::S =+ zow=(lent zon) + ::S %= bed + ::S bul zow + ::S bus zow + ::S but zon + ::S buy p.q.+.sih + ::S hux p.+.sih + ::S hiz 0 + ::S hyt [+(p.hyt) [%$ q.hyt]] + ::S pot q.q.+.sih + ::S pol (lent q.q.+.sih) + ::S == + ::S :: + ::S ?(%hail %make %sith) + ::S +>.$(mos :_(mos [hen %pass ~ %b +.sih])) + ::S :: + %mean ~& %dill-mean +>.$ + %nice +>.$ + %note ?.(p.yar +>.$ (fume p.+.sih q.+.sih)) :: debug message + ?(%rush %rust) :: XX reset prompt + ?> ?=(%term-line +>-.sih) + =. +>.$ (furl (zing (turn r.q.sih |=(a=tank (~(win re a) 0 p.q.yar))))) %- edit =| bed=bein =+ ^= hyt ^- hist - =+ hyt=(~(get by r.yar) p.+.sih) + =+ hyt=(~(get by r.yar) /) ?~(hyt *hist u.hyt) - ?: &(?=(^ q.q.yar) =(p.+.sih hux.u.q.q.yar)) + ?: &(?=(^ q.q.yar) =(/ hux.u.q.q.yar)) %= u.q.q.yar hyt [+(p.hyt) [%$ q.hyt]] - pot q.q.+.sih - pol (lent q.q.+.sih) - buy p.q.+.sih + pot (trip p.q.sih) + pol (met 3 p.q.sih) + buy %text == - =+ zon=(tuba r.q.+.sih) - =+ zow=(lent zon) - %= bed - bul zow - bus zow - but zon - buy p.q.+.sih - hux p.+.sih + %_ bed + bul 0 + bus 0 + but ~ + buy %text + hux / hiz 0 hyt [+(p.hyt) [%$ q.hyt]] - pot q.q.+.sih - pol (lent q.q.+.sih) + pot (trip p.q.sih) + pol (met 3 p.q.sih) == :: - ?(%hail %make %sith) - +>.$(mos :_(mos [hen %pass ~ %b +.sih])) - :: - %note ?.(p.yar +>.$ (fume p.+.sih q.+.sih)) :: debug message %sage :: write a jamfile %= +>.$ mos :_(mos [hen [%give %blit [%sag p.+.sih q.+.sih] ~]]) == - :: - %save :: write a file - %= +>.$ - mos :_(mos [hen [%give %blit [%sav p.+.sih q.+.sih] ~]]) - == - :: - %tell (furl (turn p.+.sih |=(a=@t (trip a)))) :: wall of text - %talk (furl (~(win re p.+.sih) 0 p.q.yar)) :: program output - %text $(+.sih [%talk %leaf p.+.sih]) :: simple message - %warn (fume '~' [%leaf p.+.sih]) :: system message - ?(%init %logo %veer %vega %verb) :: drop-throughs + ::S :: + ::S %save :: write a file + ::S %= +>.$ + ::S mos :_(mos [hen [%give %blit [%sav p.+.sih q.+.sih] ~]]) + ::S == + ::S :: + ::S %tell (furl (turn p.+.sih |=(a=@t (trip a)))) :: wall of text + ::S %talk (furl (~(win re p.+.sih) 0 p.q.yar)) :: program output + ::S %text $(+.sih [%talk %leaf p.+.sih]) :: simple message + ::S %warn (fume '~' [%leaf p.+.sih]) :: system message + ::S ?(%init %logo %veer %vega %verb) :: drop-throughs + ::S +>(mos :_(mos [hen %give +.sih])) + ?(%init %veer %vega) :: drop-through +>(mos :_(mos [hen %give +.sih])) + %wake + %= +>.$ + mos + :_ mos + [hen %pass / %g %show [~zod /terminal] ~zod /tines] :: XX ~zod %init + == == :: ++ lear :: handle request @@ -324,6 +415,7 @@ %noop +> %belt :: terminal input ?~ q.q.yar + ~& %dill-no-bein beep ?^ hyr.u.q.q.yar :: live search ?+ p.kyz $(hiz.u.q.q.yar 0, hyr.u.q.q.yar ~) @@ -389,7 +481,9 @@ %d ?: ?& =(0 bul.u.q.q.yar) =(0 bus.u.q.q.yar) == - +>.$(mos :_(mos [hen %pass ~ %b [%kill ~]])) + ~& %dill-kill-not-implemented + +>.$ + ::S +>.$(mos :_(mos [hen %pass ~ %b [%kill ~]])) :: XX send \c $(kyz [%belt %del ~]) %e (edit u.q.q.yar(bus bul.u.q.q.yar)) %f $(kyz [%belt %aro %r]) @@ -438,7 +532,8 @@ %r (edit u.q.q.yar(hyr [~ ~])) :: TODO :: %w +>.$(mos :_(mos [hen %pass ~ %b [%limn ~]])) - %x +>.$(mos :_(mos [hen %pass ~ %b [%ling ~]])) + %x +>.$(mos :_(mos (poke %term-in -:!>(*term-in) / %cmd %x))) + ::S %x +>.$(mos :_(mos [hen %pass ~ %b [%ling ~]])) %y ?: =(0 p.r.q.yar) beep $(kyz [%belt %txt (snag q.r.q.yar r.r.q.yar)]) @@ -507,9 +602,11 @@ [p.hyt.u.q.q.yar [jab ?~(q.hyt.u.q.q.yar ~ +.q.hyt.u.q.q.yar)]] :: mos - :* [hen %pass ~ %b [%hail ~]] + :* ::S [hen %pass ~ %b [%hail ~]] + (poke %term-ctrl -:!>(%hail) %hail) [hen %give [%bbye ~]] - [hen %pass ~ %b [%line jab]] + ::S [hen %pass ~ %b [%line jab]] + (poke %term-in -:!>(*term-in) / %line jab) [hen %give [%blit [[%mor ~] ~]]] mos == @@ -533,9 +630,9 @@ :: %blew +>.$(p.q.yar p.p.kyz) :: window size %boot - %= +>.$ - mos - :_(mos [hen %pass ~ (note %b p.kyz)]) + %= +>.$ + mos + :_(mos [hen %pass ~ (note %a p.kyz)]) == :: %crud :: error trace @@ -545,23 +642,40 @@ (fume:$(q.kyz t.q.kyz) '!' `tank`i.q.kyz) :: %hail :: refresh - +>.$(mos :_(mos [hen %pass ~ %b kyz])) + +>.$ + ::S +>.$(mos :_(mos [hen %pass ~ %b kyz])) :: %harm :: all terms hung up =+ nug=((map duct yard) [[hen (~(get by dug) hen)] ~ ~]) ^+ +>.$ %= +>.$ dug nug - mos :_(mos [hen %pass ~ %b kyz]) + ::S mos :_(mos [hen %pass ~ %b kyz]) == :: %hook :: this term hung up - +>.$(dug (~(del by dug) hen), mos :_(mos [hen %pass ~ %b kyz])) + ~& %dill-hook-not-implemented + +>.$ + ::S +>.$(dug (~(del by dug) hen), mos :_(mos [hen %pass ~ %b kyz])) + :: + %init + %= +>.$ + mos + :_ mos + [hen %slip %t %wait `@da`0] :: XX ~zod %init + == :: %talk (furl (~(win re p.kyz) 0 p.q.yar)) :: program output %text $(kyz [%talk %leaf p.kyz]) :: simple message == :: + ++ poke + |= msg=mess + ^- move + :^ hen %pass / :: XX ~zod %init + :^ %g %mess [~zod /terminal] + :- ~zod msg + :: ++ yerk :: complete core ^- [p=(list move) q=(map duct yard)] :- (flop mos) diff --git a/arvo/eyre.hoon b/arvo/eyre.hoon index 79be81a1ac..fed62417ef 100644 --- a/arvo/eyre.hoon +++ b/arvo/eyre.hoon @@ -29,11 +29,6 @@ ++ note :: out request $-> $% $: %a :: to %ames $% [%want p=sock q=path r=*] :: - == == :: - $: %b :: to %batz - $% [%hail ~] :: - [%line p=@t] :: - [%ling ~] :: == == :: $: %c :: to %clay $% [%warp p=sock q=riff] :: diff --git a/arvo/gall.hoon b/arvo/gall.hoon index 5bcecbfa97..c017da19ba 100644 --- a/arvo/gall.hoon +++ b/arvo/gall.hoon @@ -131,7 +131,7 @@ $% [%dirt p=twig] :: == :: ++ sign :: in result $<- - $? [?(%b %c %d %e) @tas *] :: + $? [?(%c %d %e) @tas *] :: $: %a :: by %ames $% [%woot p=ship q=coop] :: [%went p=ship q=cape] :: XX only for apps @@ -144,6 +144,7 @@ [%nice ~] :: [%rush p=mark q=*] :: [%rust p=mark q=*] :: + [%sage p=path q=*] :: [%veer p=@ta q=path r=@t] :: [%vega p=path] :: == == :: @@ -441,6 +442,7 @@ %nice [%give %nice ~] %rush !! %rust !! + %sage !! %veer !! %vega !! == @@ -457,6 +459,7 @@ %nice [%give %nice ~] %rush [%pass [%r pax] (rod %d p.+.sih q.+.sih)] %rust [%pass [%r pax] (rod %f p.+.sih q.+.sih)] + %sage !! %veer !! %vega !! == diff --git a/arvo/hoon.hoon b/arvo/hoon.hoon index d6fa98bdc8..1d842ba766 100644 --- a/arvo/hoon.hoon +++ b/arvo/hoon.hoon @@ -9886,7 +9886,6 @@ ?+ hap !! [@ %ames *] %a [@ %newt *] %a - [@ %batz *] %b [@ %sync *] %c [@ %term *] %d [@ %http *] %e diff --git a/main/app/shell/core.hook b/main/app/shell/core.hook index 3c57153fc1..f6e7c7d261 100644 --- a/main/app/shell/core.hook +++ b/main/app/shell/core.hook @@ -14,6 +14,7 @@ [%mean p=ares] :: [%nice ~] :: [%meta p=vase] :: + [%sage p=path q=*] :: [%veer p=@ta q=path r=@t] :: [%vega p=path] :: == :: @@ -53,6 +54,7 @@ [%nice ~] :: [%rush p=mark q=*] :: [%rust p=mark q=*] :: + [%sage p=path q=*] :: [%veer p=@ta q=path r=@t] :: [%vega p=path] :: == == == :: @@ -293,6 +295,8 @@ ::~& shel-purr/pax :: ~& [%shell-pour -.sih (,@ta +<.sih)] ::=+ sih=((hard sign) sih) + ?: ?=(%sage +<.sih) :: vomit + [[ost %give +.sih]~ +>.$] ?: ?=(%veer +<.sih) :: vomit [[ost %give +.sih]~ +>.$] ?: ?=(%vega +<.sih) :: vomit diff --git a/main/app/solid/core.hook b/main/app/solid/core.hook index b244e9b4ff..ed3be0d30d 100644 --- a/main/app/solid/core.hook +++ b/main/app/solid/core.hook @@ -17,10 +17,10 @@ [%g %gall] [%f %ford] [%a %ames] - [%b %batz] [%c %clay] [%d %dill] [%e %eyre] + [%t %time] == |- ^+ all ?~ vay all @@ -31,19 +31,19 @@ =+ gat=.*(all .*(all [0 42])) =+ nex=+:.*([-.gat [sam +>.gat]] -.gat) $(vay t.vay, all nex) - :_ ~ :_ ~ - ~& %solid-jamming - =+ pac=(jam [ken all]) - ~& %solid-finished - =+ nax=/(scot %p our.hid)/try/(scot %da lat.hid)/urbit/pill - :* [ost %pass /cp %c %info our.hid (foal nax pac)] - [ost %give %nice ~] - %+ turn (~(tap by sup.hid)) - |= [ost=bone *] - :^ ost %give %rush - :- %tang :_ ~ - leaf/"done" - == + [ost %give %sage [%urbit %pill ~] [ken all]]~ +:: ~& %solid-jamming +:: =+ pac=(jam [ken all]) +:: ~& %solid-finished +:: =+ nax=/(scot %p our.hid)/try/(scot %da lat.hid)/urbit/pill +:: :* [ost %pass /cp %c %info our.hid (foal nax pac)] +:: [ost %give %nice ~] +:: %+ turn (~(tap by sup.hid)) +:: |= [ost=bone *] +:: :^ ost %give %rush +:: :- %tang :_ ~ +:: leaf/"done" +:: == ++ peer |= * diff --git a/main/app/terminal/core.hook b/main/app/terminal/core.hook index 6afa20229d..130240cc2e 100644 --- a/main/app/terminal/core.hook +++ b/main/app/terminal/core.hook @@ -3,7 +3,7 @@ :::: /hook/core/terminal/app :: /? 314 :: need urbit 314 -/- term-line, kyev +/- term-line, term-in, term-ctrl, kyev /= stat /:/%%/:/hymn/ :: :::: structures @@ -22,6 +22,7 @@ [%rust gilt] :: [%mean p=ares] :: [%nice ~] :: + [%sage p=path q=*] :: [%veer p=@ta q=path r=@t] :: [%vega p=path] :: == :: @@ -41,6 +42,7 @@ [%nice ~] :: [%rust p=%term-line q=term-line] :: [%rush p=%term-line q=term-line] :: + [%sage p=path q=*] :: [%veer p=@ta q=path r=@t] :: [%vega p=path] :: == == == @@ -85,7 +87,7 @@ %lines :_ +>.$ :_ ~ - (jell ost t.pax) + (jell-json ost (fall (~(get by hiz) t.pax) *term-line)) %term =+ tel=(fall (~(get by hiz) t.pax) *term-line) =^ mof r.tel @@ -101,19 +103,16 @@ =. hiz (~(put by hiz) t.pax tel) :_ +>.$ [[ost %give %rust %hymn (page t.pax)] mof] + %tines + :_ +>.$ + :_ ~ + (jell-term ost (fall (~(get by hiz) t.pax) *term-line)) == :: -++ poke-json - |= [ost=bone you=ship jon=json] +++ poke-term-in + |= [ost=bone you=ship term-in] ^- [(list move) _+>] ::~& tem-poke/jon - =+ ^- [pax=path jof=$%([%line p=span] [%res p=span] [%cmd p=char])] - %- need - %. jon => jo - %^ ot - pax/(su ;~(pfix fas (more fas sym))) - act/(of line/so res/so cmd/so ~) - ~ |- =+ tel=(fall (~(get by hiz) pax) *term-line) ?- -.jof @@ -134,7 +133,7 @@ :^ %g %show [our.hid joc imp.hid] :- you /out [ost %pass [%hi joc mar/pax] %g %sire [p.jof joc]] - (spam pax) + (spam pax tel) :: %line =. r.tel :_(r.tel rose/["> " ~ ~]^~[leaf/(trip p.tel) leaf/(trip p.jof)]) @@ -148,6 +147,26 @@ %r $(jof [%res 'shell']) == == +:: +++ poke-json + |= [ost=bone you=ship jon=json] + ^- [(list move) _+>] + ::=+ ^- [pax=path jof=$%([%line p=span] [%res p=span] [%cmd p=char])] + %^ poke-term-in ost you + ^- [pax=path jof=$%([%line p=span] [%res p=span] [%cmd p=char])] + %- need + %. jon => jo + %^ ot + pax/(su ;~(pfix fas (more fas sym))) + act/(of line/so res/so cmd/so ~) + ~ +:: +++ poke-term-ctrl + |= [ost=bone you=ship col=term-ctrl] + ^- [(list move) _+>] + :_ +>.$ :_ ~ + [ost %give %rush %term-line [p q ~]:(fall (~(get by hiz) /) *term-line)] +:: ++ send |= [ost=bone you=ship pax=path mez=[?(%txt %kyev) vase]] %+ murn (~(tap by cub.hid)) @@ -157,24 +176,31 @@ :^ ost %pass [-.mez p (scot %da lat.hid) pax] [%g %mess [our.hid p imp.hid] you mez] :: -++ jell - |= [a=bone b=path] - [a %give %rust %json (tel-to-jon (fall (~(get by hiz) b) *term-line))] +++ jell-json + |= [a=bone b=term-line] + [a %give %rush %json (tel-to-jon b)] +:: +++ jell-term + |= [a=bone b=term-line] + [a %give %rush %term-line b] :: ++ spam - |= pax=path + |= [pax=path tel=term-line] ::~& tem-spam/(~(run by hiz) |=(term-line p)) %+ murn (~(tap by sup.hid)) |= [ost=bone @ paf=path] - ?. =([%lines pax] paf) ~ - (some (jell ost pax)) + ?: =([%lines pax] paf) + (some (jell-json ost tel)) + ?: =([%tines pax] paf) + (some (jell-term ost tel)) + ~ :: ++ pour |= [ost=bone pax=path sih=*] ^- [(list move) _+>] =+ sih=((hard sign) sih) - ?: ?=(?(%veer %vega) &2.sih) :: vomit + ?: ?=(?(%sage %veer %vega) &2.sih) :: vomit [[ost %give +.sih]~ +>.$] ?: ?=(%gone &2.sih) `+>.$ @@ -188,7 +214,7 @@ [p.tol (weld q.q.sih q.tol) (weld r.q.sih r.tol)] [p.q.sih (weld q.q.sih q.tol) (weld r.q.sih r.tol)] =. hiz (~(put by hiz) paf tol) - [(spam paf) +>.$] + [(spam paf q.sih) +>.$] == =+ tel=(fall (~(get by hiz) paf) *term-line) =+ old=tel @@ -202,8 +228,9 @@ =. hiz (~(put by hiz) paf tel) :_ +>.$ :- [ost %give +.sih] - ::?: =(old tel) ~ - (spam paf) + ?: =(old tel) ~ + ~& [%term-wuh-spamming r.tel] + (spam paf tel) :: ++ tel-to-jon |= tel=term-line diff --git a/main/app/terminal/hymn/.script.js.swp b/main/app/terminal/hymn/.script.js.swp new file mode 100644 index 0000000000000000000000000000000000000000..01185b75d3bf22524dbadc1e3389846302ede712 GIT binary patch literal 12288 zcmeI2&u`pB6vy4F{0bB(Z~y^fnugj|cI{1*s%1+G2vo|Ch)T5OkcMd1JDYXaYg_hs zlQe|hC?fjC6(^EsOfgOAG$n_T`7{TAM(I$uXaN>^%6gp&e?QJbGkw+pcUAz z0-0=85AQan4@}jl%f9iw?Ed>sZMU~>rxnl&Xa%$aS^=$qRzNGD70?R&4-}B`4&yxL zv9p*Bzy%P4Q{Wh=f-&&pU50TLtbuc&0bT?L0Rwx$?{~r`xC|D-3GfW4 zfJebD@XMHCd=9RHkH9JLG^m4vU;zxm4*$U= za1p!<7C{X>0B+o77(an;z$f55cpXfE32+12e*r!O?}4|$X<&hUfY!zV`qBz$1+)VH zvI6V&5reUH8wJY2XBH=->qxO8pN&E(Ldj-XlS>D1Cr+YnEZHP8k1~^bvSmMPM#~O< z#}x&^$;hfznvs`v(a&i_&DEmfxbTfB1i>WyP1`y-y615dg-?; zxf+Y8#o!H_on>Y!6F*!s`_t(0B(ECi8Tg?{=lumWUMos0YU49M+|b0%J#t+}lXCnp z6v^?Eb1!3U%zPc%SO+}Sl%=+xjw~BJN6D&#&K{Q*J?2iq=W=bMj?EGwvm~To!0+~) zG;7fB^BTfhi@9vqSp1W%LCXV+a81muSnvCN5B8o~QlJ!Ltd92VU^y@ik;CsTN1)Q%fIH?GPa_Cjb z6RbFt5G${=tno7;Jeb8wRHu|IWOAr~t@5`m^w6C;IXxa&Bw-w-cvUK5BXsC3HGx2; zAI6!a$5*@5>a_K+H^>DKT6Hj{s;B%5H!uR!_ZDG7O2IsOHiL*r6BVZ zSSZ5gLWK=Jk7%}l6|)%vIbG&)X@dGxtL0;#4@?M=O&_HgE=Q z^R0lruvrU_V}H-o>WqAN9H}cTM{Oj6cPRGrYty-s?a9fq%?3yR0VT@0s#x9jTuE&w z5aE(+Z#nDf!^Nz#f$-azb2%%sOl3?huakvo+iyv$M{$*3XXB`2nY6JHb9i4?^cxiS zzohV9nMfI;ar4|=Yzv%EWdD3cQ;b z%t7T`8kJgARH-cGDTvCjnWx+$38GDuqTnlrL5X)mmK$=B;UcRl3pe^fuJ&3#^vmiZ zd=Xb%<*0lQu>Jc7N4ZE6rMEg;=}XBPeW|LW7(G?{hbrz4_vAcZz~me7lxB&Sc*23a ZQXf8XD-12`YwPPqKdSPm;gtr){1f5(EolG% literal 0 HcmV?d00001 diff --git a/main/app/terminal/hymn/script.js b/main/app/terminal/hymn/script.js index 74d7486eb1..7354a2b59f 100644 --- a/main/app/terminal/hymn/script.js +++ b/main/app/terminal/hymn/script.js @@ -81,9 +81,9 @@ $(function() { if(urb.term.pax != "/") pax += urb.term.pax urb.subscribe({path: pax}, function(e, dat){ if(dat.data.ok) return; - hist = dat.data.history + hist = dat.data.history.concat(hist) hind = 0 - cont.innerHTML = '' + // cont.innerHTML = '' for(var i in dat.data.lines){ var lom = dat.data.lines[i] if(typeof lom == 'string') diff --git a/main/bin/solid.hoon b/main/bin/solid.hoon index 4f32d28a51..3e6bb86144 100644 --- a/main/bin/solid.hoon +++ b/main/bin/solid.hoon @@ -22,7 +22,6 @@ :~ [%$ %zuse] [%f %ford] [%a %ames] - [%b %batz] [%c %clay] [%d %dill] [%e %eyre] From d3745596a1ccb643ec3a4c21ef6c8c9099cb405a Mon Sep 17 00:00:00 2001 From: Ubuntu Date: Wed, 22 Oct 2014 17:19:18 +0000 Subject: [PATCH 02/31] start shell on startup --- main/app/terminal/core.hook | 45 +++++++++++++------------- main/app/terminal/hymn/.script.js.swp | Bin 12288 -> 0 bytes 2 files changed, 22 insertions(+), 23 deletions(-) delete mode 100644 main/app/terminal/hymn/.script.js.swp diff --git a/main/app/terminal/core.hook b/main/app/terminal/core.hook index 130240cc2e..3b5e37c9c1 100644 --- a/main/app/terminal/core.hook +++ b/main/app/terminal/core.hook @@ -69,6 +69,21 @@ :::: program :: |_ [hid=hide axle] +++ get-shell + |= [ost=bone you=ship pax=path] + ^- [mof=(list move) tel=term-line hit=(map path term-line)] + =+ tel=(fall (~(get by hiz) pax) *term-line) + =+ aut=%shell + =+ auc=(encode aut pax) + ?: (~(has by cub.hid) auc) + [~ tel hiz] + =. tel tel(r :_(r.tel leaf/"+ {(trip aut)}")) + :_ [tel (~(put by hiz) pax tel)] + :_ [ost %pass [%hi auc mar/[pax]] %g %sire [aut auc]]~ + :^ ost %pass [%hi auc in/[pax]] + :+ %g %show + [[our.hid [auc imp.hid]] you /out] +:: ++ page |= pax=path %. stat @@ -83,30 +98,14 @@ ^- [(list move) _+>] ?~ pax $(pax /term) + =+ ^- [mof=(list move) tel=term-line hit=(map path term-line)] + (get-shell ost you t.pax) + =. hiz hit + :_ +>.$ :_ mof ?+ -.pax !! - %lines - :_ +>.$ - :_ ~ - (jell-json ost (fall (~(get by hiz) t.pax) *term-line)) - %term - =+ tel=(fall (~(get by hiz) t.pax) *term-line) - =^ mof r.tel - =+ aut=%shell - =+ auc=(encode aut t.pax) - ?: (~(has by cub.hid) auc) - [~ r.tel] - :_ :_(r.tel leaf/"+ {(trip aut)}") - :_ [ost %pass [%hi auc mar/[t.pax]] %g %sire [aut auc]]~ - :^ ost %pass [%hi auc in/[t.pax]] - :+ %g %show - [[our.hid [auc imp.hid]] you /out] - =. hiz (~(put by hiz) t.pax tel) - :_ +>.$ - [[ost %give %rust %hymn (page t.pax)] mof] - %tines - :_ +>.$ - :_ ~ - (jell-term ost (fall (~(get by hiz) t.pax) *term-line)) + %lines (jell-json ost tel) + %term [ost %give %rust %hymn (page t.pax)] + %tines (jell-term ost tel) == :: ++ poke-term-in diff --git a/main/app/terminal/hymn/.script.js.swp b/main/app/terminal/hymn/.script.js.swp deleted file mode 100644 index 01185b75d3bf22524dbadc1e3389846302ede712..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 12288 zcmeI2&u`pB6vy4F{0bB(Z~y^fnugj|cI{1*s%1+G2vo|Ch)T5OkcMd1JDYXaYg_hs zlQe|hC?fjC6(^EsOfgOAG$n_T`7{TAM(I$uXaN>^%6gp&e?QJbGkw+pcUAz z0-0=85AQan4@}jl%f9iw?Ed>sZMU~>rxnl&Xa%$aS^=$qRzNGD70?R&4-}B`4&yxL zv9p*Bzy%P4Q{Wh=f-&&pU50TLtbuc&0bT?L0Rwx$?{~r`xC|D-3GfW4 zfJebD@XMHCd=9RHkH9JLG^m4vU;zxm4*$U= za1p!<7C{X>0B+o77(an;z$f55cpXfE32+12e*r!O?}4|$X<&hUfY!zV`qBz$1+)VH zvI6V&5reUH8wJY2XBH=->qxO8pN&E(Ldj-XlS>D1Cr+YnEZHP8k1~^bvSmMPM#~O< z#}x&^$;hfznvs`v(a&i_&DEmfxbTfB1i>WyP1`y-y615dg-?; zxf+Y8#o!H_on>Y!6F*!s`_t(0B(ECi8Tg?{=lumWUMos0YU49M+|b0%J#t+}lXCnp z6v^?Eb1!3U%zPc%SO+}Sl%=+xjw~BJN6D&#&K{Q*J?2iq=W=bMj?EGwvm~To!0+~) zG;7fB^BTfhi@9vqSp1W%LCXV+a81muSnvCN5B8o~QlJ!Ltd92VU^y@ik;CsTN1)Q%fIH?GPa_Cjb z6RbFt5G${=tno7;Jeb8wRHu|IWOAr~t@5`m^w6C;IXxa&Bw-w-cvUK5BXsC3HGx2; zAI6!a$5*@5>a_K+H^>DKT6Hj{s;B%5H!uR!_ZDG7O2IsOHiL*r6BVZ zSSZ5gLWK=Jk7%}l6|)%vIbG&)X@dGxtL0;#4@?M=O&_HgE=Q z^R0lruvrU_V}H-o>WqAN9H}cTM{Oj6cPRGrYty-s?a9fq%?3yR0VT@0s#x9jTuE&w z5aE(+Z#nDf!^Nz#f$-azb2%%sOl3?huakvo+iyv$M{$*3XXB`2nY6JHb9i4?^cxiS zzohV9nMfI;ar4|=Yzv%EWdD3cQ;b z%t7T`8kJgARH-cGDTvCjnWx+$38GDuqTnlrL5X)mmK$=B;UcRl3pe^fuJ&3#^vmiZ zd=Xb%<*0lQu>Jc7N4ZE6rMEg;=}XBPeW|LW7(G?{hbrz4_vAcZz~me7lxB&Sc*23a ZQXf8XD-12`YwPPqKdSPm;gtr){1f5(EolG% From 6326d25140b944d31ba54293d23575ec6da32c9b Mon Sep 17 00:00:00 2001 From: Ubuntu Date: Wed, 22 Oct 2014 19:13:07 +0000 Subject: [PATCH 03/31] cleaned up terminal code --- arvo/dill.hoon | 3 +- main/app/terminal/core.hook | 144 ++++++++++++++++++++---------------- 2 files changed, 83 insertions(+), 64 deletions(-) diff --git a/arvo/dill.hoon b/arvo/dill.hoon index c15bc9a3ac..8b652bef9e 100644 --- a/arvo/dill.hoon +++ b/arvo/dill.hoon @@ -30,7 +30,8 @@ $% [%crud p=@tas q=(list tank)] :: [%text p=tape] :: == :: -++ mess $% [%term-ctrl p=(hypo ,%hail)] :: +++ mess :: message to terminal + $% [%term-ctrl p=(hypo ,%hail)] :: [%term-in p=(hypo term-in)] :: == :: ++ move ,[p=duct q=(mold note gift)] :: local move diff --git a/main/app/terminal/core.hook b/main/app/terminal/core.hook index 3b5e37c9c1..1de5ab0278 100644 --- a/main/app/terminal/core.hook +++ b/main/app/terminal/core.hook @@ -27,13 +27,17 @@ [%vega p=path] :: == :: ++ hapt ,[p=ship q=path] :: +++ mess :: + $% [%txt p=(hypo cord)] :: + [%kyev p=(hypo kyev)] :: + == :: ++ move ,[p=bone q=(mold note gift)] :: ++ note :: $% $: %g :: $% [%cide p=span] :: [%show p=hapt q=ship r=path] :: [%sire p=term q=span] :: - [%mess p=hapt q=ship r=[?(%txt %kyev) vase]] :: + [%mess p=hapt q=ship r=mess] :: == == == :: ++ sign :: $% $: %g :: @@ -51,6 +55,7 @@ :::: helpers :: |% +++ aut %shell ++ encode |= [a=term b=path] ^- span (rap 3 a (turn b |=(c=span (cat 3 '_' c)))) @@ -73,17 +78,28 @@ |= [ost=bone you=ship pax=path] ^- [mof=(list move) tel=term-line hit=(map path term-line)] =+ tel=(fall (~(get by hiz) pax) *term-line) - =+ aut=%shell =+ auc=(encode aut pax) ?: (~(has by cub.hid) auc) [~ tel hiz] =. tel tel(r :_(r.tel leaf/"+ {(trip aut)}")) :_ [tel (~(put by hiz) pax tel)] - :_ [ost %pass [%hi auc mar/[pax]] %g %sire [aut auc]]~ - :^ ost %pass [%hi auc in/[pax]] + (start-shell ost you pax) +:: +++ start-shell + |= [ost=bone you=ship pax=path] + ^- (list move) + =+ auc=(encode aut pax) + :_ [ost %pass [%legacy pax] %g %sire [aut auc]]~ + :^ ost %pass [%output pax] :+ %g %show [[our.hid [auc imp.hid]] you /out] :: +++ end-shell + |= [ost=bone pax=path] + ^- move + =+ auc=(encode aut pax) + [ost %pass [%legacy pax] %g %cide auc] +:: ++ page |= pax=path %. stat @@ -98,51 +114,51 @@ ^- [(list move) _+>] ?~ pax $(pax /term) - =+ ^- [mof=(list move) tel=term-line hit=(map path term-line)] - (get-shell ost you t.pax) + =+ (get-shell ost you t.pax) =. hiz hit :_ +>.$ :_ mof ?+ -.pax !! - %lines (jell-json ost tel) - %term [ost %give %rust %hymn (page t.pax)] - %tines (jell-term ost tel) + %lines (jell-json ost tel) :: json output + %term [ost %give %rust %hymn (page t.pax)] :: hymn front end + %tines (jell-term ost tel) :: term-line output == :: ++ poke-term-in |= [ost=bone you=ship term-in] ^- [(list move) _+>] - ::~& tem-poke/jon - |- =+ tel=(fall (~(get by hiz) pax) *term-line) ?- -.jof - %res - =+ joc=(encode p.jof pax) + %res :: restart shell + =+ joc=(encode aut pax) =^ mof r.tel ?. (~(has by cub.hid) joc) [~ r.tel] - :_ :_(r.tel leaf/"- {(trip p.jof)}") - [ost %pass [%hi joc mar/pax] %g %cide joc]~ - ::~& poke-sire/[jof cub.hid] + :- [(end-shell ost pax) ~] + [leaf/"- {(trip aut)}" r.tel] =. r.tel :_(r.tel leaf/"+ {(trip joc)}") =. hiz (~(put by hiz) pax tel) - :_ +>.^$ - %+ welp mof - :^ [ost %give %nice ~] - :^ ost %pass [%hi joc in/[pax]] - :^ %g %show [our.hid joc imp.hid] - :- you /out - [ost %pass [%hi joc mar/pax] %g %sire [p.jof joc]] - (spam pax tel) + :_ +>.$ + ;: welp + mof + [ost %give %nice ~]~ + (start-shell ost you pax) + (spam pax tel) + == :: - %line - =. r.tel :_(r.tel rose/["> " ~ ~]^~[leaf/(trip p.tel) leaf/(trip p.jof)]) + %line :: command entered + =. r.tel + :_ r.tel + rose/["> " ~ ~]^~[leaf/(trip p.tel) leaf/(trip p.jof)] =. hiz (~(put by hiz) pax tel) ?: =('\\' (end 3 1 p.jof)) $(jof [%cmd (rsh 3 1 p.jof)]) - :_ +>.^$ - (send ost you pax %txt !>(p.jof)) - %cmd - ?+ p.jof :_(+>.^$ (send ost you pax %kyev !>(`kyev`[[%ctrl ~ ~] p.jof]))) + :_ +>.$ + (send ost you pax %txt -:!>(*cord) p.jof) + %cmd :: key command + ?+ p.jof + :_ +>.$ + %^ send ost you + [pax %kyev -:!>(*kyev) [[%ctrl ~ ~] p.jof]] %r $(jof [%res 'shell']) == == @@ -150,9 +166,8 @@ ++ poke-json |= [ost=bone you=ship jon=json] ^- [(list move) _+>] - ::=+ ^- [pax=path jof=$%([%line p=span] [%res p=span] [%cmd p=char])] %^ poke-term-in ost you - ^- [pax=path jof=$%([%line p=span] [%res p=span] [%cmd p=char])] + ^- term-in %- need %. jon => jo %^ ot @@ -163,16 +178,17 @@ ++ poke-term-ctrl |= [ost=bone you=ship col=term-ctrl] ^- [(list move) _+>] - :_ +>.$ :_ ~ - [ost %give %rush %term-line [p q ~]:(fall (~(get by hiz) /) *term-line)] + =+ (get-shell ost you /) + :_ +>.$(hiz hit) :_ mof + [ost %give %rush %term-line [p q ~]:tel] :: ++ send - |= [ost=bone you=ship pax=path mez=[?(%txt %kyev) vase]] + |= [ost=bone you=ship pax=path mez=mess] %+ murn (~(tap by cub.hid)) |= [p=span q=term] ?. =(pax q:(decode p)) ~ %- some ^- move - :^ ost %pass [-.mez p (scot %da lat.hid) pax] + :^ ost %pass [-.mez (scot %da lat.hid) pax] [%g %mess [our.hid p imp.hid] you mez] :: ++ jell-json @@ -185,7 +201,6 @@ :: ++ spam |= [pax=path tel=term-line] - ::~& tem-spam/(~(run by hiz) |=(term-line p)) %+ murn (~(tap by sup.hid)) |= [ost=bone @ paf=path] @@ -201,35 +216,38 @@ =+ sih=((hard sign) sih) ?: ?=(?(%sage %veer %vega) &2.sih) :: vomit [[ost %give +.sih]~ +>.$] - ?: ?=(%gone &2.sih) - `+>.$ - =* paf |3.pax - ?: ?=([%hi @ %in *] pax) - ?+ &2.sih !! + ?~ pax !! + ?+ -.pax !! + %legacy ?>(?=(%gone +<.sih) `+>.$) :: XX maybe mean? + %output + ?+ +<.sih !! %nice `+>.$ ?(%rust %rush) - =+ tol=(fall (~(get by hiz) paf) *term-line) - =. tol ?^ q.q.sih :: XX prompt hack - [p.tol (weld q.q.sih q.tol) (weld r.q.sih r.tol)] - [p.q.sih (weld q.q.sih q.tol) (weld r.q.sih r.tol)] - =. hiz (~(put by hiz) paf tol) - [(spam paf q.sih) +>.$] + =+ tol=(fall (~(get by hiz) t.pax) *term-line) + =. tol + ?^ q.q.sih :: XX prompt hack + [p.tol (weld q.q.sih q.tol) (weld r.q.sih r.tol)] + [p.q.sih (weld q.q.sih q.tol) (weld r.q.sih r.tol)] + =. hiz (~(put by hiz) t.pax tol) + [(spam t.pax q.sih) +>.$] == - =+ tel=(fall (~(get by hiz) paf) *term-line) - =+ old=tel - =. r.tel - ?. ?=(%mean &2.sih) r.tel - %- welp :_ r.tel - =- (turn - |=(a=tank rose/[~ "! " ~]^[a]~)) - ^- (list tank) - ?~ p.sih ~ - (welp q.u.p.sih leaf/(trip p.u.p.sih) ~) - =. hiz (~(put by hiz) paf tel) - :_ +>.$ - :- [ost %give +.sih] - ?: =(old tel) ~ - ~& [%term-wuh-spamming r.tel] - (spam paf tel) + :: + ?(%txt %kyev) + ?+ +<.sih !! + %nice `+>.$ + %mean + ?< ?=(~ t.pax) + =+ tel=(fall (~(get by hiz) t.t.pax) *term-line) + =. r.tel + %- welp :_ r.tel + =- (turn - |=(a=tank rose/[~ "! " ~]^[a]~)) + ^- (list tank) + ?~ p.sih ~ + (welp q.u.p.sih leaf/(trip p.u.p.sih) ~) + =. hiz (~(put by hiz) t.t.pax tel) + [[[ost %give +.sih] (spam t.t.pax tel)] +>.$] + == + == :: ++ tel-to-jon |= tel=term-line From 56c1c938d322f880a2817ef1cf04b26eabfec611 Mon Sep 17 00:00:00 2001 From: Ubuntu Date: Wed, 22 Oct 2014 21:28:07 +0000 Subject: [PATCH 04/31] requisite structures --- main/sur/bang-args/gate.hook | 1 + main/sur/term-ctrl/gate.hook | 1 + main/sur/term-in/gate.hook | 1 + 3 files changed, 3 insertions(+) create mode 100644 main/sur/bang-args/gate.hook create mode 100644 main/sur/term-ctrl/gate.hook create mode 100644 main/sur/term-in/gate.hook diff --git a/main/sur/bang-args/gate.hook b/main/sur/bang-args/gate.hook new file mode 100644 index 0000000000..58320dab63 --- /dev/null +++ b/main/sur/bang-args/gate.hook @@ -0,0 +1 @@ +,[mov=(mold) ~] diff --git a/main/sur/term-ctrl/gate.hook b/main/sur/term-ctrl/gate.hook new file mode 100644 index 0000000000..31b413aa2b --- /dev/null +++ b/main/sur/term-ctrl/gate.hook @@ -0,0 +1 @@ +,%hail diff --git a/main/sur/term-in/gate.hook b/main/sur/term-in/gate.hook new file mode 100644 index 0000000000..32b45d781a --- /dev/null +++ b/main/sur/term-in/gate.hook @@ -0,0 +1 @@ +,[pax=path jof=$%([%line p=span] [%res p=span] [%cmd p=char])] From 33fcc0951971943c50618f5c3c96abdc34b2cb93 Mon Sep 17 00:00:00 2001 From: Anton Dyudin Date: Wed, 22 Oct 2014 14:49:47 -0700 Subject: [PATCH 05/31] Path refactoring --- arvo/dill.hoon | 2 +- main/app/terminal/core.hook | 18 +++++++++--------- main/app/terminal/hymn/script.js | 2 +- 3 files changed, 11 insertions(+), 11 deletions(-) diff --git a/arvo/dill.hoon b/arvo/dill.hoon index 8b652bef9e..7e3df16c2a 100644 --- a/arvo/dill.hoon +++ b/arvo/dill.hoon @@ -404,7 +404,7 @@ %= +>.$ mos :_ mos - [hen %pass / %g %show [~zod /terminal] ~zod /tines] :: XX ~zod %init + [hen %pass / %g %show [~zod /terminal] ~zod /lines] :: XX ~zod %init == == :: diff --git a/main/app/terminal/core.hook b/main/app/terminal/core.hook index 1de5ab0278..bfa33529cd 100644 --- a/main/app/terminal/core.hook +++ b/main/app/terminal/core.hook @@ -89,8 +89,8 @@ |= [ost=bone you=ship pax=path] ^- (list move) =+ auc=(encode aut pax) - :_ [ost %pass [%legacy pax] %g %sire [aut auc]]~ - :^ ost %pass [%output pax] + :_ [ost %pass [%fork pax] %g %sire [aut auc]]~ + :^ ost %pass [%resp pax] :+ %g %show [[our.hid [auc imp.hid]] you /out] :: @@ -98,7 +98,7 @@ |= [ost=bone pax=path] ^- move =+ auc=(encode aut pax) - [ost %pass [%legacy pax] %g %cide auc] + [ost %pass [%fork pax] %g %cide auc] :: ++ page |= pax=path @@ -118,9 +118,9 @@ =. hiz hit :_ +>.$ :_ mof ?+ -.pax !! - %lines (jell-json ost tel) :: json output + %lines-jon (jell-json ost tel) :: json output %term [ost %give %rust %hymn (page t.pax)] :: hymn front end - %tines (jell-term ost tel) :: term-line output + %lines (jell-term ost tel) :: term-line output == :: ++ poke-term-in @@ -204,9 +204,9 @@ %+ murn (~(tap by sup.hid)) |= [ost=bone @ paf=path] - ?: =([%lines pax] paf) + ?: =([%lines-jon pax] paf) (some (jell-json ost tel)) - ?: =([%tines pax] paf) + ?: =([%lines pax] paf) (some (jell-term ost tel)) ~ :: @@ -218,8 +218,8 @@ [[ost %give +.sih]~ +>.$] ?~ pax !! ?+ -.pax !! - %legacy ?>(?=(%gone +<.sih) `+>.$) :: XX maybe mean? - %output + %fork ?>(?=(%gone +<.sih) `+>.$) :: XX maybe mean? + %resp ?+ +<.sih !! %nice `+>.$ ?(%rust %rush) diff --git a/main/app/terminal/hymn/script.js b/main/app/terminal/hymn/script.js index 7354a2b59f..7f5eb152af 100644 --- a/main/app/terminal/hymn/script.js +++ b/main/app/terminal/hymn/script.js @@ -77,7 +77,7 @@ $(function() { return {top:_top,bot:_bot} } - pax = '/lines' + pax = '/lines-jon' if(urb.term.pax != "/") pax += urb.term.pax urb.subscribe({path: pax}, function(e, dat){ if(dat.data.ok) return; From 3aa2348eab3bfa8e85282188bf5b9a0175e829d7 Mon Sep 17 00:00:00 2001 From: Ubuntu Date: Wed, 22 Oct 2014 23:20:34 +0000 Subject: [PATCH 06/31] put gars in the correct places --- main/app/terminal/core.hook | 10 ++++------ main/app/terminal/hymn/script.js | 4 ++-- 2 files changed, 6 insertions(+), 8 deletions(-) diff --git a/main/app/terminal/core.hook b/main/app/terminal/core.hook index 1de5ab0278..d43333c440 100644 --- a/main/app/terminal/core.hook +++ b/main/app/terminal/core.hook @@ -148,7 +148,7 @@ %line :: command entered =. r.tel :_ r.tel - rose/["> " ~ ~]^~[leaf/(trip p.tel) leaf/(trip p.jof)] + rose/[~ ~ ~]^~[leaf/(trip p.tel) leaf/(trip p.jof)] =. hiz (~(put by hiz) pax tel) ?: =('\\' (end 3 1 p.jof)) $(jof [%cmd (rsh 3 1 p.jof)]) @@ -224,17 +224,15 @@ %nice `+>.$ ?(%rust %rush) =+ tol=(fall (~(get by hiz) t.pax) *term-line) - =. tol - ?^ q.q.sih :: XX prompt hack - [p.tol (weld q.q.sih q.tol) (weld r.q.sih r.tol)] - [p.q.sih (weld q.q.sih q.tol) (weld r.q.sih r.tol)] + =. p.q.sih ?^(q.q.sih p.tol (cat 3 p.q.sih '> ')) :: XX prompt hack + =. tol [p.q.sih (weld q.q.sih q.tol) (weld r.q.sih r.tol)] =. hiz (~(put by hiz) t.pax tol) [(spam t.pax q.sih) +>.$] == :: ?(%txt %kyev) ?+ +<.sih !! - %nice `+>.$ + %nice [[ost %give +.sih]~ +>.$] %mean ?< ?=(~ t.pax) =+ tel=(fall (~(get by hiz) t.t.pax) *term-line) diff --git a/main/app/terminal/hymn/script.js b/main/app/terminal/hymn/script.js index 7354a2b59f..379bfa5b23 100644 --- a/main/app/terminal/hymn/script.js +++ b/main/app/terminal/hymn/script.js @@ -89,12 +89,12 @@ $(function() { if(typeof lom == 'string') $(cont).append($('
').text(lom)) else { - $(cont).append($('').text(lom.prompt + '> '), + $(cont).append($('').text(lom.prompt), $('').text(lom.task), $('
')) } } window.scrollTo(0,document.body.scrollHeight) - prem.textContent = dat.data.prompt + '> ' + prem.textContent = dat.data.prompt }) }); From 65b33a2cd2f91f7b3ed6af9745dee0474d0c9a5f Mon Sep 17 00:00:00 2001 From: Ubuntu Date: Thu, 23 Oct 2014 03:02:18 +0000 Subject: [PATCH 07/31] deactivated lines-json --- main/app/terminal/hymn/script.js | 2 +- main/mar/term-line/door.hook | 16 ++++++++++++++++ 2 files changed, 17 insertions(+), 1 deletion(-) diff --git a/main/app/terminal/hymn/script.js b/main/app/terminal/hymn/script.js index ea0c0da85a..379bfa5b23 100644 --- a/main/app/terminal/hymn/script.js +++ b/main/app/terminal/hymn/script.js @@ -77,7 +77,7 @@ $(function() { return {top:_top,bot:_bot} } - pax = '/lines-jon' + pax = '/lines' if(urb.term.pax != "/") pax += urb.term.pax urb.subscribe({path: pax}, function(e, dat){ if(dat.data.ok) return; diff --git a/main/mar/term-line/door.hook b/main/mar/term-line/door.hook index 4547e1a6b0..67e23d6154 100644 --- a/main/mar/term-line/door.hook +++ b/main/mar/term-line/door.hook @@ -9,4 +9,20 @@ |% ++ noun term-line :: clam from %noun -- +:: +++ grow + |% + ++ json + ~& %helps + %- jobe + :~ [%prompt %s p.tel] + [%history %a (turn q.tel |=(a=cord [%s a]))] + :+ %lines %a + %- zing ^- (list (list ^json)) + %+ turn (flop r.tel) |= a=tank + ?. ?=([%rose [[%'>' %' ' ~] ~ ~] [%leaf *] [%leaf *] ~] a) + (turn (wash 0^80 a) jape) + [(jobe prompt/(jape p.i.q.a) task/(jape p.i.t.q.a) ~)]~ + == + -- -- From 89a7bc473a32e931dacce6f6f3e5c87ad830d2d1 Mon Sep 17 00:00:00 2001 From: Ubuntu Date: Thu, 23 Oct 2014 03:35:13 +0000 Subject: [PATCH 08/31] removed lines-jon --- main/app/terminal/core.hook | 27 +++------------------------ main/mar/term-line/door.hook | 1 - 2 files changed, 3 insertions(+), 25 deletions(-) diff --git a/main/app/terminal/core.hook b/main/app/terminal/core.hook index 9347c6a397..b99ef739d3 100644 --- a/main/app/terminal/core.hook +++ b/main/app/terminal/core.hook @@ -15,7 +15,6 @@ ++ gilt :: $% [%term-line p=term-line] :: [%hymn p=manx] :: - [%json p=json] :: == :: ++ gift :: $% [%rush gilt] :: @@ -118,9 +117,8 @@ =. hiz hit :_ +>.$ :_ mof ?+ -.pax !! - %lines-jon (jell-json ost tel) :: json output %term [ost %give %rust %hymn (page t.pax)] :: hymn front end - %lines (jell-term ost tel) :: term-line output + %lines (jell ost tel) :: term-line output == :: ++ poke-term-in @@ -191,11 +189,7 @@ :^ ost %pass [-.mez (scot %da lat.hid) pax] [%g %mess [our.hid p imp.hid] you mez] :: -++ jell-json - |= [a=bone b=term-line] - [a %give %rush %json (tel-to-jon b)] -:: -++ jell-term +++ jell |= [a=bone b=term-line] [a %give %rush %term-line b] :: @@ -204,10 +198,8 @@ %+ murn (~(tap by sup.hid)) |= [ost=bone @ paf=path] - ?: =([%lines-jon pax] paf) - (some (jell-json ost tel)) ?: =([%lines pax] paf) - (some (jell-term ost tel)) + (some (jell ost tel)) ~ :: ++ pour @@ -246,17 +238,4 @@ [[[ost %give +.sih] (spam t.t.pax tel)] +>.$] == == -:: -++ tel-to-jon - |= tel=term-line - %- jobe - :~ [%prompt %s p.tel] - [%history %a (turn q.tel |=(a=cord [%s a]))] - :+ %lines %a - %- zing ^- (list (list json)) - %+ turn (flop r.tel) |= a=tank - ?. ?=([%rose [[%'>' %' ' ~] ~ ~] [%leaf *] [%leaf *] ~] a) - (turn (wash 0^80 a) jape) - [(jobe prompt/(jape p.i.q.a) task/(jape p.i.t.q.a) ~)]~ - == -- diff --git a/main/mar/term-line/door.hook b/main/mar/term-line/door.hook index 67e23d6154..e03c07d9cd 100644 --- a/main/mar/term-line/door.hook +++ b/main/mar/term-line/door.hook @@ -13,7 +13,6 @@ ++ grow |% ++ json - ~& %helps %- jobe :~ [%prompt %s p.tel] [%history %a (turn q.tel |=(a=cord [%s a]))] From 9dc3e1be70ba3f8cc3596bb650dec6b7af456485 Mon Sep 17 00:00:00 2001 From: Anton Dyudin Date: Thu, 23 Oct 2014 12:59:15 -0700 Subject: [PATCH 09/31] Comment ++runt --- arvo/hoon.hoon | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/arvo/hoon.hoon b/arvo/hoon.hoon index bb1dc4b08d..2146774c4c 100644 --- a/arvo/hoon.hoon +++ b/arvo/hoon.hoon @@ -2886,10 +2886,10 @@ ?: =('\\' i.vib) ['\\' '\\' $(vib t.vib)] ?: ?|((gth i.vib 126) (lth i.vib 32) =(39 i.vib)) - ['\\' (weld ~(rux at i.vib) (runt [1 47] $(vib t.vib)))] + ['\\' (welp ~(rux at i.vib) '/' $(vib t.vib))] [i.vib $(vib t.vib)] :: -++ runt :: append to tape +++ runt :: prepend repeatedly |= [[a=@ b=@] c=tape] ^- tape ?: =(0 a) From 408b948ca24bc265f55b9e3ed999c051b4b5e7db Mon Sep 17 00:00:00 2001 From: Anton Dyudin Date: Thu, 23 Oct 2014 13:22:01 -0700 Subject: [PATCH 10/31] Shell terminal whitespace --- main/app/shell/core.hook | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/main/app/shell/core.hook b/main/app/shell/core.hook index abf9083ac9..e1820ba59c 100644 --- a/main/app/shell/core.hook +++ b/main/app/shell/core.hook @@ -88,7 +88,7 @@ ^- $+(nail (like coma)) =+ paf=pax =. pax ?.(&(?=([@ @ @ *] pax) =('0' &3.pax)) pax pax(&3 (scot da/lat))) - %+ ifix [(star ace) (star ace)] + %+ ifix [(star ace) gaw] ;~ pose (stag %run ;~(plug (star ;~(sfix (task(tol %0) bar) ace)) (task col))) (stag %end ;~(pfix sem ;~(pose (stag %& dem) (stag %| sym)))) From f7e2d0674a689b7b4d25a5c688940df396b19111 Mon Sep 17 00:00:00 2001 From: Ubuntu Date: Thu, 23 Oct 2014 21:00:23 +0000 Subject: [PATCH 11/31] removed poke-json from terminal --- main/app/terminal/core.hook | 12 ------------ main/app/terminal/hymn/script.js | 2 +- main/lib/urb.js | 1 + 3 files changed, 2 insertions(+), 13 deletions(-) diff --git a/main/app/terminal/core.hook b/main/app/terminal/core.hook index b99ef739d3..d0d53538aa 100644 --- a/main/app/terminal/core.hook +++ b/main/app/terminal/core.hook @@ -161,18 +161,6 @@ == == :: -++ poke-json - |= [ost=bone you=ship jon=json] - ^- [(list move) _+>] - %^ poke-term-in ost you - ^- term-in - %- need - %. jon => jo - %^ ot - pax/(su ;~(pfix fas (more fas sym))) - act/(of line/so res/so cmd/so ~) - ~ -:: ++ poke-term-ctrl |= [ost=bone you=ship col=term-ctrl] ^- [(list move) _+>] diff --git a/main/app/terminal/hymn/script.js b/main/app/terminal/hymn/script.js index 379bfa5b23..c3598938b7 100644 --- a/main/app/terminal/hymn/script.js +++ b/main/app/terminal/hymn/script.js @@ -1,7 +1,7 @@ function jpok(a,b){ var dat = {pax:urb.term.pax, act:{}} dat.act[a] = b - urb.send({data:dat}, function(e,dat){ + urb.send({data:dat,mark:"term-in"}, function(e,dat){ if(a === 'line' && dat.data.err){ hist.unshift(prom.val()) prom.val(b) diff --git a/main/lib/urb.js b/main/lib/urb.js index 3f3679ea51..a35c28926b 100644 --- a/main/lib/urb.js +++ b/main/lib/urb.js @@ -16,6 +16,7 @@ window.urb.send = function(params,cb) { perm = this.perms[type] params.ship = params.ship ? params.ship : this.ship + params.mark = params.mark ? params.mark : "json" method = "put" url = [perm,this.user,this.port,this.seqn_s] From 4ff6716381951b36650bd42a40a4d0feccf04f38 Mon Sep 17 00:00:00 2001 From: Anton Dyudin Date: Thu, 23 Oct 2014 14:08:11 -0700 Subject: [PATCH 12/31] wick/woad comment --- arvo/hoon.hoon | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/arvo/hoon.hoon b/arvo/hoon.hoon index 2146774c4c..a074b28e6f 100644 --- a/arvo/hoon.hoon +++ b/arvo/hoon.hoon @@ -3045,7 +3045,7 @@ [?:(=('~' i.t.b) '~' ?>(=('-' i.t.b) '_')) $(b t.t.b)] [i.b $(b t.b)] :: -++ woad :: span format +++ woad :: cord format |= a=@ta ^- @t %+ rap 3 @@ -3078,7 +3078,7 @@ %'~' ['~' $(a c)] == :: -++ wood :: span format +++ wood :: cord format |= a=@t ^- @ta %+ rap 3 From 6940b69815ff183290927bfe0e7feea8dea0e939 Mon Sep 17 00:00:00 2001 From: Ubuntu Date: Thu, 23 Oct 2014 22:35:03 +0000 Subject: [PATCH 13/31] forgot term-in --- main/mar/term-in/door.hook | 21 +++++++++++++++++++++ 1 file changed, 21 insertions(+) create mode 100644 main/mar/term-in/door.hook diff --git a/main/mar/term-in/door.hook b/main/mar/term-in/door.hook new file mode 100644 index 0000000000..765db215ba --- /dev/null +++ b/main/mar/term-in/door.hook @@ -0,0 +1,21 @@ +:: +:::: /hook/door/term-in/mar + :: +/? 314 +/- term-in +!: +|_ term-in +:: +++ grab :: convert from + |% + ++ json + |= jon=^json + %- need + %. jon => jo + %^ ot + pax/(su ;~(pfix fas (more fas sym))) + act/(of line/so res/so cmd/so ~) + ~ + ++ noun term-in :: clam from %noun + -- +-- From 35e5688b70d8ea5a9854c06c4b9f10d3c002595c Mon Sep 17 00:00:00 2001 From: Ubuntu Date: Thu, 23 Oct 2014 22:56:06 +0000 Subject: [PATCH 14/31] added kill and :verb --- arvo/dill.hoon | 9 +++++---- arvo/gall.hoon | 3 +++ main/app/shell/core.hook | 4 ++++ main/app/solid/core.hook | 4 +++- main/app/terminal/core.hook | 4 +++- main/app/verb/core.hook | 13 +++++++++++++ main/mar/verb-args/door.hook | 15 +++++++++++++++ main/sur/verb-args/gate.hook | 1 + 8 files changed, 47 insertions(+), 6 deletions(-) create mode 100644 main/app/verb/core.hook create mode 100644 main/mar/verb-args/door.hook create mode 100644 main/sur/verb-args/gate.hook diff --git a/arvo/dill.hoon b/arvo/dill.hoon index 7e3df16c2a..86d678e999 100644 --- a/arvo/dill.hoon +++ b/arvo/dill.hoon @@ -7,10 +7,10 @@ $% [%bbye ~] :: reset prompt [%blit p=(list blit)] :: terminal output [%init p=@p] :: report install - [%logo p=@] :: logout + [%logo ~] :: logout [%veer p=@ta q=path r=@t] :: install vane [%vega p=path] :: reboot by path - [%verb ~] :: by %batz + [%verb ~] :: == :: ++ kiss :: in request ->$ $% [%belt p=belt] :: terminal input @@ -90,6 +90,7 @@ [%hymn q=manx] :: [%json q=json] :: == == :: + [%verb ~] :: [%sage p=path q=*] :: [%veer p=@ta q=path r=@t] :: [%vega p=path] :: @@ -398,7 +399,7 @@ ::S %warn (fume '~' [%leaf p.+.sih]) :: system message ::S ?(%init %logo %veer %vega %verb) :: drop-throughs ::S +>(mos :_(mos [hen %give +.sih])) - ?(%init %veer %vega) :: drop-through + ?(%init %veer %vega %verb) :: drop-throughs +>(mos :_(mos [hen %give +.sih])) %wake %= +>.$ @@ -483,7 +484,7 @@ =(0 bus.u.q.q.yar) == ~& %dill-kill-not-implemented - +>.$ + +>.$(mos :_(mos [hen %give %logo ~])) ::S +>.$(mos :_(mos [hen %pass ~ %b [%kill ~]])) :: XX send \c $(kyz [%belt %del ~]) %e (edit u.q.q.yar(bus bul.u.q.q.yar)) diff --git a/arvo/gall.hoon b/arvo/gall.hoon index c017da19ba..80da1d6d63 100644 --- a/arvo/gall.hoon +++ b/arvo/gall.hoon @@ -145,6 +145,7 @@ [%rush p=mark q=*] :: [%rust p=mark q=*] :: [%sage p=path q=*] :: + [%verb ~] :: [%veer p=@ta q=path r=@t] :: [%vega p=path] :: == == :: @@ -443,6 +444,7 @@ %rush !! %rust !! %sage !! + %verb !! %veer !! %vega !! == @@ -460,6 +462,7 @@ %rush [%pass [%r pax] (rod %d p.+.sih q.+.sih)] %rust [%pass [%r pax] (rod %f p.+.sih q.+.sih)] %sage !! + %verb !! %veer !! %vega !! == diff --git a/main/app/shell/core.hook b/main/app/shell/core.hook index e1820ba59c..f5f8953375 100644 --- a/main/app/shell/core.hook +++ b/main/app/shell/core.hook @@ -15,6 +15,7 @@ [%nice ~] :: [%meta p=vase] :: [%sage p=path q=*] :: + [%verb ~] :: [%veer p=@ta q=path r=@t] :: [%vega p=path] :: == :: @@ -55,6 +56,7 @@ [%rush p=mark q=*] :: [%rust p=mark q=*] :: [%sage p=path q=*] :: + [%verb ~] :: [%veer p=@ta q=path r=@t] :: [%vega p=path] :: == == == :: @@ -297,6 +299,8 @@ ::=+ sih=((hard sign) sih) ?: ?=(%sage +<.sih) :: vomit [[ost %give +.sih]~ +>.$] + ?: ?=(%verb +<.sih) :: vomit + [[ost %give +.sih]~ +>.$] ?: ?=(%veer +<.sih) :: vomit [[ost %give +.sih]~ +>.$] ?: ?=(%vega +<.sih) :: vomit diff --git a/main/app/solid/core.hook b/main/app/solid/core.hook index ed3be0d30d..380b136214 100644 --- a/main/app/solid/core.hook +++ b/main/app/solid/core.hook @@ -31,7 +31,9 @@ =+ gat=.*(all .*(all [0 42])) =+ nex=+:.*([-.gat [sam +>.gat]] -.gat) $(vay t.vay, all nex) - [ost %give %sage [%urbit %pill ~] [ken all]]~ + :~ [ost %give %sage [%urbit %pill ~] [ken all]] + [ost %give %nice ~] + == :: ~& %solid-jamming :: =+ pac=(jam [ken all]) :: ~& %solid-finished diff --git a/main/app/terminal/core.hook b/main/app/terminal/core.hook index d0d53538aa..7e990d332f 100644 --- a/main/app/terminal/core.hook +++ b/main/app/terminal/core.hook @@ -22,6 +22,7 @@ [%mean p=ares] :: [%nice ~] :: [%sage p=path q=*] :: + [%verb ~] :: [%veer p=@ta q=path r=@t] :: [%vega p=path] :: == :: @@ -46,6 +47,7 @@ [%rust p=%term-line q=term-line] :: [%rush p=%term-line q=term-line] :: [%sage p=path q=*] :: + [%verb ~] :: [%veer p=@ta q=path r=@t] :: [%vega p=path] :: == == == @@ -194,7 +196,7 @@ |= [ost=bone pax=path sih=*] ^- [(list move) _+>] =+ sih=((hard sign) sih) - ?: ?=(?(%sage %veer %vega) &2.sih) :: vomit + ?: ?=(?(%sage %verb %veer %vega) &2.sih) :: vomit [[ost %give +.sih]~ +>.$] ?~ pax !! ?+ -.pax !! diff --git a/main/app/verb/core.hook b/main/app/verb/core.hook new file mode 100644 index 0000000000..4a3151dd68 --- /dev/null +++ b/main/app/verb/core.hook @@ -0,0 +1,13 @@ +!: +|_ [hid=hide ~] +++ poke-verb-args + |= [ost=bone you=ship ~] + :_ +>.$ + :~ [ost %give %verb ~] + [ost %give %nice ~] + == +++ peer + |= + * + `+> +-- diff --git a/main/mar/verb-args/door.hook b/main/mar/verb-args/door.hook new file mode 100644 index 0000000000..9f5cf3972f --- /dev/null +++ b/main/mar/verb-args/door.hook @@ -0,0 +1,15 @@ +:: +:::: /hoon/core/zing/pro + :: +/? 314 +/- verb-args +|_ arg=verb-args +:: +++ grab :: convert from + |% + ++ noun :: convert from %noun + |= src=* + ^+ +>+ + +>+(arg (verb-args src)) + -- +-- diff --git a/main/sur/verb-args/gate.hook b/main/sur/verb-args/gate.hook new file mode 100644 index 0000000000..28697c73ad --- /dev/null +++ b/main/sur/verb-args/gate.hook @@ -0,0 +1 @@ +,[~] From 609566117e12d3a8845d39c01427ce3f22703a3f Mon Sep 17 00:00:00 2001 From: Anton Dyudin Date: Thu, 23 Oct 2014 16:29:33 -0700 Subject: [PATCH 15/31] Arm removal with prejudice --- arvo/hoon.hoon | 3 --- 1 file changed, 3 deletions(-) diff --git a/arvo/hoon.hoon b/arvo/hoon.hoon index a074b28e6f..940a4cfec0 100644 --- a/arvo/hoon.hoon +++ b/arvo/hoon.hoon @@ -3258,8 +3258,6 @@ |=(a=tape (rap 3 ^-((list ,@) a))) (star ;~(pose nud low hep dot sig)) ++ voy ;~(pfix bas ;~(pose bas soq bix)) - ++ vym (bass 256 ;~(plug low (star ;~(pose low nud)))) - ++ vyn (bass 256 ;~(plug hep vym (easy ~))) -- ++ ag |% @@ -3285,7 +3283,6 @@ ;~(pfix bas ;~(pose bas soq bix:ab)) ;~(less bas soq prn) == - ++ sym (cook |=(a=(list ,@) (rap 3 a)) ;~(plug vym:ab (star vyn:ab))) ++ tyq (cook |=(a=(list ,@) (rap 3 a)) (plus siq:ab)) ++ viz (ape (bass 0x200.0000 ;~(plug pev:ab (star ;~(pfix dog piv:ab))))) ++ vum (bass 32 (plus siv:ab)) From 23b57f3b2731075722a6fc488420f9a0bd6138fd Mon Sep 17 00:00:00 2001 From: Anton Dyudin Date: Thu, 23 Oct 2014 17:21:28 -0700 Subject: [PATCH 16/31] Further disarming --- arvo/hoon.hoon | 6 ------ 1 file changed, 6 deletions(-) diff --git a/arvo/hoon.hoon b/arvo/hoon.hoon index 940a4cfec0..74f8ca9ec3 100644 --- a/arvo/hoon.hoon +++ b/arvo/hoon.hoon @@ -3277,12 +3277,6 @@ ++ hex (ape (bass 0x1.0000 ;~(plug qex:ab (star ;~(pfix dog qix:ab))))) ++ lip =+ tod=(ape ted:ab) (bass 256 ;~(plug tod (stun [3 3] ;~(pfix dog tod)))) - ++ qut %+ ifix [soq soq] - %+ boss 256 - %- star ;~ pose - ;~(pfix bas ;~(pose bas soq bix:ab)) - ;~(less bas soq prn) - == ++ tyq (cook |=(a=(list ,@) (rap 3 a)) (plus siq:ab)) ++ viz (ape (bass 0x200.0000 ;~(plug pev:ab (star ;~(pfix dog piv:ab))))) ++ vum (bass 32 (plus siv:ab)) From 22feaa507af5e196796ec44fd9cf428b9442b0d5 Mon Sep 17 00:00:00 2001 From: Anton Dyudin Date: Fri, 24 Oct 2014 12:58:04 -0700 Subject: [PATCH 17/31] Term-line restructure: (list ?(tank [%stem tank tank])) --- arvo/dill.hoon | 11 +++++++++-- main/app/terminal/core.hook | 2 +- main/mar/term-line/door.hook | 6 +++--- main/sur/term-line/gate.hook | 2 +- 4 files changed, 14 insertions(+), 7 deletions(-) diff --git a/arvo/dill.hoon b/arvo/dill.hoon index 86d678e999..e6d1f7b8f3 100644 --- a/arvo/dill.hoon +++ b/arvo/dill.hoon @@ -110,7 +110,8 @@ [%res p=span] :: [%cmd p=char] :: == == :: -++ term-line ,[p=cord q=(list cord) r=(list tank)] :: +++ term-line ,[p=cord q=(list cord) r=(list tark)] :: +++ tark ?(tank [%stem p=tank q=tank]) :: :::::::: :: dill tiles ++ bein :: terminal control $: $: bul=@ud :: buffer length @@ -358,7 +359,13 @@ %note ?.(p.yar +>.$ (fume p.+.sih q.+.sih)) :: debug message ?(%rush %rust) :: XX reset prompt ?> ?=(%term-line +>-.sih) - =. +>.$ (furl (zing (turn r.q.sih |=(a=tank (~(win re a) 0 p.q.yar))))) + =. +>.$ + =- (furl (zing (turn r.q.sih -))) + |= a=tark + ^- wall + ?+ -.a (~(win re a) 0 p.q.yar) + %stem ~[~(ram re p.a) ~(ram re p.a)] + == %- edit =| bed=bein =+ ^= hyt ^- hist diff --git a/main/app/terminal/core.hook b/main/app/terminal/core.hook index 7e990d332f..9b023a2b76 100644 --- a/main/app/terminal/core.hook +++ b/main/app/terminal/core.hook @@ -148,7 +148,7 @@ %line :: command entered =. r.tel :_ r.tel - rose/[~ ~ ~]^~[leaf/(trip p.tel) leaf/(trip p.jof)] + stem/[leaf/(trip p.tel) leaf/(trip p.jof)] =. hiz (~(put by hiz) pax tel) ?: =('\\' (end 3 1 p.jof)) $(jof [%cmd (rsh 3 1 p.jof)]) diff --git a/main/mar/term-line/door.hook b/main/mar/term-line/door.hook index e03c07d9cd..fb75d67292 100644 --- a/main/mar/term-line/door.hook +++ b/main/mar/term-line/door.hook @@ -18,10 +18,10 @@ [%history %a (turn q.tel |=(a=cord [%s a]))] :+ %lines %a %- zing ^- (list (list ^json)) - %+ turn (flop r.tel) |= a=tank - ?. ?=([%rose [[%'>' %' ' ~] ~ ~] [%leaf *] [%leaf *] ~] a) + %+ turn (flop r.tel) |= a=?(tank [%stem p=tank q=tank]) + ?. ?=(%stem -.a) (turn (wash 0^80 a) jape) - [(jobe prompt/(jape p.i.q.a) task/(jape p.i.t.q.a) ~)]~ + [(jobe prompt/(jape ~(ram re p.a)) task/(jape ~(ram re q.a)) ~)]~ == -- -- diff --git a/main/sur/term-line/gate.hook b/main/sur/term-line/gate.hook index c48af45cc7..65511b4c24 100644 --- a/main/sur/term-line/gate.hook +++ b/main/sur/term-line/gate.hook @@ -1 +1 @@ -,[p=cord q=(list cord) r=(list tank)] +,[p=cord q=(list cord) r=(list ?(tank [%stem p=tank q=tank]))] From f25de520d6c6413c4ec7c5b8082654c176dd5377 Mon Sep 17 00:00:00 2001 From: Anton Dyudin Date: Fri, 24 Oct 2014 13:08:19 -0700 Subject: [PATCH 18/31] Offset input --- main/app/terminal/hymn/script.js | 5 ++--- main/app/terminal/hymn/style.css | 4 +++- 2 files changed, 5 insertions(+), 4 deletions(-) diff --git a/main/app/terminal/hymn/script.js b/main/app/terminal/hymn/script.js index c3598938b7..817cb73f97 100644 --- a/main/app/terminal/hymn/script.js +++ b/main/app/terminal/hymn/script.js @@ -35,7 +35,7 @@ $(function() { if(e.shiftKey) return true v = prom.val().replace(/\xa0/g, ' ') $(cont).append($('').html(prem.innerHTML), - $('').text(v)) + $('
').text(v)) jpok('line', v) hist.unshift(v) @@ -90,8 +90,7 @@ $(function() { $(cont).append($('
').text(lom)) else { $(cont).append($('').text(lom.prompt), - $('').text(lom.task), - $('
')) + $('
').text(lom.task)) } } window.scrollTo(0,document.body.scrollHeight) diff --git a/main/app/terminal/hymn/style.css b/main/app/terminal/hymn/style.css index 4b6c67e704..32a0a9567f 100644 --- a/main/app/terminal/hymn/style.css +++ b/main/app/terminal/hymn/style.css @@ -26,9 +26,11 @@ button { background-color: #fff; padding: 1rem; } -#prom-cont { +#prom-cont, +.prom { display: block; position:relative; + left: 1rem; } textarea, #prom-size { From 8f1bf03d50ff67db6d09bcb6408f4cd92a0560da Mon Sep 17 00:00:00 2001 From: Ubuntu Date: Tue, 28 Oct 2014 01:50:07 +0000 Subject: [PATCH 19/31] autosync seems to be working --- arvo/clay.hoon | 74 ++++++++++++++++++++++++++++++++++++++++++++++++-- arvo/dill.hoon | 50 +++++++++++++++++++--------------- 2 files changed, 99 insertions(+), 25 deletions(-) diff --git a/arvo/clay.hoon b/arvo/clay.hoon index e8f374b389..1bc83827bf 100644 --- a/arvo/clay.hoon +++ b/arvo/clay.hoon @@ -1,5 +1,5 @@ :: clay (4c), revision control -:: +!: |= pit=vase => |% ++ cult (map duct rove) :: subscriptions @@ -31,7 +31,8 @@ $% [%want p=sock q=path r=*] :: == == :: $: %c :: to %clay - $% [%warp p=sock q=riff] :: + $% [%merg p=@p q=@tas r=mizu] :: + [%warp p=sock q=riff] :: == == :: $: %d :: $% [%flog p=[%crud p=@tas q=(list tank)]] :: to %dill @@ -379,6 +380,49 @@ ^- rove [%| p.p.rav q.p.rav r.p.rav ~] :: + ++ sync + |= [hen=duct her=@p rot=riot] + ^+ +>.$ + ?~ rot + ~& "autosync to {} on {} stopped" + +>.$ + ?: ?=(%y p.p.u.rot) + %= +>.$ + tag + :_ tag + :* hen /auto/(scot %p who)/(scot %p her)/[syd]/v + %c %warp [who her] syd + `[%& %v q.p.u.rot /] + == + == + ?> ?=(%v p.p.u.rot) + =+ der=((hard dome) r.u.rot) + =+ ^= lum + ^- (unit (unit mizu)) + %^ ~(construct-merge ze now dom ran) + ?:(=(0 let.dom) %init %fine) + who + :+ syd + `saba`[her syd [0 let.der] der] + now + ?~ lum + ~& "autosync to {} on {} failed, please merge manually" + +>.$ + ?~ u.lum + ~& "{} on {} up to date" + +>.$ + %= +>.$ + tag + :_ :_ tag + :* hen /auto/(scot %p who)/(scot %p her)/[syd]/y + %c %warp [who her] syd + `[%& %y [%ud +(let.der)] /] + == + :* hen /auto/(scot %p who)/(scot %p her)/[syd]/merg + %c %merg who syd u.u.lum + == + == + :: ++ wake :: update subscribers ^+ . =+ xiq=(~(tap by qyx) ~) @@ -500,7 +544,19 @@ ^- [p=(list move) q=_..^$] ?- -.q.hic %init - [~ ..^$(fat.ruf (~(put by fat.ruf) p.q.hic [hen ~ ~]))] + :_ ..^$(fat.ruf (~(put by fat.ruf) p.q.hic [hen ~ ~])) + =+ bos=(sein p.q.hic) + ~& [%bos bos p.q.hic] + ?: =(bos p.q.hic) ~ + ^- (list move) + %- zing + %+ turn (limo ~[%main %arvo %try]) + |= syd=@tas + :~ :* hen %pass /auto/(scot %p p.q.hic)/(scot %p bos)/[syd]/y + %c %warp [p.q.hic bos] syd + `[%& %y [%da now] /] + == + == :: %merg :: direct state up =^ mos ruf @@ -604,6 +660,18 @@ ++ take :: accept response |= [tea=wire hen=duct hin=(hypo sign)] ^- [p=(list move) q=_..^$] + ?: ?=([%auto @ @ @ ?(%y %v) ~] tea) + ~& %taking-auto + ?> ?=(%writ -.+.q.hin) + ~& %taking-auto-writ + =+ our=(slav %p i.t.tea) + =+ her=(slav %p i.t.t.tea) + =* syd i.t.t.t.tea + =+ une=(un our now ruf) + =+ wex=(di:une syd) + =+ wao=(sync:wex hen her p.q.hin) + =+ woo=abet:wao + [-.woo ..^$(ruf abet:(pish:une syd +.woo ran.wao))] ?- -.+.q.hin %crud [[[hen %slip %d %flog +.q.hin] ~] ..^$] diff --git a/arvo/dill.hoon b/arvo/dill.hoon index 86d678e999..fb973c13ff 100644 --- a/arvo/dill.hoon +++ b/arvo/dill.hoon @@ -39,6 +39,9 @@ $% $: %a :: $% [%make p=(unit ,@t) q=@ud r=@ s=?] :: [%sith p=@p q=@uw r=?] :: + == == :: + $: %c :: + $% [%warp p=sock q=riff] :: == == :: ::S $% $: %b :: to %batz ::S $% [%hail ~] :: @@ -50,7 +53,7 @@ ::S [%make p=(unit ,@t) q=@ud r=@ s=?] :: ::S [%sith p=@p q=@uw r=?] :: ::S == == :: - $: %d :: to %dill + $: %d :: $% [%crud p=@tas q=(list tank)] :: [%text p=tape] :: == == :: @@ -61,6 +64,7 @@ $: %t :: $% [%wait p=@da] :: == == == :: +++ riff ,[p=desk q=(unit rave)] :: see %clay ++ sign :: in result $<- $? ::S $: %b :: by %batz @@ -77,6 +81,9 @@ ::S [%vega p=path] :: ::S [%warn p=tape] :: ::S == == :: + $: %c :: + $% [%writ p=riot] :: + == == :: $: %g :: $% [%mean p=ares] :: [%nice ~] :: @@ -94,9 +101,6 @@ [%sage p=path q=*] :: [%veer p=@ta q=path r=@t] :: [%vega p=path] :: - == == :: - $: %t :: - $% [%wake ~] :: == == :: $: @tas :: by any $% [%crud p=@tas q=(list tank)] :: @@ -171,7 +175,7 @@ -- => |% ++ dy - |= [hen=duct dug=(map duct yard)] + |= [hen=duct our=ship dug=(map duct yard)] =+ ^= yar ^- yard =+ yur=(~(get by dug) hen) ?^ yur u.yur @@ -401,11 +405,13 @@ ::S +>(mos :_(mos [hen %give +.sih])) ?(%init %veer %vega %verb) :: drop-throughs +>(mos :_(mos [hen %give +.sih])) - %wake + %writ :: file exists + ~& > %dill-writ +:: +>.$ %= +>.$ mos :_ mos - [hen %pass / %g %show [~zod /terminal] ~zod /lines] :: XX ~zod %init + [hen %pass / %g %show [our /terminal] our /lines] == == :: @@ -483,9 +489,7 @@ %d ?: ?& =(0 bul.u.q.q.yar) =(0 bus.u.q.q.yar) == - ~& %dill-kill-not-implemented +>.$(mos :_(mos [hen %give %logo ~])) - ::S +>.$(mos :_(mos [hen %pass ~ %b [%kill ~]])) :: XX send \c $(kyz [%belt %del ~]) %e (edit u.q.q.yar(bus bul.u.q.q.yar)) %f $(kyz [%belt %aro %r]) @@ -662,9 +666,10 @@ :: %init %= +>.$ + our p.kyz mos :_ mos - [hen %slip %t %wait `@da`0] :: XX ~zod %init + [hen %slip %c %warp [p.kyz p.kyz] %main `[%& %y [%ud 1] /]] == :: %talk (furl (~(win re p.kyz) 0 p.q.yar)) :: program output @@ -674,17 +679,18 @@ ++ poke |= msg=mess ^- move - :^ hen %pass / :: XX ~zod %init - :^ %g %mess [~zod /terminal] - :- ~zod msg + :^ hen %pass / + :^ %g %mess [our /terminal] + :- our msg :: ++ yerk :: complete core - ^- [p=(list move) q=(map duct yard)] - :- (flop mos) + ^- [p=(list move) q=ship r=(map duct yard)] + :+ (flop mos) our (~(put by dug) hen yar) -- -- =| $: %0 :: + our=ship :: dug=(map duct yard) :: == :: |= [now=@da eny=@ ski=sled] :: current invocation @@ -708,8 +714,8 @@ :_ ..^$ %+ turn (~(tap by dug) *(list ,[p=duct q=yard])) |=([a=duct b=yard] [a %slip %d p.q.hic]) - =^ moz dug yerk:(lear:(dy hen dug) q.hic) - [moz ..^$] + =+ res=yerk:(lear:(dy hen our dug) q.hic) + [-.res ..^$(our +<.res, dug +>.res)] :: ++ doze |= [now=@da hen=duct] @@ -717,19 +723,19 @@ ~ :: ++ load - |= old=[%0 dug=(map duct yard)] + |= old=[%0 our=ship dug=(map duct yard)] ^+ ..^$ - ..^$(dug dug.old) + ..^$(our our.old, dug dug.old) :: ++ scry |= [fur=(unit (set monk)) ren=@tas his=ship syd=desk lot=coin tyl=path] ^- (unit (unit (pair mark ,*))) [~ ~ [%tank >dug<]] :: -++ stay [%0 dug] +++ stay [%0 our dug] ++ take :: process move |= [tea=wire hen=duct hin=(hypo sign)] ^- [p=(list move) q=_..^$] - =^ moz dug yerk:(leap:(dy hen dug) tea q.hin) - [moz ..^$] + =+ res=yerk:(leap:(dy hen our dug) tea q.hin) + [-.res ..^$(our +<.res, dug +>.res)] -- From e12a41c08e277abe5b88e787c65f7a1f2376412d Mon Sep 17 00:00:00 2001 From: Ubuntu Date: Tue, 28 Oct 2014 19:59:26 +0000 Subject: [PATCH 20/31] autosync/unsync works --- arvo/ames.hoon | 3 +- arvo/clay.hoon | 95 ++++++++++++++++++++++++++++++++------------------ 2 files changed, 63 insertions(+), 35 deletions(-) diff --git a/arvo/ames.hoon b/arvo/ames.hoon index b049e62eef..fa5fe18830 100644 --- a/arvo/ames.hoon +++ b/arvo/ames.hoon @@ -1714,7 +1714,8 @@ == :: %pi :: ping - $(bon [%wine p.bon " sent a ping at {(scow %da now)}"]) + `fox + :: $(bon [%wine p.bon " sent a ping at {(scow %da now)}"]) :: ?(%pr %pc) :: %pr, %pc :_ fox diff --git a/arvo/clay.hoon b/arvo/clay.hoon index 1bc83827bf..35238dc14e 100644 --- a/arvo/clay.hoon +++ b/arvo/clay.hoon @@ -10,12 +10,14 @@ [%writ p=riot] :: response == :: ++ kiss :: in request ->$ - $% [%info p=@p q=@tas r=nori] :: internal edit + $% [%font p=@p q=@tas r=@p s=@tas] :: set upstream + [%info p=@p q=@tas r=nori] :: internal edit [%ingo p=@p q=@tas r=nori] :: internal noun edit [%init p=@p] :: report install [%into p=@p q=@tas r=nori] :: external edit [%invo p=@p q=@tas r=nori] :: external noun edit [%merg p=@p q=@tas r=mizu] :: internal change + [%plug p=@p q=@tas r=@p s=@tas] :: unset upstream [%wart p=sock q=@tas r=path s=*] :: network request [%warp p=sock q=riff] :: file request == :: @@ -31,7 +33,8 @@ $% [%want p=sock q=path r=*] :: == == :: $: %c :: to %clay - $% [%merg p=@p q=@tas r=mizu] :: + $% [%font p=@p q=@tas r=@p s=@tas] :: + [%merg p=@p q=@tas r=mizu] :: [%warp p=sock q=riff] :: == == :: $: %d :: @@ -59,6 +62,7 @@ $: fat=(map ship room) :: domestic hoy=(map ship rung) :: foreign ran=rang :: hashes + sor=(map ,[p=@p q=@tas r=@p s=@tas] duct) :: upstreams == :: ++ rave :: general request $% [& p=mood] :: single request @@ -381,17 +385,17 @@ [%| p.p.rav q.p.rav r.p.rav ~] :: ++ sync - |= [hen=duct her=@p rot=riot] + |= [hen=duct her=@p sud=@tas rot=riot] ^+ +>.$ ?~ rot - ~& "autosync to {} on {} stopped" + ~& "autosync from {} on {} to {} on {} stopped" +>.$ ?: ?=(%y p.p.u.rot) %= +>.$ tag :_ tag - :* hen /auto/(scot %p who)/(scot %p her)/[syd]/v - %c %warp [who her] syd + :* hen /auto/(scot %p who)/[syd]/(scot %p her)/[sud]/v + %c %warp [who her] sud `[%& %v q.p.u.rot /] == == @@ -400,25 +404,28 @@ =+ ^= lum ^- (unit (unit mizu)) %^ ~(construct-merge ze now dom ran) - ?:(=(0 let.dom) %init %fine) + ?:(=(0 let.dom) %init %mate) who :+ syd - `saba`[her syd [0 let.der] der] + `saba`[her sud [0 let.der] der] now + =. tag + :_ tag + :* hen /auto/(scot %p who)/[syd]/(scot %p her)/[sud]/y + %c %warp [who her] sud + `[%& %y [%ud +(let.der)] /] + == ?~ lum - ~& "autosync to {} on {} failed, please merge manually" + ~& "autosync from {} on {} to {} on {} failed" + ~& "please merge manually" +>.$ ?~ u.lum - ~& "{} on {} up to date" + ~& "autosync from {} on {} to {} on {} up to date" +>.$ %= +>.$ tag - :_ :_ tag - :* hen /auto/(scot %p who)/(scot %p her)/[syd]/y - %c %warp [who her] syd - `[%& %y [%ud +(let.der)] /] - == - :* hen /auto/(scot %p who)/(scot %p her)/[syd]/merg + :_ tag + :* hen /auto/(scot %p who)/[syd]/(scot %p her)/[sud]/merg %c %merg who syd u.u.lum == == @@ -549,26 +556,20 @@ ~& [%bos bos p.q.hic] ?: =(bos p.q.hic) ~ ^- (list move) - %- zing %+ turn (limo ~[%main %arvo %try]) |= syd=@tas - :~ :* hen %pass /auto/(scot %p p.q.hic)/(scot %p bos)/[syd]/y - %c %warp [p.q.hic bos] syd + [hen %pass / %c %font p.q.hic syd bos syd] + :: + %font + ?: (~(has by sor.ruf) +.q.hic) `..^$ + :_ ..^$(sor.ruf (~(put by sor.ruf) +.q.hic hen)) + :~ :* hen %pass + /auto/(scot %p p.q.hic)/[q.q.hic]/(scot %p r.q.hic)/[s.q.hic]/y + %c %warp [p.q.hic r.q.hic] s.q.hic `[%& %y [%da now] /] == == :: - %merg :: direct state up - =^ mos ruf - =+ une=(un p.q.hic now ruf) - =+ ^= zat - (exem:(di:wake:une q.q.hic) hen now r.q.hic) - =+ zot=abet.zat - :- -.zot - =. une (pish:une q.q.hic +.zot ran.zat) - abet:une(hez.yar ?.(=(%into -.q.hic) hez.yar.une [~ hen])) - [mos ..^$] - :: ?(%info %into) ?: =(%$ q.q.hic) ?. ?=(%into -.q.hic) [~ ..^$] @@ -598,6 +599,31 @@ =. une (pish:une q.q.hic +.zot ran.zat) abet:une(hez.yar ?.(=(%invo -.q.hic) hez.yar.une [~ hen])) [mos ..^$] + :: + %merg :: direct state up + =^ mos ruf + =+ une=(un p.q.hic now ruf) + =+ ^= zat + (exem:(di:wake:une q.q.hic) hen now r.q.hic) + =+ zot=abet.zat + :- -.zot + =. une (pish:une q.q.hic +.zot ran.zat) + abet:une(hez.yar ?.(=(%into -.q.hic) hez.yar.une [~ hen])) + [mos ..^$] + :: + %plug + ?. (~(has by sor.ruf) +.q.hic) `..^$ + :_ ..^$(sor.ruf (~(del by sor.ruf) +.q.hic)) + =+ hyn=(~(got by sor.ruf) +.q.hic) + :~ :* hyn %pass + /auto/(scot %p p.q.hic)/[q.q.hic]/(scot %p r.q.hic)/[s.q.hic]/y + %c %warp [p.q.hic r.q.hic] s.q.hic ~ + == + :* hyn %pass + /auto/(scot %p p.q.hic)/[q.q.hic]/(scot %p r.q.hic)/[s.q.hic]/v + %c %warp [p.q.hic r.q.hic] s.q.hic ~ + == + == :: %warp =^ mos ruf @@ -660,16 +686,17 @@ ++ take :: accept response |= [tea=wire hen=duct hin=(hypo sign)] ^- [p=(list move) q=_..^$] - ?: ?=([%auto @ @ @ ?(%y %v) ~] tea) + ?: ?=([%auto @ @ @ @ ?(%y %v) ~] tea) ~& %taking-auto ?> ?=(%writ -.+.q.hin) ~& %taking-auto-writ =+ our=(slav %p i.t.tea) - =+ her=(slav %p i.t.t.tea) - =* syd i.t.t.t.tea + =* sud i.t.t.tea + =+ her=(slav %p i.t.t.t.tea) + =* syd i.t.t.t.t.tea =+ une=(un our now ruf) =+ wex=(di:une syd) - =+ wao=(sync:wex hen her p.q.hin) + =+ wao=(sync:wex hen her sud p.q.hin) =+ woo=abet:wao [-.woo ..^$(ruf abet:(pish:une syd +.woo ran.wao))] ?- -.+.q.hin From b2c2ae3374a356b0d2fea154711a72463d565def Mon Sep 17 00:00:00 2001 From: Ubuntu Date: Wed, 29 Oct 2014 23:07:13 +0000 Subject: [PATCH 21/31] :begin working except unix sync --- arvo/ames.hoon | 11 +++++++++- arvo/dill.hoon | 26 +++++++++++----------- arvo/gall.hoon | 15 +++++++------ main/app/began/core.hook | 43 +++++++++++++++++++++++++++++++++++++ main/app/begin/core.hook | 33 ++++++++++++++++++++++++++++ main/app/terminal/core.hook | 4 ++-- 6 files changed, 111 insertions(+), 21 deletions(-) create mode 100644 main/app/began/core.hook create mode 100644 main/app/begin/core.hook diff --git a/arvo/ames.hoon b/arvo/ames.hoon index fa5fe18830..575dccd7e6 100644 --- a/arvo/ames.hoon +++ b/arvo/ames.hoon @@ -1,5 +1,5 @@ :: ames (4a), networking -:: +!: |= pit=vase => =~ :: structures @@ -1689,6 +1689,15 @@ :: ~& [%rx p.bon q.bon] ?> ?=([@ *] q.q.bon) ?: ?=(%r i.q.q.bon) + ?: ?=([%ta *] t.q.q.bon) + =+ wil=((hard (unit will)) r.bon) + :_ fox + ?~ wil ~ + =+ ^= pax + :+ (scot %p p.p.bon) + (scot %p q.p.bon) + q.q.bon + [hen %pass pax %g %rote p.bon /began 0 %m %will u.wil]~ ?> ?=([@ @ *] t.q.q.bon) :_ fox =+ [cak=i.t.q.q.bon ven=i.t.t.q.q.bon] diff --git a/arvo/dill.hoon b/arvo/dill.hoon index 5718df1dfd..3c2e6e2769 100644 --- a/arvo/dill.hoon +++ b/arvo/dill.hoon @@ -176,10 +176,11 @@ -- => |% ++ dy - |= [hen=duct our=ship dug=(map duct yard)] + |= [hen=duct our=ship def=(unit duct) dug=(map duct yard)] =+ ^= yar ^- yard =+ yur=(~(get by dug) hen) ?^ yur u.yur + ?^ def (~(got by dug) u.def) [& [80 ~ *blot] ~] =| mos=(list move) |% @@ -414,7 +415,6 @@ +>(mos :_(mos [hen %give +.sih])) %writ :: file exists ~& > %dill-writ -:: +>.$ %= +>.$ mos :_ mos @@ -672,11 +672,12 @@ ::S +>.$(dug (~(del by dug) hen), mos :_(mos [hen %pass ~ %b kyz])) :: %init + =. def `(fall def +.hen) %= +>.$ our p.kyz mos :_ mos - [hen %slip %c %warp [p.kyz p.kyz] %main `[%& %y [%ud 1] /]] + [(need def) %pass / %c %warp [p.kyz p.kyz] %main `[%& %y [%ud 1] /]] == :: %talk (furl (~(win re p.kyz) 0 p.q.yar)) :: program output @@ -691,13 +692,14 @@ :- our msg :: ++ yerk :: complete core - ^- [p=(list move) q=ship r=(map duct yard)] - :+ (flop mos) our + ^- [p=(list move) q=ship r=(unit duct) s=(map duct yard)] + :^ (flop mos) our def (~(put by dug) hen yar) -- -- =| $: %0 :: our=ship :: + def=(unit duct) :: dug=(map duct yard) :: == :: |= [now=@da eny=@ ski=sled] :: current invocation @@ -721,8 +723,8 @@ :_ ..^$ %+ turn (~(tap by dug) *(list ,[p=duct q=yard])) |=([a=duct b=yard] [a %slip %d p.q.hic]) - =+ res=yerk:(lear:(dy hen our dug) q.hic) - [-.res ..^$(our +<.res, dug +>.res)] + =+ res=yerk:(lear:(dy hen our def dug) q.hic) + [-.res ..^$(our +<.res, dug +>+.res, def +>-.res)] :: ++ doze |= [now=@da hen=duct] @@ -730,19 +732,19 @@ ~ :: ++ load - |= old=[%0 our=ship dug=(map duct yard)] + |= old=[%0 our=ship def=(unit duct) dug=(map duct yard)] ^+ ..^$ - ..^$(our our.old, dug dug.old) + ..^$(our our.old, def def.old, dug dug.old) :: ++ scry |= [fur=(unit (set monk)) ren=@tas his=ship syd=desk lot=coin tyl=path] ^- (unit (unit (pair mark ,*))) [~ ~ [%tank >dug<]] :: -++ stay [%0 our dug] +++ stay [%0 our def dug] ++ take :: process move |= [tea=wire hen=duct hin=(hypo sign)] ^- [p=(list move) q=_..^$] - =+ res=yerk:(leap:(dy hen our dug) tea q.hin) - [-.res ..^$(our +<.res, dug +>.res)] + =+ res=yerk:(leap:(dy hen our def dug) tea q.hin) + [-.res ..^$(our +<.res, dug +>+.res, def +>-.res)] -- diff --git a/arvo/gall.hoon b/arvo/gall.hoon index 80da1d6d63..d234971f7f 100644 --- a/arvo/gall.hoon +++ b/arvo/gall.hoon @@ -1,4 +1,4 @@ -:: :: %gall, user-level applications +!: :: %gall, user-level applications !? 164 :::: |= pit=vase @@ -131,10 +131,11 @@ $% [%dirt p=twig] :: == :: ++ sign :: in result $<- - $? [?(%c %d %e) @tas *] :: + $? [?(%c %d %e %t) @tas *] :: $: %a :: by %ames - $% [%woot p=ship q=coop] :: - [%went p=ship q=cape] :: XX only for apps + $% [%init p=@p] :: only for :begin + [%woot p=ship q=coop] :: + [%went p=ship q=cape] :: only for apps == == :: $: %g :: by %gall $% [%crud p=@tas q=(list tank)] :: @@ -360,7 +361,7 @@ ?> ?=(?(%mess %show %nuke) -.kon) =+ you=`ship`?-(-.kon %mess p.kon, %nuke p.kon, %show p.kon) =+ mat=(~(got by pol.all) you) - =+ sad==+(sad=(~(get by sap.mat) our) ?^(sad u.sad *scad)) + =+ sad==+(sad=(~(get by sap.mat) our) ?^(sad u.sad [.(p 1)]:*scad)) =^ num sad =+ nym=(~(get by q.sad) hen) ?^ nym [u.nym sad] @@ -426,15 +427,16 @@ =+ rod=|=(ron=roon `note`[%a %wont [our you] [%q %gh imp] num ron]) ?+ -.pax !! %m ?: ?=(%a -.sih) ~ - :_ ~ :- hen ?+ -.sih ~& [%gall-gave-m -.sih] !! %f + :_ ~ :- hen ?- -.p.+.sih %| [%give %mean ~ %ford-fail p.p.+.sih] %& [%pass [%r pax] %g %mess [our imp] you `cage`q.p.p.+.sih] == :: %g + :_ ~ :- hen ?- -.+.sih %crud !! %dumb !! @@ -473,6 +475,7 @@ ++ gawd :: %r handle response |= [hen=duct saq=sack imp=path num=@ud ron=roon] ^- [p=(list move) q=_..^$] + ?: =(0 num) ~& %shouldnt-get-zero `..^$ =+ mat=(~(got by pol.all) p.saq) =+ sad=(~(got by sap.mat) q.saq) =+ neh=(~(got by r.sad) num) diff --git a/main/app/began/core.hook b/main/app/began/core.hook new file mode 100644 index 0000000000..fb2c9e617e --- /dev/null +++ b/main/app/began/core.hook @@ -0,0 +1,43 @@ +/- begin-args +:: +|% +++ sign + $% $: %a + $% [%went p=ship q=cape] + [%init p=@p] + == == == +-- +:: +!: +|_ [hid=hide %0 ust=bone his=@p mac=mace] +++ poke-begin-args + |= [ost=bone you=ship arg=begin-args] + =+ bur=(shax :(mix (jam ges.arg) eny.arg)) + =+ loy=(bruw 2.048 bur) + :_ +>.$(ust ost, his his.arg, mac [0 sec:ex:loy]~) + :~ :* ost %pass /ticketing %a %want [our.hid (sein his)] /q/ta + his.arg tic.arg ges.arg pub:ex:loy + == + [ost %give %nice ~] + == +:: +++ poke-will + |= [ost=bone you=ship wil=will] + :_ +>.$ :_ ~ + [ust %pass / %a %cash his mac wil] +:: +++ pour + |= [ost=bone pax=path sih=*] + =+ sih=((soft sign) sih) :: seem to get blits + ?~ sih `+>.$ + :_ +>.$ + ?- +<.u.sih + %init ~ + %went [ost %give ?:(?=(%good q.u.sih) [%nice ~] [%mean ~ %went-dead ~])]~ + == +:: +++ peer + |= + * + `+> +-- diff --git a/main/app/begin/core.hook b/main/app/begin/core.hook new file mode 100644 index 0000000000..9dfc1c6bfe --- /dev/null +++ b/main/app/begin/core.hook @@ -0,0 +1,33 @@ +/- begin-args +:: +|% +++ sign + $% $: %g + $% [%nice ~] + [%mean p=ares] + == == == +-- +:: +!: +|_ [hid=hide ~] +++ poke-begin-args + |= [ost=bone you=ship arg=begin-args] + :_ +>.$ + [ost %pass /to-gan %g %mess [our.hid /began] you %begin-args !>(arg)]~ +:: +++ pour + |= [ost=bone pax=path sih=*] + =+ sih=((hard sign) sih) + :_ +>.$ + :- [ost %give +.sih] + %+ turn (~(tap by sup.hid)) + |= [ost=bone *] + :^ ost %give %rush + :- %tang :_ ~ + [%leaf ?:(?=(%nice +<.sih) "begin successful" "begin failed")] +:: +++ peer + |= + * + `+> +-- diff --git a/main/app/terminal/core.hook b/main/app/terminal/core.hook index 9b023a2b76..7a7d4be95a 100644 --- a/main/app/terminal/core.hook +++ b/main/app/terminal/core.hook @@ -196,11 +196,11 @@ |= [ost=bone pax=path sih=*] ^- [(list move) _+>] =+ sih=((hard sign) sih) - ?: ?=(?(%sage %verb %veer %vega) &2.sih) :: vomit + ?: ?=(?(%sage %verb %veer %vega) &2.sih) :: vomit [[ost %give +.sih]~ +>.$] ?~ pax !! ?+ -.pax !! - %fork ?>(?=(%gone +<.sih) `+>.$) :: XX maybe mean? + %fork ?>(?=(%gone +<.sih) `+>.$) :: XX maybe mean? %resp ?+ +<.sih !! %nice `+>.$ From 5e39bd46d94f041a472076ba6bb36ffce1671406 Mon Sep 17 00:00:00 2001 From: Ubuntu Date: Wed, 29 Oct 2014 23:45:22 +0000 Subject: [PATCH 22/31] forgot some peripheral files --- main/app/sync/core.hook | 18 ++++++++++++++++++ main/app/unsync/core.hook | 18 ++++++++++++++++++ main/mar/begin-args/door.hook | 15 +++++++++++++++ main/mar/sync-args/door.hook | 15 +++++++++++++++ main/mar/unsync-args/door.hook | 15 +++++++++++++++ main/mar/will/door.hook | 11 +++++++++++ main/sur/begin-args/gate.hook | 1 + main/sur/sync-args/gate.hook | 1 + main/sur/unsync-args/gate.hook | 1 + 9 files changed, 95 insertions(+) create mode 100644 main/app/sync/core.hook create mode 100644 main/app/unsync/core.hook create mode 100644 main/mar/begin-args/door.hook create mode 100644 main/mar/sync-args/door.hook create mode 100644 main/mar/unsync-args/door.hook create mode 100644 main/mar/will/door.hook create mode 100644 main/sur/begin-args/gate.hook create mode 100644 main/sur/sync-args/gate.hook create mode 100644 main/sur/unsync-args/gate.hook diff --git a/main/app/sync/core.hook b/main/app/sync/core.hook new file mode 100644 index 0000000000..8616e61c00 --- /dev/null +++ b/main/app/sync/core.hook @@ -0,0 +1,18 @@ +!: +|_ [hid=hide ~] +++ poke-sync-args + |= [ost=bone you=ship syd=@tas her=@p sud=@tas ~] + :_ +>.$ + :* [ost %pass /sync %c %font our.hid syd her sud] + [ost %give %nice ~] + %+ turn (~(tap by sup.hid)) + |= [ost=bone *] + :^ ost %give %rush + :- %tang :_ ~ + leaf/"synced" + == +++ peer + |= + * + `+> +-- diff --git a/main/app/unsync/core.hook b/main/app/unsync/core.hook new file mode 100644 index 0000000000..ad506023fa --- /dev/null +++ b/main/app/unsync/core.hook @@ -0,0 +1,18 @@ +!: +|_ [hid=hide ~] +++ poke-unsync-args + |= [ost=bone you=ship syd=@tas her=@p sud=@tas ~] + :_ +>.$ + :* [ost %pass /sync %c %plug our.hid syd her sud] + [ost %give %nice ~] + %+ turn (~(tap by sup.hid)) + |= [ost=bone *] + :^ ost %give %rush + :- %tang :_ ~ + leaf/"unsynced" + == +++ peer + |= + * + `+> +-- diff --git a/main/mar/begin-args/door.hook b/main/mar/begin-args/door.hook new file mode 100644 index 0000000000..cd6cabfaec --- /dev/null +++ b/main/mar/begin-args/door.hook @@ -0,0 +1,15 @@ +:: +:::: /hoon/core/zing/pro + :: +/? 314 +/- begin-args +|_ arg=begin-args +:: +++ grab :: convert from + |% + ++ noun :: convert from %noun + |= src=* + ^+ +>+ + +>+(arg (begin-args src)) + -- +-- diff --git a/main/mar/sync-args/door.hook b/main/mar/sync-args/door.hook new file mode 100644 index 0000000000..a6266cabcc --- /dev/null +++ b/main/mar/sync-args/door.hook @@ -0,0 +1,15 @@ +:: +:::: /hoon/core/zing/pro + :: +/? 314 +/- sync-args +|_ arg=sync-args +:: +++ grab :: convert from + |% + ++ noun :: convert from %noun + |= src=* + ^+ +>+ + +>+(arg (sync-args src)) + -- +-- diff --git a/main/mar/unsync-args/door.hook b/main/mar/unsync-args/door.hook new file mode 100644 index 0000000000..15f8f73cec --- /dev/null +++ b/main/mar/unsync-args/door.hook @@ -0,0 +1,15 @@ +:: +:::: /hoon/core/zing/pro + :: +/? 314 +/- unsync-args +|_ arg=unsync-args +:: +++ grab :: convert from + |% + ++ noun :: convert from %noun + |= src=* + ^+ +>+ + +>+(arg (unsync-args src)) + -- +-- diff --git a/main/mar/will/door.hook b/main/mar/will/door.hook new file mode 100644 index 0000000000..e6145a2993 --- /dev/null +++ b/main/mar/will/door.hook @@ -0,0 +1,11 @@ +:: +:::: /hook/door/will/mar + :: +/? 314 +|_ wyl=will +:: +++ grab :: convert from + |% + ++ noun will :: clam from %noun + -- +-- diff --git a/main/sur/begin-args/gate.hook b/main/sur/begin-args/gate.hook new file mode 100644 index 0000000000..7de1ef7a8c --- /dev/null +++ b/main/sur/begin-args/gate.hook @@ -0,0 +1 @@ +,[his=@p tic=@p eny=@t ges=gens ~] diff --git a/main/sur/sync-args/gate.hook b/main/sur/sync-args/gate.hook new file mode 100644 index 0000000000..7f395c2903 --- /dev/null +++ b/main/sur/sync-args/gate.hook @@ -0,0 +1 @@ +,[syd=@tas her=@p sud=@tas ~] diff --git a/main/sur/unsync-args/gate.hook b/main/sur/unsync-args/gate.hook new file mode 100644 index 0000000000..7f395c2903 --- /dev/null +++ b/main/sur/unsync-args/gate.hook @@ -0,0 +1 @@ +,[syd=@tas her=@p sud=@tas ~] From 1fbd634ff49965ebd914a6e0ea65af566110aaec Mon Sep 17 00:00:00 2001 From: Philip C Monk Date: Wed, 29 Oct 2014 20:37:17 -0400 Subject: [PATCH 23/31] added :ticket --- arvo/clay.hoon | 2 -- arvo/dill.hoon | 1 - main/app/ticket/core.hook | 33 +++++++++++++++++++++++++++++++++ main/mar/ticket-args/door.hook | 15 +++++++++++++++ main/sur/ticket-args/gate.hook | 1 + 5 files changed, 49 insertions(+), 3 deletions(-) create mode 100644 main/app/ticket/core.hook create mode 100644 main/mar/ticket-args/door.hook create mode 100644 main/sur/ticket-args/gate.hook diff --git a/arvo/clay.hoon b/arvo/clay.hoon index 35238dc14e..351bc481d2 100644 --- a/arvo/clay.hoon +++ b/arvo/clay.hoon @@ -687,9 +687,7 @@ |= [tea=wire hen=duct hin=(hypo sign)] ^- [p=(list move) q=_..^$] ?: ?=([%auto @ @ @ @ ?(%y %v) ~] tea) - ~& %taking-auto ?> ?=(%writ -.+.q.hin) - ~& %taking-auto-writ =+ our=(slav %p i.t.tea) =* sud i.t.t.tea =+ her=(slav %p i.t.t.t.tea) diff --git a/arvo/dill.hoon b/arvo/dill.hoon index 3c2e6e2769..9f97c77358 100644 --- a/arvo/dill.hoon +++ b/arvo/dill.hoon @@ -414,7 +414,6 @@ ?(%init %veer %vega %verb) :: drop-throughs +>(mos :_(mos [hen %give +.sih])) %writ :: file exists - ~& > %dill-writ %= +>.$ mos :_ mos diff --git a/main/app/ticket/core.hook b/main/app/ticket/core.hook new file mode 100644 index 0000000000..6bb623da2a --- /dev/null +++ b/main/app/ticket/core.hook @@ -0,0 +1,33 @@ +!: +|_ [hid=hide ~] +++ poke-ticket-args + |= [ost=bone you=ship her=@p num=?(~ [p=@ud ~])] + :_ +>.$ + =+ n=?~(num 1 p.num) + =+ ^= sep ^- @ + =+ mir=(clan her) + ?+ mir ~|(%ticket-clan !!) + %king (bex 8) + %duke (bex 16) + %earl (bex 32) + == + :- [ost %give %nice ~] + |- + ?: ?=(0 n) ~ + =+ ^= tic + (,@p .^(%a (scot %p our.hid) %tick (scot %da lat.hid) (scot %p her) ~)) + %+ welp + (spam ost "{}: {}") + $(her (add sep her), n (dec n)) +++ spam + |= [ost=bone msg=tape] + %+ turn (~(tap by sup.hid)) + |= [ost=bone *] + :^ ost %give %rush + :- %tang :_ ~ + leaf/msg +++ peer + |= + * + `+> +-- diff --git a/main/mar/ticket-args/door.hook b/main/mar/ticket-args/door.hook new file mode 100644 index 0000000000..c21567edcd --- /dev/null +++ b/main/mar/ticket-args/door.hook @@ -0,0 +1,15 @@ +:: +:::: /hoon/core/zing/pro + :: +/? 314 +/- ticket-args +|_ arg=ticket-args +:: +++ grab :: convert from + |% + ++ noun :: convert from %noun + |= src=* + ^+ +>+ + +>+(arg (ticket-args src)) + -- +-- diff --git a/main/sur/ticket-args/gate.hook b/main/sur/ticket-args/gate.hook new file mode 100644 index 0000000000..386810df9f --- /dev/null +++ b/main/sur/ticket-args/gate.hook @@ -0,0 +1 @@ +,[her=@p num=?(~ [p=@ud ~])] From 7231bd8310dcff284b7a13f25aa15233c2ecb7fb Mon Sep 17 00:00:00 2001 From: Philip C Monk Date: Thu, 30 Oct 2014 16:48:37 -0400 Subject: [PATCH 24/31] refactored terminal --- main/app/terminal/core.hook | 289 +++++++++++++++++++----------------- 1 file changed, 156 insertions(+), 133 deletions(-) diff --git a/main/app/terminal/core.hook b/main/app/terminal/core.hook index 7a7d4be95a..8e5d5c27d3 100644 --- a/main/app/terminal/core.hook +++ b/main/app/terminal/core.hook @@ -26,6 +26,7 @@ [%veer p=@ta q=path r=@t] :: [%vega p=path] :: == :: +++ glas ?(%term %lines) :: ++ hapt ,[p=ship q=path] :: ++ mess :: $% [%txt p=(hypo cord)] :: @@ -52,7 +53,7 @@ [%vega p=path] :: == == == -- -:: +!: :::: helpers :: |% @@ -70,127 +71,175 @@ ?~ t.a man(c (weld c.man b)) man(c (turn c.man ^$(a t.a))) --- -!: -:::: program - :: -|_ [hid=hide axle] -++ get-shell - |= [ost=bone you=ship pax=path] - ^- [mof=(list move) tel=term-line hit=(map path term-line)] - =+ tel=(fall (~(get by hiz) pax) *term-line) - =+ auc=(encode aut pax) - ?: (~(has by cub.hid) auc) - [~ tel hiz] - =. tel tel(r :_(r.tel leaf/"+ {(trip aut)}")) - :_ [tel (~(put by hiz) pax tel)] - (start-shell ost you pax) :: ++ start-shell - |= [ost=bone you=ship pax=path] + |= [our=ship imp=path ost=bone you=ship pax=path] ^- (list move) =+ auc=(encode aut pax) - :_ [ost %pass [%fork pax] %g %sire [aut auc]]~ - :^ ost %pass [%resp pax] - :+ %g %show - [[our.hid [auc imp.hid]] you /out] -:: -++ end-shell - |= [ost=bone pax=path] - ^- move + :- [ost %pass [%fork pax] %g %sire [aut auc]] + [ost %pass [%resp pax] %g %show [our [auc imp]] you /out]~ +-- +!: +:::: per-shell + :: +|% +++ se + |= [hid=hide ost=bone you=ship hiz=(map path term-line) pax=path] + =+ tel=(fall (~(get by hiz) pax) *term-line) =+ auc=(encode aut pax) - [ost %pass [%fork pax] %g %cide auc] -:: -++ page - |= pax=path - %. stat - %+ inject - ~[%html %head] - ;= ;script: urb.appl = "{(trip app.hid)}" - ;script: urb.term = \{pax: "{(spud pax)}"} - == -:: + =^ mow tel + ?: (~(has by cub.hid) auc) + [~ tel] + :- (start-shell our.hid imp.hid ost you pax) + tel(r :_(r.tel leaf/"+ {(trip aut)}")) + |% + ++ abet + ^- [(list move) (map path term-line)] + [(flop mow) (~(put by hiz) pax tel)] + :: + ++ page + %. stat + %+ inject + ~[%html %head] + ;= ;script: urb.appl = "{(trip app.hid)}" + ;script: urb.term = \{pax: "{(spud pax)}"} + == + :: + ++ peer + |= gal=glas + %_ +>.$ + mow + :_ mow + ?- gal + %term [ost %give %rust %hymn page] :: hymn front end + %lines [ost %give %rust %term-line tel] :: term-line output + == + == + :: + ++ poke + |= jof=$%([%line p=span] [%res p=span] [%cmd p=char]) + ^+ +> + ?- -.jof + %res :: restart shell + =. +>.$ + ?. (~(has by cub.hid) auc) +>.$ + %_ +>.$ + mow :_(mow [ost %pass [%fork pax] %g %cide auc]) + r.tel :_(r.tel leaf/"- {(trip aut)}") + == + %_ +>.$ + r.tel :_(r.tel leaf/"+ {(trip auc)}") + mow + ;: welp + (spam tel) + [ost %give %nice ~]~ + (start-shell our.hid imp.hid ost you pax) + mow + == + == + :: + %line :: command entered + =. r.tel + :_ r.tel + stem/[leaf/(trip p.tel) leaf/(trip p.jof)] + ?: =('\\' (end 3 1 p.jof)) + $(jof [%cmd (rsh 3 1 p.jof)]) + (send %txt -:!>(*cord) p.jof) + :: + %cmd :: key command + ?+ p.jof + (send %kyev -:!>(*kyev) [[%ctrl ~ ~] p.jof]) + %r $(jof [%res 'shell']) + == + == + :: + ++ poke-ctrl + .(mow :_(mow [ost %give %rush %term-line [p q ~]:tel])) + :: + ++ pour + |= [dis=?(%fork %resp %txt %kyev) sih=sign] + ^+ +> + ?- dis + %fork ?>(?=(%gone +<.sih) +>.$) :: XX maybe mean? + %resp + ?+ +<.sih !! + %nice +>.$ + ?(%rust %rush) + =. p.q.sih ?^(q.q.sih p.tel (cat 3 p.q.sih '> ')) :: XX prompt hack + %_ +>.$ + mow (welp (spam q.sih) mow) + tel [p.q.sih (weld q.q.sih q.tel) (weld r.q.sih r.tel)] + == + == + :: + ?(%txt %kyev) + ?+ +<.sih !! + %nice +>.$(mow :_(mow [ost %give +.sih])) + %mean + =+ ^= new + =- (turn - |=(a=tank rose/[~ "! " ~]^[a]~)) + ^- (list tank) + ?~ p.sih ~ + (welp q.u.p.sih leaf/(trip p.u.p.sih) ~) + %_ +>.$ + r.tel (welp new r.tel) + mow + %- welp :_ mow + [[ost %give +.sih] (spam [p.tel q.tel new])] + == + == + == + :: + ++ send + |= mez=mess + %_ +>.$ + mow + %- welp :_ mow + ^- (list move) + %+ murn (~(tap by cub.hid)) + |= [p=span q=term] + ?. =(pax q:(decode p)) ~ + %- some ^- move + :^ ost %pass [-.mez pax] + [%g %mess [our.hid p imp.hid] you mez] + == + :: + ++ spam + |= tol=term-line + ^- (list move) + %+ murn + (~(tap by sup.hid)) + |= [ost=bone @ paf=path] + ?: =([%lines pax] paf) + (some ost %give %rush %term-line tol) + ~ + -- +-- +!: +:::: public interface + :: +|_ [hid=hide axle] ++ peer |= [ost=bone you=ship pax=path] ^- [(list move) _+>] ?~ pax $(pax /term) - =+ (get-shell ost you t.pax) - =. hiz hit - :_ +>.$ :_ mof - ?+ -.pax !! - %term [ost %give %rust %hymn (page t.pax)] :: hymn front end - %lines (jell ost tel) :: term-line output - == + ?. ?=(glas i.pax) + [[ost %give %mean ~ %bad-path ~]~ +>.$] + =+ abet:(peer:(se hid ost you hiz t.pax) i.pax) + [-< +>.$(hiz ->)] :: ++ poke-term-in |= [ost=bone you=ship term-in] ^- [(list move) _+>] - =+ tel=(fall (~(get by hiz) pax) *term-line) - ?- -.jof - %res :: restart shell - =+ joc=(encode aut pax) - =^ mof r.tel - ?. (~(has by cub.hid) joc) - [~ r.tel] - :- [(end-shell ost pax) ~] - [leaf/"- {(trip aut)}" r.tel] - =. r.tel :_(r.tel leaf/"+ {(trip joc)}") - =. hiz (~(put by hiz) pax tel) - :_ +>.$ - ;: welp - mof - [ost %give %nice ~]~ - (start-shell ost you pax) - (spam pax tel) - == - :: - %line :: command entered - =. r.tel - :_ r.tel - stem/[leaf/(trip p.tel) leaf/(trip p.jof)] - =. hiz (~(put by hiz) pax tel) - ?: =('\\' (end 3 1 p.jof)) - $(jof [%cmd (rsh 3 1 p.jof)]) - :_ +>.$ - (send ost you pax %txt -:!>(*cord) p.jof) - %cmd :: key command - ?+ p.jof - :_ +>.$ - %^ send ost you - [pax %kyev -:!>(*kyev) [[%ctrl ~ ~] p.jof]] - %r $(jof [%res 'shell']) - == - == + =+ abet:(poke:(se hid ost you hiz pax) jof) + [-< +>.$(hiz ->)] :: ++ poke-term-ctrl |= [ost=bone you=ship col=term-ctrl] ^- [(list move) _+>] - =+ (get-shell ost you /) - :_ +>.$(hiz hit) :_ mof - [ost %give %rush %term-line [p q ~]:tel] -:: -++ send - |= [ost=bone you=ship pax=path mez=mess] - %+ murn (~(tap by cub.hid)) - |= [p=span q=term] - ?. =(pax q:(decode p)) ~ - %- some ^- move - :^ ost %pass [-.mez (scot %da lat.hid) pax] - [%g %mess [our.hid p imp.hid] you mez] -:: -++ jell - |= [a=bone b=term-line] - [a %give %rush %term-line b] -:: -++ spam - |= [pax=path tel=term-line] - %+ murn - (~(tap by sup.hid)) - |= [ost=bone @ paf=path] - ?: =([%lines pax] paf) - (some (jell ost tel)) - ~ + =+ abet:poke-ctrl:(se hid ost you hiz /) + [-< +>.$(hiz ->)] :: ++ pour |= [ost=bone pax=path sih=*] @@ -199,33 +248,7 @@ ?: ?=(?(%sage %verb %veer %vega) &2.sih) :: vomit [[ost %give +.sih]~ +>.$] ?~ pax !! - ?+ -.pax !! - %fork ?>(?=(%gone +<.sih) `+>.$) :: XX maybe mean? - %resp - ?+ +<.sih !! - %nice `+>.$ - ?(%rust %rush) - =+ tol=(fall (~(get by hiz) t.pax) *term-line) - =. p.q.sih ?^(q.q.sih p.tol (cat 3 p.q.sih '> ')) :: XX prompt hack - =. tol [p.q.sih (weld q.q.sih q.tol) (weld r.q.sih r.tol)] - =. hiz (~(put by hiz) t.pax tol) - [(spam t.pax q.sih) +>.$] - == - :: - ?(%txt %kyev) - ?+ +<.sih !! - %nice [[ost %give +.sih]~ +>.$] - %mean - ?< ?=(~ t.pax) - =+ tel=(fall (~(get by hiz) t.t.pax) *term-line) - =. r.tel - %- welp :_ r.tel - =- (turn - |=(a=tank rose/[~ "! " ~]^[a]~)) - ^- (list tank) - ?~ p.sih ~ - (welp q.u.p.sih leaf/(trip p.u.p.sih) ~) - =. hiz (~(put by hiz) t.t.pax tel) - [[[ost %give +.sih] (spam t.t.pax tel)] +>.$] - == - == + ?. ?=(?(%fork %resp %txt %kyev) i.pax) !! + =+ abet:(pour:(se hid ost our.hid hiz t.pax) i.pax sih) + [-< +>.$(hiz ->)] -- From 9b627c6db1c7303ca953773d80362438a75b8307 Mon Sep 17 00:00:00 2001 From: Philip C Monk Date: Thu, 30 Oct 2014 21:54:54 -0400 Subject: [PATCH 25/31] refactored terminal --- main/app/shell/core.hook | 507 +++++++++++++++++++++--------------- main/app/terminal/core.hook | 4 +- 2 files changed, 292 insertions(+), 219 deletions(-) diff --git a/main/app/shell/core.hook b/main/app/shell/core.hook index d712bcf90f..0e75da762e 100644 --- a/main/app/shell/core.hook +++ b/main/app/shell/core.hook @@ -9,6 +9,14 @@ :::: structures :: |% :: +++ axle :: + $: pid=@u :: + pax=_`path`/=try= :: + act=(unit span) :: + pip=(map span span) :: + pop=(map span span) :: + var=(map term vase) :: + == :: ++ gift :: $% [%rush p=gilt] :: [%mean p=ares] :: @@ -23,6 +31,7 @@ $% [%term-line p=term-line] :: [%txt p=cord] :: == :: +++ glas $|(%out [%in p=cord]) :: ++ hapt ,[p=ship q=path] :: ++ move ,[p=bone q=(mold note gift)] :: ++ note :: @@ -119,184 +128,315 @@ -- -- !: -:::: program +:::: per event :: -|_ $: hid=hide - pid=@u - pax=_`path`/=try= - act=(unit span) - pip=(map span span) - pop=(map span span) - var=(map term vase) - == -:: -++ peer :: handle subscription - |= [ost=bone you=ship pax=path] - ^- [(list move) _+>] - ?~ pax `+>.$ - ?+ i.pax `+>.$ - %in :: to app - ?~ t.pax `+>.$ - ?. (~(has by cub.hid) i.t.pax) `+>.$ - ?: (~(has by pop) i.t.pax) `+>.$ - :_ +>.$(act `i.t.pax) - (print ost you ~) - %out :: to terminal - ?> ?=(~ t.pax) - :_ +>.$ - [ost %give %rush %term-line `term-line`[prompt ~ ~]]~ - == -:: -++ cubs :: tasks with open /in - %- sort :_ |=([a=span b=span] (lth (slav %ud a) (slav %ud b))) - ^- (list span) - %+ murn (~(tap by sup.hid)) - |= [@ @ a=path] - ?. ?& ?=([%in cord ~] a) - (~(has by cub.hid) i.t.a) - !(~(has by pop) i.t.a) - == - ~ - (some i.t.a) -:: -++ next-act :: rotate active task - =+ opt=[i=`(unit span)`~ t=(turn cubs |=(a=span `(unit span)`[~ a]))] - |- - ?~ t.opt ~ - ?: =(act i.opt) - i.t.opt - $(opt t.opt) -:: -++ poke-kyev :: handle key event - |= [ost=bone you=ship key=kyev] - ^- [(list move) _+>] - ?: ?=([~ @] key) (poke-txt ost you q.key) :: simple keypress - ?> ?=([[%ctrl ~ ~] @t] key) - ?+ q.key - :_ +>.$ - :- [ost %give %nice ~] - (print ost you leaf/"no command \\{(trip q.key)}" ~) - %x =. act next-act - :_ +>.$ - :- [ost %give %nice ~] - (print ost you ~) - %l =+ =- tak=rose/[" " "[" "]"]^(turn cubs -) - |= a=span - leaf/(trip (rap 3 (~(got by cub.hid) a) '(' a ')' ~)) - [[[ost give/nice/~] (print ost you tak ~)] +>.$] - == -:: -++ poke-txt :: handle command - |= [ost=bone you=ship txt=cord] - ^- [(list move) _+>] - ?: =('\\' (end 3 1 txt)) :: escaped ctrl-key - (poke-kyev ost you [%ctrl ~ ~] (rsh 3 1 txt)) - ?^ act :: pipe to child - :_ +>.$ - :- [ost %give %nice ~] - (spam /in/[u.act] %rush %txt txt) +|% +++ ve + |= [hid=hide ost=bone axle] + =* vat +<+> + =| mow=(list move) + |% + ++ abet + ^- [(list move) axle] + [(flop mow) vat] :: - =- :_ con - %+ welp (stash:con ost you txt) - ?~ tak - mof - %+ welp - (print:con ost you tak ~) - [[ost %give %nice ~] mof] - ^- [con=_+>.$ tak=$|(~ tank) mof=(list move)] - =+ pas=((full ~(parse from pax lat.hid)) [1 1] (trip txt)) - ?~ q.pas - [+>.$ leaf/"}>" ~] - =+ com=(wonk pas) - ^- [con=_+>.$ tak=$|(~ tank) mof=(list move)] - ?- -.com - %path - =. pax p.com - [+>.$ leaf/"=% {(spud p.com)}" ~] + ++ blab + |= mof=(list move) + +>.$(mow (welp mof mow)) :: - ?(%ins %mut %del) - :- +>.$ - =+ paf=[.(&3 '=')]:?+(-.com p.com %del p.com) - =- :- palm/[" " ~ ~ ~]^~[leaf/msg (dank:ut paf)] - (turn (drop tor) |=(a=toro [ost %pass writ/paf %c %info our.hid a])) - ^- [msg=tape tor=(unit toro)] - |- - ?- -.com - %ins - ?^ (file p.com) ["! exists" ~] - ["written" `(foal p.com q:(exec (fall q.com [%bczp atom/%t])))] - %mut - ?~ (file p.com) $(com [%del p.com]) - ["changed" `(foal p.com q:(exec q.com))] - %del - ?~ (file p.com) ["! none" ~] - ["written" `(fray p.com)] + ++ chew-file + |= [paf=path msg=tape tor=(unit toro)] + ^- (list move) + %+ welp + (print palm/[" " ~ ~ ~]^~[leaf/msg (dank:ut paf)]) + %+ turn (drop tor) + |=(a=toro [ost %pass writ/paf %c %info our.hid a]) + :: + ++ cubs :: tasks with open /in + %- sort :_ |=([a=span b=span] (lth (slav %ud a) (slav %ud b))) + ^- (list span) + %+ murn (~(tap by sup.hid)) + |= [@ @ a=path] + ?. ?& ?=([%in cord ~] a) + (~(has by cub.hid) i.t.a) + !(~(has by pop) i.t.a) + == + ~ + (some i.t.a) + :: + ++ eat + |= [you=ship com=coma] + ?- -.com + %path (eat-path +.com) + %ins (eat-ins +.com) + %mut (eat-mut +.com) + %del (eat-del +.com) + %run (eat-run you +.com) + %end (eat-end +.com) + %var (eat-var +.com) + %rvar (eat-rvar +.com) + %hoon (eat-hoon +.com) == :: - %run - =+ mof=(print ost you leaf/"+ :{(trip p.q.com)}" ~) + ++ eat-del + |= paf=path + ^+ +> + =. &3.paf '=' + %- blab + %+ chew-file paf + ?^ (file paf) ["! none" ~] + ["deleted" `(fray paf)] + :: + ++ eat-end + |= poc=(each ,@u cord) + ^+ +> + ?- -.poc + %& + =+ cil=(scot %ud p.poc) + =+ cin=(trip (~(got by cub.hid) cil)) + %+ blab + [ost %pass /child/[cil]/fork %g %cide cil] + (print leaf/"- :{cin}({(trip cil)})") + :: + %| + =+ ^- moz=(list move) + %+ murn (~(tap by cub.hid)) + |= [a=span b=term] + ?. =(b p.poc) ~ + %- some + [ost %pass /child/[a]/fork %g %cide a] + %- blab %+ welp moz + (print leaf/"-{<(lent moz)>} :{(trip p.poc)}") + == + :: + ++ eat-hoon + |= gen=twig + ^+ +> + (blab (print (sell (exec gen)))) + :: + ++ eat-ins + |= [paf=path gen=(unit twig)] + ^+ +> + =. &3.paf '=' + %- blab + %+ chew-file paf + ?^ (file paf) ["! exists" ~] + :- "written" + `(foal paf q:(exec (fall gen [%bczp atom/%t]))) + :: + ++ eat-mut + |= [paf=path gen=twig] + ^+ +> + =. &3.paf '=' + %- blab + %+ chew-file paf + ?^ (file paf) ["! none" ~] + ["changed" `(foal paf q:(exec gen))] + :: + ++ eat-path + |= paf=path + ^+ +> + =. pax paf + (blab (print leaf/"=% {(spud paf)}")) + :: + ++ eat-run + |= [you=ship mud=(list mand) mad=mand] + ^+ +> + =. +>.$ (blab (print leaf/"+ :{(trip p.mad)}")) =| inp=(unit span) - =< [+>.$ ~ mof] + =< +>.$ %+ reel - `(list mand)`(welp p.com q.com ~) + `(list mand)`(welp mud mad ~) =+ a=[app=*mand .] |. => a =+ cil=(scot %ud pid) - ::~& [%pipsqueak ] - %_ +> + %_ +> pid +(pid) pip ?~ inp pip (~(put by pip) cil u.inp) pop ?~ inp pop (~(put by pop) u.inp cil) inp `cil - mof + mow =+ yon=[our.hid cil imp.hid] =+ mez=[(cat 3 p.app '-args') (exec [%clsg q.app])] - =- (weld (flop -) mof) :: XX strange order + %- welp :_ mow ^- (list move) - :~ [ost %pass /child/[cil] %g %sire p.app cil] + :~ [ost %pass /child/[cil]/fork %g %sire p.app cil] [ost %pass /child/[cil]/out %g %show yon you /out] [ost %pass /child/[cil]/main %g %meta !>([%mess yon you mez])] == == :: - %end - ?: ?=(%& -.p.com) - =+ cil=(scot %ud p.p.com) - =+ cin=(trip (~(got by cub.hid) cil)) - :- +>.$ :- ~ - :_ (print ost you leaf/"- :{cin}({(trip cil)})" ~) - [ost %pass /child/[cil] %g %cide cil] - =* cil p.p.com - =- [+>.$ leaf/"-{<(lent moz)>} :{(trip cil)}" moz] - ^= moz - %+ murn (~(tap by cub.hid)) |= [a=span b=term] - ?. =(b cil) ~ - %- some - [ost %pass /child/[a] %g %cide a] + ++ eat-rvar + |= vor=term + ^+ +> + =+ mod=(~(has by var) vor) + =. var (~(del by var) vor) + (blab (print leaf/"{?:(mod "var gone" "no var")} {}")) :: - %var - =+ old=(~(get by var) p.com) - =+ new=(exec q.com) + ++ eat-var + |= [vor=term gen=twig] + ^+ +> + =+ old=(~(get by var) vor) + =+ new=(exec gen) =+ mod=?~(old "new var" ?:(=(new u.old) "same var" "changed")) - =. var (~(put by var) p.com new) - [+>.$ leaf/"{mod} {}" ~] + =. var (~(put by var) vor new) + (blab (print leaf/"{mod} {}")) :: - %rvar - =+ mod=(~(has by var) p.com) - =. var (~(del by var) p.com) - [+>.$ leaf/"{?:(mod "var gone" "no var")} {}" ~] + ++ exec + |= gen=twig + %- slap :_ gen + %+ roll (~(tap by var)) + =< .(q pit) + |= [[n=term v=vase] q=vase] + (slop [[%face n p.v] q.v] q) :: - %hoon - [+>.$ (sell (exec p.com)) ~] - == + ++ next-act :: rotate active task + =+ opt=[i=`(unit span)`~ t=(turn cubs |=(a=span `(unit span)`[~ a]))] + |- + ?~ t.opt ~ + ?: =(act i.opt) + i.t.opt + $(opt t.opt) + :: + ++ peer + |= [you=ship gal=glas] + ^+ +> + ?@ gal + %_ +>.$ + mow :_(mow [ost %give %rush %term-line prompt ~ ~]) + == + ?. (~(has by cub.hid) p.gal) +>.$ + ?: (~(has by pop) p.gal) +>.$ + =. act `p.gal + (blab ping) + :: + ++ ping (print-vase !>(*(list tank))) + ++ poke-kyev + |= [you=ship key=kyev] + ^+ +> + ?: ?=([~ @] key) (poke-txt you q.key) :: simple keypress ? + ?> ?=([[%ctrl ~ ~] @t] key) + ?+ q.key + %+ blab + [ost %give %nice ~] + (print leaf/"no command \\{(trip q.key)}") + %x =. act next-act + (blab [ost %give %nice ~] ping) + %l =+ =- tak=rose/[" " "[" "]"]^(turn cubs -) + |= a=span + leaf/(trip (rap 3 (~(got by cub.hid) a) '(' a ')' ~)) + (blab [ost give/nice/~] (print tak)) + == + :: + ++ poke-txt :: handle command + |= [you=ship txt=cord] + ^+ +> + ?: =('\\' (end 3 1 txt)) :: escaped ctrl-key + (poke-kyev you [%ctrl ~ ~] (rsh 3 1 txt)) + ?^ act :: pipe to child + %+ blab + [ost %give %nice ~] + (spam /in/[u.act] %rush %txt txt) + =+ pas=((full ~(parse from pax lat.hid)) [1 1] (trip txt)) + ?~ q.pas + (blab (print leaf/"}>")) + =+ com=(wonk pas) + => .(+>.$ (eat you com)) + =. +>.$ (blab (stash txt)) + +>.$(mow :_(mow [ost %give %nice ~])) + :: + ++ print |=(a=tank (print-vase !>(`(list tank)`[a ~]))) + ++ print-vase + |= tan=vase :: [p=p:!>(*(list tank)) q=*] + ^- (list move) + %^ spam /out %meta + :(slop !>(%rush) !>(%term-line) !>(prompt) !>(~) tan) + :: + ++ prompt + ^- @t + ?^ act + (rap 3 (~(got by cub.hid) u.act) '(' u.act ') ' ~) + ?. &(?=([@ @ @ *] pax) =('0' &3.pax)) + (rsh 3 1 (spat pax)) + (rap 3 &1.pax '/' &2.pax '=' ?~(|3.pax ~ [(spat |3.pax)]~)) + :: + ++ purr + |= [cil=span fom=?(%fork %out %main) typ=type sih=sign] + ^+ +> + ?< ?=(?(%sage %verb %veer %vega) +<.sih) + ?- fom + %fork + ?> ?=(%gone +<.sih) + %_ +>.$ + mow :_(mow [ost %give %nice ~]) + act ?:(=(act [~ cil]) ~ act) + == + :: + %main + ?> ?=(?(%nice %mean) +<.sih) + (blab [ost %give +.sih] ping) + :: + %out + ?. ?=(?(%rust %rush) +<.sih) +>.$ + %- blab + ?: (~(has by pip) cil) + (spam /in/(~(got by pip) cil) %meta (slot 3 typ sih)) + %- print-vase + ?+ p.sih + !>([(sell (slot 15 [typ sih]))]~) + %tang + (slot 15 [typ sih]) + %txt + ?^ q.sih !! :: move to vase space? + !>([leaf/(trip q.sih)]~) + == + == + :: + ++ spam + |= [pax=path gip=gift] + ^- (list move) + %+ turn + (~(tap in (~(get ju pus.hid) pax))) + |=(a=bone [a %give gip]) + :: + ++ stash + |= a=cord + %^ spam /out %meta + !>([%rush %term-line `term-line`[prompt [a]~ ~]]) + -- +-- +!: +:::: formal interface + :: +|_ [hid=hide vat=axle] +:: +++ peer :: handle subscription + |= [ost=bone you=ship pax=path] + ^- [(list move) _+>] + ?~ pax `+>.$ + ?. ?=(?(%in %out) i.pax) `+>.$ + =+ ^= gal + ?: ?=(%out i.pax) %out + [%in ?<(?=(~ t.pax) i.pax)] + =+ abet:(peer:(ve hid ost vat) you gal) + [-< +>.$(vat ->)] +:: +++ poke-kyev :: handle key event + |= [ost=bone you=ship key=kyev] + ^- [(list move) _+>] + =+ abet:(poke-kyev:(ve hid ost vat) you key) + [-< +>.$(vat ->)] +:: +++ poke-txt :: handle command + |= [ost=bone you=ship txt=cord] + ^- [(list move) _+>] + =+ abet:(poke-txt:(ve hid ost vat) you txt) + [-< +>.$(vat ->)] :: ++ purr |= [ost=bone pax=path typ=type sih=sign] ^- [(list move) _+>] - ::~& shel-purr/pax - :: ~& [%shell-pour -.sih (,@ta +<.sih)] - ::=+ sih=((hard sign) sih) ?: ?=(%sage +<.sih) :: vomit [[ost %give +.sih]~ +>.$] ?: ?=(%verb +<.sih) :: vomit @@ -306,74 +446,7 @@ ?: ?=(%vega +<.sih) :: vomit [[ost %give +.sih]~ +>.$] ?~ pax ~& %no-path !! - ?+ &1.pax ~& %strange-path !! - %print - `+>.$ - :: - %child - ?~ |1.pax ~& %no-child !! - ?~ |2.pax - ?> ?=(%gone +<.sih) - :- [ost %give %nice ~]~ - +>.$(act ?:(=(act [~ &2.pax]) ~ act)) - :_ +>.$ - ?+ &3.pax ~& %strange-child-path !! - %main - ?> ?=(?(%nice %mean) +<.sih) - :- [ost %give +.sih] - ::~& act - (print ost our.hid ~) - %out - ?. ?=(?(%rust %rush) +<.sih) ~ - ?: (~(has by pip) &2.pax) - :: ~& [%yay &2.pax ] - :: ~& [%spamming-to /in/(~(got by pip) &2.pax) (~(get ju pus.hid) /in/(~(got by pip) &2.pax))] - (spam /in/(~(got by pip) &2.pax) %meta (slot 3 typ sih)) - :: ~& [%nay &2.pax ] - %^ print-vase ost our.hid - ?+ p.sih - !>([(sell (slot 15 [typ sih]))]~) - %tang - (slot 15 [typ sih]) - %txt - ?^ q.sih !! :: move to vase space? - !>([leaf/(trip q.sih)]~) - == - == == -:: -++ stash - |= [a=bone b=ship c=cord] - ::~& shel-stash/[prompt c] - %^ spam /out %meta - !>([%rush %term-line `term-line`[prompt [c]~ ~]]) -:: -++ print |=([a=bone b=ship c=(list tank)] (print-vase a b !>(c))) -++ print-vase - |= [ost=bone you=ship tan=vase] :: [p=p:!>(*(list tank)) q=*] - ^- (list move) - ::~& shel-print/prompt - %^ spam /out %meta - :(slop !>(%rush) !>(%term-line) !>(prompt) !>(~) tan) -:: -++ prompt - ^- @t - ?^ act - (rap 3 (~(got by cub.hid) u.act) '(' u.act ') ' ~) - ?. &(?=([@ @ @ *] pax) =('0' &3.pax)) - (rsh 3 1 (spat pax)) - (rap 3 &1.pax '/' &2.pax '=' ?~(|3.pax ~ [(spat |3.pax)]~)) -++ exec - |= gen=twig - %- slap :_ gen - %+ roll (~(tap by var)) - =< .(q pit) - |= [[n=term v=vase] q=vase] - (slop [[%face n p.v] q.v] q) -:: -++ spam - |= [pax=path gip=gift] - ^- (list move) - %+ turn - (~(tap in (~(get ju pus.hid) pax))) - |=(a=bone [a %give gip]) + ?> ?=([%child span ?(%fork %out %main) ~] pax) + =+ abet:(purr:(ve hid ost vat) i.t.pax i.t.t.pax typ sih) + [-< +>.$(vat ->)] -- diff --git a/main/app/terminal/core.hook b/main/app/terminal/core.hook index 8e5d5c27d3..679311fedd 100644 --- a/main/app/terminal/core.hook +++ b/main/app/terminal/core.hook @@ -80,7 +80,7 @@ [ost %pass [%resp pax] %g %show [our [auc imp]] you /out]~ -- !: -:::: per-shell +:::: per shell :: |% ++ se @@ -216,7 +216,7 @@ -- -- !: -:::: public interface +:::: formal interface :: |_ [hid=hide axle] ++ peer From f2dea88245adf874e35690c34e88c3acc0cc228e Mon Sep 17 00:00:00 2001 From: Philip C Monk Date: Fri, 31 Oct 2014 20:53:11 -0400 Subject: [PATCH 26/31] prompting :begin seems to work... --- main/app/began/core.hook | 12 +- main/app/begin/core.hook | 361 +++++++++++++++++++++++++++++++++- main/app/grep/core.hook | 1 + main/app/shell/core.hook | 22 ++- main/sur/begin-args/gate.hook | 2 +- 5 files changed, 380 insertions(+), 18 deletions(-) diff --git a/main/app/began/core.hook b/main/app/began/core.hook index fb2c9e617e..3333f9ac2c 100644 --- a/main/app/began/core.hook +++ b/main/app/began/core.hook @@ -6,19 +6,19 @@ $% [%went p=ship q=cape] [%init p=@p] == == == +++ began-args ,[his=@p tic=@p eny=@t ges=gens] -- :: !: |_ [hid=hide %0 ust=bone his=@p mac=mace] -++ poke-begin-args - |= [ost=bone you=ship arg=begin-args] - =+ bur=(shax :(mix (jam ges.arg) eny.arg)) +++ poke-began-args + |= [ost=bone you=ship began-args] + =+ bur=(shax :(mix (jam ges) eny)) =+ loy=(bruw 2.048 bur) - :_ +>.$(ust ost, his his.arg, mac [0 sec:ex:loy]~) + :_ +>.$(ust ost, his his, mac [0 sec:ex:loy]~) :~ :* ost %pass /ticketing %a %want [our.hid (sein his)] /q/ta - his.arg tic.arg ges.arg pub:ex:loy + his tic ges pub:ex:loy == - [ost %give %nice ~] == :: ++ poke-will diff --git a/main/app/begin/core.hook b/main/app/begin/core.hook index 9dfc1c6bfe..b13f8b54b7 100644 --- a/main/app/begin/core.hook +++ b/main/app/begin/core.hook @@ -5,19 +5,370 @@ $% $: %g $% [%nice ~] [%mean p=ares] + [%rush %txt p=cord] == == == +++ form ,[his=@p tic=@p eny=@t ges=gens] +++ state + $? %begin %his %tic %eny %lag + %name %form %psect %pname %year + %govt %sect %fname %mname %nname + %lname %done + == -- :: !: -|_ [hid=hide ~] +|_ [hid=hide sat=state form] +++ done + |= ost=bone + :_ +>.$ + :~ :* ost %pass /to-gan %g %mess [our.hid /began] our.hid + %began-args !>([his tic eny ges]) + == + == +:: +++ loon + %+ cook + |= all=(list ,@t) + |- ^- @t + ?~ all %$ + ?~ t.all i.all + (cat 3 i.all (cat 3 ' ' $(all t.all))) + (most ace (cook |=(a=(list ,@) (rap 3 a)) (plus prn))) +:: +++ next + |= txt=cord + ^- [[cord (list cord)] _+>.$] + ?- sat + %begin [['Your ship: ~' ~] +>.$(sat %his)] + %his + =+ her=(rash txt fed:ag) + => .(-.q.ges (clan her)) + =+ ^= cow + |- ^- @ud + ?- -.q.ges + %czar 256 + %king (mul 255 $(-.q.ges %czar)) + %duke (mul 65.535 $(-.q.ges %king)) + %earl (mul (dec (bex 32)) $(-.q.ges %duke)) + %pawn (sub (bex 128) $(-.q.ges %earl)) + == + =+ ^= ves ^- tape + ?- -.q.ges + %czar "carriers" + %king "cruisers" + %duke "destroyers" + %earl "yachts" + %pawn "submarines" + == + :_ ^+ +>.$ +>.$(his (rash txt fed:ag), sat %tic) + :- 'Your ticket: ~' + %- lore %- crip + """ + + Launching {}, one of {} Urbit {ves}... + + If I did not build for myself + for whom should I build? + + -- Bunting, _Chomei at Toyama_ + + Let's configure your identity. Warning - it's nontrivial to + change this data once you've sent it to the server. If you enter + something wrong, hit ^D to cancel, then run the program again. + + """ + :: + %tic + :_ +>.$(tic (rash txt fed:ag), sat %eny) + :- 'Entropy: ' + %- lore %- crip + """ + + Enter a passphrase or other unusual text. You (or your enemies) + can regenerate your ship from this entropy. + + """ + :: + %eny + :_ +>.$(eny (rash txt (boss 256 (more gon qit))), sat %lag) + :- 'Language: ' + %- lore %- crip + """ + + What language would your ship rather speak? Enter it as a + two-letter (ISO 639-1) code, like "en" for English. Whatever + language you pick, it'll all be English now, but in future + we'll be more sensitive to your needs. + + """ + :: + %lag + =+ ^= par + %+ sear + |= [a=@ b=@] + ^- (unit ,@ta) + =+ c=(cat 3 a b) + =+(d=(glon c) ?~(d ~ [~ c])) + ;~(plug low low) + ?. ?=(%duke -.q.ges) + :_ +>.$(p.ges (rash txt par), sat %name) + ['Name: ' ~] + :_ +>.$(p.ges (rash txt par), sat %form) + :- 'Form: ' + %- lore %- crip + """ + + Please select one of the pre-chosen forms: + + %lady female-identified individual + %lord male-identified individual + %punk opaque handle + %anon totally anonymous + + """ + :: + %name + ?> ?=(?(%earl %king) -.q.ges) + =+ nam=(rash txt (boss 256 (more gon qit))) + =+ gos=?-(-.q.ges %earl [%earl nam], %king [%king nam]) + :_ +>.$(q.ges gos, sat %done) + ['' ~] + :: + %form + ^- [[cord (list cord)] _+>.$] + =+ ^= par + ;~ pose + (jest %anon) + (jest %lady) + (jest %lord) + (jest %punk) + == + =+ fom=(rash txt par) + ?+ fom !! + %anon [['' ~] +>.$(q.ges [%duke %anon ~], sat %done)] + %punk + :_ +>.$(q.ges [%duke %punk *sect ''], sat %pname) + ['Handle: ' ~] + ?(%lady %lord) + =+ wat=?-(fom %lady [%lady *whom], %lord [%lord *whom]) + :_ +>.$(q.ges `gcos`[%duke wat], sat %year) + :- 'Year you were born: ' + %- lore %- crip + """ + + You've selected a personal identity. For a %lord or a %lady, + please use your real name only. If you'd prefer a fictitious + handle, you can hit ^D and start over as a %punk. Or you can + use %anon and go by your ship name alone. + + As a real person, we're going to ask you for a little bit of + personal information - not enough to compromise your privacy, + just enough to make everyone on Urbit feel like a neighbor. + + What we're going to ask you for is information that's (a) + public (would be obvious, or at least easy to guess, for + someone who met you in person); (b) durable (doesn't change + often); and (c) relevant (helps you connect with friends). + + For example, we'll ask for the year (not day) you were born, + because your age is easy to guess in person, doesn't change, + and has a big effect on how people perceive you. + + """ + == + :: + %pname + :_ +>.$(q.ges [%duke %punk *sect (rash txt loon)], sat %psect) + :- 'Banner: %' + %- lore %- crip + """ + + One basic human instinct is the urge to form political tribes. + In a network that fights this need, these tribes form anyway and + they form badly. Urbit designs them into the infrastructure. + Inspired by the Qing Dynasty, you'll align yourself with one of + five colored "banners" - %red, %blue, %orange, %black or %white. + + Political discourse across tribal boundaries is almost always an + antisocial act - less communication, than symbolic violence. In + Urbit, messages marked political stay within your own banner; + your friends in other banners simply won't see them. Between + banners, politics doesn't erode apolitical relationships; inside + each banner, political discourse is harmonious and productive. + + Pick a banner by the adjective you feel best describes you: + + %red far left: radical, anarchist + %blue center-left: moderate, liberal + %orange center-right: conservative, libertarian + %black far right: traditionalist, reactionary + + Or if digital agitation isn't your cup of tea, choose %white, and + your Urbit experience will remain politics-free. + + """ + :: + %psect + ?> ?=(%duke -.q.ges) + ?> ?=(%punk -.p.q.ges) + =+ ^= par + ;~ pose + (jest %white) + (jest %blue) + (jest %red) + (jest %black) + (jest %orange) + == + :- ['' ~] + %= +>.$ + q.ges [%duke %punk ((hard sect) (rash txt par)) q.p.q.ges] + sat %done + == + :: + %year + ?> ?=(%duke -.q.ges) + ?> ?=(?(%lord %lady) -.p.q.ges) + =+ woh=`whom`[(rash txt dim:ag) *govt *sect *name] + =+ wat=`what`?-(-.p.q.ges %lord [%lord woh], %lady [%lady woh]) + :_ +>.$(q.ges [%duke wat], sat %govt) + :- 'Location (e.g. us/94103):' + %- lore %- crip + """ + + Where are you? This is totally optional, but we'd like to + know your vague general location. You can enter nothing at + all, just a country code, or country and postal code. + + """ + :: + %govt + ?> ?=(%duke -.q.ges) + ?> ?=(?(%lord %lady) -.p.q.ges) + =+ ^= par + ;~ pose + ;~ plug (cook |=([a=@ b=@] (cat 3 a b)) ;~(plug low low)) + ;~ pfix fas + %+ cook + |=(a=tape (rap 3 ^-((list ,@) a))) + (star ;~(pose hig hep nud)) + == + (easy ~) + == + == + =+ woh=`whom`[p.p.p.q.ges (rash txt par) *sect *name] + =+ wat=`what`?-(-.p.q.ges %lord [%lord woh], %lady [%lady woh]) + :_ +>.$(q.ges [%duke wat], sat %sect) + :- 'Banner: %' + %- lore %- crip + """ + + One basic human instinct is the urge to form political tribes. + In a network that fights this need, these tribes form anyway and + they form badly. Urbit designs them into the infrastructure. + Inspired by the Qing Dynasty, you'll align yourself with one of + five colored "banners" - %red, %blue, %orange, %black or %white. + + Political discourse across tribal boundaries is almost always an + antisocial act - less communication, than symbolic violence. In + Urbit, messages marked political stay within your own banner; + your friends in other banners simply won't see them. Between + banners, politics doesn't erode apolitical relationships; inside + each banner, political discourse is harmonious and productive. + + Pick a banner by the adjective you feel best describes you: + + %red far left: radical, anarchist + %blue center-left: moderate, liberal + %orange center-right: conservative, libertarian + %black far right: traditionalist, reactionary + + Or if digital agitation isn't your cup of tea, choose %white, and + your Urbit experience will remain politics-free. + + """ + :: + %sect + ?> ?=(%duke -.q.ges) + ?> ?=(?(%lord %lady) -.p.q.ges) + =+ ^= par + ;~ pose + (jest %white) + (jest %blue) + (jest %red) + (jest %black) + (jest %orange) + == + =+ woh=`whom`[p.p.p.q.ges q.p.p.q.ges (sect (rash txt par)) *name] + =+ wat=`what`?-(-.p.q.ges %lord [%lord woh], %lady [%lady woh]) + :_ +>.$(q.ges [%duke wat], sat %fname) + ['First name: ' ~] + :: + %fname + ?> ?=(%duke -.q.ges) + ?> ?=(?(%lord %lady) -.p.q.ges) + =+ nam=[(rash txt loon) *(unit ,@t) *(unit ,@t) *@t] + =+ woh=`whom`[p.p.p.q.ges q.p.p.q.ges r.p.p.q.ges nam] + =+ wat=`what`?-(-.p.q.ges %lord [%lord woh], %lady [%lady woh]) + :_ +>.$(q.ges [%duke wat], sat %mname) + ['Middle name (or blank): ' ~] + :: + %mname + ?> ?=(%duke -.q.ges) + ?> ?=(?(%lord %lady) -.p.q.ges) + =+ uni=(rash txt ;~(pose (stag ~ loon) (easy ~))) + =+ nam=[p.s.p.p.q.ges uni *(unit ,@t) *@t] + =+ woh=`whom`[p.p.p.q.ges q.p.p.q.ges r.p.p.q.ges nam] + =+ wat=`what`?-(-.p.q.ges %lord [%lord woh], %lady [%lady woh]) + :_ +>.$(q.ges [%duke wat], sat %nname) + ['Nickname/handle (or blank): ' ~] + :: + %nname + ?> ?=(%duke -.q.ges) + ?> ?=(?(%lord %lady) -.p.q.ges) + =+ uni=(rash txt ;~(pose (stag ~ loon) (easy ~))) + =+ nam=[p.s.p.p.q.ges q.s.p.p.q.ges uni *@t] + =+ woh=`whom`[p.p.p.q.ges q.p.p.q.ges r.p.p.q.ges nam] + =+ wat=`what`?-(-.p.q.ges %lord [%lord woh], %lady [%lady woh]) + :_ +>.$(q.ges [%duke wat], sat %lname) + ['Last name: ' ~] + :: + %lname + ?> ?=(%duke -.q.ges) + ?> ?=(?(%lord %lady) -.p.q.ges) + =+ nam=[p.s.p.p.q.ges q.s.p.p.q.ges r.s.p.p.q.ges (rash txt loon)] + =+ woh=`whom`[p.p.p.q.ges q.p.p.q.ges r.p.p.q.ges nam] + =+ wat=`what`?-(-.p.q.ges %lord [%lord woh], %lady [%lady woh]) + :_ +>.$(q.ges [%duke wat], sat %done) + ['' ~] + :: + %done !! + == +:: ++ poke-begin-args |= [ost=bone you=ship arg=begin-args] + =^ res +>.$ ^- [[pot=cord tak=(list cord)] _+>.$] (next(sat %begin) '') :_ +>.$ - [ost %pass /to-gan %g %mess [our.hid /began] you %begin-args !>(arg)]~ + %+ welp + :~ [ost %pass /in %g %show [our.hid +.imp.hid] you /in/[-.imp.hid]] + [ost %give %nice ~] + == + %+ welp + (spam %rush %prompt pot.res) + %- zing + (turn tak.res |=(a=cord (spam %rush %txt a))) :: ++ pour |= [ost=bone pax=path sih=*] =+ sih=((hard sign) sih) + ?: ?=([%in ~] pax) + ?. ?=(%rush +<.sih) `+>.$ + =^ res +>.$ ^- [[pot=cord tak=(list cord)] _+>.$] (next p.sih) + ?: ?=(%done sat) + (done ost) + :_ +>.$ + %+ welp (spam %rush %prompt pot.res) + %- zing + (turn tak.res |=(a=cord (spam %rush %txt a))) :_ +>.$ :- [ost %give +.sih] %+ turn (~(tap by sup.hid)) @@ -30,4 +381,10 @@ |= * `+> +:: +++ spam + |* git=* + %+ turn + (~(tap in (~(get ju pus.hid) /out))) + |=(a=bone [a %give git]) -- diff --git a/main/app/grep/core.hook b/main/app/grep/core.hook index 2132fd2dc1..ce47360382 100644 --- a/main/app/grep/core.hook +++ b/main/app/grep/core.hook @@ -29,6 +29,7 @@ %nice [ost %give %nice ~]~ %rush + %+ weld (spam %rush %prompt 'searching for {}...') %- spam ?- &3.sih %txt diff --git a/main/app/shell/core.hook b/main/app/shell/core.hook index 8a771d1a15..89a6726be6 100644 --- a/main/app/shell/core.hook +++ b/main/app/shell/core.hook @@ -10,12 +10,13 @@ :: |% :: ++ axle :: - $: pid=@u :: - pax=_`path`/=try= :: - act=(unit span) :: - pip=(map span span) :: - pop=(map span span) :: - var=(map term vase) :: + $: pid=@u :: next process id + pax=_`path`/=try= :: working directory + act=(unit span) :: active child + pip=(map span span) :: pipe out->in + pop=(map span span) :: pipe in->out + pot=(map span cord) :: prompts + var=(map term vase) :: variables == :: ++ gift :: $% [%rush p=gilt] :: @@ -190,7 +191,7 @@ ?^ (file paf) ["! none" ~] ["deleted" `(fray paf)] :: - ++ eat-end + ++ eat-end :: XX clean up state |= poc=(each ,@u cord) ^+ +> ?- -.poc @@ -359,6 +360,8 @@ ++ prompt ^- @t ?^ act + =+ por=(~(get by pot) u.act) + ?^ por u.por (rap 3 (~(got by cub.hid) u.act) '(' u.act ') ' ~) ?. &(?=([@ @ @ *] pax) =('0' &3.pax)) (rsh 3 1 (spat pax)) @@ -385,11 +388,12 @@ %- blab ?: (~(has by pip) cil) (spam /in/(~(got by pip) cil) %meta (slot 3 typ sih)) + ?: ?=(%prompt p.sih) + ping(pot (~(put by pot) cil (cord q.sih))) %- print-vase ?+ p.sih !>([(sell (slot 15 [typ sih]))]~) - %tang - (slot 15 [typ sih]) + %tang (slot 15 [typ sih]) %txt ?^ q.sih !! :: move to vase space? !>([leaf/(trip q.sih)]~) diff --git a/main/sur/begin-args/gate.hook b/main/sur/begin-args/gate.hook index 7de1ef7a8c..476e9abed0 100644 --- a/main/sur/begin-args/gate.hook +++ b/main/sur/begin-args/gate.hook @@ -1 +1 @@ -,[his=@p tic=@p eny=@t ges=gens ~] +(list) From b2fb76dbd9c62829ca0c7ab9f32c68df22d9aa3d Mon Sep 17 00:00:00 2001 From: Philip C Monk Date: Mon, 3 Nov 2014 16:17:57 -0500 Subject: [PATCH 27/31] some begin stuff --- main/app/begin/core.hook | 139 ++++++++++++++++++++++++++++++++++++++- 1 file changed, 137 insertions(+), 2 deletions(-) diff --git a/main/app/begin/core.hook b/main/app/begin/core.hook index b13f8b54b7..16827c9b45 100644 --- a/main/app/begin/core.hook +++ b/main/app/begin/core.hook @@ -345,8 +345,143 @@ == :: ++ poke-begin-args - |= [ost=bone you=ship arg=begin-args] - =^ res +>.$ ^- [[pot=cord tak=(list cord)] _+>.$] (next(sat %begin) '') + |= [ost=bone you=ship arg=(list)] + =^ sot +>.$ + ?~ arg [%begin +>.$] + =+ ((soft ,@p) i.arg) + ?~ - [%begin +>.$] + =. his u.- + ?~ t.arg [%his +>.$] + =+ ((soft ,@p) i.t.arg) + ?~ - [%his +>.$] + =. tic u.- + ?~ t.t.arg [%tic +>.$] + =+ ((soft ,@t) i.t.t.arg) + ?~ - [%tic +>.$] + =. eny u.- + ?~ t.t.t.arg [%eny +>.$] + =+ ((soft lang) i.t.t.t.arg) + ?~ - [%eny +>.$] + ?~ (glon u.-) [%eny +>.$] + =. p.ges u.- + =+ ran=(clan his) + =* sec t.t.t.t.arg + ?~ sec [%lag +>.$] + ?- ran + ?(%czar %pawn) %begin + ?(%king %earl) + =+ ((soft ,@t) i.sec) + ?~ - [%lag +>.$] + =. q.ges + ?- ran + %king [%king u.-] + %earl [%earl u.-] + == + [%done +>.$] + :: + %duke + =+ ((soft ?(%anon %lady %lord %punk)) i.sec) + ?~ - [%lag +>.$] + ?- u.- + %anon + =. q.ges [%duke %anon ~] + [%done +>.$] + :: + %punk + ?~ t.sec [%form +>.$] + =+ ((soft ,@t) i.t.sec) + ?~ - [%form +>.$] + =. q.ges [%duke %punk *sect u.-] + ?~ t.t.sec [%pname +>.$] + =+ ((soft sect) i.t.t.sec) + ?~ - [%pname +>.$] + ?> ?=(%duke -.q.ges) + ?> ?=(%punk -.p.q.ges) + =. q.ges [%duke %punk u.- q.p.q.ges] + [%done +>.$] + :: + ?(%lady %lord) + =. q.ges + ^- gcos + :- %duke + ?- u.- + %lady [%lady *whom] + %lord [%lord *whom] + == + ?~ t.sec [%form +>.$] + =+ ((soft ,@ud) i.t.sec) + ?~ - [%form +>.$] + =+ ^= wat + =+ woh=`whom`[u.- *govt *sect *name] + ?> ?=(%duke -.q.ges) + ?> ?=(?(%lady %lord) -.p.q.ges) + `what`?-(-.p.q.ges %lord [%lord woh], %lady [%lady woh]) + =. q.ges `gcos`[%duke wat] + ?~ t.t.sec [%year +>.$] + =+ ((soft govt) i.t.t.sec) + ?~ - [%year +>.$] + =+ ^= wat + ?> ?=(%duke -.q.ges) + ?> ?=(?(%lady %lord) -.p.q.ges) + =+ woh=`whom`[p.p.p.q.ges u.- *sect *name] + `what`?-(-.p.q.ges %lord [%lord woh], %lady [%lady woh]) + =. q.ges [%duke wat] + ?~ t.t.t.sec [%govt +>.$] + =+ ((soft sect) i.t.t.t.sec) + ?~ - [%govt +>.$] + =+ ^= wat + ?> ?=(%duke -.q.ges) + ?> ?=(?(%lady %lord) -.p.q.ges) + =+ woh=`whom`[p.p.p.q.ges q.p.p.q.ges u.- *name] + `what`?-(-.p.q.ges %lord [%lord woh], %lady [%lady woh]) + =. q.ges [%duke wat] + =+ nam=((hard (list)) |8.arg) + ?~ nam [%sect +>.$] + =+ ((soft ,@t) i.nam) + ?~ - [%sect +>.$] + =+ ^= wat + ?> ?=(%duke -.q.ges) + ?> ?=(?(%lady %lord) -.p.q.ges) + =+ nym=`name`[u.- *(unit ,@t) *(unit ,@t) *@t] + =+ woh=`whom`[p.p.p.q.ges q.p.p.q.ges r.p.p.q.ges nym] + `what`?-(-.p.q.ges %lord [%lord woh], %lady [%lady woh]) + ~! nama=nam + =. q.ges `gcos`[%duke wat] + ~! namb=nam + ?~ t.nam [%fname +>.$] + =+ ((soft (unit ,@t)) i.t.nam) + ?~ - [%fname +>.$] + =+ ^= wat + ?> ?=(%duke -.q.ges) + ?> ?=(?(%lady %lord) -.p.q.ges) + =+ nym=[p.s.p.p.q.ges u.- *(unit ,@t) *@t] + =+ woh=`whom`[p.p.p.q.ges q.p.p.q.ges r.p.p.q.ges nym] + `what`?-(-.p.q.ges %lord [%lord woh], %lady [%lady woh]) + =. q.ges [%duke wat] + ?~ t.t.nam [%mname +>.$] + =+ ((soft (unit ,@t)) i.t.t.nam) + ?~ - [%mname +>.$] + =+ ^= wat + ?> ?=(%duke -.q.ges) + ?> ?=(?(%lady %lord) -.p.q.ges) + =+ nym=[p.s.p.p.q.ges q.s.p.p.q.ges u.- *@t] + =+ woh=`whom`[p.p.p.q.ges q.p.p.q.ges r.p.p.q.ges nym] + `what`?-(-.p.q.ges %lord [%lord woh], %lady [%lady woh]) + =. q.ges [%duke wat] + ?~ t.t.t.nam [%nname +>.$] + =+ ((soft ,@t) i.t.t.t.nam) + ?~ - [%nname +>.$] + =+ ^= wat + ?> ?=(%duke -.q.ges) + ?> ?=(?(%lady %lord) -.p.q.ges) + =+ nym=[p.s.p.p.q.ges q.s.p.p.q.ges r.s.p.p.q.ges u.-] + =+ woh=`whom`[p.p.p.q.ges q.p.p.q.ges r.p.p.q.ges nym] + `what`?-(-.p.q.ges %lord [%lord woh], %lady [%lady woh]) + =. q.ges [%duke wat] + [%done +>.$] + == + == + =^ res +>.$ ^- [[pot=cord tak=(list cord)] _+>.$] (next(sat sot) '') :_ +>.$ %+ welp :~ [ost %pass /in %g %show [our.hid +.imp.hid] you /in/[-.imp.hid]] From 36ef1778ca9882cee099699400189ebca2013696 Mon Sep 17 00:00:00 2001 From: Philip C Monk Date: Wed, 5 Nov 2014 14:39:00 -0500 Subject: [PATCH 28/31] fixed some ordering issues --- arvo/dill.hoon | 2 +- main/app/begin/core.hook | 13 ++++++++++--- 2 files changed, 11 insertions(+), 4 deletions(-) diff --git a/arvo/dill.hoon b/arvo/dill.hoon index 9f97c77358..f6ea0b7d52 100644 --- a/arvo/dill.hoon +++ b/arvo/dill.hoon @@ -365,7 +365,7 @@ ?(%rush %rust) :: XX reset prompt ?> ?=(%term-line +>-.sih) =. +>.$ - =- (furl (zing (turn r.q.sih -))) + =- (furl (zing (turn (flop r.q.sih) -))) |= a=tark ^- wall ?+ -.a (~(win re a) 0 p.q.yar) diff --git a/main/app/begin/core.hook b/main/app/begin/core.hook index 16827c9b45..7d9b7dac4d 100644 --- a/main/app/begin/core.hook +++ b/main/app/begin/core.hook @@ -39,7 +39,14 @@ |= txt=cord ^- [[cord (list cord)] _+>.$] ?- sat - %begin [['Your ship: ~' ~] +>.$(sat %his)] + %begin + :_ +>.$(sat %his) + :- 'Your ship: ~' + %- lore %- crip + """ + Do you have a ship and a ticket? If not, please ask + urbit@urbit.org for one. + """ %his =+ her=(rash txt fed:ag) => .(-.q.ges (clan her)) @@ -490,7 +497,7 @@ %+ welp (spam %rush %prompt pot.res) %- zing - (turn tak.res |=(a=cord (spam %rush %txt a))) + (turn (flop tak.res) |=(a=cord (spam %rush %txt a))) :: ++ pour |= [ost=bone pax=path sih=*] @@ -503,7 +510,7 @@ :_ +>.$ %+ welp (spam %rush %prompt pot.res) %- zing - (turn tak.res |=(a=cord (spam %rush %txt a))) + (turn (flop tak.res) |=(a=cord (spam %rush %txt a))) :_ +>.$ :- [ost %give +.sih] %+ turn (~(tap by sup.hid)) From 0c1037cbeb5cc843551832983511e55cff5fcc99 Mon Sep 17 00:00:00 2001 From: Philip C Monk Date: Wed, 5 Nov 2014 15:35:36 -0500 Subject: [PATCH 29/31] various shell/terminal fixes --- main/app/begin/core.hook | 2 +- main/app/shell/core.hook | 12 +++++++----- main/app/terminal/core.hook | 2 +- 3 files changed, 9 insertions(+), 7 deletions(-) diff --git a/main/app/begin/core.hook b/main/app/begin/core.hook index 7d9b7dac4d..456af41f0a 100644 --- a/main/app/begin/core.hook +++ b/main/app/begin/core.hook @@ -72,7 +72,7 @@ %- lore %- crip """ - Launching {}, one of {} Urbit {ves}... + Launching {(scow %p her)}, one of {} Urbit {ves}... If I did not build for myself for whom should I build? diff --git a/main/app/shell/core.hook b/main/app/shell/core.hook index 89a6726be6..7a631892ce 100644 --- a/main/app/shell/core.hook +++ b/main/app/shell/core.hook @@ -246,7 +246,7 @@ ++ eat-run |= [you=ship mud=(list mand) mad=mand] ^+ +> - =. +>.$ (blab (print leaf/"+ :{(trip p.mad)}")) + :: =. +>.$ (blab (print leaf/"+ :{(trip p.mad)}")) =| inp=(unit span) =< +>.$ %+ reel @@ -365,7 +365,7 @@ (rap 3 (~(got by cub.hid) u.act) '(' u.act ') ' ~) ?. &(?=([@ @ @ *] pax) =('0' &3.pax)) (rsh 3 1 (spat pax)) - (rap 3 &1.pax '/' &2.pax '=' ?~(|3.pax ~ [(spat |3.pax)]~)) + (rap 3 &1.pax '/' &2.pax '=' ?~(|3.pax ~['> '] ~[(spat |3.pax) '> '])) :: ++ purr |= [cil=span fom=?(%fork %out %main) typ=type sih=sign] @@ -385,11 +385,13 @@ :: %out ?. ?=(?(%rust %rush) +<.sih) +>.$ + ?: ?=(%prompt p.sih) + ?: (~(has by pip) cil) +>.$ + =. pot (~(put by pot) cil (cord q.sih)) + (blab ping) %- blab ?: (~(has by pip) cil) (spam /in/(~(got by pip) cil) %meta (slot 3 typ sih)) - ?: ?=(%prompt p.sih) - ping(pot (~(put by pot) cil (cord q.sih))) %- print-vase ?+ p.sih !>([(sell (slot 15 [typ sih]))]~) @@ -425,7 +427,7 @@ ?. ?=(?(%in %out) i.pax) `+>.$ =+ ^= gal ?: ?=(%out i.pax) %out - [%in ?<(?=(~ t.pax) i.pax)] + [%in ?<(?=(~ t.pax) i.t.pax)] =+ abet:(peer:(ve hid ost vat) you gal) [-< +>.$(vat ->)] :: diff --git a/main/app/terminal/core.hook b/main/app/terminal/core.hook index 679311fedd..429ebc359b 100644 --- a/main/app/terminal/core.hook +++ b/main/app/terminal/core.hook @@ -165,7 +165,7 @@ ?+ +<.sih !! %nice +>.$ ?(%rust %rush) - =. p.q.sih ?^(q.q.sih p.tel (cat 3 p.q.sih '> ')) :: XX prompt hack + =. p.q.sih ?^(q.q.sih p.tel p.q.sih) :: XX prompt hack %_ +>.$ mow (welp (spam q.sih) mow) tel [p.q.sih (weld q.q.sih q.tel) (weld r.q.sih r.tel)] From 55fa6d0408fe7f9dbca60b43f9a3c411cb8276f0 Mon Sep 17 00:00:00 2001 From: Philip C Monk Date: Wed, 5 Nov 2014 17:40:18 -0500 Subject: [PATCH 30/31] added different password prompt mode --- arvo/dill.hoon | 14 +++++------ arvo/ford.hoon | 3 +-- main/app/begin/core.hook | 49 +++++++++++++++++++----------------- main/app/shell/core.hook | 9 ++++--- main/app/terminal/core.hook | 4 +-- main/mar/term-line/door.hook | 2 +- main/sur/term-line/gate.hook | 2 +- 7 files changed, 43 insertions(+), 40 deletions(-) diff --git a/arvo/dill.hoon b/arvo/dill.hoon index f6ea0b7d52..732aa971f3 100644 --- a/arvo/dill.hoon +++ b/arvo/dill.hoon @@ -114,7 +114,7 @@ [%res p=span] :: [%cmd p=char] :: == == :: -++ term-line ,[p=cord q=(list cord) r=(list tark)] :: +++ term-line ,[p=[p=cord q=prom] q=(list cord) r=(list tark)] ++ tark ?(tank [%stem p=tank q=tank]) :: :::::::: :: dill tiles ++ bein :: terminal control @@ -379,20 +379,20 @@ ?: &(?=(^ q.q.yar) =(/ hux.u.q.q.yar)) %= u.q.q.yar hyt [+(p.hyt) [%$ q.hyt]] - pot (trip p.q.sih) - pol (met 3 p.q.sih) - buy %text + pot (trip p.p.q.sih) + pol (met 3 p.p.q.sih) + buy q.p.q.sih == %_ bed bul 0 bus 0 but ~ - buy %text + buy q.p.q.sih hux / hiz 0 hyt [+(p.hyt) [%$ q.hyt]] - pot (trip p.q.sih) - pol (met 3 p.q.sih) + pot (trip p.p.q.sih) + pol (met 3 p.p.q.sih) == :: %sage :: write a jamfile diff --git a/arvo/ford.hoon b/arvo/ford.hoon index a75ba3b049..b5ebeb90ac 100644 --- a/arvo/ford.hoon +++ b/arvo/ford.hoon @@ -804,8 +804,7 @@ |= [cof=cafe vax=vase gen=twig] =+ puz=(mule |.((~(mint ut p.vax) [%noun gen]))) ?- -.puz - | ~& [%maim-fail p.puz] - (flaw cof p.puz) + | (flaw cof p.puz) & %+ (coup cof) (mock [q.vax q.p.puz] (mole ska)) |= val=* `vase`[p.p.puz val] diff --git a/main/app/begin/core.hook b/main/app/begin/core.hook index 456af41f0a..e2d017eb7b 100644 --- a/main/app/begin/core.hook +++ b/main/app/begin/core.hook @@ -37,11 +37,11 @@ :: ++ next |= txt=cord - ^- [[cord (list cord)] _+>.$] + ^- [[[cord prom] (list cord)] _+>.$] ?- sat %begin :_ +>.$(sat %his) - :- 'Your ship: ~' + :- ['Your ship: ~' %text] %- lore %- crip """ Do you have a ship and a ticket? If not, please ask @@ -68,7 +68,7 @@ %pawn "submarines" == :_ ^+ +>.$ +>.$(his (rash txt fed:ag), sat %tic) - :- 'Your ticket: ~' + :- ['Your ticket: ~' %text] %- lore %- crip """ @@ -87,7 +87,7 @@ :: %tic :_ +>.$(tic (rash txt fed:ag), sat %eny) - :- 'Entropy: ' + :- ['Entropy: ' %pass] %- lore %- crip """ @@ -98,7 +98,7 @@ :: %eny :_ +>.$(eny (rash txt (boss 256 (more gon qit))), sat %lag) - :- 'Language: ' + :- ['Language: ' %text] %- lore %- crip """ @@ -119,9 +119,9 @@ ;~(plug low low) ?. ?=(%duke -.q.ges) :_ +>.$(p.ges (rash txt par), sat %name) - ['Name: ' ~] + [['Name: ' %text] ~] :_ +>.$(p.ges (rash txt par), sat %form) - :- 'Form: ' + :- ['Form: ' %text] %- lore %- crip """ @@ -139,10 +139,9 @@ =+ nam=(rash txt (boss 256 (more gon qit))) =+ gos=?-(-.q.ges %earl [%earl nam], %king [%king nam]) :_ +>.$(q.ges gos, sat %done) - ['' ~] + [['' %text] ~] :: %form - ^- [[cord (list cord)] _+>.$] =+ ^= par ;~ pose (jest %anon) @@ -152,14 +151,14 @@ == =+ fom=(rash txt par) ?+ fom !! - %anon [['' ~] +>.$(q.ges [%duke %anon ~], sat %done)] + %anon [[['' %text] ~] +>.$(q.ges [%duke %anon ~], sat %done)] %punk :_ +>.$(q.ges [%duke %punk *sect ''], sat %pname) - ['Handle: ' ~] + [['Handle: ' %text] ~] ?(%lady %lord) =+ wat=?-(fom %lady [%lady *whom], %lord [%lord *whom]) :_ +>.$(q.ges `gcos`[%duke wat], sat %year) - :- 'Year you were born: ' + :- ['Year you were born: ' %text] %- lore %- crip """ @@ -186,7 +185,7 @@ :: %pname :_ +>.$(q.ges [%duke %punk *sect (rash txt loon)], sat %psect) - :- 'Banner: %' + :- ['Banner: %' %text] %- lore %- crip """ @@ -226,7 +225,7 @@ (jest %black) (jest %orange) == - :- ['' ~] + :- [['' %text] ~] %= +>.$ q.ges [%duke %punk ((hard sect) (rash txt par)) q.p.q.ges] sat %done @@ -238,7 +237,7 @@ =+ woh=`whom`[(rash txt dim:ag) *govt *sect *name] =+ wat=`what`?-(-.p.q.ges %lord [%lord woh], %lady [%lady woh]) :_ +>.$(q.ges [%duke wat], sat %govt) - :- 'Location (e.g. us/94103):' + :- ['Location (e.g. us/94103):' %text] %- lore %- crip """ @@ -265,7 +264,7 @@ =+ woh=`whom`[p.p.p.q.ges (rash txt par) *sect *name] =+ wat=`what`?-(-.p.q.ges %lord [%lord woh], %lady [%lady woh]) :_ +>.$(q.ges [%duke wat], sat %sect) - :- 'Banner: %' + :- ['Banner: %' %text] %- lore %- crip """ @@ -308,7 +307,7 @@ =+ woh=`whom`[p.p.p.q.ges q.p.p.q.ges (sect (rash txt par)) *name] =+ wat=`what`?-(-.p.q.ges %lord [%lord woh], %lady [%lady woh]) :_ +>.$(q.ges [%duke wat], sat %fname) - ['First name: ' ~] + [['First name: ' %text] ~] :: %fname ?> ?=(%duke -.q.ges) @@ -317,7 +316,7 @@ =+ woh=`whom`[p.p.p.q.ges q.p.p.q.ges r.p.p.q.ges nam] =+ wat=`what`?-(-.p.q.ges %lord [%lord woh], %lady [%lady woh]) :_ +>.$(q.ges [%duke wat], sat %mname) - ['Middle name (or blank): ' ~] + [['Middle name (or blank): ' %text] ~] :: %mname ?> ?=(%duke -.q.ges) @@ -327,7 +326,7 @@ =+ woh=`whom`[p.p.p.q.ges q.p.p.q.ges r.p.p.q.ges nam] =+ wat=`what`?-(-.p.q.ges %lord [%lord woh], %lady [%lady woh]) :_ +>.$(q.ges [%duke wat], sat %nname) - ['Nickname/handle (or blank): ' ~] + [['Nickname/handle (or blank): ' %text] ~] :: %nname ?> ?=(%duke -.q.ges) @@ -337,7 +336,7 @@ =+ woh=`whom`[p.p.p.q.ges q.p.p.q.ges r.p.p.q.ges nam] =+ wat=`what`?-(-.p.q.ges %lord [%lord woh], %lady [%lady woh]) :_ +>.$(q.ges [%duke wat], sat %lname) - ['Last name: ' ~] + [['Last name: ' %text] ~] :: %lname ?> ?=(%duke -.q.ges) @@ -346,7 +345,7 @@ =+ woh=`whom`[p.p.p.q.ges q.p.p.q.ges r.p.p.q.ges nam] =+ wat=`what`?-(-.p.q.ges %lord [%lord woh], %lady [%lady woh]) :_ +>.$(q.ges [%duke wat], sat %done) - ['' ~] + [['' %text] ~] :: %done !! == @@ -488,7 +487,9 @@ [%done +>.$] == == - =^ res +>.$ ^- [[pot=cord tak=(list cord)] _+>.$] (next(sat sot) '') + =^ res +>.$ + ^- [[pot=[cord prom] tak=(list cord)] _+>.$] + (next(sat sot) '') :_ +>.$ %+ welp :~ [ost %pass /in %g %show [our.hid +.imp.hid] you /in/[-.imp.hid]] @@ -504,7 +505,9 @@ =+ sih=((hard sign) sih) ?: ?=([%in ~] pax) ?. ?=(%rush +<.sih) `+>.$ - =^ res +>.$ ^- [[pot=cord tak=(list cord)] _+>.$] (next p.sih) + =^ res +>.$ + ^- [[pot=[cord prom] tak=(list cord)] _+>.$] + (next p.sih) ?: ?=(%done sat) (done ost) :_ +>.$ diff --git a/main/app/shell/core.hook b/main/app/shell/core.hook index 7a631892ce..bb7652b018 100644 --- a/main/app/shell/core.hook +++ b/main/app/shell/core.hook @@ -15,7 +15,7 @@ act=(unit span) :: active child pip=(map span span) :: pipe out->in pop=(map span span) :: pipe in->out - pot=(map span cord) :: prompts + pot=(map span ,[cord prom]) :: prompts var=(map term vase) :: variables == :: ++ gift :: @@ -358,11 +358,12 @@ :(slop !>(%rush) !>(%term-line) !>(prompt) !>(~) tan) :: ++ prompt - ^- @t + ^- [cord prom] ?^ act =+ por=(~(get by pot) u.act) ?^ por u.por - (rap 3 (~(got by cub.hid) u.act) '(' u.act ') ' ~) + [(rap 3 (~(got by cub.hid) u.act) '(' u.act ') ' ~) %text] + :_ %text ?. &(?=([@ @ @ *] pax) =('0' &3.pax)) (rsh 3 1 (spat pax)) (rap 3 &1.pax '/' &2.pax '=' ?~(|3.pax ~['> '] ~[(spat |3.pax) '> '])) @@ -387,7 +388,7 @@ ?. ?=(?(%rust %rush) +<.sih) +>.$ ?: ?=(%prompt p.sih) ?: (~(has by pip) cil) +>.$ - =. pot (~(put by pot) cil (cord q.sih)) + =. pot (~(put by pot) cil (,[cord prom] q.sih)) (blab ping) %- blab ?: (~(has by pip) cil) diff --git a/main/app/terminal/core.hook b/main/app/terminal/core.hook index 429ebc359b..691ded4af4 100644 --- a/main/app/terminal/core.hook +++ b/main/app/terminal/core.hook @@ -141,7 +141,7 @@ %line :: command entered =. r.tel :_ r.tel - stem/[leaf/(trip p.tel) leaf/(trip p.jof)] + stem/[leaf/(trip p.p.tel) leaf/(trip p.jof)] ?: =('\\' (end 3 1 p.jof)) $(jof [%cmd (rsh 3 1 p.jof)]) (send %txt -:!>(*cord) p.jof) @@ -165,7 +165,7 @@ ?+ +<.sih !! %nice +>.$ ?(%rust %rush) - =. p.q.sih ?^(q.q.sih p.tel p.q.sih) :: XX prompt hack + =. p.q.sih ?^(q.q.sih p.tel p.q.sih) :: XX prompt hack %_ +>.$ mow (welp (spam q.sih) mow) tel [p.q.sih (weld q.q.sih q.tel) (weld r.q.sih r.tel)] diff --git a/main/mar/term-line/door.hook b/main/mar/term-line/door.hook index fb75d67292..76f3c5496b 100644 --- a/main/mar/term-line/door.hook +++ b/main/mar/term-line/door.hook @@ -14,7 +14,7 @@ |% ++ json %- jobe - :~ [%prompt %s p.tel] + :~ [%prompt %s p.p.tel] [%history %a (turn q.tel |=(a=cord [%s a]))] :+ %lines %a %- zing ^- (list (list ^json)) diff --git a/main/sur/term-line/gate.hook b/main/sur/term-line/gate.hook index 65511b4c24..3ba76521d3 100644 --- a/main/sur/term-line/gate.hook +++ b/main/sur/term-line/gate.hook @@ -1 +1 @@ -,[p=cord q=(list cord) r=(list ?(tank [%stem p=tank q=tank]))] +,[p=[p=cord q=prom] q=(list cord) r=(list ?(tank [%stem p=tank q=tank]))] From f44d1590be96dd55c8e5e29e8f775f7e443cb0f6 Mon Sep 17 00:00:00 2001 From: Philip C Monk Date: Thu, 6 Nov 2014 20:22:23 -0500 Subject: [PATCH 31/31] fixed gall bug --- arvo/gall.hoon | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/arvo/gall.hoon b/arvo/gall.hoon index 67a7831a17..4d3593245d 100644 --- a/arvo/gall.hoon +++ b/arvo/gall.hoon @@ -345,7 +345,7 @@ :- %meta ^- vase :- :+ %cell [%cube sem %atom %tas] - [%cell [%atom %tas] p.q.cay] + [%cell [%cube p.cay %atom %tas] p.q.cay] [sem p.cay q.q.cay] :: ++ gaff :: take and go