/****************************** Module Header *******************************
*
* Module Name: box.e
*
* Copyright (c) Netlabs EPM Distribution Project 2002
*
* $Id$
*
* ===========================================================================
*
* This file is part of the Netlabs EPM Distribution package and is free
* software.  You can redistribute it and/or modify it under the terms of the
* GNU General Public License as published by the Free Software
* Foundation, in version 2 as it comes in the "COPYING" file of the
* Netlabs EPM Distribution.  This library is distributed in the hope that it
* will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty
* of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
* General Public License for more details.
*
****************************************************************************/
;  For linking version, BOX can be an external command.
;  Script style suggested by Larry Salomon, Jr.

compile if not defined( SMALL)  -- If compiled separately
   EA_comment 'This defines the BOX command; it can be linked or executed directly.'

define
   INCLUDING_FILE = 'BOX.E'

   include 'stdconst.e'
const
   tryinclude 'mycnf.e'
const
 compile if not defined( NLS_LANGUAGE)
   NLS_LANGUAGE = 'ENGLISH'
 compile endif
   include NLS_LANGUAGE'.e'

defmain     -- External modules always start execution at DEFMAIN.
   'Box' arg( 1)
compile endif

; ---------------------------------------------------------------------------
; Syntax: Box <arg>
; <arg> =
; 1 thin, single line
; 2 thin, double line
; 3 dotted line
; 4 thick line
; 5 double, thin line horizontally; single, thin line vertically
; 6 double, thin line vertically; single, thin line horizontally
; C creates a box comment using the C language syntax
; P creates a box comment using the Pascal language syntax
; A creates a box comment using Assembler syntax
; E erases the box around the marked area
; R reflows text in marked area
; B places spaces on all sides of the marked area, i.e. creates a box of blank spaces
; /character Any character which follows the slash ( / ) will be used to form a box.
defc Box
   universal tempofid
   universal header_width

   args = arg( 1)
   if args = '' then
      KeyPath = '\NEPMD\User\Format\BoxStyle'
      args = QueryConfigKey( KeyPath)
   endif
   upargs = upcase( args)
   if upargs = 'SELECT' | upargs = '' then
      call SelectBoxStyle()
      return
   endif

   call pSave_Pos( savepos)
   getmark markfirstline, marklastline, markfirstcol, marklastcol, markfid
   getfileid fid
   if markfid = '' then
      sayerror NO_MARK__MSG
      return
   elseif fid <> markfid then
      sayerror OTHER_FILE_MARKED__MSG
      return
   endif

   StartCol = markfirstcol
   EndCol   = marklastcol
   mt = marktype()
   if mt = 'CHAR' then
      if markfirstline = marklastline then
         -- Single-line char mark
         EndCol = marklastcol
      else
         -- Multi-line char mark
         if marklastcol < markfirstcol then
            marklastline = marklastline - 1
         endif
         if marklastcol < header_width then
            marklastcol = header_width
         endif
         EndCol = marklastcol
      endif
   elseif mt = 'LINE' then
      parse value pMargins() with StartCol EndCol .
   endif

   if EndCol = MAXMARGIN then
      EndCol = header_width
   endif
   if mt <> 'BLOCK' then
      -- Change to block mark
      mt = 'BLOCK'
      call pset_mark( markfirstline, marklastline, StartCol, EndCol, mt, markfid)
   endif

   call NextCmdAltersText()

   fSlash = 0
   for ptr = 1 to length( args)
      if fSlash then
         Style = substr( args, ptr, 1)
      else
         Style = substr( upargs, ptr, 1)
      endif
      if Style = '/' then
         fSlash = 1
         iterate
      endif
      if not fSlash and verify( upargs, '123456BCPAERS') then
         sayerror BOX_ARGS__MSG
         return
      endif

      fReplaceDone = 0
      if Style = 'E' then      -- Erase box
         getline tLineStr, markfirstline, markfid
         getline bLineStr, marklastline, markfid
         if StartCol = 1 or markfirstline = 1 or marklastline = markfid.last then
            sayerror BOX_MARK_BAD__MSG
            return
         endif

         brc = substr( bLineStr, EndCol + 1, 1)
         lside = substr( tLineStr, StartCol - 1, 1)
         if pos( lside, 'º³;|Û') > 0  then
            sl = 1
         elseif lside = '*' and StartCol > 2 and  -- MAX prevents error if StartCol <= 2
                                pos( substr( tLineStr, Max( StartCol - 2, 1), 1), '{/.') then
            sl = 2
         elseif brc = lside then
            sl = 1
         else
            sayerror BOX_MARK_BAD__MSG
            return
         endif

         do i = markfirstline to marklastline
            getline LineStr, i, markfid
            pReplaceLine( substr( LineStr, 1, StartCol - sl - 1) ||
                          substr( LineStr, StartCol, EndCol + 1 - StartCol) ||
                          substr( LineStr, EndCol + sl + 1), i, markfid)
         enddo
         deleteline marklastline + 1, markfid
         deleteline markfirstline - 1, markfid
         fReplaceDone = 1

         call pRestore_Pos( savepos)
         call pSet_Mark( markfirstline - 1, marklastline - 1, StartCol - sl, EndCol - sl, mt, markfid)

      elseif Style = 'R' then  -- Reflow
         if not pBlock_Reflow( 0, spc, tempofid) then
            call pBlock_Reflow( 1, spc, tempofid)
         endif
         fReplaceDone = 1
         call pRestore_Pos( savepos)

      elseif fSlash then       -- /<char>
         lside = Style
         rside = Style
         tside = Style
         tlc   = Style
         trc   = Style
         blc   = Style
         brc   = Style

      elseif Style = 'P' then  -- Pascal
         lside = '{*'
         rside = '*}'
         tside = '*'
         tlc   = '{*'
         trc   = '*}'
         blc   = '{*'
         brc   = '*}'

      elseif Style = 'A' then  -- Assembler
         lside = ';'
         rside = ' '
         tside = '*'
         tlc   = ';'
         trc   = ' '
         blc   = ';'
         brc   = ' '

      elseif Style = 'C' then  -- C
         lside = '/*'
         rside = '*/'
         tside = '*'
         tlc   = '/*'
         trc   = '*/'
         blc   = '/*'
         brc   = '*/'

      elseif Style = 1 then
         lside = '³'
         rside = '³'
         tside = 'Ä'
         tlc   = 'Ú'
         trc   = '¿'
         blc   = 'À'
         brc   = 'Ù'

      elseif Style = 2 then
         lside = 'º'
         rside = 'º'
         tside = 'Í'
         tlc   = 'É'
         trc   = '»'
         blc   = 'È'
         brc   = '¼'

      elseif Style = 3 then
         lside = '|'
         rside = '|'
         tside = '-'
         tlc   = '+'
         trc   = '+'
         blc   = '+'
         brc   = '+'

      elseif Style = 4 then
         lside = 'Û'
         rside = 'Û'
         tside = 'ß'
         tlc   = 'Û'
         trc   = 'Û'
         blc   = 'ß'
         brc   = 'ß'

      elseif Style = 5 then
         lside = '³'
         rside = '³'
         tside = 'Í'
         tlc   = 'Õ'
         trc   = '¸'
         blc   = 'Ô'
         brc   = '¾'

      elseif Style = 6 then
         lside = 'º'
         rside = 'º'
         tside = 'Ä'
         tlc   = 'Ö'
         trc   = '·'
         blc   = 'Ó'
         brc   = '½'

      elseif Style = 'S' then  -- Script
         lside = '.*'
         rside = '**'
         tside = '*'
         tlc   = '.*'
         trc   = '**'
         blc   = '.*'
         brc   = '**'

      else
         Style = 'B'           -- Blank
         lside = ' '
         rside = ' '
         tside = ' '
         tlc   = ' '
         trc   = ' '
         blc   = ' '
         brc   = ' '
      endif

      if fReplaceDone = 0 then
         sl = length( lside)
         width = 1 + EndCol - StartCol  -- width of inside of box
         side  = substr( '', 1, width, tside)
         next  = substr( '', 1, StartCol - 1) ||
                 blc  ||
                 side ||
                 brc
         insertline next, marklastline + 1, markfid
         next  = substr( '', 1, StartCol - 1) ||
                 tlc  ||
                 side ||
                 trc
         insertline next, markfirstline, markfid
         for i = markfirstline + 1 to marklastline + 1
            getline LineStr, i, markfid
            next = substr( LineStr, 1, StartCol - 1) ||
                   lside ||
                   substr( LineStr, StartCol, width) ||
                   rside ||
                   substr( LineStr, EndCol + 1)
            pReplaceLine( next, i, markfid)
         endfor
         call pRestore_Pos( savepos)
         call pSet_Mark( markfirstline + 1, marklastline + 1, StartCol + sl, EndCol + sl, mt, markfid)
      endif
      fSlash = 0
   endfor

