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 ,@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))