home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / forth / compiler / fpc / source / browsepr.seq < prev    next >
Text File  |  1991-03-04  |  4KB  |  123 lines
  1. \ TOBROWSE.SEQ          direct printed text to the browser
  2.  
  3. comment:
  4.  
  5.   This file allows re-direction of printed output to a file called
  6. BROWSE.PRN, which is then subsequently passed to the borwser for your
  7. perusal. You can say for example:
  8.  
  9.                 >B WORDS DUP <enter>
  10.  
  11. Which will send a list of all words containing DUP to a file. The browser
  12. is then started on the file so you can examine them. Or,
  13.  
  14.                 >B REF HOPEN <enter>
  15.  
  16. Browse a list of all places where HOPEN is used. Or,
  17.  
  18.                 >B FLOOK HDELETE SRC\*.SEQ <enter>
  19.  
  20. Browse a list of all the places in all files in the SRC directory where
  21. HDELETE is used.
  22.  
  23. comment;
  24.  
  25. \       ******** LOAD FILE ONLY IF WE HAVE THE EDITOR ********
  26.  
  27. defined editor nip 0=
  28. #if
  29.         cr .( Can't load BROWSEPR.SEQ, no editor available)
  30.         \s                              \ Discard the rest of the file
  31. #then
  32.  
  33.  
  34. only forth also editor also hidden definitions also
  35.  
  36. @> errfix value oldfix
  37. 2variable #prbytes
  38. 2variable #prsave
  39.  
  40. : outfix        ( --- )
  41.                 ['] qtypeL  is typeL
  42.                 ['] (emit)  is emit
  43.                 ['] (print) is pemit
  44.                 oldfix is errfix ;    \ remove from errfix
  45.  
  46. comment:
  47.   ┌────────────────────────────────────────────────────────────────────┐
  48.   │ In the following definition, QTYPE is used "on purpose", to assure │
  49.   │ the typing actually goes to the screen, and not to the redirected  │
  50.   │ TYPE which is going to a printer file.                             │
  51.   └────────────────────────────────────────────────────────────────────┘
  52. comment;
  53.  
  54. 10 array numsave_buf
  55.  
  56. : ?.prbytes     ( -- )
  57.                 #prbytes 2@ #prsave 2@ d>
  58.                 if      savecursor cursor-off
  59.                         pad 9 - numsave_buf 10 cmove    \ save numb convert
  60.                         save> hld                       \ preserve HLD
  61.                         false      save!> printing
  62.                         ibm-at?        2>r
  63.                         #out @ #line @ 2>r
  64.                                 base @  >r decimal
  65.                         52 9 at #prbytes 2@ (UD.) >attrib1
  66.                         6 over - spcs swap 0MAX
  67.                                 ?CS: -ROT qtypeL
  68.                                 ?CS: -ROT qtypeL
  69.                         spcs 2  ?CS: -ROT qtypeL >norm
  70.                               r> base !
  71.                              2r> #line ! #out !
  72.                              2r> ibm-at
  73.                         restore> printing
  74.                         restore> hld                    \ restore HLD
  75.                         numsave_buf pad 9 - 10 cmove    \ restore num convert
  76.                         #prbytes 2@ 256. d+ #prsave 2!
  77.                         restcursor
  78.                 then    ;
  79.  
  80. : prtypeL       ( SEG a1 n1 --- )
  81.                 dup 0 #prbytes 2@ d+ #prbytes 2!
  82.                 PRNTYPEL ?.prbytes ;
  83.  
  84. : premit        ( c1 --- )
  85.                 (print)
  86.                 #prbytes 2@ 1. d+ #prbytes 2!
  87.                 ?.prbytes ;
  88.  
  89. forth definitions
  90.  
  91. : >browser      ( | <command_line> --- )  \ browse results of command line
  92.                 " BROWSE.PRN" ">$ dup>r
  93.                 $pfile abort" Failed to create BROWSE.PRN"
  94.                 savescr savecursor
  95.                 20 8 61 10 box&fill
  96.                 ."  \1 Building BROWSE.PRN file...   "
  97.                 restcursor
  98.                 0.0 #prbytes 2!
  99.                 0.0 #prsave  2!
  100.                 @> errfix =: oldfix
  101.                 ['] pemit  save!> emit
  102.                 ['] prtypeL save!> typeL
  103.                 ['] outfix is errfix
  104.                 ['] premit save!> pemit
  105.                 printing on cr interpret cr cr printing off
  106.                 restscr pclose
  107.                 restore> pemit
  108.                 restore> typeL
  109.                 restore> emit
  110.                 oldfix =: errfix
  111.                 r> $file abort" Couldn't re-open BROWSE.PRN"
  112.                 on> newbrowse
  113.                 on> ?browse
  114.                 off> seding
  115.                 off> newfl
  116.                 off> edready
  117.                 <ed> ;
  118.  
  119. ' >browser alias >b
  120.  
  121. only forth also definitions
  122.  
  123.