1# 2# Messagebox 3# ---------------------------------------------------------------------- 4# Implements an information messages area widget with scrollbars. 5# Message types can be user defined and configured. Their options 6# include foreground, background, font, bell, and their display 7# mode of on or off. This allows message types to defined as needed, 8# removed when no longer so, and modified when necessary. An export 9# method is provided for file I/O. 10# 11# The number of lines that can be displayed may be limited with 12# the default being 1000. When this limit is reached, the oldest line 13# is removed. There is also support for saving the contents to a 14# file, using a file selection dialog. 15# ---------------------------------------------------------------------- 16# 17# History: 18# 01/16/97 - Alfredo Jahn Renamed from InfoMsgBox to MessageBox 19# Initial release... 20# 01/20/97 - Alfredo Jahn Add a popup window so that 3rd mouse 21# button can be used to configure/access the message area. 22# New methods added: _post and _toggleDebug. 23# 01/30/97 - Alfredo Jahn Add -filename option 24# 05/11/97 - Mark Ulferts Added the ability to define and configure 25# new types. Changed print method to be issue. 26# 09/05/97 - John Tucker Added export method. 27# 28# ---------------------------------------------------------------------- 29# AUTHOR: Alfredo Jahn V EMAIL: ajahn@spd.dsccc.com 30# Mark L. Ulferts mulferts@austin.dsccc.com 31# 32# @(#) $Id: messagebox.itk,v 1.6 2002/03/19 19:48:57 mgbacke Exp $ 33# ---------------------------------------------------------------------- 34# Copyright (c) 1997 DSC Technologies Corporation 35# ====================================================================== 36# Permission to use, copy, modify, distribute and license this software 37# and its documentation for any purpose, and without fee or written 38# agreement with DSC, is hereby granted, provided that the above copyright 39# notice appears in all copies and that both the copyright notice and 40# warranty disclaimer below appear in supporting documentation, and that 41# the names of DSC Technologies Corporation or DSC Communications 42# Corporation not be used in advertising or publicity pertaining to the 43# software without specific, written prior permission. 44# 45# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING 46# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON- 47# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE 48# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, 49# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL 50# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR 51# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, 52# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION, 53# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS 54# SOFTWARE. 55# ====================================================================== 56 57# 58# Usual options. 59# 60itk::usual Messagebox { 61 keep -activebackground -activeforeground -background -borderwidth \ 62 -cursor -highlightcolor -highlightthickness \ 63 -jump -labelfont -textbackground -troughcolor 64} 65 66# ------------------------------------------------------------------ 67# MSGTYPE 68# ------------------------------------------------------------------ 69 70itcl::class iwidgets::MsgType { 71 constructor {args} {eval configure $args} 72 73 public variable background \#d9d9d9 74 public variable bell 0 75 public variable font -*-Courier-Medium-R-Normal--*-120-*-*-*-*-*-* 76 public variable foreground Black 77 public variable show 1 78} 79 80# ------------------------------------------------------------------ 81# MESSAGEBOX 82# ------------------------------------------------------------------ 83itcl::class iwidgets::Messagebox { 84 inherit itk::Widget 85 86 constructor {args} {} 87 destructor {} 88 89 itk_option define -filename fileName FileName "" 90 itk_option define -maxlines maxLines MaxLines 1000 91 itk_option define -savedir saveDir SaveDir "[pwd]" 92 93 public { 94 method clear {} 95 method export {filename} 96 method find {} 97 method issue {string {type DEFAULT} args} 98 method save {} 99 method type {op tag args} 100 } 101 102 protected { 103 variable _unique 0 104 variable _types {} 105 variable _interior {} 106 107 method _post {x y} 108 } 109} 110 111# 112# Provide a lowercased access method for the Messagebox class. 113# 114proc ::iwidgets::messagebox {pathName args} { 115 uplevel ::iwidgets::Messagebox $pathName $args 116} 117 118# 119# Use option database to override default resources of base classes. 120# 121option add *Messagebox.labelPos n widgetDefault 122option add *Messagebox.cursor top_left_arrow widgetDefault 123option add *Messagebox.height 0 widgetDefault 124option add *Messagebox.width 0 widgetDefault 125option add *Messagebox.visibleItems 80x24 widgetDefault 126 127# ------------------------------------------------------------------ 128# CONSTRUCTOR 129# ------------------------------------------------------------------ 130itcl::body iwidgets::Messagebox::constructor {args} { 131 set _interior $itk_interior 132 133 # 134 # Create the text area. 135 # 136 itk_component add text { 137 iwidgets::Scrolledtext $itk_interior.text -width 1 -height 1 \ 138 -state disabled -wrap none 139 } { 140 keep -borderwidth -cursor -exportselection -highlightcolor \ 141 -highlightthickness -padx -pady -relief -setgrid -spacing1 \ 142 -spacing2 -spacing3 143 144 keep -activerelief -elementborderwidth -jump -troughcolor 145 146 keep -hscrollmode -height -sbwidth -scrollmargin -textbackground \ 147 -visibleitems -vscrollmode -width 148 149 keep -labelbitmap -labelfont -labelimage -labelmargin \ 150 -labelpos -labeltext -labelvariable 151 } 152 grid $itk_component(text) -row 0 -column 0 -sticky nsew 153 grid rowconfigure $_interior 0 -weight 1 154 grid columnconfigure $_interior 0 -weight 1 155 156 # 157 # Setup right mouse button binding to post a user configurable 158 # popup menu and diable the binding for left mouse clicks. 159 # 160 bind [$itk_component(text) component text] <ButtonPress-1> "break" 161 bind [$itk_component(text) component text] \ 162 <ButtonPress-3> [itcl::code $this _post %x %y] 163 164 # 165 # Create the small popup menu that can be configurable by users. 166 # 167 itk_component add itemMenu { 168 menu $itk_component(hull).itemmenu -tearoff 0 169 } { 170 keep -background -font -foreground \ 171 -activebackground -activeforeground 172 ignore -tearoff 173 } 174 175 # 176 # Add clear and svae options to the popup menu. 177 # 178 $itk_component(itemMenu) add command -label "Find" \ 179 -command [itcl::code $this find] 180 $itk_component(itemMenu) add command -label "Save" \ 181 -command [itcl::code $this save] 182 $itk_component(itemMenu) add command -label "Clear" \ 183 -command [itcl::code $this clear] 184 185 # 186 # Create a standard type to be used if no others are specified. 187 # 188 type add DEFAULT 189 190 eval itk_initialize $args 191} 192 193# ------------------------------------------------------------------ 194# DESTURCTOR 195# ------------------------------------------------------------------ 196itcl::body iwidgets::Messagebox::destructor {} { 197 foreach type $_types { 198 type remove $type 199 } 200} 201 202# ------------------------------------------------------------------ 203# METHODS 204# ------------------------------------------------------------------ 205 206# ------------------------------------------------------------------ 207# METHOD clear 208# 209# Clear the text area. 210# ------------------------------------------------------------------ 211itcl::body iwidgets::Messagebox::clear {} { 212 $itk_component(text) configure -state normal 213 214 $itk_component(text) delete 1.0 end 215 216 $itk_component(text) configure -state disabled 217} 218 219# ------------------------------------------------------------------ 220# PUBLIC METHOD: type <op> <tag> <args> 221# 222# The type method supports several subcommands. Types can be added 223# removed and configured. All the subcommands use the MsgType class 224# to implement the functionaility. 225# ------------------------------------------------------------------ 226itcl::body iwidgets::Messagebox::type {op tag args} { 227 switch $op { 228 add { 229 eval iwidgets::MsgType $this$tag $args 230 231 lappend _types $tag 232 233 $itk_component(text) tag configure $tag \ 234 -font [$this$tag cget -font] \ 235 -background [$this$tag cget -background] \ 236 -foreground [$this$tag cget -foreground] 237 238 return $tag 239 } 240 241 remove { 242 if {[set index [lsearch $_types $tag]] != -1} { 243 itcl::delete object $this$tag 244 set _types [lreplace $_types $index $index] 245 246 return 247 } else { 248 error "bad message type: \"$tag\", does not exist" 249 } 250 } 251 252 configure { 253 if {[set index [lsearch $_types $tag]] != -1} { 254 set retVal [eval $this$tag configure $args] 255 256 $itk_component(text) tag configure $tag \ 257 -font [$this$tag cget -font] \ 258 -background [$this$tag cget -background] \ 259 -foreground [$this$tag cget -foreground] 260 261 return $retVal 262 263 } else { 264 error "bad message type: \"$tag\", does not exist" 265 } 266 } 267 268 cget { 269 if {[set index [lsearch $_types $tag]] != -1} { 270 return [eval $this$tag cget $args] 271 } else { 272 error "bad message type: \"$tag\", does not exist" 273 } 274 } 275 276 default { 277 error "bad type operation: \"$op\", should be add,\ 278 remove, configure or cget" 279 } 280 } 281} 282 283# ------------------------------------------------------------------ 284# PUBLIC METHOD: issue string ?type? args 285# 286# Print the string out to the Messagebox. Check the options of the 287# message type to see if it should be displayed or if the bell 288# should be wrong. 289# ------------------------------------------------------------------ 290itcl::body iwidgets::Messagebox::issue {string {type DEFAULT} args} { 291 if {[lsearch $_types $type] == -1} { 292 error "bad message type: \"$type\", use the type\ 293 command to create a new types" 294 } 295 296 # 297 # If the type is currently configured to be displayed, then insert 298 # it in the text widget, add the tag to the line and move the 299 # vertical scroll bar to the bottom. 300 # 301 set tag $this$type 302 303 if {[$tag cget -show]} { 304 $itk_component(text) configure -state normal 305 306 # 307 # Find end of last message. 308 # 309 set prevend [$itk_component(text) index "end - 1 chars"] 310 311 $itk_component(text) insert end "$string\n" $args 312 313 $itk_component(text) tag add $type $prevend "end - 1 chars" 314 $itk_component(text) yview end 315 316 # 317 # Sound a beep if the message type is configured such. 318 # 319 if {[$tag cget -bell]} { 320 bell 321 } 322 323 # 324 # If we reached our max lines limit, then remove enough lines to 325 # get it back under. 326 # 327 set lineCount [lindex [split [$itk_component(text) index end] "."] 0] 328 329 if { $lineCount > $itk_option(-maxlines) } { 330 set numLines [expr {$lineCount - $itk_option(-maxlines) -1}] 331 332 $itk_component(text) delete 1.0 $numLines.0 333 } 334 335 $itk_component(text) configure -state disabled 336 } 337} 338 339# ------------------------------------------------------------------ 340# PUBLIC METHOD: save 341# 342# Save contents of messages area to a file using a fileselectionbox. 343# ------------------------------------------------------------------ 344itcl::body iwidgets::Messagebox::save {} { 345 set saveFile "" 346 set filter "" 347 348 set saveFile [tk_getSaveFile -title "Save Messages" \ 349 -initialdir $itk_option(-savedir) \ 350 -parent $itk_interior \ 351 -initialfile $itk_option(-filename)] 352 353 if { $saveFile != "" } { 354 $itk_component(text) export $saveFile 355 } 356} 357 358# ------------------------------------------------------------------ 359# PUBLIC METHOD: find 360# 361# Search the contents of messages area for a specific string. 362# ------------------------------------------------------------------ 363itcl::body iwidgets::Messagebox::find {} { 364 if {! [info exists itk_component(findd)]} { 365 itk_component add findd { 366 iwidgets::Finddialog $itk_interior.findd \ 367 -textwidget $itk_component(text) 368 } 369 } 370 371 $itk_component(findd) center $itk_component(text) 372 $itk_component(findd) activate 373} 374 375# ------------------------------------------------------------------ 376# PRIVATE METHOD: _post 377# 378# Used internally to post the popup menu at the coordinate (x,y) 379# relative to the widget. 380# ------------------------------------------------------------------ 381itcl::body iwidgets::Messagebox::_post {x y} { 382 set rx [expr {[winfo rootx $itk_component(text)]+$x}] 383 set ry [expr {[winfo rooty $itk_component(text)]+$y}] 384 385 tk_popup $itk_component(itemMenu) $rx $ry 386} 387 388 389# ------------------------------------------------------------------ 390# METHOD export filename 391# 392# write text to a file (export filename) 393# ------------------------------------------------------------------ 394itcl::body iwidgets::Messagebox::export {filename} { 395 396 $itk_component(text) export $filename 397 398} 399 400