App-orgdaemon
view release on metacpan or search on metacpan
bin/org-daemon view on Meta::CPAN
sub line { $_[0]->{line} }
# tags
sub tags { @{ $_[0]->{tags} || [] } }
## methods
sub id {
my $self = shift;
join '|', $self->{text}, $self->{date};
}
sub state {
my $self = shift;
my $now = do { package main; time }; # hack: don't call the method time() in this package, and using CORE::time does not work together with Time::Fake
if ($now >= $self->{epoch}) {
'due';
} elsif (defined $self->{early_warning_epoch} && $now >= $self->{early_warning_epoch}) {
'early';
} else {
'wait';
}
}
sub formatted_text {
my $self = shift;
(my $formatted_text = $self->{text}) =~ s{\t}{ }g;
$formatted_text =~ s{^\*+}{};
$formatted_text =~ s{^\s+}{};
$formatted_text =~ s{^(TODO|DONE|WAITING|WONTFIX|LATER)\s+}{};
$formatted_text;
}
sub copy {
my($self, $src) = @_;
while(my($k,$v) = each %$src) {
$self->{$k} = $v;
}
}
sub date_of_date {
my $self = shift;
my @l = localtime $self->{epoch};
sprintf "%04d-%02d-%02d", $l[5]+1900, $l[4]+1, $l[3];
}
sub start_is_timeless {
my $self = shift;
!defined $self->{time} || !length $self->{time};
}
sub end_is_timeless {
my $self = shift;
!length $self->{time_end};
}
sub epoch_end {
my $self = shift;
my($Y,$M,$D) = $self->{date_end} =~ m{^(\d{4})-(\d{2})-(\d{2})};
my($h,$m);
if ($self->end_is_timeless) {
($h,$m) = (23,59);
} else {
($h,$m) = $self->{time_end} =~ m{^(\d{1,2}):(\d{2})};
}
Time::Local::timelocal(0,$m,$h,$D,$M-1,$Y);
}
}
my $small_font = 'sans 8';
my $default_early_warning = 30*60;
my $default_timeless_early_warning = 86400;
my $include_timeless;
my $time_fallback = '06:00';
my $recheck_interval;
my $debug;
my $use_emacsclient_eval = 1;
my $emacsclient_fmt_cmd;
my $show_version;
my $overview_widget = 'hlist';
my @ignore_tags;
my $mw;
my $lb;
my @lb_contents;
my %org_files;
my %open_warning;
our %window_for_date; # ($date_id -> $tk_window), for a (maybe) currently display date; "our" just for testing
my %seen_early_warning; # ($date_id -> 1)
my %seen_due_date; # ($date_id -> 1)
my $with_move_button;
my $use_anyevent;
my $org_alert_logo;
sub normal_repeater {
$lb->repeat($recheck_interval*1000, sub { tk_do_one_iteration() });
}
sub show_date_by_index_in_emacs {
my($index) = @_;
my $date = $lb_contents[$index];
if (!$date) {
# probably a date separator --- look for the next entry and use it
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")};
bin/org-daemon view on Meta::CPAN
if ($duration < 3600) {
($fg, $bg) = ('white', 'red');
} elsif ($duration < 86400) {
($fg, $bg) = ('black', 'orange');
} elsif ($duration < 86400*7) {
($fg, $bg) = ('black', 'yellow');
} else {
($fg, $bg) = ('black', 'green');
}
}
if ($overview_widget eq 'listbox') {
$lb->itemconfigure($i, -foreground => $fg, -background => $bg, -selectforeground => $fg, -selectbackground => $bg);
} else {
my $style = $hl_is{$fg}->{$bg};
if (!$style) {
$style = $hl_is{$fg}->{$bg} = $lb->ItemStyle('text', -foreground => $fg, -background => $bg, -selectforeground => $fg, -selectbackground => $bg);
}
$lb->entryconfigure($i, -style => $style);
eval {
$lb->itemConfigure($i, 1, -style => $style);
$lb->itemConfigure($i, 2, -style => $style);
};
}
}
}
}
sub check_for_alarms {
my %active;
my @dates = map { @{ $_->{dates} } } values %org_files;
my $date_i = -1;
for my $date (@dates) {
$date_i++;
my $date_id = $date->id;
$active{$date_id} = 1;
my $date_state = $date->state;
if ($date_state =~ m{^(early|due)$}) {
my $is_early_warning = $date_state eq 'early';
my $t = $window_for_date{$date_id};
if ($t && Tk::Exists($t)) {
next if $t->{DateState} eq $date_state; # nothing changed
}
if ($date_state eq 'early') {
if ($seen_early_warning{$date_id}) {
next; # user already saw the early warning and clicked it away, don't redisplay
} else {
$seen_early_warning{$date_id} = 1;
}
} elsif ($date_state eq 'due') {
if ($seen_due_date{$date_id}) {
next;
} else {
$seen_due_date{$date_id} = 1;
}
}
my %colargs = (
-background => ($is_early_warning ? 'orange' : 'red'),
-foreground => ($is_early_warning ? 'black' : 'white'),
);
my %smlbtnargs = (-font => $small_font);
my %t_args = (
-title => ($is_early_warning ? "Early Warning" : "Alarm!"),
%colargs,
);
if ($t && Tk::Exists($t)) {
# something changed: early -> due
$t->configure(%t_args);
$_->destroy for $t->children;
$t->{OverflowCounter}->cancel;
$t->deiconify;
$t->raise;
$t->{DateState} = $date_state;
} else {
$t = $mw->Toplevel(%t_args);
$t->Icon(-image => $org_alert_logo);
$t->bind($_ => sub { $t->destroy })
for ('<Escape>', '<Control-q>');
$t->{DateId} = $date_id;
$t->{DateState} = $date_state;
}
$t->Label(-text => (($is_early_warning ? "Early warning:\n" : "")
. $date->formatted_text),
-justify => 'left',
-anchor => 'nw',
-font => 'sans 24',
%colargs,
)->pack(qw(-fill x -expand 1));
my $overflow = ($is_early_warning ? "" : "+00:00");
$t->Label(-textvariable => \$overflow,
-justify => 'right',
-anchor => 'e',
%colargs, %smlbtnargs,
)->pack(qw(-side right));
my @button_opts = (
-anchor => 'w',
-borderwidth => 1,
-highlightthickness => 0,
-padx => 1, -pady => 1,
%colargs, %smlbtnargs,
);
my $edit_b = $t->Button(
-text => 'Edit',
-command => sub { show_date_in_emacs($date) },
@button_opts,
)->pack(qw(-side left));
my $mv_b;
if ($with_move_button) {
my($right, $left) = ("\x{2192}", "\x{2190}");
$mv_b = $t->Button(
-text => $right,
-command => sub {
if ($mv_b->cget(-text) eq $left) {
$t->MoveToplevelWindow(10, $t->y);
$mv_b->configure(-text => $right);
} else {
$t->MoveToplevelWindow($t->screenwidth-60, $t->y);
$mv_b->configure(-text => $left);
}
},
@button_opts,
)->pack(qw(-side left));
}
$t->bind('<Control-e>' => sub { $edit_b->invoke });
if ($mv_b) {
$t->bind('<Control-m>' => sub { $mv_b->invoke });
}
if ($is_early_warning) {
$t->{OverflowCounter} =
$t->repeat(1000, sub {
my $diff = $date->{epoch} - time;
if ($diff <= 0) { # may happen if the original date was deleted
$t->{OverflowCounter}->cancel;
$overflow = "";
} else {
$overflow = sprintf "-%02d:%02d", int($diff/60), $diff%60;
}
});
} else {
$t->{OverflowCounter} =
$t->repeat(1000, sub {
my $diff = time - $date->{epoch};
$overflow = sprintf "+%02d:%02d", int($diff/60), $diff%60;
});
}
bin/org-daemon view on Meta::CPAN
$mw0->raise;
return;
}
}
require Config;
require File::Basename;
my @perldirs = grep { defined $_ && -x $_ } ($Config::Config{'sitebin'}, $Config::Config{'scriptdir'});
push @perldirs, File::Basename::dirname(File::Basename::dirname($^X)); # for the SiePerl installation
my $perldir;
TRY: {
no warnings 'once';
# "local" probably does not work here, we're in a MainLoop...
$Data::Dumper::Deparse = 1; # if I need a "ptksh" window, then I need more diagnostics!
$Data::Dumper::Sortkeys = 1;
local @ARGV; # ptksh would read 1st argument as perl script
# Find the ptksh script
for $perldir (@perldirs) {
if (-r "$perldir/ptksh") {
require "$perldir/ptksh";
last TRY;
}
}
$perldir = File::Basename::dirname($^X);
if (-r "$perldir/ptksh") {
require "$perldir/ptksh";
} else {
my $f = ((Tk::MainWindow::Existing())[0])->getOpenFile
((-d $perldir ? (-initialdir => $perldir) : ()),
-title => "Path to ptksh",
);
if (defined $f) {
require $f;
} else {
return;
}
}
}
# The created mainwindow is unnecessary - destroy it
for my $mw0 (Tk::MainWindow::Existing()) {
if ($mw0->title eq '$mw') {
$mw0->destroy;
} elsif ($mw0->title eq 'ptksh') {
$mw0->protocol('WM_DELETE_WINDOW' => [$mw0, 'withdraw']);
}
}
}
return 1 if caller;
GetOptions(
"d|debug!" => \$debug,
"recheck-interval=i" => \$recheck_interval,
"early-warning=i" => \$default_early_warning,
"early-warning-timeless=i" => \$default_timeless_early_warning,
"include-timeless!" => \$include_timeless,
'time-fallback=s' => \$time_fallback,
"small-font=s" => \$small_font,
'emacsclient-eval!' => \$use_emacsclient_eval,
'emacsclient-cmd=s' => \$emacsclient_fmt_cmd,
'overview-widget=s' => \$overview_widget,
'ignore-tag=s@' => \@ignore_tags,
'v|version' => \$show_version,
'move-button!' => \$with_move_button,
'use-anyevent' => \$use_anyevent,
)
or die <<EOF;
$0 [--debug] [--early-warning=seconds] [--early-warning-timeless=seconds] [--recheck-interval=seconds]
\t[--no-emacsclient-eval] [--emacsclient-cmd=...]
\t[--overview-widget=...] [--move-button]
\t[--[no-]include-timeless] [--time-fallback HH:MM]
\t[--ignore-tag=... ...]
\torgfile ...
$0 --version
EOF
if ($overview_widget !~ m{^(listbox|hlist)$}i) {
die "Valid values for --overview-widget are 'listbox' or 'hlist'.\n";
}
if ($show_version) {
print "org-daemon $VERSION\n";
exit 0;
}
if (!$recheck_interval) {
if ($debug) {
$recheck_interval = 3;
} else {
$recheck_interval = 60;
}
}
if ($recheck_interval < 1) {
die "Invalid --recheck-interval, must be 1 second or larger.\n";
}
{
my @org_files = @ARGV;
if (!@org_files) {
die "No org files given, exiting...\n";
}
%org_files = map { ($_, {}) } @org_files;
}
$mw = tkinit;
if (!$debug) {
if ($^O eq 'darwin') { # XXX actually should check for Xquartz or so
$mw->after(1000, sub { $mw->iconify }); # XXX hack --- the window gets invisible and unselectable if immediately iconified. See https://rt.cpan.org/Ticket/Display.html?id=114203
} else {
$mw->iconify;
}
}
set_x11_properties($mw);
# Taken from http://orgmode.org/org-mode-unicorn-logo.png, scaled down
# to 32x32 and encoded using "mmencode -b"
my $org_logo = $mw->Photo
(-format => 'png',
bin/org-daemon view on Meta::CPAN
9OB6Hj7bBgRZGQGklHhKEQ6FuNjYSOWur8gPh5lUUsLUsrKBAfiHZCGkxGidLj5PSsrabvDL
qFJagmEKnQ4yXJfOpMv7ixZRXDCcq83NCODIyVM0dXQwJBBA94mSE4vx8pQpA9cAQH7ZRCzb
h1GKhGUjMNjGMK6jmUt5I7ntC3A5byRKKSaXjmPZa68SDgbT59csWcKRmpN8ceAAN6NRno9E
yMvNwWjDnKlTB2GB1mTl5ZM/fiJCKVpCQ6nLH4Vfe2S4SWZdv9AnKTCzvJxwMIjWGpV6XM+j
YvYsDlRtYc3SJQzLyUEKwdY1q/H77EE6Yar/O0032PvWXJwRxVQXjaOoq4PS9iaGxR2u5+Zz
cswEPGNYPm8ea99eOqCIpWcBrbGkHCQFQmC0JjSykAVbdnBw03pyC4q5nDeSxtw8pNbpJqSV
orG1tX+P+hk6HmT8PhoKKTHGUFaxkDc3f0xxcwMimUQJiWfZJK1evNKy+L2+nouNDU9+Jryj
2eXL3mHDpg+ZPKqQ20mXpNYIq7e9SiFo6uhg77eH0SldeNT1QDk2WiOkJBqLceLsOfZ+9x11
164RDgbxlEJKya1olAPbtlJSUICQEvEkp2KRylswO5uKWTPZs7mSD5YvJ+G6WJaFSGnB8dpa
ZJ/e8dTGctuyeLdiPvurtlBSUIDWGp/P5mJDY0oXzNMHoLRmeDjMno82s/SVOQggFo8/VhHa
D/NxXzptWLYM27Jpam9/7LH5kZfW2uz7odoYY4yn1CP9Qzzu3fB2IkFmIPDkafi/vJz+JwH8
BUIoz9dd4ccZAAAAAElFTkSuQmCC
EOF
$mw->Icon(-image => $org_logo);
# Combined with the following sources:
# * By Greg Newman - http://orgmode.org/, GPL, https://commons.wikimedia.org/w/index.php?curid=8250451
# * Von nach den historischen Vorgaben digital umgesetzt durch Mediatus - siehe oben, DIN-Normen, Gemeinfrei, https://commons.wikimedia.org/w/index.php?curid=982688
# Exported in inkscape as a 32x32 png. Removed alpha channel (because
# it seems that Tk cannot handle this well). Used "base64" program to
# generate data.
$org_alert_logo = $mw->Photo
(-format => 'png',
-data => <<EOF);
iVBORw0KGgoAAAANSUhEUgAAACAAAAAgCAIAAAD8GO2jAAAACXBIWXMAAALFAAACxQGJ1n/vAAAA
B3RJTUUH4QwYCTQ2OtCtFwAABg9JREFUSMe1VmtsFFUUPvPY2d1pp9PtdLes2/dS2rUV2AqKicEU
AqVayiNUgxQVBYQo+EClKIXioxjxhwYsGBAVUWPB4CuakIBAgkXC+9GypdLti23Zdrvvndfe8cfU
biF0ITTeXzPnfOd895x7zzkXlFGvOaXTDx8+PJIWh9GtA/sbBN6Xnp4+EmBUBIIgfP/FZwzN5OXl
jYQhR0NQV1uTZuIyxhXHweCj2b7L2ezxeJ95Yen/QrDx7bVccmJERGPGjIkDu9sUDQwMOJ1Ou90e
CAQqly6eVvxwV2tzwbjsx8om38HyLu/ioiVPz1qy0Ol0vv7ma3U/fV08pXjr5vXPLyjz+/3xDe8q
gq6uLpnW+NyBNQtKi4wM1nJien5myO9xewIMw8S3vfMZOByO1eUlnDUHJ3CqqDDEct36pG6fv40g
jFMfenJZVf32bXHMMUVRRkr6uXPnDuyq53pbKSzqW/5yd2u7OcuCa8hwIERqSEpLAYYBQO/FpnBH
71MVlRUVFSQ5mBKEEI7jtyEIhUJbata5zxw30xoTSydTGt4/0BcWepaswAlCxYi84Pj7QhQptinj
tXqdKgz3ur2d15Ekg4wUJHu9/q8/+Tw1NfUmgvb29pqFs8us5gSDAQCQLPm7OxQFAcDZSVN1Ntsd
L0xvx3WDkaNoHShKz8HGr3Z9FTsDp9P5UVXF/Il5qncA4H0DqncASHVcviXWFJrJptmb842ZMswU
rQMAJEl6nTZWB7Isb6yaN/cBK05qBgs16JcFflCLFKrvhq+xMXHSZFJDAoZRJDlz/xHxYpP03qru
oFeFRfzBfpc7gWVEnnc3nm3Y+0PsFtWsWjHDmkZoqEGPAh/xuKOioAD0K5gj1dJhzvJevgIIDfS4
o7JcwlP+X37n25yPnXcOBaBnEhgD29ni9PX7CvMKaJqORRC8ciapKNYRkSTiBBlFokdWWnAdPbUk
2tnF5lg9110KRhBBIWnvNyEAAAhs/9L25srjly+GBV6MSgoGSQAcoand/GGsVTQ3N2extHrn1NRH
vP0YYAAQ0OplSy4Chb2/QFGUbsc/UZkv57WhS0363Bz92FzPwUOPXO18dvvOeIXW0tKSrNMOpj7g
k4UIKIqioDbQJEalJFuBjmEAQAhHorJcnJFLfPsjAFjf32Ct24RrqZ7vGoIXLsUj4DguIkkAEBno
570ede8yAh1J/pM/QTl+DMkyACgIYRg240qX1NdnKJn6l8Tv/PVny8plgFBr9YZ4lezz+bYtKsvj
GDHoj0qiqvBF0aVxdm12Dklrg65ezpbPh8J2mcpdvwUUePDYwcnz5zY1NXlcLse0J8TeG7Zd9cZ5
s28fAcuyrhAvhmLeW4FqZdMYdw8RCWmTkzlbPgAks+yEg42KJN+3ZDGdn8eyLI7jrMmUs6EaAK7V
foB4fsRmF01OU/MAAG5RCRKUOMGuqZgT4UUpHFHl04O4/9ARTYohq3oNAJhMppSUFBzH055awBRP
FLq6O7fuGJFg/bZdp/vCAHBU0mK0vp/lKA0JGGYoLNDQegAwJjC67XsAIKv6DTKZVQmMRqNawNbN
mwDDOj+tF667bk9gsVjK1m6+FhS1xfaewgmc0eDr8w7HTWt2RRwtCbZ883OLVInJZEpNTVW/kyYV
p1XOR5FIW23diPNg1uwK+4p3XOebifETkTXPPLFoSGVLMETqdwOAta4W+6+nxiIAAICcjeuIhIQb
P/7kP3lqOAFRW1s79FNQWJTCjTl54RSbkT5UdziGz/zzQvjkae7x0szXXh4Cm0ym7OzssWPHDjpK
TMQw8B47Hmq6Yl68MGZ+S0QzS0snG3Nd5y4PSR4lGO93+3AtlftuzXBkQ0PDnj17hkssK5frsjMD
Z8/3fL/vDkO/5erVyqrKqjUrX/l4w9k5Tx5NSb+2qe4WTHl5udlsFkVxuND92x9HU9IbC+xyMKhK
RhyZ6urYf8D54mpcS9l27yCYxOGqKEKCKNA6/S0mV195K9LmzHz1peya6ngzGQCiknR6SgnvbL+H
ZxmupSadOKLLzIj3bEGynFho01nuu5eHH4GjKAKAfwEkxHqUW0+AiwAAAABJRU5ErkJggg==
EOF
if ($overview_widget eq 'listbox') {
$lb = $mw->Scrolled('Listbox',
-width => 100,
-height => 8,
-scrollbars => "osoe",
-font => 'Courier 9', # a fixed font
)->pack(qw(-fill both -expand 1));
$lb->bind("<Double-1>" => sub {
show_date_by_index_in_emacs(shift->xyIndex);
});
} else {
require Tk::HList;
require Tk::ItemStyle;
$lb = $mw->Scrolled('HList',
-width => 100,
-height => 10,
-scrollbars => 'osoe',
-selectbackground => '#4a6984',
-selectmode => 'browse',
-header => 0,
-columns => 3,
-command => sub {
my $path = shift;
show_date_by_index_in_emacs($path);
},
)->pack(qw(-fill both -expand 1));
$lb->anchorClear;
$lb->columnWidth(0, 400);
}
$lb->Button(-padx => 0, -pady => 0, -borderwidth => 1,
-font => $small_font,
-text => 'Update',
-command => \&tk_do_one_iteration,
)->place(-relx => 1, -rely => 1, -anchor => 'se');
$mw->bind('<Control-p>' => sub { start_ptksh() });
tk_do_one_iteration();
if ($recheck_interval == 60) {
# synchronize with full minute, only implemented for recheck_interval=60
my(@l) = localtime;
my $first_delay = $recheck_interval - $l[0];
if ($first_delay) {
$lb->after($first_delay*1000, sub {
tk_do_one_iteration();
normal_repeater();
});
} else {
normal_repeater();
}
} else {
normal_repeater();
}
$mw->protocol('WM_DELETE_WINDOW', sub {
return if ($mw->messageBox
(-icon => "question",
-title => "Exit org-daemon",
-message => "Really exit org-daemon?",
-type => "YesNo",
-default => 'No',
) =~ /no/i);
$mw->destroy;
if ($AnyEvent::Impl::Tk::mw) {
$AnyEvent::Impl::Tk::mw->destroy;
# otherwise process would still run & hang
}
for my $mw0 (Tk::MainWindow::Existing()) {
if ($mw0->title eq 'ptksh') {
$mw0->destroy;
}
}
});
# emacsclient does not start if a directory is missing,
# so make sure we change into a non-removable directory.
chdir '/';
my @anyevent_notifiers; # for AnyEvent::Filesys::Notify
my $inotify_w; # for Linux::Inotify2
if ($use_anyevent) {
if ($^O eq 'linux') {
require AnyEvent;
require Linux::Inotify2;
my $inotify = Linux::Inotify2->new
or die "Cannot create new inotify object: $!";
for my $org_file (keys %org_files) {
$inotify->watch($org_file, &Linux::Inotify2::IN_CLOSE_WRITE, sub {
my $e = shift;
if ($debug) {
( run in 0.999 second using v1.01-cache-2.11-cpan-ceb78f64989 )