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