beirc-cvs September 2005

beirc-cvs@common-lisp.net

3 participants
54 discussions

[beirc-cvs] CVS update: beirc/application.lisp
by afuchs＠common-lisp.net 26 Sep '05

26 Sep '05

Update of /project/beirc/cvsroot/beirc In directory common-lisp.net:/tmp/cvs-serv11537 Modified Files: application.lisp Log Message: replace (read-line ...) with (accept 'mumble ...) in read-frame-command. this makes RET in the middle of the line work! Date: Mon Sep 26 10:28:10 2005 Author: afuchs Index: beirc/application.lisp diff -u beirc/application.lisp:1.10 beirc/application.lisp:1.11 --- beirc/application.lisp:1.10 Sun Sep 25 20:57:25 2005 +++ beirc/application.lisp Mon Sep 26 10:28:10 2005 @@ -524,7 +524,7 @@ (clim:accept 'clim:command :stream stream :prompt nil)) (t - (list 'com-say (read-line stream)))))) + (list 'com-say (accept 'mumble :prompt nil :stream stream)))))) (window-clear stream))) (defmethod read-frame-command :around ((frame beirc)

1 0

[beirc-cvs] CVS update: beirc/application.lisp beirc/variables.lisp
by mretzlaff＠common-lisp.net 25 Sep '05

25 Sep '05

Update of /project/beirc/cvsroot/beirc In directory common-lisp.net:/tmp/cvs-serv20162 Modified Files: application.lisp variables.lisp Log Message: Adds the new variable *default-nick* with the default value "brucio-X" (where X is a random number below 100). The second parameter NICK of COM-CONNECT is now a &KEY parameter, the default being *default-nick*. Date: Sun Sep 25 20:57:25 2005 Author: mretzlaff Index: beirc/application.lisp diff -u beirc/application.lisp:1.9 beirc/application.lisp:1.10 --- beirc/application.lisp:1.9 Sun Sep 25 20:21:08 2005 +++ beirc/application.lisp Sun Sep 25 20:57:25 2005 @@ -479,7 +479,9 @@ (irc:join (current-connection *application-frame*) channel)) (define-beirc-command (com-connect :name t) - ((server 'string :prompt "Server") (nick 'string :prompt "Nick name")) + ((server 'string :prompt "Server") + &key + (nick 'string :prompt "Nick name" :default *default-nick*)) (cond ((current-connection *application-frame*) (format *query-io* "You are already connected.~%")) (t Index: beirc/variables.lisp diff -u beirc/variables.lisp:1.2 beirc/variables.lisp:1.3 --- beirc/variables.lisp:1.2 Sun Sep 25 14:55:10 2005 +++ beirc/variables.lisp Sun Sep 25 20:57:25 2005 @@ -1,8 +1,9 @@ (in-package :beirc) -(defparameter *hyperspec-base-url* "file://localhost/Users/dmurray/lisp/HyperSpec/") -(defparameter *default-fill-column* 80) -(defparameter *timestamp-column-orientation* :right) +(defvar *hyperspec-base-url* "file://localhost/Users/dmurray/lisp/HyperSpec/") +(defvar *default-fill-column* 80) +(defvar *timestamp-column-orientation* :right) +(defvar *default-nick* (format nil "Brucio-~d" (random 100))) (defvar *beirc-user-init-file* (merge-pathnames (make-pathname :name ".beirc.lisp") (user-homedir-pathname)))

1 0

[beirc-cvs] CVS update: beirc/receivers.lisp
by afuchs＠common-lisp.net 25 Sep '05

25 Sep '05

Update of /project/beirc/cvsroot/beirc In directory common-lisp.net:/tmp/cvs-serv20130 Modified Files: receivers.lisp Log Message: fix receiver lookup in the presence of global notices and Chanserv on channels. Date: Sun Sep 25 20:53:54 2005 Author: afuchs Index: beirc/receivers.lisp diff -u beirc/receivers.lisp:1.3 beirc/receivers.lisp:1.4 --- beirc/receivers.lisp:1.3 Sun Sep 25 20:19:28 2005 +++ beirc/receivers.lisp Sun Sep 25 20:53:53 2005 @@ -70,7 +70,7 @@ (lambda (frame pane) (beirc-app-display frame pane receiver)) :display-time nil - :width 400 :height 600 + :width 600 :height 800 :incremental-redisplay t))) (setf (gethash normalized-name (receivers frame)) receiver) receiver))))) @@ -85,26 +85,30 @@ unless the user has opened a query window to the source already.") -(defun network-service-p (source frame) +(defun from-network-service-p (source frame) (member source *network-service-sources* :test (lambda (source1 source2) (string= (irc:normalize-nickname (current-connection frame) source1) (irc:normalize-nickname (current-connection frame) source2))))) +(defun global-notice-p (message target) + (and (typep message 'irc:irc-notice-message) (string= target "$*"))) + (macrolet ((define-privmsg-receiver-lookup (message-type) `(defmethod receiver-for-message ((message ,message-type) frame) - (if (or - (find-receiver (irc:source message) frame) - (not (network-service-p (irc:source message) frame))) - (let* ((mynick (irc:normalize-nickname (current-connection frame) + (let* ((mynick (irc:normalize-nickname (current-connection frame) (slot-value frame 'nick))) (nominal-target (irc:normalize-channel-name (slot-value frame 'connection) (first (irc:arguments message)))) (target (if (equal nominal-target mynick) (irc:source message) nominal-target))) - (intern-receiver target frame :channel target)) - (server-receiver frame))))) + (if (or (find-receiver (irc:source message) frame) + (not (from-network-service-p (irc:source message) frame)) + (and (string= nominal-target target) + (not (global-notice-p message nominal-target)))) + (intern-receiver target frame :channel target) + (server-receiver frame)))))) (define-privmsg-receiver-lookup irc:irc-privmsg-message) (define-privmsg-receiver-lookup irc:ctcp-action-message) (define-privmsg-receiver-lookup irc:irc-notice-message))

