namespace eval cooltk {

  namespace export {[a-z]*}

  # One time, cooltk will be a cool library for Tk. With nice app-framework,
  # but _no_ clunky megawidgets. Currently just a nice skin-switching and some
  # menu logic are inplemented.
  #
  # Add more skin procedures if you like!
  #
  # Procedures in namespace ::cooltk::skin are visible and are called when skin
  # is selected.  cooltk::skinList returns a list with skins.  Set a skin with
  # cooltk::skinSet skinName.  `none' is a special skin, it returns the
  # application's state to the .Xdefaults state.
  #
  # When cooltk becomes more mature, loading sys-wide or user defined skins
  # will become possible. See below.

  # default script to execute before loading new skin.
  # Change this by calling cooltk::skinSetResetCommand resetCommand
  #
  variable skinResetCommand {
    option clear
    option add *Label.anchor			w
    option add *Radiobutton.anchor		w
    option add *Checkbutton.anchor		w
  }
  # these widget attributes of named classes (All=all) are/may be
  # reconfigured in skins.
  variable widgetAttributes
  array set widgetAttributes {
    -activebackground		All
    -activeborderwidth		All
    -activeforeground		All
    -activerelief		All
    -anchor			All
    -background			All
    -borderwidth		All
    -cursor			All
    -disabledforeground		All
    -elementborderwidth		All
    -font			All
    -foreground			All
    -highlightbackground	All
    -highlightcolor		All
    -highlightthickness		All
    -insertbackground		All
    -insertborderwidth		All
    -insertofftime		All
    -insertontime		All
    -insertwidth		All
    -justify			All
    -padx			All
    -pady			All
    -relief			All
    -selectbackground		All
    -selectborderwidth		All
    -selectcolor		All
    -selectforeground		All
    -troughcolor		All
    -width			Scrollbar
  }
  # text tags that may be reconfigured in skins...
  # The names are the tags, the elements are the class.
  # (so *urlForeground goes before *AllForeground)
  variable textTags
  array set textTags {
    title	All
    url		All
    p		All
  }
  # with these attributes: Here `All' means, all tags in textTags may be
  # reconfigured. A (list of) name(s) like `url p' makes reconfigure of
  # that attribute only possible for that tags.
  variable textAttributes
  array set textAttributes {
    -background	All
    -font	All
    -foreground	All
    -justify	All
    -relief	All
    -underline	All
  }
  # these are used by the menuParseAccel procedure
  variable menuModifiers {
    ctrl  Control
    ctl   Control
    ^     Control
    alt   Alt
    m     Meta
    meta  Meta
    shft  Shift
    shift Shift
    ~     Shift
  }
  variable menuKeys {
    esc	  Escape
    enter Return
    tab	  Tab
    bs	  BackSpace
    del	  Delete
    \\	  backslash
    /	  slash
    ,	  comma
    .	  period
  }
}


proc cooltk::skinSetResetCommand {{resetCommand none}} {

  variable skinResetCommand
  
  switch -- $resetCommand {
    none    { return $skinResetCommand }
    default { set skinResetCommand $resetCommand }
  }
}
  

proc cooltk::skinList {} {

  return [lsort -dict [namespace eval skin {info procs}]]

}


# These are the basic options needed.


proc cooltk::skinSet skin {

  variable skinResetCommand

  eval $skinResetCommand
  switch -- $skin {
    none    {}
    default {catch cooltk::skin::$skin}
  }
  skinReconfigure .
}


proc cooltk::skinReconfigure w {

  variable widgetAttributes

  foreach widget [winfo children $w] {
    skinReconfigure $widget
  }
  foreach confList [$w configure] {
    upvar 0 widgetAttributes([lindex $confList 0]) attr
    if {[info exists attr] && ( [string equal $attr All] || [lsearch -exact $attr [winfo class $w]] != -1 )} {
      foreach {item dbase class default cur} $confList break
      set value [option get $w $dbase $class]
      if {[string equal $value {}]} {
        set value $default
      }
      $w configure $item $value
    }
  }
  # configure tags
  switch -- [winfo class $w] {
    Text {
      eval {skinConfigureDefaultTextTags $w} [$w tag names]
    }
  }
}


