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