#
package provide elastictabs 23.12.24

#<20231224.1629.32>

# Here is a proc to implement a tab scheme for a string of text.
# The rules:
# The user is to insert a tab when s/he wants to start what follows at a
# common place (a tab stop) in this and following lines with tabs in them.
# A line with no tab stop ends the prior stops and the next line with
# tab stops starts a new set of stops.

# We examine the bit of text between each new-line and tab and use the
# longest such to set the tab stop (in pixels).

# We then use the 'width' information to break lines (word break) and line
# up the line continuation at the last tab stop.

# Issue(s) what to do if a tab stop is in the continuation line???
#
# The parameters:
#
# theString theWindow args
#
# args are used to adjust the result to various needs. Each is a keyword
#      value pair:
# key         value
# preamble    prelist    how to prefix new lines generated
#                        because the input line is too long. Possible:
#             {}         No preamble (default)
#             fixed:<st> use <st> as a preamble
#             first:n    use first n characters of the original line
# spacetab    n          (default is 0) if greater than 2, 'n' or more
#                        leading spaces are treated the same as tab
#                        (this is possible only for the equivalent of 1
#                        tab per line) If tabs are used with spacetab > 2,
#                        they are assumed to be the second and higher
#                        tab stops. A 'spacetab' must end before 1/2
#                        of the window width to be recognized.
# keeplong    <bool>     (default is false) if true and can not word
#                        wrap just keep the whole line. Default is
#                        to	end the line with "⤶" (\u2936) and start the
#                        next line with "⤷" (\u2937) with space fill to
#                        the last tab stop. (Note: if the desire is to
#                        not limit the line length just code a very high
#                        number for 'width' (below).
# continue    chars      This option allows the caller to replace the
#                        "⤶" "⤷" (above) with 1 or 2 chars of choice.
#                        If only 1 character is given nill is used for
#                        the second (exmple '-' would hyphenate the word
#                        at the end of the line.
# width       <pixals>   '<pixals>' will override 'theWindow's width,
#                        which normally is found by examining 'theWindow'.
# returnLn    <bool>     (default false) If true return return a list,
#                        the first element is the string of lines, the
#                        second element is the length in pixals of the
#                        longest line.


# tabs or, if spacetab is true, spaces must be after the preamble
#




catch {namespace delete elasticTabStops}

namespace eval elasticTabStops {
  variable font
  variable w
  variable charStop
  variable lines
  variable lineInfo
  variable newLine
  variable fixFont   ; # true if fixed font
  variable spaceChars

