1# -*- tcl -*- 2# 3# stext.tcl - 4# 5# Scrolled text widget. A blend of the text widget with the 6# scrolledwindow. 7# 8# While I do not recommend making scrolledXXX versions of widgets 9# (instead, use the 3 line wrapper), this is an example of how one 10# would do that. 11# 12# RCS: @(#) $Id: stext.tcl,v 1.2 2008/12/11 18:07:20 hobbs Exp $ 13# 14 15if 0 { 16 # Samples 17 package require widget::scrolledwindow 18 #set sw [widget::scrolledwindow .sw -scrollbar vertical] 19 #set text [text .sw.text -wrap word] 20 #$sw setwidget $text 21 #pack $sw -fill both -expand 1 22 23 proc test {{root .f}} { 24 destroy $root 25 set f [ttk::frame $root] 26 set lbl [ttk::label $f.lbl -text "Scrolled Text snidget:" -anchor w] 27 set st [widget::scrolledtext $f.sw -borderwidth 1 -relief sunken] 28 pack $lbl -fill x 29 pack $st -fill both -expand 1 30 pack $f -fill both -expand 1 -padx 4 -pady 4 31 } 32} 33 34### 35 36package require widget 37package require widget::scrolledwindow 38 39snit::widgetadaptor widget::scrolledtext { 40 # based on widget::scrolledwindow 41 component text 42 43 delegate option * to text 44 delegate method * to text 45 46 delegate option -scrollbar to hull 47 delegate option -auto to hull 48 delegate option -sides to hull 49 delegate option -borderwidth to hull 50 delegate option -relief to hull 51 52 constructor args { 53 # You want the outer scrolledwindow to display bd/relief 54 installhull using widget::scrolledwindow 55 install text using text $win.text \ 56 -borderwidth 0 -relief flat -highlightthickness 1 57 $hull setwidget $text 58 59 # Enable with the bits below to have a fancy override for text 60 # widget commands (like insert/delete) 61 #rename $text ${selfns}::$text. 62 #interp alias {} $text {} {*}[mymethod _text] 63 64 # Use Ttk TraverseIn event to handle megawidget focus properly 65 bind $win <<TraverseIn>> [list focus -force $text] 66 67 $self configurelist $args 68 } 69 70 #destructor { rename $text {} } 71 #method _text {cmd args} { 72 # # Here you could override insert or delete ... 73 # uplevel 1 [linsert $args 0 ${selfns}::$text. $cmd] 74 #} 75} 76 77package provide widget::scrolledtext 1.0 78