summaryrefslogtreecommitdiffstats
path: root/qemu/roms/SLOF/slof/fs/accept.fs
diff options
context:
space:
mode:
Diffstat (limited to 'qemu/roms/SLOF/slof/fs/accept.fs')
-rw-r--r--qemu/roms/SLOF/slof/fs/accept.fs410
1 files changed, 0 insertions, 410 deletions
diff --git a/qemu/roms/SLOF/slof/fs/accept.fs b/qemu/roms/SLOF/slof/fs/accept.fs
deleted file mode 100644
index 7e8e2717e..000000000
--- a/qemu/roms/SLOF/slof/fs/accept.fs
+++ /dev/null
@@ -1,410 +0,0 @@
-\ *****************************************************************************
-\ * Copyright (c) 2004, 2008 IBM Corporation
-\ * All rights reserved.
-\ * This program and the accompanying materials
-\ * are made available under the terms of the BSD License
-\ * which accompanies this distribution, and is available at
-\ * http://www.opensource.org/licenses/bsd-license.php
-\ *
-\ * Contributors:
-\ * IBM Corporation - initial implementation
-\ ****************************************************************************/
-
-
-\ Implementation of ACCEPT. Using ECMA-48 for terminal control.
-
-: beep bell emit ;
-
-: TABLE-EXECUTE
- CREATE DOES> swap cells+ @ ?dup IF execute ELSE beep THEN ;
-
-0 VALUE accept-adr
-0 VALUE accept-max
-0 VALUE accept-len
-0 VALUE accept-cur
-
-: esc 1b emit ;
-: csi esc 5b emit ;
-
-: move-cursor ( -- )
- esc ." 8" accept-cur IF
- csi base @ decimal accept-cur 0 .r base ! ." C"
- THEN
-;
-
-: redraw-line ( -- )
- accept-cur accept-len = IF EXIT THEN
- move-cursor
- accept-adr accept-len accept-cur /string type
- csi ." K" move-cursor
-;
-
-: full-redraw-line ( -- )
- accept-cur 0 to accept-cur move-cursor
- accept-adr accept-len type
- csi ." K" to accept-cur move-cursor
-;
-
-: redraw-prompt ( -- )
- cr depth . [char] > emit
-;
-
-: insert-char ( char -- )
- accept-len accept-max = IF drop beep EXIT THEN
- accept-cur accept-len <> IF csi ." @" dup emit
- accept-adr accept-cur + dup 1+ accept-len accept-cur - move
- ELSE dup emit THEN
- accept-adr accept-cur + c!
- accept-cur 1+ to accept-cur
- accept-len 1+ to accept-len redraw-line
-;
-
-: delete-char ( -- )
- accept-cur accept-len = IF beep EXIT THEN
- accept-len 1- to accept-len
- accept-adr accept-cur + dup 1+ swap accept-len accept-cur - move
- csi ." P" redraw-line
-;
-
-\ *
-\ * History handling
-\ *
-
-STRUCT
-cell FIELD his>next
-cell FIELD his>prev
-cell FIELD his>len
- 0 FIELD his>buf
-CONSTANT /his
-0 VALUE his-head
-0 VALUE his-tail
-0 VALUE his-cur
-
-: add-history ( -- )
- accept-len 0= IF EXIT THEN
- /his accept-len + alloc-mem
- his-tail IF dup his-tail his>next ! ELSE dup to his-head THEN
- his-tail over his>prev ! 0 over his>next ! dup to his-tail
- accept-len over his>len ! accept-adr swap his>buf accept-len move
-;
-
-: history ( -- )
- his-head BEGIN dup WHILE
- cr dup his>buf over his>len @ type
- his>next @ REPEAT drop
-;
-
-: select-history ( his -- )
- dup to his-cur dup IF
- dup his>len @ accept-max min dup to accept-len to accept-cur
- his>buf accept-adr accept-len move ELSE
- drop 0 to accept-len 0 to accept-cur THEN
- full-redraw-line
-;
-
-
-\
-\ tab completion
-\
-
-\ tab completion state variables
-0 value ?tab-pressed
-0 value tab-last-adr
-0 value tab-last-len
-
-\ compares two strings and returns the longest equal substring.
-: $same-string ( addr-1 len-1 addr-2 len-2 -- addr-1 len-1' )
- dup 0= IF \ The second parameter is not a string.
- 2drop EXIT \ bail out
- THEN
- rot min 0 0 -rot ( addr1 addr2 0 len' 0 )
- DO ( addr1 addr2 len-1' )
- 2 pick i + c@ lcc
- 2 pick i + c@ lcc
- = IF 1 + ELSE leave THEN
- LOOP
- nip
-;
-
-: $tab-sift-words ( text-addr text-len -- sift-count )
- sift-compl-only >r true to sift-compl-only \ save sifting mode
-
- last BEGIN @ ?dup WHILE \ loop over all words
- $inner-sift IF \ any completions possible?
- \ convert to lower case for user interface sanity
- 2dup bounds DO I c@ lcc I c! LOOP
- ?tab-pressed IF 2dup type space THEN \ <tab><tab> prints possibilities
- tab-last-adr tab-last-len $same-string \ find matching substring ...
- to tab-last-len to tab-last-adr \ ... and save it
- THEN
- repeat
- 2drop
-
- #sift-count 0 to #sift-count \ how many words were found?
- r> to sift-compl-only \ restore sifting completion mode
-;
-
-\ 8< node sifting for tab completion on device tree nodes below this line 8<
-
-#include <stack.fs>
-
-10 new-stack device-stack
-
-: (next-dev) ( node -- node' addr len )
- device-stack
- dup (node>path) rot
- dup child IF dup push child -rot EXIT THEN
- dup peer IF peer -rot EXIT THEN
- drop
- BEGIN
- stack-depth
- WHILE
- pop peer ?dup IF -rot EXIT THEN
- REPEAT
- 0 -rot
-;
-
-: $inner-sift-nodes ( text-addr text-len node -- ... path-addr path-len true | false )
- (next-dev) ( text-addr text-len node' path-addr path-len )
- dup 0= IF drop false EXIT THEN
- 2dup 6 pick 6 pick find-isubstr ( text-addr text-len node' path-addr path-len pos )
- 0= IF
- #sift-count 1+ to #sift-count \ count completions
- true
- ELSE
- 2drop false
- THEN
-;
-
-\
-\ test function for (next-dev)
-: .nodes ( -- )
- s" /" find-node BEGIN dup WHILE
- (next-dev)
- type cr
- REPEAT
- drop
- reset-stack
-;
-
-\ node sifting wants its own pockets
-create sift-node-buffer 1000 allot
-0 value sift-node-num
-: sift-node-buffer
- sift-node-buffer sift-node-num 100 * +
- sift-node-num 1+ dup 10 = IF drop 0 THEN
- to sift-node-num
-;
-
-: $tab-sift-nodes ( text-addr text-len -- sift-count )
- s" /" find-node BEGIN dup WHILE
- $inner-sift-nodes IF \ any completions possible?
- sift-node-buffer swap 2>r 2r@ move 2r> \ make an almost permanent copy without strdup
- ?tab-pressed IF 2dup type space THEN \ <tab><tab> prints possibilities
- tab-last-adr tab-last-len $same-string \ find matching substring ...
- to tab-last-len to tab-last-adr \ ... and save it
- THEN
- REPEAT
- 2drop drop
- #sift-count 0 to #sift-count \ how many words were found?
- reset-stack
-;
-
-: $tab-sift ( text-addr text-len -- sift-count )
- ?tab-pressed IF beep space THEN \ cosmetical fix for <tab><tab>
-
- dup IF bl rsplit dup IF 2swap THEN ELSE 0 0 THEN >r >r
-
- 0 dup to tab-last-len to tab-last-adr \ reset last possible match
- current-node @ IF \ if we are in a node?
- 2dup 2>r \ save text
- $tab-sift-words to #sift-count \ search in current node first
- 2r> \ fetch text to complete, again
- THEN
- 2dup 2>r
- current-node @ >r 0 set-node \ now search in global words
- $tab-sift-words to #sift-count
- r> set-node
- 2r> $tab-sift-nodes
- \ concatenate previous commands
- r> r> dup IF s" " $cat THEN tab-last-adr tab-last-len $cat
- to tab-last-len to tab-last-adr \ ... and save the whole string
-;
-
-\ 8< node sifting for tab completion on device tree nodes above this line 8<
-
-: handle-^A
- 0 to accept-cur move-cursor ;
-: handle-^B
- accept-cur ?dup IF 1- to accept-cur ( csi ." D" ) move-cursor THEN ;
-: handle-^D
- delete-char ( redraw-line ) ;
-: handle-^E
- accept-len to accept-cur move-cursor ;
-: handle-^F
- accept-cur accept-len <> IF accept-cur 1+ to accept-cur csi ." C" THEN ;
-: handle-^H
- accept-cur 0= IF beep EXIT THEN
- handle-^B delete-char
-;
-: handle-^I
- accept-adr accept-len
- $tab-sift 0 > IF
- ?tab-pressed IF
- redraw-prompt full-redraw-line
- false to ?tab-pressed
- ELSE
- tab-last-adr accept-adr tab-last-len move \ copy matching substring
- tab-last-len dup to accept-len to accept-cur \ len and cursor position
- full-redraw-line \ redraw new string
- true to ?tab-pressed \ second tab will print possible matches
- THEN
- THEN
-;
-
-: handle-^K
- BEGIN accept-cur accept-len <> WHILE delete-char REPEAT ;
-: handle-^L
- history redraw-prompt full-redraw-line ;
-: handle-^N
- his-cur IF his-cur his>next @ ELSE his-head THEN
- dup to his-cur select-history
-;
-: handle-^P
- his-cur IF his-cur his>prev @ ELSE his-tail THEN
- dup to his-cur select-history
-;
-: handle-^Q \ Does not handle terminal formatting yet.
- key insert-char ;
-: handle-^R
- full-redraw-line ;
-: handle-^U
- 0 to accept-len 0 to accept-cur full-redraw-line ;
-
-: handle-fn
- key drop beep
-;
-
-TABLE-EXECUTE handle-CSI
-0 , ' handle-^P , ' handle-^N , ' handle-^F ,
-' handle-^B , 0 , 0 , 0 ,
-' handle-^A , 0 , 0 , ' handle-^E ,
-0 , 0 , 0 , 0 ,
-0 , 0 , 0 , 0 ,
-0 , 0 , 0 , 0 ,
-0 , 0 , 0 , 0 ,
-0 , 0 , 0 , 0 ,
-
-TABLE-EXECUTE handle-meta
-0 , 0 , 0 , 0 ,
-0 , 0 , 0 , 0 ,
-0 , 0 , 0 , 0 ,
-0 , 0 , 0 , ' handle-fn ,
-0 , 0 , 0 , 0 ,
-0 , 0 , 0 , 0 ,
-0 , 0 , 0 , ' handle-CSI ,
-0 , 0 , 0 , 0 ,
-
-: handle-ESC-O
- key
- dup 48 = IF
- handle-^A
- ELSE
- dup 46 = IF
- handle-^E
- THEN
- THEN drop
-;
-
-: handle-ESC-5b
- key
- dup 31 = IF \ HOME
- key drop ( drops closing 7e ) handle-^A
- ELSE
- dup 33 = IF \ DEL
- key drop handle-^D
- ELSE
- dup 34 = IF \ END
- key drop handle-^E
- ELSE
- dup 1f and handle-CSI
- THEN
- THEN
- THEN drop
-;
-
-: handle-ESC
- key
- dup 5b = IF
- handle-ESC-5b
- ELSE
- dup 4f = IF
- handle-ESC-O
- ELSE
- dup 1f and handle-meta
- THEN
- THEN drop
-;
-
-TABLE-EXECUTE handle-control
-0 , \ ^@:
-' handle-^A ,
-' handle-^B ,
-0 , \ ^C:
-' handle-^D ,
-' handle-^E ,
-' handle-^F ,
-0 , \ ^G:
-' handle-^H ,
-' handle-^I , \ tab
-0 , \ ^J:
-' handle-^K ,
-' handle-^L ,
-0 , \ ^M: enter: handled in main loop
-' handle-^N ,
-0 , \ ^O:
-' handle-^P ,
-' handle-^Q ,
-' handle-^R ,
-0 , \ ^S:
-0 , \ ^T:
-' handle-^U ,
-0 , \ ^V:
-0 , \ ^W:
-0 , \ ^X:
-0 , \ ^Y: insert save buffer
-0 , \ ^Z:
-' handle-ESC ,
-0 , \ ^\:
-0 , \ ^]:
-0 , \ ^^:
-0 , \ ^_:
-
-: (accept) ( adr len -- len' )
- cursor-on
- to accept-max to accept-adr
- 0 to accept-len 0 to accept-cur
- 0 to his-cur
- 1b emit 37 emit
- BEGIN
- key dup 0d <>
- WHILE
- dup 9 <> IF 0 to ?tab-pressed THEN \ reset state machine
- dup 7f = IF drop 8 THEN \ Handle DEL as if it was BS. ??? bogus
- dup bl < IF handle-control ELSE
- dup 80 and IF
- dup a0 < IF 7f and handle-meta ELSE drop beep THEN
- ELSE
- insert-char
- THEN
- THEN
- REPEAT
- drop add-history
- accept-len to accept-cur
- move-cursor space
- accept-len
- cursor-off
-;
-
-' (accept) to accept
-