view release on metacpan or  search on metacpan

bin/org-daemon  view on Meta::CPAN

	if ($lb_contents[$index+1]) {
	    $date = $lb_contents[$index+1];
	} else {
	    return;
	}
    }
    $lb->after(100, sub { show_date_in_emacs($date) }); # do it after the buttonrelease event
}

sub show_date_in_emacs {
    my $date = shift;
    my $file = $date->{file};
    die "No file associated with given date" if !defined $file;
    my @cmd;
    if ($emacsclient_fmt_cmd) {
	my $line = defined $date->{line} ? $date->{line} : 1;
	my $cmd = $emacsclient_fmt_cmd;
	$cmd =~ s{%l}{$line}g;
	$cmd =~ s{%f}{$file}g;
	system $cmd;
	if ($? != 0) {
	    warn "Failed to run '$cmd'";
	}
    } else {
	if ($use_emacsclient_eval) {
	    # XXX escape $file?
	    my $eval = qq{(progn (find-file "$file")};
	    if ($date->{line}) {
		$eval .= " (goto-line $date->{line}) (org-show-entry)";
	    }
	    $eval .= qq{ (select-frame-set-input-focus (window-frame)) "Positioning in file $file at line $date->{line}" )};
	    @cmd = ('emacsclient', '--eval', $eval);
	} else {
	    @cmd = ('emacsclient', '-n',
		    (defined $date->{line} ? '+'.$date->{line} : ()),
		    $file,
		   );
	}
	if (eval { require IPC::Run; 1 }) {
	    IPC::Run::run(\@cmd, '>', \my $ignore)
		    or warn "Failed to run '@cmd'";
	} else {
	    system @cmd;
	    if ($? != 0) {
		warn "Failed to run '@cmd'";
	    }
	}
    }
}

sub tk_do_one_iteration {
    if (check_for_updates()) {
	update_lb();
    }

    check_for_alarms();

    colorize_entries();
}

sub update_lb {
    if ($overview_widget eq 'listbox') {
	$lb->delete(0, "end");
    } else {
	$lb->delete('all');
    }
    @lb_contents = ();
    my @dates = map { @{ $_->{dates} } } values %org_files;
    @dates = sort { $a->{epoch} <=> $b->{epoch} } @dates;
    if (!@dates) {
	if ($overview_widget eq 'listbox') {
	    $lb->insert("end", "<no dates>");
	} else {
	    $lb->add(0, -text => '<no dates>');
	}
    } else {
	my $now = time;
	my($today_begin, $today_end);
	{
	    my @l1 = localtime $now;
	    $today_begin = timelocal 0,0,0,@l1[3..5];
	    $today_end = timelocal 59,59,23,@l1[3..5];
	}
	my $tomorrow_end;
	{
	    my @l2 = localtime $now+86400; # XXX which is not correct during DST switches, but well
	    $tomorrow_end = timelocal 59,59,23,@l2[3..5];
	}

	# XXX find a solution with less parsing here (i.e. $date
	# should have more information available)
	my @segmented_dates; # ([$dateobj, [$text, $tags, $scheduled, $orgdate]], ...)
	for my $date (@dates) {
	    my $formatted_text = $date->formatted_text;
	    if ($formatted_text =~ s{(?:^|\s+)(<.*?>)}{}) {
		my $orgdate = $1;
		my($scheduled, $tags);
		if ($formatted_text =~ s{(?:^|\s+)(SCHEDULED:)$}{}) {
		    $scheduled = $1;
		}
		if ($formatted_text =~ s{(?:^|\s+)(:\S+:)$}{}) {
		    $tags = $1;
		}
		my $text = $formatted_text;
		push @segmented_dates, [$date, [$text, $tags, $scheduled, $orgdate]];
	    } else {
		warn "Can't parse " . $date->formatted_text . "...\n";
		push @segmented_dates, [$date];
	    }
	}
	# Maximum lengths for sprintf
	my(@max);
	for my $i (0..3) {
	    $max[$i] = max map {
		my $text_segments = $_->[1];
		if ($text_segments && defined $text_segments->[$i]) {
		    length $text_segments->[$i];
		} else {
		    0;
		}
	    } @segmented_dates;