Subversion Repositories or1k

/TextDisplay.itk

TextDisplay.itk Property changes : Added: svn:executable ## -0,0 +1 ## +* \ No newline at end of property Index: Info.itk =================================================================== --- Info.itk (nonexistent) +++ Info.itk (revision 1765) @@ -0,0 +1,59 @@ +# ---------------------------------------------------------------------- +# EXAMPLE: info dialog box (Toplevel widget) +# ---------------------------------------------------------------------- +# COURSE: Object-Oriented Programming with [incr Tcl] +# AUTHOR: Michael J. McLennan, Bell Labs Innovations +# ====================================================================== +# Copyright (c) 1996 Lucent Technologies +# ====================================================================== + +option add *Info.title "Info" widgetDefault + +class Info { + inherit itk::Toplevel + + constructor {args} { + itk_component add dismiss { + button $itk_interior.dismiss -text "Dismiss" \ + -command "destroy $itk_component(hull)" + } + pack $itk_component(dismiss) -side bottom -pady 4 + + itk_component add separator { + frame $itk_interior.sep -height 2 -borderwidth 1 -relief sunken + } + pack $itk_component(separator) -side bottom -fill x -padx 4 + + itk_component add icon { + label $itk_interior.icon -bitmap info + } + pack $itk_component(icon) -side left -padx 8 -pady 8 + + itk_component add infoFrame { + frame $itk_interior.info + } + pack $itk_component(infoFrame) -side left -expand yes \ + -fill both -padx 4 -pady 4 + + set itk_interior $itk_component(infoFrame) + + eval itk_initialize $args + + after idle [code $this centerOnScreen] + } + + protected method centerOnScreen {} { + update idletasks + set wd [winfo reqwidth $itk_component(hull)] + set ht [winfo reqheight $itk_component(hull)] + set x [expr ([winfo screenwidth $itk_component(hull)]-$wd)/2] + set y [expr ([winfo screenheight $itk_component(hull)]-$ht)/2] + wm geometry $itk_component(hull) +$x+$y + } +} + +usual Info { + keep -background -cursor -foreground -font + keep -activebackground -activeforeground -disabledforeground + keep -highlightcolor -highlightthickness +}

Info.itk Property changes : Added: svn:executable ## -0,0 +1 ## +* \ No newline at end of property Index: MessageInfo.itk =================================================================== --- MessageInfo.itk (nonexistent) +++ MessageInfo.itk (revision 1765) @@ -0,0 +1,40 @@ +# ---------------------------------------------------------------------- +# EXAMPLE: using inheritance to specialize mega-widgets +# ---------------------------------------------------------------------- +# COURSE: Object-Oriented Programming with [incr Tcl] +# AUTHOR: Michael J. McLennan, Bell Labs Innovations +# ====================================================================== +# Copyright (c) 1996 Lucent Technologies +# ====================================================================== + +option add *MessageInfo.title "Notice" widgetDefault + +class MessageInfo { + inherit Info + + constructor {args} { + itk_component add message { + label $itk_interior.mesg -width 20 + } { + usual + rename -text -message message Text + } + pack $itk_component(message) -expand yes -fill both + bind $itk_component(message) [code $this resize] + + eval itk_initialize $args + } + + private method resize {} { + set w [winfo width $itk_component(message)] + if {$w > 1} { + $itk_component(message) configure -wraplength $w + } + } +} + +usual MessageInfo { + keep -background -cursor -foreground -font + keep -activebackground -activeforeground -disabledforeground + keep -highlightcolor -highlightthickness +}

MessageInfo.itk Property changes : Added: svn:executable ## -0,0 +1 ## +* \ No newline at end of property Index: TextInfo.itk =================================================================== --- TextInfo.itk (nonexistent) +++ TextInfo.itk (revision 1765) @@ -0,0 +1,46 @@ +# ---------------------------------------------------------------------- +# EXAMPLE: using mega-widgets as components +# ---------------------------------------------------------------------- +# COURSE: Object-Oriented Programming with [incr Tcl] +# AUTHOR: Michael J. McLennan, Bell Labs Innovations +# ====================================================================== +# Copyright (c) 1996 Lucent Technologies +# ====================================================================== + +option add *TextInfo.title "Text" widgetDefault + +class TextInfo { + inherit Info + + constructor {args} { + itk_component add textArea { + TextDisplay $itk_interior.txt -scrollbar auto + } { + usual + keep -wrap -tabs + rename -font -textfont textFont Font + } + pack $itk_component(textArea) -expand yes -fill both + + eval itk_initialize $args + } + + public method display {args} { + eval $itk_component(textArea) display $args + } + + public method append {args} { + eval $itk_component(textArea) append $args + } +} + +usual TextInfo { + keep -background -cursor -foreground -font + keep -activebackground -activeforeground -activerelief + keep -disabledforeground + keep -highlightcolor -highlightthickness + keep -insertbackground -insertborderwidth -insertwidth + keep -insertontime -insertofftime + keep -selectbackground -selectborderwidth -selectforeground + keep -textbackground -troughcolor +}

