Anatomy of a NexTk Widget

The goal of this document is to provide information about the structure and design of a typical NexTk widget.

NexTk is built around a C extension called objstructure. Objstructure is used to create widget instance commands, and it also provides some internal data structures. These commands each have unique methods and instance variables. For example the following code creates a widget-like command:

 objstructure .widget 

To add some options to the widget we use a core method of every objstructure. Core methods begin with :: It should be noted that no Tcl namespace code is used to implement objstructure. This :: is felt to be an understandable convention.

Here is an example of adding keys/options with a core method:

 objstructure .widget
 .widget ::add-keys -text "Hello World"
 .widget -text Neat

A method is added in a similar way:

 .widget ::add-method knob [list knob-callback .widget]
 .widget knob 123 ;# calls knob-callback

So, now that we have some of the basic structural design covered, let's jump into a window.

 proc NS_window {path width height} {
         global NS_windows
 
         if {[info exists NS_windows($path)]} {
                 return -code error "window $path already exists"
         }
 
         objstructure $path
         set NS_windows($path) $path
 
         set parent [NS_window-parent $path]
 
         # Append the child to the parent's window list.
         set pchildren [$parent _children]
         lappend pchildren $path
         $parent _children $pchildren
 
         # _manager is a private key that corresponds to a structure 
         # that manages the children.
         $path ::add-keys \
                 _manager {} \
                 _managedby {} \
                 _children [list] \
                 reqwidth $width reqheight $height \
                 minwidth -1 minheight -1 \
                 x 0 y 0 width $width height $height rotate 0 \
                 obj [megaimage-blank $width $height] \
                 _redraw [list] \
                 _destroy [list] \
                 _focus [list] \
                 _focuslost [list] \
                 _remove-from-manager "" \
                 _parent $parent \
                 _update 1 \
                 _render_tree_data {} \
                 -buttonpress {} -buttonrelease {} -keypress {} -keyrelease {} -motion {} \
                 -visible 1 \
                 _toplevel 0 \
                 _propagate_geometry 1
 
         $path ::add-callback rotate [list NS_window-rotate-callback $path]
         $path ::add-method destroy [list NS_destroy-window $path]
         $path ::add-method render [list NS_render $path]
         $path ::add-method raise [list NS_raise $path]
         
         return $path
 }

The first thing you may notice is that NS_ is used. This gets substituted with [string map] and for the moment replaced with ntk_. In this way the namespace is dynamic. The public options are prefixed with -, and as you can see there are a few. The private members are prefixed with _. The semi-private or mostly private members have no prefix. If you desire to use any of these you can. I won't stop you from violating the promise of encapsulation.

Now the ::add-callback is something you may not be familiar with. If say for instance you wanted to verify that the rotate key always has a valid integer value betwen [-360,360] associated with it, then you would use this. A callback is passed the specified new value, and the callback may return 0 or 1 to indicate whether or not the value should be set. An error may also be returned to not set the value.

The obj key is used to store the actual window contents (as a megaimage instance), and that is what forms the basis for the final display.

If an existing key would be clobbered by an ::add-keys, then an error is returned.

 proc NS_label {path args} {
         NS_window $path 10 10
 
         $path ::add-keys \
                 -text "" \
                 -textcolor $::NS_default_text_color \
                 -bg $::NS_default_background_color \
                 -font $::NS_default_font \
                 -bd 0 \
                 _textbuf {} \
                 _textwidth 0 \
                 _textheight 0
 
 
         NS_append-redraw-handler $path [list NS_label-draw $path]
         $path ::add-callback -textcolor [list NS_verify-color $path -textcolor]
         $path ::add-callback -bg [list NS_verify-color $path -background]
         $path ::add-callback -bd [list NS_label-verify-bd]
 
         foreach key [list -text -textcolor -bg -font -bd] {
                 $path ::add-trace $key [list NS_label-trace $path]
         }
 
         NS_expand-args $path $args
         NS_label-draw $path
 
         return $path
}

