#
# Globalpref
# ----------------------------------------------------------------------
# Implements Global preferences dialog
#
#   PUBLIC ATTRIBUTES:
#
#   METHODS:
#
#     config ....... used to change public attributes
#
#     PRIVATE METHODS
#
#   X11 OPTION DATABASE ATTRIBUTES
#
#
# ----------------------------------------------------------------------
#   AUTHOR:  Martin M. Hunt	hunt@cygnus.com     
#            Cygnus Solutions   
#


itcl_class Globalpref {
  # ------------------------------------------------------------------
  #  CONSTRUCTOR - create new toolbar preferences dialog
  # ------------------------------------------------------------------
  constructor {args} {
    #
    #  Create a window with the same name as this object
    #
    set attach $args
    set class [$this info class]
    @@rename $this $this-tmp-
    @@frame $this -class $class 
    @@rename $this $this-win-
    @@rename $this-tmp- $this
    build_win
  }

  # ------------------------------------------------------------------
  #  METHOD:  build_win - build the dialog
  # ------------------------------------------------------------------
  method build_win {} {
    global tcl_platform
    if {$attach == 1} {
      set frame $this
    } else {
      frame $this.f
      frame $this.x
      set frame $this.f
    }

    frame $frame.a
    frame $frame.b
    frame $frame.c
    frame $frame.d
    
    # Image directory
    set f $frame.a
    set file [pref get gdb ImageDir]
    label $f.lab -text "Images: " -anchor e
    entry $f.ent -width 40 
    $f.ent insert 0 $file
    bind $f.ent <Return> "$this update_file $f.ent"
    button $f.but -command "$this get_file" \
      -image [image create photo -file [@@file join [pref get gdb ImageDir] open.gif]]
    pack $f.lab $f.ent $f.but -side left -pady 10
    
    # save window configuration
    set f $frame.b
    button $f.winbut -fg red -text "SAVE" -command "manage save"
    label $f.winlab -text "current window configuration"
    pack $f.winbut $f.winlab -side left -pady 10

    # create ComboBox with font name
    set f $frame.d
    tixComboBox $f.fontname -label "Default Font:" -command "$this font_changed"
    $f.fontname config -value [font configure global-font -family]

    # searching for fixed font families take a long time
    # therefore, we cache the font names.  The font cache
    # can be saved in the init file. A way should be provided
    # to rescan the font list, without deleting the entry from the
    # init file.
    set font_cache [pref get global font_cache]
    if {$font_cache == ""} {
      if {$tcl_platform(platform) == "unix"} {
	toplevel .c
	message .c.m -bg red -fg white -width 2i -text "Scanning fonts\nPlease wait..." \
	  -relief flat -padx 30 -pady 30
	@@update
	pack .c.m
	focus .c
	raise .c
	@@update
      }
      set fam [font families]
      foreach fn $fam {
	if {[font metrics [list $fn] -fixed] == 1} {
	  lappend font_cache $fn
	}
      }
      pref set global font_cache $font_cache
      if {$tcl_platform(platform) == "unix"} { destroy .c }
    }

    # load names into combobox
    foreach fn $font_cache {
      $f.fontname insert end $fn
    }

    # create control widget for font size
    tixControl $f.fs -label Size: -integer true -max 18 -min 6
    $f.fs config -value [font configure global-font -size] -command "$this font_changed"
    pack $f.fontname $f.fs -side left -fill both -expand yes

    # create label showing current font
    set font_label $frame.abc
    label $frame.abc -text ABCDEFabcdef0123456789 -font [pref get global font]

    # colors
    set f $frame.c
    label $f.lab -fg navy -text "color requesters will go here..."    
    pack $f.lab -side left -pady 10

    pack $frame.a $frame.d $frame.abc $frame.b $frame.c -side top -fill both -expand yes

    if {$attach != 1} {
      button $this.x.save -text Save -underline 0 -command "pref save $this"
      button $this.x.apply -text Apply -underline 0 -command "pref apply"
      button $this.x.quit -text Quit -underline 0 -command "$this delete"
      pack $this.f
      pack $this.x.save $this.x.apply $this.x.quit -side left -expand yes
      pack $this.x $this -expand yes -fill both
    }
    @@update
  }

  # ------------------------------------------------------------------
  #  DESTRUCTOR - destroy window containing widget
  # ------------------------------------------------------------------
  destructor {
    set top [winfo toplevel $this]
    manage delete $this 1
    destroy $this
    if {$attach != 1} {
      destroy $top
    }
  }

  # ------------------------------------------------------------------
  #  METHOD:  config - used to change public attributes
  # ------------------------------------------------------------------
  method config {config} {}

  # ------------------------------------------------------------------
  #  PRIVATE METHOD:  get_file
  # ------------------------------------------------------------------
  method get_file {} {
    global GDBTK_LIBRARY
    set file [tk_getOpenFile -parent $this -initialdir $GDBTK_LIBRARY]
    pref set gdb ImageDir $file
  }

  # ------------------------------------------------------------------
  #  PRIVATE METHOD:  update_file
  # ------------------------------------------------------------------
  method update_file {win} {
    set file [$win get]
    # need to check this and put up requestor on error
    pref set gdb ImageDir $file
  }

  # ------------------------------------------------------------------
  #  PRIVATE METHOD:  font_changed - callback from font requesters
  # ------------------------------------------------------------------
  method font_changed {val} {
    # val will be a size or a font name
    if [string match {[1-9]*} $val] {
      # size changed
      set oldval [font configure global-font -size]
      font configure global-font -size $val
    } else {
      # font family changed
      set oldval [font configure global-font -family]
      font configure global-font -family $val
    }
    if {$val != $oldval} {
      $font_label configure -font global-font
      # change a named font into a font description
      # make this a procedure someday
      set f [font configure global-font]
      set desc ""
      for {set i 0} {[lindex $f $i] != ""} {incr i 2} {
	switch -- [lindex $f $i] {
	  -family { lappend desc [lindex $f [expr $i + 1]] }
	  -size { lappend desc [lindex $f [expr $i + 1]] }
	  -slant { lappend desc [lindex $f [expr $i + 1]] }
	  -weight { lappend desc [lindex $f [expr $i + 1]] }
	}
      }
      pref set global font $desc
      option add *font $desc
    }
  }

  # ------------------------------------------------------------------
  #  METHOD:  reconfig - used when preferences change
  # ------------------------------------------------------------------
  method reconfig {} {
    # for now, just delete and recreate
    destroy $this.f
    build_win
  }
  #
  #  PROTECTED DATA
  #
  protected attach 0
  protected font_label
}

