[Lisppaste-cvs] CVS update: lisppaste2/irc-log-link.lisp lisppaste2/encode-for-pre.lisp lisppaste2/lisppaste.asd lisppaste2/package.lisp lisppaste2/persistent-pastes.lisp lisppaste2/web-server.lisp

Brian Mastenbrook bmastenbrook at common-lisp.net
Wed Feb 4 02:41:12 UTC 2004


Update of /project/lisppaste/cvsroot/lisppaste2
In directory common-lisp.net:/tmp/cvs-serv3389

Modified Files:
	encode-for-pre.lisp lisppaste.asd package.lisp 
	persistent-pastes.lisp web-server.lisp 
Added Files:
	irc-log-link.lisp 
Log Message:
IRC log links from the pastebot to the context at meme.b9.com

Date: Tue Feb  3 21:41:12 2004
Author: bmastenbrook



Index: lisppaste2/encode-for-pre.lisp
diff -u lisppaste2/encode-for-pre.lisp:1.7 lisppaste2/encode-for-pre.lisp:1.8
--- lisppaste2/encode-for-pre.lisp:1.7	Sat Jan 17 12:54:13 2004
+++ lisppaste2/encode-for-pre.lisp	Tue Feb  3 21:41:12 2004
@@ -1,4 +1,4 @@
-;;;; $Id: encode-for-pre.lisp,v 1.7 2004/01/17 17:54:13 bmastenbrook Exp $
+;;;; $Id: encode-for-pre.lisp,v 1.8 2004/02/04 02:41:12 bmastenbrook Exp $
 ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/encode-for-pre.lisp,v $
 
 ;;;; See the LICENSE file for licensing information.
@@ -41,4 +41,4 @@
   (replace-in-string str '(#\& #\< #\>) '("&" "<" ">")))
 
 (defun encode-for-tt (str)
-  (replace-in-string-1 (replace-in-string str '(#\& #\< #\> #\newline #\return #\linefeed #\tab) '("&" "<" ">" "" "<br>" "" "    ")) #\space " " 1))
\ No newline at end of file
+  (replace-in-string (replace-in-string-1 str #\space " " t) '(#\& #\< #\> #\newline #\return #\linefeed #\tab) '("&" "<" ">" "" "<br>" "" "    ")))


Index: lisppaste2/lisppaste.asd
diff -u lisppaste2/lisppaste.asd:1.3 lisppaste2/lisppaste.asd:1.4
--- lisppaste2/lisppaste.asd:1.3	Sat Jan 17 13:02:14 2004
+++ lisppaste2/lisppaste.asd	Tue Feb  3 21:41:12 2004
@@ -1,4 +1,5 @@
-;;;; $Id: lisppaste.asd,v 1.3 2004/01/17 18:02:14 bmastenbrook Exp $
+;;;; Silly emacs, this is -*- Lisp -*-
+;;;; $Id: lisppaste.asd,v 1.4 2004/02/04 02:41:12 bmastenbrook Exp $
 ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/lisppaste.asd,v $
 
 ;;;; See the LICENSE file for licensing information.
@@ -26,11 +27,10 @@
                         :depends-on ("package"))
                  (:file "encode-for-pre"
                         :depends-on ("variable"))
+                 (:file "irc-log-link")
                  (:file "web-server"
-                        :depends-on ("encode-for-pre"))
+                        :depends-on ("encode-for-pre" "irc-log-link"))
                  (:file "lisppaste"
                         :depends-on ("web-server"))
                  (:file "persistent-pastes"
                         :depends-on ("web-server"))))
-
-


Index: lisppaste2/package.lisp
diff -u lisppaste2/package.lisp:1.1.1.1 lisppaste2/package.lisp:1.2
--- lisppaste2/package.lisp:1.1.1.1	Mon Nov  3 12:17:53 2003
+++ lisppaste2/package.lisp	Tue Feb  3 21:41:12 2004
@@ -1,4 +1,4 @@
-;;;; $Id: package.lisp,v 1.1.1.1 2003/11/03 17:17:53 eenge Exp $
+;;;; $Id: package.lisp,v 1.2 2004/02/04 02:41:12 bmastenbrook Exp $
 ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/package.lisp,v $
 
 ;;;; See the LICENSE file for licensing information.
@@ -7,7 +7,7 @@
 
 (eval-when (:execute :load-toplevel :compile-toplevel)
   (defpackage :lisppaste
-      (:use :cl)
+      (:use :cl :sb-bsd-sockets)
     (:export :start-lisppaste)))
 
 


