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 \ Permission to use, copy, modify, and/or distribute this
   6 \ software for any purpose with or without fee is hereby granted.
   7 \
   8 \ THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL
   9 \ WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED
  10 \ WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL
  11 \ THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR
  12 \ CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING
  13 \ FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF
  14 \ CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
  15 \ OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
  16
  17 anew task-save-input.fth
  18
  19 private{
  20
  21 : SAVE-BUFFER ( -- column source-id 2 ) >in @ source-id 2 ;
  22
  23 \ Restore >IN from COLUMN unless COLUMN is too large.  Valid values
  24 \ for COLUMN are from 0 to (including) the length of SOURCE plus one.
  25 : RESTORE-COLUMN ( column -- flag )
  26     source nip 1+ over u<
  27     IF   drop  true
  28     ELSE >in ! false
  29     THEN
  30 ;
  31
  32 \ Return the file-position of the beginning of the current line in
  33 \ file SOURCE-ID.  Assume that the current line is stored in SOURCE
  34 \ and that the current file-position is at an end-of-line (or
  35 \ end-of-file).
  36 : LINE-START-POSITION ( -- ud )
  37     source-id file-position throw
  38     \ unless at end-of-file, subtract newline
  39     source-id file-size throw 2over d= 0= IF 1 s>d d- THEN
  40     \ subtract line length
  41     source nip s>d d-
  42 ;
  43
  44 : SAVE-FILE ( column line filepos:ud source-id 5 -- )
  45     >in @
  46     source-line-number@
  47     line-start-position
  48     source-id
  49     5
  50 ;
  51
  52 : RESTORE-FILE ( column line filepos:ud -- flag )
  53     source-id reposition-file  IF 2drop true EXIT THEN
  54     refill                     0= IF 2drop true EXIT THEN
  55     source-line-number!
  56     restore-column
  57 ;
  58
  59 : NDROP ( n*x n -- ) 0 ?DO drop LOOP ;
  60
  61 }private
  62
  63 \ Source      Stack
  64 \ EVALUATE    >IN  SourceID=(-1)  2
  65 \ keyboard    >IN  SourceID=(0)   2
  66 \ file        >IN  lineNumber filePos  SourceID=(fileID) 5
  67 : SAVE-INPUT ( -- column {line filepos}? source-id n )
  68     source-id CASE
  69         -1 OF save-buffer ENDOF
  70         0  OF save-buffer ENDOF
  71         drop save-file EXIT
  72     ENDCASE
  73 ;
  74
  75 : RESTORE-INPUT ( column {line filepos}? source-id n -- flag )
  76     over source-id <> IF ndrop true EXIT THEN
  77     drop
  78     CASE
  79         -1 OF restore-column ENDOF
  80         0  OF restore-column ENDOF
  81         drop restore-file EXIT
  82     ENDCASE
  83 ;
  84
  85 privatize