# jmetawidgets.tcl - compound pseudo-widgets that can be packed
#
######################################################################
# Copyright 1992-2001 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
###   ::aq::buttonbar_button to add a button to the buttonbar
###   make metawidgets create a widget command like real widgets
###   make metawidgets understand `-configure'

package provide aq 0.1

# following has side-effect of making sure ::aq namespace is defined
namespace eval ::aq {
  namespace export {[a-z]*}
  catch {
    package require jldb
    # following likely to fail, because done by other libraries too
    namespace import ::jldb::shortcuts::*
  }
}

######################################################################
# 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
#
######################################################################


######################################################################
# ::aq::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 ::aq::buttonbar {args} {
  ::aq::parse_args {
    {default "(NONE)"}
    {padx -1}
    {pady -1}
    {orient horizontal}
    buttons
  }
  
  global AQSYSINFO				;# for padx and pady defaults
  
  if {[llength $args] != 1} {
    error {wrong # args: should be "::aq::buttonbar pathName ?options?"}
  }
  
  set newframe [lindex $args 0]
  
  if {$orient == "horizontal"} {
    set side right				;# for packing
  } else {
    set side bottom				;# for packing
  }
  
  # if padx or pady was not specified, default to 0 on tiny screens, or
  #   5 on normal screens:
  
  if {$padx < 0} {
    if {$AQSYSINFO(tinyscreen)} {
      set padx 0
    } else {
      set pady 5
    }
  }
  
  if {$pady < 0} {
    if {$AQSYSINFO(tinyscreen)} {
      set pady 0
    } else {
      set pady 5
    }
  }
  
  frame $newframe
  if {$padx} {
    pack [::aq::filler $newframe -width $padx] -in $newframe -side left
    pack [::aq::filler $newframe -width $padx] -in $newframe -side right
  }
  if {$pady} {
    pack [::aq::filler $newframe -height $pady] -in $newframe -side top
    pack [::aq::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 = $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
    pack $button -in $newframe -side $side
    if [string match $default $name] {
      $button configure -default active
    } else {
      if {$AQSYSINFO(tinyscreen)} {
        $button configure -default disabled
      } else {
        $button configure -default normal
      }
    }
  }
  return $newframe
}

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

proc ::aq::colour_chooser { w args } {
  ::aq::parse_args {
    {label "Colour:"}
    {variable j_prefs_colour}
  }
  
  set label [uplevel 1 [list = $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 [= colour:rgb] \
    -command "
    set $variable \[::aq::prompt_colour_rgb\]
    $w.patch configure -background \[set $variable\]
  "
  button $w.name \
    -width 8 \
    -text [= colour:name] \
    -command "
    set $variable \[::aq::prompt_colour_name\]
    $w.patch configure -background \[set $variable\]
  "
  
  pack [::aq::filler $w] -in $w -side top -fill x
  pack [::aq::filler $w] -in $w -side bottom -fill x
  pack [::aq::filler $w] \
    $w.name \
    [::aq::filler $w] \
    $w.rgb \
    [::aq::filler $w] \
    $w.patch [::aq::filler $w] \
    -in $w -side right
  pack $w.label -side right -expand yes -fill x
  
  return $w
}

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

######################################################################
# ::aq::variable_entry w ?options? - labelled entry for global variable
# 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 ::aq::variable_entry {args} {
  ::aq::parse_args {
    {label {Value:} }
    {variable value }
    {labelwidth {16} }
    {entrywidth {40} }
    {labelconfig {} }
    {entryconfig {} }
    {history {} }
  }
  global aq_library
  global $variable

  set doing_history ![string match "" $history]

  set label [uplevel 1 [list = $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
  
  if $doing_history {
    ::aq::history_begin $history
    
    update idletasks
    set h [winfo reqheight $newframe]
    set ht [$e cget -highlightthickness]
    set h [expr {$h - ( $ht * 2 ) - 6}]	;# um, derived empirically. :-) ######
    button $newframe.down \
      -width $h -height $h -padx 0 -pady 0 \
      -takefocus 0 \
      -bitmap @$aq_library/bitmaps/down.xbm \
      -command "
      $e delete 0 end
      $e insert end \[::aq::history_down $history\]
      $e xview end
    "
    button $newframe.up \
      -width $h -height $h -padx 0 -pady 0 \
      -takefocus 0 \
      -bitmap @$aq_library/bitmaps/up.xbm \
      -command "
      $e delete 0 end
      $e insert end \[::aq::history_up $history\]
      $e xview end
    "
    pack $newframe.down $newframe.up -side left
  
    bind $e <Up> "
      %W delete 0 end
      %W insert end \[::aq::history_up $history\]
      %W xview end
      catch {break}
    "
    bind $e <Down> "
      %W delete 0 end
      %W insert end \[::aq::history_down $history\]
      %W xview end
      catch {break}
    "
  }
  
  return $newframe
}

