Update cl/khal-notify.lisp

This commit is contained in:
Alexander Rosenberg 2025-02-11 20:26:30 -08:00
parent ed0b55c3b4
commit 37a87cc34e
Signed by: Zander671
GPG Key ID: 5FD0394ADBD72730

View File

@ -36,6 +36,16 @@
(subseq str 0 (1- len))
str)))
(defun process-escape-sequences (str)
(coerce (loop with escape = nil
for chr across str
when (and (not escape) (eql chr #\\))
do (setq escape t)
else
do (setq escape nil) and
collect chr)
'string))
(defun get-ics-file-alarms (path)
(with-open-file (stream path :direction :input :if-does-not-exist nil)
(when stream
@ -49,7 +59,10 @@
while line
do (cond
((and (not in-valarm) (uiop:string-prefix-p "SUMMARY:" line))
(setq summary (subseq (remove-trailing-return line) 8)))
(setq summary (subseq
(process-escape-sequences
(remove-trailing-return line))
8)))
((uiop:string-prefix-p "BEGIN:VALARM" line)
(setq in-valarm t))
((uiop:string-prefix-p "END:VALARM" line)
@ -59,18 +72,19 @@
current-notice ""))
((and in-valarm (uiop:string-prefix-p "TRIGGER:" line))
(ppcre:register-groups-bind
(negative (#'parse-integer num) unit)
(pattern (subseq line 8))
(setq current-offset
(* (if (equal negative "-") -1 1)
(cond
((equal unit "S") num)
((equal unit "M") (* num 60))
((equal unit "H") (* num 60 60))
((equal unit "D") (* num 60 60 24))
(t 0))))))
(negative (#'parse-integer num) unit)
(pattern (subseq line 8))
(setq current-offset
(* (if (equal negative "-") -1 1)
(cond
((equal unit "S") num)
((equal unit "M") (* num 60))
((equal unit "H") (* num 60 60))
((equal unit "D") (* num 60 60 24))
(t 0))))))
((and in-valarm (uiop:string-prefix-p "DESCRIPTION:" line))
(setq current-notice (subseq (remove-trailing-return line)
(setq current-notice (subseq (process-escape-sequences
(remove-trailing-return line))
12))))
finally (return (mapcar (lambda (alarm)
(list (if (uiop:emptyp (car alarm))
@ -115,7 +129,8 @@
:time alarm-time
:event-title event-title
:event-end end
:uid uid)))) alarms)))))))
:uid uid))))
alarms)))))))
(defun build-alarm-list (calendar-dirs &optional exclude-before)
(let* ((output (run-khal "list"
@ -166,4 +181,4 @@
(defun toplevel ()
(sb-ext:disable-debugger)
(exit-on-ctrl-c
(main)))
(main)))