home *** CD-ROM | disk | FTP | other *** search
/ High Voltage Shareware / high1.zip / high1 / DIR8 / WP4PROG.ZIP / WP4PROG.S < prev   
Text File  |  1993-04-22  |  61KB  |  1,844 lines

  1. /*****************************************************************************
  2.  
  3.             WordPerfect For Programmers User Interface for
  4.                        The SemWare Editor V1.0
  5.        The Semware Editor Copyright 1991-1993 SemWare Corporation.
  6.                     All Rights Reserved Worldwide.
  7.  
  8.         WordPerfect for Programmers Interface by Mike Hammer 4/93
  9.  
  10. -----------------------------------------------------------------------------
  11.  
  12.  This program gives The SemWare Editor a very different user interface
  13.  (UI) than standard TSE or WordPerfect. It attempts to walk the line
  14.  between retaining all the standard WP editing keys and commands while
  15.  including as many of the nice programmer's editor features of TSE.
  16.  
  17.  Much has been changed, including user preferences, certain built-in
  18.  commands, menus, help, and key-assignments. Macros have been moved in
  19.  from the original WP-TSE v1.0ß and from the standard TSE interface, and
  20.  a few very simple ones written to enhance basic functions in places
  21.  QEdit handled things better (IMHO) than TSE v1.0ß or WP. Basic
  22.  commenting has been retained from those interfaces, and some additional
  23.  added.
  24.  
  25.  This file (wp4prog.s) is the main program file.  It also includes the
  26.  following files:
  27.  
  28.  wp4prog.hlp     - help for keys not on the menus or the help-bar
  29.  wp4prog.key     - key assignments (#include'd at the end of this file)
  30.  
  31.  Additionally, if you want to use a config file rather than ICONFIG for user
  32.  preferences, include the following file:
  33.  
  34.  wp4prog.cfg     - user preferences file
  35.  
  36.  *****************************************************************************/
  37.  
  38. #include ["wp4prog.cfg"]      // config-endconfig definitions
  39. #include ["wp4prog.hlp"]      // help text
  40. // the key definitions are #include'd at the end of this file
  41.  
  42. /*****************************************************************
  43.   Some definitions / notes
  44.  
  45.   Macros used as commands (that are assigned to keys or menus sequences)
  46.   are prefixed with lower case "m" to distinguish them from built-in
  47.   commands, e.g., mDelChar() is a macro in this file, DelChar() is a
  48.   builtin command.
  49.  
  50.   Current character - The character at the cursor position in the
  51.   currently edited file.  Where the next typed character will be
  52.   inserted or replaced.
  53.  
  54.  *****************************************************************/
  55.  
  56. /*----------------------------------------------------------------
  57.   A simple language indenting package, providing the following:
  58.  
  59.   When AutoIndent is on,
  60.  
  61.   BackSpace, when the cursor is on a blank line or the first
  62.   non-blank character of a line, issues  TabLeft(), in
  63.   effect doing an outdent.
  64.  
  65.   Return, causes an extra indent when the first word of the line
  66.   is one of the following:
  67.  
  68.   if else elseif while repeat loop for switch case when
  69.  
  70.   Additionally, special handling of {} is provided for C
  71.   programmers.
  72.  
  73.   To make this package work:
  74.  
  75.   Assign mBackSpace() to <backspace>
  76.   Assign mCReturn() to <Enter>          // special handling for C
  77.   Assign  TabLeft() to <shift tab>
  78.   Assign CloseBrace() to <shift ]>      // For C files
  79.  
  80.   The _ON_CHANGING_FILES_ hook sets this mode (language) for files with
  81.   extensions of s, c, and h.
  82.   cmode is also set for files with extensions of c and h.
  83.  
  84.   ----------------------------------------------------------------*/
  85.  
  86. // Global variables - assumes globals initialized to 0.
  87.  
  88. integer
  89.     cmode,              // used to invoke C-mode
  90.     language,           // used to invoke language package
  91.     sort_flags,
  92.     pick_buffer         // id of the pick-buffer
  93.  
  94. string KeyWords[] = " if else elseif while repeat loop for switch case when otherwise proc "
  95.  
  96. /*************************************************************************
  97.   Helper macros/Subroutines
  98.  
  99.   These routines are:
  100.  
  101.    not intended for use as commands by themselves
  102.    not intended to be assigned to keys or menus
  103.    intended to be called from other macros
  104.  
  105.  *************************************************************************/
  106.  
  107. string proc CurrExt()
  108.     return (SplitPath(CurrFilename(), _EXT_))
  109. end
  110.  
  111. integer proc ListIt(string title, integer width)
  112.     width = width + 4
  113.     if width > Query(ScreenCols)
  114.         width = Query(ScreenCols)
  115.     endif
  116.     return (List(title, width))
  117. end
  118.  
  119. /*************************************************************************
  120.   Return the word at the cursor as a string.
  121.  *************************************************************************/
  122. string proc GetWordAtCursor()
  123.     string word[80] = ''
  124.  
  125.     PushBlock()                     // Save current block status
  126.     if MarkWord()                   // Mark the word
  127.         word = GetMarkedText()      // Get it
  128.     endif
  129.     PopBlock()                      // Restore block status
  130.     return (word)                   // Thats all, folks!
  131. end GetWordAtCursor
  132.  
  133. /*************************************************************************
  134.    Return the first word on the line as string - '' if not there.
  135.  *************************************************************************/
  136. string proc GetFirstWord()
  137.     string word[32] = ''
  138.  
  139.     PushPosition()                  // Save where we're at
  140.     GotoPos(PosFirstNonWhite())     // Go to first non white
  141.     word = GetWordAtCursor()        // Now get the word there
  142.     PopPosition()                   // Restore saved position
  143.     Lower(word)                     // Make it lower case
  144.     return (' ' + word + ' ')       // And return the word
  145. end
  146.  
  147. string proc GetTextUntil(string stopchar)
  148.     integer start = CurrPos()
  149.  
  150.     while CurrChar() <> Asc(stopchar) and CurrChar() >= 0 and Right()
  151.     endwhile
  152.  
  153.     return (GetText(start, CurrPos() - start))
  154. end
  155.  
  156. /*************************************************************************
  157.  *************************************************************************/
  158. menu ExecLoadPurge()
  159.     Title = "Macro function"
  160.     Width = 16
  161.  
  162.     "&Execute..."
  163.     "&Load..."
  164.     "&Purge..."
  165. end
  166.  
  167. /*************************************************************************
  168.  *************************************************************************/
  169. menu LoadExec()
  170.     "&Load macro"
  171.     "&Execute macro"
  172. end
  173.  
  174. /*************************************************************************
  175.  *************************************************************************/
  176. string proc OnOffStr(integer i)
  177.     return (iif(i, "On", "Off"))
  178. end
  179.  
  180. /*************************************************************************
  181.  *************************************************************************/
  182. string proc ShowSortFlag()
  183.     return (iif(sort_flags & 1, "Descending", "Ascending"))
  184. end
  185.  
  186. proc ToggleSortFlag(integer which)
  187.     if sort_flags & which
  188.         sort_flags = sort_flags & ~ which
  189.     else
  190.         sort_flags = sort_flags | which
  191.     endif
  192. end
  193.  
  194. /*************************************************************************
  195.  *************************************************************************/
  196. integer proc ReadNum(integer n)
  197.     string s[5] = str(n)
  198.  
  199.     return (iif(Read(s), val(s), n))
  200. end ReadNum
  201.  
  202. ///////////////////// End Help Macros/Subroutines ///////////////////////
  203.  
  204. /*************************************************************************
  205.   Macros that follow can:
  206.  
  207.    be assigned to keys and menus as commands
  208.    therefore, can be directly executed by the user
  209.  
  210.   Commands implemented in the macro langauge:
  211.  
  212.      mCopyCharAbove             // removed WP4Prog 4/93; seems useless!!!
  213.      mMatch
  214.      mListOpenFiles
  215.      mCenterLine
  216.      mScratchBuffer
  217.      mShift [ShiftBlock]
  218.      mIncrementalSearch
  219.      mFindWordAtCursor
  220.      mclosebrace
  221.      mCompressView
  222.      mAsciiChart
  223.      mListRecentFiles
  224.      mMacMenu
  225.      mSwapLines
  226.      mCount
  227.      mSendFormFeed
  228.      GetPrintDevice
  229.      GetHeader
  230.      GetFooter
  231.      GetInitString
  232.      SendInit
  233.      mDateTimeStamp
  234.  
  235.   Commands augmented via macros:
  236.  
  237.      mBackSpace()
  238.      mDelChar()
  239.      mCReturn()
  240.      mUpper()
  241.      mLower()
  242.      mFlip()
  243.      mWrapPara
  244.  *************************************************************************/
  245.  
  246. /*************************************************************************
  247.   The match command.  Use this macro to match (){}{}<> chars.
  248.  
  249.   * NOTE: Updated version from Sammy Mitchell RIME msg of 4/16/93 *
  250.  *************************************************************************/
  251. string match_chars[] = "(){}[]<>"   // pairs of chars to match
  252. integer proc mMatch()
  253.   integer p, level, mc, ch, start_line = CurrLine()
  254.  
  255.   p = Pos(chr(CurrChar()), match_chars)
  256.   // If we're not already on a match char, go forward to find one
  257.   if p == 0 and lFind("[(){}[\]<>]", "x")
  258.     return (FALSE)
  259.   endif
  260.  
  261.   PushPosition()
  262.   if p
  263.     // Get the character we're matching
  264.     ch = asc(match_chars[p])
  265.     mc = asc(match_chars[iif(p & 1, p + 1, p - 1)])  // And its reverse
  266.     level = 1             // Start out at level 1
  267.  
  268.     while lFind("[\" + chr(ch) + "\" + chr(mc) + "]", iif(p & 1, "x+", "xb"))
  269.       case CurrChar() // And check out the current character
  270.         when ch
  271.           level = level + 1
  272.         when mc
  273.           level = level - 1
  274.           if level == 0
  275.             KillPosition() // Found a match, remove position
  276.             GotoXoffset(0) // Fix up possible horizontal scrolling
  277.             // Fix up vertical scrolling if we can
  278.             ScrollToRow(CurrLine() - start_line + CurrRow())
  279.             return (TRUE)  // And return success
  280.           endif
  281.       endcase
  282.     endwhile
  283.   endif
  284.   PopPosition()            // Restore position
  285.   return (warn("Match not found"))   // Warn() returns False
  286. end mMatch
  287.  
  288. /*****************************************************************************
  289.   List Files placed in the editor's internal ring of files.
  290.  
  291.   Notes:
  292.     System buffers are _not_ intended for interactive editing.  Therefore,
  293.     this command will exit if it is determined that the current buffer is a
  294.     system buffer.
  295.  *****************************************************************************/
  296. proc mListOpenFiles()
  297.     integer start_file, filelist, id, rc, maxl, total, n
  298.     string fn[65]
  299.  
  300.     n = NumFiles() + (Query(BufferType) <> _NORMAL_)
  301.     if n == 0
  302.         return ()
  303.     endif
  304.     maxl = 0
  305.     total = 0
  306.     start_file = GetBufferid()                 // Save current
  307.     filelist = CreateTempBuffer()
  308.     if filelist == 0
  309.         warn("Can't create filelist")
  310.         return ()
  311.     endif
  312.     GotoBufferId(start_file)
  313.     id = GetBufferid()
  314.     while n
  315.         fn = CurrFilename()
  316.         if length(fn)
  317.             if length(fn) > maxl
  318.                 maxl = length(fn)
  319.             endif
  320.             rc = isChanged()
  321.             GotoBufferId(filelist)
  322.             AddLine(iif(rc, '*', ' ') + fn)
  323.             GotoBufferId(id)
  324.         endif
  325.         NextFile(_DONT_LOAD_)
  326.         id = GetBufferid()
  327.         n = n - 1
  328.     endwhile
  329.     GotoBufferId(filelist)
  330.     BegFile()
  331.     if ListIt("Buffer List", maxl)
  332.         EditFile(GetText(2, sizeof(fn)))    // Force loading from disk
  333.     else
  334.         GotoBufferId(start_file)
  335.     endif
  336.     AbandonFile(filelist)
  337. end mListOpenFiles
  338.  
  339. /************************************************************************
  340.   Routine to center a line.
  341.   If a block is marked, all the lines in the block are centered, using
  342.     the left and right margins;
  343.   if the block is a column block, only the text in the column block is
  344.     centered, without disturbing surrounding text.
  345.  ************************************************************************/
  346. proc mCenterLine()
  347.     integer right_margin = Query(RightMargin),
  348.         left_margin = Query(LeftMargin),
  349.         first_line, last_line, type, p, center, cid, tid
  350.  
  351.     PushPosition()
  352.     if left_margin == 0 or left_margin >= right_margin
  353.         left_margin = 1
  354.     endif
  355.     first_line = CurrLine()
  356.     last_line = first_line
  357.     type = isCursorInBlock()
  358.     if type
  359.         Set(Marking, off)
  360.         first_line = Query(BlockBegLine)
  361.         last_line = Query(BlockEndLine)
  362.         if type == _COLUMN_
  363.             GotoBlockBegin()
  364.             cid = GetBufferId()
  365.             tid = CreateTempBuffer()
  366.             CopyBlock()
  367.  
  368.             /*
  369.               Need to make sure we overlay everything with spaces
  370.              */
  371.             PushBlock()
  372.             GotoBufferId(cid)
  373.             CopyBlock(_OVERWRITE_)
  374.             FillBlock(' ')
  375.             GotoBufferid(tid)
  376.             PopBlock()
  377.  
  378.             last_line = last_line - first_line + 1
  379.             first_line = 1
  380.             left_margin = 1
  381.             right_margin = Query(BlockEndCol) - Query(BlockBegCol) + 1
  382.         endif
  383.     endif
  384.     if right_margin > left_margin
  385.         GotoLine(first_line)
  386.         repeat
  387.             p = PosFirstNonWhite()
  388.             center = ((p + PosLastNonWhite()) / 2) - ((left_margin + right_margin) / 2)
  389.             ShiftText(iif(center > 0,
  390.                 - (iif(center < p, center, p - 1)), Abs(center)))
  391.         until (not RollDown()) or CurrLine() > last_line
  392.         if type == _COLUMN_
  393.             GotoBufferId(cid)
  394.             CopyBlock(_OVERWRITE_)
  395.             AbandonFile(tid)
  396.         endif
  397.     endif
  398.     PopPosition()
  399. end mCenterLine
  400.  
  401. // QEdit 2.15 style scratch buffer package
  402.  
  403. constant
  404.     GETOVERLAY =    0,
  405.     GETTING =       1,  // code depends on this order
  406.  
  407.     STORING =       2,
  408.     APPENDING =     3,
  409.     CUTTING =       4,
  410.     CUTAPPEND =     5
  411.  
  412. integer proc mScratchBuffer(integer operation)
  413.     integer cid, id, result, SaveClipBoardId
  414.     string BufferName[40], msg[30]
  415.  
  416.     if operation > GETTING and (NOT isBlockInCurrFile())
  417.         return (FALSE)
  418.     endif
  419.     BufferName = ""
  420.     result = TRUE                               // assume success
  421.     SaveClipBoardId = GetClipBoardId()          // save id
  422.     case operation
  423.         when STORING    msg = "Copy to ClipBoard:"
  424.         when APPENDING  msg = "Copy Append to ClipBoard:"
  425.         when GETTING    msg = "Paste from ClipBoard:"
  426.         when GETOVERLAY msg = "Paste Over from ClipBoard:"
  427.         when CUTTING    msg = "Cut to ClipBoard:"
  428.         when CUTAPPEND  msg = "Cut Append to ClipBoard:"
  429.     endcase
  430.     if ask(msg, BufferName) and Length(BufferName)   // get scratch name
  431.         BufferName = "+++" + BufferName         // Fudge for scratch
  432.         id = GetBufferId(BufferName)             // See if already there
  433.         if operation <> GETTING and id == 0
  434.             cid = GetBufferId()
  435.             id = CreateBuffer(BufferName, _SYSTEM_)    // create a buffer
  436.             GotoBufferId(cid)
  437.         endif
  438.         if id <> 0                              // if it worked
  439.             SetClipBoardId(id)                  // new ClipBoard
  440.             case operation
  441.                 when STORING    result = Copy()
  442.                 when APPENDING    result = Copy(_APPEND_)
  443.                 when GETTING    result = Paste()
  444.                 when GETOVERLAY result = Paste(_OVERWRITE_)
  445.                 when CUTTING    result = Cut()
  446.                 when CUTAPPEND  result = Cut(_APPEND_)
  447.             endcase
  448.             SetClipBoardId(SaveClipBoardId)     // restore ClipBoard
  449.         else
  450.             warn("Could not create/find buffer")
  451.         endif
  452.     endif
  453.     return (result)                               // return result
  454. end
  455.  
  456. constant SHIFTLEFT = -1, SHIFTRIGHT = 1
  457.  
  458. integer proc mShiftBlock(integer direction)
  459.     integer goal_line = CurrLine(),
  460.             btype     = isCursorInBlock(),
  461.             save_marking   = Query(Marking)
  462.  
  463.     PushPosition()
  464.     if btype
  465.         goal_line = Query(BlockEndLine)
  466.         GotoBlockBegin()
  467.     endif
  468.     repeat until not ShiftText(direction)
  469.             or   not RollDown()
  470.             or   CurrLine() > goal_line
  471.     PopPosition()
  472.     Set(Marking, save_marking)
  473.     return (TRUE)
  474. end
  475.  
  476. proc mShift()
  477.     integer k = Set(EquateEnhancedKbd, ON)
  478.  
  479.     loop
  480.         Message("<Left>,<Right> or <Tab>,<Shift Tab> to shift text; <Enter> when done")
  481.         case GetKey()
  482.             when <CursorLeft>
  483.                 mShiftBlock(-1)
  484.             when <CursorRight>
  485.                 mShiftBlock(1)
  486.             when <Tab>
  487.                 mShiftBlock(Query(TabWidth))
  488.             when <Shift Tab>
  489.                 mShiftBlock(-Query(TabWidth))
  490.             when <Escape>, <Enter>
  491.                 break
  492.             when <Alt U>
  493.                 if isCursorInBlock()
  494.                     UnMarkBlock()
  495.                     break
  496.                 endif
  497.         endcase
  498.         UpdateDisplay(_REFRESH_THIS_ONLY_ | _WINDOW_REFRESH_)
  499.     endloop
  500.     Set(EquateEnhancedKbd, k)
  501.     UpdateDisplay()
  502. end
  503.  
  504. /***************************************************************************
  505.   An Incremental search.  I rarely use regular search, since implementing
  506.   this...
  507.  ***************************************************************************/
  508. proc mIncrementalSearch()
  509.     string s[40]="", option[8] = "i"
  510.     integer ch, global_or_reverse, next
  511.  
  512.     global_or_reverse = FALSE
  513.  
  514.     PushPosition()
  515.     loop
  516.         if Length(s) and global_or_reverse
  517.             option = substr(option, 1, length(option) - 1)
  518.             global_or_reverse = FALSE
  519.         endif
  520.         next = FALSE
  521.         message("I-Search (^N=Next ^P=Prev ^B=Beginning):", s)
  522.  
  523.         retry:
  524.         ch = getkey()
  525.         case ch
  526.             when <BackSpace>                // go back to start
  527.                 PopPosition()
  528.                 PushPosition()
  529.                 s = iif(length(s) <= 1, "", substr(s, 1, length(s) - 1))
  530.             when <Ctrl L>, <Ctrl N>         // just search again
  531.                 NextChar()
  532.                 next = TRUE
  533.             when <Ctrl R>, <Ctrl P>         // go to previous occurrence
  534.                 option = option + 'b'
  535.                 global_or_reverse = TRUE
  536.             when <Ctrl G>, <Ctrl B>         // beginning of file
  537.                 option = option + 'g'
  538.                 global_or_reverse = TRUE
  539.             when <Enter>, <Escape>
  540.                 if Length(s)
  541.                     AddHistoryStr(s, _FINDHISTORY_)
  542.                 endif
  543.                 break
  544.             otherwise
  545.                 if (ch & 0xff) == 0         // Function key?
  546.                     goto retry              // Yes, try again.
  547.                 endif
  548.                 s = s + chr(ch & 0xff)      // mask off the scan code
  549.         endcase
  550.         if Length(s) and NOT find(s, option) and NOT global_or_reverse and NOT next
  551.             s = substr(s, 1, length(s) - 1)
  552.         endif
  553.     endloop
  554.     KillPosition()
  555.     UpdateDisplay()
  556. end
  557.  
  558. integer proc mFindWordAtCursor(string option)
  559.     if Length(GetWordAtCursor())
  560.         AddHistoryStr(GetWordAtCursor(), _FINDHISTORY_)
  561.         return (Find(GetWordAtCursor(), Query(FindOptions) + option))
  562.     endif
  563.     return (Find())
  564. end mFindWordAtCursor
  565.  
  566. // Special handling of } for C programmers
  567. integer proc mCloseBrace()
  568.     if cmode and PosFirstNonWhite() == 0
  569.         TabLeft()
  570.     endif
  571.     return (InsertText("}"))
  572. end
  573.  
  574. string lineone[] = "      ■■■ Select this line to edit COMPRESS file ■■■"
  575. integer compress_hist, compress_options_history
  576. string compress_buffer_name[] = "[<compress>]"
  577.  
  578. proc mCompressView(integer compress_type)
  579.     string expr[65] = '', opts[12] = '',
  580.            line[132]
  581.     integer
  582.         line_no,        // saved CurrLine() for compressed view
  583.         list_no,        // line we exited on
  584.         start_line_no,   // line number we were on
  585.         goto_line_no,
  586.         width,
  587.         mk,
  588.         compress_id,
  589.         current_id = GetBufferId(), maxlen = Length(lineone)
  590.  
  591.     if compress_hist == 0   // This must be first time through - do initialization.
  592.         compress_hist = GetFreeHistory()
  593.         compress_options_history = GetFreeHistory()
  594.         AddHistoryStr(Query(FindOptions), compress_options_history)
  595.     endif
  596.  
  597.     start_line_no = CurrLine()
  598.     if NumLines() == 0
  599.         return ()
  600.     endif
  601.  
  602.     line_no = 0
  603.     list_no = 0
  604.     goto_line_no = 1
  605.     width = Length(Str(NumLines()))
  606.  
  607.     // compress_types are [0..1]
  608.     if compress_type == 0
  609.         if not ask("String to list all occurrences of:", expr, compress_hist)
  610.             return ()
  611.         endif
  612.         if Length(expr) == 0
  613.             opts = "x"
  614.             expr = "^[a-zA-Z_]"
  615.         elseif not ask("Search options [IWX] (Ignore-case Words reg-eXp):", opts, compress_options_history)
  616.             return ()
  617.         endif
  618.     else
  619.         opts = "ix"
  620.         case CurrExt()
  621.             when ".c",".cpp"
  622.                 expr = "^[a-zA-Z_].*\(.*[~;]$"
  623.             when ".s"
  624.                 expr = "^{public #}?{{integer #}|{string #}}@proc +[a-zA-Z_]"
  625.             when ".pas"
  626.                 expr = "{procedure}|{function} +[a-zA-Z_]"
  627.             when ".prg",".spr",".mpr",".qpr",".fmt",".frg",".lbg",".ch"
  628.                 expr = "^{procedure}|{function} +[a-zA-Z_]"
  629.             otherwise
  630.                 warn("Extension not supported")
  631.                 return ()
  632.         endcase
  633.     endif
  634.  
  635.     compress_id = CreateBuffer(compress_buffer_name)
  636.     if compress_id == 0
  637.         compress_id = GetBufferId(compress_buffer_name)
  638.     endif
  639.     if compress_id == current_id
  640.         warn("Can't use this buffer")
  641.         return ()
  642.     endif
  643.     if compress_id == 0 or not GotoBufferId(compress_id)
  644.         return ()
  645.     endif
  646.  
  647.     // At this point, we are in the compress buffer
  648.     EmptyBuffer()
  649.     InsertText(lineone)
  650.     GotoBufferId(current_id)
  651.     PushPosition()
  652.     BegFile()
  653.     if lFind(expr, opts)
  654.         repeat
  655.             line = GetText(1, sizeof(line))
  656.             line_no = CurrLine()
  657.             if Length(line) > maxlen
  658.                 maxlen = Length(line)
  659.             endif
  660.             GotoBufferId(compress_id)
  661.             if not AddLine(Format(line_no:width, ': ', line))
  662.                 break
  663.             endif
  664.             if goto_line_no == 1 and line_no > start_line_no
  665.                 goto_line_no = CurrLine() - 1
  666.             endif
  667.             GotoBufferId(current_id)
  668.             EndLine()
  669.         until not lRepeatFind()
  670.     endif
  671.     GotoBufferId(compress_id)
  672.     GotoLine(goto_line_no)
  673.     if ListIt(iif(compress_type == 0, expr, "Function List"), maxlen + width)
  674.         if CurrLine() == 1
  675.             PopPosition()
  676.             GotoBufferId(compress_id)
  677.             mk = Set(KillMax, 0)
  678.             DelLine()
  679.             Set(KillMax, mk)
  680.             ForceChanged(FALSE)
  681.             return ()
  682.         endif
  683.         list_no = val(GetText(1, width))
  684.     endif
  685.     AbandonFile()
  686.     PopPosition()
  687.     if list_no
  688.         GotoLine(list_no)
  689.         ScrollToRow(Query(WindowRows)/2)
  690.     endif
  691. end mCompressView
  692.  
  693. /**************************************************************************
  694.     Alternate ASCII chart macro included with TSE v1.0
  695. ***************************************************************************/
  696. Data ASCIIData
  697.     "   0  00     ^@  NUL Null"
  698.     "   1  01    ^A  SOH Start of Header"
  699.     "   2  02    ^B  STX Start of Text"
  700.     "   3  03    ^C  ETX End of Text"
  701.     "   4  04    ^D  EOT End of Transmission"
  702.     "   5  05    ^E  ENQ Enquiry"
  703.     "   6  06    ^F  ACK Acknowledge"
  704.     "   7  07    ^G  BEL Bell"
  705.     "   8  08    ^H  BS  BackSpace"
  706.     "   9  09  "+chr(9) +"  ^I  HT  Horizontal Tab"
  707.     "  10  0A  "+chr(10)+"  ^J  LF  Line Feed"
  708.     "  11  0B     ^K  VT  Verical Tab"
  709.     "  12  0C     ^L  FF  Form Feed"
  710.     "  13  0D  "+chr(13)+"  ^M  CR  Carriage Return"
  711.     "  14  0E    ^N  SO  Shift Out"
  712.     "  15  0F    ^O  SI  Shift In"
  713.     "  16  10    ^P  DLE Data Link Escape"
  714.     "  17  11    ^Q  DC1 Device Control 1"
  715.     "  18  12    ^R  DC2 Device Control 2"
  716.     "  19  13    ^S  DC3 Device Control 3"
  717.     "  20  14    ^T  DC4 Device Control 4"
  718.     "  21  15    ^U  NAK Negative Acknowledge"
  719.     "  22  16    ^V  SYN Synchronous Idle"
  720.     "  23  17    ^W  ETB End Transmission Block"
  721.     "  24  18    ^X  CAN Cancel"
  722.     "  25  19    ^Y  EM  End of Medium"
  723.     "  26  1A    ^Z  SUB Substitute"
  724.     "  27  1B    ^[  ESC Escape"
  725.     "  28  1C    ^\  FS  File Separator"
  726.     "  29  1D    ^]  GS  Group Separator"
  727.     "  30  1E    ^^  RS  Record Separator"
  728.     "  31  1F    ^_  US  Unit Separator"
  729. end
  730.  
  731. integer ASCII_id
  732. proc CreateASCIIFile()
  733.     integer i
  734.  
  735.     ASCII_id = CreateTempBuffer()
  736.  
  737.     if (ASCII_id)
  738.         PushBlock()
  739.         InsertData(ASCIIData)
  740.         GotoBlockEnd()
  741.         PopBlock()
  742.         EndLine()
  743.         JoinLine()
  744.         i = 32
  745.         while AddLine(format(i:4, str(i, 16):4, chr(i):3)) and i < 255
  746.             i = i + 1
  747.         endwhile
  748.     endif
  749. end
  750.  
  751. proc mAsciiChart()
  752.     integer ok,
  753.             c = CurrChar(),
  754.             saveit = set(ExpandTabs, OFF)
  755.  
  756.     PushPosition()
  757.     if ASCII_id == 0
  758.         CreateASCIIFile()
  759.     endif
  760.     if (ASCII_id)
  761.         GotoBufferId(ASCII_id)
  762.         BegFile()
  763.         if c >= 0
  764.             GotoLine(c + 1)
  765.         endif
  766.         ok = list("Dec Hex Chr     Description               ", 44)
  767.         c = CurrLine() - 1
  768.         PopPosition()
  769.         if ok
  770.             InsertText(chr(c))
  771.         endif
  772.     endif
  773.     set(ExpandTabs, saveit)
  774. end mAsciiChart
  775.  
  776. //                   * end of Ascii Chart stuff *
  777.  
  778. /****************************************************************************
  779.     Alternate Date Format Macro from v1.0 ß
  780.    02-14-93: Submitted by Mel Hulse (Msg 6308 Cnf 15)
  781.    03-09-93: KAC - Rewritten, commented, and tested.
  782. *****************************************************************************/
  783. proc mFullDate()
  784.     integer mon, day, year, dow
  785.     string  month_name[9] = ''
  786.  
  787.     GetDate(mon, day, year, dow)    // get current date
  788.     case mon
  789.         when  1 month_name = 'January'
  790.         when  2 month_name = 'February'
  791.         when  3 month_name = 'March'
  792.         when  4 month_name = 'April'
  793.         when  5 month_name = 'May'
  794.         when  6 month_name = 'June'
  795.         when  7 month_name = 'July'
  796.         when  8 month_name = 'August'
  797.         when  9 month_name = 'September'
  798.         when 10 month_name = 'October'
  799.         when 11 month_name = 'November'
  800.         when 12 month_name = 'December'
  801.     endcase
  802.     InsertText(Format(month_name,' ',day,', ',year))
  803. end
  804.  
  805. proc mListRecentFiles()
  806.     integer maxl = 0, cid = GetBufferId()
  807.  
  808.     if GotoBufferId(pick_buffer)
  809.         BegFile()
  810.         repeat
  811.             if CurrLineLen() > maxl
  812.                 maxl = CurrLineLen()
  813.             endif
  814.         until not down()
  815.         GotoLine(2)
  816.         if ListIt("Recent Files", maxl)
  817.             EditFile(GetText(1, CurrLineLen()))
  818.         else
  819.             GotoBufferId(cid)
  820.         endif
  821.     endif
  822. end mListRecentFiles
  823.  
  824. /************************************************************************
  825.   This version assumes the compiler program is either in the current
  826.   directory or available via the path.
  827.  ************************************************************************/
  828. proc mCompile()
  829.     string fn[65] = CurrFilename(),
  830.         err_fn[12] = "$errors$.tmp"
  831.     integer line, col
  832.  
  833.     if CurrExt() <> ".s"
  834.         Warn("Extension not supported")
  835.         return ()
  836.     endif
  837.     OneWindow()         // Force a single window
  838.     if isChanged()
  839.         SaveFile()
  840.     endif
  841.     // Remove the error file if we're already editing it
  842.     AbandonFile(GetBufferId(ExpandPath(err_fn)))
  843.     PurgeMacro(fn)
  844.     EraseDiskFile(err_fn)
  845.     Dos("sc " + fn + ">" + err_fn, _DONT_CLEAR_)
  846.     EditFile(err_fn)
  847.     EraseDiskFile(err_fn)
  848.     //
  849.     // 3 cases -
  850.     //      1 - SC didn't run, probably not found. Identify by empty err_fn
  851.     //      2 - Error/Warning msg found in err_fn - position to error
  852.     //      3 - No Errors/Warnings!  Load/Exec the new macro.
  853.     //
  854.     if lFind("^{Error}|{Warning} #[0-9]# #\c","ix")
  855.         PrevFile()
  856.         HWindow()
  857.         if CurrChar() == Asc('(')
  858.             Right()
  859.             line = Val(GetTextUntil(','))
  860.             Right()                             // skip the comma
  861.             col  = Val(GetTextUntil(')'))
  862.             PrevWindow()
  863.             GotoLine(line)
  864.             ScrollToRow(Query(WindowRows) / 2)
  865.             GotoColumn(col)
  866.         endif
  867.         UpdateDisplay()
  868.     else
  869.         // At this point, no error/warning messages found, in the error file
  870.         AbandonFile()
  871.         if NumLines() == 0                      // If empty, we failed
  872.             Warn("Error running SC.EXE")
  873.         else
  874.             UpdateDisplay()                     // Force a statusline refresh
  875.             fn = SplitPath(fn, _DRIVE_ | _NAME_)
  876.             case LoadExec("Compile successful")
  877.                 when 1
  878.                     LoadMacro(fn)
  879.                 when 2
  880.                     ExecMacro(fn)
  881.             endcase
  882.         endif
  883.     endif
  884. end
  885.  
  886. integer proc mMacMenu(integer n)
  887.     string s[8] = ''
  888.  
  889.     if n == 0
  890.         n = ExecLoadPurge()
  891.     endif
  892.     case n
  893.         when 1
  894.             return (ExecMacro())
  895.         when 2
  896.             return (LoadMacro())
  897.         when 3
  898.             if ask("Purge macro:", s) and Length(s) and PurgeMacro(s)
  899.                 Message(s, " purged.")
  900.                 return (TRUE)
  901.             endif
  902.     endcase
  903.     return (FALSE)
  904. end
  905.  
  906. proc mSwapLines()
  907.     integer km
  908.  
  909.     if Down()
  910.         km = Set(KillMax, 1)
  911.         DelLine()
  912.         Up()
  913.         UnDelete()
  914.         Set(KillMax, km)
  915.     endif
  916. end
  917.  
  918. proc mCount()
  919.     integer count = 0
  920.     string s[60] = '', opts[12] = Query(FindOptions)
  921.  
  922.     if Ask("String to count occurrences of:", s) and Length(s) and
  923.         Ask("Options [GLIWX] (Global Local Ignore-case Words reg-eXp):", opts)
  924.         PushPosition()
  925.         if lFind(s, opts)
  926.             repeat
  927.                 count = count + 1
  928.             until not lRepeatFind()
  929.         endif
  930.         PopPosition()
  931.         Message("Found ", count, " occurrence(s)")
  932.     endif
  933. end
  934.  
  935. proc mSendFormFeed()
  936.     if not PrintChar(chr(12))
  937.         warn("Error sending formfeed")
  938.     endif
  939. end
  940.  
  941. proc GetPrintDevice()
  942.     string s[48] = Query(PrintDevice)
  943.  
  944.     if ask("Print Device:", s)
  945.         Set(PrintDevice, s)
  946.     endif
  947. end
  948.  
  949. proc GetHeader()
  950.     string s[4] = Query(PrintHeader)
  951.  
  952.     if ask("Print Header [FDTP] (Filename Date Time Page):", s)
  953.         Set(PrintHeader, s)
  954.     endif
  955. end
  956.  
  957. proc GetFooter()
  958.     string s[4] = Query(PrintFooter)
  959.  
  960.     if ask("Print Footer [FDTP] (Filename Date Time Page):", s)
  961.         Set(PrintFooter, s)
  962.     endif
  963. end
  964.  
  965. proc GetInitString()
  966.     string s[60] = Query(PrintInit)
  967.  
  968.     if ask("Init String:", s)
  969.         Set(PrintInit, s)
  970.     endif
  971. end
  972.  
  973. proc mSendInitString()
  974.     string s[60] = Query(PrintInit)
  975.     integer i = 1
  976.  
  977.     while i <= Length(s) and PrintChar(s[i])
  978.         i = i + 1
  979.     endwhile
  980. end
  981.  
  982. proc mDateTimeStamp()
  983.     InsertText(GetDateStr(), _INSERT_)
  984.     InsertText(" ", _INSERT_)
  985.     InsertText(GetTimeStr(), _INSERT_)
  986. end
  987.  
  988. /*************************************************************************
  989.   Commands augmented by macros:
  990.  *************************************************************************/
  991.  
  992. /*********************************************************************
  993.   Fancy backspace() command.
  994.   Sort of like Borlands environment.  In language mode, backspace
  995.   does a "outdent" when there is only white space before the cursor.
  996.  
  997.   Also does special handling for overwrite mode.  In overwrite mode,
  998.   does a "rubout" instead of a backspace.
  999.  *********************************************************************/
  1000. proc mBackSpace()
  1001.     if CurrPos() == 1       // at beg-of-line, just join to previous
  1002.         if PrevChar()
  1003.             JoinLine()
  1004.         endif
  1005.         return ()
  1006.     endif
  1007.  
  1008.     // if from here to prev-tabstop is 'white', then TabLeft()
  1009.  
  1010.     if Query(AutoIndent) and language
  1011.         if CurrPos() <= PosFirstNonWhite()
  1012.             TabLeft()
  1013.             return ()
  1014.         endif
  1015.         PushPosition()
  1016.         GotoColumn(CurrCol() - DistanceToTab())
  1017.         if CurrPos() > PosLastNonWhite()
  1018.             PopPosition()
  1019.             TabLeft()
  1020.             return ()
  1021.         endif
  1022.         PopPosition()
  1023.     endif
  1024.  
  1025.     // Finally, do either rubout or backspace based on InsertMode
  1026.  
  1027.     Left()
  1028.     if CurrChar() >= 0
  1029.         if Query(Insert)
  1030.             DelChar()
  1031.         else
  1032.             InsertText(" ", _OVERWRITE_)
  1033.             Left()
  1034.         endif
  1035.     endif
  1036. end
  1037.  
  1038. // Augment delchar by joining lines if at or passed eol
  1039. integer proc mDelChar()
  1040.     return(iif(CurrChar() >= 0, DelChar(), JoinLine()))
  1041. end
  1042.  
  1043. // Fancy CarriageReturn command.  Works if language mode is on.
  1044. integer proc mCReturn()
  1045.     integer found = FALSE
  1046.  
  1047.     if language and CurrPos() > PosFirstNonWhite()
  1048.         if pos(GetFirstWord(), KeyWords)
  1049.             found = TRUE
  1050.         elseif cmode
  1051.             PushPosition()
  1052.             repeat
  1053.                 if CurrChar() == asc('{')
  1054.                     found = TRUE
  1055.                     break
  1056.                 endif
  1057.             until not left()
  1058.             PopPosition()
  1059.         endif
  1060.     endif
  1061.     if not CReturn()
  1062.         return (FALSE)
  1063.     endif
  1064.     return (iif(found
  1065.                 and ((Query(Insert) and Query(ReturnEqNextLine) == FALSE)
  1066.                 or PosFirstNonWhite() == 0),
  1067.                 TabRight(), TRUE))
  1068. end
  1069.  
  1070. constant WORDCASE  = 1,
  1071.          LINECASE  = 2,
  1072.          BLOCKCASE = 3
  1073.  
  1074. constant UPPER_CASE = 0,
  1075.          LOWER_CASE = 1,
  1076.          FLIP_CASE  = 2
  1077.  
  1078. integer casetype
  1079.  
  1080. // Assume type is always one of WORDCASE, LINECASE or BLOCKCASE.
  1081. proc ChangeCase(integer type)
  1082.     PushBlock()
  1083.     if type <> BLOCKCASE
  1084.         UnMarkBlock()
  1085.         if type == LINECASE
  1086.             MarkLine()
  1087.         elseif not MarkWord()
  1088.             goto done
  1089.         endif
  1090.     elseif not isCursorInBlock()
  1091.         goto done
  1092.     endif
  1093.     case casetype
  1094.         when UPPER_CASE
  1095.             Upper()
  1096.         when LOWER_CASE
  1097.             Lower()
  1098.         otherwise
  1099.             Flip()
  1100.     endcase
  1101.     done:
  1102.  
  1103.     PopBlock()
  1104. end
  1105.  
  1106. menu CaseMenu()
  1107.     Command = ChangeCase(MenuOption())
  1108.  
  1109.     "&Word at Cursor"   // if the order of these options is changed,
  1110.     "Current &Line"     // Change to order of the constants
  1111.     "&Block"            // WORDCASE, LINECASE, and BLOCKCASE
  1112. end
  1113.  
  1114. proc mUpper()
  1115.     casetype = UPPER_CASE
  1116.     CaseMenu("Upper Case")
  1117. end
  1118.  
  1119. proc mLower()
  1120.     casetype = LOWER_CASE
  1121.     CaseMenu("Lower Case")
  1122. end
  1123.  
  1124. proc mFlip()
  1125.     casetype = FLIP_CASE
  1126.     CaseMenu("Flip Case")
  1127. end
  1128.  
  1129. integer proc mSaveSettings()
  1130.     if YesNo("Overwrite existing config?") == 1
  1131.         return (iif(SaveSettings(), TRUE, Warn("Error updating executable")))
  1132.     endif
  1133.     return (FALSE)
  1134. end
  1135.  
  1136. /************************************************************************
  1137.   Macro to wrap text in a column block, without disturbing the surrounding
  1138.   text.
  1139.  
  1140.   If a column isn't marked, the normal WrapPara() is called.
  1141.  ************************************************************************/
  1142. proc mWrapPara()
  1143.     integer
  1144.         id,                         // work buffer id
  1145.         block_beg_col,
  1146.         save_leftmargin,
  1147.         save_rightmargin,
  1148.         save_autoindent,
  1149.         save_wrapend,
  1150.         curr_id = GetBufferId(),    // current file id
  1151.         blocktype = isCursorInBlock()
  1152.  
  1153.     if blocktype == 0
  1154.         WrapPara()
  1155.     else
  1156.         Set(Marking, off)               // Stop marking
  1157.         if blocktype <> _COLUMN_        // Wrap entire block if not column
  1158.             GotoBlockEnd()
  1159.             AddLine()
  1160.             GotoBlockBegin()
  1161.             repeat
  1162.             until (not WrapPara()) or (not isCursorInBlock())
  1163.             if CurrLineLen() == 0
  1164.                 DelLine()
  1165.             endif
  1166.         else                            // Otherwise, wrap whats in col
  1167.             GotoBlockBegin()
  1168.             block_beg_col = CurrCol()
  1169.             id = CreateTempBuffer()
  1170.             CopyBlock()                 // Copy block to temp buffer
  1171.  
  1172.             /**************************************************************
  1173.               The number of lines in the column may become less than what
  1174.               it was - so we must fill the old block with spaces.
  1175.              **************************************************************/
  1176.             PushBlock()                 // Save block settings
  1177.             GotoBufferId(curr_id)       // Back to original file
  1178.             CopyBlock(_OVERWRITE_)      // And get the block back
  1179.             FillBlock(' ')              // Wipe it out
  1180.             GotoBufferid(id)            // Back to where we were
  1181.             PopBlock()                  // And get our block marked again
  1182.  
  1183.             /**************************************************************
  1184.               Prepare to wrap - we need to set the left/right margins to
  1185.               1 and the width of the column.  We also need to preserve the
  1186.               old settings.
  1187.              **************************************************************/
  1188.             save_leftmargin = Set(LeftMargin, 1)
  1189.             GotoBlockEnd()
  1190.             save_rightmargin = Set(RightMargin, CurrCol())
  1191.             save_autoindent = Set(AutoIndent, Off)
  1192.             save_wrapend = Set(ParaEndStyle, 0)
  1193.             BegFile()
  1194.             repeat
  1195.             until not WrapPara()
  1196.             UnmarkBlock()           // We need to re-mark the block
  1197.             BegFile()
  1198.             MarkColumn()
  1199.             EndFile()
  1200.             GotoColumn(Query(RightMargin))
  1201.  
  1202.             /*************************************************************
  1203.               And finally, go back to the original file, and copy the block
  1204.               in.
  1205.              *************************************************************/
  1206.             GotoBufferId(curr_id)
  1207.             CopyBlock(_OVERWRITE_)
  1208.             AbandonFile(id)
  1209.             GotoBlockEnd()
  1210.             Down()
  1211.             GotoColumn(block_beg_col)
  1212.  
  1213.             // Restore saved settings
  1214.  
  1215.             Set(LeftMargin, save_leftmargin)
  1216.             Set(RightMargin, save_rightmargin)
  1217.             Set(AutoIndent, save_autoindent)
  1218.             Set(ParaEndStyle, save_wrapend)
  1219.         endif
  1220.     endif
  1221. end mWrapPara
  1222.  
  1223.  /***********************************************************************
  1224.   The following are macros moved in from the WP emulator supplied with
  1225.   TSE Beta 1.0 to handle some of the things WP actually *does* do nicer
  1226.   than normal programming editors, and to fill in some blanks in the
  1227.   function key assignments.
  1228.  
  1229.   WP Macros  <- my unique search string !!!
  1230.  ************************************************************************/
  1231.  
  1232. proc WPDelWord()
  1233.     BegWord()
  1234.     DelRightWord()
  1235. end
  1236.  
  1237. proc BegScreen()
  1238.     if CurrRow() == 1
  1239.         PageUp()            // goto top of next window-full
  1240.     else
  1241.         BegWindow()         // goto top of current window
  1242.     endif
  1243. end
  1244.  
  1245. proc EndScreen()
  1246.     if CurrRow() == Query(WindowRows)
  1247.         PageDown()          // goto bottom of next window-full
  1248.     else
  1249.         EndWindow()         // goto bottom of current window
  1250.     endif
  1251. end
  1252.  
  1253. proc BottomOfScreen(integer line)
  1254.     vGotoXY(1, Query(ScreenRows) + line)
  1255.     ClrEOL()
  1256. end
  1257.  
  1258. proc WPHome()                           // hard to get around without this one!
  1259. integer seek = Set(EquateEnhancedKBD, On)
  1260.     Case GetKey()
  1261.         when <BackSpace>        WPDelWord()
  1262.         when <CursorUp>         BegScreen()
  1263.         when <CursorDown>       EndScreen()
  1264.         when <CursorRight>      EndLine()
  1265.         when <CursorLeft>       BegLine()
  1266.         when <Home>
  1267.             case GetKey()
  1268.                 when <CursorUp>     BegFile()
  1269.                 when <CUrsorDown>   EndFile()
  1270.             endcase
  1271.     endcase
  1272.     Set(EquateEnhancedKBD, seek)
  1273. end
  1274.  
  1275. /*************************************************************************
  1276.  
  1277.    GetHistoryStr()
  1278.  
  1279.    Gets current history string from history.
  1280.  
  1281.    Use Read() in conjunction with PushKey() to get last string.
  1282.  
  1283.    Problems:
  1284.    (1) Read() needs window to be defined and cursor placed appropriately.
  1285.        If not done, read() may go outside screen and destroy memory
  1286.        which is not ours.
  1287.  
  1288.    (2) But when the pop window is created in which to read there will
  1289.        be flicker at that point.
  1290.        To remove flicker we need to set the attribute read() uses
  1291.        to hide the popwin() and read().  BUT, read() uses one of two
  1292.        attributes... either BlockAttr or MsgAttr depending on the
  1293.        length of the history string.
  1294.        This will NOT work on Monochrome displays!!!
  1295.  
  1296. ************************************************************************/
  1297.  
  1298. // could return null string if popwin fails instead
  1299.  
  1300. integer proc GetHistoryStr(var string s, integer history_no)
  1301.     integer StatusLineBackGround = Query(StatusLineAttr) & 0xf0
  1302.     integer BlockAttr, MsgAttr
  1303.     integer Attr
  1304.     integer y
  1305.     integer popped
  1306.  
  1307.     Attr = StatusLineBackGround | ((StatusLineBackGround shr 4) & 0x07)
  1308.     BlockAttr = Set(BlockAttr, Attr)
  1309.     MsgAttr = Set(MsgAttr, Attr)
  1310.  
  1311.     // position popwin() on the "SPACE" which follows the first 'L'
  1312.     // in the statusline
  1313.  
  1314.     Set(Cursor,Off)
  1315.     y = iif(Query(StatusLineAtTop), Query(ScreenRows) , 1)
  1316.     popped = PopWinOpen(2, y, 2, y,0,"",0)  // box with no border
  1317.     if (popped)
  1318.         VHomeCursor()
  1319.         PushKey(<Enter>)
  1320.         Read(s,history_no)
  1321.         PopWinClose()
  1322.     endif
  1323.     Set(Cursor,On)
  1324.  
  1325.     Set(BlockAttr, BlockAttr)
  1326.     Set(MsgAttr, MsgAttr)
  1327.  
  1328.     return (popped)
  1329. end
  1330.  
  1331. integer proc mRepeatBackward()
  1332.     String  options[8] = '',
  1333.             findstr[60] = ''
  1334.  
  1335.     GetHistoryStr(findstr, _FIND_HISTORY_)
  1336.     GetHistoryStr(options, _FINDOPTIONS_HISTORY_)
  1337.  
  1338.     if not pos('b', options)
  1339.         options = options + 'b'
  1340.     endif
  1341.     return(find(findstr, options + '+'))
  1342. end
  1343.  
  1344. integer proc mRepeatForward()
  1345.     String  options[8] = '',
  1346.             findstr[60] = ''
  1347.     integer b = 0
  1348.  
  1349.     GetHistoryStr(findstr, _FIND_HISTORY_)
  1350.     GetHistoryStr(options, _FINDOPTIONS_HISTORY_)
  1351.     b = pos('b', options)
  1352.     if b
  1353.         options = substr(options, 1, b - 1) + substr(options, b + 1, length(options))
  1354.     endif
  1355.     return(find(findstr, options + '+'))
  1356. end
  1357.  
  1358.  /***********************************************************************
  1359.   FlushRight moves the cursorline so that the last character is on the
  1360.   right margin.
  1361.  ***********************************************************************/
  1362. proc mFlushRight()
  1363.     PushBlock()
  1364.     UnMarkBlock()
  1365.     PushPosition()
  1366.     GotoPos(PosLastNonWhite())
  1367.     Right()
  1368.     If CurrPos() >= Query(RightMargin)
  1369.         PopPosition()
  1370.     else
  1371.         MarkColumn()
  1372.         GotoPos(Query(RightMargin))
  1373.         MarkColumn()
  1374.         PopPosition()
  1375.         CopyBlock()
  1376.         GotoBlockEnd()
  1377.     endif
  1378.     PopBlock()
  1379. end
  1380.  
  1381.  /***********************************************************************
  1382.   Display a string, and translate '&' to change the attr.  Uses Menu
  1383.   attributes.
  1384.  ***********************************************************************/
  1385. proc PutIt(string outstring)
  1386.     integer num     = Length(outstring),
  1387.             counter = 1,
  1388.             mta     = Query(MenuTextAttr),
  1389.             mtla    = Query(MenuTextLtrAttr),
  1390.             sattr   = Query(Attr)
  1391.     repeat
  1392.         Set(Attr, mta)
  1393.         if outstring[counter] == '&'
  1394.             Set(Attr, mtla)
  1395.             counter = counter + 1
  1396.         endif
  1397.         PutChar(outstring[counter])
  1398.         counter = counter + 1
  1399.     until counter > num
  1400.     Set(Attr, sattr)
  1401. end
  1402.  
  1403. proc mTextInOut()
  1404.  /***********************************************************************
  1405.   1 Save; 2 Retrieve: 0
  1406.  ***********************************************************************/
  1407.     BottomOfScreen(0)
  1408.     PutIt('&1 &Save; &2 &Retrieve: &0')
  1409.     case GetKey()
  1410.         when <1>, <S>, <Shift S>    SaveAs()
  1411.         when <2>, <R>, <Shift R>    InsertFile()
  1412.     endcase
  1413.     UpdateDisplay()
  1414. end
  1415.  
  1416.  /***********************************************************************
  1417.   This procedure will run ShareSpell on the current file.  This assumes
  1418.   that ShareSpell is in your path.
  1419.  ***********************************************************************/
  1420. proc mSpellChk()
  1421.     string file[80] = CurrFileName()
  1422.  
  1423.     if SaveFile()
  1424.         Dos("SS " + file, 1)
  1425.         AbandonFile()
  1426.         EditFile(file)
  1427.     endif
  1428. end
  1429.  
  1430. /*************************************************************************
  1431.     The following macro(s) are to enhance some standard functions. QEdit
  1432.     did these little things _really_ nicely!
  1433.  
  1434.     WP-for-Programmers TSE         Mike Hammer 4/93
  1435.  *************************************************************************/
  1436. proc mQEditGetFile()    // enhanced EditFile() -- how simple it can be!!!
  1437.     HWindow()           // open a new window to ...
  1438.     EditFile()          // put another file in
  1439. end                     // that's all!
  1440.  
  1441. proc mQEditExit()       // enhanced QuitFile()
  1442.     QuitFile()          // leave current file
  1443.     CloseWindow()       // close window if file was in a split window
  1444. end                     // that's it!
  1445.  
  1446. /*************************************************************************
  1447.   TSE called macros, including:
  1448.  
  1449.   WhenLoaded
  1450.   Main
  1451.   Hooked functions
  1452.  *************************************************************************/
  1453.  
  1454. /**************************************************************************
  1455.   This macro is called everytime EditFile() or Next/PrevFile() is called.
  1456.  **************************************************************************/
  1457. proc OnChangingFiles()
  1458.     string fn[65] = CurrFilename()
  1459.     integer mk, cid = GetBufferId()
  1460.  
  1461.     /* First, do 'RecentFiles' processing */
  1462.  
  1463.     if Query(BufferType) == _NORMAL_ and GotoBufferId(pick_buffer)
  1464.         mk = Set(KillMax, 0)
  1465.         if lFind(fn, "^$g")
  1466.             DelLine()
  1467.         elseif NumLines() > 20
  1468.             EndFile()
  1469.             DelLine()
  1470.         endif
  1471.         BegFile()
  1472.         InsertLine(fn)
  1473.         GotoBufferId(cid)
  1474.         Set(KillMax, mk)
  1475.     endif
  1476.  
  1477.     /* Ok, on with the rest of the show */
  1478.  
  1479.     language = FALSE
  1480.     cmode = FALSE
  1481.     case CurrExt()
  1482.         when ".s",".asm",".pas",".inc",".prg"
  1483.             language = TRUE
  1484.         when ".c",".h",".cpp",".hpp"
  1485.             language = TRUE
  1486.             cmode = TRUE
  1487.     endcase
  1488. end
  1489.  
  1490. /**************************************************************************
  1491.   This macro is called The firsttime a file is loaded into the editor.
  1492.  **************************************************************************/
  1493. proc OnFirstEdit()
  1494. end
  1495.  
  1496. /***************************************************************************
  1497.   This macro is called just after the editor starts, before the command line
  1498.   has been processed and any files are loaded.
  1499.  ***************************************************************************/
  1500. proc WhenLoaded()
  1501.     integer cid = GetBufferId()
  1502.  
  1503.     pick_buffer = CreateTempBuffer()
  1504.     GotoBufferId(cid)
  1505.     Hook(_ON_CHANGING_FILES_, OnChangingFiles)
  1506.     Hook(_ON_FIRST_EDIT_, OnFirstEdit)
  1507. end
  1508.  
  1509. /***************************************************************************
  1510.    This macro is called just after the first file is loaded, but before the
  1511.    user is given control, and before any hook functions are called.
  1512.  ***************************************************************************/
  1513. proc Main()
  1514. end
  1515.  
  1516. //  ╔═══════════╗
  1517. //  ║ The Menus ║
  1518. //  ╚═══════════╝
  1519.  
  1520. Menu FileMenu()
  1521.     history
  1522.  
  1523.     "&Open..."                      ,   EditFile()
  1524.     "&Insert..."                    ,   InsertFile()
  1525.     ""                              ,                       ,   Divide
  1526.     "&Next"                         ,   NextFile()
  1527.     "&Previous"                     ,   PrevFile()
  1528.     "&List Open  "                 ,   mListOpenFiles()
  1529.     "List &Recent  "               ,   mListRecentFiles()
  1530.     "Current File"                  ,                       ,   Divide
  1531.     "&Save"                         ,   SaveFile()
  1532.     "Save &As..."                   ,   SaveAs()
  1533.     "Save && Qui&t"                 ,   SaveAndQuitFile()
  1534.     "&Quit"                         ,   QuitFile()
  1535.     "&Change Name..."               ,   ChangeCurrFilename()
  1536.     "All Files"                     ,                       ,   Divide
  1537.     "Sa&ve All"                     ,   SaveAllFiles()
  1538.     "Save All && &Exit"             ,   SaveAllAndExit()
  1539.     "E&xit"                         ,   Exit()
  1540. end
  1541.  
  1542. Menu NamedClipBoardMenu()
  1543.     history
  1544.  
  1545.     "Cu&t..."           ,   mScratchBuffer(CUTTING)
  1546.     "C&ut Append..."    ,   mScratchBuffer(CUTAPPEND)
  1547.     "&Copy..."          ,   mScratchBuffer(STORING)
  1548.     "Cop&y Append..."   ,   mScratchBuffer(APPENDING)
  1549.     ""                  ,   ,                           Divide
  1550.     "&Paste..."         ,   mScratchBuffer(GETTING)
  1551.     "&Paste &Over..."   ,   mScratchBuffer(GETOVERLAY)
  1552. end
  1553.  
  1554. Menu ClipboardMenu()
  1555.     history
  1556.  
  1557.     "Cu&t"              ,   Cut()
  1558.     "C&ut Append"       ,   Cut(_APPEND_)
  1559.     "&Copy"             ,   Copy()
  1560.     "Cop&y Append"      ,   Copy(_APPEND_)
  1561.     ""                  ,                       , Divide
  1562.     "&Paste"            ,   Paste()
  1563.     "Paste &Over"       ,   Paste(_OVERWRITE_)
  1564.     ""                  ,                       , Divide
  1565.     "&Named ClipBoards  ", NamedClipBoardMenu(), DontClose
  1566. end
  1567.  
  1568. Menu WindowMenu()
  1569.     history
  1570.  
  1571.     "&Horizontal"           ,   HWindow()
  1572.     "&Vertical"             ,   VWindow()
  1573.     "&Resize..."            ,   ResizeWindow()
  1574.     "&Go to..."             ,   GotoWindow()
  1575.     "&Zoom"                 ,   ZoomWindow()
  1576.     "&One"                  ,   OneWindow()
  1577.     "&Close..."             ,   CloseWindow()
  1578. end
  1579.  
  1580. Menu BlockMenu()
  1581.     history
  1582.  
  1583.     "Mark &Line"                ,   MarkLine()
  1584.     "Mark Ch&aracter"           ,   MarkStream()
  1585.     "Mar&k Column"              ,   MarkColumn()
  1586.     "&UnMark"                   ,   UnMarkBlock()
  1587.     ""                          ,                       , Divide
  1588.     "&Copy"                     ,   CopyBlock()
  1589.     "&Move"                     ,   MoveBlock()
  1590.     "&Shift..."                 ,   mShift()
  1591.     "&Write to File..."         ,   SaveBlock()
  1592.     "&Delete"                   ,   DelBlock()
  1593.     ""                          ,                       , Divide
  1594.     "U&pper  "                 ,   mUpper()            , DontClose
  1595.     "Lowe&r  "                 ,   mLower()            , DontClose
  1596.     "Fl&ip   "                 ,   mFlip()             , DontClose
  1597.     "&Fill..."                  ,   FillBlock()
  1598. end
  1599.  
  1600. Menu SearchMenu()
  1601.     history
  1602.  
  1603.     "&Find..."                      ,   find()
  1604.     "&Replace..."                   ,   replace()
  1605.     "&Again"                        ,   repeatfind()
  1606.     ""                              ,                       , Divide
  1607.     "Find &Word at Cursor"          ,   mFindWordAtCursor('+')
  1608.     "&Incremental Search..."        ,   mIncrementalSearch()
  1609.     "Compressed &View..."           ,   mCompressView(0)
  1610.     ""                              ,                       , Divide
  1611.     "F&unction List"                ,   mCompressView(1)
  1612.     "&Match"                        ,   mMatch()
  1613.     "Cou&nt..."                     ,   mCount()
  1614.     ""                              ,                       , Divide
  1615.     "&Place Bookmark..."            ,   placemark()
  1616.     "&Go to Bookmark..."            ,   gotomark()
  1617.     ""                              ,                       , Divide
  1618.     "Go to &Line..."                ,   GotoLine()
  1619.     "Go to &Column..."              ,   GotoColumn()
  1620. end
  1621.  
  1622. Menu PrintConfig()
  1623.     Title = 'Print Output Options'
  1624.     History
  1625.  
  1626.     "&Left Margin"              [Query(PrintLeftMargin):5],
  1627.             Set(PrintLeftMargin,ReadNum(Query(PrintLeftMargin))),
  1628.             DontClose
  1629.     "&Right Margin"             [Query(PrintRightMargin):5],
  1630.             Set(PrintRightMargin,ReadNum(Query(PrintRightMargin))),
  1631.             DontClose
  1632.     "&Top Margin"               [Query(PrintTopMargin):5],
  1633.             Set(PrintTopMargin,ReadNum(Query(PrintTopMargin))),
  1634.             DontClose
  1635.     "&Bottom Margin"            [Query(PrintBotMargin):5],
  1636.             Set(PrintBotMargin,ReadNum(Query(PrintBotMargin))),
  1637.             DontClose
  1638.     "Lines &Per Page"           [Query(PrintLinesPerPage):5],
  1639.             Set(PrintLinesPerPage,ReadNum(Query(PrintLinesPerPage))),
  1640.             DontClose,
  1641.             "Number of lines per page, 0 for continuous forms"
  1642.     "Line &Spacing"             [Query(PrintLineSpacing):5],
  1643.             Set(PrintLineSpacing,ReadNum(Query(PrintLineSpacing))),
  1644.             DontClose,
  1645.             "Type of spacing, 1=Single 2=Double 3=Triple etc..."
  1646.     ""      ,,
  1647.             Divide
  1648.     "&Header"                   [Query(PrintHeader):4],
  1649.             GetHeader(),
  1650.             DontClose,
  1651.             "Specifies what to print at top of each page"
  1652.     "&Footer"                   [Query(PrintFooter):4],
  1653.             GetFooter(),
  1654.             DontClose,
  1655.             "Specifies what to print at bottom of each page"
  1656.     "&Device"                   [Query(PrintDevice):15],
  1657.             GetPrintDevice(),
  1658.             DontClose,
  1659.             "Name of device to send print,  can be a filename"
  1660.     "&Init String"              [Query(PrintInit):10],
  1661.             GetInitString(),
  1662.             DontClose,
  1663.             "String to be sent to the printer before each print job"
  1664.     ""      ,,
  1665.             Divide
  1666.     "First P&age"               [Query(PrintFirstPage):5],
  1667.             Set(PrintFirstPage,ReadNum(Query(PrintFirstPage))),
  1668.             DontClose,
  1669.             "Page Number to start printing from"
  1670.     "Last Pa&ge"                [Query(PrintLastPage):5],
  1671.             Set(PrintLastPage,ReadNum(Query(PrintLastPage))),
  1672.             DontClose,
  1673.             "Page Number of last page to print"
  1674.     "Number of &Copies"         [Query(PrintCopies):5],
  1675.             Set(PrintCopies,ReadNum(Query(PrintCopies))),
  1676.             DontClose,
  1677.             "Number of copies to print"
  1678.     ""      ,,
  1679.             Divide
  1680.     "Print Line &Numbers"           [OnOffStr(Query(PrintLineNumbers)):3],
  1681.             Toggle(PrintLineNumbers),
  1682.             DontClose,
  1683.             "Line numbers will be printed at beginning of each line"
  1684.     "F&ormfeed After Printing"      [OnOffStr(Query(PrintAddFF)):3],
  1685.             Toggle(PrintAddFF),
  1686.             DontClose,
  1687.             "Sends a Form Feed to the printer after print job is complete"
  1688.     "Pa&use Between Pages"          [OnOffStr(Query(PrintPause)):3],
  1689.             Toggle(PrintPause),
  1690.             DontClose,
  1691.             "Pause between each printed page"
  1692. end PrintConfig
  1693.  
  1694. Menu PrintMenu()
  1695.     history
  1696.  
  1697.     "&All"                  ,   PrintFile()
  1698.     "&Block"                ,   PrintBlock()
  1699.     "Send &Formfeed"        ,   mSendFormFeed()
  1700.     "Send &Init String"     ,   mSendInitString(),  DontClose
  1701.     "Set &Options  "       ,   PrintConfig(),      DontClose
  1702. end PrintMenu
  1703.  
  1704. Menu MacroMenu()
  1705.     Title = "Keyboard Macros"
  1706.     history
  1707.  
  1708.     "&Record"                       ,   RecordKeyMacro()
  1709.     "&Save..."                      ,   SaveKeyMacro()
  1710.     "Loa&d..."                      ,   LoadKeyMacro()
  1711.     "Run Scrap &Macro"              ,   ExecScrapMacro()
  1712.     "Pur&ge"                        ,   PurgeKeyMacro()
  1713.     "Compiled Macros"               ,                   ,   Divide
  1714.     "&Execute..."                   ,   mMacMenu(1)
  1715.     "&Load..."                      ,   mMacMenu(2)
  1716.     "&Purge..."                     ,   mMacMenu(3)
  1717.     "&Compile"                      ,   mCompile()
  1718. end
  1719.  
  1720. Menu TextMenu()
  1721.     history
  1722.  
  1723.     "&Add Line (below)"         ,   AddLine()
  1724.     "&Insert Line (above)"      ,   InsertLine()
  1725.     "D&up Line"                 ,   DupLine()
  1726.     "&Join Line"                ,   JoinLine()
  1727.     "Spli&t Line"               ,   SplitLine()
  1728.     "&Swap Lines"               ,   mSwapLines()
  1729.     ""                          ,                   ,   Divide
  1730.     "&Delete Line"              ,   DelLine()
  1731.     "Delete to &End of Line"    ,   DelToEol()
  1732.     "Delete Right &Word"        ,   DelRightWord()
  1733.     ""                          ,                   ,   Divide
  1734.     "&Global UnDelete"          ,   GlobalUnDelete()
  1735.     "&Local UnDelete"           ,   UnDelete()
  1736.     "Paste U&nDelete"           ,   PasteUnDelete()
  1737.     "&Restore Cursor Line"      ,   RestoreCursorLine()
  1738.     ""                          ,                   ,   Divide
  1739.     "Wrap &Paragraph"           ,   mWrapPara()
  1740.     "&Center Line"              ,   mCenterLine()
  1741. end
  1742.  
  1743. Menu VideoModeMenu()
  1744.     history = Query(CurrVideoMode)
  1745.     command = Set(CurrVideoMode,MenuOption())
  1746.  
  1747.     "&25-Line"
  1748.     "2&8-Line"
  1749.     "&43-Line"
  1750.     "&50-Line"
  1751. end
  1752.  
  1753. Menu UtilMenu()
  1754.     history
  1755.  
  1756.     "&Line Draw" [OnOffStr(Query(LineDraw)):3], Toggle(LineDraw), DontClose
  1757.     "Line &Type  "         ,   LineTypeMenu()      ,   DontClose
  1758.     ""                          ,                   ,   Divide
  1759.     "&Sort"                 ,   Sort(sort_flags)
  1760.     "Sort &Order"   [ShowSortFlag() : 10], ToggleSortFlag(1), DontClose
  1761.     "&Case-Sensitive Sort" [OnOffStr((sort_flags & 2) == 0):3], ToggleSortFlag(2), DontClose
  1762.     ""                          ,                   ,   Divide
  1763.     "&ASCII Chart"          ,   mAsciiChart()
  1764.     "&Date/Time Stamp"      ,   mDateTimeStamp()
  1765.     "Change &Video Mode  " ,   VideoModeMenu()     ,   DontClose
  1766.     "DOS S&hell"            ,   Shell()
  1767. end
  1768.  
  1769. menu AutoIndentMenu()
  1770.     command = Set(AutoIndent, MenuOption() - 1)
  1771.     history = query(AutoIndent) + 1
  1772.  
  1773.     "O&ff"      ,, CloseBefore
  1774.     "O&n"       ,, CloseBefore
  1775.     "&Sticky"   ,, CloseBefore
  1776. end
  1777.  
  1778. Menu TabTypeMenu()
  1779.     history = query(tabtype) + 1
  1780.     command = Set(TabType,MenuOption()-1)
  1781.  
  1782.     "&Hard"     ,, CloseBefore
  1783.     "&Soft"     ,, CloseBefore
  1784.     "Smar&t"    ,, CloseBefore
  1785.     "&Variable" ,, CloseBefore
  1786. end
  1787.  
  1788. Menu ReconfigMenu()
  1789.     history
  1790.  
  1791.     "&AutoIndent"           [MenuStr(AutoIndentMenu,query(AutoIndent)+1) : 6],
  1792.                             AutoIndentMenu()            ,   DontClose
  1793.     "&WordWrap"             [OnOffStr(query(WordWrap))   : 3],
  1794.                             Toggle(WordWrap)            ,   DontClose
  1795.     "&Right Margin"         [query(RightMargin) : 5],
  1796.                             set(RightMargin, ReadNum(Query(RightMargin))),   DontClose
  1797.     "&Left Margin"          [query(LeftMargin) : 5],
  1798.                             set(LeftMargin, ReadNum(Query(LeftMargin))),   DontClose
  1799.     ""                          ,                   ,   Divide
  1800.     "Tab Ty&pe"             [MenuStr(TabTypeMenu,query(TabType)+1) : 8],
  1801.                             TabTypeMenu()               ,   DontClose
  1802.     "&Tab Width"            [query(TabWidth) : 5],
  1803.                             set(TabWidth, ReadNum(Query(TabWidth))),   DontClose
  1804.     ""                          ,                   ,   Divide
  1805.     "&Backups"              [OnOffStr(Query(MakeBackups)) : 3],
  1806.                             Toggle(MakeBackups)         ,   DontClose
  1807.     ""                          ,                   ,   Divide
  1808.     "&Full Configuration  ",          ExecMacro("iconfig"),DontClose
  1809.     "&Save Current Settings",       mSaveSettings()
  1810. end
  1811.  
  1812. MenuBar MainMenu()
  1813.     history
  1814.  
  1815.     "&File"    ,    FileMenu()
  1816.     "&Block"   ,    BlockMenu()
  1817.     "&Text"    ,    TextMenu()
  1818.     "&Search"  ,    SearchMenu()
  1819.     "&Window"  ,    WindowMenu()
  1820.     "&Clipboard",   ClipboardMenu()
  1821.     "&Macro"   ,    MacroMenu()
  1822.     "&Print"   ,    PrintMenu()
  1823.     "&Util"    ,    UtilMenu()
  1824.     "&Options" ,    ReconfigMenu()
  1825. end
  1826.  
  1827. // removed mPullDownMenu() ; not used
  1828.  
  1829. // Mouse functions:
  1830.  
  1831. proc mLeftBtn()
  1832.     if not ProcessHotSpot()
  1833.        MainMenu()
  1834.     endif
  1835. end
  1836.  
  1837. proc mTrackMouseCursor()
  1838.     if GotoMouseCursor()
  1839.         TrackMouseCursor()
  1840.     endif
  1841. end
  1842.  
  1843. #include ["wp4prog.key"]             // key-assignments
  1844.