#! /usr/bin/env tclsh

#
# This routine builds the colorList.tcl file.
# It uses the man page "colors.n[.gz]" as the raw
# list of colors to do the build.
#

set e 0
set file /usr/share/man/mann/colors.n.gz
proc echo {args} {
  if {!$::e} {return}
  foreach arg $args {
    set arg {*}$arg
    puts -nonewline "$arg "
  }
  puts ""
}

proc complain {ex args} {
  set x $::e
  set ::e 1
  echo $args
  set ::e $x
  if {$ex} {exit 1}
}

proc BuildPreamble {fid} {
  puts -nonewline $fid {#
# This routine is machine generated from Tk version 8.5.13
# using man file /usr/share/man/mann/colors.n.gz
#
# This code was generated by the script 'buildColorlist.tcl'
#

# The function getColors returns a filtered list of color names
# available on this platform (where run). Each entry looks like:
# {{name} {r g b}} where name is the color name and r, g, and b
# are the red, green, and blue values as returned by 'winfo rgb'.
#
# parameters : single   if true only return names without blanks
#              nodups   remove names that have the same value as others
#              filter   remove names that match 'filter' (glob )
#
# All colors with names containing spaces have alternate names 
# usually formed by capitalizing each word and removing the spaces.
#
# In removing duplicates preference is given to names with out numbers
# in them.
#
# The filter is mainly to settle on a particular spelling of gray (grey).
# Use e.g. {*grey*}
#

proc getColors {{single 0} {nodups 0} {filter {}}} }
   puts $fid "\{"
   puts $fid "    set possibleColors \{"
}

proc BuildPostAmble {fid} {
  puts $fid {
  foreach color $possibleColors {
    if {$single && [llength $color] != 1} {continue}
    if {$filter != {} && [string match -nocase $filter $color]} {continue}
    set r [catch {winfo rgb . $color} out]
    if {$r == 0} {
      lappend clist [list $color $out]
    }
  }
  # puts {>$filter<}
  if {$nodups} {
    # form a list of indexes to eliminate
    set duplist {}
    set point 0
    foreach c $clist {
      set point2 $point
      if {$point in $duplist} {
	incr point
	continue
      }
      foreach cc [lrange $clist $point+1 end] {
	incr point2
	if {[lindex $c 1] == [lindex $cc 1]} {
	  # Favor the first but try to take out the ones with numbers
	  if {[string match {*[0-9]*} [lindex $cc 0]] || $point in $duplist} {
	    lappend duplist $point2
	  } else {
	    lappend duplist $point
	  }
	}
      }
      incr point
    }
    # now have a list of indexes to remove
    # we want to start with the last so the indexes don't move
    foreach indx [lsort -decreasing -integer -unique $duplist] {
      set clist [lreplace $clist $indx $indx]
    }
  }
  return $clist
  }
}

set ol {}

proc buildLine {fid el {fl 0}} {
  if {$::ol == {}} {
    set ::ol "    "
  }
  if {$fl} {
    puts $fid "$::ol\}"
    set ::ol {}
    return
  }
  if {[llength $el] > 1 } {
    set ::ol "$::ol \{$el\}"
  } else {
    set ::ol "$::ol $el"
  }
  if {[string length $::ol] > 57} {
    puts $fid "$::ol"
    set ::ol {}
  }
}

foreach arg $argv {
  switch -glob $arg {
    -db -
    -echo {
      set e 1
    }
    -o=* -
    O=* {
      set ofile [regsub {.*=(.*)} $arg {\1}]
    }
    -help -
    --help {
      complain 0 "This program builds the colorList.tcl file."
      complain 0 "\nbuildColorList.tcl \[-db | -echo] \[-help | --help]\
      \[-o=outfile | O=outfile] \[infile]\n"
      complain 0 "By default echo is off (turn on with -echo or -db)"
      complain 0 "By default output is to stdout (change with O=file)"
      complain 0 "By default input is from $file "
      complain 1 "Get this helpful info with -help or --help"
    }
    default {
      if {[file exists $arg]} {
	set file $arg
      } elseif {[file exists $arg.gz]} {
	set file $arg.gz
      } else {
	complain 1 "$arg is not a file. Don't know what to do with it."
      }
    }
  }
}

if {![file exists $file]} {
  if {[file exists [file rootname $file]]} {
    set file [file rootname $file]
  } else {
    complain 1 "Can not find the needed color man page
	Tried:
        $file
        [file rootname $file]
        bye."
  }
}

if {[string tolower [file extension $file]] == ".gz"} {
  echo "reading $file using gzip"
  set in [exec gzip -dc $file]
} else {
  echo "reading $file using cat"
  set in [exec cat $file]
}
set in [split $in \n]

echo "striping unwanted data from the result"
foreach line $in {
  if {[string is alpha [string range $line 0 0]]} {
    if {[llength $line] < 6} {
      if {![string match *:* $line] && ![string match *,* $line]} {
	# At this point we have only colors.  The list comes in two
	# varities.  Colors with R/G/B values and those without.
	# Those without do NOT have embeded spaces.  Those that do
	# may have embeded spaces.
	if {[llength $line] > 3 && [string is integer [lindex $line end]]} {
	  # it is in the "with" camp
	  lappend ino [lrange $line 0 end-3]
	} else {
	  foreach x $line {
	    lappend ino $x
	  }
	}
      }
    }
  }
}

# Now we have the color array, build the file
if {[info exists ofile]} {
  echo "opening $ofile"
  set r [catch "open $ofile w" out]
  if {$r != 0} {
    complain 1 "Could not open output file $ofile $out"
  }
  set fid $out
} else {
  set fid "stdout"
}
echo "writing the preamble"
BuildPreamble $fid
echo "writing the color name list"
foreach line $ino {
  buildLine $fid $line
}
buildLine $fid {} 1
echo "writing the postamble"
BuildPostAmble $fid

puts $fid "}"
echo "done, no errors found"
# foreach x $ino {
#   complain 0 $x
# }
#complain 1 "end"
