1# Copyright (c) 1993 by Sanjay Ghemawat 2############################################################################## 3# DayView 4# 5# DESCRIPTION 6# =========== 7# A DayView shows the notices and appointments for one day. 8 9set dayview_id 0 10set ICAL_ICON [file join [file dirname [info script]] contrib ical_icon.png] 11 12class DayView {} { 13 global ICAL_ICON 14 # Generate new id for window 15 global dayview_id 16 incr dayview_id 17 set n .dayview$dayview_id 18 set slot(window) $n 19 set slot(sel) {} 20 21 global ical_state ical_view 22 lappend ical_state(views) $self 23 set ical_view($n) $self 24 25 toplevel $n -class Dayview 26 set_geometry {} $n [option get $n geometry Geometry] 27 28 set slot(apptlist) [ApptList $n.al $self] 29 set slot(notelist) [NoteList $n.nl $self] 30 set slot(dateeditor) [DateEditor $n.de [date today] $self] 31 32 frame $n.status -class Pane 33 label $n.cal -text "" 34 label $n.rep -text "" 35 frame $n.menu -class Pane 36 37 $self build_menu 38 39 # Pack windows 40 pack $n.cal -in $n.status -side left 41 pack $n.rep -in $n.status -side right 42 pack $n.menu -side top -fill x 43 pack $n.status -side bottom -fill x 44 pack $n.al -side right -expand 1 -fill both 45 pack $n.nl -side bottom -expand 1 -fill both 46 pack $n.de -side top -fill x 47 48 $self reconfig 49 50 wm title $n Calendar 51 wm iconname $n ical 52 image create photo applicationIcon -file $ICAL_ICON;wm iconphoto $n -default applicationIcon 53 54 wm protocol $n WM_DELETE_WINDOW [list ical_close_view $n] 55 56 $self set_date [date today] 57 58 # Set-up triggers. 59 # 60 # Save is not useful because dayview never keeps unsaved changes. 61 # Add/delete/flush are not useful because we are only 62 # interested in the currently selected item, and one of our 63 # subwindows is going to tell us about it anyway. 64 # 65 # Therefore, we just need to listen for "change" so that we can 66 # update the status window, and to "reconfig" so that we 67 # can obey option changes. We also need to listen for "midnight" 68 # to automatically switch to next day. 69 70 trigger on change [list $self change] 71 trigger on reconfig [list $self reconfig] 72 trigger on midnight [list $self midnight] 73 trigger on keybind [list $self update_menu_accelerators] 74 trigger on select [list $self check_selection] 75 76 # Set-up key bindings 77 bindtags $n [list IcalUser $n IcalCommand Dayview all] 78 79 # User customization 80 ical_with_view $self {run-hook dayview-startup $self} 81 82 # Do the following after user customization to handle user menus as well 83 $self update_menu_accelerators 84} 85 86method DayView destructor {} { 87 ical_with_view $self {run-hook dayview-close [ical_view]} 88 89 # Remove from list of registered views 90 global ical_state ical_view 91 lremove ical_state(views) $self 92 catch {unset ical_view($slot(window))} 93 94 trigger remove change [list $self change] 95 trigger remove reconfig [list $self reconfig] 96 trigger remove midnight [list $self midnight] 97 trigger remove keybind [list $self update_menu_accelerators] 98 trigger remove select [list $self check_selection] 99 100 class_kill $slot(apptlist) 101 class_kill $slot(notelist) 102 class_kill $slot(dateeditor) 103 destroy $slot(window) 104} 105 106############################################################################## 107# Routines needed by action procs. 108 109# Return the toplevel window for the view 110method DayView window {} { 111 return $slot(window) 112} 113 114# Return the displayed date 115method DayView date {} { 116 return $slot(date) 117} 118 119# Set the displayed date 120method DayView set_date {date} { 121 set slot(date) $date 122 $slot(dateeditor) set_date $date 123 $slot(apptlist) set_date $date 124 $slot(notelist) set_date $date 125 126 ical_with_view $self {run-hook dayview-set-date $self $date} 127} 128 129method DayView check_selection {args} { 130 if [string compare [ical_view] $self] { 131 # This is not the current view 132 $self clear_selection 133 return 134 } 135 136 if [catch {set i [ical_find_selection]}] { 137 # No current selection 138 $self clear_selection 139 return 140 } 141 142 if ![string compare $i $slot(sel)] { 143 # Already selected 144 return 145 } 146 147 # Need to clear old selection 148 $self clear_selection 149 150 if [$i contains $slot(date)] { 151 # Item exists on current date 152 $self set_selection $i 153 } 154} 155 156method DayView set_selection {item} { 157 set slot(sel) $item 158 $self config_status 159} 160 161method DayView clear_selection {} { 162 set slot(sel) {} 163 $self config_status 164} 165 166method DayView appt_list {} {return $slot(apptlist)} 167method DayView note_list {} {return $slot(notelist)} 168 169############################################################################## 170# Trigger callbacks 171 172# Called at midnight by a trigger. Advance to today if appropriate. 173method DayView midnight {} { 174 # Only advance if at previous date 175 set today [date today] 176 if {$slot(date) == ($today-1)} {$self set_date $today} 177} 178 179method DayView change {item} { 180 if {$slot(sel) == $item} { 181 $self config_status 182 } 183} 184 185method DayView reconfig {} { 186 set name $slot(window) 187 188 # Geometry management 189 set width [winfo pixels $name "[cal option ItemWidth]c"] 190 191 set start [cal option DayviewTimeStart] 192 set finish [cal option DayviewTimeFinish] 193 wm grid $name\ 194 1\ 195 [expr ($finish - $start) * 2]\ 196 $width\ 197 [$slot(apptlist) line_height] 198 wm minsize $name 1 10 199 wm maxsize $name 1 48 200} 201 202############################################################################## 203# Internal helper procs 204 205method DayView config_status {} { 206 set item $slot(sel) 207 if {$item == ""} { 208 $slot(window).cal configure -text "" 209 $slot(window).rep configure -text "" 210 } else { 211 set disp "" 212 catch {set disp [ical_title [$item calendar]]} 213 214 if {[$item hilite] == "holiday"} { 215 set disp [format {%s Holiday} $disp] 216 } 217 218 set owner [$item owner] 219 if {$owner != ""} { 220 set disp [format {%s [Owner %s]} $disp $owner] 221 } 222 223 set type "" 224 if [string compare [$item type] ""] { 225 set type [$item describe_repeat] 226 if {[string length $type] > 30} { 227 set type "[string range $type 0 26]..." 228 } 229 } 230 231 $slot(window).cal configure -text $disp 232 $slot(window).rep configure -text $type 233 } 234} 235 236# Update menu accelerator keys 237method DayView update_menu_accelerators {} { 238 global keymap 239 foreach {seq cmd} $keymap(command) {set key([lindex $cmd 0]) $seq} 240 foreach {seq cmd} $keymap(item) {set key([lindex $cmd 0]) $seq} 241 242 # Also collect user defined key bindings 243 catch { 244 foreach {seq cmd} [cal option Keybindings] { 245 set key([lindex $cmd 0]) $seq 246 } 247 } 248 249 foreach m [winfo children $slot(window).menu] { 250 set last [$m.m index last] 251 for {set i 0} {$i <= $last} {incr i} { 252 catch { 253 set act [lindex [$m.m entrycget $i -command] 0] 254 set seq {} 255 catch {set seq " [key_shortform $key($act)]"} 256 $m.m entryconfig $i -acc $seq 257 } 258 } 259 } 260} 261 262# Build the menu 263method DayView build_menu {} { 264 set b $slot(window).menu 265 266 menu-entry $b File Save {ical_save} 267 menu-entry $b File Re-Read {ical_reread} 268 menu-entry $b File Print {ical_print} 269 menu-sep $b File 270 menu-entry $b File {Include Calendar} {ical_addinclude} 271 menu-pull $b File {Configure Calendar} {ical_fill_config} 272 menu-sep $b File 273 menu-entry $b File {New Window} {ical_newview} 274 menu-entry $b File {Close Window} {ical_close} 275 menu-sep $b File 276 menu-entry $b File Exit {ical_exit} 277 278 menu-entry $b Edit {Cut Item} {ical_cut_or_hide} 279 menu-entry $b Edit {Copy Item} {ical_copy} 280 menu-entry $b Edit {Paste Item} {ical_paste} 281 menu-sep $b Edit 282 menu-entry $b Edit {Delete Text} {ical_delete_selection} 283 menu-entry $b Edit {Insert Text} {ical_insert_selection} 284 menu-sep $b Edit 285 menu-entry $b Edit {Import Text as Item} {ical_import} 286 287 menu-bool $b Item Todo {ical_toggle_todo}\ 288 dv_state(state:todo) 289 menu-sep $b Item 290 $self fill_hilite $b Item 291 menu-sep $b Item 292 menu-entry $b Item {Link to Web Document} {ical_link_to_uri} 293 menu-entry $b Item {Link to Local File} {ical_link_to_file} 294 menu-entry $b Item {Remove Link} {ical_remove_link} 295 menu-sep $b Item 296 menu-entry $b Item {Change Alarms...} {ical_alarms} 297 menu-entry $b Item {Early Warning...} {ical_set_remind} 298 #menu-pull $b Item {Move Item To} {ical_fill_move} 299 menu-sep $b Item 300 menu-entry $b Item {Properties...} {ical_edit_item} 301 menu-sep $b Item 302 menu-entry $b Item {Search Forward} {ical_search_forward} 303 menu-entry $b Item {Search Backard} {ical_search_backward} 304 305 menu-entry $b Repeat {Don't Repeat} {ical_norepeat} 306 menu-sep $b Repeat 307 menu-entry $b Repeat {Daily} {ical_daily} 308 menu-entry $b Repeat {Weekly} {ical_weekly} 309 menu-entry $b Repeat {Monthly} {ical_monthly} 310 menu-entry $b Repeat {Annually} {ical_annual} 311 menu-sep $b Repeat 312 menu-entry $b Repeat {Edit Weekly...} {ical_edit_weekly} 313 menu-entry $b Repeat {Edit Monthly...} {ical_edit_monthly} 314 menu-entry $b Repeat {Set Range...} {ical_set_range} 315 menu-sep $b Repeat 316 menu-entry $b Repeat {Last Occurrence} {ical_last_date} 317 menu-entry $b Repeat {Make Unique} {ical_makeunique} 318 319 menu-entry $b List {One Day} {ical_list 1} 320 menu-entry $b List {Seven Days} {ical_list 7} 321 menu-entry $b List {Ten Days} {ical_list 10} 322 menu-entry $b List {Thirty Days} {ical_list 30} 323 menu-sep $b List 324 menu-entry $b List {Week} {ical_list week} 325 menu-entry $b List {Month} {ical_list month} 326 menu-entry $b List {Year} {ical_list year} 327 menu-sep $b List 328 menu-pull $b List {From Calendar} {ical_fill_listinc} 329 330 menu-entry $b Options {Appointment Range} {ical_timerange} 331 menu-entry $b Options {Notice Window Height} {ical_noticeheight} 332 menu-entry $b Options {Item Width} {ical_itemwidth} 333 menu-entry $b Options {Web Browser} {ical_webbrowser} 334 menu-sep $b Options 335 menu-bool $b Options {Allow Text Overflow} {ical_toggle_overflow}\ 336 dv_state(state:overflow) 337 menu-bool $b Options {Display Am/Pm} {ical_toggle_ampm}\ 338 dv_state(state:ampm) 339 menu-bool $b Options {Start Week On Monday} {ical_toggle_monday}\ 340 dv_state(state:mondayfirst) 341 menu-sep $b Options 342 menu-entry $b Options {Default Alarms...} {ical_defalarms} 343 menu-entry $b Options {Default Listings...} {ical_deflistings} 344 345 menu-sep $b Options 346 menu-entry $b Options {Define a Command Key} {ical_edit_key} 347 348 menu-entry $b Help {About Ical} {ical_about} 349 menu-entry $b Help {User Guide} {ical_help} 350 menu-entry $b Help {Tcl Interface to Ical} {ical_tcl_interface} 351 352 # Move "Help" menu all the way to the right 353 pack configure $b.help -side right 354} 355 356############################################################################# 357# Commands to fill cascading menus 358 359proc add_menu_command {menu title cmd} { 360 $menu add command -label $title -command $cmd 361} 362proc add_menu_cascade {menu title cmd} { 363 set i [$menu index last] 364 set m $menu.submenu$i 365 destroy $m 366 menu $m -postcommand [concat $cmd $m] -tearoff 0 367 $menu add cascade -label $title -menu $m 368} 369 370# effects - Fill menu with calendar names. 371# Invoke "<action> <calendar file>" when 372# menu entry is selected. 373 374proc ical_fill_includes {add menu action {exclude_main ""}} { 375 set list {} 376 cal forincludes file { 377 lappend list $file 378 } 379 380 $menu delete 0 last 381 382 if ![string length $exclude_main] { 383 $add $menu [ical_title [cal main]] [list $action [cal main]] 384 $menu add separator 385 } 386 387 # Add menu separator whenever directory changes. 388 set last_dir {} 389 foreach f [lsort $list] { 390 set d [file dirname $f] 391 if [string compare $last_dir $d] { 392 if [string compare $last_dir {}] {$menu add separator} 393 set last_dir $d 394 } 395 $add $menu [ical_title $f] [list $action $f] 396 } 397} 398 399# effects - fill config-menu for one calendar 400proc fill_cal_config {cal menu} { 401 variable cal_state 402 set cal_state($cal:visible) [cal option -calendar $cal Visible] 403 set cal_state($cal:ignorealarms) [cal option -calendar $cal IgnoreAlarms] 404 405 $menu delete 0 last 406 # the label is "hidden" instead of "visible" to have all checkboxes off by default 407 $menu add checkbutton -label "Hidden" -onvalue 0 -offvalue 1 -variable cal_state($cal:visible) -command [list ical_toggle_visible $cal] 408 $menu add checkbutton -label "Ignore Alarms" -onvalue 1 -offvalue 0 -variable cal_state($cal:ignorealarms) -command [list ical_toggle_ignorealarms $cal] 409 $menu add command -label "Color..." -command [list ical_change_colors $cal] 410 $menu add command -label "Rename" -command [list ical_rename $cal] 411 #these two are only needed for non-ical calendars 412 #$menu add command -label "Default Highlight..." 413 #$menu add command -label "Default Time Zone..." 414 if {$cal != [cal main]} { 415 $menu add separator 416 $menu add command -label "Remove" -command [list ical_removeinc $cal] 417 } 418 set color [cal option -calendar $cal Color] 419 set fg [lindex $color 0] 420 set bg [lindex $color 1] 421 if { $fg != "<Default>" && [color_exists $fg]} { 422 $menu entryconfigure 2 -foreground $fg 423 } 424 if { $bg != "<Default>" && [color_exists $bg]} { 425 $menu entryconfigure 2 -background $bg 426 } 427} 428 429# effects - Fill configure-include menu 430proc ical_fill_config {menu} { 431 ical_fill_includes add_menu_cascade $menu fill_cal_config 432} 433 434# effects - Fill move-to-include menu 435proc ical_fill_move {menu} { 436 ical_fill_includes add_menu_command $menu ical_moveitem 437} 438 439# effects - Fill list-include menu 440proc ical_fill_listinc {menu} { 441 ical_fill_includes add_menu_command $menu ical_viewitems 442} 443 444# effects Fill hilite menu entries 445method DayView fill_hilite {b m} { 446 set entries { 447 { {Always Highlight} {always} } 448 { {Never Highlight} {never} } 449 { {Highlight Future} {expire} } 450 { {Holiday} {holiday} } 451 } 452 453 foreach e $entries { 454 menu-oneof $b $m\ 455 [lindex $e 0]\ 456 [list ical_hilite [lindex $e 1]]\ 457 dv_state(state:hilite)\ 458 [lindex $e 1] 459 } 460} 461 462#### Special code to set enablers for cascade menus #### 463global ical_action_enabler 464set ical_action_enabler(ical_fill_config) writable 465set ical_action_enabler(ical_fill_move) witem 466set ical_action_enabler(ical_fill_listinc) always 467