todoと連動したカレンダー作例

背景

~/org/gtd.org というスケジュールテキストに書いた日時が把握しにくかった。
そして1週間の単位が月火水木金土日というのに馴染んでおり、一般のカレンダーの
日曜日スタートに違和感があった。
また、 cal -3 のような複数のカレンダーが横に表示されていくのにも不満があった。
30や31日の月末ごとに意識が分断されていた。30や31の隣に1が表示されてほしかった。
好みに合わない数が多いので作り直すことにした。

概要

gtd.orgと連動した好みに合うように再開発されたカレンダーは以下の特徴を持つ。
~/org/gtd.org を読み込み TODO,Deadline のある日をハイライトする。
それらの日のtodoは右に簡易表示させる。
そのうち、今日行うべきことがあれば当日専用のハイライトで強調する。
月曜日スタートで始まる。
月末を終えても改ページ等々は無し。日付は連続する。
表示する月を増やせる。
祝日など任意の日を自由にハイライトさせられる。

コード説明

org_todo_finder.pl はgtd.orgを簡単に読むためのスクリプトだ。
それは何ヶ月分なのか、見出しだけなのか、本文も必要なのか、について
TODO、Deadlineのあるものを日付順にソートして返してくる。
ソートされるのが便利なので、独立させた。
cal サブルーチンで使う @dye_way が今回のハイライト実装の中心を担っている。
土日だからシアンや赤に染めることと、todoが被ってアンダーバーを引くなど
複数のハイライト修飾ができる限り両立する為には、
1日1日を何年何月の何日であるのか認識してコードを書くのが
理路整然としていて保守がしやすい。
整列も printf や format には頼れないが、
padding_1t_10_day を書くことで矛盾無く整列させられる。

使用例

コード

#!/usr/bin/env perl
use strict;
use warnings;
require Colorlizer;
sub say {print @_, "\n"};
sub dye {Colorlizer::dye(@_)};
use constant ONE_DAY => 60*60*24;
use Time::Piece;

# private
my $extra_ref = [ 
                    [ 20220824, qw(orange) ],
                    [ 20220825, qw(orange) ],
                    [ 20220826, qw(orange) ],
                    [ 20220829, qw(orange) ],
                    [ 20220830, qw(orange) ],
                    [ 20220831, qw(orange) ],
                    [ 20220901, qw(orange) ],
                    [ 20220902, qw(orange) ],
                    [ 20220919, qw(cyan) ], # 敬老の日
                    [ 20220923, qw(cyan) ], # 秋分の日
                    [ 20230101, qw(blink) ], # happy new year
                ];

# import schedule from org_todo file
my @todo ;
my @dates;
my $numbers_of_month = shift // 2;
{
    for (qx{ ~/bin/org_todo_finder.pl td$numbers_of_month }) {
        chomp;
        /^[*]+ \s+ (.*)$/x        ? push @todo , s/^[*]+ \s+ TODO \s+//xr:
        /(\d{4})-(\d{2})-(\d{2})/ ? push @dates, "$1$2$3"                :
        die "I can't understand $_ as neither date or todo.\n"                  ;
    }

}

my %dates_map = map {$_ => 1} @dates;

sub HEADER () {say " Mo Tu We Th Fr Sa Su"};
my $now = localtime;
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime;
++$mon and $year += 1900;

sub struct_Y4M2D2 {
    my $self = shift;
    sprintf "%4s%02s%02s" , $self->year, $self->mon, $self->mday
};
my $now_Y4M2D2 = struct_Y4M2D2($now);
sub calHeaderYYYYMM_nameMonth {
    my $d= $now + ONE_DAY * (1 - $mday);
    sprintf "%-4s %02s %13s" , $d->year, $d->mon, $d->fullmonth;
}

sub cal {
    my $self = shift;
    my $wd= $self + ONE_DAY * (1 - $mday);
    for my $d (1 .. $self->month_last_day) {

        padding_1st_day($wd);

        my $Y4M2D2 = sprintf "%4s%02s%02s"
            , $wd->year, $wd->mon, $d;

        my @dye_way = qw(itaric);
        # today
        if ($Y4M2D2 == $now_Y4M2D2) {
            push @dye_way, qw(back_white black);
        }
        # org_todo
        if ($dates_map{$Y4M2D2}) {
            push @dye_way, qw(underline);
        }

        for my $d_color_ref (@$extra_ref) {
            my($d, @cs);
            ($d, @cs) = @$d_color_ref;
            if ($Y4M2D2 == $d) {
                push @dye_way, @cs;
            }
        }

        if ($wd->wdayname eq "Sat") {
            push @dye_way, qw(cyan);
        }
        if ($wd->wdayname eq "Sun") {
            push @dye_way, qw(red);
        }

        print q( ) . dye( padding_lt_10_day($d), @dye_way);
        foldingSun($wd);
        $wd += ONE_DAY;
    }
}
sub padding_lt_10_day {
    my $day = shift;
    $day < 10 ? q( ) . $day : $day ;
}

sub padding_1st_day {
    my $self = shift;
    my %pad_map = (
        Mon => 0,
        Tue => 3,
        Wed => 6,
        Thu => 9,
        Fri => 12,
        Sat => 15,
        Sun => 18,
    );
    if ($self->mon == $mon and $self->mday == 1) {
        print q( ) x $pad_map{$self->wdayname};
    }
}

sub foldingSun {
    my $self = shift;
    if ($self->wdayname eq "Sun") {
        my ($t,$d);
        if ($t = shift @todo) {
            $d = shift @dates;
            $d = ($now_Y4M2D2 == $d) ? dye($d , qw(back_white black)) : $d;
            print "\t$d $t" =~ s/\d{4}//r;
        }
        print "\n";
    }
}

sub main {
    say calHeaderYYYYMM_nameMonth();
    HEADER;
    for my $n (1 .. $numbers_of_month) {
        cal($now->add_months($n -1));
    }
}

main();