\\         *** Funktionstasten in STdecode ***         23jun92py                                                                Angeregt von Bernd Forstbauer                                                                                                   Auch wenn die Funktionstasten des STs nicht gerade die ergono-  mischte Form haben... Es ist doch komfortabel, wenn man h„ufig  ben”tigte W”rter auf die Funktionstasten legen kann.            Die geschifteten Tasten werden als F11-F20 betrachtet.          Vorbelegung:                                                    F1    F2    F3    F4    F5    F6    F7    F8    F9    F10       .S    ORDER WORDS FILE? FILES DIR   PATH  FREE? FLUSH V                                                                         F11   F12   F13   F14   F15   F16   F17   F18   F19   F20       DECIM HEX   TOSS  --    --    --    --    --    --    --                                                                        Belegung mit <n> F' <Word>                                      \ Funktionstasten auswerten                            19oct94py                                                                Table: (Ftast                                                     .s    order words file? files pwd   path  free? flush noop      hex decimal toss  only  noop  noop  noop  noop  noop  noop  [                                                                 | : .names $50 bounds DO  i @ >name count $1F and under type                              8 swap - 0 max spaces  cell +LOOP ;                                                                   : help ( -- ) FORTHstart 2+                                       5 0 DO cr count 2dup cols over - 2/ spaces type + LOOP drop     cr ." Funktionstasten:" cr  (Ftast .names                       ." State: " state @ IF ." compile" ELSE ." interpret" THEN cr   ." Order: " order cr ." Datei: " file? cr ." Stack: " .s cr     ." Verlassen des Systems mit BYE" cr ;                        : <help>  >r >r >r >r help r> r> r> r> 0 ;      -->             \ Funktionstasten auswerten                            19oct94py                                                                : <func>  ( m s addr pos -- m s addr pos )  clrline               lastkey @ $FFBE $FFCA within                                    IF    lastkey @ $FFBE -                                         ELSE  false EXIT  THEN                                          cells (Ftast +                                                  -rot >r >r -rot >r >r perform r> r> r> r>                       prompt cr over 3 pick type row over at 0 ;                                                                                    : F' ( n -- ) ' swap 1- 0 max &19 min cells (Ftast + ! ;                                                                        ' <func> ctrl @ cells ctrlkeys + !                              ' <help>    $1C cells ctrlkeys + !                                                                                                                                              -->             \ expand tabs                                          18oct94py                                                                | Create prefix-found  0 , 0 ,                                                                                                  | : word-lex ( nfa1 nfa2 -- -1/0/1 )                                dup 0=  IF  2drop 1  EXIT  THEN                                 cell+ >r cell+ count $1F and                                    dup r@ c@ $1F and =                                             IF  r> char+ capscomp 0<=  EXIT  THEN                           nip r> c@ $1F and < ;                                                                                                                                                                                                                                                                                                                                                                                                                       -->             \ expand tabs                                          31oct94py: search-prefix  ( addr len1 -- suffix len2 )  0 >r  context      BEGIN  BEGIN  dup @ over  cell- @ =  WHILE  cell-  REPEAT              dup >r -rot r> @ @                                              BEGIN  dup  WHILE  >r dup r@ cell+ c@ $1F and <=                       IF  2dup r@ cell+ char+ capscomp  0=                                IF  r> dup r@ word-lex                                              IF  dup prefix-found @ word-lex                                     0>= IF  rdrop dup >r  THEN                                  THEN >r                                                     THEN                                                        THEN  r> @                                               REPEAT  drop rot cell-  dup vp u> 0=                     UNTIL  drop r> dup prefix-found ! ?dup                          IF    cell+ count $1F and rot /string rot drop                  ELSE  2drop s" "  THEN  ;                     -->             \ expand tabs                                          18oct94py                                                                : extract-word ( addr len -- addr' len' )  dup >r                 BEGIN  1- dup 0>=  WHILE  2dup + c@ bl =  UNTIL  THEN  1+       tuck + r> rot - ;                                             : <tab> ( max span addr pos1 -- max span addr pos2 0 )            prefix-found cell+ @  0 ?DO  <bs> drop  LOOP                    2dup extract-word search-prefix                                 dup prefix-found @ 0<> - prefix-found cell+ !                   bounds ?DO  I c@ tolower <ins>  LOOP                            prefix-found @ IF  bl <ins>  THEN  0 ;                        | : kill-prefix  ( key -- key )                                     dup $FF and #tab <> IF  0 0 prefix-found 2!  THEN ;                                                                         ' kill-prefix IS everychar                                      ' <tab> #tab cells ctrlkeys + !