#  <20240202.1758.31>
# The following namespace delete is to allow multiple source
# commands when debugging.
catch {namespace delete putsTrimSpace}
# A short function (well it was) to allow us to print the '#'
# lines in col 1 even though emacs wants to indent... We also
# set this up to use a relatively uniform line length.  This
# means we blend short lines and carry over long one.  While
# it is no longer required to put the '#' character in front
# of each line, we handle those too. A blank line or "#" alone
# will produce a blank line in the output. We also handle
# special functions as follows:

# A special function starts with "`" followed by a script.
# The script must be enclosed in {} and followed with "`"
# (i.e. `{script}` The script has the following
# values and functions available to it:

# $soFar The line so far.

# next   Function to flush the current line and start a new one.
#        This will set soFar to an empty string.

# fill c ?n? Fill the remaining characters with string "c"
#        without ?n?, just fill, if ?n? >0 fill with ?n? copies of c
#        if ?n? < 0 fill with c to (but not beyond) column -%n%
#        (column number starts a 0 after the preamble)
#        if already at or beyond ?n? produce 1 blank (i.e. space)
#        if c is more than one char. and would not endt at the
#        requested column, produce spaces to make the difference.

# in 1/0 ?n? control indention:if first parm is 1 turn on, if 0 turn off
#        ?n? (only if turning on) how many spaces to indent (default
#        is 4 or is used before on this call to putsTrim the last
#        value. Indention is stacked, i.e. an intention call while
#        indention is active added to the prio. A 'in 0' backs out
#        the last 'in 1' request.
# in e/h 'in e' or 'in E' clears all indents. 'in h' or 'in H' (a 'hanging'
#        indent) does the indent after the next newline. With the exception
#        of the 'hanging' indent any pending full lines are flushed with the
#        old indent prior to setting up the new. A partial line that remain
#        will use then new indent. The 'hanging' indent is activated
#        immediately after the next linefeed so that any pending partial
#        line with its continuation uses the old indent while lines after
#        the pending line and its continuation use the new indent.

# other  all tcl commands are available
#
# The script may flush the line(s) (see next) or leave the result in soFar
# which will be output in due course.
#
# call: putsTrim fid string ?preamble? ?length?
#
# We assume the string may be (most likely is) multi line.
# ?preamble? will be put in front of each line. Default is "#  ".
# This parameter is sticky, i.e. only the first call need
# have it until a change is desired.

# The proc ::putsTrimSpace::init take an optional parameter to
#     set the line length which is not to be exceeded. Default is
#     to figure it based on the expected size of the window which
#     will be constructed the same size as '.'.  This, of course,
#     is not what should be as the result is written to a file and
#     read back when needed at which time the window size may differ.


# Each call to putsTrim produces zero or more complete lines. There is no
# carry over to the next call.
#            


namespace eval putsTrimSpace {
  variable preamble "#  "
  variable noComs 0
  variable length 60
  variable indent 0
  variable indentLast
  variable indentStack {}
  variable scriptS "`{"
  variable scriptE "}`"   
  variable remains {}
  variable soFar
  variable co 0
  variable hanging 0
  
  # We put "B" and "I" (bold and italic) format routines with the same name as
  # the global ones here. The difference is that these are conditional on the
  # config option.

  # Make a stab at setting the right length. The '11' below accounts for
  # two scroll bars (4) borders (1) an extra char in the left box (1) preamble (2)
  # which leaves 3 un accounted for/fudge.

  namespace export init

  proc init {args} {
    variable preamble
    variable noComs 0
    
    # This dodge is needed because it is possible to want to write the
    # config file prior to 'wm' getting around to processing the 'geometry' command.
    set len 0
    if {[set w [lindex [split [wm geo .] x] 0]] == 1} {
      set w [lindex [split $::config(geometry,main) x] 0]
    }

    foreach arg $args {
      if {$arg == "noComs"} {set noComs 1}
      if {[string is integer -strict $arg]} {set len $arg}
    }
	
    variable length [expr {$w / \
			       [font measure $::glob(gui,ListBoxFont) " "] -\
			       $::fr_config::leftMax -\
			       [string length $preamble]\
			       -9}]
    if {$len != 0} {
      set length [incr len [string length $preamble]]
    }
    # And just incase some one trys to edit the configure file with the main window
    # cramped to unreadable...
    if {$length < 67} {set length 67}
    if {$length > 100} {set length 100}
    return
  }

