- cl-irc-cvs@common-lisp.net - mailman3.common-lisp.net

[Cl-irc-cvs] CVS update: cl-irc/example/cliki.lisp cl-irc/example/Mop_Sym.txt
by Brian Mastenbrook 03 Jun '04

03 Jun '04

Update of /project/cl-irc/cvsroot/cl-irc/example In directory common-lisp.net:/home/bmastenbrook/cl-irc/example Modified Files: cliki.lisp Removed Files: Mop_Sym.txt Log Message: CLiki: shut-up function; Mop_Sym removed Date: Thu Jun 3 07:15:16 2004 Author: bmastenbrook Index: cl-irc/example/cliki.lisp diff -u cl-irc/example/cliki.lisp:1.7 cl-irc/example/cliki.lisp:1.8 --- cl-irc/example/cliki.lisp:1.7 Tue Jun 1 08:39:15 2004 +++ cl-irc/example/cliki.lisp Thu Jun 3 07:15:16 2004 @@ -1,4 +1,4 @@ -;;;; $Id: cliki.lisp,v 1.7 2004/06/01 15:39:15 bmastenbrook Exp $ +;;;; $Id: cliki.lisp,v 1.8 2004/06/03 14:15:16 bmastenbrook Exp $ ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/example/cliki.lisp,v $ ;;;; cliki.lisp - CLiki as an infobot; only works on SBCL. @@ -9,9 +9,10 @@ (defpackage :cliki (:use :common-lisp :irc :cl-ppcre) (:export :start-cliki-bot :*cliki-nickserv-password* - :*respond-to-general-hellos*)) + :*respond-to-general-hellos* :shut-up :un-shut-up)) (in-package :cliki) + (defvar *small-definitions* nil) (defun read-small-definitions () @@ -163,6 +164,13 @@ (defvar *cliki-connection*) (defvar *cliki-nickname*) + +(defun shut-up () + (setf (irc:client-stream *cliki-connection*) (make-broadcast-stream))) + +(defun un-shut-up () + (setf (irc:client-stream *cliki-connection*) *trace-output*)) + (defmacro aif (test conseq &optional (else nil)) `(let ((it ,test))

1 0

[Cl-irc-cvs] CVS update: cl-irc/example/specbot.lisp
by Brian Mastenbrook 03 Jun '04

03 Jun '04

Update of /project/cl-irc/cvsroot/cl-irc/example In directory common-lisp.net:/home/bmastenbrook/cl-irc/example Added Files: specbot.lisp Log Message: Long live specbot! Date: Thu Jun 3 07:11:59 2004 Author: bmastenbrook

1 0

[Cl-irc-cvs] CVS update: cl-irc/example/clhs.lisp
by Brian Mastenbrook 03 Jun '04

03 Jun '04

Update of /project/cl-irc/cvsroot/cl-irc/example In directory common-lisp.net:/home/bmastenbrook/cl-irc/example Removed Files: clhs.lisp Log Message: clhs is dead; long live specbot Date: Thu Jun 3 07:07:36 2004 Author: bmastenbrook

1 0

[Cl-irc-cvs] CVS update: cl-irc/example/cliki.lisp
by Brian Mastenbrook 01 Jun '04

01 Jun '04

Update of /project/cl-irc/cvsroot/cl-irc/example In directory common-lisp.net:/home/bmastenbrook/cl-irc/example Modified Files: cliki.lisp Log Message: slight change Date: Tue Jun 1 08:39:15 2004 Author: bmastenbrook Index: cl-irc/example/cliki.lisp diff -u cl-irc/example/cliki.lisp:1.6 cl-irc/example/cliki.lisp:1.7 --- cl-irc/example/cliki.lisp:1.6 Tue Jun 1 08:29:19 2004 +++ cl-irc/example/cliki.lisp Tue Jun 1 08:39:15 2004 @@ -1,4 +1,4 @@ -;;;; $Id: cliki.lisp,v 1.6 2004/06/01 15:29:19 bmastenbrook Exp $ +;;;; $Id: cliki.lisp,v 1.7 2004/06/01 15:39:15 bmastenbrook Exp $ ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/example/cliki.lisp,v $ ;;;; cliki.lisp - CLiki as an infobot; only works on SBCL. @@ -194,9 +194,9 @@ (find-package :lisppaste) channel (> (length channel) 0) - (char= (elt channel 0) #\#)) - (funcall (intern "SAY-HELP" :lisppaste) - channel) + (char= (elt channel 0) #\#) + (funcall (intern "SAY-HELP" :lisppaste) + channel)) (return-from cliki-lookup nil)) (or (if (string-equal first-pass "help") *cliki-bot-help*)

1 0

[Cl-irc-cvs] CVS update: cl-irc/example/clhs.lisp cl-irc/example/cliki.lisp
by Brian Mastenbrook 01 Jun '04

01 Jun '04

Update of /project/cl-irc/cvsroot/cl-irc/example In directory common-lisp.net:/home/bmastenbrook/cl-irc/example Modified Files: clhs.lisp cliki.lisp Log Message: wootage! minion talks to lisppaste, if it can Date: Tue Jun 1 08:29:19 2004 Author: bmastenbrook Index: cl-irc/example/clhs.lisp diff -u cl-irc/example/clhs.lisp:1.5 cl-irc/example/clhs.lisp:1.6 --- cl-irc/example/clhs.lisp:1.5 Tue Jun 1 06:48:12 2004 +++ cl-irc/example/clhs.lisp Tue Jun 1 08:29:19 2004 @@ -1,4 +1,4 @@ -;;;; $Id: clhs.lisp,v 1.5 2004/06/01 13:48:12 bmastenbrook Exp $ +;;;; $Id: clhs.lisp,v 1.6 2004/06/01 15:29:19 bmastenbrook Exp $ ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/example/clhs.lisp,v $ ;;;; clhs.lisp - an example IRC bot for cl-irc @@ -20,7 +20,7 @@ (in-package :clhs) ;;; CLHS. This will be the default lookup. -(defparameter *hyperspec-pathname* #p"/Users/chandler/HyperSpec/") +(defparameter *hyperspec-pathname* #p"/home/bmastenbrook/HyperSpec/") (defparameter *hyperspec-map-file* (merge-pathnames "Data/Map_Sym.txt" *hyperspec-pathname*)) @@ -77,7 +77,7 @@ do (add-clhs-section-to-table section s1 s2 s3 s4 s5)))))))) ;; format directives (loop for code from 32 to 127 - do (setf (gethash (format nil "format:~A" (code-char code)) *table*) + do (setf (gethash (format nil "~~~A" (code-char code)) *table*) (concatenate 'string *hyperspec-root* (case (code-char code) Index: cl-irc/example/cliki.lisp diff -u cl-irc/example/cliki.lisp:1.5 cl-irc/example/cliki.lisp:1.6 --- cl-irc/example/cliki.lisp:1.5 Tue Jun 1 06:48:12 2004 +++ cl-irc/example/cliki.lisp Tue Jun 1 08:29:19 2004 @@ -1,4 +1,4 @@ -;;;; $Id: cliki.lisp,v 1.5 2004/06/01 13:48:12 bmastenbrook Exp $ +;;;; $Id: cliki.lisp,v 1.6 2004/06/01 15:29:19 bmastenbrook Exp $ ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/example/cliki.lisp,v $ ;;;; cliki.lisp - CLiki as an infobot; only works on SBCL. @@ -174,7 +174,7 @@ (defparameter *cliki-bot-help* "The minion bot supplies small definitions and performs lookups on CLiki. To use it, try ``minion: term?''. To add a term for IRC, try saying ``minion: add \"term\" as: definition'' or ``minion: alias \"term\" as: term''; otherwise, edit the corresponding CLiki page.") -(defun cliki-lookup (term-with-question &optional sender) +(defun cliki-lookup (term-with-question &key sender channel) (let ((first-pass (regex-replace-all "^(\\s*)([^?]+)(\\?*)$" term-with-question "\\2"))) (setf first-pass (regex-replace-all "\\s\\s+" first-pass "")) (setf first-pass (regex-replace-all "\\s*$" first-pass "")) @@ -190,6 +190,14 @@ "OK, done.") (progn (setf first-pass (regex-replace-all "(:|/|\\\\|\\#)" first-pass "")) + (when (and (scan "^(?i)lisppaste(\\s|!|\\?|\\.|$)*" first-pass) + (find-package :lisppaste) + channel + (> (length channel) 0) + (char= (elt channel 0) #\#)) + (funcall (intern "SAY-HELP" :lisppaste) + channel) + (return-from cliki-lookup nil)) (or (if (string-equal first-pass "help") *cliki-bot-help*) (if (scan "^(?i)hello(\\s|$)*" first-pass) "what's up?") @@ -225,7 +233,8 @@ (defun msg-hook (message) (let ((respond-to (if (string-equal (first (arguments message)) *cliki-nickname*) (source message) (first (arguments message))))) (if (valid-cliki-message message) - (privmsg *cliki-connection* respond-to (cliki-lookup (regex-replace *cliki-attention-prefix* (trailing-argument message) "") (source message))) + (let ((response (cliki-lookup (regex-replace *cliki-attention-prefix* (trailing-argument message) "") :sender (source message) :channel (first (irc:arguments message))))) + (and response (privmsg *cliki-connection* respond-to response))) (if (string-equal (first (arguments message)) *cliki-nickname*) (privmsg *cliki-connection* respond-to (cliki-lookup (trailing-argument message))) (if (anybody-here (trailing-argument message))

1 0

[Cl-irc-cvs] CVS update: cl-irc/example/clhs.lisp cl-irc/example/cliki-bot.asd cl-irc/example/cliki.lisp cl-irc/example/eliza-rules.lisp
by Brian Mastenbrook 01 Jun '04

01 Jun '04

Update of /project/cl-irc/cvsroot/cl-irc/example In directory common-lisp.net:/tmp/cvs-serv12457/example Modified Files: clhs.lisp cliki-bot.asd cliki.lisp eliza-rules.lisp Log Message: Portability fixes Date: Tue Jun 1 06:48:12 2004 Author: bmastenbrook Index: cl-irc/example/clhs.lisp diff -u cl-irc/example/clhs.lisp:1.4 cl-irc/example/clhs.lisp:1.5 --- cl-irc/example/clhs.lisp:1.4 Sun Feb 1 06:11:56 2004 +++ cl-irc/example/clhs.lisp Tue Jun 1 06:48:12 2004 @@ -1,4 +1,4 @@ -;;;; $Id: clhs.lisp,v 1.4 2004/02/01 14:11:56 bmastenbrook Exp $ +;;;; $Id: clhs.lisp,v 1.5 2004/06/01 13:48:12 bmastenbrook Exp $ ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/example/clhs.lisp,v $ ;;;; clhs.lisp - an example IRC bot for cl-irc @@ -20,7 +20,7 @@ (in-package :clhs) ;;; CLHS. This will be the default lookup. -(defparameter *hyperspec-pathname* #p"/home/bmastenbrook/HyperSpec/") +(defparameter *hyperspec-pathname* #p"/Users/chandler/HyperSpec/") (defparameter *hyperspec-map-file* (merge-pathnames "Data/Map_Sym.txt" *hyperspec-pathname*)) @@ -167,8 +167,12 @@ (setf *clhs-connection* (connect :nickname *clhs-nickname* :server server)) (mapcar #'(lambda (channel) (join *clhs-connection* channel)) channels) (add-hook *clhs-connection* 'irc::irc-privmsg-message 'msg-hook) - #+sbcl (start-background-message-handler *clhs-connection*) - #-sbcl (read-message-loop *clhs-connection*)) + #+(or sbcl + openmcl) + (start-background-message-handler *clhs-connection*) + #-(or sbcl + openmcl) + (read-message-loop *clhs-connection*)) (defun shuffle-hooks () (irc::remove-hooks *clhs-connection* 'irc::irc-privmsg-message) Index: cl-irc/example/cliki-bot.asd diff -u cl-irc/example/cliki-bot.asd:1.1 cl-irc/example/cliki-bot.asd:1.2 --- cl-irc/example/cliki-bot.asd:1.1 Sat Jan 17 11:19:55 2004 +++ cl-irc/example/cliki-bot.asd Tue Jun 1 06:48:12 2004 @@ -1,4 +1,4 @@ -;;;; $Id: cliki-bot.asd,v 1.1 2004/01/17 19:19:55 bmastenbrook Exp $ +;;;; $Id: cliki-bot.asd,v 1.2 2004/06/01 13:48:12 bmastenbrook Exp $ ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/example/cliki-bot.asd,v $ ;;;; See the LICENSE file for licensing information. @@ -17,10 +17,9 @@ :licence "MIT" :description "IRC bot for SBCL" :depends-on - #+sbcl (:cl-irc :cl-ppcre) - #-sbcl (:sbcl) + (:cl-irc :cl-ppcre) :properties ((#:author-email . "cl-irc-devel(a)common-lisp.net") - (#:date . "$Date: 2004/01/17 19:19:55 $") + (#:date . "$Date: 2004/06/01 13:48:12 $") ((#:albert #:output-dir) . "doc/api-doc/") ((#:albert #:formats) . ("docbook")) ((#:albert #:docbook #:template) . "book") @@ -30,4 +29,4 @@ (:file "eliza-rules" :depends-on ("mp2eliza")) (:file "cliki" - :depends-on ("mp2eliza")))) \ No newline at end of file + :depends-on ("mp2eliza")))) Index: cl-irc/example/cliki.lisp diff -u cl-irc/example/cliki.lisp:1.4 cl-irc/example/cliki.lisp:1.5 --- cl-irc/example/cliki.lisp:1.4 Sun Feb 1 06:11:56 2004 +++ cl-irc/example/cliki.lisp Tue Jun 1 06:48:12 2004 @@ -1,4 +1,4 @@ -;;;; $Id: cliki.lisp,v 1.4 2004/02/01 14:11:56 bmastenbrook Exp $ +;;;; $Id: cliki.lisp,v 1.5 2004/06/01 13:48:12 bmastenbrook Exp $ ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/example/cliki.lisp,v $ ;;;; cliki.lisp - CLiki as an infobot; only works on SBCL. @@ -7,7 +7,7 @@ ;;; cliki.lisp, and invoke (cliki::start-cliki-bot "desirednickname" ;;; "desiredserver" "#channel1" "#channel2" "#channel3" ...) -(defpackage :cliki (:use :common-lisp :irc :sb-bsd-sockets :cl-ppcre) +(defpackage :cliki (:use :common-lisp :irc :cl-ppcre) (:export :start-cliki-bot :*cliki-nickserv-password* :*respond-to-general-hellos*)) (in-package :cliki) @@ -50,31 +50,47 @@ (or port-start (length url))))) (subseq url 7 host-end))) +#+(or ccl allegro) +(defun socket-connect (host port) + (#+ccl ccl:make-socket + #+allegro socket:make-socket + :connect :active + :remote-host host + :remote-port port)) + +#+sbcl +(defun socket-connect (host port) + (let ((s (make-instance 'sb-bsd-sockets:inet-socket + :type :stream + :protocol :tcp))) + (sb-bsd-sockets:socket-connect s (car (sb-bsd-sockets:host-ent-addresses + (sb-bsd-sockets:get-host-by-name host))) port) + (sb-bsd-sockets:socket-make-stream s + :element-type 'character + :input t + :output t + :buffering :none))) + (defun url-connection (url) - (let ((s (make-instance 'inet-socket :type :stream :protocol :tcp)) - (host (url-host url)) - (port (url-port url))) - (declare (ignore port)) - (socket-connect - s (car (host-ent-addresses (get-host-by-name (url-host url)))) - (url-port url)) - (let ((stream (socket-make-stream s :input t :output t :buffering :full))) - ;; we are exceedingly unportable about proper line-endings here. - ;; Anyone wishing to run this under non-SBCL should take especial care - (format stream "GET ~A HTTP/1.0~%Host: ~A~%User-Agent: CLiki Bot~%~%" url host) - (force-output stream) - (list - (let* ((l (read-line stream)) - (space (position #\Space l))) - (parse-integer l :start (1+ space) :junk-allowed t)) - (loop for line = (read-line stream nil nil) - until (or (null line) (eql (elt line 0) (code-char 13))) - collect - (let ((colon (position #\: line))) - (cons (intern (string-upcase (subseq line 0 colon)) :keyword) - (string-trim (list #\Space (code-char 13)) - (subseq line (1+ colon)))))) - stream)))) + (let* ((host (url-host url)) + (port (url-port url)) + (stream (socket-connect host port))) + ;; we are exceedingly unportable about proper line-endings here. + ;; Anyone wishing to run this under non-SBCL should take especial care + (format stream "GET ~A HTTP/1.0~%Host: ~A~%User-Agent: CLiki Bot~%~%" url host) + (force-output stream) + (list + (let* ((l (read-line stream)) + (space (position #\Space l))) + (parse-integer l :start (1+ space) :junk-allowed t)) + (loop for line = (read-line stream nil nil) + until (or (null line) (eql (elt line 0) (code-char 13))) + collect + (let ((colon (position #\: line))) + (cons (intern (string-upcase (subseq line 0 colon)) :keyword) + (string-trim (list #\Space (code-char 13)) + (subseq line (1+ colon)))))) + stream))) (defun encode-for-url (str) (setf str (regex-replace-all " " str "%20")) @@ -83,13 +99,33 @@ ;(format t "hi ~A~%" str) str) +#+sbcl +(defmacro host-with-timeout (timeout &body body) + `(sb-ext:with-timeout ,timeout ,@body)) + +#+ccl +(defmacro host-with-timeout (timeout &body body) + `(let ((interrupt-thread nil)) + (setf interrupt-thread + (ccl:process-run-function 'timeout + (let ((process ccl:*current-process*)) + (lambda () + (sleep ,timeout) + (ccl:process-interrupt process + (lambda () + (signal 'openmcl-timeout))))))) + (unwind-protect + (progn ,@body) + (if interrupt-thread + (ccl:process-kill interrupt-thread))))) + (defun cliki-first-sentence (term) (let* ((cliki-url (format nil "http://www.cliki.net/~A" (encode-for-url term))) (url (concatenate 'string cliki-url "?source"))) (block cliki-return (handler-case - (sb-ext:with-timeout 5 + (host-with-timeout 5 (destructuring-bind (response headers stream) (block got (loop @@ -138,7 +174,7 @@ (defparameter *cliki-bot-help* "The minion bot supplies small definitions and performs lookups on CLiki. To use it, try ``minion: term?''. To add a term for IRC, try saying ``minion: add \"term\" as: definition'' or ``minion: alias \"term\" as: term''; otherwise, edit the corresponding CLiki page.") -(defun cliki-lookup (term-with-question) +(defun cliki-lookup (term-with-question &optional sender) (let ((first-pass (regex-replace-all "^(\\s*)([^?]+)(\\?*)$" term-with-question "\\2"))) (setf first-pass (regex-replace-all "\\s\\s+" first-pass "")) (setf first-pass (regex-replace-all "\\s*$" first-pass "")) @@ -156,9 +192,15 @@ (setf first-pass (regex-replace-all "(:|/|\\\\|\\#)" first-pass "")) (or (if (string-equal first-pass "help") *cliki-bot-help*) - (if (scan "^(?i)hello(\\s|$)" first-pass) "what's up?") - (if (scan "^(?i)hi(\\s|$)" first-pass) "what's up?") - (if (scan "^(?i)yo(\\s|$)" first-pass) "what's up?") + (if (scan "^(?i)hello(\\s|$)*" first-pass) "what's up?") + (if (scan "^(?i)hi(\\s|$)*" first-pass) "what's up?") + (if (scan "^(?i)yo(\\s|$)*" first-pass) "what's up?") + (if (scan "^(?i)thank(s| you)(\\s|!|\\?|\\.|$)*" first-pass) + (if sender + (format nil "~A: you failed the inverse turing test!" sender) + "you failed the inverse turing test!")) + (if (scan "^(?i)version(\\s|!|\\?|\\.|$)*" first-pass) + (format nil "This is the minion bot, running on a ~A (~A) and running under ~A ~A." (machine-type) (machine-version) (lisp-implementation-type) (lisp-implementation-version))) (if (scan "^(?i)(?i)do my bidding!*$" first-pass) "Yes, my master.") (aif (or (let ((term (cdr (assoc first-pass *small-definitions* :test #'string-equal)))) (if term (if (stringp term) term (cliki-lookup (car term))))) @@ -183,7 +225,7 @@ (defun msg-hook (message) (let ((respond-to (if (string-equal (first (arguments message)) *cliki-nickname*) (source message) (first (arguments message))))) (if (valid-cliki-message message) - (privmsg *cliki-connection* respond-to (cliki-lookup (regex-replace *cliki-attention-prefix* (trailing-argument message) ""))) + (privmsg *cliki-connection* respond-to (cliki-lookup (regex-replace *cliki-attention-prefix* (trailing-argument message) "") (source message))) (if (string-equal (first (arguments message)) *cliki-nickname*) (privmsg *cliki-connection* respond-to (cliki-lookup (trailing-argument message))) (if (anybody-here (trailing-argument message)) @@ -203,8 +245,7 @@ (mapcar #'(lambda (channel) (join *cliki-connection* channel)) channels) (add-hook *cliki-connection* 'irc::irc-privmsg-message 'msg-hook) (add-hook *cliki-connection* 'irc::irc-notice-message 'notice-hook) - #+sbcl (start-background-message-handler *cliki-connection*) - #-sbcl (read-message-loop *cliki-connection*)) + (start-background-message-handler *cliki-connection*)) (defun shuffle-hooks () (irc::remove-hooks *cliki-connection* 'irc::irc-privmsg-message) Index: cl-irc/example/eliza-rules.lisp diff -u cl-irc/example/eliza-rules.lisp:1.2 cl-irc/example/eliza-rules.lisp:1.3 --- cl-irc/example/eliza-rules.lisp:1.2 Sun Feb 1 06:11:56 2004 +++ cl-irc/example/eliza-rules.lisp Tue Jun 1 06:48:12 2004 @@ -21,6 +21,9 @@ (((?* ?x) bot (?* ?y)) (|I'm| not a |bot.| I prefer the term |``electronically composed''.|)) + ((seen ?x) + (?x was last seen 5y6m14d32h43m10s |ago,| saying |"minion: when are you going to support seen?"|)) + (((?* ?x) did you (?* ?y)) (|no, I didn't| ?y) (|yes, I| ?y)) @@ -34,6 +37,9 @@ (Thanks!)) ((bot snack) + (Thanks!)) + + ((welcome (?* ?y)) (Thanks!)) ((not much) (good))

1 0

[Cl-irc-cvs] CVS update: cl-irc/event.lisp
by Brian Mastenbrook 21 May '04

21 May '04

Update of /project/cl-irc/cvsroot/cl-irc In directory common-lisp.net:/tmp/cvs-serv30690 Modified Files: event.lisp Log Message: Bug fix Date: Fri May 21 15:12:06 2004 Author: bmastenbrook Index: cl-irc/event.lisp diff -u cl-irc/event.lisp:1.3 cl-irc/event.lisp:1.4 --- cl-irc/event.lisp:1.3 Thu Mar 18 16:57:25 2004 +++ cl-irc/event.lisp Fri May 21 15:12:06 2004 @@ -1,4 +1,4 @@ -;;;; $Id: event.lisp,v 1.3 2004/03/18 21:57:25 ehuelsmann Exp $ +;;;; $Id: event.lisp,v 1.4 2004/05/21 19:12:06 bmastenbrook Exp $ ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/event.lisp,v $ ;;;; See LICENSE for licensing information. @@ -26,9 +26,10 @@ (realname (trailing-argument message)) (username (third (arguments message))) (hostname (fourth (arguments message)))) - (setf (realname user) realname) - (setf (username user) username) - (setf (hostname user) hostname))) + (when user + (setf (realname user) realname) + (setf (username user) username) + (setf (hostname user) hostname)))) (defmethod default-hook ((message irc-rpl_list-message)) (let ((connection (connection message))

1 0

[Cl-irc-cvs] CVS update: cl-irc/parse-message.lisp
by Brian Mastenbrook 21 May '04

21 May '04

Update of /project/cl-irc/cvsroot/cl-irc In directory common-lisp.net:/tmp/cvs-serv5216 Modified Files: parse-message.lisp Log Message: Disable irc-error-reply-p for now Date: Fri May 21 14:56:10 2004 Author: bmastenbrook Index: cl-irc/parse-message.lisp diff -u cl-irc/parse-message.lisp:1.2 cl-irc/parse-message.lisp:1.3 --- cl-irc/parse-message.lisp:1.2 Fri May 21 12:41:58 2004 +++ cl-irc/parse-message.lisp Fri May 21 14:56:10 2004 @@ -1,4 +1,4 @@ -;;;; $Id: parse-message.lisp,v 1.2 2004/05/21 16:41:58 bmastenbrook Exp $ +;;;; $Id: parse-message.lisp,v 1.3 2004/05/21 18:56:10 bmastenbrook Exp $ ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/parse-message.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -151,7 +151,9 @@ (ctcp (ctcp-message-type trailing-argument))) (when command (cond - ((irc-error-reply-p command) + (nil ;(irc-error-reply-p command) + ;; Disable for now, as it prevents adding hooks for some useful + ;; error types (progn (setf command (find-reply-name (parse-integer command))) (setf class 'irc-error-reply)))

1 0

[Cl-irc-cvs] CVS update: cl-irc/command.lisp cl-irc/parse-message.lisp cl-irc/protocol.lisp
by Brian Mastenbrook 21 May '04

21 May '04

Update of /project/cl-irc/cvsroot/cl-irc In directory common-lisp.net:/tmp/cvs-serv15936 Modified Files: command.lisp parse-message.lisp protocol.lisp Log Message: OpenMCL patches from marco (segv) Date: Fri May 21 12:41:58 2004 Author: bmastenbrook Index: cl-irc/command.lisp diff -u cl-irc/command.lisp:1.3 cl-irc/command.lisp:1.4 --- cl-irc/command.lisp:1.3 Thu Mar 18 16:57:25 2004 +++ cl-irc/command.lisp Fri May 21 12:41:58 2004 @@ -1,4 +1,4 @@ -;;;; $Id: command.lisp,v 1.3 2004/03/18 21:57:25 ehuelsmann Exp $ +;;;; $Id: command.lisp,v 1.4 2004/05/21 16:41:58 bmastenbrook Exp $ ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/command.lisp,v $ ;;;; See LICENSE for licensing information. @@ -237,22 +237,26 @@ (defmethod time- ((connection connection) &optional (target "")) (send-irc-message connection :time nil target)) -#+sbcl (defun connect-to-server-socket (host port) + #+sbcl (let ((s (make-instance 'sb-bsd-sockets:inet-socket :type :stream :protocol :tcp))) (sb-bsd-sockets:socket-connect s (car (sb-bsd-sockets:host-ent-addresses (sb-bsd-sockets:get-host-by-name host))) port) - s)) + s) + #+openmcl + (ccl:make-socket :remote-host host :remote-port port)) -#+sbcl (defun socket-stream (socket) + #+sbcl (sb-bsd-sockets:socket-make-stream socket :element-type 'character :input t :output t - :buffering :none)) + :buffering :none) + #+openmcl + socket) (defun connect (&key (nickname *default-nickname*) (username nil) @@ -262,15 +266,15 @@ (port *default-irc-server-port*) (logging-stream t)) "Connect to server and return a connection object." - (let* ((socket #+sbcl (connect-to-server-socket server port) - #-sbcl nil) + (let* ((socket #+(or sbcl openmcl) (connect-to-server-socket server port)) (stream #+lispworks (comm:open-tcp-stream server port :errorp t) #+cmu (sys:make-fd-stream (ext:connect-to-inet-socket server port) :input t :output t :element-type 'character) #+allegro (socket:make-socket :remote-host server :remote-port port) - #+sbcl (socket-stream socket)) + #+sbcl (socket-stream socket) + #+openmcl socket) (user (make-user :nickname nickname :username username :realname realname)) Index: cl-irc/parse-message.lisp diff -u cl-irc/parse-message.lisp:1.1.1.1 cl-irc/parse-message.lisp:1.2 --- cl-irc/parse-message.lisp:1.1.1.1 Mon Jan 5 09:13:04 2004 +++ cl-irc/parse-message.lisp Fri May 21 12:41:58 2004 @@ -1,4 +1,4 @@ -;;;; $Id: parse-message.lisp,v 1.1.1.1 2004/01/05 14:13:04 eenge Exp $ +;;;; $Id: parse-message.lisp,v 1.2 2004/05/21 16:41:58 bmastenbrook Exp $ ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/parse-message.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -167,15 +167,17 @@ (when ctcp (setf class (find-ctcp-message-class ctcp))) (let ((instance (make-instance class - :source source - :user user - :host host - :command command + :source (or source "") + :user (or user "") + :host (or host "") + :command (if command + (string command) + "") :arguments arguments :connection nil - :trailing-argument trailing-argument + :trailing-argument (or trailing-argument "") :received-time (get-universal-time) - :raw-message-string string))) + :raw-message-string (or string "")))) (when ctcp (setf (ctcp-command instance) ctcp)) instance)))) Index: cl-irc/protocol.lisp diff -u cl-irc/protocol.lisp:1.6 cl-irc/protocol.lisp:1.7 --- cl-irc/protocol.lisp:1.6 Sat Apr 17 07:15:50 2004 +++ cl-irc/protocol.lisp Fri May 21 12:41:58 2004 @@ -1,4 +1,4 @@ -;;;; $Id: protocol.lisp,v 1.6 2004/04/17 11:15:50 ehuelsmann Exp $ +;;;; $Id: protocol.lisp,v 1.7 2004/05/21 16:41:58 bmastenbrook Exp $ ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/protocol.lisp,v $ ;;;; See LICENSE for licensing information. @@ -142,14 +142,15 @@ #+allegro (mp:process-run-function name function) #+cmu (mp:make-process function :name name) #+lispworks (mp:process-run-function name nil function) - #+sb-thread (sb-thread:make-thread function)) + #+sb-thread (sb-thread:make-thread function) + #+openmcl (ccl:process-run-function name function)) (defmethod start-background-message-handler ((connection connection)) "Read messages from the `connection', parse them and dispatch irc-message-event on them. Returns background process ID if available." (flet ((do-loop () (read-message-loop connection))) (let ((name (format nil "irc-hander-~D" (incf *process-count*)))) - #+(or allegro cmu lispworks sb-thread) + #+(or allegro cmu lispworks sb-thread openmcl) (start-process #'do-loop name) #+(and sbcl (not sb-thread)) (sb-sys:add-fd-handler (sb-bsd-sockets:socket-file-descriptor @@ -163,7 +164,8 @@ #+cmu (mp:destroy-process process) #+allegro (mp:process-kill process) #+sb-thread (sb-thread:destroy-thread process) - #+lispworks (mp:process-kill process)) + #+lispworks (mp:process-kill process) + #+openmcl (ccl:process-kill process)) (defmethod read-message-loop ((connection connection)) (loop while (read-message connection))) @@ -251,7 +253,14 @@ :stream (sb-bsd-sockets:socket-make-stream socket :input t :output t :buffering :none) :socket socket :output-stream t)) - #-sbcl + #+openmcl + (let ((socket-stream (ccl:make-socket :remote-host remote-address + :remote-port remote-port))) + (make-instance 'dcc-connection + :user user + :stream socket-stream + :output-stream output-stream)) + #-(or openmcl sbcl) (warn "make-dcc-connection not supported for this implementation.")) (defgeneric dcc-close (connection)) @@ -596,6 +605,7 @@ :pong :invite)) (defmethod find-irc-message-class (type) + (declare (ignore type)) (find-class 'irc-message)) (defmethod client-log ((connection connection) (message irc-message) &optional (prefix "")) @@ -645,6 +655,7 @@ :dcc-send-request)) (defmethod find-ctcp-message-class (type) + (declare (ignore type)) (find-class 'standard-ctcp-message)) (defmethod client-log ((connection connection) (message ctcp-mixin) &optional (prefix ""))

1 0

[Cl-irc-cvs] No commit messages
by Erik Huelsmann 17 Apr '04

17 Apr '04

Several weeks ago I saw a commit mail comming through the cl-irc-cvs mailing list. Whenever I commit (yesterday and before the debian commit) I don't see a mail comming through the list. Is the repository configured in such a way that it does not always generate a commit mail? bye, Erik. -- NEU : GMX Internet.FreeDSL Ab sofort DSL-Tarif ohne Grundgebühr: http://www.gmx.net/info

1 0