dill: replace %ctl and %met belts with %key

Previously, we relied on foolish hacks, like [%met %bac], to send
"special" keystrokes with modifiers.

This updates the belt type to have %key, which represents a single
keystroke, with any combination of modifier keys.

Note that this has overlap with %txt to some extent. [%key ~ 'a'] should
be considered equivalent and preferred to [%txt 'a' ~], but updating
existing usage is left to a later commit.
This commit is contained in:
fang 2021-03-10 21:49:56 +01:00
parent 544126f3ee
commit 2861de983b
No known key found for this signature in database
GPG Key ID: EB035760C1BBA972
9 changed files with 203 additions and 85 deletions

View File

@ -2,7 +2,7 @@
/+ drum=hood-drum, helm=hood-helm, kiln=hood-kiln /+ drum=hood-drum, helm=hood-helm, kiln=hood-kiln
|% |%
+$ state +$ state
$: %12 $: %13
drum=state:drum drum=state:drum
helm=state:helm helm=state:helm
kiln=state:kiln kiln=state:kiln
@ -15,6 +15,7 @@
[%9 drum=state:drum helm=state:helm kiln=state:kiln] [%9 drum=state:drum helm=state:helm kiln=state:kiln]
[%10 drum=state:drum helm=state:helm kiln=state:kiln] [%10 drum=state:drum helm=state:helm kiln=state:kiln]
[%11 drum=state:drum helm=state:helm kiln=state:kiln] [%11 drum=state:drum helm=state:helm kiln=state:kiln]
[%12 drum=any-state:drum helm=state:helm kiln=state:kiln]
== ==
+$ any-state-tuple +$ any-state-tuple
$: drum=any-state:drum $: drum=any-state:drum

View File