  proc B {text {t bold}} {
    if {$::config(overstrike,config)} {
      return [::B $text $t]
    }
    return $text
  }

  proc I {text} {return [B $text 1]}
  
  # The loOs function returns the length of a string with the overstrike chars removed.
  # Without this we will wrap lines too soon...

  proc lnOs {string} {
    return [string length [regsub -all -nocase {\u001b[^a-z]*[a-z]} $string {}]]
    # return [string length [regsub -all {.\b} $string {}]]
  }

  proc putsPre {fid line} {
    variable preamble
    variable hanging
    variable co

    puts $fid "${preamble}$line"
    if {$hanging != 0} {
      pushIndent $hanging
    }
  }
    
  # allButRemains outputs lines from soFar so that
  # only a line fragment less that $lenth remains

  proc allButRemains {} {
    uplevel {
      #variable length
      while {[lnOs $soFar] >= $length} {
	if {[lnOs $soFar] == $length} {
	  putsPre $fid "$soFar"
	  set soFar {}
	} else {
	  set tempLn $length
	  set actualLn [string length $soFar]
	  while {[lnOs [string range $soFar 0 $tempLn]] < $length &&\
		     [incr tempLn] < $actualLn} {
	    # frputs "[string range $soFar 0 $tempLn] " tempLn actualLn soFar length
	  }
	  set lp [string last " " $soFar $tempLn]
	  if {$lp == -1} {
	    set lp [string first " " $soFar]
	  } 
	  if {$lp == -1} {set lp [string length $soFar]}
	  set pr [putsPre $fid "[string range $soFar 0 $lp-1]"]
	  set soFar [string range $soFar $lp+1 end]
	}
      }
    }
  }
  
  proc next {} {
    variable remains
    variable indent
    variable hanging
    uplevel {
      allButRemains
      putsPre $fid "$soFar"
      set soFar {}
      set remains [string trim $remains]
    }
    return
  }
  
  proc fill {s {n {}}} {
    variable length
    variable remains
    variable indent
    variable soFar

    uplevel { allButRemains}
    
    if {$n == {}} {
      set n [expr {-$length - $indent}]
    }
    if {![string is integer $n] || $n == 0} {
      append soFar "\"-->fill parm \"$n\" is not a non-zero integer<--\""
      return
    }
    if {$n > 0} {
      set rp $n
      set sp 0
    } else {
      # current col is length + indent
      set targetCol [expr {-$n - [lnOs $soFar] - $indent}]
      # frputs targetCol n
      set sl [string length $s]
      if {$targetCol < 0} {
	set sp 1
	set rp 0
      } else {
	set rp [expr {$targetCol / $sl}]
	set sp [expr {$targetCol % $sl}]
      }
    }
    append soFar [string repeat $s $rp] [string repeat " " $sp]
    return
  }

  proc in {on {amount {}}} {
    variable preamble
    variable length 
    variable indent 
    variable indentLast
    variable indentStack
    variable soFar
    variable hanging

    frputs soFar

    uplevel {allButRemains}
    frputs on
    if {$on in {"E" "e"}} {
      while {$indent > 0} {in 0}
      set hanging 0
      return
    }
    if {$on == 0} {
      if {$indentStack == {}} {
	append soFar \
	    "\"-->in: No indention active when called to turn off<--\""
	return
      }
      set am [lindex $indentStack end]
      set indent [expr {$indent - $am}]
      set length [expr {$length + $am}]
      set indentLast $am
      set preamble [string range $preamble 0 end-$am]
      set indentStack [lrange $indentStack 0 end-1]
      return
    }
    
    # if not off, treat as on
    if {$amount == {}} {
      set amount [expr {$indentLast == 0 ? 4 : $indentLast}]
    }
    if {![string is integer $amount] || \
	    $amount <= 0 ||\
	    $amount >= $length} {
      append soFar "\"-->in: indention amount ($amount)\
                          is not a integer >0 and < $length<--\""
      return
    }
    frputs on soFar 
    if {$on in {"H" "h"} && $soFar != {}} {
      set hanging $amount
      frputs hanging indentLast
      return
    }
    pushIndent $amount
  }

