From eenge at common-lisp.net Mon Nov 3 17:17:57 2003 From: eenge at common-lisp.net (Erik Enge) Date: Mon, 03 Nov 2003 12:17:57 -0500 Subject: [Lisppaste-cvs] CVS update: Module improted: lisppaste2 Message-ID: Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/tmp/cvs-serv425 Log Message: initial import Status: Vendor Tag: eenge Release Tags: init N lisppaste2/variable.lisp N lisppaste2/apache.conf.include N lisppaste2/encode-for-pre.lisp N lisppaste2/web-server.lisp N lisppaste2/README.lisp N lisppaste2/lisppaste.asd N lisppaste2/LICENSE N lisppaste2/package.lisp N lisppaste2/Makefile N lisppaste2/CREDITS N lisppaste2/lisppaste.lisp No conflicts created by this import Date: Mon Nov 3 12:17:56 2003 Author: eenge New module lisppaste2 added From eenge at common-lisp.net Mon Nov 3 17:35:09 2003 From: eenge at common-lisp.net (Erik Enge) Date: Mon, 03 Nov 2003 12:35:09 -0500 Subject: [Lisppaste-cvs] CVS update: lisppaste2/apache.conf.include Message-ID: Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/tmp/cvs-serv9339 Modified Files: apache.conf.include Log Message: redirect index.html -> /paste/new Date: Mon Nov 3 12:35:09 2003 Author: eenge Index: lisppaste2/apache.conf.include diff -u lisppaste2/apache.conf.include:1.1.1.1 lisppaste2/apache.conf.include:1.2 --- lisppaste2/apache.conf.include:1.1.1.1 Mon Nov 3 12:17:53 2003 +++ lisppaste2/apache.conf.include Mon Nov 3 12:35:08 2003 @@ -1,4 +1,4 @@ -#### $Id: apache.conf.include,v 1.1.1.1 2003/11/03 17:17:53 eenge Exp $ +#### $Id: apache.conf.include,v 1.2 2003/11/03 17:35:08 eenge Exp $ #### $Source: /project/lisppaste/cvsroot/lisppaste2/apache.conf.include,v $ # To include this file, simply add: @@ -8,8 +8,9 @@ # and you are set to go. -ServerName localhost -ProxyPass /paste/ http://localhost:8081/paste/ -ProxyPassReverse /paste/ http://localhost:8081/paste/ -SetEnvIf User-Agent ".*MSIE.*" nokeepalive ssl-unclean-shutdown + ServerName localhost + Redirect /index.html http://localhost/paste/new + ProxyPass /paste/ http://localhost:8081/paste/ + ProxyPassReverse /paste/ http://localhost:8081/paste/ + SetEnvIf User-Agent ".*MSIE.*" nokeepalive ssl-unclean-shutdown From eenge at common-lisp.net Mon Nov 3 17:35:51 2003 From: eenge at common-lisp.net (Erik Enge) Date: Mon, 03 Nov 2003 12:35:51 -0500 Subject: [Lisppaste-cvs] CVS update: lisppaste2/variable.lisp Message-ID: Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/tmp/cvs-serv9660 Modified Files: variable.lisp Log Message: using localhost as default Date: Mon Nov 3 12:35:51 2003 Author: eenge Index: lisppaste2/variable.lisp diff -u lisppaste2/variable.lisp:1.1.1.1 lisppaste2/variable.lisp:1.2 --- lisppaste2/variable.lisp:1.1.1.1 Mon Nov 3 12:17:53 2003 +++ lisppaste2/variable.lisp Mon Nov 3 12:35:51 2003 @@ -1,4 +1,4 @@ -;;;; $Id: variable.lisp,v 1.1.1.1 2003/11/03 17:17:53 eenge Exp $ +;;;; $Id: variable.lisp,v 1.2 2003/11/03 17:35:51 eenge Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/variable.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -8,7 +8,7 @@ (defparameter *internal-http-port* 8081 "Port lisppaste will listen on for WWW requests.") -(defparameter *paste-site-name* "common-lisp.net" +(defparameter *paste-site-name* "localhost" "Website we are running on (used for creating links).") (defparameter *paste-url* From eenge at common-lisp.net Mon Nov 3 17:57:03 2003 From: eenge at common-lisp.net (Erik Enge) Date: Mon, 03 Nov 2003 12:57:03 -0500 Subject: [Lisppaste-cvs] CVS update: lisppaste2/apache.conf.include Message-ID: Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/tmp/cvs-serv19664 Modified Files: apache.conf.include Log Message: d'oh, that redirect is no good. Date: Mon Nov 3 12:57:02 2003 Author: eenge Index: lisppaste2/apache.conf.include diff -u lisppaste2/apache.conf.include:1.2 lisppaste2/apache.conf.include:1.3 --- lisppaste2/apache.conf.include:1.2 Mon Nov 3 12:35:08 2003 +++ lisppaste2/apache.conf.include Mon Nov 3 12:57:02 2003 @@ -1,4 +1,4 @@ -#### $Id: apache.conf.include,v 1.2 2003/11/03 17:35:08 eenge Exp $ +#### $Id: apache.conf.include,v 1.3 2003/11/03 17:57:02 eenge Exp $ #### $Source: /project/lisppaste/cvsroot/lisppaste2/apache.conf.include,v $ # To include this file, simply add: @@ -9,7 +9,6 @@ ServerName localhost - Redirect /index.html http://localhost/paste/new ProxyPass /paste/ http://localhost:8081/paste/ ProxyPassReverse /paste/ http://localhost:8081/paste/ SetEnvIf User-Agent ".*MSIE.*" nokeepalive ssl-unclean-shutdown From eenge at common-lisp.net Wed Nov 5 13:40:09 2003 From: eenge at common-lisp.net (Erik Enge) Date: Wed, 05 Nov 2003 08:40:09 -0500 Subject: [Lisppaste-cvs] CVS update: Module improted: public_html Message-ID: Update of /project/lisppaste/cvsroot/public_html In directory common-lisp.net:/tmp/cvs-serv597 Log Message: initial import Status: Vendor Tag: eenge Release Tags: init N public_html/index.html No conflicts created by this import Date: Wed Nov 5 08:40:09 2003 Author: eenge New module public_html added From eenge at common-lisp.net Wed Nov 5 13:44:12 2003 From: eenge at common-lisp.net (Erik Enge) Date: Wed, 05 Nov 2003 08:44:12 -0500 Subject: [Lisppaste-cvs] CVS update: public_html/index.html Message-ID: Update of /project/lisppaste/cvsroot/public_html In directory common-lisp.net:/home/eenge/tmp/lisppaste-public_html Modified Files: index.html Log Message: mentioning lisppaste2 Date: Wed Nov 5 08:44:11 2003 Author: eenge Index: public_html/index.html diff -u public_html/index.html:1.1.1.1 public_html/index.html:1.2 --- public_html/index.html:1.1.1.1 Wed Nov 5 08:39:58 2003 +++ public_html/index.html Wed Nov 5 08:44:09 2003 @@ -16,7 +16,7 @@

No downloads are available but the code in CVS (checkout instructions) is considered fairly - usable. You'll also need irc, araneida and SBCL. If you do install it, read the ViewCVS for the curious.

+ +

There's a second version of lisppaste in CVS called lisppaste2. + It uses the net-nittin-irc + library and features an ASDF system.

'lisppaste' is written and copyrighted by Brian Mastenbrook. The sources are covered by an MIT-type license.

From eenge at common-lisp.net Wed Nov 5 14:01:43 2003 From: eenge at common-lisp.net (Erik Enge) Date: Wed, 05 Nov 2003 09:01:43 -0500 Subject: [Lisppaste-cvs] CVS update: public_html/index.html Message-ID: Update of /project/lisppaste/cvsroot/public_html In directory common-lisp.net:/home/eenge/tmp/lisppaste-public_html Modified Files: index.html Log Message: fixing email address Date: Wed Nov 5 09:01:42 2003 Author: eenge Index: public_html/index.html diff -u public_html/index.html:1.2 public_html/index.html:1.3 --- public_html/index.html:1.2 Wed Nov 5 08:44:09 2003 +++ public_html/index.html Wed Nov 5 09:01:41 2003 @@ -36,7 +36,7 @@ The sources are covered by an MIT-type license.