; ---------------------------------------------------------------------------
defproc SelectBoxStyle
   Sep = \1
   Entries = ''
   -- E bug: String concatenation sometimes adds an additional space char
   -- for string1''string2 if string2 contains a special (non-ASCII?) char.
   -- That doesn't happen with string1 || string2.
   -- The following spacing looks good with 9.Warp Sans:
   Entries = Entries''Sep || '1     '\179'        CP 850, 437' -- ³  thin, single line
   Entries = Entries''Sep || '2     '\186'        CP 850, 437' -- º  thin, double line
   Entries = Entries''Sep || '3     |         ASCII'           -- |  ASCII chars
   Entries = Entries''Sep || '4     '\219'        CP 850, 437' -- Û  thick line
   Entries = Entries''Sep || '5     '\216'         CP 437'     -- Ø  H: double, V: single line
   Entries = Entries''Sep || '6     '\215'         CP 437'     -- ×  H: single, V: double line
   Entries = Entries''Sep || 'C     /'||'*      C comment'
   Entries = Entries''Sep || 'P     (*      Pascal comment'
   Entries = Entries''Sep || 'A     ;          Assembler comment'
   Entries = Entries''Sep || 'S     .*       Script comment'
   Entries = Entries''Sep || 'B                space'
   Entries = Entries''Sep || 'E                erase'
   Entries = Entries''Sep || 'R                reflow'
   Entries = Entries''Sep || '/<char>   any char'

   KeyPath = '\NEPMD\User\Format\BoxStyle'
   OldStyle = QueryConfigKey( KeyPath)
   rest = Entries
   i = 0
   DefaultItem = 1
   do while rest <> ''
      if i = 20 then  -- just to prevent looping forever
         leave
      endif
      i = i + 1
      parse value rest with (Sep) 2 Char 3 . (Sep) +0 rest
      if Char = leftstr( OldStyle, 1) then
         DefaultItem = i
         leave
      endif
   enddo
   Title = 'Select a box style'  --copies( ' ', 20)
   Text = 'The selection will be saved on 'ChangeStr( '~', OK__MSG, '')'.'
   HelpId = 2050
   DefaultButton = 1
   Buttons = '/'OK__MSG'/'CANCEL__MSG'/'HELP__MSG

   refresh
   Result = ListBox( Title\0,         -- <-- \0 required?
                     Entries,
                     Buttons,
                     0, 0,      -- top, left in chars, (0,0) = center, (C,C) = cursor
                     14, 50,    -- height, width in chars
                     GethWndC( APP_HANDLE) || atoi( DefaultItem) ||
                     atoi( DefaultButton) || atoi( HelpId) ||
                     Text\0)
   refresh

   -- Check result
   parse value Result with Button 2 Selected \0
   Selected = leftstr( Selected, 1)
   BoxChar = ''
   Style = ''
   if Button = \1 then                         -- OK
      if wordpos( Selected, '1 2 3 4 5 6 C P A S B E R') then
         Style = Selected
      endif
      if Selected = '/' then
         -- Get box char
         Title = 'Configure box character'
         Text  = 'Enter a character:'
         Text  = Text''copies( ' ', Max( 100 - length(Text), 0))
         Buttons = '/'OK__MSG'/'CANCEL__MSG
         Entry = ''
         parse value EntryBox( Title,
                               Buttons,
                               Entry,
                               0,
                               240,
                               atoi( 1) || atoi( 0) || atol( 0) ||
                               Text) with Button 2 BoxChar \0
         if Button = \1 then      -- OK
            Style = Selected''BoxChar
         else                     -- Cancel
            Style = ''
         endif
      endif
      if Style <> '' & Style <> OldStyle then
         -- Save selection
         WriteConfigKey( KeyPath, Style)
         sayerror 'Box style saved to 'Style'.'
      endif
   else                                       -- Cancel
   endif