# <20220513.1532.23>

# This set of routines is ment to be called to set up a
# search capability for text windows.  It is to be called
# after the text window is created with the window name
# and a title for the tearoff menu which is raised with
# a button <3> mouse click.  In addition to the three
# entries in the menu, the caller can supply pre and post
# entries to be put in the menu.  
# The supplied entries should be in a list
# with a 'label' 'script' pairs.  An empty 'script' 
# i.e. '{}' will generate a 'separator' entry.
#
# textSearch   sets up the <3> menu for
#
#  wtext           the text window name
#  title           the title for the sub menu.This will appear as the
#                  title of the tearoff of this menu. The first word of
#                  this title will also be used to create a namespace
#                  to hold search variables. This means that these can
#                  be shared or not depending on the title first word.
#  config          The name of a list of value pairs to configure the window
#                  these should be -item value pairs (optional)
#                  A -item that ends in "tag" will be used to configure
#                  the tag used to highlight the found search.
#                  If config starts with "+" it indicats a script
#                  that will be executed to get the config list.
#                  This is passed by name so that it can be configured
#                  after the widows are built. If an entry starts with
#                  'values' it tells the search code that there is a
#                  pop-up list of search values. The second part of
#                  the 'value' entry should be a list name. This list
#                  will be added to by search selections. Optionally
#                  if 'values' is specified, you may also specify
#                  'valueCount' which should be an integer and is the
#                  number of entries the 'value' list will be restricted
#                  to. If not specified, 25 is used as a limit.
#  preMenuEntries  a list of menu item pairs {label command} 
#  postMenuEntries a list of menu item pairs {label command}
#                  pre & post entries may also have format:
#                  {label {? command option-pairs}
#                  where an option-pair is "-option value"
#                  This is how to code accelerators, e.g.
#                  (see below for examples)
#                  Any "%w" sequences found in the 'command' part will
#                  be replaced with the name of the main toplevel window.
# EXTERNAL references:
# smart_dialog
# _            (But replaced if not present)


