Flexible Lisp Blogware. Fork for personal use. Mirrored from https://github.com/kingcons/coleslaw originally.

twitter.lisp 1.9KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950
  1. (:eval-when (:compile-toplevel :load-toplevel)
  2. (ql:quickload :chirp))
  3. (defpackage :coleslaw-twitter
  4. (:use :cl)
  5. (:export #:enable))
  6. (in-package :coleslaw-twitter)
  7. (defvar *tweet-format* '("~A by ~A" coleslaw::post-title coleslaw::post-author)
  8. "Controls what the tweet annoucing the post looks like. It contains a format
  9. control string followed with the accesors to evaluate for post.")
  10. (defun enable (&key api-key api-secret access-token access-secret tweet-format)
  11. (if (and api-key api-secret access-token access-secret)
  12. (setf chirp:*oauth-api-key* api-key
  13. chirp:*oauth-api-secret* api-secret
  14. chirp:*oauth-access-token* access-token
  15. chirp:*oauth-access-secret* access-secret)
  16. (error 'plugin-conf-error :plugin "twitter"
  17. :message "Credentials missing.")
  18. ;; fallback to chirp for credential erros
  19. (chirp:account/verify-credentials))
  20. (when tweet-format
  21. (setf *tweet-format* tweet-format)))
  22. (defmethod render :after (post (eql (find-class 'coleslaw:post)))
  23. (format-post post))
  24. (defun format-post (post)
  25. "Take a post and return a string of 140 character length, at most. Urls have 23 len and are a must."
  26. (chirp:statuses/update (%format-post post)))
  27. (defun %format-post (offset post)
  28. "Garauntee that the tweet content is 140 chars at most."
  29. (let* ((content-prefix (subseq (render-tweet post) 0 (- 117 offset)))
  30. (content (format nil "~A ~A" content-prefix (coleslaw:page-url post)))
  31. (content-length (chirp:compute-status-length content)))
  32. (cond
  33. ((>= 140 content-length) content)
  34. ((< 140 content-length) (%format-post (1- offset) post)))))
  35. (defun render-tweet (post)
  36. "Sans the url, which is a must."
  37. (apply #'format `(nil ,(car *tweet-format*)
  38. ,@(loop
  39. :for accesor in (cdr *tweet-format*)
  40. :collect (funcall accesor post)))))