/[climacs]/climacs/gui.lisp
ViewVC logotype

Diff of /climacs/gui.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.241 by thenriksen, Mon Dec 10 21:31:09 2007 UTC revision 1.242 by thenriksen, Tue Dec 11 23:19:45 2007 UTC
# Line 97  window")) Line 97  window"))
97           (find-if #'(lambda (other-pane)           (find-if #'(lambda (other-pane)
98                        (and (not (eq other-pane pane))                        (and (not (eq other-pane pane))
99                             (eq (view other-pane) view)))                             (eq (view other-pane) view)))
100                    (windows (pane-frame pane)))))                    (windows (pane-frame pane))))
101            (old-view-active (active (view pane))))
102      (cond ((not (member view (views (pane-frame pane))))      (cond ((not (member view (views (pane-frame pane))))
103             (restart-case (error 'unknown-view :view view)             (restart-case (error 'unknown-view :view view)
104               (add-to-view-list ()               (add-to-view-list ()
# Line 121  window")) Line 122  window"))
122                                   (pane-frame window-displaying-view) view)))                                   (pane-frame window-displaying-view) view)))
123               (cancel ()               (cancel ()
124                :report "Cancel the setting of the windows view and just return")))                :report "Cancel the setting of the windows view and just return")))
125            (t (call-next-method)))))            (t (call-next-method)))
126        (when old-view-active
127          (ensure-only-view-active (pane-frame pane) view))))
128    
129  (defmethod (setf view) :before ((view drei-view) (pane climacs-pane))  (defmethod (setf view) :before ((view drei-view) (pane climacs-pane))
130    (with-accessors ((views views)) (pane-frame pane)    (with-accessors ((views views)) (pane-frame pane)
# Line 299  window")) Line 302  window"))
302    (setf (buffer (current-view (esa-current-window application-frame)))    (setf (buffer (current-view (esa-current-window application-frame)))
303          new-buffer))          new-buffer))
304    
305    (defmethod (setf windows) :after (new-val (climacs climacs))
306      ;; Ensures that we don't end up with two views that both believe
307      ;; they are active.
308      (activate-window (esa-current-window climacs)))
309    
310    (defun current-window-p (window)
311      "Return true if `window' is the current window of its Climacs
312    instance."
313      (eq window (esa-current-window (pane-frame window))))
314    
315    (defun ensure-only-view-active (climacs view)
316      "Ensure that `view' is the only view of `climacs' that is
317    active."
318      (dolist (other-view (views climacs))
319        (unless (eq other-view view)
320          (setf (active other-view) nil)))
321      (setf (active view) t))
322    
323  (defmethod (setf views) :around (new-value (frame climacs))  (defmethod (setf views) :around (new-value (frame climacs))
324    ;; If any windows show a view that no longer exists in the    ;; If any windows show a view that no longer exists in the
325    ;; view-list, make them show something else. The view-list might be    ;; view-list, make them show something else. The view-list might be
326    ;; destructively updated, so copy it for safekeeping.    ;; destructively updated, so copy it for safekeeping. Also make sure
327      ;; only one view thinks that it's active.
328    (with-accessors ((views views)) frame    (with-accessors ((views views)) frame
329      (let* ((old-views (copy-list views))      (let* ((old-views (copy-list views))
330             (removed-views (set-difference             (removed-views (set-difference
331                             old-views (call-next-method) :test #'eq)))                             old-views (call-next-method) :test #'eq)))
   
332        (dolist (window (windows frame))        (dolist (window (windows frame))
333          (when (member (view window) removed-views :test #'eq)          (when (and (typep window 'climacs-pane)
334                       (member (view window) removed-views :test #'eq))
335            (handler-case (setf (view window)            (handler-case (setf (view window)
336                                (any-preferably-undisplayed-view))                                (any-preferably-undisplayed-view))
337              (view-already-displayed ()              (view-already-displayed ()
338                (delete-window window)))))                (delete-window window)))))))
339        ;; If the active view was removed, we have to designate a new    (ensure-only-view-active
340        ;; active view.     frame (when (typep (esa-current-window frame) 'climacs-pane)
341        (if (find-if #'active removed-views)             (view (esa-current-window frame)))))
           (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)))))))))  
342    
343  (defmethod (setf views) :after ((new-value null) (frame climacs))  (defmethod (setf views) :after ((new-value null) (frame climacs))
344    ;; You think you can remove all views? I laught at your silly    ;; You think you can remove all views? I laught at your silly
# Line 330  window")) Line 346  window"))
346    (setf (views frame) (list (make-new-view-for-climacs    (setf (views frame) (list (make-new-view-for-climacs
347                               frame 'textual-drei-syntax-view))))                               frame 'textual-drei-syntax-view))))
348    
 (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)))  
   
349  (defun make-view-subscript-generator (climacs)  (defun make-view-subscript-generator (climacs)
350    #'(lambda (name)    #'(lambda (name)
351        (1+ (reduce #'max (remove name (views climacs)        (1+ (reduce #'max (remove name (views climacs)
# Line 346  window")) Line 357  window"))
357    "Clone `view' and add it to `climacs's list of views."    "Clone `view' and add it to `climacs's list of views."
358    (let ((new-view (apply #'clone-view view    (let ((new-view (apply #'clone-view view
359                     :subscript-generator (make-view-subscript-generator climacs)                     :subscript-generator (make-view-subscript-generator climacs)
360                     :active nil :syntax (make-syntax-for-view view (class-of (syntax view)))                     :active nil initargs)))
361                     initargs)))      (setf (syntax new-view) (make-syntax-for-view new-view (class-of (syntax view))))
362      (push new-view (views climacs))      (push new-view (views climacs))
363      new-view))      new-view))
364    
# Line 366  window")) Line 377  window"))
377    
378  (defun any-displayed-view ()  (defun any-displayed-view ()
379    "Return some view on display."    "Return some view on display."
380    (view (first (windows *application-frame*))))    (view (esa-current-window *application-frame*)))
381    
382  (defun any-preferably-undisplayed-view ()  (defun any-preferably-undisplayed-view ()
383    "Return some view, any view, preferable one that is not    "Return some view, any view, preferable one that is not
# Line 485  FIXME: does this really have that effect Line 496  FIXME: does this really have that effect
496           'base-table           'base-table
497           '((#\l :control)))           '((#\l :control)))
498    
499  (defun activate-view (climacs active-view)  (defun activate-window (window)
500    "Set `view' to be the active view for `climacs'."    "Set `window' to be the active window for its Climacs
501    instance. `Window' must already be recognized by the Climacs
502    instance."
503    ;; Ensure that only one pane can be active.    ;; Ensure that only one pane can be active.
504    (dolist (view (views climacs))    (let ((climacs (pane-frame window)))
505      (unless (eq active-view view)      (unless (current-window-p window)
506        (setf (active view) nil)))        (when (typep (esa-current-window climacs) 'climacs-pane)
507    (setf (active active-view) t))          (setf (active (esa-current-window climacs)) nil))
508          (unless (member window (windows climacs))
509            (error "Cannot set unknown window to be active window"))
510          (setf (windows climacs)
511                (cons window (remove window (windows climacs)))))
512        (when (typep window 'climacs-pane)
513          (ensure-only-view-active climacs (view window)))))
514    
515  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
516  ;;;  ;;;
# Line 589  pane to a clone of the view in `orig-pan Line 608  pane to a clone of the view in `orig-pan
608          (replace-constellation constellation-root vbox vertically-p)          (replace-constellation constellation-root vbox vertically-p)
609          (full-redisplay current-window)          (full-redisplay current-window)
610          (full-redisplay new-pane)          (full-redisplay new-pane)
611          (activate-view (pane-frame pane) pane)          (activate-window pane)
612          new-pane))))          new-pane))))
613    
614  (defun make-typeout-constellation (&optional label)  (defun make-typeout-constellation (&optional label)
# Line 653  be created." Line 672  be created."
672                      (remove pane (windows *esa-instance*))))                      (remove pane (windows *esa-instance*))))
673        (setf (windows *esa-instance*)        (setf (windows *esa-instance*)
674              (append (rest (windows *esa-instance*))              (append (rest (windows *esa-instance*))
675                      (list (first (windows *esa-instance*))))))                      (list (esa-current-window *esa-instance*)))))
676    (activate-view *esa-instance* (view (first (windows *esa-instance*))))    (activate-window (esa-current-window *esa-instance*))
677    (setf *standard-output* (first (windows *esa-instance*))))    (setf *standard-output* (esa-current-window *esa-instance*)))
678    
679  ;;; For the ESA help functions.  ;;; For the ESA help functions.
680    

Legend:
Removed from v.1.241  
changed lines
  Added in v.1.242

  ViewVC Help
Powered by ViewVC 1.1.5