4chan CL interface


; incomplete

(defvar +DEFAULT-SERVER+ "dis")
(defvar +DEFAULT-BOARD+ "prog")

(defstruct post-profile
  (name "Anonymous" :type string)
  (e-mail "" :type string)
  (signature (lambda (&optional profile) (declare (ignore profile))))
  (post-count 0)
  (posts ()))

(defvar *default-post-profile*
  (make-post-profile))                                                                                                                                                             

(defun thread-info (line)
  "Return the information extracted from subject.txt"
  (remove-if (lambda (x)
               (zerop (length x)))
             (cl-ppcre:split "<>" line)))

(defun num-to-str (num)
  (if (stringp num)
      num
      (write-to-string num)))

(defmacro with-thread ((&rest names) line &body body)
  `(destructuring-bind `,(,@names &rest ,(gensym))
       (thread-info ,line)
     ,@body))

(defun server-link (&optional (server +DEFAULT-SERVER+) (domain "4chan.org"))
  "Return link to a suitable HTTP link to the domain/ip"
  (concatenate 'string
               "http://" server "." domain))

(defun thread-link (&key (id nil) (server +DEFAULT-SERVER+)
                    (bbs +DEFAULT-BOARD+) (post-number ""))
  (concatenate 'string
               (server-link server)
               (if id
                   (concatenate 'string
                                "read/" bbs "/" id "/"
                                (num-to-str post-number))
                   (concatenate 'string "/" bbs))))

(defmacro 4chan-post (bbs id name e-mail comment &optional subject)
  (if subject
      `'(("bbs" . ,bbs)
         ("id" . ,id)
         ("schiichan" . "proper2")
         ("subj" . ,subject)
         ("kotehan" . ,name)
         ("meiru" . ,e-mail)
         ("com" . ,comment))
      `'(("bbs" . ,bbs)
         ("id" . ,(num-to-str id))
         ("schiichan" . "proper2")
         ("kotehan" . ,name)
         ("meiru" . ,e-mail)
         ("com" . ,comment))))

(defun new-comment (id comment &key (bbs +DEFAULT-BOARD+)
                    (server +DEFAULT-SERVER+) (post-profile *default-post-profile*))
  "Make a new comment (post)."
  (declare (ignore bbs post-profile id comment))
  (drakma:http-request (concatenate 'string
                                    (server-link server)
                                    "/post")
                       :method :post
                       :content-length t
                       :parameters
                       (4chan-post bbs id
                                   (post-profile-name post-profile)
                                   (post-profile-e-mail post-profile)
                                   (concatenate 'string
                                                comment
                                                (funcall post-profile-signature
                                                         post-profile)))))

(defun new-thread (subject comment &key (bbs +DEFAULT-BOARD+)
                   (server +DEFAULT-SERVER+) (post-profile *default-post-profile*))
  (declare (ignore bbs post-profile comment subject))
  (let ((index-page (get-page)))
    (declare (ignore index-page))
    (drakma:http-request (concatenate 'string
                                      (server-link server)
                                      "/post")
                         :method :post
                         :content-length t
                         :parameters
                         (4chan-post bbs index-page
                                     (post-profile-name post-profile)
                                     (post-profile-e-mail post-profile)
                                     comment subject))))

>>27
I actually understand memq, memv, assq, etc. because they are specialisations of slightly more sensibly named functions like member and assoc, but I will never understand why they chose RPLACA and RPLACD.

>>29
I'll get there, but I'm sure as hell redefining them to set-car! and set-cdr!