git.gag.com Git - debian/pforth/blob - fth/history.fth

   1 \ Command Line History\r
   2 \\r
   3 \ Author: Phil Burk\r
   4 \ Copyright 1988 Phil Burk\r
   5 \ Revised 2001 for pForth\r
   6 \r
   7 0 [IF]\r
   8 \r
   9 Requires an ANSI compatible terminal.\r
  10 \r
  11 To get Windows computers to use ANSI mode in their DOS windows,\r
  12 Add this line to "C:\CONFIG.SYS" then reboot.\r
  13   \r
  14   device=c:\windows\command\ansi.sys\r
  15 \r
  16 When command line history is on, you can use the UP and DOWN arrow to scroll\r
  17 through previous commands. Use the LEFT and RIGHT arrows to edit within a line.\r
  18    CONTROL-A moves to beginning of line.\r
  19    CONTROL-E moves to end of line.\r
  20    CONTROL-X erases entire line.\r
  21 \r
  22 \r
  23 HISTORY#       ( -- , dump history buffer with numbers)\r
  24 HISTORY        ( -- , dump history buffer )\r
  25 XX             ( line# -- , execute line x of history )\r
  26 HISTORY.RESET  ( -- , clear history tables )\r
  27 HISTORY.ON     ( -- , install history vectors )\r
  28 HISTORY.OFF    ( -- , uninstall history vectors )\r
  29 \r
  30 [THEN]\r
  31 \r
  32 include? ESC[ termio.fth\r
  33 \r
  34 ANEW TASK-HISTORY.FTH\r
  35 decimal\r
  36 \r
  37 private{\r
  38 \r
  39 \ You can expand the history buffer by increasing this constant!!!!!!!!!!\r
  40 2048 constant KH_HISTORY_SIZE\r
  41 \r
  42 create KH-HISTORY kh_history_size allot\r
  43 KH-HISTORY kh_history_size erase\r
  44 \r
  45 \ An entry in the history buffer consists of\r
  46 \   byte  - Count byte = N,\r
  47 \   chars - N chars,\r
  48 \   short -  line number in Big Endian format,\r
  49 \   byte  - another Count byte = N, for reverse scan\r
  50 \\r
  51 \ The most recent entry is put at the beginning,\r
  52 \ older entries are shifted up.\r
  53 \r
  54 4 constant KH_LINE_EXTRA_SIZE ( 2 count bytes plus 2 size bytes )\r
  55 \r
  56 : KH-END ( -- addr , end of history buffer )\r
  57         kh-history kh_history_size +\r
  58 ;\r
  59 \r
  60 : LINENUM@ ( addr -- w , stores in BigEndian format )\r
  61         dup c@ 8 shift\r
  62         swap 1+ c@ or\r
  63 ;\r
  64 \r
  65 : LINENUM! ( w addr -- )\r
  66         over -8 shift over c!\r
  67         1+ c!\r
  68 ;\r
  69 \r
  70 variable KH-LOOK      ( cursor offset into history, point to 1st count byte of line )\r
  71 variable KH-MAX\r
  72 variable KH-COUNTER       ( 16 bit counter for line # )\r
  73 variable KH-SPAN          ( total number of characters in line )\r
  74 variable KH-MATCH-SPAN    ( span for matching on shift-up )\r
  75 variable KH-CURSOR        ( points to next insertion point )\r
  76 variable KH-ADDRESS       ( address to store chars )\r
  77 variable KH-INSIDE        ( true if we are scrolling inside the history buffer )\r
  78 \r
  79 : KH.MAKE.ROOM ( N -- , make room for N more bytes at beginning)\r
  80         >r  ( save N )\r
  81         kh-history dup r@ + ( source dest )\r
  82         kh_history_size r> - 0 max move\r
  83 ;\r
  84 \r
  85 : KH.NEWEST.LINE  ( -- addr count , most recent line )\r
  86         kh-history count\r
  87 ;\r
  88 \r
  89 : KH.REWIND ( -- , move cursor to most recent line )\r
  90         0 kh-look !\r
  91 ;\r
  92 \r
  93 : KH.CURRENT.ADDR ( -- $addr , count byte of current line )\r
  94         kh-look @ kh-history +\r
  95 ;\r
  96 \r
  97 : KH.CURRENT.LINE ( -- addr count )\r
  98         kh.current.addr count\r
  99 ;\r
 100 \r
 101 : KH.COMPARE ( addr count -- flag , true if redundant )\r
 102         kh.newest.line compare 0=   \ note: ANSI COMPARE is different than JForth days\r
 103 ;\r
 104 \r
 105 : KH.NUM.ADDR ( -- addr , address of current line's line count )\r
 106         kh.current.line +\r
 107 ;\r
 108 \r
 109 : KH.CURRENT.NUM ( -- # , number of current line )\r
 110         kh.num.addr LINENUM@\r
 111 ;\r
 112 \r
 113 : KH.ADDR++  ( $addr -- $addr' , convert one kh to previous )\r
 114         count + 3 +\r
 115 ;\r
 116 : KH.ADDR--  ( $addr -- $addr' , convert one kh to next )\r
 117         dup 1- c@   \ get next lines endcount\r
 118         4 +      \ account for lineNum and two count bytes\r
 119         -       \ calc previous address\r
 120 ;\r
 121 \r
 122 : KH.ENDCOUNT.ADDR ( -- addr , address of current end count )\r
 123         kh.num.addr 2+\r
 124 ;\r
 125 \r
 126 : KH.ADD.LINE ( addr count -- )\r
 127         dup 256 >\r
 128         IF ." KH.ADD.LINE - Too big for history!" 2drop\r
 129         ELSE   ( add to end )\r
 130 \ Compare with most recent line.\r
 131                 2dup kh.compare\r
 132                 IF 2drop\r
 133                 ELSE\r
 134                         >r ( save count )\r
 135 \ Set look pointer to point to first count byte of last string.\r
 136                         0 kh-look !\r
 137 \ Make room for this line of text and line header. \r
 138 \ PLB20100823 Was cell+ which broke on 64-bit code.\r
 139                         r@ KH_LINE_EXTRA_SIZE + kh.make.room\r
 140 \ Set count bytes at beginning and end.\r
 141                         r@ kh-history c!  ( start count )\r
 142                         r@ kh.endcount.addr c!\r
 143                         kh-counter @ kh.num.addr LINENUM!  ( line )\r
 144 \ Number lines modulo 1024\r
 145                         kh-counter @ 1+ $ 3FF and kh-counter !\r
 146                         kh-history 1+   ( calc destination )\r
 147                         r> cmove  ( copy chars into space )\r
 148                 THEN\r
 149         THEN\r
 150 ;\r
 151 \r
 152 : KH.BACKUP.LINE  { | cantmove addr' -- cantmove , advance KH-LOOK if in bounds }\r
 153         true -> cantmove ( default flag, at end of history )\r
 154 \ KH-LOOK points to count at start of current line\r
 155         kh.current.addr c@       \ do we have any lines?\r
 156         IF\r
 157                 kh.current.addr kh.addr++ -> addr'\r
 158                 addr' kh-end U<      \ within bounds?\r
 159                 IF  \r
 160                         addr' c@     \ older line has chars?\r
 161                         IF\r
 162                                 addr' kh-history - kh-look !\r
 163                                 false -> cantmove\r
 164                         THEN\r
 165                 THEN\r
 166         THEN\r
 167         cantmove\r
 168 ;\r
 169 \r
 170 : KH.FORWARD.LINE ( -- cantmove? )\r
 171     kh-look @ 0= dup not\r
 172     IF  kh.current.addr kh.addr--\r
 173         kh-history - kh-look !\r
 174     THEN\r
 175 ;\r
 176 \r
 177 : KH.OLDEST.LINE   ( -- addr count | 0, oldest in buffer )\r
 178     BEGIN kh.backup.line\r
 179     UNTIL\r
 180     kh.current.line dup 0=\r
 181     IF\r
 182         nip\r
 183     THEN\r
 184 ;\r
 185 \r
 186 : KH.FIND.LINE ( line# -- $addr )\r
 187         kh.rewind\r
 188     BEGIN kh.current.num over -\r
 189     WHILE kh.backup.line\r
 190         IF ." Line not in History Buffer!" cr drop 0 exit\r
 191         THEN\r
 192     REPEAT\r
 193     drop kh.current.addr\r
 194 ;\r
 195 \r
 196 \r
 197 : KH-BUFFER ( -- buffer )\r
 198     kh-address @\r
 199 ;\r
 200 \r
 201 : KH.RETURN ( -- , move to beginning of line )\r
 202     0 out !\r
 203     13 emit\r
 204 ;\r
 205 \r
 206 : KH.REPLACE.LINE  ( addr count -- , make this the current line of input )\r
 207     kh.return\r
 208     tio.erase.eol\r
 209     dup kh-span !\r
 210     dup kh-cursor !\r
 211     2dup kh-buffer swap cmove\r
 212     type\r
 213 ;\r
 214 \r
 215 : KH.GET.MATCH ( -- , search for line with same start )\r
 216     kh-match-span @ 0=  ( keep length for multiple matches )\r
 217     IF kh-span @ kh-match-span !\r
 218     THEN\r
 219     BEGIN\r
 220         kh.backup.line not\r
 221     WHILE\r
 222         kh.current.line drop\r
 223         kh-buffer kh-match-span @ text=\r
 224         IF kh.current.line kh.replace.line\r
 225            exit\r
 226         THEN\r
 227     REPEAT\r
 228 ;\r
 229 \r
 230 : KH.FAR.RIGHT\r
 231     kh-span @ kh-cursor @ - dup 0>\r
 232     IF\r
 233         tio.forwards\r
 234         kh-span @ kh-cursor !\r
 235     ELSE drop\r
 236     THEN\r
 237 ;\r
 238 \r
 239 : KH.FAR.LEFT ( -- )\r
 240     kh.return\r
 241     kh-cursor off\r
 242 ;\r
 243 \r
 244 : KH.GET.OLDER ( -- , goto previous line )\r
 245         kh-inside @\r
 246         IF kh.backup.line drop\r
 247         THEN\r
 248         kh.current.line kh.replace.line\r
 249         kh-inside on\r
 250 ;\r
 251 \r
 252 : KH.GET.NEWER ( -- , next line )\r
 253         kh.forward.line\r
 254         IF\r
 255                 kh-inside off\r
 256                 tib 0\r
 257         ELSE  kh.current.line\r
 258         THEN\r
 259         kh.replace.line\r
 260 ;\r
 261 \r
 262 : KH.CLEAR.LINE ( -- , rewind history scrolling and clear line )\r
 263         kh.rewind\r
 264         tib 0 kh.replace.line\r
 265         kh-inside off\r
 266 ;\r
 267 \r
 268 : KH.GO.RIGHT  ( -- )\r
 269     kh-cursor @ kh-span @ <\r
 270     IF 1 kh-cursor +!\r
 271        1 tio.forwards\r
 272     THEN\r
 273 ;\r
 274 \r
 275 : KH.GO.LEFT ( -- )\r
 276     kh-cursor @ ?dup\r
 277     IF 1- kh-cursor !\r
 278        1 tio.backwards\r
 279     THEN\r
 280 ;\r
 281 \r
 282 : KH.REFRESH  ( -- , redraw current line as is )\r
 283         kh.return\r
 284         kh-buffer kh-span @ type\r
 285         tio.erase.eol\r
 286         \r
 287         kh.return\r
 288         kh-cursor @ ?dup \r
 289         IF tio.forwards\r
 290         THEN\r
 291         \r
 292         kh-span @ out !\r
 293 ;\r
 294 \r
 295 : KH.BACKSPACE ( -- , backspace character from buffer and screen )\r
 296     kh-cursor @ ?dup  ( past 0? )\r
 297     IF  kh-span @ <\r
 298         IF  ( inside line )\r
 299             kh-buffer kh-cursor @ +  ( -- source )\r
 300             dup 1- ( -- source dest )\r
 301             kh-span @ kh-cursor @ - cmove\r
 302 \            ." Deleted!" cr \r
 303         ELSE\r
 304             backspace\r
 305         THEN\r
 306         -1 kh-span +!\r
 307         -1 kh-cursor +!\r
 308     ELSE bell\r
 309     THEN\r
 310     kh.refresh\r
 311 ;\r
 312 \r
 313 : KH.DELETE ( -- , forward delete )\r
 314     kh-cursor @ kh-span @ <  ( before end )\r
 315     IF  ( inside line )\r
 316         kh-buffer kh-cursor @ + 1+ ( -- source )\r
 317         dup 1- ( -- source dest )\r
 318         kh-span @ kh-cursor @ - 0 max cmove\r
 319         -1 kh-span +!\r
 320         kh.refresh\r
 321     THEN\r
 322 ;\r
 323     \r
 324 : KH.HANDLE.WINDOWS.KEY ( char -- , handle fkeys or arrows used by Windows ANSI.SYS )\r
 325         CASE\r
 326                 $ 8D OF kh.get.match    ENDOF\r
 327                         0 kh-match-span ! ( reset if any other key )\r
 328                 $ 48 OF kh.get.older    ENDOF\r
 329                 $ 50 OF kh.get.newer  ENDOF\r
 330                 $ 4D OF kh.go.right ENDOF\r
 331                 $ 4B OF kh.go.left  ENDOF\r
 332                 $ 91 OF kh.clear.line  ENDOF\r
 333                 $ 74 OF kh.far.right ENDOF\r
 334                 $ 73 OF kh.far.left  ENDOF\r
 335                 $ 53 OF kh.delete  ENDOF\r
 336         ENDCASE\r
 337 ;\r
 338 \r
 339 : KH.HANDLE.ANSI.KEY ( char -- , handle fkeys or arrows used by ANSI terminal )\r
 340         CASE\r
 341                 $ 41 OF kh.get.older    ENDOF\r
 342                 $ 42 OF kh.get.newer  ENDOF\r
 343                 $ 43 OF kh.go.right ENDOF\r
 344                 $ 44 OF kh.go.left  ENDOF\r
 345         ENDCASE\r
 346 ;\r
 347 \r
 348 \r
 349 : KH.SPECIAL.KEY ( char  -- true | false , handle fkeys or arrows, true if handled )\r
 350         true >r\r
 351         CASE\r
 352         \r
 353         $ E0 OF key kh.handle.windows.key\r
 354         ENDOF\r
 355         \r
 356         ASCII_ESCAPE OF\r
 357                 key dup $ 4F = \ for TELNET\r
 358                 $ 5B = OR \ for regular ANSI terminals\r
 359                 IF\r
 360                         key kh.handle.ansi.key\r
 361                 ELSE\r
 362                         rdrop false >r\r
 363                 THEN\r
 364         ENDOF\r
 365         \r
 366         ASCII_BACKSPACE OF kh.backspace ENDOF\r
 367         ASCII_DELETE    OF kh.backspace ENDOF\r
 368         ASCII_CTRL_X    OF kh.clear.line ENDOF\r
 369         ASCII_CTRL_A    OF kh.far.left ENDOF\r
 370         ASCII_CTRL_E    OF kh.far.right ENDOF\r
 371         \r
 372         rdrop false >r\r
 373         \r
 374         ENDCASE\r
 375         r>\r
 376 ;\r
 377                 \r
 378 : KH.SMART.KEY ( -- char )\r
 379     BEGIN\r
 380         key dup kh.special.key\r
 381     WHILE\r
 382         drop\r
 383     REPEAT\r
 384 ;\r
 385         \r
 386 : KH.INSCHAR  { charc | repaint -- }\r
 387         false -> repaint\r
 388         kh-cursor @ kh-span @ <\r
 389         IF \r
 390 \ Move characters up\r
 391                 kh-buffer kh-cursor @ +  ( -- source )\r
 392                 dup 1+ ( -- source dest )\r
 393                 kh-span @ kh-cursor @ - cmove>\r
 394                 true -> repaint\r
 395         THEN\r
 396 \ write character to buffer\r
 397         charc kh-buffer kh-cursor @ + c!\r
 398         1 kh-cursor +!\r
 399         1 kh-span +!\r
 400         repaint\r
 401         IF kh.refresh\r
 402         ELSE charc emit\r
 403         THEN\r
 404 ;\r
 405 \r
 406 : EOL? ( char -- flag , true if an end of line character )\r
 407         dup 13 =\r
 408         swap 10 = OR\r
 409 ;\r
 410 \r
 411 : KH.GETLINE ( max -- )\r
 412         kh-max !\r
 413         kh-span off\r
 414         kh-cursor off\r
 415         kh-inside off\r
 416         kh.rewind\r
 417         0 kh-match-span !\r
 418         BEGIN\r
 419                 kh-max @ kh-span @ >\r
 420                 IF  kh.smart.key\r
 421                         dup EOL? not  ( <cr?> )\r
 422                 ELSE 0 false\r
 423                 THEN  ( -- char flag )\r
 424         WHILE ( -- char )\r
 425                 kh.inschar\r
 426         REPEAT drop\r
 427         kh-span @ kh-cursor @ - ?dup\r
 428         IF tio.forwards  ( move to end of line )\r
 429         THEN\r
 430         space\r
 431         flushemit\r
 432 ;\r
 433 \r
 434 : KH.ACCEPT ( addr max -- numChars )\r
 435         swap kh-address !\r
 436         kh.getline\r
 437         kh-span @ 0>\r
 438         IF kh-buffer kh-span @ kh.add.line\r
 439         THEN\r
 440         kh-span @\r
 441 ;\r
 442 \r
 443 : TEST.HISTORY\r
 444         4 0 DO\r
 445                 pad 128 kh.accept\r
 446                 cr pad swap type cr\r
 447         LOOP\r
 448 ;\r
 449 \r
 450 }private\r
 451 \r
 452 \r
 453 : HISTORY# ( -- , dump history buffer with numbers)\r
 454         cr kh.oldest.line ?dup\r
 455         IF\r
 456                 BEGIN kh.current.num 3 .r ." ) " type ?pause cr\r
 457                         kh.forward.line 0=\r
 458                 WHILE kh.current.line\r
 459                 REPEAT\r
 460         THEN\r
 461 ;\r
 462 \r
 463 : HISTORY ( -- , dump history buffer )\r
 464         cr kh.oldest.line ?dup\r
 465         IF\r
 466                 BEGIN type ?pause cr\r
 467                         kh.forward.line 0=\r
 468                 WHILE kh.current.line\r
 469                 REPEAT\r
 470         THEN\r
 471 ;\r
 472 \r
 473 : XX  ( line# -- , execute line x of history )\r
 474         kh.find.line ?dup\r
 475         IF count evaluate\r
 476         THEN\r
 477 ;\r
 478 \r
 479 \r
 480 : HISTORY.RESET  ( -- , clear history tables )\r
 481         kh-history kh_history_size erase\r
 482         kh-counter off\r
 483 ;\r
 484 \r
 485 : HISTORY.ON ( -- , install history vectors )\r
 486         history.reset\r
 487         what's accept ['] (accept) =\r
 488         IF ['] kh.accept is accept\r
 489         THEN\r
 490 ;\r
 491 \r
 492 : HISTORY.OFF ( -- , uninstall history vectors )\r
 493         what's accept ['] kh.accept =\r
 494         IF ['] (accept) is accept\r
 495         THEN\r
 496 ;\r
 497 \r
 498 \r
 499 : AUTO.INIT\r
 500         auto.init\r
 501         history.on\r
 502 ;\r
 503 : AUTO.TERM\r
 504         history.off\r
 505         auto.term\r
 506 ;\r
 507 \r
 508 if.forgotten history.off\r
 509 \r
 510 0 [IF]\r
 511 history.reset\r
 512 history.on\r
 513 [THEN]\r