Code for the Lisp for the Web tutorial by Adam Thornhill

retrogames.lisp

(defmethod vote-for (user-selected-game)
  (incf (votes user-selected-game)))


;;;; A prototypic backend
(defvar *games* '())

(defun game-from-name (name)
  (find name *games*
        :test #'string-equal
        :key #'name))

(defun game-stored? (game-name)
  (game-from-name game-name))

(defun games ()
  (sort (copy-list *games*) #'> :key #'votes))

(defun add-game (name)
  (unless (game-stored? name)
    (push (make-instance 'game :name name) *games*)))

(defmethod print-object ((object game) stream)
  (print-unreadable-object (object stream :type t)
    (with-slots (name votes) object
      (format stream "name: ~s with ~d votes" name votes))))

;;;;; Entering the Web
;;;; Generating HTML dynamically

(setf (html-mode) :html5)

;; (with-html-output (*standard-output* nil :prologue t :indent t)
;;   (:html
;;    (:head
;;     (:title "Test Page"))
;;    (:body
;;     :p "CL-WHO is really easy to use")))

;;;; Macros: Fighting the evils of code duplication
(defmacro standard-page ((&key title) &body body)
  `(with-html-output-to-string
       (*standard-output* nil :prologue t :indent t)
     (:html :lang "en"
            (:head
             (:meta :charset "utf-8")
             (:title ,title)
             (:link :type "text/css"
                    :rel "stylesheet"
                    :href "/retro.css"))
            (:body
             (:div :id "header" ; Retro games header
                   (:img :src "/logo.jpg"
                         :alt "Commodore 64"
                         :class "logo")
                   (:span :class "strapline"
                          "Vote on your favorite Retro Game"))
             ,@body))))

(standard-page (:title "Retro Games")
  (:h1 "Top Retro Games")
  (:p "We'll write the code later..."))

;;;;; More than an opera
;;;; Meet the Hunchentoot web-server
(defun start-server (port)
  (start (make-instance 'easy-acceptor :port port)))

(start-server 8080)

;;;; Publishing content
(push (create-prefix-dispatcher "/retro-games.htm" 'retro-games)
      *dispatch-table*)

(defun retro-games ()
  (standard-page (:title "Retro Games")
    (:h1 "Top Retro Games")
    (:p "Well write the code later...")))

;;;; Putting it together
(define-easy-handler (retro-games :uri "/retro-games") ()
  (standard-page (:title "Retro Games")
    (:h1 "Vote on your all time favourite retro games!")
    (:p "Missing a game? Make it available for votes "
        (:a :href "/new-game" "here"))
    (:h2 "Current stand")
    (:div :id "chart"  ; Used for CSS styling of the links
          (:ol
           (dolist (game (games))
             (htm
              (:li (:a :href (format nil "vote?name=~a"
                                     (escape-string  ; avoid html injections