rivet/packages/dio/diodisplay.tcl (1,101 lines of code) (raw):

# diodisplay.tcl -- # Copyright 2002-2004 The Apache Software Foundation # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at # http://www.apache.org/licenses/LICENSE-2.0 # Unless required by applicable law or agreed to in writing, software # distributed under the License is distributed on an "AS IS" BASIS, # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. # # $Id$ # package require Itcl package require DIO package require form package provide DIODisplay 1.0 catch { ::itcl::delete class DIODisplay } ::itcl::class ::DIODisplay { constructor {args} { eval configure $args load_response if {[::rivet::lempty $DIO]} { return -code error "You must specify a DIO object" } if {[::rivet::lempty $form]} { set form [namespace which [::form #auto -defaults response]] } set document [env DOCUMENT_NAME] if {[info exists response(num)] \ && ![::rivet::lempty $response(num)]} { set pagesize $response(num) } read_css_file } destructor { if {$cleanup} { do_cleanup } } method destroy {} { ::itcl::delete object $this } # # configvar - a convenient helper for creating methods that can # set and fetch one of the object's variables # method configvar {varName string} { if {[::rivet::lempty $string]} { return [set $varName] } configure -$varName $string } # # is_function - return true if name is known to be a function # such as Search List Add Edit Delete Details Main Save DoDelete Cancel # etc. # method is_function {name} { if {[lsearch $functions $name] > -1} { return 1 } if {[lsearch $allfunctions $name] > -1} { return 1 } return 0 } # # do_cleanup - clean up our field subobjects, DIO objects, forms, and the # like. # method do_cleanup {} { ## Destroy all the fields created. foreach field $allfields { catch { $field destroy } } ## Destroy the DIO object. catch { $DIO destroy } ## Destroy the form object. catch { $form destroy } } # # handle_error - emit an error message # method handle_error {error} { puts "<B>An error has occurred processing your request</B>" puts "<PRE>" puts "$error" puts "" puts "$::errorInfo" puts "</PRE>" } # # read_css_file - parse and read in a CSS file so we can # recognize CSS info and emit it in appropriate places # method read_css_file {} { if {[::rivet::lempty $css]} { return } if {[catch {open [virtual_filename $css]} fp]} { return } set contents [read $fp] close $fp array set tmpArray $contents foreach class [array names tmpArray] { set cssArray([string toupper $class]) $tmpArray($class) } } # # get_css_class - figure out which CSS class we want to use. # If class exists, we use that. If not, we use default. # method get_css_class {tag default class} { # if tag.class exists, use that if {[info exists cssArray([string toupper $tag.$class])]} { return $class } # if .class exists, use that if {[info exists cssArray([string toupper .$class])]} { return $class } # use the default return $default } # # parse_css_class - given a class and the name of an array, parse # the named CSS class (read from the style sheet) and return it as # key-value pairs in the named array. # method parse_css_class {class arrayName} { # if we don't have an entry for the specified glass, give up if {![info exists cssArray($class)]} { return } # split CSS entry on semicolons, for each one... upvar 1 $arrayName array foreach line [split $cssArray($class) \;] { # trim leading and trailing spaces set line [string trim $line] # split the line on a colon into property and value lassign [split $line :] property value # map the property to space-trimmed lowercase and # space-trim the value, then store in the passed array set property [string trim [string tolower $property]] set value [string trim $value] set array($property) $value } } # # button_image_src - return the value of the image-src element in # the specified class (from the CSS style sheet), or an empty # string if there isn't one. # method button_image_src {class} { set class [string toupper input.$class] parse_css_class $class array if {![info exists array(image-src)]} { return } return $array(image-src) } # state - return a list of name-value pairs that represents the current # state of the query, which can be used to properly populate links # outside DIOdisplay. method state {} { set state {} foreach fld {mode query by how sort num page} { if [info exists response($fld)] { lappend state $fld $response($fld) } } return $state } method show {} { # if there's a mode in the response array, use that, else set # mode to Main set mode Main if {[info exists response(mode)]} { set mode $response(mode) } # if there is a style sheet defined, emit HTML to reference it if {![::rivet::lempty $css]} { puts "<LINK REL=\"stylesheet\" TYPE=\"text/css\" HREF=\"$css\">" } # put out the table header puts {<TABLE WIDTH="100%" CLASS="DIO">} puts "<TR>" puts {<TD VALIGN="center" CLASS="DIO">} # if mode isn't Main and persistentmain is set (the default), # run Main if {$mode != "Main" && $persistentmain} { Main } if {![is_function $mode]} { puts "In-valid function" return } if {[catch "$this $mode" error]} { handle_error $error } puts "</TD>" puts "</TR>" puts "</TABLE>" if {$cleanup} { destroy } } method showview {} { puts {<TABLE CLASS="DIOView">} set row 0 foreach field $fields { $field showview [lindex {"" "Alt"} $row] set row [expr 1 - $row] } puts "</TABLE>" } # # showform_prolog - emit a form for inserting a new record # # response(by) will contain whatever was in the "where" field # response(query) will contain whatever was in the "is" field # method showform_prolog {{args ""}} { get_field_values array eval $form start $args foreach fld [array names hidden] { $form hidden $fld -value $hidden($fld) } $form hidden mode -value Save $form hidden DIODfromMode -value $response(mode) $form hidden DIODkey -value [$DIO makekey array] puts {<TABLE CLASS="DIOForm">} } method showform_epilog {} { set save [button_image_src DIOFormSaveButton] set cancel [button_image_src DIOFormCancelButton] puts "</TABLE>" puts "<TABLE>" puts "<TR>" puts "<TD>" if {![::rivet::lempty $save]} { $form image save -src $save -class DIOFormSaveButton } else { $form submit save.x -value "Save" -class DIOFormSaveButton } puts "</TD>" puts "<TD>" if {![::rivet::lempty $cancel]} { $form image cancel -src $cancel -class DIOFormSaveButton } else { $form submit cancel.x -value "Cancel" -class DIOFormCancelButton } puts "</TD>" puts "</TR>" puts "</TABLE>" $form end } # # showform - emit a form for inserting a new record # # response(by) will contain whatever was in the "where" field # response(query) will contain whatever was in the "is" field # method showform {} { showform_prolog # emit each field foreach field $fields { showform_field $field } showform_epilog } # showform_field - emit the form field for the specified field using # the showform method of the field. If the user has typed something # into the search field and it matches the fields being emitted, # use that value as the default # method showform_field {field} { if {[info exists response(by)] && $response(by) == [$field text]} { if {![$field readonly] && $response(query) != ""} { $field value $response(query) } } $field showform } method page_buttons {end {count 0}} { if {$pagesize <= 0} { return } if {![info exists response(page)]} { set response(page) 1 } set pref DIO$end if {!$count} { set count [$DIOResult numrows] } set pages [expr ($count + $pagesize - 1) / $pagesize] if {$pages <= 1} { return } set first [expr $response(page) - 4] if {$first > $pages - 9} { set first [expr $pages - 9] } if {$first > 1} { lappend pagelist 1 1 if {$first > 3} { lappend pagelist ".." 0 } elseif {$first > 2} { lappend pagelist 2 2 } } else { set first 1 } set last [expr $response(page) + 4] if {$last < 9} { set last 9 } if {$last > $pages} { set last $pages } for {set i $first} {$i <= $last} {incr i} { lappend pagelist $i $i } if {$last < $pages} { if {$last < $pages - 2} { lappend pagelist ".." 0 } elseif {$last < $pages - 1} { incr last lappend pagelist $last $last } lappend pagelist $pages $pages } foreach {n p} $pagelist { if {$p == 0 || $p == $response(page)} { lappend navbar $n } else { set html {<A HREF="} append html "$document?mode=$response(mode)" foreach var {query by how sort num} { if {[info exists response($var)]} { append html "&$var=$response($var)" } } foreach fld [array names hidden] { append html "&$fld=$hidden($fld)" } append html "&page=$p\">$n</A>" lappend navbar $html } } if {"$end" == "Bottom"} { puts "<BR/>" } set class [get_css_class TABLE DIONavButtons ${pref}NavButtons] puts "<TABLE WIDTH=\"100%\" CLASS=\"$class\">" puts "<TR>" puts "<TD>" if {"$end" == "Top"} { puts "$count rows, go to page" } else { puts "Go to page" } foreach link $navbar { puts "$link&nbsp;" } puts "</TD>" if {"$end" == "Top" && $pages>10} { set f [::form #auto] $f start foreach fld [array names hidden] { $f hidden $fld -value $hidden($fld) } foreach fld {mode query by how sort num} { if [info exists response($fld)] { $f hidden $fld -value $response($fld) } } puts "<TD ALIGN=RIGHT>" puts "Jump directly to" $f text page -size 4 -value $response(page) $f submit submit -value "Go" puts "</TD>" $f end } puts "</TR>" puts "</TABLE>" if {"$end" == "Top"} { puts "<BR/>" } } method rowheader {{total 0}} { set fieldList $fields if {![::rivet::lempty $rowfields]} { set fieldList $rowfields } set rowcount 0 puts <P> if {$topnav} { page_buttons Top $total } puts {<TABLE BORDER WIDTH="100%" CLASS="DIORowHeader">} puts "<TR CLASS=DIORowHeader>" foreach field $fieldList { set text [$field text] set sorting $allowsort ## If sorting is turned off, or this field is not in the ## sortfields, we don't display the sort option. if {$sorting && ![::rivet::lempty $sortfields]} { if {[lsearch $sortfields $field] < 0} { set sorting 0 } } if {$sorting && [info exists response(sort)]} { if {"$response(sort)" == "$field"} { set sorting 0 } } if {!$sorting} { set html $text } else { set html {<A HREF="} append html "$document?mode=$response(mode)" foreach var {query by how num} { if {[info exists response($var)]} { append html "&$var=$response($var)" } } foreach fld [array names hidden] { append html "&$fld=$hidden($fld)" } append html "&sort=$field\">$text</A>" } set class [get_css_class TH DIORowHeader DIORowHeader-$field] puts "<TH CLASS=\"$class\">$html</TH>" } if {![::rivet::lempty $rowfunctions] && "$rowfunctions" != "-"} { puts {<TH CLASS="DIORowHeaderFunctions">Functions</TH>} } puts "</TR>" } method showrow {arrayName} { upvar 1 $arrayName a incr rowcount set alt "" if {$alternaterows && ![expr $rowcount % 2]} { set alt Alt } set fieldList $fields if {![::rivet::lempty $rowfields]} { set fieldList $rowfields } puts "<TR>" foreach field $fieldList { set class [get_css_class TD DIORowField$alt DIORowField$alt-$field] set text "" if {[info exists a($field)]} { set text $a($field) if [info exists filters($field)] { set text [$filters($field) $text] } } if ![string length $text] { set text "&nbsp;" } puts "<TD CLASS=\"$class\">$text</TD>" } if {![::rivet::lempty $rowfunctions] && "$rowfunctions" != "-"} { set f [::form #auto] puts "<TD NOWRAP CLASS=\"DIORowFunctions$alt\">" $f start foreach fld [array names hidden] { $f hidden $fld -value $hidden($fld) } $f hidden query -value [$DIO makekey a] if {[llength $rowfunctions] > 1} { $f select mode -values $rowfunctions -class DIORowFunctionSelect$alt $f submit submit -value "Go" -class DIORowFunctionButton$alt } else { set func [lindex $rowfunctions 0] $f hidden mode -value $func $f submit submit -value $func -class DIORowFunctionButton$alt } puts "</TD>" $f end } puts "</TR>" } method rowfooter {{total 0}} { puts "</TABLE>" if {$bottomnav} { page_buttons Bottom $total } } ## Define a new function. method function {name} { lappend allfunctions $name } ## Define a field in the object. method field {name args} { import_keyvalue_pairs data $args lappend fields $name lappend allfields $name set class DIODisplayField if {[info exists data(type)]} { if {![::rivet::lempty [::itcl::find classes *DIODisplayField_$data(type)]]} { set class DIODisplayField_$data(type) } } eval $class $name -name $name -display $this -form $form $args set FieldTextMap([$name text]) $name } method fetch {key arrayName} { upvar 1 $arrayName $arrayName set result [$DIO fetch $key $arrayName] set error [$DIO errorinfo] if {![::rivet::lempty $error]} { return -code error $error } return $result } method store {arrayName} { upvar 1 $arrayName array set result [$DIO store array] set error [$DIO errorinfo] if {![::rivet::lempty $error]} { return -code error $error } return $result } method update_with_explicit_key {key arrayName} { upvar 1 $arrayName array set result [$DIO update_with_explicit_key $key array] set error [$DIO errorinfo] if {![::rivet::lempty $error]} {return -code error $error} return $result } method delete {key} { set result [$DIO delete $key] set error [$DIO errorinfo] if {![::rivet::lempty $error]} { return -code error $error } return $result } method pretty_fields {list} { foreach field $list { lappend fieldList [$field text] } return $fieldList } method set_field_values {arrayName} { upvar 1 $arrayName array # for all the elements in the specified array, try to invoke # the element as an object, invoking the method "value" to # set the value to the specified value foreach var [array names array] { #if {[catch { $var value $array($var) } result] == 1} {} if {[catch { $var configure -value $array($var) } result] == 1} { } } } method get_field_values {arrayName} { upvar 1 $arrayName array foreach field $allfields { # for some reason the method for getting the value doesn't # work for boolean values, which inherit DIODisplayField, # something to do with configvar #set array($field) [$field value] set array($field) [$field cget -value] } } method DisplayRequest {query} { set DIOResult [eval $DIO search -select "count(*)" $query] if [$DIOResult numrows] { $DIOResult next -array a set total $a(count) } else { set total 0 } $DIOResult destroy set DIOResult "" append query [sql_order_by_syntax] append query [sql_limit_syntax] set DIOResult [eval $DIO search $query] if {[$DIOResult numrows] <= 0} { puts "Could not find any matching records." $DIOResult destroy set DIOResult "" return } rowheader $total $DIOResult forall -array a { showrow a } rowfooter $total $DIOResult destroy set DIOResult "" } method Main {} { puts "<TABLE BORDER=0 WIDTH=100% CLASS=DIOForm><TR>" set selfunctions {} foreach f $functions { if {"$f" != "List"} { lappend selfunctions $f } else { set f [::form #auto] $f start foreach fld [array names hidden] { $f hidden $fld -value $hidden($fld) } $f hidden mode -value "List" $f hidden query -value "" puts "<TD CLASS=DIOForm ALIGN=CENTER VALIGN=MIDDLE WIDTH=0%>" $f submit submit -value "Show All" -class DIORowFunctionButton puts "</TD>" $f end } } puts "<TD CLASS=DIOForm VALIGN=MIDDLE WIDTH=100%>" $form start puts "&nbsp;" foreach fld [array names hidden] { $form hidden $fld -value $hidden($fld) } if {[llength $selfunctions] > 1} { $form select mode -values $selfunctions -class DIOMainFunctionsSelect puts "where" } else { puts "Where" } set useFields $fields if {![::rivet::lempty $searchfields]} { set useFields $searchfields } $form select by -values [pretty_fields $useFields] \ -class DIOMainSearchBy if [string match {[Ss]earch} $selfunctions] { $form select how -values {"=" "<" "<=" ">" ">="} } else { puts "is" } if [info exists response(query)] { $form text query -value $response(query) -class DIOMainQuery } else { $form text query -value "" -class DIOMainQuery } if {[llength $selfunctions] > 1} { $form submit submit -value "GO" -class DIOMainSubmitButton } else { $form hidden mode -value $selfunctions $form submit submit -value $selfunctions -class DIOMainSubmitButton } puts "</TD></TR>" if {![::rivet::lempty $numresults]} { puts "<TR><TD CLASS=DIOForm>Results per page: " $form select num -values $numresults -class DIOMainNumResults puts "</TD></TR>" } $form end puts "</TABLE>" } method sql_order_by_syntax {} { if {[info exists response(sort)] && ![::rivet::lempty $response(sort)]} { return " ORDER BY $response(sort)" } if {![::rivet::lempty $defaultsortfield]} { return " ORDER BY $defaultsortfield" } } method sql_limit_syntax {} { if {$pagesize <= 0} { return } set offset "" if {[info exists response(page)]} { set offset [expr ($response(page) - 1) * $pagesize] } return [$DIO sql_limit_syntax $pagesize $offset] } method Search {} { set searchField $FieldTextMap($response(by)) set what $response(query) if {[info exists response(how)] && [string length $response(how)]} { set what "$response(how)$what" } DisplayRequest "-$searchField $what" } method List {} { DisplayRequest "" } method Add {} { showform } method Edit {} { if {![fetch $response(query) array]} { puts "That record does not exist in the database." return } set_field_values array showform } ## ## When we save, we want to set all the fields' values and then get ## them into a new array. We do this because we want to clean any ## unwanted variables out of the array but also because some fields ## have special handling for their values, and we want to make sure ## we get the right value. ## method Save {} { if {[info exists response(cancel.x)]} { Cancel return } ## We need to see if the key exists. If they are adding a new ## entry, we just want to see if the key exists. If they are ## editing an entry, we need to see if they changed the keyfield ## while editing. If they didn't change the keyfield, there's no ## reason to check it. if {$response(DIODfromMode) == "Add"} { set key [$DIO makekey response] fetch $key a } else { set key $response(DIODkey) set newkey [$DIO makekey response] ## If we have a new key, and the newkey doesn't exist in the ## database, we are moving this record to a new key, so we ## need to delete the old key. if {$key != $newkey} { if {![fetch $newkey a]} { # no record already exists with the new key, # do a special update set_field_values response get_field_values updateArray update_with_explicit_key $key updateArray headers redirect $document return } } } # if we got here and array "a" exists, they're trying to alter a key # to a key that already exists if {[array exists a]} { puts "That record already exists in the database." return } set_field_values response get_field_values storeArray store storeArray headers redirect $document } method Delete {} { if {![fetch $response(query) array]} { puts "That record does not exist in the database." return } if {!$confirmdelete} { DoDelete return } puts "<CENTER>" puts {<TABLE CLASS="DIODeleteConfirm">} puts "<TR>" puts {<TD COLSPAN=2 CLASS="DIODeleteConfirm">} puts "Are you sure you want to delete this record from the database?" puts "</TD>" puts "</TR>" puts "<TR>" puts {<TD ALIGN="center" CLASS="DIODeleteConfirmYesButton">} set f [::form #auto] $f start foreach fld [array names hidden] { $f hidden $fld -value $hidden($fld) } $f hidden mode -value DoDelete $f hidden query -value $response(query) $f submit submit -value Yes -class DIODeleteConfirmYesButton $f end puts "</TD>" puts {<TD ALIGN="center" CLASS="DIODeleteConfirmNoButton">} set f [::form #auto] $f start foreach fld [array names hidden] { $f hidden $fld -value $hidden($fld) } $f submit submit -value No -class "DIODeleteConfirmNoButton" $f end puts "</TD>" puts "</TR>" puts "</TABLE>" puts "</CENTER>" } method DoDelete {} { delete $response(query) headers redirect $document } method Details {} { if {![fetch $response(query) array]} { puts "That record does not exist in the database." return } set_field_values array showview } method Cancel {} { headers redirect $document } ### ## Define variable functions for each variable. ### method fields {{list ""}} { if {[::rivet::lempty $list]} { return $fields } foreach field $list { if {[lsearch $allfields $field] < 0} { return -code error "Field $field does not exist." } } set fields $list } method searchfields {{list ""}} { if {[::rivet::lempty $list]} { return $searchfields } foreach field $list { if {[lsearch $allfields $field] < 0} { return -code error "Field $field does not exist." } } set searchfields $list } method rowfields {{list ""}} { if {[::rivet::lempty $list]} { return $rowfields } foreach field $list { if {[lsearch $allfields $field] < 0} { return -code error "Field $field does not exist." } } set rowfields $list } method filter {field {value ""}} { if [string length $value] { set filters($field) [uplevel 1 [list namespace which $value]] } else { if [info exists filters($field)] { return $filters($field) } else { return "" } } } method hidden {name {value ""}} { if [string length $value] { set hidden($name) $value } else { if [info exists hidden($name)] { return $hidden($name) } else { return "" } } } method DIO {{string ""}} { configvar DIO $string } method DIOResult {{string ""}} { configvar DIOResult $string } method title {{string ""}} { configvar title $string } method functions {{string ""}} { configvar functions $string } method pagesize {{string ""}} { configvar pagesize $string } method form {{string ""}} { configvar form $string } method cleanup {{string ""}} { configvar cleanup $string } method confirmdelete {{string ""}} { configvar confirmdelete $string } method css {{string ""}} { configvar css $string } method persistentmain {{string ""}} { configvar persistentmain $string } method alternaterows {{string ""}} { configvar alternaterows $string } method allowsort {{string ""}} { configvar allowsort $string } method sortfields {{string ""}} { configvar sortfields $string } method topnav {{string ""}} { configvar topnav $string } method bottomnav {{string ""}} { configvar bottomnav $string } method numresults {{string ""}} { configvar numresults $string } method defaultsortfield {{string ""}} { configvar defaultsortfield $string } method rowfunctions {{string ""}} { configvar rowfunctions $string } ## OPTIONS ## public variable DIO "" public variable DIOResult "" public variable title "" public variable fields "" public variable searchfields "" public variable functions "Search List Add Edit Delete Details" public variable pagesize 25 public variable form "" public variable cleanup 1 public variable confirmdelete 1 public variable css "diodisplay.css" { if {![::rivet::lempty $css]} { catch {unset cssArray} read_css_file } } public variable persistentmain 1 public variable alternaterows 1 public variable allowsort 1 public variable sortfields "" public variable topnav 1 public variable bottomnav 1 public variable numresults "" public variable defaultsortfield "" public variable rowfields "" public variable rowfunctions "Details Edit Delete" public variable response public variable cssArray public variable document "" public variable allfields "" public variable FieldTextMap public variable allfunctions { Search List Add Edit Delete Details Main Save DoDelete Cancel } private variable rowcount private variable filters private variable hidden } ; ## ::itcl::class DIODisplay catch { ::itcl::delete class ::DIODisplayField } # # DIODisplayField object -- defined for each field we're displaying # ::itcl::class ::DIODisplayField { constructor {args} { ## We want to simulate Itcl's configure command, but we want to ## check for arguments that are not variables of our object. If ## they're not, we save them as arguments to the form when this ## field is displayed. import_keyvalue_pairs data $args foreach var [array names data] { if {![info exists $var]} { lappend formargs -$var $data($var) } else { set $var $data($var) } } # if text (field description) isn't set, prettify the actual # field name and use that if {[::rivet::lempty $text]} { set text [pretty [split $name _]] } } destructor { } method destroy {} { ::itcl::delete object $this } # # get_css_class - ask the parent DIODIsplay object to look up # a CSS class entry # method get_css_class {tag default class} { return [$display get_css_class $tag $default $class] } # # get_css_tag -- set tag to select or textarea if type is select # or textarea, else to input # method get_css_tag {} { switch -- $type { "select" { set tag select } "textarea" { set tag textarea } default { set tag input } } } # # pretty -- prettify a list of words by uppercasing the first letter # of each word # method pretty {string} { set words "" foreach w $string { lappend words \ [string toupper [string index $w 0]][string range $w 1 end] } return [join $words " "] } method configvar {varName string} { if {[::rivet::lempty $string]} { return [set $varName] } configure -$varName $string } # # showview - emit a table row of either DIOViewRow, DIOViewRowAlt, # DIOViewRow-fieldname (this object's field name), or # DIOViewRowAlt-fieldname, a table data field of either # DIOViewHeader or DIOViewHeader-fieldname, and then a # value of class DIOViewField or DIOViewField-fieldname # method showview {{alt ""}} { set class [get_css_class TR DIOViewRow$alt DIOViewViewRow$alt-$name] puts "<TR CLASS=\"$class\">" set class [get_css_class TD DIOViewHeader DIOViewHeader-$name] puts "<TD CLASS=\"$class\">$text:</TD>" set class [get_css_class TD DIOViewField DIOViewField-$name] puts "<TD CLASS=\"$class\">$value</TD>" puts "</TR>" } # # showform -- like showview, creates a table row and table data, but # if readonly isn't set, emits a form field corresponding to the type # of this field # method showform {} { puts "<TR>" set class [get_css_class TD DIOFormHeader DIOFormHeader-$name] puts "<TD CLASS=\"$class\">$text:</TD>" set class [get_css_class TD DIOFormField DIOFormField-$name] puts "<TD CLASS=\"$class\">" if {$readonly} { puts "$value" } else { set tag [get_css_tag] set class [get_css_class $tag DIOFormField DIOFormField-$name] if {$type == "select"} { $form select $name -values $values -value $value -class $class } else { eval $form $type $name -value [list $value] $formargs -class $class } } puts "</TD>" puts "</TR>" } # methods that give us method-based access to get and set the # object's variables... method display {{string ""}} { configvar display $string } method form {{string ""}} { configvar form $string } method formargs {{string ""}} { configvar formargs $string } method name {{string ""}} { configvar name $string } method text {{string ""}} { configvar text $string } method type {{string ""}} { configvar type $string } method value {{string ""}} { configvar value $string } method readonly {{string ""}} { configvar readonly $string } public variable display "" public variable form "" public variable formargs "" # values - for fields of type "select" only, the values that go in # the popdown (or whatever) selector public variable values "" # name - the field name public variable name "" # text - the description text for the field. if not specified, # it's constructed from a prettified version of the field name public variable text "" # value - the default value of the field public variable value "" # type - the data type of the field public variable type "text" # readonly - if 1, we don't allow the value to be changed public variable readonly 0 } ; ## ::itcl::class DIODisplayField catch { ::itcl::delete class ::DIODisplayField_boolean } # # DIODisplayField_boolen -- superclass of DIODisplayField that overrides # a few methods to specially handle booleans # ::itcl::class ::DIODisplayField_boolean { inherit ::DIODisplayField constructor {args} {eval configure $args} { eval configure $args } method add_true_value {string} { lappend trueValues $string } # # showform -- emit a form field for a boolean # method showform {} { puts "<TR>" set class [get_css_class TD DIOFormHeader DIOFormHeader-$name] puts "<TD CLASS=\"$class\">$text:</TD>" set class [get_css_class TD DIOFormField DIOFormField-$name] puts "<TD CLASS=\"$class\">" if {$readonly} { if {[boolean_value]} { puts $true } else { puts $false } } else { if {[boolean_value]} { $form default_value $name $true } else { $form default_value $name $false } eval $form radiobuttons $name \ -values [list "$true $false"] $formargs } puts "</TD>" puts "</TR>" } # # showview -- emit a view for a boolean # method showview {{alt ""}} { set class [get_css_class TR DIOViewRow$alt DIOViewRow$alt-$name] puts "<TR CLASS=\"$class\">" set class [get_css_class TD DIOViewHeader DIOViewHeader-$name] puts "<TD CLASS=\"$class\">$text:</TD>" set class [get_css_class TD DIOViewField DIOViewField-$name] puts "<TD CLASS=\"$class\">" if {[boolean_value]} { puts $true } else { puts $false } puts "</TD>" puts "</TR>" } # # boolean_value -- return 1 if value is found in the values list, else 0 # method boolean_value {} { set val [string tolower $value] if {[lsearch -exact $values $val] > -1} { return 1 } return 0 } method value {{string ""}} { configvar value $string } public variable true "Yes" public variable false "No" public variable values "1 y yes t true on" public variable value "" { if {[boolean_value]} { set value $true } else { set value $false } } } ; ## ::itcl::class ::DIODisplayField_boolean