Stella bugs in new CM

Rick Taube taube@uiuc.edu
Thu, 2 Oct 1997 14:48:55 -0500 (CDT)


>- The unmute command doesn't work - the mute flag doesn't go away (at


In stella.lisp, replace the current version of this defcommand with the
following:


(tl:defcommand "UNMUTE" unmute-cmd "Unmark objects as silent."
*commands*)



>- The paste command is seriously ill. After copying one event to the


in stella.lisp, replace the current paste-cmd definintion with the
following. notice that ive

changed the behavior to make it less confusing, the new behavior is


paste {place}*


where {place}* is an optional name or location to paste at. if you dont
specify {place}

or its not already a thread then a new container is created to hold the
pasted objects.


ill update the archives with the changes tomorrow morning.


----------------------------------------------------------------------------=
-------

(defcmd paste-cmd (input)

  (check-top-level)

  (unless (subobjectsp .pasteboard.)

    (tell-user "~:(~A~) is empty." (object-name .pasteboard.))

    (cmdreturn nil))

  (with-args (input :argchecking t :syntax "PASTE {place}*")

             ((str :reference))

    (let (pos name new? objects)

      (if str=20

        (progn =20

          (multiple-value-setq (pos name)

            (ask-position :prompt "Paste position: " :only-one
:reference

                          :include-containers :absolute-ok

                          :focus (focus-container )=20

                          :null-ok t :default str))

          (cond ((eq pos ':aborted)

                 (return-from paste-cmd nil))

                ((null pos)

                 (if (find-if #'alpha-char-p name)

                   (setf pos=20

                         (make-object (list 'thread=20

                                            (intern (string-upcase
name))))

                         new? t)

                   (cmderror "Not a position or name: ~S" name)))

                ((singleref? pos)

                 (let ((x (refobject pos)))

                   (when (typep x 'container)

                     (setf pos x))))

                ((rangeref? pos)

                 (let ((x (refcontainer pos)))

                   (remove-cmd-aux pos)

                   (setf pos=20

                         (if (>=3D (caar pos) (object-count x))=20

                           x (makeref x (caar pos))))))

                (t

                 (cmderror "Position not an index or range" ))))

        (progn

          (if (and (=3D (object-count .pasteboard.) 1)

                   (typep (first (container-objects .pasteboard.))

                          'id-mixin))

            (setf pos .top-level.)

            (setf pos (make-object 'thread)

                  new? t))))

      (setf objects

            (mapcar

             #'(lambda (o &aux (c (copy-object o)))

                 (when (typep c 'id-mixin)

                   (rename-object c (gentemp (format nil "~A-COPY-"

                                                     (object-name o)))

                                  (object-name c)))

                 c)

             (container-objects .pasteboard.)))

      (add-cmd-aux objects pos "Pasted")

      (when new? (update-top-level t)))))