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