home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a067 / 1.img / GRUMP501.EXE / POPNOTE.PRG < prev    next >
Encoding:
Text File  |  1991-07-21  |  36.5 KB  |  1,046 lines
  1. /*
  2.     Program: POPNOTE.PRG
  3.     System: GRUMPFISH LIBRARY
  4.     Author: Greg Lief
  5.     Copyright (c) 1988-90, Greg Lief
  6.     Clipper 5.x Version
  7.     Compile instructions: clipper popnote /n/w/a
  8.  
  9.     Procs & Fncts: FILEWRITE()
  10.                  : NOTEPAD_HD
  11.                  : GRUMPFUN()
  12.                  : NOTEHELP()
  13.                  : GETVAR()
  14.                  : PROBLEM()
  15.                  : NEWFILE()
  16.                  : STAT_MSG()
  17.                  : SETTINGS()
  18.                  : GETFILE()
  19. */
  20.  
  21. //───── begin preprocessor directives
  22.  
  23. #include "grump.ch"
  24. #include "inkey.ch"
  25. #include "fileio.ch"
  26. #include "memoedit.ch"
  27.  
  28. //───── end preprocessor directives
  29.  
  30. //───── begin global declarations
  31.  
  32. static pastebuff := []            // buffer for pasting
  33. static notefile  := []            // last file edited
  34. static leftmargin := 1, linewidth := 80, rightmargin := 80, pagelength
  35. static blockmarks                 // number of block markers currently placed
  36. static blocksel                   // selected block command
  37. static block_ := { 'Move block', 'Copy block', 'Kill block', 'Print block', ;
  38.                    'Uppercase', 'Lowercase', 'Erase markers' }
  39. static afields := {}              // array to hold fields for insertion
  40. static oldscrn                    // entry screen
  41. static nrelcol, nrelrow           // offset row/col position for memoedit()
  42. static start_row                  // starting row for memoedit()
  43. static wordwrap                   // wordwrap status
  44. static cdir                       // current search directory
  45. static cwildcard                  // current search wildcard pattern
  46. static memoedkey                  // last key -- must be visible in main
  47. static filename                   // current file being edited
  48. static filechange                 // flag for whether current file was changed
  49. static nlines                     // total lines in memo--used for elevator bar
  50.  
  51. //───── manifest constants for blocksel values
  52. #define MOVEBLOCK     1
  53. #define COPYBLOCK     2
  54. #define KILLBLOCK     3
  55. #define PRINTBLOCK    4
  56. #define UPPERBLOCK    5
  57. #define LOWERBLOCK    6
  58. #define ERASEMARKERS  7
  59.  
  60. //───── pseudo-function to strip directory from filename
  61. #translate StripDir(<file>) => trim(substr(<file>, rat('\', <file>) + 1))
  62.  
  63. //───── pseudo-function to save current position in the memo
  64. #translate SavePosition() => start_row := nrelrow := gfline ; nrelcol := gfcol
  65.  
  66. //───── end global declarations
  67.  
  68.  
  69. function popnote(gfproc, line, var)
  70. local hotkey := 0, temparray := [], nworkarea, nmaxarea, xx, yy, mfile, ;
  71.       oldscore, num_flds, workfile, marker1, marker2, temptext, srchstr, ;
  72.       repstr, copyblock, oldtext, condblock, handle, marker
  73. memvar curr_dir, wildcard  // globals possibly declared in calling program
  74. //───── determine whether this was called via hot-key; if so, disable it
  75. if (gfproc != NIL)
  76.    setkey(hotkey := lastkey(), NIL)
  77. endif
  78. GFSaveEnv()
  79. oldscrn := savescreen(0, 0, maxrow(), maxcol())
  80. //───── clear out afields array from last time
  81. asize(afields, 0)
  82.  
  83. //───── initialize fields array if a database is open (fcount() > 0)
  84. if (num_flds := fcount()) > 0
  85.    nworkarea := select()      // save current work area
  86.    select 0
  87.    nmaxarea := select() - 1   // determine highest numbered active work area
  88.    num_flds := 0              // accumulator for total number of fields
  89.    for xx = 1 to nmaxarea
  90.       temparray := (xx)->(dbstruct())   // add # of fields in that work area
  91.       yy := 0
  92.       //───── loop through this array and add each element to AFIELDS array
  93.       //───── preface each field name by the alias name
  94.       aeval(temparray, { | a | yy++, ;
  95.                aadd(afields, (xx)->(alias()) + '->' + a[1]) } )
  96.    next
  97.    select(nworkarea)         // pop back to the current work area
  98. endif
  99.  
  100. //───── if global variable CURR_DIR exists, use that as default directory
  101. cdir := IF(type('curr_dir') == "U", '', ;
  102.            curr_dir + if(right(curr_dir, 1)!='\','\',''))
  103.  
  104. //───── if global variable WILDCARD exists, use that as default wildcard
  105. cwildcard := if(type('wildcard') == "U", '*.*', wildcard)
  106. oldscore := set(_SET_SCOREBOARD, .F.)   // no keeping score here!
  107. ColorSet(C_NOTEPAD_BOX)
  108.  
  109. //───── initialize the variables
  110. nrelrow := nrelcol := blockmarks := 0
  111. start_row := 1
  112. pagelength := 60
  113. wordwrap := .t.
  114. filechange := .f.
  115. filename := ''
  116.  
  117. //───── paint note pad box
  118. @ 0, 0, maxrow(), maxcol() box BOXFRAMES[4]
  119. @ maxrow() - 2,  0 ssay chr(199)
  120. @ maxrow() - 2,  1 ssay replicate( chr(196), maxcol() - 1)
  121. @ maxrow() - 2, maxcol() ssay chr(182)
  122. //───── if NOTEFILE contains a filename, use that -- otherwise prompt the user
  123. if ! empty(notefile)
  124.    filename := notefile
  125. else
  126.    setcursor(1)
  127.    filename := upper(GetVar('Enter file name to edit:','C'))
  128.    //───── if they hit enter without a filename, give them pop-up list
  129.    filename := if(empty(filename), GetFile(.t.), filename)
  130. endif
  131. if ! empty(filename)  // i.e., if they didn't hit ESC at the file directory
  132.    ColorSet(C_NOTEPAD_BOX)
  133.    @ 0, maxcol() - 13 ssay 'Alt-H = help'
  134.    ColorSet(C_NOTEPAD_WINDOW)
  135.    temptext := NewFile()
  136.    memoedkey := 0
  137.    //───── begin main edit loop
  138.    do while memoedkey != K_ESC .and. memoedkey != K_ALT_X .and. ;
  139.             memoedkey != K_ALT_Q
  140.       //───── determine total lines in this memo for status indicator
  141.       nlines := mlcount(temptext, rightmargin)
  142.       scroll(01, 01, maxrow() - 3, maxcol() - 1, 0)
  143.       setcursor(1)
  144.       workfile := memoedit(temptext, 1, leftmargin, maxrow() - 3, ;
  145.                   min(rightmargin, maxcol() - 1), .t., 'GFEditFunc', ;
  146.                   linewidth, '', start_row, nrelcol, nrelrow, nrelcol)
  147.  
  148.       //───── various actions to take upon exiting memoedit()
  149.       do case
  150.  
  151.          case memoedkey == K_ALT_A       // append new file and continue
  152.             if ! empty(mfile := GetFile(.f.))
  153.                if file(mfile)
  154.                   temptext := strtran(workfile, chr(26)) + memoread(mfile)
  155.                elseif len(trim(mfile)) > 0
  156.                   problem('file ' + mfile + ' not found')
  157.                endif
  158.             else
  159.                temptext := workfile
  160.             endif
  161.  
  162.          case blockmarks == 3          // block command
  163.             blockmarks := 0
  164.             marker1 := at(chr(254), workfile)
  165.             marker2 := rat(chr(254), workfile)
  166.             do case
  167.  
  168.                case blocksel == MOVEBLOCK
  169.                   //───── copy marked block to scrap buffer
  170.                   copyblock := substr(workfile, marker1+1, marker2-marker1-1)
  171.                   //───── delete marked block
  172.                   workfile := substr(workfile, 1, marker1 - 1) + ;
  173.                               substr(workfile, marker2 + 1)
  174.                   //───── then paste the scrap buffer at the new location
  175.                   temptext := substr(workfile, 1, at(chr(255), workfile) - 1) +;
  176.                               copyblock + ;
  177.                               substr(workfile, at(chr(255), workfile) + 1)
  178.  
  179.                case blocksel == COPYBLOCK
  180.                   //───── copy marked block to scrap buffer
  181.                   copyblock := substr(workfile, marker1+1, marker2-marker1-1)
  182.                   //───── save text after the marker
  183.                   oldtext   := substr(workfile, at(chr(255), workfile) + 1)
  184.                   //───── add in the marked block
  185.                   temptext := substr(workfile, 1, at(chr(255), workfile) - 1) +;
  186.                               copyblock + oldtext
  187.  
  188.                case blocksel == KILLBLOCK
  189.                   temptext := substr(workfile, 1, marker1 - 1) + ;
  190.                               substr(workfile, marker2 + 1)
  191.  
  192.                case blocksel == PRINTBLOCK
  193.                   marker := recno()
  194.                   printit(substr(workfile, marker1 + 1, marker2 - marker1 - 1))
  195.                   go marker
  196.  
  197.                case blocksel == UPPERBLOCK .or. blocksel == LOWERBLOCK
  198.                   //───── copy marked block to scrap buffer & convert appropriately
  199.                   if blocksel == UPPERBLOCK
  200.                      copyblock := upper(substr(workfile, marker1 + 1, ;
  201.                                               marker2 - marker1 - 1))
  202.                   else
  203.                      copyblock := lower(substr(workfile, marker1 + 1, ;
  204.                                                marker2 - marker1 - 1))
  205.                   endif
  206.                   temptext := substr(workfile, 1, marker1-1) + copyblock + ;
  207.                              substr(workfile, marker2+1)
  208.  
  209.                //───── erase block markers
  210.                case blocksel == 7
  211.                   temptext := workfile
  212.  
  213.             endcase
  214.             temptext := strtran(temptext, chr(254), '')  // erase block markers
  215.  
  216.          case memoedkey == K_ALT_R      // search and replace
  217.             srchstr := trim(GetVar('enter search string:', 'C'))
  218.             //───── if user entered null string, forget the whole thing
  219.             if len(srchstr) > 0
  220.                repstr := trim(GetVar('Enter replacement string:', 'C'))
  221.                if GetVar('Replace all? (y/n)','L')
  222.                   temptext := strtran(workfile, srchstr, repstr)
  223.                else
  224.                   if ( xx := GetVar('Occurrences to replace:', 'N')) > 0
  225.                      temptext := strtran(workfile, srchstr, repstr, 1, xx)
  226.                   else
  227.                      temptext := workfile   // to retain working text
  228.                   endif
  229.                endif
  230.             else
  231.                temptext := workfile         // to retain working text
  232.             endif
  233.  
  234.          case memoedkey == K_ALT_S .or. memoedkey == K_ALT_Q  // save file
  235.             if len(workfile) > 0 .or. ;
  236.                    (len(workfile) == 0 .and. len(temptext) > 0)
  237.                if filename == 'tempfile'
  238.                   filename := upper(GetVar('enter file name to save to:','C'))
  239.                endif
  240.                Stat_Msg('Saving ' + filename)
  241.                FileWrite(filename, workfile)
  242.                temptext := workfile
  243.             endif
  244.  
  245.          case memoedkey == K_ALT_W      // write to new file
  246.             mfile := upper(GetVar('File name to write to:','C'))
  247.             if file(mfile)
  248.                Problem('The file ' + mfile + ' already exists')
  249.             elseif len(trim(mfile)) > 0
  250.                Stat_Msg('Writing to ' + mfile)
  251.                FileWrite(mfile, workfile)
  252.             endif
  253.             temptext := workfile  // so that we retain the working text
  254.  
  255.          case memoedkey == K_ALT_N           // change files
  256.             if ! empty( mfile := GetFile(.t.) )
  257.                if len(trim(mfile)) > 0
  258.                   if len(workfile) == 0   // delete this file handle if no text
  259.                      ferase(filename)
  260.                   endif
  261.                   filename := mfile
  262.                   temptext := NewFile()
  263.                   blockmarks := 0          // reset block markers
  264.                endif
  265.             else
  266.                temptext := workfile
  267.             endif
  268.  
  269.          case memoedkey == K_ALT_P            // print file
  270.             temptext := workfile
  271.             if ! isprinter()
  272.                Problem('printer not ready')
  273.             else
  274.  
  275.                //───── establish condition for do..while printing loop
  276.                marker2 := recno()
  277.                condblock := NIL
  278.                go marker2
  279.  
  280.                //───── if you would like to call the interactive query builder
  281.                //───── (setfilt) to filter out records for mail merge, all you
  282.                //───── need to do is compile this program with the following
  283.                //───── syntax:  CLIPPER POPNOTE /N/W/A/DMAILMERGE
  284.  
  285.    #ifdef MAILMERGE
  286.                marker1 = at('{', temptext)
  287.                if marker1 > 0
  288.                   if GetVar('Print for more than one record (y/n)', 'L')
  289.                      setfilt()        // establish filter criteria
  290.                      condblock := { | | ! eof() }
  291.                   endif
  292.                endif
  293.    #endif
  294.  
  295.                PrintIt(workfile, condblock)
  296.                //───── reset record pointer and turn off filter if database is open
  297.                go marker2           // defined at the top of this block
  298.                if num_flds > 0
  299.                   set filter to
  300.                endif
  301.  
  302.             endif
  303.  
  304.          otherwise
  305.             temptext := workfile      // to retain the working text
  306.  
  307.       endcase
  308.    enddo
  309.  
  310.    //───── delete last file handle if there is no text
  311.    if file(filename)
  312.       handle := fopen(filename, FO_READ)
  313.       temptext := fseek(handle, 0, FS_END)
  314.       fclose(handle)
  315.       if temptext == 0
  316.          ferase(filename)
  317.       endif
  318.    endif
  319.    notefile := filename       /* save filename for next time */
  320. endif
  321.  
  322. //───── restore hot-key
  323. if hotkey != 0
  324.    setkey( hotkey, {|p, l, v| popnote(p, l, v)} )
  325. endif
  326. GFRestEnv()
  327. restscreen(0, 0, maxrow(), maxcol(), oldscrn)
  328. return NIL
  329.  
  330. * end function PopNote()
  331. *--------------------------------------------------------------------*
  332.  
  333.  
  334. /*
  335.   PrintIt(): print either the entire file or a portion
  336. */
  337. static function printit(mtext, condition)
  338. local linewidth, printline, currline, lines, oldtext, page := 1, skipline, ;
  339.       oldmargin, oldcursor := setcursor(0), marker, marker2, mtype, xx := 1
  340. memvar setup_str, reset_str, notehead  // globals from calling program
  341.  
  342. /*
  343.    XX is a pointer to the codeblock that sets the condition for looping
  344.    below -- if we are not doing a mail merge, the code block will
  345.    essentially call for one time through the loop by specifying XX == 1
  346.    if we are doing a mail merge, the value of XX will be meaningless
  347.    sounds crazy, but this is actually the best way to do it, and i sure
  348.    did not want to resort to macros
  349. */
  350. default condition to { | | xx == 1 }
  351. oldmargin := set(_SET_MARGIN, leftmargin)
  352. linewidth := rightmargin - leftmargin + 1
  353. Stat_Msg('Printing ' + filename + ', page ' + ltrim(str(page)))
  354. set device to print
  355.  
  356. //───── if SETUP_STR is defined in your calling routine, send it to the printer now
  357. if type('setup_str') != 'U'
  358.    @ prow(), pcol() say setup_str
  359. endif
  360.  
  361. //───── begin main loop
  362. lines := mlcount(mtext, linewidth)
  363. do while eval(condition)
  364.    //───── if NOTEHEAD is defined in your calling routine, print a header
  365.    if type('notehead') != "U"
  366.       notepad_hd(page)
  367.    endif
  368.    currline := 1
  369.    do while currline <= lines .and. inkey() <> K_ESC
  370.       printline := memoline(mtext, linewidth, currline)
  371.       skipline := .f.
  372.       //───── check for embedded fieldname
  373.       if ( marker := at('{', printline) ) > 0 .and. ;
  374.          ( marker2 := at('}', printline) ) > 0 .and. marker2 > marker + 1
  375.          do while marker > 0 .and. marker + 1 < marker2
  376.             oldtext := substr(printline, marker + 1, marker2 - marker - 1)
  377.             //───── convert this field appropriately
  378.             do case
  379.                case (mtype := type(oldtext)) == 'N'
  380.                   oldtext := &("{ | | ltrim(str(" + oldtext + "))}")
  381.                case mtype == 'L'
  382.                   oldtext := &("{ | | if(" + oldtext + ", 'yes', 'no') }")
  383.                case mtype == 'D'
  384.                   oldtext := &("{ | | dtoc(" + oldtext + ") }")
  385.                case mtype $ 'UM'
  386.                   oldtext := &("{ | | '' }")
  387.                otherwise
  388.                   oldtext := &("{ | | trim(" + oldtext + ") }")
  389.             endcase
  390.             printline := substr(printline, 1, marker-1) + eval(oldtext) + ;
  391.                          substr(printline, marker2 + 1)
  392.             marker := at('{', printline)
  393.             marker2 := at('}', printline)
  394.          enddo
  395.          //───── if by chance the inserted field is blank, then do not print
  396.          //───── this line down below!
  397.          if empty(printline)
  398.             skipline := .t.
  399.          endif
  400.       endif
  401.       if ! skipline
  402.          @ prow()+1, 0 say trim(printline)
  403.          if prow() == pagelength - 1
  404.             page++
  405.             set device to screen
  406.             Stat_Msg('Printing ' + filename + ', page ' + ltrim(str(page)))
  407.             set device to print
  408.             if type('notehead') != "U"
  409.                Notepad_Hd(page)
  410.             else
  411.                eject
  412.             endif
  413.          endif
  414.       endif
  415.       currline++
  416.    enddo
  417.    eject
  418.    //───── if no database open, fall out
  419.    if len(afields) == 0
  420.       exit
  421.    else
  422.       skip
  423.       xx++
  424.    endif
  425. enddo     // end main loop
  426. //───── if RESET_STR is defined in your calling routine, send it to the printer now
  427. if type('reset_str') != 'U'
  428.    @ prow(), pcol() say reset_str
  429. endif
  430. set device to screen
  431. if lastkey() == K_ESC
  432.    Stat_Msg('Printing aborted')
  433. endif
  434. return NIL
  435.  
  436. * end static function PrintIt()
  437. *--------------------------------------------------------------------*
  438.  
  439.  
  440. /*
  441.   notepad_hd: heading when printing file
  442. */
  443. static function notepad_hd(page)
  444. @ 0,0 say ''
  445. @ 1,0 say StripDir(filename)
  446. CENTER(1, dateword())
  447. @ 1, linewidth - 8 say 'Page ' + ltrim(str(page))
  448. @ 3, 0 say ''
  449. return NIL
  450.  
  451. * end static function Notepad_Hd()
  452. *--------------------------------------------------------------------*
  453.  
  454.  
  455. /*
  456.   gfeditfunc(): fancy UDF for memoedit()
  457. */
  458. function gfeditfunc(gfstatus, gfline, gfcol)
  459. local ret_val := 0, scrnbuff, buffer, sel, trightmargin, switchfile, ;
  460.       quickquit, mdir
  461. static firstloop
  462. static nstatrow
  463. memoedkey := lastkey()
  464. ColorSet(C_NOTEPAD_BOX)
  465. do case
  466. case gfstatus == ME_INIT
  467.    @ maxrow() - 1, maxcol() - 11 ssay '<wrap>' + if(readinsert(), '<ins>', '')
  468.    //───── use full block cursor for insert mode
  469.    setcursor(if(readinsert(), 3, 1))
  470.    firstloop := .t.
  471.    //───── if there are more lines than will fit in one screen,
  472.    //───── draw indicator showing relative position in the memo
  473.    if nlines > maxrow() - 3
  474.       @ 0, maxcol() say chr(24)
  475.       @ maxrow(), maxcol() say chr(25)
  476.       @ 1, maxcol(), maxrow() - 1, maxcol() box replicate(chr(178), 9)
  477.       @ 1, maxcol() say chr(219)
  478.       nstatrow := 1                      // set status row for next time
  479.    endif
  480. case gfstatus == ME_IDLE
  481.    //───── if there are more lines than will fit in one screen,
  482.    //───── draw indicator showing relative position in the memo
  483.    if nlines > maxrow() - 3
  484.       //───── first, adjust total # of lines if they have added to the memo
  485.       nlines := max(nlines, gfline)
  486.       //───── prepare to draw status indicator on the right side
  487.       @ nstatrow, maxcol() say chr(178)  // remove old status indicator
  488.       //───── determine new row position for status indicator
  489.       if gfline == nlines
  490.          nstatrow := maxrow() - 1
  491.       else
  492.          //───── note: use of MAX() keeps status indicator off row 0
  493.          nstatrow := max(int((gfline/nlines) * (maxrow() - 1)), 1)
  494.       endif
  495.       @ nstatrow, maxcol() say chr(219)  // redraw status indicator at new row
  496.    endif
  497.    if firstloop .and. ! filechange    // on 1st loop we don't want the asterisk
  498.       firstloop := .f.
  499.       @ 0, maxcol() - 15 ssay chr(196)
  500.    elseif ! filechange
  501.       //───── file was changed if they hit backspace, enter, or printable characters
  502.       filechange = (memoedkey == K_BS .or. memoedkey == K_ENTER .or. memoedkey > 31)
  503.       if filechange
  504.          @ 0, maxcol() - 15 ssay '*'
  505.       endif
  506.    endif
  507.    Settings(gfline, gfcol)
  508.    Stat_Msg(StripDir(filename))
  509.  
  510. otherwise
  511.  
  512.    do case
  513.  
  514.       case memoedkey == K_CTRL_V      // toggled insert on/off
  515.          @ maxrow() - 1, 74 ssay if(! readinsert(), "<Ins>", space(5))
  516.          setcursor(if(readinsert(), 1, 3))
  517.          ret_val := 22
  518.  
  519.       case memoedkey == K_ALT_A       // append file
  520.          filechange := .t.
  521.          ret_val := 23
  522.  
  523.       case memoedkey == K_ALT_B       // mark a block
  524.          if blockmarks == 2
  525.             SavePosition()
  526.             ColorSet(C_MESSAGE)
  527.             scrnbuff := shadowbox(08, 32, 16, 46, 2)
  528.             blocksel := achoice(09, 33, 15, 45, block_, .t.)
  529.             ByeByeBox(scrnbuff)
  530.  
  531.             //───── if moving or copying block, we must mark current position with
  532.             //───── chr(255), which looks for all intents/purposes like a space
  533.             if blocksel == COPYBLOCK .or. blocksel == MOVEBLOCK
  534.                if ! readinsert()
  535.                   readinsert(.t.)
  536.                   keyboard chr(255) + chr(K_CTRL_W) + chr(22)
  537.                else
  538.                   keyboard chr(255) + chr(K_CTRL_W)
  539.                endif
  540.             endif
  541.             blockmarks := if(blocksel > 0, 3, 2)
  542.             ret_val := if(blocksel > 2, 23, 32)
  543.          else
  544.             blockmarks++
  545.  
  546.             //───── switch to insert mode (if not already) so as not
  547.             //───── overwrite text, then stuff keyboard w/ insert key
  548.             //───── to switch back -- this is the only way i found to do it
  549.             if ! readinsert()
  550.                readinsert(.t.)
  551.                keyboard chr(254) + chr(22)
  552.             else
  553.                keyboard chr(254)
  554.             endif
  555.             ret_val := 32
  556.          endif
  557.  
  558.       case memoedkey == K_ALT_F           // insert field
  559.          if len(afields) > 0
  560.             ColorSet(C_MESSAGE)
  561.             scrnbuff := shadowbox(4, 29, 18, 50, 2, 'fields')
  562.             sel := achoice(5, 30, 17, 49, afields, .t.)
  563.             ByeByeBox(scrnbuff)
  564.             //───── switch to insert mode (if not already) so as not
  565.             //───── overwrite text, then stuff keyboard w/ name of field
  566.             if sel > 0
  567.                sel := "{" + afields[sel] + "}"
  568.                if ! readinsert()
  569.                   readinsert(.t.)
  570.                   keyboard sel + chr(22)
  571.                else
  572.                   keyboard sel
  573.                endif
  574.             endif
  575.          endif
  576.  
  577.       case memoedkey == K_ALT_G        // go to line
  578.          nrelrow := GetVar('Go to line number:', 'N')
  579.          start_row := nrelrow
  580.          ret_val := 23
  581.  
  582.       case memoedkey == K_ALT_H        // help screen
  583.          NoteHelp()
  584.          ret_val := 32
  585.  
  586.       case memoedkey == K_ALT_I        // insert buffer
  587.          if ! empty(pastebuff)
  588.             //───── switch to insert mode (if not already) so as not
  589.             //───── overwrite text, then stuff keyboard w/ insert key
  590.             if ! readinsert()
  591.                readinsert(.t.)
  592.                keyboard pastebuff + chr(22)
  593.             else
  594.                keyboard pastebuff
  595.             endif
  596.          endif
  597.          ret_val := 32
  598.  
  599.       case memoedkey == K_ALT_K         // kut and paste
  600.          buffer := cutnpaste(@oldscrn)
  601.          if lastkey() != K_ESC
  602.             pastebuff := buffer
  603.          endif
  604.          ret_val := 32
  605.  
  606.       case memoedkey == K_ALT_L         // change page length for printing
  607.          pagelength := GetVar('Enter new page length:', 'N')
  608.          ret_val = 32
  609.  
  610.       case memoedkey == K_ALT_M         // change margins for printing
  611.          SavePosition()
  612.          do while .t.
  613.             leftmargin := max(GetVar('Enter new left margin:', 'N'), 1)
  614.             trightmargin := GetVar('Enter new right margin:', 'N')
  615.             //───── if user hit enter for right margin (0), use previous setting
  616.             rightmargin := if(trightmargin == 0, rightmargin, trightmargin)
  617.             if rightmargin > leftmargin
  618.                exit
  619.             endif
  620.             Problem('Illegal margins, try again')
  621.          enddo
  622.          linewidth := rightmargin - leftmargin + 1
  623.          Settings(gfline, gfcol)
  624.          ret_val := 23
  625.  
  626.       case memoedkey == K_ALT_N         // edit new file
  627.          switchfile := .t.
  628.          if filechange
  629.             switchfile := GetVar('File changed, exit anyway (y/n)', 'L')
  630.          endif
  631.          if switchfile
  632.             nrelrow := nrelcol := 0
  633.             start_row := 1
  634.             filechange := .f.
  635.             ret_val := 23
  636.          else
  637.             ret_val := 32
  638.          endif
  639.  
  640.       case memoedkey == K_ALT_P         // print file
  641.          SavePosition()
  642.          ret_val := 23
  643.  
  644.       case memoedkey == K_ALT_Q         // save file and quit
  645.          ret_val := 23
  646.  
  647.       case memoedkey == K_ALT_R         // search and replace
  648.          SavePosition()
  649.          filechange := .t.
  650.          ret_val := 23
  651.  
  652.       case memoedkey == K_ALT_S         // save file
  653.          SavePosition()
  654.          @ 0, maxcol() - 15 ssay chr(196)  // remove 'file changed' indicator
  655.          filechange := .f.
  656.          ret_val := 23
  657.  
  658.       case memoedkey == K_ALT_T         // toggle word wrap
  659.          wordwrap := ! wordwrap
  660.          @ maxrow() - 1, maxcol() - 11 ssay if(wordwrap, '<wrap>', space(6))
  661.          ret_val := 34
  662.  
  663.       case memoedkey == K_ALT_V         // view buffer
  664.          ColorSet(C_MESSAGE)
  665.          scrnbuff := shadowbox(9, 10, 15, 69, 2, 'Scrap Buffer')
  666.          pastebuff := memoedit(pastebuff, 10, 11, 14, 68, .f.)
  667.          ByeByeBox(scrnbuff)
  668.  
  669.       case memoedkey == K_ALT_W         // write text to new file
  670.          SavePosition()
  671.          ret_val := 23
  672.  
  673.       case memoedkey == K_ALT_X .or. memoedkey == K_ESC  // exit
  674.          quickquit := .t.
  675.          if filechange
  676.             quickquit := GetVar('File changed, exit anyway (y/n)', 'L')
  677.          elseif memoedkey == K_ESC
  678.             quickquit := GetVar('Abort editing (y/n)', 'L')
  679.          endif
  680.          if quickquit
  681.             ret_val := 27
  682.          else
  683.             ret_val := 32
  684.          endif
  685.  
  686.       case memoedkey == K_ALT_Y           // change directory
  687.          mdir := upper(GetVar('Enter directory and/or wildcard:', 'C'))
  688.          do case
  689.  
  690.                //───── user input wildcard mask only
  691.             case '.' $ mdir .and. ! ('\' $ mdir)
  692.                cwildcard := mdir
  693.  
  694.                //───── user input directory only
  695.             case ! ('*' $ mdir) .and. len(trim(mdir)) > 0
  696.                /* add a backslash if they either did not begin it with a
  697.                   backslash or inserted a drive designator */
  698.                cdir := if(left(mdir,1) == '\' .or. substr(mdir, 2, 1) == ':', ;
  699.                        '', '\') + mdir + if(right(trim(mdir),1) == '\', '', '\')
  700.                cwildcard := '*.*'
  701.                //───── add new subdirectory to current working filename
  702.                filename := cdir + StripDir(filename)
  703.  
  704.                //───── user input directory and wildcard mask - parse string
  705.             case len(trim(mdir)) > 0
  706.                cwildcard := substr(mdir, rat('\', mdir) + 1)
  707.                /* add a backslash if they either did not begin it with a
  708.                   backslash or inserted a drive designator */
  709.                cdir := if(left(mdir, 1) == '\' .or. substr(mdir, 2, 1) == ':', ;
  710.                        '', '\') + substr(mdir, 1, rat('\', mdir))
  711.                //───── add new subdirectory to current working filename
  712.                filename := cdir + StripDir(filename)
  713.  
  714.          endcase
  715.          ret_val = 32
  716.  
  717.    endcase
  718. endcase
  719. ColorSet(C_NOTEPAD_WINDOW)
  720. return (ret_val)
  721.  
  722. * end function GFEditFunc()
  723. *--------------------------------------------------------------------*
  724.  
  725.  
  726. /*
  727.   NoteHelp(): display list of active keys
  728. */
  729. static function NoteHelp
  730. local oldscrn := savescreen(01, 01, maxrow() - 3, maxcol() - 1)
  731. setcolor(C_NOTEPAD_BOX)
  732. scroll(01, 01, maxrow() - 3, maxcol() - 1, 0)
  733. @ 2, 7 ssay 'Alt-A  (a)ppend file'
  734. @ 3, 42 ssay 'Alt-B  '+if(blockmarks<2, 'place (B)lock marker','(B)lock operation')
  735. if len(afields) > 0
  736.    @ 3, 42 ssay 'Alt-F insert (F)ield'
  737. endif
  738. @ 3,  7 ssay 'Alt-G  (G)oto line'
  739. @ 4,  7 ssay 'Alt-H  show (H)elp screen'
  740. @ 4, 42 ssay 'Alt-I  (I)nsert buffer'
  741. @ 5,  7 ssay 'Alt-K  (K)ut and paste'
  742. @ 5, 42 ssay 'Alt-L  page (L)ength'
  743. @ 6,  7 ssay 'Alt-M  change (M)argins'
  744. @ 6, 42 ssay 'Alt-N  edit (N)ew file'
  745. @ 7,  7 ssay 'Alt-P  (P)rint file'
  746. @ 7, 42 ssay 'Alt-Q  (Q)uit w/ save'
  747. @ 8,  7 ssay 'Alt-R  search and (R)eplace'
  748. @ 8, 42 ssay 'Alt-S  (S)ave file & continue'
  749. @ 9,  7 ssay 'Alt-T  (T)oggle wordwrap on/off    Alt-V  (V)iew buffer contents'
  750. @10,  7 ssay 'Alt-W  (W)rite to file'
  751. @10, 42 ssay 'Alt-X  e(X)it without saving'
  752. @11,  7 ssay 'Alt-Y  change director(Y)'
  753. @12,  7 ssay '^E     go up one line'
  754. @12, 42 ssay '^X     go down one line'
  755. @13,  7 ssay '^S     go left one char'
  756. @13, 42 ssay '^D     go right one char'
  757. @14,  7 ssay '^A     go left one word'
  758. @14, 42 ssay '^F     go right one word'
  759. @15,  7 ssay 'Home    go to start of line'
  760. @15, 42 ssay 'End    go to end of line'
  761. @16,  7 ssay '^Home   top corner of window'
  762. @16, 42 ssay '^End   bottom corner of window'
  763. @17, 7 ssay '^PgUp   go to start of file'
  764. @17, 42 ssay '^PgDn  go to end of file'
  765. @18, 7 ssay 'Esc     abort edit, no save'
  766. @18, 42 ssay '^Y     delete current line'
  767. @ 1,33 ssay 'MNEMONIC KEYS'
  768. @ 21,24 ssay 'press any key to resume editing' color "*" + setcolor()
  769. ginkey(0)
  770. restscreen(01, 01, maxrow() - 3, maxcol() - 1, oldscrn)
  771. return NIL
  772.  
  773. * end static function NoteHelp()
  774. *--------------------------------------------------------------------*
  775.  
  776.  
  777. /*
  778.   filewrite: write text to new or existing file
  779. */
  780. static function filewrite(gffilename, text)
  781. if ! memowrit(gffilename, text)
  782.    Problem('Write error - ' + ltrim(str(doserror())))
  783. endif
  784. return NIL
  785.  
  786. * end static function FileWrite()
  787. *--------------------------------------------------------------------*
  788.  
  789.  
  790. /*
  791.   GetVar(): get a variable from the user
  792. */
  793. static function GetVar(msg, vartype)
  794. local ret_val := [], keypress
  795. setcolor('+' + ColorSet(C_NOTEPAD_BOX, .T.))
  796. scroll(maxrow() - 1, 02, maxrow() - 1, 67, 0)
  797. @ maxrow() - 1, 02 ssay msg + ' '
  798. if vartype == 'L'     // special case for yes/no questions
  799.    do while ! upper(chr(inkey())) $ 'YN'
  800.    enddo
  801.    ret_val := (chr(lastkey()) $ 'Yy')
  802. else
  803.    do while .t.
  804.       keypress := ginkey(0)
  805.       do case
  806.  
  807.             //───── exit loop
  808.          case keypress == K_ESC .or. keypress == K_ENTER
  809.             ret_val := if(vartype == 'N', val(ret_val), ret_val)
  810.             exit
  811.  
  812.             //───── scrub last character
  813.          case (keypress == K_BS .or. keypress == K_LEFT) .and. len(ret_val) > 0
  814.             ret_val := substr(ret_val, 1, len(ret_val) - 1)
  815.             @ row(), col()-1 ssay chr(32)
  816.             devpos(row(), col()-1)
  817.  
  818.             //───── other printable characters
  819.          case keypress > 31 .and. keypress < 127
  820.             ret_val += chr(keypress)
  821.             @ row(),col() ssay chr(keypress)
  822.       endcase
  823.    enddo
  824. endif
  825. Stat_Msg(StripDir(filename))      // clear message
  826. return (ret_val)
  827.  
  828. * end static function NoteHelp()
  829. *--------------------------------------------------------------------*
  830.  
  831.  
  832. /*
  833.   Problem(): display error message
  834. */
  835. static function Problem(msg)
  836. ColorSet(C_NOTEPAD_BOX)
  837. @ maxrow() - 1, 02 ssay padr(msg, 65)
  838. tone(MUSIC_ERROR, 1)
  839. tone(MUSIC_ERROR, 1)
  840. inkey(2)
  841. ColorSet(C_NOTEPAD_WINDOW)
  842. return NIL
  843.  
  844. * end static function Problem()
  845. *--------------------------------------------------------------------*
  846.  
  847.  
  848. /*
  849.   newfile(): create new file handle
  850. */
  851. static function newfile
  852. local nhandle
  853. if ! file(filename)
  854.    nhandle := fcreate(filename, FC_NORMAL)
  855.    if nhandle == -1
  856.       Problem('File creation error - ' + ltrim(str(doserror())))
  857.    else
  858.       fclose(nhandle)
  859.    endif
  860. endif
  861. return memoread(filename)
  862.  
  863. * end static function NewFile()
  864. *--------------------------------------------------------------------*
  865.  
  866.  
  867. /*
  868.   Stat_Msg(): display status message
  869. */
  870. static function Stat_Msg(msg)
  871. ColorSet(C_NOTEPAD_BOX)
  872. @ maxrow() - 1, 02 ssay padr(msg, 41)
  873. ColorSet(C_NOTEPAD_WINDOW)
  874. return NIL
  875.  
  876. * end static function Stat_Msg()
  877. *--------------------------------------------------------------------*
  878.  
  879.  
  880. /*
  881.   Settings(): self-explanatory
  882. */
  883. static function Settings(nline, ncolumn)
  884. ColorSet(C_NOTEPAD_BOX)
  885. @ maxrow() - 1,43 ssay padr('L ' + ltrim(str(nline)), 6)
  886. @ maxrow() - 1,50 ssay padr('C ' + ltrim(str(ncolumn + 1)), 4)
  887. @ maxrow() - 1,55 ssay 'LM ' + str(leftmargin, 2)
  888. @ maxrow() - 1,61 ssay 'RM ' + str(rightmargin, 3)
  889. return NIL
  890.  
  891. * end static function Settings()
  892. *--------------------------------------------------------------------*
  893.  
  894.  
  895. /*
  896.   GetFile(): pop up file directory for user
  897. */
  898. static function GetFile(adding)
  899. local numfiles, ele, oldscrn := savescreen(0, 0, maxrow(), maxcol()), ;
  900.       files_ := directory(cdir + cwildcard), xx, browse, key, column, ;
  901.       searchstr := [], telem, oldcursor := setcursor(0), ret_val
  902. if empty(files_)
  903.    problem("No files found!")
  904. else
  905.    numfiles := len(files_)
  906.    for xx := 1 to numfiles
  907.       //───── strip out binary files and any file > 64K
  908.       if substr(files_[xx,1], at('.', files_[xx,1]) + 1, 3) $ ;
  909.              'EXE-COM-DBF-NTX-DBT-NDX-OBJ-FRM-LIB-LBL-MEM-ZIP-ARC' .or. ;
  910.              files_[xx,2] > 65535
  911.          adel(files_, xx)
  912.          numfiles--
  913.          xx--
  914.       endif
  915.    next
  916.    asize(files_, numfiles)
  917.    //───── sort array alphabetically by filename
  918.    asort(files_,,, { | x, y | x[1] < y[1] } )
  919.    if adding
  920.       aadd(files_, { "NEW FILE", 0, date(), time() } )
  921.       numfiles++
  922.    endif
  923.    ColorSet(C_MESSAGE)
  924.    shadowbox(2, 18, 16, 61, 2, cdir + cwildcard)
  925.    SINGLEBOX(19, 13, 21, 66)
  926.    @ 20, 15 ssay 'Move highlight bar to desired file and press enter'
  927.    browse := TBrowseNew(3, 19, 15, 60)
  928.    browse:colorSpec := setcolor()
  929.    browse:headSep := "═"
  930.    browse:colSep  := "│"
  931.    ele := 1
  932.    browse:goTopBlock := { || ele := 1 }
  933.    browse:goBottomBlock := { || ele := numfiles }
  934.    browse:skipBlock := { |SkipCnt| AwSkipIt(@ele, SkipCnt, numfiles) }
  935.    column := TBColumnNew("Name", { | | files_[ele, 1] })
  936.    column:width := 12
  937.    browse:AddColumn( column )
  938.    column := TBColumnNew("  Size", { | | files_[ele, 2] })
  939.    column:width := 10
  940.    browse:AddColumn( column )
  941.    column := TBColumnNew("  Date", { | | files_[ele, 3] })
  942.    column:width := 8
  943.    browse:AddColumn( column )
  944.    column := TBColumnNew("  Time", { | | files_[ele, 4] })
  945.    column:width := 8
  946.    browse:AddColumn( column )
  947.    do while .t.
  948.       dispbegin()
  949.       do while ! browse:stabilize() .and. (key := inkey()) == 0
  950.       enddo
  951.       dispend()
  952.       if browse:stable
  953.          key := ginkey(0, "KEY")
  954.       endif
  955.       do case
  956.          case key == K_LEFT
  957.             browse:left()
  958.          case key == K_RIGHT
  959.             browse:right()
  960.          case key == K_UP
  961.             searchstr := []
  962.             browse:up()
  963.          case key == K_DOWN
  964.             searchstr := []
  965.             browse:down()
  966.          case key == K_PGUP .or. key == K_HOME   // top o' window
  967.             searchstr := []
  968.             browse:pageUp()
  969.          case key == K_PGDN .or. key == K_END    // bottom o' window
  970.             searchstr := []
  971.             browse:pageDown()
  972.          case key == K_ESC .or. key == K_ENTER
  973.             exit
  974.          case Isalpha(chr(key))      // letter key - search 'em, Dan-O
  975.             if (telem := ascan(files_, ;
  976.                          { |a| upper(a[1]) = upper(searchstr + chr(key)) })) > 0
  977.                searchstr += chr(key)
  978.                ele := telem
  979.                browse:refreshAll()
  980.             endif
  981.          case key == K_BS             // truncate the search string
  982.             if len(searchstr) > 0
  983.                searchstr := substr(searchstr, 1, len(searchstr) - 1)
  984.                if (telem := ascan(files_, ;
  985.                             { | a | upper(a[1]) = upper(searchstr) })) > 0
  986.                   ele := telem
  987.                   browse:refreshAll()
  988.                endif
  989.             endif
  990.       endcase
  991.    enddo
  992.    setcursor(oldcursor)
  993.    do case
  994.       case key == K_ESC      // user pressed esc to abort
  995.          ret_val := ''
  996.       case ele == len(files_) .and. adding    // user selected 'new file'
  997.          ret_val := cdir + upper(GetVar('Enter file name:', 'C'))
  998.       otherwise
  999.          ret_val := cdir + files_[ele][1]
  1000.    endcase
  1001.    restscreen(0, 0, maxrow(), maxcol(), oldscrn)
  1002. endif
  1003. return (ret_val)
  1004.  
  1005. * end static function GetFile()
  1006. *--------------------------------------------------------------------*
  1007.  
  1008.  
  1009. /*
  1010.    Function: AwSkipIt()
  1011.    Purpose:  Custom skip udf for TBROWSE() above
  1012.    Author:   Greg Lief
  1013. */
  1014. static function AwSkipIt(ele, skip_cnt, maxval)
  1015. local movement // this will be returned to TBROWSE
  1016. //───── increment the current element pointer by the appropriate amount
  1017. if skip_cnt >= 0 .and. ele + skip_cnt > maxval
  1018.    movement := maxval - ele
  1019.    ele := maxval
  1020. elseif skip_cnt < 0 .and. ele + skip_cnt < 1
  1021.    movement := 1 - skip_cnt
  1022.    ele := 1
  1023. else
  1024.    movement := skip_cnt
  1025.    ele += skip_cnt
  1026. endif
  1027. return movement
  1028.  
  1029. * end static function AwSkipIt()
  1030. *--------------------------------------------------------------------*
  1031.  
  1032.  
  1033. /*
  1034.   pastebuff: paste the current popnote buffer
  1035. */
  1036. function pastebuff(p, l, v)
  1037. if ! empty(pastebuff)
  1038.    keyboard pastebuff
  1039. endif
  1040. return NIL
  1041.  
  1042. * end function PasteBuff()
  1043. *--------------------------------------------------------------------*
  1044.  
  1045. * eof popnote.prg
  1046.