new file mode 100644

@@ -0,0 +1,88 @@

+(defpackage :alimenta-clim

+  (:use :clim-lisp :alexandria :serapeum :fw.lu))

+

+(in-package :alimenta-clim)

+

+(defclass feed-view (clim:view) ())

+(defclass item-view (clim:view) ((%item :initarg :item :accessor item)))

+

+(defparameter *feed-view* (make-instance 'feed-view))

+

+(clim:define-application-frame alimenta ()

+  ()

+  (:pointer-documentation t)

+  (:panes

+    (app :application

+         :height 500

+         :width  500

+         :display-function #'display-app

+         :default-view *feed-view*)

+    (int :interactor

+         :height 500

+         :width 500))

+  (:layouts

+    (default (clim:vertically () app int))  

+    (flopped (clim:horizontally () app int))))

+

+(defparameter *articles*

+  (let ((errors 0))

+    (handler-bind ((simple-error (lambda (c) c

+                                   (incf errors)

+                                   (when (< errors 1000)

+                                     (invoke-restart 'alimenta.rss::pop-token)))))

+      (alimenta.pull-feed:pull-feed "http://planet.lisp.org/rss20.xml" :type :rss))))

+

+(defgeneric display-pane-with-view (frame pane view))

+

+(defun display-app (frame pane)

+  (display-pane-with-view frame pane (clim:stream-default-view pane)))

+

+(defmethod display-pane-with-view (frame pane (view feed-view))

+  (clim:with-text-style (pane (clim:make-text-style :serif :bold :larger))

+    (format pane "~a <~a>~%"

+            (alimenta::title *articles*)

+            (alimenta::link *articles*)))

+  (dolist (item (alimenta::items *articles*))

+    (clim:with-output-as-presentation (pane item 'alimenta:item)

+      (format pane "~a~%" (alimenta::title item)))))

+

+(defmethod display-pane-with-view (frame pane (view item-view))

+  (let ((item (item view)))

+    (with-accessors ((title alimenta::title)) item

+      (clim:with-output-as-presentation (pane item 'alimenta:item)

+        (clim:with-text-style (pane (clim:make-text-style :serif :bold :larger))

+          (format pane "~a <~a>~%"

+                  (alimenta::title item)

+                  (alimenta::link item)))))

+    (let ((text (funcall (compose #'plump:text #'plump:parse)

+                         (alimenta::content item))))

+      (format pane "~&~{~{~a~^ ~}~^~%~}~2&"

+              (remove-if #'null

+                         (mapcar #'tokens

+                                 (split-sequence #\newline

+                                                 text)))))))

+

+(define-alimenta-command (com-inspect :name t) ()

+  (clouseau:inspector

+    *articles*))

+

+(define-alimenta-command (com-quite :name t) ()

+  (clim:frame-exit clim:*application-frame*))

+

+(define-alimenta-command (to-feed :name t) ()

+  (let ((pane (clim:find-pane-named clim:*application-frame* 'app)))

+    (setf (clim:stream-default-view pane) *feed-view*)))

+

+(define-alimenta-command (com-pick-item :name t) ((item 'alimenta:item))

+  (let ((pane (clim:find-pane-named clim:*application-frame* 'app)))

+    (setf (clim:stream-default-view pane) (make-instance 'item-view :item item))))

+

+(define-alimenta-command (flop-layout :name t) ()

+  (let ((old-view (clim:frame-current-layout clim:*application-frame*)))

+    (setf (clim:frame-current-layout clim:*application-frame*)

+          (case old-view

+            ('default  'flopped)

+            (t 'default)))))

+

+(clim:run-frame-top-level

+  (clim:make-application-frame 'alimenta-clim::alimenta))

@@ -1,3 +1,4 @@

+(in-package :cl-user)

 (ql:quickload :clack)

 (ql:quickload :ningle )

 (ql:quickload :araneus)

@@ -23,22 +24,39 @@

        :padding "1em")

     `(div.articles

-       :display "flex"

+       :display "block"

        :flex-flow "row"

        :flex-wrap "wrap-reverse"

        :align-items "baseline"

        :justify-content "space-around"

        :align-content "space-between"

+

        )

     `(article

        :padding "1em"

        :border "4px double #888"

        :vertical-align "middle"

-       :width "30%"

+       :width "100%"

        :overflow "hidden"

        :min-height "4em"

        :background "#aaa"

+

+       (div.title

+         :float "left"

+         :width "50%")

+

+       (a.link

+         :float "left"

+         :clear "left"

+         :width "50%")

+

+       (div.content

+         :margin-top "-3em"

+         :padding-right "5em"

+         :float "right"

+         :width "50%")

+

        )

     ))

@@ -73,7 +91,8 @@

                     do (araneus:view 'root item)))))))))

 (araneus:define-controller root (params)

-  (let* ((url "http://reddit.com/r/programming.rss")

+  (declare (optimize (debug 3)))

+  (let* ((url "http://reddit.com/r/prolog.rss")

          (feed (alimenta.pull-feed::fetch-doc-from-url url)))

     (alimenta:to-feed feed :feed-link url)))

@@ -82,7 +101,7 @@

     (:content-type "application/xml+atom")

     (,(concatenate 'string

                "<?xml version=\"1.0\"?>"

-               (plump:serialize (alimenta:generate-xml feed :feed-type :atom)

+               (plump:serialize (alimenta:generate-xml feed :atom)

                    nil)))))

 (araneus:define-view feed-to-rss (feed)

@@ -90,14 +109,14 @@

     (:content-type "application/xml+rss")

     (,(concatenate 'string

                "<?xml version=\"1.0\"?>"

-               (plump:serialize (alimenta:generate-xml feed :feed-type :rss)

+               (plump:serialize (alimenta:generate-xml feed :rss)

                    nil)))))

-(defvar *app* (make-instance 'ningle:<app>))

+(defparameter *app* (make-instance 'ningle:<app>))

 (araneus:defroutes *app*

   (("/") (araneus:as-route 'root))

   (("/.rss") (araneus::compose-route (root) feed-to-rss)) 

   (("/.atom") (araneus::compose-route (root) feed-to-atom)))

-(defvar *handler* (clack:clackup *app* :port 9090 ))

+(defparameter *handler* (clack:clackup *app* :port 9091 ))