@ -1,10 +1,10 @@
/- *sole /- *sole
/+ sole /+ sole
|% |%
+$ any-state $%(state) +$ any-state $%(state state-2)
+$ state [%2 pith-2] +$ state [%3 pith]
:: ::
++ pith-2 :: ++ pith ::
$: eel=(set gill:gall) :: connect to $: eel=(set gill:gall) :: connect to
ray=(set well:gall) :: ray=(set well:gall) ::
fur=(map dude:gall (unit server)) :: servers fur=(map dude:gall (unit server)) :: servers
@ -49,6 +49,42 @@
pom=sole-prompt :: static prompt pom=sole-prompt :: static prompt
inp=sole-command :: input state inp=sole-command :: input state
== :: == ::
::
::
+$ state-2 [%2 pith-2]
::
+$ pith-2
$: eel=(set gill:gall)
ray=(set well:gall)
fur=(map dude:gall (unit server))
bin=(map bone source-2)
==
::
+$ source-2
$: edg=_80
off=@ud
kil=kill
inx=@ud
fug=(map gill:gall (unit target-2))
mir=(pair @ud stub)
==
::
+$ target-2
$: $= blt
%+ pair
(unit dill-belt-2)
(unit dill-belt-2)
ris=(unit search)
hit=history
pom=sole-prompt
inp=sole-command
==
::
+$ dill-belt-2
$% [%ctl p=@c]
[%met p=@c]
dill-belt:dill
==
-- --
:: :: :: :: :: ::
:::: :: :: :::: :: ::
@ -217,49 +253,85 @@
== ==
:: ::
++ on-load ++ on-load
|= [hood-version=@ud old=any-state] |^ |= [hood-version=@ud old=any-state]
=< se-abet =< se-view =< se-abet =< se-view
=. sat old =. sat (load-state old)
=. dev (~(gut by bin) ost *source) =. dev (~(gut by bin) ost *source)
=? ..on-load (lte hood-version %4) (load-apps hood-version)
~> %slog.0^leaf+"drum: starting os1 agents" ::
=> (se-born | %home %s3-store) ++ load-state
=> (se-born | %home %contact-view) |= old=any-state
=> (se-born | %home %contact-hook) ^- state
=> (se-born | %home %contact-store) ?- -.old
=> (se-born | %home %metadata-hook) %3 old
=> (se-born | %home %metadata-store) %2 [%3 (pith-2-to-3 +.old)]
=> (se-born | %home %goad) ==
~> %slog.0^leaf+"drum: resubscribing to %dojo and %chat-cli" ::
=> (se-drop:(se-pull our.hid %dojo) | our.hid %dojo) ++ pith-2-to-3
(se-drop:(se-pull our.hid %chat-cli) | our.hid %chat-cli) |= p=pith-2
=? ..on-load (lte hood-version %5) ^- pith
(se-born | %home %file-server) p(bin (~(run by bin.p) source-2-to-3))
=? ..on-load (lte hood-version %7) ::
(se-born | %home %glob) ++ source-2-to-3
=? ..on-load (lte hood-version %8) |= s=source-2
=> (se-born | %home %group-push-hook) ^- source
(se-born | %home %group-pull-hook) s(fug (~(run by fug.s) |=(t=(unit target-2) (bind t target-2-to-3))))
=? ..on-load (lte hood-version %9) ::
(se-born | %home %graph-store) ++ target-2-to-3
=? ..on-load (lte hood-version %10) |= t=target-2
=> (se-born | %home %graph-push-hook) ^- target
(se-born | %home %graph-pull-hook) :_ +.t
=? ..on-load (lte hood-version %11) :- (bind p.blt.t belt-2-to-3)
=> (se-born | %home %hark-graph-hook) (bind q.blt.t belt-2-to-3)
=> (se-born | %home %hark-group-hook) ::
=> (se-born | %home %hark-chat-hook) ++ belt-2-to-3
=> (se-born | %home %hark-store) |= b=dill-belt-2
=> (se-born | %home %observe-hook) ^- dill-belt:dill
=> (se-born | %home %metadata-pull-hook) ?. ?=(?(%ctl %met) -.b) b
=> (se-born | %home %metadata-push-hook) [%key -.b p.b]
(se-born | %home %herm) ::
=? ..on-load (lte hood-version %12) ++ load-apps
=> (se-born | %home %contact-push-hook) |= hood-version=@ud
=> (se-born | %home %contact-pull-hook) =? ..on-load (lte hood-version %4)
=> (se-born | %home %settings-store) ~> %slog.0^leaf+"drum: starting os1 agents"
(se-born | %home %group-view) => (se-born | %home %s3-store)
..on-load => (se-born | %home %contact-view)
=> (se-born | %home %contact-hook)
=> (se-born | %home %contact-store)
=> (se-born | %home %metadata-hook)
=> (se-born | %home %metadata-store)
=> (se-born | %home %goad)
~> %slog.0^leaf+"drum: resubscribing to %dojo and %chat-cli"
=> (se-drop:(se-pull our.hid %dojo) | our.hid %dojo)
(se-drop:(se-pull our.hid %chat-cli) | our.hid %chat-cli)
=? ..on-load (lte hood-version %5)
(se-born | %home %file-server)
=? ..on-load (lte hood-version %7)
(se-born | %home %glob)
=? ..on-load (lte hood-version %8)
=> (se-born | %home %group-push-hook)
(se-born | %home %group-pull-hook)
=? ..on-load (lte hood-version %9)
(se-born | %home %graph-store)
=? ..on-load (lte hood-version %10)
=> (se-born | %home %graph-push-hook)
(se-born | %home %graph-pull-hook)
=? ..on-load (lte hood-version %11)
=> (se-born | %home %hark-graph-hook)
=> (se-born | %home %hark-group-hook)
=> (se-born | %home %hark-chat-hook)
=> (se-born | %home %hark-store)
=> (se-born | %home %observe-hook)
=> (se-born | %home %metadata-pull-hook)
=> (se-born | %home %metadata-push-hook)
(se-born | %home %herm)
=? ..on-load (lte hood-version %12)
=> (se-born | %home %contact-push-hook)
=> (se-born | %home %contact-pull-hook)
=> (se-born | %home %settings-store)
(se-born | %home %group-view)
..on-load
--
:: ::
++ reap-phat :: ack connect ++ reap-phat :: ack connect
|= [way=wire saw=(unit tang)] |= [way=wire saw=(unit tang)]
@ -721,12 +793,19 @@
?- bet ?- bet
[%aro *] (ta-aro p.bet) [%aro *] (ta-aro p.bet)
[%bac *] ta-bac [%bac *] ta-bac
[%ctl *] (ta-ctl p.bet)
[%del *] ta-del [%del *] ta-del
[%hit *] (ta-hit +.bet) [%hit *] (ta-hit +.bet)
[%met *] (ta-met p.bet)
[%ret *] ta-ret [%ret *] ta-ret
[%txt *] (ta-txt p.bet) [%txt *] (ta-txt p.bet)
::
[%key *]
?+ mod.bet
?^ key.bet $(bet key.bet)
(ta-txt key.bet ~)
::
%ctl (ta-ctl key.bet)
%met (ta-met key.bet)
==
== ==
:: ::
++ ta-det :: send edit ++ ta-det :: send edit
@ -750,7 +829,7 @@
(ta-hom %del (dec pos.inp)) (ta-hom %del (dec pos.inp))
:: ::
++ ta-ctl :: hear control ++ ta-ctl :: hear control
|= key=@c |= key=bolt:dill
^+ +> ^+ +>
=. ris ?.(?=(?(%g %r) key) ~ ris) =. ris ?.(?=(?(%g %r) key) ~ ris)
?+ key ta-bel ?+ key ta-bel
@ -891,8 +970,8 @@
kil kil
?. ?& ?=(^ old.kil) ?. ?& ?=(^ old.kil)
?=(^ p.blt) ?=(^ p.blt)
?| ?=([%ctl ?(%k %u %w)] u.p.blt) ?| ?=([%key %ctl ?(%k %u %w)] u.p.blt)
?=([%met ?(%d %bac)] u.p.blt) ?=([%key %met ?(%d [%bac ~])] u.p.blt)
== == == ==
%= kil :: prepend %= kil :: prepend
num +(num.kil) num +(num.kil)
@ -909,17 +988,18 @@
== ==
:: ::
++ ta-met :: meta key ++ ta-met :: meta key
|= key=@c |= key=bolt:dill
^+ +> ^+ +>
=. ris ~ =. ris ~
?+ key ta-bel ?+ key ta-bel
%dot ?. &(?=(^ old.hit) ?=(^ i.old.hit)) :: last "arg" from hist %'.' ?. &(?=(^ old.hit) ?=(^ i.old.hit)) :: last "arg" from hist
ta-bel ta-bel
=+ old=`(list @c)`i.old.hit =+ old=`(list @c)`i.old.hit
=+ sop=(ta-jump(buf.say.inp old) %l %ace (lent old)) =+ sop=(ta-jump(buf.say.inp old) %l %ace (lent old))
(ta-hom (cat:edit pos.inp (slag sop old))) (ta-hom (cat:edit pos.inp (slag sop old)))
:: ::
%bac ?: =(0 pos.inp) :: kill left-word [%bac ~]
?: =(0 pos.inp) :: kill left-word
ta-bel ta-bel
=+ sop=(ta-pos %l %edg pos.inp) =+ sop=(ta-pos %l %edg pos.inp)
(ta-kil %l [(sub pos.inp sop) sop]) (ta-kil %l [(sub pos.inp sop) sop])
@ -975,8 +1055,8 @@
:: ::
%y ?. ?& ?=(^ old.kil) :: rotate & yank %y ?. ?& ?=(^ old.kil) :: rotate & yank
?=(^ p.blt) ?=(^ p.blt)
?| ?=([%ctl %y] u.p.blt) ?| ?=([%key %ctl %y] u.p.blt)
?=([%met %y] u.p.blt) ?=([%key %met %y] u.p.blt)
== == == ==
ta-bel ta-bel
=+ las=(lent ta-yan) =+ las=(lent ta-yan)

