gforth/history.fs - view

File: [gforth] / gforth / history.fs
Revision 1.15: download - view: text, annotated - select for diffs
Mon Sep 1 23:07:07 1997 UTC (26 years, 7 months ago) by jwilke
Branches: MAIN
CVS tags: HEAD

Dos Changes:
!!Moved:
engine/32bit.h moved to arch/generic/machine.h
cache.c moved to arch/hppa/
cleanalign.c moved to engine/
!!New Files:
envos.* *.bsh
Instead of linking arch/xy/machine.h an custom include path is used
engine.a engine.o main.o makes with engine/Makefile now
history.fs and startup.fs works for dos and unix now
environment variable osclass is set in envos.fs, wich is os-specific
any comments?
supressed some warnings in main.c

1: \ command line edit and history support 16oct94py 2: 3: \ Copyright (C) 1995 Free Software Foundation, Inc. 4: 5: \ This file is part of Gforth. 6: 7: \ Gforth is free software; you can redistribute it and/or 8: \ modify it under the terms of the GNU General Public License 9: \ as published by the Free Software Foundation; either version 2 10: \ of the License, or (at your option) any later version. 11: 12: \ This program is distributed in the hope that it will be useful, 13: \ but WITHOUT ANY WARRANTY; without even the implied warranty of 14: \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15: \ GNU General Public License for more details. 16: 17: \ You should have received a copy of the GNU General Public License 18: \ along with this program; if not, write to the Free Software 19: \ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 20: 21: :noname 22: char [char] @ - ; 23: :noname 24: char [char] @ - postpone Literal ; 25: interpret/compile: ctrl ( "<char>" -- ctrl-code ) 26: 27: \ command line editing 16oct94py 28: 29: : >string ( span addr pos1 -- span addr pos1 addr2 len ) 30: over 3 pick 2 pick chars /string ; 31: : type-rest ( span addr pos1 -- span addr pos1 back ) 32: >string tuck type ; 33: : (del) ( max span addr pos1 -- max span addr pos2 ) 34: 1- >string over 1+ -rot move 35: rot 1- -rot #bs emit type-rest bl emit 1+ backspaces ; 36: : (ins) ( max span addr pos1 char -- max span addr pos2 ) 37: >r >string over 1+ swap move 2dup chars + r> swap c! 38: rot 1+ -rot type-rest 1- backspaces 1+ ; 39: : ?del ( max span addr pos1 -- max span addr pos2 0 ) 40: dup IF (del) THEN 0 ; 41: : (ret) type-rest drop true space ; 42: : back dup IF 1- #bs emit ELSE #bell emit THEN 0 ; 43: : forw 2 pick over <> IF 2dup + c@ emit 1+ ELSE #bell emit THEN 0 ; 44: : eof 2 pick over or 0= IF 45: bye 46: ELSE 2 pick over <> 47: IF forw drop (del) ELSE #bell emit THEN 0 48: THEN ; 49: 50: ' forw ctrl F cells ctrlkeys + ! 51: ' back ctrl B cells ctrlkeys + ! 52: ' ?del ctrl H cells ctrlkeys + ! 53: ' eof ctrl D cells ctrlkeys + ! 54: 55: ' (ins) IS insert-char 56: 57: \ history support 16oct94py 58: 59: 0 Value history \ history file fid 60: 61: 2Variable forward^ 62: 2Variable backward^ 63: 2Variable end^ 64: 65: : force-open ( addr len -- fid ) 66: 2dup r/w open-file 0< 67: IF drop r/w create-file throw ELSE nip nip THEN ; 68: 69: : get-history ( addr len -- ) 70: force-open to history 71: history file-size throw 72: 2dup forward^ 2! 2dup backward^ 2! end^ 2! ; 73: 74: s" os-class" environment? [IF] s" unix" compare 0= [ELSE] true [THEN] 75: [IF] 76: : history-cold 77: s" GFORTHHIST" getenv dup 0= IF 78: 2drop s" ~/.gforth-history" 79: THEN get-history ; 80: [ELSE] 81: 82: : history-dir 83: s" TMP" getenv ?dup ?EXIT drop 84: s" TEMP" getenv ?dup ?EXIT drop 85: s" c:/" ; 86: 87: : history-file 88: s" GFORTHHIST" getenv ?dup ?EXIT 89: drop 90: history-dir pad place 91: s" /ghist.txt" pad +place pad count ; 92: 93: : history-cold 94: history-file 95: get-history ; 96: [THEN] 97: 98: ' history-cold INIT8 chained 99: history-cold 100: 101: \ moving in history file 16oct94py 102: 103: : clear-line ( max span addr pos1 -- max addr ) 104: backspaces over spaces swap backspaces ; 105: 106: : clear-tib ( max span addr pos -- max 0 addr 0 false ) 107: clear-line 0 tuck dup ; 108: 109: : hist-pos ( -- ud ) history file-position throw ; 110: : hist-setpos ( ud -- ) history reposition-file throw ; 111: 112: : get-line ( addr len -- len' flag ) 113: swap history read-line throw ; 114: 115: : next-line ( max span addr pos1 -- max span addr pos2 false ) 116: clear-line 117: forward^ 2@ 2dup hist-setpos backward^ 2! 118: 2dup get-line drop 119: hist-pos forward^ 2! 120: tuck 2dup type 0 ; 121: 122: : prev-line ( max span addr pos1 -- max span addr pos2 false ) 123: clear-line backward^ 2@ forward^ 2! 124: over 2 + negate s>d backward^ 2@ d+ 0. dmax 2dup hist-setpos 125: BEGIN 126: backward^ 2! 2dup get-line WHILE 127: hist-pos 2dup forward^ 2@ d< WHILE 128: rot drop 129: REPEAT 2drop THEN 130: tuck 2dup type 0 ; 131: 132: Create lfpad #lf c, 133: 134: : (enter) ( max span addr pos1 -- max span addr pos2 true ) 135: >r end^ 2@ hist-setpos 136: 2dup swap history write-line throw 137: hist-pos 2dup backward^ 2! end^ 2! 138: r> (ret) ; 139: 140: \ some other key commands 16oct94py 141: 142: : first-pos ( max span addr pos1 -- max span addr 0 0 ) 143: backspaces 0 0 ; 144: : end-pos ( max span addr pos1 -- max span addr span 0 ) 145: type-rest 2drop over 0 ; 146: 147: : extract-word ( addr len -- addr' len' ) dup >r 148: BEGIN 1- dup 0>= WHILE 2dup + c@ bl = UNTIL THEN 1+ 149: tuck + r> rot - ; 150: 151: Create prefix-found 0 , 0 , 152: 153: : word-lex ( nfa1 nfa2 -- -1/0/1 ) 154: dup 0= 155: IF 156: 2drop 1 EXIT 157: THEN 158: name>string 2>r name>string 159: dup r@ = 160: IF 161: rdrop r> capscomp 0<= EXIT 162: THEN 163: r> < 164: nip rdrop ; 165: 166: : search-voc ( addr len nfa1 nfa2 -- addr len nfa3 ) 167: >r 168: BEGIN 169: dup 170: WHILE 171: >r dup r@ name>string nip <= 172: IF 173: 2dup r@ name>string drop capscomp 0= 174: IF 175: r> dup r@ word-lex 176: IF 177: dup prefix-found @ word-lex 178: 0>= 179: IF 180: rdrop dup >r 181: THEN 182: THEN 183: >r 184: THEN 185: THEN 186: r> @ 187: REPEAT 188: drop r> ; 189: 190: : prefix-string ( addr len nfa -- addr' len' ) 191: dup prefix-found ! ?dup 192: IF 193: name>string rot /string rot drop 194: dup 1+ prefix-found cell+ ! 195: ELSE 196: 2drop s" " prefix-found cell+ off 197: THEN ; 198: 199: : search-prefix ( addr1 len1 -- addr2 len2 ) 200: 0 vp dup @ 1- cells over + 201: DO I 2@ <> 202: IF I cell+ @ @ swap search-voc THEN 203: [ -1 cells ] Literal +LOOP 204: prefix-string ; 205: 206: : kill-expand ( max span addr pos1 -- max span addr pos2 ) 207: prefix-found cell+ @ 0 ?DO (del) LOOP ; 208: 209: : tib-full? ( max span addr pos addr' len' -- max span addr pos addr1 u flag ) 210: 5 pick over 4 pick + prefix-found @ 0<> - < ; 211: 212: : tab-expand ( max span addr pos1 -- max span addr pos2 0 ) 213: kill-expand 2dup extract-word search-prefix 214: tib-full? 215: IF 7 emit 2drop 0 0 prefix-found 2! 216: ELSE bounds ?DO I c@ (ins) LOOP THEN 217: prefix-found @ IF bl (ins) THEN 0 ; 218: 219: : kill-prefix ( key -- key ) 220: dup #tab <> IF 0 0 prefix-found 2! THEN ; 221: 222: ' kill-prefix IS everychar 223: 224: ' next-line ctrl N cells ctrlkeys + ! 225: ' prev-line ctrl P cells ctrlkeys + ! 226: ' clear-tib ctrl K cells ctrlkeys + ! 227: ' first-pos ctrl A cells ctrlkeys + ! 228: ' end-pos ctrl E cells ctrlkeys + ! 229: ' (enter) #lf cells ctrlkeys + ! 230: ' (enter) #cr cells ctrlkeys + ! 231: ' tab-expand #tab cells ctrlkeys + !