random-scripts/cl/khal-notify.lisp

(eval-when (:compile-toplevel :load-toplevel :execute)
  (ql:quickload '(with-user-abort chronicity
                  cl-ppcre adopt uiop) :silent t))

(defpackage :khal-notify
  (:use :cl)
  (:export :toplevel))

(in-package :khal-notify)

(defun run-khal (&rest args)
  (multiple-value-bind (out err code)
      (uiop:run-program `("khal" . ,args)
                        :output :string
                        :error-output nil
                        :ignore-error-status t)
    (declare (ignore err))
    (when (= code 0)
      out)))

(defun notify-send (summary content &optional (time 0))
  (uiop:launch-program `("notify-send"
                         "-t" ,(princ-to-string time)
                         ,summary ,content)))

(defun get-calendar-dir-hash-table ()
  (let ((output (make-hash-table :test 'equal)))
    (dolist (dir (directory #P"~/.local/share/vdirsyncer/*/*") output)
      (unless (pathname-match-p dir #P"~/.local/share/vdirsyncer/status/*/")
        (let ((dir-name (car (last (pathname-directory dir)))))
          (setf (gethash dir-name output) dir))))))

(defun remove-trailing-return (str)
  (let ((len (length str)))
    (if (eq (char str (1- len)) #\return)
        (subseq str 0 (1- len))
        str)))

(defun get-ics-file-alarms (path)
  (with-open-file (stream path :direction :input :if-does-not-exist nil)
    (when stream
      (loop for line = (read-line stream nil)
            with in-valarm = nil
            and alarms = '()
            and pattern = (ppcre:create-scanner "(-?)[A-Z]+([0-9]+)([DHSM]).*")
            and summary = ""
            and current-offset = 0
            and current-notice = ""
            while line
            do (cond
                 ((and (not in-valarm) (uiop:string-prefix-p "SUMMARY:" line))
                  (setq summary (subseq (remove-trailing-return line) 8)))
                 ((uiop:string-prefix-p "BEGIN:VALARM" line)
                  (setq in-valarm t))
                 ((uiop:string-prefix-p "END:VALARM" line)
                  (pushnew (cons current-notice current-offset) alarms)
                  (setq in-valarm nil
                        current-offset 0
                        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))))))
                 ((and in-valarm (uiop:string-prefix-p "DESCRIPTION:" line))
                  (setq current-notice (subseq (remove-trailing-return line)
                                               12))))
            finally (return (mapcar (lambda (alarm)
                                      (list (if (uiop:emptyp (car alarm))
                                                summary
                                                (car alarm))
                                            (cdr alarm)
                                            summary)) alarms))))))

(defstruct cal-alarm
  hash uid time title event-title event-end)

(defun parse-event-line (calendar-dirs line &optional exclude-before)
  (unless (uiop:emptyp line)
    (destructuring-bind
        (uid calendar start-date start-time end-date end-time &optional alarm-sym)
        (uiop:split-string line :separator " ")
      (when alarm-sym
        (let* ((start (chronicity:parse (concatenate 'string
                                                     start-date
                                                     " "
                                                     start-time)))
               (end (chronicity:parse (concatenate 'string
                                                   end-date
                                                   " "
                                                   end-time)))
               (file (merge-pathnames (concatenate 'string uid ".ics")
                                      (gethash calendar calendar-dirs)))
               (alarms (get-ics-file-alarms file)))
          (when (or (not exclude-before)
                    (local-time:timestamp>= end exclude-before))
            (mapcar (lambda (alarm)
                      (destructuring-bind (title offset event-title) alarm
                        (let ((alarm-time (local-time:timestamp+ start
                                                                 offset :sec)))
                          (make-cal-alarm :hash (format nil "~A~A~A~A~A"
                                                        title
                                                        alarm-time
                                                        event-title
                                                        end
                                                        uid)
                                          :title title
                                          :time alarm-time
                                          :event-title event-title
                                          :event-end end
                                          :uid uid)))) alarms)))))))

(defun build-alarm-list (calendar-dirs &optional exclude-before)
  (let* ((output (run-khal "list"
                           "--day-format"
                           ""
                           "--format"
                           "{uid} {calendar} {start-date} {start-time} {end-date} {end-time}{alarm-symbol}"
                           "today"
                           "tomorrow"))
         (lines (uiop:split-string output :separator '(#\newline)))
         (result '()))
    (dolist (line lines result)
      (uiop:if-let ((alarms (parse-event-line calendar-dirs line exclude-before)))
        (setq result (concatenate 'list result alarms))))))

(defun main ()
  (let* ((calendar-dirs (get-calendar-dir-hash-table))
         (already-notified (make-hash-table :test 'equal))
         (program-start-now (local-time:now))
         (alarms (build-alarm-list calendar-dirs program-start-now))
         (last-update (local-time:now)))
    (loop 
      (let ((now (local-time:now)))
        (when (local-time:timestamp<= (local-time:timestamp+ last-update 1 :minute)
                                      now)
          (setq alarms (build-alarm-list calendar-dirs program-start-now))
          (let ((new-notified (make-hash-table :test 'equal)))
            (dolist (alarm alarms)
              (when (gethash (cal-alarm-hash alarm) already-notified)
                (setf (gethash (cal-alarm-hash alarm) new-notified) t)))
            (setq already-notified new-notified
                  last-update (local-time:now))))
        (dolist (alarm alarms)
          (when (and (not (gethash (cal-alarm-hash alarm) already-notified))
                     (local-time:timestamp<= (cal-alarm-time alarm) now))
            (notify-send (concatenate 'string
                                      "Alarm for "
                                      (cal-alarm-event-title alarm))
                         (cal-alarm-title alarm))
            (setf (gethash (cal-alarm-hash alarm) already-notified) t)))
        (sleep 10)))))

;; interface
(defmacro exit-on-ctrl-c (&body body)
  `(handler-case (with-user-abort:with-user-abort (progn ,@body))
     (with-user-abort:user-abort () (adopt:exit 130))))

(defun toplevel ()
  (sb-ext:disable-debugger)
  (exit-on-ctrl-c
    (main)))