1#----------------------------------------------------------
2# VisualQueryBuilder
3#
4#   provides for rapid query building
5#
6#----------------------------------------------------------
7#
8# The following package is required
9  package require Tktable 2.8
10
11# The following is the variable for Tktable
12# (which must be global)
13
14  global tbquery
15
16#
17namespace eval VisualQueryBuilder {
18  variable Win
19  variable hlite none
20  variable lbnam
21
22  # The following array will hold all the local variables
23  variable vqb
24}
25
26
27#----------------------------------------------------------
28# ::VisualQueryBuilder::init
29#----------------------------------------------------------
30#
31proc ::VisualQueryBuilder::init {} {
32
33  global PgAcVar tbquery
34  variable vqb
35
36  catch {unset vqb}
37  set vqb(rescriteria) {}
38  set vqb(links) {}
39  set vqb(ntables) 0
40  set vqb(tid) {}; # Array of lists containing table name and table id (needed for dragging individual tables)
41  set vqb(newtablename) {}
42
43  # Clear out table
44  array unset tbquery
45
46  # Set row headings for table query
47  set tbquery(1,0) "Field: "
48  set tbquery(2,0) "Table: "
49  set tbquery(3,0) "Sort: "
50  set tbquery(4,0) "Visible: "
51  set tbquery(5,0) "Criteria: "
52  set tbquery(6,0) "Or: "
53
54};   # end proc ::VisualQueryBuilder::init
55
56
57#----------------------------------------------------------
58# ::VisualQueryBuilder::print
59#----------------------------------------------------------
60#
61proc ::VisualQueryBuilder::print {} {
62
63  variable Win
64  variable vqb
65
66  set g [string trimleft [wm geometry .pgaw:VisualQuery] "="]
67  set vqb(xsize) [lindex [split $g "x+"] 0]
68  set vqb(ysize) [lindex [split $g "x+"] 1]
69
70  ::Printer::init "::VisualQueryBuilder::printcallback"
71
72};   # end proc ::VisualQueryBuilder::print
73
74
75#----------------------------------------------------------
76# ::VisualQueryBuilder::printcallback
77#----------------------------------------------------------
78#
79proc ::VisualQueryBuilder::printcallback {fid} {
80
81  variable vqb
82
83  set cv .pgaw:VisualQuery.pw.f0.frame.c
84
85  ::Printer::printStart $fid $vqb(xsize) $vqb(ysize) 1
86  ::Printer::printPage $fid 1 $cv
87  ::Printer::printStop $fid
88
89};   # end proc ::VisualQueryBuilder::print
90
91
92#------------------------------------------------------------
93# ::VisualQueryBuilder::createDropDown
94#------------------------------------------------------------
95#
96proc ::VisualQueryBuilder::createDropDown {} {
97
98  global PgAcVar
99  variable vqb
100
101  if {[winfo exists .pgaw:VisualQuery.ddf]} {
102    destroy .pgaw:VisualQuery.ddf
103  } else {
104    create_drop_down .pgaw:VisualQuery 70 27 200
105    focus .pgaw:VisualQuery.ddf.sb
106    foreach tbl [Database::getTablesList] {.pgaw:VisualQuery.ddf.lb insert end $tbl}
107    bind .pgaw:VisualQuery.ddf.lb <ButtonRelease-1> {
108      set i [.pgaw:VisualQuery.ddf.lb curselection]
109      if {$i!=""} {
110        set VisualQueryBuilder::vqb(newtablename) [.pgaw:VisualQuery.ddf.lb get $i]
111        VisualQueryBuilder::addNewTable
112      }
113      destroy .pgaw:VisualQuery.ddf
114      break
115    }
116  }
117
118  return
119
120}; # end proc ::VisualQueryBuilder::createDropDown
121
122
123#----------------------------------------------------------
124# ::VisualQueryBuilder::addNewTable
125#----------------------------------------------------------
126#
127proc ::VisualQueryBuilder::addNewTable {{tabx 0} {taby 0} {alias -1}} {
128
129  global PgAcVar CurrentDB
130  variable vqb
131  variable Win
132
133  if {$vqb(newtablename)==""} return
134  set fldlist {}
135  set l [split [string map {\" \'} $vqb(newtablename)] "."]
136  if {[llength $l] == 2} {
137    set schemaname [lindex $l 0]
138  }
139  set tablename [lindex $l end]
140  set ver [string range [::Database::getPgVersion $CurrentDB] 0 2]
141  setCursor CLOCK
142  set fldlist [::Database::getColumnsList $vqb(newtablename)]
143  setCursor DEFAULT
144  if {$fldlist==""} {
145    showError [format [intlmsg "Table '%s' not found!"] $vqb(newtablename)]
146    return
147  }
148  if {$alias==-1} {
149    set tabnum $vqb(ntables)
150  } else {
151    regsub t $alias "" tabnum
152  }
153  set vqb(tablename$tabnum) $vqb(newtablename)
154  set vqb(tablestruct$tabnum) $fldlist
155  set vqb(tablealias$tabnum) "t$tabnum"
156  set vqb(ali_t$tabnum) $vqb(newtablename)
157  set vqb(tablex$tabnum) $tabx
158  set vqb(tabley$tabnum) $taby
159  incr vqb(ntables)
160  if {$vqb(ntables)==1} {
161    repaintAll
162  } else {
163    drawTable [expr $vqb(ntables)-1]
164  }
165  set vqb(newtablename) {}
166  focus $Win(entertable)
167
168};   # end proc ::VisualQueryBuilder::addNewTable
169
170
171#----------------------------------------------------------
172# ::VisualQueryBuilder::drawTable
173#----------------------------------------------------------
174#
175proc ::VisualQueryBuilder::drawTable {it} {
176
177  global PgAcVar
178  variable vqb
179  variable hlite
180  variable lbnam
181
182  set cv  .pgaw:VisualQuery.pw.f0.frame.c
183  set tbl .pgaw:VisualQuery.pw.f1.frame.tb
184
185  # Get the number of pixels for (scrollregion) 29.7cm and 21cm on the canvas
186  set nx [winfo fpixels $cv 29.7c]
187  set ny [winfo fpixels $cv 21.0c]
188  if {$vqb(tablex$it)==0} {
189    set posy 10
190    set allbox [$cv bbox ftbl]
191    if {$allbox==""} {
192        set posx 10
193    } else {
194        set posx [expr 20 + [lindex $allbox 2]]
195    }
196    # ToDo: Try to get smarter placement
197    if {$posx > $nx} {
198      set posx 20
199      set posy 20
200    }
201    set vqb(tablex$it) $posx
202    set vqb(tabley$it) $posy
203  } else {
204    set posx [expr int($vqb(tablex$it))]
205    set posy [expr int($vqb(tabley$it))]
206  }
207
208  # Remove leading and trailing double-quotes
209  set tablename [string trim $vqb(tablename$it) \"]
210  set tablealias $vqb(tablealias$it)
211
212  # Create table window (frame, label and Listbox)
213  set fnam tab$it
214  frame $cv.$fnam -borderwidth 2 -relief raised -height 10 -width 10
215  label $cv.$fnam.lab -borderwidth 2 -text $tablename
216  ListBox $cv.$fnam.lb -background #fefefe -foreground #000000 \
217    -selectforeground white -selectbackground darkblue \
218    -borderwidth 1 -highlightthickness 0 -deltay 14 -selectmode single\
219    -yscrollcommand [subst {$cv.$fnam.sb set}] \
220    -dragenabled 1 -dragevent 1 -dropenabled 1 -dropovermode i\
221    -dropcmd {VisualQueryBuilder::lbdrop}
222  scrollbar $cv.$fnam.sb -borderwidth 1 -command [subst {$cv.$fnam.lb yview}] -highlightthickness 0 -orient vert
223
224  # Get the width of the longest field and height of fields
225  set w 0
226  set numflds 0
227  foreach fld $vqb(tablestruct$it) {
228    set tmp [font measure system -displayof $cv.$fnam.lb $fld]
229    if {$tmp > $w} {
230      set w $tmp}
231    incr numflds
232  }
233  set h [expr $numflds * 14]
234
235  # Add 30 to width to allow for left border where an image can be displayed
236  # Add 30 to height to allow for the label
237  set tid [$cv create window $posx $posy -anchor nw -window $cv.$fnam \
238           -height [expr $h + 30] -width [expr $w + 30] -tags ftbl]
239  lappend vqb(tid) [list $cv.$fnam $tid]
240  pack $cv.$fnam.lab -side top -fill x
241  pack $cv.$fnam.lb -side left -expand 1 -fill y
242  foreach fld $vqb(tablestruct$it) {$cv.$fnam.lb insert end $fld -text $fld -data $it}
243  $cv.$fnam.lb bindText <Button-1> [list VisualQueryBuilder::clickListbox $cv.$fnam.lb]
244  $cv.$fnam.lb bindText <Double-Button-1> [list VisualQueryBuilder::dblclickListbox $cv.$fnam.lb]
245
246  # Set up events for dragging the tables on the canvas
247  bind $cv.$fnam.lab <ButtonPress-1> {
248    set dragx %x
249    set dragy %y
250    set w [winfo parent %W]
251    set tid [VisualQueryBuilder::findtid $w]
252  }
253
254  bind $cv.$fnam.lab <B1-Motion> {
255    set dx [expr %x - $dragx]
256    set dy [expr %y - $dragy]
257    .pgaw:VisualQuery.pw.f0.frame.c move $tid $dx $dy
258    VisualQueryBuilder::drawLinks
259  }
260
261  bind $cv.$fnam.lab <ButtonRelease-1> {
262    #set dragstart 0
263  }
264
265}; # end proc ::VisualQueryBuilder::drawTable
266
267
268#----------------------------------------------------------
269# ::VisualQueryBuilder::clickListbox
270#----------------------------------------------------------
271#
272proc ::VisualQueryBuilder::clickListbox {w i} {
273  VisualQueryBuilder::deselectGrid
274  VisualQueryBuilder::deselectLinks
275  VisualQueryBuilder::deselectTables
276  $w selection set $i
277  set VisualQueryBuilder::hlite tabl
278  set VisualQueryBuilder::lbnam $w
279}
280
281
282#----------------------------------------------------------
283# ::VisualQueryBuilder::dblclickListbox
284#----------------------------------------------------------
285#
286proc ::VisualQueryBuilder::dblclickListbox {w i} {
287
288  global PgAcVar
289  variable vqb
290
291  set cv  .pgaw:VisualQuery.pw.f0.frame.c
292  set tbl .pgaw:VisualQuery.pw.f1.frame.tb
293
294  VisualQueryBuilder::deselectGrid
295  VisualQueryBuilder::deselectLinks
296  VisualQueryBuilder::deselectTables
297  $w selection set $i
298  set VisualQueryBuilder::hlite tabl
299  set VisualQueryBuilder::lbnam $w
300
301  # Find first free column in table
302  # If none free, add column to end of table
303  set cl -1
304  for {set c 1} {$c < [$tbl cget -cols]} {incr c} {
305    if {[$tbl get 1,$c] == ""} {
306      set cl $c
307      break
308    }
309  }
310  if {$cl == -1} {
311    $tbl insert cols $c 1
312    set cl [expr [$tbl cget -cols] - 1]
313  }
314
315  set f [winfo parent $w]
316  set tablename [$f.lab cget -text]
317  $tbl set 1,$cl $i
318  $tbl set 2,$cl $tablename
319  $tbl set 3,$cl Unsorted
320  $tbl set 4,$cl Yes
321}
322
323
324#----------------------------------------------------------
325# ::VisualQueryBuilder::findtid
326#----------------------------------------------------------
327#
328proc ::VisualQueryBuilder::findtid {w} {
329  variable vqb
330
331  foreach l $vqb(tid) {
332    if {[lindex $l 0]==$w} {
333      set tid [lindex $l 1]
334      break;
335    }
336  }
337  return $tid
338}; # end proc ::VisualQueryBuilder::findtid
339
340
341#----------------------------------------------------------
342# ListBox drop (lbdrop)
343#
344# target: pathname of the listbox dropped onto
345# source: pathname of the drag source
346# lst   : list describing where the drop occurs. It can be
347#           {widget}
348#           {item item} or
349#           {position index}
350# op    : current operation
351# type  : data type (of drag source, should be LISTBOX_ITEM)
352# data  : data (of drag source)
353#----------------------------------------------------------
354#
355proc ::VisualQueryBuilder::lbdrop {target source lst op type data} {
356  global PgAcVar
357  variable vqb
358
359  set sourcetable [winfo parent [winfo parent $source]]
360  set targetfield [lindex $lst end]
361  set targettable [winfo parent $target]
362
363  if {$sourcetable!=$targettable} {
364    lappend vqb(links) [list $sourcetable $data $targettable $targetfield]
365    drawLinks
366  }
367}
368
369
370#----------------------------------------------------------
371# ::VisualQueryBuilder::tableDrop
372#----------------------------------------------------------
373#
374proc ::VisualQueryBuilder::tableDrop {target source x y currentop type data} {
375
376  global PgAcVar
377  variable vqb
378
379  set cv  .pgaw:VisualQuery.pw.f0.frame.c
380  set tbl .pgaw:VisualQuery.pw.f1.frame.tb
381
382  set c [$tbl index @$x,$y col]
383  if {$c <= 0} return
384
385  # Check if already a field in this column. If yes
386  # insert this before the current column
387  if {[$tbl get 1,$c] != ""} {
388    $tbl insert cols $c -1
389  }
390  set it [[winfo parent $source] itemcget $data -data]
391  set tablename [string trim $vqb(tablename$it) \"]
392  $tbl set 1,$c $data
393  $tbl set 2,$c $tablename
394  $tbl set 3,$c Unsorted
395  $tbl set 4,$c Yes
396
397}
398
399
400#----------------------------------------------------------
401# ::VisualQueryBuilder::drawLinks
402#----------------------------------------------------------
403#
404proc ::VisualQueryBuilder::drawLinks {} {
405
406  global PgAcVar
407  variable vqb
408
409  if {[llength $vqb(links)]==0} return
410
411  set cv  .pgaw:VisualQuery.pw.f0.frame.c
412
413  $cv delete links
414  set i 0
415
416  # vqb(links) is an array of lists
417  # each list (link) contains sourcetable, sourcefield, targettable, targetfield
418  foreach link $vqb(links) {
419    set sourcetable [lindex $link 0]
420    set sourcefield [lindex $link 1]
421    set targettable [lindex $link 2]
422    set targetfield [lindex $link 3]
423
424    # Compute the source and destination right edge
425    set tid [findtid $sourcetable]
426    set scoords [$cv bbox $tid]
427    set sre [lindex $scoords 2]
428    set tid [findtid $targettable]
429    set tcoords [$cv bbox $tid]
430    set dre [lindex $tcoords 2]
431
432    # Compute field bound boxes
433    set slb $sourcetable.lb
434    set sidx [$slb index $sourcefield]
435    set tlb $targettable.lb
436    set tidx [$tlb index $targetfield]
437
438    # Compute the auxiliary lines
439    if {$sre < $dre} {
440      # Source object is on the left of target object
441      set x1 $sre
442      set y1 [expr $sidx * 14 + [lindex $scoords 1] + 30]
443      $cv create line $x1 $y1 [expr $x1+10] $y1 -tags [subst {links lkid$i}] -width 3
444      set x2 [lindex $tcoords 0]
445      set y2 [expr $tidx * 14 + [lindex $tcoords 1] + 30]
446      $cv create line [expr $x2-10] $y2 $x2 $y2 -tags [subst {links lkid$i}] -width 3
447      $cv create line [expr $x1+10] $y1 [expr $x2-10] $y2 -tags [subst {links lkid$i}] -width 2
448    } else {
449      # source object is on the right of target object
450      set x1 $dre
451      set y1 [expr $tidx * 14 + [lindex $tcoords 1] + 30]
452      $cv create line $x1 $y1 [expr $x1+10] $y1 -tags [subst {links lkid$i}] -width 3
453      set x2 [lindex $scoords 0]
454      set y2 [expr $sidx * 14 + [lindex $scoords 1] + 30]
455      $cv create line $x2 $y2 [expr $x2-10] $y2 -tags [subst {links lkid$i}] -width 3
456      $cv create line [expr $x1+10] $y1 [expr $x2-10] $y2 -tags [subst {links lkid$i}] -width 2
457      }
458      incr i
459  }
460
461  $cv lower links
462  #$cv bind links <Button-1> {VisualQueryBuilder::linkClick %x %y}
463
464}; # end proc ::VisualQueryBuilder::drawLinks
465
466
467#----------------------------------------------------------
468# ::VisualQueryBuilder::linkClick
469#----------------------------------------------------------
470#
471proc ::VisualQueryBuilder::linkClick {obj} {
472
473  global PgAcVar
474  variable vqb
475  variable hlite
476
477  set cv  .pgaw:VisualQuery.pw.f0.frame.c
478
479  set taglist [$cv gettags $obj]
480
481  # deselct everything
482  deselectGrid
483  deselectLinks
484  deselectTables
485
486  set lt [lindex $taglist 1]
487  $cv addtag hili withtag $lt
488  foreach i [$cv find withtag hili] {
489    $cv itemconfigure $i -fill blue
490  }
491  set hlite link
492}; # end proc ::VisualQueryBuilder::linkClick
493
494
495#----------------------------------------------------------
496# ::VisualQueryBuilder::canvasClick
497#----------------------------------------------------------
498#
499proc ::VisualQueryBuilder::canvasClick {x y} {
500
501  global PgAcVar
502  variable vqb
503  variable hlite
504
505  set cv  .pgaw:VisualQuery.pw.f0.frame.c
506
507  # As the scrollregion for the canvas is larger than the
508  # screen, we need to convert the screen x,y coordinates
509  # to the canvas x,y coordinates.
510  set lx [$cv canvasx $x]
511  set ly [$cv canvasy $y]
512  set obj [$cv find overlapping $lx $ly $lx $ly]
513  if {$obj != ""} {
514    linkClick $obj
515  } else {
516    deselectGrid
517    deselectLinks
518    deselectTables
519    set hlite none
520  }
521}
522
523
524#----------------------------------------------------------
525# ::VisualQueryBuilder::computeSQL
526#----------------------------------------------------------
527#
528proc ::VisualQueryBuilder::computeSQL {} {
529
530  global PgAcVar
531  variable vqb
532
533  set cv  .pgaw:VisualQuery.pw.f0.frame.c
534  set tbl .pgaw:VisualQuery.pw.f1.frame.tb
535
536  set vqb(rescriteria) {}
537
538  set sqlcmd "SELECT "
539
540  for {set c 1} {$c < [$tbl cget -cols]} {incr c} {
541    if {[string trim [$tbl get 4,$c]] == "Yes"} {
542      if {![string match "$sqlcmd" "SELECT "]} {
543        set sqlcmd "$sqlcmd, "
544      }
545      set f [$tbl get 1,$c]
546      set t [$tbl get 2,$c]
547      append sqlcmd "\"${t}\".\"${f}\""
548    }
549  }
550
551  # Read table names from grid and sort unique to remove duplicates
552  set tables [list]
553  for {set c 1} {$c < [$tbl cget -cols]} {incr c} {
554    set t [string trim [$tbl get 2,$c]]
555    if {$t != ""} {
556      lappend tables "$t"
557    }
558  }
559  set tables [lsort -unique $tables]
560  append sqlcmd "\nFROM [join $tables ,] "
561
562  set sup1 {}
563  if {[llength $vqb(links)] > 0} {
564    set sup1 "\nWHERE "
565    foreach link $vqb(links) {
566      if {$sup1 != "\nWHERE "} {
567        append sup1 " AND "
568      }
569      foreach {t1 f1 t2 f2} $link {break}
570      set tab1 [$t1.lab cget -text]
571      set tab2 [$t2.lab cget -text]
572      append sup1 " (\"${tab1}\".\"${f1}\"=\"${tab2}\".\"${f2}\")"
573    }
574  }
575
576
577  # Expressions in multiple columns in a single row are treated as And criteria. To be
578  # selected as part of the query's results, a record must meet all the criteria in a given row.
579  # Expressions in different rows are treated as Or criteria. To be selected, a record needs
580  # to meet the criteria only in any one row.
581  #--------------------------------------------------------------------------
582  # Assume this section is empty
583  set addSectionStart 0
584
585  # set start of this section to 'where' or 'and'
586  if {$sup1 == ""} {
587    set strt "\nWHERE ("
588  } else {
589    set strt " AND ("
590  }
591
592  for {set r 5} {$r < [$tbl cget -rows]} {incr r} {
593    set str "("
594    for {set c 1} {$c < [$tbl cget -cols]} {incr c} {
595      if {[string trim [$tbl get $r,$c]] != ""} {
596        set f [$tbl get 1,$c]
597        set t [$tbl get 2,$c]
598        set o [$tbl get $r,$c]
599        append str "(\"${t}\".\"${f}\" $o) AND "
600      }
601    }
602    # remove last " and " if there is one
603    set pos [string last " AND " $str]
604    if {$pos > 0} {
605      set str [string range $str 0 [expr $pos - 1]]
606    }
607    append str ")"
608    if {$str != "()"} {
609      set addSectionStart 1
610    }
611    lappend vqb(rescriteria) $str
612  }
613
614  if {$addSectionStart == 1} {
615    set addor 0
616    append sup1 $strt
617
618    foreach s $vqb(rescriteria) {
619      if {$s != "()"} {
620        if {$addor == 1} {
621          append sup1 "\nOR "
622        }
623        append sup1 $s
624        set addor 1
625      }
626    }
627    append sup1 ")"
628  }
629  append sqlcmd " $sup1"
630
631
632  set sup2 {}
633  for {set c 1} {$c < [$tbl cget -cols]} {incr c} {
634    set how [$tbl get 3,$c]
635    if {$how != ""} {
636      if {$how != "Unsorted"} {
637        if {$how == "Ascending"} {
638          set how ASC
639        } else {
640          set how DESC
641        }
642        if {$sup2 == ""} {
643          set sup2 "\nORDER BY "
644        } else {
645          append sup2 ","
646        }
647        set f [$tbl get 1,$c]
648        set t [$tbl get 2,$c]
649        append sup2 "\"${t}\".\"${f}\" $how "
650      }
651    }
652  }
653
654  append sqlcmd " $sup2"
655
656  return [set vqb(qcmd) $sqlcmd]
657
658};   # end proc ::VisualQueryBuilder::computeSQL
659
660
661#----------------------------------------------------------
662# ::VisualQueryBuilder::deleteObject
663#----------------------------------------------------------
664#
665proc ::VisualQueryBuilder::deleteObject {} {
666
667  global PgAcVar
668  variable vqb
669  variable hlite
670  variable lbnam
671
672  set cv  .pgaw:VisualQuery.pw.f0.frame.c
673  set tbl .pgaw:VisualQuery.pw.f1.frame.tb
674
675  switch $hlite {
676    grid {set c [$tbl tag col HILITEcol]
677          set r [$tbl tag row HILITErow]
678          foreach cl $c {$tbl delete cols $cl 1}
679          foreach rw $r {$tbl delete rows $rw 1}
680         }
681    link {set lnks [$cv find withtag hili]
682          if {$lnks==""} return
683          set taglist [$cv gettags [lindex $lnks 0]]
684          if {$taglist==""} return
685          set lt [lindex $taglist 1]
686          set tagpos [string range $lt 4 end]
687          set vqb(links) [lreplace $vqb(links) $tagpos $tagpos]
688          $cv delete hili
689          drawLinks
690         }
691    tabl {set it [$lbnam itemcget [$lbnam selection get] -data]
692          set tablename [string trim $vqb(tablename$it) \"]
693
694          # First, delete columns in query table
695          # If you delete column 3 (for example) column 4 becomes column 3
696          # and it is missed as c has been incremented to 4. So reverse the loop
697          for {set c [expr [$tbl cget -cols] - 1]} {$c > 0 } {set c [expr $c - 1]} {
698            if {[string trim [$tbl get 2,$c]] == $tablename} {
699              $tbl delete cols $c 1
700            }
701          }
702
703          # Second, find and delete links to the table
704          set tnam [winfo parent $lbnam]
705          set tagpos 0
706          # Reverse the loop
707          # Does the following work?
708          foreach lnk $vqb(links) {
709            if {[lindex $lnk 0]==$tnam || [lindex $lnk 2]==$tnam} {
710              set vqb(links) [lreplace $vqb(links) $tagpos $tagpos]
711            } else {
712              incr tagpos
713            }
714          }
715          $cv delete links
716          drawLinks
717
718          # Finally, delete the table
719          set tid [VisualQueryBuilder::findtid $tnam]
720          $cv delete $tid
721          # delete from vqb(tid)
722          for {set pos 0} {$pos < [llength $vqb(tid)]} {incr pos} {
723            set lst [lindex $vqb(tid) $pos]
724            if {[lindex $lst 0]==$tnam} {
725              set vqb(tid) [lreplace $vqb(tid) $pos $pos]
726              break;
727            }
728          }
729         }
730  }; # end switch
731
732}; # end proc ::VisualQueryBuilder::deleteObject
733
734
735#----------------------------------------------------------
736# ::VisualQueryBuilder::deselectGrid
737#----------------------------------------------------------
738#
739proc ::VisualQueryBuilder::deselectGrid {} {
740
741  variable vqb
742
743  set cv  .pgaw:VisualQuery.pw.f0.frame.c
744  set tbl .pgaw:VisualQuery.pw.f1.frame.tb
745
746  set c [$tbl tag col HILITEcol]
747  set r [$tbl tag row HILITErow]
748  foreach cl $c {$tbl tag col {} $cl}
749  foreach rw $r {$tbl tag row {} $rw}
750  $tbl selection clear all
751}
752
753
754#----------------------------------------------------------
755# ::VisualQueryBuilder::deselectLinks
756#----------------------------------------------------------
757#
758proc ::VisualQueryBuilder::deselectLinks {} {
759
760  variable vqb
761
762  set cv  .pgaw:VisualQuery.pw.f0.frame.c
763  set tbl .pgaw:VisualQuery.pw.f1.frame.tb
764
765  set lnks [$cv find withtag hili]
766  if {$lnks==""} return
767  foreach i $lnks {
768    $cv itemconfigure $i -fill black
769    $cv dtag $i hili
770  }
771}
772
773
774#----------------------------------------------------------
775# ::VisualQueryBuilder::deselectTables
776#----------------------------------------------------------
777#
778proc ::VisualQueryBuilder::deselectTables {} {
779
780  variable vqb
781
782  set cv  .pgaw:VisualQuery.pw.f0.frame.c
783  set tbl .pgaw:VisualQuery.pw.f1.frame.tb
784
785  foreach l $vqb(tid) {
786    set w [lindex $l 0]
787    $w.lb selection clear 0 end
788  }
789}
790
791
792#----------------------------------------------------------
793# ::VisualQueryBuilder::getTableList
794#----------------------------------------------------------
795#
796proc ::VisualQueryBuilder::getTableList {} {
797
798    global PgAcVar
799    variable vqb
800
801    set tablelist {}
802    set num 0
803    foreach lst $vqb(tid) {
804      set f [lindex $lst 0]
805      set name [$f.lab cget -text]
806      lappend tablelist $name [winfo x $f] [winfo y $f] t$num
807      incr num
808    }
809
810    return $tablelist
811
812}; # end proc ::VisualQueryBuilder::getTableList
813
814
815#----------------------------------------------------------
816# ::VisualQueryBuilder::getLinkList
817#----------------------------------------------------------
818#
819proc ::VisualQueryBuilder::getLinkList {} {
820
821    global PgAcVar
822    variable vqb
823
824    set linklist {}
825    foreach lst $vqb(links) {
826        lappend linklist [lindex $lst 0] [lindex $lst 1] [lindex $lst 2] [lindex $lst 3]
827    }
828
829    return $linklist
830
831}; # end proc ::VisualQueryBuilder::getLinkList {} {
832
833
834#----------------------------------------------------------
835# ::VisualQueryBuilder::loadVisualLayout
836#----------------------------------------------------------
837#
838proc ::VisualQueryBuilder::loadVisualLayout {} {
839
840    global PgAcVar tbquery
841    variable vqb
842
843    set tbl .pgaw:VisualQuery.pw.f1.frame.tb
844
845    init
846    foreach {t x y a} $PgAcVar(query,tables) {
847        set vqb(newtablename) $t
848        addNewTable $x $y $a
849    }
850    foreach {t0 f0 t1 f1} $PgAcVar(query,links) {
851        lappend vqb(links) [list $t0 $f0 $t1 $f1]
852    }
853    if {$PgAcVar(query,results)!=""} {
854      set lst $PgAcVar(query,results)
855      $tbl configure -rows [lindex $lst 0]
856      $tbl configure -cols [lindex $lst 1]
857      array set tbquery [lindex $lst 2]
858      drawLinks
859    }
860
861}; # end proc ::VisualQueryBuilder::loadVisualLayout {} {
862
863
864#----------------------------------------------------------
865# ::VisualQueryBuilder::repaintAll
866#----------------------------------------------------------
867#
868proc ::VisualQueryBuilder::repaintAll {} {
869
870  global PgAcVar
871  variable vqb
872
873  set cv  .pgaw:VisualQuery.pw.f0.frame.c
874  set tbl .pgaw:VisualQuery.pw.f1.frame.tb
875
876  $cv delete all
877  set posx 20
878
879  foreach tn [array names vqb tablename*] {
880    regsub tablename $tn "" it
881    drawTable $it
882  }
883
884  drawLinks
885  #drawResultPanel
886
887  bind .pgaw:VisualQuery <Key-Delete> {
888    VisualQueryBuilder::deleteObject
889  }
890
891}; # end proc ::VisualQueryBuilder::repaintAll
892
893
894#----------------------------------------------------------
895# ::VisualQueryBuilder::showSQL
896#----------------------------------------------------------
897#
898proc ::VisualQueryBuilder::showSQL {} {
899
900  global PgAcVar
901  variable vqb
902
903  set sqlcmd [computeSQL]
904  set tl .showSQL
905  toplevel $tl -class Toplevel
906  wm title $tl [intlmsg "Show SQL"]
907  text $tl.txtSQL -height 15 -width 80 -bg white -wrap word
908  $tl.txtSQL insert end $sqlcmd
909  $tl.txtSQL configure -state disabled
910  button $tl.close -text "Close" -command {destroy .showSQL}
911  pack $tl.txtSQL -in $tl -fill both
912  pack $tl.close -in $tl -fill x
913
914}; # end proc ::VisualQueryBuilder::showSQL
915
916
917#------------------------------------------------------------
918# ::VisualQueryBuilder::saveToQueryBuilder
919#------------------------------------------------------------
920#
921proc ::VisualQueryBuilder::saveToQueryBuilder {} {
922
923    global PgAcVar tbquery
924    variable vqb
925
926    set tbl .pgaw:VisualQuery.pw.f1.frame.tb
927
928    Window show .pgaw:QueryBuilder
929    $::Queries::Win(qrytxt) delete 1.0 end
930    set vqb(qcmd) [computeSQL]
931    set PgAcVar(query,tables) [getTableList]
932    set PgAcVar(query,links) [getLinkList]
933    set PgAcVar(query,results) [list [$tbl cget -rows] [$tbl cget -cols] [array get tbquery]]
934    $::Queries::Win(qrytxt) insert end $vqb(qcmd)
935    focus .pgaw:QueryBuilder
936
937    return
938
939}; # end proc ::VisualQueryBuilder::saveToQueryBuilder
940
941
942#------------------------------------------------------------
943# ::VisualQueryBuilder::executeSQL
944#------------------------------------------------------------
945#
946proc ::VisualQueryBuilder::executeSQL {} {
947
948    global PgAcVar
949    variable vqb
950
951    set vqb(qcmd) [computeSQL]
952    set wn [Tables::getNewWindowName]
953    set PgAcVar(mw,$wn,query) [subst $vqb(qcmd)]
954    set PgAcVar(mw,$wn,updatable) 0
955    set PgAcVar(mw,$wn,isaquery) 1
956    Tables::createWindow
957    Tables::loadLayout $wn nolayoutneeded
958    Tables::selectRecords $wn $PgAcVar(mw,$wn,query)
959
960}; # end proc ::VisualQueryBuilder::executeSQL
961
962
963#------------------------------------------------------------
964# ::VisualQueryBuilder::tableButton1
965#------------------------------------------------------------
966#
967proc ::VisualQueryBuilder::tableButton1 {w x y} {
968
969  global PgAcVar
970  variable vqb
971  variable hlite
972
973  set cv  .pgaw:VisualQuery.pw.f0.frame.c
974  set tbl .pgaw:VisualQuery.pw.f1.frame.tb
975
976  set r [$tbl index @$x,$y row]
977  set c [$tbl index @$x,$y col]
978
979  # deselect everything else
980  deselectLinks
981  deselectTables
982  set hlite grid
983
984  if {$r==0 && $c>0} {
985    if {[$tbl tag includes HILITEcol $r,$c]} {
986      $tbl tag col {} $c
987    } else {
988      $tbl tag col HILITEcol $c
989    }
990  } elseif {$r>6 && $c==0} {
991    if {[$tbl tag includes HILITErow $r,$c]} {
992      $tbl tag row {} $r
993    } else {
994      $tbl tag row HILITErow $r
995    }
996  }
997
998  if {$r==4 && $c>0} {
999    if {[$tbl get $r,$c] != ""} {
1000      if {[string match Yes [$tbl get $r,$c]]} {
1001        $tbl set $r,$c No
1002      } else {
1003        $tbl set $r,$c Yes
1004      }
1005    }
1006  }
1007
1008  if {$r==3 && $c>0} {
1009    if {[$tbl get $r,$c] != ""} {
1010      if {[string match Unsorted [$tbl get $r,$c]]} {
1011        $tbl set $r,$c Ascending
1012      } elseif {[string match Ascending [$tbl get $r,$c]]} {
1013        $tbl set $r,$c Descending
1014      } elseif {[string match Descending [$tbl get $r,$c]]} {
1015        $tbl set $r,$c Unsorted
1016      } else {
1017        $tbl set $r,$c Unsorted
1018      }
1019    }
1020  }
1021}
1022
1023
1024#------------------------------------------------------------
1025# ::VisualQueryBuilder::tableButton3
1026#------------------------------------------------------------
1027#
1028proc ::VisualQueryBuilder::tableButton3 {w x y} {
1029
1030  global PgAcVar
1031  variable vqb
1032
1033  set cv  .pgaw:VisualQuery.pw.f0.frame.c
1034  set tbl .pgaw:VisualQuery.pw.f1.frame.tb
1035
1036  #set r [$tbl index @$x,$y row]
1037  #set c [$tbl index @$x,$y col]
1038
1039  if {[$tbl tag cell active] == ""} {return}
1040  if {[$tbl index active col]==0} {return}
1041  if {[$tbl index active row]>6} {
1042    $tbl.pop.casd entryconfigure 1 -state normal
1043    $tbl.pop.casi entryconfigure 1 -state normal
1044  } else {
1045    $tbl.pop.casd entryconfigure 1 -state disabled
1046    $tbl.pop.casi entryconfigure 1 -state disabled
1047  }
1048
1049  tk_popup $tbl.pop [winfo pointerx $w] [winfo pointery $w]
1050}
1051
1052
1053#============================================================
1054#   GUI
1055#============================================================
1056#
1057proc vTclWindow.pgaw:VisualQuery {base} {
1058
1059    global PgAcVar
1060    variable vqb
1061
1062    if {$base==""} {
1063        set base .pgaw:VisualQuery
1064    }
1065
1066    if {[winfo exists $base]} {
1067        wm deiconify $base; return
1068    }
1069
1070    toplevel $base -class Toplevel
1071    wm focusmodel $base passive
1072    wm geometry $base 759x530+10+13
1073    wm maxsize $base 1280 1024
1074    wm minsize $base 1 1
1075    wm overrideredirect $base 0
1076    wm resizable $base 1 1
1077    wm deiconify $base
1078    wm title $base [intlmsg "Visual query designer"]
1079
1080    bind $base <Key-F1> "Help::load visual_designer"
1081
1082    # frame widget for label and combobox
1083    frame $base.fb \
1084        -height 75 \
1085        -width 125
1086
1087    # label and combobox widgets to add a table
1088    Label $base.fb.ltable \
1089        -borderwidth 0 \
1090        -text [intlmsg "Add table"]
1091    ComboBox $base.fb.cbtable \
1092        -background #fefefe \
1093        -borderwidth 1 \
1094        -highlightthickness 0 \
1095        -values [concat [::Database::getPrefObjList Tables] \
1096            [::Database::getPrefObjList Views]] \
1097        -editable true \
1098        -textvariable ::VisualQueryBuilder::vqb(newtablename) \
1099        -modifycmd {::VisualQueryBuilder::addNewTable}
1100
1101    set ::VisualQueryBuilder::Win(entertable) $base.fb.cbtable
1102
1103    # butoon widgets for toolbar
1104    ButtonBox $base.fb.bbox \
1105        -orient horizontal \
1106        -homogeneous 1 \
1107        -spacing 2
1108    $base.fb.bbox add \
1109        -borderwidth 1 \
1110        -image ::icon::imagegallery-22 \
1111        -helptext [intlmsg "Show SQL"] \
1112        -command VisualQueryBuilder::showSQL
1113    $base.fb.bbox add \
1114        -borderwidth 1 \
1115        -image ::icon::misc-16 \
1116        -helptext [intlmsg "Execute SQL"] \
1117        -command VisualQueryBuilder::executeSQL
1118    $base.fb.bbox add \
1119        -borderwidth 1 \
1120        -image ::icon::filesave-22 \
1121        -helptext [intlmsg "Save to query builder"] \
1122        -command VisualQueryBuilder::saveToQueryBuilder
1123    $base.fb.bbox add \
1124        -borderwidth 1 \
1125        -image ::icon::fileprint-22 \
1126        -helptext [intlmsg "Print"] \
1127        -command VisualQueryBuilder::print
1128    $base.fb.bbox add \
1129        -borderwidth 1 \
1130        -image ::icon::help-22 \
1131        -helptext [intlmsg "Help"] \
1132        -command {::Help::load visual_designer}
1133    $base.fb.bbox add \
1134        -borderwidth 1 \
1135        -image ::icon::exit-22 \
1136        -helptext [intlmsg "Close"] \
1137        -command {Window destroy .pgaw:VisualQuery}
1138
1139    # create paned window to hold canvas and table
1140    set pw1 [PanedWindow $base.pw -side left]
1141    set pane1 [$pw1 add -minsize 100 -weight 2]
1142    set pane2 [$pw1 add -minsize 60 -weight 1]
1143
1144    canvas $pane1.c \
1145        -width 295 -height 207 \
1146        -background #CCCCCC \
1147        -borderwidth 2 \
1148        -relief ridge \
1149        -takefocus 0 \
1150        -yscrollcommand {.pgaw:VisualQuery.pw.f0.frame.sy set} \
1151        -xscrollcommand {.pgaw:VisualQuery.pw.f0.frame.sx set} \
1152        -scrollregion {-29.7c -21.0c 29.7c 21.0c};   #scrollregion equivalent to an A2 sheet
1153
1154    scrollbar $pane1.sy -command [list $pane1.c yview]
1155    scrollbar $pane1.sx -command [list $pane1.c xview] -orient horizontal
1156
1157    place $pane1.c -x 0 -y 0 -relheight 1.0 -relwidth 1.0 -height -18 -width -18 -anchor nw
1158    place $pane1.sy -relx 1.0 -y 0 -relheight 1.0 -height -18 -width 18 -anchor ne
1159    place $pane1.sx -x -18 -relx 1.0 -rely 1.0 -relwidth 1.0 -width -18 -anchor se
1160
1161    table $pane2.tb \
1162        -background white \
1163        -borderwidth 1 \
1164        -bordercursor crosshair \
1165        -colwidth 20 \
1166        -drawmode fast \
1167        -relief solid \
1168        -resizeborders both \
1169        -selectmode browse \
1170        -titlecols 1 -titlerows 1 \
1171        -yscrollcommand {.pgaw:VisualQuery.pw.f1.frame.sy set} \
1172        -xscrollcommand {.pgaw:VisualQuery.pw.f1.frame.sx set} \
1173        -variable tbquery
1174
1175    scrollbar $pane2.sy -command [list $pane2.tb yview]
1176    scrollbar $pane2.sx -command [list $pane2.tb xview] -orient horizontal
1177
1178    # Set table properties
1179    $pane2.tb tag config title -bg #CCCCCC -fg #000000 -anchor e
1180    $pane2.tb height 0 -10
1181    $pane2.tb width 0 -78
1182    #$pane2.tb tag configure sel -fg black
1183    $pane2.tb tag configure active -fg black
1184
1185    # set up tags for the various states of the columns
1186    $pane2.tb tag configure HILITEcol -bg darkblue -fg white
1187    $pane2.tb tag configure HILITErow -bg darkblue -fg white
1188
1189    place $pane2.tb -x 0 -y 0 -relheight 1.0 -relwidth 1.0 -height -18 -width -18 -anchor nw
1190    place $pane2.sy -relx 1.0 -y 0 -relheight 1.0 -height -18 -width 18 -anchor ne
1191    place $pane2.sx -x -18 -relx 1.0 -rely 1.0 -relwidth 1.0 -width [expr [$pane2.tb width 0] + -18] -anchor se
1192
1193    # create popup menu
1194    set p $pane2.tb.pop
1195    menu $p -type normal
1196    $p add cascade -label "Delete" -underline 0 -menu $pane2.tb.pop.casd
1197    $p add cascade -label "Insert" -underline 0 -menu $pane2.tb.pop.casi
1198
1199    # create cascade menu
1200    set d $pane2.tb.pop.casd
1201    menu $d -type normal
1202    $d add command -label "Column" -command {.pgaw:VisualQuery.pw.f1.frame.tb delete cols [.pgaw:VisualQuery.pw.f1.frame.tb index active col] 1}
1203    $d add command -label "Row" -command {.pgaw:VisualQuery.pw.f1.frame.tb delete rows [.pgaw:VisualQuery.pw.f1.frame.tb index active row] 1}
1204
1205    # create cascade menu
1206    set i $pane2.tb.pop.casi
1207    menu $i -type normal
1208    $i add command -label "Column" -command {.pgaw:VisualQuery.pw.f1.frame.tb insert cols [.pgaw:VisualQuery.pw.f1.frame.tb index active col] -1}
1209    $i add command -label "Row" -command {.pgaw:VisualQuery.pw.f1.frame.tb insert rows [.pgaw:VisualQuery.pw.f1.frame.tb index active row] -1}
1210
1211    # display widgets
1212    # frame
1213    pack $base.fb \
1214        -in $base \
1215        -expand 0 \
1216        -fill x
1217    # label
1218    pack $base.fb.ltable \
1219        -in $base.fb \
1220        -side left
1221    # combobox
1222    pack $base.fb.cbtable \
1223        -in $base.fb \
1224        -side left
1225    # toolbar
1226    pack $base.fb.bbox \
1227        -in $base.fb \
1228        -side right \
1229        -expand 0 \
1230        -fill x
1231    # PanedWindow
1232    pack $pw1 \
1233        -in $base \
1234        -expand 1 \
1235        -fill both
1236
1237    # point to canvas
1238    set cv  .pgaw:VisualQuery.pw.f0.frame.c
1239
1240    # some helpful key bindings for canvas
1241    bind $cv <Control-Key-w> [subst {destroy $base}]
1242    bind $cv <Key-Delete> {VisualQueryBuilder::deleteObject}
1243    bind $cv <Button-1> {VisualQueryBuilder::canvasClick %x %y}
1244
1245    #point to table
1246    set tbl .pgaw:VisualQuery.pw.f1.frame.tb
1247
1248    # some helpful key bindings for table
1249    bind $tbl <Button-1> {VisualQueryBuilder::tableButton1 %W %x %y}
1250    bind $tbl <Button-3> {VisualQueryBuilder::tableButton3 %W %x %y}
1251
1252    # Set up events for drop on table
1253    # -dropcmd and -droptypes must be set for DropSite to work
1254    DropSite::register $tbl -dropcmd {VisualQueryBuilder::tableDrop} \
1255                            -droptypes [list LISTBOX_ITEM [list copy [list alt]]]
1256}
1257