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