From 557bd380adb2d41523c2af7486d2fdcb1fb71363 Mon Sep 17 00:00:00 2001
From: hobbs <hobbs>
Date: Fri, 3 Dec 1999 07:15:02 +0000
Subject: 	* library/msgbox.tcl: added color icons for tk_messageBox on
 Unix 	and Mac when tk_strictMotif isn't set. (Hipp) 	* library/tk.tcl:
 added window bounds checking to ::tk::PlaceWindow

---
 library/msgbox.tcl | 149 +++++++++++++++++++++++++++++++++++++++++++++++++++--
 library/tk.tcl     |  24 +++++++--
 2 files changed, 164 insertions(+), 9 deletions(-)

diff --git a/library/msgbox.tcl b/library/msgbox.tcl
index 1456f1c..09928ee 100644
--- a/library/msgbox.tcl
+++ b/library/msgbox.tcl
@@ -3,7 +3,7 @@
 #	Implements messageboxes for platforms that do not have native
 #	messagebox support.
 #
-# RCS: @(#) $Id: msgbox.tcl,v 1.7 1999/11/24 20:59:06 hobbs Exp $
+# RCS: @(#) $Id: msgbox.tcl,v 1.8 1999/12/03 07:15:02 hobbs Exp $
 #
 # Copyright (c) 1994-1997 Sun Microsystems, Inc.
 #
@@ -11,6 +11,108 @@
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
 
