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

   1 \ SAVE-INPUT and RESTORE-INPUT
   2 \
   3 \ This code is part of pForth.
   4 \
   5 \ The pForth software code is dedicated to the public domain,
   6 \ and any third party may reproduce, distribute and modify
   7 \ the pForth software code or any derivative works thereof
   8 \ without any compensation or license.  The pForth software
   9 \ code is provided on an "as is" basis without any warranty
  10 \ of any kind, including, without limitation, the implied
  11 \ warranties of merchantability and fitness for a particular
  12 \ purpose and their equivalents under the laws of any jurisdiction.
  13
  14 anew task-save-input.fth
  15
  16 private{
  17
  18 : SAVE-BUFFER ( -- column source-id 2 ) >in @ source-id 2 ;
  19
  20 \ Restore >IN from COLUMN unless COLUMN is too large.  Valid values
  21 \ for COLUMN are from 0 to (including) the length of SOURCE plus one.
  22 : RESTORE-COLUMN ( column -- flag )
  23     source nip 1+ over u<
  24     IF   drop  true
  25     ELSE >in ! false
  26     THEN
  27 ;
  28
  29 \ Return the file-position of the beginning of the current line in
  30 \ file SOURCE-ID.  Assume that the current line is stored in SOURCE
  31 \ and that the current file-position is at an end-of-line (or
  32 \ end-of-file).
  33 : LINE-START-POSITION ( -- ud )
  34     source-id file-position throw
  35     \ unless at end-of-file, subtract newline
  36     source-id file-size throw 2over d= 0= IF 1 s>d d- THEN
  37     \ subtract line length
  38     source nip s>d d-
  39 ;
  40
  41 : SAVE-FILE ( column line filepos:ud source-id 5 -- )
  42     >in @
  43     source-line-number@
  44     line-start-position
  45     source-id
  46     5
  47 ;
  48
  49 : RESTORE-FILE ( column line filepos:ud -- flag )
  50     source-id reposition-file  IF 2drop true EXIT THEN
  51     refill                     0= IF 2drop true EXIT THEN
  52     source-line-number!
  53     restore-column
  54 ;
  55
  56 : NDROP ( n*x n -- ) 0 ?DO drop LOOP ;
  57
  58 }private
  59
  60 \ Source      Stack
  61 \ EVALUATE    >IN  SourceID=(-1)  2
  62 \ keyboard    >IN  SourceID=(0)   2
  63 \ file        >IN  lineNumber filePos  SourceID=(fileID) 5
  64 : SAVE-INPUT ( -- column {line filepos}? source-id n )
  65     source-id CASE
  66         -1 OF save-buffer ENDOF
  67         0  OF save-buffer ENDOF
  68         drop save-file EXIT
  69     ENDCASE
  70 ;
  71
  72 : RESTORE-INPUT ( column {line filepos}? source-id n -- flag )
  73     over source-id <> IF ndrop true EXIT THEN
  74     drop
  75     CASE
  76         -1 OF restore-column ENDOF
  77         0  OF restore-column ENDOF
  78         drop restore-file EXIT
  79     ENDCASE
  80 ;
  81
  82 privatize