source: tol/tolbase/lib/toltk/calendar.tcl @ dd6e916

1941-docker-image-to-testdevel
Last change on this file since dd6e916 was 81d4b20, checked in by Liván Ramírez Dorta <livanr68@…>, 18 years ago

Expert on calendars did not work due to poor specification of an argument in a call to ::tol::timeset

git-svn-id: ​https://www.tol-project.org/svn/tolp/trunk@287 be4846ae-f051-483a-831f-b64e7d08527f
  • Property mode set to 100644
File size: 30.9 KB
Line 
1#/////////////////////////////////////////////////////////////////////////////
2# FILE    : calendar.tcl
3# PURPOSE : This file contains the namespace CalendarTms.
4#           CalendarTms is for creating a several months calendar to
5#           highlight dates in a TOL TimeSet.
6#/////////////////////////////////////////////////////////////////////////////
7
8
9#/////////////////////////////////////////////////////////////////////////////
10# Namespace CalendarTms
11#/////////////////////////////////////////////////////////////////////////////
12
13#/////////////////////////////////////////////////////////////////////////////
14  namespace eval CalendarTms {
15#
16# PURPOSE: The purpose of this namespace is organize code and functions.
17#          A special namespace is created for each instance of CalendarTms.
18#
19# VARIABLES:
20#   tmpOpt  -> temporary array used to store the widgets and variables of the
21#              options dialog.
22#   calendarExpert ->
23#
24#/////////////////////////////////////////////////////////////////////////////
25  variable tmpOpt
26  variable calendarExpert ""
27}
28
29#/////////////////////////////////////////////////////////////////////////////
30  proc ::CalendarTms::Create {path {tms {}} } {
31#
32# PURPOSE: Creates a CalendarTms instance. Creates and packs the calendar
33#          window (frame with toolbar, month calendars and status bar)
34#
35# PARAMETERS:
36#   path ->
37#   tms  -> Timeset that is used.
38#
39# RETURN: CalendarTms instance
40#
41#/////////////////////////////////////////////////////////////////////////////
42  set instance ::CalendarTms::$path
43
44  #  A namespace is created for each bayes graph widget.
45
46  namespace eval $instance {
47 
48    # data -> array with information about the instance:
49    #   this  -> path to frame of the widget
50    #   all   -> if it's a general CalendarTms
51    #   tms   -> if it isn't a general CalendarTms, the TimeSet to highlight
52    #   rows  -> number of rows
53    #   cols  -> number of cols
54    #   n     -> number of months that are in the calendar
55    #   day   -> day selected
56    #   month -> month selected
57    #   year  -> year selected
58
59    variable data
60
61  }
62  upvar \#0 ${instance}::data data
63   
64  # Use or not of timeset specify
65  if {($tms == "")} {
66    set data(all)   1
67  } else  {
68    set data(tms)   $tms
69  }
70  # Read the origin configuration
71  ReadIni $instance 
72
73  set data(n) [expr $data(rows)*$data(cols)] 
74  set data(day)   1
75
76  # Create the widgets
77  set data(this)  [frame $path -class CalendarTms]
78
79  bind $data(this) <Destroy> [list ::CalendarTms::Destroy $instance]
80  set sw [ScrolledWindow $path.sw]
81  # buttons
82  set bbox [ButtonBox $path.bb -orient horizontal -spacing 5 -padx 0 -pady 0]
83  $bbox add -image [Bitmap::get "begin"] -height 16 -width 16\
84    -command [list ::CalendarTms::Adjust $instance  0 -1]\
85    -helptext [mc "Moves to previous year"] -relief link
86  $bbox add -image [Bitmap::get "reverse"] -height 16 -width 16\
87    -command [list ::CalendarTms::Adjust $instance -1 0]\
88    -helptext [mc "Moves to previous month"] -relief link
89  set data(back) [$bbox add -image [Bitmap::get "backward"] -height 1 -width 3\
90        -command [list ::CalendarTms::Back $instance]\
91        -helptext [mc "Moves to previous %1\$d months" $data(n)] -relief link]
92  set data(next) [$bbox add -image [Bitmap::get "forward"] -height 1 -width 3\
93        -command [list ::CalendarTms::Next $instance]\
94        -helptext [mc "Moves to next %1\$d months" $data(n)] -relief link]
95  $bbox add -image [Bitmap::get "play"] -height 16 -width 16\
96    -command [list ::CalendarTms::Adjust $instance  1  0]\
97    -helptext [mc "Moves to next month"] -relief link
98  $bbox add -image [Bitmap::get "end"] -height 16 -width 16\
99    -command [list ::CalendarTms::Adjust $instance  0  1]\
100    -helptext [mc "Moves to next year"] -relief link
101  set data(zoomin) [$bbox add -image [Bitmap::get "zoomin"] -height 16\
102         -width 16\
103         -command [list ::CalendarTms::ZoomIn $instance]\
104          -helptext [mc "Zoom In"] -relief link]
105  set data(zoomout) [$bbox add -image [Bitmap::get "zoomout"] -height 16\
106          -width 16\
107          -command [list ::CalendarTms::ZoomOut $instance]\
108          -helptext [mc "Zoom Out"] -relief link]
109  $bbox add -image [Bitmap::get "tools"] -height 16 -width 16\
110     -command [list ::CalendarTms::OptionsCreate $instance]\
111     -helptext [mc Options] -relief link
112 
113  if {[info exists data(all)]} { ;# General calendar
114    set data(allTms) [::tol::info variable TimeSet]
115    #puts "::CalendarTms::Create data(allTms) = $data(allTms)"
116    foreach item $data(allTms) {
117      ::tol::timeset create $item [list TimeSet $item]
118    }
119    label $path.lTms -text [mc TimeSet]:
120    # Combobox with the timesets
121    bcombobox $path.cbTms -width 18 -height 5 -editable false \
122        -values $data(allTms) \
123        -textvariable ::CalendarTms::${path}::data(tms) \
124        -modifycmd [list ::CalendarTms::Display $instance]
125  }
126 
127  set sf [ScrollableFrame $path.sw.fr -width 450]
128  $sw setwidget $sf
129  set f [$sf getframe]
130  set data(frame) $f
131  # Creation of the calendar
132  CreateCalendars $instance
133  # Set the statusbars
134  set data(statusbar) [frame $path.status]
135  set status_sep [Separator $data(statusbar).ss -orient horizontal]
136  set sf [frame $data(statusbar).sf]
137  set data(statusbar,cursor) [label $sf.cursor -text "" -relief sunken\
138                              -width 13]
139  grid $data(statusbar,cursor) -sticky w
140  grid columnconfigure $sf 1 -weight 1
141  grid $status_sep -sticky ew -pady 2
142  grid $sf         -sticky ew
143
144  grid columnconfigure $data(statusbar) 0 -weight 1
145
146  if {[info exists data(all)]} {
147    # If it's a general calendar
148    grid $path.bb $path.lTms $path.cbTms -sticky nw -padx 2
149    grid $path.sw     -columnspan 3      -sticky news
150    grid $path.status -columnspan 3      -sticky  ew
151  } else  {
152    # If the calendar is of specific timeset
153    grid $path.bb     -sticky nw -padx 2
154    grid $path.sw     -sticky news
155    grid $path.status -sticky  ew
156  }
157  # Packing the canvas
158  grid rowconfigure    $path 1 -weight 1
159  grid columnconfigure $path 0 -weight 1
160
161}
162
163#/////////////////////////////////////////////////////////////////////////////
164proc ::CalendarTms::CreateCalendars {instance} {
165#
166# PURPOSE:  Associates the events and packs every month of calendar.
167#
168#/////////////////////////////////////////////////////////////////////////////
169  upvar \#0 ${instance}::data data
170 
171  set month $data(month)
172  set year  $data(year)
173 
174  for {set i 0} {$i < $data(n)} {incr i} {
175    # associates the events of every month of the calendar.
176    date::Chooser $data(frame).$i $month $year \
177        [list OnClickDay "::CalendarTms::GetDay $instance" \
178             CheckDate   "::CalendarTms::CheckDate $instance" \
179             OnDoubleDay "::CalendarTms::ShowHours $instance"]
180    incr month
181    if {$month>12} {set month 1; incr year}
182  }
183  # Pack every month of calendar
184  for {set i 0} {$i < $data(rows)} {incr i} {
185    for {set j 0} {$j < $data(cols)} {incr j} {
186        grid $data(frame).[expr $data(cols)*$i + $j] -row $i -column $j \
187                                                     -sticky news
188
189    }
190  }
191}
192
193#/////////////////////////////////////////////////////////////////////////////
194proc  ::CalendarTms::Destroy { instance } {
195#
196# PURPOSE: Destroy the instance of CalendarTms
197#
198#/////////////////////////////////////////////////////////////////////////////   
199  upvar \#0 ${instance}::data data
200  # Eliminates the different used timesets
201  if {[info exists data(all)]} {
202    foreach item $data(allTms) {
203      ::tol::timeset destroy $item
204    }
205  }
206  # Save the state 
207  WriteIni $instance
208  # Delete the namespace of the instace
209  namespace delete $instance
210}
211
212#/////////////////////////////////////////////////////////////////////////////
213proc ::CalendarTms::ReadIni {instance} {
214#
215# PURPOSE: Load the configuration of calendar.
216#
217#/////////////////////////////////////////////////////////////////////////////
218  upvar \#0 ${instance}::data data
219  ::date::Init
220  upvar \#0 ::date::a a
221  set rini ::iniFile::Read
222
223  # Definition of options of the calendar
224  # Year of the first month of calendar 
225  set data(year)     [$rini Calendar year  [lindex [::tol::date now] 0]]
226  # First month of calendar
227  set data(month)    [$rini Calendar month [lindex [::tol::date now] 1]]
228  # Definition of position and separation between the elements of calendar
229  set data(rows)     [$rini Calendar rows 2]
230  set data(cols)     [$rini Calendar cols 3]
231  set a(dx)          [$rini Calendar dx  18]
232  set a(dy)          [$rini Calendar dy  14]
233  set a(-mon)        [$rini Calendar mon  0]
234  set a(otherday)    [$rini Calendar otherday 1]
235  set a(-bg)         [$rini Calendar bg white]
236  # Definition of values of presentation of calendar.
237  array set def {
238    titlefont     {Helvetica 10 bold}
239    weekdaysfont  {Helvetica 9}
240    dayfont       {Helvetica 9}
241    otherfont     {Helvetica 9}
242    titlefill     black
243    weekdaysfill  blue
244    dayfill       black
245    otherfill     grey
246    h1type        oval
247    h1font        {Helvetica 9 bold}
248    h1color       red
249    #h1fill        LightYellow
250    #h1outline     red
251    h1fill        ""
252    h1outline     ""
253    h2type        rect
254    h2font        {Helvetica 9 italic}
255    h2color       orange
256    #h2fill        white
257    #h2outline     blue
258    h2fill        ""
259    h2outline     ""
260  }
261  # Load of values of configuration
262  # Example: -$pre$post-> -dayfill 
263  foreach pre {title weekdays other day} {
264    foreach post {font fill} {
265        set a(-$pre$post) [$rini Calendar $pre$post $def($pre$post)]
266    }
267  }
268  foreach pre {h1 h2} {
269    foreach post {font color type fill outline} {
270       set a(-$pre$post) [$rini Calendar $pre$post $def($pre$post)]
271    }
272  }
273}
274
275#/////////////////////////////////////////////////////////////////////////////
276proc ::CalendarTms::WriteIni {instance} {
277#
278# PURPOSE: Save the configuration of calendar.
279#
280#/////////////////////////////////////////////////////////////////////////////
281  upvar \#0 ${instance}::data data
282  upvar \#0 ::date::a a
283  set wini ::iniFile::Write
284  # Write the values of position and separation between the elements
285  $wini Calendar year     $data(year)
286  $wini Calendar month    $data(month)
287  $wini Calendar rows     $data(rows)
288  $wini Calendar cols     $data(cols)
289  $wini Calendar dx       $a(dx)
290  $wini Calendar dy       $a(dy)
291  $wini Calendar mon      $a(-mon)
292  $wini Calendar otherday $a(otherday)
293  $wini Calendar bg       $a(-bg)
294
295  # Write of values of configuration
296  foreach pre {title weekdays other day} {
297    foreach post {font fill} {
298      $wini Calendar $pre$post $a(-$pre$post)
299    }
300  }
301  foreach pre {h1 h2} {
302    foreach post {font color type fill outline} {
303      $wini Calendar $pre$post $a(-$pre$post)
304    }
305  }
306  ::iniFile::Flush
307}
308
309#/////////////////////////////////////////////////////////////////////////////
310proc ::CalendarTms::GetDay {instance day month year tags} {
311#
312# PURPOSE: Shows the date in format tol in the bottom bar
313#
314#/////////////////////////////////////////////////////////////////////////////
315  upvar \#0 ${instance}::data data   
316#puts "##################"
317#puts [ListHours $instance $day $month $year]
318  set data(date) $day/$month/$year
319  $data(statusbar,cursor) configure\
320       -text "y${year}m[format "%02d" $month]d[format "%02d" $day]"   
321}
322
323#/////////////////////////////////////////////////////////////////////////////
324proc ::CalendarTms::ShowHours {instance day month year tags} {
325#/////////////////////////////////////////////////////////////////////////////   
326  if { [lsearch $tags type2] != -1 } {
327#puts "day: $day"
328#puts "month: $month"
329#puts "year: $year"
330#puts "tags: $tags"
331#puts [concat "textSalida: " [ListHours $instance $day $month $year] ]
332           
333    Tolcon_Trace [ListHours $instance $day $month $year]
334  }
335}
336
337#/////////////////////////////////////////////////////////////////////////////
338proc ::CalendarTms::DateTol {day month year} {
339#/////////////////////////////////////////////////////////////////////////////
340#    set day   
341#    set month 
342#    set year   
343}
344
345#/////////////////////////////////////////////////////////////////////////////
346proc ::CalendarTms::ZoomIn {instance} {
347#
348# PURPOSE: Increases the distance between the elements of calendar.
349#
350#/////////////////////////////////////////////////////////////////////////////   
351  upvar \#0 ${instance}::data data
352  upvar \#0 ::date::a a   
353  # Increases the distance between the elements
354  set a(dx) [expr $a(dx)+1]
355  set a(dy) [expr $a(dy)+1]
356  # It isn't possible to be extended more
357  if {$a(dx) >= $a(dxmax)} { ;# Horizontally
358    set a(dx) $a(dxmax)
359    $data(zoomin) configure -state disabled
360  }
361  if {$a(dy) >= $a(dymax)} { ;# Vertically
362    set a(dy) $a(dymax)
363    $data(zoomin) configure -state disabled
364  }
365  # Now it's possible to zoom out 
366  $data(zoomout) configure -state normal
367  Display $instance
368}
369
370#/////////////////////////////////////////////////////////////////////////////
371proc ::CalendarTms::ZoomOut {instance} {
372#
373# PURPOSE: Decreases the distance between the elements of calendar.
374#
375#/////////////////////////////////////////////////////////////////////////////   
376  upvar \#0 ${instance}::data data   
377  upvar \#0 ::date::a a
378  # Decreases the distance between the elements
379  set a(dx) [expr $a(dx)-1]
380  set a(dy) [expr $a(dy)-1]
381  # It isn't possible to be reduced more
382  if {$a(dx) <= $a(dxmin)} { ;# Horizontally
383    set a(dx) $a(dxmin)
384    $data(zoomout) configure -state disabled
385  }
386  if {$a(dy) <= $a(dymin)} { ;# Vertically
387    set a(dy) $a(dymin)
388    $data(zoomout) configure -state disabled
389  }
390   # Now it's possible to zoom in
391  $data(zoomin) configure -state normal
392  Display $instance
393}
394
395#/////////////////////////////////////////////////////////////////////////////
396proc ::CalendarTms::Display {instance} {
397#
398# PURPOSE: Displays each one of the months of calendar
399#
400#/////////////////////////////////////////////////////////////////////////////   
401  upvar \#0 ${instance}::data data 
402  set n [expr $data(rows)*$data(cols)]
403  # Display each month
404  for {set i 0} {$i < $n} {incr i} {   
405    date::Display ::date::$data(frame).$i
406  }
407}
408
409#/////////////////////////////////////////////////////////////////////////////
410proc ::CalendarTms::ReDisplay {instance} {
411#
412# PURPOSE: Refresh the calendar.
413#
414#/////////////////////////////////////////////////////////////////////////////   
415  upvar \#0 ${instance}::data data
416  # Destroy the previous calendar
417  for {set i 0} {$i < $data(n)} {incr i} {
418    destroy $data(frame).$i
419  }
420  set data(n) [expr $data(rows)*$data(cols)]
421  # Configure back and next buttons   
422  $data(back) configure -helptext \
423        [mc "Moves to previous %1\$d months" $data(n)]
424  $data(next) configure -helptext \
425        [mc "Moves to next %1\$d months" $data(n)]
426  # Create and display updated calendar
427  CreateCalendars $instance
428  Display $instance
429}
430
431#/////////////////////////////////////////////////////////////////////////////
432proc ::CalendarTms::Adjust {instance dmonth dyear} {
433#
434# PURPOSE: Move to a calendar witch starts in a concrete month and year,
435#          with a displacement respect to the present values.
436#
437# PARAMETERS:
438#     dmonth -> Amount of months to displace. Example: 1 next or -1 previous
439#     dyear -> Amount of years to displace. Example: 1 next or -1 previous
440#
441#/////////////////////////////////////////////////////////////////////////////
442  upvar \#0 ${instance}::data data
443  # The increases or decrements are applied
444  incr data(year)  $dyear
445  incr data(month) $dmonth
446  # Increases the year of the calendar
447  if {$data(month)>12} {
448    incr data(year)  [expr $data(month)/12]
449    set data(month)  [expr $data(month)%12]
450  }
451  # Decreases the year of the calendar
452  if {$data(month)<1}  {
453    incr data(year) -[expr 1+abs($data(month))/12]
454    set data(month) [expr 12 - (abs($data(month))%12)]       
455  }
456  # Adjust the calendars of all the months
457  set n [expr $data(rows)*$data(cols)]
458  for {set i 0} {$i < $n} {incr i} {
459    date::Adjust ::date::$data(frame).$i $dmonth $dyear
460  }
461}
462
463#/////////////////////////////////////////////////////////////////////////////
464proc ::CalendarTms::Back {instance} {
465#
466# PURPOSE: Moves the calendar to the previous [n number of months].
467#
468#/////////////////////////////////////////////////////////////////////////////   
469  upvar \#0 ${instance}::data data
470  Adjust $instance -$data(n) 0
471}
472
473#/////////////////////////////////////////////////////////////////////////////
474proc ::CalendarTms::Next {instance} {
475#
476# PURPOSE: Moves the calendar to the following [n number of months].
477#
478#/////////////////////////////////////////////////////////////////////////////
479  upvar \#0 ${instance}::data data
480  Adjust $instance $data(n) 0
481}
482
483# Return -
484
485#/////////////////////////////////////////////////////////////////////////////
486proc ::CalendarTms::CheckDate {instance day month year} {
487#
488# PURPOSE: Check if a date is belongs to a Timeset.
489#
490# PARAMETERS:
491#     day, month, year -> Date to check.
492#       
493# RETURN:
494#    0 - date does not belong to tms
495#    1 - date does belong to tms but only the hour 0 of that day
496#    2 - date does belong and some other hour of the same day
497#
498#/////////////////////////////////////////////////////////////////////////////   
499  upvar \#0 ${instance}::data data
500  set result 0
501  set date "$year $month $day"
502  # The calendar has a Timeset
503  if { [string length $data(tms)] } {
504    # The date belongs to the Timeset
505    #puts "::CalendarTms::CheckDate data(tms) = $data(tms)"   
506    set result [$data(tms) contain $date]
507   #foreach {y0 m0 d0 h0 mi0 s0} [$data(tms) start [list $year $month $day]] break
508   # if { $y0 == $year && $m0 == $month && $d0 == $day } {
509   #   if { [expr $h0 + $mi0 + $s0 > 0] } {
510   #     set result 2
511   #   } else {
512   #     foreach {y0 m0 d0} [$data(tms) next] break
513   #     set result [expr (($y0 == $year) && ($m0 == $month) && ($d0 == $day))+1]
514   #   }
515   # }
516  }
517  return $result
518}
519
520#/////////////////////////////////////////////////////////////////////////////
521proc ::CalendarTms::ListHours {instance day month year} {
522#
523# PURPOSE:
524#
525# PARAMETERS:
526#     day, month, year -> Date
527#
528#/////////////////////////////////////////////////////////////////////////////   
529  upvar \#0 ${instance}::data data
530  set lstHours {}
531  # The calendar has a Timeset
532  if { [string length $data(tms)] } {
533    set tick [$data(tms) start [list $year $month $day]]
534    foreach {y0 m0 d0} $tick break
535    while { ($y0 == $year) && ($m0 == $month) && ($d0 == $day) } {
536      lappend lstHours [lrange $tick 3 end]
537      set tick [$data(tms) next]
538      foreach {y0 m0 d0} $tick {
539        break
540      }
541    }
542  }
543  set lstHours
544}
545
546#/////////////////////////////////////////////////////////////////////////////
547proc ::CalendarTms::ViewTimeSet {} {
548#
549# PURPOSE:
550#
551#/////////////////////////////////////////////////////////////////////////////   
552  # create
553  if { [winfo exists $::CalendarTms::calendarExpert] } {
554    if { [$::CalendarTms::calendarExpert cget -state] eq "minimized" } {
555      $::CalendarTms::calendarExpert restore
556    }
557    $::CalendarTms::calendarExpert raise
558        return
559  } else {
560    set tl [::project::CreateForm \
561              -width 470 -height 345 \
562              -iniconfig Calendar -title [mc "TimeSets calendar"] \
563              -helpkey  "Tb4Cal"]
564        set tlf [$tl getframe]
565    set ::CalendarTms::calendarExpert $tl
566    # config
567        ::CalendarTms::Create $tlf.t
568    $tl bind <Control-F4> [list $tl kill]
569    pack $tlf.t -fill both -expand yes
570  }
571}
572
573#/////////////////////////////////////////////////////////////////////////////
574proc ::CalendarTms::OptionsCreate {instance} {
575#
576# PURPOSE: It creates the a dialog of options of the calendar
577#
578#/////////////////////////////////////////////////////////////////////////////   
579  upvar \#0 ${instance}::data data
580  variable tmpOpt
581  # Read the options that the calendar had previously
582  OptionsGet $instance
583  # Create the dialog 
584  set path $data(this)
585  set dialog [Dialog $data(this).t -title [mc "Calendar Options"]\
586            -default 0 \
587            -parent $data(this) -modal local]
588  wm protocol $dialog WM_DELETE_WINDOW \
589        [list ::CalendarTms::OptionsDestroy $instance $dialog]
590  # Create the frame within the dialog
591  set w [$dialog getframe]
592  wm resizable $dialog 0 0
593  # Create the set of tabs
594  set w_tabset [::blt::tabset $w.ts -relief flat -highlightthickness 0\
595            -bd 0 -outerpad 0 -tier 2 -slant right -textside right]
596  $w_tabset insert end General Style Highlight
597  # Create each one of frames
598  set f1 [frame $w_tabset.f1]
599  set f2 [frame $w_tabset.f2]
600  set f3 [frame $w_tabset.f3]
601  # Create each one of tabs
602  $w_tabset tab configure "General" -text [mc "General"]\
603          -window $f1 -fill both -padx 0 -selectbackground \#d9d9d9 -bg gray75
604  $w_tabset tab configure "Style" -text [mc "Style"]\
605          -window $f2 -fill both -padx 0 -selectbackground \#d9d9d9 -bg gray75
606  $w_tabset tab configure "Highlight" -text [mc "Highligth"]\
607          -window $f3 -fill both -padx 0 -selectbackground \#d9d9d9 -bg gray75
608  # Fill up each one of the tabs
609  OptionsCreateGeneral $instance $f1
610  OptionsCreateStyle   $instance $f2
611  OptionsCreateHighlight $instance $f3
612   
613  set w_bbox \
614          [ButtonBox $w.bb -orient horizontal -spacing 10 -padx 0 -pady 0 \
615          -homogeneous false]
616  $w_bbox add -text [mc "Accept"] -relief link \
617          -helptext [mc "Accept"] \
618          -image [::Bitmap::get accept] -compound left -padx 5 -pady 1 \
619          -command [list ::CalendarTms::OptionsOK $instance $dialog]
620  $w_bbox add -text [mc "Cancel"] -relief link \
621          -helptext [mc "Cancel"]\
622          -image [::Bitmap::get cancelx] -compound left -padx 5 -pady 1 \
623          -command [list ::CalendarTms::OptionsDestroy $instance $dialog]
624  $w_bbox add -text [mc "Apply"] -relief link \
625          -helptext [mc "Apply"]\
626          -image [::Bitmap::get apply] -compound left -padx 5 -pady 1 \
627          -command [list ::CalendarTms::OptionsApply $instance]     
628   
629    # Pack all created components
630    pack $w_bbox -fill x -expand false -side bottom
631    pack $w_tabset -fill both -expand true
632   
633  $dialog draw
634}
635
636#/////////////////////////////////////////////////////////////////////////////
637proc ::CalendarTms::OptionsCreateGeneral {instance w} {
638#
639# PURPOSE: Creation of the tab "General Options"
640#
641# PARAMETERS:
642#     w -> frame container
643#
644#/////////////////////////////////////////////////////////////////////////////
645  variable tmpOpt
646  TitleFrame $w.tf -text [mc "General Options"]
647  set f [$w.tf getframe]
648
649  #month and year
650  label $f.lm -text [mc Month]:
651  SpinBox $f.sbm -range {1 12 1}\
652    -textvariable ::CalendarTms::tmpOpt(var,month) -width 6 -editable 0
653  label $f.ly -text [mc Year]:
654  SpinBox $f.sby -range {0 9999 1}\
655     -textvariable ::CalendarTms::tmpOpt(var,year) -width 6
656  #rows and columns
657  label $f.lr -text [mc Rows]:
658  SpinBox $f.sbr -range {1 8 1}\
659    -textvariable ::CalendarTms::tmpOpt(var,rows) -width 6 -editable 0
660  label $f.lc -text [mc Columns]:
661  SpinBox $f.sbc -range {1 8 1}\
662    -textvariable ::CalendarTms::tmpOpt(var,cols)  -width 6 -editable 0
663  #other options
664  checkbutton $f.mon -text [mc "Sunday starts week"]\
665     -variable ::CalendarTms::tmpOpt(var,-mon)   
666  checkbutton $f.oth  -text [mc "Other days"]\
667     -variable ::CalendarTms::tmpOpt(var,otherday)
668
669  frame $f.f -width 25
670  grid $f.f $f.lm   $f.sbm  $f.ly   $f.sby -sticky nw -pady 1 -padx 2
671  grid ^    $f.lr   $f.sbr  $f.lc   $f.sbc -sticky nw -pady 1 -padx 2
672  grid ^    $f.mon  -       -       $f.oth -sticky nw -pady 2 -padx 2
673  grid columnconfigure $f 4 -weight 1
674  grid rowconfigure    $f 2 -weight 1
675  grid columnconfigure $f 1 -pad 20
676
677  grid $w.tf -sticky news -padx 2
678  grid rowconfigure    $w 0 -weight 1
679  grid columnconfigure $w 0 -weight 1
680}
681
682#/////////////////////////////////////////////////////////////////////////////
683proc ::CalendarTms::OptionsCreateStyle {instance w} {
684#
685# PURPOSE: Creation of the tab "Appareance Options"
686#
687# PARAMETERS:
688#     w -> frame container
689#
690#/////////////////////////////////////////////////////////////////////////////   
691  global toltk_options
692  variable tmpOpt
693  TitleFrame $w.tf -text [mc "Appareance Options"]
694  set f [$w.tf getframe]
695  #Colors and fonts
696  label $f.lbg -text [mc "Background"]:
697  ::Objects::ColorCreate ::CalendarTms::tmpOpt(var,-bg) $f.fbg
698
699  label $f.lFont  -text [mc "Font"]  -font $toltk_options(fonts,Title1)
700  label $f.lColor -text [mc "Color"] -font $toltk_options(fonts,Title1)
701
702  label $f.lt -text [mc "Month names"]:
703  ::Objects::FontCreate ::CalendarTms::tmpOpt(var,-titlefont) $f.btf
704  ::Objects::ColorCreate ::CalendarTms::tmpOpt(var,-titlefill) $f.ftc
705  label $f.lw -text [mc "Weekdays"]:
706  ::Objects::FontCreate ::CalendarTms::tmpOpt(var,-weekdaysfont) $f.bwf
707  ::Objects::ColorCreate ::CalendarTms::tmpOpt(var,-weekdaysfill) $f.fwc
708  label $f.ld -text [mc "Month days"]:
709  ::Objects::FontCreate ::CalendarTms::tmpOpt(var,-dayfont) $f.bdf
710  ::Objects::ColorCreate ::CalendarTms::tmpOpt(var,-dayfill) $f.fdc
711  label $f.lo -text [mc "Other days"]:
712  ::Objects::FontCreate ::CalendarTms::tmpOpt(var,-otherfont) $f.bof
713  ::Objects::ColorCreate ::CalendarTms::tmpOpt(var,-otherfill) $f.foc
714
715  frame $f.f -width 25
716  grid $f.f $f.lbg $f.fbg    -          -sticky nw -pady 0 -padx 2
717  grid ^    ^      $f.lFont  $f.lColor  -sticky n -pady 2 -padx 2
718  grid ^    $f.lt  $f.btf    $f.ftc     -sticky n -pady 0 -padx 2
719  grid ^    $f.lw  $f.bwf    $f.fwc     -sticky n -pady 0 -padx 2
720  grid ^    $f.ld  $f.bdf    $f.fdc     -sticky n -pady 0 -padx 2
721  grid ^    $f.lo  $f.bof    $f.foc     -sticky n -pady 0 -padx 2
722 
723  grid configure $f.lbg $f.lt $f.lw $f.ld $f.lo -sticky nw
724
725  grid columnconfigure $f 4 -weight 1
726  grid rowconfigure    $f 6 -weight 1
727
728  grid $w.tf -sticky news -padx 2
729  grid rowconfigure    $w 0 -weight 1
730  grid columnconfigure $w 0 -weight 1
731}
732
733#/////////////////////////////////////////////////////////////////////////////
734proc ::CalendarTms::OptionsCreateHighlight {instance w} {
735#
736# PURPOSE: Creation of the tab "Highligth Appareance Options"
737#
738# PARAMETERS:
739#     w -> frame container
740#
741#/////////////////////////////////////////////////////////////////////////////   
742  global toltk_options
743  variable tmpOpt
744  TitleFrame $w.tf -text [mc "Highligth Appareance Options"]
745  set f [$w.tf getframe]
746
747
748  frame $f.f
749  label $f.lFont    -text [mc "Font"]    -font $toltk_options(fonts,Title1)
750  label $f.lColor   -text [mc "Color"]   -font $toltk_options(fonts,Title1)
751  label $f.lType    -text [mc "Type"]    -font $toltk_options(fonts,Title1)
752  label $f.lFill    -text [mc "Fill"]    -font $toltk_options(fonts,Title1)
753  label $f.lOutline -text [mc "Outline"] -font $toltk_options(fonts,Title1)
754
755  label $f.lh1 -text [mc "Full highligth"]:
756  ::Objects::FontCreate ::CalendarTms::tmpOpt(var,-h1font) $f.bh1fo
757  ::Objects::ColorCreate ::CalendarTms::tmpOpt(var,-h1color) $f.fh1c
758  radiobutton $f.rbh1O -text [mc oval] -value oval -highlightthickness 0 \
759    -pady 0 -variable ::CalendarTms::tmpOpt(var,-h1type)
760  radiobutton $f.rbh1R -text [mc "rectangle"] -value rect -highlightthickness 0\
761    -pady 0 -variable ::CalendarTms::tmpOpt(var,-h1type)
762  ::Objects::ColorCreate ::CalendarTms::tmpOpt(var,-h1fill)    $f.fh1f "" 1
763  ::Objects::ColorCreate ::CalendarTms::tmpOpt(var,-h1outline) $f.fh1o "" 1
764  label $f.lh2 -text [mc "Partial highligth"]: -anchor w
765  ::Objects::FontCreate ::CalendarTms::tmpOpt(var,-h2font) $f.bh2fo
766  ::Objects::ColorCreate ::CalendarTms::tmpOpt(var,-h2color) $f.fh2c
767  radiobutton $f.rbh2O -text [mc "oval"] -value oval -highlightthickness 0\
768    -pady 0 -variable ::CalendarTms::tmpOpt(var,-h2type)
769  radiobutton $f.rbh2R -text [mc "rectangle"] -value rect -highlightthickness 0\
770    -pady 0 -variable ::CalendarTms::tmpOpt(var,-h2type)
771  ::Objects::ColorCreate ::CalendarTms::tmpOpt(var,-h2fill)    $f.fh2f "" 1
772  ::Objects::ColorCreate ::CalendarTms::tmpOpt(var,-h2outline) $f.fh2o "" 1
773
774  grid $f.f   $f.lFont $f.lColor $f.lType  -         $f.lFill $f.lOutline \
775    -sticky n -pady 2 -padx 2
776  grid $f.lh1 $f.bh1fo $f.fh1c   $f.rbh1O  $f.rbh1R  $f.fh1f  $f.fh1o     \
777    -sticky n
778  grid $f.lh2 $f.bh2fo $f.fh2c   $f.rbh2O  $f.rbh2R  $f.fh2f  $f.fh2o     \
779    -sticky n
780
781  grid configure $f.lh1 $f.lh2 -sticky nw
782
783  grid columnconfigure $f 7 -weight 1
784  grid rowconfigure    $f 3 -weight 1
785
786  grid $w.tf -sticky news -padx 2
787  grid rowconfigure    $w 0 -weight 1
788  grid columnconfigure $w 0 -weight 1
789}
790
791#/////////////////////////////////////////////////////////////////////////////
792  proc ::CalendarTms::OptionsDestroy {this dialog} {
793#
794# PURPOSE: Destroy options dialog
795#
796# PARAMETERS:
797#   this   -> Instance of CalendarTms
798#   dialog -> Options dialog
799#
800#/////////////////////////////////////////////////////////////////////////////
801  variable tmpOpt
802  array unset tmpOpt
803  destroy $dialog
804}
805
806#/////////////////////////////////////////////////////////////////////////////
807proc ::CalendarTms::OptionsGet {instance} {
808#
809# PURPOSE: Get the options from the variable temporary tmpOpt to the Calendar
810#   
811#/////////////////////////////////////////////////////////////////////////////   
812  upvar \#0 ${instance}::data data
813  upvar \#0 ::date::a a
814  variable tmpOpt
815  # Get the the own options of the calendar
816  set tmpOpt(var,year)       $data(year)
817  set tmpOpt(var,month)      $data(month)
818  set tmpOpt(var,rows)       $data(rows)
819  set tmpOpt(var,cols)       $data(cols)
820  set tmpOpt(var,-mon)       $a(-mon)
821  set tmpOpt(var,otherday)   $a(otherday)
822  set tmpOpt(var,-bg)        $a(-bg)
823  # Get the options of presentation of the calendar 
824  foreach pre {-title -weekdays -other -day} {
825    foreach post {font fill} {
826      set tmpOpt(var,$pre$post) $a($pre$post)
827    }
828  }
829  foreach pre {-h1 -h2} {
830    foreach post {font color type fill outline} {
831      set tmpOpt(var,$pre$post) $a($pre$post)
832    }
833  }
834}
835
836#/////////////////////////////////////////////////////////////////////////////
837proc ::CalendarTms::OptionsSet {instance} {
838#
839# PURPOSE: Set the options from the Calendar to the variable temporary tmpOpt
840#
841#/////////////////////////////////////////////////////////////////////////////
842  upvar \#0 ${instance}::data data
843  upvar \#0 ::date::a a
844  variable tmpOpt
845  # Set the the own options of the calendar
846  set data(year)    $tmpOpt(var,year)
847  set data(month)   $tmpOpt(var,month)
848  set data(rows)    $tmpOpt(var,rows)
849  set data(cols)    $tmpOpt(var,cols)
850  set a(-mon)       $tmpOpt(var,-mon)
851  set a(otherday)   $tmpOpt(var,otherday)
852  set a(-bg)        $tmpOpt(var,-bg)
853  # Set the options of presentation of the calendar
854  foreach pre {-title -weekdays -other -day} {
855    foreach post {font fill} {
856      set a($pre$post) $tmpOpt(var,$pre$post)
857    }
858  }
859  foreach pre {-h1 -h2} {
860    foreach post {font color type fill outline} {
861      set a($pre$post) $tmpOpt(var,$pre$post)
862    }
863  }
864}
865
866#/////////////////////////////////////////////////////////////////////////////
867proc ::CalendarTms::OptionsApply {instance} {
868#
869# PURPOSE: The options are applied, and the dialogue is refreshed without
870#          destroying it
871#
872#/////////////////////////////////////////////////////////////////////////////   
873  OptionsSet $instance
874  ReDisplay  $instance
875}
876
877#/////////////////////////////////////////////////////////////////////////////
878proc ::CalendarTms::OptionsOK {instance dialog} {
879#
880# PURPOSE: The options are applied, and the dialogue is destroyed
881#
882#/////////////////////////////////////////////////////////////////////////////   
883  OptionsApply $instance
884  OptionsDestroy $instance $dialog
885}
Note: See TracBrowser for help on using the repository browser.