+# Ensure existence of ::tk::dialog namespace
+#
+namespace eval ::tk::dialog {}
+
+image create bitmap ::tk::dialog::b1 -foreground black \
+-data "#define b1_width 32\n#define b1_height 32
+static unsigned char q1_bits[] = {
+   0x00, 0xf8, 0x1f, 0x00, 0x00, 0x07, 0xe0, 0x00, 0xc0, 0x00, 0x00, 0x03,
+   0x20, 0x00, 0x00, 0x04, 0x10, 0x00, 0x00, 0x08, 0x08, 0x00, 0x00, 0x10,
+   0x04, 0x00, 0x00, 0x20, 0x02, 0x00, 0x00, 0x40, 0x02, 0x00, 0x00, 0x40,
+   0x01, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x80,
+   0x01, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x80,
+   0x01, 0x00, 0x00, 0x80, 0x02, 0x00, 0x00, 0x40, 0x02, 0x00, 0x00, 0x40,
+   0x04, 0x00, 0x00, 0x20, 0x08, 0x00, 0x00, 0x10, 0x10, 0x00, 0x00, 0x08,
+   0x60, 0x00, 0x00, 0x04, 0x80, 0x03, 0x80, 0x03, 0x00, 0x0c, 0x78, 0x00,
+   0x00, 0x30, 0x04, 0x00, 0x00, 0x40, 0x04, 0x00, 0x00, 0x40, 0x04, 0x00,
+   0x00, 0x80, 0x04, 0x00, 0x00, 0x00, 0x05, 0x00, 0x00, 0x00, 0x06, 0x00,
+   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};"
+image create bitmap ::tk::dialog::b2 -foreground white \
+-data "#define b2_width 32\n#define b2_height 32
+static unsigned char b2_bits[] = {
+   0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0x1f, 0x00, 0x00, 0xff, 0xff, 0x00,
+   0xc0, 0xff, 0xff, 0x03, 0xe0, 0xff, 0xff, 0x07, 0xf0, 0xff, 0xff, 0x0f,
+   0xf8, 0xff, 0xff, 0x1f, 0xfc, 0xff, 0xff, 0x3f, 0xfc, 0xff, 0xff, 0x3f,
+   0xfe, 0xff, 0xff, 0x7f, 0xfe, 0xff, 0xff, 0x7f, 0xfe, 0xff, 0xff, 0x7f,
+   0xfe, 0xff, 0xff, 0x7f, 0xfe, 0xff, 0xff, 0x7f, 0xfe, 0xff, 0xff, 0x7f,
+   0xfe, 0xff, 0xff, 0x7f, 0xfc, 0xff, 0xff, 0x3f, 0xfc, 0xff, 0xff, 0x3f,
+   0xf8, 0xff, 0xff, 0x1f, 0xf0, 0xff, 0xff, 0x0f, 0xe0, 0xff, 0xff, 0x07,
+   0x80, 0xff, 0xff, 0x03, 0x00, 0xfc, 0x7f, 0x00, 0x00, 0xf0, 0x07, 0x00,
+   0x00, 0xc0, 0x03, 0x00, 0x00, 0x80, 0x03, 0x00, 0x00, 0x80, 0x03, 0x00,
+   0x00, 0x00, 0x03, 0x00, 0x00, 0x00, 0x02, 0x00, 0x00, 0x00, 0x00, 0x00,
+   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};"
+image create bitmap ::tk::dialog::q -foreground blue \
+-data "#define q_width 32\n#define q_height 32
+static unsigned char q_bits[] = {
+   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0x07, 0x00,
+   0x00, 0x10, 0x0f, 0x00, 0x00, 0x18, 0x1e, 0x00, 0x00, 0x38, 0x1e, 0x00,
+   0x00, 0x38, 0x1e, 0x00, 0x00, 0x10, 0x0f, 0x00, 0x00, 0x80, 0x07, 0x00,
+   0x00, 0xc0, 0x01, 0x00, 0x00, 0xc0, 0x00, 0x00, 0x00, 0xc0, 0x00, 0x00,
+   0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0x00, 0x00, 0x00, 0xe0, 0x01, 0x00,
+   0x00, 0xe0, 0x01, 0x00, 0x00, 0xc0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};"
+image create bitmap ::tk::dialog::i -foreground blue \
+-data "#define i_width 32\n#define i_height 32
+static unsigned char i_bits[] = {
+   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+   0x00, 0xe0, 0x01, 0x00, 0x00, 0xf0, 0x03, 0x00, 0x00, 0xf0, 0x03, 0x00,
+   0x00, 0xe0, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+   0x00, 0xf8, 0x03, 0x00, 0x00, 0xf0, 0x03, 0x00, 0x00, 0xe0, 0x03, 0x00,
+   0x00, 0xe0, 0x03, 0x00, 0x00, 0xe0, 0x03, 0x00, 0x00, 0xe0, 0x03, 0x00,
+   0x00, 0xe0, 0x03, 0x00, 0x00, 0xe0, 0x03, 0x00, 0x00, 0xf0, 0x07, 0x00,
+   0x00, 0xf8, 0x0f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};"
+image create bitmap ::tk::dialog::w1 -foreground black \
+-data "#define w1_width 32\n#define w1_height 32
+static unsigned char w1_bits[] = {
+   0x00, 0x80, 0x01, 0x00, 0x00, 0x40, 0x02, 0x00, 0x00, 0x20, 0x04, 0x00,
+   0x00, 0x10, 0x04, 0x00, 0x00, 0x10, 0x08, 0x00, 0x00, 0x08, 0x08, 0x00,
+   0x00, 0x08, 0x10, 0x00, 0x00, 0x04, 0x10, 0x00, 0x00, 0x04, 0x20, 0x00,
+   0x00, 0x02, 0x20, 0x00, 0x00, 0x02, 0x40, 0x00, 0x00, 0x01, 0x40, 0x00,
+   0x00, 0x01, 0x80, 0x00, 0x80, 0x00, 0x80, 0x00, 0x80, 0x00, 0x00, 0x01,
+   0x40, 0x00, 0x00, 0x01, 0x40, 0x00, 0x00, 0x02, 0x20, 0x00, 0x00, 0x02,
+   0x20, 0x00, 0x00, 0x04, 0x10, 0x00, 0x00, 0x04, 0x10, 0x00, 0x00, 0x08,
+   0x08, 0x00, 0x00, 0x08, 0x08, 0x00, 0x00, 0x10, 0x04, 0x00, 0x00, 0x10,
+   0x04, 0x00, 0x00, 0x20, 0x02, 0x00, 0x00, 0x20, 0x01, 0x00, 0x00, 0x40,
+   0x01, 0x00, 0x00, 0x40, 0x01, 0x00, 0x00, 0x40, 0x02, 0x00, 0x00, 0x20,
+   0xfc, 0xff, 0xff, 0x1f, 0x00, 0x00, 0x00, 0x00};"
+image create bitmap ::tk::dialog::w2 -foreground yellow \
+-data "#define w2_width 32\n#define w2_height 32
+static unsigned char w2_bits[] = {
+   0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0xc0, 0x03, 0x00,
+   0x00, 0xe0, 0x03, 0x00, 0x00, 0xe0, 0x07, 0x00, 0x00, 0xf0, 0x07, 0x00,
+   0x00, 0xf0, 0x0f, 0x00, 0x00, 0xf8, 0x0f, 0x00, 0x00, 0xf8, 0x1f, 0x00,
+   0x00, 0xfc, 0x1f, 0x00, 0x00, 0xfc, 0x3f, 0x00, 0x00, 0xfe, 0x3f, 0x00,
+   0x00, 0xfe, 0x7f, 0x00, 0x00, 0xff, 0x7f, 0x00, 0x00, 0xff, 0xff, 0x00,
+   0x80, 0xff, 0xff, 0x00, 0x80, 0xff, 0xff, 0x01, 0xc0, 0xff, 0xff, 0x01,
+   0xc0, 0xff, 0xff, 0x03, 0xe0, 0xff, 0xff, 0x03, 0xe0, 0xff, 0xff, 0x07,
+   0xf0, 0xff, 0xff, 0x07, 0xf0, 0xff, 0xff, 0x0f, 0xf8, 0xff, 0xff, 0x0f,
+   0xf8, 0xff, 0xff, 0x1f, 0xfc, 0xff, 0xff, 0x1f, 0xfe, 0xff, 0xff, 0x3f,
+   0xfe, 0xff, 0xff, 0x3f, 0xfe, 0xff, 0xff, 0x3f, 0xfc, 0xff, 0xff, 0x1f,
+   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};"
+image create bitmap ::tk::dialog::w3 -foreground black \
+-data "#define w3_width 32\n#define w3_height 32
+static unsigned char w3_bits[] = {
+   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+   0x00, 0xc0, 0x03, 0x00, 0x00, 0xe0, 0x07, 0x00, 0x00, 0xe0, 0x07, 0x00,
+   0x00, 0xe0, 0x07, 0x00, 0x00, 0xe0, 0x07, 0x00, 0x00, 0xe0, 0x07, 0x00,
+   0x00, 0xc0, 0x03, 0x00, 0x00, 0xc0, 0x03, 0x00, 0x00, 0xc0, 0x03, 0x00,
+   0x00, 0x80, 0x01, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x80, 0x01, 0x00,
+   0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0xc0, 0x03, 0x00,
+   0x00, 0xc0, 0x03, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00,
+   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};"
 
 # tkMessageBox --
 #
