App-orgdaemon
view release on metacpan or search on metacpan
bin/org-daemon view on Meta::CPAN
} elsif ($date->{epoch} <= $today_end) {
$today_or_tomorrow = ' (today)';
} elsif ($date->{epoch} <= $tomorrow_end) {
$today_or_tomorrow = ' (tomorrow)';
} else {
my @l = localtime $date->{epoch};
my $day_begin = timelocal 0,0,0,@l[3..5];
my $days = int(($day_begin - $today_begin) / 86400); # XXX probably inaccurate through DST switches
$today_or_tomorrow = " (in $days days)"; # always plural at this point
}
my $text = ' ' . $this_day . $today_or_tomorrow;
if ($overview_widget eq 'listbox') {
$lb->insert('end', $text);
} else {
$lb->add($lb_i, -text => $text);
$lb_i++;
}
push @lb_contents, undef;
$last_day = $this_day;
}
my $text;
if ($text_segments) {
if ($overview_widget eq 'listbox') {
no warnings 'uninitialized';
$lb->insert('end', sprintf $fmt, @$text_segments);
} else {
$lb->add ($lb_i, -text => $text_segments->[0]); # text
$lb->itemCreate($lb_i, 1, -text => $text_segments->[3]); # orgdate
$lb->itemCreate($lb_i, 2, -text => $text_segments->[1]); # tags
}
} else {
if ($overview_widget eq 'listbox') {
$lb->insert("end", $date->formatted_text);
} else {
$lb->add($lb_i, -text => $date->formatted_text);
}
}
push @lb_contents, $date;
}
}
}
{
my %hl_is;
sub colorize_entries {
for my $i (0 .. $#lb_contents) {
my($fg, $bg) = ('black', 'grey80');
if ($lb_contents[$i]) {
my $duration = $lb_contents[$i]->{epoch} - time;
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);
bin/org-daemon view on Meta::CPAN
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 '/';
bin/org-daemon view on Meta::CPAN
my %dirs_to_basenames;
for my $org_file (keys %org_files) {
my($dirname, $basename) = (File::Basename::dirname($org_file), File::Basename::basename($org_file));
push @{ $dirs_to_basenames{$dirname} }, $basename;
}
for my $dir (keys %dirs_to_basenames) {
my $all_basenames = "(^|/)(" . join("|", map { quotemeta $_ } @{ $dirs_to_basenames{$dir} }) . ')$';
$all_basenames = qr{$all_basenames};
my $notifier = AnyEvent::Filesys::Notify->new
(
dirs => [ $dir ],
# no need for interval, the Tk recheck_interval is still enabled
filter => sub { $_[0] =~ $all_basenames },
cb => sub {
my (@events) = @_;
if ($debug) {
warn "AnyEvent::Filesys::Notify got events:\n";
require Data::Dumper;
print STDERR Data::Dumper->new([@events],[qw()])->Indent(1)->Useqq(1)->Sortkeys(1)->Terse(1)->Dump;
}
tk_do_one_iteration();
},
);
push @anyevent_notifiers, $notifier;
}
}
}
#$mw->WidgetDump;
MainLoop;
__END__
=head1 NAME
org-daemon - watch for appointments in org-mode files
=head1 SYNOPSIS
org-daemon [--debug] [--early-warning=seconds] [--recheck-interval=seconds] \
[--no-emacsclient-eval] [--emacsclient-cmd=...] \
[--overview-widget=...] [--move-button] \
orgfile ... &
=head1 DESCRIPTION
B<org-daemon> is a Perl/Tk program which watches one or more emacs
org-mode files for
L<appointments|http://orgmode.org/manual/Timestamps.html>, that is,
entries in the form of C<< <YYYY-MM-DD AAA HH:MM> >> and fires alarms
in the form of non-modal dialogs. "Passive" timestamps (enclosed in
square brackets) are ignored. Diary-style sexp entries are not
implemented (see L</TODO>).
=head1 OPTIONS
=over
=item --early-warning=I<seconds>
There's an warning (a non-modal dialog with orange background) before
the real alarm, by default 30 minutes (1800 seconds) before. This
option can be used to change this default. Use 0 to turn early
warnings off completely.
=item --recheck-interval=I<seconds>
Set the interval for checking the specified org-mode files for
changes. By default, B<org-daemon> checks every 60 seconds.
=item --debug
Turn on debugging mode. Currently this means: do not iconify
appointment list by default, and check every 3 seconds instead every
60 seconds.
=item --no-emacsclient-eval
If there are problems with the usage of C<emacsclient --eval>, then
this option may be used for simple non-eval emacsclient usage. If this
is used, then a referenced org entry is not opened automatically.
=item --emacsclient-cmd=I<cmdline ... %l %f ...>
Provide an alternative commandline for emacsclient calls. The
placeholder strings C<%l> and C<%f> are replaced by line and file of
the current appointment. Example:
org-daemon --emacsclient-cmd="ssh otheruser@otherhost emacsclient +%l '%f'" ...
=item --overview-widget=I<widgettype>
Select widget for overview window. Default is C<hlist>, another
possible value is C<listbox>.
=item --move-button
The early warning and alarm windows will get an additional "move"
button (displayed with a right arrow: E<x2192>) for moving the window
quickly to the right screen border.
=item --use-anyevent (EXPERIMENTAL!)
Use either L<Linux::Inotify2> together with L<AnyEvent> (linux
systems) or L<AnyEvent::Filesys::Notify> (non-linux systems) for
getting file modification events. Probably not useful on systems using
kevent (*BSD). C<--recheck-interval> is still applied for periodic
checks.
=back
=head2 FEATURES
=over
=item * Watch all given org-mode files periodically every minute (or
the interval as given with the C<--recheck-interval> switch).
=item * Iconified list of next appointments, with entries in different
colors (red for appointments in near future, over orange and yellow to
green for appointments in far future)
( run in 0.733 second using v1.01-cache-2.11-cpan-f56aa216473 )