home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 24 / CD_ASCQ_24_0995.iso / dos / tools / aurora21 / ext.aml < prev    next >
Text File  |  1995-08-10  |  76KB  |  2,917 lines

  1.  
  2. // -------------------------------------------------------------------
  3. // The Aurora Editor v2.1
  4. // Copyright 1993-1995 nuText Systems. All Rights Reserved Worldwide.
  5. //
  6. // Editor library extensions (included by MAIN.AML)
  7. //
  8. // *You should be very familiar with AML before making changes here*
  9. // If you have made any changes, save this file and select 'Recompile
  10. // the Editor' <alt f2> from the Set menu. Exit and re-enter the
  11. // editor for your changes to take effect.
  12. // -------------------------------------------------------------------
  13.  
  14. // -------------------------------------------------------------------
  15. //  All windows
  16. // -------------------------------------------------------------------
  17.  
  18.   object  a
  19.  
  20.     // get the drive and path portion of a filespec
  21.     function  getpath (file)
  22.       return  file [1 : pos "\\" file 'r']
  23.     end
  24.  
  25.     // get the name and extension portion of a filespec
  26.     function  getname (file)
  27.       return  file [(pos "\\" file 'r') + 1 : TO_END]
  28.     end
  29.  
  30.     // get the extension portion of a filespec
  31.     function  getext (file)
  32.       p = pos '.' file 'r'
  33.       if? p file [p : TO_END] ''
  34.     end
  35.  
  36.     // append a default extension for filenames that don't have one
  37.     function  defext (file extension)
  38.       if pos '.' file then
  39.         file
  40.       else
  41.         file + '.' + extension
  42.       end
  43.     end
  44.  
  45.     // force a filename to have an extension
  46.     function  forceext (file ext)
  47.       p = pos '.' file 'r'
  48.       return (if? p  file [1 : p]  file + '.') + ext
  49.     end
  50.  
  51.     // generate shiftkey events from raw <shiftkey> event
  52.     function  <shiftkey> (newstate oldstate)
  53.       send ( if newstate & 3 and not (oldstate & 3) then
  54.                "shiftdown"
  55.              elseif oldstate & 3 and not (newstate & 3) then
  56.                "shiftup"
  57.              elseif newstate & 10h and not (oldstate & 10h) then
  58.                "scrlockdown"
  59.              elseif oldstate & 10h and not (newstate & 10h) then
  60.                "scrlockup"
  61.              end )
  62.     end
  63.  
  64.     // generate multi-key events
  65.     function  prefix (keycode)
  66.       keyname = locase (getkeyname keycode)
  67.       say  keyname + "<more...>"
  68.       keyname2 = locase (getkeyname (getkey))
  69.       queue  keyname + keyname2
  70.       // allow the <ctrl> key to be held down...
  71.       if keyname [1:5] == "<ctrl" and keyname2 [1:5] == "<ctrl" then
  72.         queue keyname + '<' + keyname2 [7 : TO_END]
  73.       end
  74.       display
  75.     end
  76.  
  77.     // repeat keys for a user-specified number of times
  78.     function  askrepkey
  79.       var keystring
  80.       var i
  81.       say "Enter keys to repeat, then <esc>:"
  82.       hidecursor
  83.       keycode = getkey
  84.       while keycode <> <esc> do
  85.         keystring = keystring + (char2 keycode)
  86.         keycode = getkey
  87.       end
  88.       if keystring then
  89.         count = ask "Number of repetitions"
  90.         if count then
  91.           strlen = sizeof keystring
  92.           while count do
  93.             j = 1
  94.             while j < strlen do
  95.               queuekey (bin2int keystring [j : 2])
  96.               j = j + 2
  97.             end
  98.             repeat
  99.               dispatch
  100.             until not event?
  101.             count = count - 1
  102.           end
  103.         end
  104.       end
  105.     end
  106.  
  107.     // write to the screen background
  108.     function  writebak (string attr x y)
  109.       w = getcurrwin
  110.       while w do
  111.         hidewindow w
  112.         w = getprevwin w
  113.       end
  114.       gotoscreen
  115.       writestr string attr x y
  116.     end
  117.  
  118.     // a simple file picklist
  119.     function  picklist (filespec title)
  120.       filespec = qualify filespec (getbufname)
  121.       repeat
  122.         filespec = askfile filespec  filespec + title _FmgrSort _FmgrOpt
  123.       until not (filespec and (dir? filespec))
  124.       return filespec
  125.     end
  126.  
  127.     // execute a fully qualified DOS program
  128.     // (saving and restoring the current path)
  129.     function  os (program options)
  130.       cp = getcurrpath
  131.       currpath (getpath (getbufname))
  132.       r = exec program options
  133.       currpath cp
  134.       return r
  135.     end
  136.  
  137.     // shell to DOS by executing COMMAND.COM
  138.     function  shell
  139.       os (getenv "COMSPEC") "ch"
  140.     end
  141.  
  142.     // execute DOS commands, programs, and .bat files
  143.     function  run (file options)
  144.       if file then
  145.         os (getenv "COMSPEC") + " /c " + file  options
  146.       else
  147.         shell
  148.       end
  149.     end
  150.  
  151.     // execute DOS commands or programs and capture the output
  152.     // via DOS piping (will not capture .bat file output)
  153.     function  runcap (command options)
  154.       _cap = _cap + 1
  155.       capfile = qualify  "capture." + _cap  (getbufname)
  156.       run  command + '>' + capfile  options
  157.       open capfile
  158.       deletefile capfile
  159.     end
  160.  
  161.     // translate an AML compiler error code to an error message
  162.     function  errormsg (error)
  163.       case error
  164.         when 1001  "Can't open file"
  165.         when 1002, 1003  "Read error"
  166.         when 1004  "Not an executable macro file"
  167.         when 1031  "Write error"
  168.         when 1032  "Can't open compiler output file"
  169.         when 1101  "No closing quote"
  170.         when 1102  "No closing bracket"
  171.         when 1103  "Invalid symbol"
  172.         when 1104  "Invalid key or event"
  173.         when 1301  "No terminator"
  174.         when 1302  "Unexpected end of source"
  175.         when 1303  "No closing parenthesis"
  176.         when 1310  "Unexpected argument"
  177.         when 1311  "Unexpected terminator"
  178.         when 1312  "Unexpected function"
  179.         when 1313  "Unexpected operator"
  180.         when 1318  "Invalid number"
  181.         when 1319  "Identifier '" + (geterror 's') + "' not defined"
  182.         when 1320  "Bad assignment"
  183.         when 1330  "Bad when clause"
  184.         when 1336  "Improperly placed break"
  185.         when 1337  "Invalid reference"
  186.         when 1501  "Can't open include file " + (geterror 's')
  187.         when 1502  "Include level exceeded"
  188.         when 1503  "Can't include compiled file in expression"
  189.         when 1504  "Include must be at top level"
  190.         when 1505  "Define can't be nested"
  191.         when 1506  "Function must be at top level"
  192.         when 1507  "Can't redefine builtin function"
  193.         when 1508  "Duplicated function argument"
  194.         when 1509  "Object statement not permitted"
  195.         when 1701  "Too many variables"
  196.         when 1702  "Too many function arguments"
  197.         when 1703  "Function or expression too large"
  198.         when 1704, 1705, 1707   "Internal stack overflow"
  199.         when 1706  "Out of symbol space"
  200.         otherwise "Fatal compilation error " + error
  201.       end
  202.     end
  203.  
  204.     // compile a macro with error messages
  205.     // the cursor is moved to any syntax errors
  206.     function  compilemacro2 (source dest msg)
  207.       if not source then
  208.         source = getbufname
  209.       end
  210.       if msg then
  211.         say msg
  212.       end
  213.       source = qualify (defext source "aml") (getbufname)
  214.       error = compilemacro source (if? dest dest (forceext source 'x'))
  215.  
  216.       if error then
  217.  
  218.         // get additional error info
  219.         column = geterror 'k'
  220.         line = geterror 'l'
  221.         file = geterror 'f'
  222.  
  223.         // translate error code to an error message
  224.         msg = errormsg error
  225.  
  226.         // position the cursor to the error
  227.         if error <> 1001 and (open file) then
  228.           gotopos column line
  229.           send "onfound"
  230.         end
  231.  
  232.         // display the error
  233.         location = file + " (line " + line + ", col " + column + "): "
  234.         // 1 or 2 line msgbox
  235.         msgbox location +
  236.                (if? ((sizeof location) + (sizeof msg)) > getvidcols - 8 "\n") +
  237.                msg  "Error!" 'b'
  238.       else
  239.         if wintype? "edit_fmgr" then
  240.           say "Done."
  241.         end
  242.       end
  243.  
  244.       return error
  245.     end
  246.  
  247.     // regenerate the editor boot macro (a.x)
  248.     function  regen (msg)
  249.       dest = bootpath "main.x"
  250.       error = compilemacro2 (bootpath "main.aml") dest msg
  251.       if not error then
  252.         bootfile = bootpath "a.x"
  253.         deletefile bootfile
  254.         renamefile dest bootfile
  255.       end
  256.       return error
  257.     end
  258.  
  259.     // regenerate the editor boot macro (a.x) with a message
  260.     function  recompile
  261.       if not regen then
  262.         msgbox "Exit and re-enter for changes to take effect. "
  263.       end
  264.     end
  265.  
  266.     // load, run, and discard a compiled macro file
  267.     function  runmacro2 (macrofile)
  268.       runmacro (qualify (forceext
  269.                  (if? macrofile macrofile (getbufname)) 'x') (getbufname))
  270.     end
  271.  
  272.     // run a configuration macro
  273.     function  runcfg (macrosuffix)
  274.       runmacro getbootpath + "CFG\\CFG" + macrosuffix + ".X"
  275.     end
  276.  
  277.     // save current configuration to CONFIG.AML and COLOR.AML and recompile
  278.     function  savecfg
  279.       runcfg "upd"
  280.     end
  281.  
  282.     // run a macro in the macro subdirectory
  283.     function  runmac (macro)
  284.       runmacro getbootpath + "MACRO\\" + macro + ".X"
  285.     end
  286.  
  287.     // send a string to the default printer device
  288.     function  printstr (string)
  289.       if string then
  290.         fileid = openfile _PrtDev 'w'
  291.         if fileid then
  292.           writefile fileid string
  293.           closefile fileid
  294.         end
  295.       end
  296.     end
  297.  
  298.     // open a new file
  299.     function  opennew (file options)
  300.       prevbufname = getbufname
  301.       buffer = createbuf
  302.       if buffer then
  303.         setbufname (qualify (if? file file "NEW.TXT") prevbufname)
  304.         openbuf buffer options
  305.       end
  306.     end
  307.  
  308.     // toggle the video mode between 80x25 and 80x50
  309.     function  togglemode
  310.       videomode 80 (if? getvidrows == 25  50 25)
  311.     end
  312.  
  313.  
  314.     // search/replace with verification
  315.     // (returns the number of replacements made)
  316.     function  replver (searchstr replstr options)
  317.  
  318.       var title
  319.       var count
  320.  
  321.       repeat
  322.         length = find searchstr options
  323.         if length then
  324.  
  325.           if not title then
  326.             title = gettitle
  327.             settitle  "Replace (Yes/No/All/One/Reverse/Undo/Quit)? "
  328.             // remove global for next find
  329.             options = sub 'g' '' options
  330.           end
  331.  
  332.           send "onfound" length
  333.  
  334.           // get keycode and convert to lower case
  335.           p = getkey | 020h
  336.           case p
  337.  
  338.             when <y>, <o>, <a>
  339.               undobegin
  340.               l = (replace searchstr replstr  (sub 'r' '' options) + "*z") - 1
  341.               if not (pos 'r' options) then
  342.                 right l
  343.               end
  344.               count = count + 1
  345.               if p <> <y> then
  346.                 length = ''
  347.                 if p == <a> then
  348.                   count = count + (replace searchstr replstr  options + "az")
  349.                 end
  350.               end
  351.               undoend
  352.  
  353.             when <u>
  354.               if count then
  355.                 undo
  356.                 count = count - 1
  357.                 if pos 'r' options then
  358.                   right 1
  359.                 else
  360.                   if getcol == 1 then
  361.                     if up then
  362.                       col 16000
  363.                     end
  364.                   else
  365.                     left l
  366.                   end
  367.                 end
  368.               end
  369.  
  370.             when <n>
  371.                // do nothing
  372.  
  373.             when <r>
  374.                options = if? (pos 'r' options) (sub 'r' '' options)  options + 'r'
  375.  
  376.             otherwise
  377.               if not count then
  378.                 count = '0'
  379.               end
  380.               break
  381.           end
  382.         end
  383.       until not length
  384.  
  385.       if title then
  386.         settitle title
  387.       end
  388.  
  389.       return count
  390.     end
  391.  
  392.  
  393.     // search for a multi-string search argument
  394.     function  search (searchstr reverse rep refopt refrepl)
  395.  
  396.       var replstr
  397.       var options
  398.  
  399.       // split up search multi-string
  400.       if pos '/' searchstr then
  401.         n = splitstr '' searchstr  ref searchstr  ref replstr  ref options
  402.         if n > 1 then
  403.           if n == 2 then
  404.             options = replstr
  405.             replstr = ''
  406.             // case sensitive
  407.             if not options then
  408.               options = 'c'
  409.             end
  410.           end
  411.         end
  412.       end
  413.  
  414.       if searchstr then
  415.  
  416.         // default options
  417.         if not options then
  418.           options = _SearchOpt
  419.           if n > 2 then
  420.             options = options + _ReplaceOpt
  421.           end
  422.         end
  423.  
  424.         // reverse search direction if specified
  425.         if reverse then
  426.           options = if pos 'r' options then
  427.                       sub 'r' '' options
  428.                     else
  429.                       options + 'r'
  430.                     end
  431.         end
  432.  
  433.         // remove global for repeat find
  434.         if rep and (pos 'g' options) then
  435.           options = sub 'g' '' options
  436.         end
  437.  
  438.         // return values for calling function to check
  439.         refopt  = options
  440.         refrepl = n >= 3
  441.  
  442.         // resurface marked window for block search
  443.         if pos 'b' options then
  444.           buffer = getmarkbuf
  445.           if buffer and buffer <> getcurrbuf then
  446.             currwin (getcurswin (getcurrcurs buffer))
  447.           end
  448.         end
  449.  
  450.         // search and replace
  451.         if n >= 3 then
  452.  
  453.           // do the replace
  454.           if pos 'a' options then
  455.             replace searchstr replstr options
  456.           else
  457.             replver searchstr replstr options
  458.           end
  459.  
  460.         // search only
  461.         else
  462.           find searchstr options
  463.         end
  464.       end
  465.     end
  466.  
  467.     // hot key for the file mgr and file picklists
  468.     function  onhotkey (character)
  469.       searchstr = (if? character == '\\'  '^.*'  '^ *') +
  470.                   (upcase character)
  471.       if find searchstr 'x' then
  472.         adjustrow getviewrows / 3
  473.         return
  474.       else
  475.         line = getrow
  476.         gotopos 1 1
  477.         if find searchstr 'x*' then
  478.           adjustrow getviewrows / 3
  479.           return
  480.         end
  481.         // not found
  482.         beep 320 70
  483.         row line
  484.       end
  485.     end
  486.  
  487.     // generic prompt for a string
  488.     function  ask (prompt history init title options width)
  489.  
  490.       var value
  491.  
  492.       if not options then
  493.         options = _PromptStyle
  494.         suffix = if? (pos '2' options) ':' '>'
  495.       end
  496.  
  497.       if pos 'd' options then
  498.         if suffix then
  499.           prompt = prompt + ':'
  500.         end
  501.         if not width then
  502.           width = 48
  503.         end
  504.  
  505.         dialog (if? title title "Prompt")  18 + width  5 'cp'
  506.         field  prompt 3 2 width - (if? prompt [0] == '>' ((sizeof prompt) - 3) -2) init history
  507.         button "O&k"    width + 8 2 8
  508.         button "Cancel" width + 8 4 8
  509.  
  510.         if (getdialog ref value) == 'Ok' then
  511.           return (if? value value ' ')
  512.         end
  513.       else
  514.         if (case options
  515.               when 'c' askline ref value prompt + suffix       history init
  516.               when '1' askbox1 ref value prompt + suffix + ' ' history init
  517.               when '2' askbox  ref value prompt + suffix       history init
  518.             end) then
  519.           return (if? value value ' ')
  520.         end
  521.       end
  522.     end
  523.  
  524.  
  525.   object  mon
  526.  
  527.     // erase key macros
  528.     function  erasekey2 (options)
  529.       if erasekey options then
  530.         _kd = TRUE
  531.         display
  532.         say (if? (pos options 'a') "All keys macros erased"
  533.                                    "Scrap key macro erased")
  534.       end
  535.     end
  536.  
  537.     // toggle the key macro record mode
  538.     function  record
  539.       if not playing? then
  540.         _kd = TRUE
  541.         if not setting? 'R' then
  542.           erasekey
  543.           record_on = TRUE
  544.         end
  545.         setting 'R' TOGGLE
  546.         say "Record" + (if? record_on "ing..." " OFF")
  547.       end
  548.     end
  549.  
  550.     // play a key macro
  551.     function  play (keymacro)
  552.       setdisplay OFF
  553.       if not (playkey keymacro) then
  554.         say "No key macro to play." 'b'
  555.       end
  556.       setdisplay ON
  557.     end
  558.  
  559.  
  560. // -------------------------------------------------------------------
  561. //  Edit windows and File Manager windows
  562. // -------------------------------------------------------------------
  563.  
  564.   object  edit_fmgr
  565.  
  566.     // close all windows
  567.     function  closeall (options)
  568.       setxobj "__G" ON 'a'
  569.       begdesk
  570.       while getwincount and (send "close" options) end
  571.       enddesk
  572.       setxobj "__G" OFF 'a'
  573.     end
  574.  
  575.     // move the cursor to any edge of a mark
  576.     function  gotomark (options)
  577.       if mark? then
  578.  
  579.         window = getcurswin (getcurrcurs (getmarkbuf))
  580.         if window then
  581.           currwin window
  582.         end
  583.  
  584.         // left or right
  585.         if pos 'l' options then
  586.           col (getmarkleft)
  587.         elseif pos 'r' options then
  588.           col (getmarkright)
  589.         end
  590.  
  591.         // top or bottom
  592.         if pos 't' options then
  593.           row (getmarktop)
  594.         elseif pos 'b' options then
  595.           row (getmarkbot)
  596.         end
  597.  
  598.         if window then
  599.           send "onfound"
  600.         end
  601.  
  602.       else
  603.         say "Block not found" 'b'
  604.       end
  605.     end
  606.  
  607.     // goto a bookmark with message
  608.     function  gotobook2 (bookmark)
  609.       msg = "Bookmark '" + bookmark + "'"
  610.       bookbuf = getbookbuf bookmark
  611.       if bookbuf <> getwinbuf then
  612.         open (getbufname bookbuf)
  613.       end
  614.       if gotobook bookmark then
  615.         display
  616.         say msg
  617.       else
  618.         say msg + " not found"  'b'
  619.       end
  620.     end
  621.  
  622.     // prompt to goto a bookmark
  623.     function  askbook (msg)
  624.       askx (if? msg msg "Bookmark Name") "_book" "gotobook2"
  625.     end
  626.  
  627.     // cycle though all existing bookmarks
  628.     function  cyclebook
  629.       repeat
  630.         l = _lb
  631.         bookmark = if? l (getprevbook l) (getcurrbook)
  632.         buffer = getcurrbuf
  633.         while not bookmark and buffer do
  634.           buffer = getprevbuf buffer
  635.           bookmark = getcurrbook buffer
  636.         end
  637.         _lb = bookmark
  638.       until bookmark or not l
  639.       gotobook2 bookmark
  640.     end
  641.  
  642.     // print the current buffer or mark
  643.     function  print (options)
  644.       printstr _PrtIni
  645.       header = _PrtHdr
  646.       printformat '' _PrtOpt _PrtPag _PrtLeft _PrtTop _PrtRight _PrtBot
  647.                      _PrtSpace _PrtCop
  648.       if not (posnot ' ' header) or (dir? (getbufname)) then
  649.         date = getdate
  650.         header = getbufname + "   (" + date [posnot ' ' date : TO_END] +
  651.                                  ' ' + gettime + ')'
  652.       end
  653.       if not ( if pos 'b' options  then printblock _PrtDev header ''
  654.                 else    printbuf _PrtDev header end ) then
  655.         say "Print failed" 'b'
  656.       end
  657.     end
  658.  
  659.     // replace/append/cancel or ok/cancel menus
  660.     function  askrac (file menuname)
  661.       if _ConRpl == 'y' and (locatefile file) then
  662.         locase (popup (if? menuname menuname "rac" )
  663.                         file + " Exists" +
  664.                         (if? menuname == "ok" ". Replace?")) [1]
  665.       else
  666.         'r'
  667.       end
  668.     end
  669.  
  670.     // generic prompt to change a configuration variable
  671.     function  askc (pstring variable history)
  672.       newvalue = ask pstring history (lookup variable "prf")
  673.       if newvalue then
  674.         setxobj variable newvalue "prf"
  675.       end
  676.     end
  677.  
  678.     // prompts to change specific configuration variables
  679.     function  askclip    askc "Clipboard Name" "ClipName"    end
  680.     function  askprthdr  askc "Current Header/Footer" "PrtHdr" end
  681.  
  682.     // generic prompt with command execution
  683.     function  askx (pstring history func parm2)
  684.       parm1 = ask pstring history
  685.       if parm1 then
  686.         send func parm1 parm2
  687.         if history then
  688.           addhistory history parm1
  689.         end
  690.         return 1
  691.       end
  692.     end
  693.  
  694.     // open prompt
  695.     function  askopen
  696.       file = ask "[file/ibcenz] Open" "_load"
  697.       if file then
  698.         // addhistory not needed for open
  699.         open file
  700.       end
  701.     end
  702.  
  703.     // open binary prompt
  704.     function  askopenb
  705.       askx "File to open in Binary Mode" "_load" "open" 'b'
  706.     end
  707.  
  708.     // macro expression prompt
  709.     function  askeval
  710.       if askx "Macro Expression" "_cmd" "eval" then
  711.         error = geterror 'c'
  712.         if error then
  713.           msgbox "Expression column " + (geterror 'k') +
  714.                  ": " + (errormsg error)  "Error" 'b'
  715.         end
  716.       end
  717.     end
  718.  
  719.     // prompt to run a macro
  720.     function  askrmacro
  721.       askx "Run Macro File"  "_load" "runmacro2"
  722.     end
  723.  
  724.     // prompt to compile a macro
  725.     function  askcmacro
  726.       askx "Compile Macro File"  "_load" "compilemacro2"
  727.     end
  728.  
  729.     // macro picklist
  730.     function  pickmacro
  731.       macro = askfile getbootpath + "MACRO\\*.X" "Select a macro to run"
  732.                       _FmgrSort _FmgrOpt "maclist"
  733.       if macro then
  734.         runmacro macro
  735.       end
  736.     end
  737.  
  738.     // DOS command prompt
  739.     function  askrun
  740.       askx "DOS Command" "_os" "run" "ck"
  741.     end
  742.  
  743.     // prompt to capture DOS output
  744.     function  askruncap
  745.       askx "Capture DOS Output" "_os" "runcap" 'c'
  746.     end
  747.  
  748.     // open key macro file with messages
  749.     function  openkey2 (file)
  750.       if openkey file then
  751.         say (getname file) + " loaded"
  752.       else
  753.         say "Load failed" 'b'
  754.       end
  755.     end
  756.  
  757.     // prompt to open a key macro file
  758.     function  askopenkey
  759.       file = ask "Key macro filename" "_load"
  760.       if file then
  761.         openkey2 (qualify (defext file "mac") (getbufname))
  762.       end
  763.     end
  764.  
  765.     // prompt to save current key macros
  766.     function  asksavekey
  767.       file = ask "Save current key macros as" "_load"
  768.       if file then
  769.         file = qualify (defext file "mac") (getbufname)
  770.         if pos (askrac file "ok") "or" 'i' then
  771.           if not savekey file then
  772.             say "Save failed" 'b'
  773.           end
  774.         end
  775.       end
  776.     end
  777.  
  778.     // search files for a string in multi-string format with msgs
  779.     function  searchfiles (s)
  780.       var searchstr
  781.       var filespec
  782.       var options
  783.       n = splitstr '' s  ref searchstr  ref filespec  ref options
  784.       if n < 3 then
  785.         options = _SearchOpt
  786.         if n < 2 then
  787.           filespec = '.'
  788.         end
  789.       end
  790.       if searchstr then
  791.         r = scanfiles filespec searchstr options
  792.         if r <= 0 then
  793.           say (if? r filespec s) + " not found" 'b'
  794.         else
  795.           addhistory "_find" (joinstr '' searchstr options)
  796.         end
  797.       end
  798.     end
  799.  
  800.     // prompt to scan files for a string
  801.     function  askscan
  802.       scanstring = if _PromptStyle == 'd' then
  803.                      scandlg
  804.                    else
  805.                      ask "[string/files/iwx] Scan" "_scan"
  806.                    end
  807.       if scanstring then
  808.         searchfiles scanstring
  809.         addhistory "_scan" scanstring
  810.       end
  811.     end
  812.  
  813.     // reload the current file from disk
  814.     function  reopen (file)
  815.       open (if? file file (getbufname)) 'r'
  816.     end
  817.  
  818.     // open last file or directory
  819.     function  openlast
  820.       file = gethiststr "_load"
  821.       if file then
  822.         open file
  823.       end
  824.     end
  825.  
  826.     // open an AML configuration file in boot directory
  827.     function  opencfg (file)
  828.       open (bootpath  file + ".aml")
  829.     end
  830.  
  831.     // quick reference help
  832.     function  quickref (options openopt)
  833.       quickfile = getbootpath + (if? options <> 'o' "DOC\\") +
  834.                     case options [1]
  835.                       when 'l'  "LANGUAGE.DOX"
  836.                       when 'f'  "FUNCTION.DOX"
  837.                       when 'q'  "QUICKFUN.DOX"
  838.                       when 'o'  "ORDERFRM.DOC"
  839.                       when 't'  "TIPS.DOX"
  840.                       otherwise "USER.DOX"
  841.                     end
  842.       if (wintype? "edit") and (pos 'w' options) then
  843.         wordstr = send "getword" "a-zA-Z0-9?"
  844.       end
  845.       open quickfile openopt
  846.  
  847.       // make read/only
  848.       if options [1] <> 'o' then
  849.         bufferflag 'r'
  850.       end
  851.  
  852.       if wordstr then
  853.         gotopos 1 1
  854.  
  855.         // find string in reference
  856.         if find (char 0ffh) + wordstr + (char 0ffh) then
  857.           right
  858.           send "onfound" (sizeof wordstr)
  859.  
  860.         // not found? then try function header in EXT.AML
  861.         elseif poschar 'fq' options then
  862.           close
  863.           ext = bootpath "EXT.AML"
  864.           closeit = _MultCopy == 'n' and not (findbuf ext)
  865.           open ext openopt
  866.           gotopos 1 1
  867.           n = find "function #" + wordstr  'x'
  868.           if n then
  869.             send "onfound" n
  870.  
  871.           else
  872.             // still not found? then go back to the reference
  873.             if closeit then
  874.               close
  875.             end
  876.             open quickfile openopt
  877.             // make read/only
  878.             bufferflag 'r'
  879.           end
  880.         end
  881.       end
  882.     end
  883.  
  884.  
  885. // -------------------------------------------------------------------
  886. //  Prompts and Edit windows
  887. // -------------------------------------------------------------------
  888.  
  889.   object  prompt
  890.  
  891.     // support for cua-style <shift> key marking
  892.     function  smark
  893.       if shiftkey? then
  894.         if _shfx then
  895.           undobegin
  896.           destroymark
  897.           markstream _shfx _shfx _shfy _shfy
  898.           _shfx = ''
  899.           _shfy = ''
  900.         end
  901.         extendmark
  902.       end
  903.     end
  904.  
  905.     // set anchor for shift-key marking
  906.     function  shiftdown
  907.       _shfx = getcol
  908.       _shfy = getrow
  909.       pass
  910.     end
  911.  
  912.     // end shift-key mark
  913.     function  shiftup
  914.       if not _shfx then
  915.         stopmark
  916.         undoend
  917.       end
  918.       pass
  919.     end
  920.  
  921.     // backspace in a prompt
  922.     function  backsp
  923.       if getcol > 1 then
  924.         left
  925.         delchar
  926.       end
  927.     end
  928.  
  929.     // get the word at the cursor
  930.     function  getword (charset column mark)
  931.       if not column then
  932.         column = getcol
  933.       end
  934.       if column <= getlinelen then
  935.         if not charset then
  936.           charset = _CSet
  937.         end
  938.         b = posnot charset (gettext column)
  939.         if b <> 1 then
  940.           b = if? b  column + b - 2  getlinelen
  941.           a = posnot charset (gettext 1 column) 'r'
  942.           a = if? a  a + 1  1
  943.           if mark then
  944.             undobegin
  945.             destroymark
  946.             markchar a b
  947.             undoend
  948.           else
  949.             gettext a  b - a + 1
  950.           end
  951.         end
  952.       end
  953.     end
  954.  
  955.     // mark the word at the cursor using getword
  956.     function  markword (charset)
  957.       getword charset '' 1
  958.     end
  959.  
  960.     // mark to end-of-line
  961.     function  markeol
  962.       undobegin
  963.       destroymark
  964.       if getcol <= getlinelen then
  965.         markchar '' (getlinelen)
  966.       end
  967.       undoend
  968.     end
  969.  
  970.     // delete a block
  971.     function  deleteblock2
  972.       if getmarkbuf == getcurrbuf then
  973.         deleteblock
  974.       else
  975.         if wintype? "edit" then
  976.           if _DelLine == 'y' then
  977.             delline
  978.           end
  979.         end
  980.       end
  981.     end
  982.  
  983.     // prompt to enter character literally
  984.     function  literal
  985.       say "Enter Literal..."
  986.       queue <char> (char getkey & 0ffh)
  987.     end
  988.  
  989.     // ascii chart with character entry
  990.     function  asciilist
  991.       buffer = asciibuf
  992.       // name it so the position can be remembered
  993.       setbufname "_asc"
  994.       character = (popup buffer '' 13) [10]
  995.       destroybuf
  996.       if character then
  997.         queue <char> character
  998.       end
  999.     end
  1000.  
  1001.     // support for file name completion (open prompts only)
  1002.     function  askcomplete
  1003.       if gethistname == "_load" then
  1004.         filespec = gettext
  1005.         if filespec then
  1006.           if not pos "*.*" filespec then
  1007.             filespec = filespec + (if? (pos '.' filespec) '*' "*.*")
  1008.           end
  1009.         else
  1010.           filespec = "*.*"
  1011.         end
  1012.         file = picklist (qualify filespec (getbufname (getwinbuf (getprevwin (getcurrwin)))))
  1013.         if file then
  1014.           col 1
  1015.           delchar (getlinelen)
  1016.           writetext file
  1017.           return file
  1018.         end
  1019.       end
  1020.     end
  1021.  
  1022.     // get the first line of text in the default mark
  1023.     function  getmarktext
  1024.       if mark? then
  1025.         buffer = getmarkbuf
  1026.         topline = getmarktop
  1027.         if getmarktype == 'l' then
  1028.           gettext (getlinebeg topline buffer) (getlinelen topline buffer)
  1029.                   (getmarktop) buffer
  1030.         else
  1031.           gettext (getmarkleft) (getmarkcols) topline buffer
  1032.         end
  1033.       end
  1034.     end
  1035.  
  1036.     // copy or copy-append to the clipboard
  1037.     function  copy (options)
  1038.  
  1039.       if mark? then
  1040.  
  1041.         // copy to ms windows
  1042.         if pos 'w' options then
  1043.           if not saveblock "^:c" _SaveOpt + 'x' then
  1044.             msgbox "The MS Windows clipboard is not available."
  1045.           end
  1046.  
  1047.         else
  1048.           currentbuf = getcurrbuf
  1049.           clip = _ClipName
  1050.           destroymark clip
  1051.           copymark (getmarkuse) clip
  1052.  
  1053.           // copy append
  1054.           if options and (buffer? clip) then
  1055.             if getmarktype <> 'l' then
  1056.               insline '' '' (getlines clip) clip
  1057.             end
  1058.             copyblock clip clip 1 (getlines clip)
  1059.             markline 1 (getlines clip) clip clip
  1060.  
  1061.           // copy
  1062.           else
  1063.             destroybuf clip
  1064.             createbuf clip
  1065.             copyblock clip clip
  1066.             if getmarktype == 'l' then
  1067.               delline 1 1 clip
  1068.             end
  1069.           end
  1070.           currbuf currentbuf
  1071.         end
  1072.       end
  1073.     end
  1074.  
  1075.     // cut or cut-append to the clipboard
  1076.     function  cut (options)
  1077.       if mark? then
  1078.         copy options
  1079.         deleteblock
  1080.       end
  1081.     end
  1082.  
  1083.     // enter a character or string into the current prompt
  1084.     function  write (charstring)
  1085.       writetext charstring
  1086.     end
  1087.  
  1088.  
  1089. // -------------------------------------------------------------------
  1090. //  Edit windows
  1091. // -------------------------------------------------------------------
  1092.  
  1093.   object  edit
  1094.  
  1095.     // mark a paragraph
  1096.     function  markpara (options)
  1097.  
  1098.       if getlinelen then
  1099.  
  1100.         undobegin
  1101.         destroymark
  1102.  
  1103.         // find the beginning of the paragraph
  1104.         pushcursor
  1105.         // check for mark-to-end of paragraph
  1106.         if not pos 'e' options then
  1107.           while up and getlinelen end
  1108.           if not getlinelen then
  1109.             down
  1110.           end
  1111.           markline
  1112.         end
  1113.         popcursor
  1114.  
  1115.         // find the end of the paragraph
  1116.         pushcursor
  1117.         while down and getlinelen end
  1118.         if not getlinelen then
  1119.           up
  1120.         end
  1121.         markline
  1122.         popcursor
  1123.  
  1124.         undoend
  1125.  
  1126.         return 1
  1127.       end
  1128.     end
  1129.  
  1130.     // setup for insert-above (copy, move, paste - lineblocks only)
  1131.     function  begabove
  1132.       _ba = ''
  1133.       undobegin
  1134.       if getmarktype == 'l' and _InsAbove == 'y' then
  1135.         _ba = 1
  1136.         if not up then
  1137.           insabove
  1138.           up
  1139.           _ba = 2
  1140.         end
  1141.       end
  1142.     end
  1143.  
  1144.     // end insert-above
  1145.     function  endabove
  1146.       case _ba
  1147.         when 1 down
  1148.         when 2 delline
  1149.       end
  1150.       undoend
  1151.     end
  1152.  
  1153.     // paste or paste-over from the clipboard
  1154.     function  paste (options)
  1155.       // paste from ms windows
  1156.       if pos 'w' options then
  1157.         undobegin
  1158.         old_size = getlines
  1159.         if insertbuf "^:c" then
  1160.           // mark inserted text
  1161.           if getlines > old_size then
  1162.             markline  getrow + 1  getrow + getlines - old_size
  1163.           end
  1164.         else
  1165.           msgbox "The MS Windows clipboard is not available."
  1166.         end
  1167.         undoend
  1168.       elseif mark? _ClipName then
  1169.         destroymark
  1170.         copymark _ClipName (getmarkuse)
  1171.         if options then
  1172.           copyblockover
  1173.         else
  1174.           begabove
  1175.           copyblock
  1176.           endabove
  1177.         end
  1178.       else
  1179.         say "Nothing to paste" 'b'
  1180.       end
  1181.     end
  1182.  
  1183.     // clear the clipboard
  1184.     function  clear
  1185.       destroybuf _ClipName
  1186.     end
  1187.  
  1188.     // copy a block
  1189.     function  copyblock2
  1190.       if mark? then
  1191.         begabove
  1192.         if not copyblock then
  1193.           say "Copy failed" 'b'
  1194.         end
  1195.         endabove
  1196.       else
  1197.         if _CopyLine == 'y' then
  1198.           undobegin
  1199.           markline
  1200.           copyblock
  1201.           destroymark
  1202.           undoend
  1203.         end
  1204.       end
  1205.     end
  1206.  
  1207.     // move a block
  1208.     function  moveblock2
  1209.       begabove
  1210.       if getmarktop < getviewtop then
  1211.         y = 1 + getrow - (apparentrow  getviewtop - getrow)
  1212.       end
  1213.       if moveblock then
  1214.         if y then
  1215.           adjustrow y
  1216.         end
  1217.       else
  1218.         say "Move failed" 'b'
  1219.       end
  1220.       endabove
  1221.     end
  1222.  
  1223.     // move a block over text
  1224.     function  moveblockover
  1225.       if mark? then
  1226.         undobegin
  1227.         // use a temporary clipboard
  1228.         clip = _ClipName
  1229.         setobj ClipName 'T' 'prf'
  1230.         copy
  1231.         fillblock ' '
  1232.         paste 'o'
  1233.         setobj ClipName clip 'prf'
  1234.         destroybuf 'T'
  1235.         undoend
  1236.       end
  1237.     end
  1238.  
  1239.     // reformat a block or the current paragraph
  1240.     function  formatblock2 (options)
  1241.       if not options then
  1242.         options = _FormatOpt
  1243.       end
  1244.  
  1245.       // advance cursor
  1246.       if not getlinelen and (pos 'c' options) then
  1247.         loop
  1248.           if not down then
  1249.             return
  1250.           end
  1251.           if getlinelen then
  1252.             break
  1253.           end
  1254.         end
  1255.       end
  1256.  
  1257.       undobegin
  1258.       if not mark? then
  1259.         if markpara options then
  1260.           markcolumn (getcol) _RMargin (getmarktop) (getmarkbot)
  1261.           flag = ON
  1262.         end
  1263.       end
  1264.       // special case for single lines
  1265.       if getmarkrows == 1 and getcol < getlinebeg then
  1266.         delchar getlinebeg - getcol
  1267.       else
  1268.         formatblock _LMargin _RMargin options
  1269.       end
  1270.  
  1271.       if flag then
  1272.         // advance cursor
  1273.         if pos 'c' options then
  1274.           row getmarkbot + 1
  1275.         end
  1276.         destroymark
  1277.       end
  1278.       undoend
  1279.     end
  1280.  
  1281.     // simple text quoting support for a block or the current paragraph
  1282.     function  quote
  1283.       undobegin
  1284.       if getmarkbuf <> getcurrbuf then
  1285.         tempmark = TRUE
  1286.         oldmark = usemark 'T'
  1287.         markpara
  1288.       end
  1289.       if mark? then
  1290.         shiftblock 1 '' '>'
  1291.         if tempmark then
  1292.           destroymark
  1293.           usemark oldmark
  1294.         end
  1295.       else
  1296.         say "Nothing to quote"
  1297.       end
  1298.       undoend
  1299.     end
  1300.  
  1301.     // sort a block
  1302.     function  sortblock2
  1303.       if mark? and (runcfg "sort") then
  1304.         sortblock _SortOpt
  1305.       end
  1306.     end
  1307.  
  1308.     // prompt to fill a block with a string
  1309.     function  fillblock2
  1310.       askx "Enter fill string" '' "fillblock"
  1311.     end
  1312.  
  1313.     // prompt to save a block
  1314.     function  saveblock2 (options file)
  1315.       var c1
  1316.       var c2
  1317.       if mark? then
  1318.         if not file then
  1319.           file = ask "Save block as" "_load"
  1320.         end
  1321.         if file then
  1322.           file = qualify file (getbufname)
  1323.           addhistory "_load" file
  1324.           if fileattr? file 'r' then
  1325.             say "Read Only!" 'b'
  1326.           else
  1327.             action = locase (askrac file)
  1328.             if pos action "ra" then
  1329.               send "oncomment" file ref c1 ref c2
  1330.               options = _SaveOpt + options
  1331.               if not saveblock file
  1332.                       (if? (pos 'e' options) 'e' + _TabWidth) + options +
  1333.                       (if? action == 'a' 'a')
  1334.                       '' '' '' (if? c1 c1 + _FoldSign) c2 then
  1335.                 msgbox "Save Failed!" "Error!" 'b'
  1336.               end
  1337.             end
  1338.           end
  1339.         end
  1340.       else
  1341.         say "No marked block" 'b'
  1342.       end
  1343.     end
  1344.  
  1345.     // left justify, center, or right justify a block
  1346.     function  justblock2 (options)
  1347.       justblock options '' _LMargin _RMargin
  1348.     end
  1349.  
  1350.     // destroy open and closed folds
  1351.     function  destroyfold2
  1352.       undobegin
  1353.       if not fold? then
  1354.         closefold
  1355.       end
  1356.       destroyfold
  1357.       undoend
  1358.     end
  1359.  
  1360.     // do fold operations on entire file
  1361.     function  foldall (options)
  1362.       undobegin
  1363.       oldmark = usemark 'T'
  1364.       markline 1 (getlines)
  1365.       foldblock options
  1366.       destroymark
  1367.       usemark oldmark
  1368.       undoend
  1369.     end
  1370.  
  1371.     // fold a block or the current paragraph
  1372.     function  foldblock2
  1373.       undobegin
  1374.       if mark? then
  1375.         foldblock
  1376.       elseif markpara then
  1377.         foldblock
  1378.         destroymark
  1379.       end
  1380.       undoend
  1381.     end
  1382.  
  1383.     // fold a block and destroy subfolds
  1384.     function  foldflat
  1385.       undobegin
  1386.       foldblock 'ds'
  1387.       foldblock
  1388.       undoend
  1389.     end
  1390.  
  1391.     // fold or unfold a line
  1392.     function  foldline (options)
  1393.       undobegin
  1394.       oldmark = usemark 'T'
  1395.       markline
  1396.       unfold = pos 'u' options
  1397.       if fold? then
  1398.         foldblock 'd'
  1399.         if not unfold or getmarkrows > 1 then
  1400.           bottom = actualrow (if? unfold -1 1) (getmarkbot)
  1401.           if not (getfold 'o' bottom) then
  1402.             markline (getrow) bottom
  1403.           end
  1404.           foldblock
  1405.         end
  1406.       else
  1407.         if not unfold then
  1408.           foldblock
  1409.         end
  1410.       end
  1411.       destroymark
  1412.       usemark oldmark
  1413.       undoend
  1414.     end
  1415.  
  1416.     // detab or entab the current file
  1417.     // (+width=detab, -width=entab)
  1418.     function  tabfile (width)
  1419.       undobegin
  1420.       oldmark = usemark 'T'
  1421.       markline 1 (getlines)
  1422.       tabblock (if? width width _TabWidth)
  1423.       destroymark
  1424.       usemark oldmark
  1425.       undoend
  1426.     end
  1427.  
  1428.     // insert a line after the current line with autoindent
  1429.     function  insline2
  1430.       undobegin
  1431.       insline
  1432.       if setting? 'A' then
  1433.         if getlinelen then
  1434.           col (getlinebeg)
  1435.         else
  1436.           nextline = getrow + 2
  1437.           if getlinelen nextline then
  1438.             col (getlinebeg nextline)
  1439.           end
  1440.         end
  1441.       end
  1442.       down
  1443.       undoend
  1444.     end
  1445.  
  1446.     // swap the current line with the next line
  1447.     function  swapline
  1448.       undobegin
  1449.       oldmark = usemark 'T'
  1450.       markline
  1451.       stopmark
  1452.       down
  1453.       moveblock
  1454.       destroymark
  1455.       usemark oldmark
  1456.       undoend
  1457.     end
  1458.  
  1459.     // center the current line
  1460.     function  centerline
  1461.       undobegin
  1462.       oldmark = usemark 'T'
  1463.       markline
  1464.       justblock 'c' '' _LMargin _RMargin
  1465.       destroymark
  1466.       usemark oldmark
  1467.       undoend
  1468.     end
  1469.  
  1470.     // comment or uncomment a line
  1471.     function  commentline (c1 c2)
  1472.       if not c1 then
  1473.         send "oncomment" (getbufname) ref c1 ref c2
  1474.         if not c1 then
  1475.           c1 = '>'
  1476.         end
  1477.       end
  1478.       undobegin
  1479.       column = getlinebeg
  1480.       if (gettext column (sizeof c1)) == c1 then
  1481.         delchar (sizeof c2) getlinelen - (sizeof c2) + 1
  1482.         delchar (sizeof c1) column
  1483.       elseif getlinelen then
  1484.         instext c1 (getlinebeg)
  1485.         if column then
  1486.           ovltext c2  getlinelen + 1
  1487.         end
  1488.       end
  1489.       down
  1490.       undoend
  1491.     end
  1492.  
  1493.     // find previous word
  1494.     function  prevword
  1495.       while getcol > 1 and (poschar _CSet (getchar)) do
  1496.         left
  1497.       end
  1498.       find _CSet '[r'
  1499.       while getcol > 1 and
  1500.             (poschar _CSet (getchar getcol - 1)) do
  1501.         left
  1502.       end
  1503.     end
  1504.  
  1505.     // find next word
  1506.     function  nextword
  1507.       while poschar _CSet (getchar) do
  1508.         right
  1509.       end
  1510.       find _CSet '['
  1511.     end
  1512.  
  1513.     // change the case of the word at the cursor
  1514.     function  caseword (options charset)
  1515.       undobegin
  1516.       oldmark = usemark 'T'
  1517.       markword charset
  1518.       caseblock options
  1519.       destroymark
  1520.       usemark oldmark
  1521.       undoend
  1522.     end
  1523.  
  1524.     // open the filename at the cursor
  1525.     function  openword (charset)
  1526.       file = getword (if? charset charset _CSetB)
  1527.       if file then
  1528.         open file
  1529.       end
  1530.     end
  1531.  
  1532.     // delete the character at the cursor
  1533.     function  delchar2
  1534.       undobegin
  1535.       if getcol > getlinelen and _DelJoin == 'y' then
  1536.         joinline
  1537.       else
  1538.         delchar
  1539.         if setting? 'L' then
  1540.           livewrap
  1541.         end
  1542.       end
  1543.       undoend
  1544.     end
  1545.  
  1546.     // backspace
  1547.     function  backsp
  1548.       undobegin
  1549.       if getcol > 1 then
  1550.         left
  1551.         if not insert? and _BakOvl == 'y' then
  1552.           ovltext ' '
  1553.         else
  1554.           delchar
  1555.           if setting? 'L' then
  1556.             livewrap
  1557.           end
  1558.         end
  1559.       elseif getrow > 1 and _BakJoin == 'y' then
  1560.         up
  1561.         col getlinelen + 1
  1562.         joinline
  1563.       end
  1564.       undoend
  1565.     end
  1566.  
  1567.     // delete right word
  1568.     function  delword (charset)
  1569.       if not charset then
  1570.         charset = _CSet
  1571.       end
  1572.       undobegin
  1573.       if getcol > getlinelen then
  1574.         joinline
  1575.       else
  1576.         p = posnot charset (gettext (getcol))
  1577.         if p > 1 then
  1578.           delchar p - 1
  1579.         end
  1580.         delchar (
  1581.           if p then
  1582.             if getchar == ' ' and
  1583.                  (getcol == 1 or
  1584.                  (posnot charset (getchar getcol - 1))) then
  1585.               (posnot ' ' (gettext (getcol))) - 1
  1586.             else
  1587.               p == 1
  1588.             end
  1589.           else
  1590.             getlinelen
  1591.           end
  1592.         )
  1593.       end
  1594.       if setting? 'L' then
  1595.         livewrap
  1596.       end
  1597.       undoend
  1598.     end
  1599.  
  1600.     // splitline with autoindent
  1601.     function splitline2 (column)
  1602.       undobegin
  1603.       b = getlinebeg
  1604.       if splitline column then
  1605.         if not setting? 'A' then
  1606.           b = _LMargin
  1607.         end
  1608.         if b > 1 then
  1609.           pushcursor
  1610.           down
  1611.           oldmark = usemark 'T'
  1612.           markline
  1613.           shiftblock (if? getcol > b  b  (getcol)) - 1
  1614.           destroymark
  1615.           usemark oldmark
  1616.           popcursor
  1617.         end
  1618.       end
  1619.       undoend
  1620.     end
  1621.  
  1622.     // <enter> key behavior
  1623.     function  enter
  1624.  
  1625.       // terminate a word for text translation
  1626.       lastrow = getrow
  1627.       if getcol == getlinelen + 1 and getlinelen then
  1628.         if setting? 'T' then
  1629.           send <char> ' '
  1630.         end
  1631.       end
  1632.  
  1633.       if getrow == lastrow then
  1634.         case (if? (insert?) _EnterIns _EnterOvl)
  1635.           when 'i'
  1636.             insline2
  1637.           when 's'
  1638.             if fold? then
  1639.               insline2
  1640.             else
  1641.               startcolumn = getlinebeg
  1642.               length = getlinelen
  1643.               splitline2
  1644.               down
  1645.               if setting? 'A' then
  1646.                 if length then
  1647.                   col startcolumn
  1648.                 end
  1649.               else
  1650.                 startcolumn = _LMargin
  1651.                 col (if? startcolumn startcolumn 1)
  1652.               end
  1653.             end
  1654.           otherwise
  1655.             down
  1656.             col (if? (getlinelen) (getlinebeg) _LMargin)
  1657.         end
  1658.       end
  1659.     end
  1660.  
  1661.     // for use by variable tab right
  1662.     function  vtabr
  1663.       i = 1
  1664.       while i <= arg do
  1665.         if (arg i) <= getcol then
  1666.           i = i + 1
  1667.         else
  1668.           return arg i
  1669.         end
  1670.       end
  1671.       return 0
  1672.     end
  1673.  
  1674.     // for use by variable tab left
  1675.     function  vtabl
  1676.       i = arg
  1677.       while i do
  1678.         if (arg i) >= getcol then
  1679.           i = i - 1
  1680.         else
  1681.           return arg i
  1682.         end
  1683.       end
  1684.       return 0
  1685.     end
  1686.  
  1687.     // tab support
  1688.     function  tabfunc (next)
  1689.  
  1690.       oldcolumn = getcol
  1691.  
  1692.       // smart tabs
  1693.       if setting? 'S' then
  1694.         prevline = getrow - 1
  1695.         while prevline and not (getlinelen prevline) do
  1696.           prevline = prevline - 1
  1697.         end
  1698.         if prevline then
  1699.           pushcursor
  1700.           row prevline
  1701.           send (if? next "nextword" "prevword")
  1702.           if prevline == getrow then
  1703.             newcolumn = getcol
  1704.           end
  1705.           popcursor
  1706.         end
  1707.       end
  1708.  
  1709.       // variable tabs
  1710.       if not newcolumn then
  1711.         if setting? 'V' then
  1712.           newcolumn = eval (if? next "vtabr " "vtabl ") + _VarTabs
  1713.         end
  1714.  
  1715.         // standard interval tabs
  1716.         if not newcolumn then
  1717.           width = _TabWidth
  1718.           if not width then
  1719.             width = 8
  1720.           end
  1721.           newcolumn = oldcolumn +
  1722.                         if next then
  1723.                           width - (oldcolumn - 1) mod width
  1724.                         elseif oldcolumn > 1 then
  1725.                           -((oldcolumn - 2) mod width + 1)
  1726.                         end
  1727.         end
  1728.       end
  1729.  
  1730.       // move to tabstop and shift text if needed
  1731.       if newcolumn then
  1732.         if _TabShift == 'y' and insert? then
  1733.           if newcolumn < oldcolumn then
  1734.             delchar  oldcolumn - newcolumn  newcolumn
  1735.           elseif newcolumn > oldcolumn then
  1736.             instext (copystr ' ' newcolumn - oldcolumn)
  1737.           end
  1738.         end
  1739.         col newcolumn
  1740.       end
  1741.     end
  1742.  
  1743.     // tab left and right
  1744.     function  tabright    tabfunc 1  end
  1745.     function  tableft     tabfunc    end
  1746.  
  1747.     // prompt to verify close
  1748.     function  close?
  1749.       if bufchanged? and not getprevcurs then
  1750.         savechanges = popup "ync"  "Save changes to " +
  1751.                                         (getname (getbufname)) + '?'
  1752.         if savechanges == "Yes" then
  1753.           if not save then
  1754.             return ''
  1755.           end
  1756.         end
  1757.         icompare savechanges "Yes" "No"
  1758.       else
  1759.         1
  1760.       end
  1761.     end
  1762.  
  1763.     // close an edit window
  1764.     function  close (options)
  1765.       if pos 's' options then
  1766.         if save then
  1767.           pass
  1768.         end
  1769.       elseif close? then
  1770.         pass
  1771.       end
  1772.     end
  1773.  
  1774.     // open and insert prompt
  1775.     function  askinsert (file)
  1776.       if not file then
  1777.         file = ask  "File to insert into " + (getname (getbufname)) "_load"
  1778.       end
  1779.       if file then
  1780.         // addhistory not needed for open
  1781.         old_size = getlines
  1782.         undobegin
  1783.         if open file 'i' then
  1784.           // mark the inserted text
  1785.           if not (dir? (getbufname)) then
  1786.             if getlines > old_size then
  1787.               markline  getrow + 1  getrow + getlines - old_size
  1788.             end
  1789.           end
  1790.         end
  1791.         undoend
  1792.       end
  1793.     end
  1794.  
  1795.     // prompt to change the current file name
  1796.     function  askname
  1797.       newname = ask  "Rename " + (getname (getbufname)) + " to"  "_load"
  1798.       if newname then
  1799.         case setname newname
  1800.           when -1 say "Failed" 'b'
  1801.           when -2 say "Failed - file already loaded" 'b'
  1802.           otherwise
  1803.             addhistory "_load" (getbufname)
  1804.         end
  1805.       end
  1806.     end
  1807.  
  1808.     // search and replace with messages and highlighting
  1809.     function  search2 (search_str reverse again)
  1810.       var opt
  1811.       var rpl
  1812.       n = search search_str reverse again ref opt ref rpl
  1813.       if n then
  1814.         // replace occurred
  1815.         if rpl then
  1816.           display
  1817.           say (thousands n) + " changes made"
  1818.         // count occurrences
  1819.         elseif pos 'a' opt then
  1820.           display
  1821.           say (thousands n) + " occurrences of '" + search_str + "' found"
  1822.         // search only
  1823.         else
  1824.           onfound n
  1825.         end
  1826.       else
  1827.         display
  1828.         say "'" + search_str + "' not found"  'b'
  1829.       end
  1830.       return n
  1831.     end
  1832.  
  1833.     // find prompt
  1834.     function  askfind (reverse)
  1835.       search_string = if _PromptStyle == 'd' then
  1836.                         finddlg
  1837.                       else
  1838.                         ask "[string/abgirswx] Find"  "_find"
  1839.                       end
  1840.       if search_string then
  1841.         search2 search_string reverse
  1842.         addhistory "_find" search_string
  1843.       end
  1844.     end
  1845.  
  1846.     // replace prompt
  1847.     function  askrepl (reverse)
  1848.       search_string = if _PromptStyle == 'd' then
  1849.                         repldlg
  1850.                       else
  1851.                         ask "[string/replstr/abgirswx] Repl"  "_find"
  1852.                       end
  1853.       if search_string then
  1854.         search2 search_string reverse
  1855.         addhistory "_find" search_string
  1856.       end
  1857.     end
  1858.  
  1859.     // do the last find/replace operation
  1860.     // (reverse=r reverses the search direction)
  1861.     function  findlast (reverse)
  1862.       search2 (gethiststr "_find") reverse TRUE
  1863.     end
  1864.  
  1865.     // incremental search
  1866.     function  isearch
  1867.  
  1868.       var search_string
  1869.  
  1870.       repeat
  1871.  
  1872.         settitle  "I-search for [" + search_string + "] "
  1873.         keycode = getkey
  1874.         options = _SearchOpt
  1875.         new_char = ''
  1876.  
  1877.         case  keycode
  1878.  
  1879.           when <backspace>
  1880.             if search_string then
  1881.               popcursor
  1882.               search_string = if (sizeof search_string) > 1 then
  1883.                                 search_string [1 : (sizeof search_string) - 1]
  1884.                               else
  1885.                                 ''
  1886.                               end
  1887.               if not search_string then
  1888.                 display
  1889.               end
  1890.               options = '*'
  1891.             end
  1892.  
  1893.           when <ctrl p>, <ctrl r>
  1894.             options = 'r'
  1895.  
  1896.           when <ctrl n>, <ctrl l>
  1897.             // do nothing
  1898.  
  1899.           when <ctrl g>, <ctrl b>
  1900.             options = 'g'
  1901.  
  1902.           otherwise
  1903.             keyname = getkeyname keycode
  1904.             if (sizeof keyname) == 3 then
  1905.               pushcursor
  1906.               new_char = keyname [2]
  1907.               options = '*'
  1908.             else
  1909.  
  1910.               // restore window title
  1911.               settitle (getbufname)
  1912.               display
  1913.  
  1914.               // clear all pushed cursors
  1915.               popcursor "ad"
  1916.               addhistory "_find" search_string
  1917.  
  1918.               if keycode <> <enter> and keycode <> <esc> then
  1919.                 queuekey keycode
  1920.               end
  1921.  
  1922.               done = TRUE
  1923.             end
  1924.         end
  1925.  
  1926.         if not done and (search_string or new_char) then
  1927.           new_string = concat search_string new_char
  1928.           str_length = find new_string  _SearchOpt + options
  1929.           if str_length then
  1930.             onfound str_length
  1931.             search_string = new_string
  1932.           else
  1933.             say  new_string + " not found"  'b'
  1934.             if new_char then
  1935.               popcursor
  1936.             end
  1937.             onfound (sizeof search_string)
  1938.           end
  1939.         end
  1940.  
  1941.       until done
  1942.     end
  1943.  
  1944.  
  1945.     // find occurrences search
  1946.     function  findo (string_and_opt)
  1947.  
  1948.       var search_string
  1949.       var options
  1950.       var o
  1951.  
  1952.       n = splitstr '' string_and_opt
  1953.                    ref search_string  ref options  ref o
  1954.  
  1955.       // initialize search options
  1956.       if n >= 2 then
  1957.         if n > 2 then
  1958.           options = o
  1959.         end
  1960.       else
  1961.         options = _SearchOpt
  1962.       end
  1963.       if pos 'g' options then
  1964.         options = sub 'g' '' options
  1965.       end
  1966.       options = options + '*'
  1967.  
  1968.       // do the search
  1969.       buffer = createbuf
  1970.       ovltext "≡≡≡≡≡≡ Select this line to edit occurrences ≡≡≡≡≡≡"
  1971.       gotobuf (getprevbuf)
  1972.       pushcursor
  1973.       gotopos 1 1
  1974.       while find  search_string options  do
  1975.         addline  getrow + ": " + gettext  '' '' buffer
  1976.         col MAX_COL
  1977.       end
  1978.       popcursor
  1979.  
  1980.       // display occurrences
  1981.       if (getlines buffer) > 1 then
  1982.         bname = getbufname
  1983.         line = popup buffer
  1984.                  "Occurrences of '" + search_string + "' in "
  1985.                  + (getname bname) + " - " + ((getlines buffer) - 1) +
  1986.                  " lines"   getvidcols - 11 getvidrows - 8
  1987.         if line then
  1988.           if line [1] == '≡' then
  1989.             delline 1 1 buffer
  1990.             setbufname (qualify "TEMP.TXT" bname) buffer
  1991.             openbuf buffer
  1992.           else
  1993.             destroybuf buffer
  1994.             gotopos 1 line [1 : (pos ':' line) - 1]
  1995.             onfound (find search_string  options + '*l')
  1996.           end
  1997.         end
  1998.       else
  1999.         destroybuf buffer
  2000.         display
  2001.         say  "'" + string_and_opt + "' not found"  'b'
  2002.       end
  2003.     end
  2004.  
  2005.     // prompt to find occurrences
  2006.     function  askfindo
  2007.       search_str = ask "[string/birswx] Find occurrences of"  "_find"
  2008.       if search_str then
  2009.         findo search_str
  2010.         addhistory "_find" search_str
  2011.       end
  2012.     end
  2013.  
  2014.     // find all occurrences of last find string
  2015.     function  findlasto
  2016.       findo (gethiststr "_find")
  2017.     end
  2018.  
  2019.     // find matching character (){}[]<>
  2020.     function  gotomatch2
  2021.       if gotomatch "(){}[]<>" then
  2022.         onfound 1
  2023.       else
  2024.         say "Not found" 'b'
  2025.       end
  2026.     end
  2027.  
  2028.     // goto column
  2029.     function  col2 (column)
  2030.       case column [1]
  2031.         when '+'   right  column [2 : TO_END]
  2032.         when '-'   left   column [2 : TO_END]
  2033.         otherwise  col (if? column > MAX_COL MAX_COL column)
  2034.       end
  2035.       onfound
  2036.     end
  2037.  
  2038.     // goto line
  2039.     function  row2 (line)
  2040.       case line [1]
  2041.         when '+'   down line [2 : TO_END]
  2042.         when '-'   up   line [2 : TO_END]
  2043.         otherwise  row (if? line > getlines (getlines) line)
  2044.       end
  2045.       onfound
  2046.     end
  2047.  
  2048.     // goto line prompt
  2049.     function  askrow
  2050.       askx "Line number" "_line" "row2"
  2051.     end
  2052.  
  2053.     // goto column prompt
  2054.     function  askcol
  2055.       askx "Column Number" '' "col2"
  2056.     end
  2057.  
  2058.     // set a quick bookmark
  2059.     function  quickbook
  2060.       _bk = _bk + 1
  2061.       bookmark = "Book" + _bk
  2062.       setbook bookmark
  2063.       display
  2064.       say "Bookmark " + bookmark + " set"
  2065.     end
  2066.  
  2067.     // place a bookmark
  2068.     function  placebook (bookmark)
  2069.       if not bookmark then
  2070.         bookmark = ask "Bookmark Name" "_book"
  2071.       end
  2072.       if bookmark then
  2073.         setbook bookmark
  2074.         display
  2075.         say "Bookmark '" + bookmark + "' set"
  2076.       end
  2077.     end
  2078.  
  2079.  
  2080.     // Go to the compiler error on the current line of a compiler
  2081.     // error output file. This function recognizes compiler errors
  2082.     // of the form:
  2083.     //
  2084.     //   <text>  FILENAME.EXT  <text>  LINENUMBER  <text> : MESSAGE
  2085.     //
  2086.     // (implemented by using the 'parse' builtin function with regular
  2087.     // expression searching)
  2088.  
  2089.     function  gotoerror
  2090.       var filename
  2091.       var line
  2092.       var message
  2093.  
  2094.       // filename charclass to use (max closure without the period)
  2095.       fileset = "[a-zA-Z0-9_\-/\\\\@~:^!#$%&`']#"
  2096.  
  2097.       // parse the current line into filename/line/message variables
  2098.       if parse '{' + fileset + '\.' + fileset + "}.*{[0-9]#}.*:{.*}$"
  2099.                (gettext) 'x' ref filename ref line ref message then
  2100.  
  2101.         // open the file
  2102.         if open filename then
  2103.  
  2104.           // get the real line number if folds are present
  2105.           if (getfold 'n') and
  2106.              (loadbuf (getbufname) '' (hex2bin _LineDlm) 'x') then
  2107.             row line
  2108.             line = line - (find _FoldSign 'ar')
  2109.             destroybuf
  2110.           end
  2111.  
  2112.           row line
  2113.  
  2114.           // open folds until the line is exposed
  2115.           while (getfold 'c') and getrow <> line do
  2116.             openfold
  2117.             row line
  2118.           end
  2119.  
  2120.           col (getlinebeg)
  2121.           send "onfound"
  2122.           say  message + '  '
  2123.           return
  2124.         end
  2125.       end
  2126.       display
  2127.       say "Compiler message not recognized."
  2128.     end
  2129.  
  2130.  
  2131.     // backup a file and return the backup filename if sucessful
  2132.     function  backup (file)
  2133.       if locatefile file then
  2134.         dir = _BackupDir
  2135.         if dir then
  2136.           if (sizeof dir) > 3 and  dir [LAST_CHAR] == "\\" then
  2137.             dir = dir [1 : (sizeof dir) - 1]
  2138.           end
  2139.           createdir dir
  2140.           dir = qualify dir
  2141.           backup_file = if pos "*.*" dir then
  2142.                           qualify (getname file) dir
  2143.                         else
  2144.                           msgbox "Unable to create backup file!"
  2145.                                  "Warning!"
  2146.                           return 1
  2147.                         end
  2148.         else
  2149.           backup_file = forceext file _BackupExt
  2150.         end
  2151.  
  2152.         // delete the old backup file
  2153.         deletefile backup_file
  2154.  
  2155.         // attempt a rename
  2156.         if not renamefile file backup_file then
  2157.           // try copy if rename fails
  2158.           if (copyfile file backup_file) <= 0 then
  2159.             msgbox "File backup failed!" "Error"
  2160.             return 0
  2161.           end
  2162.         end
  2163.         return backup_file
  2164.       else
  2165.         return 1
  2166.       end
  2167.     end
  2168.  
  2169.     // save the current file to disk
  2170.     function  save (file options)
  2171.       var c1
  2172.       var c2
  2173.  
  2174.       // check for a truncated file
  2175.       if trunc? and
  2176.          not (icompare (popup "ok" "Truncated file - are you sure?") "Ok") then
  2177.         return
  2178.       end
  2179.  
  2180.       file = if file then
  2181.                qualify file (getbufname)
  2182.              else
  2183.                getbufname
  2184.              end
  2185.       // check for read/only
  2186.       if (bufferflag? 'r') or (fileattr? file 'r') then
  2187.         say "Read Only!" 'b'
  2188.       else
  2189.         backup_file = 1
  2190.         if setting? 'B' then
  2191.           backup_file = backup file
  2192.         end
  2193.         if not backup_file then
  2194.           say "Backup failed" 'b'
  2195.         else
  2196.           send "onsave" file
  2197.  
  2198.           // get fold comments for the file (if any)
  2199.           send "oncomment" file ref c1 ref c2
  2200.           options = _SaveOpt + options
  2201.           if not savebuf file
  2202.                    (if? (pos 'e' options) 'e' + _TabWidth) + options  ''
  2203.                    (if not getbinarylen then hex2bin _LineDlm end) ''
  2204.                    (if? c1 c1 + _FoldSign) c2 then
  2205.  
  2206.             // restore the backup after save failure
  2207.             if backup_file <> 1 then
  2208.               if not renamefile backup_file file then
  2209.                 copyfile backup_file file
  2210.               end
  2211.             end
  2212.             msgbox "Save failed!  Check file path / file attributes / disk space"  "Error!" 'b'
  2213.             return 0
  2214.           else
  2215.             1
  2216.           end
  2217.         end
  2218.       end
  2219.     end
  2220.  
  2221.     // save-as prompt
  2222.     function  asksaveas (options)
  2223.       file = ask "Save " + (getname (getbufname)) + " as"  "_load"
  2224.       if file then
  2225.         file = qualify file (getbufname)
  2226.         addhistory "_load" file
  2227.         save file options
  2228.       end
  2229.     end
  2230.  
  2231.     // start, stop, or do autosave
  2232.     function  autosave (seconds)
  2233.       if not arg then
  2234.         if bufchanged? then
  2235.           save
  2236.         end
  2237.       elseif seconds <= 0 then
  2238.         destroytimer "asav"
  2239.       else
  2240.         setrepeat "asav" seconds * 1000  '' "autosave"
  2241.       end
  2242.     end
  2243.  
  2244.     // prompt for autosave interval in seconds
  2245.     function  askasave
  2246.       seconds = ask "Autosave interval in secs (-1=disable)"
  2247.       if seconds then
  2248.         autosave seconds
  2249.       end
  2250.     end
  2251.  
  2252.     // highlight all occurrences of the word at the cursor
  2253.     function  hiliteword
  2254.       sobj = send "onsyntax" (getbufname)
  2255.       if not sobj then
  2256.         setting 'X' DEFAULT
  2257.         sobj = "syndef"
  2258.       end
  2259.       if sobj then
  2260.         w = send "getword" "a-zA-Z_0-9?"
  2261.         if w then
  2262.           // create a color selection menu
  2263.           menu "hcolor"
  2264.             item " &None"           -1
  2265.             item " &Default"        -2
  2266.             item "-"
  2267.             item " &Black"          color white on black
  2268.             item " B&lue"           color yellow on blue
  2269.             item " &Green"          color white on green
  2270.             item " &Cyan"           color white on cyan
  2271.             item " &Red"            color white on red
  2272.             item " &Magenta"        color white on magenta
  2273.             item " Br&own"          color white on brown
  2274.             item " Gr&ay"           color white on gray
  2275.             item "-"
  2276.             item " Dar&kgray"       color white on darkgray
  2277.             item " Brightbl&ue"     color white on brightblue
  2278.             item " Brightgr&een"    color black on brightgreen
  2279.             item " Brig&htcyan"     color black on brightcyan
  2280.             item " Br&ightred"      color white on brightred
  2281.             item " Brightmagen&ta"  color white on brightmagenta
  2282.             item " &Yellow"         color black on yellow
  2283.             item " &White"          color black on white
  2284.           end
  2285.           setbufname "colorlist"
  2286.           hcolor = popup "hcolor" "select a color "
  2287.           // destroy the menu
  2288.           destroybuf "hcolor"
  2289.           if hcolor then
  2290.             if hcolor == -1 then
  2291.               unsetx w sobj
  2292.             else
  2293.               setxobj w (if? hcolor == -2 '' hcolor) sobj
  2294.             end
  2295.           end
  2296.           display
  2297.         end
  2298.       end
  2299.     end
  2300.  
  2301.     // live word wrap support
  2302.     function  livewrap
  2303.  
  2304.       if fold? then
  2305.         return
  2306.       end
  2307.  
  2308.       startcol = getlinebeg
  2309.       if getrow < getlines and (getlinelen  getrow + 1) then
  2310.         n = getlinebeg  getrow + 1
  2311.         startcol = if? n < startcol  n  startcol
  2312.       elseif not getlinelen or not (setting? 'A') then
  2313.         startcol = _LMargin
  2314.       end
  2315.  
  2316.       if getcol < startcol then
  2317.         startcol = getcol
  2318.       end
  2319.  
  2320.       if getlinelen then
  2321.         undobegin
  2322.         saved_char = getchar
  2323.         ovltext '²'
  2324.  
  2325.         // mark to the end of the paragraph
  2326.         pushcursor
  2327.         top = getrow
  2328.         while down and getlinelen do end
  2329.         if not getlinelen then
  2330.           up
  2331.         end
  2332.         bottom = getrow
  2333.         popcursor
  2334.  
  2335.         // reformat
  2336.         oldmark = usemark 'T'
  2337.         markcolumn startcol _RMargin top bottom
  2338.         formatblock '' '' "kr"
  2339.         destroymark
  2340.         usemark oldmark
  2341.  
  2342.         // find the original cursor position
  2343.         col 1
  2344.         find '²' '*'
  2345.         ovltext (if? saved_char saved_char ' ')
  2346.  
  2347.         undoend
  2348.       end
  2349.     end
  2350.  
  2351.     // enter a character or string at the cursor, with support for:
  2352.     //   - match character
  2353.     //   - translate
  2354.     //   - standard word wrap
  2355.     //   - live word wrap
  2356.  
  2357.     function  write (write_str)
  2358.  
  2359.       // group together as one undoable operation
  2360.       undobegin
  2361.  
  2362.       // enter the character or string at the cursor and
  2363.       // advance the cursor
  2364.       writetext write_str
  2365.  
  2366.       // get the current window settings
  2367.       setting_str = getsettings
  2368.  
  2369.       // match character
  2370.       if pos 'M' setting_str then
  2371.         instext ( case write_str
  2372.                     when '"'  '"'
  2373.                     when '('  ')'
  2374.                     when '['  ']'
  2375.                     when '{'  '}'
  2376.                     otherwise ''
  2377.                   end )
  2378.       end
  2379.  
  2380.       // translate
  2381.       if pos 'T' setting_str then
  2382.  
  2383.         // delimited lookup?
  2384.         to_word_end = if? (posnot _TranCSet write_str) 2 1
  2385.  
  2386.         // get the last word typed
  2387.         word_str = getword _TranCSet (getcol - to_word_end)
  2388.         if word_str then
  2389.           lookup_str = word_str + (if? to_word_end == 2 '*')
  2390.  
  2391.           // lookup the word in the translate object
  2392.           value = lookup lookup_str _TranObj
  2393.  
  2394.           if value then
  2395.             // is it a function? ..then evaluate it
  2396.             if function? lookup_str _TranObj then
  2397.               eval value
  2398.  
  2399.             // otherwise replace the word
  2400.             else
  2401.               word_column = getcol - (sizeof word_str) - to_word_end + 1
  2402.               delchar (sizeof word_str) word_column
  2403.               instext value word_column
  2404.               col word_column + (sizeof value) + to_word_end - 1
  2405.             end
  2406.           end
  2407.         end
  2408.       end
  2409.  
  2410.       // check for word wrap and live wrap
  2411.       if getlinelen > _RMargin then
  2412.  
  2413.         // live word wrap
  2414.         if pos 'L' setting_str then
  2415.           livewrap
  2416.  
  2417.         // standard word wrap
  2418.         elseif (pos 'W' setting_str) and (not fold?) then
  2419.           column = getcol
  2420.           limit = _RMargin + 1
  2421.           if column > limit then
  2422.             if write_str <> ' ' then
  2423.               first_col = if? (setting? 'A') (getlinebeg) _LMargin
  2424.               split_col = pos ' ' (gettext 1 limit) 'r'
  2425.               split_col = if? split_col > first_col  split_col + 1  limit
  2426.               splitline split_col
  2427.               down
  2428.               markline '' '' 'T'
  2429.               shiftblock  first_col - 1 'T'
  2430.               destroymark 'T'
  2431.               col  column - split_col + first_col
  2432.             end
  2433.           end
  2434.         end
  2435.       end
  2436.  
  2437.       undoend
  2438.     end
  2439.  
  2440.     // enter a date/time stamp at the cursor
  2441.     function  timestamp
  2442.       write getdate + ' ' + gettime
  2443.     end
  2444.  
  2445.  
  2446. // -------------------------------------------------------------------
  2447. //  File Manager windows
  2448. // -------------------------------------------------------------------
  2449.  
  2450.   object  fmgr
  2451.  
  2452.     // return the file name for fmgr commands
  2453.     function  fname2
  2454.       if fmark? then
  2455.         "MARKED FILES"
  2456.       else
  2457.         getname (getffile)
  2458.       end
  2459.     end
  2460.  
  2461.     // error notification
  2462.     function  ferror (s)
  2463.       msgbox  s + " Failed"  "Error!" 'b'
  2464.     end
  2465.  
  2466.     // fmgr confirmation prompt
  2467.     function  fconfirm (confirm pstring func)
  2468.       if (icompare confirm 'n') or
  2469.          (icompare (popup "ok" pstring + ' ' + fname2 + '?') "ok") then
  2470.         fdomark func
  2471.         reopen
  2472.       end
  2473.     end
  2474.  
  2475.     // internal fopen
  2476.     function  fopn (file options)
  2477.       if file then
  2478.         openf file options
  2479.       else
  2480.         fdomark "fopn" options
  2481.       end
  2482.     end
  2483.  
  2484.     // fmgr open file(s) command
  2485.     function  fopen (options)
  2486.  
  2487.       var searchopt
  2488.  
  2489.       if pos '1' options then
  2490.         if shiftkey? then
  2491.           options = options + 'v'
  2492.         end
  2493.         scanstr = fscanstr
  2494.         openf '' options
  2495.  
  2496.         // find first occurrence for scan windows
  2497.         if scanstr then
  2498.           addhistory "_find" scanstr
  2499.           splitstr '' scanstr '' ref searchopt
  2500.           gotopos 1 (if? (pos 'r' searchopt) (getlines) 1)
  2501.           send "onfound" (search scanstr)
  2502.         end
  2503.  
  2504.       else
  2505.         fopn '' options
  2506.       end
  2507.     end
  2508.  
  2509.     // fmgr change file attributes command
  2510.     function  fattr (file attr)
  2511.       if file then
  2512.         chgfileattr file attr
  2513.       else
  2514.         attr = ask "New attributes [AHSR] for " + fname2
  2515.         if attr then
  2516.           fdomark "fattr" (if? attr <> ' ' attr)
  2517.           reopen
  2518.         end
  2519.       end
  2520.     end
  2521.  
  2522.     // fmgr delete file(s) command
  2523.     function  fdelete (file)
  2524.       if file then
  2525.         if pos "*.*" file then
  2526.           file = getpath file
  2527.         end
  2528.         if not deletefile file 'd' then
  2529.           ferror "Delete"
  2530.         end
  2531.       else
  2532.         fconfirm _ConDel "Delete" "fdelete"
  2533.       end
  2534.     end
  2535.  
  2536.     // fmgr touch file(s) command
  2537.     function  ftouch (file)
  2538.       if file then
  2539.         if not touchfile file then
  2540.           ferror "Touch"
  2541.         end
  2542.       else
  2543.         fconfirm _ConTch "Touch" "ftouch"
  2544.       end
  2545.     end
  2546.  
  2547.     // print a file or directory with the current printer settings
  2548.     function  printfile (file)
  2549.       if loadbuf file '' '' _FmgrOpt _TruncLength then
  2550.         print
  2551.         destroybuf
  2552.       end
  2553.     end
  2554.  
  2555.     // fmgr print file(s) command
  2556.     function  fprint (file)
  2557.       if file then
  2558.         if not printfile file then
  2559.           ferror "Print"
  2560.         end
  2561.       else
  2562.         fconfirm 'y' "Print" "fprint"
  2563.       end
  2564.     end
  2565.  
  2566.     // fmgr run file command
  2567.     function  frun (options)
  2568.       run (getffile) options
  2569.       reopen
  2570.     end
  2571.  
  2572.     // fmgr rename file command
  2573.     function  frename
  2574.       oldname = getffile
  2575.       newname = ask  "Rename " + (getname oldname) + " to"  "_load"
  2576.       if newname then
  2577.         if renamefile oldname (qualify newname (getbufname)) then
  2578.           reopen
  2579.         else
  2580.           ferror "Rename"
  2581.         end
  2582.       end
  2583.     end
  2584.  
  2585.     // fmgr copy (or move) file(s) command
  2586.     function  fcopy (source dest options)
  2587.       if source then
  2588.         if dir? dest then
  2589.           dest = qualify (getname source) dest
  2590.         end
  2591.         action = askrac dest
  2592.         if pos action "ra" 'i' then
  2593.           move? = options == 'm'
  2594.           say (if? move? "Mov" "Copy") + "ing " + source "..."
  2595.           if not move? or (icompare action 'a') or not (renamefile source dest) then
  2596.             if not copyfile source dest (if? (icompare action 'a') 'a') then
  2597.               ferror (if? move? "Move" "Copy")
  2598.               fdobrk
  2599.             else
  2600.               if move? then
  2601.                 deletefile source
  2602.               end
  2603.             end
  2604.           end
  2605.         end
  2606.       else
  2607.         if fmark? then
  2608.           dir_dest = qualify (getffile)
  2609.           if not dir? dir_dest then
  2610.             dir_dest = ''
  2611.           end
  2612.         end
  2613.         dest = ask (if? options == 'm' "Move " "Copy ") + fname2 + " to"
  2614.                    "_load" dir_dest
  2615.         if dest then
  2616.           fdomark "fcopy" (qualify dest (getbufname)) options
  2617.           reopen
  2618.         end
  2619.       end
  2620.     end
  2621.  
  2622.     // fmgr move file(s) command
  2623.     function  fmove
  2624.       fcopy '' '' 'm'
  2625.     end
  2626.  
  2627.     // fmgr create new directory command
  2628.     function  fmkdir
  2629.       dir = ask "New directory name" "_load"
  2630.       if dir then
  2631.         if createdir (qualify dir (getbufname)) then
  2632.           reopen
  2633.         else
  2634.           ferror "Create directory"
  2635.         end
  2636.       end
  2637.     end
  2638.  
  2639.  
  2640. // -------------------------------------------------------------------
  2641. //  On-Event functions called by the editor
  2642. // -------------------------------------------------------------------
  2643.  
  2644.   // edit windows & file manager windows only
  2645.   object  edit_fmgr
  2646.  
  2647.     // called while loading files
  2648.     function  onloading (lines)
  2649.       say (if? lines  "Loading [" + lines + "]..."  getbufname)
  2650.     end
  2651.  
  2652.     // called while saving files
  2653.     function  onsaving (lines)
  2654.       say (if? lines  "Saving [" + lines + "]..."  getbufname)
  2655.     end
  2656.  
  2657.     // called while printing files
  2658.     function  onprinting (lines)
  2659.       say (if? lines  "Printing [" + lines + "]... <ctrl break> to stop "
  2660.            getbufname)
  2661.     end
  2662.  
  2663.     // called while scanning files
  2664.     function  onscanning (file found)
  2665.  
  2666.       // create scan progress window
  2667.       if not window? 'scan' then
  2668.  
  2669.         obj = geteventobj
  2670.         createwindow 'scan'
  2671.         setwinobj
  2672.         setframe ">b"
  2673.         setcolor  border_color   color white on gray
  2674.         setcolor  text_color     color black on gray
  2675.         settitle "Scanning" 'c'
  2676.         setborder "1i"
  2677.         setshadow 2 1
  2678.  
  2679.         // center the window
  2680.         width = (sizeof (getpath file)) + 24
  2681.         height = 16
  2682.         ox = (getvidcols - width) / 2
  2683.         oy = (getvidrows - height) / 2
  2684.         sizewindow ox oy ox + width oy + height "ad"
  2685.         writestr   file + "..."
  2686.         eventobject obj
  2687.  
  2688.       elseif found then
  2689.         writestr " FOUND" (color brightgreen on gray) (getcoord 'x1') - 7
  2690.  
  2691.       elseif file then
  2692.         writeline
  2693.         writestr   file + "..."
  2694.  
  2695.       else
  2696.         obj = geteventobj
  2697.         destroywindow
  2698.         eventobject obj
  2699.       end
  2700.  
  2701.       display
  2702.     end
  2703.  
  2704.     // called while compiling files
  2705.     function  oncompiling (file lines)
  2706.       say (if? lines  "Compiling " + file + " [" + lines + "]..."  getbufname)
  2707.     end
  2708.  
  2709.  
  2710.   // edit windows only
  2711.   object  edit
  2712.  
  2713.     // called after a file is opened and before it's displayed
  2714.     function  onopen
  2715.  
  2716.       // set window event object
  2717.       setwinobj "edit"
  2718.  
  2719.       // default window settings (if not remembered by open)
  2720.       if not getsettings then
  2721.         setting _DefaultSet ON
  2722.       end
  2723.  
  2724.       // check for file truncation
  2725.       if trunc? then
  2726.         display
  2727.         say "File Truncated!" 'b'
  2728.       end
  2729.     end
  2730.  
  2731.     // called immediately before a file is saved
  2732.     //function  onsave (file)
  2733.     //end
  2734.  
  2735.     // called when switching to a file or window
  2736.     //function  onfocus
  2737.     //end
  2738.  
  2739.     // called when closing a file
  2740.     //function  onclose
  2741.     //end
  2742.  
  2743.     // called after a search to change the window view and
  2744.     // optionally highlight a string
  2745.     function  onfound (stringlength)
  2746.  
  2747.       // check if the cursor is outside the window view
  2748.       if getcol < getviewleft then
  2749.         if getcol < getviewcols then
  2750.           rollcol -getviewleft
  2751.         else
  2752.           adjustcol 3
  2753.         end
  2754.       elseif getcol + stringlength >= getviewright then
  2755.         adjustcol
  2756.       end
  2757.  
  2758.       if getrow > getviewbot then
  2759.         adjustrow 3
  2760.       elseif getrow < getviewtop then
  2761.         adjustrow
  2762.       end
  2763.       display
  2764.  
  2765.       // highlight a string if stringlength is specified
  2766.       if stringlength then
  2767.         hilite stringlength 1 (getpalette (if? (inmark?) 9 8))
  2768.       end
  2769.     end
  2770.  
  2771.  
  2772.   object  fmgr
  2773.  
  2774.     // called after a fmgr window is opened and before it's displayed
  2775.     function  onopen
  2776.  
  2777.       // set the window event object
  2778.       setwinobj "fmgr"
  2779.  
  2780.       // check for include picklist
  2781.       if ftype? 'i' then
  2782.         display
  2783.         say "Select file to insert"
  2784.       end
  2785.     end
  2786.  
  2787.  
  2788.   // all windows
  2789.   object  a
  2790.  
  2791.     // called when sounding an alarm
  2792.     // (allows you to customize the alarm sound)
  2793.     function  onalarm
  2794.       beep 750 70
  2795.     end
  2796.  
  2797.     // get default comments for a filename (c1, c2 passed by reference)
  2798.     // (associates a filename with comment symbols)
  2799.     function  oncomment (file c1 c2)
  2800.       case getext (upcase file)
  2801.         when ".C", ".AML", ".CPP", ".H"   c1 = "//"
  2802.         when ".ASM"                       c1 = ';'
  2803.         when ".PAS"                       c1 = '{'   c2 = '}'
  2804.         otherwise                         c1 = '>'
  2805.       end
  2806.     end
  2807.  
  2808.  
  2809.     // called when entering the editor before any windows are open.
  2810.     // DOS command-line filespecs are passed to this function
  2811.     function  onentry
  2812.  
  2813.       // save the DOS entry path
  2814.       _cp = getcurrpath
  2815.  
  2816.       // open prompt and window history
  2817.       if _SaveHistory == 'y' then
  2818.         openhistory (bootpath "history.dat")
  2819.       end
  2820.  
  2821.       // process command-line parameters passed to the editor
  2822.       param_num = 1
  2823.       parameter = arg 1
  2824.  
  2825.       while parameter do
  2826.  
  2827.         // check for command line options
  2828.         if parameter [1:2] == "-e"  then
  2829.           queue parameter [3 : TO_END]
  2830.  
  2831.         // open files/directories
  2832.         else
  2833.           open parameter
  2834.         end
  2835.  
  2836.         // next command line parm
  2837.         param_num = param_num + 1
  2838.         parameter = arg param_num
  2839.       end
  2840.  
  2841.       // still no windows open? then do bootoptions...
  2842.       if not getcurrwin then
  2843.         case _BootOpt
  2844.           when 'd'  restoredesk
  2845.           when 'f'  open '.'
  2846.           when 'n'  opennew
  2847.           otherwise
  2848.             filespec = ask "File or Directory" "_load"
  2849.             if filespec then
  2850.               open filespec
  2851.             else
  2852.               halt
  2853.             end
  2854.         end
  2855.       end
  2856.  
  2857.       // initialize the mouse
  2858.       if _Mouse == 'y' then
  2859.         if openmouse _MouseOpt then
  2860.           mousepos  15999 + getvidcols  15999 + getvidrows
  2861.           y_sens = _MouSenY
  2862.           if (getos 'v') > 9 then
  2863.             mousesense (_MouSenX * 5) / 8  (y_sens * 5) / 8  _MouDST
  2864.           else
  2865.             mousesense _MouSenX y_sens _MouDST
  2866.           end
  2867.         end
  2868.       end
  2869.  
  2870.       // open key macros if configured
  2871.       if _SaveMac == 'y' then
  2872.         openkey (bootpath "a.mac")
  2873.       end
  2874.  
  2875.       // set autosave timer
  2876.       send "autosave" _AutoSave
  2877.     end
  2878.  
  2879.  
  2880.     // called when exiting the editor after all windows are closed
  2881.     function  onexit
  2882.  
  2883.       // open prompt on non-global exit (if configured)
  2884.       if not __G then
  2885.         if _ExitOpen == 'y' then
  2886.           filespec = ask "File or Directory" "_load"
  2887.           if filespec then
  2888.             open filespec
  2889.           end
  2890.         end
  2891.       end
  2892.  
  2893.       // final exit if no windows open
  2894.       if not getcurrwin then
  2895.  
  2896.         // save prompt and window history
  2897.         if _SaveHistory == 'y' then
  2898.           savehistory (bootpath "history.dat")
  2899.         end
  2900.  
  2901.         // save key macros if configured
  2902.         if _SaveMac == 'y' then
  2903.           // check if record occurred
  2904.           if lookup "kd" "mon" then
  2905.             savekey (bootpath "a.mac")
  2906.           end
  2907.         end
  2908.  
  2909.         // restore entry path saved in onentry
  2910.         currpath _cp
  2911.  
  2912.         closemouse
  2913.         halt
  2914.       end
  2915.     end
  2916.  
  2917.