[Lisppaste-cvs] CVS update: lisppaste2/irc-notification.lisp lisppaste2/README.lisp lisppaste2/lisppaste.asd lisppaste2/lisppaste.lisp lisppaste2/package.lisp lisppaste2/variable.lisp

Brian Mastenbrook bmastenbrook at common-lisp.net
Wed Oct 20 20:22:15 UTC 2004


Update of /project/lisppaste/cvsroot/lisppaste2
In directory common-lisp.net:/home/bmastenbrook/lisppaste2

Modified Files:
	README.lisp lisppaste.asd lisppaste.lisp package.lisp 
	variable.lisp 
Added Files:
	irc-notification.lisp 
Log Message:
Support for running without IRC notification: cleanup pending; for now, take a hacksaw and separate the parts

Date: Wed Oct 20 22:22:13 2004
Author: bmastenbrook



Index: lisppaste2/README.lisp
diff -u lisppaste2/README.lisp:1.13 lisppaste2/README.lisp:1.14
--- lisppaste2/README.lisp:1.13	Fri Oct 15 20:23:15 2004
+++ lisppaste2/README.lisp	Wed Oct 20 22:22:13 2004
@@ -1,4 +1,4 @@
-;;;; $Id: README.lisp,v 1.13 2004/10/15 18:23:15 bmastenbrook Exp $
+;;;; $Id: README.lisp,v 1.14 2004/10/20 20:22:13 bmastenbrook Exp $
 ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/README.lisp,v $
 
 ;;;; See the LICENSE file for licensing information.
@@ -22,13 +22,24 @@
 ;;; httpd.conf. Then, run SBCL and invoke the magical invocation as
 ;;; follows, or simply (load "README").
 
+;;; If you wish to run without an IRC server, uncomment the following
+;;; line:
+;; (pushnew :lisppaste-no-irc *features*)
+
 (require :asdf)
 (asdf:operate 'asdf:load-op :lisppaste)
 (load (compile-file "redirect-handler"))
 
 (s-xml-rpc:start-xml-rpc-server :port 8185)
 
-(lisppaste:start-lisppaste :channels '("#lisp" "#scheme" "#opendarwin" "#macdev" "#fink" "#jedit" "#dylan" "#emacs" "#xemacs" "#colloquy" "#adium" "#growl" "#chicken" "#quicksilver" "#svn" "#slate" "#squeak" "#wiki" "#nebula" "#imgames")
-                           :nickname "lisppaste"
-                           :server "orwell.freenode.net"
-                           :port 6667)
+(lisppaste:start-lisppaste)
+
+#-lisppaste-no-irc
+(lisppaste:start-irc-notification)
+ :channels '("#lisp" "#scheme" "#opendarwin" "#macdev" "#fink"
+             "#jedit" "#dylan" "#emacs" "#xemacs" "#colloquy" "#adium"
+             "#growl" "#chicken" "#quicksilver" "#svn" "#slate"
+             "#squeak" "#wiki" "#nebula" "#imgames")
+ :nickname "lisppaste"
+ :server "orwell.freenode.net"
+ :port 6667)


Index: lisppaste2/lisppaste.asd
diff -u lisppaste2/lisppaste.asd:1.17 lisppaste2/lisppaste.asd:1.18
--- lisppaste2/lisppaste.asd:1.17	Tue Jul 27 20:47:10 2004
+++ lisppaste2/lisppaste.asd	Wed Oct 20 22:22:13 2004
@@ -1,5 +1,5 @@
 ;;;; Silly emacs, this is -*- Lisp -*-
-;;;; $Id: lisppaste.asd,v 1.17 2004/07/27 18:47:10 bmastenbrook Exp $
+;;;; $Id: lisppaste.asd,v 1.18 2004/10/20 20:22:13 bmastenbrook Exp $
 ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/lisppaste.asd,v $
 
 ;;;; See the LICENSE file for licensing information.
@@ -21,7 +21,8 @@
 paste text into it.  Once pasted, lisppaste will notify a
 pre-configured IRC channel about the paste and where it can be
 located."
