Artifact e71e73dd81dd0d1a591046a70272cc2cc9bc7146
File editor.rx part of check-in [b85ceef2f2] - hide 'eval' by crc on 2010-11-15 20:11:03. [annotate]
( retro editor v11-2010.11.15 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
( Key Action )
( --- ------------------------------------------------- )
( i Move cursor up )
( j Move cursor left )
( k Move cursor right )
( l Move cursor down )
( [ Switch to previous block )
( ] Switch to next block )
( e Evaluate current block )
( E Evaluate all blocks )
( m Move cursor to start of next line )
( I Move cursor to top line of block )
( J Move cursor to start of current line )
( K Move cursor to last line of block )
( L Move cursor to end of current line )
( M Center cursor on current line )
( z Exit RxE )
( z Exit RxE )
( TAB Switch between edit and command mode )
( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
{{
2 elements buffer count
: restore ( - ) &key :devector ok ;
: get ( -c ) @buffer @ ;
: next ( -c ) @count 0 =if 32 restore ;then count -- get buffer ++ ;
: replace ( - ) &next &key :is ;
: eval ( an- ) !count !buffer replace ;
7 elements #blocks offset blk line column mode active
: toBlock 1600 * @offset + ;
: thisBlock @blk toBlock ;
: toLine 80 * thisBlock + ;
( check boundaries ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
: top ( - ) 0 !line ;
: bot ( - ) 19 !line ;
: beg ( - ) 0 !column ;
: end ( - ) 79 !column ;
: mid ( - ) 41 !column ;
: 1st ( - ) 0 !blk ;
: bounds ( - )
@column -1 =if end line -- then
@column 80 =if beg line ++ then
@line -1 =if top blk -- then
@line 20 =if bot blk ++ then
@blk -1 =if 1st then
@blk @#blocks >if blk -- then ;
( display a block ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
: rows 20 [ dup 80 ^console'cyan [ @ emit ] buffer.each 80 + cr ] times ;
: mode? @mode [ "INS" ] [ "CMD" ] choose ;
: .block @column @line @blk mode? "(%s) #%d - %d:%d " puts ;
: bar ^console'red 80 [ '- emit ] times cr ;
: vb @blk toBlock rows drop bar ^console'yellow .block ^console'white ;
: (v) ( - ) ^console'colors @ if ^console'home else clear then vb ;
: pos ( -cl ) @column @line ;
: get ( cl-a ) toLine + ;
: va ( a-va ) dup @ swap ;
: c! ( a- ) '* swap ! ;
: show ( va- ) dup c! (v) ! ;
: display ( - ) bounds pos get va show ;
( input processing ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
: ws ( - ) remapping off later remapping on ;
: advance? ( - ) line ++ @line 20 >if 0 !line blk ++ then 0 !column ;
: remap ( c-c )
dup 9 =if drop 27 then
dup 13 =if drop 10 then
dup 10 =if drop 32 advance? then ;
: input ( - )
repeat
display
@mode 0; drop
key
dup 27 <> 0; drop
dup 8 =if drop column -- display [[ over 8 , , ]] then
dup 10 =if drop line ++ else pos get ! column ++ then
again ;
: rxe.in ( -c ) mode on ws input mode off ;
: match ( c- ) "$$_" dup [ 2 + ! ] dip find if @d->xt do else drop then ;
: edit? ( c-c ) dup 27 =if rxe.in drop then ;
( various support bits ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
: new ( - ) @offset 32 1600 @#blocks * fill ;
: e ( - ) thisBlock 1600 eval ;
: ea ( - ) @offset @#blocks 1600 * eval ;
---reveal---
: setBlocks ( n- ) !#blocks @memory 1600 @#blocks * - !offset new ;
: edit ( - )
@fh 22 > @fw 80 > and dup
[ "requires an 80x22 or greater display, sorry!\n" puts ] ifFalse
0; drop
@fb [ ^console'colors off ] ifTrue active on
&remap &remapKeys :is clear ^console'bold
[ display key edit? match @active ] while ;
: $$i line -- ;
: $$j column -- ;
: $$k line ++ ;
: $$l column ++ ;
: $$m $$k beg ;
: $$I top ;
: $$J beg ;
: $$K bot ;
: $$L end ;
: $$M mid ;
: $$[ blk -- ;
: $$] blk ++ ;
: $$e active off ^console'normal e ;
: $$E active off ^console'normal ea ;
: $$z active off ;
128 setBlocks
}}
global