home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / CLIPPER / MISC / FFA.ZIP / VIEW.SEQ < prev    next >
Encoding:
Text File  |  1988-01-11  |  8.2 KB  |  196 lines
  1. \ VIEW.SEQ      Viewing code for ZF.                    by Tom Zimmer
  2.  
  3. variable viewlen
  4.  
  5. : >VIEWLINE     ( n1 --- )      \ move to line n1 of currently open file.
  6.                 dup >r 0 shndl @ movepointer
  7.                 inlen off errorline off
  8.                 r> loadline ! ;
  9.  
  10. : <viewlines>   ( n1 n2 --- )
  11.                 loadline @ >r viewlen off
  12.                 swap    0
  13.                 do      lineread dup c@ 0= if drop leave then
  14.                         cr count 2- 0 max
  15.                         i 3 pick =
  16.                         if      >attrib2 type >norm  \ underline it.
  17.                         else        type 77 #OUT @ - QSPACES
  18.                         then    outbuf c@ viewlen +!
  19.                 loop    drop cr r> loadline ! ;
  20.  
  21. : VIEWLINES     ( n1 n2 --- )   \ n1 lines to view, n2 line to underline.
  22.                 >rev shndl @ count type >norm <viewlines> ;
  23.  
  24. : NAME>PAD      ( A1 --- PAD )
  25.                 >r r@ ys: ?cs: pad r> yc@ 31 and 1+ cmovel  \ move name
  26.                 pad c@ 31 and pad c!                        \ clip count
  27.                 pad count + 1- dup c@ 127 and swap c!       \ mask last ch
  28.                 PAD     ;
  29.  
  30. : ?prepend.vpath ( a1 --- a1 )
  31.                 >r r@ 3 + c@ ascii \ =                  \ ? already have path
  32.                 if r> exit then                         \ then leave
  33.                 r@ count viewpath count + swap cmove
  34.                 r@ c@ viewpath c@ +                     \ total length
  35.                 dup r@ c!                               \ to a1
  36.                 viewpath 1+ r@ 1+ rot cmove             \ move data to a1
  37.                 viewpath count + off                    \ erase extra viewpath
  38.                 r> ;                                    \ return a1
  39.  
  40. comment:
  41. : >viewfile     ( cfa --- offset a1 )   \ returns the string name in PAD
  42.                 filelist                \ of the file containing cfa as a1
  43.                 begin   @ 2dup u> until \ step to proper file name.
  44.                 SWAP    >view y@        \ Also returns offset to source def.
  45.                 SWAP    BODY> >NAME name>pad ?prepend.vpath ;
  46. comment;
  47.  
  48. : files_set     ( --- )
  49.                 ['] files >body HERE 500 + #THREADS 2* CMOVE ;
  50.  
  51. : 1file         ( --- false | nfa )
  52.                 HERE 500 + #THREADS LARGEST DUP
  53.                 if      DUP L>NAME >r Y@ SWAP ! r>
  54.                 else    nip
  55.                 then    ;
  56.  
  57. 0 constant maxname
  58. 0 constant maxcfa
  59.  
  60. : >viewfile     ( cfa --- offset a1 )
  61.                 >r files_set 0 =: maxcfa 0 =: maxname
  62.                 begin   1file dup
  63.                 while   r@ over name> u>
  64.                         if      dup name> maxcfa u>
  65.                                 if      dup =: maxname
  66.                                         dup name> =: maxcfa
  67.                                 then
  68.                         then    drop
  69.                 repeat  drop r> >view y@
  70.                 maxname name>pad ?prepend.vpath ;
  71.  
  72. : <VIEW>        ( a1 --- f1 )   \ VIEW the name specified by a1 the cfa
  73.                 >viewfile       ( --- offset f1 )
  74.                 $hopen dup 0=
  75.                 if      swap dark cr
  76.                         >viewline 17 0 viewlines  \ show 17 lines from file.
  77.                 else    nip
  78.                 then    ;
  79.  
  80. variable foundit
  81.  
  82. : <HELP>        ( a1 --- f1 )   \ Show the HELP for a word specified by a1
  83.                 >viewfile >r drop
  84.                 " HLP" ">$ r@ $>ext
  85.                 r> $hopen dup 0=
  86.                 if      inlen off 0.0 seek loadline off
  87.                         ."  Looking..." foundit off
  88.                         8000 1
  89.                         do      lineread c@ 0= ?leave
  90.                                 bl outbuf count + 2- c!
  91.                                      \ have at least 1 blank at end of line.
  92.                                 here count outbuf 1+ swap 1+ caps-comp 0=
  93.                                 if      dark cr ." Line " i u. ." of "
  94.                                         loadline @ >viewline 17 0 viewlines
  95.                                         foundit on leave
  96.                                 then    outbuf c@ loadline +!
  97.                         loop    foundit @ 0=
  98.                         if      ." ..Sorry, no information available"
  99.                         then    cr
  100.                 then    ;
  101.  
  102. : .VIEWHELP     ( --- )
  103. dark
  104. cr cr 24 spaces >rev ."  HELP ME GET STARTED! " >norm
  105. cr cr
  106. ." To obtain help on a particular word,        type: HELP <wordname> <enter>" cr
  107. ." To see the source code for a word,          type: VIEW <wordname> <enter>" cr
  108. ." To find out what commands are available,    type: WORDS <enter>" cr
  109. ."    (space pauses, ESC stops list)" cr
  110. ." To find out which words contain a" cr
  111. ."    particular letter sequence,              type: WORDS <letters> <enter>" cr
  112. ." To see a decompiled source for a word,      type: SEE  <wordname> <enter>" cr
  113. ." To open a file, use VIEW above, or          type: OPEN <filename> <enter>" cr
  114. ." To edit the currently open file,            type: ED <enter>" cr
  115. ."    (press ESC to leave the editor)" cr
  116. ." To create a file, or select a file to edit, type: SED <enter>" cr
  117. cr
  118. ." Type the following command sequence for a couple of examples: cr
  119. cr
  120. 10 spaces ." OPEN INTRO <enter>" cr
  121. 10 spaces ." L <enter>" cr
  122. cr
  123. ." See the accompanying .TXT files for further descriptions of FF." cr ;
  124.  
  125. : VIEW          ( | name --- )  \ VIEW is followed on the same line by name.
  126.                 >in @ span @ 1- >       \ if nothing following command
  127.                 if      .viewhelp       \ display the help screen
  128.                 else    ' <view>
  129.                         if      cr ." File " .file ."  is not available."
  130.                         then
  131.                 then    ;
  132.  
  133. ' view alias LL         ( | name --- )  \ LL is a pseudonym for VIEW
  134.  
  135. : HELP          ( | name --- )  \ VIEW is followed on the same line by name.
  136.                 >in @ span @ 1- >       \ if nothing following command
  137.                 if      .viewhelp       \ display the help screen
  138.                 else    ' <help>
  139.                         if      cr ." File " .file ."  is not available."
  140.                         then
  141.                 then    ;
  142.  
  143. : ?fileopen     ( --- )                 \ Verify a file is open.
  144.                 shndl @ >hndle @ 0<
  145.                 abort" A file MUST be open to perform this operation." ;
  146.  
  147. : L             ( --- )         \ display 18 lines starting at current
  148.                 ?fileopen
  149.                 dark cr           \ loadline marker.
  150.                 loadline @ >viewline
  151.                 18 -1 viewlines ;
  152.  
  153. : LIST          ( n1 --- )      \ n1 is the line number to list from
  154.                 ?fileopen
  155.                 >line L ;
  156.  
  157. : LOAD          ( n1 --- )      \ n1 is the line number to load from
  158.                 ?fileopen
  159.                 >line           \ move to line n1
  160.                 cr ." Loading.." <load>  ;
  161.  
  162. : +lines        ( n1 --- )      \ move forward n1 lines in the current file.
  163.                 loadline @ >viewline
  164.                 0 swap 0
  165.                ?do      lineread c@ + outbuf c@ 0= ?leave
  166.                 loop    loadline +! ;
  167.  
  168. : N             ( --- )         \ go forward 16 lines and display 18 lines.
  169.                 ?fileopen
  170.                 16 +lines L ;
  171.  
  172. : -1line        ( --- )      \ backup 1 line from current loadline
  173.                 loadline @ dup 0> swap 256 - swap
  174.                 if      0 max
  175.                 then    0 shndl @ movepointer
  176.                 0 ( inbuf ) 256 loadline @ dup 0>
  177.                 if      min  else drop then
  178.                 shndl @ INBSEG EXHREAD inlen !
  179.                 inlen @ 0 ( inbuf ) over 2- 0 max bounds swap
  180.                ?do      INBSEG  i c@L 10 =       \ is char an LF
  181.                         if      drop ( inbuf ) inlen @ ( + ) i 1+ -
  182.                                 leave
  183.                         then
  184.             -1 +loop    negate loadline +! ;
  185.  
  186. : -lines        ( n1 --- )      \ backup n1 lines in the current file.
  187.                 0
  188.                ?do      -1line
  189.                loop     ;
  190.  
  191. : B             ( --- )         \ backup 16 lines in current file and
  192.                 ?fileopen
  193.                 16 -lines L ;   \ display 18 lines.
  194.  
  195.  
  196.