Trying to get Finder to Command-A (select all)

[cornell@cs.umass.edu (MATTHEW CORNELL)]

Dear Folks:

Here's some code (the function TEST) that wants to post the Command-A
event after switching to the Finder, with the hope of getting the
finder to Select All. The result, however, is MCL does a select all
then the Finder gets switched to. I'd love to hear suggestions on what
I'm missing here. My ultimate goal is to incrementally paste some
strings and pictures into another application as a kind of log-keeping
feature; I'll repeatedly PUT-SCRAP, switch the the logging app, and
post the Command-V (or whatever keystroke's bound to Paste).


Hopefully,

matt



(in-package "COMMON-LISP-USER")

(require "APPLEEVENT-TOOLKIT")


;;;

(defun set-front-process-name-str (string)
  "Calls #_SetFrontProcess on a :ProcessSerialNumber corresponding to
string, via find-named-process . Returns nil if it couldn't find the
process. Otherwise returns the result of calling #_SetFrontProcess ."
  ;;
  (multiple-value-bind (int-psn-high int-psn-low)
                       (find-named-process string)
    (when (and (integerp int-psn-high)
               (integerp int-psn-low))
      (rlet ((psn :ProcessSerialNumber
                  :highLongOfPSN int-psn-high
                  :lowLongOfPSN int-psn-low))
        (#_SetFrontProcess psn)))))


(defun test ()
  "Tries to switch to the Finder then post a Command-A key press
event. BROKEN: First selects the text in mcl THEN switches."
  ;;
  (without-interrupts                   ;doesn't seem to help
   (let* ((*emacs-mode* nil)            ;otherwise need #$shiftKey too
          (str-name-process "Finder")
          (int-event1 #$keyDown)
          (int-event2 #$keyUp)
          (int-event-message (logand (char-code #\a) #$charCodeMask))
          (int-modifiers #$cmdKey)
          ;;
          (f-process-set (set-front-process-name-str str-name-process))
          int-result)
     (unless (and f-process-set (zerop f-process-set))
       (error "Couldn't set front process."))
     (%stack-block ((p-addr-EvQEl 4))         ;holds address of returned EvQEl
       ;;
       ;; Post the first unmodified event and add the modifier to the
       ;;  queued element.
       ;;
       (setf int-result (#_PPostEvent int-event1 int-event-message p-addr-EvQEl))
       (unless (zerop int-result)
         (error "First #_PPostEvent returned non-zero (~A)." int-result))
       (rset (%get-ptr p-addr-EvQEl) :EvQEl.evtQModifiers int-modifiers)
       ;;
       ;; Post the second event and add the modifier.
       ;;
       (setf int-result (#_PPostEvent int-event2 int-event-message p-addr-EvQEl))
       (unless (zerop int-result)
         (error "Second #_PPostEvent returned non-zero (~A)." int-result))