| # |
| # 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 |
| |
| } |
| |
