124 lines
3.4 KiB
Plaintext
124 lines
3.4 KiB
Plaintext
[[Kategorie:Lisp]]
|
|
=Lisp-Geekend=
|
|
|
|
== Allgemeines ==
|
|
|
|
[[blitz]] plant ein Lisp-Geekend, auf dem ähnlich dem Dylan-Geekend die breite Öffentlichkeit (*hust*) dem Lisp-Virus ausgesetzt wird.
|
|
|
|
* Buch online: [http://www.gigamonkeys.com/book/ Practical Common Lisp]
|
|
|
|
== Geplante Themen ==
|
|
|
|
* Einführung in Lisp (Common Lisp) ([http://common-lisp.net/movies/slime.torrent Common Lisp development environment intro])
|
|
* Domänen-spezifische Sub-Sprachen (oder was man mit richtigen Makros machen kann) [http://www.xach.com/bt/dsl-in-lisp.mov.torrent Demo-Video]
|
|
* Lisp auf L4
|
|
* Die Wunder von (X)Emacs
|
|
|
|
== Themenwünsche ==
|
|
(einfach gewünschte Sachen der Liste anfügen)
|
|
|
|
* Webprogrammierung ([http://common-lisp.net/movies/hello-world.torrent UnCommonWeb Hello World])
|
|
"It was pretty slick when Marco fixed an error in some code while Firefox was blocked trying to display the page, then was able to compile the fixed code and finish serving the request to the browser."
|
|
|
|
==xmpp-demo.lisp==
|
|
<source lang="lisp">
|
|
(defpackage :xmpp-demo
|
|
(:use "COMMON-LISP" "EXCL" "XMPP" "MP"
|
|
"NET.ASERVE" "NET.HTML.GENERATOR"))
|
|
(in-package :xmpp-demo)
|
|
|
|
(defclass bot-connection (connection)
|
|
((event-thread :accessor event-thread)))
|
|
|
|
(defmethod authenticate ((con bot-connection))
|
|
(auth con "blitz" cl-user::*jabber-pw* "allegrocl"))
|
|
|
|
(defmethod start-event-thread ((con bot-connection))
|
|
(setf (event-thread con)
|
|
(process-run-function "xmpp"
|
|
(lambda ()
|
|
(receive-stanza-loop con)))))
|
|
|
|
;; Parsing
|
|
|
|
(defun ensure-keyword (str)
|
|
(values (intern (string-upcase str) "KEYWORD")))
|
|
|
|
(defun parse-command (str)
|
|
(multiple-value-bind (match? whole cmd rest)
|
|
(match-re "(\\S+)\\s*(.*)" str)
|
|
(if match?
|
|
(values (ensure-keyword cmd) rest)
|
|
(error "Invalid command."))))
|
|
|
|
;; -> CMD arg
|
|
|
|
;; Links
|
|
|
|
(defvar *links* nil)
|
|
|
|
(defstruct link
|
|
url submitter)
|
|
|
|
;; Handler fun
|
|
|
|
(defvar *cn* nil
|
|
"Our current connection")
|
|
|
|
(defun start-it ()
|
|
(setq *cn* (connect :hostname "spaceboyz.net"
|
|
:class 'bot-connection))
|
|
(authenticate *cn*)
|
|
(start-event-thread *cn*))
|
|
|
|
(defmethod handle ((con bot-connection) (event message))
|
|
(handler-case
|
|
(multiple-value-bind (cmd parameter)
|
|
(parse-command (body event))
|
|
(case cmd
|
|
(:hello (message con (from event) "Hello you!"))
|
|
(:url (push (make-link :url parameter
|
|
:submitter (from event))
|
|
*links*))
|
|
))
|
|
(t (c) (message con "blitz@spaceboyz.net"
|
|
(format nil "~A" c)))))
|
|
|
|
|
|
;; HTML
|
|
|
|
(defun html-redirect (url &optional (delay 0))
|
|
(html
|
|
(:html
|
|
(:head ((:meta :http-equiv "Refresh"
|
|
:content (format nil "~A; URL=~A" delay url)))))))
|
|
|
|
(defun xmpp-render (req ent)
|
|
(with-http-response (req ent)
|
|
(with-http-body (req ent)
|
|
(let ((go (request-query-value "go" req)))
|
|
(if go
|
|
(let ((submitter (link-submitter (find go *links* :key 'link-url :test 'string=))))
|
|
(when submitter
|
|
(message *cn* submitter
|
|
(format nil "Your link ~A was followed." go)))
|
|
(html-redirect go))
|
|
(html
|
|
(:html
|
|
(:body (:h1 "XMPP Demo")
|
|
(:table
|
|
(:tr (:th "Submitter")
|
|
(:th "URL"))
|
|
(loop for link in *links*
|
|
do (html
|
|
(:tr (:td (:princ-safe (link-submitter link)))
|
|
(:td ((:a :href (format nil "/xmpp?~A"
|
|
(query-to-form-urlencoded
|
|
(list (cons "go" (link-url link))))))
|
|
(:princ-safe (link-url link)))))))))
|
|
)))))))
|
|
|
|
(publish :path "/xmpp"
|
|
:function 'xmpp-render)
|
|
</source>
|