beirc-cvs March 2006

beirc-cvs@common-lisp.net

2 participants
32 discussions

[beirc-cvs] CVS beirc
by rgoldman 21 Mar '06

21 Mar '06

Update of /project/beirc/cvsroot/beirc In directory clnet:/tmp/cvs-serv26475 Modified Files: variables.lisp Log Message: Added *auto-connect-list*, which initially defaults to NIL. As the name suggests, beirc will attempt to connect to these servers automagically on startup. --- /project/beirc/cvsroot/beirc/variables.lisp 2006/02/25 22:22:47 1.10 +++ /project/beirc/cvsroot/beirc/variables.lisp 2006/03/21 15:22:03 1.11 @@ -14,6 +14,12 @@ format: (\"server-name\" . (\"#channel-name\" \"#channel2\" \"#channel3\"))") +(defvar *auto-connect-list* + nil + "A list of servers (strings) specifying servers to which +beirc should automatically connect on startup." +) + (defvar *nickserv-password-alist* '() "Default password to send to the NickServ authentication bot")

1 0

[beirc-cvs] CVS beirc
by afuchs 17 Mar '06

17 Mar '06

Update of /project/beirc/cvsroot/beirc In directory clnet:/tmp/cvs-serv14301 Modified Files: application.lisp Log Message: Add an /Everywhere command, that allows performing another command on every server connection. --- /project/beirc/cvsroot/beirc/application.lisp 2006/03/16 21:01:21 1.64 +++ /project/beirc/cvsroot/beirc/application.lisp 2006/03/17 17:44:22 1.65 @@ -122,8 +122,17 @@ (defun receiver-from-tab-pane (tab-pane &optional (frame *application-frame*)) (gethash tab-pane (tab-panes-to-receivers frame))) +(defvar *current-receiver-override*) + +(defmacro with-current-receiver ((var receiver) &body body) + `(let* ((*current-receiver-override* ,receiver) + (,var *current-receiver-override*)) + ,@body)) + (defmethod current-receiver ((frame beirc)) - (let ((receiver (receiver-from-tab-pane (enabled-pane (find-pane-named frame 'query)) frame))) + (let ((receiver (if (boundp '*current-receiver-override*) + *current-receiver-override* + (receiver-from-tab-pane (enabled-pane (find-pane-named frame 'query)) frame)))) (if (typep receiver 'receiver) receiver nil))) @@ -515,6 +524,12 @@ (make-pathname :type nil :defaults pathname) pathname)))) +(define-beirc-command (com-everywhere :name t) ((command 'command :prompt "command")) + (mapc (lambda (server-receiver) + (with-current-receiver (receiver (cdr server-receiver)) + (execute-frame-command *application-frame* command))) + (server-receivers *application-frame*))) + (defun make-fake-irc-message (message-type &key command arguments (source (current-nickname)) trailing-argument)

1 0

[beirc-cvs] CVS beirc
by afuchs 16 Mar '06

16 Mar '06

Update of /project/beirc/cvsroot/beirc In directory clnet:/tmp/cvs-serv18270 Modified Files: application.lisp Log Message: Make the quit reason in com-quit an (optional) keyword arg. --- /project/beirc/cvsroot/beirc/application.lisp 2006/03/16 20:56:52 1.63 +++ /project/beirc/cvsroot/beirc/application.lisp 2006/03/16 21:01:21 1.64 @@ -573,7 +573,7 @@ (define-beirc-command (com-back :name t) () (irc:away (current-connection *application-frame*) "")) -(define-beirc-command (com-quit :name t) ((reason 'mumble :prompt "reason")) +(define-beirc-command (com-quit :name t) (&key (reason 'mumble :prompt "reason" :default "Client Quit")) (disconnect-all *application-frame* reason) (frame-exit *application-frame*))

1 0

[beirc-cvs] CVS beirc
by afuchs 16 Mar '06

16 Mar '06

Update of /project/beirc/cvsroot/beirc In directory clnet:/tmp/cvs-serv16566 Modified Files: application.lisp Log Message: Add box-adjuster-gadget between io and the query buffers. --- /project/beirc/cvsroot/beirc/application.lisp 2006/03/16 20:33:36 1.62 +++ /project/beirc/cvsroot/beirc/application.lisp 2006/03/16 20:56:52 1.63 @@ -83,7 +83,8 @@ (presence :initform (make-hash-table :test #'equal) :reader presence)) (:panes (io - :interactor) + :interactor + :height 72) (pointer-doc :pointer-documentation) (status-bar :application @@ -111,7 +112,8 @@ (with-tab-layout ('receiver-pane :name 'query) ("*Not Connected*" server 'receiver-pane)) ;; (68 io) ;; no drop-shadow prompt - (72 io) + (make-pane 'clim-extensions:box-adjuster-gadget) + io (20 pointer-doc) (20 ;<-- Sigh! Bitrot! status-bar)))))

1 0

[beirc-cvs] CVS beirc
by afuchs 16 Mar '06

16 Mar '06

Update of /project/beirc/cvsroot/beirc In directory clnet:/tmp/cvs-serv14194 Modified Files: presentations.lisp Log Message: Fix completion in accept method for receivers for multiple server connections. --- /project/beirc/cvsroot/beirc/presentations.lisp 2006/02/25 19:55:56 1.10 +++ /project/beirc/cvsroot/beirc/presentations.lisp 2006/03/16 20:44:56 1.11 @@ -107,7 +107,9 @@ (define-presentation-method accept ((type receiver) *standard-input* (view textual-view) &key) (completing-from-suggestions (*standard-input* :partial-completers '(#\Space)) - (maphash #'suggest (receivers *application-frame*)))) + (maphash (lambda (key receiver) + (suggest (second key) receiver)) + (receivers *application-frame*)))) ;;; channels

1 0

[beirc-cvs] CVS beirc
by afuchs 16 Mar '06

16 Mar '06

Update of /project/beirc/cvsroot/beirc In directory clnet:/tmp/cvs-serv13411 Modified Files: application.lisp Log Message: I forgot to mention: the "previous/next page" bindings are derived from a function by Thomas Persson. --- /project/beirc/cvsroot/beirc/application.lisp 2006/03/16 20:32:05 1.61 +++ /project/beirc/cvsroot/beirc/application.lisp 2006/03/16 20:33:36 1.62 @@ -438,6 +438,7 @@ if (<= prev (bounding-rectangle-min-y (pane-viewport-region pane)) this) do (return this)) bottom) + (define-scroller-command (com-previous-page (:prior)) (top bottom) (let* ((pane (actual-application-pane (pane (current-receiver *application-frame*)))) (pane-min-y (rectangle-min-y (pane-viewport-region pane)))

1 0

[beirc-cvs] CVS beirc
by afuchs 16 Mar '06

16 Mar '06

Update of /project/beirc/cvsroot/beirc In directory clnet:/tmp/cvs-serv13300 Modified Files: application.lisp message-processing.lisp Log Message: Fixes by Robert P. Goldman: rename "receiver" to "tab", choose a different nickname on connect. --- /project/beirc/cvsroot/beirc/application.lisp 2006/03/16 20:22:57 1.60 +++ /project/beirc/cvsroot/beirc/application.lisp 2006/03/16 20:32:05 1.61 @@ -116,11 +116,12 @@ (20 ;<-- Sigh! Bitrot! status-bar))))) -(defun receiver-from-tab-pane (tab-pane) - (gethash tab-pane (tab-panes-to-receivers *application-frame*))) +;;; addition of optional argument allows debugging from outside the frame process. [2006/03/16:rpg] +(defun receiver-from-tab-pane (tab-pane &optional (frame *application-frame*)) + (gethash tab-pane (tab-panes-to-receivers frame))) (defmethod current-receiver ((frame beirc)) - (let ((receiver (receiver-from-tab-pane (enabled-pane (find-pane-named frame 'query))))) + (let ((receiver (receiver-from-tab-pane (enabled-pane (find-pane-named frame 'query)) frame))) (if (typep receiver 'receiver) receiver nil))) @@ -283,7 +284,10 @@ (load-user-init-file) (run-frame-top-level frame) (clim-sys:destroy-process ticker-process) - (disconnect-all frame "Client Quit")))))))) + (disconnect-all frame "Client Quit")))) + ;; added process name for easier debug... + :name "BEIRC GUI process")))) + (defun message-directed-to-me-p (message) (irc:destructuring-arguments (&last body) message @@ -396,7 +400,7 @@ (define-window-switcher com-window-next (:next :control) 1 (constantly t)) (define-window-switcher com-window-previous (:prior :control) -1 (constantly t)))) -(define-beirc-command (com-close :name t) ((receiver 'receiver :prompt "receiver")) +(define-beirc-command (com-close :name t) ((receiver 'receiver :prompt "tab")) (let* ((connection (connection receiver)) (channel (irc:find-channel connection (title receiver)))) (cond --- /project/beirc/cvsroot/beirc/message-processing.lisp 2006/03/06 10:21:28 1.4 +++ /project/beirc/cvsroot/beirc/message-processing.lisp 2006/03/16 20:32:05 1.5 @@ -67,3 +67,10 @@ "Set/Unset away status." (setf (away-status *application-frame* (irc:connection message)) (typep message 'irc:irc-rpl_noaway-message))) + +(define-beirc-hook autojoin-hoook ((message cl-irc:irc-rpl_welcome-message)) + "When you establish a connection, check the list of channels for autojoin +and set them up accordingly." + (declare (ignore message)) + (join-missing-channels *application-frame*)) +

1 0

[beirc-cvs] CVS beirc
by afuchs 16 Mar '06

16 Mar '06

Update of /project/beirc/cvsroot/beirc In directory clnet:/tmp/cvs-serv10954 Modified Files: application.lisp Log Message: Do nothing if connecting to a server/nick that we're already connected to. --- /project/beirc/cvsroot/beirc/application.lisp 2006/03/16 19:29:10 1.59 +++ /project/beirc/cvsroot/beirc/application.lisp 2006/03/16 20:22:57 1.60 @@ -133,6 +133,14 @@ &optional (connection (current-connection *application-frame*))) (cdr (assoc connection (server-receivers frame) :test #'connection=))) +(defmethod server-receiver-from-args ((frame beirc) server-name port nickname) + (loop for (connection . receiver) in (server-receivers frame) + if (and (equal (irc:nickname (irc:user connection)) nickname) + (equal (irc:server-name connection) server-name) + ;; TODO: no port. + ) + do (return receiver))) + (defmethod (setf server-receiver) (newval (frame beirc) &optional (connection (current-connection *application-frame*))) (pushnew (cons connection newval) (slot-value frame 'server-receivers) @@ -817,33 +825,34 @@ (pass 'string :prompt "Password" :default nil) (port 'number :prompt "Port" :default irc::*default-irc-server-port*)) (let ((success nil)) - (let* ((frame *application-frame*) - (connection (apply #'irc:connect - :nickname nick :server server :connection-type 'beirc-connection :port port - (if (null pass) - nil - `(:password ,pass)))) - (server-receiver (intern-receiver (format nil "~A on ~A:~A" nick server port) connection frame))) - (unwind-protect - (progn - (setf (irc:client-stream connection) (make-broadcast-stream)) - (when (tab-layout:find-in-tab-panes-list (find-pane-named frame 'server) - (find-pane-named frame 'query)) - (tab-layout:remove-pane (find-pane-named frame 'server) - (find-pane-named frame 'query))) - (setf (server-receiver frame connection) server-receiver) - (setf (ui-process *application-frame*) (current-process)) - (setf (connection-process *application-frame* connection) - (clim-sys:make-process #'(lambda () - (restart-case - (irc-event-loop frame connection) - (disconnect () - :report "Terminate this connection" - (disconnect connection frame "Client Disconnect")))) - :name "IRC Message Muffling Loop")) - (setf success t)) - (unless success - (disconnect connection frame "Client error.")))))) + (or (server-receiver-from-args *application-frame* server port nick) + (let* ((frame *application-frame*) + (connection (apply #'irc:connect + :nickname nick :server server :connection-type 'beirc-connection :port port + (if (null pass) + nil + `(:password ,pass)))) + (server-receiver (intern-receiver (format nil "~A on ~A:~A" nick server port) connection frame))) + (unwind-protect + (progn + (setf (irc:client-stream connection) (make-broadcast-stream)) + (when (tab-layout:find-in-tab-panes-list (find-pane-named frame 'server) + (find-pane-named frame 'query)) + (tab-layout:remove-pane (find-pane-named frame 'server) + (find-pane-named frame 'query))) + (setf (server-receiver frame connection) server-receiver) + (setf (ui-process *application-frame*) (current-process)) + (setf (connection-process *application-frame* connection) + (clim-sys:make-process #'(lambda () + (restart-case + (irc-event-loop frame connection) + (disconnect () + :report "Terminate this connection" + (disconnect connection frame "Client Disconnect")))) + :name "IRC Message Muffling Loop")) + (setf success t)) + (unless success + (disconnect connection frame "Client error."))))))) (defun disconnect (connection frame reason) (let ((*application-frame* frame))

1 0

[beirc-cvs] CVS beirc
by afuchs 16 Mar '06

16 Mar '06

Update of /project/beirc/cvsroot/beirc In directory clnet:/tmp/cvs-serv2721 Modified Files: application.lisp Log Message: Use explicit :gesture nil on menu-only presentation translators. --- /project/beirc/cvsroot/beirc/application.lisp 2006/03/16 19:18:38 1.58 +++ /project/beirc/cvsroot/beirc/application.lisp 2006/03/16 19:29:10 1.59 @@ -626,6 +626,7 @@ (define-presentation-to-command-translator nickname-to-ignore-translator (nickname com-ignore beirc :menu t + :gesture nil :documentation "Ignore this user" :pointer-documentation "Ignore this user" :tester ((object) @@ -638,6 +639,7 @@ (define-presentation-to-command-translator nickname-to-unignore-translator (nickname com-unignore beirc :menu t + :gesture nil :documentation "Unignore this user" :pointer-documentation "Unignore this user" :tester ((object) @@ -649,6 +651,7 @@ (define-presentation-to-command-translator nickname-to-focus-translator (nickname com-focus beirc :menu t + :gesture nil :documentation "Focus this user" :pointer-documentation "Focus this user" :tester ((object) @@ -660,6 +663,7 @@ (define-presentation-to-command-translator nickname-to-unfocus-translator (nickname com-unfocus beirc :menu t + :gesture nil :documentation "Unfocus this user" :pointer-documentation "Unfocus this user" :tester ((object) @@ -671,6 +675,7 @@ (define-presentation-to-command-translator nickname-to-query-translator (nickname com-query beirc :menu t + :gesture nil :documentation "Query this user" :pointer-documentation "Query this user") (object) @@ -679,6 +684,7 @@ (define-presentation-to-command-translator nickname-to-kick-translator (nickname com-kick beirc :menu t + :gesture nil :documentation "Kick this user" :pointer-documentation "Kick this user") (object) @@ -691,6 +697,7 @@ (define-presentation-to-command-translator nickname-to-ban-nick-translator (nickname com-ban-nick beirc :menu t + :gesture nil :documentation "Ban this user's nickname" :pointer-documentation "Ban this user's nickname") (object) @@ -699,6 +706,7 @@ (define-presentation-to-command-translator hostmask-to-ban-translator (hostmask com-ban-hostmask beirc :menu t + :gesture nil :documentation "Ban this hostmask" :pointer-documentation "Ban this hostmask") (object) @@ -707,6 +715,7 @@ (define-presentation-to-command-translator hostmask-to-unban-translator (hostmask com-unban-hostmask beirc :menu t + :gesture nil :documentation "Unban this hostmask" :pointer-documentation "Unban this hostmask") (object) @@ -715,6 +724,7 @@ (define-presentation-to-command-translator nickname-to-ban-hostmask-translator (nickname com-ban-hostmask beirc :menu t + :gesture nil :documentation "Ban this user's hostmask" :pointer-documentation "Ban this user's hostmask") (object)

1 0

[beirc-cvs] CVS beirc
by afuchs 16 Mar '06

16 Mar '06

Update of /project/beirc/cvsroot/beirc In directory clnet:/tmp/cvs-serv2267 Modified Files: application.lisp Log Message: Increase :priority of the translators we want to use on gestures. --- /project/beirc/cvsroot/beirc/application.lisp 2006/03/16 19:11:19 1.57 +++ /project/beirc/cvsroot/beirc/application.lisp 2006/03/16 19:18:38 1.58 @@ -725,7 +725,8 @@ :gesture :select :menu t :documentation "Perform WHOIS query on user" - :pointer-documentation "Perform WHOIS query on user") + :pointer-documentation "Perform WHOIS query on user" + :priority 10) (object) (list object)) @@ -734,7 +735,8 @@ :gesture :describe :menu t :documentation "Join this channel" - :pointer-documentation "Join this channel") + :pointer-documentation "Join this channel" + :priority 10) (object) (list object))

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

beirc-cvs March 2006