Scid  4.6.5
date.tcl
Go to the documentation of this file.
1 
2 namespace eval ::utils::date {}
3 
4 # ::utils::date::today:
5 # Returns todays date, in "yyyy.mm.dd" format.
6 # The optional parameter "year", "month" or "day" can be used to
7 # limit the returned value to just the year, month or day.
8 #
9 proc ::utils::date::today {{type all}} {
10  set timeNow [clock seconds]
11  set year [clock format $timeNow -format "%Y"]
12  set month [clock format $timeNow -format "%m"]
13  set day [clock format $timeNow -format "%d"]
14  switch -- $type {
15  "all" { return [format "%s.%s.%s" $year $month $day]}
16  "year" { return $year}
17  "month" { return $month}
18  "day" { return $day}
19  default { error "Unrecognised parameter: $type"}
20  }
21 }
22 
23 # ::utils::date::chooser
24 #
25 # Produce a date-selection dialog box.
26 # Originally based on code from Effective Tcl/Tk Programming by
27 # Mark Harrison, but with lots of changes and improvements.
28 #
29 proc ::utils::date::chooser {{date "now"}} {
30  set time [clock seconds]
31  if {$date != "now"} {
32  catch {set time [clock scan $date]}
33  }
34  set ::utils::date::_time $time
35  set ::utils::date::_selected [clock format $time -format "%Y-%m-%d"]
36 
37  set win .dateChooser
38  toplevel $win
39  canvas $win.cal -width 300 -height 220
40  pack [frame $win.b] -side bottom -fill x
41  button $win.b.ok -text "OK" -command "destroy $win"
42  button $win.b.cancel -text $::tr(Cancel) -command "
43  set ::utils::date::_selected {}
44  destroy $win"
45  pack $win.b.cancel $win.b.ok -side right -padx 5 -pady 5
46  pack $win.cal -side top -expand yes -fill both
47 
48  button $win.cal.prevY -image tb_start -command "::utils::date::_month $win -12"
49  button $win.cal.prev -image tb_prev -command "::utils::date::_month $win -1"
50  button $win.cal.next -image tb_next -command "::utils::date::_month $win +1"
51  button $win.cal.nextY -image tb_end -command "::utils::date::_month $win +12"
52  bind $win.cal <Configure> "::utils::date::_redraw $win"
53  bind $win.cal <Double-Button-1> "destroy $win"
54  bind $win <Escape> "$win.b.cancel invoke"
55  bind $win <Return> "$win.b.ok invoke"
56  bind $win <Prior> "$win.cal.prev invoke"
57  bind $win <Next> "$win.cal.next invoke"
58  bind $win <Shift-Prior> "$win.cal.prevY invoke"
59  bind $win <Shift-Next> "$win.cal.nextY invoke"
60  bind $win <Up> "::utils::date::_day $win -7"
61  bind $win <Down> "::utils::date::_day $win +7"
62  bind $win <Left> "::utils::date::_day $win -1"
63  bind $win <Right> "::utils::date::_day $win +1"
64 
65  wm minsize $win 250 200
66  wm title $win "Scid: Choose Date"
67  focus $win
68  grab $win
69  tkwait window $win
70  if {$::utils::date::_selected == ""} { return {}}
71  set time [clock scan $::utils::date::_selected]
72  return [list \
73  [clock format $time -format "%Y"] \
74  [clock format $time -format "%m"] \
75  [clock format $time -format "%d"]]
76 }
77 
78 proc ::utils::date::_day {win delta} {
79  set unit "day"
80  if {$delta < 0} {set unit "day ago"}
81  set time [clock scan "[expr abs($delta)] $unit" -base $::utils::date::_time]
82  set day [string trimleft [clock format $time -format "%d"] 0]
83  set month [string trimleft [clock format $time -format "%m"] 0]
84  set year [clock format $time -format "%Y"]
85  ::utils::date::_select $win "$year-$month-$day"
86 }
87 
88 proc ::utils::date::_month {win delta} {
89  set dir [expr {($delta > 0) ? 1 : -1}]
90  set day [string trimleft [clock format $::utils::date::_time -format "%d"] 0]
91  set month [string trimleft [clock format $::utils::date::_time -format "%m"] 0]
92  set year [clock format $::utils::date::_time -format "%Y"]
93 
94  for {set i 0} {$i < abs($delta)} {incr i} {
95  incr month $dir
96  if {$month < 1} {
97  set month 12
98  incr year -1
99  } elseif {$month > 12} {
100  set month 1
101  incr year 1
102  }
103  }
104  if {[catch {::date::_select $win "$year-$month-$day"}]} {
105  ::utils::date::_select $win "$year-$month-28"
106  }
107 }
108 
109 proc ::utils::date::_redraw {win} {
110  $win.cal delete all
111  set time $::utils::date::_time
112  set wmax [winfo width $win.cal]
113  set hmax [winfo height $win.cal]
114 
115  $win.cal create window 3 3 -anchor nw -window $win.cal.prevY
116  $win.cal create window 40 3 -anchor nw -window $win.cal.prev
117  $win.cal create window [expr {$wmax-43}] 3 -anchor ne -window $win.cal.next
118  $win.cal create window [expr {$wmax-3}] 3 -anchor ne -window $win.cal.nextY
119  set bottom [lindex [$win.cal bbox all] 3]
120 
121  set month [string trimleft [clock format $time -format "%m"] 0]
122  set year [clock format $time -format "%Y"]
123  $win.cal create text [expr {$wmax/2}] $bottom -anchor s -font font_Bold \
124  -text "[lindex $::tr(Months) [expr $month - 1]] $year"
125 
126  incr bottom 3
127  $win.cal create line 0 $bottom $wmax $bottom -width 2
128  incr bottom 25
129 
130  set current ""
131 
132  set layout [::utils::date::_layout $time]
133  set weeks [expr {[lindex $layout end]+1}]
134 
135  for {set day 0} {$day < 7} {incr day} {
136  set x0 [expr {$day*($wmax-7)/7+3}]
137  set x1 [expr {($day+1)*($wmax-7)/7+3}]
138  $win.cal create text [expr {($x1+$x0)/2}] $bottom -anchor s \
139  -text [lindex $::tr(Days) $day] -font font_Small
140  }
141  incr bottom 3
142 
143  foreach {day date dcol wrow} $layout {
144  set x0 [expr {$dcol*($wmax-7)/7+3}]
145  set y0 [expr {$wrow*($hmax-$bottom-4)/$weeks+$bottom}]
146  set x1 [expr {($dcol+1)*($wmax-7)/7+3}]
147  set y1 [expr {($wrow+1)*($hmax-$bottom-4)/$weeks+$bottom}]
148 
149  if {$date == $::utils::date::_selected} {set current $date}
150 
151  $win.cal create rectangle $x0 $y0 $x1 $y1 -outline black -fill white
152 
153  $win.cal create text [expr {$x0+4}] [expr {$y0+2}] -anchor nw -text "$day" \
154  -fill black -font font_Small -tags [list $date-text all-text]
155 
156  $win.cal create rectangle $x0 $y0 $x1 $y1 \
157  -outline "" -fill "" -tags [list $date-sensor all-sensor]
158 
159  $win.cal bind $date-sensor <ButtonPress-1> "::utils::date::_select $win $date"
160  }
161 
162  if {$current != ""} {
163  $win.cal itemconfigure $current-sensor -outline red -width 3
164  $win.cal raise $current-sensor
165  } elseif {$::utils::date::_selected == ""} {
166  set date [clock format $time -format "%Y-%m-%d"]
167  ::utils::date::_select $win $date
168  }
169 }
170 
171 proc ::utils::date::_layout {time} {
172  set month [string trimleft [clock format $time -format "%m"] 0]
173  set year [clock format $time -format "%Y"]
174 
175  foreach lastday {31 30 29 28} {
176  if {[catch {clock scan "$year-$month-$lastday"}] == 0} { break}
177  }
178  set seconds [clock scan "$year-$month-1"]
179  set firstday [clock format $seconds -format %w]
180  set weeks [expr {ceil(double($lastday+$firstday)/7)}]
181 
182  set rlist ""
183  for {set day 1} {$day <= $lastday} {incr day} {
184  set seconds [clock scan "$year-$month-$day"]
185  set date [clock format $seconds -format "%Y-%m-%d"]
186  set daycol [clock format $seconds -format %w]
187  set weekrow [expr {($firstday+$day-1)/7}]
188  lappend rlist $day $date $daycol $weekrow
189  }
190  return $rlist
191 }
192 
193 proc ::utils::date::_select {win date} {
194  set time [clock scan $date]
195  set date [clock format $time -format "%Y-%m-%d"]
196 
197  set currentMonth [clock format $::utils::date::_time -format "%m %Y"]
198  set selectedMonth [clock format $time -format "%m %Y"]
199  set ::utils::date::_time $time
200  set ::utils::date::_selected $date
201 
202  if {$currentMonth == $selectedMonth} {
203  $win.cal itemconfigure all-sensor -outline "" -width 1
204  $win.cal itemconfigure $date-sensor -outline red -width 3
205  $win.cal raise $date-sensor
206  } else {
208  }
209 }