anchor.diff:      (setf (joined-channels irc) (remove (current-channel irc) (joined-channels irc)))
       (setf (current-channel irc) (first (joined-channels irc)))))
   
  -(defun irc-top-level (irc)
  -  (let ((*standard-input* irc)
  -        (*standard-output* (irc-display irc))
  -        (*error-output* (irc-display irc))
  -        ;; This isn't great... No line editing.
  -        (*query-io* (make-two-way-stream irc (irc-display irc)))
  -        (*debug-io* (make-two-way-stream irc (irc-display irc))))
  -    (unwind-protect
  -         (handler-case
  -             (loop (format irc "~A] " (or (current-channel irc) "")) ; write prompt to the input line. (ugh!)
  -                (let ((line (read-line)))
  -                  (sys.int::stream-move-to irc 0 0)
  -                  (cond ((and (>= (length line) 1)
  -                              (eql (char line 0) #\/)
  -                              (not (and (>= (length line) 2)
  -                                        (eql (char line 1) #\/))))
  -                         (multiple-value-bind (command rest)
  -                             (parse-command line)
  -                           (let ((fn (gethash (string-upcase command) *top-level-commands*)))
  -                             (if fn
  -                                 (with-simple-restart (abort "Abort evaulation and return to IRC.")
  -                                   (funcall fn irc rest))
  -                                 (format t "Unknown command ~S.~%" command)))))
  -                        ((current-channel irc)
  -                         (format t "[~A]<~A> ~A~%" (current-channel irc) (nickname irc) line)
  -                         (send (irc-connection irc) "PRIVMSG ~A :~A~%" (current-channel irc) line)))))
  -           (quit-irc ()))
  -      (sys.int::process-disable (irc-receive-process irc))
  -      (when (irc-connection irc)
  -        (close (irc-connection irc)))
  -      (sys.graphics::close-window irc))))
  -
  -(defun create-irc-client ()
  -  "Open an IRC window."
  -  ;; 400 = 24 8 pixel tall characters for the display.
  -  ;; 1 pixel for the seperator line.
  -  ;; 8 pixels for the input line.
  -  (sys.graphics::window-set-visibility (sys.graphics::make-window "IRC" 640 (+ 400 1 8) 'irc-client) t))
  -
  -(setf (gethash (name-char "F2") sys.graphics::*global-keybindings*) 'create-irc-client)
  +(defmacro with-window ((window fifo width height &rest options) &body body)
  +  `(let (,window)
  +     (unwind-protect
  +          (progn (setf ,window (mezzanine.gui.compositor:make-window ,fifo ,width ,height ,@options))
  +                 ,@body)
  +       (when ,window
  +         (mezzanine.gui.compositor:close-window ,window)))))
  +
  +(defclass irc-client ()
  +  ((%fifo :initarg :fifo :reader fifo)
  +   (%window :initarg :window :reader window)
  +   (%frame :initarg :frame :reader frame)
  +   (%display-pane :initarg :display-pane :reader display-pane)
  +   (%input-pane :initarg :input-pane :reader input-pane)
  +   (%input-buffer :initarg :input-buffer :accessor input-buffer)
  +   (%current-channel :initarg :current-channel :accessor current-channel)
  +   (%joined-channels :initarg :joined-channels :accessor joined-channels)
  +   (%nickname :initarg :nickname :accessor nickname)
  +   (%connection :initarg :connection :accessor irc-connection)
  +   (%receive-thread :initarg :receive-thread :accessor receive-thread))
  +  (:default-initargs :current-channel nil :joined-channels '() :nickname nil :connection nil))
  +
  +(defun reset-input (irc)
  +  (setf (input-buffer irc) (make-array 100 :element-type 'character :adjustable t :fill-pointer 0))
  +  (mezzanine.gui.widgets:reset (input-pane irc))
  +  (format (input-pane irc) "~A] " (or (current-channel irc) "")))
  +
  +(defgeneric dispatch-event (irc event)
  +  (:method (irc event)))
  +
  +(defmethod dispatch-event (irc (event mezzanine.gui.compositor:window-activation-event))
  +  (setf (mezzanine.gui.widgets:activep (frame irc)) (mezzanine.gui.compositor:state event))
  +  (mezzanine.gui.widgets:draw-frame (frame irc))
  +  (mezzanine.gui.compositor:damage-window (window irc)
  +                                          0 0
  +                                          (mezzanine.gui.compositor:width (window irc))
  +                                          (mezzanine.gui.compositor:height (window irc))))
  +
  +(defmethod dispatch-event (irc (event mezzanine.gui.compositor:mouse-event))
  +  (cond ((mezzanine.gui.widgets:in-frame-close-button (frame irc)
  +                                                      (mezzanine.gui.compositor:mouse-x-position event)
  +                                                      (mezzanine.gui.compositor:mouse-y-position event))
  +         (when (not (mezzanine.gui.widgets:close-button-hover (frame irc)))
  +           (setf (mezzanine.gui.widgets:close-button-hover (frame irc)) t)
  +           (mezzanine.gui.widgets:draw-frame (frame irc))
  +           (mezzanine.gui.compositor:damage-window (window irc)
  +                                                   0 0
  +                                                   (mezzanine.gui.compositor:width (window irc))
  +                                                   (mezzanine.gui.compositor:height (window irc))))
  +         ;; Check for close button click.
  +         (when (and (logbitp 0 (mezzanine.gui.compositor:mouse-button-change event))
  +                    ;; Mouse1 up
  +                    (not (logbitp 0 (mezzanine.gui.compositor:mouse-button-state event))))
  +           (throw 'quit nil)))
  +        (t (when (mezzanine.gui.widgets:close-button-hover (frame irc))
  +             (setf (mezzanine.gui.widgets:close-button-hover (frame irc)) nil)
  +             (mezzanine.gui.widgets:draw-frame (frame irc))
  +             (mezzanine.gui.compositor:damage-window (window irc)
  +                                                     0 0
  +                                                     (mezzanine.gui.compositor:width (window irc))
  +                                                     (mezzanine.gui.compositor:height (window irc)))))))
  +
  +(defmethod dispatch-event (irc (event mezzanine.gui.compositor:window-close-event))
  +  (throw 'quit nil))
  +
  +(defmethod dispatch-event (irc (event mezzanine.gui.compositor:key-event))
  +  ;; should filter out strange keys?
  +  (when (not (mezzanine.gui.compositor:key-releasep event))
  +    (let ((ch (mezzanine.gui.compositor:key-key event)))
  +      (cond ((eql ch #\Newline)
  +             (let ((line (input-buffer irc)))
  +               (reset-input irc)
  +               (multiple-value-bind (command rest)
  +                   (parse-command line)
  +                 (let ((fn (gethash (string-upcase command) *top-level-commands*)))
  +                   (if fn
  +                       (funcall fn irc rest)
  +                       (error "Unknown command ~S." command))))))
  +            ((eql ch #\Backspace)
  +             (when (not (zerop (fill-pointer (input-buffer irc))))
  +               (decf (fill-pointer (input-buffer irc)))
  +               (mezzanine.gui.widgets:reset (input-pane irc))
  +               (format (input-pane irc) "~A] ~A" (or (current-channel irc) "") (input-buffer irc))))
  +            (t (vector-push-extend ch (input-buffer irc))
  +               (write-char ch (input-pane irc)))))))
  +
  +(defmethod dispatch-event (irc (event server-disconnect-event))
  +  (format (display-pane irc) "Disconnected.~%"))
  +
  +(defmethod dispatch-event (irc (event server-line-event))
  +  (let ((line (line event)))
  +    (multiple-value-bind (prefix command parameters)
  +        (decode-command line)
  +      (let ((fn (gethash command *command-table*)))
  +        (cond (fn (funcall fn irc prefix parameters))
  +              ((keywordp command)
  +               (format (display-pane irc) "[~A] -!- ~A~%" prefix (car (last parameters))))
  +              ((integerp command)
  +               (format (display-pane irc) "[~A] ~D ~A~%" prefix command parameters))
  +              (t (write-line line (display-pane irc))))))))
  +
  +(defun irc-main ()
  +  (catch 'quit
  +    (mezzanine.gui.font:with-font (font mezzanine.gui.font:*default-monospace-font* mezzanine.gui.font:*default-monospace-font-size*)
  +      (let ((fifo (mezzanine.supervisor:make-fifo 50)))
  +        (with-window (window fifo 640 480)
  +          (let* ((framebuffer (mezzanine.gui.compositor:window-buffer window))
  +                 (frame (make-instance 'mezzanine.gui.widgets:frame
  +                                       :framebuffer framebuffer
  +                                       :title "IRC"
  +                                       :close-button-p t))
  +                 (display-pane (make-instance 'mezzanine.gui.widgets:text-widget
  +                                              :font font
  +                                              :framebuffer framebuffer
  +                                              :x-position (nth-value 0 (mezzanine.gui.widgets:frame-size frame))
  +                                              :y-position (nth-value 2 (mezzanine.gui.widgets:frame-size frame))
  +                                              :width (- (mezzanine.gui.compositor:width window)
  +                                                        (nth-value 0 (mezzanine.gui.widgets:frame-size frame))
  +                                                        (nth-value 1 (mezzanine.gui.widgets:frame-size frame)))
  +                                              :height (- (mezzanine.gui.compositor:height window)
  +                                                         (nth-value 2 (mezzanine.gui.widgets:frame-size frame))
  +                                                         (nth-value 3 (mezzanine.gui.widgets:frame-size frame))
  +                                                         2
  +                                                         (mezzanine.gui.font:line-height font))
  +                                              :damage-function (lambda (&rest args)
  +                                                                 (apply #'mezzanine.gui.compositor:damage-window window args))))
  +                 (input-pane (make-instance 'mezzanine.gui.widgets:text-widget
  +                                            :font font
  +                                            :framebuffer framebuffer
  +                                            :x-position (nth-value 0 (mezzanine.gui.widgets:frame-size frame))
  +                                            :y-position (+ (nth-value 2 (mezzanine.gui.widgets:frame-size frame))
  +                                                           (- (mezzanine.gui.compositor:height window)
  +                                                              (nth-value 2 (mezzanine.gui.widgets:frame-size frame))
  +                                                              (nth-value 3 (mezzanine.gui.widgets:frame-size frame))
  +                                                              (mezzanine.gui.font:line-height font)
  +                                                              1))
  +                                            :width (- (mezzanine.gui.compositor:width window)
  +                                                      (nth-value 0 (mezzanine.gui.widgets:frame-size frame))
  +                                                      (nth-value 1 (mezzanine.gui.widgets:frame-size frame)))
  +                                            :height (mezzanine.gui.font:line-height font)
  +                                            :damage-function (lambda (&rest args)
  +                                                               (apply #'mezzanine.gui.compositor:damage-window window args))))
  +                 (irc (make-instance 'irc-client
  +                                     :fifo fifo
  +                                     :window window
  +                                     :frame frame
  +                                     :display-pane display-pane
  +                                     :input-pane input-pane)))
  +            ;; Line seperating display and input panes.
  +            (mezzanine.gui:bitset 1 (- (mezzanine.gui.compositor:width window)
  +                                       (nth-value 0 (mezzanine.gui.widgets:frame-size frame))
  +                                       (nth-value 1 (mezzanine.gui.widgets:frame-size frame)))
  +                                  #xFF808080
  +                                  framebuffer
  +                                  (+ (nth-value 2 (mezzanine.gui.widgets:frame-size frame))
  +                                     (- (mezzanine.gui.compositor:height window)
  +                                        (nth-value 2 (mezzanine.gui.widgets:frame-size frame))
  +                                        (nth-value 3 (mezzanine.gui.widgets:frame-size frame))
  +                                        (mezzanine.gui.font:line-height font)
  +                                        2))
  +                                  (nth-value 0 (mezzanine.gui.widgets:frame-size frame)))
  +            (mezzanine.gui.widgets:draw-frame frame)
  +            (mezzanine.gui.compositor:damage-window window
  +                                                    0 0
  +                                                    (mezzanine.gui.compositor:width window)
  +                                                    (mezzanine.gui.compositor:height window))
  +            (reset-input irc)
  +            (unwind-protect
  +                 (loop
  +                    (handler-case
  +                        (dispatch-event irc (mezzanine.supervisor:fifo-pop fifo))
  +                      (error (c)
  +                        (ignore-errors
  +                          (format (display-pane irc) "~&Error: ~A~%" c)))))
  +              (when (irc-connection irc)
  +                (close (irc-connection irc))))))))))
  +
  +(defun spawn ()
  +  (mezzanine.supervisor:make-thread 'irc-main
  +                                    :name "IRC"))
  
positive.code:            (values (second known) (third known)))
            (t (error "Unknown server ~S~%" name)))))
  
  (defclass irc-client (sys.graphics::character-input-mixin
                        sys.graphics::window-with-chrome
                        sys.int::simple-edit-mixin
                        sys.gray:fundamental-character-input-stream
                        sys.gray:fundamental-character-output-stream
                        sys.gray:unread-char-mixin)
    ((command-process :reader irc-command-process)
     (receive-process :reader irc-receive-process)
     (connection :initform nil :accessor irc-connection)
     (input :reader irc-input)
     (display :reader irc-display)
     (current-channel :initform nil :accessor current-channel)
     (joined-channels :initform '() :accessor joined-channels)
     (nickname :initarg :nickname :accessor nickname))
    (:default-initargs :nickname nil))
  
  ;;; This is just so the graphics manager knows the display needs an update.
  (defclass irc-display (sys.graphics::text-widget) ())
  (defmethod sys.gray:stream-write-char :after ((stream irc-display) character)
    (setf sys.graphics::*refresh-required* t))
  
  (defmethod initialize-instance :after ((instance irc-client))
    (multiple-value-bind (left right top bottom)
        (sys.graphics::compute-window-margins instance)
      (setf (slot-value instance 'display) (make-instance 'irc-display
                                                          :framebuffer (sys.graphics::window-backbuffer instance)
                                                          :x left
                                                          :y top
                                                          :width (- (array-dimension (sys.graphics::window-backbuffer instance) 1)
                                                                    left right)
                                                          :height (- (array-dimension (sys.graphics::window-backbuffer instance) 0)
                                                                     top bottom 1 16)))
      (setf (slot-value instance 'input) (make-instance 'sys.graphics::text-widget
                                                        :framebuffer (sys.graphics::window-backbuffer instance)
                                                        :x left
                                                        :y (+ top
                                                              (- (array-dimension (sys.graphics::window-backbuffer instance) 0)
                                                                 top bottom 1 16)
                                                              1)
                                                        :width (- (array-dimension (sys.graphics::window-backbuffer instance) 1)
                                                                  left right)
                                                        :height 16)))
    (let ((cmd (sys.int::make-process "IRC command"))
          (rcv (sys.int::make-process "IRC receive")))
      (setf (slot-value instance 'command-process) cmd)
      (setf (slot-value instance 'receive-process) rcv)
      (sys.int::process-preset cmd 'irc-top-level instance)
      (sys.int::process-preset rcv 'irc-receive instance)
      (sys.int::process-enable cmd)))
  
  ;;; The IRC-CLIENT stream is used to read/write from the input line, not from
  ;;; the display.
  ;;; Edit-stream expects the stream to be able to do input and output, so
  ;;; *STANDARD-INPUT* is bound to this stream (with line-editing) and
  ;;; *STANDARD-OUTPUT* is bound to the display text widget (no input).
  ;;; READ-CHAR is provided by Character-Input-Mixin.
  (defmethod sys.gray:stream-write-char ((stream irc-client) character)
    (write-char character (irc-input stream))
    (setf sys.graphics::*refresh-required* t))
  (defmethod sys.gray:stream-start-line-p ((stream irc-client))
    (sys.gray:stream-start-line-p (irc-input stream)))
  (defmethod sys.int::stream-cursor-pos ((stream irc-client))
    (sys.int::stream-cursor-pos (irc-input stream)))
  (defmethod sys.int::stream-move-to ((stream irc-client) x y)
    (sys.int::stream-move-to (irc-input stream) x y))
  (defmethod sys.int::stream-character-width ((stream irc-client) character)
    (sys.int::stream-character-width (irc-input stream) character))
  (defmethod sys.int::stream-compute-motion ((stream irc-client) string &optional (start 0) end initial-x initial-y)
    (sys.int::stream-compute-motion (irc-input stream) string start end initial-x initial-y))
  (defmethod sys.int::stream-clear-between ((stream irc-client) start-x start-y end-x end-y)
    (sys.int::stream-clear-between (irc-input stream) start-x start-y end-x end-y)
    (setf sys.graphics::*refresh-required* t))
  (defmethod sys.gray:stream-line-column ((stream irc-client))
    (sys.gray:stream-line-column (irc-input stream)))
  
  (defmethod sys.graphics::window-close-event ((irc irc-client))
    (sys.int::process-disable (irc-command-process irc))
    (sys.int::process-disable (irc-receive-process irc))
    (when (irc-connection irc)
      (close (irc-connection irc)))
    (sys.graphics::close-window irc))
  
  (defmethod sys.graphics::window-redraw ((window irc-client))
    (multiple-value-bind (left right top bottom)
        (sys.graphics::compute-window-margins window)
      (sys.graphics::bitset (sys.graphics::window-height window) (sys.graphics::window-width window)
                            (sys.graphics::window-background-colour (irc-display window))
                            (sys.graphics::window-backbuffer window) top left)
      (sys.graphics::bitset 1 (sys.graphics::window-width window)
                            (sys.graphics::make-colour :gray)
                            (sys.graphics::window-backbuffer window)
                            (+ top
                               (- (array-dimension (sys.graphics::window-backbuffer window) 0)
                                  top bottom 1 16))
                            left)))
  
  (defun irc-receive (irc)
    (let ((*standard-input* irc)
          (*standard-output* (irc-display irc))
          (*error-output* (irc-display irc))
          (*query-io* (make-two-way-stream irc (irc-display irc)))
          (*debug-io* (make-two-way-stream irc (irc-display irc))))
      ;; Should close the connection here...
      (with-simple-restart (abort "Give up")
        (let ((connection (irc-connection irc)))
          (loop (let ((line (read-line connection)))
                  (multiple-value-bind (prefix command parameters)
                      (decode-command line)
                    (let ((fn (gethash command *command-table*)))
                      (cond (fn (funcall fn irc prefix parameters))
                            ((keywordp command)
                             (format t "[~A] -!- ~A~%" prefix (car (last parameters))))
                            ((integerp command)
                             (format t "[~A] ~D ~A~%" prefix command parameters))
                            (t (write-line line)))))))))))
  
  (defvar *top-level-commands* (make-hash-table :test 'equal))
  
  
negative.code:     (terpri (irc-connection irc))))
  
  (define-command eval (irc text)
    (let ((*standard-output* (display-pane irc)))
      (format t "[eval] ~A~%" text)
      (eval (read-from-string text))
      (fresh-line)))
  
  (define-command say (irc text)
    (cond ((and (irc-connection irc) (current-channel irc))
           (format (display-pane irc) "[~A]<~A> ~A~%" (current-channel irc) (nickname irc) text)
           (send (irc-connection irc) "PRIVMSG ~A :~A~%"
                 (current-channel irc) text))
          (t (error "Not connected or not joined to a channel."))))
  
  (define-command me (irc text)
    (cond ((and (irc-connection irc) (current-channel irc))
           (format (display-pane irc) "[~A]* ~A ~A~%" (current-channel irc) (nickname irc) text)
           (send (irc-connection irc) "PRIVMSG ~A :~AACTION ~A~A~%"
                 (current-channel irc) (code-char 1) text (code-char 1)))
          (t (error "Not connected or not joined to a channel."))))
  
  (define-command nick (irc text)
    (format (display-pane irc) "~&Changing nickname to ~A.~%" text)
    ;; FIXME: Check status.
    (setf (nickname irc) text)
    (when (irc-connection irc)
      (send (irc-connection irc) "NICK ~A~%" (nickname irc))))
  
  (define-command connect (irc text)
    (cond ((not (nickname irc))
           (error "No nickname set. Use /nick to set a nickname before connecting."))
          ((irc-connection irc)
           (error "Already connected to ~S." (irc-connection irc)))
          (t (multiple-value-bind (address port)
                 (resolve-server-name text)
               (format (display-pane irc) "Connecting to ~A (~A:~A).~%" text address port)
               (setf (mezzanine.gui.widgets:frame-title (frame irc)) (format nil "IRC - ~A" text))
               (mezzanine.gui.widgets:draw-frame (frame irc))
               (mezzanine.gui.compositor:damage-window (window irc)
                                                       0 0
                                                       (mezzanine.gui.compositor:width (window irc))
                                                       (mezzanine.gui.compositor:height (window irc)))
               (setf (irc-connection irc) (sys.net::tcp-stream-connect address port)
                     (receive-thread irc) (mezzanine.supervisor:make-thread (lambda () (irc-receive irc))
                                                                            :name "IRC receive"))
               (send (irc-connection irc) "USER ~A hostname servername :~A~%" (nickname irc) (nickname irc))
               (send (irc-connection irc) "NICK ~A~%" (nickname irc))))))
  
  (define-command join (irc text)
    (cond ((find text (joined-channels irc) :test 'string-equal)
           (error "Already joined to channel ~A." text))
          ((irc-connection irc)
           (send (irc-connection irc) "JOIN ~A~%" text)
           (push text (joined-channels irc))
           (unless (current-channel irc)
             (setf (current-channel irc) text)))
          (t (error "Not connected."))))
  
  (define-command chan (irc text)
    (when (irc-connection irc)
      (if (find text (joined-channels irc) :test 'string-equal)
          (setf (current-channel irc) text)
          (error "Not joined to channel ~A." text))))
  
  (define-command part (irc text)
    (when (and (irc-connection irc) (current-channel irc))
  