TextInfo.itk Property changes : Added: svn:executable ## -0,0 +1 ## +* \ No newline at end of property Index: tclIndex =================================================================== --- tclIndex (nonexistent) +++ tclIndex (revision 1765) @@ -0,0 +1,16 @@ +# Tcl autoload index file, version 2.0 for [incr Tcl] +# This file is generated by the "auto_mkindex" command +# and sourced to set up indexing information for one or +# more commands. Typically each line is a command that +# sets an element in the auto_index array, where the +# element name is the name of a command and the value is +# a script that loads the command. + +set auto_index(::TextDisplay) [list source [file join $dir TextDisplay.itk]] +set auto_index(::TextDisplay::display) [list source [file join $dir TextDisplay.itk]] +set auto_index(::TextDisplay::append) [list source [file join $dir TextDisplay.itk]] +set auto_index(::TextDisplay::substitute) [list source [file join $dir TextDisplay.itk]] +set auto_index(::TextDisplay::fixScrollbar) [list source [file join $dir TextDisplay.itk]] +set auto_index(::TextInfo) [list source [file join $dir TextInfo.itk]] +set auto_index(::MessageInfo) [list source [file join $dir MessageInfo.itk]] +set auto_index(::Info) [list source [file join $dir Info.itk]]

tclIndex Property changes : Added: svn:executable ## -0,0 +1 ## +* \ No newline at end of property Index: viewfile =================================================================== --- viewfile (nonexistent) +++ viewfile (revision 1765) @@ -0,0 +1,44 @@ +#!/bin/sh +#\ +exec itkwish $0 +# ---------------------------------------------------------------------- +# EXAMPLE: show "TextInfo" and "MessageInfo" widgets in action +# ---------------------------------------------------------------------- +# COURSE: Object-Oriented Programming with [incr Tcl] +# AUTHOR: Michael J. McLennan, Bell Labs Innovations +# ====================================================================== +# Copyright (c) 1996 Lucent Technologies +# ====================================================================== +lappend auto_path . + +if {[string match *color [winfo screenvisual .]]} { + option add *textBackground ivory startupFile + option add *MessageInfo.background DarkSeaGreen startupFile + option add *TextInfo.background DarkSeaGreen startupFile + option add *activeBackground ForestGreen startupFile + option add *activeForeground white startupFile + option add *selectForeground white startupFile + option add *selectBackground ForestGreen startupFile +} + +label .label -text "View File:" +pack .label -anchor w + +entry .file +pack .file -fill x + +bind .file {show_file [.file get]} + +proc show_file {file} { + set cmd { + set fid [open $file r] + set info [read $fid] + close $fid + } + if {[catch $cmd] == 0} { + set win [TextInfo .#auto -wrap none] + $win display $info + } else { + MessageInfo .#auto -message "Cannot read file:\n$file" + } +}

viewfile Property changes : Added: svn:executable ## -0,0 +1 ## +* \ No newline at end of property Index: README =================================================================== --- README (nonexistent) +++ README (revision 1765) @@ -0,0 +1,30 @@ + + EXAMPLES +------------------------------------------------------------------------ + This directory contains some simple code examples for mega-widgets + built using [incr Tk]: + + TextDisplay ........ derived from itk::Widget + Acts as a read-only display of text. + Has a text widget and an automatic scrollbar. + + Info ............... derived from itk::Toplevel + Base class for notice windows with an "info" + icon and a "Dismiss" button. + + MessageInfo ........ derived from class Info + Adds a label and a "-message" option for + displaying pop-up messages. + + TextInfo ........... derived from class Info + Adds a TextDisplay and display/append + methods for adding text to the display + + + To see these in action, run the "viewfile" demo program. For this + simple demo to work properly, it must be executed in this directory. + + The "viewfile" program has an entry widget which prompts for a file + name. Type a file name into the entry and press return. If the file + is found, a TextInfo widget will appear displaying its contents. + Otherwise, a MessageInfo widget will appear with an error message.

README Property changes : Added: svn:executable ## -0,0 +1 ## +* \ No newline at end of property