You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
400 lines
13 KiB
Plaintext
400 lines
13 KiB
Plaintext
#
|
|
# Messagebox
|
|
# ----------------------------------------------------------------------
|
|
# Implements an information messages area widget with scrollbars.
|
|
# Message types can be user defined and configured. Their options
|
|
# include foreground, background, font, bell, and their display
|
|
# mode of on or off. This allows message types to defined as needed,
|
|
# removed when no longer so, and modified when necessary. An export
|
|
# method is provided for file I/O.
|
|
#
|
|
# The number of lines that can be displayed may be limited with
|
|
# the default being 1000. When this limit is reached, the oldest line
|
|
# is removed. There is also support for saving the contents to a
|
|
# file, using a file selection dialog.
|
|
# ----------------------------------------------------------------------
|
|
#
|
|
# History:
|
|
# 01/16/97 - Alfredo Jahn Renamed from InfoMsgBox to MessageBox
|
|
# Initial release...
|
|
# 01/20/97 - Alfredo Jahn Add a popup window so that 3rd mouse
|
|
# button can be used to configure/access the message area.
|
|
# New methods added: _post and _toggleDebug.
|
|
# 01/30/97 - Alfredo Jahn Add -filename option
|
|
# 05/11/97 - Mark Ulferts Added the ability to define and configure
|
|
# new types. Changed print method to be issue.
|
|
# 09/05/97 - John Tucker Added export method.
|
|
#
|
|
# ----------------------------------------------------------------------
|
|
# AUTHOR: Alfredo Jahn V EMAIL: ajahn@spd.dsccc.com
|
|
# Mark L. Ulferts mulferts@austin.dsccc.com
|
|
#
|
|
# @(#) $Id: messagebox.itk,v 1.6 2002/03/19 19:48:57 mgbacke Exp $
|
|
# ----------------------------------------------------------------------
|
|
# Copyright (c) 1997 DSC Technologies Corporation
|
|
# ======================================================================
|
|
# Permission to use, copy, modify, distribute and license this software
|
|
# and its documentation for any purpose, and without fee or written
|
|
# agreement with DSC, is hereby granted, provided that the above copyright
|
|
# notice appears in all copies and that both the copyright notice and
|
|
# warranty disclaimer below appear in supporting documentation, and that
|
|
# the names of DSC Technologies Corporation or DSC Communications
|
|
# Corporation not be used in advertising or publicity pertaining to the
|
|
# software without specific, written prior permission.
|
|
#
|
|
# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
|
|
# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
|
|
# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
|
|
# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE,
|
|
# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL
|
|
# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
|
|
# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
|
|
# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
|
|
# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
|
|
# SOFTWARE.
|
|
# ======================================================================
|
|
|
|
#
|
|
# Usual options.
|
|
#
|
|
itk::usual Messagebox {
|
|
keep -activebackground -activeforeground -background -borderwidth \
|
|
-cursor -highlightcolor -highlightthickness \
|
|
-jump -labelfont -textbackground -troughcolor
|
|
}
|
|
|
|
# ------------------------------------------------------------------
|
|
# MSGTYPE
|
|
# ------------------------------------------------------------------
|
|
|
|
itcl::class iwidgets::MsgType {
|
|
constructor {args} {eval configure $args}
|
|
|
|
public variable background \#d9d9d9
|
|
public variable bell 0
|
|
public variable font -*-Courier-Medium-R-Normal--*-120-*-*-*-*-*-*
|
|
public variable foreground Black
|
|
public variable show 1
|
|
}
|
|
|
|
# ------------------------------------------------------------------
|
|
# MESSAGEBOX
|
|
# ------------------------------------------------------------------
|
|
itcl::class iwidgets::Messagebox {
|
|
inherit itk::Widget
|
|
|
|
constructor {args} {}
|
|
destructor {}
|
|
|
|
itk_option define -filename fileName FileName ""
|
|
itk_option define -maxlines maxLines MaxLines 1000
|
|
itk_option define -savedir saveDir SaveDir "[pwd]"
|
|
|
|
public {
|
|
method clear {}
|
|
method export {filename}
|
|
method find {}
|
|
method issue {string {type DEFAULT} args}
|
|
method save {}
|
|
method type {op tag args}
|
|
}
|
|
|
|
protected {
|
|
variable _unique 0
|
|
variable _types {}
|
|
variable _interior {}
|
|
|
|
method _post {x y}
|
|
}
|
|
}
|
|
|
|
#
|
|
# Provide a lowercased access method for the Messagebox class.
|
|
#
|
|
proc ::iwidgets::messagebox {pathName args} {
|
|
uplevel ::iwidgets::Messagebox $pathName $args
|
|
}
|
|
|
|
#
|
|
# Use option database to override default resources of base classes.
|
|
#
|
|
option add *Messagebox.labelPos n widgetDefault
|
|
option add *Messagebox.cursor top_left_arrow widgetDefault
|
|
option add *Messagebox.height 0 widgetDefault
|
|
option add *Messagebox.width 0 widgetDefault
|
|
option add *Messagebox.visibleItems 80x24 widgetDefault
|
|
|
|
# ------------------------------------------------------------------
|
|
# CONSTRUCTOR
|
|
# ------------------------------------------------------------------
|
|
itcl::body iwidgets::Messagebox::constructor {args} {
|
|
set _interior $itk_interior
|
|
|
|
#
|
|
# Create the text area.
|
|
#
|
|
itk_component add text {
|
|
iwidgets::Scrolledtext $itk_interior.text -width 1 -height 1 \
|
|
-state disabled -wrap none
|
|
} {
|
|
keep -borderwidth -cursor -exportselection -highlightcolor \
|
|
-highlightthickness -padx -pady -relief -setgrid -spacing1 \
|
|
-spacing2 -spacing3
|
|
|
|
keep -activerelief -elementborderwidth -jump -troughcolor
|
|
|
|
keep -hscrollmode -height -sbwidth -scrollmargin -textbackground \
|
|
-visibleitems -vscrollmode -width
|
|
|
|
keep -labelbitmap -labelfont -labelimage -labelmargin \
|
|
-labelpos -labeltext -labelvariable
|
|
}
|
|
grid $itk_component(text) -row 0 -column 0 -sticky nsew
|
|
grid rowconfigure $_interior 0 -weight 1
|
|
grid columnconfigure $_interior 0 -weight 1
|
|
|
|
#
|
|
# Setup right mouse button binding to post a user configurable
|
|
# popup menu and diable the binding for left mouse clicks.
|
|
#
|
|
bind [$itk_component(text) component text] <ButtonPress-1> "break"
|
|
bind [$itk_component(text) component text] \
|
|
<ButtonPress-3> [itcl::code $this _post %x %y]
|
|
|
|
#
|
|
# Create the small popup menu that can be configurable by users.
|
|
#
|
|
itk_component add itemMenu {
|
|
menu $itk_component(hull).itemmenu -tearoff 0
|
|
} {
|
|
keep -background -font -foreground \
|
|
-activebackground -activeforeground
|
|
ignore -tearoff
|
|
}
|
|
|
|
#
|
|
# Add clear and svae options to the popup menu.
|
|
#
|
|
$itk_component(itemMenu) add command -label "Find" \
|
|
-command [itcl::code $this find]
|
|
$itk_component(itemMenu) add command -label "Save" \
|
|
-command [itcl::code $this save]
|
|
$itk_component(itemMenu) add command -label "Clear" \
|
|
-command [itcl::code $this clear]
|
|
|
|
#
|
|
# Create a standard type to be used if no others are specified.
|
|
#
|
|
type add DEFAULT
|
|
|
|
eval itk_initialize $args
|
|
}
|
|
|
|
# ------------------------------------------------------------------
|
|
# DESTURCTOR
|
|
# ------------------------------------------------------------------
|
|
itcl::body iwidgets::Messagebox::destructor {} {
|
|
foreach type $_types {
|
|
type remove $type
|
|
}
|
|
}
|
|
|
|
# ------------------------------------------------------------------
|
|
# METHODS
|
|
# ------------------------------------------------------------------
|
|
|
|
# ------------------------------------------------------------------
|
|
# METHOD clear
|
|
#
|
|
# Clear the text area.
|
|
# ------------------------------------------------------------------
|
|
itcl::body iwidgets::Messagebox::clear {} {
|
|
$itk_component(text) configure -state normal
|
|
|
|
$itk_component(text) delete 1.0 end
|
|
|
|
$itk_component(text) configure -state disabled
|
|
}
|
|
|
|
# ------------------------------------------------------------------
|
|
# PUBLIC METHOD: type <op> <tag> <args>
|
|
#
|
|
# The type method supports several subcommands. Types can be added
|
|
# removed and configured. All the subcommands use the MsgType class
|
|
# to implement the functionaility.
|
|
# ------------------------------------------------------------------
|
|
itcl::body iwidgets::Messagebox::type {op tag args} {
|
|
switch $op {
|
|
add {
|
|
eval iwidgets::MsgType $this$tag $args
|
|
|
|
lappend _types $tag
|
|
|
|
$itk_component(text) tag configure $tag \
|
|
-font [$this$tag cget -font] \
|
|
-background [$this$tag cget -background] \
|
|
-foreground [$this$tag cget -foreground]
|
|
|
|
return $tag
|
|
}
|
|
|
|
remove {
|
|
if {[set index [lsearch $_types $tag]] != -1} {
|
|
itcl::delete object $this$tag
|
|
set _types [lreplace $_types $index $index]
|
|
|
|
return
|
|
} else {
|
|
error "bad message type: \"$tag\", does not exist"
|
|
}
|
|
}
|
|
|
|
configure {
|
|
if {[set index [lsearch $_types $tag]] != -1} {
|
|
set retVal [eval $this$tag configure $args]
|
|
|
|
$itk_component(text) tag configure $tag \
|
|
-font [$this$tag cget -font] \
|
|
-background [$this$tag cget -background] \
|
|
-foreground [$this$tag cget -foreground]
|
|
|
|
return $retVal
|
|
|
|
} else {
|
|
error "bad message type: \"$tag\", does not exist"
|
|
}
|
|
}
|
|
|
|
cget {
|
|
if {[set index [lsearch $_types $tag]] != -1} {
|
|
return [eval $this$tag cget $args]
|
|
} else {
|
|
error "bad message type: \"$tag\", does not exist"
|
|
}
|
|
}
|
|
|
|
default {
|
|
error "bad type operation: \"$op\", should be add,\
|
|
remove, configure or cget"
|
|
}
|
|
}
|
|
}
|
|
|
|
# ------------------------------------------------------------------
|
|
# PUBLIC METHOD: issue string ?type? args
|
|
#
|
|
# Print the string out to the Messagebox. Check the options of the
|
|
# message type to see if it should be displayed or if the bell
|
|
# should be wrong.
|
|
# ------------------------------------------------------------------
|
|
itcl::body iwidgets::Messagebox::issue {string {type DEFAULT} args} {
|
|
if {[lsearch $_types $type] == -1} {
|
|
error "bad message type: \"$type\", use the type\
|
|
command to create a new types"
|
|
}
|
|
|
|
#
|
|
# If the type is currently configured to be displayed, then insert
|
|
# it in the text widget, add the tag to the line and move the
|
|
# vertical scroll bar to the bottom.
|
|
#
|
|
set tag $this$type
|
|
|
|
if {[$tag cget -show]} {
|
|
$itk_component(text) configure -state normal
|
|
|
|
#
|
|
# Find end of last message.
|
|
#
|
|
set prevend [$itk_component(text) index "end - 1 chars"]
|
|
|
|
$itk_component(text) insert end "$string\n" $args
|
|
|
|
$itk_component(text) tag add $type $prevend "end - 1 chars"
|
|
$itk_component(text) yview end
|
|
|
|
#
|
|
# Sound a beep if the message type is configured such.
|
|
#
|
|
if {[$tag cget -bell]} {
|
|
bell
|
|
}
|
|
|
|
#
|
|
# If we reached our max lines limit, then remove enough lines to
|
|
# get it back under.
|
|
#
|
|
set lineCount [lindex [split [$itk_component(text) index end] "."] 0]
|
|
|
|
if { $lineCount > $itk_option(-maxlines) } {
|
|
set numLines [expr {$lineCount - $itk_option(-maxlines) -1}]
|
|
|
|
$itk_component(text) delete 1.0 $numLines.0
|
|
}
|
|
|
|
$itk_component(text) configure -state disabled
|
|
}
|
|
}
|
|
|
|
# ------------------------------------------------------------------
|
|
# PUBLIC METHOD: save
|
|
#
|
|
# Save contents of messages area to a file using a fileselectionbox.
|
|
# ------------------------------------------------------------------
|
|
itcl::body iwidgets::Messagebox::save {} {
|
|
set saveFile ""
|
|
set filter ""
|
|
|
|
set saveFile [tk_getSaveFile -title "Save Messages" \
|
|
-initialdir $itk_option(-savedir) \
|
|
-parent $itk_interior \
|
|
-initialfile $itk_option(-filename)]
|
|
|
|
if { $saveFile != "" } {
|
|
$itk_component(text) export $saveFile
|
|
}
|
|
}
|
|
|
|
# ------------------------------------------------------------------
|
|
# PUBLIC METHOD: find
|
|
#
|
|
# Search the contents of messages area for a specific string.
|
|
# ------------------------------------------------------------------
|
|
itcl::body iwidgets::Messagebox::find {} {
|
|
if {! [info exists itk_component(findd)]} {
|
|
itk_component add findd {
|
|
iwidgets::Finddialog $itk_interior.findd \
|
|
-textwidget $itk_component(text)
|
|
}
|
|
}
|
|
|
|
$itk_component(findd) center $itk_component(text)
|
|
$itk_component(findd) activate
|
|
}
|
|
|
|
# ------------------------------------------------------------------
|
|
# PRIVATE METHOD: _post
|
|
#
|
|
# Used internally to post the popup menu at the coordinate (x,y)
|
|
# relative to the widget.
|
|
# ------------------------------------------------------------------
|
|
itcl::body iwidgets::Messagebox::_post {x y} {
|
|
set rx [expr {[winfo rootx $itk_component(text)]+$x}]
|
|
set ry [expr {[winfo rooty $itk_component(text)]+$y}]
|
|
|
|
tk_popup $itk_component(itemMenu) $rx $ry
|
|
}
|
|
|
|
|
|
# ------------------------------------------------------------------
|
|
# METHOD export filename
|
|
#
|
|
# write text to a file (export filename)
|
|
# ------------------------------------------------------------------
|
|
itcl::body iwidgets::Messagebox::export {filename} {
|
|
|
|
$itk_component(text) export $filename
|
|
|
|
}
|
|
|