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))))

>>28,30
I'm just happy using (setf (car x) y) and (setf (cdr x) y), they expand to rplaca/rplacd anyway. I don't remember the exact naming rationale of RPLACA/RPLACD, but I think it was something along the lines of ``RePLAce Contents of the Accumulator/Decrement part.'', which do make some sense if you think of car/cdr's naming, albeit they're both historical artifacts, not that having a better name would be of much benefit: FIRST/REST make sense when you're talking of lists, but cons cells are more general than that (an efficient stucture holding 2 arbitrary pointers can be used for many things).