src/blog/feed.lisp teepeedee2-test.asd @@ -22,13 +22,23 @@ (my set-page)) me) +(my-defun blog ready-entries (&key (start 0)) + (subseq (remove-if-not 'entry-ready (my entries)) start)) + +(my-defun blog feed-url () + (byte-vector-cat (my link-base) "feed.atom")) + (my-defun blog set-page () (with-site ((my site)) + (defpage-lambda (my feed-url) + (lambda () + (my feed))) + (defpage-lambda (my link-base) (lambda(&key n) - (webapp (my name) + (webapp ((my name) :head-contents (<link :rel "alternate" :type "application/atom+xml" :href (my feed-url))) (let ((n (byte-vector-parse-integer n))) - (let ((entries (subseq (remove-if-not 'entry-ready (my entries)) n)) (count 10)) + (let ((entries (my ready-entries :start n)) (count 10)) (<div :class "blog" (loop while entries repeat count @@ -40,3 +50,7 @@ (<p :class "next-entries" (<a :href (page-link (my link-base) :n (force-byte-vector (+ n count))) "More entries")))))))) ((n (force-byte-vector 0)))))) +(my-defun blog last-updated () + (loop for e in (my entries) + when (entry-ready e) + maximizing (entry-time e))) \ No newline at end of file src/blog/blog.lisp @@ -37,9 +37,8 @@ (defun time-string (&optional (ut (get-universal-time))) (multiple-value-bind - (second minute hour date month year day daylight-p zone) + (second minute hour date month year) (decode-universal-time ut 0) - (declare (ignore day daylight-p zone)) (format nil "~4,'0D-~2,'0D-~2,'0D ~2,'0D:~2,'0D:~2,'0D GMT" year month date hour minute second))) (my-defun entry filename () @@ -104,7 +103,7 @@ (with-site ((its site (my blog))) (defpage-lambda (my url-path) (lambda() - (webapp (my combined-title) + (webapp ((my combined-title)) (output-object-to-ml me)))))) (my-defun entry read-paragraphs-from-buffer (buffer) src/blog/entry.lisp @@ -1,7 +1,7 @@ (in-package #:tpd2.game) (eval-always - (defconstant +suits+ '(:clubs :hearts :spades :diamonds)) + (define-constant +suits+ '(:clubs :hearts :spades :diamonds) :test 'equal) (defconstant +cards-per-suit+ 13)) (defstruct card src/game/card.lisp @@ -14,7 +14,6 @@ (with-sendbuf (response) "HTTP/1.1 " code " " banner +newline+ "Content-Length: " (sendbuf-len body) +newline+ - "Content-Type: text/html;charset=utf-8" +newline+ headers +newline+ body)) src/http/dispatcher.lisp @@ -54,7 +54,8 @@ (timeout-set (my timeout) delay) (values)) -(defconstant +newline+ (force-byte-vector #(13 10))) +(define-constant +newline+ (force-byte-vector #(13 10)) + :test 'equalp) (my-defun con set-callback (func) (setf (my ready-callback) func)) src/io/con.lisp @@ -146,8 +146,8 @@ (def-simple-syscall close (fd :int)) -(defconstant +SIG_IGN+ (cffi:make-pointer 1)) -(defconstant +SIG_DFL+ (cffi:make-pointer 0)) +(define-constant +SIG_IGN+ (cffi:make-pointer 1) :test 'cffi:pointer-eq) +(define-constant +SIG_DFL+ (cffi:make-pointer 0) :test 'cffi:pointer-eq) (defconstant +SIGPIPE+ 13) (cffi:defcfun ("signal" syscall-signal) src/io/syscalls.lisp @@ -37,7 +37,7 @@ do (setf (aref ret i) arg)) ret)) -(defconstant +byte-to-digit-table+ +(define-constant +byte-to-digit-table+ (make-array 256 :element-type '(integer -1 36) :initial-contents (loop for i from 0 below 256 collect @@ -52,7 +52,8 @@ (or (in-range #\a #\z i 10) (in-range #\A #\Z i 10) (in-range #\0 #\9 i 0) - -1))))) + -1)))) + :test 'equalp) (declaim-defun-consistent-ftype byte-to-digit ((unsigned-byte 8)) (integer -1 36)) (defun-consistent byte-to-digit (byte) src/lib/byte-vector.lisp @@ -63,3 +63,7 @@ `(debug-assert (not 'reached-here))) +(defmacro defconstant-string (name value &optional documentation) + `(define-constant ,name ,value + :test 'string= + ,@(when documentation `((:documentation ,documentation))))) \ No newline at end of file src/lib/one-liners.lisp @@ -50,4 +50,4 @@ (defun backtrace-description (err) (format nil "ERROR ~A:~&~A" (with-output-to-string (*standard-output*) (describe err)) - (trivial-backtrace:get-backtrace err))) + (trivial-backtrace:backtrace-string))) src/lib/utils.lisp @@ -2,7 +2,7 @@ ; From http://www.w3.org/TR/REC-CSS2/propidx.html ; if you want more just use "strings" -(defconstant +css-properties+ '( +(define-constant +css-properties+ '( :azimuth :background :background-color @@ -147,7 +147,8 @@ :x-opacity :x-column-width :x-column-gap - )) + ) + :test 'equalp) ;; Write CSS like this: (("p.asdfsaf" "p + p") :property "value" :property "value") src/ml/css.lisp @@ -5,7 +5,7 @@ (defpackage #:teepeedee2.lib (:nicknames #:tpd2.lib) (:use #:common-lisp #:iter #:cl-irregsexp.bytestrings) - (:import-from #:cl-utilities #:with-unique-names) + (:import-from #:alexandria #:with-unique-names #:define-constant) (:import-from #:trivial-garbage #:finalize #:cancel-finalization) (:import-from #:cl-cont #:call/cc #:with-call/cc) (:import-from #:cl-irregsexp @@ -48,7 +48,8 @@ #:with-unique-names #:once-only - + #:define-constant + #:defconstant-string #:copy-byte-vector #:make-byte-vector @@ -236,6 +237,8 @@ #:js-html-script #:js-attrib #:js-to-string + + #:w3c-timestring )) (eval-when (:compile-toplevel :load-toplevel :execute) src/packages.lisp @@ -26,7 +26,7 @@ (t my-best-card)))))) -(defconstant +best-starts+ #(0 0 0 0 0 0 0 0 0 2 2 2 2 2 2 2 0 2 2 2 2 2 2 2 0 2 2 0 2 2 2 2 0 2 2 2 +(define-constant +best-starts+ #(0 0 0 0 0 0 0 0 0 2 2 2 2 2 2 2 0 2 2 2 2 2 2 2 0 2 2 0 2 2 2 2 0 2 2 2 0 0 2 2 0 2 2 2 0 0 0 2 0 2 2 2 2 0 0 0 0 2 2 2 2 2 0 0 0 2 2 2 2 2 2 2 2 0 1 1 1 1 1 1 2 1 2 1 1 2 2 2 2 1 1 0 1 1 2 2 2 1 1 1 0 1 1 2 2 1 2 1 1 0 1 2 2 1 2 2 1 1 0 1 2 1 2 2 2 2 1 0 0 2 2 2 2 2 2 2 2 1 2 1 1 2 2 2 @@ -41,10 +41,11 @@ 0 0 0 0 0 0 0 0 0 1 1 1 1 1 0 0 0 2 2 2 2 2 0 0 2 1 2 2 2 2 1 0 2 2 1 2 2 1 1 0 2 2 2 1 2 1 1 0 2 2 2 2 1 1 1 0 2 2 1 1 1 1 1 0 0 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0) - "Given the hand described by the index, 0 means play the highest card, 1 the middle card and 2 the lowest card first") + :documentation "Given the hand described by the index, 0 means play the highest card, 1 the middle card and 2 the lowest card first" + :test 'equalp) -(defconstant +three-card-win-probabilities+ +(define-constant +three-card-win-probabilities+ #(0 1/1218 1/522 11/3654 5/1218 19/3654 23/3654 3/406 1/1218 79/3654 44/1827 71/1827 122/1827 197/1827 296/1827 419/1827 1/522 44/1827 101/3654 82/1827 5/63 8/63 49/261 478/1827 11/3654 71/1827 82/1827 143/1827 64/609 323/1827 @@ -100,7 +101,8 @@ 298/609 55/87 179/261 1375/1827 1457/1827 1651/1827 1 892/1827 49/87 170/261 1375/1827 1468/1827 1574/1827 1720/1827 1 373/609 132/203 428/609 1457/1827 1574/1827 545/609 1765/1827 1 2609/3654 1441/1827 1558/1827 - 1651/1827 1720/1827 1765/1827 3575/3654 1 1 1 1 1 1 1 1 1)) + 1651/1827 1720/1827 1765/1827 3575/3654 1 1 1 1 1 1 1 1 1) + :test 'equalp) (my-defun truc-player win-probability () "Rough and ready win probability not taking into account who starts or anything much" src/truc/robots.lisp @@ -1,9 +1,10 @@ (in-package #:tpd2.game.truc) -(defconstant +truc-ranking+ '(6 7 0 12 11 10 9 8)) -(defconstant +truc-deck+ - (mapcar 'card-number - (loop for s in +suits+ append (loop for i in +truc-ranking+ collect (make-card :suit s :value i))))) +(define-constant +truc-ranking+ '(6 7 0 12 11 10 9 8) :test 'equal) +(define-constant +truc-deck+ + (map 'vector 'card-number + (loop for s in +suits+ append (loop for i in +truc-ranking+ collect (make-card :suit s :value i)))) + :test 'equalp) (defconstant +truc-winning-stack+ 12) (defgame truc () src/truc/truc.lisp @@ -1,14 +1,14 @@ (in-package #:tpd2.webapp) -(defconstant +channel-page-name+ "/*channel*") +(defconstant-string +channel-page-name+ "/*channel*") -(defconstant +action-page-name+ "/*action*") +(defconstant-string +action-page-name+ "/*action*") -(defconstant +action-form-class+ "-action-form-") -(defconstant +action-link-class+ "-action-link-") -(defconstant +replace-link-class+ "-replace-link-") +(defconstant-string +action-form-class+ "-action-form-") +(defconstant-string +action-link-class+ "-action-link-") +(defconstant-string +replace-link-class+ "-replace-link-") -(defconstant +html-id-async-status+ "-async-status-") -(defconstant +html-class-scroll-to-bottom+ "-scroll-to-bottom-") -(defconstant +html-class-collapsed+ "-collapsed-") +(defconstant-string +html-id-async-status+ "-async-status-") +(defconstant-string +html-class-scroll-to-bottom+ "-scroll-to-bottom-") +(defconstant-string +html-class-collapsed+ "-collapsed-") src/webapp/html-constants.lisp @@ -1,6 +1,6 @@ (in-package #:tpd2.webapp) -(defconstant +names+ '("Mildred" +(define-constant +names+ #("Mildred" "Henry" "Alice" "Walter" @@ -1980,7 +1980,8 @@ "Lenord" "Macy" "Arden" - "Paralee")) + "Paralee") + :test 'equalp) (defun-speedy random-letter () (code-char (+ (char-code #\A) (random 26)))) src/webapp/names.lisp @@ -1,14 +1,16 @@ (in-package #:tpd2.webapp) (defvar *webapp-frame*) -(defconstant +webapp-frame-id-param+ (force-byte-vector ".webapp-frame.")) +(define-constant +webapp-frame-id-param+ (force-byte-vector ".webapp-frame.") + :test 'equalp) -(defconstant +web-safe-chars+ +(define-constant +web-safe-chars+ (force-byte-vector (append (loop for c from (char-code #\A) to (char-code #\Z) collect c) (loop for c from (char-code #\a) to (char-code #\z) collect c) (loop for c from (char-code #\0) to (char-code #\9) collect c) - (mapcar 'char-code '(#\- #\_))))) + (mapcar 'char-code '(#\- #\_)))) + :test 'equalp) (defun generate-args-for-defpage-from-params (params-var defaulting-lambda-list) (let ((arg-names (mapcar 'force-first defaulting-lambda-list)) src/webapp/page.lisp @@ -1,8 +1,8 @@ (in-package #:tpd2.webapp) (eval-always - (defconstant +site-customization-funcs+ '(page-head page-body-start page-body-footer)) - (defconstant +site-customization-func-args+ '(title))) + (define-constant +site-customization-funcs+ '(page-head page-body-start page-body-footer) :test 'equalp) + (define-constant +site-customization-func-args+ '(title) :test 'equalp)) (defparameter *current-site* nil) @@ -14,9 +14,9 @@ (runtime-name '*current-site*) (dispatcher *default-dispatcher*) (page-head (lambda(title) - `(<head - (<title ,title) - (webapp-default-page-head-contents)))) + `(with-ml-output + (<title ,title)) + (webapp-default-page-head-contents))) (page-body-start (lambda(title) `(<h1 ,title))) src/webapp/site.lisp @@ -13,32 +13,38 @@ (defmacro ml-to-byte-vector (ml) `(sendbuf-to-byte-vector (with-ml-output-start ,ml))) -(defmacro webapp-ml (title &body body) +(defmacro webapp-ml (title-and-options &body body) (with-unique-names (title-ml) - `(let ((,title-ml - (ml-to-byte-vector ,title))) - (setf (webapp-frame-var 'actions) nil) - (with-frame-site - (with-ml-output-start + (destructuring-bind (title &key head-contents) + (force-list title-and-options) + `(let ((,title-ml + (ml-to-byte-vector ,title))) + (setf (webapp-frame-var 'actions) nil) + (values + (with-frame-site + (with-ml-output-start (output-raw-ml "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\"" - " \"http://www.w3.org/TR/html4/loose.dtd\">") - (<html - (current-site-call page-head ,title-ml) - (<body - (current-site-call page-body-start ,title-ml) - ,@body - (current-site-call page-body-footer ,title-ml)))))))) - -(defmacro webapp-lambda (title &body body) + " \"http://www.w3.org/TR/html4/loose.dtd\">") + (<html + (<head + (current-site-call page-head ,title-ml) + ,head-contents) + (<body + (current-site-call page-body-start ,title-ml) + ,@body + (current-site-call page-body-footer ,title-ml))))) + (byte-vector-cat "Content-Type: text/html;charset=utf-8" tpd2.io:+newline+)))))) + +(defmacro webapp-lambda (title-and-options &body body) (with-unique-names (l) `(labels ((,l () (setf (frame-current-page (webapp-frame)) #',l) - (webapp-ml ,title ,@body))) + (webapp-ml ,title-and-options ,@body))) #',l))) -(defmacro webapp (title &body body) - `(funcall (webapp-lambda ,title ,@body))) +(defmacro webapp (title-and-options &body body) + `(funcall (webapp-lambda ,title-and-options ,@body))) (defmacro link-to-webapp (title &body body) (with-unique-names (title-ml) src/webapp/webapp.lisp @@ -13,6 +13,7 @@ (setf sb-ext:*inline-expansion-limit* 50) (pushnew "../cl-irregsexp/" asdf:*central-registry* :test #'equal) +(pushnew "../trivial-backtrace/" asdf:*central-registry* :test #'equal) #+tpd2-debug (progn @@ -76,7 +77,8 @@ (:file "define-dtd" :depends-on ("object-to-ml")) (:file "css" :depends-on ("html")) (:file "js" :depends-on ("html")) - (:file "html" :depends-on ("define-dtd")))) + (:file "html" :depends-on ("define-dtd")) + (:file "atom" :depends-on ("define-dtd")))) (:module :datastore :depends-on (:lib) :components ((:file "datastore"))) @@ -104,26 +106,19 @@ (:module :blog :depends-on (:webapp :ml :datastore) :components ((:file "entry") + (:file "feed" :depends-on ("blog")) (:file "blog" :depends-on ("entry")))) (:module :truc :depends-on (:game) :components ( (:file "truc") (:file "web" :depends-on ("truc")) - (:file "robots" :depends-on ("truc")))))) - - (:module :t - :depends-on (:src) - :components ( - (:file "suite") - (:file "io" :depends-on ("suite")) - (:file "http" :depends-on ("suite")) - ))) + (:file "robots" :depends-on ("truc"))))))) :depends-on ( :trivial-garbage :cl-cont :cffi :iterate - :fiveam - :cl-utilities + :alexandria :cl-irregsexp :trivial-backtrace :parenscript)) + teepeedee2.asd 6ea615648a7c1d945964a72305666c985d3d6cc3 John Fremlin john@fremlin.org http://github.com/vii/teepeedee2/commit/bf7ab7f7e0dc7c060fecac69d90ea0ca0c481ee8 bf7ab7f7e0dc7c060fecac69d90ea0ca0c481ee8 2009-05-11T18:35:56-07:00 2009-05-11T18:35:56-07:00 added atom feeds (still rather weird) 1f99db45574bb3f95fa5441daaadc6d469f4a4ee John Fremlin john@fremlin.org