# skinConfigureDefaultTextTags window ?tag? ...
#
# Description:
#	configures specified tags if present in the resource database
# Returns: nothing
#
proc cooltk::skinConfigureDefaultTextTags {w args} {
  
  variable textTags
  variable textAttributes

  foreach tag $args {
    if {[info exists textTags($tag)]} {
      foreach attr [$w tag configure $tag] {
        upvar 0 textAttributes([lindex $attr 0]) a
        if {[info exists a] && ( [string equal $a All] || [lsearch -exact $a $tag] != -1 )} {
          set Attr [string totitle [string range [lindex $attr 0] 1 end]]
          set value [option get $w $tag$Attr $textTags($tag)$Attr]
          if {[string equal $value {}]} {
            set value [lindex $attr 3]
          }
          $w tag configure $tag [lindex $attr 0] $value
        }
      }
    }
  }
}


namespace eval cooltk::skin {

  proc Default {} {
  set p userDefault
  # look options (change this if you like!)
  option add *foreground		black		$p
  option add *background		rgb:c/c/c	$p
  option add *highlightBackground	rgb:c/c/c	$p
  option add *highlightColor		black		$p
  option add *activeBackground		rgb:d/d/d	$p
  option add *activeForeground		black		$p
  option add *selectForeground		black		$p
  option add *selectBackground		rgb:b/b/b	$p
  option add *disabledForeground	rgb:9/9/9	$p
  option add *troughColor		rgb:b/b/b	$p
  option add *insertBackground		black		$p
  option add *selectColor		rgb:d/3/6	$p

  # Lengths and widths
  option add *insertWidth		2		$p
  option add *insertBorderWidth		0		$p
    
  # Fonts
  option add *Listbox.font		{helvetica 12}	$p

  # I like light backgrounds in editable fields
  option add *Entry.background		rgb:e/e/e	$p
  option add *Listbox.background	rgb:e/e/e	$p
  option add *Text.background		rgb:e/e/e	$p

  # Specific options
  option add *StatusBar.Entry.background	rgb:c/c/c	$p
  option add *StatusBar.Entry.foreground	blue		$p
  option add *StatusBar.Button.padY		0		$p

  # Options within text tags  
  option add *urlForeground			blue		$p
  }


