Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv5034 Modified Files: core.lisp gui.lisp Log Message: Made typeout windows work again. Now Climacs doesn't primarily deal with the "active view" any more (that was a mistake on my part, typeout windows do not have views, hence this would never work) but the "active window". Not a user-visible change, but fixes typeout windows. --- /project/climacs/cvsroot/climacs/core.lisp 2007/12/08 08:55:06 1.16 +++ /project/climacs/cvsroot/climacs/core.lisp 2007/12/11 23:19:45 1.17 @@ -388,4 +388,4 @@ (error () (progn (beep) (display-message "Invalid answer") (return-from frame-exit nil))))) - (call-next-method))) \ No newline at end of file + (call-next-method))) --- /project/climacs/cvsroot/climacs/gui.lisp 2007/12/10 21:31:09 1.241 +++ /project/climacs/cvsroot/climacs/gui.lisp 2007/12/11 23:19:45 1.242 @@ -97,7 +97,8 @@ (find-if #'(lambda (other-pane) (and (not (eq other-pane pane)) (eq (view other-pane) view))) - (windows (pane-frame pane))))) + (windows (pane-frame pane)))) + (old-view-active (active (view pane)))) (cond ((not (member view (views (pane-frame pane)))) (restart-case (error 'unknown-view :view view) (add-to-view-list () @@ -121,7 +122,9 @@ (pane-frame window-displaying-view) view))) (cancel () :report "Cancel the setting of the windows view and just return"))) - (t (call-next-method))))) + (t (call-next-method))) + (when old-view-active + (ensure-only-view-active (pane-frame pane) view)))) (defmethod (setf view) :before ((view drei-view) (pane climacs-pane)) (with-accessors ((views views)) (pane-frame pane) @@ -299,30 +302,43 @@ (setf (buffer (current-view (esa-current-window application-frame))) new-buffer)) +(defmethod (setf windows) :after (new-val (climacs climacs)) + ;; Ensures that we don't end up with two views that both believe + ;; they are active. + (activate-window (esa-current-window climacs))) + +(defun current-window-p (window) + "Return true if `window' is the current window of its Climacs +instance." + (eq window (esa-current-window (pane-frame window)))) + +(defun ensure-only-view-active (climacs view) + "Ensure that `view' is the only view of `climacs' that is +active." + (dolist (other-view (views climacs)) + (unless (eq other-view view) + (setf (active other-view) nil))) + (setf (active view) t)) + (defmethod (setf views) :around (new-value (frame climacs)) ;; If any windows show a view that no longer exists in the ;; view-list, make them show something else. The view-list might be - ;; destructively updated, so copy it for safekeeping. + ;; destructively updated, so copy it for safekeeping. Also make sure + ;; only one view thinks that it's active. (with-accessors ((views views)) frame (let* ((old-views (copy-list views)) (removed-views (set-difference old-views (call-next-method) :test #'eq))) - (dolist (window (windows frame)) - (when (member (view window) removed-views :test #'eq) + (when (and (typep window 'climacs-pane) + (member (view window) removed-views :test #'eq)) (handler-case (setf (view window) (any-preferably-undisplayed-view)) (view-already-displayed () - (delete-window window))))) - ;; If the active view was removed, we have to designate a new - ;; active view. - (if (find-if #'active removed-views) - (activate-view frame (any-displayed-view)) - ;; Else, we just have to make sure that the active view is - ;; still number one in the list. - (let ((active-view (find-if #'active views))) - (unless (eq active-view (first views)) - (setf views (cons active-view (delete active-view views))))))))) + (delete-window window))))))) + (ensure-only-view-active + frame (when (typep (esa-current-window frame) 'climacs-pane) + (view (esa-current-window frame))))) (defmethod (setf views) :after ((new-value null) (frame climacs)) ;; You think you can remove all views? I laught at your silly @@ -330,11 +346,6 @@ (setf (views frame) (list (make-new-view-for-climacs frame 'textual-drei-syntax-view)))) -(defmethod (setf windows) :after (new-value (frame climacs)) - ;; It may be that the window holding the active view has been - ;; removed, if so, we must activate another view. - (activate-view frame (any-displayed-view))) - (defun make-view-subscript-generator (climacs) #'(lambda (name) (1+ (reduce #'max (remove name (views climacs) @@ -346,8 +357,8 @@ "Clone `view' and add it to `climacs's list of views." (let ((new-view (apply #'clone-view view :subscript-generator (make-view-subscript-generator climacs) - :active nil :syntax (make-syntax-for-view view (class-of (syntax view))) - initargs))) + :active nil initargs))) + (setf (syntax new-view) (make-syntax-for-view new-view (class-of (syntax view)))) (push new-view (views climacs)) new-view)) @@ -366,7 +377,7 @@ (defun any-displayed-view () "Return some view on display." - (view (first (windows *application-frame*)))) + (view (esa-current-window *application-frame*))) (defun any-preferably-undisplayed-view () "Return some view, any view, preferable one that is not @@ -485,13 +496,21 @@ 'base-table '((#\l :control))) -(defun activate-view (climacs active-view) - "Set `view' to be the active view for `climacs'." +(defun activate-window (window) + "Set `window' to be the active window for its Climacs +instance. `Window' must already be recognized by the Climacs +instance." ;; Ensure that only one pane can be active. - (dolist (view (views climacs)) - (unless (eq active-view view) - (setf (active view) nil))) - (setf (active active-view) t)) + (let ((climacs (pane-frame window))) + (unless (current-window-p window) + (when (typep (esa-current-window climacs) 'climacs-pane) + (setf (active (esa-current-window climacs)) nil)) + (unless (member window (windows climacs)) + (error "Cannot set unknown window to be active window")) + (setf (windows climacs) + (cons window (remove window (windows climacs))))) + (when (typep window 'climacs-pane) + (ensure-only-view-active climacs (view window))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; @@ -589,7 +608,7 @@ (replace-constellation constellation-root vbox vertically-p) (full-redisplay current-window) (full-redisplay new-pane) - (activate-view (pane-frame pane) pane) + (activate-window pane) new-pane)))) (defun make-typeout-constellation (&optional label) @@ -653,9 +672,9 @@ (remove pane (windows *esa-instance*)))) (setf (windows *esa-instance*) (append (rest (windows *esa-instance*)) - (list (first (windows *esa-instance*)))))) - (activate-view *esa-instance* (view (first (windows *esa-instance*)))) - (setf *standard-output* (first (windows *esa-instance*)))) + (list (esa-current-window *esa-instance*))))) + (activate-window (esa-current-window *esa-instance*)) + (setf *standard-output* (esa-current-window *esa-instance*))) ;;; For the ESA help functions.