diff options
Diffstat (limited to 'library')
| -rw-r--r-- | library/msgbox.tcl | 149 | ||||
| -rw-r--r-- | 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 |