beirc-cvs April 2006

beirc-cvs@common-lisp.net

2 participants
20 discussions

[beirc-cvs] CVS beirc
by afuchs 12 Apr '06

12 Apr '06

Update of /project/beirc/cvsroot/beirc In directory clnet:/tmp/cvs-serv27592 Modified Files: receivers.lisp Log Message: oops. remove #\Newline writing to debug-io. --- /project/beirc/cvsroot/beirc/receivers.lisp 2006/04/12 18:27:16 1.27 +++ /project/beirc/cvsroot/beirc/receivers.lisp 2006/04/12 18:42:30 1.28 @@ -122,8 +122,7 @@ ;; KLUDGE: reset the connection of messages so ;; that channel/user finding queries don't fail ;; horribly - (setf (irc:connection message) connection))) - (write-char #\Newline *debug-io*))) + (setf (irc:connection message) connection))))) (receivers frame))))

1 0

[beirc-cvs] CVS beirc
by afuchs 12 Apr '06

12 Apr '06

Update of /project/beirc/cvsroot/beirc In directory clnet:/tmp/cvs-serv25758 Modified Files: application.lisp message-display.lisp message-processing.lisp receivers.lisp Log Message: Add "reconnect" support. * notices when connections are dropped * offers to reconnect when the connection is dropped. * connection setup now believes in reconnecting. --- /project/beirc/cvsroot/beirc/application.lisp 2006/04/07 01:42:56 1.75 +++ /project/beirc/cvsroot/beirc/application.lisp 2006/04/12 18:27:16 1.76 @@ -374,9 +374,8 @@ (make-instance 'bar-event :sheet frame)) (sleep 1))) -(defun join-missing-channels (frame) - (let* ((connection (current-connection frame)) - (server (when connection (irc:server-name connection)))) +(defun join-missing-channels (frame &optional (connection (current-connection frame))) + (let* ((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)) @@ -890,15 +889,20 @@ (nick 'string :prompt "Nick name" :default *default-nick*) (pass 'string :prompt "Password" :default nil) (port 'number :prompt "Port" :default irc::*default-irc-server-port*)) - (let ((success nil)) - (or (server-receiver-from-args *application-frame* server port nick) + (let ((success nil) + (maybe-server-receiver (server-receiver-from-args *application-frame* server port nick))) + (or (and maybe-server-receiver (connection-open-p maybe-server-receiver)) (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))) + (server-receiver (if maybe-server-receiver + (prog1 maybe-server-receiver + (reinit-receiver-for-new-connection maybe-server-receiver + connection)) + (intern-receiver (format nil "~A on ~A:~A" nick server port) connection frame)))) (unwind-protect (progn (setf (irc:client-stream connection) (make-broadcast-stream)) @@ -1030,13 +1034,17 @@ (command (save-input-line stream frame) object))) - (window-clear stream))) + (window-clear stream))) (defun irc-event-loop (frame connection) - (unwind-protect - (let ((*application-frame* frame)) - (irc:read-message-loop connection)) - (irc:remove-all-hooks connection))) + (let ((*application-frame* frame)) + (unwind-protect (irc:read-message-loop connection) + (setf (connection-open-p (server-receiver frame connection)) nil) + (irc:remove-all-hooks connection) + (irc:irc-message-event connection + (make-fake-irc-message 'irc-connection-closed-message + :command "Connnection closed" + :source (irc:server-name connection)))))) ;;; Hack: --- /project/beirc/cvsroot/beirc/message-display.lisp 2006/04/02 20:51:54 1.45 +++ /project/beirc/cvsroot/beirc/message-display.lisp 2006/04/12 18:27:16 1.46 @@ -494,6 +494,14 @@ (with-drawing-options (*standard-output* :ink +grey12+ :text-size :small) (format-message* "Click here to close this tab.")))) +(defun offer-reconnect (receiver) + (let* ((conn (connection receiver)) + (server (irc:server-name conn)) + (nickname (irc:nickname (irc:user conn)))) + (with-output-as-presentation (t `(com-connect ,server :nick ,nickname) 'command) + (with-drawing-options (*standard-output* :ink +grey12+ :text-size :small) + (format-message* (format nil "Click here to reconnect to ~A as ~A" server nickname)))))) + (defmethod print-message ((message irc:irc-err_nosuchnick-message) receiver) (formatting-message (t message receiver) ((format t " ")) @@ -672,6 +680,13 @@ (irc:irc-rpl_invitelist-message "INVITED: ") (irc:irc-rpl_exceptlist-message "UNBANNED: "))) +(defmethod print-message ((message irc-connection-closed-message) receiver) + (formatting-message (t message receiver) + ((format t " ")) + ((with-drawing-options (*standard-output* :ink +red3+) + (format-message* "Connection to server closed.") + (offer-reconnect receiver))))) + ;;; the display function (& utilities) (defgeneric preamble-length (message) --- /project/beirc/cvsroot/beirc/message-processing.lisp 2006/04/04 18:37:28 1.7 +++ /project/beirc/cvsroot/beirc/message-processing.lisp 2006/04/12 18:27:16 1.8 @@ -71,5 +71,4 @@ (define-beirc-hook autojoin-hoook ((message cl-irc:irc-rpl_welcome-message)) "When a connection is established, check the list of channels for autojoin and set them up accordingly." - (declare (ignore message)) - (join-missing-channels *application-frame*)) + (join-missing-channels *application-frame* (irc:connection message))) --- /project/beirc/cvsroot/beirc/receivers.lisp 2006/04/11 22:28:58 1.26 +++ /project/beirc/cvsroot/beirc/receivers.lisp 2006/04/12 18:27:16 1.27 @@ -9,7 +9,8 @@ (messages-directed-to-me :accessor messages-directed-to-me :initform 0) (channel :reader channel :initform nil :initarg :channel) (connection :accessor connection :initarg :connection) - (query :reader query :initform nil :initarg :query) ;; <- XXX: remove this. + (connection-open-p :accessor connection-open-p :initform t) ; used only on server receivers. + (query :reader query :initform nil :initarg :query) (focused-nicks :accessor focused-nicks :initform nil) (title :reader title :initarg :title) (last-visited :accessor last-visited :initform 0) @@ -18,6 +19,8 @@ (pane :reader pane) (tab-pane :accessor tab-pane))) +(defclass irc-connection-closed-message (irc:irc-message) ()) + (defun slot-value-or-something (object &key (slot 'name) (something "without name")) (if (slot-boundp object slot) (slot-value object slot) @@ -107,6 +110,23 @@ (setf (gethash (list connection normalized-name) (receivers frame)) receiver) receiver)))) +(defun reinit-receiver-for-new-connection (server-receiver connection &optional (frame *application-frame*)) + (let ((old-connection (connection server-receiver))) + (maphash (lambda (key receiver) + (destructuring-bind (rec-connection name) key + (when (eql old-connection rec-connection) + (remhash key (receivers frame)) + (setf (gethash (list connection name) (receivers frame)) receiver) + (setf (connection receiver) connection) + (dolist (message (messages receiver)) + ;; KLUDGE: reset the connection of messages so + ;; that channel/user finding queries don't fail + ;; horribly + (setf (irc:connection message) connection))) + (write-char #\Newline *debug-io*))) + (receivers frame)))) + + (defun remove-receiver (receiver frame) (tab-layout:remove-pane (tab-pane receiver) (find-pane-named frame 'query)) @@ -256,7 +276,6 @@ 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.

1 0

[beirc-cvs] CVS beirc
by rgoldman 12 Apr '06

12 Apr '06

Update of /project/beirc/cvsroot/beirc In directory clnet:/tmp/cvs-serv12718 Modified Files: receivers.lisp Log Message: Reduced minimum dimensions of receiver-pane to give more freedom to resize things. --- /project/beirc/cvsroot/beirc/receivers.lisp 2006/04/04 18:37:29 1.25 +++ /project/beirc/cvsroot/beirc/receivers.lisp 2006/04/11 22:28:58 1.26 @@ -98,7 +98,7 @@ (lambda (frame pane) (beirc-app-display frame pane receiver)) :display-time nil - :min-width 600 :min-height 800 + :min-width 400 :min-height 600 :incremental-redisplay t))) (update-drawing-options receiver)))) (if (equal (current-process) (ui-process frame))

1 0

[beirc-cvs] CVS beirc
by afuchs 09 Apr '06

09 Apr '06

Update of /project/beirc/cvsroot/beirc In directory clnet:/tmp/cvs-serv6956 Modified Files: sound-player.lisp Log Message: Make sound-server functions work with sbcl: * add :wait nil to run-program invocation, * use the sb-ext package prefix where needed, * store the process structure instead of the PID in the *s-s-pid* variable and * kill & wait for the process correctly --- /project/beirc/cvsroot/beirc/sound-player.lisp 2006/04/07 15:43:15 1.2 +++ /project/beirc/cvsroot/beirc/sound-player.lisp 2006/04/09 09:32:42 1.3 @@ -33,9 +33,9 @@ (let ((p (sb-ext:run-program "/bin/sh" (list "-c" sound-player-cmd) - :input :stream :output nil :error nil))) - (setf sound-stream (process-input p) - pid (process-pid p))) + :input :stream :output nil :error nil :wait nil))) + (setf sound-stream (sb-ext:process-input p) + pid p)) #-(or allegro sbcl) (progn (cerror "Just reset *default-sound-player* to NIL and run without sounds." @@ -51,7 +51,9 @@ OS subprocess." (when *sound-server-pid* #+sbcl - (sb-posix:kill *sound-server-pid* sb-posix:sigkill) + (progn + (sb-ext:process-kill *sound-server-pid* sb-posix:sigkill) + (sb-ext:process-wait *sound-server-pid* t)) #+allegro (progn (close *sound-server-stream*)

