emacs-在org-agenda中展示从今日开始一月后的任务
1. 前言
先前文章：emacs-在org-agenda中展示年度、季度、月度、周度任务
在此基础上，我们这篇文章要解决两个痛点。
一是提升灵活性。先前的代码将搜索的 QUERY 部分写死在了函数中，导致只能展示固定的查询结果。
二是提升时间的相对性。先前的代码搜索出来的内容是互相包含的，月度结果包含周度结果，我们需要有一个排除的办法。
1.1. 提升时间相对性
(defun my/time-add-months (time delta)
"将 TIME 增加 DELTA 个月，若目标日不存在则截断至月末。"
(let* ((dec (decode-time time))
(day (decoded-time-day dec))
(month (decoded-time-month dec))
(year (decoded-time-year dec))
(new-month (+ month delta))
(new-year (+ year (/ (1- new-month) 12)))
(new-month (1+ (mod (1- new-month) 12)))
(last-day (calendar-last-day-of-month new-month new-year)))
(encode-time 0 (decoded-time-minute dec)
(decoded-time-hour dec)
(min day last-day) new-month new-year)))
(defun my/org-ql-ts-period (period)
"根据输入的 PERIOD 返回当前或相对当前时间的起止日期，格式为 'YYYY-MM-DD'。
季节 (Season) 定义:
- 季度1: 1月 - 3月
- 季度2: 4月 - 6月
- 季度3: 7月 - 9月
- 季度4: 10月 - 12月
星期一被视为一周的开始。
支持的 PERIOD 符号：
- 'y' : 当前年（1月1日 ~ 12月31日）
- 's' : 当前季度
- 'm' : 当前月
- 'w' : 当前周（周一 ~ 周日）
- 'ry' : 从今天开始的一年（今天 ~ 今天 + 12个月）
- 'rs' : 从今天开始的一个季度（今天 ~ 今天 + 3个月）
- 'rm' : 从今天开始的一个月（今天 ~ 今天 + 1个月）
- 'rw' : 从今天开始的一周（今天 ~ 今天 + 7天）
参数 PERIOD: 一个表示时间段的符号。
返回: (start-date . end-date) 的 cons，日期字符串为 'YYYY-MM-DD'。
若输入无效则返回错误信息。"
(let* ((now (current-time))
(decoded-time (decode-time now))
(sec (nth 0 decoded-time))
(min (nth 1 decoded-time))
(hour (nth 2 decoded-time))
(day (nth 3 decoded-time))
(month (nth 4 decoded-time))
(year (nth 5 decoded-time))
start-date
end-date)
(cond
;; 年 (Year)
((eq period 'y)
(setq start-date (format-time-string "%Y-01-01"))
(setq end-date (format-time-string "%Y-12-31")))
;; 季 (Season)
((eq period 's)
(let* ((start-month (cond ((<= month 3) 1)
((<= month 6) 4)
((<= month 9) 7)
(t 10)))
(end-month (+ start-month 2))
(end-day (calendar-last-day-of-month end-month year)))
(setq start-date (format-time-string "%Y-%m-01" (encode-time 0 0 0 1 start-month year)))
(setq end-date (format-time-string (format "%%Y-%%m-%d" end-day) (encode-time 0 0 0 end-day end-month year)))))
;; 月 (Month)
((eq period 'm)
(setq start-date (format-time-string "%Y-%m-01"))
(let* ((last-day (calendar-last-day-of-month month year)))
(setq end-date (format-time-string (format "%%Y-%%m-%d" last-day)))))
;; 周 (Week)
((eq period 'w)
(let* ((day-of-week (string-to-number (format-time-string "%u"))) ; 星期一为1，星期日为7
(start-offset (- day-of-week 1))
(end-offset (- 7 day-of-week))
(start-time (time-subtract now (seconds-to-time (* start-offset 24 60 60))))
(end-time (time-add now (seconds-to-time (* end-offset 24 60 60)))))
(setq start-date (format-time-string "%Y-%m-%d" start-time))
(setq end-date (format-time-string "%Y-%m-%d" end-time))))
;; 相对年 (Relative Year)
((eq period 'ry)
(let ((start-time now)
(end-time (time-add now (seconds-to-time (* 365 24 60 60)))))
(setq start-date (format-time-string "%Y-%m-%d" start-time))
(setq end-date (format-time-string "%Y-%m-%d" end-time))))
;; 相对季度 (Relative Season, 3 months)
((eq period 'rs)
(let ((start-time now)
(end-time (my/time-add-months now 3)))
(setq start-date (format-time-string "%Y-%m-%d" start-time))
(setq end-date (format-time-string "%Y-%m-%d" end-time))))
;; 相对月 (Relative Month)
((eq period 'rm)
(let ((start-time now)
(end-time (my/time-add-months now 1)))
(setq start-date (format-time-string "%Y-%m-%d" start-time))
(setq end-date (format-time-string "%Y-%m-%d" end-time))))
;; 相对周 (Relative Week, 7 days)
((eq period 'rw)
(let ((start-time now)
(end-time (time-add now (seconds-to-time (* 7 24 60 60)))))
(setq start-date (format-time-string "%Y-%m-%d" start-time))
(setq end-date (format-time-string "%Y-%m-%d" end-time))))
;; 无效输入
(t (error "无效的参数，请输入 'y', 's', 'm', 'w', 'ry', 'rs', 'rm', 或 'rw'")))
(cons start-date end-date)))
my/time-add-months 函数可以将输入的 TIME 添加 DELTA 个月后返回时间戳。和其他函数不同，这里会采取反向截断的方式。如果你想在8月31日计算1月后时间，其他函数会计算为10月1日（因为9月只有30日），而这个函数会向后截断，返回9月30日。
my/org-ql-ts-period 函数可以根据输入的符号返回以当前时间为准的一对字符串 '(起始时间 结束时间) 。
对应的输入和输出表格如下。
| 输入符号 | 输出的起始时间 | 输出的结束时间 |
|---|---|---|
| 'y | 今年第一天 | 今年最后一天 |
| 's | 本季度第一天 | 本季度最后一天 |
| 'm | 本月第一天 | 本月最后一天 |
| 'w | 本周第一天 | 本周最后一天 |
| 'ry | 当天 | 从当天起往后365天的那天 |
| 'rs | 当天 | 从当天起往后3个月的那天 |
| 'rm | 当天 | 从当天起往后1个月的那天 |
| 'rw | 当天 | 从当天起往后7天的那天 |
1.2. 提升灵活性
为了灵活查询，最好的办法是构造一个函数，使其返回的值能直接在 org-ql-block 的查询中使用。这里我们跟在 :except 后的符号，代表会被排除。
(cl-defun my/org-ql-range (field period &key ((:except except-period)))
"根据 FIELD 和 PERIOD 返回一个 org-ql 查询片段，表示 FIELD 在该周期内。
FIELD 是日期字段符号，如 'deadline、'scheduled、'ts 等。
PERIOD 是周期符号，如 'w、'm、's、'y、'ry、'rs、'rm、'rw。
如果提供 :except EXCEPT-PERIOD，则从主范围中排除该周期。"
(let ((main-range (my/org-ql-ts-period period)))
(if except-period
(let ((except-range (my/org-ql-ts-period except-period)))
`(and (,field :from ,(car main-range) :to ,(cdr main-range))
(not (,field :from ,(car except-range) :to ,(cdr except-range)))))
`(,field :from ,(car main-range) :to ,(cdr main-range)))))
使用例：
(org-ql-block
`((and (todo "TODO" "HOLD") (tags "工作") ,(my/org-ql-range 'deadline 'w))
:sort (deadline scheduled priority)
:header "🎯本周截止🎯" ))
(org-ql-block
`((and (todo "TODO" "HOLD") (tags "工作") ,(my/org-ql-range 'deadline 'rm :except 'w))
:sort (deadline scheduled priority)
:header "🎯未来一月🎯" ))