diff options
Diffstat (limited to 'iwidgets/generic/messagebox.itk')
| -rw-r--r-- | iwidgets/generic/messagebox.itk | 399 |
1 files changed, 399 insertions, 0 deletions
diff --git a/iwidgets/generic/messagebox.itk b/iwidgets/generic/messagebox.itk new file mode 100644 index 00000000000..40cad1caad9 --- /dev/null +++ b/iwidgets/generic/messagebox.itk @@ -0,0 +1,399 @@ +# +# 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$ +# ---------------------------------------------------------------------- +# 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 + +} + |