[beirc-cvs] CVS update: beirc/application.lisp beirc/beirc.asd beirc/presentations.lisp

[Andreas Fuchs]

Update of /project/beirc/cvsroot/beirc
In directory common-lisp.net:/tmp/cvs-serv7018

Modified Files:
	application.lisp beirc.asd presentations.lisp 
Log Message:
quit if the application frame is exited with an active connection.

also, rearrange presentations.lisp a bit and add a missing asdf
dependency.


Date: Sun Sep 25 17:48:32 2005
Author: afuchs

Index: beirc/application.lisp
diff -u beirc/application.lisp:1.2 beirc/application.lisp:1.3
--- beirc/application.lisp:1.2	Sun Sep 25 17:09:01 2005
+++ beirc/application.lisp	Sun Sep 25 17:48:32 2005
@@ -224,6 +224,8 @@
                                                              :name "Beirc Ticker")))
                  (setf *beirc-frame* frame)
                  (run-frame-top-level frame)
+                 (unless (null (current-connection frame))
+                   (irc:quit (current-connection frame) "Client Quit"))
                  (clim-sys:destroy-process ticker-process))))))))
 
 (defun message-directed-to-me-p (frame message)
@@ -443,6 +445,19 @@
    (presentation)
   (list (presentation-object presentation)))
 
+(define-presentation-translator receiver-pane-to-receiver-translator
+    (receiver-pane receiver beirc)
+    (object)
+  (receiver-from-tab-pane
+         (find-in-tab-panes-list object 'tab-layout-pane)))
+
+#+(or) ; XXX: for some reason, this translator is activated when accepting NICKNAME.
+(define-presentation-translator nickname-to-hostmask-translator
+    (nickname hostmask beirc)
+    (object)
+  (format nil "*!*@~A" (irc:hostname (irc:find-user (current-connection *application-frame*) object))))
+
+
 (define-beirc-command (com-join :name t) ((channel 'channel :prompt "channel"))
   (raise-receiver (intern-receiver channel *application-frame* :channel channel))
   (irc:join (current-connection *application-frame*) channel))
@@ -587,17 +602,6 @@
     (redisplay-frame-pane (pane-frame pane) pane)))
 
 ;;;;;;
-
-(define-presentation-type mumble ())
-
-(define-presentation-method accept ((type mumble) *standard-input* (view textual-view) &key)
-  (with-output-to-string (bag)
-    (loop
-        (let ((c (peek-char nil)))
-          (cond ((char= c #\newline)
-                 (return))
-                (t
-                 (write-char (read-char) bag)))))))
 
 (define-beirc-command (com-me :name t) ((what 'mumble))
   (with-slots (connection) *application-frame*


Index: beirc/beirc.asd
diff -u beirc/beirc.asd:1.4 beirc/beirc.asd:1.5
--- beirc/beirc.asd:1.4	Sun Sep 25 14:43:52 2005
+++ beirc/beirc.asd	Sun Sep 25 17:48:32 2005
@@ -10,6 +10,6 @@
   :components ((:file "package")
                (:file "variables" :depends-on ("package"))
                (:file "receivers" :depends-on ("package" "variables"))
-               (:file "presentations" :depends-on ("package" "variables"))
+               (:file "presentations" :depends-on ("package" "variables" "receivers"))
                (:file "message-display" :depends-on ("package" "variables" "presentations"))
                (:file "application" :depends-on ("package" "variables" "presentations" "receivers"))))


Index: beirc/presentations.lisp
diff -u beirc/presentations.lisp:1.1 beirc/presentations.lisp:1.2
--- beirc/presentations.lisp:1.1	Sun Sep 25 14:43:52 2005
+++ beirc/presentations.lisp	Sun Sep 25 17:48:32 2005
@@ -1,5 +1,7 @@
 (in-package :beirc)
 
+(define-presentation-type mumble ())
+
 (define-presentation-type nickname ())
 (define-presentation-type unhighlighted-nickname () :inherit-from 'nickname)
 (define-presentation-type ignored-nickname () :inherit-from 'nickname)
@@ -10,6 +12,19 @@
   (maphash (lambda (k v) (push (cons k v) res)) hashtable)
   res)
 
+;;; mumble
+
+(define-presentation-method accept ((type mumble) *standard-input* (view textual-view) &key)
+  (with-output-to-string (bag)
+    (loop
+        (let ((c (peek-char nil)))
+          (cond ((char= c #\newline)
+                 (return))
+                (t
+                 (write-char (read-char) bag)))))))
+
+;;; nicknames
+
 (define-presentation-method accept ((type nickname) *standard-input* (view textual-view) &key)
   (with-slots (connection nick) *application-frame*
     (let ((users (unless (null (current-channel))
@@ -20,23 +35,6 @@
   (with-slots (ignored-nicks) *application-frame*
     (accept `(member , at ignored-nicks) :prompt nil)))
 
-(define-presentation-method accept ((type receiver) *standard-input* (view textual-view) &key)
-  (completing-from-suggestions (*standard-input* :partial-completers '(#\Space))
-    (maphash #'suggest (receivers *application-frame*))))
-
-(define-presentation-translator receiver-pane-to-receiver-translator
-    (receiver-pane receiver beirc)
-    (object)
-  (receiver-from-tab-pane
-         (find-in-tab-panes-list object 'tab-layout-pane)))
-
-;;; XXX: for some reason, this translator is activated when accepting NICKNAME.
-#+(or)
-(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)))
@@ -54,6 +52,14 @@
         (with-text-face (t :bold)
           (write-string o)))
       (write-string o)))
+
+;;; receivers
+
+(define-presentation-method accept ((type receiver) *standard-input* (view textual-view) &key)
+  (completing-from-suggestions (*standard-input* :partial-completers '(#\Space))
+    (maphash #'suggest (receivers *application-frame*))))
+
+;;; channels
 
 (define-presentation-method presentation-typep (object (type channel))
   (channelp object))