View File

@ -11,15 +11,31 @@
^- $-(^json belt:dill) ^- $-(^json belt:dill)
=, dejs:format =, dejs:format
%- of %- of
:~ aro+(su (perk %d %l %r %u ~)) |^ :* key+(ot 'mod'^mod 'key'^bot ~)
bac+ul txt+(ar (cu taft so))
ctl+(cu taft so) bol
del+ul ==
hit+(ot 'r'^ni 'c'^ni ~) ::
met+(cu taft so) ++ bol
ret+ul :~ aro+(su (perk %d %l %r %u ~))
txt+(ar (cu taft so)) bac+ul
== del+ul
hit+(ot 'r'^ni 'c'^ni ~)
ret+ul
==
::
++ bot
|= jon=json
?+ jon !!
[%s *] ((cu taft so) jon)
[%o *] ((of bol) jon)
==
::
++ mod
|= jon=json
?~ jon ~
((su (perk %ctl %met %hyp ~)) jon)
--
-- --
:: +grow: convert to :: +grow: convert to
:: ::

View File

@ -1068,13 +1068,15 @@
+$ belt :: outside belt +$ belt :: outside belt
$% [%aro p=?(%d %l %r %u)] :: arrow key $% [%aro p=?(%d %l %r %u)] :: arrow key
[%bac ~] :: true backspace [%bac ~] :: true backspace
[%ctl p=@c] :: control-key
[%del ~] :: true delete [%del ~] :: true delete
[%hit r=@ud c=@ud] :: mouse click [%hit r=@ud c=@ud] :: mouse click
[%met p=@c] :: meta-key [%key mod=?(~ %ctl %met %hyp) key=bolt] :: input w/ modifier
[%ret ~] :: return [%ret ~] :: return
[%txt p=(list @c)] :: utf32 text [%txt p=(list @c)] :: utf32 text
== :: == ::
+$ bolt :: single input
$@ @cF :: simple
$<(?(%txt %key) belt) :: special
+$ blit :: outside blit +$ blit :: outside blit
$% [%bel ~] :: make a noise $% [%bel ~] :: make a noise
[%clr ~] :: clear the screen [%clr ~] :: clear the screen

