;;;-*- Mode: Lisp; Package: HTTP-DEMO -*-

(in-package :http-user)

;
; Image site example
;

(defmacro with-page ((url stream title) &body body)
  "Provides the response function to emit a page body."
  `(with-successful-response (,stream :html)
     (with-html-document (:stream ,stream)
       (with-document-preamble (:stream ,stream)
         (declare-title ,title :stream ,stream))
       (with-document-body (:stream ,stream)
         (with-section-heading (,title :stream ,stream)
           ,@body)))))

(defparameter *images* nil)

(defun display-image-site (url stream)
  "Routine to display an image upload site."
  (with-page (url stream "Images")
    (dolist (pathname *images*)
      (image pathname pathname :stream stream))
    (with-paragraph (:stream stream)
      (with-fillout-form
          (:post url :stream stream :encoding-type '(:multipart :form-data))
        (accept-input 'file "photo" :directory #P"/uploads/" :stream stream)
        (accept-input 'submit-button "SUBMIT" :display-string "Upload" :stream stream)))))

(defun update-image-site (url stream alist)
  "Response function to add an image to the page."
  (capi:display-message "~s" alist)
  (bind-query-values (photo) (url alist)
    (atomic-push (namestring photo) *images*)
  (display-image-site url stream)))

(export-url "http://localhost:8000/uploads/"
            :image-directory
            :pathname #P"/uploads/")

(export-url "http://localhost:8000/images.html"
            :html-computed-form
            :form-function 'display-image-site
            :response-function 'update-image-site)

;; Advanced version

(defun update-image-site (url stream alist)
  "Response function to add an image to the page."
  (destructuring-bind
      (keyword pathname formname 
               (&key upload-filename content-type copy-mode)) 
      (assoc :photo alist)
    (declare (ignore keyword formname upload-filename content-type copy-mode))
    (atomic-push (namestring pathname) *images*)
    (display-image-site url stream)))