October 2005 - beirc-cvs@common-lisp.net - mailman3.common-lisp.net

[beirc-cvs] CVS update: beirc/application.lisp
by mretzlaff＠common-lisp.net 02 Oct '05

02 Oct '05

Update of /project/beirc/cvsroot/beirc In directory common-lisp.net:/tmp/cvs-serv30389 Modified Files: application.lisp Log Message: NICKNAME-TO-IGNORE-TRANSLATOR, NICKNAME-TO-FOCUS-TRANSLATOR, and NICKNAME-TO-UNFOCUS-TRANSLATOR have now :TESTERs; so you can only FOCUS someone if he/she/it is not focused yet, and UNFOCUS only if the enitity is currently focused. There is also a NICKNAME-TO-UNIGNORE-TRANSLATOR now. Useful to UNIGNORE via the /names list. Date: Mon Oct 3 00:40:55 2005 Author: mretzlaff Index: beirc/application.lisp diff -u beirc/application.lisp:1.28 beirc/application.lisp:1.29 --- beirc/application.lisp:1.28 Sun Oct 2 23:57:19 2005 +++ beirc/application.lisp Mon Oct 3 00:40:54 2005 @@ -453,7 +453,23 @@ :gesture :menu :menu t :documentation "Ignore this user" - :pointer-documentation "Ignore this user") + :pointer-documentation "Ignore this user" + :tester ((object) + (not (find object (slot-value *application-frame* 'ignored-nicks) + :test 'string-equal)))) + + (object) + (list object)) + +(define-presentation-to-command-translator nickname-to-unignore-translator + (nickname com-unignore beirc + :gesture :menu + :menu t + :documentation "Unignore this user" + :pointer-documentation "Unignore this user" + :tester ((object) + (find object (slot-value *application-frame* 'ignored-nicks) + :test 'string-equal))) (object) (list object)) @@ -462,7 +478,10 @@ :gesture :menu :menu t :documentation "Focus this user" - :pointer-documentation "Focus this user") + :pointer-documentation "Focus this user" + :tester ((object) + (not (find object (current-focused-nicks) + :test 'string-equal)))) (object) (list object)) @@ -471,7 +490,10 @@ :gesture :menu :menu t :documentation "Unfocus this user" - :pointer-documentation "Unfocus this user") + :pointer-documentation "Unfocus this user" + :tester ((object) + (find object (current-focused-nicks) + :test 'string-equal))) (object) (list object)) @@ -562,10 +584,9 @@ (nickname hostmask beirc :tester ((object context-type) (declare (ignore object)) - (presentation-subtypep context-type 'hostmask))) + (presentation-subtypep context-type 'hostmask))) (object) (format nil "*!*@~A" (irc:hostname (irc:find-user (current-connection *application-frame*) object)))) - (define-beirc-command (com-join :name t) ((channel 'channel :prompt "channel")) (raise-receiver (intern-receiver channel *application-frame* :channel channel))

1 0

[beirc-cvs] CVS update: beirc/application.lisp
by mretzlaff＠common-lisp.net 02 Oct '05

02 Oct '05

Update of /project/beirc/cvsroot/beirc In directory common-lisp.net:/tmp/cvs-serv26898 Modified Files: application.lisp Log Message: Changes the size of the interactor from 60 pixels to 68. This seems to be the minimum size dictated by the scrollbar. It solves the the "half input line"-problem (the easy way)... Date: Sun Oct 2 23:57:19 2005 Author: mretzlaff Index: beirc/application.lisp diff -u beirc/application.lisp:1.27 beirc/application.lisp:1.28 --- beirc/application.lisp:1.27 Sun Oct 2 23:39:07 2005 +++ beirc/application.lisp Sun Oct 2 23:57:19 2005 @@ -106,7 +106,7 @@ (vertically () (with-tab-layout ('receiver-pane :name 'query) ("*Server*" server 'receiver-pane)) - (60 io) + (68 io) (20 pointer-doc) (20 ;<-- Sigh! Bitrot! status-bar)))))

1 0

[beirc-cvs] CVS update: beirc/application.lisp
by mretzlaff＠common-lisp.net 02 Oct '05

02 Oct '05

Update of /project/beirc/cvsroot/beirc In directory common-lisp.net:/tmp/cvs-serv25833 Modified Files: application.lisp Log Message: Bugfix for JOIN-MISSING-CHANNELS: Try only to connect to the channels if the current *application-frame* is already connected to an IRC server. Drops the call to TIME in handle-event ((frame beirc) (event foo-event)). Date: Sun Oct 2 23:39:07 2005 Author: mretzlaff Index: beirc/application.lisp diff -u beirc/application.lisp:1.26 beirc/application.lisp:1.27 --- beirc/application.lisp:1.26 Sun Oct 2 19:34:15 2005 +++ beirc/application.lisp Sun Oct 2 23:39:07 2005 @@ -204,7 +204,7 @@ (pane (actual-application-pane (pane receiver)))) (let ((btmp (pane-scrolled-to-bottom-p pane))) (setf (pane-needs-redisplay pane) t) - (time (redisplay-frame-panes frame)) + (redisplay-frame-panes frame) (when btmp (scroll-pane-to-bottom pane))) (medium-force-output (sheet-medium pane)) ;### )) @@ -267,10 +267,11 @@ (defun join-missing-channels (frame) (let* ((connection (current-connection frame)) - (server (irc:server-name connection))) - (loop for join-channel in (cdr (assoc server *auto-join-alist* :test #'equal)) + (server (when connection (irc:server-name connection)))) + (when server + (loop for join-channel in (cdr (assoc server *auto-join-alist* :test #'equal)) do (unless (gethash join-channel (receivers frame)) - (irc:join connection join-channel))))) + (irc:join connection join-channel)))))) (defun load-user-init-file (&key (pathname *beirc-user-init-file*)) (when (probe-file pathname)

1 0

[beirc-cvs] CVS update: beirc/application.lisp
by mretzlaff＠common-lisp.net 02 Oct '05

02 Oct '05

Update of /project/beirc/cvsroot/beirc In directory common-lisp.net:/tmp/cvs-serv9481 Modified Files: application.lisp Log Message: Adds COM-WINDOW-NEXT and COM-WINDOW-PREVIOUS. The keystrokes do not yet work (and are uncommented). I hope this will be changed soon. (Also TAB-LAYOUT:ENABLED-PANE will perhaps be changed; an application that uses the tab-layout-pane should really not get in touch with objects of the class TAB-LAYOUT::TAB-PANE itself...) Date: Sun Oct 2 19:34:18 2005 Author: mretzlaff Index: beirc/application.lisp diff -u beirc/application.lisp:1.25 beirc/application.lisp:1.26 --- beirc/application.lisp:1.25 Sun Oct 2 11:30:19 2005 +++ beirc/application.lisp Sun Oct 2 19:34:15 2005 @@ -300,6 +300,28 @@ (define-beirc-command (com-raise :name t) ((receiver 'receiver :prompt "receiver")) (raise-receiver receiver)) +(define-beirc-command (com-window-next :name t);; :keystroke (:right :meta)) + () + (let* ((current-pane (tab-layout::tab-pane-pane + (enabled-pane (find-pane-named *application-frame* 'query)))) + (list-of-panes (sheet-children (sheet-parent current-pane))) + (position (position current-pane list-of-panes))) + (when list-of-panes + (if (>= position (1- (length list-of-panes))) + (switch-to-pane (car list-of-panes) 'tab-layout-pane) + (switch-to-pane (nth (1+ position) list-of-panes) 'tab-layout-pane))))) + +(define-beirc-command (com-window-previous :name t);; :keystroke (:left :meta)) + () + (let* ((current-pane (tab-layout::tab-pane-pane + (enabled-pane (find-pane-named *application-frame* 'query)))) + (list-of-panes (sheet-children (sheet-parent current-pane))) + (position (position current-pane list-of-panes))) + (when list-of-panes + (if (<= position 0) + (switch-to-pane (car (last list-of-panes)) 'tab-layout-pane) + (switch-to-pane (nth (1- position) list-of-panes) 'tab-layout-pane))))) + (define-beirc-command (com-close :name t) ((receiver 'receiver :prompt "receiver")) (when (eql receiver (server-receiver *application-frame*)) (error "Can't close the server tab for this application!"))

1 0

[beirc-cvs] CVS update: beirc/application.lisp beirc/package.lisp beirc/variables.lisp
by afuchs＠common-lisp.net 02 Oct '05

02 Oct '05

Update of /project/beirc/cvsroot/beirc In directory common-lisp.net:/tmp/cvs-serv7060 Modified Files: application.lisp package.lisp variables.lisp Log Message: add variable *nickserv-password-alist* and command /identify. export variable names. Date: Sun Oct 2 11:30:19 2005 Author: afuchs Index: beirc/application.lisp diff -u beirc/application.lisp:1.24 beirc/application.lisp:1.25 --- beirc/application.lisp:1.24 Sun Oct 2 11:14:16 2005 +++ beirc/application.lisp Sun Oct 2 11:30:19 2005 @@ -283,6 +283,17 @@ (define-beirc-command (com-reload :name t) () (load-user-init-file)) +(define-beirc-command (com-identify :name t) (&key + (password 'string :prompt "Password" + :default (cdr (assoc (irc:server-name (current-connection *application-frame*)) + *nickserv-password-alist* + :test #'equal))) + (who 'nickname :prompt "Target" :default "NickServ")) + (when (null password) + (accept 'string :prompt "Password")) + (irc:privmsg (current-connection *application-frame*) who + (format nil "IDENTIFY ~A" password))) + (define-beirc-command (com-query :name t) ((nick 'nickname :prompt "who")) (raise-receiver (intern-receiver nick *application-frame* :query nick))) @@ -396,7 +407,7 @@ (current-channel))) (define-beirc-command (com-say :name t) ((what 'mumble)) - (unless (string= what "") + (unless (or (string= what "") (null (target))) (post-message *application-frame* (make-fake-irc-message 'irc:irc-privmsg-message :trailing-argument what Index: beirc/package.lisp diff -u beirc/package.lisp:1.3 beirc/package.lisp:1.4 --- beirc/package.lisp:1.3 Sun Sep 25 14:55:10 2005 +++ beirc/package.lisp Sun Oct 2 11:30:19 2005 @@ -1,4 +1,7 @@ (cl:defpackage :beirc (:use :clim :clim-lisp :clim-sys :tab-layout) (:export #:beirc - #:*hyperspec-base-url* #:*default-fill-column* #:*timestamp-column-orientation*)) + #:*beirc-user-init-file* + #:*hyperspec-base-url* #:*default-fill-column* #:*timestamp-column-orientation* + #:*default-nick* #:*nickserv-password-alist* #:*default-web-browser + #:*auto-join-alist*)) Index: beirc/variables.lisp diff -u beirc/variables.lisp:1.6 beirc/variables.lisp:1.7 --- beirc/variables.lisp:1.6 Sun Oct 2 10:59:23 2005 +++ beirc/variables.lisp Sun Oct 2 11:30:19 2005 @@ -7,9 +7,13 @@ (defvar *default-web-browser* #+darwin "/usr/bin/open" ;; assuming a debian system running X: #+linux "/usr/bin/x-www-browser") -(defvar *auto-join-alist* (("irc.freenode.net" . ("#beirc"))) +(defvar *auto-join-alist* '(("irc.freenode.net" . ("#beirc"))) "An alist mapping irc server name to a list of channels to automatically join on connect.") + +(defvar *nickserv-password-alist* '() + "Default password to send to the NickServ authentication bot") + (defvar *beirc-user-init-file* (merge-pathnames (make-pathname :name ".beirc.lisp") (user-homedir-pathname)))

1 0

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

02 Oct '05

Update of /project/beirc/cvsroot/beirc In directory common-lisp.net:/tmp/cvs-serv6047 Modified Files: application.lisp Log Message: small bug fix to load-user-init-file: use pathname consistently; don't try to redraw an *a-f* that isn't there. Date: Sun Oct 2 11:14:17 2005 Author: afuchs Index: beirc/application.lisp diff -u beirc/application.lisp:1.23 beirc/application.lisp:1.24 --- beirc/application.lisp:1.23 Sun Oct 2 10:59:23 2005 +++ beirc/application.lisp Sun Oct 2 11:14:16 2005 @@ -272,12 +272,13 @@ do (unless (gethash join-channel (receivers frame)) (irc:join connection join-channel))))) -(defun load-user-init-file (&optional (pathname *beirc-user-init-file*)) - (when (probe-file *beirc-user-init-file*) +(defun load-user-init-file (&key (pathname *beirc-user-init-file*)) + (when (probe-file pathname) (let ((*package* #.*package*)) (load pathname)) - (join-missing-channels *application-frame*) - (redraw-all-receivers))) + (when *application-frame* + (join-missing-channels *application-frame*) + (redraw-all-receivers)))) (define-beirc-command (com-reload :name t) () (load-user-init-file))

1 0

[beirc-cvs] CVS update: beirc/application.lisp beirc/variables.lisp
by afuchs＠common-lisp.net 02 Oct '05

02 Oct '05

Update of /project/beirc/cvsroot/beirc In directory common-lisp.net:/tmp/cvs-serv4986 Modified Files: application.lisp variables.lisp Log Message: add variable *auto-join-channels*. On /connect or /reload, joins the channels corresponding to the server name. Date: Sun Oct 2 10:59:24 2005 Author: afuchs Index: beirc/application.lisp diff -u beirc/application.lisp:1.22 beirc/application.lisp:1.23 --- beirc/application.lisp:1.22 Sun Oct 2 10:42:20 2005 +++ beirc/application.lisp Sun Oct 2 10:59:23 2005 @@ -190,7 +190,8 @@ (redisplay-frame-pane *application-frame* pane))) (defun redraw-all-receivers () - (when (boundp '*application-frame*) + (when (and (boundp '*application-frame*) + (not (null *application-frame*))) (maphash (lambda (name receiver) (declare (ignore name)) (redraw-receiver receiver)) @@ -264,9 +265,19 @@ (make-instance 'bar-event :sheet frame)) (sleep 1))) +(defun join-missing-channels (frame) + (let* ((connection (current-connection frame)) + (server (irc:server-name connection))) + (loop for join-channel in (cdr (assoc server *auto-join-alist* :test #'equal)) + do (unless (gethash join-channel (receivers frame)) + (irc:join connection join-channel))))) + (defun load-user-init-file (&optional (pathname *beirc-user-init-file*)) - (load pathname) - (redraw-all-receivers)) + (when (probe-file *beirc-user-init-file*) + (let ((*package* #.*package*)) + (load pathname)) + (join-missing-channels *application-frame*) + (redraw-all-receivers))) (define-beirc-command (com-reload :name t) () (load-user-init-file)) @@ -545,6 +556,7 @@ (loop for receiver being the hash-values of (receivers frame) if (channelp (channel receiver)) do (irc:join connection (channel receiver))) + (join-missing-channels frame) (initialize-receiver-with-pane (server-receiver frame) frame (find-pane-named frame 'server) :add-pane-p nil) Index: beirc/variables.lisp diff -u beirc/variables.lisp:1.5 beirc/variables.lisp:1.6 --- beirc/variables.lisp:1.5 Sun Oct 2 10:42:20 2005 +++ beirc/variables.lisp Sun Oct 2 10:59:23 2005 @@ -7,6 +7,9 @@ (defvar *default-web-browser* #+darwin "/usr/bin/open" ;; assuming a debian system running X: #+linux "/usr/bin/x-www-browser") +(defvar *auto-join-alist* (("irc.freenode.net" . ("#beirc"))) + "An alist mapping irc server name to a list of channels to + automatically join on connect.") (defvar *beirc-user-init-file* (merge-pathnames (make-pathname :name ".beirc.lisp") (user-homedir-pathname)))

1 0

[beirc-cvs] CVS update: beirc/application.lisp beirc/variables.lisp
by afuchs＠common-lisp.net 02 Oct '05

02 Oct '05

Update of /project/beirc/cvsroot/beirc In directory common-lisp.net:/tmp/cvs-serv3895 Modified Files: application.lisp variables.lisp Log Message: Load the user init file when beirc is started, not when loaded. also add a com-reload command. Date: Sun Oct 2 10:42:20 2005 Author: afuchs Index: beirc/application.lisp diff -u beirc/application.lisp:1.21 beirc/application.lisp:1.22 --- beirc/application.lisp:1.21 Sun Oct 2 10:30:41 2005 +++ beirc/application.lisp Sun Oct 2 10:42:20 2005 @@ -190,10 +190,11 @@ (redisplay-frame-pane *application-frame* pane))) (defun redraw-all-receivers () - (maphash (lambda (name receiver) - (declare (ignore name)) - (redraw-receiver receiver)) - (receivers *application-frame*))) + (when (boundp '*application-frame*) + (maphash (lambda (name receiver) + (declare (ignore name)) + (redraw-receiver receiver)) + (receivers *application-frame*)))) (defmethod handle-event ((frame beirc) (event foo-event)) ;; Hack: @@ -225,6 +226,7 @@ (ticker-process (clim-sys:make-process (lambda () (ticker frame)) :name "Beirc Ticker"))) (setf *beirc-frame* frame) + (load-user-init-file) (run-frame-top-level frame) (unless (null (current-connection frame)) (irc:quit (current-connection frame) "Client Quit")) @@ -261,6 +263,13 @@ (clim-internals::event-queue-prepend (climi::frame-event-queue frame) (make-instance 'bar-event :sheet frame)) (sleep 1))) + +(defun load-user-init-file (&optional (pathname *beirc-user-init-file*)) + (load pathname) + (redraw-all-receivers)) + +(define-beirc-command (com-reload :name t) () + (load-user-init-file)) (define-beirc-command (com-query :name t) ((nick 'nickname :prompt "who")) (raise-receiver (intern-receiver nick *application-frame* :query nick))) Index: beirc/variables.lisp diff -u beirc/variables.lisp:1.4 beirc/variables.lisp:1.5 --- beirc/variables.lisp:1.4 Sun Oct 2 10:30:41 2005 +++ beirc/variables.lisp Sun Oct 2 10:42:20 2005 @@ -9,7 +9,4 @@ #+linux "/usr/bin/x-www-browser") (defvar *beirc-user-init-file* (merge-pathnames (make-pathname :name ".beirc.lisp") - (user-homedir-pathname))) - -(when (probe-file *beirc-user-init-file*) - (load *beirc-user-init-file*)) \ No newline at end of file + (user-homedir-pathname))) \ No newline at end of file

1 0

[beirc-cvs] CVS update: beirc/application.lisp beirc/variables.lisp
by afuchs＠common-lisp.net 02 Oct '05

02 Oct '05

Update of /project/beirc/cvsroot/beirc In directory common-lisp.net:/tmp/cvs-serv3317 Modified Files: application.lisp variables.lisp Log Message: Make the web browser program customizable. Date: Sun Oct 2 10:30:41 2005 Author: afuchs Index: beirc/application.lisp diff -u beirc/application.lisp:1.20 beirc/application.lisp:1.21 --- beirc/application.lisp:1.20 Sun Oct 2 10:25:37 2005 +++ beirc/application.lisp Sun Oct 2 10:30:41 2005 @@ -388,14 +388,10 @@ (irc:nick (current-connection *application-frame*) new-nick)) (define-beirc-command (com-browse-url :name t) ((url 'url :prompt "url")) - #+ (and sbcl darwin) - (sb-ext:run-program "/usr/bin/open" `(,url) :wait nil) - #+ (and openmcl darwin) - (ccl:run-program "/usr/bin/open" `(,url) :wait nil) - ;; XXX: daring assumption. perhaps this should use x-www-browser on - ;; debian/debian systems? - #+ (and sbcl linux) - (sb-ext:run-program "/usr/bin/x-www-browser" `(,url) :wait nil)) + #+sbcl + (sb-ext:run-program *default-web-browser* `(,url) :wait nil) + #+openmcl + (ccl:run-program *default-web-browser* `(,url) :wait nil)) (define-presentation-to-command-translator nickname-to-ignore-translator (nickname com-ignore beirc Index: beirc/variables.lisp diff -u beirc/variables.lisp:1.3 beirc/variables.lisp:1.4 --- beirc/variables.lisp:1.3 Sun Sep 25 20:57:25 2005 +++ beirc/variables.lisp Sun Oct 2 10:30:41 2005 @@ -4,6 +4,9 @@ (defvar *default-fill-column* 80) (defvar *timestamp-column-orientation* :right) (defvar *default-nick* (format nil "Brucio-~d" (random 100))) +(defvar *default-web-browser* #+darwin "/usr/bin/open" + ;; assuming a debian system running X: + #+linux "/usr/bin/x-www-browser") (defvar *beirc-user-init-file* (merge-pathnames (make-pathname :name ".beirc.lisp") (user-homedir-pathname)))

1 0

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

02 Oct '05

Update of /project/beirc/cvsroot/beirc In directory common-lisp.net:/tmp/cvs-serv2852 Modified Files: application.lisp Log Message: add "auto-join on reconnect" feature to com-connect; also, disconnect if there was an error during connecting. Date: Sun Oct 2 10:25:37 2005 Author: afuchs Index: beirc/application.lisp diff -u beirc/application.lisp:1.19 beirc/application.lisp:1.20 --- beirc/application.lisp:1.19 Sun Oct 2 06:01:25 2005 +++ beirc/application.lisp Sun Oct 2 10:25:37 2005 @@ -524,28 +524,38 @@ ((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 - (setf (slot-value *application-frame* 'connection) - (irc:connect :nickname nick :server server :connection-type 'beirc-connection)) - (setf (irc:client-stream (current-connection *application-frame*)) - (make-broadcast-stream)) - (setf (slot-value *application-frame* 'nick) nick) - (let ((connection (current-connection *application-frame*))) - (let ((frame *application-frame*)) - (initialize-receiver-with-pane (server-receiver frame) frame - (find-pane-named frame 'server) - :add-pane-p nil) - (setf (gethash "*Server*" (receivers frame)) (server-receiver frame)) - (setf (connection-process *application-frame*) - (clim-sys:make-process #'(lambda () - (restart-case - (irc-event-loop frame connection) - (disconnect () - :report "Disconnect from IRC" - (disconnect frame "Client Disconnect")))) - :name "IRC Message Muffling Loop"))))))) + (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)) + (unwind-protect + (progn + (setf (irc:client-stream (current-connection *application-frame*)) + (make-broadcast-stream)) + (setf (slot-value *application-frame* 'nick) nick) + (let ((connection (current-connection *application-frame*))) + (let ((frame *application-frame*)) + (loop for receiver being the hash-values of (receivers frame) + if (channelp (channel receiver)) + do (irc:join connection (channel receiver))) + (initialize-receiver-with-pane (server-receiver frame) frame + (find-pane-named frame 'server) + :add-pane-p nil) + (setf (gethash "*Server*" (receivers frame)) (server-receiver frame)) + (setf (connection-process *application-frame*) + (clim-sys:make-process #'(lambda () + (restart-case + (irc-event-loop frame connection) + (disconnect () + :report "Disconnect from IRC" + (disconnect frame "Client Disconnect")))) + :name "IRC Message Muffling Loop")))) + (setf success t)) + (unless success + (disconnect *application-frame* "Client error."))))))) + (defun disconnect (frame reason) (raise-receiver (server-receiver frame)) (irc:quit (current-connection frame) reason)

1 0