new file mode 100644

@@ -0,0 +1,4 @@

+;;; Directory Local Variables

+;;; For more information see (info "(emacs) Directory Variables")

+

+((nil . ((fwoar::*package-prefix* . "aion"))))

new file mode 100644

@@ -0,0 +1,2 @@

+*~

+*.*f?sl*

new file mode 100644

@@ -0,0 +1,15 @@

+;;; -*- Mode:Lisp; Syntax:ANSI-Common-Lisp; Package: ASDF-USER -*-

+(in-package :asdf-user)

+

+(defsystem :aion

+  :description ""

+  :author "Ed L <edward@elangley.org>"

+  :license "MIT"

+  :depends-on (:alexandria

+               :uiop

+               :serapeum

+               :fwoar-lisputils)

+  :serial t

+  :components ((:file "packages")

+               (:file "parser")

+               (:file "build-tree")))

new file mode 100644

@@ -0,0 +1,20 @@

+(in-package :aion.build-tree)

+

+(fw.lu:defclass+ build-tree ()

+  ((%history :accessor history :initform ())))

+

+(defmethod handle-begin ((client build-tree) block)

+  (push (list block) (history client)))

+(defmethod handle-end ((client build-tree) block)

+  (progn (when (cdr (history client))

+           (let ((last (pop (history client))))

+             (push (nreverse last)

+                   (car (history client)))))))

+(defmethod handle-property ((client build-tree) tag params content)

+  (push (list tag params content)

+        (car (history client))))

+

+(defun ics->tree (data)

+  (let ((client (build-tree)))

+    (process-ics client data)

+    (nreverse (car (history client)))))

new file mode 100644

@@ -0,0 +1,22 @@

+(defpackage :aion.packages

+  (:use :cl )

+  (:export ))

+(in-package :aion.packages)

+

+(defpackage :aion.parser

+  (:use :cl)

+  (:export #:handle-begin

+           #:handle-end

+           #:handle-property))

+

+(defpackage :aion.build-tree

+  (:use :cl)

+  (:import-from #:aion.parser #:handle-begin #:handle-end

+                #:handle-property #:process-ics)

+  (:export #:ics->tree))

+

+(uiop:define-package :aion

+    (:use)

+  (:import-from :aion.parser #:handle-begin #:handle-end #:handle-property)

+  (:import-from :aion.build-tree #:ics->tree)

+  (:reexport :aion.build-tree :aion.parser))

new file mode 100644

@@ -0,0 +1,85 @@

+(in-package :aion.parser)

+

+(defgeneric handle-begin (client block)

+  (:documentation "handle the beginning of a new block in the iCalendar data"))

+(defgeneric handle-end (client block)

+  (:documentation "handle the ending of a block in the iCalendar data"))

+(defgeneric handle-property (client tag params content)

+  (:documentation "handle a property for the current iCalendar block"))

+

+(defun get-line (stream)

+  (loop for line = (read-line stream nil)

+        while line

+        collect line into results

+        while (eql #\space (peek-char nil stream nil))

+        finally (return (when results

+                          (string-right-trim

+                           '(#\newline #\return)

+                           (serapeum:string-replace-all

+                            #1=#.(coerce (list #\return #\space)

+                                         'string)

+                            (serapeum:string-join results "")

+                            ""))))))

+

+(defmacro with-temporary-keywords ((intern) &body body)

+  (alexandria:with-gensyms (kw-list)

+    `(let ((,kw-list '()))

+       (unwind-protect

+            (flet ((,intern (inp)

+                     (multiple-value-bind (kw existing?)

+                         (alexandria:make-keyword (string-upcase inp))

+                       (prog1 kw

+                         (unless existing?

+                           (push kw ,kw-list))))))

+              ,@body)

+         (mapc 'unintern ,kw-list)))))

+

+(defgeneric as-stream (it)

+  (:method ((it string))

+    (make-string-input-stream it))

+  (:method ((it pathname))

+    (open it))

+  (:method ((it stream))

+    it))

+

+(defun process-ics (client file)

+  (let ((states '()))

+    (with-temporary-keywords (normalize)

+      (labels ((%handle-block-delimiter (tag type)

+                 (push type states)

+                 (ecase tag

+                   ((:begin) (handle-begin client type))

+                   ((:end) (handle-end client type))))

+               (parse-params (inp)

+                 (destructuring-bind (head params) (fwoar.string-utils:partition #\; inp)

+                   (values head

+                           (when params

+                             (map 'list

+                                  (data-lens:• (data-lens:transform-head #'normalize)

+                                               (serapeum:op

+                                                 (fwoar.string-utils:partition #\= _)))

+                                  (fwoar.string-utils:split #\; params))))))

+               (parse-property (it)

+                 (destructuring-bind (s e) (fwoar.string-utils:partition #\: it)

+                   (multiple-value-bind (head params) (parse-params s)

+                     (list (normalize head)

+                           params

+                           e))))

+               (%handle-property (it)

+                 (apply 'handle-property client it))

+               (handle-line (tag tagged line)

+                 (case tag

+                   ((:begin)

+                    (%handle-block-delimiter tag (normalize tagged)))

+                   ((:end)

+                    (%handle-block-delimiter tag (normalize tagged)))

+                   (t (%handle-property (parse-property line))))))

+        (with-open-stream (s (as-stream file))

+          (loop for line = (get-line s)

+                for (tag tagged) = (if line

+                                       (fwoar.string-utils:partition #\: line)

+                                       '(nil nil))

+                while line

+                do (handle-line (fw.lu:may (normalize tag))

+                                tagged

+                                line)))))))