[beirc-cvs] CVS update: beirc/application.lisp beirc/message-display.lisp

[Andreas Fuchs]

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%))