# jmetawidgets.tcl - compound pseudo-widgets that can be packed
#
######################################################################
# Copyright 1992-1995 by Jay Sekora.  This file may be freely        #
# distributed, modified or unmodified, for any purpose, provided     #
# that this copyright notice is retained verbatim in all copies and  #
# no attempt is made to obscure the authorship of this file.  If you #
# distribute any modified versions, I ask, but do not require, that  #
# you clearly mark any changes you make as such and that you provide #
# your users with instructions for getting the original sources.     #
######################################################################

### TO DO
###   j:buttonbar:button to add a button to the buttonbar
###   make metawidgets create a widget command like real widgets
###   make metawidgets understand `-configure'

######################################################################
# metawidget options:
#
option add *Rule.relief sunken widgetDefault
option add *Rule.width 2 widgetDefault
option add *Rule.height 2 widgetDefault
option add *Rule.borderWidth 1 widgetDefault
option add *Filler.relief flat widgetDefault
option add *Filler.width 10 widgetDefault
option add *Filler.height 10 widgetDefault
#
######################################################################


######################################################################
# j:buttonbar w ?options? - make a buttonbar packed in w
# options are:
#   -default (default none)
#   -padx (default 5)
#   -pady (default 5)
#   -orient (default horizontal)
#   -buttons (default {})
# syntax of button list is {{name key command} ... }
######################################################################

proc j:buttonbar {args} {
  j:parse_args {
    {default "(NONE)"}
    {padx 5}
    {pady 5}
    {orient horizontal}
    buttons
  }

  if {[llength $args] != 1} {
    error [j:ldb misc:badargs {Improper arguments}]
  }
  
  set newframe [lindex $args 0]
  
  if {$orient == "horizontal"} {
    set side right				;# for packing
  } else {
    set side bottom				;# for packing
  }

  frame $newframe
  if {$padx} {
    pack [j:filler $newframe -width $padx] -in $newframe -side left
    pack [j:filler $newframe -width $padx] -in $newframe -side right
  }
  if {$pady} {
    pack [j:filler $newframe -height $pady] -in $newframe -side top
    pack [j:filler $newframe -height $pady] -in $newframe -side bottom
  }
  
  foreach i $buttons {
    set name [lindex $i 0]
    set key [lindex $i 1]
    set command [lindex $i 2]
    
    set text [uplevel 1 [list j:ldb $key]]
    
    set width [expr {[string length $text] + 1}]    
    if {$width < 8} {set width 8}
    
    set button $newframe.$name
    button $button -width $width -text $text -command $command
    set border $newframe.border_$name
    frame $border -relief flat -borderwidth 1
    raise $button
    pack $button -in $border -padx 2 -pady 2
    pack $border -in $newframe -side $side -padx 2
    if [string match $default $name] {
      $border configure -relief sunken
    }
  }
  return $newframe
}

######################################################################
# j:colour_chooser w ?options? - create a metawidget for selecting colors
# options include
#   -label (default "Colour:")
#   -variable (global variable to set - not really optional)
### SHOULD SUPPORT -padx and -pady
######################################################################

proc j:colour_chooser { w args } {
  j:parse_args { {label "Colour:"} {variable j_prefs_colour} }
  
  set label [uplevel 1 [list j:ldb $label]]
  
  set array_or_variable [lindex [split $variable "("] 0]
  
  global $array_or_variable
  
  append $variable {}
  if {[set $variable] == {} } then {set $variable "#a8a8a8"} ;# bisque

  frame $w
  
  label $w.label \
    -anchor e \
    -text $label
  
  button $w.patch \
    -background [set $variable] \
    -activebackground [set $variable] \
    -width 4
  
  button $w.rgb \
    -width 8 \
    -text [j:ldb colour:rgb] \
    -command "
    set $variable \[j:prompt_colour_rgb\]
    $w.patch configure -background \[set $variable\]
  "
  button $w.name \
    -width 8 \
    -text [j:ldb colour:name] \
    -command "
    set $variable \[j:prompt_colour_name\]
    $w.patch configure -background \[set $variable\]
  "
  
  pack [j:filler $w] -in $w -side top -fill x
  pack [j:filler $w] -in $w -side bottom -fill x
  pack [j:filler $w] $w.name [j:filler $w] $w.rgb [j:filler $w] \
     $w.patch [j:filler $w] \
    -in $w -side right
  pack $w.label -side right -expand yes -fill x
  
  return $w
}

proc j:color_chooser \
  [info args j:colour_chooser] \
  [info body j:colour_chooser]

######################################################################
# j:variable_entry w ?options? - labelled entry for global variable
# options include
#   -label (default "Value:")
#   -variable (default value - not really optional)
#   -labelwidth (default 16)
#   -entrywidth (default 40)
#   -labelconfig (default "")
#   -entryconfig (default "")
# labelconfig and entryconfig are lists of additional configuration
#   options to control the appearance of the label and the entry
# BOGUSNESS:  you need to know that the entry is $newframe.e
#   in order to bind to it!
######################################################################

proc j:variable_entry {args} {
  j:parse_args {
    {label {Value:} }
    {variable value }
    {labelwidth {16} }
    {entrywidth {40} }
    {labelconfig {} }
    {entryconfig {} }
  }
  global $variable
  
  set label [uplevel 1 [list j:ldb $label]]
  
  set newframe [lindex $args 0]
  
  frame $newframe
  set l $newframe.l
  set e $newframe.e
  label $l -text $label -width $labelwidth -anchor e
  entry $e -width $entrywidth -textvariable $variable
  
  if {$labelconfig != ""} {
    eval $l configure $labelconfig
  }
  if {$entryconfig != ""} {
    eval $e configure $entryconfig
  }
  pack $l -in $newframe -side left -fill both
  pack $e -in $newframe -side left -fill both
  
  return $newframe
}