@@ -20,13 +122,16 @@
 #	messagebox support, or if the particular type of messagebox is
 #	not supported natively.
 #
+#	Color icons are used on Unix displays that have a color
+#	depth of 4 or more and $tk_strictMotif is not on.
+#
 #	This procedure is a private procedure shouldn't be called
 #	directly. Call tk_messageBox instead.
 #
 #	See the user documentation for details on what tk_messageBox does.
 #
 proc tkMessageBox {args} {
-    global tkPriv tcl_platform
+    global tkPriv tcl_platform tk_strictMotif
 
     set w tkPrivMsgBox
     upvar #0 $w data
@@ -48,7 +153,7 @@ proc tkMessageBox {args} {
 
     tclParseConfigSpec $w $specs "" $args
 
-    if {[lsearch {info warning error question} $data(-icon)] == -1} {
+    if {[lsearch -exact {info warning error question} $data(-icon)] == -1} {
 	error "bad -icon value \"$data(-icon)\": must be error, info, question, or warning"
     }
     if {[string equal $tcl_platform(platform) "macintosh"]} {
@@ -167,7 +272,43 @@ proc tkMessageBox {args} {
     label $w.msg -justify left -text $data(-message)
     pack $w.msg -in $w.top -side right -expand 1 -fill both -padx 3m -pady 3m
     if {[string compare $data(-icon) ""]} {
-	label $w.bitmap -bitmap $data(-icon)
+	if {[string equal $tcl_platform(platform) "macintosh"] \
+		|| ([winfo depth $w] < 4) || $tk_strictMotif} {
+	    label $w.bitmap -bitmap $data(-icon)
+	} else {
+	    canvas $w.bitmap -width 32 -height 32 -highlightthickness 0
+	    switch $data(-icon) {
+		error {
+		    $w.bitmap create oval 0 0 31 31 -fill red -outline black
+		    $w.bitmap create line 9 9 23 23 -fill white -width 4
+		    $w.bitmap create line 9 23 23 9 -fill white -width 4
+		}
+		info {
+		    $w.bitmap create image 0 0 -anchor nw \
+			    -image ::tk::dialog::b1
+		    $w.bitmap create image 0 0 -anchor nw \
+			    -image ::tk::dialog::b2
+		    $w.bitmap create image 0 0 -anchor nw \
+			    -image ::tk::dialog::i
+		}
+		question {
+		    $w.bitmap create image 0 0 -anchor nw \
+			    -image ::tk::dialog::b1
+		    $w.bitmap create image 0 0 -anchor nw \
+			    -image ::tk::dialog::b2
+		    $w.bitmap create image 0 0 -anchor nw \
+			    -image ::tk::dialog::q
+		}
+		default {
+		    $w.bitmap create image 0 0 -anchor nw \
+			    -image ::tk::dialog::w1
+		    $w.bitmap create image 0 0 -anchor nw \
+			    -image ::tk::dialog::w2
+		    $w.bitmap create image 0 0 -anchor nw \
+			    -image ::tk::dialog::w3
+		}
+	    }
+	}
 	pack $w.bitmap -in $w.top -side left -padx 3m -pady 3m
     }
 
diff --git a/library/tk.tcl b/library/tk.tcl
index e64a98f..dc793e8 100644
--- a/library/tk.tcl
+++ b/library/tk.tcl
@@ -3,7 +3,7 @@
 # Initialization script normally executed in the interpreter for each
 # Tk-based application.  Arranges class bindings for widgets.
 #
-# RCS: @(#) $Id: tk.tcl,v 1.14 1999/11/30 00:02:12 hobbs Exp $
+# RCS: @(#) $Id: tk.tcl,v 1.15 1999/12/03 07:15:02 hobbs Exp $
 #
 # Copyright (c) 1992-1994 The Regents of the University of California.
 # Copyright (c) 1994-1996 Sun Microsystems, Inc.
@@ -45,19 +45,20 @@ namespace eval ::tk {
 # Results:
 #   Returns nothing
 #
-proc ::tk::PlaceWindow {w {placement ""} {anchor ""}} {
+proc ::tk::PlaceWindow {w {place ""} {anchor ""}} {
     wm withdraw $w
     update idletasks
-    if {[string match p* $placement]} {
+    set checkBounds 1
+    if {[string equal -len [string length $place] $place "pointer"]} {
 	## place at POINTER (centered if $anchor == center)
-	if {[string match "c*" $anchor]} {
+	if {[string equal -len [string length $anchor] $anchor "center"]} {
 	    set x [expr {[winfo pointerx $w]-[winfo reqwidth $w]/2}]
 	    set y [expr {[winfo pointery $w]-[winfo reqheight $w]/2}]
 	} else {
 	    set x [winfo pointerx $w]
 	    set y [winfo pointery $w]
 	}
-    } elseif {[string match w* $placement] && \
+    } elseif {[string equal -len [string length $place] $place "widget"] && \
 	    [winfo exists $anchor] && [winfo ismapped $anchor]} {
 	## center about WIDGET $anchor, widget must be mapped
 	set x [expr {[winfo rootx $anchor] + \
@@ -67,6 +68,19 @@ proc ::tk::PlaceWindow {w {placement ""} {anchor ""}} {
     } else {
 	set x [expr {([winfo screenwidth $w]-[winfo reqwidth $w])/2}]
 	set y [expr {([winfo screenheight $w]-[winfo reqheight $w])/2}]
+	set checkBounds 0
+    }
+    if {$checkBounds} {
+	if {$x < 0} {
+	    set x 0
+	} elseif {$x > ([winfo screenwidth $w]-[winfo reqwidth $w])} {
+	    set x [expr {[winfo screenwidth $w]-[winfo reqwidth $w]}]
+	}
+	if {$y < 0} {
+	    set y 0
+	} elseif {$y > ([winfo screenheight $w]-[winfo reqheight $w])} {
+	    set y [expr {[winfo screenheight $w]-[winfo reqheight $w]}]
+	}
     }
     wm geometry $w +$x+$y
     wm deiconify $w
-- 
cgit v0.12