  proc Dark {} {
  set p userDefault
  option add *foreground		white		$p
  option add *background		rgb:3/3/3	$p
  option add *highlightBackground	rgb:3/3/3	$p
  option add *highlightColor		rgb:9/9/9	$p
  option add *activeBackground		rgb:4/4/4	$p
  option add *activeForeground		white		$p
  option add *selectForeground		white		$p
  option add *selectBackground		rgb:5/9/f	$p
  option add *disabledForeground	rgb:a/a/a	$p
  option add *troughColor		rgb:2/2/2	$p
  option add *insertBackground		white		$p
  option add *selectColor		red		$p

  # Lengths and Widths
  option add *insertWidth		2		$p
  option add *insertBorderWidth		0		$p

  # Fonts
  option add *Listbox.font		{helvetica 12}	$p
  
  # backgrounds in editable fields
  option add *Entry.background		rgb:4/4/4	$p
  option add *Listbox.background	rgb:4/4/4	$p
  option add *Text.background		rgb:4/4/4	$p

  # Specific options
  option add *StatusBar.Entry.background	rgb:3/3/3	$p
  option add *StatusBar.Entry.foreground	rgb:5/9/f	$p
  option add *StatusBar.Button.padY		0		$p
  
  # Options within text tags
  option add *urlForeground			rgb:5/9/f	$p
  }
  
  
  proc Pale-pink {} {
  set p userDefault
  option add *foreground		white		$p
  option add *background		rgb:d0/70/f0	$p
  option add *highlightBackground	rgb:d0/70/f0	$p
  option add *highlightColor		white		$p
  option add *activeBackground		rgb:d/7/f	$p
  option add *activeForeground		white		$p
  option add *selectForeground		white		$p
  option add *selectBackground		rgb:d/7/f	$p
  option add *disabledForeground	rgb:7/4/8	$p
  option add *troughColor		rgb:b/6/d	$p
  option add *insertBackground		white		$p
  option add *selectColor		yellow		$p

  # Lengths and Widths
  option add *insertWidth		2	$p
  option add *insertBorderWidth		0	$p
  option add *selectBorderWidth		1	$p
  option add *elementBorderWidth	1	$p
  option add *Scrollbar.borderWidth	1	$p
  option add *Menu.borderWidth		1	$p
  option add *Menu.activeBorderWidth	1	$p
  option add *Entry.borderWidth		1	$p
  option add *Listbox.borderWidth	1	$p
  option add *Text.borderWidth		1	$p
  option add *Button.borderWidth	1	$p
  option add *Radiobutton.borderWidth	1	$p
  option add *Checkbutton.borderWidth	1	$p

  option add *Scrollbar.width		10	$p

  # Fonts
  option add *font		{lucida 12}	widgetDefault
  option add *Text.font		{lucidatypewriter 12}	$p
  
  # fonts for tags (experimental!)
  option add *AllFont		{lucida 12}	$p
  option add *titleFont		{lucida 18}	$p
  
  # backgrounds in editable fields
  option add *Entry.background		rgb:9/5/b	$p
  option add *Listbox.background	rgb:9/5/b	$p
  option add *Text.background		rgb:9/5/b	$p

  # Specific options
  option add *StatusBar.Entry.background	rgb:d/7/f	$p
  option add *StatusBar.Entry.foreground	white		$p
  option add *StatusBar.Entry.font	{lucida 12 italic}	$p
  option add *StatusBar.Button.padY		0		$p
  
  option add *urlForeground			lightskyblue	$p
  
  # Misc for this skin
  option add [winfo class .].Label.anchor		center	
  option add [winfo class .].Label.padY		4	
  option add [winfo class .].Radiobutton.padY	4	
  option add [winfo class .].Checkbutton.padY	4	
  option add *Button.background			rgb:c/c/c	$p
  option add *Button.activeBackground		rgb:d/d/d	$p
  option add *Button.foreground			black		$p
  option add *Button.activeForeground		black		$p
  option add *Button.font		{lucida 12 bold}	$p
  }


