From rgoldman at common-lisp.net Tue May 9 17:08:04 2006 From: rgoldman at common-lisp.net (rgoldman) Date: Tue, 9 May 2006 13:08:04 -0400 (EDT) Subject: [beirc-cvs] CVS beirc Message-ID: <20060509170804.0A97339004@common-lisp.net> Update of /project/beirc/cvsroot/beirc In directory clnet:/tmp/cvs-serv4043 Modified Files: variables.lisp Log Message: Added *auto-identify-list* configuration variable. --- /project/beirc/cvsroot/beirc/variables.lisp 2006/04/26 18:22:54 1.16 +++ /project/beirc/cvsroot/beirc/variables.lisp 2006/05/09 17:08:03 1.17 @@ -34,6 +34,12 @@ beirc should automatically connect on startup." ) +(defvar *auto-identify-list* + nil + "A list of servers for which BEIRC should automatically execute +the identify command on connection.") + + (defvar *nickserv-password-alist* '() "Default password to send to the NickServ authentication bot") From rgoldman at common-lisp.net Tue May 9 17:08:25 2006 From: rgoldman at common-lisp.net (rgoldman) Date: Tue, 9 May 2006 13:08:25 -0400 (EDT) Subject: [beirc-cvs] CVS beirc Message-ID: <20060509170825.D01CC39004@common-lisp.net> Update of /project/beirc/cvsroot/beirc In directory clnet:/tmp/cvs-serv4065 Modified Files: application.lisp Log Message: Added auto-identify behavior to com-connect. --- /project/beirc/cvsroot/beirc/application.lisp 2006/04/26 18:22:54 1.81 +++ /project/beirc/cvsroot/beirc/application.lisp 2006/05/09 17:08:25 1.82 @@ -965,7 +965,12 @@ (irc:start-background-message-handler connection)) (setf success t)) (unless success - (disconnect connection frame "Client error."))))))) + (disconnect connection frame "Client error."))))) + ;; added auto-identify [2006/05/09:rpg] + (when success + (when (member server *auto-identify-list* :test 'equalp) + (com-identify))) + )) (defun disconnect (connection frame reason) (let ((*application-frame* frame)) From rgoldman at common-lisp.net Tue May 9 17:10:00 2006 From: rgoldman at common-lisp.net (rgoldman) Date: Tue, 9 May 2006 13:10:00 -0400 (EDT) Subject: [beirc-cvs] CVS beirc Message-ID: <20060509171000.5E5113E002@common-lisp.net> Update of /project/beirc/cvsroot/beirc In directory clnet:/tmp/cvs-serv4185 Modified Files: message-display.lisp Log Message: Fixed strip-preceding-punctuation to remove a leading open paren. This makes clicking on parenthesized urls work, previously the leading paren was incorrectly identified as part of the URL. --- /project/beirc/cvsroot/beirc/message-display.lisp 2006/04/26 18:23:16 1.48 +++ /project/beirc/cvsroot/beirc/message-display.lisp 2006/05/09 17:10:00 1.49 @@ -146,7 +146,7 @@ (values word "") (let ((first-char (char word 0))) (case first-char - ((#\@ #\+ #\<) + ((#\@ #\+ #\< #\() (values (subseq word 1) (string first-char))) (otherwise (values word "")))))) From afuchs at common-lisp.net Mon May 29 20:05:42 2006 From: afuchs at common-lisp.net (afuchs) Date: Mon, 29 May 2006 16:05:42 -0400 (EDT) Subject: [beirc-cvs] CVS beirc Message-ID: <20060529200542.1EDA424002@common-lisp.net> Update of /project/beirc/cvsroot/beirc In directory clnet:/tmp/cvs-serv25410 Modified Files: application.lisp message-display.lisp package.lisp Log Message: Restore compatibility with cl-irc trunk. --- /project/beirc/cvsroot/beirc/application.lisp 2006/05/09 17:08:25 1.82 +++ /project/beirc/cvsroot/beirc/application.lisp 2006/05/29 20:05:41 1.83 @@ -328,7 +328,7 @@ (defun message-directed-to-me-p (message) - (irc:destructuring-arguments (&last body) message + (irc:destructuring-arguments (&rest :ignored &req body) message (let ((my-nick (current-nickname (irc:connection message)))) (search my-nick (or body ""))))) --- /project/beirc/cvsroot/beirc/message-display.lisp 2006/05/09 17:10:00 1.49 +++ /project/beirc/cvsroot/beirc/message-display.lisp 2006/05/29 20:05:42 1.50 @@ -308,7 +308,7 @@ (with-text-face (*standard-output* (if (message-from-focused-nick-p message receiver) :bold :roman)) - (irc:destructuring-arguments (&last body) message + (irc:destructuring-arguments (&rest :ignored &req body) message (formatting-message (t message receiver) ((write-string start-string *standard-output*) (present (irc:source message) 'unhighlighted-nickname) @@ -346,8 +346,7 @@ ,@(loop for (message-type . message-name) in message-specs collect `(defmethod print-message ((message ,message-type) receiver) - (irc:destructuring-arguments (_ &rest arguments &last body) message - (declare (ignore _)) + (irc:destructuring-arguments (:ignored &rest arguments &req body) message (formatting-message (t message receiver) ((format t "~A" (irc:source message))) ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small) @@ -379,7 +378,7 @@ (defmethod print-message (message receiver) ;; default message if we don't know how to render a message. #+(or) (break "~S" message) ; uncomment to debug - (irc:destructuring-arguments (&whole args &last body) message + (irc:destructuring-arguments (&whole args &rest :ignored &req body) message (formatting-message (t message receiver) ((format t "!!! ~A" (irc:source message))) ((with-drawing-options (*standard-output* :ink +red+ :text-size :small) @@ -408,7 +407,7 @@ (write-char #\))) (defmethod print-message ((message irc:irc-nick-message) receiver) - (irc:destructuring-arguments (&last body) message + (irc:destructuring-arguments (&rest :ignored &req body) message (formatting-message (t message receiver) ((format t " ")) ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small) @@ -423,16 +422,14 @@ (formatting-message (t message receiver) ((format t " ")) ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small) - (irc:destructuring-arguments (me nickname user host &last ircname) message - (declare (ignore me)) + (irc:destructuring-arguments (:ignored nickname user host &rest :ignored &req ircname) message (present nickname 'nickname) (format t " is ") (present-as-hostmask user host) (format t " (~A)" ircname)))))) (defmethod print-message ((message irc:irc-rpl_whoischannels-message) receiver) - (irc:destructuring-arguments (me nickname &last body) message - (declare (ignore me)) + (irc:destructuring-arguments (:ignored nickname &rest :ignored &req body) message (formatting-message (t message receiver) ((format t " ")) ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small) @@ -440,8 +437,7 @@ (format-message* (format nil " is in ~A" body) :start-length (length nickname))))))) (defmethod print-message ((message irc:irc-rpl_whoisserver-message) receiver) - (irc:destructuring-arguments (me nickname server &last server-callout) message - (declare (ignore me)) + (irc:destructuring-arguments (:ignored nickname server &rest :ignored &req server-callout) message (formatting-message (t message receiver) ((format t " ")) ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small) @@ -450,8 +446,7 @@ :start-length (length nickname))))))) (defmethod print-message ((message irc:irc-rpl_away-message) receiver) - (irc:destructuring-arguments (me nickname &last away-msg) message - (declare (ignore me)) + (irc:destructuring-arguments (:ignored nickname &rest :ignored &req away-msg) message (formatting-message (t message receiver) ((format t " ")) ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small) @@ -460,8 +455,7 @@ :start-length (length nickname))))))) (defmethod print-message ((message irc:irc-rpl_whoisidentified-message) receiver) - (irc:destructuring-arguments (me nickname body) message - (declare (ignore me)) + (irc:destructuring-arguments (:ignored nickname body) message (formatting-message (t message receiver) ((format t " ")) ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small) @@ -480,8 +474,7 @@ year month date hour minute second))) (defmethod print-message ((message irc:irc-rpl_whoisidle-message) receiver) - (irc:destructuring-arguments (me nickname idle signon &rest rest) message - (declare (ignore me rest)) + (irc:destructuring-arguments (:ignored nickname idle signon &rest :ignored) message (formatting-message (t message receiver) ((format t " ")) ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small) @@ -510,8 +503,7 @@ (defmethod print-message ((message irc:irc-err_nosuchnick-message) receiver) (formatting-message (t message receiver) ((format t " ")) - ((irc:destructuring-arguments (me target &rest rest) message - (declare (ignore me rest)) + ((irc:destructuring-arguments (:ignored target &rest :ignored) message (with-drawing-options (*standard-output* :ink +red3+ :text-size :small) (format-message* (format nil "No such nick or channel \"~A\". " target))) @@ -523,15 +515,14 @@ (formatting-message (t message receiver) ((format t " ")) ((with-drawing-options (*standard-output* :ink +red3+ :text-size :small) - (irc:destructuring-arguments (me &last msg) message - (declare (ignore me)) + (irc:destructuring-arguments (:ignored msg) message (format-message* msg) (with-drawing-options (*standard-output* :ink +grey12+ :text-size :small) (with-output-as-presentation (t `(com-identify) 'command) (format-message* "Click here to identify yourself.")))))))) (defmethod print-message ((message irc:irc-err_chanoprivsneeded-message) receiver) - (irc:destructuring-arguments (&last body) message + (irc:destructuring-arguments (:ignored body) message (formatting-message (t message receiver) ((format t " ")) ((with-drawing-options (*standard-output* :ink +red3+ :text-size :small) @@ -554,26 +545,25 @@ (format-message* (format nil " set the topic for ~A to ~A" channel topic)))))))) (defmethod print-message ((message irc:irc-topic-message) receiver) - (irc:destructuring-arguments (channel &last topic) message + (irc:destructuring-arguments (channel &rest :ignored &req topic) message (print-topic receiver message (irc:source message) channel topic))) (defmethod print-message ((message irc:irc-rpl_topic-message) receiver) - (irc:destructuring-arguments (target channel &optional topic) message - (declare (ignore target)) + (irc:destructuring-arguments (:ignored channel &optional topic) message (print-topic receiver message nil channel topic))) (defmethod print-message ((message irc:irc-rpl_topicwhotime-message) receiver) (formatting-message (t message receiver) ((format t " ")) ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small) - (irc:destructuring-arguments (me channel who time) message - (declare (ignore me)) + (irc:destructuring-arguments (:ignored channel who time) message (format-message* (format nil "~A topic set by ~A on ~A" channel who (format-unix-epoch (parse-integer time))))))))) (defmethod print-message ((message irc:irc-rpl_namreply-message) receiver) - (irc:destructuring-arguments (me privacy channel &last nicks) message - (declare (ignore me privacy)) + (irc:destructuring-arguments (:ignored ; me + :ignored ; privacy + channel &rest :ignored &req nicks) message (formatting-message (t message receiver) ((format t " ")) ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small) @@ -600,8 +590,7 @@ (present-as-hostmask (irc:user message) (irc:host message)))))) (defmethod print-message ((message irc:irc-kick-message) receiver) - (irc:destructuring-arguments (channel victim &optional kick-msg) message - (declare (ignore channel)) + (irc:destructuring-arguments (:ignored victim &optional kick-msg) message (formatting-message (t message receiver) ((format t " ")) ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small) --- /project/beirc/cvsroot/beirc/package.lisp 2005/10/02 09:30:19 1.4 +++ /project/beirc/cvsroot/beirc/package.lisp 2006/05/29 20:05:42 1.5 @@ -4,4 +4,5 @@ #:*beirc-user-init-file* #:*hyperspec-base-url* #:*default-fill-column* #:*timestamp-column-orientation* #:*default-nick* #:*nickserv-password-alist* #:*default-web-browser - #:*auto-join-alist*)) + #:*auto-join-alist*) + (:import-from #:cl-irc #:&req)) From afuchs at common-lisp.net Wed May 31 19:35:39 2006 From: afuchs at common-lisp.net (afuchs) Date: Wed, 31 May 2006 15:35:39 -0400 (EDT) Subject: [beirc-cvs] CVS beirc Message-ID: <20060531193539.51EBB19005@common-lisp.net> Update of /project/beirc/cvsroot/beirc In directory clnet:/tmp/cvs-serv2704 Modified Files: application.lisp Log Message: Fix message-directed-to-me-p for messages with no args. --- /project/beirc/cvsroot/beirc/application.lisp 2006/05/29 20:05:41 1.83 +++ /project/beirc/cvsroot/beirc/application.lisp 2006/05/31 19:35:39 1.84 @@ -190,16 +190,17 @@ (defvar *beirc-frame*) (defun beirc-status-display (*application-frame* *standard-output*) - (with-text-family (t :sans-serif) - (multiple-value-bind (seconds minutes hours) (decode-universal-time (get-universal-time)) - seconds + (multiple-value-bind (seconds minutes hours) + (decode-universal-time (get-universal-time)) + seconds + (with-text-family (t :sans-serif) (format t "~:[~;~2,'0D:~2,'0D ~]~A~:[~;(away)~] ~@[on ~A~]~@[ speaking to ~A~]~100T~D messages" (processes-supported-p) ; don't display time if threads are not supported hours minutes (current-nickname) (away-status *application-frame* (current-connection *application-frame*)) (current-channel) - (current-query) + (current-query) (length (current-messages)))))) (defun beirc-prompt (*standard-output* *application-frame*) @@ -328,9 +329,9 @@ (defun message-directed-to-me-p (message) - (irc:destructuring-arguments (&rest :ignored &req body) message - (let ((my-nick (current-nickname (irc:connection message)))) - (search my-nick (or body ""))))) + (let ((body (car (last (irc:arguments message)))) + (my-nick (current-nickname (irc:connection message)))) + (search my-nick (or body "")))) (defun interesting-message-p (message) (typep message '(or irc:irc-privmsg-message irc:irc-notice-message irc:irc-topic-message irc:irc-kick-message irc:ctcp-action-message))) @@ -339,7 +340,7 @@ (let ((message-to-me-p (message-directed-to-me-p message)) (interesting-message-p (interesting-message-p message))) (setf (messages receiver) - (append (messages receiver) (list message))) + (nconc (messages receiver) (list message))) (unless (eql receiver (current-receiver frame)) (when interesting-message-p (incf (unseen-messages receiver))) @@ -770,7 +771,7 @@ (define-presentation-to-command-translator nickname-to-query-translator (nickname com-query beirc :menu t - :gesture nil + :gesture :describe :documentation "Query this user" :pointer-documentation "Query this user") (object) @@ -856,7 +857,9 @@ ;;; presentation types, I bet I could fold this into the previous ;;; translator. [2006/04/18:rpg] (define-presentation-to-command-translator meme-url-to-browse-url-translator - (meme-url com-browse-url beirc :pointer-documentation "Browse meme log" + (meme-url com-browse-url beirc + :documentation "Browse meme log" + :pointer-documentation "Browse meme log" ;; override url-to-browse-url-translator :priority 1) (presentation) @@ -963,7 +966,8 @@ (disconnect connection frame "Client Disconnect")))) :name "IRC Message Muffling Loop")) (irc:start-background-message-handler connection)) - (setf success t)) + (setf success t) + connection) (unless success (disconnect connection frame "Client error."))))) ;; added auto-identify [2006/05/09:rpg]