  proc ElasticTabStops {theString theWindow args} {
	
	variable font
	variable passedInFont [$theWindow cget -font]
	variable w            $theWindow
	variable options
	variable charStop
	variable lines
	variable lineInfo
	variable newLine {}
	variable returnLength 0
	variable fixFont
	variable spaceChars
	variable spaceCharIndex
	variable minTab [font measure $passedInFont -displayof $w "  "]

	# set up the options...
	set legalOps {preamble spacetab keeplong width continue returnLn}
	array set options [list preamble {} preambleLn 0 spacetab 0 continue "⤶⤷"\
						   keeplong 0 width [winfo width $w] returnLn 0]
	
	foreach {op val} $args {
	  set lsr [lsearch -inline $legalOps ${op}*]
	  if {[llength $lsr] != 1} {
		error "$op is not a legal option, must be one of \"$legalOps\""
	  }
	  set options($lsr) $val
	}
	foreach op $legalOps {
	  if {$op == "preamble"} {
		set vals [split $options($op) :]
		if {[set pv [lindex $vals 0]] ni {{} fixed first}} {
		  error "preamble option must be one of \"{} fixed: first:n\""
		}
		if {$pv == "first" &&\
				(![string is integer -strict [lindex $vals 1]] ||\
					 [lindex $vals 1] < 0)} {
		  error "in preamble 'first:n' option 'n' must be a positive integer"
		}
		set options(preambleLn)\
			[expr {$pv == {} ? 0 :\
					   $pv == "first" ? [lindex $vals 1] :\
					   [string length [lindex $vals 1]] }]
	  } elseif {$op == "spacetab"} {
		if {![string is integer -strict $options(spacetab)] ||\
				[font measure $passedInFont -displayof $w\
					 [set spaceCharStr\
						  [string repeat " " $options(spacetab)]]] >=\
				$options(width) / 2} {
		  error "option $op value must be < 1/2 'width' but found $options($op)"
		}
		# Lets calculate where a spaceChar string needs to end to be considered
		# such.
		# ??
	  } elseif {$op in {"keeplong" "returnLn"} &&\
					![string is boolean -strict $options($op)]} {
		error "option $op: expected boolean but got $options($op)"
	  }
	}
		
	lassign {} lineInfo charStop lines
	###########
	# set options(keeplong) 1
	# Lets do the deed
	
	frputs startHere
	foreach line [split $theString \n] {
	  set lineLn [string length $line]
	  set info {}
	  set char {}
	  set startHere $options(preambleLn)
	  
	  # frputs line ts startHere
	  while {1} {
		if {$options(spacetab) > 1 &&\
				$info == {} &&\
				[set ts [string first $spaceCharStr $line $startHere]] != -1 &&\
				[escAdj [string range $line 0 \
							 [set ts [stringNextNot " " $line $ts]]]] <\
				$options(width) / 2} {
		  incr ts -1
		} elseif {[set ts [string first "\t" $line $startHere]] == -1} {
		  frputs ts startHere line
		  set ts $lineLn
		}
		frputs ts startHere line
		# frputs YES ts line
		# 'info' is the pixal distance from the end of the line sofar
		#        to the next tab
		lappend info [font measure\
						  $passedInFont\
						  -displayof $w\
						  "[string range $line\
                            $startHere-$options(preambleLn) $ts-1]  "]
		#
		# frputs info line ts ">[string range $line $startHere $ts-1]< "
		if {$ts == $lineLn} {break}
		lappend char $ts
		set startHere $ts
		incr startHere
	  }
	  if {$startHere != $options(preambleLn)} {
		lappend lines $line
		lappend lineInfo $info
		lappend charStop $char
		# continue until we find a tab free line
		continue
	  } else {
		# A line with no tab. We use a private function here as we also need
		# do this when the 'foreach line' finishes
	    # frputs line lines newLine
		processTheLines
		widthLimit $line 0 0 0
	    # frputs line lines newLine
	  }
	}
	processTheLines
	# frputs line lines newLine
	#frputs newLine
	if {$options(returnLn)} {
	  return [list [string range $newLine 0 end-1] $returnLength]
	}	  
	return [string range $newLine 0 end-1]
  }


  proc processTheLines {} {
	variable minTab
	variable charStop
	variable lines
	variable lineInfo
	variable newLine
	variable fixFont
	variable spaceChars
	variable spaceCharIndex
	variable passedInFont
	variable w
	variable options
	#********** debug
	variable stops
	# we have the lines and information on where the stops are...
	array unset stops
	# lineInfo is a list of pixal lengths of each chunk of the
	# line (i.e. to the next stop)

	# Here we find the longest length for each tab stop in the group of lines
	# This is saved in the 'stops' array (all these numbers are in pixals)
	foreach lineinfo $lineInfo {
	  set stopNo -1
	  foreach tab $lineinfo {
		incr stopNo
		if {![info exists stops($stopNo)]} {
		  set stops($stopNo) 0
		}
		set stops($stopNo) [expr {max($stops($stopNo) , $tab)}]
	  }
	}
	set stops(-1) $minTab
	# frputs STOPS "[array get stops] "
	# Here we reconstruct the lines. There are two possibilities

	# lineInfo is a list of pixal locations of the tabs in the line
	# charStop is the character location of the tab

	foreach line $lines info $lineInfo char $charStop {
	  set end [string length $line]
	  set this 0
	  set tmpLine {}
	  set cumStop 0
	  set tabIndex -1
	  foreach tab $info stop $char {
		incr tabIndex
		# frputs tab stop tabIndex stops($tabIndex) lineInfo line
		
		# If no data left, we are done (we do one more 'info' than 'stop'
		# which allows us to see the end of lines without the full set
		# of tab stops. We don't want an additional stop so we can
		# do the special multi line thing with the part of the line
		# after the last stop.
		
		if {$this >= $end || $stop == {}} {frputs; break}
		set endOfLine [string length $tmpLine]
		append tmpLine [string range $line $this $stop-1]
		
		append tmpLine [spaceOf [expr {$stops($tabIndex) - $tab + $minTab}]]
		set this $stop
		# frputs this stop tab tmpLine stops(tabIndex)
		incr this
		incr cumStop $stops($tabIndex)
	  }
	  #if {$this < $end} {
		set endOfLine [string length $tmpLine]
		append tmpLine [string range $line $this end]
	  #}
	  # frputs line  tmpLine minTab info char lineInfo charStop
	  # figure the last tab stop in pixals
	  
	  widthLimit $tmpLine $cumStop $tabIndex $endOfLine
	  frputs tabIndex stops($tabIndex) "[array get stops] " info line
	 
	}
	lassign {} lineInfo lines charStop
  }

