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