git.gag.com Git - debian/pforth/blob - fth/save-input.fth

   1 \ SAVE-INPUT and RESTORE-INPUT
   2
   3 anew task-save-input.fth
   4
   5 private{
   6
   7 : save-buffer ( -- column source-id 2 ) >in @ source-id 2 ;
   8
   9 : restore-column ( column -- flag )
  10     source nip over <
  11     IF   drop  true
  12     ELSE >in ! false
  13     THEN
  14 ;
  15
  16 \ Return the file-position of the beginning of the current line in
  17 \ file SOURCE-ID.  Assume that the current line is stored in SOURCE
  18 \ and that the current file-position is at an end-of-line (or
  19 \ end-of-file).
  20 : line-start-position ( -- ud )
  21     source-id file-position throw
  22     \ unless at end-of-file, subtract newline
  23     source-id file-size throw 2over d= 0= IF 1 s>d d- THEN
  24     \ subtract line length
  25     source nip s>d d-
  26 ;
  27
  28 : save-file ( column line filepos:ud source-id 5 -- )
  29     >in @
  30     source-line-number@
  31     line-start-position
  32     source-id
  33     5
  34 ;
  35
  36 : restore-file ( column line filepos:ud -- flag )
  37     source-id reposition-file  IF 2drop true exit THEN
  38     refill                     0= IF 2drop true exit THEN
  39     source-line-number!
  40     restore-column
  41 ;
  42
  43 : ndrop ( n*x n -- ) 0 ?do drop loop ;
  44
  45 }private
  46
  47 \ Source      Stack
  48 \ EVALUATE    >IN  SourceID=(-1)  2
  49 \ keyboard    >IN  SourceID=(0)   2
  50 \ file        >IN  lineNumber filePos  SourceID=(fileID) 5
  51 : SAVE-INPUT ( -- column {line filepos}? source-id n )
  52     source-id case
  53         -1 of save-buffer endof
  54         0  of save-buffer endof
  55         drop save-file exit
  56     endcase
  57 ;
  58
  59 : RESTORE-INPUT ( column {line filepos}? source-id n -- flag )
  60     over source-id <> IF ndrop true exit THEN
  61     drop
  62     case
  63         -1 of restore-column endof
  64         0  of restore-column endof
  65         drop restore-file exit
  66     endcase
  67 ;
  68
  69 privatize