git.fiddlerwoaroof.com
alimenta-clim.lisp
a757a586
 (defpackage :alimenta-clim
   (:use :clim-lisp :alexandria :serapeum :fw.lu))
 
 (in-package :alimenta-clim)
 
51e19805
 (defclass feed-list (clim:view)
   ((%feeds :initarg :feeds :initform '() :accessor feeds)))
 
 (defmethod initialize-instance :after ((object feed-list) &key feeds)
   (setf (feeds object) (copy-seq feeds)))
 
a757a586
 (defclass feed-view (clim:view) ())
 (defclass item-view (clim:view) ((%item :initarg :item :accessor item)))
 
51e19805
 (defclass feed-url ()
   ((%uri :initarg :uri :reader uri)))
 
 (defmethod displayed-feeds ((feed-list feed-list))
   (feeds feed-list))
 
 (defparameter *feed-list* (make-instance 'feed-list))
a757a586
 (defparameter *feed-view* (make-instance 'feed-view))
 
 (clim:define-application-frame alimenta ()
51e19805
   ((%feed-list :initarg :feed-list :initform (make-instance 'feed-list) :reader feed-list))
   (:menu-bar t)
a757a586
   (:pointer-documentation t)
   (:panes
51e19805
    (feeds :application
           :height 400
2806d56a
           :width 300
51e19805
           :display-function 'display-app
           :default-view (clim:with-application-frame (frame)
                           (feed-list frame)))
    (items :application
           :height 400
2806d56a
           :width  600
51e19805
           :display-function #'display-app
           :default-view *feed-view*)
    (articles :application
              :height 400
2806d56a
              :width  600
51e19805
              :display-function 'display-app
              )
    (int :interactor
         :height 200
         :width 600))
a757a586
   (:layouts
51e19805
    (default (clim:vertically () (clim:horizontally ()
                                   feeds
                                   items
                                   articles)
                              int))  
    (flopped (clim:horizontally () feeds items articles int))))
 
 (defparameter *feeds* '("https://sancrucensis.com/feed/"
                         "https://thomism.wordpress.com/feed/"))
a757a586
 
 (defparameter *articles*
   (let ((errors 0))
     (handler-bind ((simple-error (lambda (c) c
51e19805
                                          (incf errors)
                                          (when (< errors 1000)
                                            (invoke-restart 'alimenta.rss::pop-token)))))
a757a586
       (alimenta.pull-feed:pull-feed "http://planet.lisp.org/rss20.xml" :type :rss))))
 
 (defgeneric display-pane-with-view (frame pane view))
 
51e19805
 (defmethod display-pane-with-view (frame pane view)
   (format pane "~&No content~%"))
 
a757a586
 (defun display-app (frame pane)
   (display-pane-with-view frame pane (clim:stream-default-view pane)))
 
51e19805
 (defmethod display-pane-with-view (frame pane (view feed-list))
   (clim:with-text-style (pane (clim:make-text-style :serif :bold :larger))
     (format pane "Feeds~%"))
   (dolist (feed (displayed-feeds view))
     (clim:with-output-as-presentation (pane feed 'feed-url)
       (format pane "~a~%" (uri feed)))))
 
a757a586
 (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)))))
 
51e19805
 (defun format-content (node)
   (lquery:$ (initialize (alimenta:content node)) "> p" (text)
             (filter (op (string/= "" _)))
             (map (op (trim-whitespace _)))))
 
a757a586
 (defmethod display-pane-with-view (frame pane (view item-view))
51e19805
   ;; (format *xxx* "~&Displaying view~%")
a757a586
   (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)))))
fb2683df
     (let ((text (plump:text (plump:parse (alimenta::content item)))))
a757a586
       (format pane "~&~{~{~a~^ ~}~^~%~}~2&"
               (remove-if #'null
                          (mapcar #'tokens
                                  (split-sequence #\newline
                                                  text)))))))
 
51e19805
 ;; (define-alimenta-command (com-inspect :name t) ()
 ;;   (clouseau:inspector
 ;;    *articles*))
a757a586
 
51e19805
 (define-alimenta-command (com-quit :name t :menu t) ()
a757a586
   (clim:frame-exit clim:*application-frame*))
 
1483b44e
 (defmacro with-interactor ((interactor-symbol) &body body)
   `(let ((,interactor-symbol (clim:find-pane-named clim:*application-frame* 'int)))
      ,@body))
 
51e19805
 (define-alimenta-command (add-feed :name t) ((url string))
   (let ((int (clim:find-pane-named clim:*application-frame* 'int)))
     (push (make-instance 'feed-url :uri url)
           (feeds (feed-list clim:*application-frame*)))
     (format int "~&Added feed ~A~%" url)))
 
 (define-alimenta-command (open-feed :name t) ((url feed-url :gesture :select))
fb2683df
   (let ((int (clim:find-pane-named clim:*application-frame* 'int))
51e19805
         (app (clim:find-pane-named clim:*application-frame* 'items)))
     (setf *articles* (alimenta.pull-feed:pull-feed (uri url)))
fb2683df
     (format int "~&Switching to the feed view~%")
     (setf (clim:stream-default-view app) *feed-view*)))
 
a757a586
 (define-alimenta-command (to-feed :name t) ()
1483b44e
   (let ((int (clim:find-pane-named clim:*application-frame* 'int))
51e19805
         (app (clim:find-pane-named clim:*application-frame* 'items)))
1483b44e
     (format int "~&Switching to the feed view~%")
     (setf (clim:stream-default-view app) *feed-view*)))
a757a586
 
1483b44e
 (define-alimenta-command (com-pick-item :name t) ((item 'alimenta:item :gesture :select))
51e19805
   (let ((pane (clim:find-pane-named clim:*application-frame* 'articles)))
     (format pane "~&ARTICLE PANE~%")
1483b44e
     (with-interactor (int)
       (format int "~&Switching to the item: ")
       (clim:with-output-as-presentation (int item 'alimenta:item)
         (format int "~a" (alimenta:title item)))
       (terpri int))
51e19805
     (setf (clim:stream-default-view pane)
           (make-instance 'item-view :item item))))
a757a586
 
 (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)))))
 
51e19805
 
2806d56a
 
51e19805
 (defun main ()
   (clim:run-frame-top-level
    (clim:make-application-frame 'alimenta-clim::alimenta
                                 :feed-list
                                 (make-instance 'feed-list
2806d56a
                                                :feeds (list 
                                                        (make-instance 'feed-url
                                                                       :uri
                                                                       "http://planet.lisp.org/rss20.xml"))))))