home *** CD-ROM | disk | FTP | other *** search
/ PC Welt 2005 March / PCWELT_3_2005.ISO / pcwsoft / framework-2.2.exe / messagebox.itk < prev    next >
Encoding:
Text File  |  2003-09-01  |  13.4 KB  |  400 lines
  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. #
  60. itk::usual Messagebox {
  61.     keep -activebackground -activeforeground -background -borderwidth \
  62.     -cursor -highlightcolor -highlightthickness \
  63.     -jump -labelfont -textbackground -troughcolor 
  64. }
  65.  
  66. # ------------------------------------------------------------------
  67. #                              MSGTYPE
  68. # ------------------------------------------------------------------
  69.  
  70. itcl::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. # ------------------------------------------------------------------
  83. itcl::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. # 
  114. proc ::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. #
  121. option add *Messagebox.labelPos n widgetDefault
  122. option add *Messagebox.cursor top_left_arrow widgetDefault
  123. option add *Messagebox.height 0 widgetDefault
  124. option add *Messagebox.width 0 widgetDefault
  125. option add *Messagebox.visibleItems 80x24 widgetDefault
  126.  
  127. # ------------------------------------------------------------------
  128. #                           CONSTRUCTOR
  129. # ------------------------------------------------------------------
  130. itcl::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. # ------------------------------------------------------------------
  196. itcl::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. # ------------------------------------------------------------------
  211. itcl::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. # ------------------------------------------------------------------
  226. itcl::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. # ------------------------------------------------------------------
  290. itcl::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. # ------------------------------------------------------------------
  344. itcl::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. # ------------------------------------------------------------------
  363. itcl::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. # ------------------------------------------------------------------
  381. itcl::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. # ------------------------------------------------------------------
  394. itcl::body iwidgets::Messagebox::export {filename} {
  395.  
  396.     $itk_component(text) export $filename
  397.  
  398. }
  399.  
  400.