Fix last commit

This commit is contained in:
2026-04-10 12:01:42 -07:00
parent 31a84838ef
commit ce7691d73b

View File

@@ -1,6 +1,5 @@
(eval-when (:compile-toplevel :load-toplevel :execute) (eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload '(with-user-abort chronicity (ql:quickload '(with-user-abort chronicity cl-ppcre adopt uiop) :silent t))
cl-ppcre adopt uiop) :silent t))
(defpackage :khal-notify (defpackage :khal-notify
(:use :cl) (:use :cl)
@@ -25,8 +24,9 @@
(defun get-calendar-dir-hash-table () (defun get-calendar-dir-hash-table ()
(let ((output (make-hash-table :test 'equal))) (let ((output (make-hash-table :test 'equal)))
(dolist (dir (directory #P"~/.local/share/vdirsyncer/*.*/*.*") output) (dolist (dir (directory #P"~/.local/share/vdirsyncer/*/*.*") output)
(unless (pathname-match-p dir #P"~/.local/share/vdirsyncer/status/*.*/") (unless (uiop:subpathp dir (uiop:truename*
#P"~/.local/share/vdirsyncer/status/"))
(let ((dir-name (car (last (pathname-directory dir))))) (let ((dir-name (car (last (pathname-directory dir)))))
(setf (gethash dir-name output) dir)))))) (setf (gethash dir-name output) dir))))))
@@ -72,16 +72,16 @@
current-notice "")) current-notice ""))
((and in-valarm (uiop:string-prefix-p "TRIGGER:" line)) ((and in-valarm (uiop:string-prefix-p "TRIGGER:" line))
(ppcre:register-groups-bind (ppcre:register-groups-bind
(negative (#'parse-integer num) unit) (negative (#'parse-integer num) unit)
(pattern (subseq line 8)) (pattern (subseq line 8))
(setq current-offset (setq current-offset
(* (if (equal negative "-") -1 1) (* (if (equal negative "-") -1 1)
(cond (cond
((equal unit "S") num) ((equal unit "S") num)
((equal unit "M") (* num 60)) ((equal unit "M") (* num 60))
((equal unit "H") (* num 60 60)) ((equal unit "H") (* num 60 60))
((equal unit "D") (* num 60 60 24)) ((equal unit "D") (* num 60 60 24))
(t 0)))))) (t 0))))))
((and in-valarm (uiop:string-prefix-p "DESCRIPTION:" line)) ((and in-valarm (uiop:string-prefix-p "DESCRIPTION:" line))
(setq current-notice (subseq (process-escape-sequences (setq current-notice (subseq (process-escape-sequences
(remove-trailing-return line)) (remove-trailing-return line))
@@ -181,4 +181,4 @@
(defun toplevel () (defun toplevel ()
(sb-ext:disable-debugger) (sb-ext:disable-debugger)
(exit-on-ctrl-c (exit-on-ctrl-c
(main))) (main)))