Edit Line Extensions

{ ============================================================================
   EditLine.F Extensions

   (C) Copyright 2004 LOGIX, All Rights Reserved.

   Changes:
   Created 11/03/2003 by Mike Ghan
   Released to the Public Domain  1/20/2004 MAG

   Enhancements:
   1) Allow up/down arrow keys to invoke auto-complete if not at line start.
   2) Save all lines 1 or more chars long into history buffer.
   3) Ctl Shift Del = Delete to End of Line
   4) Ctl Home = Show History
   5) F3 = Append Last to EOL (ala DOS)
   6) Auto-complete comparison is now case-insensitive.
   7) Fixed a few zero length bugs (ie DO >> ?DO).

   Future:
   1) If new line exists in history, delete old entry

=========================================================================== }

PACKAGE ACCEPTOR

PRIVATE

VARIABLE RECALLED?
VARIABLE RECALLING?

\ Bug with zero lengths (Bug reported 5/7/01 MAG)
-?  \ Broken COMPARE(NC)
: COMPARE(NC)  ( c-addr1 len1 c-addr2 len2 -- n )
   DUP 0= 3 PICK 0= AND
   IF  4DROP 0  EXIT THEN
   DUP 0= 3 PICK 0= OR
   IF  NIP - NIP  EXIT THEN
   COMPARE(NC) ;

[UNDEFINED] PTR+ [IF]
\ Increment Pointer
: PTR+  ( addr limit --- )
   OVER @ 1+ TUCK  U> AND SWAP ! ;

\ Decrement pointer
: PTR-  ( addr limit --- )
   1- OVER @ ?DUP
   IF 1- NIP THEN  SWAP ! ;
[THEN]

-?
: /COMPLETE ( a n # -- a n # )
   THIRD PATTERN COUNT TUCK COMPARE(NC)  PATTERN C@ 0=  OR  IF
      THIRD OVER PATTERN PLACE   -1 THELINE ! ( << changed )
   THEN ;

-? \ Fixed 0 length bug
: A-REPLACE ( a n # a n -- a n # )
   2>R A-ESCAPE 2R> BOUNDS ?DO  ( <<< change to ?DO )
      I C@ A-OVERSTRIKE
   LOOP  A-HOME A-END ;

: A-MATCH-LINE?  ( a n # -- a n # flag )  \ True = Match
   THELINE @ NTH-LINE   PATTERN COUNT  ROT MIN TUCK COMPARE(NC) 0= ( Match? ) ;

: A-LINE-REPLACE  ( a n # -- a n # )
   THELINE @ NTH-LINE  A-REPLACE ;

-?
: A-COMPLETE  ( a n # -- a n # )
   /COMPLETE
   #LBUF 0
   ?DO  THELINE #LBUF PTR+
      A-MATCH-LINE?
      IF  A-LINE-REPLACE  UNLOOP EXIT  THEN
   LOOP ;

: -A-COMPLETE ( a n # -- a n # )
   /COMPLETE  THELINE @ 0 MAX THELINE !
   #LBUF 0
   ?DO  THELINE #LBUF PTR-
      A-MATCH-LINE?
      IF  A-LINE-REPLACE  UNLOOP EXIT  THEN
   LOOP ;



: A-UP-ARROW   ( a n # -- a n # )
   DUP
   RECALLING? @ NOT AND
   IF  A-COMPLETE
      RECALLED? OFF
      EXIT
   THEN ( else ) A-RECALL-UP  RECALLED? ON ;

: A-DN-ARROW   ( a n # -- a n # )
   DUP
   RECALLING? @ NOT AND
   IF  -A-COMPLETE
      RECALLED? OFF
      EXIT
   THEN ( else ) A-RECALL-DOWN  RECALLED? ON ;


-?  \ Fixed 0 length bug, validate n
: HISTORY ( n -- )
   #LBUF MIN
   1- 0 MAX 0 SWAP ?DO
      CR I NTH-LINE TYPE
   -1 +LOOP CR ;

: A-SHOW-HIST  ( a n # -- a n # )  A-ESCAPE  10 HISTORY ;


: REPATTERN ( a n # -- a n # )
   THIRD OVER PATTERN PLACE
   -1 THELINE ! ;


: A-DEL-EOL  ( a n # -- a n # )
   R-BUF THIRD OVER R@ PLACE R> COUNT A-REPLACE ;

: A-APPEND-LAST  ( a n # -- a n # )
   A-DEL-EOL
   0 NTH-LINE THIRD /STRING 0 MAX BOUNDS
   ?DO  I C@ A-OVERSTRIKE  LOOP  REPATTERN ;

\ Repattern relevant control operations
: A-BACKSPACE-X  ( a n # -- a n # )  A-BACKSPACE REPATTERN ;
: A-LEFT-X       ( a n # -- a n # )  A-LEFT      REPATTERN ;
: A-RIGHT-X      ( a n # -- a n # )  A-RIGHT     REPATTERN ;
: A-END-X        ( a n # -- a n # )  A-END       REPATTERN ;
: A-LEFTWORD-X   ( a n # -- a n # )  A-LEFTWORD  REPATTERN ;
: A-RIGHTWORD-X  ( a n # -- a n # )  A-RIGHTWORD REPATTERN ;


[+SWITCH CONTROL ( a n # echar -- a n # )
         8 RUNS A-BACKSPACE-X
         9 RUNS A-COMPLETE
   $010025 RUNS A-LEFT-X
   $010027 RUNS A-RIGHT-X
   $010023 RUNS A-END-X
   $030025 RUNS A-LEFTWORD-X
   $030027 RUNS A-RIGHTWORD-X
   $010026 RUNS A-UP-ARROW
   $010028 RUNS A-DN-ARROW
   $030024 RUNS A-SHOW-HIST    \ Ctl Home
   $07002E RUNS A-DEL-EOL      \ Ctl Shift Del
   $010072 RUNS A-APPEND-LAST  \ F3 - Append Last to EOL (ala DOS)
SWITCH]

-?
: ESTROKE  ( a n # echar -- a n # )
   DUP 32 256 WITHIN IF  CHARACTER REPATTERN ( new )  ELSE  CONTROL  THEN ;

: ~ACCEPT~  ( a n -- n )
   -1 THELINE !  PATTERN OFF
   2DUP BLANK  0 BEGIN ( a n # )
      AKEY
      RECALLED? @ RECALLING? !  RECALLED? OFF ( <<< new )
      ESTROKE
      RECALLED? @ RECALLING? !  ( <<< new )
      DUP 0<
   UNTIL DROP ;

-?
: E-ACCEPT  ( a n -- n )
   ~ACCEPT~  TUCK  2DUP >HISTORY   PUSHLINE ;

' E-ACCEPT IS ACCEPT

PUBLIC

: CONSOLE-ACCEPT  ( a n -- n )  ~ACCEPT~  ;

PRIVATE


\ This is Very Ugly (and Dangerous)!  We'll Patch Existing Code.
\ Next we'll configure to min line length from the history buffer.
\ Note: If this is ever merged with EditLine.F, PUSHLINE should be modified to
\ use a user adjustable (PUBLIC) variable or value.
1 ( Min Line Length to be Saved in Line History )
1- 0 MAX ' PUSHLINE >CODE 2+ DUP C@ $02 <>
[IF] CR .( Bad Patch, Expecting $02 ) /FORTH ABORT [THEN] C!


END-PACKAGE