home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / forth / compiler / f88 / view.bak < prev   
Text File  |  1988-06-07  |  9KB  |  248 lines
  1. \ VIEW.SEQ      Viewing code for ZF.                    by Tom Zimmer
  2.  
  3. mbuf.init \ buffer in ram for a screen
  4.  
  5. variable viewlen
  6.  
  7. : >VIEWLINE     ( n1 --- )      \ move to line n1 of currently open file.
  8.     dup >r 0 shndl @ movepointer
  9.     ibreset errorline off
  10.     r> loadline ! ;
  11.  
  12. : <viewlines>   ( n1 n2 --- )
  13.     loadline @ >r viewlen off
  14.     swap    0
  15.     do      lineread dup c@ 0= if drop leave then
  16.             cr count 2- 0 max
  17.             i 3 pick =
  18.             if      >attrib2 type >norm  \ underline it.
  19.             else        type 77 #out @ - spaces
  20.             then    outbuf c@ viewlen +!
  21.     loop    drop cr r> loadline ! ;
  22.  
  23. : VIEWLINES     ( n1 n2 --- )   \ n1 lines to view, n2 line to underline.
  24.     >attrib4 shndl @ count type >norm <viewlines> ;
  25.  
  26. : NAME>PAD      ( A1 --- PAD )
  27.     >r r@ ys: ?cs: pad r> yc@ 31 and 1+ cmovel  \ move name
  28.     pad c@ 31 and pad c!                        \ clip count
  29.     pad count + 1- dup c@ 127 and swap c!       \ mask last ch
  30.     PAD     ;
  31.  
  32. : ?prepend.vpath ( a1 --- a1 )
  33.     >r r@ 3 + c@ ascii \ =                  \ ? already have path
  34.     if r> exit then                         \ then leave
  35.     r@ count viewpath count + swap cmove
  36.     r@ c@ viewpath c@ +                     \ total length
  37.     dup r@ c!                               \ to a1
  38.     viewpath 1+ r@ 1+ rot cmove             \ move data to a1
  39.     viewpath count + off                    \ erase extra viewpath
  40.     r> ;                                    \ return a1
  41.  
  42. comment:
  43. : >viewfile     ( cfa --- offset a1 )   \ returns the string name in PAD
  44.     filelist                \ of the file containing cfa as a1
  45.     begin   @ 2dup u> until \ step to proper file name.
  46.     SWAP    >view y@        \ Also returns offset to source def.
  47.     SWAP    BODY> >NAME name>pad ?prepend.vpath ;
  48. comment;
  49.  
  50. : files_set     ( --- )
  51.     ['] files >body HERE 500 + #THREADS 2* CMOVE ;
  52.  
  53. : 1file         ( --- false | nfa )
  54.     HERE 500 + #THREADS LARGEST DUP
  55.     if      DUP L>NAME >r Y@ SWAP ! r>
  56.     else    nip
  57.     then    ;
  58.  
  59. 0 constant maxname
  60. 0 constant maxcfa
  61.  
  62. : >viewfile     ( cfa --- offset a1 )
  63.     >r files_set 0 =: maxcfa 0 =: maxname
  64.     begin   1file dup
  65.     while   r@ over name> u>
  66.             if      dup name> maxcfa u>
  67.                     if      dup =: maxname
  68.                             dup name> =: maxcfa
  69.                     then
  70.             then    drop
  71.     repeat  drop r> >view y@
  72.     maxname name>pad ?prepend.vpath ;
  73.  
  74. : <VIEW>        ( a1 --- f1 )   \ VIEW the name specified by a1 the cfa
  75.     >viewfile       ( --- offset f1 )
  76.     $hopen dup 0=
  77.     if      swap CLS 0 1 at  \ dark cr
  78.             >viewline 21 0 viewlines  \ show 21 (was 17) lines from file.
  79.     else    nip
  80.     then    ;
  81.  
  82. variable foundit
  83.  
  84. : <HELP>        ( a1 --- f1 )   \ Show the HELP for a word specified by a1
  85.     >viewfile >r drop
  86.     " HLP" ">$ r@ $>ext
  87.     r> $hopen dup 0=
  88.     if      ibreset 0.0 seek loadline off
  89.             ."  Looking..." foundit off
  90.             8000 1
  91.             do      lineread c@ 0= ?leave
  92.                     bl outbuf count + 2- c!
  93.                          \ have at least 1 blank at end of line.
  94.                     here count outbuf 1+ swap 1+ caps-comp 0=
  95.                     if      dark cr ." Line " i u. ." of "
  96.                             loadline @ >viewline 21 0 viewlines
  97.                             foundit on leave
  98.                     then    outbuf c@ loadline +!
  99.             loop    foundit @ 0=
  100.             if      ." ..Sorry, no information available"
  101.             then    cr
  102.     then    ;
  103.  
  104. : .VIEWHELP     ( --- )
  105. cursor-off dark
  106. mbuf.prep
  107. >attrib4 0 2 at ."  HELP ME GET STARTED! " >norm
  108. 0 4 at
  109. ." To obtain help on a particular word,        type: HELP <wordname> <enter>"
  110. 0 5 at
  111. ." To see the source code for a word,          type: VIEW <wordname> <enter>"
  112. 0 6 at
  113. ." To find out what commands are available,    type: WORDS <enter>"
  114. 0 7 at
  115. ."    (space pauses, ESC stops list)"
  116. 0 8 at
  117. ." To find out which words contain a"
  118. 0 9 at
  119. ."    particular letter sequence,              type: WORDS <letters> <enter>"
  120. 0 10 at
  121. ." To see a decompiled source for a word,      type: SEE  <wordname> <enter>"
  122. 0 11 at
  123. ." To open a file, use VIEW above, or          type: OPEN <filename> <enter>"
  124. 0 12 at
  125. ." To edit the currently open file,            type: ED <enter>"
  126. 0 13 at
  127. ."    (press ESC to leave the editor)"
  128. 0 14 at
  129. ." To create a file, or select a file to edit, type: SED <enter>"
  130. 0 16 at
  131. ." Type the following command sequence for a couple of examples:"
  132. 11 18 at >attrib1 ." OPEN INTRO <enter>"
  133. 11 19 at ." L <enter>" >norm
  134. 0 21 at
  135. ." See the accompanying .TXT files for further descriptions of FF."
  136.  movem  mbuf.off
  137. 0 22 at cursor-on ;
  138.  
  139. comment:
  140. \ This is how paging works. Copy this word to a small test file.
  141. : testview
  142.     savescr cls
  143.     page2 .viewhelp 2 >page
  144.     60 tillkey
  145.     page0 restscr 0 >page ;
  146. comment;
  147.  
  148. : VIEW          ( | name --- )  \ VIEW is followed on the same line by name.
  149.     >in @ span @ 1- >       \ if nothing following command
  150.     if      .viewhelp       \ display the help screen
  151.     else    ' <view>
  152.             if      cr ." File " .file ."  is not available."
  153.             then
  154.     then    ;
  155.  
  156. ' view alias LL         ( | name --- )  \ LL is a pseudonym for VIEW
  157.  
  158. : HELP          ( | name --- )  \ VIEW is followed on the same line by name.
  159.     >in @ span @ 1- >       \ if nothing following command
  160.     if      .viewhelp       \ display the help screen
  161.     else    ' <help>
  162.             if      cr ." File " .file ."  is not available."
  163.             then
  164.     then    ;
  165.  
  166. : ?fileopen     ( --- )                 \ Verify a file is open.
  167.     shndl @ >hndle @ 0<
  168.     abort" A file MUST be open to perform this operation." ;
  169.  
  170. : L             ( --- )         \ display (18) lines starting at current
  171.     ?fileopen
  172.     dark cr           \ loadline marker.
  173.     loadline @ >viewline
  174.     21 -1 viewlines ;
  175.  
  176. : LIST          ( n1 --- )      \ n1 is the line number to list from
  177.     ?fileopen
  178.     >line L ;
  179.  
  180. : LOAD          ( n1 --- )      \ n1 is the line number to load from
  181.     ?fileopen
  182.     >line           \ move to line n1
  183.     cr ." Loading.." <load>  ;
  184.  
  185. : +lines        ( n1 --- )      \ move forward n1 lines in the current file.
  186.     loadline @ >viewline
  187.     0 swap 0
  188.    ?do      lineread c@ + outbuf c@ 0= ?leave
  189.     loop    loadline +! ;
  190.  
  191. : N             ( --- )         \ go forward 16 lines and display 18 lines.
  192.     ?fileopen
  193.     16 +lines L ;
  194.  
  195. : -1line        ( --- )      \ backup 1 line from current loadline
  196.     loadline @ dup 0> swap 256 - swap
  197.     if      0 max
  198.     then    0 shndl @ movepointer
  199.     IBRESET INSTART
  200.      256 loadline @ dup 0>
  201.     if      min  else drop then
  202.     shndl @ INBSEG EXHREAD =: inlength
  203.     inlength INSTART over 2- 0 max bounds swap
  204.    ?do      INBSEG  i c@L 10 =       \ is char an LF
  205.             if      drop INSTART inlength  +  i 1+ -
  206.                     leave
  207.             then
  208. -1 +loop    negate loadline +! ;
  209.  
  210. : -lines        ( n1 --- )      \ backup n1 lines in the current file.
  211.     0
  212.    ?do      -1line
  213.    loop     ;
  214.  
  215. : B             ( --- )         \ backup 16 lines in current file and
  216.     ?fileopen
  217.     16 -lines L ;   \ display 18 lines.
  218.  
  219. \ installation routine, added to the list of stuff to do when installing
  220. \ FF for a new system.
  221.  
  222. : setview       ( | name --- )  \ set the path for all views
  223.                 >in @ span @ 1- >       \ if nothing following command
  224.                 if      viewpath clr-hcb
  225.                         viewpath prepend.path drop
  226.                 cr ." ******"
  227. cr ." The current PATH where F88 searches for system sources when viewing is"
  228. cr cr tab >rev viewpath count type >norm cr
  229. cr ." Type in the New VIEW PATH (where the system sources are located),"
  230. cr ." or press <enter> alone to leave the VIEW PATH the same. "
  231. cr ." VIEW PATH ->"
  232.                         query
  233.                 then
  234.                 >in @ span @ 1- > 0=
  235.                 if      viewpath clr-hcb
  236.                         bl word viewpath over c@ 1+ cmove
  237.                 then    cr cr tab
  238.                 ." VIEW PATH set to " >rev viewpath count type >norm ;
  239.  
  240.                                                                              
  241. : installviewpath  ( --- )
  242.                 defers installstuff
  243.                 span @ >in !
  244.                 setview ;
  245.  
  246. ' installviewpath is installstuff
  247.                                     
  248.