/tktimex

#!/usr/bin/perl
# -*- perl -*-

#
# $Id: tktimex,v 6.24 2005/05/03 19:32:27 eserte Exp $
#
# Author: Slaven Rezic
# Copyright: see in subroutine show_copyright or the Help/Copyright menu entry
#            (it's basically a BSD-styled copyright)
#
# Mail: mailto:eserte@users.sourceforge.net
# WWW:  http://ptktools.sourceforge.net/
#

#use blib qw(/home/e/eserte/src/CPAN/Tk-Date);#XXXXXXXXXXXXXXXX
#use blib qw(/home/e/eserte/src/perl/Devel-SRT);
#use Devel::SRT;

#BEGIN { eval q{ use utf8 } }

BEGIN {
    $Devel::Trace::TRACE = 0;
    sub state_change { }
    state_change("before Tk");
}

use Tk;
BEGIN {
    state_change("after Tk");
}
use Tk::ErrorDialog;

BEGIN {
    if (!eval '
use blib "/home/e/eserte/src/perl/Msg";
use Msg;
1;
') {
	warn $@ if $@ and $ENV{USER} and $ENV{USER} =~ /eserte/;
	eval 'sub M ($) { $_[0] }';
	eval 'sub Mfmt { sprintf(shift, @_) }';
    }
}

eval '
use lib "/home/e/eserte/lib/perl";
use Tk::App::Reloader;
$Tk::App::Reloader::VERBOSE = 1;
'; warn $@ if $@ and $ENV{USER} and $ENV{USER} =~ /eserte/;

state_change("all use's processed...");

######################################################################

package Tk::Wm;

sub Popup
{
 my $w = shift;
 $w->withdraw;        # force invisible update
 $w->configure(@_) if @_;
 $w->idletasks;
 my ($mw,$mh) = ($w->reqwidth,$w->reqheight);
 my ($rx,$ry,$rw,$rh) = (0,0,0,0);
 my $base    = $w->cget('-popover');
 my $outside = 0;
 if (defined $base)
  {
   if ($base eq 'cursor')
    {
     ($rx,$ry) = $w->pointerxy;
    }
   else
    {
     $rx = $base->rootx;
     $ry = $base->rooty;
     $rw = $base->Width;
     $rh = $base->Height;
    }
  }
 else
  {
   my $sc = ($w->parent) ? $w->parent->toplevel : $w;
   $rx = -$sc->vrootx;
   $ry = -$sc->vrooty;
   $rw = $w->screenwidth;
   $rh = $w->screenheight;
  }
 my ($X,$Y) = AnchorAdjust($w->cget('-overanchor'),$rx,$ry,$rw,$rh);
 ($X,$Y)    = AnchorAdjust($w->cget('-popanchor'),$X,$Y,-$mw,-$mh);

 my ($sh,$sw) = ($w->screenheight, $w->screenwidth);
 $mw += 6; $mh += 28; # XXX for window manager frame
 if ($X + $mw > $sw) { $X = $sw - $mw }
 if ($X < 0)         { $X = 0         }
 if ($Y + $mh > $sh) { $Y = $sh - $mh }
 if ($Y < 0)         { $Y = 0         }

 $w->deiconify;
 $w->Post($X,$Y);
 $w->waitVisibility;
}

######################################################################
package Tk::MyHList;
@Tk::MyHList::ISA = qw(Tk::HList);
Construct Tk::Widget 'MyHList';

# Hack to prevent the selection to disappear if clicking on empty hlist space
sub Button1 {
    my $w = shift;
    my($orig_sel) = $w->selectionGet;
    my $r = $w->SUPER::Button1(@_);
    if (!$w->selectionGet && $orig_sel) {
	$w->selectionSet($orig_sel);
    }
    $r;
}

sub ButtonRelease_1
{
 my $w = shift;
 my $Ev = $w->XEvent;
 $w->CancelRepeat
     if($w->cget('-selectmode') ne 'dragdrop');
 main::MyButtonRelease1($w, $Ev);
}


######################################################################
package Tk::MyTree;
use base qw(Tk::Tree);
Construct Tk::Widget 'MyTree';

sub Button1 { shift->Tk::MyHList::Button1(@_) }
sub ButtonRelease_1 { shift->Tk::MyHList::ButtonRelease_1(@_) }

######################################################################

package main;

##use Tk::HList;
##use Tk::Tree;
BEGIN { state_change("after Tk::HList"); }
use File::Basename;
use FindBin;
use lib ("$FindBin::RealBin");

BEGIN {
    unshift @INC, "$_/Timex" for reverse @INC;
}

eval { require Tk::UnderlineAll unless $Tk::VERSION eq 803.023 };
BEGIN { state_change("before Timex::Project"); }
use Timex::Project;
BEGIN { state_change("after Timex::Project"); }
use strict;
use vars qw($VERSION);
#XXX broken in perl5.6.0+Linux: floating numbers are interpreted as integers?!
#use locale; # for sort, broken in older FreeBSD
BEGIN { state_change("after use locale"); }
# enable DnD
use Tk::DropSite;
BEGIN { state_change("after Tk::DropSite"); }
use File::Spec qw();

$VERSION = sprintf("%d.%02d", q$Revision: 6.24 $ =~ /(\d+)\.(\d+)/);

use vars qw($os);
$os = ($^O eq 'MSWin32' || $^O eq 'os2' ? 'win' : 'unix');

use vars qw($can_lock $lock_is_strict $file_writeable);
$can_lock = ($^O ne 'MSWin32'); # gefährlich für win...
$lock_is_strict = ($os eq 'win');

if ($Tk::VERSION <= 402.002) {
    Tk::HList->EnterMethods("Tk/HList.pm", qw(header));
}

use vars qw($root $templates_root);
$root = new Timex::Project;

use vars qw($utmp
	    $quit_dialog $title
	    $current_project $is_opened
	    $start_session_time $time_after $time_update
	    $autosave_after @nowtime $today_time
	    $status_text $project_frame $status_edit
	    $separator $undo_register
	    $last_projects $max_last_projects
	    $username $realname $home
	    $inner_fg $inner_bg
	    $status_browse_entry
	    %history %rcs_cache @rcs_cache
	    $ctrl_s $sbside $use_enterprise
	    $load_merge_filename $load_menu
	    $p_itemtype %icons
	    $old_search_regex $initial_search_direction
	   );

$title = "tktimex $VERSION";
$current_project = undef;
$start_session_time = time;
$time_update = 0;
@nowtime = localtime;
$today_time = time - $nowtime[0] - $nowtime[1]*60 - $nowtime[2]*60*60;

# There are two forms of separators: for intern store in HList
# use $separator, for human-readable output use "/".
$separator = 'Ś';
# XXX iso8859-1 support with newest Tk's is buggy
if ($Tk::VERSION >= 803) {
    $separator = '|';
}

$status_edit = 0;
$max_last_projects = 4;
$inner_fg = "black";
$inner_bg = "white";
$ctrl_s = ($os eq 'win' ? 'Ctrl-' : 'C-');
$sbside = ($os eq 'win' ? 'e' : 'w');
$use_enterprise = 0;
$p_itemtype = 'imagetext';
$home     = get_home_dir();

eval {
    require Timex::Utmp;
    $utmp = new Timex::Utmp;
    $utmp->init;
}; warn $@ if $@;

use vars qw($date_require);
$date_require = <<'EOF';
	require Tk::Date;
	Tk::Date->VERSION(0.27);
	if ($Tk::Date::VERSION >= 0.30) {
	    ($inner_bg_opt, $inner_fg_opt) = ('-innerbg', '-innerfg');
	}
	if ($Tk::Date::VERSION >= 0.33) {
	    %date_args = (-allarrows => 1);
	}
	$has_date = 1;
EOF

state_change("before Getopt definition");