1 0

[beirc-cvs] CVS update: beirc/application.lisp
by afuchs＠common-lisp.net 25 Sep '05

25 Sep '05

Update of /project/beirc/cvsroot/beirc In directory common-lisp.net:/tmp/cvs-serv17956 Modified Files: application.lisp Log Message: add "unfocus" translator by mgr. Date: Sun Sep 25 20:21:08 2005 Author: afuchs Index: beirc/application.lisp diff -u beirc/application.lisp:1.8 beirc/application.lisp:1.9 --- beirc/application.lisp:1.8 Sun Sep 25 19:58:14 2005 +++ beirc/application.lisp Sun Sep 25 20:21:08 2005 @@ -407,6 +407,15 @@ (object) (list object)) +(define-presentation-to-command-translator nickname-to-unfocus-translator + (nickname com-unfocus beirc + :gesture :menu + :menu t + :documentation "Unfocus this user" + :pointer-documentation "Unfocus this user") + (object) + (list object)) + (define-presentation-to-command-translator nickname-to-query-translator (nickname com-query beirc :gesture :menu

1 0

[beirc-cvs] CVS update: beirc/message-display.lisp beirc/receivers.lisp
by afuchs＠common-lisp.net 25 Sep '05

25 Sep '05

Update of /project/beirc/cvsroot/beirc In directory common-lisp.net:/tmp/cvs-serv17917 Modified Files: message-display.lisp receivers.lisp Log Message: * handle "you need channel operator status" message right. * fix intern-receiver: should always use the normalized-name Date: Sun Sep 25 20:19:28 2005 Author: afuchs Index: beirc/message-display.lisp diff -u beirc/message-display.lisp:1.16 beirc/message-display.lisp:1.17 --- beirc/message-display.lisp:1.16 Sun Sep 25 19:55:26 2005 +++ beirc/message-display.lisp Sun Sep 25 20:19:28 2005 @@ -190,6 +190,12 @@ ;;; channel management messages +(defmethod print-message ((message irc:irc-err_chanoprivsneeded-message) receiver) + (formatting-message (t message receiver) + ((format t " ")) + ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small) + (format-message* (format nil "Not permitted: ~A" (irc:trailing-argument message))))))) + (defun print-topic (receiver message sender channel topic) (formatting-message (t message receiver) ((format t " ")) Index: beirc/receivers.lisp diff -u beirc/receivers.lisp:1.2 beirc/receivers.lisp:1.3 --- beirc/receivers.lisp:1.2 Sun Sep 25 19:51:34 2005 +++ beirc/receivers.lisp Sun Sep 25 20:19:28 2005 @@ -72,7 +72,7 @@ :display-time nil :width 400 :height 600 :incremental-redisplay t))) - (setf (gethash name (receivers frame)) receiver) + (setf (gethash normalized-name (receivers frame)) receiver) receiver))))) (defun remove-receiver (receiver frame) @@ -138,7 +138,7 @@ (intern-receiver target frame :channel target)))))))) (define-nth-arg-message-receiver-lookup (0 irc:irc-topic-message irc:irc-kick-message) - (1 irc:irc-rpl_topic-message) + (1 irc:irc-rpl_topic-message irc:irc-err_chanoprivsneeded-message) (2 irc:irc-rpl_namreply-message) (nil irc:irc-join-message))) @@ -181,7 +181,11 @@ cl-irc:irc-rpl_endofexceptlist-message cl-irc:irc-ping-message)) + +;;; default receiver. (defmethod receiver-for-message ((message irc:irc-message) frame) + #+or ; comment out to debug on uncaught messages. + (break) (server-receiver frame)) ;; TODO: more receiver-for-message methods.

1 0

[beirc-cvs] CVS update: beirc/application.lisp
by afuchs＠common-lisp.net 25 Sep '05

25 Sep '05

Update of /project/beirc/cvsroot/beirc In directory common-lisp.net:/tmp/cvs-serv15876 Modified Files: application.lisp Log Message: don't do anything on /say <nothing>. Date: Sun Sep 25 19:58:14 2005 Author: afuchs Index: beirc/application.lisp diff -u beirc/application.lisp:1.7 beirc/application.lisp:1.8 --- beirc/application.lisp:1.7 Sun Sep 25 19:55:26 2005 +++ beirc/application.lisp Sun Sep 25 19:58:14 2005 @@ -367,13 +367,13 @@ (current-channel))) (define-beirc-command (com-say :name t) ((what 'mumble)) - ;; make a fake IRC-PRIV-MESSAGE object - (post-message *application-frame* - (make-fake-irc-message 'irc:irc-privmsg-message - :trailing-argument what - :arguments (list (target)) - :command "PRIVMSG")) - (irc:privmsg (current-connection *application-frame*) (target) what)) + (unless (string= what "") + (post-message *application-frame* + (make-fake-irc-message 'irc:irc-privmsg-message + :trailing-argument what + :arguments (list (target)) + :command "PRIVMSG")) + (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.

1 0

[beirc-cvs] CVS update: beirc/application.lisp beirc/message-display.lisp
by afuchs＠common-lisp.net 25 Sep '05

25 Sep '05

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

1 0

[beirc-cvs] CVS update: beirc/application.lisp beirc/receivers.lisp
by afuchs＠common-lisp.net 25 Sep '05

25 Sep '05

Update of /project/beirc/cvsroot/beirc In directory common-lisp.net:/tmp/cvs-serv15809 Modified Files: application.lisp receivers.lisp Log Message: commit mgr's pointer documentation pane patch. Thanks! Date: Sun Sep 25 19:51:35 2005 Author: afuchs Index: beirc/application.lisp diff -u beirc/application.lisp:1.5 beirc/application.lisp:1.6 --- beirc/application.lisp:1.5 Sun Sep 25 18:30:40 2005 +++ beirc/application.lisp Sun Sep 25 19:51:34 2005 @@ -80,6 +80,7 @@ (:panes (io :interactor) + (pointer-doc :pointer-documentation) (status-bar :application :display-function 'beirc-status-display @@ -106,6 +107,7 @@ (with-tab-layout ('receiver-pane :name 'query) ("*Server*" server 'receiver-pane)) (60 io) + (20 pointer-doc) (20 ;<-- Sigh! Bitrot! status-bar))))) @@ -446,7 +448,11 @@ (list (presentation-object presentation))) (define-presentation-translator receiver-pane-to-receiver-translator - (receiver-pane receiver beirc) + (receiver-pane receiver beirc + :documentation ((object stream) + (format stream "Reiceiver: ~A" + (title (receiver-from-tab-pane + (find-in-tab-panes-list object 'tab-layout-pane)))))) (object) (receiver-from-tab-pane (find-in-tab-panes-list object 'tab-layout-pane))) Index: beirc/receivers.lisp diff -u beirc/receivers.lisp:1.1 beirc/receivers.lisp:1.2 --- beirc/receivers.lisp:1.1 Sun Sep 25 14:43:52 2005 +++ beirc/receivers.lisp Sun Sep 25 19:51:34 2005 @@ -11,6 +11,16 @@ (pane :reader pane) (tab-pane :accessor tab-pane))) +(defun slot-value-or-something (object &key (slot 'name) (something "without name")) + (if (slot-boundp object slot) + (slot-value object slot) + something)) + +(defmethod print-object ((receiver receiver) stream) + (print-unreadable-object (receiver stream :type t) + (write-string (slot-value-or-something receiver :slot 'title :something "without title") + stream))) + (define-presentation-type receiver-pane ()) ;;; KLUDGE: make-clim-application-pane doesn't return an application

1 0

[beirc-cvs] CVS update: beirc/application.lisp
by afuchs＠common-lisp.net 25 Sep '05

25 Sep '05

Update of /project/beirc/cvsroot/beirc In directory common-lisp.net:/tmp/cvs-serv9767 Modified Files: application.lisp Log Message: rename QUIT->DISCONNECT and use it from a restart in the irc listener process. also, use :prompt nil on /Me. Date: Sun Sep 25 18:30:40 2005 Author: afuchs Index: beirc/application.lisp diff -u beirc/application.lisp:1.4 beirc/application.lisp:1.5 --- beirc/application.lisp:1.4 Sun Sep 25 18:07:58 2005 +++ beirc/application.lisp Sun Sep 25 18:30:40 2005 @@ -346,12 +346,12 @@ (define-beirc-command (com-quit :name t) ((reason 'mumble :prompt "reason")) (when (current-connection *application-frame*) - (quit *application-frame* reason)) + (disconnect *application-frame* reason)) (frame-exit *application-frame*)) (define-beirc-command (com-disconnect :name t) ((reason 'mumble :prompt "reason")) (when (current-connection *application-frame*) - (quit *application-frame* reason))) + (disconnect *application-frame* reason))) (define-beirc-command (com-switch-timestamp-orientation :name t) () (setf *timestamp-column-orientation* (if (eql *timestamp-column-orientation* :left) @@ -480,9 +480,13 @@ (setf (gethash "*Server*" (receivers frame)) (server-receiver frame)) (setf (connection-process *application-frame*) (clim-sys:make-process #'(lambda () - (irc-event-loop frame connection)) + (restart-case + (irc-event-loop frame connection) + (disconnect () + :report "Disconnect from IRC" + (disconnect frame "Client Disconnect")))) :name "IRC Message Muffling Loop"))))))) -(defun quit (frame reason) +(defun disconnect (frame reason) (raise-receiver (server-receiver frame)) (irc:quit (current-connection frame) reason) (when (and (connection-process frame) @@ -586,7 +590,7 @@ ;;;;;; -(define-beirc-command (com-me :name t) ((what 'mumble)) +(define-beirc-command (com-me :name t) ((what 'mumble :prompt nil)) (with-slots (connection) *application-frame* (let ((m (make-fake-irc-message 'irc:ctcp-action-message :trailing-argument

1 0

[beirc-cvs] CVS update: beirc/application.lisp
by afuchs＠common-lisp.net 25 Sep '05

25 Sep '05

Update of /project/beirc/cvsroot/beirc In directory common-lisp.net:/tmp/cvs-serv8527 Modified Files: application.lisp Log Message: remove the ugly DISCONNECT function. it did the wrong thing, anyway. Date: Sun Sep 25 18:07:58 2005 Author: afuchs Index: beirc/application.lisp diff -u beirc/application.lisp:1.3 beirc/application.lisp:1.4 --- beirc/application.lisp:1.3 Sun Sep 25 17:48:32 2005 +++ beirc/application.lisp Sun Sep 25 18:07:58 2005 @@ -480,25 +480,8 @@ (setf (gethash "*Server*" (receivers frame)) (server-receiver frame)) (setf (connection-process *application-frame*) (clim-sys:make-process #'(lambda () - (unwind-protect - (irc-event-loop frame connection) - (disconnect frame))) + (irc-event-loop frame connection)) :name "IRC Message Muffling Loop"))))))) - -(defun disconnect (frame) - (raise-receiver (server-receiver frame)) - (post-message frame - (make-fake-irc-message 'irc:irc-quit-message - :trailing-argument "You disconnected from IRC" - :command "QUIT")) - (when (and (connection-process frame) - (not (eql (clim-sys:current-process) - (connection-process frame)))) - (destroy-process (connection-process frame))) - (setf (slot-value frame 'connection) nil - (connection-process frame) nil - (slot-value frame 'nick) nil)) - (defun quit (frame reason) (raise-receiver (server-receiver frame)) (irc:quit (current-connection frame) reason)

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

beirc-cvs September 2005