beirc-cvs January 2006

beirc-cvs@common-lisp.net

1 participants
5 discussions

[beirc-cvs] CVS beirc
by afuchs 30 Jan '06

30 Jan '06

Update of /project/beirc/cvsroot/beirc In directory common-lisp:/tmp/cvs-serv23794 Modified Files: application.lisp Log Message: Only highlight the tab when an interesting message appears. --- /project/beirc/cvsroot/beirc/application.lisp 2006/01/27 22:35:57 1.35 +++ /project/beirc/cvsroot/beirc/application.lisp 2006/01/30 18:56:00 1.36 @@ -246,11 +246,15 @@ (text (or (irc:trailing-argument message) ""))) (search my-nick text))) +(defun interesting-message-p (message) + (typep message '(or irc:irc-privmsg-message irc:irc-topic-message irc:irc-kick-message irc:ctcp-action-message))) + (defun post-message-to-receiver (frame message receiver) (setf (messages receiver) (append (messages receiver) (list message))) (unless (eql receiver (current-receiver frame)) - (incf (unseen-messages receiver)) + (when (interesting-message-p message) + (incf (unseen-messages receiver))) (when (message-directed-to-me-p frame message) (incf (messages-directed-to-me receiver)))) (update-drawing-options receiver)

1 0

[beirc-cvs] CVS beirc
by afuchs 27 Jan '06

27 Jan '06

Update of /project/beirc/cvsroot/beirc In directory common-lisp:/tmp/cvs-serv5563 Modified Files: receivers.lisp Log Message: strip the silly beirc:: package prefix from define-global-message-receiver-lookup --- /project/beirc/cvsroot/beirc/receivers.lisp 2005/10/05 13:08:29 1.12 +++ /project/beirc/cvsroot/beirc/receivers.lisp 2006/01/27 22:40:32 1.13 @@ -133,8 +133,10 @@ (remove nil (mapcar (lambda (channel) (find-receiver (irc:name channel) frame)) - (irc:channels (irc:find-user (beirc::current-connection frame) - (irc:source message)))))))) + (let ((user (irc:find-user (current-connection frame) + (irc:source message)))) + (when user + (irc:channels user)))))))) (define-global-message-receiver-lookup irc:irc-quit-message) (define-global-message-receiver-lookup irc:irc-nick-message))

1 0

[beirc-cvs] CVS beirc
by afuchs 27 Jan '06

27 Jan '06

Update of /project/beirc/cvsroot/beirc In directory common-lisp:/tmp/cvs-serv5402 Modified Files: message-display.lisp Log Message: Add (simple) printers for all the server reply lines I see at startup. Well, not all of them. There's still an odd one I get from zelazny.freenode.net. --- /project/beirc/cvsroot/beirc/message-display.lisp 2005/10/06 23:35:20 1.26 +++ /project/beirc/cvsroot/beirc/message-display.lisp 2006/01/27 22:39:09 1.27 @@ -165,6 +165,48 @@ ;;; server messages +(macrolet ((define-server-message-printer ((&rest message-specs)) + `(progn + ,@(loop for (message-type . message-name) in message-specs + collect + `(defmethod print-message ((message ,message-type) receiver) + (formatting-message (t message receiver) + ((format t "~A" (irc:source message))) + ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small) + (format-message* + (format nil "~@[~A: ~]~{~A ~}~A" + ,message-name + (cdr (irc:arguments message)) + (irc:trailing-argument message))))))))))) + (define-server-message-printer ((irc:irc-rpl_motd-message . "MODT") + (irc:irc-rpl_motdstart-message . "MOTD") + (irc:irc-rpl_isupport-message) + (irc:irc-rpl_yourid-message . "Your id") + (irc:irc-rpl_luserop-message) + (irc:irc-rpl_luserclient-message) + (irc:irc-rpl_luserme-message) + (irc:irc-rpl_luserchannels-message) + (irc:irc-rpl_luserunknown-message) + (irc:irc-rpl_globalusers-message) + (irc:irc-rpl_localusers-message) + (irc:irc-rpl_created-message) + (irc:irc-rpl_welcome-message) + (irc:irc-rpl_yourhost-message) + (irc:irc-rpl_myinfo-message) + (irc:irc-rpl_hello-message) + (irc:irc-rpl_statsdline-message) + (irc:irc-rpl_statskline-message) + (irc:irc-rpl_statshline-message) + (irc:irc-rpl_statsvline-message) + (irc:irc-rpl_noaway-message) + (irc:irc-rpl_unaway-message)))) + +(defmethod print-message ((message irc:irc-rpl_isupport-message) receiver) + (formatting-message (t message receiver) + ((format t "~A" (irc:source message))) + ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small) + (format t "MOTD: ~A" (irc:trailing-argument message)))))) + (defmethod print-message ((message irc:irc-rpl_motd-message) receiver) (formatting-message (t message receiver) ((format t "~A" (irc:source message)))

1 0

[beirc-cvs] CVS beirc
by afuchs 27 Jan '06

27 Jan '06

