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

Re: fred windows



> 
> 
> Ok, so apparently none of you have tried ccl::%buffer-insert-handle.
> 
> I'll try a different tack.  Anyone got code for a simple, read only
> scrolling text window?
> 
> Thx
> Blake Meike
> blakem@world.std.com
> 
It seems a little obvious, but I just used a *fred-window* and shadowed
out the behavior that I didn't want (such as user type in).  The code is
below.  Paul Krueger (plkrueger@serc.3m.com)

(defobject *text-window* *fred-window*)

(defobfun (exist *text-window*) (args)
  (usual-exist (init-list-default args
                                  :window-title "TEXT"
                                  :window-position #@(0 18)
                                  :window-size (make-point (- *screen-width* 2) 
                                                           (- *screen-height* 38))
                                  :scratch-p t
                                  :close-box-p t)))

(defobfun (stream-tyo *text-window*) (ch)
;;; This does some simple word wrap
  (usual-stream-tyo ch)
  (let ((width (point-h (window-size)))
        (wb (window-buffer)))
    (when (>= (window-hpos) width)
      (buffer-insert wb 
                     #.(format nil "~%") 
                     (1+ (or (buffer-char-pos wb #\space :from-end t)
                             (1- (buffer-size wb))))))))

(defobfun (window-click-event-handler *text-window*) (where)
  (%stack-block ((ctl-hdl 4))
    (if (_findcontrol :long where :ptr wptr :ptr ctl-hdl :word)
      (usual-window-click-event-handler where)
      (ed-beep))))

(defobfun (window-update-cursor *text-window*) (where)
  (declare (ignore where))
  (set-cursor *arrow-cursor*))