Update of /project/beirc/cvsroot/beirc In directory common-lisp.net:/tmp/cvs-serv15846

Modified Files: application.lisp message-display.lisp Log Message: fix topic display and presentation of URLs within <> brackets

Date: Sun Sep 25 19:55:26 2005 Author: afuchs

Index: beirc/application.lisp diff -u beirc/application.lisp:1.6 beirc/application.lisp:1.7 --- beirc/application.lisp:1.6 Sun Sep 25 19:51:34 2005 +++ beirc/application.lisp Sun Sep 25 19:55:26 2005 @@ -317,7 +317,8 @@ :SOURCE source))

(define-beirc-command (com-topic :name t) (&key (topic 'mumble :prompt "New topic")) - (if (and (not (string= topic ""))) + (if (and (not (null topic)) + (not (equal topic ""))) (irc:topic- (current-connection *application-frame*) (target) topic) (post-message *application-frame* (make-fake-irc-message 'irc:irc-rpl_topic-message

Index: beirc/message-display.lisp diff -u beirc/message-display.lisp:1.15 beirc/message-display.lisp:1.16 --- beirc/message-display.lisp:1.15 Sun Sep 25 14:55:10 2005 +++ beirc/message-display.lisp Sun Sep 25 19:55:26 2005 @@ -84,12 +84,12 @@ (string last-char))) (otherwise (values word ""))))))

-(defun strip-op-signs (word) +(defun strip-preceding-punctuation (word) (if (= (length word) 0) (values word "") (let ((first-char (char word 0))) (case first-char - ((#@ #+) + ((#@ #+ #<) (values (subseq word 1) (string first-char))) (otherwise (values word "")))))) @@ -101,9 +101,9 @@ when (> column limit) do (setf column (length word)) (terpri) - do (multiple-value-bind (%word stripped-opsigns) (strip-op-signs word) + do (multiple-value-bind (%word stripped-preceding-punctuation) (strip-preceding-punctuation word) (multiple-value-bind (word% stripped-punctuation) (strip-punctuation %word) - (write-string stripped-opsigns) + (write-string stripped-preceding-punctuation) (cond ((search "http://" word%) (present-url word%))