-    :depends-on (:araneida :cl-irc :split-sequence :s-xml :s-xml-rpc)
+    :depends-on (:araneida #-lisppaste-no-irc :cl-irc
+                           :split-sequence :s-xml :s-xml-rpc)
     :components ((:file "encode-for-pre")
                  (:file "package" :depends-on ("encode-for-pre"))
                  (:file "variable"
@@ -33,10 +34,13 @@
                  (:file "clhs-lookup" :depends-on ("encode-for-pre" "abbrev"))
                  (:file "r5rs-lookup" :depends-on ("encode-for-pre"))
                  (:file "elisp-lookup" :depends-on ("encode-for-pre"))
+                 #-lisppaste-no-irc (:file "irc-notification" :depends-on ("variable" "package"))
                  (:file "lisppaste"
                         :depends-on ("variable" "clhs-lookup"
                                                 "r5rs-lookup"
-                                                "elisp-lookup"))
+                                                "elisp-lookup"
+                                                #-lisppaste-no-irc
+                                                "irc-notification"))
                  (:file "coloring-types"
                         :depends-on ("colorize" "clhs-lookup"))
                  (:file "web-server"


Index: lisppaste2/lisppaste.lisp
diff -u lisppaste2/lisppaste.lisp:1.24 lisppaste2/lisppaste.lisp:1.25
--- lisppaste2/lisppaste.lisp:1.24	Tue Jul 27 20:47:10 2004
+++ lisppaste2/lisppaste.lisp	Wed Oct 20 22:22:13 2004
@@ -1,107 +1,38 @@
-;;;; $Id: lisppaste.lisp,v 1.24 2004/07/27 18:47:10 bmastenbrook Exp $
+;;;; $Id: lisppaste.lisp,v 1.25 2004/10/20 20:22:13 bmastenbrook Exp $
 ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/lisppaste.lisp,v $
 
 ;;;; See the LICENSE file for licensing information.
 
 (in-package :lisppaste)
 
-(defun say-help (channel)
-  (when (and *connection*
-             (find channel *channels* :test #'string=))
-    (irc:privmsg *connection*
-                 channel
-                 (format nil "To use the lisppaste bot, visit ~A/~A and enter your paste." (araneida:urlstring *new-paste-url*) (subseq channel 1)))
-    t))
-
-(defun help-request-p (nick help text)
-  (and (> (length text)
-          (length nick))
-       (search nick text :start2 0 :end2 (length nick) :test #'char-equal)
-       (let ((url-position (search help text :start2 (length nick)
-                                   :test #'char-equal)))
-         (and
-          url-position
-          (notany #'alphanumericp (subseq text (length nick) (1- url-position)))
-          (notany #'alphanumericp (subseq text (+ url-position (length help))))))))
-
-(defun make-msg-hook (nick)
-  (lambda (message)
-    (let ((text (irc:trailing-argument message)))
-      (cond ((string= (first (irc:arguments message)) nick)
-             (irc:privmsg *connection*
-                          (irc:source message)
-                          (format nil "To use the lisppaste bot, visit ~A and enter your paste. Be sure to select the right channel!" (araneida:urlstring *new-paste-url*))))
-            ((some #'(lambda (e)
-                       (help-request-p nick e text))
-                   '("url" "help" "hello"))
-             (say-help (first (irc:arguments message))))))))
-  
-  
-(defun add-hook (nick)
-  (irc:remove-hooks *connection* 'irc:irc-privmsg-message)
-  (irc:add-hook *connection* 'irc:irc-privmsg-message (make-msg-hook nick)))
-
-(defun start-lisppaste (&key (channels (list *default-channel*))
-                             (nickname *default-nickname*)
-                             (server *default-irc-server*)
-                             (port *default-irc-server-port*))
-  "Connect to specified server, join specified channel and start
-accepting requests through the web."
-  (let ((connection (irc:connect :nickname nickname
-                                 :realname (araneida:urlstring *new-paste-url*)
-                                 :server server
-                                 :port port)))
-    (setf *connection* connection)
-    (setf *channels* channels)
-    (if *no-channel-pastes*
-        (pushnew "None" *channels* :test #'string-equal))
-    (read-xml-pastes)
-    (format t "Populating lookup table...~%")
-    (clhs-lookup:populate-table)
-    (r5rs-lookup:populate-table)
-    (elisp-lookup:populate-table)
-    (format t "Done!~%")
-    (mapcar #'(lambda (channel) (irc:join connection channel)) channels)
-    (add-hook nickname)
-    (setf *boot-time* (get-universal-time))
-    (irc:start-background-message-handler connection)
-    (araneida:start-listening *paste-listener*)))
-
-(defun join-new-channel (channel)
-  (setf *channels* (nconc *channels* (list channel)))
-  (irc:join *connection* channel))
-
-(defun hup-connection (nickname server)
-  (ignore-errors (irc:quit *connection*))
-  (setf *connection* (irc:connect :nickname nickname
-				  :realname (araneida:urlstring *new-paste-url*)
-				  :server server
-				  :port *default-irc-server-port*))
-  (mapcar #'(lambda (channel) (irc:join *connection* channel)) *channels*)
-  (add-hook nickname)
-  (irc:start-background-message-handler *connection*))
+(defun start-lisppaste ()
+  "Start accepting web requests."
+  (if *no-channel-pastes*
+      (pushnew "None" *channels* :test #'string-equal))
+  (read-xml-pastes)
+  (format t "Populating lookup table...~%")
+  (clhs-lookup:populate-table)
+  (r5rs-lookup:populate-table)
+  (elisp-lookup:populate-table)
+  (format t "Done!~%")
+  (setf *boot-time* (get-universal-time))
+  (araneida:start-listening *paste-listener*))
 
 (defmacro make-new-paste (paste-list (&optional annotate real-number annotate-list) url &rest keys
                           &key channel user title &allow-other-keys)
   (let ((paste-name (gensym)))
     `(let ((,paste-name (make-paste , at keys)))
       (if (not (string-equal ,channel "None"))
-          (irc:privmsg *connection* ,channel
-                       (if ,annotate
-                           (format nil "~A annotated #~A with \"~A\" at ~A" ,user ,real-number ,title ,url)
-                           (format nil "~A pasted \"~A\" at ~A" ,user ,title ,url))))
+          (irc-notify ,channel
+                      (if ,annotate
+                          (format nil "~A annotated #~A with \"~A\" at ~A" ,user ,real-number ,title ,url)
+                          (format nil "~A pasted \"~A\" at ~A" ,user ,title ,url))))
       ,(if annotate
            `(if ,annotate
              (push ,paste-name ,annotate-list)
              (push ,paste-name ,paste-list))
            `(push ,paste-name ,paste-list))
       (serialize-transaction ,paste-name (if ,annotate ,real-number)))))
-
-(defun shut-up ()
-  (setf (irc:client-stream *connection*) (make-broadcast-stream)))
-
-(defun un-shut-up ()
-  (setf (irc:client-stream *connection*) *trace-output*))
 
 (defun kill-paste (number)
   (let ((paste (find-paste number)))


Index: lisppaste2/package.lisp
diff -u lisppaste2/package.lisp:1.8 lisppaste2/package.lisp:1.9
--- lisppaste2/package.lisp:1.8	Tue Jul  6 18:34:24 2004
+++ lisppaste2/package.lisp	Wed Oct 20 22:22:13 2004
@@ -1,4 +1,4 @@
-;;;; $Id: package.lisp,v 1.8 2004/07/06 16:34:24 bmastenbrook Exp $
+;;;; $Id: package.lisp,v 1.9 2004/10/20 20:22:13 bmastenbrook Exp $
 ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/package.lisp,v $
 
 ;;;; See the LICENSE file for licensing information.
@@ -8,7 +8,9 @@
 (eval-when (:execute :load-toplevel :compile-toplevel)
   (defpackage :lisppaste
       (:use :cl #+sbcl :sb-bsd-sockets :html-encode)
-    (:export :start-lisppaste :join-new-channel :shut-up :un-shut-up :say-help
+    (:export :start-lisppaste :join-new-irc-channel
+             :start-irc-notification :hup-irc-connection
+             :shut-up :un-shut-up :irc-say-help
              :kill-paste :kill-paste-annotations :kill-paste-annotation
              :display-paste-url :find-paste)))
 


Index: lisppaste2/variable.lisp
diff -u lisppaste2/variable.lisp:1.31 lisppaste2/variable.lisp:1.32
--- lisppaste2/variable.lisp:1.31	Fri Oct 15 20:23:15 2004
+++ lisppaste2/variable.lisp	Wed Oct 20 22:22:13 2004
@@ -1,4 +1,4 @@
-;;;; $Id: variable.lisp,v 1.31 2004/10/15 18:23:15 bmastenbrook Exp $
+;;;; $Id: variable.lisp,v 1.32 2004/10/20 20:22:13 bmastenbrook Exp $
 ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/variable.lisp,v $
 
 ;;;; See the LICENSE file for licensing information.
@@ -48,6 +48,11 @@
 (defvar *meme-links* t) ; whether to link to meme IRC logs, probably
 			  ; only useful for freenode's lisppaste
 
+(defvar *irc-network-name* "Freenode") ; the name of the IRC network
+                                        ; lisppaste is running on; can
+                                        ; be ignored when not running
+                                        ; with an IRC connection
+
 (defvar *paste-maximum-size* 51200) ; in bytes
 
 (defvar *pastes-per-page* 50) ; for the paste list
@@ -149,6 +154,7 @@
 (defvar *pastes* nil)
 (defvar *paste-counter* 0)
 (defvar *connection* nil)
+(defvar *nickname*)
 (defvar *channels* '("None"))
 
 (defvar *paste-file*





More information about the Lisppaste-cvs mailing list