  proc pushIndent {amount} {
    variable hanging
    variable indentLast
    variable indent
    variable length
    variable indentStack
    variable preamble
    
    set hanging 0
    set indentLast $amount
    lappend indentStack $amount
    incr indent $amount
    incr length -$amount
    append preamble [string repeat " " $amount]
    return
    # set preamble [string cat $preamble [string repeat " " $amount]]
  }

  # The "ifThis" function takes three arguments:
  # 1: an expression that evaluates true or false
  # 2: a body of text to add to the result if 1: is true
  # 3: a body of test to add to the result if 1: is false
  
  proc ifThis {condition true {false {}}} {
    set cmd [list if \{ $condition \} \{ return [ list $true ] \} \{ return [ list $false ] \} ]
    uplevel eval $cmd
  }
  
  
  
  proc doTheWork {fid exp} {
    variable length
    variable soFar
    variable scriptS 
    variable scriptE  
    variable remains
    variable indentLast 0
    variable preamble
    variable indent
    variable hanging 0

    while {$indent > 0} {in 0}
    set remains {}
    if {$exp == {}} {set exp { }}
    set lines $exp
    while {[string length $lines ] > 0} {
      regexp {([^\n]*)($|\n)(.*)} $lines m line nn lines
      #set lines [lassign $lines line]
      # first remove leading & and trailing blanks and then any leading "#"
      set soFar [string trim $line ]
      if {[string index $soFar 0] == "#"} {
	set soFar [string trim [string range $soFar 1 end]]
      }
      if {[string length $soFar] == 0} {
	if {[string length $remains ] > 0} {
	  putsPre $fid "$remains"
	  set remains {}
	}
	puts $fid ""
	continue
      }
      set tmp {}
      append tmp $remains " " $soFar
      set soFar [string trim $tmp]
      # check for an embeded script.. .
      if {[set s1 [string first $scriptS $soFar]] != -1} {
	# here we build the script... possibly multi lined.
	set script [string range $soFar $s1+1 end]
	set soFar [string range $soFar 0 $s1-1]
	# We have the start of a script, now find the end assuming
	# there may be embeded scripts.
	set nest 1
	set loc 0
	while {$nest > 0} {
	  set s2 [string first $scriptE $script $loc]
	  set s3 [string first $scriptS $script $loc]
	  # If script start is immediately after a normal close brace, complain
	  if {$s3 - $s2 == 1} {
	    error "fail to parse `open brace immediately after close brace in script:\n $script"
	  }
	  # puts "nest $nest s2 $s2 s3 $s3 $script $loc"
	  if {$s2 == -1 && $s3 == -1} {
	    # we don't strip blanks or #'s in a script
	    if {[string length $lines] < 1} {
	      error "End of script not found"
	    }
	    set loc [string length $script ]
	    # set lines [lassign $lines line]
	    regexp {([^\n]*)($|\n)(.*)} $lines m line nn lines
	    append script "\n" $line
	  } elseif {$s2 < $s3 || $s3 == -1} {
	    if {[incr nest -1] == 0} {break}
	    set loc [incr s2 2]
	  } else {
	    # the case left is s3<s2 || s3 && s2 == -1
	    incr nest
	    set loc [incr s3 2]
	  }
	}
	set remains [string range $script $s2+2 end]
	set script [string range $script 0 $s2]
	# frputs script
	set mlines [uplevel 0 [regsub -all {^\{|\}$} $script {}]]
	set left "$soFar$mlines$remains"
	if {[string length $left] > 0} {
	  set lines "$left\n$lines"
	}
	set remains {}
	continue
      }
      # here we check if we have enough to put out..
      # frputs soFar
      allButRemains
      set remains $soFar
      # frputs remains
    }
    # put out any remaing line bits...
    if {[string length $remains] > 0} {
      putsPre $fid "$remains"
    }
  }
}

proc putsTrim {fid exp args} {

  lassign $args pre 
  if {$pre != {}} {set ::putsTrimSpace::preamble $pre}
  
  if {$::putsTrimSpace::noComs} {return}

  ::putsTrimSpace::doTheWork $fid $exp
}