Update of /project/beirc/cvsroot/beirc In directory common-lisp:/tmp/cvs-serv5203 Modified Files: application.lisp Log Message: * Bring beirc up-to-date with recent cl-irc, and remove the kludgy read-message method * Add a password &key argument to com-connect * Add com-back; /away with empty reason is too awkward. --- /project/beirc/cvsroot/beirc/application.lisp 2005/10/07 00:59:58 1.34 +++ /project/beirc/cvsroot/beirc/application.lisp 2006/01/27 22:35:57 1.35 @@ -435,6 +435,9 @@ (define-beirc-command (com-away :name t) ((reason 'mumble :prompt "reason")) (irc:away (current-connection *application-frame*) reason)) +(define-beirc-command (com-back :name t) () + (irc:away (current-connection *application-frame*) "")) + (define-beirc-command (com-quit :name t) ((reason 'mumble :prompt "reason")) (when (current-connection *application-frame*) (disconnect *application-frame* reason)) @@ -672,13 +675,19 @@ (define-beirc-command (com-connect :name t) ((server 'string :prompt "Server") &key - (nick 'string :prompt "Nick name" :default *default-nick*)) + (nick 'string :prompt "Nick name" :default *default-nick*) + (pass 'string :prompt "Password" :default nil) + (port 'number :prompt "Port" :default irc::*default-irc-server-port*)) (let ((success nil)) (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 :connection-type 'beirc-connection)) + (apply #'irc:connect + :nickname nick :server server :connection-type 'beirc-connection :port port + (if (null pass) + nil + `(:password ,pass)))) (unwind-protect (progn (setf (irc:client-stream (current-connection *application-frame*)) @@ -784,16 +793,9 @@ ;;; user before we got the message (so that we can display it ;;; everywhere it is relevant). ;;; So, this method is basically a copy of IRC:READ-MESSAGE. ugh. -(defmethod irc:read-message ((connection beirc-connection)) - (handler-case - (when (irc::connectedp connection) - (let ((message (irc::read-irc-message connection))) - (post-message *application-frame* message) - (irc::irc-message-event message) - message)) - (stream-error (c) (signal 'irc::invalidate-me :stream - (irc:server-stream connection) - :condition c)))) +(defmethod irc::irc-message-event :around ((connection beirc-connection) message) + (post-message *application-frame* message) + (call-next-method)) (defun irc-event-loop (frame connection) (unwind-protect

1 0

[beirc-cvs] CVS beirc
by afuchs 27 Jan '06

27 Jan '06

Update of /project/beirc/cvsroot/beirc In directory common-lisp:/tmp/cvs-serv10831 Modified Files: presentations.lisp Log Message: Finally! RET no longer tries to complete the line! (Careful reading of the clim spec really paid off (-:) --- /project/beirc/cvsroot/beirc/presentations.lisp 2005/10/01 18:18:50 1.7 +++ /project/beirc/cvsroot/beirc/presentations.lisp 2006/01/27 17:18:04 1.8 @@ -32,27 +32,29 @@ (cond ((not success) "") ((zerop (length prefix)) ": ") (t " "))))) - (multiple-value-bind (string success object nmatches possibilities) - (complete-from-possibilities word - (let ((channel (and - (current-channel) - (irc:find-channel - (current-connection *application-frame*) - (current-channel))))) - (if (not (null channel)) - (hash-alist (irc:users channel)) - nil)) - '() - :action mode - :value-key #'cdr) - (values (prefixify (if (not success) - string - (irc:nickname object)) - success) - success object nmatches (mapcar (lambda (possibility) - (cons (prefixify (car possibility)) - (cdr possibility))) - possibilities)))))) + (if (eql mode :complete) ; the user entered an activation gesture. don't complete. + (values so-far nil nil 0 nil) + (multiple-value-bind (string success object nmatches possibilities) + (complete-from-possibilities word + (let ((channel (and + (current-channel) + (irc:find-channel + (current-connection *application-frame*) + (current-channel))))) + (if (not (null channel)) + (hash-alist (irc:users channel)) + nil)) + '() + :action mode + :value-key #'cdr) + (values (prefixify (if (not success) + string + (irc:nickname object)) + success) + success object nmatches (mapcar (lambda (possibility) + (cons (prefixify (car possibility)) + (cdr possibility))) + possibilities))))))) ;; FIXME/FIXMCCLIM: :possibility-printer is ignored in current ;; McCLIM's COMPLETE-INPUT implementation. @@ -64,11 +66,11 @@ (define-presentation-method accept ((type mumble) *standard-input* (view textual-view) &key) (with-delimiter-gestures (nil :override t) (let ((*completion-gestures* '(#\Tab))) - (nth-value 2 - (complete-input *standard-input* 'nickname-completer - #+(or):possibility-printer #+(or) 'nickname-competion-printer - :allow-any-input t - :partial-completers '()))))) + (nth-value 2 + (complete-input *standard-input* 'nickname-completer + #+(or):possibility-printer #+(or) 'nickname-competion-printer + :allow-any-input t + :partial-completers '()))))) ;;; nicknames

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

beirc-cvs January 2006