Update of /project/beirc/cvsroot/beirc In directory clnet:/tmp/cvs-serv13160

Modified Files: application.lisp Log Message: oops. Input saving won't work without a receiver object.

--- /project/beirc/cvsroot/beirc/application.lisp 2006/03/06 10:25:00 1.50 +++ /project/beirc/cvsroot/beirc/application.lisp 2006/03/06 17:41:32 1.51 @@ -805,12 +805,13 @@ ;;; irc command and mumble reading

(defun save-input-line (stream frame) - (let ((buffer (stream-input-buffer stream))) - (setf (incomplete-input (current-receiver frame)) - (with-output-to-string (s) - (loop for elt across buffer - if (characterp elt) - do (write-char elt s)))))) + (when (current-receiver frame) + (let ((buffer (stream-input-buffer stream))) + (setf (incomplete-input (current-receiver frame)) + (with-output-to-string (s) + (loop for elt across buffer + if (characterp elt) + do (write-char elt s)))))))

(define-condition invoked-command-by-clicking () () @@ -856,45 +857,48 @@ (defmethod read-frame-command ((frame beirc) &key (stream *standard-input*)) (multiple-value-prog1 (clim:with-input-editing (stream) - (when (incomplete-input (current-receiver frame)) + (when (and (current-receiver frame) (incomplete-input (current-receiver frame))) (replace-input stream (incomplete-input (current-receiver frame)) :rescan t)) (with-input-context ('command) (object) (with-command-table-keystrokes (*accelerator-gestures* (frame-command-table frame)) (catch 'keystroke-command (let ((force-restore-input-state nil)) - (handler-bind ((accelerator-gesture - (lambda (gesture) - (save-input-line stream frame) - (throw 'keystroke-command (lookup-keystroke-command-item - (accelerator-gesture-event gesture) - (frame-command-table frame))))) - (abort-gesture - (lambda (gesture) - (declare (ignore gesture)) - (setf (incomplete-input (current-receiver frame)) "" - force-restore-input-state nil))) - (invoked-command-by-clicking - (lambda (cond) - (declare (ignore cond)) - (save-input-line stream frame) - (setf force-restore-input-state t) - (invoke-restart 'acknowledged)))) - (let ((c (clim:read-gesture :stream stream :peek-p t))) - (multiple-value-prog1 - (cond ((eql c #/) - (clim:read-gesture :stream stream) - ;; XXX: when accepting commands, the - ;; input buffer line will not be saved - ;; if the user selects a command or - ;; presentation-translated-to-a-command. - ;; - ;; maybe using *pointer-button-press-handler* could work. - (accept 'command :stream stream :prompt nil)) - (t - (list 'com-say (accept 'mumble :history 'mumble :prompt nil :stream stream)))) - (if force-restore-input-state - (setf force-restore-input-state nil) - (setf (incomplete-input (current-receiver frame)) "")))))))) + (labels ((reset-saved-input () + (when (current-receiver frame) + (setf (incomplete-input (current-receiver frame)) "")))) + (handler-bind ((accelerator-gesture + (lambda (gesture) + (save-input-line stream frame) + (throw 'keystroke-command (lookup-keystroke-command-item + (accelerator-gesture-event gesture) + (frame-command-table frame))))) + (abort-gesture + (lambda (gesture) + (declare (ignore gesture)) + (reset-saved-input) + (setf force-restore-input-state nil))) + (invoked-command-by-clicking + (lambda (cond) + (declare (ignore cond)) + (save-input-line stream frame) + (setf force-restore-input-state t) + (invoke-restart 'acknowledged)))) + (let ((c (clim:read-gesture :stream stream :peek-p t))) + (multiple-value-prog1 + (cond ((eql c #/) + (clim:read-gesture :stream stream) + ;; XXX: when accepting commands, the + ;; input buffer line will not be saved + ;; if the user selects a command or + ;; presentation-translated-to-a-command. + ;; + ;; maybe using *pointer-button-press-handler* could work. + (accept 'command :stream stream :prompt nil)) + (t + (list 'com-say (accept 'mumble :history 'mumble :prompt nil :stream stream)))) + (if force-restore-input-state + (setf force-restore-input-state nil) + (reset-saved-input))))))))) (command (save-input-line stream frame) object)))