#!/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',…