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

Dynamically resizing editable-text-dialog-items?

I am having trouble understanding and controlling the automatic scrolling of
EDITABLE-TEXT-DIALOG-ITEMs.  I am trying to make an editable text field
whose size grows and shrinks depending on the size of its contents (like,
for example, the file and folder names in the Finder).  Alas, when I type
at the end of one of these, the front few characters scroll off into
invisibility, and I am left with a corresponding amount of white space at
the right end.  This makes some sense because there needs to be room for
the new char, but it doesn't help to add extra space.  I would like to be
able to turn off this horizontal scrolling, or control it so it is not

I have also tried this with TEXT-EDIT-DIALOG-ITEMs (from that example
file), but with the same problem.

Am I doing something fundamentally wrong, or is there a simple fix?
Thanks.  --Pete Szolovits

(defparameter *w* (make-instance 'dialog))

(defclass etdi (editable-text-dialog-item)
  ((origin :accessor origin)
   (extra-width :accessor extra-width))
    :dialog-item-text "Untitled"
    :view-size #@(55 16)                ;; empirically determined
"Untitled" in Chicago 12.
                                        ;; I have tried upping the 55, to
no avail.

(defmethod initialize-instance :after ((di etdi) &key)
  (let ((p (view-position di))
        (s (view-size di)))
    (setf (origin di) 
          (make-point (+ (point-h p) (round (point-h s) 2))
                      (+ (point-v p) (round (point-v s) 2))))
    (setf (extra-width di)              ; this accounts for width-correction
          (- (point-h s)                ; and frame, I think
             (string-width (dialog-item-text di) (view-font di))))

(defmethod dialog-item-action ((di etdi))
  (recalc-posn di)
  ;; (fred-update di)                      ; this doesn't seem to matter either

(defun recalc-posn (di)
  (let ((o (origin di))
        (hs (string-width (dialog-item-text di) (view-font di))))
    (set-view-size di
                   (+ hs (extra-width di))
                   (point-v (view-size di)))
    (set-view-position di 
                       (- (point-h o)
                          (round (+ hs (extra-width di)) 2))
                       (- (point-v o)
                          (round (point-v (view-size di)) 2)))))

(add-subviews *w* (make-instance 'etdi :view-position #@(100 100)))