summaryrefslogtreecommitdiffstats
path: root/library
diff options
context:
space:
mode:
Diffstat (limited to 'library')
-rw-r--r--library/msgbox.tcl149
-rw-r--r--library/tk.tcl24
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