diff options
Diffstat (limited to 'itcl/iwidgets/generic/scrolledcanvas.itk')
| -rw-r--r-- | itcl/iwidgets/generic/scrolledcanvas.itk | 477 |
1 files changed, 477 insertions, 0 deletions
diff --git a/itcl/iwidgets/generic/scrolledcanvas.itk b/itcl/iwidgets/generic/scrolledcanvas.itk new file mode 100644 index 00000000000..aa113548940 --- /dev/null +++ b/itcl/iwidgets/generic/scrolledcanvas.itk @@ -0,0 +1,477 @@ +# +# Scrolledcanvas +# ---------------------------------------------------------------------- +# Implements horizontal and vertical scrollbars around a canvas childsite +# Includes options to control display of scrollbars. The standard +# canvas options and methods are supported. +# +# ---------------------------------------------------------------------- +# AUTHOR: Mark Ulferts mulferts@austin.dsccc.com +# +# @(#) $Id$ +# ---------------------------------------------------------------------- +# Copyright (c) 1995 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 Scrolledcanvas { + keep -activebackground -activerelief -background -borderwidth -cursor \ + -elementborderwidth -foreground -highlightcolor -highlightthickness \ + -insertbackground -insertborderwidth -insertofftime -insertontime \ + -insertwidth -jump -labelfont -selectbackground -selectborderwidth \ + -selectforeground -textbackground -troughcolor +} + +# ------------------------------------------------------------------ +# SCROLLEDCANVAS +# ------------------------------------------------------------------ +itcl::class iwidgets::Scrolledcanvas { + inherit iwidgets::Scrolledwidget + + constructor {args} {} + destructor {} + + itk_option define -autoresize autoResize AutoResize 1 + itk_option define -automargin autoMargin AutoMargin 0 + + public method childsite {} + public method justify {direction} + + public method addtag {args} + public method bbox {args} + public method bind {args} + public method canvasx {args} + public method canvasy {args} + public method coords {args} + public method create {args} + public method dchars {args} + public method delete {args} + public method dtag {args} + public method find {args} + public method focus {args} + public method gettags {args} + public method icursor {args} + public method index {args} + public method insert {args} + public method itemconfigure {args} + public method itemcget {args} + public method lower {args} + public method move {args} + public method postscript {args} + public method raise {args} + public method scale {args} + public method scan {args} + public method select {args} + public method type {args} + public method xview {args} + public method yview {args} +} + +# +# Provide a lowercased access method for the Scrolledcanvas class. +# +proc ::iwidgets::scrolledcanvas {pathName args} { + uplevel ::iwidgets::Scrolledcanvas $pathName $args +} + +# +# Use option database to override default resources of base classes. +# +option add *Scrolledcanvas.width 200 widgetDefault +option add *Scrolledcanvas.height 230 widgetDefault +option add *Scrolledcanvas.labelPos n widgetDefault + +# ------------------------------------------------------------------ +# CONSTRUCTOR +# ------------------------------------------------------------------ +itcl::body iwidgets::Scrolledcanvas::constructor {args} { + # + # Create a clipping frame which will provide the border for + # relief display. + # + itk_component add clipper { + frame $itk_interior.clipper + } { + usual + + keep -borderwidth -relief -highlightthickness -highlightcolor + rename -highlightbackground -background background Background + } + grid $itk_component(clipper) -row 0 -column 0 -sticky nsew + grid rowconfigure $_interior 0 -weight 1 + grid columnconfigure $_interior 0 -weight 1 + + # + # Create a canvas to scroll + # + itk_component add canvas { + canvas $itk_component(clipper).canvas \ + -height 1.0 -width 1.0 \ + -scrollregion "0 0 1 1" \ + -xscrollcommand \ + [itcl::code $this _scrollWidget $itk_interior.horizsb] \ + -yscrollcommand \ + [itcl::code $this _scrollWidget $itk_interior.vertsb] + } { + usual + + ignore -highlightthickness -highlightcolor + + keep -closeenough -confine -scrollregion + keep -xscrollincrement -yscrollincrement + + rename -background -textbackground textBackground Background + } + grid $itk_component(canvas) -row 0 -column 0 -sticky nsew + grid rowconfigure $itk_component(clipper) 0 -weight 1 + grid columnconfigure $itk_component(clipper) 0 -weight 1 + + # + # Configure the command on the vertical scroll bar in the base class. + # + $itk_component(vertsb) configure \ + -command [itcl::code $itk_component(canvas) yview] + + # + # Configure the command on the horizontal scroll bar in the base class. + # + $itk_component(horizsb) configure \ + -command [itcl::code $itk_component(canvas) xview] + + # + # Initialize the widget based on the command line options. + # + eval itk_initialize $args +} + +# ------------------------------------------------------------------ +# DESTURCTOR +# ------------------------------------------------------------------ +itcl::body iwidgets::Scrolledcanvas::destructor {} { +} + +# ------------------------------------------------------------------ +# OPTIONS +# ------------------------------------------------------------------ + +# ------------------------------------------------------------------ +# OPTION: -autoresize +# +# Automatically adjusts the scrolled region to be the bounding +# box covering all the items in the canvas following the execution +# of any method which creates or destroys items. Thus, as new +# items are added, the scrollbars adjust accordingly. +# ------------------------------------------------------------------ +itcl::configbody iwidgets::Scrolledcanvas::autoresize { + if {$itk_option(-autoresize)} { + set bbox [$itk_component(canvas) bbox all] + + if {$bbox != {}} { + set marg $itk_option(-automargin) + set bbox [lreplace $bbox 0 0 [expr {[lindex $bbox 0] - $marg}]] + set bbox [lreplace $bbox 1 1 [expr {[lindex $bbox 1] - $marg}]] + set bbox [lreplace $bbox 2 2 [expr {[lindex $bbox 2] + $marg}]] + set bbox [lreplace $bbox 3 3 [expr {[lindex $bbox 3] + $marg}]] + } + + $itk_component(canvas) configure -scrollregion $bbox + } +} + +# ------------------------------------------------------------------ +# METHODS +# ------------------------------------------------------------------ + +# ------------------------------------------------------------------ +# METHOD: childsite +# +# Returns the path name of the child site widget. +# ------------------------------------------------------------------ +itcl::body iwidgets::Scrolledcanvas::childsite {} { + return $itk_component(canvas) +} + +# ------------------------------------------------------------------ +# METHOD: justify +# +# Justifies the canvas scrolled region in one of four directions: top, +# bottom, left, or right. +# ------------------------------------------------------------------ +itcl::body iwidgets::Scrolledcanvas::justify {direction} { + if {[winfo ismapped $itk_component(canvas)]} { + update idletasks + + switch $direction { + left { + $itk_component(canvas) xview moveto 0 + } + right { + $itk_component(canvas) xview moveto 1 + } + top { + $itk_component(canvas) yview moveto 0 + } + bottom { + $itk_component(canvas) yview moveto 1 + } + default { + error "bad justify argument \"$direction\": should be\ + left, right, top, or bottom" + } + } + } +} + +# ------------------------------------------------------------------ +# CANVAS METHODS: +# +# The following methods are thin wraps of standard canvas methods. +# Consult the Tk canvas man pages for functionallity and argument +# documentation +# ------------------------------------------------------------------ + +# ------------------------------------------------------------------ +# METHOD: addtag tag searchSpec ?arg arg ...? +# ------------------------------------------------------------------ +itcl::body iwidgets::Scrolledcanvas::addtag {args} { + return [eval $itk_component(canvas) addtag $args] +} + +# ------------------------------------------------------------------ +# METHOD: bbox tagOrId ?tagOrId tagOrId ...? +# ------------------------------------------------------------------ +itcl::body iwidgets::Scrolledcanvas::bbox {args} { + return [eval $itk_component(canvas) bbox $args] +} + +# ------------------------------------------------------------------ +# METHOD: bind tagOrId ?sequence? ?command? +# ------------------------------------------------------------------ +itcl::body iwidgets::Scrolledcanvas::bind {args} { + return [eval $itk_component(canvas) bind $args] +} + +# ------------------------------------------------------------------ +# METHOD: canvasx screenx ?gridspacing? +# ------------------------------------------------------------------ +itcl::body iwidgets::Scrolledcanvas::canvasx {args} { + return [eval $itk_component(canvas) canvasx $args] +} + +# ------------------------------------------------------------------ +# METHOD: canvasy screeny ?gridspacing? +# ------------------------------------------------------------------ +itcl::body iwidgets::Scrolledcanvas::canvasy {args} { + return [eval $itk_component(canvas) canvasy $args] +} + +# ------------------------------------------------------------------ +# METHOD: coords tagOrId ?x0 y0 ...? +# ------------------------------------------------------------------ +itcl::body iwidgets::Scrolledcanvas::coords {args} { + return [eval $itk_component(canvas) coords $args] +} + +# ------------------------------------------------------------------ +# METHOD: create type x y ?x y ...? ?option value ...? +# ------------------------------------------------------------------ +itcl::body iwidgets::Scrolledcanvas::create {args} { + set retval [eval $itk_component(canvas) create $args] + + configure -autoresize $itk_option(-autoresize) + + return $retval +} + +# ------------------------------------------------------------------ +# METHOD: dchars tagOrId first ?last? +# ------------------------------------------------------------------ +itcl::body iwidgets::Scrolledcanvas::dchars {args} { + return [eval $itk_component(canvas) dchars $args] +} + +# ------------------------------------------------------------------ +# METHOD: delete tagOrId ?tagOrId tagOrId ...? +# ------------------------------------------------------------------ +itcl::body iwidgets::Scrolledcanvas::delete {args} { + set retval [eval $itk_component(canvas) delete $args] + + configure -autoresize $itk_option(-autoresize) + + return $retval +} + +# ------------------------------------------------------------------ +# METHOD: dtag tagOrId ?tagToDelete? +# ------------------------------------------------------------------ +itcl::body iwidgets::Scrolledcanvas::dtag {args} { + eval $itk_component(canvas) dtag $args + + configure -autoresize $itk_option(-autoresize) +} + +# ------------------------------------------------------------------ +# METHOD: find searchCommand ?arg arg ...? +# ------------------------------------------------------------------ +itcl::body iwidgets::Scrolledcanvas::find {args} { + return [eval $itk_component(canvas) find $args] +} + +# ------------------------------------------------------------------ +# METHOD: focus ?tagOrId? +# ------------------------------------------------------------------ +itcl::body iwidgets::Scrolledcanvas::focus {args} { + return [eval $itk_component(canvas) focus $args] +} + +# ------------------------------------------------------------------ +# METHOD: gettags tagOrId +# ------------------------------------------------------------------ +itcl::body iwidgets::Scrolledcanvas::gettags {args} { + return [eval $itk_component(canvas) gettags $args] +} + +# ------------------------------------------------------------------ +# METHOD: icursor tagOrId index +# ------------------------------------------------------------------ +itcl::body iwidgets::Scrolledcanvas::icursor {args} { + eval $itk_component(canvas) icursor $args +} + +# ------------------------------------------------------------------ +# METHOD: index tagOrId index +# ------------------------------------------------------------------ +itcl::body iwidgets::Scrolledcanvas::index {args} { + return [eval $itk_component(canvas) index $args] +} + +# ------------------------------------------------------------------ +# METHOD: insert tagOrId beforeThis string +# ------------------------------------------------------------------ +itcl::body iwidgets::Scrolledcanvas::insert {args} { + eval $itk_component(canvas) insert $args +} + +# ------------------------------------------------------------------ +# METHOD: itemconfigure tagOrId ?option? ?value? ?option value ...? +# ------------------------------------------------------------------ +itcl::body iwidgets::Scrolledcanvas::itemconfigure {args} { + set retval [eval $itk_component(canvas) itemconfigure $args] + + configure -autoresize $itk_option(-autoresize) + + return $retval +} + +# ------------------------------------------------------------------ +# METHOD: itemcget tagOrId ?option? +# ------------------------------------------------------------------ +itcl::body iwidgets::Scrolledcanvas::itemcget {args} { + set retval [eval $itk_component(canvas) itemcget $args] + + return $retval +} + +# ------------------------------------------------------------------ +# METHOD: lower tagOrId ?belowThis? +# ------------------------------------------------------------------ +itcl::body iwidgets::Scrolledcanvas::lower {args} { + eval $itk_component(canvas) lower $args +} + +# ------------------------------------------------------------------ +# METHOD: move tagOrId xAmount yAmount +# ------------------------------------------------------------------ +itcl::body iwidgets::Scrolledcanvas::move {args} { + eval $itk_component(canvas) move $args + + configure -autoresize $itk_option(-autoresize) +} + +# ------------------------------------------------------------------ +# METHOD: postscript ?option value ...? +# ------------------------------------------------------------------ +itcl::body iwidgets::Scrolledcanvas::postscript {args} { + # + # Make sure the fontmap is in scope. + # + set fontmap "" + regexp -- {-fontmap +([^ ]+)} $args all fontmap + + if {$fontmap != ""} { + global $fontmap + } + + return [eval $itk_component(canvas) postscript $args] +} + +# ------------------------------------------------------------------ +# METHOD: raise tagOrId ?aboveThis? +# ------------------------------------------------------------------ +itcl::body iwidgets::Scrolledcanvas::raise {args} { + eval $itk_component(canvas) raise $args +} + +# ------------------------------------------------------------------ +# METHOD: scale tagOrId xOrigin yOrigin xScale yScale +# ------------------------------------------------------------------ +itcl::body iwidgets::Scrolledcanvas::scale {args} { + eval $itk_component(canvas) scale $args +} + +# ------------------------------------------------------------------ +# METHOD: scan option args +# ------------------------------------------------------------------ +itcl::body iwidgets::Scrolledcanvas::scan {args} { + eval $itk_component(canvas) scan $args +} + +# ------------------------------------------------------------------ +# METHOD: select option ?tagOrId arg? +# ------------------------------------------------------------------ +itcl::body iwidgets::Scrolledcanvas::select {args} { + eval $itk_component(canvas) select $args +} + +# ------------------------------------------------------------------ +# METHOD: type tagOrId +# ------------------------------------------------------------------ +itcl::body iwidgets::Scrolledcanvas::type {args} { + return [eval $itk_component(canvas) type $args] +} + +# ------------------------------------------------------------------ +# METHOD: xview index +# ------------------------------------------------------------------ +itcl::body iwidgets::Scrolledcanvas::xview {args} { + eval $itk_component(canvas) xview $args +} + +# ------------------------------------------------------------------ +# METHOD: yview index +# ------------------------------------------------------------------ +itcl::body iwidgets::Scrolledcanvas::yview {args} { + eval $itk_component(canvas) yview $args +} |