beirc-cvs

beirc-cvs@common-lisp.net

168 discussions

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

27 Mar '06

Update of /project/beirc/cvsroot/beirc In directory clnet:/tmp/cvs-serv15257 Modified Files: application.lisp message-display.lisp message-processing.lisp variables.lisp Log Message: Fix ignore. Make timestamps mouse-sensitive. Fix updating-output. * Ignore and unignore would remove the messages, but not set the scroll state. Make them use the new with-pane-kept-scrolled-to-bottom macro. * Timestamps are now pointers to meme.b9.com on channels that have a user "cmeme" on them. The nickname of the log bot is configurable via *meme-log-bot-nick*. * Updating-output's new SXHASH function would ignore the non-booleans on the list. Ugh. --- /project/beirc/cvsroot/beirc/application.lisp 2006/03/24 21:19:43 1.69 +++ /project/beirc/cvsroot/beirc/application.lisp 2006/03/27 13:46:47 1.70 @@ -254,21 +254,35 @@ (defmethod handle-event ((frame beirc) (event new-sheet-event)) (funcall (sheet-creation-closure event) frame)) +(defmacro with-pane-kept-scrolled-to-bottom ((pane-form) &body body) + "Ensure that the pane in PANE-FORM has the same scroll state +after BODY terminates as it had before: + +If the pane is scrolled to some position before the end, it is +kept there. If the pane is at the bottom of the pane, the +viewport is reset to the then-current bottom after BODY is +finished." + (let ((pane (gensym)) + (bottom-p (gensym))) + `(let* ((,pane ,pane-form) + (,bottom-p (pane-scrolled-to-bottom-p ,pane))) + (multiple-value-prog1 (progn ,@body) + (when ,bottom-p (scroll-pane-to-bottom ,pane)))))) + (defmethod handle-event ((frame beirc) (event foo-event)) ;; Hack: ;; 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)))) - (let ((btmp (pane-scrolled-to-bottom-p pane))) + (with-pane-kept-scrolled-to-bottom (pane) (update-drawing-options receiver) ;; delay redisplay until this is the last event in the queue ;; (for this event's receiver). (unless (and (typep next-event 'foo-event) (eql (receiver next-event) receiver)) (setf (pane-needs-redisplay pane) t) - (redisplay-frame-panes frame)) - (when btmp (scroll-pane-to-bottom pane))) + (redisplay-frame-panes frame))) (medium-force-output (sheet-medium pane)) ;### )) @@ -496,13 +510,17 @@ (redraw-receiver (current-receiver *application-frame*))) (define-beirc-command (com-ignore :name t) ((who 'nickname :prompt "who")) - (pushnew who (slot-value *application-frame* 'ignored-nicks) :test #'string=) - (redraw-all-receivers)) + (with-pane-kept-scrolled-to-bottom ((actual-application-pane + (pane (current-receiver *application-frame*)))) + (pushnew who (slot-value *application-frame* 'ignored-nicks) :test #'string=) + (redraw-all-receivers))) (define-beirc-command (com-unignore :name t) ((who 'ignored-nickname :prompt "who")) - (setf (slot-value *application-frame* 'ignored-nicks) - (remove who (slot-value *application-frame* 'ignored-nicks) :test #'string=)) - (redraw-all-receivers)) + (with-pane-kept-scrolled-to-bottom ((actual-application-pane + (pane (current-receiver *application-frame*)))) + (setf (slot-value *application-frame* 'ignored-nicks) + (remove who (slot-value *application-frame* 'ignored-nicks) :test #'string=)) + (redraw-all-receivers))) (define-beirc-command (com-unfocus :name t) ((who 'nickname :prompt "who")) (setf (current-focused-nicks) @@ -950,7 +968,7 @@ x y) (declare (ignore object options)) (when (and ptype (presentation-subtypep ptype 'command) - (boundp '*current-input-stream*) *current-input-stream*) + (boundp 'climi::*current-input-stream*) climi::*current-input-stream*) (restart-case (signal 'invoked-command-by-clicking) (acknowledged ())))))))) (call-next-method)) --- /project/beirc/cvsroot/beirc/message-display.lisp 2006/03/24 21:07:20 1.40 +++ /project/beirc/cvsroot/beirc/message-display.lisp 2006/03/27 13:46:47 1.41 @@ -38,28 +38,48 @@ (member (irc:source message) (slot-value *application-frame* 'ignored-nicks) :test #'string=)) +(defun +boolean (initial-value &rest booleans) + (loop for value = initial-value then (+ (ash value 1) + (if boolean 1 0)) + for boolean in booleans + finally (return value))) + (defun invoke-formatting-message (stream message receiver preamble-writer message-body-writer) (let* ((*current-message* message) (stream* (if (eql stream t) *standard-output* stream)) (width (- (floor (bounding-rectangle-width (sheet-parent stream*)) (clim:stream-string-width stream* "X")) 2))) - (labels ((output-timestamp-column (position) + (labels ((make-meme-url (message) + (format nil "http://meme.b9.com/cview.html?channel=~A&utime=~A#utime_requested" + (string-trim '(#\#) (channel receiver)) + (irc:received-time message))) + (format-timestamp (message) + (format stream* "[~2,'0D:~2,'0D]" + (nth-value 2 (decode-universal-time (irc:received-time message))) + (nth-value 1 (decode-universal-time (irc:received-time message))))) + (output-timestamp-column (position) (when (eql position *timestamp-column-orientation*) (formatting-cell (stream* :align-x :left) (with-drawing-options (stream* :ink +gray+) - (format stream* "[~2,'0D:~2,'0D]" - (nth-value 2 (decode-universal-time (irc:received-time message))) - (nth-value 1 (decode-universal-time (irc:received-time message))))))))) + (if (and *meme-log-bot-nick* + (irc:find-user (connection receiver) *meme-log-bot-nick*) + (member (title receiver) + (irc:channels (irc:find-user (connection receiver) *meme-log-bot-nick*)) + :test #'equal + :key #'irc:name)) + (with-output-as-presentation (stream* (make-meme-url message) 'url) + (format-timestamp message)) + (format-timestamp message))))))) (updating-output (stream* :cache-value - (sxhash (list message - (message-from-focused-nick-p message receiver) - (message-from-ignored-nick-p message receiver) - width - *max-preamble-length* - *timestamp-column-orientation* - *default-fill-column*)) + (+boolean (sxhash (list message + width + *max-preamble-length* + *default-fill-column*)) + (message-from-focused-nick-p message receiver) + (message-from-ignored-nick-p message receiver) + (eql *timestamp-column-orientation* :left)) :cache-test #'eql) (formatting-row (stream*) (output-timestamp-column :left) --- /project/beirc/cvsroot/beirc/message-processing.lisp 2006/03/16 20:32:05 1.5 +++ /project/beirc/cvsroot/beirc/message-processing.lisp 2006/03/27 13:46:47 1.6 @@ -69,8 +69,13 @@ (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 + "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*)) +(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/variables.lisp 2006/03/24 21:19:44 1.12 +++ /project/beirc/cvsroot/beirc/variables.lisp 2006/03/27 13:46:47 1.13 @@ -47,3 +47,6 @@ the command /Close Inactive Queries and the automatic query window closing mechanism (see *auto-close-inactive-query-windows-p*).") + +(defvar *meme-log-bot-nick* "cmeme" + "The name of the meme channel log bot") \ No newline at end of file

1 0

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

24 Mar '06

Update of /project/beirc/cvsroot/beirc In directory clnet:/tmp/cvs-serv15877 Modified Files: application.lisp beirc.asd variables.lisp Added Files: post-message-hooks.lisp Log Message: Added support for making noise on certain messages. --- /project/beirc/cvsroot/beirc/application.lisp 2006/03/21 22:50:21 1.68 +++ /project/beirc/cvsroot/beirc/application.lisp 2006/03/24 21:19:43 1.69 @@ -309,25 +309,29 @@ (typep message '(or irc:irc-privmsg-message irc:irc-notice-message irc:irc-topic-message irc:irc-kick-message irc:ctcp-action-message))) (defun post-message-to-receiver (frame message receiver) - (setf (messages receiver) - (append (messages receiver) (list message))) - (unless (eql receiver (current-receiver frame)) - (when (interesting-message-p message) - (incf (unseen-messages receiver))) - (when (message-directed-to-me-p message) - (incf (messages-directed-to-me receiver))) - (incf (all-unseen-messages receiver))) - (when (and (slot-boundp receiver 'pane) (pane receiver)) - (let* ((pane (actual-application-pane (pane receiver))) - (current-insert-position (bounding-rectangle-height pane))) - (when (and (not (eql current-insert-position - (first (positions-mentioning-user receiver)))) - (message-directed-to-me-p message)) - (push current-insert-position - (positions-mentioning-user receiver))))) - (queue-event (frame-top-level-sheet frame) - (make-instance 'foo-event :sheet frame :receiver receiver)) - nil) + (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))) + (unless (eql receiver (current-receiver frame)) + (when interesting-message-p + (incf (unseen-messages receiver))) + (when message-to-me-p + (incf (messages-directed-to-me receiver))) + (incf (all-unseen-messages receiver))) + (when (and (slot-boundp receiver 'pane) (pane receiver)) + (let* ((pane (actual-application-pane (pane receiver))) + (current-insert-position (bounding-rectangle-height pane))) + (when (and (not (eql current-insert-position + (first (positions-mentioning-user receiver)))) + message-to-me-p) + (push current-insert-position + (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)) + nil)) (defun post-message (frame message) (let ((receiver (receiver-for-message message frame))) --- /project/beirc/cvsroot/beirc/beirc.asd 2006/03/12 09:48:57 1.7 +++ /project/beirc/cvsroot/beirc/beirc.asd 2006/03/24 21:19:43 1.8 @@ -14,4 +14,6 @@ (:file "presentations" :depends-on ("package" "variables" "receivers")) (:file "message-display" :depends-on ("package" "variables" "presentations")) (:file "application" :depends-on ("package" "variables" "presentations" "events" "receivers")) - (:file "message-processing" :depends-on ("package" "variables" "receivers" "application")))) \ No newline at end of file + (:file "message-processing" :depends-on ("package" "variables" "receivers" "application")) + (:file "post-message-hooks" :depends-on ("package")) + )) \ No newline at end of file --- /project/beirc/cvsroot/beirc/variables.lisp 2006/03/21 15:22:03 1.11 +++ /project/beirc/cvsroot/beirc/variables.lisp 2006/03/24 21:19:44 1.12 @@ -6,7 +6,15 @@ (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") + #+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.") +(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 +played when your nick is mentioned.") (defvar *auto-join-alist* '(("irc.freenode.net" . ("#beirc"))) "An alist mapping irc server name to a list of channels to --- /project/beirc/cvsroot/beirc/post-message-hooks.lisp 2006/03/24 21:19:44 NONE +++ /project/beirc/cvsroot/beirc/post-message-hooks.lisp 2006/03/24 21:19:44 1.1 (in-package :beirc) (defvar *post-message-hooks* (make-hash-table) "Table of hooks to be run when a message is posted to a receiver.") (defun run-post-message-hooks (message frame receiver &rest args) (maphash #'(lambda (k v) (declare (ignore k)) (apply v message frame receiver args)) *post-message-hooks*) (values)) (defmacro define-post-message-hook (hook-name (message-var frame-var receiver-var &rest other-args) &body body) "Convenience macro for defining hooks that are run when a message is posted to a receiver." `(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)))

1 0

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

24 Mar '06

Update of /project/beirc/cvsroot/beirc In directory clnet:/tmp/cvs-serv14343 Modified Files: message-display.lisp Log Message: Speed up updating output by storing an sxhashed value. Also, force re-draw of messages that are actually affected by nick focussing and ignore states. --- /project/beirc/cvsroot/beirc/message-display.lisp 2006/03/12 09:48:57 1.39 +++ /project/beirc/cvsroot/beirc/message-display.lisp 2006/03/24 21:07:20 1.40 @@ -53,14 +53,14 @@ (nth-value 1 (decode-universal-time (irc:received-time message))))))))) (updating-output (stream* :cache-value - (list message - (focused-nicks receiver) - (slot-value *application-frame* 'ignored-nicks) - width - *max-preamble-length* - *timestamp-column-orientation* - *default-fill-column*) - :cache-test #'equal) + (sxhash (list message + (message-from-focused-nick-p message receiver) + (message-from-ignored-nick-p message receiver) + width + *max-preamble-length* + *timestamp-column-orientation* + *default-fill-column*)) + :cache-test #'eql) (formatting-row (stream*) (output-timestamp-column :left) (formatting-cell (stream* :align-x :right :min-width '(3 :character))

1 0

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

22 Mar '06

Update of /project/beirc/cvsroot/beirc In directory clnet:/tmp/cvs-serv2592 Modified Files: presentations.lisp Log Message: Remove typo that prevented presentations.lisp from compiling. --- /project/beirc/cvsroot/beirc/presentations.lisp 2006/03/21 22:45:03 1.12 +++ /project/beirc/cvsroot/beirc/presentations.lisp 2006/03/22 00:31:14 1.13 @@ -69,12 +69,12 @@ ;; argument must be terminated by hitting RET twice. ugh. (define-presentation-method accept ((type mumble) *standard-input* (view textual-view) &key) (with-delimiter-gestures (nil :override t) - . (let ((*completion-gestures* '(#\Tab))) - (nth-value 2 - (complete-input *standard-input* 'nickname-completer - #+(or):possibility-printer #+(or) 'nickname-competion-printer - :allow-any-input t - :partial-completers '()))))) + (let ((*completion-gestures* '(#\Tab))) + (nth-value 2 + (complete-input *standard-input* 'nickname-completer + #+(or):possibility-printer #+(or) 'nickname-competion-printer + :allow-any-input t + :partial-completers '()))))) ;;; nicknames

1 0

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

21 Mar '06

Update of /project/beirc/cvsroot/beirc In directory clnet:/tmp/cvs-serv22374 Modified Files: application.lisp Log Message: Make read-frame-command always clear the input window - especially for abort-gesture --- /project/beirc/cvsroot/beirc/application.lisp 2006/03/21 22:45:03 1.67 +++ /project/beirc/cvsroot/beirc/application.lisp 2006/03/21 22:50:21 1.68 @@ -952,47 +952,47 @@ (call-next-method)) (defmethod read-frame-command ((frame beirc) &key (stream *standard-input*)) - (multiple-value-prog1 - (clim:with-input-editing (stream) - (when (and (current-receiver frame) (incomplete-input (current-receiver frame))) - (replace-input stream (incomplete-input (current-receiver frame)) :rescan t)) - (with-input-context ('command) (object) - (with-command-table-keystrokes (*accelerator-gestures* (frame-command-table frame)) - (catch 'keystroke-command - (let ((force-restore-input-state nil)) - (labels ((reset-saved-input () - (when (current-receiver frame) - (setf (incomplete-input (current-receiver frame)) "")))) - (handler-bind ((accelerator-gesture - (lambda (gesture) - (save-input-line stream frame) - (throw 'keystroke-command (lookup-keystroke-command-item - (accelerator-gesture-event gesture) - (frame-command-table frame))))) - (abort-gesture - (lambda (gesture) - (declare (ignore gesture)) - (reset-saved-input) - (setf force-restore-input-state nil))) - (invoked-command-by-clicking - (lambda (cond) - (declare (ignore cond)) - (save-input-line stream frame) - (setf force-restore-input-state t) - (invoke-restart 'acknowledged)))) - (let ((c (clim:read-gesture :stream stream :peek-p t))) - (multiple-value-prog1 - (cond ((eql c #\/) - (clim:read-gesture :stream stream) - (accept 'command :stream stream :prompt nil)) - (t - (list 'com-say (accept 'mumble :history 'mumble :prompt nil :stream stream)))) - (if force-restore-input-state - (setf force-restore-input-state nil) - (reset-saved-input))))))))) - (command - (save-input-line stream frame) - object))) + (unwind-protect + (clim:with-input-editing (stream) + (when (and (current-receiver frame) (incomplete-input (current-receiver frame))) + (replace-input stream (incomplete-input (current-receiver frame)) :rescan t)) + (with-input-context ('command) (object) + (with-command-table-keystrokes (*accelerator-gestures* (frame-command-table frame)) + (catch 'keystroke-command + (let ((force-restore-input-state nil)) + (labels ((reset-saved-input () + (when (current-receiver frame) + (setf (incomplete-input (current-receiver frame)) "")))) + (handler-bind ((accelerator-gesture + (lambda (gesture) + (save-input-line stream frame) + (throw 'keystroke-command (lookup-keystroke-command-item + (accelerator-gesture-event gesture) + (frame-command-table frame))))) + (abort-gesture + (lambda (gesture) + (declare (ignore gesture)) + (reset-saved-input) + (setf force-restore-input-state nil))) + (invoked-command-by-clicking + (lambda (cond) + (declare (ignore cond)) + (save-input-line stream frame) + (setf force-restore-input-state t) + (invoke-restart 'acknowledged)))) + (let ((c (clim:read-gesture :stream stream :peek-p t))) + (multiple-value-prog1 + (cond ((eql c #\/) + (clim:read-gesture :stream stream) + (accept 'command :stream stream :prompt nil)) + (t + (list 'com-say (accept 'mumble :history 'mumble :prompt nil :stream stream)))) + (if force-restore-input-state + (setf force-restore-input-state nil) + (reset-saved-input))))))))) + (command + (save-input-line stream frame) + object))) (window-clear stream))) (defun irc-event-loop (frame connection)

1 0

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

21 Mar '06

Update of /project/beirc/cvsroot/beirc In directory clnet:/tmp/cvs-serv21100 Modified Files: presentations.lisp application.lisp Log Message: Make com-close accept a list of receivers; default to the current one. Also, add an explanatory comment about multiple RET hitting to completion. --- /project/beirc/cvsroot/beirc/presentations.lisp 2006/03/16 20:44:56 1.11 +++ /project/beirc/cvsroot/beirc/presentations.lisp 2006/03/21 22:45:03 1.12 @@ -63,14 +63,18 @@ (declare (ignore string)) (present (irc:nickname object) 'nickname :stream stream)) + +;; FIXME: complete-input here and (accept 'command) in +;; read-frame-command means that every command that takes a 'mumble +;; argument must be terminated by hitting RET twice. ugh. (define-presentation-method accept ((type mumble) *standard-input* (view textual-view) &key) (with-delimiter-gestures (nil :override t) - (let ((*completion-gestures* '(#\Tab))) - (nth-value 2 - (complete-input *standard-input* 'nickname-completer - #+(or):possibility-printer #+(or) 'nickname-competion-printer - :allow-any-input t - :partial-completers '()))))) + . (let ((*completion-gestures* '(#\Tab))) + (nth-value 2 + (complete-input *standard-input* 'nickname-completer + #+(or):possibility-printer #+(or) 'nickname-competion-printer + :allow-any-input t + :partial-completers '()))))) ;;; nicknames --- /project/beirc/cvsroot/beirc/application.lisp 2006/03/21 15:23:35 1.66 +++ /project/beirc/cvsroot/beirc/application.lisp 2006/03/21 22:45:03 1.67 @@ -411,17 +411,18 @@ (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 "tab")) - (let* ((connection (connection receiver)) - (channel (irc:find-channel connection (title receiver)))) - (cond - ((member receiver (server-receivers *application-frame*) :key #'cdr) - (disconnect connection *application-frame* "Client Quit") - (setf (slot-value *application-frame* 'server-receivers) - (delete receiver (server-receivers *application-frame*) :key #'cdr))) - (channel - (irc:part connection channel)))) - (remove-receiver receiver *application-frame*)) +(define-beirc-command (com-close :name t) ((receivers '(sequence receiver) :prompt "tab" :default (list (current-receiver *application-frame*)))) + (dolist (receiver receivers) + (let* ((connection (connection receiver)) + (channel (irc:find-channel connection (title receiver)))) + (cond + ((member receiver (server-receivers *application-frame*) :key #'cdr) + (disconnect connection *application-frame* "Client Quit") + (setf (slot-value *application-frame* 'server-receivers) + (delete receiver (server-receivers *application-frame*) :key #'cdr))) + (channel + (irc:part connection channel)))) + (remove-receiver receiver *application-frame*))) (macrolet ((define-scroller-command ((com-name keystroke) (top-var bot-var) next-pos-form &optional fallback-position) `(define-beirc-command (,com-name :name t :keystroke ,keystroke) ()

1 0

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

21 Mar '06

Update of /project/beirc/cvsroot/beirc In directory clnet:/tmp/cvs-serv26685 Modified Files: application.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. Auto-connect is achieved by :after method on adopt-frame added in this file. Idea courtesy of CLIM Guided Tour article. --- /project/beirc/cvsroot/beirc/application.lisp 2006/03/17 17:44:22 1.65 +++ /project/beirc/cvsroot/beirc/application.lisp 2006/03/21 15:23:35 1.66 @@ -582,12 +582,20 @@ (define-beirc-command (com-names :name t) () (irc:names (current-connection *application-frame*) (target))) -(define-beirc-command (com-away :name t) ((reason 'mumble :prompt "reason")) +(define-beirc-command (com-away :name t) ((reason 'mumble + :prompt (if (away-status *application-frame* (current-connection *application-frame*)) + "reason: to come back from away use /back instead of away" + "reason"))) (irc:away (current-connection *application-frame*) reason)) (define-beirc-command (com-back :name t) () (irc:away (current-connection *application-frame*) "")) +(defmethod command-enabled ((command-name (eql 'com-back)) frame) + "Turn off the back command when it's not appropriate -- i.e., when you are +not away." + (away-status frame (current-connection frame))) + (define-beirc-command (com-quit :name t) (&key (reason 'mumble :prompt "reason" :default "Client Quit")) (disconnect-all *application-frame* reason) (frame-exit *application-frame*)) @@ -997,3 +1005,13 @@ (defmethod allocate-space :after ((pane climi::viewport-pane) w h) (let ((pane (first (sheet-children pane)))) (redisplay-frame-pane (pane-frame pane) pane))) + +;;; proposed addition to auto-connect to servers in the +;;; *auto-connect-list* [2006/03/21:rpg] +(defmethod adopt-frame :after (frame-manager (frame beirc)) + (declare (ignore frame-manager)) + (loop for server in *auto-connect-list* + do (execute-frame-command frame + `(com-connect ,server)))) + +

1 0

[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

← Newer
1
2
3
4
5
6
7
8
...
17
Older →

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

beirc-cvs