# this code is based upon the code posted by:
# kennykb@dssv01.crd.ge.com (Kevin B. Kenny)
#
# AtFSid: $Header: wmColorIconPixmap.tcl[3.0] Wed Jan 12 16:31:22 1994 garfield@garfield frozen $
#

proc wm_color_iconpixmap {pathName pixmapName} {
  # the icon window name
  set number 0
  foreach counter [winfo children .] {
    if {[string match .xfIconToplevel* $counter]} {
      if {[string range $counter 15 end] > $number} {
        set number [string range $counter 15 end]
      }
    }
  }
  incr number
  set toplevelName .xfIconToplevel$number

  # create the icon window
  toplevel $toplevelName -borderwidth 0
  # create pixmap area
  label $toplevelName.xfpixmap -borderwidth 0 -bitmap $pixmapName
  # create label area
  label $toplevelName.xflabel -borderwidth 0 -text [wm iconname $pathName]
  # show pixmap area
  pack append $toplevelName \
              $toplevelName.xflabel {bottom fill} \
              $toplevelName.xfpixmap {top fill expand}

  # hide the icon window
  wm withdraw $toplevelName
  # update
  update idletask
  # set geometry
  wm geometry $toplevelName [winfo reqwidth $toplevelName]x[winfo reqheight $toplevelName]
  # register the wm stuff
  wm iconwindow $pathName $toplevelName
  # update again
  update
}

# testing
if {0} {
  wm maxsize . 1000 1000
  wm geometry . 100x100
  wm iconname . Testname1
  wm_color_iconpixmap . @demo.TkPixmap/example.gif
  toplevel .t1
  wm maxsize .t1 1000 1000
  wm geometry .t1 100x100
  wm iconname .t1 Testname2
  wm_color_iconpixmap .t1 @demo.TkPixmap/example.gif
  toplevel .t2
  wm maxsize .t2 1000 1000
  wm geometry .t2 100x100
  wm iconname .t2 Testname3
  wm_color_iconpixmap .t2 @demo.TkPixmap/example.gif
}

# eof
