diary-float による org-mode の日付作成 (3)

1. これまでのあらすじ
2. はじめに
3. 問題点
4. 解決策
5. 結果
6. その他
7. 参考URL

#+File Created: <2019-04-08 Mon 16:15>
#+Last Updated: <2019-04-08 Mon 19:14>

このメモは, diary-float による org-mode の日付作成 (2) の続きである.

1 これまでのあらすじ

少々複雑な繰り返しタスクを org-mode 内でうまく処理したい.
そのため, 繰り返しタスクの PROPERTIES の中に DIARYF という property を作り, そこに diary-float 形式で繰り返し日付のルールを elisp program として書くことにした.

以下のような感じ

:PROPERTIES:
:DIARYF: %%(diary-lecture '(04 01 2019) 7 15 '(3 10))
:END:

この状態で org-todo を実行すると, DIARYF にある elisp program に基づいて次の予定日が計算され更新される. また, この予定日の次の予定も計算されて日付の差分(+1d とか)として更新される.
こうすることで, 複雑な繰り返し日付のルールを DIARYF に押し込めることができ, 実際のスケジュールは常に具体的な日付となって org-mode の他のいろんなツールの利用と矛盾しないようになった(ような気がする).

2 はじめに

一応使えてはいるのだが…
予定日からずれた使い方をすると途端によくわからん状態になってしまうことが判明.

例えば今日が <2019-04-05 Fri> で, SCHEDULED された日付が例えば以下のように書かれているとする.

