examples/browsetest.tcl

   1 #!/usr/bin/itkwish
   2 #package require -exact Itcl 3.1
   3 #package require -exact Itk 3.1
   4 #namespace import -force itcl::*
   5 #namespace import -force itk::*
   6
   7 source "boilerplate.tcl"
   8
   9 package require Pg_sql
  10
  11 pg_sql::Pg_sql sql -dbname "testnett" -user ""
  12
  13 proc bgerror {args} {
  14         puts $::errorInfo
  15 }
  16
  17 proc onselect_id {row_id} {
  18         puts "Got onselect_id: ($row_id)"
  19
  20         set inf         [list id $row_id]
  21         set tmp         [sql getlist "
  22                 select
  23                         data,
  24                         path
  25                 from
  26                         hconfig
  27                 where
  28                         id = '[sql quote $row_id]'
  29         "]
  30         lappend inf             data [lindex [lindex $tmp 0] 0] \
  31                                                 path [lindex [lindex $tmp 0] 1]
  32
  33         .f.details set_data $inf
  34
  35 }
  36
  37
  38 proc dump_selection {} {
  39         puts "current selection: ([.f.bt get_selected_items])"
  40 }
  41
  42 set ds [tlc::Datasource_sql ::#auto -sql_obj sql \
  43         -criteria {
  44                 Path {path combobox -choices {bank user} -initial_choice bank}
  45                 Variables {data}
  46                 "Require match on all criteria" {boolean checkbox}
  47         } \
  48         -lookup_query "select
  49                                                 id,
  50                                                 path,
  51                                                 leaf,
  52                                                 datatypes
  53                                         from
  54                                                 hconfig
  55                                         where
  56                                                 path like '%path%%'
  57                                                 %boolean%
  58                                                 data like '%%data%%'
  59                                         order by path;" \
  60         -insert_query "insert into hconfig (
  61                                                 path,
  62                                                 leaf,
  63                                                 datatypes
  64                                         ) values (
  65                                                 '%path%',
  66                                                 %leaf%,
  67                                                 '%datatypes%'
  68                                         );" \
  69         -update_query "update hconfig set
  70                                                 path='%path%',
  71                                                 leaf=%leaf%,
  72                                                 datatypes='%datatypes%'
  73                                         where
  74                                                 id=%id%;" \
  75         -delete_query "delete
  76                                                 from hconfig
  77                                         where
  78                                                 id=%id%;" \
  79         -item_schema {
  80                                         Path {path}
  81                                         Variables {data}
  82                                         "Require match on all criteria" {boolean checkbox}
  83                                         Leafnode {leaf checkbox}
  84                                         Datatypes {datatypes}
  85                                 } \
  86         -id_column 0 \
  87         -full_row_query "select
  88                                                 id,
  89                                                 path,
  90                                                 data,
  91                                                 leaf,
  92                                                 datatypes
  93                                         from
  94                                                 hconfig
  95                                         where
  96                                                 id=%id%"
  97         ]
  98
  99 $ds set_criteria_values "path user boolean or data {}"
 100 $ds set_criteria_map "boolean {1 and 0 or}"
 101 frame .f -relief groove -borderwidth 4
 102
 103 set tv [tlc::Browse_treeview_flat .f.bt \
 104                 -datasource $ds \
 105                 -show_criteria 1 \
 106                 -criteriapos    {9,10 -pady {0 15} -anchor e -padx {5 25}} \
 107                 -filterpos              {8,10 -pady {0 15} -anchor e -padx {5 25}}\
 108                 -filter_insensitive 1\
 109                 -filter_mode 1 \
 110                 -tree_style web]
 111 set sr [$tv selected_ref]
 112 $tv action_add "Print" print
 113 $tv action_attach_signal "Print" $sr
 114 $tv action_add_supported
 115 $tv filter_add "Path" path {[string first $filter(path) $row(path)] > -1}
 116 $tv filter_add_standard "Data Types" datatypes {match_left}
 117 #$tv filter_add "Path2" {path2} {1}
 118
 119 Form .f.details -schema {
 120         "ID"            {id       label}
 121         "Path"          {path label}
 122         "Data"          {data text}
 123 }
 124 .f.details attach_signal [.f.bt selected_ref]
 125
 126 table .f \
 127                 .f.bt                   1,1 -fill both \
 128                 .f.details              1,2
 129 table configure .f c2 -resize none
 130
 131 .f.bt register_handler onselect_id                      onselect_id
 132
 133
 134 button .exit -command "destroy ." -text "Exit"
 135 button .style -command "$tv style_tree web"
 136 table . \
 137         .f              1,1 -fill both \
 138         .style  2,1 -anchor w \
 139         .exit   2,1 -anchor e
 140 table configure . c2 r2 -resize none
 141
 142 bind . <Escape> "destroy ."
 143 . configure -height 480 -width 640
 144 Confirm .confirm