beirc-cvs

beirc-cvs@common-lisp.net

168 discussions

[beirc-cvs] CVS beirc
by dlichteblau 24 Feb '07

24 Feb '07

Update of /project/beirc/cvsroot/beirc In directory clnet:/tmp/cvs-serv1658 Modified Files: application.lisp beirc.asd message-display.lisp package.lisp receivers.lisp Log Message: use McCLIM's built-in tab layout --- /project/beirc/cvsroot/beirc/application.lisp 2006/05/31 19:35:39 1.84 +++ /project/beirc/cvsroot/beirc/application.lisp 2007/02/24 10:58:16 1.85 @@ -79,7 +79,7 @@ (ignored-nicks :initform nil) (receivers :initform (make-hash-table :test #'equal) :accessor receivers) (server-receivers :initform nil :reader server-receivers) - (tab-panes-to-receivers :initform (make-hash-table :test #'equal) :accessor tab-panes-to-receivers) + (tab-pages-to-receivers :initform (make-hash-table :test #'equal) :accessor tab-pages-to-receivers) (presence :initform (make-hash-table :test #'equal) :reader presence)) (:panes (io @@ -115,7 +115,7 @@ (default (vertically () (with-tab-layout ('receiver-pane :name 'query) - ("*Not Connected*" server 'receiver-pane)) + ("*Not Connected*" server :presentation-type 'receiver-pane)) (make-pane 'clim-extensions:box-adjuster-gadget) io (20 pointer-doc) @@ -123,8 +123,8 @@ status-bar))))) ;;; addition of optional argument allows debugging from outside the frame process. [2006/03/16:rpg] -(defun receiver-from-tab-pane (tab-pane &optional (frame *application-frame*)) - (gethash tab-pane (tab-panes-to-receivers frame))) +(defun receiver-from-tab-page (page &optional (frame *application-frame*)) + (gethash page (tab-pages-to-receivers frame))) (defvar *current-receiver-override*) @@ -136,7 +136,7 @@ (defmethod current-receiver ((frame beirc)) (let ((receiver (if (boundp '*current-receiver-override*) *current-receiver-override* - (receiver-from-tab-pane (enabled-pane (find-pane-named frame 'query)) frame)))) + (receiver-from-tab-page (tab-layout-enabled-page (find-pane-named frame 'query)) frame)))) (if (typep receiver 'receiver) receiver nil))) @@ -417,8 +417,8 @@ (macrolet ((define-window-switcher (name keystroke direction predicate) `(define-beirc-command (,name :name t :keystroke ,keystroke) () - (let* ((current-pane (tab-layout::tab-pane-pane - (enabled-pane (find-pane-named *application-frame* 'query)))) + (let* ((current-pane (tab-page-pane + (tab-layout-enabled-page (find-pane-named *application-frame* 'query)))) (list-of-panes (sheet-children (sheet-parent current-pane))) (n-panes (length list-of-panes)) (current-pane-position (position current-pane list-of-panes)) @@ -433,11 +433,9 @@ until (or (= i end-position) (funcall predicate (nth (mod (+ n-panes i) n-panes) list-of-panes))) finally (return i))) - (switch-to-pane (nth (mod (+ n-panes position) n-panes) list-of-panes) - 'tab-layout-pane)))))) + (switch-to-page (sheet-to-page (nth (mod (+ n-panes position) n-panes) list-of-panes)))))))) (labels ((pane-interesting-p (pane) - (let ((receiver (receiver-from-tab-pane - (find-in-tab-panes-list pane 'tab-layout-pane)))) + (let ((receiver (receiver-from-tab-page (sheet-to-page pane)))) (or (> (messages-directed-to-me receiver) 0) (> (unseen-messages receiver) 0))))) (define-window-switcher com-interesting-window-next (#\Tab :control) 1 #'pane-interesting-p) @@ -870,24 +868,20 @@ (receiver-pane receiver beirc :documentation ((object stream) (format stream "Reiceiver: ~A" - (title (receiver-from-tab-pane - (find-in-tab-panes-list object 'tab-layout-pane)))))) + (title (receiver-from-tab-page + (sheet-to-page object)))))) (object) - (receiver-from-tab-pane - (find-in-tab-panes-list object 'tab-layout-pane))) + (receiver-from-tab-page (sheet-to-page object))) (define-presentation-translator receiver-pane-to-channel-translator (receiver-pane channel beirc :documentation ((object stream) (format stream "Channel: ~A" - (channel (receiver-from-tab-pane - (find-in-tab-panes-list object 'tab-layout-pane))))) + (channel (sheet-to-page object)))) :tester ((object) - (channel (receiver-from-tab-pane - (find-in-tab-panes-list object 'tab-layout-pane))))) + (channel (receiver-from-tab-page (sheet-to-page object))))) (object) - (channel (receiver-from-tab-pane - (find-in-tab-panes-list object 'tab-layout-pane)))) + (channel (sheet-to-page object))) (define-presentation-translator receiver-to-channel-translator (receiver channel beirc @@ -950,10 +944,8 @@ (unwind-protect (progn (setf (irc:client-stream connection) (make-broadcast-stream)) - (when (tab-layout:find-in-tab-panes-list (find-pane-named frame 'server) - (find-pane-named frame 'query)) - (tab-layout:remove-pane (find-pane-named frame 'server) - (find-pane-named frame 'query))) + (when (sheet-to-page (find-pane-named frame 'server)) + (remove-page (sheet-to-page (find-pane-named frame 'server)))) (setf (server-receiver frame connection) server-receiver) (setf (ui-process *application-frame*) (current-process)) (if (processes-supported-p) @@ -1138,4 +1130,4 @@ (defmethod frame-exit :after ((frame beirc)) "Shut off the sound server process, if necessary." - (stop-sound-server)) \ No newline at end of file + (stop-sound-server)) --- /project/beirc/cvsroot/beirc/beirc.asd 2006/04/19 21:22:47 1.11 +++ /project/beirc/cvsroot/beirc/beirc.asd 2007/02/24 10:58:16 1.12 @@ -6,7 +6,7 @@ (cl:in-package :beirc.system) (defsystem :beirc - :depends-on (:mcclim :cl-irc :split-sequence :tab-layout :cl-ppcre :cl-fad) + :depends-on (:mcclim :cl-irc :split-sequence :cl-ppcre :cl-fad) :components ((:file "package") (:file "variables" :depends-on ("package")) (:file "events" :depends-on ("package")) @@ -20,4 +20,4 @@ ;; probably wrong, and the dependency should be ;; removed. [2006/04/06:rpg] (:file "sound-player" :depends-on ("package" "variables")) - )) \ No newline at end of file + )) --- /project/beirc/cvsroot/beirc/message-display.lisp 2006/05/29 20:05:42 1.50 +++ /project/beirc/cvsroot/beirc/message-display.lisp 2007/02/24 10:58:16 1.51 @@ -697,4 +697,4 @@ maximize (preamble-length message)))) (formatting-table (t) (loop for message in messages - do (print-message message receiver))))) \ No newline at end of file + do (print-message message receiver))))) --- /project/beirc/cvsroot/beirc/package.lisp 2006/05/29 20:05:42 1.5 +++ /project/beirc/cvsroot/beirc/package.lisp 2007/02/24 10:58:16 1.6 @@ -1,5 +1,5 @@ (cl:defpackage :beirc - (:use :clim :clim-lisp :clim-sys :tab-layout) + (:use :clim :clim-lisp :clim-sys :clim-tab-layout) (:export #:beirc #:*beirc-user-init-file* #:*hyperspec-base-url* #:*default-fill-column* #:*timestamp-column-orientation* --- /project/beirc/cvsroot/beirc/receivers.lisp 2006/04/12 18:42:30 1.28 +++ /project/beirc/cvsroot/beirc/receivers.lisp 2007/02/24 10:58:16 1.29 @@ -17,7 +17,7 @@ (incomplete-input :accessor incomplete-input :initform "") (positions-mentioning-user :accessor positions-mentioning-user :initform nil) (pane :reader pane) - (tab-pane :accessor tab-pane))) + (tab-page :accessor tab-page))) (defclass irc-connection-closed-message (irc:irc-message) ()) @@ -56,16 +56,18 @@ (defun initialize-receiver-with-pane (receiver frame pane &key (add-pane-p t)) (setf (slot-value receiver 'pane) pane) (if (not add-pane-p) - (setf (slot-value receiver 'tab-pane) - (find-in-tab-panes-list pane - 'tab-layout-pane)) + (setf (slot-value receiver 'tab-page) (sheet-to-page pane)) (progn - (setf (slot-value receiver 'tab-pane) - (make-tab-pane-from-list (title receiver) (pane receiver) 'receiver-pane)) - (add-pane (tab-pane receiver) (find-pane-named frame 'query)) + (setf (slot-value receiver 'tab-page) + (make-instance 'tab-page + :title (title receiver) + :pane (pane receiver) + :enabled-callback 'receiver-page-enabled-callback + :presentation-type 'receiver-pane)) + (add-page (tab-page receiver) (find-pane-named frame 'query)) ;; resize the pane to fit the tab container (change-space-requirements pane))) - (setf (gethash (tab-pane receiver) (tab-panes-to-receivers frame)) receiver)) + (setf (gethash (tab-page receiver) (tab-pages-to-receivers frame)) receiver)) (defun rename-query-receiver (receiver new-name) (let ((old-title (irc:normalize-nickname (connection receiver) @@ -75,7 +77,7 @@ (with-slots (title query) receiver (setf title new-name query new-name - (tab-layout::tab-pane-title (tab-pane receiver)) new-name) + (tab-page-title (tab-page receiver)) new-name) (remhash (list (connection receiver) old-title) (receivers *application-frame*)) (setf (gethash (list (connection receiver) normalized-name) (receivers *application-frame*)) receiver)))) @@ -127,8 +129,7 @@ (defun remove-receiver (receiver frame) - (tab-layout:remove-pane (tab-pane receiver) - (find-pane-named frame 'query)) + (remove-page (tab-page receiver)) (remhash (list (connection receiver) (title receiver)) (receivers frame))) (defparameter *network-service-sources* '("nickserv" "memoserv" "chanserv" "") @@ -299,29 +300,24 @@ (defun update-drawing-options (receiver) (when (and (slot-boundp receiver 'pane) (sheetp (pane receiver)) - (find-in-tab-panes-list (pane receiver) 'tab-layout-pane)) - (set-drawing-options-for-pane-in-tab-layout (pane receiver) - `(:ink ,(cond ((> (messages-directed-to-me receiver) 0) +green+) - ((> (unseen-messages receiver) 0) +red+) - (t +black+)))))) - -(defmethod switch-to-pane :after ((pane sheet) (parent (eql 'tab-layout-pane))) - (let ((my-tab-layout-pane (find-pane-named *application-frame* 'query))) - (when (eq (sheet-parent (sheet-parent pane)) ;; Is this the desired tab-layout? - my-tab-layout-pane) - - (let ((receiver (receiver-from-tab-pane - (find-in-tab-panes-list pane my-tab-layout-pane)))) - (unless (null receiver) - (setf (unseen-messages receiver) 0) - (setf (all-unseen-messages receiver) 0) - (setf (messages-directed-to-me receiver) 0) - (setf (last-visited receiver) (get-universal-time)) - (update-drawing-options receiver)))))) + (sheet-to-page (pane receiver))) + (setf (tab-page-drawing-options (sheet-to-page (pane receiver))) + `(:ink ,(cond ((> (messages-directed-to-me receiver) 0) +green+) + ((> (unseen-messages receiver) 0) +red+) + (t +black+)))))) + +(defun receiver-page-enabled-callback (page) + (let ((receiver (receiver-from-tab-page page))) + (unless (null receiver) + (setf (unseen-messages receiver) 0) + (setf (all-unseen-messages receiver) 0) + (setf (messages-directed-to-me receiver) 0) + (setf (last-visited receiver) (get-universal-time)) + (update-drawing-options receiver)))) (defun raise-receiver (receiver) (setf (unseen-messages receiver) 0) (setf (all-unseen-messages receiver) 0) (setf (messages-directed-to-me receiver) 0) (setf (last-visited receiver) (get-universal-time)) - (switch-to-pane (pane receiver) 'tab-layout-pane)) + (switch-to-page (sheet-to-page (pane receiver))))

1 0

[beirc-cvs] CVS beirc
by mretzlaff 10 Sep '06

10 Sep '06

Update of /project/beirc/cvsroot/beirc In directory clnet:/tmp/cvs-serv24337 Modified Files: events.lisp Log Message: "whenever" instead of "when ever" in comment. (Yeah.) --- /project/beirc/cvsroot/beirc/events.lisp 2006/04/04 18:37:28 1.2 +++ /project/beirc/cvsroot/beirc/events.lisp 2006/09/10 17:58:00 1.3 @@ -5,7 +5,7 @@ ;;; Although I would pretty much prefer an implementation of CLIM ;;; which is thread safe, I figure we better go through the central ;;; event loop. We define a new event class, subclass of -;;; WINDOW-MANAGER-EVENT, and when ever we want to update the display +;;; WINDOW-MANAGER-EVENT, and whenever we want to update the display ;;; we send it to the frame. (defclass foo-event (clim:window-manager-event) @@ -20,7 +20,6 @@ ((sheet :initarg :sheet :reader event-sheet) (closure :initarg :creator :reader sheet-creation-closure) (receiver :initarg :receiver :reader receiver))) - (defun processes-supported-p () (processp (current-process)))

1 0

[beirc-cvs] CVS beirc
by afuchs 31 May '06

31 May '06

Update of /project/beirc/cvsroot/beirc In directory clnet:/tmp/cvs-serv2704 Modified Files: application.lisp Log Message: Fix message-directed-to-me-p for messages with no args. --- /project/beirc/cvsroot/beirc/application.lisp 2006/05/29 20:05:41 1.83 +++ /project/beirc/cvsroot/beirc/application.lisp 2006/05/31 19:35:39 1.84 @@ -190,16 +190,17 @@ (defvar *beirc-frame*) (defun beirc-status-display (*application-frame* *standard-output*) - (with-text-family (t :sans-serif) - (multiple-value-bind (seconds minutes hours) (decode-universal-time (get-universal-time)) - seconds + (multiple-value-bind (seconds minutes hours) + (decode-universal-time (get-universal-time)) + seconds + (with-text-family (t :sans-serif) (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*)) (current-channel) - (current-query) + (current-query) (length (current-messages)))))) (defun beirc-prompt (*standard-output* *application-frame*) @@ -328,9 +329,9 @@ (defun message-directed-to-me-p (message) - (irc:destructuring-arguments (&rest :ignored &req body) message - (let ((my-nick (current-nickname (irc:connection message)))) - (search my-nick (or body ""))))) + (let ((body (car (last (irc:arguments message)))) + (my-nick (current-nickname (irc:connection message)))) + (search my-nick (or body "")))) (defun interesting-message-p (message) (typep message '(or irc:irc-privmsg-message irc:irc-notice-message irc:irc-topic-message irc:irc-kick-message irc:ctcp-action-message))) @@ -339,7 +340,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))) + (nconc (messages receiver) (list message))) (unless (eql receiver (current-receiver frame)) (when interesting-message-p (incf (unseen-messages receiver))) @@ -770,7 +771,7 @@ (define-presentation-to-command-translator nickname-to-query-translator (nickname com-query beirc :menu t - :gesture nil + :gesture :describe :documentation "Query this user" :pointer-documentation "Query this user") (object) @@ -856,7 +857,9 @@ ;;; presentation types, I bet I could fold this into the previous ;;; translator. [2006/04/18:rpg] (define-presentation-to-command-translator meme-url-to-browse-url-translator - (meme-url com-browse-url beirc :pointer-documentation "Browse meme log" + (meme-url com-browse-url beirc + :documentation "Browse meme log" + :pointer-documentation "Browse meme log" ;; override url-to-browse-url-translator :priority 1) (presentation) @@ -963,7 +966,8 @@ (disconnect connection frame "Client Disconnect")))) :name "IRC Message Muffling Loop")) (irc:start-background-message-handler connection)) - (setf success t)) + (setf success t) + connection) (unless success (disconnect connection frame "Client error."))))) ;; added auto-identify [2006/05/09:rpg]

1 0

[beirc-cvs] CVS beirc
by afuchs 29 May '06

29 May '06

Update of /project/beirc/cvsroot/beirc In directory clnet:/tmp/cvs-serv25410 Modified Files: application.lisp message-display.lisp package.lisp Log Message: Restore compatibility with cl-irc trunk. --- /project/beirc/cvsroot/beirc/application.lisp 2006/05/09 17:08:25 1.82 +++ /project/beirc/cvsroot/beirc/application.lisp 2006/05/29 20:05:41 1.83 @@ -328,7 +328,7 @@ (defun message-directed-to-me-p (message) - (irc:destructuring-arguments (&last body) message + (irc:destructuring-arguments (&rest :ignored &req body) message (let ((my-nick (current-nickname (irc:connection message)))) (search my-nick (or body ""))))) --- /project/beirc/cvsroot/beirc/message-display.lisp 2006/05/09 17:10:00 1.49 +++ /project/beirc/cvsroot/beirc/message-display.lisp 2006/05/29 20:05:42 1.50 @@ -308,7 +308,7 @@ (with-text-face (*standard-output* (if (message-from-focused-nick-p message receiver) :bold :roman)) - (irc:destructuring-arguments (&last body) message + (irc:destructuring-arguments (&rest :ignored &req body) message (formatting-message (t message receiver) ((write-string start-string *standard-output*) (present (irc:source message) 'unhighlighted-nickname) @@ -346,8 +346,7 @@ ,@(loop for (message-type . message-name) in message-specs collect `(defmethod print-message ((message ,message-type) receiver) - (irc:destructuring-arguments (_ &rest arguments &last body) message - (declare (ignore _)) + (irc:destructuring-arguments (:ignored &rest arguments &req body) message (formatting-message (t message receiver) ((format t "~A" (irc:source message))) ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small) @@ -379,7 +378,7 @@ (defmethod print-message (message receiver) ;; default message if we don't know how to render a message. #+(or) (break "~S" message) ; uncomment to debug - (irc:destructuring-arguments (&whole args &last body) message + (irc:destructuring-arguments (&whole args &rest :ignored &req body) message (formatting-message (t message receiver) ((format t "!!! ~A" (irc:source message))) ((with-drawing-options (*standard-output* :ink +red+ :text-size :small) @@ -408,7 +407,7 @@ (write-char #\))) (defmethod print-message ((message irc:irc-nick-message) receiver) - (irc:destructuring-arguments (&last body) message + (irc:destructuring-arguments (&rest :ignored &req body) message (formatting-message (t message receiver) ((format t " ")) ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small) @@ -423,16 +422,14 @@ (formatting-message (t message receiver) ((format t " ")) ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small) - (irc:destructuring-arguments (me nickname user host &last ircname) message - (declare (ignore me)) + (irc:destructuring-arguments (:ignored nickname user host &rest :ignored &req ircname) message (present nickname 'nickname) (format t " is ") (present-as-hostmask user host) (format t " (~A)" ircname)))))) (defmethod print-message ((message irc:irc-rpl_whoischannels-message) receiver) - (irc:destructuring-arguments (me nickname &last body) message - (declare (ignore me)) + (irc:destructuring-arguments (:ignored nickname &rest :ignored &req body) message (formatting-message (t message receiver) ((format t " ")) ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small) @@ -440,8 +437,7 @@ (format-message* (format nil " is in ~A" body) :start-length (length nickname))))))) (defmethod print-message ((message irc:irc-rpl_whoisserver-message) receiver) - (irc:destructuring-arguments (me nickname server &last server-callout) message - (declare (ignore me)) + (irc:destructuring-arguments (:ignored nickname server &rest :ignored &req server-callout) message (formatting-message (t message receiver) ((format t " ")) ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small) @@ -450,8 +446,7 @@ :start-length (length nickname))))))) (defmethod print-message ((message irc:irc-rpl_away-message) receiver) - (irc:destructuring-arguments (me nickname &last away-msg) message - (declare (ignore me)) + (irc:destructuring-arguments (:ignored nickname &rest :ignored &req away-msg) message (formatting-message (t message receiver) ((format t " ")) ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small) @@ -460,8 +455,7 @@ :start-length (length nickname))))))) (defmethod print-message ((message irc:irc-rpl_whoisidentified-message) receiver) - (irc:destructuring-arguments (me nickname body) message - (declare (ignore me)) + (irc:destructuring-arguments (:ignored nickname body) message (formatting-message (t message receiver) ((format t " ")) ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small) @@ -480,8 +474,7 @@ year month date hour minute second))) (defmethod print-message ((message irc:irc-rpl_whoisidle-message) receiver) - (irc:destructuring-arguments (me nickname idle signon &rest rest) message - (declare (ignore me rest)) + (irc:destructuring-arguments (:ignored nickname idle signon &rest :ignored) message (formatting-message (t message receiver) ((format t " ")) ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small) @@ -510,8 +503,7 @@ (defmethod print-message ((message irc:irc-err_nosuchnick-message) receiver) (formatting-message (t message receiver) ((format t " ")) - ((irc:destructuring-arguments (me target &rest rest) message - (declare (ignore me rest)) + ((irc:destructuring-arguments (:ignored target &rest :ignored) message (with-drawing-options (*standard-output* :ink +red3+ :text-size :small) (format-message* (format nil "No such nick or channel \"~A\". " target))) @@ -523,15 +515,14 @@ (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)) + (irc:destructuring-arguments (:ignored msg) message (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 + (irc:destructuring-arguments (:ignored body) message (formatting-message (t message receiver) ((format t " ")) ((with-drawing-options (*standard-output* :ink +red3+ :text-size :small) @@ -554,26 +545,25 @@ (format-message* (format nil " set the topic for ~A to ~A" channel topic)))))))) (defmethod print-message ((message irc:irc-topic-message) receiver) - (irc:destructuring-arguments (channel &last topic) message + (irc:destructuring-arguments (channel &rest :ignored &req topic) message (print-topic receiver message (irc:source message) channel topic))) (defmethod print-message ((message irc:irc-rpl_topic-message) receiver) - (irc:destructuring-arguments (target channel &optional topic) message - (declare (ignore target)) + (irc:destructuring-arguments (:ignored channel &optional topic) message (print-topic receiver message nil channel topic))) (defmethod print-message ((message irc:irc-rpl_topicwhotime-message) receiver) (formatting-message (t message receiver) ((format t " ")) ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small) - (irc:destructuring-arguments (me channel who time) message - (declare (ignore me)) + (irc:destructuring-arguments (:ignored channel who time) message (format-message* (format nil "~A topic set by ~A on ~A" channel who (format-unix-epoch (parse-integer time))))))))) (defmethod print-message ((message irc:irc-rpl_namreply-message) receiver) - (irc:destructuring-arguments (me privacy channel &last nicks) message - (declare (ignore me privacy)) + (irc:destructuring-arguments (:ignored ; me + :ignored ; privacy + channel &rest :ignored &req nicks) message (formatting-message (t message receiver) ((format t " ")) ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small) @@ -600,8 +590,7 @@ (present-as-hostmask (irc:user message) (irc:host message)))))) (defmethod print-message ((message irc:irc-kick-message) receiver) - (irc:destructuring-arguments (channel victim &optional kick-msg) message - (declare (ignore channel)) + (irc:destructuring-arguments (:ignored victim &optional kick-msg) message (formatting-message (t message receiver) ((format t " ")) ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small) --- /project/beirc/cvsroot/beirc/package.lisp 2005/10/02 09:30:19 1.4 +++ /project/beirc/cvsroot/beirc/package.lisp 2006/05/29 20:05:42 1.5 @@ -4,4 +4,5 @@ #:*beirc-user-init-file* #:*hyperspec-base-url* #:*default-fill-column* #:*timestamp-column-orientation* #:*default-nick* #:*nickserv-password-alist* #:*default-web-browser - #:*auto-join-alist*)) + #:*auto-join-alist*) + (:import-from #:cl-irc #:&req))

1 0

[beirc-cvs] CVS beirc
by rgoldman 09 May '06

09 May '06

Update of /project/beirc/cvsroot/beirc In directory clnet:/tmp/cvs-serv4185 Modified Files: message-display.lisp Log Message: Fixed strip-preceding-punctuation to remove a leading open paren. This makes clicking on parenthesized urls work, previously the leading paren was incorrectly identified as part of the URL. --- /project/beirc/cvsroot/beirc/message-display.lisp 2006/04/26 18:23:16 1.48 +++ /project/beirc/cvsroot/beirc/message-display.lisp 2006/05/09 17:10:00 1.49 @@ -146,7 +146,7 @@ (values word "") (let ((first-char (char word 0))) (case first-char - ((#\@ #\+ #\<) + ((#\@ #\+ #\< #\() (values (subseq word 1) (string first-char))) (otherwise (values word ""))))))

1 0

[beirc-cvs] CVS beirc
by rgoldman 09 May '06

09 May '06

Update of /project/beirc/cvsroot/beirc In directory clnet:/tmp/cvs-serv4065 Modified Files: application.lisp Log Message: Added auto-identify behavior to com-connect. --- /project/beirc/cvsroot/beirc/application.lisp 2006/04/26 18:22:54 1.81 +++ /project/beirc/cvsroot/beirc/application.lisp 2006/05/09 17:08:25 1.82 @@ -965,7 +965,12 @@ (irc:start-background-message-handler connection)) (setf success t)) (unless success - (disconnect connection frame "Client error."))))))) + (disconnect connection frame "Client error."))))) + ;; added auto-identify [2006/05/09:rpg] + (when success + (when (member server *auto-identify-list* :test 'equalp) + (com-identify))) + )) (defun disconnect (connection frame reason) (let ((*application-frame* frame))

1 0

[beirc-cvs] CVS beirc
by rgoldman 09 May '06

09 May '06

Update of /project/beirc/cvsroot/beirc In directory clnet:/tmp/cvs-serv4043 Modified Files: variables.lisp Log Message: Added *auto-identify-list* configuration variable. --- /project/beirc/cvsroot/beirc/variables.lisp 2006/04/26 18:22:54 1.16 +++ /project/beirc/cvsroot/beirc/variables.lisp 2006/05/09 17:08:03 1.17 @@ -34,6 +34,12 @@ beirc should automatically connect on startup." ) +(defvar *auto-identify-list* + nil + "A list of servers for which BEIRC should automatically execute +the identify command on connection.") + + (defvar *nickserv-password-alist* '() "Default password to send to the NickServ authentication bot")

1 0

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

26 Apr '06

Update of /project/beirc/cvsroot/beirc In directory clnet:/tmp/cvs-serv16234 Modified Files: message-display.lisp Log Message: Changed offer-reconnect to honor realname setting. --- /project/beirc/cvsroot/beirc/message-display.lisp 2006/04/19 02:53:48 1.47 +++ /project/beirc/cvsroot/beirc/message-display.lisp 2006/04/26 18:23:16 1.48 @@ -501,8 +501,9 @@ (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) + (nickname (irc:nickname (irc:user conn))) + (realname (irc:realname (irc:user conn)))) + (with-output-as-presentation (t `(com-connect ,server :nick ,nickname :realname ,realname) '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))))))

1 0

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

26 Apr '06

Update of /project/beirc/cvsroot/beirc In directory clnet:/tmp/cvs-serv16201 Modified Files: application.lisp variables.lisp Log Message: Added *default-realname* variable and made com-connect set realname. --- /project/beirc/cvsroot/beirc/application.lisp 2006/04/21 16:58:58 1.80 +++ /project/beirc/cvsroot/beirc/application.lisp 2006/04/26 18:22:54 1.81 @@ -922,6 +922,7 @@ ((server 'string :prompt "Server") &key (nick 'string :prompt "Nick name" :default *default-nick*) + (realname 'string :prompt "Real name (phrase)" :default *default-realname*) (pass 'string :prompt "Password" :default nil) (port 'number :prompt "Port" :default irc::*default-irc-server-port*)) (let ((success nil) @@ -930,6 +931,11 @@ (let* ((frame *application-frame*) (connection (apply #'irc:connect :nickname nick :server server :connection-type 'beirc-connection :port port + ;; this works because the default in + ;; cl-irc is NIL, so we don't have + ;; to handle this specially as with + ;; password. + :realname realname (if (null pass) nil `(:password ,pass)))) --- /project/beirc/cvsroot/beirc/variables.lisp 2006/04/07 01:42:56 1.15 +++ /project/beirc/cvsroot/beirc/variables.lisp 2006/04/26 18:22:54 1.16 @@ -4,6 +4,8 @@ (defvar *default-fill-column* 80) (defvar *timestamp-column-orientation* :right) (defvar *default-nick* (format nil "Brucio-~d" (random 100))) +(defvar *default-realname* NIL + "Either a string or NIL.") (defvar *default-web-browser* #+darwin "/usr/bin/open" ;; assuming a debian system running X: #+linux "/usr/bin/x-www-browser")

1 0

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

21 Apr '06

Update of /project/beirc/cvsroot/beirc In directory clnet:/tmp/cvs-serv596 Modified Files: application.lisp Log Message: Keep cl-irc:no-such-reply errors from crashing BEIRC. Unfortunately, this is only a partial patch; it doesn't work for lisps without processing. --- /project/beirc/cvsroot/beirc/application.lisp 2006/04/20 06:39:27 1.79 +++ /project/beirc/cvsroot/beirc/application.lisp 2006/04/21 16:58:58 1.80 @@ -1094,14 +1094,17 @@ (format stream "\"."))))) (defun irc-event-loop (frame 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)))))) + ;; keep unrecognized responses from crashing BEIRC [2006/04/21:rpg] + (handler-bind ((cl-irc:no-such-reply #'(lambda (c) + (continue c)))) + (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:

1 0

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