** task hoge
    SCHEDULED: <2019-04-01 Mon +2d>
    :PROPERTIES:
    :DIARYF: %%(diary-habit-weekday '(04 01 2019) 1 3 5)
    :END:

<2019-04-01 Mon> にやるつもりだったが出来てなくて, 今日 <2019-04-05 Fri> にやろうかなーと思った, そんなよくある状況を想定している.

ちなみに DIARYF の後ろの関数はこんなやつで,

 1: (defun diary-habit-weekday(stt &rest wds)
 2:   ""
 3:   (let* ((jst0 nil)
 4:          (jst  nil)
 5:          (sttd  (calendar-absolute-from-gregorian stt ))
 6:          (today (calendar-absolute-from-gregorian date))
 7:          (diffd (- today sttd)))
 8:     ;;(y-or-n-p (message "date=%s" date))
 9:     (if (not (minusp diffd)) (setq jst0 t))
10:     (if (and jst0 (not wds)) (setq jst  t)) ;; 毎日
11:     (if (and jst0 wds)       (setq jst (diary-habit-weekday-week date wds)))
12:     jst
13:     ))
14: (defun diary-habit-weekday-week(date wds)
15:   ""
16:   (let ((wd nil)
17:         (jst nil))
18:     (while wds
19:       (setq wd (car wds))
20:       (if (= wd (calendar-day-of-week date)) (setq jst t))
21:       (setq wds (cdr wds))
22:       )
23:     jst))

<2019-04-01 Mon> 以降の月, 水, 金曜日にやるという意味である.

このタスクを今日 <2019-04-05 Fri> に行って DONE にする(org-todo) と…
何と以下のようになってしまうのであった.

** task hoge
    SCHEDULED: <2019-04-03 Wed +2d>
    :PROPERTIES:
    :DIARYF: %%(diary-habit-weekday '(04 01 2019) 1 3 5)
    :END:

うーん違うだろって感じだ.
繰り返し日付で今日は金曜日なんで,

** task hoge
    SCHEDULED: <2019-04-08 Mon +2d>
    :PROPERTIES:
    :DIARYF: %%(diary-habit-weekday '(04 01 2019) 1 3 5)
    :END:

こうなって欲しいことは明らかなのだが, どうすればいいんだろ？

.+2d (DONE にした日付から 2 日後), ++2d (DONE した日付から直近の 2 日後) で行けるのかなと思ったが, それもなかなか難しいことが判明.

例えばこうしておく.

** task hoge
    SCHEDULED: <2019-04-01 Wed .+2d>
    :PROPERTIES:
    :DIARYF: %%(diary-habit-weekday '(04 01 2019) 1 3 5)
    :END:

04/05 (金) に DONE にすると

** task hoge
    SCHEDULED: <2019-04-07 Sun .+1d>
    :PROPERTIES:
    :DIARYF: %%(diary-habit-weekday '(04 01 2019) 1 3 5)
    :END:

次の日付を作るときは .+2d しか見ないから, こうなってしまうのであった.
うーんイマイチだなぁ. このタスクは日曜日にやる予定はないのだ.

3 問題点

スケジュールされた日に実行すると仮定して日付差分(+2d など)が作成されているため, スケジュールされた日 + 差分よりも今日の方が新しい場合には, DONE にした後の再スケジューリングが過去の日付になってしまう.

4 解決策

スケジュールされた日が今日よりも前の場合には, スケジュールを今日に変更し, DIARYF を見て次のスケジュールを差分で書くように変更する.

5 結果

いくつかの部品をまず作成する.
日付の format が色々あってめんどくさい.

1: (defun my-org-diary-float-get-sexp()
2:   "カーソルがある場所の DIARYF にある S 式を取得して返す"
3:   (let (elem sexp)
4:     (end-of-line)
5:     (org-back-to-heading)
6:     (setq elem (org-element-headline-parser (point-max) t))
7:     (setq sexp (org-element-property :DIARYF elem))   ;; PROPERTIES: の中身のデータを取り出す方法
8:     sexp
9:     ))

 1: (defun diary-float-to-diff(sexp day &optional pdays)
 2:   "sexp: DIARYF の S 式               %%(diary-lecture ......)
 3:    day:  日付リスト形式              '(50 7 20 4 5 2019 5 nil 32400)   => 2019/04/05
 4:    pdays: 何日後の予定まで考えるか.   60"
 5:   (let ((ii       0)
 6:         (cdate  nil)
 7:         (result nil))
 8:     (unless pdays (setq pdays 0))
 9:     (if (string-match "^%%" sexp) (setq sexp (substring-no-properties sexp 2)))
10:     (catch 'break
11:       (while (< ii (1+ pdays))
12:         (setq cdate  (my-calendar-format-nth-day-after day ii))
13:         (setq result (org-diary-sexp-entry sexp t cdate))
14:         (if result (throw 'break nil))
15:         (incf ii)
16:         ))
17:     (if result
18:         ii ;; 次の予定日まで何日分あるか？を返す.
19:         -1 ;; 見つからなければ -1 を返す.
20:       )
21:     ))
22: 
23: (defun my-calendar-format(dayl)
24:   "dayl = '(50 7 20 12 5 2017 5 nil 32400) 日付リスト形式
25: から calendar-format '(5 12 2017) へ変更する"
26:   (list (nth 4 dayl) (nth 3 dayl) (nth 5 dayl)))
27: 
28: (defun my-calendar-format-nth-day-after(dayl n)
29:   "日付リスト形式の日付 dayl から n(=2) 日目の日付を calendar-format で返す.
30:    dayl='(50 7 20 12 5 2017 5 nil 32400) n=2 の場合
31:   '(5 14 2017) を返す."
32:   (let ((unday (apply #'encode-time dayl)))
33:     (my-calendar-format (decode-time (time-add unday (days-to-time n))))
34:     ))

 1: (defun my-org-diary-float-replace-scheduled-repeat(sch-format next-diff)
 2:   "sch-format= 2019-04-02 Tue
 3: next-diff= 8
 4: のとき, SCHEDULED: の文字列を上の値に置き換える.
 5: SCHEDULED: <2019-04-01 Mon> => SCHEDULED: <2019-04-02 Tue +8d> に置き換え"
 6:   (let (sch-format-with-repeat)
 7:     (if (= next-diff 0) (setq sch-format-with-repeat (format "SCHEDULED: <%s>" sch-format))
 8:       (setq sch-format-with-repeat (format "SCHEDULED: <%s %s>" sch-format (concat "+" (number-to-string next-diff) "d"))))
 9:     (org-back-to-heading)
10:     (re-search-forward "\\(SCHEDULED: <\\(.*?\\)>\\)" (save-excursion (outline-next-heading) (point)))
11:     (replace-match sch-format-with-repeat)
12:     ))

unix-sch-date (UNIX 形式日付)から数えた次のスケジュールについての情報を以下で計算.

 1: (defun my-org-diary-float-get-next-schedule(unix-sch-date sexp)
 2:   "unix-date を引数にして, この日から数えた (次のスケジュールの日付, 追加する日数) を返す
 3: 例: unix-sch-date = <2019-04-01 Mon> (の unix-date 表記)
 4: sexp = %%(diary-habit-weekday '(4 1 2019) 1)    ;; 2019/04/01 からの毎月曜日
 5:      => (list \"2019-04-08 Mon\" 7) が返る"
 6:   (let* (
 7:          ;; 次の日にする.
 8:          (unix-sch-next-date (time-add unix-sch-date (days-to-time 1)))
 9:          ;; 日付リスト形式 (0 0 0 11 3 2019 0 nil 32400) に変換
10:          (lst-sch-next-date (decode-time unix-sch-next-date))
11:          ;; 次のスケジュールまでの日付計算(次の日から計算してるので + 1 を入れておく)
12:          (next-diff (+ 1 (diary-float-to-diff sexp lst-sch-next-date org-gcal-down-days)))
13:          ;; 次のスケジュールの日付
14:          (unix-sch-next-scheduled-date (time-add unix-sch-date (days-to-time next-diff)))
15:          ;; フォーマット変更
16:          (sch-format (format-time-string "%Y-%m-%d %a %H:%M" unix-sch-next-scheduled-date))
17:          )
18:     (list sch-format next-diff) ;; リストで返す
19:     ))

これらの部品を使って…

カーソル上にあるタスクの予定日付と DIARYF の elisp program を見て次の予定との差分を計算し書き出す.

 1: (defun my-org-diary-float-next-schedule-diff()
 2:     "DIARYF: プロパティの diary-float 形式日付(habit)があれば
 3: 読み込んで次回のスケジューリングを行う.
 4: 具体的には, SCHUEDULED: <日付> => SCHEDULED: <日付 +8d> とかにする.
 5: (次の予定が 8 日後にあると diary-float 内の関数で計算された場合の例)"
 6:   (interactive)
 7:   (let (unix-sch-date lst next-diff sch-format sexp)
 8:     (save-excursion
 9:       (end-of-line)
10:       (org-back-to-heading)
11:       (setq sexp (my-org-diary-float-get-sexp))
12:       (if sexp
13:           (progn
14:             (setq unix-sch-date (org-get-scheduled-time (point))) ;;UNIX date
15:             (setq lst (my-org-diary-float-get-next-schedule unix-sch-date sexp))
16:             (setq sch-format (format-time-string "%Y-%m-%d %a %H:%M" unix-sch-date))
17:             (setq next-diff  (nth 1 lst))
18:             (if (string-match " 00:00" sch-format) (setf (substring sch-format (match-beginning 0) (match-end 0)) ""))
19:             (my-org-diary-float-replace-scheduled-repeat sch-format next-diff)
20:             )
21:         )
22:       )
23:     ))

スケジュールされた日と今日を比較して今日の方が新しければスケジュールを今日に変更.

 1: (defun my-org-diary-float-next-schedule-diff-replace-today()
 2:   ":DIARYF: の diary-float 形式日付があれば次回のスケジューリングを行う.
 3: SCHEDULE が <2019-04-01 Mon> で今日が例えば <2019-04-03 Wed> の場合,
 4: つまりスケジューリングされた日付が過去の場合には, スケジュールを今日にする."
 5:   (interactive)
 6:   (let (unix-today unix-sch-date sch-format-today stime ext)
 7:     (save-excursion
 8:       ;; SCHEDULE された日付より今日のほうが新しい場合
 9:       (setq unix-today (current-time))
10:       (setq unix-sch-date (org-get-scheduled-time (point)))
11:       (if (< (float-time unix-sch-date) (float-time unix-today))
12:           (progn
13:             (setq stime (format-time-string "%H:%M" unix-sch-date))
14:             ;; org-extend-today-until よりも時刻が前なら前日にする
15:             (setq unix-today (my-org-diary-float-replace-date-extend-today unix-today))
16:             ;; 時刻は入れ替える
17:             (setq sch-format-today (concat (format-time-string "%Y-%m-%d %a" unix-today) " " stime))
18:             ;; SCHEDULED 日付を今日に変更する
19:             (my-org-diary-float-replace-scheduled-repeat sch-format-today 0)
20:             )
21:         )
22:       ;; 次のスケジュール +nd を作成し直し
23:       (my-org-diary-float-next-schedule-diff)
24:       ;; このあと +nd が計算され次のスケジュール日付に書き換わる
25:       )))
26: 
27: (defun my-org-diary-float-replace-date-extend-today(unix-date)
28:   "unix-date の時刻が 5:00(org-extend-today-until) よりも前だったら, 前の日にやったことにする"
29:   (let (ext)
30:     (if org-extend-today-until
31:         (progn
32:           (setq ext (string-to-number (format-time-string "%H.%M" unix-date)))
33:           ;(y-or-n-p (message "ext=%f" ext))
34:           ;(y-or-n-p (message "extend=%d" org-extend-today-until))
35:           (if (> org-extend-today-until ext)  ;; 5 > 4.50 (unix-date の日時が 4:50 の場合)
36:               ;; 前の日にする
37:               (setq unix-date (time-add unix-date (days-to-time -1)))
38:             )))
39:     unix-date
40:     ))

org-todo の後で計算するように設定.

1: (defadvice org-todo(after my-org-next-todo-migration-automatic-hook)
2:   ""
3:   (let* ((end   (my-org-get-end-head))
4:          (elem  (org-element-headline-parser end t))
5:          (todo  (org-element-property :todo-keyword elem)))
6:     (if (org-element-property :DIARYF elem) (my-org-diary-float-next-schedule-diff-replace-today)) ;; [2019-04-03 Wed]
7:       ))
8: (ad-activate-regexp "my-org-next-todo-migration-automatic-hook")

6 その他

この件で色々調べてるときに, 有用そうな変数を見つけた.
一つはこれ.

(setq org-extend-today-until 5) ;; 05:00 までは前の日扱い

org-extend-today-until を 5 にしておくと, 05:00 までは前の日扱いで処理してくれるらしい.
上のプログラムでもこの値が定義されてるときを考慮した.

このパラメータを設定しとかないと, 夜更かしの人は結構めんどくさいことになる.
例えば, <2019-04-02 Tue +1d> のタスクを <2019-04-03 Wed 1:00> に実行した場合などである.
ここで DONE とすると, 次のスケジュールは <2019-04-04 Thu +1d> となるが, これはやっぱ違うだろーと思うわけである.
こうなってると, <2019-04-03 Wed> 中は org-agenda でこのタスクが見えてこない.
今日の夜もやる筈なのでスケジュールとしては <2019-04-03 Wed +1d> になってて欲しいわけである.
org-extend-today-until に値があれば, この時間までは前の日扱いとなるため, <2019-04-03 Wed 1:00> に DONE とすると <2019-04-02 Tue> にやったこととなり次のスケジュールは <2019-04-03 Wed +1d> となってめでたしめでたしとなる.

もう一つの変数はこれ.

(setq org-use-effective-time t) ;; 05:00 前の timestamp を前日の 25:59 にする.

STYLE: habit でグラフを描いているときなどにいいのではないだろーか.
<2019-04-03 Wed 1:00> に実行し DONE にしたときに, State ログが前日のものになってくれる.

これが設定されてない場合, 繰り返し日付で DONE とすると State ログが書き出されて,

:LOGBOOK:
- State "DONE"       from ""           [2019-04-03 Wed 01:00]
- State "DONE"       from ""           [2019-04-01 Mon 23:30]
:END:

とこんな感じになる.

これを基にグラフが描かれるわけだが, 気持ち的には <2019-04-02 Tue> の夜にやってるつもりなんだけどなーと思うわけである.
次の日とかがこんな感じになってると, ほんとは毎日やってる筈なのにグラフ上では <2019-04-02 Tue> には何もやってない感じが出てしまう.

:LOGBOOK:
- State "DONE"       from ""           [2019-04-03 Wed 23:45]
- State "DONE"       from ""           [2019-04-03 Wed 01:00]
- State "DONE"       from ""           [2019-04-01 Mon 23:30]
:END:

一方, 上の変数 org-use-effective-time が t になってると, ログは以下のようになる.

:LOGBOOK:
- State "DONE"       from ""           [2019-04-03 Wed 23:45]
- State "DONE"       from ""           [2019-04-02 Tue 23:59]  ;; 変わったところ
- State "DONE"       from ""           [2019-04-01 Mon 23:30]
:END:

つまり, org-extend-today-until に指定された時刻の前までは前日の 23:59 にやったことにしてくれる.

7 参考URL

emacs lisp で日付を表示する
 人類滅亡までのカウントダウンを Emacs に表示する
 parse a unix timestamp to date in emacs (elisp)
Elisp: Date Time
逆引き Emacs Lisp 日付と時刻
 40.8 Parsing and Formatting Times
40.7 Time Conversion
40.5 Time of Day

部分文字列を置き換える
 Replace string in buffer programatically

Make agenda clockreport respect org-extend-today-until
org-timeline
Documentation for Org hooks, commands and options