Sources/OrgCore/Agenda/DiarySexp.swift
285 lines · 15131 bytes
1import Foundation
2
3/// Diary sexps, `%%(…)` lines and `<%%(…)>` timestamps: `org-diary-sexp-entry` with the
4/// calendar, diary-lib and org functions agenda files use. A sexp that uses anything else, or
5/// signals an error, doesn't apply, as Emacs reports a bad sexp and moves on.
6public enum DiarySexp {
7 /// The entries `sexp` gives on `day` for a diary line whose text is `entry`, or nil where
8 /// it doesn't apply.
9 public static func entries(_ sexp: Sexp, entry: String, day: Int) -> [String]? {
10 let lisp = interpreter(day: day, entry: entry)
11 guard let result = try? lisp.eval(sexp), !Elisp.isNil(result) else { return nil }
12 switch result {
13 case .string(let s): return s.components(separatedBy: "; ")
14 case .dotted(let items, .string(let s)) where items.count == 1: return [s]
15 case .list(let items) where items.first?.string != nil: return items.map { Elisp.printed($0) }
16 default: return [entry]
17 }
18 }
19
20 /// Whether `sexp` applies on `day`, for diary timestamps.
21 public static func matches(_ sexp: Sexp, day: Int) -> Bool {
22 entries(sexp, entry: "", day: day) != nil
23 }
24
25 static func interpreter(day: Int, entry: String) -> Elisp {
26 let lisp = Elisp()
27 lisp.set("date", gregorian(day))
28 lisp.set("entry", .string(entry))
29 lisp.set("calendar-date-style", .symbol("american"))
30 define(lisp)
31 return lisp
32 }
33
34 /// `(MONTH DAY YEAR)`.
35 static func gregorian(_ day: Int) -> Sexp {
36 let date = Days.date(day)
37 return .list([.integer(date.month), .integer(date.day), .integer(date.year)])
38 }
39
40 /// A number from Lisp used in date arithmetic, within what that arithmetic handles.
41 static func bounded(_ v: Sexp) throws -> Int {
42 let i = try Elisp.int(v)
43 guard (-100_000_000...100_000_000).contains(i) else { throw Elisp.Unsupported(what: "date number \(i)") }
44 return i
45 }
46
47 static func parts(_ date: Sexp) throws -> (month: Int, day: Int, year: Int) {
48 let items = try Elisp.elements(date)
49 guard items.count == 3 else { throw Elisp.Signal(message: "Bad date \(date.description)") }
50 return (try bounded(items[0]), try bounded(items[1]), try bounded(items[2]))
51 }
52
53 static func absolute(_ date: Sexp) throws -> Int {
54 let d = try parts(date)
55 return Days.absolute(year: d.year, month: d.month, day: d.day)
56 }
57
58 static func isLeap(_ year: Int) -> Bool { year % 4 == 0 && (year % 100 != 0 || year % 400 == 0) }
59
60 static func lastDay(month: Int, year: Int) throws -> Int {
61 guard (1...12).contains(month) else { throw Elisp.Signal(message: "Args out of range: \(month)") }
62 return month == 2 ? (isLeap(year) ? 29 : 28) : [31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31][month - 1]
63 }
64
65 /// `calendar-nth-named-absday`.
66 static func nthNamedAbsday(_ n: Int, _ dayname: Int, _ month: Int, _ year: Int, _ day: Int?) throws -> Int {
67 func onOrBefore(_ date: Int) -> Int { date - (date - dayname) % 7 }
68 if n > 0 {
69 return 7 * (n - 1) + onOrBefore(6 + Days.absolute(year: year, month: month, day: day ?? 1))
70 }
71 return 7 * (n + 1) + onOrBefore(Days.absolute(year: year, month: month, day: try day ?? lastDay(month: month, year: year)))
72 }
73
74 /// `diary-ordinal-suffix`.
75 static func ordinalSuffix(_ n: Int) throws -> String {
76 if [11, 12, 13].contains(n % 100) || 3 < n % 10 { return "th" }
77 guard n % 10 >= 0 else { throw Elisp.Signal(message: "Args out of range") }
78 return ["th", "st", "nd", "rd"][n % 10]
79 }
80
81 /// `diary-make-date`: arguments in `calendar-date-style` order, as `(MONTH DAY YEAR)`.
82 static func makeDate(_ lisp: Elisp, _ a: Sexp, _ b: Sexp, _ c: Sexp) throws -> [Sexp] {
83 switch try lisp.value("calendar-date-style") {
84 case .symbol("iso"): [b, c, a]
85 case .symbol("european"): [b, a, c]
86 default: [a, b, c]
87 }
88 }
89
90 /// Runs `body` with `calendar-date-style` bound to `iso`, as the `org-` wrappers do.
91 static func iso(_ lisp: Elisp, _ body: () throws -> Sexp) rethrows -> Sexp {
92 try lisp.binding(["calendar-date-style": .symbol("iso")], body)
93 }
94
95 static func optional(_ args: [Sexp], _ i: Int) -> Sexp { i < args.count ? args[i] : .nil }
96
97 static func define(_ lisp: Elisp) {
98 func date() throws -> Sexp { try lisp.value("date") }
99 func entry() throws -> Sexp { try lisp.value("entry") }
100 func arity(_ args: [Sexp], _ range: ClosedRange<Int>, _ name: String) throws {
101 try Elisp.arity(args, range, name)
102 }
103
104 lisp.define("calendar-extract-month") { _, args in try arity(args, 1...1, "calendar-extract-month"); return .integer(try parts(args[0]).month) }
105 lisp.define("calendar-extract-day") { _, args in try arity(args, 1...1, "calendar-extract-day"); return .integer(try parts(args[0]).day) }
106 lisp.define("calendar-extract-year") { _, args in try arity(args, 1...1, "calendar-extract-year"); return .integer(try parts(args[0]).year) }
107 lisp.define("calendar-absolute-from-gregorian") { _, args in
108 try arity(args, 1...1, "calendar-absolute-from-gregorian")
109 return .integer(try absolute(args[0]))
110 }
111 lisp.define("calendar-gregorian-from-absolute") { _, args in
112 try arity(args, 1...1, "calendar-gregorian-from-absolute")
113 return gregorian(try bounded(args[0]))
114 }
115 lisp.define("calendar-day-of-week") { _, args in
116 try arity(args, 1...1, "calendar-day-of-week")
117 return .integer(Days.weekday(try absolute(args[0])))
118 }
119 lisp.define("calendar-leap-year-p") { _, args in
120 try arity(args, 1...1, "calendar-leap-year-p")
121 return Elisp.bool(isLeap(try Elisp.int(args[0])))
122 }
123 lisp.define("calendar-last-day-of-month") { _, args in
124 try arity(args, 2...2, "calendar-last-day-of-month")
125 return .integer(try lastDay(month: try bounded(args[0]), year: try bounded(args[1])))
126 }
127 lisp.define("calendar-date-equal") { _, args in
128 try arity(args, 2...2, "calendar-date-equal")
129 let a = try parts(args[0])
130 let b = try parts(args[1])
131 return Elisp.bool(a == b)
132 }
133 lisp.define("calendar-day-number") { _, args in
134 try arity(args, 1...1, "calendar-day-number")
135 let d = try parts(args[0])
136 return .integer(Days.absolute(year: d.year, month: d.month, day: d.day) - Days.absolute(year: d.year, month: 1, day: 0))
137 }
138 lisp.define("calendar-nth-named-absday") { _, args in
139 try arity(args, 4...5, "calendar-nth-named-absday")
140 let day = Elisp.isNil(optional(args, 4)) ? nil : try bounded(args[4])
141 return .integer(try nthNamedAbsday(try bounded(args[0]), try bounded(args[1]), try bounded(args[2]), try bounded(args[3]), day))
142 }
143 lisp.define("calendar-nth-named-day") { lisp, args in
144 gregorian(try bounded(try lisp.callNamed("calendar-nth-named-absday", args)))
145 }
146 lisp.define("calendar-iso-from-absolute") { _, args in
147 try arity(args, 1...1, "calendar-iso-from-absolute")
148 let day = try bounded(args[0])
149 let thursday = day - (Days.weekday(day) + 6) % 7 + 3
150 return .list([.integer(Days.isoWeek(day)), .integer(Days.weekday(day)), .integer(Days.date(thursday).year)])
151 }
152
153 lisp.define("diary-ordinal-suffix") { _, args in
154 try arity(args, 1...1, "diary-ordinal-suffix")
155 return .string(try ordinalSuffix(try Elisp.int(args[0])))
156 }
157 lisp.define("diary-make-date") { lisp, args in
158 try arity(args, 3...3, "diary-make-date")
159 return .list(try makeDate(lisp, args[0], args[1], args[2]))
160 }
161 lisp.define("diary-date") { lisp, args in
162 try arity(args, 3...4, "diary-date")
163 let wanted = try makeDate(lisp, args[0], args[1], args[2])
164 let d = try parts(try date())
165 for (spec, actual) in zip(wanted, [d.month, d.day, d.year]) {
166 let holds = switch spec {
167 case .symbol("t"): true
168 case .list(let items): items.contains(.integer(actual))
169 case .integer(let i): i == actual
170 default: false
171 }
172 if !holds { return .nil }
173 }
174 return Elisp.cons(optional(args, 3), try entry())
175 }
176 lisp.define("diary-block") { lisp, args in
177 try arity(args, 6...7, "diary-block")
178 let first = try absolute(.list(try makeDate(lisp, args[0], args[1], args[2])))
179 let last = try absolute(.list(try makeDate(lisp, args[3], args[4], args[5])))
180 let d = try absolute(try date())
181 return first <= d && d <= last ? Elisp.cons(optional(args, 6), try entry()) : .nil
182 }
183 lisp.define("diary-float") { _, args in
184 try arity(args, 3...5, "diary-float")
185 let month = args[0]
186 let dayname = try bounded(args[1])
187 let n = try bounded(args[2])
188 let day = Elisp.isNil(optional(args, 3)) ? nil : try bounded(args[3])
189 let current = try absolute(try date())
190 guard dayname == Days.weekday(current) else { return .nil }
191 let d = Days.date(current)
192 let limit = try nthNamedAbsday(-n, dayname, d.month, d.year, d.day)
193 let lastAbs = n > 0 ? limit : limit + 6
194 let firstAbs = n > 0 ? limit - 6 : limit
195 let first = Days.date(firstAbs)
196 let last = Days.date(lastAbs)
197 func monthMatches(_ m: Int) -> Bool {
198 switch month {
199 case .symbol("t"): true
200 case .list(let items): items.contains(.integer(m))
201 case .integer(let i): i == m
202 default: false
203 }
204 }
205 func base(_ m: Int, _ y: Int) throws -> Int { try day ?? (n > 0 ? 1 : lastDay(month: m, year: y)) }
206 let applies: Bool
207 if first.month == last.month {
208 let b = try base(first.month, first.year)
209 applies = monthMatches(first.month) && first.day <= b && b <= last.day
210 } else {
211 let firstBase = try base(first.month, first.year)
212 let lastBase = try base(last.month, last.year)
213 applies = (first.year < last.year || (first.year == last.year && first.month < last.month))
214 && ((monthMatches(first.month) && first.day <= firstBase) || (monthMatches(last.month) && lastBase <= last.day))
215 }
216 return applies ? Elisp.cons(optional(args, 4), try entry()) : .nil
217 }
218 lisp.define("diary-anniversary") { lisp, args in
219 try arity(args, 2...4, "diary-anniversary")
220 let made = try makeDate(lisp, args[0], args[1], optional(args, 2))
221 var dd = try bounded(made[1])
222 var mm = try bounded(made[0])
223 let y = try parts(try date()).year
224 let diff = Elisp.isNil(made[2]) ? 100 : y - (try bounded(made[2]))
225 if mm == 2, dd == 29, !isLeap(y) {
226 mm = 3
227 dd = 1
228 }
229 let d = try parts(try date())
230 guard diff > 0, (mm, dd, y) == (d.month, d.day, d.year) else { return .nil }
231 return Elisp.cons(optional(args, 3), .string(try Elisp.format([try entry(), .integer(diff), .string(try ordinalSuffix(diff))])))
232 }
233 lisp.define("diary-cyclic") { lisp, args in
234 try arity(args, 4...5, "diary-cyclic")
235 let n = try Elisp.int(args[0])
236 guard n > 0 else { throw Elisp.Signal(message: "Day count must be positive") }
237 let diff = try absolute(try date()) - (try absolute(.list(try makeDate(lisp, args[1], args[2], args[3]))))
238 let cycle = diff / n
239 guard diff >= 0, diff % n == 0 else { return .nil }
240 return Elisp.cons(optional(args, 4), .string(try Elisp.format([try entry(), .integer(cycle), .string(try ordinalSuffix(cycle))])))
241 }
242 lisp.define("diary-remind") { lisp, args in
243 try arity(args, 2...3, "diary-remind")
244 var days = args[1]
245 if case .integer(let n) = days, n < 0 {
246 guard n >= -Elisp.lengthLimit else { throw Elisp.Signal(message: "Too many days for diary-remind") }
247 days = Elisp.list((1...(-n)).map { .integer($0) })
248 }
249 func remind(_ days: Sexp) throws -> Sexp {
250 let applies = try lisp.eval(args[0])
251 if !Elisp.isNil(applies) { return applies }
252 if case .integer(let n) = days {
253 let shifted = gregorian(try absolute(try date()) + (try bounded(.integer(n))))
254 var found = try lisp.binding(["date": shifted]) { try lisp.eval(args[0]) }
255 guard !Elisp.isNil(found) else { return .nil }
256 if case .dotted = found { found = try Elisp.cdr(found) } else if case .list = found { found = try Elisp.cdr(found) }
257 let span = n % 7 == 0 ? String(format: "%d week%@", n / 7, n == 7 ? "" : "s") : String(format: "%d day%@", n, n == 1 ? "" : "s")
258 return .string("Reminder: Only " + span + " until " + Elisp.printed(found))
259 }
260 guard case .list(let items) = days, let first = items.first else { return .nil }
261 let head = try remind(first)
262 return Elisp.isNil(head) ? try remind(Elisp.list(Array(items.dropFirst()))) : head
263 }
264 return try remind(days)
265 }
266
267 lisp.define("org-anniversary") { lisp, args in try iso(lisp) { try lisp.callNamed("diary-anniversary", args) } }
268 lisp.define("org-cyclic") { lisp, args in try iso(lisp) { try lisp.callNamed("diary-cyclic", args) } }
269 lisp.define("org-block") { lisp, args in try iso(lisp) { try lisp.callNamed("diary-block", args) } }
270 lisp.define("org-date") { lisp, args in try iso(lisp) { try lisp.callNamed("diary-date", args) } }
271 lisp.define("org-class") { _, args in
272 try arity(args, 7...Int.max, "org-class")
273 let ints = try args.prefix(7).map(bounded)
274 let first = Days.absolute(year: ints[0], month: ints[1], day: ints[2])
275 let last = Days.absolute(year: ints[3], month: ints[4], day: ints[5])
276 let d = try absolute(try date())
277 let skip = Array(args.dropFirst(7))
278 // Holiday names and `holidays' need the calendar's holiday lists.
279 guard skip.allSatisfy({ $0.integer != nil }) else { throw Elisp.Unsupported(what: "org-class holidays") }
280 let week = Days.isoWeek(d)
281 guard first <= d, d <= last, Days.weekday(d) == ints[6], !skip.contains(.integer(week)) else { return .nil }
282 return try entry()
283 }
284 }
285}