The first calls for this label widget should be fairly self-explanatory. We append a redraw handler for this window, so that when the window is resized and needs to be redrawn NS_label-draw is called.

 proc NS_label-draw {path} {
         [$path obj] setall [$path -bg]
 
         if {[$path -bd] > 0} {
                 NS_theme-label-draw-border $path
         }
 
         if {[string length [$path -text]]} {
                 set x [expr {[$path width] / 2 - [$path _textwidth] / 2}]
                 set y [expr {[$path height] / 2 - [$path _textheight] / 2}]
                 [$path obj] blend $x $y [$path _textbuf]
         }
 
         $path render
 }

Here you may notice the usage of [$path obj] setall that is used to set the background color. Then the theme code is called to draw a border, and finally the _textbuf is blended with the background.

NexTk uses a method for caching of blended windows, so that less of the tree needs to be recomposited. The $path render command triggers an update of composited contents, and eventually (when idle) the window contents will be rendered and displayed.

 proc NS_label-trace {path} {
         if {![string length [$path -text]]} {
                 NS_label-draw $path
                 return
         }
 
         $path _textbuf [freetype [$path -font] [$path -text] [$path -textcolor] width height]
         $path _textwidth $width
         $path _textheight $height
         set bdt [expr {[$path -bd] * 2}]
         set rwidth [expr {$width + $bdt + 2}]
         set rheight [expr {$height + $bdt + 2}]
 
         NS_request-size $path $rwidth $rheight
         NS_label-draw $path
 }

The freetype command is part of the freetypeext used by NexTk. NS_request-size is used to interact with geometry managers.

 proc NS_label-verify-bd {arg} {
         if {![string is integer -strict $arg] || $arg < 0} {
                 return -code error "invalid argument for -bd: $arg"
         }
 
         return 1
 }

This bit of code keeps the -bd value within constraints.

The objstructure design allows for creating very powerful, and concise widgets within Tcl. The majority of the widgets are scripted in this manner.


Comments/Questions

Q. (via email) What is the minimum required for a widget?

A. Very little is required for a widget. As the label widget that follows may demonstrate.

 proc NS_label {path args} {
         NS_window $path 10 10

         $path ::add-keys \
                 -text "" \
                 -textcolor $::NS_default_text_color \
                 -bg $::NS_default_background_color \
                  -font $::NS_default_font \
                 -bd 0 \
                 _textbuf {} \
                 _textwidth 0 \
                 _textheight 0
 

         NS_append-redraw-handler $path [list NS_label-draw $path]
         $path ::add-callback -textcolor [list NS_verify-color $path -textcolor]
         $path ::add-callback -bg [list NS_verify-color $path -bg]
         $path ::add-callback -bd [list NS_label-verify-bd]
 
         foreach key [list -text -textcolor -bg -font -bd] {
                 $path ::add-trace $key [list NS_label-trace $path]
         }
 
         NS_expand-args $path $args
         NS_label-draw $path
 
         return $path
 }
 
 proc NS_label-draw {path} {
         [$path obj] setall [$path -bg]
 
         if {[$path -bd] > 0} {
                 NS_theme-label-draw-border $path
         }
 
         if {[string length [$path -text]]} {
                 set x [expr {[$path width] / 2 - [$path _textwidth] / 2}]
                 set y [expr {[$path height] / 2 - [$path _textheight] / 2}]
                 [$path obj] blend $x $y [$path _textbuf]
         }
 
         $path render
 }

 proc NS_label-trace {path} {
         if {![string length [$path -text]]} {
                 NS_label-draw $path
                 return
         }
 
         $path _textbuf [freetype [$path -font] [$path -text] [$path -textcolor] width height]
         $path _textwidth $width
         $path _textheight $height
         set bdt [expr {[$path -bd] * 2}]
         set rwidth [expr {$width + $bdt + 2}]
         set rheight [expr {$height + $bdt + 2}]
 
         NS_request-size $path $rwidth $rheight
         NS_label-draw $path
 }

 proc NS_label-verify-bd {arg} {
         if {![string is integer -strict $arg] || $arg < 0} {
                 return -code error "invalid argument for -bd: $arg"
         }
 
         return 1
 }