  proc Goldenrod {} {
  set p userDefault
  # lighter than goldenrod:
  set c rgb:e8/b0/25
  option add *foreground		white		$p
  option add *background		goldenrod	$p
  option add *highlightBackground	goldenrod	$p
  option add *highlightColor		white		$p
  option add *activeBackground		rgb:9/9/9	$p
  option add *activeForeground		white		$p
  option add *selectBackground		rgb:9/9/9	$p
  option add *selectForeground		white		$p
  option add *disabledForeground	darkgoldenrod	$p
  option add *troughColor		rgb:8/8/8	$p
  option add *insertBackground		white		$p
  option add *selectColor		red		$p
  
  option add *Scrollbar.background	rgb:9/9/9	$p
  option add *Scrollbar.activeBackground	rgb:a/a/a	$p
  option add *Button.background		rgb:9/9/9	$p
  option add *Button.activeBackground	rgb:a/a/a	$p
  option add *Button.disabledForeground	rgb:7/7/7	$p
    
  # Lengths and Widths
  option add *insertWidth		2	$p
  option add *insertBorderWidth		0	$p
  option add *selectBorderWidth		1	$p
  option add *elementBorderWidth	1	$p
  option add *Menu.borderWidth		1	$p
  option add *Menu.activeBorderWidth	1	$p
  option add *Entry.borderWidth		1	$p
  option add *Listbox.borderWidth	1	$p
  option add *Text.borderWidth		1	$p
  option add *Button.borderWidth	1	$p
  option add *Radiobutton.borderWidth	1	$p
  option add *Checkbutton.borderWidth	1	$p
  option add *Scrollbar.borderWidth	1	$p
  
  option add *Scrollbar.width		10	$p

  # Fonts
  option add *font		{helvetica 12}	widgetDefault
  option add *Text.font		{-adobe-courier-medium-r-normal-*-*-120-*}	$p

  # Colors for certain tags.
  option add *urlForeground		blue	$p

  # Nice labels in toplevel
  option add [winfo class .].Label.font	{helvetica 12 {bold italic}}
  option add [winfo class .].Label.anchor	center
  option add [winfo class .].Label.padY	4

  # Background in editable fields
  option add *Listbox.background	$c	$p
  option add *Entry.background		$c	$p
  option add *Text.background		$c	$p
  
  # The statusbar, a frame provided by this cooltk lib.
  option add *StatusBar.borderWidth		2		$p
  option add *StatusBar.relief			ridge		$p
  option add *StatusBar.Entry.borderWidth	0		$p
  option add *StatusBar.Entry.background	goldenrod	$p
  option add *StatusBar.Button.padY		0		$p


  }
  
  # Finally, load user defined skins
  #catch {source ~/.cooltk/skins.tcl}
}



# menuSetLabelAccel menu bindTo
#
# Description:
#	setLabelAccel performs two things: 1. Replace all & in labels
#	to real underlined chars. 2. Bind accellerators to real
#	keys, in window bindTo. This tries to interpret the accel valus.
#	Look in menu::parseAccel, for the very disputable way this is
#	implemented.
#
#	Iterates also in submenus.
#
# Returns:
#	nothing
#
proc cooltk::menuSetLabelAccel {m bindTo} {

  for {set i 0} {$i <= [$m index end]} {incr i} {
    switch [$m type $i] {
      cascade {
        eval $m entryconfig $i [menuLabelUnderline [$m entrycget $i -label]]
        menuSetLabelAccel [$m entrycget $i -menu] $bindTo
      }
      separator -
      tearoff {}
      default {
        eval $m entryconfig $i [menuLabelUnderline [$m entrycget $i -label]]
        set ac [$m entrycget $i -accel]
        if {[string compare $ac {}]} {
          bind $bindTo [menuParseAccel $ac] [list $m invoke $i]
        }
      }
    }
  }
}


# menuLabelUnderline label
#
# Description:
#	Substitutes eventually &-symbols in label, returns
#	a -label <lab> -underline <ul> list. If no & found, returns
#	a -label <label> solely.
# Example:
#	eval .menu add command [menuLabelUnderline {Save &As}]
#
proc cooltk::menuLabelUnderline label {

  if {[regsub & $label {} l]} {
    return [list -label $l -underline [string first & $label]]
  } else {
    return [list -label $label]
  }
}


# menuParseAccel accelerator
#
# Description:
#       Tries to parse a common menu accellerator. Recoqnizes some special
#       keys. Returns a valid binding string. Also supports multiple events,
#       eg <Control-Key-x><Key-s>.
#
# Notes:
#	Could be improved a lot. ;-)
#
proc cooltk::menuParseAccel ac {

  variable menuModifiers
  variable menuKeys
  
  set binding {}
  foreach event [split $ac] {
    set eventFields [split $event +-]
    set key [string map -nocase $menuKeys [lindex $eventFields end]]
    append binding "<"
    foreach mod [lreplace $eventFields end end] {
      append binding [string map $menuModifiers [string tolower $mod]]-
    }
    if {[string length $key] == 1 && ![regexp Shift $binding]} {
      set key [string tolower $key]
    }
    append binding "Key-$key>"
  }
  return $binding
}