-
Erik Enge
+
Erik Enge
Last modified: Fri Oct 31 17:17:45 EST 2003 From eenge at common-lisp.net Mon Nov 10 16:18:24 2003 From: eenge at common-lisp.net (Erik Enge) Date: Mon, 10 Nov 2003 11:18:24 -0500 Subject: [Lisppaste-cvs] CVS update: lisppaste2/web-server.lisp Message-ID: Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/tmp/cvs-serv5661 Modified Files: web-server.lisp Log Message: updating for araneida 0.80. Date: Mon Nov 10 11:18:23 2003 Author: eenge Index: lisppaste2/web-server.lisp diff -u lisppaste2/web-server.lisp:1.1.1.1 lisppaste2/web-server.lisp:1.2 --- lisppaste2/web-server.lisp:1.1.1.1 Mon Nov 3 12:17:53 2003 +++ lisppaste2/web-server.lisp Mon Nov 10 11:18:23 2003 @@ -1,4 +1,4 @@ -;;;; $Id: web-server.lisp,v 1.1.1.1 2003/11/03 17:17:53 eenge Exp $ +;;;; $Id: web-server.lisp,v 1.2 2003/11/10 16:18:23 eenge Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -12,122 +12,130 @@ (contents nil :type string) (universal-time nil :type integer)) -(defun say-handler (request rest) - (araneida:request-send-headers request) - (irc:send-irc-message *connection* :privmsg rest (channel *connection*)) - (princ - (html - `(html - (head - (title "Sent!")) - (body - ,(format nil "Your text was sent to ~A!" (channel *connection*))))))) +(defclass new-paste-handler (araneida:handler) ()) + +(defclass submit-paste-handler (araneida:handler) + ((username + :accessor username + :initform "") + (title + :accessor title + :initform "") + (text + :accessor text + :initform ""))) -(defun display-handler (request rest) +(defclass display-paste-handler (araneida:handler) ()) + +(defmethod araneida:handle-request-response ((handler new-paste-handler) method request) (araneida:request-send-headers request :expires 0) - (write-sequence - (let ((pnumber (parse-integer rest :junk-allowed t))) - (if (not pnumber) - (html - `(html (head (title "Invalid paste number!")) - (body (h1 ,(format nil "The supplied paste number is not an integer."))))) - (let ((thepaste (some #'(lambda (e) (and (eql pnumber (paste-number e)) e)) *pastes*))) - (if (not thepaste) - (html - `(html (head (title "Invalid paste number!")) - (body (h1 ,(format nil "No paste numbered ~A could be found." pnumber))))) - (html - `(html (head (title ,(format nil "Paste number ~A" pnumber))) - (body (h3 ,(format nil "Paste number ~A: ~A" pnumber (encode-for-pre (paste-title thepaste)))) - ,(format nil "Pasted by ~A" (encode-for-pre (paste-user thepaste))) - (hr) - ((pre) ,(encode-for-pre (paste-contents thepaste)))))))))) - (araneida:request-stream request))) - -(defun new-paste-form () - `((form :method post :action ,(araneida:urlstring *new-paste-url*)) - "Enter a username, title, and paste contents into the fields below. If you choose a unique username for your pastes then other users will be able to search for your pastes (not now)." - (hr) - "Enter your username: " ((input :type text :name username)) (br) - "Enter a title: " ((input :type text :name title)) (br) - "Enter your paste: " (br) ((textarea :rows 24 :cols 80 :name text)) - (br) - ((input :type submit)) - ((input :type reset)))) - -#|(defun search-paste-handler (request rest) - (request-send-headers request :expires 0) - (write-sequence - (html - `(html - (head (title "Search Pastes")) - (body - ,@(let ((username-param (body-param "USERNAME" (request-body request))) - (title-param (body-param "TITLE" (request-body request))) - (text-param (body-param "TEXT" (request-body request)))) - (if (not (or username-param title-param text-param)) - `((h1 "Search for pastes") - `((form :method post :action ,(urlstring *search-paste-url*)) - "Enter one or more of a username, title, or paste contents to search for. The searches are exact substring searches." - (hr) - "Search for a username: " ((input :type text :name username)) (br) - "Search for a title: " ((input :type text :name title)) (br) - "Search for a paste: " ((input :type text :name text)) (br) - ((input :type submit)) - ((input :type reset)))))))))))|# + (new-paste-form request)) -(defun new-paste-handler (request rest) +(defun new-paste-form (request &optional (message "")) + (araneida:html-stream + (araneida:request-stream request) + `(html + (head (title "Paste")) + (body + (h1 "Enter your paste") + ((font :color red) (h2 ,message)) + ((form :method post :action ,(araneida:urlstring *submit-paste-url*)) + (p "Enter a username, title, and paste contents into the fields below. The +paste will appear on " ,*channel* " @ " ,(irc:server-name *connection*) ".") + (hr) + (table + (tr + (th "Enter your username:") + (td ((input :type text :name username)))) + (tr + (th "Enter a title:") + (td ((input :type text :name title)))) + (tr + ((th :valign top) "Enter your paste:") + (td ((textarea :rows 24 :cols 80 :name text)))) + (tr + ((td :colspan 2) ((input :type submit)))) + (tr + ((td :colspan 2) ((input :type reset)))))))))) + +(defmethod araneida:handle-request-response ((handler submit-paste-handler) method request) + (setf (username handler) (araneida:body-param "USERNAME" (araneida:request-body request))) + (setf (title handler) (araneida:body-param "TITLE" (araneida:request-body request))) + (setf (text handler) (araneida:body-param "TEXT" (araneida:request-body request))) + (araneida:request-send-headers request) + + (let ((username (username handler)) + (title (title handler)) + (text (text handler))) + (cond + ((zerop (length username)) + (new-paste-form request "Please enter your username.")) + ((zerop (length title)) + (new-paste-form request "Please enter a title.")) + ((zerop (length text)) + (new-paste-form request "Please enter your paste.")) + (t + (progn + (incf *paste-counter*) + (let ((url (araneida:urlstring (araneida:merge-url *display-url* + (prin1-to-string *paste-counter*)))) + (paste (make-paste :number *paste-counter* + :user username + :title title + :contents text + :universal-time (get-universal-time)))) + (irc:privmsg *connection* *channel* + (format nil "~A pasted ~A at ~A" username title url)) + (push paste *pastes*) + (araneida:html-stream + (araneida:request-stream request) + `(html + (head (title "Paste number " ,*paste-counter*)) + (body + (h1 "Pasted!") + (p "Your paste should be available at " ((a :href ,url) ,url) ", and +was also sent to " ,*channel* " @ " ,(irc:server-name *connection*))))))))))) + +(defmethod araneida:handle-request-response ((handler display-paste-handler) method request) (araneida:request-send-headers request :expires 0) - (write-sequence - (html - `(html - (head (title "Paste")) - (body - ,@(let ((username-param (body-param "USERNAME" (araneida:request-body request))) - (title-param (body-param "TITLE" (araneida:request-body request))) - (text-param (body-param "TEXT" (araneida:request-body request)))) - (print 'hi) - (if (not username-param) ;;; We weren't supplied a paste - `((h1 "Enter your paste") - ,(new-paste-form)) - (if (string= username-param "") - `(((font :color red) "Please enter a valid username!") - (br) - (h1 "Enter your paste") - ,(new-paste-form)) - (if (or (not title-param) (string= title-param "")) - `(((font :color red) "Please enter a valid title!") - (h1 "Enter your paste") - ,(new-paste-form)) - (if (or (not text-param) (string= text-param "")) - `(((font :color red) "Please enter some text for your paste!") - (h1 "Enter your paste") - ,(new-paste-form)) - (progn - (incf *paste-counter*) - (push (make-paste :number *paste-counter* - :user username-param - :title title-param - :contents text-param - :universal-time (get-universal-time)) *pastes*) - (let ((theurl (urlstring (merge-url *display-paste-url* (prin1-to-string *paste-counter*))))) - (irc:send-irc-message connection - :privmsg (format nil "~A pasted ~A at ~A" username-param title-param theurl) - (channel connection)) - `((h1 "Pasted!") - "Your paste should be available at " ((a :href ,theurl) ,theurl)))))))))))) - (araneida:request-stream request))) - -(araneida:export-server *paste-server*) - -(araneida:export-handler *new-paste-url* - #'new-paste-handler - :method t :stage :response) - -(araneida:export-handler *say-url* - #'say-handler - :match :prefix :method t :stage :response) - -(araneida:export-handler *display-paste-url* - #'display-handler - :match :prefix :method t :stage :response) + ; XXX request-unhandled-part will be exported in 0.81 + (let* ((paste-number (parse-integer + (araneida::request-unhandled-part request) + :junk-allowed t)) + (paste (some #'(lambda (element) + (and (eql paste-number (paste-number element)) + element)) *pastes*))) + (if paste + (araneida:html-stream + (araneida:request-stream request) + `(html + (head + (title "Paste number " ,paste-number)) + (body + (h2 "Paste number " ,paste-number ,(encode-for-pre (paste-title paste))) + (p "Pasted by " ,(encode-for-pre (paste-user paste))) + (hr) + (pre ,(encode-for-pre (paste-contents paste)))))) + (araneida:html-stream + (araneida:request-stream request) + `(html + (head + (title "Invalid paste number" ,paste-number)) + (body + (h1 "No paste numberd " ,paste-number "could be found."))))))) + +(araneida:install-handler + (araneida:http-listener-handler *paste-listener*) + (make-instance 'new-paste-handler) + (araneida:urlstring *new-paste-url*) t) + +(araneida:install-handler + (araneida:http-listener-handler *paste-listener*) + (make-instance 'submit-paste-handler) + (araneida:urlstring *submit-paste-url*) t) + +(araneida:install-handler + (araneida:http-listener-handler *paste-listener*) + (make-instance 'display-paste-handler) + (araneida:urlstring *display-paste-url*) nil) + From eenge at common-lisp.net Mon Nov 10 16:18:39 2003 From: eenge at common-lisp.net (Erik Enge) Date: Mon, 10 Nov 2003 11:18:39 -0500 Subject: [Lisppaste-cvs] CVS update: lisppaste2/variable.lisp Message-ID: Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/tmp/cvs-serv5713 Modified Files: variable.lisp Log Message: renaming and removing some urls Date: Mon Nov 10 11:18:39 2003 Author: eenge Index: lisppaste2/variable.lisp diff -u lisppaste2/variable.lisp:1.2 lisppaste2/variable.lisp:1.3 --- lisppaste2/variable.lisp:1.2 Mon Nov 3 12:35:51 2003 +++ lisppaste2/variable.lisp Mon Nov 10 11:18:39 2003 @@ -1,4 +1,4 @@ -;;;; $Id: variable.lisp,v 1.2 2003/11/03 17:35:51 eenge Exp $ +;;;; $Id: variable.lisp,v 1.3 2003/11/10 16:18:39 eenge Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/variable.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -7,23 +7,22 @@ (defparameter *internal-http-port* 8081 "Port lisppaste will listen on for WWW requests.") +(defparameter *external-http-port* 80 + "Port lisppaste will listen on for WWW requests.") (defparameter *paste-site-name* "localhost" "Website we are running on (used for creating links).") (defparameter *paste-url* (araneida:merge-url - (make-instance 'araneida:http-url - :host *paste-site-name* - :port *internal-http-port*) "/paste/")) + (araneida:make-url :scheme "http" + :host *paste-site-name* + :port *external-http-port*) "/paste/")) (defparameter *paste-external-url* (araneida:merge-url - (make-instance 'araneida:http-url - :host *paste-site-name*) "/paste/")) - -(defparameter *say-url* - (araneida:merge-url *paste-external-url* "say/")) + (araneida:make-url :scheme "http" + :host *paste-site-name*) "/paste/")) (defparameter *display-paste-url* (araneida:merge-url *paste-external-url* "display/")) @@ -31,11 +30,18 @@ (defparameter *new-paste-url* (araneida:merge-url *paste-external-url* "new")) -(defparameter *paste-server* - (make-instance 'araneida:server - :name *paste-site-name* - :base-url *paste-url* - :port *internal-http-port*)) +(defparameter *submit-paste-url* + (araneida:merge-url *paste-external-url* "submit")) + +(defparameter *paste-listener* + (let ((fwd-url (araneida:copy-url *paste-url*))) + (setf (araneida:url-port fwd-url) *internal-http-port*) + (make-instance 'araneida:serve-event-reverse-proxy-listener + :translations + `((,(araneida:urlstring *paste-url*) + ,(araneida:urlstring fwd-url))) + :address #(0 0 0 0) + :port (araneida:url-port fwd-url)))) (defvar *default-nickname* "devpaste") (defvar *default-irc-server* "irc.freenode.net") @@ -43,7 +49,6 @@ (defvar *default-channel* "#lisppaste") (defvar *pastes* nil) - (defvar *paste-counter* 0) - -(defvar *connection* nil) \ No newline at end of file +(defvar *connection* nil) +(defvar *channel* "") \ No newline at end of file From eenge at common-lisp.net Mon Nov 10 16:28:43 2003 From: eenge at common-lisp.net (Erik Enge) Date: Mon, 10 Nov 2003 11:28:43 -0500 Subject: [Lisppaste-cvs] CVS update: lisppaste2/apache.conf.include lisppaste2/lisppaste.lisp lisppaste2/web-server.lisp Message-ID: Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/tmp/cvs-serv9846 Modified Files: apache.conf.include lisppaste.lisp web-server.lisp Log Message: minor typo corrections Date: Mon Nov 10 11:28:43 2003 Author: eenge Index: lisppaste2/apache.conf.include diff -u lisppaste2/apache.conf.include:1.3 lisppaste2/apache.conf.include:1.4 --- lisppaste2/apache.conf.include:1.3 Mon Nov 3 12:57:02 2003 +++ lisppaste2/apache.conf.include Mon Nov 10 11:28:43 2003 @@ -1,4 +1,4 @@ -#### $Id: apache.conf.include,v 1.3 2003/11/03 17:57:02 eenge Exp $ +#### $Id: apache.conf.include,v 1.4 2003/11/10 16:28:43 eenge Exp $ #### $Source: /project/lisppaste/cvsroot/lisppaste2/apache.conf.include,v $ # To include this file, simply add: @@ -9,7 +9,7 @@ ServerName localhost - ProxyPass /paste/ http://localhost:8081/paste/ + Proxypass /paste/ http://localhost:8081/paste/ ProxyPassReverse /paste/ http://localhost:8081/paste/ SetEnvIf User-Agent ".*MSIE.*" nokeepalive ssl-unclean-shutdown Index: lisppaste2/lisppaste.lisp diff -u lisppaste2/lisppaste.lisp:1.1.1.1 lisppaste2/lisppaste.lisp:1.2 --- lisppaste2/lisppaste.lisp:1.1.1.1 Mon Nov 3 12:17:54 2003 +++ lisppaste2/lisppaste.lisp Mon Nov 10 11:28:43 2003 @@ -1,4 +1,4 @@ -;;;; $Id: lisppaste.lisp,v 1.1.1.1 2003/11/03 17:17:54 eenge Exp $ +;;;; $Id: lisppaste.lisp,v 1.2 2003/11/10 16:28:43 eenge Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/lisppaste.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -15,7 +15,8 @@ :server server :port port))) (setf *connection* connection) + (setf *channel* channel) (irc:join connection channel) - (araneida:install-serve-event-handlers) + (araneida:start-listening *paste-listener*) (irc:read-message-loop connection))) Index: lisppaste2/web-server.lisp diff -u lisppaste2/web-server.lisp:1.2 lisppaste2/web-server.lisp:1.3 --- lisppaste2/web-server.lisp:1.2 Mon Nov 10 11:18:23 2003 +++ lisppaste2/web-server.lisp Mon Nov 10 11:28:43 2003 @@ -1,4 +1,4 @@ -;;;; $Id: web-server.lisp,v 1.2 2003/11/10 16:18:23 eenge Exp $ +;;;; $Id: web-server.lisp,v 1.3 2003/11/10 16:28:43 eenge Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -77,7 +77,7 @@ (t (progn (incf *paste-counter*) - (let ((url (araneida:urlstring (araneida:merge-url *display-url* + (let ((url (araneida:urlstring (araneida:merge-url *display-paste-url* (prin1-to-string *paste-counter*)))) (paste (make-paste :number *paste-counter* :user username @@ -122,7 +122,7 @@ (head (title "Invalid paste number" ,paste-number)) (body - (h1 "No paste numberd " ,paste-number "could be found."))))))) + (h3 "No paste numbered " ,paste-number " could be found."))))))) (araneida:install-handler (araneida:http-listener-handler *paste-listener*) From eenge at common-lisp.net Mon Nov 10 20:04:37 2003 From: eenge at common-lisp.net (Erik Enge) Date: Mon, 10 Nov 2003 15:04:37 -0500 Subject: [Lisppaste-cvs] CVS update: lisppaste2/web-server.lisp Message-ID: Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/tmp/cvs-serv9034 Modified Files: web-server.lisp Log Message: need to tell the IRC channel about the external (rather than internal) URL for the paste Date: Mon Nov 10 15:04:37 2003 Author: eenge Index: lisppaste2/web-server.lisp diff -u lisppaste2/web-server.lisp:1.3 lisppaste2/web-server.lisp:1.4 --- lisppaste2/web-server.lisp:1.3 Mon Nov 10 11:28:43 2003 +++ lisppaste2/web-server.lisp Mon Nov 10 15:04:36 2003 @@ -1,4 +1,4 @@ -;;;; $Id: web-server.lisp,v 1.3 2003/11/10 16:28:43 eenge Exp $ +;;;; $Id: web-server.lisp,v 1.4 2003/11/10 20:04:36 eenge Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -77,15 +77,19 @@ (t (progn (incf *paste-counter*) - (let ((url (araneida:urlstring (araneida:merge-url *display-paste-url* - (prin1-to-string *paste-counter*)))) + (let ((url (araneida:urlstring + (araneida:merge-url *display-paste-url* + (prin1-to-string *paste-counter*)))) + (external-url (araneida:urlstring + (araneida:merge-url *paste-external-url* + (prin1-to-string *paste-counter*))))) (paste (make-paste :number *paste-counter* :user username :title title :contents text :universal-time (get-universal-time)))) (irc:privmsg *connection* *channel* - (format nil "~A pasted ~A at ~A" username title url)) + (format nil "~A pasted ~A at ~A" username title external-url)) (push paste *pastes*) (araneida:html-stream (araneida:request-stream request) From eenge at common-lisp.net Mon Nov 10 20:07:48 2003 From: eenge at common-lisp.net (Erik Enge) Date: Mon, 10 Nov 2003 15:07:48 -0500 Subject: [Lisppaste-cvs] CVS update: lisppaste2/web-server.lisp Message-ID: Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/tmp/cvs-serv9860 Modified Files: web-server.lisp Log Message: setf takes plenty forms; no need for three calls. Date: Mon Nov 10 15:07:48 2003 Author: eenge Index: lisppaste2/web-server.lisp diff -u lisppaste2/web-server.lisp:1.4 lisppaste2/web-server.lisp:1.5 --- lisppaste2/web-server.lisp:1.4 Mon Nov 10 15:04:36 2003 +++ lisppaste2/web-server.lisp Mon Nov 10 15:07:48 2003 @@ -1,4 +1,4 @@ -;;;; $Id: web-server.lisp,v 1.4 2003/11/10 20:04:36 eenge Exp $ +;;;; $Id: web-server.lisp,v 1.5 2003/11/10 20:07:48 eenge Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -59,9 +59,9 @@ ((td :colspan 2) ((input :type reset)))))))))) (defmethod araneida:handle-request-response ((handler submit-paste-handler) method request) - (setf (username handler) (araneida:body-param "USERNAME" (araneida:request-body request))) - (setf (title handler) (araneida:body-param "TITLE" (araneida:request-body request))) - (setf (text handler) (araneida:body-param "TEXT" (araneida:request-body request))) + (setf (username handler) (araneida:body-param "USERNAME" (araneida:request-body request)) + (title handler) (araneida:body-param "TITLE" (araneida:request-body request)) + (text handler) (araneida:body-param "TEXT" (araneida:request-body request))) (araneida:request-send-headers request) (let ((username (username handler)) From eenge at common-lisp.net Tue Nov 11 14:39:25 2003 From: eenge at common-lisp.net (Erik Enge) Date: Tue, 11 Nov 2003 09:39:25 -0500 Subject: [Lisppaste-cvs] CVS update: lisppaste2/web-server.lisp Message-ID: Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/tmp/cvs-serv8954 Modified Files: web-server.lisp Log Message: fix parenthesis mismatch bug Date: Tue Nov 11 09:39:24 2003 Author: eenge Index: lisppaste2/web-server.lisp diff -u lisppaste2/web-server.lisp:1.5 lisppaste2/web-server.lisp:1.6 --- lisppaste2/web-server.lisp:1.5 Mon Nov 10 15:07:48 2003 +++ lisppaste2/web-server.lisp Tue Nov 11 09:39:24 2003 @@ -1,4 +1,4 @@ -;;;; $Id: web-server.lisp,v 1.5 2003/11/10 20:07:48 eenge Exp $ +;;;; $Id: web-server.lisp,v 1.6 2003/11/11 14:39:24 eenge Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -82,22 +82,22 @@ (prin1-to-string *paste-counter*)))) (external-url (araneida:urlstring (araneida:merge-url *paste-external-url* - (prin1-to-string *paste-counter*))))) + (prin1-to-string *paste-counter*)))) (paste (make-paste :number *paste-counter* :user username :title title :contents text :universal-time (get-universal-time)))) - (irc:privmsg *connection* *channel* - (format nil "~A pasted ~A at ~A" username title external-url)) - (push paste *pastes*) - (araneida:html-stream - (araneida:request-stream request) - `(html - (head (title "Paste number " ,*paste-counter*)) - (body - (h1 "Pasted!") - (p "Your paste should be available at " ((a :href ,url) ,url) ", and + (irc:privmsg *connection* *channel* + (format nil "~A pasted ~A at ~A" username title external-url)) + (push paste *pastes*) + (araneida:html-stream + (araneida:request-stream request) + `(html + (head (title "Paste number " ,*paste-counter*)) + (body + (h1 "Pasted!") + (p "Your paste should be available at " ((a :href ,url) ,url) ", and was also sent to " ,*channel* " @ " ,(irc:server-name *connection*))))))))))) (defmethod araneida:handle-request-response ((handler display-paste-handler) method request) From bmastenbrook at common-lisp.net Tue Nov 11 14:42:04 2003 From: bmastenbrook at common-lisp.net (Brian Mastenbrook) Date: Tue, 11 Nov 2003 09:42:04 -0500 Subject: [Lisppaste-cvs] CVS update: lisppaste2/web-server.lisp Message-ID: Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/tmp/cvs-serv9594 Modified Files: web-server.lisp Log Message: Use strings instead of symbols for names of form fields, and use with-slots Date: Tue Nov 11 09:42:04 2003 Author: bmastenbrook Index: lisppaste2/web-server.lisp diff -u lisppaste2/web-server.lisp:1.6 lisppaste2/web-server.lisp:1.7 --- lisppaste2/web-server.lisp:1.6 Tue Nov 11 09:39:24 2003 +++ lisppaste2/web-server.lisp Tue Nov 11 09:42:03 2003 @@ -1,4 +1,4 @@ -;;;; $Id: web-server.lisp,v 1.6 2003/11/11 14:39:24 eenge Exp $ +;;;; $Id: web-server.lisp,v 1.7 2003/11/11 14:42:03 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -46,27 +46,25 @@ (table (tr (th "Enter your username:") - (td ((input :type text :name username)))) + (td ((input :type text :name "username")))) (tr (th "Enter a title:") - (td ((input :type text :name title)))) + (td ((input :type text :name "title")))) (tr ((th :valign top) "Enter your paste:") - (td ((textarea :rows 24 :cols 80 :name text)))) + (td ((textarea :rows 24 :cols 80 :name "text")))) (tr ((td :colspan 2) ((input :type submit)))) (tr ((td :colspan 2) ((input :type reset)))))))))) (defmethod araneida:handle-request-response ((handler submit-paste-handler) method request) - (setf (username handler) (araneida:body-param "USERNAME" (araneida:request-body request)) - (title handler) (araneida:body-param "TITLE" (araneida:request-body request)) - (text handler) (araneida:body-param "TEXT" (araneida:request-body request))) + (setf (username handler) (araneida:body-param "username" (araneida:request-body request)) + (title handler) (araneida:body-param "title" (araneida:request-body request)) + (text handler) (araneida:body-param "text" (araneida:request-body request))) (araneida:request-send-headers request) - (let ((username (username handler)) - (title (title handler)) - (text (text handler))) + (with-slots (username title text) handler (cond ((zerop (length username)) (new-paste-form request "Please enter your username.")) From bmastenbrook at common-lisp.net Tue Nov 11 14:55:38 2003 From: bmastenbrook at common-lisp.net (Brian Mastenbrook) Date: Tue, 11 Nov 2003 09:55:38 -0500 Subject: [Lisppaste-cvs] CVS update: lisppaste2/web-server.lisp Message-ID: Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/tmp/cvs-serv15474 Modified Files: web-server.lisp Log Message: Cosmetic changes, and fix to use *display-paste-url* Date: Tue Nov 11 09:55:37 2003 Author: bmastenbrook Index: lisppaste2/web-server.lisp diff -u lisppaste2/web-server.lisp:1.7 lisppaste2/web-server.lisp:1.8 --- lisppaste2/web-server.lisp:1.7 Tue Nov 11 09:42:03 2003 +++ lisppaste2/web-server.lisp Tue Nov 11 09:55:37 2003 @@ -1,4 +1,4 @@ -;;;; $Id: web-server.lisp,v 1.7 2003/11/11 14:42:03 bmastenbrook Exp $ +;;;; $Id: web-server.lisp,v 1.8 2003/11/11 14:55:37 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -54,9 +54,8 @@ ((th :valign top) "Enter your paste:") (td ((textarea :rows 24 :cols 80 :name "text")))) (tr - ((td :colspan 2) ((input :type submit)))) - (tr - ((td :colspan 2) ((input :type reset)))))))))) + ((th) "Submit your paste:") + ((td) ((input :type submit :value "Submit paste")) " " ((input :type reset :value "Clear paste")))))))))) (defmethod araneida:handle-request-response ((handler submit-paste-handler) method request) (setf (username handler) (araneida:body-param "username" (araneida:request-body request)) @@ -79,7 +78,7 @@ (araneida:merge-url *display-paste-url* (prin1-to-string *paste-counter*)))) (external-url (araneida:urlstring - (araneida:merge-url *paste-external-url* + (araneida:merge-url *display-paste-url* (prin1-to-string *paste-counter*)))) (paste (make-paste :number *paste-counter* :user username @@ -114,8 +113,8 @@ (head (title "Paste number " ,paste-number)) (body - (h2 "Paste number " ,paste-number ,(encode-for-pre (paste-title paste))) - (p "Pasted by " ,(encode-for-pre (paste-user paste))) + (h2 "Paste number " ,paste-number ": " ,(encode-for-pre (paste-title paste))) + (p "Pasted by: " ,(encode-for-pre (paste-user paste))) (hr) (pre ,(encode-for-pre (paste-contents paste)))))) (araneida:html-stream From bmastenbrook at common-lisp.net Wed Nov 12 04:19:39 2003 From: bmastenbrook at common-lisp.net (Brian Mastenbrook) Date: Tue, 11 Nov 2003 23:19:39 -0500 Subject: [Lisppaste-cvs] CVS update: lisppaste2/variable.lisp lisppaste2/web-server.lisp Message-ID: Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/tmp/cvs-serv6666 Modified Files: variable.lisp web-server.lisp Log Message: Added paste annotations and paste lister. Prettified HTML output for paste display and list. Added line of links to the bottom of all pages. Date: Tue Nov 11 23:19:38 2003 Author: bmastenbrook Index: lisppaste2/variable.lisp diff -u lisppaste2/variable.lisp:1.3 lisppaste2/variable.lisp:1.4 --- lisppaste2/variable.lisp:1.3 Mon Nov 10 11:18:39 2003 +++ lisppaste2/variable.lisp Tue Nov 11 23:19:38 2003 @@ -1,4 +1,4 @@ -;;;; $Id: variable.lisp,v 1.3 2003/11/10 16:18:39 eenge Exp $ +;;;; $Id: variable.lisp,v 1.4 2003/11/12 04:19:38 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/variable.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -6,9 +6,9 @@ (in-package :lisppaste) (defparameter *internal-http-port* 8081 - "Port lisppaste will listen on for WWW requests.") -(defparameter *external-http-port* 80 - "Port lisppaste will listen on for WWW requests.") + "Port lisppaste's araneida will listen on for requests from Apache.") +(defparameter *external-http-port* 8081 + "Port lisppaste's araneida will listen on for requests from remote clients.") (defparameter *paste-site-name* "localhost" "Website we are running on (used for creating links).") @@ -17,18 +17,22 @@ (araneida:merge-url (araneida:make-url :scheme "http" :host *paste-site-name* - :port *external-http-port*) "/paste/")) + :port *internal-http-port*) "/paste/")) (defparameter *paste-external-url* (araneida:merge-url (araneida:make-url :scheme "http" - :host *paste-site-name*) "/paste/")) + :host *paste-site-name* + :port *external-http-port*) "/paste/")) (defparameter *display-paste-url* (araneida:merge-url *paste-external-url* "display/")) (defparameter *new-paste-url* (araneida:merge-url *paste-external-url* "new")) + +(defparameter *list-paste-url* + (araneida:merge-url *paste-external-url* "list")) (defparameter *submit-paste-url* (araneida:merge-url *paste-external-url* "submit")) Index: lisppaste2/web-server.lisp diff -u lisppaste2/web-server.lisp:1.8 lisppaste2/web-server.lisp:1.9 --- lisppaste2/web-server.lisp:1.8 Tue Nov 11 09:55:37 2003 +++ lisppaste2/web-server.lisp Tue Nov 11 23:19:38 2003 @@ -1,47 +1,90 @@ -;;;; $Id: web-server.lisp,v 1.8 2003/11/11 14:55:37 bmastenbrook Exp $ +;;;; $Id: web-server.lisp,v 1.9 2003/11/12 04:19:38 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $ ;;;; See the LICENSE file for licensing information. (in-package :lisppaste) -(defstruct (paste (:conc-name paste-)) +(defstruct paste (number nil :type integer) (user nil :type string) (title nil :type string) (contents nil :type string) - (universal-time nil :type integer)) + (universal-time nil :type integer) + (is-annotation nil :type boolean) + (annotations nil :type list) + (annotation-counter 0 :type integer)) (defclass new-paste-handler (araneida:handler) ()) -(defclass submit-paste-handler (araneida:handler) - ((username - :accessor username - :initform "") - (title - :accessor title - :initform "") - (text - :accessor text - :initform ""))) +(defclass list-paste-handler (araneida:handler) ()) + +(defclass submit-paste-handler (araneida:handler) ()) (defclass display-paste-handler (araneida:handler) ()) (defmethod araneida:handle-request-response ((handler new-paste-handler) method request) (araneida:request-send-headers request :expires 0) - (new-paste-form request)) + (let* ((annotate-string (araneida:body-param "annotate" (araneida:request-body request))) + (annotate-number (if annotate-string (parse-integer annotate-string :junk-allowed t))) + (annotate (if annotate-number (find annotate-number *pastes* :key #'paste-number)))) + (new-paste-form request :annotate annotate))) + +(defun bottom-links () + `((hr) + ((a :href ,(araneida:urlstring *new-paste-url*)) "New paste") + " | " + ((a :href ,(araneida:urlstring *list-paste-url*)) "List all pastes") + " | " + ((a :href "http://common-lisp.net/project/lisppaste") "lisppaste home page"))) + +(defun time-delta (time) + (let ((delta (- (get-universal-time) time))) + (cond + ((< delta 1) "<Doc Brown>From the future...</Doc Brown>") + ((< delta 60) (format nil "~D seconds ago" delta)) + ((< delta (* 60 60)) (format nil "~D minutes ago" (floor delta 60))) + ((< delta (* 60 60 24)) (format nil "~D hours ago" (floor delta (* 60 60)))) + ((< delta (* 60 60 24 7)) (format nil "~D days ago" (floor delta (* 60 60 24)))) + ((< delta (* 60 60 24 7 487/16)) (format nil "~D weeks ago" (floor delta (* 60 60 24 7)))) + ((< delta (* 60 60 24 7 487/16 12)) (format nil "~D months ago" (floor delta (* 60 60 24 7 487/16)))) + (t (format nil "~D years ago" (floor delta (* 60 60 24 7 (+ 365 1/4)))))))) -(defun new-paste-form (request &optional (message "")) +(defmethod araneida:handle-request-response ((handler list-paste-handler) method request) + (araneida:request-send-headers request :expires 0) (araneida:html-stream (araneida:request-stream request) `(html - (head (title "Paste")) + (head (title "All pastes")) (body - (h1 "Enter your paste") + (center (h2 "All pastes in system")) + ((table :width "100%" :cellpadding 2) + (tr (td) (td "By") (td "When") (td "Titled") (td "Ann.")) + ,@(reverse (mapcar #'(lambda (paste) + `(tr ((td :nowrap) ((a :href ,(araneida:urlstring (araneida:merge-url *display-paste-url* (prin1-to-string (paste-number paste))))) + ,(concatenate 'string "#" (prin1-to-string (paste-number paste))))) + ((td :nowrap) ,(encode-for-pre (paste-user paste))) + ((td :nowrap) ,(time-delta (paste-universal-time paste))) + ((td :width "100%" :bgcolor "#F4F4F4" :nowrap) ,(encode-for-pre (paste-title paste))) + ((td :nowrap) ,(length (paste-annotations paste))))) + *pastes*))) + ,@(bottom-links))))) + +(defun new-paste-form (request &key (message "") (annotate nil)) + (araneida:html-stream + (araneida:request-stream request) + `(html + (head (title ,(if annotate "Annotate" "Paste"))) + (body + (h1 ,(if annotate "Enter your annotation" "Enter your paste")) ((font :color red) (h2 ,message)) ((form :method post :action ,(araneida:urlstring *submit-paste-url*)) (p "Enter a username, title, and paste contents into the fields below. The -paste will appear on " ,*channel* " @ " ,(irc:server-name *connection*) ".") +paste will be announced on " ,*channel* " @ " ,(irc:server-name *connection*) ".") + ,@(if annotate + `((p "This paste will be used to annotate " + ((a :href ,(araneida:urlstring (araneida:merge-url *display-paste-url* (prin1-to-string (paste-number annotate))))) ,(concatenate 'string (paste-title annotate) "."))) + ((input :type hidden :name "annotate" :value ,(prin1-to-string (paste-number annotate)))))) (hr) (table (tr @@ -55,47 +98,57 @@ (td ((textarea :rows 24 :cols 80 :name "text")))) (tr ((th) "Submit your paste:") - ((td) ((input :type submit :value "Submit paste")) " " ((input :type reset :value "Clear paste")))))))))) + ((td) ((input :type submit :value "Submit paste")) " " ((input :type reset :value "Clear paste")))))) + ,@(bottom-links))))) (defmethod araneida:handle-request-response ((handler submit-paste-handler) method request) - (setf (username handler) (araneida:body-param "username" (araneida:request-body request)) - (title handler) (araneida:body-param "title" (araneida:request-body request)) - (text handler) (araneida:body-param "text" (araneida:request-body request))) - (araneida:request-send-headers request) - - (with-slots (username title text) handler + (let ((username (araneida:body-param "username" (araneida:request-body request))) + (title (araneida:body-param "title" (araneida:request-body request))) + (text (araneida:body-param "text" (araneida:request-body request))) + (annotate (araneida:body-param "annotate" (araneida:request-body request)))) + (araneida:request-send-headers request) + (cond - ((zerop (length username)) - (new-paste-form request "Please enter your username.")) - ((zerop (length title)) - (new-paste-form request "Please enter a title.")) - ((zerop (length text)) - (new-paste-form request "Please enter your paste.")) - (t - (progn - (incf *paste-counter*) - (let ((url (araneida:urlstring - (araneida:merge-url *display-paste-url* - (prin1-to-string *paste-counter*)))) - (external-url (araneida:urlstring - (araneida:merge-url *display-paste-url* - (prin1-to-string *paste-counter*)))) - (paste (make-paste :number *paste-counter* - :user username - :title title - :contents text - :universal-time (get-universal-time)))) - (irc:privmsg *connection* *channel* - (format nil "~A pasted ~A at ~A" username title external-url)) - (push paste *pastes*) - (araneida:html-stream - (araneida:request-stream request) - `(html - (head (title "Paste number " ,*paste-counter*)) - (body - (h1 "Pasted!") - (p "Your paste should be available at " ((a :href ,url) ,url) ", and -was also sent to " ,*channel* " @ " ,(irc:server-name *connection*))))))))))) + ((zerop (length username)) + (new-paste-form request :message "Please enter your username.")) + ((zerop (length title)) + (new-paste-form request :message "Please enter a title.")) + ((zerop (length text)) + (new-paste-form request :message "Please enter your paste.")) + ((and annotate (not (parse-integer annotate :junk-allowed t))) + (new-paste-form request :message "Malformed annotation request.")) + (t + + (let* ((paste-number (if annotate (parse-integer annotate :junk-allowed t) (incf *paste-counter*))) + (paste-to-annotate (if annotate (find paste-number *pastes* :key #'paste-number))) + (annotation-number (if annotate (incf (paste-annotation-counter paste-to-annotate))))) + (let ((url (araneida:urlstring + (araneida:merge-url *display-paste-url* + (if annotate + (concatenate 'string (prin1-to-string paste-number) + "#" + (prin1-to-string annotation-number)) + (prin1-to-string paste-number))))) + (paste (make-paste :number (if annotate annotation-number paste-number) + :user username + :title title + :contents text + :universal-time (get-universal-time)))) + (irc:privmsg *connection* *channel* + (if annotate + (format nil "~A annotated #~A with ~A at ~A" username paste-number title url) + (format nil "~A pasted ~A at ~A" username title url))) + (if annotate + (push paste (paste-annotations paste-to-annotate)) + (push paste *pastes*)) + (araneida:html-stream + (araneida:request-stream request) + `(html + (head (title "Paste number " ,*paste-counter*)) + (body + (h1 "Pasted!") + (p ,(if annotate "Your annotation should be available at " "Your paste should be available at ") ((a :href ,url) ,url) ", and was also sent to " ,*channel* " @ " ,(irc:server-name *connection*)) + ,@(bottom-links)))))))))) (defmethod araneida:handle-request-response ((handler display-paste-handler) method request) (araneida:request-send-headers request :expires 0) @@ -113,22 +166,61 @@ (head (title "Paste number " ,paste-number)) (body - (h2 "Paste number " ,paste-number ": " ,(encode-for-pre (paste-title paste))) - (p "Pasted by: " ,(encode-for-pre (paste-user paste))) - (hr) - (pre ,(encode-for-pre (paste-contents paste)))))) + ((table :width "100%" :cellpadding 2) + (tr ((td :align "left" :nowrap) "Paste number " ,paste-number ": ") + ((td :width "100%") (b ,(encode-for-pre (paste-title paste))))) + (tr ((td :align "left" :nowrap) "Pasted by: ") + ((td :width "100%") ,(encode-for-pre (paste-user paste)))) + (tr (td) + ((td :width "100%") ,(time-delta (paste-universal-time paste)))) + (tr ((td :align "left" :valign "top" :nowrap) "Paste contents:") + (td)) + (tr (td (p))) + (tr ((td :bgcolor "#F4F4F4" :colspan 2 :width "100%") (pre ,(encode-for-pre (paste-contents paste))))) + ,@(if (paste-annotations paste) + `((tr (td (p)) (td)) + (tr ((th :align "left" :colspan 2) "Annotations for this paste: ")) + ,@(reduce #'append + (mapcar #'(lambda (a) + `((tr (td (p)) (td)) + (tr + (td ((a :name ,(prin1-to-string (paste-number a)))"Annotation title:")) + (td ,(encode-for-pre (paste-title a)))) + (tr + (td "Annotated by:") + (td ,(encode-for-pre (paste-user a)))) + (tr + (td) + (td ,(time-delta (paste-universal-time a)))) + (tr + ((td :valign "top" :nowrap) "Annotation contents:") + ((td :bgcolor "#F4F4F4" :width "100%") (pre ,(encode-for-pre (paste-contents a))))))) + (paste-annotations paste)))) + `((tr (td (p)) (td)) + (tr ((td :align "left" :colspan 2 :nowrap) "This paste has no annotations."))))) + (p) + ((form :method post :action ,(araneida:urlstring *new-paste-url*)) + ((input :type hidden :name "annotate" :value ,(prin1-to-string (paste-number paste)))) + (center ((input :type submit :value "Annotate this paste")))) + ,@(bottom-links)))) (araneida:html-stream (araneida:request-stream request) `(html (head (title "Invalid paste number" ,paste-number)) (body - (h3 "No paste numbered " ,paste-number " could be found."))))))) + (h3 "No paste numbered " ,paste-number " could be found.") + ,@(bottom-links))))))) (araneida:install-handler (araneida:http-listener-handler *paste-listener*) (make-instance 'new-paste-handler) (araneida:urlstring *new-paste-url*) t) + +(araneida:install-handler + (araneida:http-listener-handler *paste-listener*) + (make-instance 'list-paste-handler) + (araneida:urlstring *list-paste-url*) t) (araneida:install-handler (araneida:http-listener-handler *paste-listener*) From bmastenbrook at common-lisp.net Wed Nov 12 04:38:12 2003 From: bmastenbrook at common-lisp.net (Brian Mastenbrook) Date: Tue, 11 Nov 2003 23:38:12 -0500 Subject: [Lisppaste-cvs] CVS update: lisppaste2/web-server.lisp Message-ID: Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/tmp/cvs-serv14643 Modified Files: web-server.lisp Log Message: Better time-delta function Date: Tue Nov 11 23:38:12 2003 Author: bmastenbrook Index: lisppaste2/web-server.lisp diff -u lisppaste2/web-server.lisp:1.9 lisppaste2/web-server.lisp:1.10 --- lisppaste2/web-server.lisp:1.9 Tue Nov 11 23:19:38 2003 +++ lisppaste2/web-server.lisp Tue Nov 11 23:38:11 2003 @@ -1,4 +1,4 @@ -;;;; $Id: web-server.lisp,v 1.9 2003/11/12 04:19:38 bmastenbrook Exp $ +;;;; $Id: web-server.lisp,v 1.10 2003/11/12 04:38:11 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -42,13 +42,35 @@ (let ((delta (- (get-universal-time) time))) (cond ((< delta 1) "<Doc Brown>From the future...</Doc Brown>") - ((< delta 60) (format nil "~D seconds ago" delta)) - ((< delta (* 60 60)) (format nil "~D minutes ago" (floor delta 60))) - ((< delta (* 60 60 24)) (format nil "~D hours ago" (floor delta (* 60 60)))) - ((< delta (* 60 60 24 7)) (format nil "~D days ago" (floor delta (* 60 60 24)))) - ((< delta (* 60 60 24 7 487/16)) (format nil "~D weeks ago" (floor delta (* 60 60 24 7)))) - ((< delta (* 60 60 24 7 487/16 12)) (format nil "~D months ago" (floor delta (* 60 60 24 7 487/16)))) - (t (format nil "~D years ago" (floor delta (* 60 60 24 7 (+ 365 1/4)))))))) + ((< delta (* 60 60)) (format nil "~A ago" (time-delta-primitive delta 1))) + (t (format nil "~A ago" (time-delta-primitive delta)))))) + +(defun first-<-mod (n &rest nums) + (some #'(lambda (n2) + (if (< n2 n) (mod n n2) nil)) nums)) + +(defun time-delta-primitive (delta &optional (level 2)) + (let* ((seconds 60) + (minutes (* seconds 60)) + (hours (* minutes 24)) + (days (* hours 7)) + (weeks (* days 487/16)) + (months (* weeks 12)) + (years (* hours (+ 365 1/4)))) + (let ((primitive + (cond + ((< delta seconds) (format nil "~D second~:P" delta)) + ((< delta minutes) (format nil "~D minute~:P" (floor delta seconds))) + ((< delta hours) (format nil "~D hour~:P" (floor delta minutes))) + ((< delta days) (format nil "~D day~:P" (floor delta hours))) + ((< delta weeks) (format nil "~D week~:P" (floor delta days))) + ((< delta months) (format nil "~D month~:P" (floor delta weeks))) + (t (format nil "~D years" (floor delta years)))))) + (if (eql level 1) primitive + (format nil "~A, ~A" primitive + (time-delta-primitive + (first-<-mod delta years months weeks days hours minutes seconds) + (1- level))))))) (defmethod araneida:handle-request-response ((handler list-paste-handler) method request) (araneida:request-send-headers request :expires 0) From bmastenbrook at common-lisp.net Wed Nov 12 05:38:46 2003 From: bmastenbrook at common-lisp.net (Brian Mastenbrook) Date: Wed, 12 Nov 2003 00:38:46 -0500 Subject: [Lisppaste-cvs] CVS update: lisppaste2/web-server.lisp Message-ID: Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/tmp/cvs-serv7490 Modified Files: web-server.lisp Log Message: Changed HTML output a slight bit Date: Wed Nov 12 00:38:46 2003 Author: bmastenbrook Index: lisppaste2/web-server.lisp diff -u lisppaste2/web-server.lisp:1.10 lisppaste2/web-server.lisp:1.11 --- lisppaste2/web-server.lisp:1.10 Tue Nov 11 23:38:11 2003 +++ lisppaste2/web-server.lisp Wed Nov 12 00:38:46 2003 @@ -1,4 +1,4 @@ -;;;; $Id: web-server.lisp,v 1.10 2003/11/12 04:38:11 bmastenbrook Exp $ +;;;; $Id: web-server.lisp,v 1.11 2003/11/12 05:38:46 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -190,11 +190,11 @@ (body ((table :width "100%" :cellpadding 2) (tr ((td :align "left" :nowrap) "Paste number " ,paste-number ": ") - ((td :width "100%") (b ,(encode-for-pre (paste-title paste))))) + ((td :width "100%" :align "left") (b ,(encode-for-pre (paste-title paste))))) (tr ((td :align "left" :nowrap) "Pasted by: ") - ((td :width "100%") ,(encode-for-pre (paste-user paste)))) + ((td :width "100%" :align "left") ,(encode-for-pre (paste-user paste)))) (tr (td) - ((td :width "100%") ,(time-delta (paste-universal-time paste)))) + ((td :width "100%" :align "left") ,(time-delta (paste-universal-time paste)))) (tr ((td :align "left" :valign "top" :nowrap) "Paste contents:") (td)) (tr (td (p))) @@ -206,7 +206,7 @@ (mapcar #'(lambda (a) `((tr (td (p)) (td)) (tr - (td ((a :name ,(prin1-to-string (paste-number a)))"Annotation title:")) + (td ((a :name ,(prin1-to-string (paste-number a))) "Annotation title:")) (td ,(encode-for-pre (paste-title a)))) (tr (td "Annotated by:") From bmastenbrook at common-lisp.net Wed Nov 12 05:43:12 2003 From: bmastenbrook at common-lisp.net (Brian Mastenbrook) Date: Wed, 12 Nov 2003 00:43:12 -0500 Subject: [Lisppaste-cvs] CVS update: lisppaste2/web-server.lisp Message-ID: Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/tmp/cvs-serv9265 Modified Files: web-server.lisp Log Message: Minor changes Date: Wed Nov 12 00:43:12 2003 Author: bmastenbrook Index: lisppaste2/web-server.lisp diff -u lisppaste2/web-server.lisp:1.11 lisppaste2/web-server.lisp:1.12 --- lisppaste2/web-server.lisp:1.11 Wed Nov 12 00:38:46 2003 +++ lisppaste2/web-server.lisp Wed Nov 12 00:43:11 2003 @@ -1,4 +1,4 @@ -;;;; $Id: web-server.lisp,v 1.11 2003/11/12 05:38:46 bmastenbrook Exp $ +;;;; $Id: web-server.lisp,v 1.12 2003/11/12 05:43:11 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -38,12 +38,12 @@ " | " ((a :href "http://common-lisp.net/project/lisppaste") "lisppaste home page"))) -(defun time-delta (time) +(defun time-delta (time &optional (level 2)) (let ((delta (- (get-universal-time) time))) (cond ((< delta 1) "<Doc Brown>From the future...</Doc Brown>") ((< delta (* 60 60)) (format nil "~A ago" (time-delta-primitive delta 1))) - (t (format nil "~A ago" (time-delta-primitive delta)))))) + (t (format nil "~A ago" (time-delta-primitive delta level)))))) (defun first-<-mod (n &rest nums) (some #'(lambda (n2) @@ -86,7 +86,7 @@ `(tr ((td :nowrap) ((a :href ,(araneida:urlstring (araneida:merge-url *display-paste-url* (prin1-to-string (paste-number paste))))) ,(concatenate 'string "#" (prin1-to-string (paste-number paste))))) ((td :nowrap) ,(encode-for-pre (paste-user paste))) - ((td :nowrap) ,(time-delta (paste-universal-time paste))) + ((td :nowrap) ,(time-delta (paste-universal-time paste) 1)) ((td :width "100%" :bgcolor "#F4F4F4" :nowrap) ,(encode-for-pre (paste-title paste))) ((td :nowrap) ,(length (paste-annotations paste))))) *pastes*))) @@ -207,13 +207,13 @@ `((tr (td (p)) (td)) (tr (td ((a :name ,(prin1-to-string (paste-number a))) "Annotation title:")) - (td ,(encode-for-pre (paste-title a)))) + ((td :align "left") ,(encode-for-pre (paste-title a)))) (tr (td "Annotated by:") - (td ,(encode-for-pre (paste-user a)))) + ((td :align "left") ,(encode-for-pre (paste-user a)))) (tr (td) - (td ,(time-delta (paste-universal-time a)))) + ((td :align "left") ,(time-delta (paste-universal-time a)))) (tr ((td :valign "top" :nowrap) "Annotation contents:") ((td :bgcolor "#F4F4F4" :width "100%") (pre ,(encode-for-pre (paste-contents a))))))) From bmastenbrook at common-lisp.net Wed Nov 12 05:58:57 2003 From: bmastenbrook at common-lisp.net (Brian Mastenbrook) Date: Wed, 12 Nov 2003 00:58:57 -0500 Subject: [Lisppaste-cvs] CVS update: lisppaste2/encode-for-pre.lisp lisppaste2/web-server.lisp Message-ID: Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/tmp/cvs-serv14987 Modified Files: encode-for-pre.lisp web-server.lisp Log Message: Use encode-for-tt and Date: Wed Nov 12 00:58:56 2003 Author: bmastenbrook Index: lisppaste2/encode-for-pre.lisp diff -u lisppaste2/encode-for-pre.lisp:1.1.1.1 lisppaste2/encode-for-pre.lisp:1.2 --- lisppaste2/encode-for-pre.lisp:1.1.1.1 Mon Nov 3 12:17:53 2003 +++ lisppaste2/encode-for-pre.lisp Wed Nov 12 00:58:56 2003 @@ -1,4 +1,4 @@ -;;;; $Id: encode-for-pre.lisp,v 1.1.1.1 2003/11/03 17:17:53 eenge Exp $ +;;;; $Id: encode-for-pre.lisp,v 1.2 2003/11/12 05:58:56 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/encode-for-pre.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -21,4 +21,9 @@ (defun encode-for-pre (str) (replace-in-string (replace-in-string - (replace-in-string str #\& "&") #\< "<") #\> ">")) \ No newline at end of file + (replace-in-string str #\& "&") #\< "<") #\> ">")) + +(defun encode-for-tt (str) + (replace-in-string + (replace-in-string + (replace-in-string str #\newline "") #\return "
") #\linefeed "")) \ No newline at end of file Index: lisppaste2/web-server.lisp diff -u lisppaste2/web-server.lisp:1.12 lisppaste2/web-server.lisp:1.13 --- lisppaste2/web-server.lisp:1.12 Wed Nov 12 00:43:11 2003 +++ lisppaste2/web-server.lisp Wed Nov 12 00:58:56 2003 @@ -1,4 +1,4 @@ -;;;; $Id: web-server.lisp,v 1.12 2003/11/12 05:43:11 bmastenbrook Exp $ +;;;; $Id: web-server.lisp,v 1.13 2003/11/12 05:58:56 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -189,16 +189,16 @@ (title "Paste number " ,paste-number)) (body ((table :width "100%" :cellpadding 2) - (tr ((td :align "left" :nowrap) "Paste number " ,paste-number ": ") - ((td :width "100%" :align "left") (b ,(encode-for-pre (paste-title paste))))) + (tr ((td :align "left" :width "0%" :nowrap) "Paste number " ,paste-number ": ") + ((td :align "left" :width "100%") (b ,(encode-for-pre (paste-title paste))))) (tr ((td :align "left" :nowrap) "Pasted by: ") - ((td :width "100%" :align "left") ,(encode-for-pre (paste-user paste)))) + ((td :align "left" :width "100%") ,(encode-for-pre (paste-user paste)))) (tr (td) - ((td :width "100%" :align "left") ,(time-delta (paste-universal-time paste)))) + ((td :align "left" :width "100%") ,(time-delta (paste-universal-time paste)))) (tr ((td :align "left" :valign "top" :nowrap) "Paste contents:") - (td)) + ((td :width "100%"))) (tr (td (p))) - (tr ((td :bgcolor "#F4F4F4" :colspan 2 :width "100%") (pre ,(encode-for-pre (paste-contents paste))))) + (tr ((td :bgcolor "#F4F4F4" :colspan 2 :width "100%") (tt ,(encode-for-tt (paste-contents paste))))) ,@(if (paste-annotations paste) `((tr (td (p)) (td)) (tr ((th :align "left" :colspan 2) "Annotations for this paste: ")) @@ -216,7 +216,7 @@ ((td :align "left") ,(time-delta (paste-universal-time a)))) (tr ((td :valign "top" :nowrap) "Annotation contents:") - ((td :bgcolor "#F4F4F4" :width "100%") (pre ,(encode-for-pre (paste-contents a))))))) + ((td :bgcolor "#F4F4F4" :width "100%") (tt ,(encode-for-tt (paste-contents a))))))) (paste-annotations paste)))) `((tr (td (p)) (td)) (tr ((td :align "left" :colspan 2 :nowrap) "This paste has no annotations."))))) From bmastenbrook at common-lisp.net Wed Nov 12 06:04:14 2003 From: bmastenbrook at common-lisp.net (Brian Mastenbrook) Date: Wed, 12 Nov 2003 01:04:14 -0500 Subject: [Lisppaste-cvs] CVS update: lisppaste2/web-server.lisp Message-ID: Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/tmp/cvs-serv18295 Modified Files: web-server.lisp Log Message: Fix the order of the annotations Date: Wed Nov 12 01:04:14 2003 Author: bmastenbrook Index: lisppaste2/web-server.lisp diff -u lisppaste2/web-server.lisp:1.13 lisppaste2/web-server.lisp:1.14 --- lisppaste2/web-server.lisp:1.13 Wed Nov 12 00:58:56 2003 +++ lisppaste2/web-server.lisp Wed Nov 12 01:04:14 2003 @@ -1,4 +1,4 @@ -;;;; $Id: web-server.lisp,v 1.13 2003/11/12 05:58:56 bmastenbrook Exp $ +;;;; $Id: web-server.lisp,v 1.14 2003/11/12 06:04:14 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -202,7 +202,7 @@ ,@(if (paste-annotations paste) `((tr (td (p)) (td)) (tr ((th :align "left" :colspan 2) "Annotations for this paste: ")) - ,@(reduce #'append + ,@(reduce #'append (nreverse (mapcar #'(lambda (a) `((tr (td (p)) (td)) (tr @@ -217,7 +217,7 @@ (tr ((td :valign "top" :nowrap) "Annotation contents:") ((td :bgcolor "#F4F4F4" :width "100%") (tt ,(encode-for-tt (paste-contents a))))))) - (paste-annotations paste)))) + (paste-annotations paste))))) `((tr (td (p)) (td)) (tr ((td :align "left" :colspan 2 :nowrap) "This paste has no annotations."))))) (p) From bmastenbrook at common-lisp.net Wed Nov 12 06:18:55 2003 From: bmastenbrook at common-lisp.net (Brian Mastenbrook) Date: Wed, 12 Nov 2003 01:18:55 -0500 Subject: [Lisppaste-cvs] CVS update: lisppaste2/web-server.lisp Message-ID: Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/tmp/cvs-serv23000 Modified Files: web-server.lisp Log Message: Added a note about the annotation functionality on the post-submission page. Date: Wed Nov 12 01:18:55 2003 Author: bmastenbrook Index: lisppaste2/web-server.lisp diff -u lisppaste2/web-server.lisp:1.14 lisppaste2/web-server.lisp:1.15 --- lisppaste2/web-server.lisp:1.14 Wed Nov 12 01:04:14 2003 +++ lisppaste2/web-server.lisp Wed Nov 12 01:18:55 2003 @@ -1,4 +1,4 @@ -;;;; $Id: web-server.lisp,v 1.14 2003/11/12 06:04:14 bmastenbrook Exp $ +;;;; $Id: web-server.lisp,v 1.15 2003/11/12 06:18:55 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -170,6 +170,7 @@ (body (h1 "Pasted!") (p ,(if annotate "Your annotation should be available at " "Your paste should be available at ") ((a :href ,url) ,url) ", and was also sent to " ,*channel* " @ " ,(irc:server-name *connection*)) + (p "If you wish to paste a correction or addendum to this paste, you can annotate the paste using the submission button on the " ((a :href ,url) "paste's page.")) ,@(bottom-links)))))))))) (defmethod araneida:handle-request-response ((handler display-paste-handler) method request) From bmastenbrook at common-lisp.net Wed Nov 12 06:23:43 2003 From: bmastenbrook at common-lisp.net (Brian Mastenbrook) Date: Wed, 12 Nov 2003 01:23:43 -0500 Subject: [Lisppaste-cvs] CVS update: lisppaste2/web-server.lisp Message-ID: Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/tmp/cvs-serv24766 Modified Files: web-server.lisp Log Message: Removing redundant superflous verbage. Date: Wed Nov 12 01:23:43 2003 Author: bmastenbrook Index: lisppaste2/web-server.lisp diff -u lisppaste2/web-server.lisp:1.15 lisppaste2/web-server.lisp:1.16 --- lisppaste2/web-server.lisp:1.15 Wed Nov 12 01:18:55 2003 +++ lisppaste2/web-server.lisp Wed Nov 12 01:23:43 2003 @@ -1,4 +1,4 @@ -;;;; $Id: web-server.lisp,v 1.15 2003/11/12 06:18:55 bmastenbrook Exp $ +;;;; $Id: web-server.lisp,v 1.16 2003/11/12 06:23:43 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -207,16 +207,16 @@ (mapcar #'(lambda (a) `((tr (td (p)) (td)) (tr - (td ((a :name ,(prin1-to-string (paste-number a))) "Annotation title:")) + (td ((a :name ,(prin1-to-string (paste-number a))) "Title:")) ((td :align "left") ,(encode-for-pre (paste-title a)))) (tr - (td "Annotated by:") + (td "By:") ((td :align "left") ,(encode-for-pre (paste-user a)))) (tr (td) ((td :align "left") ,(time-delta (paste-universal-time a)))) (tr - ((td :valign "top" :nowrap) "Annotation contents:") + ((td :valign "top" :nowrap) "Contents:") ((td :bgcolor "#F4F4F4" :width "100%") (tt ,(encode-for-tt (paste-contents a))))))) (paste-annotations paste))))) `((tr (td (p)) (td)) From bmastenbrook at common-lisp.net Thu Nov 13 04:30:57 2003 From: bmastenbrook at common-lisp.net (Brian Mastenbrook) Date: Wed, 12 Nov 2003 23:30:57 -0500 Subject: [Lisppaste-cvs] CVS update: lisppaste2/encode-for-pre.lisp Message-ID: Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/tmp/cvs-serv22707 Modified Files: encode-for-pre.lisp Log Message: Fix for multiple spaces. Date: Wed Nov 12 23:30:55 2003 Author: bmastenbrook Index: lisppaste2/encode-for-pre.lisp diff -u lisppaste2/encode-for-pre.lisp:1.2 lisppaste2/encode-for-pre.lisp:1.3 --- lisppaste2/encode-for-pre.lisp:1.2 Wed Nov 12 00:58:56 2003 +++ lisppaste2/encode-for-pre.lisp Wed Nov 12 23:30:54 2003 @@ -1,4 +1,4 @@ -;;;; $Id: encode-for-pre.lisp,v 1.2 2003/11/12 05:58:56 bmastenbrook Exp $ +;;;; $Id: encode-for-pre.lisp,v 1.3 2003/11/13 04:30:54 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/encode-for-pre.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -26,4 +26,7 @@ (defun encode-for-tt (str) (replace-in-string (replace-in-string - (replace-in-string str #\newline "") #\return "
") #\linefeed "")) \ No newline at end of file + (replace-in-string + (replace-in-string + (replace-in-string str #\newline "") #\return "
") #\linefeed "") + #\space " ") #\tab "    ")) \ No newline at end of file From bmastenbrook at common-lisp.net Thu Nov 13 04:34:21 2003 From: bmastenbrook at common-lisp.net (Brian Mastenbrook) Date: Wed, 12 Nov 2003 23:34:21 -0500 Subject: [Lisppaste-cvs] CVS update: lisppaste2/encode-for-pre.lisp Message-ID: Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/tmp/cvs-serv24534 Modified Files: encode-for-pre.lisp Log Message: One more fix Date: Wed Nov 12 23:34:20 2003 Author: bmastenbrook Index: lisppaste2/encode-for-pre.lisp diff -u lisppaste2/encode-for-pre.lisp:1.3 lisppaste2/encode-for-pre.lisp:1.4 --- lisppaste2/encode-for-pre.lisp:1.3 Wed Nov 12 23:30:54 2003 +++ lisppaste2/encode-for-pre.lisp Wed Nov 12 23:34:20 2003 @@ -1,4 +1,4 @@ -;;;; $Id: encode-for-pre.lisp,v 1.3 2003/11/13 04:30:54 bmastenbrook Exp $ +;;;; $Id: encode-for-pre.lisp,v 1.4 2003/11/13 04:34:20 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/encode-for-pre.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -28,5 +28,5 @@ (replace-in-string (replace-in-string (replace-in-string - (replace-in-string str #\newline "") #\return "
") #\linefeed "") + (replace-in-string (encode-for-pre str) #\newline "") #\return "
") #\linefeed "") #\space " ") #\tab "    ")) From bmastenbrook at common-lisp.net Sun Nov 30 22:16:47 2003 From: bmastenbrook at common-lisp.net (Brian Mastenbrook) Date: Sun, 30 Nov 2003 17:16:47 -0500 Subject: [Lisppaste-cvs] CVS update: lisppaste2/encode-for-pre.lisp Message-ID: Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/tmp/cvs-serv13757 Modified Files: encode-for-pre.lisp Log Message: Attempt to make this a little less slow Date: Sun Nov 30 17:16:46 2003 Author: bmastenbrook Index: lisppaste2/encode-for-pre.lisp diff -u lisppaste2/encode-for-pre.lisp:1.4 lisppaste2/encode-for-pre.lisp:1.5 --- lisppaste2/encode-for-pre.lisp:1.4 Wed Nov 12 23:34:20 2003 +++ lisppaste2/encode-for-pre.lisp Sun Nov 30 17:16:45 2003 @@ -1,32 +1,27 @@ -;;;; $Id: encode-for-pre.lisp,v 1.4 2003/11/13 04:34:20 bmastenbrook Exp $ +;;;; $Id: encode-for-pre.lisp,v 1.5 2003/11/30 22:16:45 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/encode-for-pre.lisp,v $ ;;;; See the LICENSE file for licensing information. (in-package :lisppaste) -(defun replace-in-string (str char repstr) - (declare (type string str repstr)) - (let ((stri str) - (startpos 0)) - (tagbody - start - (let ((pos (position char stri :test #'char= :start startpos))) - (when pos - (setf stri (concatenate 'string (subseq stri 0 pos) repstr (subseq stri (1+ pos) (length stri)))) - (setf startpos (+ pos (length repstr))) - (go start)))) - stri)) +(defun replace-in-string (str chars repstrs) + (declare (type string str)) + (let ((stri str)) + (loop for char in chars for repstr in repstrs do + (let ((startpos 0)) + (tagbody + start + (let ((pos (position char stri :test #'char= :start startpos))) + (when pos + (setf stri (concatenate 'string (subseq stri 0 pos) repstr (subseq stri (1+ pos) (length stri)))) + (setf startpos (+ pos (length repstr))) + (go start)))) + stri)) + stri)) (defun encode-for-pre (str) - (replace-in-string - (replace-in-string - (replace-in-string str #\& "&") #\< "<") #\> ">")) + (replace-in-string str '(#\& #\< #\>) '("&" "<" ">"))) (defun encode-for-tt (str) - (replace-in-string - (replace-in-string - (replace-in-string - (replace-in-string - (replace-in-string (encode-for-pre str) #\newline "") #\return "
") #\linefeed "") - #\space " ") #\tab "    ")) \ No newline at end of file + (replace-in-string str '(#\& #\< #\> #\newline #\return #\linefeed #\space #\tab) '("&" "<" ">" "" "
" "" " " "    "))) \ No newline at end of file From bmastenbrook at common-lisp.net Sun Nov 30 22:32:46 2003 From: bmastenbrook at common-lisp.net (Brian Mastenbrook) Date: Sun, 30 Nov 2003 17:32:46 -0500 Subject: [Lisppaste-cvs] CVS update: lisppaste2/encode-for-pre.lisp Message-ID: Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/tmp/cvs-serv19766 Modified Files: encode-for-pre.lisp Log Message: Further optimization Date: Sun Nov 30 17:32:45 2003 Author: bmastenbrook Index: lisppaste2/encode-for-pre.lisp diff -u lisppaste2/encode-for-pre.lisp:1.5 lisppaste2/encode-for-pre.lisp:1.6 --- lisppaste2/encode-for-pre.lisp:1.5 Sun Nov 30 17:16:45 2003 +++ lisppaste2/encode-for-pre.lisp Sun Nov 30 17:32:45 2003 @@ -1,23 +1,32 @@ -;;;; $Id: encode-for-pre.lisp,v 1.5 2003/11/30 22:16:45 bmastenbrook Exp $ +;;;; $Id: encode-for-pre.lisp,v 1.6 2003/11/30 22:32:45 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/encode-for-pre.lisp,v $ ;;;; See the LICENSE file for licensing information. (in-package :lisppaste) +(defun replace-in-string-1 (str char repstr) + (let* ((new-length (loop for i from 0 to (1- (length str)) + summing (if (char= (elt str i) char) + (length repstr) 1))) + (new-array (make-array `(,new-length) :element-type 'character))) + (loop for i from 0 to (1- (length str)) + with j = 0 + do (if (char= (elt str i) char) + (progn + (loop for k from 0 to (1- (length repstr)) + do (setf (elt new-array (+ j k)) (elt repstr k))) + (incf j (length repstr))) + (progn + (setf (elt new-array j) (elt str i)) + (incf j)))) + new-array)) + (defun replace-in-string (str chars repstrs) (declare (type string str)) (let ((stri str)) (loop for char in chars for repstr in repstrs do - (let ((startpos 0)) - (tagbody - start - (let ((pos (position char stri :test #'char= :start startpos))) - (when pos - (setf stri (concatenate 'string (subseq stri 0 pos) repstr (subseq stri (1+ pos) (length stri)))) - (setf startpos (+ pos (length repstr))) - (go start)))) - stri)) + (setf stri (replace-in-string-1 stri char repstr))) stri)) (defun encode-for-pre (str)