  # spaceOf returns a string of white space 'pixals' long
  # 1) it is a fixed font allowing us to use spaces and
  # 2) the font is not fixed leading us to find and use variable width spaces

  proc spaceOf {pixals} {
	variable font
	variable passedInFont
	variable w
	variable fixFont
	variable fixSpace
	variable spaceChars
	variable spaceCharIndex
	
	# if this is a new proportional font collect space data
	#
	if {![info exists font] || $font != $passedInFont || 1} {
	  if {![set fixFont [font metrics $passedInFont -displayof $w -fixed]]} {
		unset -nocomplain spaceChars spaceCharIndex
		foreach ch {
		  \u2000 \u2001 \u2002 \u2003 \u2004 \u2005
		  \u2006 \u2007 \u2008 \u2009 \u200a \u0020} {
		  if {[set sz [font measure $passedInFont -displayof $w $ch]] !=0} {
			lappend ar $sz  $ch
		  }
		}
		set ar [lsort -stride 2 -decreasing -unique -integer $ar]
		array set spaceChars $ar
		# frputs ar
		foreach {indx char} $ar {
		  lappend spaceCharIndex $indx
		  # frputs indx
		}
	  } else {
		set fixSpace [font measure $passedInFont -displayof $w " " ]
	  }
	  set font $passedInFont
	}
	set tmpLine {}
	if {$fixFont} {
	  set tmpLine [string repeat " " [expr {$pixals / $fixSpace}]]
	} else {
	  # proportional font
	  set idx [lassign [fillKnapsack $pixals $spaceCharIndex] q]
	  set which -1
	  foreach num $idx {
		incr which
		if {$num == 0} {continue}
		set key [lindex $spaceCharIndex $which]
		append tmpLine [string repeat $spaceChars($key) $num]
	  }
	}
	return $tmpLine
  }

  # we test and adjust the line length. If a new line is needed it should
  # state 'stop' pixals in. tabNo is used only if there is a prefix.
  # It indicates how many tab stops the continuation needs to be
  # adjusted for.

  # Since ESC sequences do not, usually, take space, we remove them from
  # the count. Here we define an escape sequence as a sequence that
  # starts with ESC (\u001b) and ends with an upper or lower case letter.

  proc escAdj {string} {
	variable passedInFont
	variable w
	if {[string first \u001b $string] != -1} {
	  set string [regsub -all -nocase {\u001b[^a-z]*[a-z]} $string {}]
	}
	return [font measure $passedInFont -displayof $w $string]
  }

  # Each line is processed here to make sure it fits in the given width.
  # We have two options is the line is too long. First we word wrap as follows,
  # break the line at the space nearest but within the given 'width'. Generated
  # new lines are space filled to start at the last tab stop. If this is
  # impossible (i.e. no space found between the tab stop and the width limit)
  # there are two choices (as chosen by keeplong):

  # 1.) If keeplong is false (default) end the line mid word with "⤶" (\u2936)
  #     and start a new line with space fill to the (tabstop-1) "⤷" (\u2937)
  #     followed by the remaining line which is processed by treating this as a
  #     new line (i.e. first word wrap and then this action).
  # 2.) If keeplong is true, try word wrap beyond the width limit and keeping
  #     the result, even if the width is exceeded. I.e. this removes the
  #     restriction on finding a space prior the the width limit.

  # parms: line         the proposed line
  #        stop         the pixal address of the last tab stop
  #        tabNo        index in the 'stops' array of
  #        charAdOfLast character address of last chunck added to line
  
