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)))))