# ScrollbarSet row col stick scrollBar offset size
#
# Description: Helper procedure.
#	Use this to grid scrollbars only when they are needed.
#
proc cooltk::ScrollbarSet {row col stick scrollBar offset size} {

  if {$offset != 0 || $size != 1} {
    grid $scrollBar -row $row -column $col -sticky $stick
  }
  $scrollBar set $offset $size
}


# scrollListbox widget args
# 
# Description:
#	Creates a scrolled listbox widget. The scrollbars are only there when
#	needed. The widgetcommand for the real listbox is $w.l
# Returns:
#	the pathName of the frame widget. The listbox is $w.l
#
proc cooltk::scrollListbox {w args} {

  frame $w -class ScrollListbox
  eval {listbox $w.l} $args
  scrollbar $w.y -orient vert -command [list $w.l yview]
  scrollbar $w.x -orient hori -command [list $w.l xview]
  $w.l config -yscrollcommand [list cooltk::ScrollbarSet 0 1 ns $w.y]
  $w.l config -xscrollcommand [list cooltk::ScrollbarSet 1 0 we $w.x]
  grid $w.l -sticky news
  grid rowconfigure $w 0 -weight 1
  grid columnconfigure $w 0 -weight 1
  return $w
}


# scrollText widget args
# 
# Description:
#	Creates a scrolled text widget. The scrollbars are only there when
#	needed. The widgetcommand for the real text is $w.t
# Returns:
#	the pathName of the frame widget. The text is $w.t
#
proc cooltk::scrollText {w args} {

  frame $w -class ScrollText
  eval {text $w.t} $args
  scrollbar $w.y -orient vert -command [list $w.t yview]
  scrollbar $w.x -orient hori -command [list $w.t xview]
  $w.t config -yscrollcommand [list cooltk::ScrollbarSet 0 1 ns $w.y]
  $w.t config -xscrollcommand [list cooltk::ScrollbarSet 1 0 we $w.x]
  grid $w.t -sticky news
  grid rowconfigure $w 0 -weight 1
  grid columnconfigure $w 0 -weight 1
  return $w
}
  