View File

@ -415,12 +415,18 @@
:: ::
+$ axon-4 +$ axon-4
$: ram=term $: ram=term
tem=(unit (list dill-belt)) tem=(unit (list dill-belt-4))
wid=_80 wid=_80
pos=$@(@ud [@ud @ud]) pos=$@(@ud [@ud @ud])
see=$%([%lin (list @c)] [%klr stub]) see=$%([%lin (list @c)] [%klr stub])
== ==
:: ::
+$ dill-belt-4
$% [%ctl p=@c]
[%met p=@c]
dill-belt
==
::
++ axle-4-to-5 ++ axle-4-to-5
|= axle-4 |= axle-4
^- axle ^- axle
@ -435,7 +441,17 @@
%+ ~(put by nay) ses %+ ~(put by nay) ses
(~(put in (~(get ju eye) duct)) duct) (~(put in (~(get ju eye) duct)) duct)
:: ::
++ axon-4-to-5 |=(axon-4 `axon`[ram tem wid]) ++ axon-4-to-5
|= axon-4
^- axon
=; tem [ram tem wid]
?~ tem ~
%- some
%+ turn u.tem
|= b=dill-belt-4
^- dill-belt
?. ?=(?(%ctl %met) -.b) b
[%key -.b p.b]
-- --
:: ::
++ scry ++ scry

View File

