1 files changed, 59 insertions, 0 deletions
diff --git a/itcl/itk/examples/Info.itk b/itcl/itk/examples/Info.itk
new file mode 100644
index 00000000000..c4f86d52ddd
--- /dev/null
+++ b/itcl/itk/examples/Info.itk
@@ -0,0 +1,59 @@
+# ----------------------------------------------------------------------
+#  EXAMPLE: info dialog box (Toplevel widget)
+# ----------------------------------------------------------------------
+#  COURSE:  Object-Oriented Programming with [incr Tcl]
+#  AUTHOR:  Michael J. McLennan, Bell Labs Innovations
+# ======================================================================
+#               Copyright (c) 1996  Lucent Technologies
+# ======================================================================
+
+option add *Info.title "Info" widgetDefault
+
+class Info {
+    inherit itk::Toplevel
+
+    constructor {args} {
+        itk_component add dismiss {
+            button $itk_interior.dismiss -text "Dismiss" \
+                -command "destroy $itk_component(hull)"
+        }
+        pack $itk_component(dismiss) -side bottom -pady 4
+
+        itk_component add separator {
+            frame $itk_interior.sep -height 2 -borderwidth 1 -relief sunken
+        }
+        pack $itk_component(separator) -side bottom -fill x -padx 4
+
+        itk_component add icon {
+            label $itk_interior.icon -bitmap info
+        }
+        pack $itk_component(icon) -side left -padx 8 -pady 8
+
+        itk_component add infoFrame {
+            frame $itk_interior.info
+        }
+        pack $itk_component(infoFrame) -side left -expand yes \
+            -fill both -padx 4 -pady 4
+
+        set itk_interior $itk_component(infoFrame)
+
+        eval itk_initialize $args
+
+        after idle [code $this centerOnScreen]
+    }
+
+    protected method centerOnScreen {} {
+        update idletasks
+        set wd [winfo reqwidth $itk_component(hull)]
+        set ht [winfo reqheight $itk_component(hull)]
+        set x [expr ([winfo screenwidth $itk_component(hull)]-$wd)/2]
+        set y [expr ([winfo screenheight $itk_component(hull)]-$ht)/2]
+        wm geometry $itk_component(hull) +$x+$y
+    }
+}
+
+usual Info {
+    keep -background -cursor -foreground -font
+    keep -activebackground -activeforeground -disabledforeground
+    keep -highlightcolor -highlightthickness
+}