Index: lisppaste2/persistent-pastes.lisp
diff -u lisppaste2/persistent-pastes.lisp:1.5 lisppaste2/persistent-pastes.lisp:1.6
--- lisppaste2/persistent-pastes.lisp:1.5	Sat Jan 17 13:34:37 2004
+++ lisppaste2/persistent-pastes.lisp	Tue Feb  3 21:41:12 2004
@@ -8,7 +8,8 @@
    (cons 'contents (paste-contents paste))
    (cons 'universal-time (paste-universal-time paste))
    (cons 'channel (paste-channel paste))
-   (cons 'annotations (mapcar #'paste-alist (paste-annotations paste)))))
+   (cons 'annotations (mapcar #'paste-alist (paste-annotations paste)))
+   (cons 'log-link (paste-log-link paste))))
 
 (defun save-pastes-to-file (file-name)
   (let ((*package* (find-package :lisppaste)))
@@ -22,7 +23,7 @@
      , at body))
 
 (defun make-paste-from-alist (e &optional annotation)
-  (with-assoc-vals (number user title contents universal-time annotations channel) e
+  (with-assoc-vals (number user title contents universal-time annotations channel log-link) e
                    (unless annotation (setf *paste-counter* (max *paste-counter* number)))
                    (make-paste :number number
                                :user user
@@ -30,11 +31,13 @@
                                :contents contents
                                :universal-time universal-time
                                :channel (if (not channel) (car *channels*) channel)
-                               :annotations (mapcar #'(lambda (e) (make-paste-from-alist e)) annotations))))
+                               :annotations (mapcar #'(lambda (e) (make-paste-from-alist e)) annotations)
+                               :log-link (if (not log-link) "" log-link))))
 
 (defun read-pastes-from-file (file-name)
   (setf *pastes* nil)
   (let ((*package* (find-package :lisppaste)))
     (with-open-file (file file-name :direction :input :if-does-not-exist nil)
-      (let ((paste-alist (read file nil)))
-        (setf *pastes* (mapcar #'make-paste-from-alist paste-alist))))))
\ No newline at end of file
+      (if file
+          (let ((paste-alist (read file nil)))
+            (setf *pastes* (mapcar #'make-paste-from-alist paste-alist)))))))


Index: lisppaste2/web-server.lisp
diff -u lisppaste2/web-server.lisp:1.22 lisppaste2/web-server.lisp:1.23
--- lisppaste2/web-server.lisp:1.22	Tue Feb  3 20:18:38 2004
+++ lisppaste2/web-server.lisp	Tue Feb  3 21:41:12 2004
@@ -1,4 +1,4 @@
-;;;; $Id: web-server.lisp,v 1.22 2004/02/04 01:18:38 bmastenbrook Exp $
+;;;; $Id: web-server.lisp,v 1.23 2004/02/04 02:41:12 bmastenbrook Exp $
 ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $
 
 ;;;; See the LICENSE file for licensing information.
@@ -14,7 +14,8 @@
   (is-annotation nil :type boolean)
   (annotations nil :type list)
   (annotation-counter 0 :type integer)
-  (channel "" :type string))
+  (channel "" :type string)
+  (log-link "" :type string))
 
 (defclass new-paste-handler (araneida:handler) ())
 
@@ -180,7 +181,8 @@
      (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)))))
+	     (annotation-number (if annotate (incf (paste-annotation-counter paste-to-annotate))))
+             (log-link (araneida:urlstring (irc-log-link channel))))
 	(let ((url (araneida:urlstring
 		    (araneida:merge-url *display-paste-url*
 					(if annotate
@@ -193,7 +195,8 @@
 				 :title title
 				 :contents text
 				 :universal-time (get-universal-time)
-                                 :channel channel)))
+                                 :channel channel
+                                 :log-link log-link)))
 	  (irc:privmsg *connection* channel
 		       (if annotate
 			   (format nil "~A annotated #~A with \"~A\" at ~A" username paste-number title url)
@@ -238,7 +241,10 @@
 	     (tr (td)
 		 ((td :align "left" :width "100%") ,(time-delta (paste-universal-time paste))))
              (tr (td)
-		 ((td :align "left" :width "100%") ,(encode-for-pre (paste-channel paste))))
+		 ((td :align "left" :width "100%") ,(encode-for-pre (paste-channel paste))
+                  ,@(if (not (string= (paste-log-link paste) ""))
+                        `(" | "
+                          ((a :href ,(paste-log-link paste)) "Context in IRC logs")))))
 	     (tr ((td :align "left" :valign "top" :nowrap) "Paste contents:")
 		 ((td :width "100%")))
 	     (tr (td (p)))





More information about the Lisppaste-cvs mailing list