home *** CD-ROM | disk | FTP | other *** search
- #
- # 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: scrolledcanvas.itk,v 1.3 2001/08/17 19:04:06 smithc Exp $
- # ----------------------------------------------------------------------
- # 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
- }
-