[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: Default Fred window size?



>In MACL 1.3.x, there was a global variable that determined the default
>window size for a new Fred window.  I can't figure out how to achieve
>the same customization for MCL2.0.  Anybody know how?  If this info is
>stored as a class default, where is it?  And can one add subclass
>defaults to a CLOS hierarchy without redefining classes like fred-window?

The globals are now called *window-default-size* and
*window-default-position*. These values are used as the defaults
for ALL windows, not just Fred windows.

The variables *listener-window-size* and *listener-window-position*
control the initial size & position for the Listener window.

The generic functions view-default-size & view-default-position
are called when a window is created with no specific size and/or
position. You can specialize these to get the behavior you want.
My init file contains the following code which locates the listener
near the bottom of the main screen with enough room under it for
my GC thermometer (this code will be available with 2.0 final. It won't
work in 2.0b1). It also increases the default height of Fred windows.

--------------------------------------------------------------------

(let ((*warn-if-redefine* nil)
      (*warn-if-redefine-kernel* nil))

(defmethod view-default-size ((w listener))
  (make-point (point-h *listener-window-size*)
              (- (floor *screen-height* 3) 3)))

(defmethod view-default-position ((w listener))
  (let ((size (view-default-size w)))
    (make-point (max 1 (- *screen-width* (point-h size) 60))
                (- *screen-height* (point-v size) 11))))

)

(defmethod view-default-size ((w fred-window))
  (make-point (point-h *window-default-size*)
              (- *screen-height* (point-v *window-default-position*) 50)))

(defun rl () 
  (let ((l *top-listener*))
    (when l
      (set-view-position l (view-default-position l))
      (set-view-size l (view-default-size l)))))

(pushnew 'rl *lisp-startup-functions*)
(rl)