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
|%
+$ state
$: %12
$: %13
drum=state:drum
helm=state:helm
kiln=state:kiln
@ -15,6 +15,7 @@
[%9 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]
[%12 drum=any-state:drum helm=state:helm kiln=state:kiln]
==
+$ any-state-tuple
$: drum=any-state:drum

View File

@ -1,10 +1,10 @@
/- *sole
/+ sole
|%
+$ any-state $%(state)
+$ state [%2 pith-2]
+$ any-state $%(state state-2)
+$ state [%3 pith]
::
++ pith-2 ::
++ pith ::
$: eel=(set gill:gall) :: connect to
ray=(set well:gall) ::
fur=(map dude:gall (unit server)) :: servers
@ -49,6 +49,42 @@
pom=sole-prompt :: static prompt
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
|= [hood-version=@ud old=any-state]
=< se-abet =< se-view
=. sat old
=. dev (~(gut by bin) ost *source)
=? ..on-load (lte hood-version %4)
~> %slog.0^leaf+"drum: starting os1 agents"
=> (se-born | %home %s3-store)
=> (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
|^ |= [hood-version=@ud old=any-state]
=< se-abet =< se-view
=. sat (load-state old)
=. dev (~(gut by bin) ost *source)
(load-apps hood-version)
::
++ load-state
|= old=any-state
^- state
?- -.old
%3 old
%2 [%3 (pith-2-to-3 +.old)]
==
::
++ pith-2-to-3
|= p=pith-2
^- pith
p(bin (~(run by bin.p) source-2-to-3))
::
++ source-2-to-3
|= s=source-2
^- source
s(fug (~(run by fug.s) |=(t=(unit target-2) (bind t target-2-to-3))))
::
++ target-2-to-3
|= t=target-2
^- target
:_ +.t
:- (bind p.blt.t belt-2-to-3)
(bind q.blt.t belt-2-to-3)
::
++ belt-2-to-3
|= b=dill-belt-2
^- dill-belt:dill
?. ?=(?(%ctl %met) -.b) b
[%key -.b p.b]
::
++ load-apps
|= hood-version=@ud
=? ..on-load (lte hood-version %4)
~> %slog.0^leaf+"drum: starting os1 agents"
=> (se-born | %home %s3-store)
=> (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
|= [way=wire saw=(unit tang)]
@ -721,12 +793,19 @@
?- bet
[%aro *] (ta-aro p.bet)
[%bac *] ta-bac
[%ctl *] (ta-ctl p.bet)
[%del *] ta-del
[%hit *] (ta-hit +.bet)
[%met *] (ta-met p.bet)
[%ret *] ta-ret
[%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
@ -750,7 +829,7 @@
(ta-hom %del (dec pos.inp))
::
++ ta-ctl :: hear control
|= key=@c
|= key=bolt:dill
^+ +>
=. ris ?.(?=(?(%g %r) key) ~ ris)
?+ key ta-bel
@ -891,8 +970,8 @@
kil
?. ?& ?=(^ old.kil)
?=(^ p.blt)
?| ?=([%ctl ?(%k %u %w)] u.p.blt)
?=([%met ?(%d %bac)] u.p.blt)
?| ?=([%key %ctl ?(%k %u %w)] u.p.blt)
?=([%key %met ?(%d [%bac ~])] u.p.blt)
== ==
%= kil :: prepend
num +(num.kil)
@ -909,17 +988,18 @@
==
::
++ ta-met :: meta key
|= key=@c
|= key=bolt:dill
^+ +>
=. ris ~
?+ key ta-bel
%dot ?. &(?=(^ old.hit) ?=(^ i.old.hit)) :: last "arg" from hist
%'.' ?. &(?=(^ old.hit) ?=(^ i.old.hit)) :: last "arg" from hist
ta-bel
=+ old=`(list @c)`i.old.hit
=+ sop=(ta-jump(buf.say.inp old) %l %ace (lent 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
=+ sop=(ta-pos %l %edg pos.inp)
(ta-kil %l [(sub pos.inp sop) sop])
@ -975,8 +1055,8 @@
::
%y ?. ?& ?=(^ old.kil) :: rotate & yank
?=(^ p.blt)
?| ?=([%ctl %y] u.p.blt)
?=([%met %y] u.p.blt)
?| ?=([%key %ctl %y] u.p.blt)
?=([%key %met %y] u.p.blt)
== ==
ta-bel
=+ las=(lent ta-yan)

View File

@ -11,15 +11,31 @@
^- $-(^json belt:dill)
=, dejs:format
%- of
:~ aro+(su (perk %d %l %r %u ~))
bac+ul
ctl+(cu taft so)
del+ul
hit+(ot 'r'^ni 'c'^ni ~)
met+(cu taft so)
ret+ul
txt+(ar (cu taft so))
==
|^ :* key+(ot 'mod'^mod 'key'^bot ~)
txt+(ar (cu taft so))
bol
==
::
++ bol
:~ aro+(su (perk %d %l %r %u ~))
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
::

View File

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

View File

@ -415,12 +415,18 @@
::
+$ axon-4
$: ram=term
tem=(unit (list dill-belt))
tem=(unit (list dill-belt-4))
wid=_80
pos=$@(@ud [@ud @ud])
see=$%([%lin (list @c)] [%klr stub])
==
::
+$ dill-belt-4
$% [%ctl p=@c]
[%met p=@c]
dill-belt
==
::
++ axle-4-to-5
|= axle-4
^- axle
@ -435,7 +441,17 @@
%+ ~(put by nay) ses
(~(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

View File

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

View File

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

View File

@ -603,6 +603,7 @@
# define c3__just c3_s4('j','u','s','t')
# define c3__keep c3_s4('k','e','e','p')
# 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__kick c3_s4('k','i','c','k')
# 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 {
if ( (cay_y >= 'a') && (cay_y <= 'z') ) {
tat_u->esc.ape = c3n;
_term_io_belt(uty_u, u3nc(c3__met, cay_y));
}
else if ( '.' == cay_y ) {
tat_u->esc.ape = c3n;
_term_io_belt(uty_u, u3nc(c3__met, c3__dot));
_term_io_belt(uty_u, u3nt(c3__key, c3__met, cay_y));
}
else if ( 8 == cay_y || 127 == cay_y ) {
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) ) {
tat_u->esc.bra = c3y;
@ -877,7 +873,7 @@ _term_io_suck_char(u3_utty* uty_u, c3_y cay_y)
}
#endif
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 ) {
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 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( uty_u->car_u );