home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / tcl / spectcl-.000 / spectcl- / usr / local / SpecTcl-0.1a / scroll.tk < prev    next >
Encoding:
Text File  |  1995-11-06  |  3.7 KB  |  130 lines
  1. # SpecTcl, by S. A. Uhler
  2. # Copyright (c) 1994-1995 Sun Microsystems, Inc.
  3. #
  4. # See the file "license.txt" for information on usage and redistribution
  5. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  6. #
  7. # figure out how to attach scroll bars
  8.  
  9. # determine which widgets are scrollable by scrollbars in the same row/col
  10.  
  11. proc find_scrollable {} {
  12.     global Widget_data Scroll_column Scroll_row
  13.     set widgets [array names Widget_data default:*,xscrollcommand]
  14.     regsub -all {default:([^,]+),xscrollcommand} $widgets {\1 } Scroll_column
  15.     set widgets [array names Widget_data default:*,yscrollcommand]
  16.     regsub -all {default:([^,]+),yscrollcommand} $widgets {\1 } Scroll_row
  17. }
  18.  
  19. proc scroll_attach {} {
  20.     global Widgets Scroll_row Scroll_column
  21.  
  22.     # find scrollbars and scrollable items
  23.  
  24.     find_scrollable
  25.  
  26.     dputs $Scroll_row $Scroll_column
  27.     set scrollbars ""; set scrollable_row ""; set scrollable_column ""
  28.     foreach win [array names Widgets] {
  29.         if {$win == "f"} continue
  30.         upvar #0 $win data
  31.         if {[string match *$data(type)* $Scroll_row]} {
  32.             lappend scrollable_row $win
  33.         }
  34.         if {[string match *$data(type)* $Scroll_column]} {
  35.             lappend scrollable_column $win
  36.         } elseif {$data(type) == "scrollbar"} {
  37.             lappend scrollbars $win
  38.         }
  39.     }
  40.     dputs scrollbars: $scrollbars <$scrollable_row> <$scrollable_column>
  41.     set num_scrolls [llength $scrollbars]
  42.  
  43.     # find candidates for each scrollbar
  44.  
  45.     foreach scrollbar $scrollbars {
  46.         upvar #0 $scrollbar data
  47.         set master $data(master)
  48.         array set map {row column column row}
  49.         if {[string match v* $data(orient)] == 0} {
  50.             set dim column
  51.         } else {
  52.             set dim row
  53.         }
  54.         set orient($scrollbar) $dim
  55.         set pos $data($dim)        ;# row or column number
  56.         set offset $data($map($dim))
  57.         set distance 99            ;# distance from nearest scrollable item
  58.         foreach item [set scrollable_$dim] {
  59.             upvar #0 $item data
  60.             if {$master != $data(master)} continue    ;# wrong master
  61.             if {$pos != $data($dim)} continue        ;# wrong row or column
  62.             set delta [expr abs($offset - $data($map($dim)))]
  63.             if {$delta < $distance} {
  64.                 set candidate($scrollbar) $item
  65.                 set distance $delta
  66.             } elseif {$delta == $distance} {
  67.                 lappend candidate($scrollbar) $item
  68.             }
  69.         }
  70.     }
  71.  
  72.     # start assigning scrollbars
  73.     # do the easy ones first (1 candidate), then remove candidate from lists
  74.  
  75.     set assign 1
  76.     while {$assign && [set list [array names candidate]] != ""} {
  77.         set assign 0
  78.             
  79.         # process all scrollbars with 1 possible entry
  80.  
  81.         dputs loop $list
  82.         foreach i $list {
  83.             dputs <$candidate($i)> == 1 ??
  84.             if {[llength $candidate($i)] == 1} {
  85.                 scroll_associate $i $candidate($i) $orient($i)
  86.                 set assign 1
  87.                 lappend done($candidate($i)) $orient($i)
  88.                 unset candidate($i)
  89.             }
  90.         }
  91.         # puts "new candidate list"
  92.         # parray candidate
  93.         # puts "assigned widgets"
  94.         # parray done
  95.  
  96.         # remove assigned widgets (slow for now)
  97.  
  98.         foreach i [array names candidate] {
  99.             set list $candidate($i)
  100.             foreach j [array names done] {
  101.                 dputs remove? done: $j ($done($j)) from: $i=$list
  102.                 if {[lsearch -exact $done($j) $orient($i)] == -1} continue
  103.                 dputs orient match $j in $list
  104.                 if {[set found [lsearch -exact $list $j]] != -1} {
  105.                     dputs removing: $list element $found
  106.                     set candidate($i) [lreplace $list $found $found]
  107.                     dputs ------to: $candidate($i)
  108.                 }
  109.             }
  110.         }
  111.         catch "unset done"
  112.     }
  113.     return "$num_scrolls scrollbar(s) found"
  114. }
  115.  
  116. # configure the scroll bar and its associated widget to make the attachment
  117.  
  118. proc scroll_associate {scroll widget orient} {
  119.     dputs $scroll $widget by $orient
  120.     upvar #0 $scroll sc
  121.     upvar #0 $widget w
  122.     if {$orient == "column"} {
  123.         set sc(command) "%B.$w(item_name) xview"
  124.         set w(xscrollcommand) "%B.$sc(item_name) set"
  125.     } else {
  126.         set sc(command) "%B.$w(item_name) yview"
  127.         set w(yscrollcommand) "%B.$sc(item_name) set"
  128.     }
  129. }
  130.