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

[beirc-cvs] CVS update: beirc/application.lisp beirc/message-display.lisp beirc/receivers.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-serv2022 Modified Files: application.lisp message-display.lisp receivers.lisp variables.lisp Log Message: Add various hostmask and mode change related features: * every display method that shows a user@host combination now presents them as 'hostmask, with associated object *!*@<host> * add a mode message destructuring mechanism that knows about hostmasks, numbers and nicknames and presents them nicely. * add an unban hostmask command & hostmask-to-*-translator. Date: Mon Oct 3 01:47:51 2005 Author: afuchs Index: beirc/application.lisp diff -u beirc/application.lisp:1.29 beirc/application.lisp:1.30 --- beirc/application.lisp:1.29 Mon Oct 3 00:40:54 2005 +++ beirc/application.lisp Mon Oct 3 01:47:51 2005 @@ -401,6 +401,12 @@ (define-beirc-command (com-ban-hostmask :name t) ((who 'hostmask :prompt "hostmask")) (irc:ban (current-connection *application-frame*) (target) who)) +(define-beirc-command (com-unban-hostmask :name t) ((who 'hostmask :prompt "hostmask")) + (irc:unban (current-connection *application-frame*) (target) who)) + +(define-beirc-command (com-unban-nick :name t) ((who 'nickname :prompt "who")) + (irc:unban (current-connection *application-frame*) (target) (format nil "~A!*@*" who))) + (define-beirc-command (com-kick :name t) ((who 'nickname :prompt "who") (reason 'mumble :prompt "reason")) (irc:kick (current-connection *application-frame*) (target) who reason)) @@ -525,6 +531,24 @@ :menu t :documentation "Ban this user's nickname" :pointer-documentation "Ban this user's nickname") + (object) + (list object)) + +(define-presentation-to-command-translator hostmask-to-ban-translator + (hostmask com-ban-hostmask beirc + :gesture :menu + :menu t + :documentation "Ban this hostmask" + :pointer-documentation "Ban this hostmask") + (object) + (list object)) + +(define-presentation-to-command-translator hostmask-to-unban-translator + (hostmask com-unban-hostmask beirc + :gesture :menu + :menu t + :documentation "Unban this hostmask" + :pointer-documentation "Unban this hostmask") (object) (list object)) Index: beirc/message-display.lisp diff -u beirc/message-display.lisp:1.21 beirc/message-display.lisp:1.22 --- beirc/message-display.lisp:1.21 Wed Sep 28 21:33:28 2005 +++ beirc/message-display.lisp Mon Oct 3 01:47:51 2005 @@ -195,7 +195,10 @@ ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small) (format t "Nick change: ") (present (irc:source message) 'nickname) - (format t " (~A@~A) is now known as " (irc:user message) (irc:host message)) + (write-string " (") + (with-output-as-presentation (t (format nil "*!*@~A" (irc:host message)) 'hostmask) + (format t "~A@~A" (irc:user message) (irc:host message))) + (write-string " is now known as ") (present (irc:trailing-argument message) 'nickname))))) (defmethod print-message ((message irc:irc-rpl_whoisuser-message) receiver) @@ -205,7 +208,10 @@ (destructuring-bind (me nickname user host &rest args) (irc:arguments message) (declare (ignore me args)) (present nickname 'nickname) - (format t " is (~A@~A) (~A)" user host (irc:trailing-argument message))))))) + (format t " is (") + (with-output-as-presentation (t (format nil "*!*@~A" host) 'hostmask) + (format t "~A@~A" user host)) + (format t ") (~A)" (irc:trailing-argument message))))))) (defmethod print-message ((message irc:irc-rpl_whoischannels-message) receiver) (formatting-message (t message receiver) @@ -312,7 +318,10 @@ ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small) (format t "Join: ") (present (irc:source message) 'nickname) - (format t " (~A@~A)" (irc:user message) (irc:host message)))))) + (write-char #\Space) + (with-output-as-presentation (t (format nil "*!*@~A" (irc:host message)) + 'hostmask) + (format t "(~A@~A)" (irc:user message) (irc:host message))))))) (defmethod print-message ((message irc:irc-kick-message) receiver) (formatting-message (t message receiver) @@ -325,21 +334,59 @@ :start-length (+ 9 (length (second (irc:arguments message))) (length (irc:source message)))))))) +;;; XXX: uses unexported symbols from cl-irc, but I think their +;;; unexportedness is accidental. +(defun mode-symbol-to-char (target mode) + (irc::mode-desc-char + (irc::mode-description (current-connection *application-frame*) + target mode))) + +(defmethod print-mode-change (target op mode (user irc:user)) + (format t "~A~A:" op (mode-symbol-to-char target mode)) + (present (irc:nickname user) 'nickname)) + +(defmethod print-mode-change (target op (mode (eql :limit)) arg) + (format t "~A~A" op (mode-symbol-to-char target mode)) + (when (not (null arg)) + (write-char #\:) + (present arg 'number))) + +(macrolet ((define-mode-change-with-hostmask-printer (&rest modes) + `(progn + ,@(loop for mode in modes + collect `(defmethod print-mode-change (target op (mode (eql ,mode)) mask) + (format t "~A~A:" op (mode-symbol-to-char target mode)) + (present mask 'hostmask)))))) + (define-mode-change-with-hostmask-printer :ban :invite :except)) + +(defmethod print-mode-change (target op mode (arg (eql nil))) + (format t "~A~A" op (mode-symbol-to-char target mode))) + (defmethod print-message ((message irc:irc-mode-message) receiver) (case (length (irc:arguments message)) (1 (formatting-message (t message receiver) - ((format t " ")) - ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small) - (format-message* (format nil "~A set mode ~A ~A" (irc:source message) - (irc:trailing-argument message) - (first (irc:arguments message)))))))) - (3 (destructuring-bind (target modes args) (irc:arguments message) - (declare (ignore target)) + ((format t " ")) + ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small) + (format-message* (format nil "~A set mode ~A ~A" (irc:source message) + (irc:trailing-argument message) + (first (irc:arguments message)))))))) + (t + (destructuring-bind (target &rest args) (irc:arguments message) + (let* ((connection (current-connection *application-frame*)) + (target (or (irc:find-user connection target) + (irc:find-channel connection target))) + (mode-changes (irc:parse-mode-arguments connection target args + :server-p (irc:user connection)))) (formatting-message (t message receiver) - ((format t " ")) - ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small) - (present (irc:source message) 'nickname) - (format-message* (format nil " set mode ~A ~A" modes args))))))))) + ((format t " ")) + ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small) + (present (irc:source message) 'nickname) + (write-string " changes channel mode: ") + (loop for (change . rest) on mode-changes + do (destructuring-bind (op mode &optional arg) change + (print-mode-change target op mode arg)) + if (not (null rest)) + do (write-string ", ")))))))))) ;;; the display function (& utilities) Index: beirc/receivers.lisp diff -u beirc/receivers.lisp:1.10 beirc/receivers.lisp:1.11 --- beirc/receivers.lisp:1.10 Sun Oct 2 06:18:24 2005 +++ beirc/receivers.lisp Mon Oct 3 01:47:51 2005 @@ -168,7 +168,7 @@ (defmethod receiver-for-message ((message irc:irc-mode-message) frame) (case (length (irc:arguments message)) (1 (server-receiver frame)) - (3 (destructuring-bind (channel modes args) (irc:arguments message) + (t (destructuring-bind (channel modes &rest args) (irc:arguments message) (declare (ignore modes args)) (intern-receiver channel frame :channel channel))))) Index: beirc/variables.lisp diff -u beirc/variables.lisp:1.7 beirc/variables.lisp:1.8 --- beirc/variables.lisp:1.7 Sun Oct 2 11:30:19 2005 +++ beirc/variables.lisp Mon Oct 3 01:47:51 2005 @@ -7,9 +7,12 @@ (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.") + automatically join on connect. Each element should have this + format: + (\"server-name\" . (\"#channel-name\" \"#channel2\" \"#channel3\"))") (defvar *nickserv-password-alist* '() "Default password to send to the NickServ authentication bot")

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