@ -1,14 +1,20 @@
import BaseApi from './base'; import BaseApi from './base';
import { StoreState } from '../store/type'; import { StoreState } from '../store/type';
export type Belt = type Bork =
| { aro: 'd' | 'l' | 'r' | 'u' } | { aro: 'd' | 'l' | 'r' | 'u' }
| { bac: null } | { bac: null }
| { ctl: string }
| { del: null } | { del: null }
| { hit: { r: number, c: number } } | { hit: { r: number, c: number } }
| { met: string }
| { ret: null } | { ret: null }
export type Bolt =
| string
| Bork
export type Belt =
| Bork
| { key: { mod: null | 'ctl' | 'met' | 'hyp', key: Bolt } }
| { txt: Array<string> }; | { txt: Array<string> };
export default class TermApi extends BaseApi<StoreState> { export default class TermApi extends BaseApi<StoreState> {

View File

@ -264,7 +264,7 @@ export default function TermApp(props: TermAppProps) {
belts.push({ ret: null }); belts.push({ ret: null });
} }
else if (c <= 26) { else if (c <= 26) {
belts.push({ ctl: String.fromCharCode(96 + c) }); belts.push({ key: { mod: 'ctl', key: String.fromCharCode(96 + c) } });
} }
// escape sequences // escape sequences
@ -295,13 +295,13 @@ export default function TermApp(props: TermAppProps) {
} }
} }
else if (c >= 97 && c <= 122) { // a <= c <= z else if (c >= 97 && c <= 122) { // a <= c <= z
belts.push({ met: e[0] }); belts.push({ key: { mod: 'met', key: e[0] } });
} }
else if (c === 46) { // . else if (c === 46) { // .
belts.push({ met: 'dot' }); belts.push({ key: { mod: 'met', key: '.' } });
} }
else if (c === 8 || c === 127) { else if (c === 8 || c === 127) {
belts.push({ met: 'bac' }); belts.push({ key: { mod: 'met', key: { bac: null } } });
} }
else { else {
term.write('\x07'); break; // bel term.write('\x07'); break; // bel

View File

@ -603,6 +603,7 @@
# define c3__just c3_s4('j','u','s','t') # define c3__just c3_s4('j','u','s','t')
# define c3__keep c3_s4('k','e','e','p') # define c3__keep c3_s4('k','e','e','p')
# define c3__kern c3_s4('k','e','r','n') # define c3__kern c3_s4('k','e','r','n')
# define c3__key c3_s3('k','e','y')
# define c3__kgo c3_s3('k','g','o') # define c3__kgo c3_s3('k','g','o')
# define c3__kick c3_s4('k','i','c','k') # define c3__kick c3_s4('k','i','c','k')
# define c3__king c3_s4('k','i','n','g') # define c3__king c3_s4('k','i','n','g')

View File

@ -800,15 +800,11 @@ _term_io_suck_char(u3_utty* uty_u, c3_y cay_y)
else { else {
if ( (cay_y >= 'a') && (cay_y <= 'z') ) { if ( (cay_y >= 'a') && (cay_y <= 'z') ) {
tat_u->esc.ape = c3n; tat_u->esc.ape = c3n;
_term_io_belt(uty_u, u3nc(c3__met, cay_y)); _term_io_belt(uty_u, u3nt(c3__key, c3__met, cay_y));
}
else if ( '.' == cay_y ) {
tat_u->esc.ape = c3n;
_term_io_belt(uty_u, u3nc(c3__met, c3__dot));
} }
else if ( 8 == cay_y || 127 == cay_y ) { else if ( 8 == cay_y || 127 == cay_y ) {
tat_u->esc.ape = c3n; tat_u->esc.ape = c3n;
_term_io_belt(uty_u, u3nc(c3__met, c3__bac)); _term_io_belt(uty_u, u3nq(c3__key, c3__met, c3__bac, u3_nul));
} }
else if ( ('[' == cay_y) || ('O' == cay_y) ) { else if ( ('[' == cay_y) || ('O' == cay_y) ) {
tat_u->esc.bra = c3y; tat_u->esc.bra = c3y;
@ -877,7 +873,7 @@ _term_io_suck_char(u3_utty* uty_u, c3_y cay_y)
} }
#endif #endif
else if ( cay_y <= 26 ) { else if ( cay_y <= 26 ) {
_term_io_belt(uty_u, u3nc(c3__ctl, ('a' + (cay_y - 1)))); _term_io_belt(uty_u, u3nt(c3__key, c3__ctl, ('a' + (cay_y - 1))));
} }
else if ( 27 == cay_y ) { else if ( 27 == cay_y ) {
tat_u->esc.ape = c3y; tat_u->esc.ape = c3y;
@ -1211,7 +1207,7 @@ u3_term_ef_ctlc(void)
{ {
u3_noun wir = u3nt(c3__term, '1', u3_nul); u3_noun wir = u3nt(c3__term, '1', u3_nul);
u3_noun cad = u3nt(c3__belt, c3__ctl, 'c'); u3_noun cad = u3nq(c3__belt, c3__key, c3__ctl, 'c');
c3_assert( 1 == uty_u->tid_l ); c3_assert( 1 == uty_u->tid_l );
c3_assert( uty_u->car_u ); c3_assert( uty_u->car_u );