# statusBar widget args
#
# Description:
#	Creates a statusbar widget, consisting of a disabled entry in a
#	frame with class StatusBar. Returns the widgetpath
#
# Options:
#	-button {name text command}
#		packs a button in the right side.
#	-delay ms
#		Indicates how long non-persistent messages will stay visible.
#	
proc cooltk::statusBar {w args} {

  variable statusBar$w
  upvar 0 statusBar$w statusBar

  set statusBar(persistentMessage) {}
  set statusBar(delay) 5000
  set statusBar(display) {}
  
  frame $w -class StatusBar
  foreach {option value} $args {
    switch -- $option {
      -button {
        foreach {name text command} $value break
        pack [button $w.$name -text $text -command $command] -side right
      }
      -delay {
        set statusBar(delay) $value
      }
    }
  }
  pack [entry $w._cooltk_stBar -textvar [namespace current]::statusBar${w}(display) -state disabled] \
       -side left -fill x -expand 1
  
  # arrange cleanup when our beloved widget ceases to exist...
  bind $w._cooltk_stBar <Destroy> [namespace code "
    variable statusBar$w
    if {\[info exists statusBar${w}(afterId)\]} {
      after cancel \${statusBar${w}(afterId)}
    }
    unset statusBar$w
  "]
  return $w
}


# statusMessage w ?options? string
#
# Description:
#	Displays string in statusbar w, for a certain time. Then returns to
#	default message.
# Option: -persistent or -temp (default)
#
proc cooltk::statusMessage {w args} {

  variable statusBar$w
  upvar 0 statusBar$w statusBar

  set opt -temp
  if {[llength $args] > 1} {
    set opt [lindex $args 0]
  }
  set string [lindex $args end]

  # cancel existing...
  if {[info exists statusBar(afterId)]} {
    after cancel $statusBar(afterId)
    unset statusBar(afterId)
  }

  switch -glob -- $opt {
    -temp* {
      set statusBar(afterId) [after $statusBar(delay) [namespace code "
        variable statusBar$w
        set statusBar${w}(display) \${statusBar${w}(persistentMessage)}
        unset statusBar${w}(afterId)
      "]]
    }
    -pers* {
      set statusBar(persistentMessage) $string
    }
  }
  set statusBar(display) $string
}


# center -- (taken from tk.tcl ::tk::PlaceWindow from tk8.3, thanks to J.Hobbs)
#   place a toplevel at a particular position
# Arguments:
#   toplevel	name of toplevel window
#   ?placement?	pointer ?center? ; places $w centered on the pointer
#		widget widgetPath ; centers $w over widget_name
#		defaults to placing toplevel in the middle of the screen
#   ?anchor?	center or widgetPath
# Results:
#   Returns nothing
#
proc cooltk::center {w {place ""} {anchor ""}} {
  wm withdraw $w
  update idletasks
  set checkBounds 1
  if {[string equal -len [string length $place] $place "pointer"]} {
    ## place at POINTER (centered if $anchor == center)
    if {[string equal -len [string length $anchor] $anchor "center"]} {
      set x [expr {[winfo pointerx $w]-[winfo reqwidth $w]/2}]
      set y [expr {[winfo pointery $w]-[winfo reqheight $w]/2}]
    } else {
      set x [winfo pointerx $w]
      set y [winfo pointery $w]
    }
  } elseif {[string equal -len [string length $place] $place "widget"] && \
	[winfo exists $anchor] && [winfo ismapped $anchor]} {
    ## center about WIDGET $anchor, widget must be mapped
    set x [expr {[winfo rootx $anchor] + \
	    ([winfo width $anchor]-[winfo reqwidth $w])/2}]
    set y [expr {[winfo rooty $anchor] + \
	    ([winfo height $anchor]-[winfo reqheight $w])/2}]
  } else {
    set x [expr {([winfo screenwidth $w]-[winfo reqwidth $w])/2}]
    set y [expr {([winfo screenheight $w]-[winfo reqheight $w])/2}]
    set checkBounds 0
  }
  if {$checkBounds} {
    if {$x < 0} {
      set x 0
    } elseif {$x > ([winfo screenwidth $w]-[winfo reqwidth $w])} {
      set x [expr {[winfo screenwidth $w]-[winfo reqwidth $w]}]
    }
    if {$y < 0} {
      set y 0
    } elseif {$y > ([winfo screenheight $w]-[winfo reqheight $w])} {
      set y [expr {[winfo screenheight $w]-[winfo reqheight $w]}]
    }
  }
  wm geometry $w +$x+$y
  wm deiconify $w
}


# seeToplevel window
#
# Description:
#	returns true if toplevel exists, and deiconifies/raises it.
#	Otherwise returns false, and the toplevel can be created by the user.
#
proc cooltk::seeToplevel w {

  if {[winfo exists $w]} {
    if {[regexp iconic|withdrawn [wm state $w]]} {
      wm deiconify $w
    } else {
      raise $w
    }
    return 1
  }
  return 0
}


# homify filename
#
# Description:
# 	a filename helper. expands home directories.
# 
proc cooltk::homify file {

  if {[string equal [file pathtype $file] absolute] &&
      [string match ~* [file rootname $file]]} {
    set f [file split $file]
    return [eval file join [lreplace $f 0 0 [glob [lindex $f 0]]]]
  } else {
    return $file
  }
}


# just for fun...
proc cooltk::wilbertsBirthDay {} {
  foreach {day year} [clock format [clock seconds] -format "%d%m %Y"] break
  return [expr {[string equal "0703" $day] ? $year - 1971 : 0}]
}




# end of cooltk:: namespace