mailman3.common-lisp.net
Sign In
Sign Up
Sign In
Sign Up
Manage this list
×
Keyboard Shortcuts
Thread View
j
: Next unread message
k
: Previous unread message
j a
: Jump to all threads
j l
: Jump to MailingList overview
2025
January
2024
December
November
October
September
August
July
June
May
April
March
February
January
2023
December
November
October
September
August
July
June
May
April
March
February
January
2022
December
November
October
September
August
July
June
May
April
March
February
January
2021
December
November
October
September
August
July
June
May
April
March
February
January
2020
December
November
October
September
August
July
June
May
April
March
February
January
2019
December
November
October
September
August
July
June
May
April
March
February
January
2018
December
November
October
September
August
July
June
May
April
March
February
January
2017
December
November
October
September
August
July
June
May
April
March
February
January
2016
December
November
October
September
August
July
June
May
April
March
February
January
2015
December
November
October
September
August
July
June
May
April
March
February
January
2014
December
November
October
September
August
July
June
May
April
March
February
January
2013
December
November
October
September
August
July
June
May
April
March
February
January
2012
December
November
October
September
August
July
June
May
April
March
February
January
2011
December
November
October
September
August
July
June
May
April
March
February
January
2010
December
November
October
September
August
July
June
May
April
March
February
January
2009
December
November
October
September
August
July
June
May
April
March
February
January
2008
December
November
October
September
August
July
June
May
April
March
February
January
2007
December
November
October
September
August
July
June
May
April
March
February
January
2006
December
November
October
September
August
July
June
May
April
March
February
January
2005
December
November
October
September
List overview
Download
beirc-cvs
----- 2025 -----
January 2025
----- 2024 -----
December 2024
November 2024
October 2024
September 2024
August 2024
July 2024
June 2024
May 2024
April 2024
March 2024
February 2024
January 2024
----- 2023 -----
December 2023
November 2023
October 2023
September 2023
August 2023
July 2023
June 2023
May 2023
April 2023
March 2023
February 2023
January 2023
----- 2022 -----
December 2022
November 2022
October 2022
September 2022
August 2022
July 2022
June 2022
May 2022
April 2022
March 2022
February 2022
January 2022
----- 2021 -----
December 2021
November 2021
October 2021
September 2021
August 2021
July 2021
June 2021
May 2021
April 2021
March 2021
February 2021
January 2021
----- 2020 -----
December 2020
November 2020
October 2020
September 2020
August 2020
July 2020
June 2020
May 2020
April 2020
March 2020
February 2020
January 2020
----- 2019 -----
December 2019
November 2019
October 2019
September 2019
August 2019
July 2019
June 2019
May 2019
April 2019
March 2019
February 2019
January 2019
----- 2018 -----
December 2018
November 2018
October 2018
September 2018
August 2018
July 2018
June 2018
May 2018
April 2018
March 2018
February 2018
January 2018
----- 2017 -----
December 2017
November 2017
October 2017
September 2017
August 2017
July 2017
June 2017
May 2017
April 2017
March 2017
February 2017
January 2017
----- 2016 -----
December 2016
November 2016
October 2016
September 2016
August 2016
July 2016
June 2016
May 2016
April 2016
March 2016
February 2016
January 2016
----- 2015 -----
December 2015
November 2015
October 2015
September 2015
August 2015
July 2015
June 2015
May 2015
April 2015
March 2015
February 2015
January 2015
----- 2014 -----
December 2014
November 2014
October 2014
September 2014
August 2014
July 2014
June 2014
May 2014
April 2014
March 2014
February 2014
January 2014
----- 2013 -----
December 2013
November 2013
October 2013
September 2013
August 2013
July 2013
June 2013
May 2013
April 2013
March 2013
February 2013
January 2013
----- 2012 -----
December 2012
November 2012
October 2012
September 2012
August 2012
July 2012
June 2012
May 2012
April 2012
March 2012
February 2012
January 2012
----- 2011 -----
December 2011
November 2011
October 2011
September 2011
August 2011
July 2011
June 2011
May 2011
April 2011
March 2011
February 2011
January 2011
----- 2010 -----
December 2010
November 2010
October 2010
September 2010
August 2010
July 2010
June 2010
May 2010
April 2010
March 2010
February 2010
January 2010
----- 2009 -----
December 2009
November 2009
October 2009
September 2009
August 2009
July 2009
June 2009
May 2009
April 2009
March 2009
February 2009
January 2009
----- 2008 -----
December 2008
November 2008
October 2008
September 2008
August 2008
July 2008
June 2008
May 2008
April 2008
March 2008
February 2008
January 2008
----- 2007 -----
December 2007
November 2007
October 2007
September 2007
August 2007
July 2007
June 2007
May 2007
April 2007
March 2007
February 2007
January 2007
----- 2006 -----
December 2006
November 2006
October 2006
September 2006
August 2006
July 2006
June 2006
May 2006
April 2006
March 2006
February 2006
January 2006
----- 2005 -----
December 2005
November 2005
October 2005
September 2005
beirc-cvs@common-lisp.net
168 discussions
Start a n
N
ew thread
[beirc-cvs] CVS update: beirc/beirc.lisp
by afuchs@common-lisp.net
24 Sep '05
24 Sep '05
Update of /project/beirc/cvsroot/beirc In directory common-lisp.net:/tmp/cvs-serv18565 Modified Files: beirc.lisp Log Message: add kick and ban presentation translators for nicknames. Date: Sat Sep 24 21:13:54 2005 Author: afuchs Index: beirc/beirc.lisp diff -u beirc/beirc.lisp:1.27 beirc/beirc.lisp:1.28 --- beirc/beirc.lisp:1.27 Sat Sep 24 21:03:14 2005 +++ beirc/beirc.lisp Sat Sep 24 21:13:54 2005 @@ -658,6 +658,33 @@ (object) (list object)) +(define-presentation-to-command-
…
[View More]
translator nickname-to-kick-translator + (nickname com-kick beirc + :gesture :menu + :menu t + :documentation "Kick this user" + :pointer-documentation "Kick this user") + (object) + (list object)) + +(define-presentation-to-command-translator nickname-to-ban-nick-translator + (nickname com-ban-nick beirc + :gesture :menu + :menu t + :documentation "Ban this user's nickname" + :pointer-documentation "Ban this user's nickname") + (object) + (list object)) + +(define-presentation-to-command-translator nickname-to-ban-hostmask-translator + (nickname com-ban-hostmask beirc + :gesture :menu + :menu t + :documentation "Ban this user's hostmask" + :pointer-documentation "Ban this user's hostmask") + (object) + (list object)) + (define-presentation-to-command-translator url-to-browse-url-translator (url com-browse-url beirc) (presentation)
[View Less]
1
0
0
0
[beirc-cvs] CVS update: beirc/beirc.lisp beirc/message-display.lisp
by afuchs@common-lisp.net
24 Sep '05
24 Sep '05
Update of /project/beirc/cvsroot/beirc In directory common-lisp.net:/tmp/cvs-serv18453 Modified Files: beirc.lisp message-display.lisp Log Message: implement kicking & banning; reorder and group print-message methods Date: Sat Sep 24 21:03:15 2005 Author: afuchs Index: beirc/beirc.lisp diff -u beirc/beirc.lisp:1.26 beirc/beirc.lisp:1.27 --- beirc/beirc.lisp:1.26 Sat Sep 24 20:14:28 2005 +++ beirc/beirc.lisp Sat Sep 24 21:03:14 2005 @@ -163,18 +163,29 @@ (define-global-message-
…
[View More]
receiver-lookup irc:irc-quit-message) (define-global-message-receiver-lookup irc:irc-nick-message)) -(defmethod receiver-for-message ((message irc:irc-topic-message) frame) - (intern-receiver (first (irc:arguments message)) frame :channel (first (irc:arguments message)))) +(macrolet ((define-nth-arg-message-receiver-lookup (&rest clauses) + "Defines receiver-for-message methods that return + the receiver associated with the nth arg of the + irc message or the trailing arg if NTH in the + clauses is nil. -(defmethod receiver-for-message ((message irc:irc-rpl_topic-message) frame) - (intern-receiver (second (irc:arguments message)) frame :channel (second (irc:arguments message)))) - -(defmethod receiver-for-message ((message irc:irc-rpl_namreply-message) frame) - (intern-receiver (third (irc:arguments message)) frame :channel (third (irc:arguments message)))) - -(defmethod receiver-for-message ((message irc:irc-join-message) frame) - (let ((target (irc:trailing-argument message))) - (intern-receiver target frame :channel target))) + Each clause must have this format: + (nth message-type ...)" + `(progn + ,@(loop for (nth . messages) in clauses + do (print messages) + nconc (loop for message-type in messages + collect + `(defmethod receiver-for-message ((message ,message-type) frame) + (let ((target ,(if (numberp nth) + `(nth ,nth (irc:arguments message)) + `(irc:trailing-argument message)))) + (intern-receiver target frame :channel target)))))))) + (define-nth-arg-message-receiver-lookup + (0 irc:irc-topic-message irc:irc-kick-message) + (1 irc:irc-rpl_topic-message) + (2 irc:irc-rpl_namreply-message) + (nil irc:irc-join-message))) (defmethod receiver-for-message ((message irc:irc-part-message) frame) (let ((target (first (irc:arguments message)))) @@ -440,6 +451,8 @@ (define-presentation-type nickname ()) (define-presentation-type unhighlighted-nickname () :inherit-from 'nickname) (define-presentation-type ignored-nickname () :inherit-from 'nickname) +(define-presentation-type channel () :inherit-from 'string) +(define-presentation-type hostmask () :inherit-from 'string) (defun hash-alist (hashtable &aux res) (maphash (lambda (k v) (push (cons k v) res)) hashtable) @@ -465,6 +478,11 @@ (receiver-from-tab-pane (find-in-tab-panes-list object 'tab-layout-pane))) +(define-presentation-translator nickname-to-hostmask-translator + (nickname hostmask beirc) + (object) + (format nil "*!*@~A" (irc:hostname (irc:find-user (current-connection *application-frame*) object)))) + (defun nick-equals-my-nick-p (nickname) (and (not (null *application-frame*)) (not (null (slot-value *application-frame* 'connection))) @@ -483,8 +501,6 @@ (write-string o))) (write-string o))) -(define-presentation-type channel () :inherit-from 'string) - (define-presentation-method presentation-typep (object (type channel)) (channelp object)) @@ -567,6 +583,15 @@ (define-beirc-command (com-deop :name t) ((who 'nickname :prompt "who")) (irc:deop (current-connection *application-frame*) (target) who)) +(define-beirc-command (com-ban-nick :name t) ((who 'nickname :prompt "who")) + (irc:ban (current-connection *application-frame*) (target) (format nil "~A!*@*" who))) + +(define-beirc-command (com-ban-hostmask :name t) ((who 'hostmask :prompt "hostmask")) + (irc:ban (current-connection *application-frame*) (target) who)) + +(define-beirc-command (com-kick :name t) ((who 'nickname :prompt "who")) + (irc:kick (current-connection *application-frame*) (target) who)) + (define-beirc-command (com-names :name t) () (irc:names (current-connection *application-frame*) (target))) @@ -662,8 +687,8 @@ (clim-sys:make-process #'(lambda () (unwind-protect (irc-event-loop frame connection) - (disconnect frame))) - :name "IRC Message Muffling Loop")) ))))) + (quit frame "IRC event loop terminated."))) + :name "IRC Message Muffling Loop"))))))) (defun disconnect (frame) (raise-receiver (server-receiver frame)) Index: beirc/message-display.lisp diff -u beirc/message-display.lisp:1.11 beirc/message-display.lisp:1.12 --- beirc/message-display.lisp:1.11 Sat Sep 24 20:13:44 2005 +++ beirc/message-display.lisp Sat Sep 24 21:03:15 2005 @@ -114,6 +114,8 @@ (incf column)) (terpri)) +;;; privmsg-like messages + (defun print-privmsg-like-message (message receiver start-string end-string) (with-drawing-options (*standard-output* @@ -145,6 +147,22 @@ (format t " ") (format-message* matter :start-length (+ 2 (length source))))))) +;;; server messages + +(defmethod print-message ((message irc:irc-rpl_motd-message) receiver) + (formatting-message (t message receiver) + ((format t "~A" (irc:source message))) + ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small) + (format t "MOTD: ~A" (irc:trailing-argument message)))))) + +(defmethod print-message (message receiver) + (formatting-message (t message receiver) + ((format t "!!! ~A" (irc:source message))) + ((with-drawing-options (*standard-output* :ink +red+ :text-size :small) + (format t "args: ~A :~A" (irc:arguments message) (irc:trailing-argument message)))))) + +;;; user-related messages + (defmethod print-message ((message irc:irc-quit-message) receiver) (formatting-message (t message receiver) ((format t " ")) @@ -155,22 +173,16 @@ (format-message* (irc:trailing-argument message) :start-length (+ 8 (length (irc:source message)))))))) -(defmethod print-message ((message irc:irc-join-message) receiver) - (formatting-message (t message receiver) - ((format t " ")) - ((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)))))) - (defmethod print-message ((message irc:irc-nick-message) receiver) (formatting-message (t message receiver) - ((format t " ")) - ((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)) - (present (irc:trailing-argument message) 'nickname))))) + ((format t " ")) + ((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)) + (present (irc:trailing-argument message) 'nickname))))) + +;;; channel management messages (defun print-topic (receiver message sender channel topic) (formatting-message (t message receiver) @@ -205,6 +217,25 @@ (present (irc:source message) 'nickname) (format t " left ~A: ~A" (first (irc:arguments message)) (irc:trailing-argument message)))))) +(defmethod print-message ((message irc:irc-join-message) receiver) + (formatting-message (t message receiver) + ((format t " ")) + ((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)))))) + +(defmethod print-message ((message irc:irc-kick-message) receiver) + (formatting-message (t message receiver) + ((format t " ")) + ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small) + (present (irc:source message) 'nickname) + (write-string " kicked ") + (present (second (irc:arguments message)) 'nickname) + (format-message* (format nil ": ~A" (irc:trailing-argument message)) + :start-length (+ 9 (length (second (irc:arguments message))) + (length (irc:source message)))))))) + (defmethod print-message ((message irc:irc-mode-message) receiver) (case (length (irc:arguments message)) (1 (formatting-message (t message receiver) @@ -221,17 +252,7 @@ (present (irc:source message) 'nickname) (format-message* (format nil " set mode ~A ~A" modes args))))))))) -(defmethod print-message ((message irc:irc-rpl_motd-message) receiver) - (formatting-message (t message receiver) - ((format t "~A" (irc:source message))) - ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small) - (format t "MOTD: ~A" (irc:trailing-argument message)))))) - -(defmethod print-message (message receiver) - (formatting-message (t message receiver) - ((format t "!!! ~A" (irc:source message))) - ((with-drawing-options (*standard-output* :ink +red+ :text-size :small) - (format t "args: ~A :~A" (irc:arguments message) (irc:trailing-argument message)))))) +;;; the display function (& utilities) (defgeneric preamble-length (message) (:method ((message irc:irc-privmsg-message)) @@ -247,30 +268,4 @@ maximize (preamble-length message)))) (formatting-table (t) (loop for message in messages - do (print-message message receiver))))) - - -#| - (let ((k 100) - (n (length messages))) - (loop for i below (* k (ceiling n k)) by k do - (updating-output (*standard-output* - :unique-id i - :cache-value - (list (min n (+ i k)) - (focused-nicks receiver) - (slot-value *application-frame* 'ignored-nicks) - w) - :cache-test #'equal) - (loop for j from i below (min n (+ i k)) do - (let ((m (elt messages j))) - (updating-output (*standard-output* - :unique-id j - :cache-value - (list m - (focused-nicks receiver) - (slot-value *application-frame* 'ignored-nicks) - w) - :cache-test #'equal) - (print-message m receiver))))))) -|# \ No newline at end of file + do (print-message message receiver))))) \ No newline at end of file
[View Less]
1
0
0
0
[beirc-cvs] CVS update: beirc/beirc.lisp
by afuchs@common-lisp.net
24 Sep '05
24 Sep '05
Update of /project/beirc/cvsroot/beirc In directory common-lisp.net:/tmp/cvs-serv14230 Modified Files: beirc.lisp Log Message: don't display PING messages. The *Server* buffer should only light up if something important happens, now. Date: Sat Sep 24 20:14:28 2005 Author: afuchs Index: beirc/beirc.lisp diff -u beirc/beirc.lisp:1.25 beirc/beirc.lisp:1.26 --- beirc/beirc.lisp:1.25 Sat Sep 24 20:13:44 2005 +++ beirc/beirc.lisp Sat Sep 24 20:14:28 2005 @@ -212,7 +212,8 @@ cl-irc:irc-
…
[View More]
rpl_endofinfo-message cl-irc:irc-rpl_endofstats-message cl-irc:irc-rpl_endofwho-message - cl-irc:irc-rpl_endofexceptlist-message)) + cl-irc:irc-rpl_endofexceptlist-message + cl-irc:irc-ping-message)) (defmethod receiver-for-message ((message irc:irc-message) frame) (server-receiver frame))
[View Less]
1
0
0
0
[beirc-cvs] CVS update: beirc/beirc.lisp beirc/message-display.lisp
by afuchs@common-lisp.net
24 Sep '05
24 Sep '05
Update of /project/beirc/cvsroot/beirc In directory common-lisp.net:/tmp/cvs-serv14202 Modified Files: beirc.lisp message-display.lisp Log Message: don't highlight the user's nickname in the first column. Date: Sat Sep 24 20:13:44 2005 Author: afuchs Index: beirc/beirc.lisp diff -u beirc/beirc.lisp:1.24 beirc/beirc.lisp:1.25 --- beirc/beirc.lisp:1.24 Sat Sep 24 19:39:36 2005 +++ beirc/beirc.lisp Sat Sep 24 20:13:44 2005 @@ -437,7 +437,8 @@ (sleep 1))) (define-presentation-type
…
[View More]
nickname ()) -(define-presentation-type ignored-nickname (nickname)) +(define-presentation-type unhighlighted-nickname () :inherit-from 'nickname) +(define-presentation-type ignored-nickname () :inherit-from 'nickname) (defun hash-alist (hashtable &aux res) (maphash (lambda (k v) (push (cons k v) res)) hashtable) @@ -471,12 +472,15 @@ (irc:normalize-nickname (current-connection *application-frame*) nickname)))) +(define-presentation-method present (o (type unhighlighted-nickname) *standard-output* (view textual-view) &key) + (write-string o)) + (define-presentation-method present (o (type nickname) *standard-output* (view textual-view) &key) (if (nick-equals-my-nick-p o) (with-drawing-options (t :ink +darkgreen+) (with-text-face (t :bold) - (format t "~A" o))) - (format t "~A" o))) + (write-string o))) + (write-string o))) (define-presentation-type channel () :inherit-from 'string) Index: beirc/message-display.lisp diff -u beirc/message-display.lisp:1.10 beirc/message-display.lisp:1.11 --- beirc/message-display.lisp:1.10 Sat Sep 24 19:28:38 2005 +++ beirc/message-display.lisp Sat Sep 24 20:13:44 2005 @@ -126,7 +126,7 @@ (if (message-from-focused-nick-p message receiver) :bold :roman)) (formatting-message (t message receiver) ((write-string start-string *standard-output*) - (present (irc:source message) 'nickname) + (present (irc:source message) 'unhighlighted-nickname) (write-string end-string *standard-output*)) ((format-message* (irc:trailing-argument message))))))))
[View Less]
1
0
0
0
[beirc-cvs] CVS update: beirc/beirc.lisp
by afuchs@common-lisp.net
24 Sep '05
24 Sep '05
Update of /project/beirc/cvsroot/beirc In directory common-lisp.net:/tmp/cvs-serv12043 Modified Files: beirc.lisp Log Message: add /part and better /close functionality. * /part exits the current channel and leaves the receiver intact. * /close closes the receiver and parts the channel (if the closed receiver is a channel). The part message from a closed channel goes to the server buffer. Date: Sat Sep 24 19:39:36 2005 Author: afuchs Index: beirc/beirc.lisp diff -u beirc/beirc.
…
[View More]
lisp:1.23 beirc/beirc.lisp:1.24 --- beirc/beirc.lisp:1.23 Sat Sep 24 19:28:38 2005 +++ beirc/beirc.lisp Sat Sep 24 19:39:36 2005 @@ -178,7 +178,11 @@ (defmethod receiver-for-message ((message irc:irc-part-message) frame) (let ((target (first (irc:arguments message)))) - (intern-receiver target frame :channel target))) + (if (and + (null (find-receiver target frame)) + (string= (irc:source message) (slot-value frame 'nick))) + (server-receiver frame) ; don't re-open previously closed channels. + (intern-receiver target frame :channel target)))) (defmethod receiver-for-message ((message irc:irc-mode-message) frame) (case (length (irc:arguments message)) @@ -497,7 +501,15 @@ (raise-receiver receiver)) (define-beirc-command (com-close :name t) ((receiver 'receiver :prompt "receiver")) + (let* ((connection (current-connection *application-frame*)) + (channel (irc:find-channel connection (title receiver)))) + (when channel + (irc:part connection channel))) (remove-receiver receiver *application-frame*)) + +(define-beirc-command (com-part :name t) () + (irc:part (current-connection *application-frame*) + (title (current-receiver *application-frame*)))) (define-beirc-command (com-focus :name t) ((who 'nickname :prompt "who")) (pushnew who (current-focused-nicks) :test #'string=))
[View Less]
1
0
0
0
[beirc-cvs] CVS update: beirc/beirc.lisp beirc/message-display.lisp
by afuchs@common-lisp.net
24 Sep '05
24 Sep '05
Update of /project/beirc/cvsroot/beirc In directory common-lisp.net:/tmp/cvs-serv11001 Modified Files: beirc.lisp message-display.lisp Log Message: * refactor message faking * fix display of irc-MODE-messages that deal with user modes * rework /topic to display the topic if no string is passed * add presentation type CHANNEL and an accept method so that /join doesn't do stupid things anymore on empty input. * add minimal receiver closing functionality. Date: Sat Sep 24 19:28:38
…
[View More]
2005 Author: afuchs Index: beirc/beirc.lisp diff -u beirc/beirc.lisp:1.22 beirc/beirc.lisp:1.23 --- beirc/beirc.lisp:1.22 Sat Sep 24 17:04:06 2005 +++ beirc/beirc.lisp Sat Sep 24 19:28:38 2005 @@ -121,6 +121,10 @@ (setf (gethash name (receivers frame)) receiver) receiver))))) +(defun remove-receiver (receiver frame) + (remove-pane (tab-pane receiver) (find-pane-named frame 'query)) + (remhash (title receiver) (receivers frame))) + (defparameter *network-service-sources* '("nickserv" "memoserv" "chanserv" "") "Sources whose private messages (PRIVMSG, NOTICE, ...) should be treated as if they came from the connected server itself, @@ -177,9 +181,11 @@ (intern-receiver target frame :channel target))) (defmethod receiver-for-message ((message irc:irc-mode-message) frame) - (destructuring-bind (channel modes args) (irc:arguments message) - (declare (ignore modes args)) - (intern-receiver channel frame :channel channel))) + (case (length (irc:arguments message)) + (1 (server-receiver frame)) + (3 (destructuring-bind (channel modes args) (irc:arguments message) + (declare (ignore modes args)) + (intern-receiver channel frame :channel channel))))) (macrolet ((define-ignore-message-types (&rest mtypes) `(progn @@ -244,7 +250,6 @@ ;;; KLUDGE: workaround for mcclim bug "Application pane vertical ;;; scrolling does not work with table formatting" - (defclass redisplay-frame-mixin () ()) @@ -469,12 +474,31 @@ (format t "~A" o))) (format t "~A" o))) +(define-presentation-type channel () :inherit-from 'string) + +(define-presentation-method presentation-typep (object (type channel)) + (channelp object)) + +(defun channelp (channel) + (and (stringp channel) + (> (length channel) 2) + (not (null (member (char channel 0) '(#\# #\+ #\! #\&)))))) + +(define-presentation-method accept ((type channel) *standard-input* (view textual-view) &key) + (let ((channel (accept 'string :view view :prompt nil))) + (if (not (presentation-typep channel 'channel)) + (input-not-of-required-type channel 'channel) + channel))) + (define-beirc-command (com-query :name t) ((nick 'nickname :prompt "who")) (raise-receiver (intern-receiver nick *application-frame* :query nick))) (define-beirc-command (com-raise :name t) ((receiver 'receiver :prompt "receiver")) (raise-receiver receiver)) +(define-beirc-command (com-close :name t) ((receiver 'receiver :prompt "receiver")) + (remove-receiver receiver *application-frame*)) + (define-beirc-command (com-focus :name t) ((who 'nickname :prompt "who")) (pushnew who (current-focused-nicks) :test #'string=)) @@ -495,8 +519,30 @@ (when (eql status :external) (apply symbol (current-connection *application-frame*) (coerce args 'list))))) -(define-beirc-command (com-topic :name t) ((topic 'mumble :prompt "topic")) - (irc:topic- (current-connection *application-frame*) (target) topic)) +(defun make-fake-irc-message (message-type &key command arguments + (source (slot-value *application-frame* 'nick)) + trailing-argument) + (make-instance message-type + :received-time (get-universal-time) + :connection :local + :trailing-argument trailing-argument + :arguments arguments + :command command + :HOST "localhost" + :USER "localuser" + :SOURCE source)) + +(define-beirc-command (com-topic :name t) (&key (topic 'mumble :prompt "New topic")) + (if (and (not (string= topic ""))) + (irc:topic- (current-connection *application-frame*) (target) topic) + (post-message *application-frame* + (make-fake-irc-message 'irc:irc-rpl_topic-message + :command "332" + :arguments `("=" ,(target)) + :trailing-argument (irc:topic + (irc:find-channel + (current-connection *application-frame*) + (target))))))) (define-beirc-command (com-op :name t) ((who 'nickname :prompt "who")) (irc:op (current-connection *application-frame*) (target) who)) @@ -523,16 +569,10 @@ (define-beirc-command (com-say :name t) ((what 'mumble)) ;; make a fake IRC-PRIV-MESSAGE object (post-message *application-frame* - (make-instance 'irc:irc-privmsg-message - :received-time (get-universal-time) - :connection :local - :trailing-argument what - :arguments (list (target)) - :command "PRIVMSG" - :HOST "localhost" - :USER "localuser" - :SOURCE (slot-value *application-frame* 'nick) - )) + (make-fake-irc-message 'irc:irc-privmsg-message + :trailing-argument what + :arguments (list (target)) + :command "PRIVMSG")) (irc:privmsg (current-connection *application-frame*) (target) what)) (define-beirc-command (com-nick :name t) ((new-nick 'string :prompt "new nick")) @@ -581,7 +621,7 @@ (presentation) (list (presentation-object presentation))) -(define-beirc-command (com-join :name t) ((channel 'string :prompt "channel")) +(define-beirc-command (com-join :name t) ((channel 'channel :prompt "channel")) (raise-receiver (intern-receiver channel *application-frame* :channel channel)) (irc:join (current-connection *application-frame*) channel)) @@ -609,26 +649,18 @@ :name "IRC Message Muffling Loop")) ))))) (defun disconnect (frame) - (let ((old-nickname (slot-value frame 'nick))) - (raise-receiver (server-receiver frame)) - (post-message frame - (make-instance 'irc:irc-quit-message - :received-time (get-universal-time) - :connection :local - :trailing-argument - (format nil "You disconnected from IRC") - :arguments nil - :command "QUIT" - :host "localhost" ;### - :user "localuser" ;### - :source old-nickname)) - (when (and (connection-process frame) - (not (eql (clim-sys:current-process) - (connection-process frame)))) - (destroy-process (connection-process frame))) - (setf (slot-value frame 'connection) nil - (connection-process frame) nil - (slot-value frame 'nick) nil))) + (raise-receiver (server-receiver frame)) + (post-message frame + (make-fake-irc-message 'irc:irc-quit-message + :trailing-argument "You disconnected from IRC" + :command "QUIT")) + (when (and (connection-process frame) + (not (eql (clim-sys:current-process) + (connection-process frame)))) + (destroy-process (connection-process frame))) + (setf (slot-value frame 'connection) nil + (connection-process frame) nil + (slot-value frame 'nick) nil)) (defun quit (frame reason) (raise-receiver (server-receiver frame)) @@ -725,32 +757,22 @@ (write-char (read-char) bag))))))) (define-beirc-command (com-me :name t) ((what 'mumble)) - (with-slots (connection nick) *application-frame* - (let ((m (make-instance 'irc:ctcp-action-message - :received-time (get-universal-time) - :connection :local - :trailing-argument - (format nil "~AACTION ~A~A" (code-char 1) what (code-char 1)) - :arguments (list (target)) - :command "PRIVMSG" - :host "localhost" ;### - :user "localuser" ;### - :source nick))) ;### + (with-slots (connection) *application-frame* + (let ((m (make-fake-irc-message 'irc:ctcp-action-message + :trailing-argument + (format nil "~AACTION ~A~A" (code-char 1) what (code-char 1)) + :arguments (list (target)) + :command "PRIVMSG"))) ;### (post-message *application-frame* m) (irc:privmsg connection (target) (format nil "~AACTION ~A~A" (code-char 1) what (code-char 1)))))) (defun send-private-message (target what) (post-message *application-frame* - (make-instance 'irc:irc-privmsg-message - :received-time (get-universal-time) - :connection :local - :trailing-argument what - :arguments (list target) - :command "PRIVMSG" - :HOST "localhost" - :USER "localuser" - :SOURCE (slot-value *application-frame* 'nick) )) + (make-fake-irc-message 'irc:irc-privmsg-message + :trailing-argument what + :arguments (list target) + :command "PRIVMSG")) (irc:privmsg (current-connection *application-frame*) target what)) (define-beirc-command (com-msg :name t) Index: beirc/message-display.lisp diff -u beirc/message-display.lisp:1.9 beirc/message-display.lisp:1.10 --- beirc/message-display.lisp:1.9 Sat Sep 24 17:04:06 2005 +++ beirc/message-display.lisp Sat Sep 24 19:28:38 2005 @@ -206,13 +206,20 @@ (format t " left ~A: ~A" (first (irc:arguments message)) (irc:trailing-argument message)))))) (defmethod print-message ((message irc:irc-mode-message) receiver) - (destructuring-bind (target modes args) (irc:arguments message) - (declare (ignore target)) - (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))))))) + (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)) + (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))))))))) (defmethod print-message ((message irc:irc-rpl_motd-message) receiver) (formatting-message (t message receiver)
[View Less]
1
0
0
0
[beirc-cvs] CVS update: beirc/beirc.lisp beirc/message-display.lisp
by afuchs@common-lisp.net
24 Sep '05
24 Sep '05
Update of /project/beirc/cvsroot/beirc In directory common-lisp.net:/tmp/cvs-serv1363 Modified Files: beirc.lisp message-display.lisp Log Message: further printing / command features: * don't print "end of <anything>" replies from the server. * add a /topic, /names, /op, /deop command. * add a method to print irc-mode-messages. Date: Sat Sep 24 17:04:07 2005 Author: afuchs Index: beirc/beirc.lisp diff -u beirc/beirc.lisp:1.21 beirc/beirc.lisp:1.22 --- beirc/beirc.lisp:1.21 Sat
…
[View More]
Sep 24 16:36:31 2005 +++ beirc/beirc.lisp Sat Sep 24 17:04:06 2005 @@ -176,6 +176,34 @@ (let ((target (first (irc:arguments message)))) (intern-receiver target frame :channel target))) +(defmethod receiver-for-message ((message irc:irc-mode-message) frame) + (destructuring-bind (channel modes args) (irc:arguments message) + (declare (ignore modes args)) + (intern-receiver channel frame :channel channel))) + +(macrolet ((define-ignore-message-types (&rest mtypes) + `(progn + ,@(loop for mtype in mtypes + collect `(defmethod receiver-for-message ((message ,mtype) frame) + nil))))) + (define-ignore-message-types cl-irc:irc-rpl_endofwhowas-message + cl-irc:irc-rpl_endoflinks-message + cl-irc:irc-rpl_endoptions-message + cl-irc:irc-rpl_endofwhois-message + cl-irc:irc-rpl_endsitelist-message + cl-irc:irc-rpl_endofinvitelist-message + cl-irc:irc-rpl_endofservices-message + cl-irc:irc-rpl_endmode-message + cl-irc:irc-rpl_endofmap-message + cl-irc:irc-rpl_endofnames-message + cl-irc:irc-rpl_endofusers-message + cl-irc:irc-rpl_endofbanlist-message + cl-irc:irc-rpl_endofmotd-message + cl-irc:irc-rpl_endofinfo-message + cl-irc:irc-rpl_endofstats-message + cl-irc:irc-rpl_endofwho-message + cl-irc:irc-rpl_endofexceptlist-message)) + (defmethod receiver-for-message ((message irc:irc-message) frame) (server-receiver frame)) @@ -463,9 +491,21 @@ (define-beirc-command (com-eval :name t) ((command 'string :prompt "command") (args '(sequence string) :prompt "arguments")) - (multiple-value-bind (symbol status) (find-symbol command :irc) + (multiple-value-bind (symbol status) (find-symbol (string-upcase command) :irc) (when (eql status :external) (apply symbol (current-connection *application-frame*) (coerce args 'list))))) + +(define-beirc-command (com-topic :name t) ((topic 'mumble :prompt "topic")) + (irc:topic- (current-connection *application-frame*) (target) topic)) + +(define-beirc-command (com-op :name t) ((who 'nickname :prompt "who")) + (irc:op (current-connection *application-frame*) (target) who)) + +(define-beirc-command (com-deop :name t) ((who 'nickname :prompt "who")) + (irc:deop (current-connection *application-frame*) (target) who)) + +(define-beirc-command (com-names :name t) () + (irc:names (current-connection *application-frame*) (target))) (define-beirc-command (com-quit :name t) ((reason 'mumble :prompt "reason")) (when (current-connection *application-frame*) Index: beirc/message-display.lisp diff -u beirc/message-display.lisp:1.8 beirc/message-display.lisp:1.9 --- beirc/message-display.lisp:1.8 Sat Sep 24 16:36:31 2005 +++ beirc/message-display.lisp Sat Sep 24 17:04:06 2005 @@ -205,6 +205,15 @@ (present (irc:source message) 'nickname) (format t " left ~A: ~A" (first (irc:arguments message)) (irc:trailing-argument message)))))) +(defmethod print-message ((message irc:irc-mode-message) receiver) + (destructuring-bind (target modes args) (irc:arguments message) + (declare (ignore target)) + (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))))))) + (defmethod print-message ((message irc:irc-rpl_motd-message) receiver) (formatting-message (t message receiver) ((format t "~A" (irc:source message)))
[View Less]
1
0
0
0
[beirc-cvs] CVS update: beirc/beirc.lisp beirc/message-display.lisp
by afuchs@common-lisp.net
24 Sep '05
24 Sep '05
Update of /project/beirc/cvsroot/beirc In directory common-lisp.net:/tmp/cvs-serv31756 Modified Files: beirc.lisp message-display.lisp Log Message: Handle printing of the server's MOTD. Add an /Eval command to debug cl-irc commands. Date: Sat Sep 24 16:36:32 2005 Author: afuchs Index: beirc/beirc.lisp diff -u beirc/beirc.lisp:1.20 beirc/beirc.lisp:1.21 --- beirc/beirc.lisp:1.20 Sat Sep 24 13:43:37 2005 +++ beirc/beirc.lisp Sat Sep 24 16:36:31 2005 @@ -461,6 +461,12 @@ (setf (current-
…
[View More]
focused-nicks) (remove who (current-focused-nicks) :test #'string=))) +(define-beirc-command (com-eval :name t) ((command 'string :prompt "command") + (args '(sequence string) :prompt "arguments")) + (multiple-value-bind (symbol status) (find-symbol command :irc) + (when (eql status :external) + (apply symbol (current-connection *application-frame*) (coerce args 'list))))) + (define-beirc-command (com-quit :name t) ((reason 'mumble :prompt "reason")) (when (current-connection *application-frame*) (quit *application-frame* reason)) Index: beirc/message-display.lisp diff -u beirc/message-display.lisp:1.7 beirc/message-display.lisp:1.8 --- beirc/message-display.lisp:1.7 Sat Sep 24 11:14:03 2005 +++ beirc/message-display.lisp Sat Sep 24 16:36:31 2005 @@ -205,6 +205,12 @@ (present (irc:source message) 'nickname) (format t " left ~A: ~A" (first (irc:arguments message)) (irc:trailing-argument message)))))) +(defmethod print-message ((message irc:irc-rpl_motd-message) receiver) + (formatting-message (t message receiver) + ((format t "~A" (irc:source message))) + ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small) + (format t "MOTD: ~A" (irc:trailing-argument message)))))) + (defmethod print-message (message receiver) (formatting-message (t message receiver) ((format t "!!! ~A" (irc:source message)))
[View Less]
1
0
0
0
[beirc-cvs] CVS update: beirc/beirc.lisp
by afuchs@common-lisp.net
24 Sep '05
24 Sep '05
Update of /project/beirc/cvsroot/beirc In directory common-lisp.net:/tmp/cvs-serv19320 Modified Files: beirc.lisp Log Message: fix NOTICE handling, including network service notices. also, revert the TICKER function back to its old self; the handler-case in there served no purpose. Date: Sat Sep 24 13:43:37 2005 Author: afuchs Index: beirc/beirc.lisp diff -u beirc/beirc.lisp:1.19 beirc/beirc.lisp:1.20 --- beirc/beirc.lisp:1.19 Sat Sep 24 11:14:03 2005 +++ beirc/beirc.lisp Sat Sep 24 13:
…
[View More]
43:37 2005 @@ -97,13 +97,17 @@ (add-pane (tab-pane receiver) (find-pane-named frame 'query)))) (setf (gethash (tab-pane receiver) (tab-panes-to-receivers frame)) receiver)) +(defun find-receiver (name frame) + (gethash (irc:normalize-channel-name (slot-value frame 'connection) name) + (receivers frame))) + (defun intern-receiver (name frame &rest initargs) - (let ((rec (gethash (irc:normalize-channel-name (slot-value frame 'connection) name) - (receivers frame)))) + (let* ((normalized-name (irc:normalize-channel-name (slot-value frame 'connection) name)) + (rec (find-receiver name frame))) (if rec rec (let ((*application-frame* frame)) - (let ((receiver (apply 'make-paneless-receiver name initargs))) + (let ((receiver (apply 'make-paneless-receiver normalized-name initargs))) (initialize-receiver-with-pane receiver frame (with-look-and-feel-realization ((frame-manager *application-frame*) *application-frame*) @@ -117,20 +121,35 @@ (setf (gethash name (receivers frame)) receiver) receiver))))) +(defparameter *network-service-sources* '("nickserv" "memoserv" "chanserv" "") + "Sources whose private messages (PRIVMSG, NOTICE, ...) should + be treated as if they came from the connected server itself, + unless the user has opened a query window to the source + already.") + +(defun network-service-p (source frame) + (member source *network-service-sources* + :test (lambda (source1 source2) + (string= (irc:normalize-nickname (current-connection frame) source1) + (irc:normalize-nickname (current-connection frame) source2))))) + (macrolet ((define-privmsg-receiver-lookup (message-type) `(defmethod receiver-for-message ((message ,message-type) frame) - (let* ((mynick (irc:normalize-nickname (slot-value frame 'connection) - (slot-value frame 'nick))) - (nominal-target (irc:normalize-channel-name (slot-value frame 'connection) - (first (irc:arguments message)))) - (target (if (equal nominal-target mynick) - (irc:source message) - nominal-target))) - (intern-receiver target frame :channel target))))) + (if (or + (find-receiver (irc:source message) frame) + (not (network-service-p (irc:source message) frame))) + (let* ((mynick (irc:normalize-nickname (current-connection frame) + (slot-value frame 'nick))) + (nominal-target (irc:normalize-channel-name (slot-value frame 'connection) + (first (irc:arguments message)))) + (target (if (equal nominal-target mynick) + (irc:source message) + nominal-target))) + (intern-receiver target frame :channel target)) + (server-receiver frame))))) (define-privmsg-receiver-lookup irc:irc-privmsg-message) (define-privmsg-receiver-lookup irc:ctcp-action-message) - ;; (define-privmsg-receiver-lookup irc:irc-notice-message) ; XXX: NOTICEs in freenode are a bit tricky. - ) + (define-privmsg-receiver-lookup irc:irc-notice-message)) (macrolet ((define-global-message-receiver-lookup (message-type) `(defmethod receiver-for-message ((message ,message-type) frame) @@ -361,28 +380,24 @@ (defun post-message (frame message) (let ((receiver (receiver-for-message message frame))) - (setf (messages receiver) - (append (messages receiver) (list message))) - (unless (eql receiver (current-receiver frame)) - (incf (unseen-messages receiver)) - (when (message-directed-to-me-p frame message) - (incf (messages-directed-to-me receiver)))) - (update-drawing-options receiver) - (clim-internals::event-queue-prepend - (climi::frame-event-queue frame) - (make-instance 'foo-event :sheet frame :receiver receiver)) - nil)) + (unless (null receiver) + (setf (messages receiver) + (append (messages receiver) (list message))) + (unless (eql receiver (current-receiver frame)) + (incf (unseen-messages receiver)) + (when (message-directed-to-me-p frame message) + (incf (messages-directed-to-me receiver)))) + (update-drawing-options receiver) + (clim-internals::event-queue-prepend + (climi::frame-event-queue frame) + (make-instance 'foo-event :sheet frame :receiver receiver)) + nil))) -;;; XXX: ticker continues to run even if the frame is no longer active -;;; or on the display. (defun ticker (frame) - (handler-case - (loop - (clim-internals::event-queue-prepend (climi::frame-event-queue frame) - (make-instance 'bar-event :sheet frame)) - (sleep 1)) - (frame-exit () - nil))) + (loop + (clim-internals::event-queue-prepend (climi::frame-event-queue frame) + (make-instance 'bar-event :sheet frame)) + (sleep 1))) (define-presentation-type nickname ()) (define-presentation-type ignored-nickname (nickname))
[View Less]
1
0
0
0
[beirc-cvs] CVS update: beirc/beirc.lisp beirc/message-display.lisp
by afuchs@common-lisp.net
24 Sep '05
24 Sep '05
Update of /project/beirc/cvsroot/beirc In directory common-lisp.net:/tmp/cvs-serv8786 Modified Files: beirc.lisp message-display.lisp Log Message: Fix /quit, /disconnect commands and quitting the irc worker thread. * /quit, /disconnect and later /connect commands now work, hopefully in all combinations. * This change also introduces a level of thread hygiene. When beirc's application frame exits, every thread (except the clim/clx listener thread) should be killed as well. Date:
…
[View More]
Sat Sep 24 11:14:04 2005 Author: afuchs Index: beirc/beirc.lisp diff -u beirc/beirc.lisp:1.18 beirc/beirc.lisp:1.19 --- beirc/beirc.lisp:1.18 Sat Sep 24 01:22:50 2005 +++ beirc/beirc.lisp Sat Sep 24 11:14:03 2005 @@ -190,7 +190,6 @@ (setf (messages-directed-to-me receiver) 0) (update-drawing-options receiver)))) - (defun raise-receiver (receiver) (setf (unseen-messages receiver) 0) (setf (messages-directed-to-me receiver) 0) @@ -211,6 +210,7 @@ (define-application-frame beirc (redisplay-frame-mixin standard-application-frame) ((connection :initform nil :reader current-connection) + (connection-process :initform nil :accessor connection-process) (nick :initform nil) (ignored-nicks :initform nil) (receivers :initform (make-hash-table :test #'equal) :accessor receivers) @@ -347,11 +347,12 @@ (clim-sys:make-process (lambda () (progv syms vals - (let ((frame (make-application-frame 'beirc))) + (let* ((frame (make-application-frame 'beirc)) + (ticker-process (clim-sys:make-process (lambda () (ticker frame)) + :name "Beirc Ticker"))) (setf *beirc-frame* frame) - (clim-sys:make-process (lambda () (ticker frame)) - :name "Beirc Ticker") - (run-frame-top-level frame)))))))) + (run-frame-top-level frame) + (clim-sys:destroy-process ticker-process)))))))) (defun message-directed-to-me-p (frame message) (let ((my-nick (slot-value frame 'nick)) @@ -372,11 +373,16 @@ (make-instance 'foo-event :sheet frame :receiver receiver)) nil)) +;;; XXX: ticker continues to run even if the frame is no longer active +;;; or on the display. (defun ticker (frame) - (loop - (clim-internals::event-queue-prepend (climi::frame-event-queue frame) - (make-instance 'bar-event :sheet frame)) - (sleep 1))) + (handler-case + (loop + (clim-internals::event-queue-prepend (climi::frame-event-queue frame) + (make-instance 'bar-event :sheet frame)) + (sleep 1)) + (frame-exit () + nil))) (define-presentation-type nickname ()) (define-presentation-type ignored-nickname (nickname)) @@ -406,7 +412,8 @@ (find-in-tab-panes-list object 'tab-layout-pane))) (defun nick-equals-my-nick-p (nickname) - (and *application-frame* + (and (not (null *application-frame*)) + (not (null (slot-value *application-frame* 'connection))) (equal (irc:normalize-nickname (current-connection *application-frame*) (slot-value *application-frame* 'nick)) (irc:normalize-nickname (current-connection *application-frame*) @@ -440,7 +447,13 @@ (remove who (current-focused-nicks) :test #'string=))) (define-beirc-command (com-quit :name t) ((reason 'mumble :prompt "reason")) - (irc:quit (current-connection *application-frame*) reason)) + (when (current-connection *application-frame*) + (quit *application-frame* reason)) + (frame-exit *application-frame*)) + +(define-beirc-command (com-disconnect :name t) ((reason 'mumble :prompt "reason")) + (when (current-connection *application-frame*) + (quit *application-frame* reason))) (defun target (&optional (*application-frame* *application-frame*)) (or (current-query) @@ -527,9 +540,45 @@ (find-pane-named frame 'server) :add-pane-p nil) (setf (gethash "*Server*" (receivers frame)) (server-receiver frame)) - (clim-sys:make-process #'(lambda () - (irc-event-loop frame connection)) - :name "IRC Message Muffling Loop") ))))) + (setf (connection-process *application-frame*) + (clim-sys:make-process #'(lambda () + (unwind-protect + (irc-event-loop frame connection) + (disconnect frame))) + :name "IRC Message Muffling Loop")) ))))) + +(defun disconnect (frame) + (let ((old-nickname (slot-value frame 'nick))) + (raise-receiver (server-receiver frame)) + (post-message frame + (make-instance 'irc:irc-quit-message + :received-time (get-universal-time) + :connection :local + :trailing-argument + (format nil "You disconnected from IRC") + :arguments nil + :command "QUIT" + :host "localhost" ;### + :user "localuser" ;### + :source old-nickname)) + (when (and (connection-process frame) + (not (eql (clim-sys:current-process) + (connection-process frame)))) + (destroy-process (connection-process frame))) + (setf (slot-value frame 'connection) nil + (connection-process frame) nil + (slot-value frame 'nick) nil))) + +(defun quit (frame reason) + (raise-receiver (server-receiver frame)) + (irc:quit (current-connection frame) reason) + (when (and (connection-process frame) + (not (eql (clim-sys:current-process) + (connection-process frame)))) + (destroy-process (connection-process frame))) + (setf (slot-value frame 'connection) nil + (connection-process frame) nil + (slot-value frame 'nick) nil)) (defmethod clim:read-frame-command ((frame beirc) &key (stream *standard-input*)) (multiple-value-prog1 @@ -544,12 +593,10 @@ (window-clear stream))) (defun restart-beirc () - (let ((m (current-messages))) - (clim-sys:destroy-process *gui-process*) - (setf *beirc-frame* nil) - (beirc) - (clim-sys:process-wait "waiting for beirc" (lambda () *beirc-frame*)) - (setf (current-messages) m))) + (clim-sys:destroy-process *gui-process*) + (setf *beirc-frame* nil) + (beirc) + (clim-sys:process-wait "waiting for beirc" (lambda () *beirc-frame*))) ;;;;;;;;; Index: beirc/message-display.lisp diff -u beirc/message-display.lisp:1.6 beirc/message-display.lisp:1.7 --- beirc/message-display.lisp:1.6 Sat Sep 24 01:04:21 2005 +++ beirc/message-display.lisp Sat Sep 24 11:14:03 2005 @@ -103,7 +103,8 @@ (present-url word%)) ((or (nick-equals-my-nick-p word%) - (irc:find-user (current-connection *application-frame*) word%)) + (and (current-connection *application-frame*) + (irc:find-user (current-connection *application-frame*) word%))) (present word% 'nickname)) (t (write-string word%))) (write-string stripped-punctuation)))
[View Less]
1
0
0
0
← Newer
1
...
12
13
14
15
16
17
Older →
Jump to page:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Results per page:
10
25
50
100
200