src/interface-utils.lisp

   1 (uiop:define-package #:lw2.interface-utils
   2   (:use #:cl #:lw2.links #:lw2.html-reader)
   3   (:export #:pretty-time #:pretty-time-js #:pretty-time-html
   4            #:pretty-number #:generate-post-auth-link #:clean-lw-link #:votes-to-tooltip #:vote-buttons))
   5
   6 (in-package #:lw2.interface-utils)
   7
   8 (named-readtables:in-readtable html-reader)
   9
  10 (defun pretty-time (timestring &key format loose-parsing)
  11   (let ((time (if loose-parsing
  12                   (chronicity:parse timestring)
  13                   (local-time:parse-timestring timestring))))
  14     (values (local-time:format-timestring nil time :timezone local-time:+utc-zone+ :format (or format '(:day #\  :short-month #\  :year #\  :hour #\: (:min 2) #\  :timezone)))
  15             (* (local-time:timestamp-to-unix time) 1000))))
  16
  17 (defun pretty-time-js ()
  18   "<script async src='data:text/javascript,prettyDate()'></script>")
  19
  20 (defun pretty-time-html (timestring &key inline)
  21   (multiple-value-bind (pretty-time js-time) (pretty-time timestring)
  22     (format *html-output* "<~A class=\"date hide-until-init\" data-js-date=~A>~A~A</~@*~A>"
  23             (if inline "span" "tag")
  24             js-time
  25             pretty-time
  26             (pretty-time-js))))
  27
  28 (defun pretty-number (number &optional object (output-format :html))
  29   (with-output-to-string (*standard-output*)
  30     (when (minusp number)
  31       (write-char #\MINUS_SIGN))
  32     (format t "~:D" (abs number))
  33     (when object
  34       (flet ((write-object () (format t " ~A~P" object number)))
  35         (cond ((eq output-format :html)
  36                (write-string "<span>")
  37                (write-object)
  38                (write-string "</span>"))
  39               (t (write-object)))))))
  40
  41 (defun maybe-need-auth (link need-auth)
  42   (if need-auth
  43       (concatenate 'string link "?need-auth=y")
  44       link))
  45
  46 (define-compiler-macro generate-post-auth-link (post &rest args &key need-auth &allow-other-keys)
  47   `(maybe-need-auth (generate-item-link :post ,post ,@(alexandria:remove-from-plist args :need-auth)) ,need-auth))
  48
  49 (defun generate-post-auth-link (post &rest args &key need-auth &allow-other-keys)
  50   (maybe-need-auth (apply #'generate-item-link :post post :allow-other-keys t args) need-auth))
  51
  52 (defun clean-lw-link (url)
  53   (when url
  54     (ppcre:regex-replace "([^/]*//[^/]*)lesserwrong\.com" url "\\1lesswrong.com")))
  55
  56 (defun votes-to-tooltip (votes)
  57   (if votes
  58       (format nil "~A vote~:*~P"
  59               (typecase votes (integer votes) (list (length votes))))
  60       ""))
  61
  62 (defun vote-buttons (base-score &key (with-buttons t) vote-count post-id af-score as-text)
  63   (labels ((button (vote-type)
  64              (when with-buttons
  65                <button type="button" class=("vote ~A" vote-type) data-vote-type=vote-type data-target-type=(if post-id "Posts" "Comments") tabindex="-1" disabled></button>))
  66            (text ()
  67              (if (and af-score (/= af-score 0))
  68                  (format nil "LW: ~A AF: ~A" base-score af-score)
  69                  (pretty-number base-score "point"))))
  70     (when base-score
  71       (if as-text
  72           (text)
  73           <div class="karma" data-post-id=post-id>
  74             (button "upvote")
  75             <span class="karma-value" title=(votes-to-tooltip vote-count)>(safe (text))</span>
  76             (button "downvote")
  77           </div>))))