1 0

[beirc-cvs] CVS beirc
by rgoldman 07 Apr '06

07 Apr '06

Update of /project/beirc/cvsroot/beirc In directory clnet:/tmp/cvs-serv10401 Modified Files: sound-player.lisp Log Message: In the introduction of the SBCL run-program code, I introduced a syntax error. Fixed now. --- /project/beirc/cvsroot/beirc/sound-player.lisp 2006/04/07 01:42:56 1.1 +++ /project/beirc/cvsroot/beirc/sound-player.lisp 2006/04/07 15:43:15 1.2 @@ -24,6 +24,7 @@ (let (sound-stream pid) #+allegro (let (bogon) + (declare (ignore bogon)) (multiple-value-setq (sound-stream bogon pid) (excl:run-shell-command sound-player-cmd :wait nil :input :stream :output "/dev/null" :if-output-exists :append :error-output "/dev/null" :if-error-output-exists :append))) @@ -41,7 +42,6 @@ "Don't know how to start a beirc sound server for this lisp. Feel free to supply one.") (setf *default-sound-player* nil) (return-from start-sound-server nil)) - (declare (ignore bogon)) (setf *sound-server-pid* pid *sound-server-stream* sound-stream)) ))

1 0

[beirc-cvs] CVS beirc
by rgoldman 07 Apr '06

07 Apr '06

Update of /project/beirc/cvsroot/beirc In directory clnet:/tmp/cvs-serv2727 Modified Files: application.lisp beirc.asd post-message-hooks.lisp variables.lisp Added Files: sound-player.lisp Log Message: Revised treatment of sounds. --- /project/beirc/cvsroot/beirc/application.lisp 2006/04/04 18:37:28 1.74 +++ /project/beirc/cvsroot/beirc/application.lisp 2006/04/07 01:42:56 1.75 @@ -104,6 +104,10 @@ (beirc-app-display frame pane (server-receiver *application-frame*))) :display-time nil :width 400 :height 600 + ;; added this, in the hopes that overwriting the :height argument + ;; would allow more freedom to resize the tab-pane + ;; (query). [2006/04/05:rpg] + :min-height 100 :incremental-redisplay t))) (:geometry :width 800 :height 600) (:top-level (clim:default-frame-top-level :prompt 'beirc-prompt)) @@ -311,6 +315,8 @@ (when (processes-supported-p) (clim-sys:destroy-process ticker-process)) (disconnect-all frame "Client Quit")))))) + ;; will start up a sound player, if you've configured one. [2006/04/06:rpg] + (start-sound-server) (cond (new-process (setf *gui-process* @@ -1047,3 +1053,6 @@ `(com-connect ,server)))) +(defmethod frame-exit :after ((frame beirc)) + "Shut off the sound server process, if necessary." + (stop-sound-server)) \ No newline at end of file --- /project/beirc/cvsroot/beirc/beirc.asd 2006/03/27 21:42:41 1.9 +++ /project/beirc/cvsroot/beirc/beirc.asd 2006/04/07 01:42:56 1.10 @@ -6,7 +6,7 @@ (cl:in-package :beirc.system) (defsystem :beirc - :depends-on (:mcclim :cl-irc :split-sequence :tab-layout :cl-ppcre) + :depends-on (:mcclim :cl-irc :split-sequence :tab-layout :cl-ppcre :cl-fad) :components ((:file "package") (:file "variables" :depends-on ("package")) (:file "events" :depends-on ("package")) @@ -16,4 +16,8 @@ (:file "application" :depends-on ("package" "variables" "presentations" "events" "receivers")) (:file "message-processing" :depends-on ("package" "variables" "receivers" "application")) (:file "post-message-hooks" :depends-on ("package")) + ;; we use the post-message-hook definer here. This is + ;; probably wrong, and the dependency should be + ;; removed. [2006/04/06:rpg] + (:file "sound-player" :depends-on ("post-message-hooks")) )) \ No newline at end of file --- /project/beirc/cvsroot/beirc/post-message-hooks.lisp 2006/03/24 21:19:44 1.1 +++ /project/beirc/cvsroot/beirc/post-message-hooks.lisp 2006/04/07 01:42:56 1.2 @@ -15,17 +15,3 @@ `(progn (defun ,hook-name (,message-var ,frame-var ,receiver-var ,@other-args &allow-other-keys) ,@body) (setf (gethash ',hook-name *post-message-hooks*) ',hook-name))) -;;;--------------------------------------------------------------------------- -;;; If you set *default-sound-player* and *sound-for-my-nick* this -;;; should work... It leaves a lot to be desired. This should -;;; probably turn into some kind of general noisemaking interface... -;;; But this should get us thinking. [2006/03/24:rpg] -;;;--------------------------------------------------------------------------- -(define-post-message-hook noisemaker (msg frame receiver &key message-directed-to-me) - (declare (ignore msg frame receiver)) - (when (and message-directed-to-me - *default-sound-player* - *sound-for-my-nick*) - #+allegro - (excl:run-shell-command (format nil "~A ~A" *default-sound-player* *sound-for-my-nick*) - :error-output "/dev/null" :if-error-output-exists :append :wait t))) --- /project/beirc/cvsroot/beirc/variables.lisp 2006/03/27 21:42:41 1.14 +++ /project/beirc/cvsroot/beirc/variables.lisp 2006/04/07 01:42:56 1.15 @@ -9,8 +9,12 @@ #+linux "/usr/bin/x-www-browser") (defvar *default-sound-player* (or nil - #+linux "/usr/bin/ogg123") - "An external program that can be used to produce sounds.") + #+linux "/usr/bin/ogg123 -") + "An external program that can be used to produce sounds. +You should set this to be a program that will read from +its standard input and produce sounds. See the example +value, which is ogg123, configured to read its input from +stdin, instead of from a file.") (defvar *sound-for-my-nick* nil "If the NOISEMAKER post-message-hook is enabled, and there is a *default-sound-player* defined, this noise will be --- /project/beirc/cvsroot/beirc/sound-player.lisp 2006/04/07 01:42:56 NONE +++ /project/beirc/cvsroot/beirc/sound-player.lisp 2006/04/07 01:42:56 1.1 (in-package :beirc) ;;;--------------------------------------------------------------------------- ;;; This is a rudimentary approach to having a permanently-running ;;; sound server to which you can dump sounds. [2006/04/06:rpg] ;;;--------------------------------------------------------------------------- ;;;--------------------------------------------------------------------------- ;;; To dos: ;;; 1. figure out whether this is at all compatible with a ;;; single-threaded lisp, and if so, how to make it work out. ;;; 2. Add cmucl and sbcl sound player forms. SBCL added; needs to be checked. ;;;--------------------------------------------------------------------------- (defvar *sound-server-pid* NIL "What's the PID of the process to which you can dump sounds? Should probably be moved to a slot of the application.") (defvar *sound-server-stream* NIL "What's the stream into which you dump sound files?") (defun start-sound-server (&optional (sound-player-cmd *default-sound-player*)) (when sound-player-cmd (let (sound-stream pid) #+allegro (let (bogon) (multiple-value-setq (sound-stream bogon pid) (excl:run-shell-command sound-player-cmd :wait nil :input :stream :output "/dev/null" :if-output-exists :append :error-output "/dev/null" :if-error-output-exists :append))) ;; the following is close to completely untested... [2006/04/06:rpg] #+sbcl (let ((p (sb-ext:run-program "/bin/sh" (list "-c" sound-player-cmd) :input :stream :output nil :error nil))) (setf sound-stream (process-input p) pid (process-pid p))) #-(or allegro sbcl) (progn (cerror "Just reset *default-sound-player* to NIL and run without sounds." "Don't know how to start a beirc sound server for this lisp. Feel free to supply one.") (setf *default-sound-player* nil) (return-from start-sound-server nil)) (declare (ignore bogon)) (setf *sound-server-pid* pid *sound-server-stream* sound-stream)) )) (defun stop-sound-server () "As the name suggests, shut down the sound server, killing the OS subprocess." (when *sound-server-pid* #+sbcl (sb-posix:kill *sound-server-pid* sb-posix:sigkill) #+allegro (progn (close *sound-server-stream*) (system:reap-os-subprocess :pid *sound-server-pid*)) (setf *sound-server-pid* nil *sound-server-stream* nil)) (values)) (defun play-sound-file (filename &optional (stream *sound-server-stream*)) "Play a sound file by dumping it into a stream opened by a sound server program." (copy-to-stream filename stream)) ;;;--------------------------------------------------------------------------- ;;; Helper function ;;;--------------------------------------------------------------------------- (defun copy-to-stream (from-file to-stream) "Dump the contents of the file FROM-FILE into the stream TO-STREAM." (with-open-file (from from-file) (cl-fad:copy-stream from to-stream))) ;;;--------------------------------------------------------------------------- ;;; If you set *default-sound-player* and *sound-for-my-nick* this ;;; should work... It leaves a lot to be desired. This should ;;; probably turn into some kind of general noisemaking interface... ;;; But this should get us thinking. [2006/03/24:rpg] ;;;--------------------------------------------------------------------------- (define-post-message-hook noisemaker (msg frame receiver &key message-directed-to-me) (declare (ignore msg frame receiver)) (when (and message-directed-to-me *sound-server-stream* *sound-for-my-nick*) (play-sound-file *sound-for-my-nick* *sound-server-stream*)))

1 0

[beirc-cvs] CVS beirc
by afuchs 04 Apr '06

04 Apr '06

Update of /project/beirc/cvsroot/beirc In directory clnet:/tmp/cvs-serv18901 Modified Files: application.lisp events.lisp message-processing.lisp receivers.lisp Log Message: Experimental single-thread support. Beware. Please test. --- /project/beirc/cvsroot/beirc/application.lisp 2006/04/03 17:32:37 1.73 +++ /project/beirc/cvsroot/beirc/application.lisp 2006/04/04 18:37:28 1.74 @@ -86,6 +86,7 @@ :interactor :height 72) (pointer-doc :pointer-documentation) + (status-bar :application :display-function 'beirc-status-display @@ -111,7 +112,6 @@ (vertically () (with-tab-layout ('receiver-pane :name 'query) ("*Not Connected*" server 'receiver-pane)) - ;; (68 io) ;; no drop-shadow prompt (make-pane 'clim-extensions:box-adjuster-gadget) io (20 pointer-doc) @@ -189,7 +189,8 @@ (with-text-family (t :sans-serif) (multiple-value-bind (seconds minutes hours) (decode-universal-time (get-universal-time)) seconds - (format t "~2,'0D:~2,'0D ~A~:[~;(away)~] ~@[on ~A~]~@[ speaking to ~A~]~100T~D messages" + (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*)) @@ -274,7 +275,7 @@ ;; Figure out if we are scrolled to the bottom. (let* ((receiver (receiver event)) (pane (actual-application-pane (pane receiver))) - (next-event (event-peek (frame-top-level-sheet frame)))) + (next-event (and (processes-supported-p) (event-peek (frame-top-level-sheet frame))))) (with-pane-kept-scrolled-to-bottom (pane) (update-drawing-options receiver) ;; delay redisplay until this is the last event in the queue @@ -295,18 +296,20 @@ ;;; -(defun beirc (&key (new-process t)) +(defun beirc (&key (new-process (processes-supported-p))) (let* ((syms '(*package* *trace-output*)) (vals (mapcar #'symbol-value syms)) (program (lambda () (progv syms vals (let* ((frame (make-application-frame 'beirc)) - (ticker-process (clim-sys:make-process (lambda () (ticker frame)) - :name "Beirc Ticker"))) + (ticker-process (when (processes-supported-p) + (clim-sys:make-process (lambda () (ticker frame)) + :name "Beirc Ticker")))) (setf *beirc-frame* frame) (load-user-init-file) (run-frame-top-level frame) - (clim-sys:destroy-process ticker-process) + (when (processes-supported-p) + (clim-sys:destroy-process ticker-process)) (disconnect-all frame "Client Quit")))))) (cond (new-process @@ -330,7 +333,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))) + (append (messages receiver) (list message))) (unless (eql receiver (current-receiver frame)) (when interesting-message-p (incf (unseen-messages receiver))) @@ -347,8 +350,8 @@ (positions-mentioning-user receiver))))) (run-post-message-hooks message frame receiver :message-directed-to-me message-to-me-p :message-interesting-p interesting-message-p) - (queue-event (frame-top-level-sheet frame) - (make-instance 'foo-event :sheet frame :receiver receiver)) + (queue-beirc-event frame + (make-instance 'foo-event :sheet frame :receiver receiver)) nil)) (defun post-message (frame message) @@ -899,14 +902,16 @@ (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")) + (if (processes-supported-p) + (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")) + (irc:start-background-message-handler connection)) (setf success t)) (unless success (disconnect connection frame "Client error."))))))) --- /project/beirc/cvsroot/beirc/events.lisp 2006/03/12 09:48:57 1.1 +++ /project/beirc/cvsroot/beirc/events.lisp 2006/04/04 18:37:28 1.2 @@ -19,4 +19,13 @@ (defclass new-sheet-event (clim:window-manager-event) ((sheet :initarg :sheet :reader event-sheet) (closure :initarg :creator :reader sheet-creation-closure) - (receiver :initarg :receiver :reader receiver))) \ No newline at end of file + (receiver :initarg :receiver :reader receiver))) + +(defun processes-supported-p () + (processp (current-process))) + +(defun queue-beirc-event (frame event) + (if (processes-supported-p) + (queue-event (frame-top-level-sheet frame) + event) + (handle-event frame event))) \ No newline at end of file --- /project/beirc/cvsroot/beirc/message-processing.lisp 2006/03/27 13:46:47 1.6 +++ /project/beirc/cvsroot/beirc/message-processing.lisp 2006/04/04 18:37:28 1.7 @@ -73,9 +73,3 @@ and set them up accordingly." (declare (ignore message)) (join-missing-channels *application-frame*)) - -(define-beirc-hook meme-whois-hook ((message irc:irc-rpl_welcome-message)) - "When a connection is established, look up the channels on -which the meme log bot is listening." - (when (not (null *meme-log-bot-nick*)) - (irc:whois (irc:connection message) *meme-log-bot-nick*))) \ No newline at end of file --- /project/beirc/cvsroot/beirc/receivers.lisp 2006/04/02 20:43:20 1.24 +++ /project/beirc/cvsroot/beirc/receivers.lisp 2006/04/04 18:37:29 1.25 @@ -103,7 +103,7 @@ (update-drawing-options receiver)))) (if (equal (current-process) (ui-process frame)) (funcall creator frame) - (queue-event (frame-top-level-sheet frame) (make-instance 'new-sheet-event :sheet frame :creator creator))) + (queue-beirc-event frame (make-instance 'new-sheet-event :sheet frame :creator creator))) (setf (gethash (list connection normalized-name) (receivers frame)) receiver) receiver))))

1 0

[beirc-cvs] CVS beirc
by rgoldman 03 Apr '06

03 Apr '06

Update of /project/beirc/cvsroot/beirc In directory clnet:/tmp/cvs-serv28964 Modified Files: application.lisp Log Message: Quotified URLs for Allegro in COM-BROWSE-URL, since they will be evaluated by the shell. question marks in URLs cause breakage. --- /project/beirc/cvsroot/beirc/application.lisp 2006/04/02 20:43:20 1.72 +++ /project/beirc/cvsroot/beirc/application.lisp 2006/04/03 17:32:37 1.73 @@ -681,7 +681,7 @@ ;; function... Not sure how to do this. [2006/03/14:rpg] ;; actually, this is true for all of these invocations. doesn't ;; bite us in sbcl, though. [2006/03/15:asf] - #+allegro (excl:run-shell-command (format nil "~A ~A" *default-web-browser* url) :wait nil) + #+allegro (excl:run-shell-command (format nil "~A \'~A\'" *default-web-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) #-(or sbcl openmcl allegro) (progn (format *debug-io* "Can't figure out how to browse to url ~A~%" url)

1 0

[beirc-cvs] CVS beirc
by afuchs 02 Apr '06

02 Apr '06

Update of /project/beirc/cvsroot/beirc In directory clnet:/tmp/cvs-serv5557 Modified Files: message-display.lisp Log Message: Make offered commands look a bit nicer (and less like error messages) --- /project/beirc/cvsroot/beirc/message-display.lisp 2006/04/02 20:43:20 1.44 +++ /project/beirc/cvsroot/beirc/message-display.lisp 2006/04/02 20:51:54 1.45 @@ -490,20 +490,21 @@ ;;; channel management messages (defun offer-close (receiver) - (format-message* "To close this tab, click ") - (present `(com-close (,receiver)) 'command)) + (with-output-as-presentation (t `(com-close (,receiver)) 'command) + (with-drawing-options (*standard-output* :ink +grey12+ :text-size :small) + (format-message* "Click here to close this tab.")))) (defmethod print-message ((message irc:irc-err_nosuchnick-message) receiver) (formatting-message (t message receiver) ((format t " ")) - ((with-drawing-options (*standard-output* :ink +red3+ :text-size :small) - (irc:destructuring-arguments (me target &rest rest) message - (declare (ignore me rest)) + ((irc:destructuring-arguments (me target &rest rest) message + (declare (ignore me rest)) + (with-drawing-options (*standard-output* :ink +red3+ :text-size :small) (format-message* (format nil "No such nick or channel \"~A\". " - target)) - (when (string= (title receiver) - (irc:normalize-nickname (connection receiver) target)) - (offer-close receiver))))))) + target))) + (when (string= (title receiver) + (irc:normalize-nickname (connection receiver) target)) + (offer-close receiver)))))) (defmethod print-message ((message irc:irc-err_blocking_notid-message) receiver) (formatting-message (t message receiver) @@ -511,9 +512,10 @@ ((with-drawing-options (*standard-output* :ink +red3+ :text-size :small) (irc:destructuring-arguments (me &last msg) message (declare (ignore me)) - (format-message* (format nil "~A~%" msg)) - (format-message* "To identify, click") - (present `(com-identify) 'command)))))) + (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

1 0

[beirc-cvs] CVS beirc
by afuchs 02 Apr '06

02 Apr '06

Update of /project/beirc/cvsroot/beirc In directory clnet:/tmp/cvs-serv4005 Modified Files: application.lisp message-display.lisp receivers.lisp Log Message: Display "not authorized" messages and offer a (fixed) clickable identify command. --- /project/beirc/cvsroot/beirc/application.lisp 2006/03/27 21:38:43 1.71 +++ /project/beirc/cvsroot/beirc/application.lisp 2006/04/02 20:43:20 1.72 @@ -391,7 +391,7 @@ :test #'equal))) (who 'nickname :prompt "Target" :default "NickServ")) (when (null password) - (accept 'string :prompt "Password")) + (setf password (accept 'string :prompt "Password"))) (irc:privmsg (current-connection *application-frame*) who (format nil "IDENTIFY ~A" password))) --- /project/beirc/cvsroot/beirc/message-display.lisp 2006/03/27 21:46:31 1.43 +++ /project/beirc/cvsroot/beirc/message-display.lisp 2006/04/02 20:43:20 1.44 @@ -490,8 +490,8 @@ ;;; channel management messages (defun offer-close (receiver) - (format-message* (format nil "To close this tab, click ")) - (present `(com-close ,receiver) 'command)) + (format-message* "To close this tab, click ") + (present `(com-close (,receiver)) 'command)) (defmethod print-message ((message irc:irc-err_nosuchnick-message) receiver) (formatting-message (t message receiver) @@ -505,6 +505,16 @@ (irc:normalize-nickname (connection receiver) target)) (offer-close receiver))))))) +(defmethod print-message ((message irc:irc-err_blocking_notid-message) receiver) + (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)) + (format-message* (format nil "~A~%" msg)) + (format-message* "To identify, click") + (present `(com-identify) 'command)))))) + (defmethod print-message ((message irc:irc-err_chanoprivsneeded-message) receiver) (irc:destructuring-arguments (&last body) message (formatting-message (t message receiver) --- /project/beirc/cvsroot/beirc/receivers.lisp 2006/03/16 00:01:46 1.23 +++ /project/beirc/cvsroot/beirc/receivers.lisp 2006/04/02 20:43:20 1.24 @@ -229,7 +229,8 @@ irc:irc-rpl_whoisidentified-message irc:irc-rpl_whoisidle-message irc:irc-rpl_away-message - irc:irc-err_nosuchnick-message)) + irc:irc-err_nosuchnick-message + irc:irc-err_blocking_notid-message)) (macrolet ((define-ignore-message-types (&rest mtypes) `(progn

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

beirc-cvs April 2006