home *** CD-ROM | disk | FTP | other *** search
/ Shareware 1 2 the Maxx / sw_1.zip / sw_1 / EDITORS / FTTEXT.ZIP / TEXTBROW.PRG < prev   
Text File  |  1992-08-01  |  17KB  |  576 lines
  1. #define TESTING
  2.  
  3. /* A file browser for essentially unlimited size text files.
  4.  
  5. Provided for Aquarium subscribers.
  6.  
  7. For use with the public domain library "Nanfor.lib" from CompuServe's
  8. Nanforum, especially the FT_FText modules by Brice deGanahl.  Note
  9. that the current version of this library on Nanforum has a limitation
  10. of 64K text files for these functions; a patched version is available
  11. as "FTTxt2.zip".
  12.  
  13. Based upon original ideas, and possibly some remaining code fragements,
  14. presented by Craig Yellick in "Clipper 5: A Developer's Guide",
  15. copyright (c) 1991 M&T Books.
  16.  
  17. In particular started with:
  18.   Listing 25.14.
  19.   A file browser for small text files.
  20.   Author: Craig Yellick
  21.   Excerpted from "Clipper 5: A Developer's Guide"
  22.   Copyright (c) 1991 M&T Books
  23.   501 Galveston Drive
  24.   Redwood City, CA 94063-4728
  25.   (415) 366-3600
  26.  
  27. My conscience about copyrights will be clearer if you own that book when
  28. you use this program.  The book is well worth having anyway.
  29.  
  30. Implementation / modifications by Tim Meneely, Ira Emus, and Kathy Beaumont,
  31. 1992.  
  32. */
  33.  
  34. //#define JERK                // Use dispbegin/dispend to avoid showing refresh?
  35. #define TAB_SPACES space(2) // Number of spaces to put in for a hor. tab
  36. #command DEFAULT <param> TO <value> => ;
  37.   <param> := IF(<param> == NIL, <value>, <param>)
  38.  
  39. #include "inkey.ch"
  40. #include "box.ch"
  41. static cline:= ''
  42. static lrec:= 0
  43. static recno:= 0
  44. static hoffset := 0
  45. static pan_step:= 5   // "Smoothness" of panning: how many columns per press
  46. static know_last:= .f.
  47.  
  48. // Long comment line, not at top of file         |50       |60       |70       |80       |90       |100      |110      |120      |130      |140      |150
  49.  
  50. #ifdef TESTING
  51. function Test(filename)
  52.   local colorspec :=  "w/n,n/w,b/w,w/b"
  53.   local color1, color2
  54.   /*  For work on LCD screens
  55.     colorspec :=    "w/n,n/w,b/w,w/b"
  56.   */
  57.     default filename to "textbrow.prg"
  58.   //setmode(50,132)
  59.   BrowText(filename,0,0,maxrow(),maxcol(),132,colorspec,.t.)
  60. return nil
  61.  
  62. #endif // TESTING
  63.  
  64. /*
  65. BrowText, a LARGE file text browser.
  66. */
  67. function BrowText(filename,;                     // Name of file to browse
  68.                   nTop, nLeft, nBottom, nRight,; // Browse window dimensions
  69.                   maxwidth,;                     // Maximum width of line
  70.                   colorspec,;                    // Colorspec string
  71.                   lShowName;                     // Show file name?
  72.                   )
  73.     local key
  74.     local txt
  75.     local col
  76.     local width
  77.     local block_:= {0,0}
  78.     local nSkipPage     // how many lines to move for a PgUp/PgDn
  79.   local oldScreen := savescreen()
  80.   local oldCursor := set(_SET_CURSOR, .F.)
  81.  
  82.     if filename = nil
  83.         //? "Must specify a file name."
  84.         return nil
  85.     endif
  86.  
  87.   default nTop to 0
  88.   default nLeft to 0
  89.   default nBottom to maxrow()
  90.   default nRight to maxcol()
  91.     default maxwidth to 132
  92.   default lShowName to .t.
  93.   SET SCOREBOARD OFF  // Hah! You shouldn't be using scoreboard anyway!
  94.  
  95.     //  Create the browse object.
  96.   txt:= TBrowseNew(nTop+1, nLeft+1, nBottom-2, nRight-1)
  97.  
  98.     //──── Calculate the value of nSkipPage
  99.   nSkipPage := ((txt:nBottom-2) - (txt:nTop+1))
  100.  
  101.   if colorspec <> NIL
  102.     txt:colorspec:= colorspec
  103.   else
  104.     txt:colorspec:= "w/n,n/w,b/w,w/b"
  105.   endif
  106.  
  107.     FT_FUse(filename)      // open text file
  108.  
  109.   @ nTop,nLeft,nBottom,nRight BOX B_SINGLE_DOUBLE + " "
  110.   setpos(nBottom-1,nLeft)
  111.     dispout(padc(;
  112.     "Alt-S=Search, Alt-B=Block, Alt-U=Unmark, Alt-F=File, Alt-P=Printer",;
  113.     nRight-nLeft,chr(177) ) )
  114.   if lShowName
  115.     setpos(nTop, nLeft)
  116.     dispout(" File: " +trim(filename)+" ")
  117.   endif
  118.   setpos(nBottom, nLeft)
  119.     dispout(" Line: "+alltrim(str(recno))+" of "+alltrim(str(lrec))+" ")
  120.  
  121.   // This line makes startup slow in big files
  122.     //lrec:=  FT_FLastRec()
  123.     //know_last:= .t.
  124.  
  125.     //  Add columns to display lines of text.
  126.     width:= txt:nright-txt:nleft+1
  127.  
  128.     col:=TBColumnNew(, {||substr(padr(TB_GetLine(),maxwidth),hoffset)} )
  129.   /*col:colorblock:= {||if(recno>=block_[1] .and. recno<=block_[2],;
  130.     {3,4},{1,2})}*/
  131.     col:colorblock:= {||if( ( recno>=block_[1] .and. recno<=block_[2] ) .or. ;
  132.                             ( recno<=block_[1] .and. recno>=block_[2] ) ,;
  133.                              {3,4},{1,2})}
  134.  
  135.     txt:addColumn(col)
  136.  
  137.     //  The data positioning blocks.
  138.     txt:goTopBlock:= { || FT_FGoTop() }
  139.     txt:goBottomBlock:= { || FT_FGoBot() }
  140.     txt:skipBlock:= { |n| TextPosition(n) }
  141.  
  142.     //  Display the window and process navigation keystrokes.
  143.     do while .t.
  144.     #ifdef JERK
  145.       dispbegin()
  146.     #endif
  147.         do while (.not. txt:stabilize()) .AND. nextkey() == 0
  148.         enddo
  149.     if block_[1] > 0
  150.       block_[2] := recno
  151.     endif
  152.     #ifdef JERK
  153.       dispend()
  154.     #endif
  155.     setpos(nBottom, nLeft)
  156.         dispout(padr("Line: "+alltrim(str(recno))+" of "+;
  157.       alltrim(str(lrec))+iif(know_last,"","+"),;
  158.       nRight-nLeft,chr(196)))
  159.  
  160.         key:= inkey(0)
  161.  
  162.         do case
  163.             case key == K_UP             //  Up one row
  164.         if block_[1] > 0 .and. block_[2] > block_[1]
  165.           //──── This reveals the current record in NON-marked color
  166.           --block_[2]
  167.           txt:refreshCurrent()
  168.           txt:stabilize()
  169.         endif
  170.         txt:up()
  171.         if block_[1] > 0
  172.           //──── We are in BLOCK mode, so have to pay attention
  173.           //──── to cleaning up the block markers.
  174.           do while !txt:stabilize()
  175.           enddo
  176.           block_[2] := recno
  177.           txt:refreshCurrent()
  178.         endif
  179.  
  180.             case key == K_DOWN             //  Down one row
  181.           if block_[1] > 0 .and. block_[2] < block_[1]
  182.             ++block_[2]
  183.             txt:refreshCurrent()
  184.             txt:stabilize()
  185.           endif
  186.           txt:down()
  187.           //──── more block dragging stuff
  188.           if block_[1] <> 0
  189.             txt:refreshCurrent()
  190.             txt:stabilize()
  191.             block_[2] := recno
  192.           endif
  193.  
  194.             case key == K_LEFT             //  Left one column
  195.                 hoffset:= max(hoffset -=pan_step,0)
  196.                 txt:refreshall()
  197.  
  198.             case key == K_RIGHT          //  Right one column
  199.                 hoffset +=pan_step
  200.                 txt:refreshall()
  201.  
  202.             case key == K_PGUP           //  Up one page
  203.         //──── The following nonsense is to
  204.                 //──── accommodate the unfortunate tendency of TBrowse not
  205.                 //──── to move the highlighter to the top if it doesn't have
  206.                 //──── to (known as the MoveHiLite() phenomenon... I'll go
  207.                 //──── into more detail if you don't know what I'm talking
  208.                 //──── about.)
  209.                 if recno - nSkipPage <= 0
  210.                   while recno > 1
  211.                     txt:up()
  212.                     txt:stabilize()
  213.                   enddo
  214.                 else
  215.                   FT_FGoTo(recno - nSkipPage)
  216.                 endif
  217.         if block_[1] > 0
  218.           block_[2] := FT_FRecno()
  219.         endif
  220.                 txt:refreshall()
  221.  
  222.       case key == K_PGDN           //  Down one page
  223.                 if know_last
  224.                   FT_FGoTo( min(recno + nSkipPage, lrec) )
  225.                 else
  226.                   FT_FGoTo( recno + nSkipPage )
  227.                   if FT_FEOF()
  228.                     FT_FGoto(recno)
  229.                     while !FT_FEof()
  230.                       FT_FSkip(1)
  231.                     enddo
  232.                   endif
  233.                 endif
  234.         if block_[1] > 0
  235.           block_[2] := FT_FRecno()
  236.         endif
  237.                 txt:refreshall()
  238.  
  239.             case key == K_CTRL_PGUP      //  Up to the first record
  240.                 txt:goTop()
  241.         if block_[1] > 0
  242.           block_[2] := FT_FRecno()
  243.         endif
  244.  
  245.       case key == K_CTRL_PGDN    //  Down to the last record
  246.                 txt:goBottom()
  247.         if block_[1] > 0
  248.           block_[2] := FT_FRecno()
  249.         endif
  250.                 know_last:= .t.
  251.  
  252.       case key == K_HOME       //  First visible column
  253.                 hoffset:= 0
  254.                 txt:refreshall()
  255.  
  256.       case key == K_END      //  Last visible column
  257.                 hoffset:= len(cline)-(txt:nRight-txt:nLeft)
  258.                 txt:refreshall()
  259.  
  260.       case key == K_CTRL_HOME    //  First column
  261.                 hoffset:= 0
  262.                 txt:refreshall()
  263.  
  264.       case key == K_CTRL_END     //  Last column
  265.                 hoffset:= len(cline)-(txt:nRight-txt:nLeft)
  266.                 txt:refreshall()
  267.  
  268.       case key == K_TAB      //  Pan to the right
  269.                 hoffset += txt:nRight-txt:nLeft
  270.                 txt:refreshall()
  271.  
  272.       case key == K_SH_TAB     //  Pan to the left
  273.                 hoffset:= max(hoffset -= txt:nRight-txt:nLeft,0)
  274.                 txt:refreshall()
  275.  
  276.       case key == K_ESC
  277.         exit
  278.  
  279.       otherwise          //  Key not handled
  280.         HandleException(key,txt,block_)
  281.         endcase
  282.     enddo
  283.     ft_fuse()                // close file
  284.   restscreen(,,,,oldScreen)
  285.   set(_SET_CURSOR, oldCursor)
  286.     return nil
  287.     // end of function BrowText(filename)
  288.     //-----------------------------------------------------------------------
  289.  
  290. function TextPosition(howMany)
  291.     local actual := howmany
  292.     local record := ft_frecno()
  293.     local numskipped
  294.  
  295.     if ( -howmany ) > record  // this solves a problem where ft_fskip()
  296.         ft_fgotop()             // ignores the command to skip to -1.
  297.     else                      // I would have expected it to move as
  298.         ft_fskip( howmany)      // far as possible, but it fooled me.
  299.     endif
  300.  
  301.     recno      := FT_FRecNo()
  302.     numskipped := recno - record
  303.  
  304.     lrec:=  max( lrec, recno )
  305.     cline:= FT_FReadLn()
  306.  
  307.     if FT_FEof()
  308.         know_last:= .t.
  309.     endif
  310.  
  311.     return (recno - record)
  312.     //-----------------------------------------------------------------------
  313.  
  314. static function HandleException(key,txt,block_)
  315.   local temp
  316.  
  317.     do case
  318.         case key == K_ALT_S // Search
  319.             SrchText(txt)
  320.  
  321.         case key == K_ALT_B
  322.             if (block_[1] == 0) .and. (block_[2] == 0)
  323.                 block_[1] := block_[2] := recno
  324.       else
  325.                 block_[1]:= recno
  326.             endif
  327.             if block_[1] > block_[2]
  328.                 temp:= block_[1]
  329.                 block_[1]:= block_[2]
  330.                 block_[2]:= temp
  331.             endif
  332.             txt:refreshall()
  333.  
  334.         case key == K_ALT_F  //──── Output to a file
  335.             TxtOut(txt,block_,"F")
  336.  
  337.         case key == K_ALT_P  //──── Send to printer
  338.             TxtOut(txt,block_,"P")
  339.  
  340.         case key == K_ALT_U       //──── unmark block
  341.             block_[1] := block_[2] := 0
  342.             txt:refreshAll()
  343.  
  344.     endcase
  345.   return NIL
  346.     // end static function HandleException(key,txt,block_)
  347.     //------------------------------------------------------------------------
  348.  
  349. static function SrchText(browse)
  350.     static SrchFor    := ""
  351.     static NoCase    := .t.
  352.   //static StartTop
  353.   static StartLine
  354.     local LineIn
  355.     local LineLong
  356.     local oldPos    := FT_FRecNo()       //──── mark our starting place
  357.     local getlist:= {}
  358.   local oldScreen:= savescreen(9,7,13,53)
  359.     local oldCursor := set(_SET_CURSOR,2)  //──── turn the cursor on
  360.     local srchlength
  361.  
  362.   //StartTop:= empty(SrchFor)
  363.   StartLine:= iif(empty(SrchFor),1,oldPos+1)
  364.     SrchFor:= padr(SrchFor,80) // 80 character max search string length
  365.   scroll(9,7,13,53)
  366.   @ 9, 7 to 13, 53
  367.   @ 10, 8 say "Search for: " get SrchFor picture "@S30K"
  368.   @ 11, 8 say "Case insensitive? " get NoCase
  369.   @ 12, 8 say "Start search on line number:" get StartLine picture "######"
  370.   //@ 12, 8 say "Start at top of file? " get StartTop
  371.     read
  372.     set(_SET_CURSOR, oldCursor)          //──── turn cursor off again
  373.     if .not. empty(SrchFor)
  374.         SrchFor := iif(NoCase,upper(trim(SrchFor)),trim(SrchFor))
  375.         srchlength := len( SrchFor )-1
  376.     FT_FGoTo(StartLine)
  377.     /*if StartTop
  378.             FT_FGoTop()
  379.         else
  380.             // Don't search present line
  381.             FT_FSkip(1)
  382.     endif*/
  383.         LineLong:= ''
  384.  
  385.         if NoCase
  386.       do while !(SrchFor $ (LineLong:= (right( linelong, SrchLength )+" "+upper(FT_FReadLn())))) ;
  387.         .and. !FT_FEof() ;
  388.         .and. inkey() == 0
  389.                 @ 12,42 say ft_frecno()
  390.                 FT_FSkip(1)
  391.             enddo
  392.         else
  393.       do while !(SrchFor, (LineLong:= (right( linelong, SrchLength )+" "+FT_FReadLn()))) ;
  394.         .and. !FT_FEof() ;
  395.         .and. inkey() == 0
  396.                 @ 12,42 say ft_frecno()
  397.                 FT_FSkip(1)
  398.             enddo
  399.         endif
  400.     endif
  401.  
  402.     if !ft_feof()
  403.         browse:refreshAll()
  404.     else
  405.         tone(100,2)
  406.     lrec:= ft_frecno()
  407.     know_last:= .t.
  408.         FT_FGoTo(oldPos)
  409.     endif
  410.   restscreen(9,7,13,53,oldScreen)
  411.     return NIL
  412.     // end static function SrchText
  413.     //-----------------------------------------------------------------------
  414.  
  415. static function TxtOut(txt,block_,F_or_P)
  416.     local getlist:= {}, oldScreen, cOutfile:= space(30), nThisrec
  417.     local nTemp
  418.     default F_or_P to "F"
  419.  
  420.     //──── KATHY 07/28/92:    My "drag it around" stuff may leave the
  421.     //──── block anchors upside down.
  422.     if block_[2] < block_[1]
  423.       nTemp     := block_[1]
  424.       block_[1] := block_[2]
  425.       block_[2] := ntemp
  426.     endif
  427.     if (block_[1] <= block_[2]) .and. (block_[2] > 0)
  428.         if F_or_P == "F"
  429.             oldScreen:= ;
  430.             savescreen(txt:nBottom-4,txt:nLeft+15,txt:nBottom-1,txt:nRight-15)
  431.             @ txt:nBottom-4,txt:nLeft+15,txt:nBottom-1,txt:nRight-15 box B_DOUBLE+" "
  432.             set cursor on
  433.             @ txt:nBottom-3,txt:nLeft +23 say "Copy marked text to where?"
  434.             @ txt:nBottom-2,txt:nLeft +20 get cOutfile picture '@!'
  435.             read
  436.             restscreen(txt:nBottom-4,txt:nLeft+15,txt:nBottom-1,txt:nRight-15,oldScreen)
  437.             set cursor off
  438.  
  439.             if lastkey() != K_ESC
  440.                 //──── if the file exists, append to the end
  441.                 if file(cOutFile)
  442.                     set printer to (cOutFile) additive
  443.                 else
  444.                     set printer to (cOutFile)
  445.                 endif
  446.             endif
  447.     endif
  448.  
  449.     DoPrnInit(.t.) // Send initialization codes to printer
  450.  
  451.         FT_FGoto(block_[1])
  452.         nThisrec:= FT_Frecno()
  453.         set console off
  454.         set print on
  455.         while nThisrec >= block_[1] .and. nThisrec <= block_[2]
  456.             ? FT_Freadln()
  457.             FT_FSkip(1)
  458.             nThisrec:= FT_Frecno()
  459.     enddo
  460.  
  461.     DoPrnInit(.f.) // Send turn-off codes to printer
  462.  
  463.         set print off
  464.         set console on
  465.         set printer to
  466.  
  467.         //──── remove the highlights of the block
  468.         block_[1] := block_[2] := 0
  469.         txt:refreshAll()
  470.     else
  471.         NoBlock(txt)
  472.     endif
  473.  
  474.     return NIL
  475.     // end static function TxtOut(txt,block_,F_or_P)
  476.     //------------------------------------------------------------------------
  477.  
  478. static function NoBlock(txt)
  479.     local oldScreen
  480.     tone(100,2)     //──── THUD
  481.     oldScreen:=  savescreen(txt:nBottom-4,txt:nLeft +15,;
  482.     txt:nBottom-1,txt:nRight -15)
  483.     @ txt:nBottom-4,txt:nLeft+15,txt:nBottom-1,txt:nRight-15 box B_DOUBLE+" "
  484.     @ txt:nBottom-3,txt:nLeft +25 say "Use Alt-B to Block Text!"
  485.     @ txt:nBottom-2,txt:nLeft +25 say "      Press a key...    "
  486.     inkey(0)
  487.     restscreen(txt:nBottom-4,txt:nLeft +15,;
  488.     txt:nBottom-1,txt:nRight -15,oldScreen)
  489.     return NIL
  490.     // end static function NoBlock
  491.     //------------------------------------------------------------------------
  492.  
  493. function TB_GetLine()
  494.   static ctrl_codes_:= {}
  495.   static codes_loaded:= .f.
  496.     local escpos, i
  497.  
  498.   if !codes_loaded
  499.         ctrl_codes_:= LoadCodes()
  500.     codes_loaded:= .t.
  501.   endif
  502.  
  503.   if chr(9) $ cline
  504.     // Expand any tabs
  505.     cline := strtran(cline,chr(9),TAB_SPACES)
  506.   endif
  507.  
  508.   // Strip printer codes
  509.   for i:= 1 to len(ctrl_codes_)
  510.     if ctrl_codes_[i] $ cline
  511.       cline := strtran(cline, ctrl_codes_[i],"")
  512.     endif
  513.   next
  514.  
  515.   // Or, for HP LaserJet only (no need to pass codes if you use this)
  516.   /*
  517.   do while ((escpos:= at(chr(27),cline)) > 0)
  518.     do while (.not. isupper(substr(cline,escpos,1))) .and. ;
  519.       (.not. substr(cline,escpos,1) == '@') .and. ;
  520.       (len(cline) >= escpos)
  521.       cline:= stuff(cline,escpos,1,"")
  522.     enddo
  523.     if (len(cline) >= escpos)
  524.       cline:= stuff(cline,escpos,1,"")
  525.     endif
  526.   enddo
  527.   */
  528.     return cline
  529.     // end of TB_GetLine()
  530.     //-----------------------------------------------------------------------
  531.  
  532. static function LoadCodes()
  533.   /* This function should be customized to load the printer control
  534.      codes which you want to strip out.  Anything in this array will
  535.      be purged while viewing (but not during other output).
  536.  
  537.      The codes shown here are a few typical Laserjet codes; the more
  538.      general case would be to go back to whatever your application uses
  539.      to store its printer codes and to load the codes directly from there.
  540.   */
  541.   return     ;
  542.     {chr(27)+"&dD" ,;
  543.      chr(27)+"&k0S",;
  544.      chr(27)+"&l0O",;
  545.      chr(27)+"&d@" ,;
  546.      chr(27)+"(s0B",;
  547.      chr(27)+"(s3B",;
  548.      chr(27)+"(10U"}
  549.     // end static function LoadCodes()
  550.     //------------------------------------------------------------------------
  551.  
  552. static function DoPrnInit(Start)
  553.   /* dummy printer initialization routine.  My systems have a function
  554.      to initialize the printer, including doing basic font setup; this
  555.      would call that.
  556.  
  557.      I guess that the "best" way to ensure printouts chopped from the
  558.      middle of other printouts would work would be to search through
  559.      the _entire_ report file, looking for every hit on a printer code
  560.      and adding that printer code to a string to be sent to the printer -
  561.      and awesome concept, sending many, many "bold on - bold off"
  562.      sequences with all the text stripped out in between.
  563.  
  564.      We need some creativity here, folks!
  565.   */
  566. return NIL
  567. // end static function DoPrnInit(Start)
  568. //------------------------------------------------------------------------
  569.  
  570. /* Version Control Data
  571. Last update: Revision @#r on @#d at @#t
  572. Revision History:
  573.   @#c
  574.  
  575. */
  576.