proc textSearch { wtext title {config {}} \
		      {preMenuEntries {}}  {postMenuEntries {}}} {
  set names [regsub -all {\.} $wtext {_}]_Sp
  if {![namespace exists $names]} {
    namespace eval $names {
      variable {}
      # keyChar is the char we put as the first char in the 'value' list
      # Ideally it would just disappear, but in any case it should be
      # rarely used.
      variable keyChar "~"
      #variable keyChar [format %c 16]
      array set {} [list regexp 0 \
			casefold 0 \
			reverse 0 \
			trace 0\
			fromhere 1\
			len 0\
			all 0\
			searchstring {}\
			w   {}\
			config {}\
			valueList {}\
			valueCount 25\
			whereWeStarted 0.0\
			names [string range [namespace current] 2 end]\
		       ]
      proc textSearch {wtext title config preMenuEntries postMenuEntries} {
	variable {}
	# upvar wtext wtext
	# upvar title title
	# upvar config config
	# upvar preMenuEntries preMenuEntries
	# upvar postMenuEntries postMenuEntries
	set (w) $wtext
	set (config) $config
	if {[info procs "_"] == {}} {
	  proc _ {s args} {return [format $s {*}$args]}
	}
	set w [winfo parent $wtext]
	# set tl [regsub {(^\.[^\.]+).*} $wtext {\1}]
	set midMenu \
	    [list \
		 [_ "Search..."] \
		 [list ? "[namespace current]::SearchViewSet [list $config]"\
				      -accelerator C-f]\
		 [_ "Search Again Forward"] \
		 [list ? "[namespace current]::SearchView  1" \
		      -accelerator F3]\
		 [_ "Search Again Backward"]\
		 [list ? "[namespace current]::SearchView  2" \
		      -accelerator Shift-F3]]
	
	bind $wtext <F3>\
	    "[namespace current]::SearchView $wtext [list $config] 1"
	bind $wtext <Shift-F3>\
	    "[namespace current]::SearchView $wtext [list $config] 2"
	bind $wtext <Control-f> \
	    "[namespace current]::SearchViewSet $wtext [list $config] 0"
	menu $wtext.p -tearoffcommand FixTearoff -title "$title" -tearoff 1
	
	foreach {item value} [searchViewGetConfig] {
	  switch -regexp -matchvar subitem $item {
	    {(.*)menu$} {
	      catch "$wtext.p config [lindex $subitem 1] \"$value\""
	    }
	  }
	}
	foreach {label cmd} [concat $preMenuEntries $midMenu $postMenuEntries] {
	  if {$cmd == {} } {
	    $wtext.p add separator
	  } else {
	    set cmd [regsub -all {%w} $cmd $w]
	    if {[lindex $cmd 0] == "?"} {
	      set rm [lassign $cmd x cmd]
	      $wtext.p add command -label $label -command  $cmd {*}$rm
	    } else {
	      $wtext.p add command -label $label -command $cmd
	    }
	  }
	}
	bind $wtext [DarMou <3>]  "tk_popup $wtext.p %X %Y"
	bind $w <Escape> "destroy $w"
	bind $w <Next>   "$wtext yview scroll 1 pages"
	bind $w <Prior>  "$wtext yview scroll -1 pages"
	bind $w <1>      "bind $w \<Next\> \"\" ; bind $w \<Prior\> \"\""
	bind $w <Home>   "$wtext see 0.0"
	bind $w <End>    "$wtext see end"
	bind $w <Alt-Escape> {break}
	#  bind $tl <Destroy> "+destroy .entry_dialog"
	return $w
      }

      proc searchViewGetConfig {} {
	variable {}
	if {$(config) == {} } {return {}}
	if {[string range $(config) 0 0] == "+"} {
	  return [eval [string range $(config) 1 end]]
	} else {
	  return [set $(config)]
	}
      }

      proc savePat {} {
	variable {}
	variable keyChar
	# save the current search string if there is one
	# We only flag exceptions, i.e. casefold or RE (or both)
	if {$(searchstring) != {} && \
		$(valueList) != {} } {
	  switch -exact $(casefold)$(regexp) {
	    00 {set pre {}}
	    01 {set pre ${keyChar}RE$keyChar}
	    10 {set pre ${keyChar}CF$keyChar}
	    11 {set pre ${keyChar}CFRE$keyChar}
	  }
	  set newString [list $pre$(searchstring)]

	  set indx [lsearch -exact [set $(valueList)] $newString]
	  if {$indx != -1} {
	    set $(valueList) \
		[concat $newString [lreplace [set $(valueList)] $indx $indx]]
	  } else {
	    # valueList grows in this case, so limit that
	    set $(valueList) \
		[concat $newString [lrange [set $(valueList)] 0 $(valueCount)-2]]
	  }
	  if {[winfo exists $(w)]} {
	    [winfo parent $(w)].search$(names).0 config -values [set $(valueList)]
	  }
	}
      }
      
      proc killwindow {w op} {
	variable {}
	variable keyChar
	# w is the search control window
	# (w) is the text window being searched
	if {$op == 0} {
	  savePat
	}
	grid forget $w
	destroy $w
	destroy .a$(names)
	traceAddRemove remove
	set (trace) 0
 	    trace remove variable [namespace current]::  write \
	    [list [namespace current]::SearchView 3]
	if {$op == 0} {
	  return
	}
	# This is a cancel, remove all tags and put window back to
	# where we started.
	$(w) mark set insert $(whereWeStarted)
	$(w) tag remove select 0.0 end
	$(w) yview $(whereWeStarted)
	
      }
      proc traceAddRemove {add} {
	variable {}
	if {$(trace)} {
	  trace $add variable [namespace current]:: write \
	      [list [namespace current]::SearchView 3]
	}
      }

      proc SearchViewSet { args} {
	variable {}
	set wp [winfo parent $(w)]
	set tw "$wp.search$(names)"
	# frputs (w) tw names
	if {[info exists tw] && [winfo exists $tw]} {
	  killwindow $tw 0
	  return
	}
	foreach {op val} [list regexp 0 \
			      casefold 0 \
			      reverse 0 \
			      trace 0\
			      fromhere 1\
			      inSmartDialog 0\
			      comboSelect 0\
			      len 0\
			      all 0\
			      pconfig {}\
			      searchstring {}] {
	  set ($op) $val
	}
	
	destroy .a$(names)
	set tag select
	# frputs (w) args
	$(w) tag config $tag -background [$(w) cget -selectbackground]
	$(w) tag config $tag -foreground [$(w) cget -selectforeground]
	
	set (valueList) {}
	# frputs "[searchViewGetConfig] "
	foreach {item value} [searchViewGetConfig] {
	  switch -regexp -matchvar subitem $item {
	    {(.*)tag$} {
	      $(w) tag config $tag [lindex $subitem 1] $value
	      #	puts "$w  [lindex $subitem 1] $value"
	    }
	    {^values.*} {set (valueList) $value}
	    {^valueC.*} {set (valueCount) $value}
	    default { lappend (pconfig) $item $value}
	  }
	}
	# frputs 
	# set 'whereWeStarted' to current top of window
	$(w) mark set insert @0,0
	set (whereWeStarted) [$(w) index insert]
	set font [$(w) cget -font]
	
	# set wp [winfo parent $(w)]
	# frputs (valueList) font
	
	# set tw "$wp.search$(names)"
	set r [smart_dialog $tw $(w) [_ "Search..."]\
		   [list {}]\
		   -1 10 \
		   [list \
			[list [_ "Text to search for:"] \
			     [list \
				  {*}[expr {$(valueList) == {} ? {} :\
						[list\
						     -values "[set $(valueList)]"]}]\
				  -textvariable [namespace current]::(searchstring)]]\
			[list "<" [list -command\
				       [list [namespace current]::SearchView 2 $tw.1]]]\
			[list [_ "all"] [list -variable \
					     [namespace current]::(all)]]\
			[list [_ "reg\nexp"] [list -variable  \
						  [namespace current]::(regexp)]]\
			[list [_ "case\nfold"] [list -variable  \
						    [namespace current]::(casefold)]]\
			[list [_ "reverse"] [list -variable\
						 [namespace current]::(reverse)]]\
			[list [_ "from\nhere"] [list -variable\
						    [namespace current]::(fromhere)]]\
			[list [_ OK] \
			     [list -command\
				  [list [namespace current]::killwindow \
				       $tw  0]]]\
			[list [_ Cancel]\
			     [list -command\
				  [list [namespace current]::killwindow \
				       $tw 1]]]\
			[list ">" [list -command\
				       [list [namespace current]::SearchView 1 $tw.9]]]]\
		   $(pconfig) ]
	# frputs tw
	grid $tw -row 0 -sticky ew -column 0 -columnspan 10
	set (tw) $tw
	# A bit of magic
	[ttk::combobox::PopdownWindow $tw.0].f.l config -font $font
	bind [winfo toplevel $(w)] <<ComboboxSelected>>\
	    {incr [namespace current]::(comboSelect)}


	# frputs {BEFORE MMMMMMMMMMMMMMMMM }
	# frputs {HERE I SMMMMMMMMMMMMMMMMMMM }
	set (trace) 1
	traceAddRemove add
	return
      }
      proc SearchView {again args} {
	variable keyChar
	variable {}
	if {![info exists (tw)] || ![winfo exists $(tw)]} {return}
	if {[info exists (inSmartDialog)] && $(inSmartDialog)} {
	  if {[winfo exists [lindex $args 0]]} {
	    [lindex $args 0] flash
	  }
	  return
	}
	traceAddRemove remove
	destroy .a$(names)
	set tag select
	switch $again {
	  2 {
	    set reverse "backwards"
	    if {[$(w) compare insert <= 1.0]} {
	      $(w) mark set insert end
	      #frputs "[$(w) index insert] "
	    }
	    savePat
	    if {$(all)} {
	      if {[set next [$(w) tag prevrange $tag insert]] == {}} {
		donf 1.0
	      } else {

		$(w) mark set insert [lindex $next 0]
		$(w) see insert
	      }
	      traceAddRemove add
	      return
	    }
	  }
	  3 {
	    # We get here when ever any thing in our namespace array {}
	    # changes. If we have a searchstring with a key char as the
	    # first char we assume it is one we set up with "re cf" flags
	    
	    realWaitForIdle
	    #set (comboSelect) 0
	    # frputs (comboSelect) args (searchstring)
	    if {[lindex $args 1] == "comboSelect" } {
	      # frputs 
	      switch -glob -- $(searchstring)\
		${keyChar}CFRE$keyChar* {
		  set (casefold) [set (regexp) 1]
		  set first 6
		}\
		${keyChar}CF$keyChar* {
		  set (casefold) 1
		  set first 4
		}\
		${keyChar}RE$keyChar* {
		  set (regexp) 1
		  set first 4
		}\
		default {
		  set (casefold) [set (regexp) [set first 0]]
		}
	      set (searchstring) [string range $(searchstring) $first end]
	    }
	    if {$(fromhere) && !$(all)} {
	      # frputs (names) (w)
	      $(w) mark set insert $(whereWeStarted)
	    } else {
	      # frputs
	      $(w) mark set insert 0.0
	    }
	    if {$(searchstring) == {}} {
	      $(w) tag remove $tag 0.0 end
	      $(w) see $(whereWeStarted)
	      traceAddRemove add
	      return
	    }
	    set reverse  [expr {$(reverse) ? "backwards" : "forwards"}]
	  }
	  1 -
	  default {
	    set reverse "forwards"
	    if {[$(w) compare insert == end-1c]} {
	      $(w) mark set insert 0.0
	      # frputs "[$(w) index insert] "
	    }
	    savePat
	    if {$(all)} {
	      if {[set next [$(w) tag nextrange $tag\
				 "[$(w) index insert] +\
                            [lindex $(len) 0] chars"]] == {}} {
		donf end
	      } else {
		$(w) mark set insert [lindex $next 0]
		$(w) see insert
	      }
	      traceAddRemove add
	      return
	    }
	    $(w) mark set insert "[$(w) index insert] + [lindex $(len) 0] chars"
	  }
	}
	# 
	set ops [list {*}[expr {$(regexp) ? "-regexp" :{}}]\
		     {*}[expr {$(casefold) ? "-nocase" : {}}]\
		     {*}[expr {$(all) ? "-all" : {}}]\
		     -$reverse]
	set stopIndex [expr {$reverse == "backwards" ? "1.0" : "end" }]
	# frput ops stopIndex
	$(w) tag remove $tag 0.0 end
	set idx [$(w) search -count  (len) {*}$ops -- \
		     $(searchstring) insert $stopIndex]
	if {$idx == ""} {
	  donf $stopIndex
	} else {
	  foreach id $idx len $(len) {
	    $(w) mark set insert  $id
	    $(w) tag add $tag $id "$id + $len chars"
	    #  puts "$idx $len"
	  }
	  if {[llength $idx] == 1} {
	    $(w) see insert
	  }
	}
	traceAddRemove add
      }
      
      proc donf {wh} {
	variable {}
	$(w) mark set insert $wh
	# smart_dialog waits from time to time. We want to protect
	# our calls to it... see entry to SearchView
	set (inSmartDialog) 1
	smart_dialog .a$(names) $(w) {Info} \
	    [list {} $(searchstring) [_ " not found"]] \
	    0 0 {} $(pconfig)
	set (inSmartDialog) 0
      }

    }
  }
  ${names}::textSearch $wtext $title $config $preMenuEntries $postMenuEntries
}
