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

[Andreas Fuchs]

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

Modified Files:
	beirc.lisp message-display.lisp 
Log Message:
add more general nickname highlighting and use current-connection consistently

Date: Sun Sep 18 00:22:58 2005
Author: afuchs

Index: beirc/beirc.lisp
diff -u beirc/beirc.lisp:1.10 beirc/beirc.lisp:1.11
--- beirc/beirc.lisp:1.10	Sat Sep 17 23:28:29 2005
+++ beirc/beirc.lisp	Sun Sep 18 00:22:57 2005
@@ -162,8 +162,6 @@
   (define-delegate current-messages messages t)
   (define-delegate current-focused-nicks focused-nicks t))
 
-
-
 (defclass stack-layout-pane (clim:sheet-multiple-child-mixin
                              clim:basic-pane)
   ())
@@ -216,7 +214,7 @@
 (define-application-frame beirc (redisplay-frame-mixin
                                  standard-application-frame)
     ((current-receiver :initform nil :accessor current-receiver)
-     (connection :initform nil)
+     (connection :initform nil :reader current-connection)
      (nick :initform nil)
      (ignored-nicks :initform nil)
      (receivers :initform (make-hash-table :test 'equal) :reader receivers)
@@ -315,8 +313,11 @@
 (defun pane-scrolled-to-bottom-p (pane)
   (multiple-value-bind (x y) (transform-position (sheet-transformation pane)
                                                  0 0)
+    (declare (ignore x))
     (with-bounding-rectangle* (x1 y1 x2 y2) pane
+      (declare (ignore x1 y1 x2))
       (with-bounding-rectangle* (ax1 ay1 ax2 ay2) (sheet-parent pane)
+        (declare (ignore ax1 ay1 ax2))
         (<= (+ y y2) ay2)))))
 
 (defun scroll-pane-to-bottom (pane)
@@ -455,11 +456,11 @@
                                :USER "localuser"
                                :SOURCE (slot-value *application-frame* 'nick)
                                ))
-  (irc:privmsg (slot-value *application-frame* 'connection) (target) what))
+  (irc:privmsg (current-connection *application-frame*) (target) what))
 
 (define-beirc-command (com-nick :name t) ((new-nick 'string :prompt "new nick"))
   (setf (slot-value *application-frame* 'nick) new-nick) ;This is _not_ the way to do it.
-  (irc:nick (slot-value *application-frame* 'connection) new-nick))
+  (irc:nick (current-connection *application-frame*) new-nick))
 
 (define-beirc-command (com-browse-url :name t) ((url 'url :prompt "url"))
   #+ (and sbcl darwin)
@@ -480,17 +481,17 @@
   (setf (current-receiver *application-frame*)
         (intern-receiver channel *application-frame* :channel channel))
   (raise-receiver (current-receiver *application-frame*))
-  (irc:join (slot-value *application-frame* 'connection) channel))
+  (irc:join (current-connection *application-frame*) channel))
 
 (define-beirc-command (com-connect :name t)
     ((server 'string :prompt "Server") (nick 'string :prompt "Nick name"))
-  (cond ((slot-value *application-frame* 'connection)
+  (cond ((current-connection *application-frame*)
          (format *query-io* "You are already connected.~%"))
         (t
          (setf (slot-value *application-frame* 'connection)
 	       (irc:connect :nickname nick :server server))
          (setf (slot-value *application-frame* 'nick) nick)
-         (let ((connection (slot-value *application-frame* 'connection)))
+         (let ((connection (current-connection *application-frame*)))
            (let ((frame *application-frame*))
              (clim-sys:make-process #'(lambda ()
                                         (irc-event-loop frame connection))
@@ -523,7 +524,7 @@
 ;  (describe message *trace-output*)
 ;  (finish-output *trace-output*)
   ;; ###
-  (irc:pong (slot-value *application-frame* 'connection) "localhost")
+  (irc:pong (current-connection *application-frame*) "localhost")
   nil)  ;### put the server you initially connected to here.
 
 (defmethod trailing-argument* (message)
@@ -614,7 +615,7 @@
                                :HOST "localhost"
                                :USER "localuser"
                                :SOURCE (slot-value *application-frame* 'nick) ))
-  (irc:privmsg (slot-value *application-frame* 'connection) target what))
+  (irc:privmsg (current-connection *application-frame*) target what))
 
 (define-beirc-command (com-msg :name t)
     ((target 'nickname :prompt "who") (what 'mumble :prompt "what"))


Index: beirc/message-display.lisp
diff -u beirc/message-display.lisp:1.1 beirc/message-display.lisp:1.2
--- beirc/message-display.lisp:1.1	Sat Sep 17 21:23:14 2005
+++ beirc/message-display.lisp	Sun Sep 18 00:22:57 2005
@@ -75,7 +75,7 @@
                (cond
                  ((search "http://" word*)
                   (present-url word*))
-                 ((nick-equals-my-nick-p word*)
+                 ((irc:find-user (current-connection *application-frame*) word*)
                   (present word* 'nickname))
                  (t (write-string word*)))
                (write-string stripped-punctuation))