use vars qw($max_enterprise_file_list @all_domains $options @opttable);
$max_enterprise_file_list = 4;
$options = {};
@opttable =
  (M"General",
   ['file|f',             '=s', get_home_dir() . "/.timex.pj1",
    'subtype' => 'file',
    'longhelp' => M"Default project file to load on startup",
    'callback-interactive' => sub { load_file(0) },
   ],
   ['offlinefile',        '=s', undef, 'subtype' => 'file',
    'longhelp' => M"Fallback project file for offline operation",
   ],
   ['mergedir',           '=s', undef, 'subtype' => 'file', 'nogui' => 1],
   ['lock',               '!',  1,
    'longhelp' => M"Set to false if you don't want file locking."],
   ['one-instance',     '!',  0,
    'longhelp' => M"Exit application if there is already another instance running"],
   ['autosave',           '!',  1,
    'callback' => \&toggle_autosave, 'alias' => ['as'],
    'longhelp' => M"Autosave is recommended!"],
   ['update',             '=i', 60*10,
    'longhelp' => M"Autosave interval in seconds."],
   ['oneday-immediately', '!',  1,
    'longhelp' => M"Daily details: immediate update if changing date"],
   ['geometry',           '=s', "500x230",
    'subtype' => 'geometry',
    'longhelp' => M"Size of window on startup"], # XXX
   ['iconified',          '!', 0,
    'longhelp' => M"Open application iconfied"],
   ['securesave',         '!', 0,
    'longhelp' => M"Saving data also in a Data::Dumper format. Not really necessary anymore."],
   ['plugins',            '=s', undef,
    'longhelp' => M"A comma-separated list of initial plugins to load."],
   ['username', '=s', $ENV{USERNAME},
    'longhelp' => M"A unix-like short username"],
   ['realname', '=s', undef,
    'longhelp' => M"The user's real name"],

   M"Enterprise",
   ['enterpriseprojects', "=s", undef, 'subtype' => 'file',
    'longhelp' => M"File with enterprise-wide list of projects"],
   ['enterprisedefaults', "=s", undef, 'subtype' => 'file',
    'longhelp' => M"File with enterprise-wide configuration settings"],
   (map { ["enterprisefile$_", "=s", undef, 'subtype' => 'file',
	   'longhelp' => M"Default enterprise timex file"]
      } (1 .. $max_enterprise_file_list)),

   M"Projects",
   ['dateformat',         '=s', 'h',
    'choices' => ['d', 'h', 'hs', 'frac d', 'frac h'],
    'strict' => 1,
    'callback' => \&set_dateformat,
    'alias' => ['df'],
    'longhelp' => M"Format of time display",
    ],
   ['day8',               '!',  1, 'callback' => \&toggle_time_arbeitstag,
    "longhelp" => M"If set: a day should be treated as 8 hours."],
   ['archived',           '!',  0, 'callback' => \&toggle_show_archived,
    "longhelp" => M"Show archived projects too.",
    ],
   ['onlytop',            '!',  0, 'callback' => \&toggle_show_archived,
    "longhelp" => M"Do not show subprojects.",
    ],
   ['domain',             '=s', undef, 'callback' => \&toggle_show_archived,
    "longhelp" => M"Restrict projects to a single domain only.",
    'choices' => \@all_domains,
    #'strict' => 1, # geht leider nicht...
    ],
   ['sort',               '=s', 'name',
    'choices' => ['', 'nothing', 'name', 'time'],
    'strict' => 1,
    'callback' => sub { insert_all() },
   ],

   'Appearance',
   ['interface',          '=s', 'all',
    'choices' => ['medium', 'small'],
    'strict' => 1,
    'longhelp' => M"Enable/disable menus and buttons.
All: show all menus and buttons.
Small: show only a minimal set of menus and buttons, no statistics available
Medium: only limited project manipulation possible"],
   ['busyind',            '!', 0,
    'longhelp' => M"Show a busy indicator if a project is running"],
   ['autoscroll',         '=s', 'none',
    'choices' => ['slow', 'normal', 'fast'],
    'strict' => 1,
    'longhelp' => M("Autoscrolling is not available on all systems.\n" .
    "Changes are effective on restart.")
    ],
   ['hourlyrate',         '=f', 0,
    'callback' => sub { update_costs_option(1) },
    'longhelp' => M"Hourly rate for work.",
    ],
   ['currency',           '=s', "EUR",
    'choices' => ['EUR', 'USD'],
    'callback' => sub { update_costs_option(1) },
    'longhelp' => M"Currency for hourlyrate option.",
    ],
   ['tree',               '!', 1,
    'longhelp' => M"Use tree representation"],
  );

{
    # save x11 options (except -geometry)
    my $geometry;
    for(my $i = 0; $i <= $#ARGV; $i++) {
	if ($ARGV[$i] eq '-geometry' && $i < $#ARGV) {
	    $geometry = $ARGV[$i+1];
	    splice @ARGV, $i, 2;
	    $i--;
	}
    }
    Tk::CmdLine::SetArguments();
    if (defined $geometry) {
	push @ARGV, -geometry => $geometry;
    }
}

use vars qw($opt);
eval {
    state_change("before require Tk::Getopt");
    require Tk::Getopt;
    Tk::Getopt->VERSION(0.49);
    state_change("after require Tk::Getopt");
};
if ($@) {
    warn M"No Tk::Getopt --- falling back to Getopt::Long\n";
    require Getopt::Long;
    my @getopt;
    push @getopt, $options;
    foreach (@opttable) {
	if (ref $_ eq 'ARRAY') {
	    $options->{$_->[0]} = $_->[2] if defined $_->[2];
	    push @getopt, $_->[0] . $_->[1];
	}
    }

    die M"Usage?" if !Getopt::Long::GetOptions(@getopt);

    if ($options->{'enterprisedefaults'} and
	-r $options->{'enterprisedefaults'}) {
	standalone_message_box
	    (-message => M("The option -enterprisedefaults does not work
without the perl module Tk::Getopt
Please install this module from CPAN.\n"));
    }

} else {
    state_change("Tk::Getopt checkpoint 1");
    $opt = new Tk::Getopt(-opttable => \@opttable,
			  -options  => $options,
			  -filename => File::Spec->catfile($home, ".tktimexrc"),
			 );
    state_change("Tk::Getopt checkpoint 2");
    $opt->set_defaults;
    state_change("Tk::Getopt checkpoint 3");
    $opt->load_options;
    die $opt->usage if !$opt->get_options;

    if ($options->{'enterprisedefaults'} and -r $options->{'enterprisedefaults'}) {
	$opt->load_options($options->{'enterprisedefaults'});
	$use_enterprise++;
    }

    require Getopt::Long; state_change("Tk::Getopt checkpoint 4");
    die $opt->usage if !$opt->get_options;
    state_change("Tk::Getopt checkpoint 5");
}
if (@ARGV) {
    $options->{'file'} = shift @ARGV;
}

$username = get_user_name();
$realname = get_real_name();

if ($use_enterprise) {
    $options->{'file'} =~ s/\@USER\@/$username/g;
}

state_change("checkpoint 1");

if ($options->{'one-instance'} and tktimex_running()) {
    require Tk::Dialog;
    my $top = tkinit;
    $top->withdraw;
    $top->Dialog
	(-title => M"Error",
	 -text => M("Another tktimex instance is already running.
Start tktimex with the option -noone-instance, if you
want really two instances of this program running.\n"),
	 -popover => 'cursor')->Show;
    exit;
}

use vars qw($m_if $s_if);
$m_if = $options->{'interface'} eq 'medium';
$s_if = $options->{'interface'} eq 'small';

use vars qw($top);
$top = new MainWindow;
Tk::App::Reloader::shortcut() if defined &Tk::App::Reloader::shortcut;
$top->protocol('WM_DELETE_WINDOW', sub { quit_program() });
$top->protocol('WM_SAVE_YOURSELF',
	       sub { save_sos();
		     # XXX andere Optionen mit speichern (?)
		     $top->command("$^X $0 $options->{'file'}");
		     $top->destroy;
		 });
# SIGHUP is not defined on Windows
eval {
    local $^W = undef;
    $SIG{'HUP'} = sub { save_sos(); };
};

if ($options->{'iconified'}) {
    $top->iconify;
}
$top->title($title);
$top->geometry($options->{'geometry'}) if $options->{'geometry'};
eval {
    my $icon = $top->Pixmap(-file => Tk::findINC("Timex/mini-clock.xpm") ||
				     "$FindBin::RealBin/Timex/mini-clock.xpm");
    if ($icon) {
	$top->Icon(-image => $icon);
    }
}; warn $@ if $@;

$top->bind("<Pause>" => sub {
	       eval {
		   require Tk::WidgetDump;
		   $top->WidgetDump;
	       }; warn $@ if $@;
	       require Config;
	       my $perldir = $Config::Config{'scriptdir'};
	       require "$perldir/ptksh";
	   });

state_change("checkpoint 2");

use vars qw($is_archiv $east %hl_entry $new_in_merge $changed_in_merge
	    $weekday_style $holiday_style);
use vars qw($balloon);
if ($Tk::VERSION >= 800.005) {
    require Tk::ItemStyle; # erst ab 800.005
    $is_archiv = $top->ItemStyle($p_itemtype, -foreground => 'red',
				 -background => $inner_bg);
    $east = $top->ItemStyle('text', -anchor => 'e',
			    -background => $inner_bg,
			    -foreground => $inner_fg);

    $hl_entry{"red"}  = $top->ItemStyle($p_itemtype, -foreground => 'red');
    $hl_entry{"blue"} = $top->ItemStyle($p_itemtype, -foreground => 'blue');

    $new_in_merge     = $top->ItemStyle($p_itemtype, -foreground => 'green3',
					-background => $inner_bg);
    $changed_in_merge = $top->ItemStyle($p_itemtype, -foreground => 'blue',
					-background => $inner_bg);
    $weekday_style    = $top->ItemStyle("text", -anchor => "e", -background => $inner_bg);
    $holiday_style    = $top->ItemStyle("text", -anchor => "e", -foreground => "red", -background => $inner_bg);

    # altes Balloon und HList vertragen sich nicht miteinander
    require Tk::Balloon;
    $balloon = $top->Balloon;
}

state_change("menu begin");

use vars qw($menu_frame $mb_file $mb_file_menu $mb_export
	    $mb_project $mb_show_curr_project_index
	    $mb_project_menu $mb_options $mb_options_menu
	    $dateformat_menu $mb_help);
$menu_frame = $top->Frame(-relief => 'raised',
			  -borderwidth => 2);

$mb_file = $menu_frame->Menubutton(-text => M"File")->pack(-side => 'left');
state_change("first menubutton loaded");
$mb_file->command(-label => M"Load",
		  -command => sub { load_file(1) })
    unless $s_if;

if (!$s_if) {
    my $show_it = 0;
    for my $i (1 .. $max_enterprise_file_list) {
	if (defined $options->{"enterprisefile$i"} &&
	    $options->{"enterprisefile$i"} ne "") {
	    $show_it++;
	    last;
	}
    }
    if ($show_it) {
	$mb_file->cascade(-label => M"Load ...");
	my $mb_load_menu = $mb_file->cget(-menu);
	my $mb_load = $mb_load_menu->Menu;
	$mb_file->entryconfigure('last', -menu => $mb_load);
	for my $i (1 .. $max_enterprise_file_list) {
	    if (defined $options->{"enterprisefile$i"} &&
		$options->{"enterprisefile$i"} ne "") {
		my $f = $options->{"enterprisefile$i"};
		$mb_load->command(-label => basename($f),
				  -command => sub { load_file(0, $f) });
	    }
	}
	if (defined $options->{'file'} && $options->{'file'} ne '') {
	    $mb_load->command
		(-label => basename($options->{'file'}),
		 -command => sub { load_file(0, $options->{'file'}) });
	}
    }
}

$mb_file->command(-label => M"Save",
		  -command => \&save_file);
$mb_file->cascade(-label => M"Export");
$mb_file_menu = $mb_file->cget(-menu);
$mb_export = $mb_file_menu->Menu;
$mb_file->entryconfigure('last', -menu => $mb_export);
$mb_file->entryconfigure('last', -state => 'disabled') if $s_if || $m_if;
$mb_export->command(-label => M"Save as ...",
		    -command => \&save_as_file);
$mb_export->command(-label => M"Save skeleton",
		    -command => \&save_skeleton);
$mb_export->command(-label => M"Save subproject",
		    -command => \&save_subproject);
$mb_export->command(-label => M"Save XML",
		    -command => \&save_xml);
$mb_export->command(-label => M"Save Excel",
		    -command => sub {
			require Timex::ExcelExport;
		        Timex::ExcelExport::save_dialog
				($top, $root,
				 -hourlyrate => $options->{'hourlyrate'},
				);
		    });
$mb_export->command(-label => M"Dump",
		    -command => \&dump_data) unless $s_if || $m_if;
$mb_file->command(-label => M"Merge",
		  -command => \&merge_file) unless $s_if || $m_if;
$mb_file->command(-label => M"Update enterprise projects",
		  -command => \&update_enterprise_projects);
$mb_file->command(-label => M"Quit",
		  -command => sub { quit_program() });
$mb_file->separator;

$mb_project = $menu_frame->Menubutton(-text => M"Project"
				     )->pack(-side => 'left');
$mb_project->command(-label => M"New",
		     -command => sub { new_project() },
		    )
    unless $s_if || $m_if;
# strange: -menu is only active if there is already a menu item
$mb_project_menu = $mb_project->cget(-menu);

$mb_project->command(-label => M"New from template",
		     -command => \&new_project_from_template)
    unless $s_if || $m_if;
$mb_project->command(-label => M"New subproject",
		     -command => sub { new_sub_project(get_sel_entry()) })
    unless $s_if || $m_if;
$mb_project->command(-label => M"Delete",
		     -command => \&delete_project)
    unless $s_if || $m_if;
## Menü ist zu überladen...
#$mb_project->command(-label => M"Pause",
#		     -command => \&pause_or_cont);
$mb_project->command(-label => M"Undo",
		     -command => \&undo);
$mb_project->command(-label => M"Search",
		     -command => sub { tk_search_project(+1) },
		     -accelerator => $ctrl_s . 's');
$top->bind('<Control-s>' => sub { tk_search_project(+1) });
$top->bind('<Key-slash>' => sub { tk_search_project(+1) });
$top->bind('<Key-question>' => sub { tk_search_project(-1) });
$top->bind('<Key-n>' => sub { search_project($old_search_regex, +1) });
$top->bind('<Key-N>' => sub { search_project($old_search_regex, -1) });
$mb_project->command(-label => M"Show current",
		     -state => "disabled",
		     -command => sub {
			 if ($current_project) {
			     $project_frame->see(make_path($current_project));
			 }
		     });
$mb_show_curr_project_index = $mb_project_menu->index("last");
$mb_project->command(-label => M"Continue last",
		     -command => \&cont_last);
$mb_project->command(-label => M"Attributes",
		     -command => sub { show_attributes(undef) })
    unless $s_if;
$mb_project->command(-label => M"Intervals",
		     -command => sub { show_intervals($top, undef) },
		     -accelerator => $ctrl_s .'i')
    unless $s_if;
$top->bind('<Control-i>' => sub { show_intervals($top, undef) })
    unless $s_if;
## Menü ist zu überladen...
#$mb_project->command(-label => M"Note",
#		     -command => sub { show_note($top) });
$mb_project->separator
    unless $s_if;
$mb_project->command(-label => M"Working time",
		     -command => \&working_time)
    unless $s_if;
$mb_project->command(-label => M"Daily details",
		     -command => \&show_one_day,
		     -accelerator => $ctrl_s . 'd')
    unless $s_if;
$top->bind('<Control-d>' => \&show_one_day)
    unless $s_if;

$mb_options = $menu_frame->Menubutton(-text => M"Options"
					)->pack(-side => 'left');
$mb_options->checkbutton(-label => M"Autosave",
			 -command => \&toggle_autosave,
			 -variable => \$options->{'autosave'},
			)
    unless $s_if || $m_if;
$mb_options->cascade(-label => M"Dateformat");
$mb_options_menu = $mb_options->cget(-menu);
$dateformat_menu = $mb_options_menu->Menu;
$mb_options->entryconfigure(M"Dateformat", -menu => $dateformat_menu);
$mb_options->entryconfigure(M"Dateformat", -state => 'disabled')
    if $s_if || $m_if;
$mb_options->checkbutton(-label => M"day = 8h",
			 -command => \&toggle_time_arbeitstag,
			 -variable => \$options->{'day8'},
			)
    unless $s_if || $m_if;
$mb_options->checkbutton(-label => M"Show archived",
			 -command => \&toggle_show_archived,
			 -variable => \$options->{'archived'},
			)
    unless $s_if || $m_if;
$mb_options->checkbutton(-label => M"Show only top",
			 -command => \&toggle_show_only_top,
			 -variable => \$options->{'onlytop'},
			)
    unless $s_if || $m_if;
if ($options->{'tree'}) {
    $mb_options->separator
        unless $s_if || $m_if;
    $mb_options->command
	(-label => M"Open all",
	 -command => sub { traverse_entries(sub {
						$project_frame->open($_[0])
					    }) }
	);
    $mb_options->command
	(-label => M"Close all",
	 -command => sub { traverse_entries(sub {
						$project_frame->close($_[0])
					    }) }
	);
}

if (defined $opt) {
    $mb_options->separator
        unless $s_if || $m_if;
    $mb_options->command(-label => M"Option editor",
			 -command => sub { $opt->option_editor($top, -buttons => ['oksave', 'cancel']) })
	unless $s_if || $m_if;
}

foreach my $def ([M"H:M:S"  => 'hs'],
		 [M"H:M"    => 'h'],
		 [M"d H:M"  => 'd'],
		 [M"Frac H" => 'frac h'],
		 [M"Frac d" => 'frac d'],
		) {
    $dateformat_menu->radiobutton(-label => $def->[0],
				  -command => \&set_dateformat,
				  -value => $def->[1],
				  -variable => \$options->{'dateformat'},
				 );
}

$mb_help = $menu_frame->Menubutton(-text => M"Help"
				  )->pack(-side => 'left');
$mb_help->command(-label => M"About",
		  -command => \&show_about);
$mb_help->command(-label => M"Copyright",
		  -command => \&show_copyright);
$mb_help->command
  (-label => M"Index",
   -command => sub {
       eval {
	   require Tk::Pod;
	   Tk::Pod->Dir($FindBin::Bin);
	   $top->Pod(-file => "$FindBin::Script",
		     -title => "tktimex",
		    );
       };
       $status_text->configure(-text => substr($@, 0, 40) . "...") if $@;
   });

state_change("menu done");

use vars qw($save_check $mod_watch $mod_sub);
# Aus mir völlig unerklärlichen Gründen muß sich mod_sub außerhalb
# des evals befinden (perl5.00404)
$mod_sub = sub {
    my($self, $newval) = @_;
    if ($newval) {
	$save_check->configure(-bg => 'red');
    } else {
	$save_check->configure(-bg => 'green');
    }
    $self->Store($newval) if $self;
};
eval {
    die;
    require Tie::Watch;
    # earlier versions used Delete instad of Unwatch:
    Tie::Watch->VERSION(0.99);
    $save_check = $menu_frame->Label(-padx => 4, -relief => 'raised');

    $mod_watch = Tie::Watch->new(-variable => \$root->{'modified'},
				 -store => $mod_sub,
				);
    $mod_sub->();
};
if (!$mod_watch || $@) {
    $save_check = $menu_frame->Checkbutton
    (-variable => \$root->{'modified'},
     ($os ne 'win' ? (-selectcolor => "red") : ()),
     -highlightthickness => 0,
     -padx => 0, -pady => 0,
     #-font => "times 5",
    );
    $save_check->bindtags([]);
}
$save_check->pack(-side => 'right');
$balloon->attach($save_check, -msg => M"Timex data modified indicator")
  if $balloon;

use vars qw($pause_cont_button $save_button);
$pause_cont_button = $menu_frame->Button
  (-text => M"Pause",
   -fg => 'red',
   -width => 5,
   -command => \&pause_or_cont)->pack(-side => 'right');

$save_button = $menu_frame->Button(-text => M"Save",
				   -fg => 'yellow4',
				   -command => \&save_file
				  )->pack(-side => 'right');
$balloon->attach($save_button, -msg => M"Save project data") if $balloon;

use vars qw($minimized $save_geometry $up_photo $down_photo $min_button);
$minimized = 0;
eval {
    $up_photo   = $top->Photo(-file => Tk::findINC("Timex/plain.up.gif"));
    $down_photo = $top->Photo(-file => Tk::findINC("Timex/plain.down.gif"));
};
warn $@ if $@;
$min_button = $menu_frame->Button(-image => $up_photo,
				  -command => \&minmaximze,
				  -relief => 'flat',
				 )->pack(-side => 'right');
$balloon->attach($min_button, -msg => 'Minimize') if $balloon;

use vars qw($busy_timer @busy_bar $busy_index $busy_string
	    $busy_update $busy_label);
@busy_bar = ('|', '/', '-', '\\');
$busy_index = 0;
$busy_string = " ";
$busy_update = 200;
$busy_label = $menu_frame->Label(-textvariable => \$busy_string,
				 -width => 1)->pack(-side => 'right');

$menu_frame->pack(-fill => 'x');

state_change("menu 2 done");

use vars qw($pf_cols $has_costs);
$pf_cols = 5; # cannot change -columns of hlists...

state_change("checkpoint 3");
$project_frame = $top->Scrolled
  (($options->{'tree'} ? 'MyTree' : 'MyHList'),
   -scrollbars => "oso$sbside",
   -bg => $inner_bg,
   -fg => $inner_fg,
   -columns => $pf_cols,
   -height => 1,
   -drawbranch => 1,
   -header => 1,
   -selectmode => 'single',
   -selectbackground => 'SeaGreen3',
   -browsecmd => sub { },
   -separator => $separator,
   ($options->{'tree'} ? (-opencmd => sub {
			      my($ent) = shift;
			      $project_frame->OpenCmd($ent,@_);
			      my $p = entry_to_project($ent);
			      $p->closed(0) if $p;
			  },
			  -closecmd => sub {
			      my($ent) = shift;
			      $project_frame->CloseCmd($ent,@_);
			      my $p = entry_to_project($ent);
			      $p->closed(1) if $p;
			  },
			 )
    : ()),
  )->pack(-expand => 1, -fill => 'both');
use vars qw($real_project_frame $is_tree);
$real_project_frame = $project_frame->Subwidget("scrolled");
$is_tree = ($project_frame->can('autosetmode') or
	    ($real_project_frame and
	     $real_project_frame->can('autosetmode')));

state_change("checkpoint 4");
if ($options->{'autoscroll'} !~ /^(|none)$/) {
    require Tk::Autoscroll;
    Tk::Autoscroll::Init($project_frame, -speed => $options->{'autoscroll'});
}
$project_frame->header('create', 0, -text => M"Projects:");
use vars qw($pf_time_index);
$pf_time_index = 1;
$project_frame->header('create', $pf_time_index, -text => M"Session");
$project_frame->header('create', $pf_time_index+1, -text => M"Today");
$project_frame->header('create', $pf_time_index+2, -text => M"Total");
update_costs_option(1);

state_change("checkpoint 5");

use vars qw($orig_selectbg);
$orig_selectbg = $project_frame->cget(-selectbackground);

$real_project_frame->bindtags([$real_project_frame, ref $real_project_frame,
			       '.', 'all']);
foreach my $ev (qw(Double-ButtonRelease-1
		   Return)) {
    $real_project_frame->bind("<$ev>" =>
			      sub { start() });
}
if ($options->{'autoscroll'} =~ /^(|none)$/) {
    $real_project_frame->bind("<Button-2>" =>
			      sub { new_sub_project(get_entry(@_)) });
}

use vars qw($popup_entry $popup_project $popup_menu);
$popup_menu = $real_project_frame->Menu(-tearoff => 0,
					-disabledforeground => "darkblue");
$popup_menu->command(-label => M"Project:",
		     -state => "disabled");
$popup_menu->command(-label => M"New subproject",
		     -command => sub { new_sub_project($popup_entry) })
    unless $s_if || $m_if;
$popup_menu->command(-label => M"Delete",
		     -command => sub { delete_project($popup_entry) })
    unless $s_if || $m_if;
$popup_menu->command(-label => M"Continue last",
		     -command => sub { cont_last($popup_project) });
$popup_menu->command(-label => M"Attributes",
		     -command => sub { show_attributes($popup_entry) })
    unless $s_if;
$popup_menu->command(-label => M"Intervals",
		     -command => sub { show_intervals($top, $popup_project) })
    unless $s_if;
if ($real_project_frame->can("menu") &&
    $real_project_frame->can("PostPopupMenu") && $Tk::VERSION >= 800) {
    $real_project_frame->menu($popup_menu);
    $real_project_frame->Tk::bind('<3>' => sub {
	my $w = $_[0];
	my $e = $w->XEvent;
	$popup_entry = $w->GetNearest($e->y, 0);
	return unless defined $popup_entry;
	$w->anchorSet($popup_entry);
	$popup_project = entry_to_project($popup_entry);
	return unless $popup_project;
	$popup_menu->entryconfigure(0, -label => $popup_project->label);
	$w->PostPopupMenu($e->X, $e->Y);
    });
} else {
    $real_project_frame->bind("<Button-3>" =>
                              sub { show_attributes(get_entry(@_)) });
}

$real_project_frame->bind("<Prior>" => sub {
    my $w = $_[0];
    my $ent = $w->GetNearest(0,0);
    if (defined $ent) {
	$w->anchorSet($ent);
	$w->UpDown("prev");
    }

});
$real_project_frame->bind("<Next>" => sub {
    my $w = $_[0];
    my $ent = $w->GetNearest($w->height,0);
    if (defined $ent) {
	$w->anchorSet($ent);
	$w->UpDown("next");
    }
});
$real_project_frame->bind("<Home>" => sub {
    my $w = $_[0];
    $w->yview(moveto => 0);
    my $ent = $w->GetNearest(0,0);
    if (defined $ent) {
	$w->anchorSet($ent);
	$w->see($ent);
    }
});
$real_project_frame->bind("<End>" => sub {
    my $w = $_[0];
    $w->yview(moveto => 1);
    my $ent = $w->GetNearest($w->height,0);
    if (defined $ent) {
	$w->anchorSet($ent);
	$w->see($ent);
    }
});


state_change("checkpoint 6");

if ($project_frame->can('DropSite')) {
    eval {
	$project_frame->DropSite
	  (-dropcommand => [\&accept_drop, $project_frame],
	   -droptypes => ($os eq 'win' ? 'Win32' : ['KDE', 'XDND', 'Sun']));
    };
}

use vars qw($status_frame);
$status_frame = $top->Frame(-relief => 'ridge',
			    -bd => 1);
$status_frame->pack(-fill => 'x');

$status_text = $status_frame->Label
  (-text => M("Current file") . ": " . ($options->{file} || ""));
$status_text->pack(-side => 'left');

state_change("checkpoint 7");

# verzögert zeigen, da evtl. wichtige Statusmeldungen dadurch
# verdeckt werden ... aber nicht, wenn in der Statuszeile editiert wird!
use vars qw($status_timer);
$project_frame->bind
  ("<Enter>" => sub {
       if ($status_timer) {
	   $status_timer->cancel;
	   undef $status_timer;
       }
       $status_timer = $project_frame->after
	 (3000, sub { $status_text->configure(-text => project_status())
			unless $status_edit;
		  })
     });
$project_frame->bind
  ("<Leave>" => sub {
       if ($status_timer) {
	   $status_timer->cancel;
	   undef $status_timer;
       }
       $status_timer = $project_frame->after
	 (3000, sub { $status_text->configure
			(-text => M("Current file") . ": " . ($options->{file} || ""))
			  unless $status_edit;
		  })
     });

$menu_frame->UnderlineAll if $menu_frame->can('UnderlineAll');

$opt->process_options if defined $opt;

state_change("checkpoint 8");

set_time_update();

$root->modified(0);

state_change("checkpoint 9");

# preload file
if ($options->{'file'}) {
    load_file(0);
    $last_projects = [ $root->last_projects($max_last_projects) ];
    create_menu_last_projects();
}
# merge enterprise-wide data
if ($options->{'enterpriseprojects'}) {
    update_enterprise_projects();
}

$project_frame->focus;

$top->repeat(5*60*1000, \&check_still_today);

Tk::App::Reloader::check_loop() if defined &Tk::App::Reloader::check_loop;

if ($options->{plugins}) {
    require Timex::Plugin;
    my @warnings;
    local $SIG{__WARN__} = sub { push @warnings, @_ };
    foreach my $plugin (split /\s*,\s*/, $options->{plugins}) {
	Timex::Plugin::load_plugin($plugin);
    }
    if (@warnings) {
	require Tk::DialogBox;
	require Tk::ROText;
	my $d = $top->DialogBox(-title => M"Error while loading plugins",
				-buttons => [M"OK"],
				-popover => 'cursor',
			       );
	my $txt = $d->add('ROText', -width => 40, -height => 10,
			  -relief => "flat", -borderwidth => 0,
			  -wrap => "word",
			 )->pack(-expand => 1, -fill => "both");
	$txt->insert("end", join("\n", @warnings));
	$d->Show;
    }
}

state_change("before MainLoop");
MainLoop;

### RELOADER_START #########################################################

sub enter_label {
    my $label = shift;
    my $caller = shift;
    my %args = @_;
    my $action;
    my $res = '';
    $status_edit++;
    $status_text->configure(-text => $label);

    my $Entry = "Entry";
    my @extra_args;
    my $this_history_file;
    my $entry;

    if ($args{-choices}) {
	$Entry = "BrowseEntry";
	require Tk::BrowseEntry;
	if ($status_browse_entry) {
	    $entry = $status_browse_entry;
	} else {
	    $entry = $status_frame->$Entry();
	}
	$entry->configure(-bg => $inner_bg,
			  -fg => $inner_fg,
			  -textvariable => \$res,
			  -width => 30,
			  -choices => $args{-choices},
			  -state => 'readonly');
    } else {
	eval {
	    require Tk::HistEntry;
	    Tk::HistEntry->VERSION(0.33);
	    $Entry = "SimpleHistEntry";
	    # -case => 1 is ugly...
	    @extra_args = (-match => 1, -dup => 0, -case => 0);
	    $this_history_file = File::Spec->catfile($home, ".tktimex_hist");
	};
	$entry = $status_frame->$Entry(-bg => $inner_bg,
				       -fg => $inner_fg,
				       -textvariable => \$res,
				       -width => 30,
				       @extra_args);

	$entry->bindtags([ref $entry, $entry]);
	if ($entry->can('historyMergeFromFile')) {
	    $entry->historyMergeFromFile($this_history_file);
	} elsif ($entry->can('history') and ref $history{$caller} eq 'ARRAY') {
	    $entry->history($history{$caller});
	}

	if ($entry->can('history')) {
	    $res = ($entry->history)[-1];
	    $entry->selectionRange(0,"end");
	}
    }

    $entry->pack(-side => 'left');
    $entry->waitVisibility;
    $entry->grab;
    $entry->focus;
    $entry->bind("<Return>", sub { $action = 'yes' });
    $entry->bind("<Escape>", sub { $action = 'no' });
    $entry->OnDestroy(sub { $status_edit-- });
    $entry->waitVariable(\$action);
    $entry->grabRelease;

    # Muss vor $entry->destroy kommen!
    if ($action eq 'yes') {
	if ($entry->can('historyAdd')) {
	    $entry->historyAdd();
	    if ($entry->can('historySave')) {
		$entry->historySave($this_history_file);
	    } else {
		$history{$caller} = [ $entry->history ];
	    }
	}
    }

    if ($Entry eq 'BrowseEntry') {
	# This is a hack for BrowseEntry's button hack
	# Problem: the toplevel binding of <ButtonRelease-1> is set
	# If the Browsecentry is destroyed, this binding will go into
	# empty space. Hence there is only one browse entry, which is
	# only pack()ed and packForge(o)t on enter_label call.
	$entry->packForget;
	$status_edit--;
    } else {
	$entry->destroy;
    }

    $status_text->configure(-text => M("Current file") . ": " .
			    ($options->{file} || ""));
    $project_frame->focus;
    if ($action eq 'yes') {
	$res =~ s/$separator//g; # sicherheitshalber ...
	$res;
    } else {
	undef;
    }
}

BEGIN { state_change("parsed 26%"); }

sub exists_project {
    my $path = shift;
    if (defined $root->find_by_pathname($path)) {
	require Tk::Dialog;
	$top->Dialog
	    (-title => M"Error",
	     -text => Mfmt("A project labeled %s already exists!", $path),
	     -popover => 'cursor',
	     )->Show;
	return 1;
    }
    0;
}

sub new_project {
    my($label) = @_;
    my $p;
    if (!defined $label) {
	$label = enter_label(M"New project name:", 'newproject');
    }
    if ($label && $root) {
	return if exists_project($label);
	$p = $root->subproject($label);
	insert_project($p);
	$project_frame->see(make_path($p));
    }
    $p;
}

sub get_templates {
    return $templates_root if $templates_root;

    my @templ_files;
    foreach my $dir (@INC) {
	push @templ_files, glob("$dir/templates/*.pjt");
	push @templ_files, glob("$dir/Timex/templates/*.pjt");
    }
    push @templ_files, glob("$FindBin::RealBin/templates/*.pjt");

    my %templ_files = map { ($_ => 1) } @templ_files;

    my @templ_projects;
    foreach my $f (sort keys %templ_files) {
	my $tp = new Timex::Project;
	$tp->load($f);
	push @templ_projects, $tp;
    }
    $templates_root = concat Timex::Project @templ_projects;
    $templates_root;
}

sub new_project_from_template {
    my $template = enter_label
	(M"Template:", 'template',,
	 -choices => [map {$_->label} get_templates()->subproject],
	);
    return if !$template;
    my $template_p = get_templates()->find_by_pathname($template);
    if (!$template_p) {
	warn M"Strange: could not find project with name $template";
	return;
    }

    my $label = enter_label(M"New project name:", 'newproject');
    if ($label && $root) {
	return if exists_project($label);
	my $p = clone $template_p;
	$p->label($label);
	$p->reparent($root);
	insert_project_recursive($p);
	$project_frame->see(make_path($p));
    }
}

sub new_sub_project {
    my $path = shift;
    return if !defined $path;
    my $label = enter_label(M"New subproject name:", 'newproject');
    if ($label) {
	my $p = entry_to_project($path);
	return if !$p;
	my $path = $p->pathname . $separator . $label;
	return if exists_project($path);
	my $sub_p = $p->subproject($label);
	insert_project($sub_p);
	$project_frame->see(make_path($sub_p));
    }
}

sub delete_project {
    my $path = shift;
    my $p;
    if (!defined $path) {
	$p = get_project_from_anchor();
    } else {
	return if !$project_frame->info('exists', $path);
	$p = $project_frame->info('data', $path);
    }
    return if !$p;
    return if !not_running(undef, $p);
    require Tk::Dialog;
    my $ans = $top->Dialog
      (-title => M"Warning",
       -text  =>
       Mfmt("Do you really want to delete the project %s" .
	    " and all its subprojects?", $p->pathname),
       -popover => 'cursor',
       -buttons => [M"Yes", M"No"],
       -default_button => M"No",
      )->Show;
    return if $ans ne M"Yes";
    $p->delete;
    insert_all();
}

sub insert_project {
    my($p, %args) = @_;

    return if !$p;
    return if $p->archived && !$options->{'archived'};
    return if (defined $options->{'domain'} && $options->{'domain'} !~ /^\s*$/)
	      && (!defined $p->domain || $p->domain ne $options->{'domain'});
    my $label = $p->label;
    my $path = make_path($p);
    return if !$path;
    if ($project_frame->info('exists', $path)) {
	warn Mfmt("Duplicate entry path %s - please check .pj1 file!",$path);
	return;
    }

    # check existence of parent and create dummy entry, if appropriate
    my $check_parent;
    $check_parent = sub {
	my($p, $path) = @_;
	my $parent_path = get_parent_path($path);
	return if $parent_path eq "";

	my $parent_p = $p->parent;
	return if !defined $parent_p;

	if (!$project_frame->info('exists', $parent_path)) {
	    $check_parent->($parent_p, $parent_path);
	    $project_frame->add($parent_path,
				-text => "(" . $parent_p->label . ")");
	}
    };

    $check_parent->($p, $path);

    $project_frame->add
	($path,
	 -text => $p->label,
	 -itemtype => $p_itemtype,
	 -data => $p,
	 # workaround for Tk804 bug: -after has to be last argument!
	 (defined $args{-after} ? (-after => $args{-after}) : ()),
	);

    if ($p_itemtype eq 'imagetext' && $p->icon) {
	if (!$icons{$path}) {
	    eval {
		$icons{$path} = $project_frame->Photo(-file => $p->icon);
	    }; warn $@ if $@;
	}
	if ($icons{$path}) {
	    $project_frame->itemConfigure($path, 0, -image => $icons{$path});
	}
    }

    if ($p->archived && $is_archiv) {
	$project_frame->itemConfigure($path, 0, -style => $is_archiv);
    }
    if ($args{-style}) {
	$project_frame->itemConfigure($path, 0, -style => $args{-style});
    }

    if (!$p->notimes) {
	my $all_time_sec = $p->sum_time(0, undef, -recursive => 1);
	$project_frame->itemCreate
	    ($path, $pf_time_index, -itemtype => 'text',
	     -text => sec2time($p->sum_time($start_session_time, undef,
					    -recursive => 1)));
	$project_frame->itemCreate
	    ($path, $pf_time_index+1, -itemtype => 'text',
	     -text => sec2time($p->sum_time($today_time, undef,
					    -recursive => 1)));
	$project_frame->itemCreate
	    ($path, $pf_time_index+2, -itemtype => 'text',
	     -text => sec2time($all_time_sec));

	if ($has_costs) {
	    my $hours = int($all_time_sec/3600);
	    $hours += ($all_time_sec%3600 > 0 ? 1 : 0);
	    $project_frame->itemCreate
		($path, $pf_time_index+3, -itemtype => 'text',
		 -text => sprintf("%.2f", $hours*hourly_rate($p)));
	}

	for ($pf_time_index .. $pf_time_index+($has_costs?3:2)) {
	    $project_frame->column('width', $_, '');
	    if ($east) {
		$project_frame->itemConfigure($path, $_, -style => $east);
	    }
	}
    }
}

sub insert_project_recursive {
    my $p = shift;
    insert_project($p);
    foreach my $sp ($p->subproject) {
	insert_project_recursive($sp);
    }
}

sub start {
    my $path = shift;

    my $p;
    if (!$path) {
	$p = get_project_from_anchor();
    } else {
	if ($path && ref $path and $path->can('Timex_Project_API')) {
	    $path = $path->pathname($separator);
	}
	return if !$project_frame->info('exists', $path);
	$p = $project_frame->info('data', $path);
    }
    return if !$p;
    start_project($p);
}

sub common_start_project {
    my $p = shift;
    stop_project();
    $current_project = $p;
    my $current_pathname = $p->pathname($separator);
    $project_frame->selectionClear;
    $project_frame->selectionSet($current_pathname);
    $project_frame->anchorSet($current_pathname);
    $project_frame->see($current_pathname);
    gui_set_pause_or_cont(M"Pause");

    $top->title($title . " (" . $p->pathname . ")");
    add_last_projects($current_project);

    if (defined $mb_show_curr_project_index) {
	$mb_project_menu->entryconfigure($mb_show_curr_project_index,
					 -state => "normal");
    }

    if (defined $busy_timer) {
	$busy_timer->cancel;
    }
    if ($options->{'busyind'}) {
	$busy_timer = $project_frame->repeat
	    ($busy_update, sub {
		$busy_index = ($busy_index >= $#busy_bar ? 0 : $busy_index+1);
		$busy_string = $busy_bar[$busy_index];
	    });
    }

    set_timeout();
}

sub start_project {
    my $p = shift;

    if (!eval { notimes_check(); 1 }) {
	$project_frame->selectionClear;
	return;
    }

    common_start_project($p);
    $p->start_time;
}

sub pause {
    if (defined $current_project) {
	stop_project();
	gui_set_pause_or_cont(M"Cont");
    }
}

sub pause_or_cont {
    if (defined $current_project) {
	stop_project();
	gui_set_pause_or_cont(M"Cont");
    } else {
	my $p = get_project_from_anchor();
	return if !$p;
	start_project($p);
    }
}

sub cont_last {
    my $p = shift;

    return unless eval { notimes_check(); 1 };

    return if !not_running();

    if (!$p) {
	$p = get_project_from_anchor();
    }
    return if !$p || !@{$p->{'times'}};
    my $last = $p->{'times'}[$#{$p->{'times'}}];

    my $last_start = sec2time(time-$last->[0], "h", 0);
    my $last_stop  = sec2time(time-$last->[1], "h", 0);

    require Tk::Dialog;
    my $d = $top->Dialog
      (-title => M"Continue last",
       -text  => Mfmt("Really continue time from last activity?\n" .
		      "%s\n" .
		      "started before %sh\n" .
		      "stopped before %sh",
		      $p->pathname, $last_start, $last_stop),
       -default_button => M"No",
       -buttons => [M"Yes", M"No"],
       -popover => 'cursor',
      );
    return if $d->Show eq M"No";
    $p->unend_time;
    insert_all(); # XXX Optimierung: nur aktuelles Projekt modifizieren
    common_start_project($p);
}

sub get_project_from_selection {
    my $sel = $project_frame->selectionGet;
    if ($sel) {
	return $project_frame->info('data', $sel);
    }
    undef;
}

sub get_project_from_anchor {
    my $sel = $project_frame->info("anchor");
    if ($sel) {
	return $project_frame->info('data', $sel);
    }
    undef;
}

sub get_project_from_anchor_or_selection {
    get_project_from_anchor() || get_project_from_selection();
}

sub update_pause_cont_balloon {
    my $txt = $pause_cont_button->cget(-text);
    if ($txt eq M"Cont") { $txt = M"Continue" }
    if ($balloon) {
	my $p = get_project_from_anchor();
	if ($p) {
	    $balloon->detach($pause_cont_button);
	    $balloon->attach($pause_cont_button,
			     -msg => $txt . " " . $p->pathname);
	}
    }
}

sub gui_set_pause_or_cont {
    my $txt = shift;
    $pause_cont_button->configure(-text => $txt,
				  -fg => ($txt eq M"Cont" ? 'green4' : 'red'));
    update_pause_cont_balloon();

}

sub stop_project {

    return unless eval { notimes_check(); 1 };

    if (defined $time_after) {
	$time_after->cancel;
	undef $time_after;
    }
    if (defined $busy_timer) {
	$busy_timer->cancel;
	undef $busy_timer;
    }
    $busy_string = " ";
    if (defined $current_project) {
	$current_project->end_time;
	act_time();
	undef $current_project;
	if ($options->{'autosave'}) {
	    save_file(); # muß nach undef $current_project kommen!!!
	}
	$project_frame->selectionClear;
	$top->title($title);
	create_menu_last_projects();

	if (defined $mb_show_curr_project_index) {
	    $mb_project_menu->entryconfigure($mb_show_curr_project_index,
					     -state => "disabled");
	}

    }
}

sub undo {

    return unless eval { notimes_check(); 1 };

    if (!defined $current_project) {
	require Tk::Dialog;
	$top->Dialog(-title => M"Info",
		     -text  => M"No running project.",
		     -default_button => M"OK",
		     -buttons => [M"OK"],
		     -popover => 'cursor',
		    )->Show;
	return;
    }

    require Tk::Dialog;
    my $d = $top->Dialog(-title => M"Undo",
			 -text  => Mfmt("Really undo last start of "
					. "%s ?", $current_project->pathname),
			 -default_button => M"No",
			 -buttons => [M"Yes", M"No"],
			 -popover => 'cursor',
			);
    return if $d->Show eq M"No";

    my $p = $current_project;
    stop_project();
    $undo_register = pop(@{$p->{'times'}});
    gui_set_pause_or_cont(M"Cont");
    act_time($p);
}

sub tk_search_project {
    my($direction) = shift;
    $initial_search_direction = $direction;
    $direction = +1 if !defined $direction;
    my $regex = enter_label($direction < 0 ? M("Backward search:") : M("Search:"),
			    'search');
    search_project($regex, $direction);
}

sub search_project {
    my($regex, $direction) = @_;
    $direction = +1 if !defined $direction;
    $direction = -$direction if $initial_search_direction < 0;
    $old_search_regex = $regex;
    if ($regex && $root) {

	my $active;
	my $symbol_dir = $direction > 0 ? "next" : "prev";

	my $checkit = sub {
	    my $p = $project_frame->info('data', $active);
	    return 0 unless $p;
	    if ($p->pathname =~ /(?i)$regex/) {
		$project_frame->see($active);
		$project_frame->anchorSet($active);
		return 1;
	    }
	};

	# first pass
	$active = $project_frame->info("anchor");
	if ($active ne "") {
	    $active = $project_frame->info($symbol_dir, $active);
	}
	while ($active ne "") {
	    return if $checkit->();
	    $active = $project_frame->info($symbol_dir, $active);
	}

	$status_text->configure(-text => M"Wrapped search");

	# second pass from beginning or end
	if ($direction > 0) {
	    ($active) = $project_frame->info("children");
	} else {
	    ($active) = ($project_frame->info("children"))[-1];
	    while (my(@c) = $project_frame->info("children", $active)) {
		$active = $c[-1];
	    }
	}
	while ($active ne "") {
	    return if $checkit->();
	    $active = $project_frame->info($symbol_dir, $active);
	}

	$status_text->configure(-text => M"Nothing found");
    }

}

sub traverse_entries {
    my $sub = shift;
    my $active;
    ($active) = $project_frame->info("children");
    while (defined $active and $active ne "") {
	$sub->($active);
	$active = $project_frame->info("next", $active);
    }
}

sub act_time {
    my $p = shift;
    if (!$p) {
	$p = $current_project;
	return if !$p;
    }
    my $project = $p;
    while ($project) {
	act_time_project($project);
	$project = ($project->level > 1 ? $project->parent : undef);
    }
    set_timeout();
}

sub act_time_project {
    my($p) = @_;
    my $path = make_path($p);
    return if !$path;
    $project_frame->itemConfigure
      ($path, $pf_time_index,
       -text => sec2time($p->sum_time($start_session_time, undef,
				      -recursive => 1,
				      -usecache => 1)));
    $project_frame->itemConfigure
      ($path, $pf_time_index+1,
       -text => sec2time($p->sum_time($today_time, undef,
				      -recursive => 1,
				      -usecache => 1)));
    $project_frame->itemConfigure
      ($path, $pf_time_index+2,
       -text => sec2time($p->sum_time(0, undef,
				      -recursive => 1,
				      -usecache => 1)));
}

sub set_timeout {
    if (defined $time_after) {
	$time_after->cancel;
    }
    $time_after = $project_frame->after
      ($time_update*1000, sub { act_time(); } );
}

sub working_time {
    my $sum = 0;
    my $week_days = 7;
    my $week_work_days = 5;
    my $month_days = 7*4;
    my $month_work_days = 5*4;
    my $last_4week_time = $today_time - 86400*$month_days;
    my $last_week_time = $today_time - 86400*$week_days;
    my $yesterday_time = $today_time - 86400;
    my $last_4week_sum = 0;
    my $last_week_sum = 0;
    my $yesterday_sum = 0;
    foreach ($root->subproject) {
	my $project_today_time = $_->sum_time($today_time, undef,
					      -recursive => 1);
	$sum += $project_today_time;
	$yesterday_sum
	  += $_->sum_time($yesterday_time, undef,
			  -recursive => 1) - $project_today_time;
	$last_week_sum
	  += $_->sum_time($last_week_time, undef, -recursive => 1);
	$last_4week_sum
	  += $_->sum_time($last_4week_time, undef, -recursive => 1);
    }

    require Tk::DialogBox;
    my $d = $top->DialogBox(-title => M"Today\'s time",
			    -buttons => [M"OK"],
			    -popover => 'cursor',
			   );
    my $gridy = 0;
    $d->add('Label',
	    -text => M"Today\'s working time:")->grid(-row => $gridy,
						     -column => 0,
						     -sticky => 'w');
    $d->add('Label',
	    -text => sec2time($sum, 'h', 0))->grid(-row => $gridy,
						   -column => 1,
						   -sticky => 'w');
    $gridy++;
    $d->add('Label',
	    -text => M"Yesterday\'s working time:")->grid(-row => $gridy,
							 -column => 0,
							 -sticky => 'w');
    $d->add('Label',
	    -text => sec2time($yesterday_sum, 'h', 0))->grid(-row => $gridy,
							     -column => 1,
							     -sticky => 'w');
    $gridy++;
    $d->add('Label')->grid(-row => $gridy, -column => 0);
    $gridy++;
    $d->add('Label',
	    -text => M"Last week\'s working time (8h-day):"
	   )->grid(-row => $gridy,
		   -column => 0,
		   -sticky => 'w');
    $d->add('Label',
	    -text => sec2time($last_week_sum, 'd', 1))->grid(-row => $gridy,
							     -column => 1,
							     -sticky => 'w');
    $gridy++;
    $d->add('Label',
	    -text => "  " . M"Average per working day:")->grid(-row => $gridy,
							       -column => 0,
							       -sticky => 'w');
    $d->add('Label',
	    -text => sec2time($last_week_sum/$week_work_days, 'h', 0)
	   )->grid(-row => $gridy,
		   -column => 1,
		   -sticky => 'w');
    $gridy++;
    $d->add('Label')->grid(-row => $gridy, -column => 0);
    $gridy++;
    $d->add('Label',
	    -text => M"Last 4 week\'s working time (8h-day): "
	   )->grid(-row => $gridy,
		   -column => 0,
		   -sticky => 'w');
    $d->add('Label',
	    -text => sec2time($last_4week_sum, 'd', 1))->grid(-row => $gridy,
							      -column => 1,
							      -sticky => 'w');
    $gridy++;
    $d->add('Label',
	    -text => "  " . M"Average per working day:")->grid(-row => $gridy,
							       -column => 0,
							       -sticky => 'w');
    $d->add('Label',
	    -text => sec2time($last_4week_sum/$month_work_days, 'h', 0)
	   )->grid(-row => $gridy,
		   -column => 1,
		   -sticky => 'w');
    $d->Show;
}

sub show_one_day {

    return unless eval { notimes_check(); 1 };

    my($inner_bg_opt, $inner_fg_opt) = ('-bg', '-fg');
    my %date_args;
    my $has_date;
    eval $date_require;

    my $one_day_only = 1;
    my $has_date_entry;
    if (!$has_date) {
	eval {
	    require Tk::DateEntry;
	};
	$has_date_entry = !$@;
	if (!$has_date_entry) {
	    require Time::Local;
	}
    }
    my $f = $top->Toplevel(-title => M"Show daily details");
    $f->{WindowType} = "Daily details"; # no M
    my $btn;
    my @p; # project array for one day
    my($dw, $dw_to);
    my $no_interval_cb;
    my $adjust_chain;
    if ($has_date) {
	my $df = $f->Frame->pack;
	# from:
	$dw = $df->Date
	  ($inner_bg_opt => $inner_bg,
	   $inner_fg_opt => $inner_fg,
	   %date_args,
	   -fields => 'date',
	   -value => 'now',
	   -datefmt => "%12A, %2d.%2m.%4y",
	   -choices => [qw(today yesterday),
			[M"one week before" => sub {time()-86400*7}],
			[M"four weeks before" => sub { time()-86400*7*4}],
		       ],
	   -command => sub {
	       # XXX if chain button activated, adjust dw_to widget
	       if ($options->{'oneday-immediately'}) {
		   $btn->invoke;
	       }
	   }
	  )->grid(-row => 0, -column => 0, -sticky => "e");
	# to:
	$dw_to = $df->Date
	    ($inner_bg_opt => $inner_bg,
	     $inner_fg_opt => $inner_fg,
	     %date_args,
	     -fields => 'date',
	     -value => 'now',
	     -datefmt => "%12A, %2d.%2m.%4y",
	     -choices => [qw(today yesterday),
			  [M"one week before" => sub {time()-86400*7}],
			  [M"four weeks before" => sub { time()-86400*7*4}],
			 ],
	     -command => sub {
		 if ($options->{'oneday-immediately'}) {
		     $btn->invoke;
		 }
	     }
	    )->grid(-row => 1, -column => 0, -sticky => "e");

	my $c;

	my $setup_chain = sub {
	    $dw_to->update; # XXX wollte ich eigentlich vermeiden
	    my $h = $dw_to->y - $dw->y + $dw_to->height;
	    my $h_step = $h*5/40;

	    $c = $df->Canvas
		(-width => 20,
		 -height => $h,
		 -takefocus => 0,
		 -highlightthickness => 0,
		)->grid(-row => 0, -column => 1, -rowspan => 2);
	    $c->createLine(5,$h_step*2, 10,$h_step*2,
			   15,$h_step*3, 15,$h_step*5,
			   10,$h_step*6, 5,$h_step*6,
			   -width => $h_step, -smooth => 1,
			   -tags => "chain");
	    my $orig_bg  = $c->cget(-bg);
	    $c->Tk::bind('<Enter>' => sub {
			     $c->itemconfigure("chain", -fill => 'grey50');
			 });
	    $c->Tk::bind('<Leave>' => sub {
			     $c->itemconfigure("chain", -fill => "black");
			 });
	    $adjust_chain = sub {
		if ($one_day_only) {
		    $c->delete("broken");
		} else {
		    $c->createRectangle(0,16/40*$h,20,23/40*$h,-fill=>$orig_bg,
					-outline=>undef,
					-tags=>"broken");
		}
	    };
	    $c->Tk::bind('<1>' => sub {
			     $no_interval_cb->toggle;
			     $adjust_chain->();
			 });
	};
	$df->afterIdle($setup_chain);
    } else {
	if ($has_date_entry) {
	    $dw = $f->DateEntry
	      (-dateformat => 2,
	       -background => $inner_bg,
	       -foreground => $inner_fg,
	       -daynames => [qw/So Mo Di Mi Do Fr Sa/],
	       -weekstart => 1,
	      )->pack;
	} else {
	    $dw = $f->Entry(-bg => $inner_bg,
			    -fg => $inner_fg,
			   )->pack;
	    $dw->bind('<Return>' => sub {
			  if ($options->{'oneday-immediately'}) {
			      $btn->invoke;
			  }
		      });
	}
	my(@l) = localtime;
	$dw->insert(0, sprintf("%04d/%02d/%02d", $l[5]+1900, $l[4]+1, $l[3]));
    }
    my $ff = $f->Frame->pack;
    $btn = $ff->Button(-text => M"Show")->pack(-side => 'left');
    $f->{InvokeButton} = $btn;
    my $clb = $ff->Button(-text => M"Close",
			  -command => sub { $f->destroy },
			 )->pack(-side => 'left');
    $f->bind('<Escape>' => sub { $clb->invoke });
    $ff->Checkbutton(-text => M"immediately",
		     -variable => \$options->{'oneday-immediately'},
		     -command => sub {
			 $btn->invoke;
		     },
		     ($has_date_entry ? (-state => 'disabled') : ()),
		    )->pack(-side => 'left');
    $no_interval_cb =
	$ff->Checkbutton(-text => M"no interval",
			 -variable => \$one_day_only,
			 -command => sub {
			     if ($options->{'oneday-immediately'}) {
				 $btn->invoke;
			     }
			     $adjust_chain->() if $adjust_chain;
			 },
			)->pack(-side => 'left');
    my $act_from_date; # current from date
    my $lb = $f->Scrolled('HList',
			  -bg => $inner_bg,
			  -fg => $inner_fg,
			  -columns => 2,
			  -width => 40,
			  -header => 1,
			  -scrollbars => "oso$sbside",
			  -selectmode => 'extended',
			  -exportselection => 1,
			  -command => sub {
			      show_intervals($f, $p[$_[0]],
					     -day => $act_from_date)
			  },
			 )->pack(-expand => 1,
				 -fill => 'both');
    $btn->configure(-command => sub {
		      my $s_from;
		      if ($has_date) {
			  $s_from = $dw->get("%s");
			  $s_from = Tk::Date::_begin_of_day($s_from);
		      } else {
			  my $s = $dw->get;
			  my($y,$m,$d) = split(/\D/, $s);
			  return if !($d >= 1 && $d <= 31 &&
				      $m >= 1 && $m <= 12 &&
				      defined $y);
			  $y -= 1900 if $y > 1900;
			  $s_from = Time::Local::timelocal(0, 0, 0,
							   $d, $m-1, $y);
		      }
		      $act_from_date = $s_from;
		      my $s_to = $s_from + 86399;
		      if ($has_date && !$one_day_only) {
			  $s_to = $dw_to->get("%s");
			  $s_to = Tk::Date::_begin_of_day($s_to)+86399;
		      }
		      if ($has_date) {
			  $dw_to->configure(-value => $s_to);
		      }
		      @p = $root->projects_by_interval($s_from, $s_to);
		      $lb->delete('all');
		      my $i = 0;
		      my $sum = 0;
		      foreach (@p) {
			  $lb->add($i, -text => $_->pathname);
			  my $diff = $_->sum_time($s_from, $s_to);
			  $sum += $diff;
			  $lb->itemCreate($i, 1, -text =>
					  sec2time($diff, undef, undef));
			  $i++;
		      }
		      $lb->header('create', 0, -text => '*** sum ***');
		      $lb->header('create', 1, -text =>
				  sec2time($sum, undef, undef));
		  });

    if ($has_date) {
	my $di = $lb->Button
	  (-text => M"Daily intervals",
	   -command => sub {
	       my $begin_date = $dw->get("%s");
	       $begin_date = Tk::Date::_begin_of_day($begin_date);
	       daily_intervals($begin_date, $begin_date+86400-1);
	   },
	   -padx => 0, -pady => 0);
	$di->place(-rely => 1, '-y' => -$di->reqheight,
		   -relx => 1, '-x' => -$di->reqwidth); # XXX place!
    }
    if ($options->{'oneday-immediately'}) { $btn->invoke }
    $f->Popup(-popover => 'cursor');
}

sub daily_intervals {
    my($begin_date, $end_date) = @_;
    require POSIX;
    my $t = $top->Toplevel;
    $t->title(POSIX::strftime("%Y-%m-%d", localtime $begin_date));

    my $c;
    my $lb;

    my $highlight_sub = sub {
	my $entry = shift;
	$c->delete("hi");
	foreach my $it ($c->find("withtag", "entry_$entry")) {
	    my $new_it = canvas_copy_item($c, $it);
	    $c->itemconfigure($new_it, -fill => "green", -tags => "hi");
	}
    };

    my @utmp_lines;
    if ($utmp) {
	$utmp->update_if_necessary(300);
	@utmp_lines = $utmp->restrict(User => $username,
				      From => $begin_date,
				      To   => $end_date);
    }

    $lb = $t->Scrolled
	('HList', -scrollbars => "oso$sbside",
	 -columns => 3,
	 -width => 60,
	 -selectmode => "browse",
	 -browsecmd => $highlight_sub,
	)->pack(-expand => 1, -fill => 'both',
		-side => "left");

    my $rad = 50;
    $c = $t->Canvas(-width => $rad*2,
		    -height => $rad*2*2+5,
		    -takefocus => 0,
		    -highlightthickness => 0,
		   )->pack(-fill => "both", -side => "left");
    my @clock = ([0,0,$rad*2,$rad*2],
		 [0,$rad*2+4, $rad*2, $rad*2]
		);
    $c->createOval(@{$clock[0]},
		   -outline => $inner_fg, -fill => $inner_bg, -width => 3);
    _draw_hour_ticks($c, @{$clock[0]});
    $c->createOval($clock[1]->[0], $clock[1]->[1],
		   $clock[1]->[0]+$clock[1]->[2],
		   $clock[1]->[1]+$clock[1]->[3],
		   -outline => $inner_fg, -fill => $inner_bg, -width => 3);
    _draw_hour_ticks($c, @{$clock[1]});
    $c->bind("entry", "<1>" => sub {
		 my $c = shift;
		 foreach ($c->gettags("current")) {
		     if (/^entry_(\d+)/) {
			 my $e = $1;
			 $lb->see($e);
			 $lb->anchorClear;
			 $lb->selectionClear;
			 $lb->anchorSet($e);
			 $highlight_sub->($e);
			 return;
		     }
		 }
	     });

    my $str_time = sub { POSIX::strftime("%H:%M:%S", localtime $_[0]) };

    my @res_times = $root->restricted_times($begin_date, $end_date);
    my $i = 0;
    my $fill_color = "red";
    foreach (@res_times) {
	my $name = $_->[0]->pathname;
	if (length($name) > 40) {
	    $name = "... " . substr($name, -36); #length($name)-36
	}
	$lb->add($i, -text => $name,
		 -itemtype => $p_itemtype,
		 ($hl_entry{$fill_color}
		  ? (-style => $hl_entry{$fill_color}) : ()));

	my $begin_time = $str_time->($_->[1]);
	my $end_time   = $str_time->($_->[2]);

	$lb->itemCreate($i, 1, -text => $begin_time,
			-itemtype => $p_itemtype,
			($hl_entry{$fill_color}
			 ? (-style => $hl_entry{$fill_color}) : ()));
	$lb->itemCreate($i, 2, -text => $end_time,
			-itemtype => $p_itemtype,
			($hl_entry{$fill_color}
			 ? (-style => $hl_entry{$fill_color}) : ()));

	my($begin_clock,
	   $begin_x,
	   $begin_y,
	   $begin_angle) = _get_tic_pos($c, $clock[0], $clock[1], $begin_time);
	my($end_clock,
	   $end_x,
	   $end_y,
	   $end_angle) = _get_tic_pos($c, $clock[0], $clock[1], $end_time);

	if ($begin_clock == $end_clock) {
	    $c->createArc($clock[$begin_clock]->[0], $clock[$begin_clock]->[1],
			  $clock[$begin_clock]->[0]+$clock[$begin_clock]->[2],
			  $clock[$begin_clock]->[1]+$clock[$begin_clock]->[3],
			  -start => $begin_angle,
			  -extent => $end_angle-$begin_angle,
			  -fill => $fill_color,
			  -tags => ["entry_$i", "entry"],
			 );
	} else {
	    $c->createArc($clock[0]->[0], $clock[0]->[1],
			  $clock[0]->[0]+$clock[0]->[2],
			  $clock[0]->[1]+$clock[0]->[3],
			  -start => $begin_angle,
			  -extent => 90-$begin_angle,
			  -fill => $fill_color,
			  -tags => ["entry_$i", "entry"],
			 );
	    $c->createArc($clock[1]->[0], $clock[1]->[1],
			  $clock[1]->[0]+$clock[1]->[2],
			  $clock[1]->[1]+$clock[1]->[3],
			  -start => 90,
			  -extent => $end_angle-(90+360),
			  -fill => $fill_color,
			  -tags => ["entry_$i", "entry"],
			 );
	}

	$fill_color = ($fill_color eq 'red' ? 'blue' : 'red');

	$i++;
    }

    my @utmp_canvas_args = (-fill => 'yellow',
			    -stipple => 'gray50',
			    -tags => "uptime",
			    -outline => undef,
			   );

    foreach my $utmp_line (@utmp_lines) {

	my $begin_time = $str_time->($utmp_line->{Begin});
	my $end_time   = $str_time->($utmp_line->{End});

	my($begin_clock,
	   $begin_x,
	   $begin_y,
	   $begin_angle) = _get_tic_pos($c, $clock[0], $clock[1], $begin_time);
	my($end_clock,
	   $end_x,
	   $end_y,
	   $end_angle) = _get_tic_pos($c, $clock[0], $clock[1], $end_time);

	if ($begin_clock == $end_clock) {
	    $c->createArc($clock[$begin_clock]->[0], $clock[$begin_clock]->[1],
			  $clock[$begin_clock]->[0]+$clock[$begin_clock]->[2],
			  $clock[$begin_clock]->[1]+$clock[$begin_clock]->[3],
			  -start => $begin_angle,
			  -extent => $end_angle-$begin_angle,
			  @utmp_canvas_args,
			 );
	} else {
	    $c->createArc($clock[0]->[0], $clock[0]->[1],
			  $clock[0]->[0]+$clock[0]->[2],
			  $clock[0]->[1]+$clock[0]->[3],
			  -start => $begin_angle,
			  -extent => 90-$begin_angle,
			  @utmp_canvas_args,
			 );
	    $c->createArc($clock[1]->[0], $clock[1]->[1],
			  $clock[1]->[0]+$clock[1]->[2],
			  $clock[1]->[1]+$clock[1]->[3],
			  -start => 90,
			  -extent => $end_angle-(90+360),
			  @utmp_canvas_args,
			 );
	}
    }

    $c->raise('uptime');
    $c->raise('entry');
    $c->raise('tics');

}

sub _draw_hour_ticks {
    my $c = shift;
    my($x, $y, $width, $height) = @_;
    for my $h (0..11) {
	$c->createLine
	    (
	     $x + $width/2-sin(deg2rad((12-$h)*30))*$width/2,
	     $y + $height/2-cos(deg2rad((12-$h)*30))*$height/2,
	     $x + $width/2-sin(deg2rad((12-$h)*30))*($width/2-8),
	     $y + $height/2-cos(deg2rad((12-$h)*30))*($height/2-8),
	     -fill => "black",
	     -width => 3,
	     -tags => "tics",
	    );
    }
}

sub _get_tic_pos {
    my($c, $clock1_def, $clock2_def, $time) = @_;
    my $clock = 0;
    if ($time =~ /^(\d{1,2}):(\d{2}):(\d{2})/) {
	my $hour = $1;
	my $min  = $2;
	if ($hour >= 12) {
	    $clock = 1;
	    $hour-=12;
	}
	$hour += $min/60;
	my $clock_def = ($clock == 0 ? $clock1_def : $clock2_def);
	my $angle = (12-$hour)*30;
	($clock,
	 $clock_def->[0] + $clock_def->[2]/2-sin(deg2rad($angle))
	       * $clock_def->[2]/2,
	 $clock_def->[1] + $clock_def->[3]/2-cos(deg2rad($angle))
	       * $clock_def->[3]/2,
	 $angle+90,
	);
    } else {
	();
    }
}

# REPO BEGIN
# REPO NAME copy_item /home/e/eserte/src/repository 
# REPO MD5 839315861d37edfcdfd81060ab32d9e4

sub canvas_copy_item {
    my($c, $i) = @_;

    my $type = $c->type($i);
    my @coords = $c->coords($i);
    my @old_config = $c->itemconfigure($i);
    my @new_config;
    foreach my $conf (@old_config) {
	push @new_config, $conf->[0], $conf->[4];
    }

    $c->create($type, @coords, @new_config);
}
# REPO END

# REPO BEGIN
# REPO NAME standalone_message_box /home/e/eserte/src/repository 
# REPO MD5 c4592f93ed4afa4f6a93d9ff38d2e905

sub standalone_message_box {
    my %args = @_;
    require Tk;
    my $mw_created;
    my(@mw) = Tk::MainWindow::Existing();
    if (!@mw) {
	push @mw, MainWindow->new();
	$mw[0]->withdraw;
	$mw_created++;
    }
    $args{-icon}  = 'error'  unless exists $args{-icon};
    $args{-title} = M"Error" unless exists $args{-error};
    $args{-type}  = "OK"     unless exists $args{-type};
    my $answer = $mw[0]->messageBox(%args);
    if ($mw_created) {
	$mw[0]->destroy;
    }
    $answer;
}

# REPO END

sub _multiproject {
    my(@files) = @_;

    require Timex::MultiProject;
    my $mp1 = Timex::MultiProject->new;
    $mp1->set(-masterproject => $root,
	      -files => \@files);
    $mp1;
}

sub load_files {
    my $mp1 = _multiproject(@_);
    $mp1->load or return 0;
    $mp1->save; # try to save updated project files
    $mp1->master_project; # return master project
}

sub save_files {
    _multiproject(@_)->save;
}

sub load_file {
    my $interactive = shift;
    my $file_to_load = shift;
    my $offline_file;

    if ($root->modified || defined $current_project) {
	require Tk::Dialog;
	my $dialog = $top->Dialog(-title => M"Load",
				  -text  => M"Load project data (overwrite current data)?",
				  -default_button => M"No",
				  -buttons => [M"Yes", M"No"],
				  -popover => 'cursor',
				 );
	return if $dialog->Show eq M"No";
    }
    stop_project();

    if (!defined $file_to_load) {
	$file_to_load = $options->{'file'};
	$offline_file = $options->{'offlinefile'};
    }

    if ($interactive) {
	my($file, $path) = fileparse($options->{'file'});
	if ($path =~ m|^\.|) {
	    require Cwd;
	    $path = Cwd::abs_path($path);
	}

	$file_to_load = get_filename($top,
				     -Title  => M"Enter project file",
				     -File   => $file,
				     -Path   => $path,
				     -FPat   => '*.pj1',
				     -filetypes => [qw/pj1 xml all/],
				     -Create => 0);
	return if !$file_to_load;

	$offline_file = '';
    }

    if ($is_opened and $lock_is_strict) {
	unlock_file_temp();
    }

    $root->delete_all;
    if (!lock_file($file_to_load)) {
	$options->{'file'} = '';
	return;
    }

    my $sos_file = sos_filename($file_to_load);
    if (-f $sos_file) {
	my $mtime = (stat($sos_file))[9];
	require Tk::Dialog;
	$top->Dialog
	  (-title => M"Warning",
	   -text => Mfmt
	   ("There is a sos file <%s>\n".
	    "from %s\n".
	    "You should check whether this file contains valueable information.\n".
	    "Otherwise delete the file to avoid this warning.",
	    $sos_file, scalar(localtime($mtime))),
	   -popover => 'cursor',
	   -default_button => M"OK",
	   -buttons => [M"OK"])->Show;
    }

    my $load_root = new Timex::Project;
    unlock_file_temp() if $lock_is_strict;

    my $ok = 1;
    if ($offline_file ne '') {
	$load_root = load_files($file_to_load, $offline_file);
	if (!$load_root) {
	    $status_text->configure(-text => $@);
	    $ok = 0;
	}
    } else {
	if (!$load_root->load($file_to_load)) {
	    $status_text->configure(-text => $@);
	    $ok = 0;
	}
    }
    return unless $ok;

    # no check if there is also an offline file
    if ($offline_file eq '') {
	$file_writeable = -w $file_to_load;
	if (!$file_writeable) {
	    require Tk::Dialog;
	    $top->Dialog
		(-title => M"Warning",
		 -text => Mfmt("The file %s is not writeable!", $file_to_load),
		 -popover => 'cursor',
		)->Show;
	}
	lock_file($file_to_load) if $lock_is_strict;
    }

    $root = $load_root;
    $options->{'file'} = $file_to_load;

    $status_text->configure(-text => Mfmt("Loaded %s", $options->{file}));
    insert_all();
    set_autosave();
    $root->modified(0);
    if ($mod_watch) {
	$mod_watch->Unwatch;
	$mod_watch = Tie::Watch->new(-variable => \$root->{'modified'},
				     -store => $mod_sub,
				    );
	$mod_sub->();
    } else {
	$save_check->configure(-variable => \$root->{'modified'});
    }
    my $last_project = $root->last_project;
    if ($last_project) {
	my $last_project_path = make_path($last_project);
	if ($project_frame->info('exists', $last_project_path)) {
	    $project_frame->anchorSet($last_project_path);
	    $project_frame->see($last_project_path);
	    gui_set_pause_or_cont(M"Cont");
	}
    }
}

BEGIN { state_change("parsed 54%"); }

sub load_file_noninteractive {
    my $file = shift;
    load_file(0, $file);
}

sub lock_file {
#warn "file=$_[0] lock:$can_lock";
    if (!$can_lock || !$options->{'lock'}) {
	return 1;
    }
    my $file = shift;
    if (!-e $file) {
	return 1;
    }
    if (!$is_opened) {
#warn "not opened";
	eval q{
	    use Fcntl qw(:flock);
	    flock CURRFILE, LOCK_UN;
	};
	warn $@ if $@;
	close CURRFILE;
	$is_opened = 0;
    }
    my $lock_ok = 0;
    if (open(CURRFILE, $file)) {
	$is_opened = 1;
#warn "opend";
	eval q{
	    use Fcntl qw(:flock);
#warn "try flock";
	    if (!flock CURRFILE, LOCK_EX|LOCK_NB) {
		use Tk::Dialog;
		$top->Dialog
		  (-title => M"File locked",
		   -text  => Mfmt
		   ("<%s> is already locked.\n\n" .
		    "Please check that there is no other tktimex process " .
		    "using this file and try again.\n", $file),
		   -default_button => M"OK",
		   -buttons => [M"OK"],
		   -popover => 'cursor',
		  )->Show;
		$lock_ok = 0;
	    } else {
		$lock_ok = 1;
	    }
	};
	warn $@ if $@;
    }
#warn "lockok=$lock_ok";
    $lock_ok;
}

sub unlock_file_temp {
#warn "file=? unlock: can_lock=$can_lock";
    return if (!$can_lock || !$options->{'lock'});
    eval q{
	use Fcntl qw(:flock);
#warn "try lock";
	flock CURRFILE, LOCK_UN;
    };
    warn $@ if $@;
    close CURRFILE;
#warn "cloce";
    $is_opened = 0;
}

sub update_project {
    my $p = shift;

    # get top parent of this project (one under root)
    my $top_parent = $p->top_parent;

    # get hlist position (i.e. previous element
    my $top_parent_entry = make_path($top_parent);
    if (!$top_parent_entry) {
	warn Mfmt("Should not happen: Can't find entry for %s",
		  $top_parent->pathname);
	return;
    }

    my @root_children = $project_frame->info("children");
    my $prev_entry;
 SEARCH:
    {
	for my $i (0 .. $#root_children) {
	    if ($top_parent_entry eq $root_children[$i]) {
		$prev_entry = $root_children[$i-1] if $i > 0;
		last SEARCH;
	    }
	}
	warn Mfmt("Can't find %s in children list (@root_children) of HList",$top_parent_entry);
	return;
    }

    $project_frame->delete("entry", $top_parent_entry);
    insert_old_project($top_parent, -after => $prev_entry);
}

sub insert_all {
    my(%args) = @_;

    my %new_p;
    if ($args{-newprojects}) {
	%new_p = map { ($_->pathname, 1) } @{ $args{-newprojects} };
    }
    my %changed_p;
    if ($args{-changedprojects}) {
	%changed_p = map { ($_->pathname, 1) } @{ $args{-changedprojects} };
    }

    $top->Busy($Tk::VERSION >= 800.014 ? (-recurse => 1) : ());
    $project_frame->delete('all');
    my $p;
    foreach $p ($root->sorted_subprojects($options->{'sort'})) {
	insert_old_project($p,
			   -newprojects => \%new_p,
			   -changedprojects => \%changed_p);
    }
    if (defined $current_project) {
	$project_frame->anchorSet(make_path($current_project));
    }
    @all_domains = $root->get_all_domains;

    if ($is_tree) {
	# custom setmode implementation to use the recorded closed information
	# in the project file
	my $setmode;
	$setmode = sub {
	    my ($ent,$mode) = @_;
	    unless (defined $mode) {
		$mode = 'none';
		my @args;
		push(@args,$ent) if defined $ent;
		my @children = $project_frame->infoChildren( @args );
		if ( @children ) {
		    my $p = entry_to_project($ent);
		    $mode = $p && $p->closed ? 'open' : 'close';
		    foreach my $c (@children) {
			if ($mode eq 'open') {
			    $project_frame->hide(-entry => $c);
			} else {
			    $mode = 'open' if $project_frame->infoHidden( $c );
			}
			$setmode->( $c );
		    }
		}
	    }

	    if (defined $ent) {
		if ( $mode eq 'open' )  {
		    $project_frame->_indicator_image( $ent, 'plus' );
		} elsif ( $mode eq 'close' ) {
		    $project_frame->_indicator_image( $ent, 'minus' );
		} elsif( $mode eq 'none' ) {
		    $project_frame->_indicator_image( $ent, undef );
		}
	    }
	};
  	$setmode->();
    }

    $top->Unbusy($Tk::VERSION >= 800.014 ? (-recurse => 1) : ());
}
*update_all = \&insert_all;

sub insert_old_project {
    my($p, %args) = @_;
    my $prev_entry = delete $args{-after};

    my $style;
    my $set_style = sub {
	my $p = shift;
	my $style;
	if ($args{-newprojects} && $args{-newprojects}->{$p->pathname}) {
	    $style = $new_in_merge;
	}
	if ($args{-changedprojects} && $args{-changedprojects}->{$p->pathname}) {
	    $style = $changed_in_merge;
	}
	$style;
    };

    insert_project($p, -after => $prev_entry, -style => $set_style->($p));
    if (!$options->{'onlytop'}) {
	foreach ($p->sorted_subprojects($options->{'sort'})) {
	    insert_old_project($_, %args);
	}
    }
}

sub update_costs_option {
    my $interactive = shift;
    $has_costs = ($options->{'hourlyrate'} > 0) ? 1 : 0;
    if ($interactive) {
	insert_all();
	my $costs_col = $pf_time_index+3;
	if ($interactive && !$has_costs) {
	    if ($project_frame->header('exist', $costs_col)) {
		$project_frame->header('delete', $costs_col);
	    }
	} else {
	    $project_frame->header
		('create', $costs_col,
		 -text => Mfmt("Cost (%s %s)",
			       $options->{'hourlyrate'},
			       $options->{'currency'}));
	}
    }
}

sub dump_data {
    print STDERR $root->dump_data();
    if (!open(OUT, ">/tmp/timex.data")) {
	$status_text->configure(-text => M("Can't write to timex.data").": $!");
	return;
    }
    print OUT $root->dump_data();
    close OUT;
}

sub old_save_file {
    eval { require Data::Dumper };
    if ($@) {
	$status_text->configure(-text => $@);
	return;
    }

    return if (!$options->{'file'});

    my $datafile = "$options->{'file'}.data";
    if ($^O =~ /(mswin|dos)/i) {
	$datafile =~ s/\.pj1//; # strip first extension
    }

    if (!open(OUT, ">$datafile")) {
	$status_text->configure
	  (-text => Mfmt("Can't write to <%s>: %s", $datafile, $!));
	return;
    }
    my $dd = new Data::Dumper [$root], ['root'];
    # Indent(0) for buggy Data::Dumper on some ActivePerl versions
    eval { $dd->Purity(1)->Indent(0) }; # eval for versions before 2.081
    my $dump;
    eval { $dump = $dd->Dumpxs };
    if ($@) {
	$dump = $dd->Dump;
    }
    print OUT $dump, "\n";
    close OUT;
}

sub save_file {
    my($autosave) = @_;

    if (!$options->{'file'}) {
	if (!$autosave) {
	    return save_as_file(@_);
	} else {
	    return;
	}
    }

    if (defined $current_project) {
	$current_project->end_time;
    }

    my @collect_warnings;
    my $dir_check_done;

    my $rename_op = sub {
	my $inx = shift;

	my $from = (defined $inx ? "$options->{'file'}.$inx" : $options->{'file'});
	my $to   = "$options->{'file'}." . (defined $inx ? $inx+1 : 1);

	if (-e $from) {
	    if (!rename $from, $to) {
		push @collect_warnings, Mfmt("Could not rename %s to %s: %s", $from, $to, $!);
		if (!$dir_check_done) {
		    $dir_check_done++;
		    my $dir = dirname($to);
		    if (!-w $dir) {
			push @collect_warnings, Mfmt("The directory %s is not writable for you", $dir);
		    }
		}
	    }
	}
    };

    if (!$autosave) {
	foreach (reverse(0 .. 8)) {
	    $rename_op->($_);
	}
    }
    $rename_op->(undef);

    if (@collect_warnings) {
	if ($top && Tk::Exists($top) && $top->can('messageBox')) {
	    my $yesno =
		$top->messageBox(-message => M("Problem while renaming backup files. Please contact your system administrator or check permissions.\nThe detailed error message is:\n") .
				 join("\n", @collect_warnings) . "\n\n" .
				 M("Do you want to continue the save operation?"),
				 -icon => 'error',
				 -title => M"Save problem",
				 -type => 'YesNo',
				);
	    if ($yesno !~ /yes/i) {
		return 0;
	    }
	} else {
	    warn join("\n", @collect_warnings);
	}
    }

    unlock_file_temp() if $lock_is_strict;

    my $offline_file = $options->{'offlinefile'};
    my $ret;
    if (defined $offline_file && $offline_file ne "") {
	$ret = save_files($options->{'file'}, $offline_file);
    } else {
	$ret = $root->save("$options->{'file'}");
    }
    if (!$ret) {
	$status_text->configure(-text => $@);
    } else {
	$status_text->configure(-text => Mfmt("Saved <%s>",$options->{'file'}));
    }
    old_save_file() if $options->{'securesave'};
    lock_file("$options->{'file'}") if $lock_is_strict;

    if (defined $current_project) {
	$current_project->unend_time;
    }

    if (!$autosave) {
	$root->modified(0);
    }

    lock_file($options->{'file'});

    set_autosave();
}

sub save_as_file {
    my $autosave = shift;

    my($file, $path) = get_file_path();
    $file = get_filename($top,
			 -Title => M"Enter project file",
			 -File => $file,
			 -Path => $path,
			 -FPat => '*.pj1',
			 -filetypes => [qw/pj1 all/],
			 -Create => 1);
    return unless $file;

    $file = adjust_filename($file);
    $options->{'file'} = $file;

    save_file($autosave);
}

sub sos_filename {
    my $file = shift;
    dirname($file) . "/#" . basename($file) . "#";
}

sub save_sos {
    return if !$root || !$root->modified;
    my $file;
    if (!$options->{'file'}) {
	$file = sos_filename(File::Spec->catfile($home, "tktimex.pj1"));
    } else {
	$file = sos_filename($options->{'file'});
    }
    if (defined $current_project) {
	$current_project->end_time;
    }
    warn Mfmt("Saving sos file %s...\n", $file);
    $root->save($file);
    if (defined $current_project) {
	$current_project->unend_time;
    }

    eval {
	require Mail::Send;
	my $msg = Mail::Send->new;
	$msg->to($username);
	$msg->subject(M"tktimex: sos file");
	my $fh = $msg->open;
	print $fh Mfmt(<<EOF, $file);
A copy of your tktimex data is saved in %s.
Please check whether the data is complete, then copy this file
as your tktimex data file with:

EOF
        print $fh <<EOF;
    @{[
         $os eq 'win' ? "copy" : "cp"
      ]} $file $options->{'file'}

EOF
        $fh->close;
    };
    warn $@ if $@;
}

sub _overwrite_warning {
    my $file = shift;
    if (-e $file) {
	require Tk::Dialog;
	die if ($top->Dialog
		(-title => M"Warning",
		 -text => Mfmt
		 ("Really overwrite %s with skeleton data?\n".
		  "All time information will be lost in %s!",$file,$file),
		 -popover => 'cursor',
		 -default_button => M"No",
		 -buttons => [M"Yes", M"No"])->Show ne M"Yes");
    }
}

sub save_skeleton {
    my($file, $path) = get_file_path();
    $file = get_filename($top,
			 -Title => M"Enter skeleton project file",
			 -Path => $path,
			 -FPat => '*.pj1',
			 -filetypes => [qw/pjt pj1 all/],
			 -Create => 1);
    return unless $file;
    $file = adjust_filename($file);
    eval {
	_overwrite_warning($file);
    };
    return if ($@);

    $root->save($file, -skeleton => 1);
}

sub save_subproject {
    my $p = get_project_from_anchor();
    return if !$p;
    my($file, $path) = get_file_path();
    $file = get_filename($top,
			 -Title => M"Enter project file",
			 -Path => $path,
			 -FPat => '*.pj1',
			 -filetypes => [qw/pj1 all/],
			 -Create => 1);
    return unless $file;
    $file = adjust_filename($file);
    eval {
	_overwrite_warning($file);
    };
    return if ($@);

    $p->save($file);
}

sub save_xml {
    my($file, $path) = get_file_path();
    $file = get_filename($top,
			 -Title => M"Enter XML project file",
			 -File => $file,
			 -Path => $path,
			 -FPat => '*.xml',
			 -filetypes => [qw/xml all/],
			 -Create => 1);
    return unless $file;

    $file = adjust_filename($file, ".xml");
    require Timex::Project::XML;
    my $clone = clone Timex::Project::XML $root;
    $clone->save($file);
}

sub merge_file {
    my $path;
    $path = $options->{'mergedir'};
    if (!defined $path || !-d $path) {
	(undef, $path) = fileparse($options->{'file'});
    }
    my $file = get_filename($top,
			    -Title => M"Enter project file for merge",
			    -Path => $path,
			    -FPat => '*.pj1',
			    -filetypes => [qw/pj1 pjt all/],
			    -Create => 0);
    return unless $file;

    $options->{'mergedir'} = dirname($file);

    merge_file_noninteractive($file);
}

sub merge_file_noninteractive {
    my $file = shift;
    my %args = @_;
###XXXX del:
#      my %load_args;
#      $load_args{-skeleton} = delete $load_args{-skeleton};

    my $new_project = new Timex::Project;
    if (!$new_project->load($file, %args)) {
	$status_text->configure(-text => $@);
	return;
    }
    my($diff, $new_p_ref, $changed_p_ref) = $root->merge($new_project);
    insert_all(-newprojects     => $new_p_ref,
	       -changedprojects => $changed_p_ref) if $diff;
    $status_text->configure
      (-text => Mfmt("Merge completed with %s %s", $diff,
		     ($diff == 1 ? M("difference") : M("differences"))),
      );
}

sub update_enterprise_projects {
    if (!$options->{'enterpriseprojects'}) {
	require Tk::Dialog;
	$top->Dialog
	    (-title => M"Error",
	     -text => M
	     ("There is no enterprise projects file defined.\n" .
	      "Please go to the enterprise tab in the option editor.\n"),
	     -popover => 'cursor')->Show;
	return;
    }

    if (!-r $options->{'enterpriseprojects'}) {
	require Tk::Dialog;
	$top->Dialog
	    (-title => M"Error",
	     -text => Mfmt("File %s is not readable or does not exist.\n",
			   $options->{'enterpriseprojects'}),
	     -popover => 'cursor')->Show;
	return;
    }

    merge_file_noninteractive($options->{'enterpriseprojects'},
			      -skeleton => 1);
}

sub get_filename {
    my($top, %args) = @_;
    my %change_opt;
    my $defaultextension;
    if ($args{'-FPat'}) {
	if ($Tk::VERSION <= 800.011) {
	    ($defaultextension = $args{'-FPat'}) =~ s/^\*\.//;
	} else {
	    ($defaultextension = $args{'-FPat'}) =~ s/^\*//;
	}
    }

    my $types = [];
    if ($args{-filetypes}) {
	foreach my $type (@{ $args{-filetypes} }) {
	    if ($type eq 'pj1') {
		push @$types, [M"Timex files", '.pj1'];
	    } elsif ($type eq 'all') {
		push @$types, [M"All files", '*'];
	    } elsif ($type eq 'xml') {
		push @$types, [M"Timex XML files", '.xml'];
	    } elsif ($type eq 'pjt') {
		push @$types, [M"Timex Template files", '.pjt'];
	    } elsif ($type eq 'gif') {
		push @$types, [M"GIF images", '.gif'];
	    } elsif ($type eq 'xpm') {
		push @$types, [M"X11 pixmaps", '.xpm'];
	    } elsif ($type eq 'xbm') {
		push @$types, [M"X11 bitmaps", '.xbm'];
	    } elsif ($type eq 'ppm') {
		push @$types, [M"PPM images", '.ppm'];
	    } elsif ($type eq 'bmp') {
		push @$types, [M"BMP images", '.bmp'];
	    } elsif ($type eq 'images') {
		push @$types, [M"Images", ['.ppm','.gif','.xpm','.xbm','.bmp']];
	    }
	}
    }

    if ($args{-Create} && $top->can('getSaveFile')) {
	my $file = $top->getSaveFile
	  (-initialdir => $args{-Path},
	   -initialfile => $args{'File'},
	   -defaultextension => $defaultextension,
	   -title => $args{-Title},
	   ($Tk::VERSION >= 800.012 ? (-filetypes => $types) : ()),
	  );
	return $file;
    } elsif (!$args{-Create} && $top->can('getOpenFile')) {
	my $file = $top->getOpenFile
	  (-initialdir => $args{-Path},
	   -defaultextension => $defaultextension,
	   -title => $args{-Title},
	   ($Tk::VERSION >= 800.012 ? (-filetypes => $types) : ()),
	  );
	return $file;
    }

    my $filedialog = 'FileDialog';
    if ($os eq 'win') {
	$@ = "XXX Tk::FileDialog does not work with win32";
    } else {
	eval { require Tk::FileDialog };
    }
    if ($@) {
	warn "Harmless warning:\n$@\n";
	require Tk::FileSelect;
	$filedialog = 'FileSelect';
	%change_opt = (-FPat   => '-filter',
		       -Path   => '-directory',
		       -File   => undef,
		       -Create => undef,
		       -Title  => undef,
		      );
    }
    foreach (keys %args) {
	if (exists $change_opt{$_}) {
	    if (defined $change_opt{$_}) {
		$args{$change_opt{$_}} = delete $args{$_};
	    } else {
		delete $args{$_};
	    }
	}
    }
    my $fd = $top->$filedialog(%args);
    $fd->Show(-popover => 'cursor');
}

sub get_file_path {
    my($file, $path);
    if ($options->{'file'}) {
	($file, $path) = fileparse($options->{'file'});
    } else {
	$file = "";
	$path = $home || "/";
    }
    ($file, $path);
}

sub set_autosave {
    if ($options->{'autosave'}) {
	if (defined $autosave_after) {
	    $autosave_after->cancel;
	}
	$autosave_after = $top->after($options->{'update'}*1000,
				      sub { save_file(1) });
    }
}

sub toggle_autosave {
    set_autosave();
}

sub set_dateformat {
    insert_all();
    if (set_time_update()) {
	set_timeout();
    }
    foreach my $w ($top->Descendants("Toplevel")) {
	# no M:
	if ($w->{WindowType} and $w->{WindowType} eq "Daily details" and
	    $w->{InvokeButton}) {
	    $w->{InvokeButton}->invoke;
	}
    }
}

sub not_running {
    my($var, $p) = @_;
    my $project_is_running;
    if (defined $p and defined $current_project and $p eq $current_project) {
	$project_is_running = 1;
    }
    if (!defined $p and defined $current_project) {
	$project_is_running = 1;
    }
    if ($project_is_running) {
	require Tk::Dialog;
	$top->Dialog(-title => 'Warning',
		     -text  =>
		     "Can't perform this action while project running",
		     -popover => 'cursor',
		    )->Show;
	if (defined $var) {
	    # alte Einstellung wiederherstellen
	    $$var = ($$var ? 0 : 1);
	}
	return undef;
    } else {
	return 1;
    }
}

sub toggle_show_archived {
    if (not_running(\$options->{'archived'})) {
	insert_all();
    }
}

sub toggle_show_only_top {
    not_running(\$options->{'onlytop'}) && insert_all();
}

sub toggle_time_arbeitstag {
    insert_all();
}

sub _fix_be {
    $_[0]->Subwidget("entry")->Subwidget("entry")->configure
	(-bg => $inner_bg, -fg => $inner_fg);
};

sub _all_labels {
    map { $_->[1] }
        sort { $a->[0] cmp $b->[0] }
	    map { [lc($_), $_] }
		$root->all_pathnames;
}

sub _all_projects_browseentry {
    my($parent, %args) = @_;

    my $exclude_root = delete $args{-excluderoot};

    require Tk::BrowseEntry;
    my $browse = $parent->BrowseEntry(%args);
    _fix_be($browse);
    # Verwendung des Schwartzian Transform wegen Problemen mit lc.
    # Es ist vielleicht auch marginal schneller.
    foreach (_all_labels) {
	if (!defined $_ || $_ eq '') {
	    next if $exclude_root;
	    $_ = '(Root)'
	}
	$browse->insert("end", $_);
    }
    $browse;
}

sub show_attributes {
    my($path, $readonly) = @_;

    my $readonly_some;
    if (defined $current_project) { $readonly_some = 1 }

    if (!defined $path) {
	$path = get_sel_entry();
	return if !defined $path;
    }

    my $project = $project_frame->info('data', $path);
    return if !defined $project;

    my $attribute_top = $top->Toplevel(-title => M"Attributes");
    my $f = $attribute_top->Frame->pack(-fill => 'both', -expand => 1);
    my $row = 0;

    my $dframe = sub {
	my $ff = $f->Frame->grid(-padx => 1,
				 -row => $row, -column => 1, -sticky => 'w');
	$ff->Label->pack(-side => "left");
	$ff;
    };

    # Name/Id ##########
    $f->Label(-text => M('Name').': ')->grid(-row => $row, -column => 0,
					     -sticky => 'w');
    my $label = $project->label;
    my $ff1 = $dframe->();
    my $name_entry = $ff1->Entry(-bg => $inner_bg,
				 -fg => $inner_fg,
				 -textvariable => \$label
				)->pack(-side => "left");
    $name_entry->focus;
    if ($readonly || $readonly_some) {
	$name_entry->configure(-state => 'disabled');
    }

    $f->Label(-text => M("Id").": " . $project->id)->grid(-row => $row,
							  -column => 2,
							  -sticky => "e");

    # Old parent ##########
    if ($project->parent) {
	$row++;
	$f->Label(-text => M('Parent').':')->grid(-row => $row,
						  -column => 0,
						  -sticky => 'w');
	$ff1 = $dframe->();
	$ff1->Label(-text => ($project->parent eq $root ?
			      '('.M("Root").')' : $project->parent->label)
		   )->pack(-side => "left");
    }

    # New parent ##########
    $row++;
    my $new_parent;
    $f->Label(-text => M("New Parent"))->grid(-row => $row,
					      -column => 0,
					      -sticky => 'w');
    my $browse = _all_projects_browseentry
	($f,
	 -variable => \$new_parent,
	 $readonly || $readonly_some ? (-state => 'disabled') : (),
	);
    $browse->grid(-row => $row, -column => 1,
		  -columnspan => 1, -sticky => 'w');

    # Rate ##########
    my $rate = my $old_rate = $project->{'rate'};
    $row++;
    $f->Label(-text => M('Rate') .
	      (defined $options->{'currency'}
	       ? " (" . $options->{'currency'} . ")"
	       : "")
	     )->grid(-row => $row, -column => 0, -sticky => 'w');
    $ff1 = $dframe->();
    my $rate_entry = $ff1->Entry
	(-textvariable => \$rate,
	 -bg => $inner_bg,
	 -fg => $inner_fg,
	)->pack(-side => "left");
    if ($readonly) { $rate_entry->configure(-state => 'disabled') }

    # Domain ##########
    my $domain = my $old_domain = $project->{'domain'};
    if (!defined $domain) {
	$domain = $project->domain;
	if (defined $domain) {
	    $domain = "($domain)";
	}
    }
    $row++;
    $f->Label(-text => M"Domain"
	     )->grid(-row => $row, -column => 0, -sticky => 'w');
    my $domain_entry = $f->BrowseEntry
	(-textvariable => \$domain,
	 -choices => ["", @all_domains],
	)->grid(-row => $row, -column => 1, -columnspan => 1, -sticky => 'w');
    if ($readonly) { $domain_entry->configure(-state => 'disabled') }
    _fix_be($domain_entry);

    # Archived ##########
    my $archived = $project->{'archived'};
    $row++;
    my $arch_check = $f->Checkbutton
      (-text => M"Archived",
       -variable => \$archived
      )->grid(-row => $row, -column => 0, -sticky => 'w');
    if ($readonly) { $arch_check->configure(-state => 'disabled') }

    my $PathEntry = "Entry";
    if (eval 'require Tk::PathEntry; 1') {
	$PathEntry = 'PathEntry';
    }

    # RCS/CVS file ##########
    my $rcsfile = $project->rcsfile;
    $row++;
    $f->Label(-text => M("RCS/CVS file").":"
	     )->grid(-row => $row, -column => 0, -sticky => 'w');
    $ff1 = $dframe->();
    my $rcs_entry = $ff1->$PathEntry(-bg => $inner_bg,
				     -fg => $inner_fg,
				     -textvariable => \$rcsfile
				    )->pack(-side => "left");
    my $browse_entry = $f->Button
	(-text => M("Browse")."...",
	 -command => sub {
	     my($file, $path) = fileparse($rcsfile) if $rcsfile;
	     my $newfile = get_filename
		 ($attribute_top,
		  -Title  => M"RCS/CVS file",
		  ($rcsfile ? (-File   => $file,
			       -Path   => $path) : ()),
		  -Create => 0,
		  -filetypes => [qw/pj1 pjt xml all/],
		 );
	     if ($newfile) {
		 $rcsfile = $newfile;
	     }
	 })->grid(-row => $row, -column => 2, -sticky => 'w');
    if ($readonly) {
	$rcs_entry->configure(-state => 'disabled');
	$browse_entry->configure(-state => 'disabled');
    }

    # Icon ##########
    my $iconfile = $project->icon;
    $row++;
    $f->Label(-text => M("Icon file").":"
	     )->grid(-row => $row, -column => 0, -sticky => 'w');
    $ff1 = $dframe->();
    my $icon_entry = $ff1->$PathEntry(-bg => $inner_bg,
				      -fg => $inner_fg,
				      -textvariable => \$iconfile
				     )->pack(-side => "left");
    my $icon_browse_entry = $f->Button
	(-text => M("Browse")."...",
	 -command => sub {
	     my($file, $path) = fileparse($iconfile) if $iconfile;
	     my $newfile = get_filename
		 ($attribute_top,
		  -Title  => M"Icon file",
		  ($iconfile ? (-File   => $file,
				-Path   => $path) : ()),
		  -Create => 0,
		  -filetypes => [qw/images xpm gif xbm ppm bmp/],
		 );
	     if ($newfile) {
		 $iconfile = $newfile;
	     }
	 })->grid(-row => $row, -column => 2, -sticky => 'w');
    if ($readonly) {
	$icon_entry->configure(-state => 'disabled');
	$icon_browse_entry->configure(-state => 'disabled');
    }

    if ($PathEntry eq 'PathEntry') {
	foreach my $w ($rcs_entry, $icon_entry) {
	    foreach my $k (qw/Return Escape/) {
		$w->bind("<$k>" => [$w, 'Finish']);
	    }
	}
    }

    # Job number ##########
    my $jobnumber = $project->jobnumber;
    $row++;
    $f->Label(-text => M("Job number").":")->grid(-row => $row,
						  -column => 0,
						  -sticky => "w");
    my $jne = $f->Entry(-textvariable => \$jobnumber,
			-bg => $inner_bg,
			-fg => $inner_fg,
		       )->grid(-row => $row,
			       -column => 1,
			       -sticky => "we");
    my $jobnumbers_browse;
    if (defined &main::browse_jobnumbers) {
	$jobnumbers_browse = $f->Button
	    (-text => M("Browse")."...",
	     -command => sub {
		 my $new_jobnumber = main::browse_jobnumbers($attribute_top);
		 if (defined $new_jobnumber) {
		     $jobnumber = $new_jobnumber;
		 }
	     })->grid(-row => $row, -column => 2, -sticky => 'w');
    }
    if ($readonly) {
	$jne->configure(-state => 'disabled');
	$jobnumbers_browse->configure(-state => 'disabled') if $jobnumbers_browse;
    }

    # Show intervals/Note ##########
    $row++;
    my $ff = $f->Frame->grid(-row => $row, -column => 0,
			     -columnspan => 3, -sticky => "w");
    $ff->Button(-text => M"Show intervals",
		-command => sub {
		    show_intervals($f,
				   $project,
				  -readonly => $readonly);
		})->pack(-side => "left");
    my $note_label = M"Note";
    if ($project->has_note) {
	$note_label .= " *";
    }
    $ff->Button(-text => $note_label,
		-command => sub {
		    show_note($top);
		})->pack(-side => "left");

    # OK/Cancel ##########
    my $command_frame = $attribute_top->Frame->pack(-fill => 'x',
						    -expand => 1);
    my $ok = $command_frame->Button
      (-command => sub {
	   my $insert_all;
	   if ($label && $label ne $project->label) {
	       $project->label($label);
	       $insert_all++;
	   }
	   if (defined $new_parent && grep($_ eq $new_parent, _all_labels)) {
	       my $new_parent_p;
	       if ($new_parent eq '(Root)') {
		   $new_parent_p = $root;
	       } else {
		   $new_parent_p = $root->find_by_pathname($new_parent);
	       }
	       if ($new_parent_p) {
		   if ($project->reparent($new_parent_p)) {
		       $insert_all++;
		   } else {
		       require Tk::Dialog;
#XXX übersetzen
		       $attribute_top->Dialog
			 (-title => M"Warning",
			  -text  =>
			  "Can't reparent " . $project->label . " to " .
			  $new_parent_p->label,
			  -popover => 'cursor',
			 )->Show;
		   }
	       }
	   }

	   {
	       local $^W = undef;
	       $insert_all++ if ($archived && !$project->{'archived'});
	   }
	   $project->archived($archived);

	   $project->rcsfile($rcsfile);
	   
	   {
	       local $^W = undef;
	       $insert_all++ if ($iconfile ne $project->{'iconfile'});
	   }
	   $project->icon($iconfile);

	   $project->jobnumber($jobnumber);

	   {
	       local $^W = undef;
	       $insert_all++ if $rate ne $old_rate;
	   }
	   $project->rate($rate);

	   {
	       local $^W = undef;
	       $insert_all++ if $domain ne $old_domain;
	   }
	   $project->domain($domain);

	   $attribute_top->destroy();
	   insert_all() if $insert_all;
       }
      );
    set_text_or_image($ok, "yes.gif", M"OK");
    $ok->pack(-side => 'left');
    if ($readonly) { $ok->focus }
    my $cancel = $command_frame->Button
      (-command => sub { $attribute_top->destroy() }
      );
    $attribute_top->bind('<Escape>' => sub { $cancel->invoke });
    set_text_or_image($cancel, "no.gif", M"Cancel");
    $cancel->pack(-side => 'left');
    $attribute_top->Popup(-popover => 'cursor');
}

BEGIN { state_change("parsed 74%"); }

sub show_intervals {
    my($top, $project, %args) = @_;

    return unless eval { notimes_check(); 1 };

    my $readonly      = $args{-readonly};
    my $show_seconds  = $args{-show_seconds};
    my $group         = $args{-group} || '';
    my $geometry      = $args{-geometry};
    my $modified      = $args{-modified};
    my $day           = $args{-day};
    my $subproj       = $args{-subproj};
    my $w             = $args{-toplevel};
    if (!Tk::Exists($w)) {
	undef $w;
    } else {
	$_->destroy for ($w->children);
    }

    if (!defined $project) {
	$project = entry_to_project(get_sel_entry());
	return if !defined $project;
    }

    if ($group eq 'weekly') {
	eval {
	    require Date::Calc;
	};
	if ($@) {
	    warn "$@. " . M"Reverting to daily";
	    $group = "daily";
	}
    }

    #$top->Busy($Tk::VERSION >= 800.014 ? (-recurse => 1) : ());

    my @rev;
    if ($project->rcsfile) {
	$top->Busy($Tk::VERSION >= 800.014 ? (-recurse => 1) : ());
	eval {
	    my $rcs = get_rcs_from_cache($project);
	    if ($rcs) {
		foreach my $rev ($rcs->revisions) {
		    push(@rev, [$rev->revision,
				$rev->unixtime,
				scalar $rcs->symbolic_name($rev)]);

		}
	    } else {
		die "Can't create rcs/cvs object";
	    }
	};
	warn $@ if $@;
	$top->Unbusy($Tk::VERSION >= 800.014 ? (-recurse => 1) : ());
    }

    my($lb, $real_lb, $times);

    my $update = sub {
	$args{-toplevel}     = $w;
	$args{-show_seconds} = $show_seconds;
	$args{-group}        = $group;
	$args{-modified}     = $modified;
	$args{-subproj}      = $subproj;
	show_intervals($top, $project,
		       %args);
    };

    my $log_viewer = sub {
	my $i = shift;
	if ($project->rcsfile) {
	    eval {
		my $rcs = get_rcs_from_cache($project);
		if ($rcs) {
		    my $log_entries = $rcs->get_log_entries
			(@{$times->[$i]}[0..1]);
		    my $t = $w->Toplevel
			(-title => "Log entries for "
			 . $project->pathname . " "
			 . join(" - ", map { scalar localtime $_ }
				       @{$times->[$i]}[0..1]));
		    my $ok = $t->Button(-text => 'OK',
					-command => sub {
					    $t->destroy;
					})->pack(-side => "bottom");
		    $t->bind('<Escape>' => sub { $ok->invoke });
		    require Tk::ROText;
		    my $ro = $t->Scrolled
			("ROText", -scrollbars => "so$sbside",
			 -wrap => "none",
			 )->pack(-fill => "both", -expand => 1);
		    $ro->insert("end", $log_entries);
		    $ok->focus;
		}
	    }
	}
    };

    my $epoch2readable_date = sub {
	my @l = localtime $_[0];
	sprintf "%04d-%02d-%02d-%02d:%02d:%02d",
	    $l[5]+1900, $l[4]+1, $l[3], $l[2], $l[1], $l[0];
    };

    my $readable_date2epoch = sub {
	if ($_[0] =~ /^\s*(\d{4})-(\d{1,2})-(\d{1,2})-(\d{1,2}):(\d{2}):(\d{2})\s*$/) {
	    require Time::Local;
	    Time::Local::timelocal($6, $5, $4, $3, $2-1, $1-1900);
	} else {
	    undef;
	}
    };

    my $interval_editor = sub {
	my $i = shift;
	my %args = @_;
	return if $readonly;

	my($inner_bg_opt, $inner_fg_opt) = ('-bg', '-fg');
	my %date_args;
	my $has_date;
	eval $date_require;

	my $t = $w->Toplevel(-title => "Edit line $i for "
			               . $project->pathname);
	my $row = 0;
	my($from, $to, $annotation) = @{$times->[$i]};

	my $date_choices = ['now'];
	if ($utmp) {
	    $utmp->update_if_necessary(300);
	    my @utmp_lines = $utmp->restrict(User => $username,
					     From => $today_time,
					     To => time,
					    );
	    if (@utmp_lines) {
		push @$date_choices,
		    ['Today login'  => $utmp_lines[-1]->{Begin}],
		    ['Today logout' => $utmp_lines[0]->{End}];
	    }
	    @utmp_lines = $utmp->restrict(User => $username,
					  From => $today_time-86400,
					  To   => $today_time-1);
	    if (@utmp_lines) {
		push @$date_choices,
		    ['Yesterday login'  => $utmp_lines[-1]->{Begin}],
		    ['Yesterday logout' => $utmp_lines[0]->{End}];
	    }
	};
	$t->Label(-text => M("From").":")->grid(-row => $row, -column => 0);

	if (!$has_date) {
	    $from = $epoch2readable_date->($from);
	    $to   = $epoch2readable_date->($to);
	}

	my $from_date = ($has_date
			 ? $t->Date($inner_bg_opt => $inner_bg,
				    $inner_fg_opt => $inner_fg,
				    %date_args,
				    -variable => \$from,
				    -choices => $date_choices,
				    )
			 : $t->Entry(-bg => $inner_bg,
				     -fg => $inner_fg,
				     -textvariable => \$from)
			 );
	$from_date->grid(-row => $row++, -column => 1);
	$t->Label(-text => M("To").":")->grid(-row => $row, -column => 0);
	my $to_date = ($has_date
		       ? $t->Date($inner_bg_opt => $inner_bg,
				  $inner_fg_opt => $inner_fg,
				  %date_args,
				  -variable => \$to,
				  -choices => $date_choices,
				 )
		       : $t->Entry(-bg => $inner_bg,
				   -fg => $inner_fg,
				   -textvariable => \$to)
		      );
	$to_date->grid(-row => $row++, -column => 1);

	$t->Label(-text => M("Annotation").":")->grid(-row => $row, -column => 0);
	$t->Entry(-textvariable => \$annotation)->grid(-row => $row++, -column => 1, -sticky => "ew");

	my $f = $t->Frame->grid(-row => $row++, -column => 0, -columnspan => 2);

	my $okb = $f->Button
	  (-text => 'OK',
	   -command => sub {
	       my($from_e, $to_e, $annotation_e);
	       if (!$has_date) {
		   $from_e = $readable_date2epoch->($from);
		   $to_e   = $readable_date2epoch->($to);
		   if (!defined $from_e || !defined $to_e) {
		       die "Can't recognize $from/$to";
		   }
	       } else {
		   ($from_e, $to_e) = ($from, $to);
	       }
	       if (defined $annotation && $annotation !~ /^\s*$/) {
		   $annotation_e = $annotation;
	       }
	       $project->set_times($i, $from_e, $to_e, $annotation);
	       $update->($t);
	   },
	  )->pack(-side => 'left');
	my $cancelb = $f->Button
	  (-text => 'Cancel',
	   -command => sub {
	       if ($args{-cancelcommand}) {
		   $args{-cancelcommand}->($i);
	       }
	       $t->destroy;
	   },
	  )->pack(-side => 'left');
	$cancelb->focus;
	my $deleteb = $f->Button
	  (-text => 'Delete',
	   -command => sub {
	       $project->delete_times($i);
	       $update->($t);
	   },
	  )->pack(-side => 'left');
	$t->bind('<Return>' => sub { $okb->invoke });
	$t->bind('<Escape>' => sub { $cancelb->invoke });
	$t->Popup(-popover => 'cursor');
    };

    my $double_click = sub {
	my $i = shift;

	my $e = $real_lb->XEvent;
	my $x = $e->x;
	my $col_width = 0;
	my $lb_column;
	foreach my $lb_i (0 .. $lb->cget(-columns)-1) {
	    my $old_col_width = $col_width;
	    $col_width += $lb->columnWidth($lb_i);
	    if ($x >= $old_col_width and $x <= $col_width) {
		$lb_column = $lb_i;
		last;
	    }
	}

	if ($group eq '' && !$subproj &&
	    (!defined $lb_column || $lb_column < 3)) {
	    $interval_editor->($i);
	} else {
	    $log_viewer->($i);
	}
    };

    $w = $top->Toplevel(-title => "Intervals for " . $project->pathname)
	if !defined $w;
    my $no_cols = 2;
    my $rev_lifetime_col;
    $no_cols ++   if !$group; # zusätzliche To-Spalte
    $no_cols ++   if $group eq 'daily'; # weekday column
    $no_cols ++   if $show_seconds; # für From/Date-Spalte
    $no_cols ++   if $show_seconds and !$group; # für To-Spalte
    $no_cols ++;              # Annotations
    $no_cols ++   if $has_costs;
    $no_cols += 2 if @rev;
    $lb = $w->Scrolled('HList', -scrollbars => "oso$sbside",
		       -bg => $inner_bg,
		       -fg => $inner_fg,
		       -columns => $no_cols,
		       -width => 80,
		       -header => 1,
		       -command => $double_click,
		       -selectmode => 'extended',
		       -exportselection => 1,
		      )->pack(-fill => 'both', -expand => 1);
    $w->Advertise(HList => $lb);
    $real_lb = $lb->Subwidget("scrolled");
    {
	my $col = 0;
	if ($group eq 'daily') {
	    $lb->header('create', $col++, -text => M"Wkday");
	    $lb->header('create', $col++, -text => M"Day");
	} elsif ($group eq 'weekly') {
	    $lb->header('create', $col++, -text => M"Week");
	} elsif ($group eq 'monthly') {
	    $lb->header('create', $col++, -text => M"Month");
	} else {
	    $lb->header('create', $col++, -text => M"From");
	}
	$lb->header('create', $col++, -text => M"seconds")
	  if $show_seconds;
	if (!$group) {
	    $lb->header('create', $col++, -text => M"To");
	    $lb->header('create', $col++, -text => M"seconds")
	      if $show_seconds;
	}
	$lb->header('create', $col++, -text => M"Time");
	$lb->header('create', $col++, -text => M"Annotations");
	if ($has_costs) {
	    $lb->header('create', $col++, -text => M"Cost");
	}
	if (@rev) {
	    $lb->header('create', $col++, -text => M"RCS/CVS");
	    $rev_lifetime_col = $col++;
	    $lb->header('create', $rev_lifetime_col,
			-text => M"Version lifetime");
	}
    }

    my $anchor_set = 0;
    my $last_rev_def;
    my $i = 0;
    $times = $project->interval_times($group,
				      -recursive => $subproj,
				      -asref => 1,
				      -annotations => 1,
				     );

    foreach (@$times) {
	my($from, $to, $annotation, $interval) = @$_;

	my(@fromdate) = localtime($from);
	$fromdate[4]++;
	$fromdate[5]+=1900;

	my $fromdate;
	my $fromwkday;
	if ($group eq '') {
	    $fromdate = sprintf "%02d.%02d.%04d %02d:%02d:%02d",
	                        @fromdate[3,4,5,2,1,0];
	} elsif ($group eq 'daily') {
	    $fromwkday = # XXX use POSIX::strftime and locale settings!
		[qw(Sun Mon Tue Wed Thu Fri Sat)]->[$fromdate[6]];
	    $fromdate = sprintf("%02d.%02d.%04d",
				@fromdate[3,4,5]
			       );
	} elsif ($group eq 'weekly') {
	    my $wk = Date::Calc::Week_Number(@fromdate[5,4,3]);
	    $fromdate = sprintf "%02d/%04d", $wk, $fromdate[5];
	} elsif ($group eq 'monthly') {
	    $fromdate = sprintf "%02d.%04d", @fromdate[4,5];
	} elsif ($group eq 'yearly') {
	    $fromdate = sprintf "%04d", $fromdate[5];
	}

	my $col = 0;
	$lb->add($i);
	if ($group eq 'daily') {
	    $lb->itemCreate($i, $col++, -text => $fromwkday,
			    ($fromwkday =~ /^(Sat|Sun)$/ && $holiday_style # XXX i18n! local holidays!
			     ? (-style => $holiday_style)
			     : ($weekday_style
				? (-style => $weekday_style)
				: ()
			       )
			    )
			   );
	}
	$lb->itemCreate($i, $col++, -text => $fromdate);
	$lb->itemCreate($i, $col++, -text => $from)
	  if $show_seconds;

	if (!$anchor_set and defined $day and $day <= $from) {
	    $lb->anchorSet($i);
	    $anchor_set = 1;
	}

	my(@todate, $todate);
	if (defined $to) {
	    @todate = localtime($to);
	    $todate[4]++;
	    $todate[5]+=1900;
	    $todate = sprintf
	      "%02d.%02d.%04d %02d:%02d:%02d", @todate[3,4,5,2,1,0];
	    if (!$group) {
		$lb->itemCreate($i, $col++, -text => $todate);
		$lb->itemCreate($i, $col++, -text => $to)
		  if $show_seconds;
	    }
	    $interval = $to-$from if !$group;
	    $lb->itemCreate($i, $col++, -text => sec2time($interval,
							  undef, undef));

	    if (defined $annotation) {
		# XXX strip annotation to X chars?
		$lb->itemCreate($i, $col, -text => $annotation);
	    }
	    $col++;

	    if ($has_costs) {
		# hier nicht runden, wegen der Granularität...
		my $hours = $interval/3600;
		$lb->itemCreate
		    ($i, $col++,
		     -text => sprintf("%.2f", $hours*hourly_rate($project)));
	    }

	    my @t;
	    foreach my $rev (@rev) {
		if ($rev->[1] >= $from and $rev->[1] <= $to) {
		    my $t = $rev->[0];
		    if ($rev->[2]) { $t .= " (" . $rev->[2] . ")" }
		    push(@t, $t);
		    if (exists $last_rev_def->{'Time'}) {
			$lb->itemCreate
			  ($last_rev_def->{'Item'},
			   $rev_lifetime_col,
			   -text => sec2time($from-$last_rev_def->{'Time'},
					     'dd', 0));
		    }
		    $last_rev_def = {Time => $to, Item => $i};
		}
	    }
	    if (@t) { $lb->itemCreate($i, $col++, -text => join(", ", @t)) }
	} else {
	    $lb->itemCreate($i, $col++, -text => M"Running");
	}
	$i++;
    }

    #$top->Unbusy($Tk::VERSION >= 800.014 ? (-recurse => 1) : ());

    if (exists $last_rev_def->{'Time'}) {
	$lb->itemCreate
	  ($last_rev_def->{'Item'}, $rev_lifetime_col,
	   -text => sec2time(time-$last_rev_def->{'Time'}, 'dd', 0));
    }

    my $delete = sub {
	return unless
	    lc($lb->messageBox
	       (-icon => 'question',
		-title => M"Delete?",
		-message => M"Really delete?",
		-type => M"OkCancel")) eq lc(M"OK");
	$project->delete_times($lb->info('selection'));
	$modified++;
	$update->();
    };

    my $insert = sub {
	my($before_or_after) = @_;
	my @sel = $lb->info('selection');
	my $before;
	if (defined $before_or_after) {
	    if ($before_or_after eq 'before') {
		$before = $sel[$#sel]-1;
	    } else {
		$before = $sel[$#sel];
	    }
	} else {
	    $before = (!@sel ? -1 : $sel[$#sel]);
	}
	$project->insert_times_after($before,
				     time, time);
	$modified++;
	$interval_editor->($before+1,
			   -cancelcommand => sub {
			       $project->delete_times($before+1);
			       $modified--;
			   });
    };

    if (!$group and
	$lb->can("menu") and
	$lb->can("PostPopupMenu")
	and $Tk::VERSION >= 800) {

	my $lb_popup_menu;
	$lb_popup_menu = $lb->Menu(-title => M"Interval menu",
				   -disabledforeground => "darkblue",
				   -tearoff => 0);

	my $current_index = undef;

	$lb_popup_menu->command(-label => "Interval:",
				-state => "disabled");

	$lb_popup_menu->command
	    (-label => M"Edit",
	     -command => sub {
		 my($index) = $lb->info('selection');
		 return if !defined $index;
		 $double_click->($index);
	     }
	    );
	$lb_popup_menu->command
	    (-label => M"Delete",
	     -command => sub {
		 $delete->();
	     },
	    );
	$lb_popup_menu->command
	    (-label => M"Insert before",
	     -command => sub {
		 $insert->("before");
	     },
	    );
	$lb_popup_menu->command
	    (-label => M"Insert after",
	     -command => sub {
		 $insert->("after");
	     },
	    );
	$lb_popup_menu->command
	    (-label => M"Move",
	     -command => sub {
		 # BrowseEntry destroys the selection, so remember as
		 # early as possible...
		 my(@current_indexes) = $real_lb->info("selection");
		 my $t2 = $lb->Toplevel(-title => M"Move interval");
		 my $f0 = $t2->Frame->pack(-fill => 'x', -expand => 1);
		 $f0->Label(-text => M"New Parent")->pack(-side => "left");
		 my $new_project;
		 my $be = _all_projects_browseentry
		     ($f0, -variable => \$new_project, -excluderoot => 1,
		      -exportselection => 0);
		 eval { $be->updateListWidth() }; warn $@ if $@;
		 $be->pack(-side => "left", -fill => "x", -expand => 1);
		 my $f = $t2->Frame->pack(-fill => 'x', -expand => 1);
		 my $ok = $f->Button
		     (-command => sub {
			  my $new_project_p = $root->find_by_pathname($new_project);
			  if (!defined $new_project_p) {
			      die "Can't find parent $new_project";
			  }
			  my $new_times = $new_project_p->interval_times("", -asref => 1);
			  if (@current_indexes == 0) {
			      @current_indexes = $current_index;
			  } elsif (@current_indexes == 1) {
			      if ($current_index != $current_indexes[0]) {
				  warn "Strange mismatch between current_index ($current_index) and current_indexes (@current_indexes)\n";
				  @current_indexes = $current_index;
			      }
			  } else {
			      my $yesno = $real_lb->messageBox
				  (-message => Mfmt("Really move %d entry/ies to $new_project?", scalar @current_indexes),
				   -icon => 'question',
				   -title => M"Move",
				   -type => 'YesNo',
				  );
			      if ($yesno !~ /yes/i) {
				  return 0;
			      }
			  }

                          # make sure to start from end while processing indexes:
			  foreach my $index (sort { $b <=> $a } @current_indexes) {
			      $new_project_p->insert_times_after($#$new_times, @{ $times->[$index] });
			      $project->delete_times($index);
			  }
			  $update->();
			  # XXX destroy problem?!
			  $lb->afterIdle(sub { $t2->destroy if Tk::Exists($t2); });
		      })->pack(-side => "left");
		 set_text_or_image($ok, "yes.gif", M"OK");
		 my $cancel = $f->Button(-command => sub { $t2->destroy() }
					)->pack(-side => 'left');
		 $t2->bind('<Escape>' => sub { $cancel->invoke });
		 set_text_or_image($cancel, "no.gif", M"Cancel");
	     },
	    );

	$lb->menu($lb_popup_menu);
	$lb->Subwidget("scrolled")->bind
	    ('<3>' => sub {
		 my $e = $_[0]->XEvent;

		 $lb_popup_menu->entryconfigure(0, -label => "???");
		 for my $i (1 .. $lb_popup_menu->index("last")) {
		     $lb_popup_menu->entryconfigure($i, -state => "disabled");
		 }
		 my $y = $e->y;
		 $current_index = $lb->nearest($y);
		 if (defined $current_index) {
		     $lb->anchorSet($current_index);
		     if (!$lb->selectionIncludes($current_index)) {
			 $lb->selectionClear;
			 $lb->selectionSet($current_index);
		     }
		     my $from = $lb->itemCget($current_index, 0, -text);
		     my $to   = $lb->itemCget($current_index, 1, -text);
		     $lb_popup_menu->entryconfigure(0, -label => "$from - $to");
		     for my $i (1 .. $lb_popup_menu->index("last")) {
			 $lb_popup_menu->entryconfigure($i, -state => "normal");
		     }
		 }

		 $_[0]->PostPopupMenu($e->X, $e->Y);
	     });
    }

    $w->withdraw;
    $lb->see($i-1) if $i > 1;
    my $f = $w->Frame->pack(-fill => 'x');
    $w->Advertise(ButtonFrame => $f);
    my $close_sub = sub {
	#insert_all() if $modified;
	update_project($project) if $modified;
	$w->destroy;
    };
    $w->protocol('WM_DELETE_WINDOW', $close_sub);
    my $clb = $f->Button(-text => M"Close",
			 -command => $close_sub,
			)->pack(-side => 'left');
    $f->Label(-text => '  ')->pack(-side => 'left');
    if ($group eq '' && !$subproj) {
	$f->Button(-text => M"Del",
		   -command => $delete,
		  )->pack(-side => 'left');
	$f->Button(-text => M"Ins",
		   -command => sub { $insert->() },
		  )->pack(-side => 'left');
    }
    if (!$subproj) {
	$f->Button(-text => M"Re-Sort",
		   -command => sub {
		       $project->sort_times;
		       # $modified++ nicht notwendig, weil sich nichts an der
		       # Gesamtzeit ändert
		       $update->();
		   }
		  )->pack(-side => 'left');
    }
    if ($group eq '' && !$subproj) {
	$f->Label(-text => ' ')->pack(-side => 'left');
	$f->Checkbutton(-text => M"Seconds",
			-variable => \$show_seconds,
			-command => sub { $update->() },
			)->pack(-side => 'left');
    }
#    $f->Label(-text => ' ')->pack(-side => 'left');

    require Tk::Optionmenu;
    my $om = $f->Optionmenu(-options => ['',
					 [M("daily")   => 'daily'  ],
					 [M("weekly")  => 'weekly' ],
					 [M("monthly") => 'monthly'],
					 [M("yearly")  => 'yearly' ],
					],
			   )->pack(-side => "right");
    # Hack for buggy Tk::Optionmenu in Tk804:
    $om->configure(-variable => \$group,
		   -textvariable => \$group,
		  );			    

    $f->Label(-text => " " . M"Group:")->pack(-side => 'right');

    $f->Checkbutton(-text => M"Subprojects",
		    -variable => \$subproj,
		    -command => sub { $update->() },
		   )->pack(-side => 'right');

    # -command cannot be specified at creation time, because this can
    # cause endless loops, at least in Tk 800.023
    $f->afterIdle(sub {$om->configure(-command => sub { $update->() })});

    $clb->focus;
    $w->bind('<Escape>' => sub { $clb->invoke });

    my @popup_args;
    #push @popup_args, (-popover => 'cursor') unless $geometry;
    $w->Popup; #(@popup_args);
    if ($geometry) {
	$w->geometry($geometry);
    }
}

sub show_note {
    my($top, $project, %args) = @_;

    if (!defined $project) {
	$project = entry_to_project(get_sel_entry());
	return if !defined $project;
    }

    my $t = $top->Toplevel(-title => M('Note for').' '.$project->pathname);
    my $txt = $t->Scrolled('Text', -scrollbars => "so$sbside"
			  )->pack(-fill => 'both', -expand => 1);
    $txt->focus;
    if ($project->has_note) {
	foreach ($project->note) {
	    $txt->insert('end', $_ . "\n");
	}
    }
    my $f = $t->Frame->pack(-fill => 'x', -expand => 1);
    $f->Button(-text => M"OK",
	       -command => sub {
		   my $s = $txt->get('1.0', 'end');
		   $project->set_note(split(/\n/, $s));
		   $t->destroy;
	       })->pack(-side => 'left');
    my $cancel = $f->Button(-text => M"Cancel",
	       -command => sub { $t->destroy })->pack(-side => 'left');
    $t->bind('<Escape>' => sub { $cancel->invoke });
    $t->Popup(-popover => 'cursor');
}

sub set_time_update {
    my $old_time_update = $time_update;
    $time_update = ($options->{'dateformat'} eq 'hs' ? 1 : 60);
    $time_update < $old_time_update;
}

sub set_text_or_image {
    my($widget, $image, $text) = @_;
    # use image if available, otherwise text
    if (-r $image) {
	eval { $widget->configure
		 (-image => $widget->Photo(-file => Tk::findINC($image)))
	     };
	if (!$@) { return }
    }
    $widget->configure(-text => $text);
}

sub make_path {
    my($p) = @_;
    return if !$p;
    die Mfmt("wrong arg for make_path: <%s>",$p) if !$p->can('Timex_Project_API');
    my @path = $p->path;
    join $separator, @path[1 .. $#path];
}

sub get_parent_path {
    my $path = shift;
    my @path = split "\Q$separator\E", $path;
    join $separator, @path[0 .. $#path-1];
}

sub get_entry {
    my($w) = @_;
    my $Ev = $w->XEvent;
    $w->GetNearest($Ev->y);
}

sub get_sel_entry {
    my $path = $project_frame->info('anchor');
    return $path if defined $path;
    ($project_frame->info('selection'))[0];
}

sub entry_to_project {
    my($path) = @_;
    return if !defined $path;
    $project_frame->info('data', $path);
}

sub quit_program {
    my $non_interactive = shift;
    if (!$non_interactive) {
	require Tk::Dialog;
	if ($root->modified || defined $current_project) {
	    if (!defined $quit_dialog) {
		$quit_dialog = $top->Dialog
		    (-title => M"Quit Program",
		     -text  => M("Really quit?\n") .
		     ($root->modified ?
		      M("(modified data) ") : "") .
		     (defined $current_project ?
		      M("(project running) ") : ""),
		     -default_button => M"No",
		     -buttons => [M"Yes", M"No"],
		     -popover => 'cursor',
		    );
	    }
	    return 0 if $quit_dialog->Show ne M"Yes";
	}
    }
    $top->destroy;
}

sub sec2time {
    my($sec, $dateformat, $day8) = @_;
    $dateformat = $options->{'dateformat'} unless defined $dateformat;
    $day8       = $options->{'day8'}       unless defined $day8;
    my($day, $hour, $min);
    if ($dateformat =~ /^d/) {
	$day = int($sec / ($day8 ? 28800 : 86400));
	$sec = $sec % ($day8 ? 28800 : 86400);
    } elsif ($dateformat eq 'frac d') {
	$day = $sec / ($day8 ? 28800 : 86400);
    }
    if ($dateformat eq 'frac h') {
	$hour = $sec / 3600;
    } else {
	$hour = int($sec / 3600);
	$sec  = $sec % 3600;
	$min  = int($sec / 60);
    }
    if ($dateformat eq 'd') {
	sprintf("%3dd %02d:%02d", $day, $hour, $min);
    } elsif ($dateformat eq 'h') {
	sprintf("%3d:%02d", $hour, $min);
    } elsif ($dateformat eq 'dd') { # round working days
	sprintf("%3dd", $day + ($hour >= ($day8 ? 4 : 12) ? 1 : 0));
    } elsif ($dateformat eq 'frac d') {
	sprintf("%.2fd", $day);
    } elsif ($dateformat eq 'frac h') {
	sprintf("%.2fh", $hour);
    } else {
	sprintf("%02d:%02d:%02d", $hour, $min, $sec % 60);
    }
}

sub check_still_today {
    my @new_nowtime = localtime;
    my $new_today_time =
      time - $new_nowtime[0] - $new_nowtime[1]*60 - $new_nowtime[2]*60*60;
    if ($new_today_time != $today_time) {
	$today_time = $new_today_time;
	@nowtime = @new_nowtime;
	insert_all();
    }
}

# force appending extension (default: .pj1) to filename
sub adjust_filename {
    my($file, $ext) = @_;
    $ext = ".pj1" unless defined $ext;
    (my $ext_re = $ext) =~ s/\./\\./g; # quote dots for regex
    if ($file !~ /$ext_re$/) {
	$file = "$file$ext";
    }
    $file;
}


sub create_menu_last_projects {
    # find last separator
    my $end = $mb_file_menu->index('end');
    my $i = $end;
  LOOP: {
	while ($i >= 0) {
	    last LOOP if ($mb_file_menu->type($i) eq 'separator');
	    $i--;
	}
	$status_text->configure(M"Separator in Menu File not found");
	return;
    }
    # delete anything from the item after the separator to the end
    if ($i < $end) {
	$mb_file_menu->delete($i+1, 'end');
    }
    # insert last_projects
    $i = 0;
    foreach my $p (@$last_projects) {
	my $pathname = $p->pathname;
	$i++;
	$mb_file_menu->command(-label => "$i: " . $pathname,
			       -underline => 0,
			       -command => sub {
				   start($p);
			       });
    }
}

sub add_last_projects {
    my($project) = @_;
    my $i;
    for($i = 0; $i <= $#$last_projects; $i++) {
	if ($last_projects->[$i] eq $project) {
	    splice @$last_projects, $i, 1;
	    last;
	}
    }
    unshift(@$last_projects, $project);
    if (@$last_projects > $max_last_projects) {
	$#$last_projects = $max_last_projects-1; # $max_last_projects Dateien merken
    }
}

# XXX bei KDE gibt es das Problem, daß beim ersten Minimize
# das Fenster nach +0+0 springt ... fvwm2 hat damit keine Probleme (?)
sub minmaximze {
    $minimized = !$minimized;
    if ($minimized) {
	$min_button->configure(-image => $down_photo);
	$balloon->attach($min_button, -msg => 'Maximize')
	  if $balloon;
	$save_geometry = $top->Width . "x" . $top->Height;
	my $menu_height = $top->Height
	  - $project_frame->Height - $status_frame->Height;
	$top->geometry($top->Width . "x" . $menu_height);
    } else {
	$min_button->configure(-image => $up_photo);
	$balloon->attach($min_button, -msg => 'Minimize')
	  if $balloon;
	$top->geometry($save_geometry);
	$top->raise;
    }
}

sub accept_drop {
    my($w, $seln) = @_;
    my $filename;
    eval {
	my @targ = $w->SelectionGet('-selection'=>$seln,'TARGETS');
	foreach (@targ) {
	    if (/FILE_NAME/) {
		$filename = $w->SelectionGet('-selection'=>$seln,$_);
		last;
	    } elsif ($Tk::platform eq 'MSWin32' && /STRING/) {
		$filename = $w->SelectionGet('-selection'=>$seln,$_);
		last;
	    } elsif (/text\/uri-list/) { # gmc Xdnd
		$filename = join "", map { chr } $w->SelectionGet('-selection'=>$seln,$_);
		$filename =~ s/\0$//;
		$filename = (split /\015\012/, $filename)[0];
		$filename =~ s/^file://;
		last;
	    }
	}
    };
    if ($@) {
	# Konqueror 2 Xdnd
        $filename = $w->SelectionGet('-selection'=>$seln);
        $filename =~ s/^file://;
    }
    if (defined $filename) {
	$w->after(10, sub {load_merge_popup($filename)});
    }
}

sub load_merge_popup {
    my $filename = shift;
    $load_merge_filename = $filename;
    if (!Tk::Exists($load_menu)) {
	$load_menu = $top->Menu(-tearoff => 0);
	$load_menu->command(-label => M"Merge",
			    -command => sub {
				merge_file_noninteractive($filename);
			    });
	$load_menu->command(-label => M"Load",
			    -command => sub {
				load_file_noninteractive($filename);
			    });
	$load_menu->command(-label => M"Cancel",
			    -command => sub { });
    }
    $load_menu->Post($top->pointerx, $top->pointery);
}

sub get_home_dir {
    if (!defined $home) {
	if ($^O eq 'MSWin32') {
	    eval q{
		use Win32Util;
		$home = Win32Util::get_user_folder();
	    };
	} else {
	    $home = eval q{
			    local $SIG{__DIE__};
			    (getpwuid($<))[7];
		          };
	}
	if (!defined $home) {
	    $home = $ENV{'HOME'} || '/';
	}
    }
    $home;
}

sub get_user_name {
    $username = $options->{username};
    if (!defined $username || $username =~ m{^\s*$}) {
	if ($^O eq 'MSWin32') {
	    eval q{
	       use Win32Util;
	       $username = Win32Util::get_user_name();
	    };
	} else {
	    $username = eval q{
				local $SIG{__DIE__};
			        getpwuid($<))[0];
			      };
	}
	if (!defined $username || $username =~ m{^\s*$}) {
	    $username = $ENV{USERNAME} || $ENV{USER} || "";
	}
    }
    $username;
}

sub get_real_name {
    $realname = $options->{realname};
    if (!defined $realname || $realname =~ m{^\s*$}) {
	$realname = eval q{
			    local $SIG{__DIE__};
			    ((getpwuid($<))[6]);
		          };
	$realname =~ s/,.*//;
    }
    $realname;
}

# This is a hack using xwininfo to report if another tktimex window
# is already running. This must be called before $top is created...
sub tktimex_running {
    return 0 if ($os eq 'win');
    open(WININFO, "xwininfo -tree -root |");
    my $r = 0;
    while (<WININFO>) {
	if (/^\s*0x[0-9a-fA-F]+\s+"tktimex.*":\s+\("tktimex"\s+"Tktimex"\)/) {
	    $r = 1;
	    last;
	}
    }
    close WININFO;
    return $r;
}

sub get_rcs_from_cache {
    my $project = shift;
    my $rcs;
    if ($rcs_cache{$project->rcsfile}) {
	$rcs = $rcs_cache{$project->rcsfile};
    } else {
	require Timex::Rcs;
	$rcs = new Timex::Rcs $project->rcsfile;
	$rcs_cache{$project->rcsfile} = $rcs;
    }
    $rcs;
}

sub hourly_rate {
    my $p = shift;
    my $rate = $p->rate;
    $rate = $options->{'hourlyrate'} if (!defined $rate);
    $rate;
}

sub pi ()   { 4 * atan2(1, 1) } # 3.141592653
sub deg2rad { ($_[0]*pi)/180 }

# HList hack... XXX move to MyHList XXX
sub MyButtonRelease1
{
 my ($w) = @_;
 my $Ev = $w->XEvent;

 delete $w->{'shiftanchor'};

 my $mode = $w->cget('-selectmode');

 if($mode eq 'dragdrop')
  {
#   $w->Send_DoneDrag();
   return;
  }

 my ($x, $y) = ($Ev->x, $Ev->y);
 my $ent = $w->GetNearest($y, 1);

 if (!defined($ent) and $mode eq 'single')
  {
     my($ent) = $w->info('selection');
     if (defined $ent)
      {
        $w->anchorSet($ent);
      }
  }
 return unless (defined($ent) and length($ent));

 if(exists $w->{tixindicator})
  {
   return unless delete($w->{tixindicator}) eq $ent;
   my @info = $w->info('item',$Ev->x, $Ev->y);
   if(defined($info[1]) && $info[1] eq 'indicator')
    {
     $w->Callback(-indicatorcmd => $ent, '<Activate>');
    }
   return;
  }

  if($mode eq 'single' || $mode eq 'browse')
   {
    $w->anchorSet($ent);
   }
  Tk->break;
}

sub project_status {
    M("Left: Select | Middle: ") .
	($options->{'autoscroll'} !~ /^(|none)$/
	 ? M"Scroll"
	 : M"Create Subproject"
	) .
    M" | Right: Attributes";
}

sub notimes_check {
    if ($root->notimes) {
	$top->messageBox(-icon => "warning",
			 -message => M"No times available",
			);
	die;
    }
}

sub show_about {
    my $dia = $top->Toplevel(-title => M"Copyright");
    # XXX Übersetung?
    $dia->Label(-text  => <<EOF,

tktimex $VERSION
Tk $Tk::VERSION
perl $]

For copyright see Help > Copyright

EOF
		-justify => 'left')->pack;
    my $okb = $dia->Button(-text => M"OK",
			   -command => sub { $dia->destroy })->pack;
    $okb->focus;
    $dia->bind('<Escape>' => sub { $okb->invoke });
    $dia->Popup(-popover => 'cursor');
}

sub show_copyright {
    my $dia = $top->Toplevel(-title => M"Copyright");
    # XXX Übersetung?
    $dia->Label(-text  => <<'EOF',

tktimex by Slaven Rezic (eserte@users.sourceforge.net)

Copyright (c) 1996-2005 Slaven Rezic. All rights reserved.

Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions
are met:
1. Redistributions of source code must retain the above copyright
   notice, this list of conditions and the following disclaimer.
2. Redistributions in binary form must reproduce the above copyright
   notice, this list of conditions and the following disclaimer in the
   documentation and/or other materials provided with the distribution.
3. All advertising materials mentioning features or use of this software
   must display the following acknowledgement:
   This product includes software developed by Slaven Rezic.
4. The name of the author may not be used to endorse or promote products
   derived from this software without specific prior written permission.

THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
SUCH DAMAGE.

EOF
		-justify => 'left')->pack;
    my $okb = $dia->Button(-text => M"OK",
			   -command => sub { $dia->destroy })->pack;
    $okb->focus;
    $dia->bind('<Escape>' => sub { $okb->invoke });
    $dia->Popup(-popover => 'cursor');
}

=head1 NAME

tktimex - time recording tool

=head1 SYNOPSIS

    tktimex [options] [projectfile]

=head1 DESCRIPTION

B<tktimex> is a time recording tool. Its purpose is to record working
times for projects. Projects may be grouped hierarchically with
subprojects. It is also possible to get some daily/weekey/monthly
statistics.

=head2 QUICK OVERVIEW

To create a new project, select from the B<Project> menu the item
B<New>.

To start the timer on a particular project, select the project from
the list by mouse click and click on the B<Cont> button. To stop the
timer, click on the B<Pause> button. You can also double-click on a
project to start/stop the timer.

If autosaving is on (which is the default), after each click on
B<Pause>, the project list will be updated on disk, and so will every
10 minutes. If autosaving is off, you have to manually save the
project list by clicking on the B<Save> button.

To reload an project list file, you have to specify the file name on
the command line:

	tktimex projectfile.pj1

If Tk::Getopt is installed on your system (highly recommended!), you
can set the default project list file in the B<Option editor> (menu
B<Options>).

=head1 COMMAND LINE OPTIONS

Possible options are:

	--file
    	--mergedir
    	--[no]lock       (default: 1)
    	--[no]one-instance
    	--[no]as, --[no]autosave         (default: 1)
    	--update         (default: 600)
    	--[no]oneday-immediately         (default: 1)
    	--geometry       (default: 500x230)
    	--[no]securesave
    	--enterpriseprojects
    	--enterprisedefaults
    	--df, --dateformat       (default: h)
    	--[no]day8       (default: 1)
    	--[no]archived
    	--[no]onlytop
    	--domain
    	--sort   (default: name)
    	--[no]busyind
    	--autoscroll     (default: none)
    	--hourlyrate
    	--currency       (default: EUR)

=head1 TODO

  - better Pod

  - enterprice-wide settings:

    - default getopt settings

    - central repository for user data (this directory should be 4777
      or 4555 with all the files already created)

    - template sets

    - set of all projects running in system

    - private vs. enterprice projects


=head1 BUGS

If tktimex crashes (it should only due to perl/Tk or OS problems!),
then it is possible that the project file gets corrupted. To prevent
loss of data, there are always some backup files with the suffixes .1,
.2 etc.

The -oneday-immediately option is not supported with Tk::DateEntry.

Setting dateformat to "hs" (show hours, minutes and seconds) is not
recommended due to cpu waste. Better leave the option at "d" or "h".

=head1 FILES

    ~/.tktimexrc        personal configuration file
    ~/.tktimex.last     list of last accessed projects
    *.pj1               project files

=head1 SEE ALSO

L<perl>, L<Tk>, L<rcsintro(1)>, L<cvs(1)>, L<Timex::Project>

=head1 AUTHOR

Slaven Rezic (eserte@users.sourceforge.net)

Copyright (c) 1996-2005 Slaven Rezic. All rights reserved.

For a complete copyright see the Help/About menu entry.

=cut