  proc widthLimit {line stop {tabNo -1} charAdOfLast} {
	variable passedInFont
	variable w
	variable newLine
	variable returnLength
	variable options
	variable minTab	
	
	set lnBreak [string index $options(continue) 0]
	set lnContu [string index $options(continue) 1]
	set tmpLine  {}
	set overFlow {}
	# here we override the width if it is less than a
	# few chars beyond the last tab stop
	if {$options(width) <\
			[set tmp [escAdj [string range $line 0 $charAdOfLast]"OOOOO"]]} {
	  set options(width) $tmp
	  frputs tmp
	}
	
	while {$line != {} && [incr failsafe1] < 2000} {
	  set lineLn [string length $line]
	  incr lineLn -1
	  set before $lineLn
	  set last $before
	  # frputs failsafe1 line
	  set backup 0
	  set failsafe 0
	  
	  while {[set db [escAdj [string range $line 0 $before]]] >\
				 ($options(width) - $backup) && [incr failsafe] < 20} {
			frputs "[string range $line 0 $before] " options(width) db
		set last $before
		if {$backup == 0} {
		  set before [string last " " $line $before]
		  incr before -1
		  if {$before > $charAdOfLast} {continue}
		  # no space found in last chunk added to the line
		  # if just keep, break out of here
		  if {$options(keeplong)} {
			set before $last
			break
		  }
		  # a line break is desired...
		  # so set the width needed to include the 'line break'
		  set backup [font measure $passedInFont -displayof $w $lnBreak]
		}
		# Now we want to just drop chars till the line fits and has
		# room for the line break
		set before $last
		incr before -1
	  }
	  if {$failsafe > 199} {error "$failsafe failsafe $lineLn $before"}
	  # frputs APPEND failsafe last before line
	  
	  append newLine [string range $line 0 $before]
	  if {$backup != 0} {
		append newLine $lnBreak
		set line [string replace $line $before $before $lnContu]
		# Refresh our notion of pixal length
		set db [escAdj [string range $line 0 $before]]
		incr before -2
	  # frputs line before lnContu
	  }
	  append newLine \n
	  set returnLength [expr {max($db, $returnLength)}]
	  if {$before == $lineLn} {break}
	  # get tab to last stop
	  # first get requested preamble
	  set pre {}
	  lassign [split $options(preamble) :] type val
	  if {$type == "first"} {
		set pre [string range $line 0 $val-1]
	  } elseif {$type == "fixed"} {
		set pre $val
	  }
	  set prePix [font measure $passedInFont -displayof $w $pre]
	  frputs pre options(width) 
	  set remains [string range $line $before+2 end]
	  set line $pre
	  append line [spaceOf [expr {$stop - $prePix}]] $remains
	    frputs line stop remains 
	}
	# puts "$newLine"
  }


  #  <20220710.1848.16>
  #
  # The 'knapsack' problem, here restated and simplified to help solve the
  # 'tab' problem where we want to know how many of each width space
  # characters it takes move to the tab stop. (See frtab to see how this
  # is used in fr.)
  
  # The call:
  #
  # fillKnapsack S I
  #
  # where 'S' is the knapsack size and 'I' is a list of available sizes ofs
  # item this is the "unbounded knapsack" (UB-KS), i.e. we may use as many
  # of each of the sizes as we like. What we want to do is to exactly fill
  # the knapsack. This may not be possible, in which case we want it as
  # close to full as possible.
  
  # This is a special case of the UB-KS.
  #
  # For best fill (i.e. where we use as many of the largest sizes rather
  # than more of smaller sizes) list 'I' should be sorted with the largest
  # entries first.
  
  # We return a list the first element of which is free space left in the
  #  knapsack(zero is best) followed by a list of how many of elements of 'I'
  # to use for each entry in the 'I' list. I.e use [lindex $rtn n] of
  # [lindex $I n-1]
  #
  # We will use recursion here mostly because it is easy to understand...

  proc fillKnapsack {S I} {
    
	set nextI [lassign $I size]
	set result  [expr {$S / $size}]
	set curQual [expr {$S % $size}]
	set best $curQual
	set bestR [lreplace $result -1 -1 $curQual]

	while {$nextI != {} && $best >0 && $result > -1} {
	  set pos [lassign  [fillKnapsack $curQual $nextI] quality]
	  set sofar [lreplace [concat $result $pos] -1 -1 $quality]
	  if {$quality < $best} {
		set best $quality
		set bestR $sofar
	  }
	  incr curQual $size
	  incr result -1
	}
	# frputs bestR
	return $bestR
	
  }
  # 
  namespace export ElasticTabStops fillKnapsack
}

namespace import elasticTabStops::ElasticTabStops elasticTabStops::fillKnapsack
