Doing what PPCBrowser do

["Andre Koehorst" <andre_koehorst@riks.nl>]

        Reply to:   RE>Doing what PPCBrowser does
Posted the same question about a week ago. 
Derek White (-ex Mr. Pascal) was so kind to share some code that only took very
small adapting to serve my needs. Below you'll find youwhat we use now, not the
original. It works fine for us but has some problems. For one machine in our
LAN, a quadra 950, the application name is not recognized. Haven't found the
cause of that.

Hope this works for you and thanks again Derek,

Andre Koehorst

;---------------------------------------------------------------------------
(in-package ccl)

(require "Appleevent-Toolkit")
(require "Eval-Server")

(defvar $local-target-name "Local")
(defconstant $your-ppc-type-name "CCL2ep01") ; where CCL2 is your creator type?

(defun parse-zone-str (str &key (default-type-string "PPCToolbox"))
  (let ((start-type (position #\: str))
        (start-zone (position #\@ str)))
    (assert start-zone)
    (values
     (subseq str 0 (or start-type
                       start-zone))
     (if start-type
       (subseq str (1+ start-type) (if start-zone 
                                     start-zone
                                     (length str)))
       default-type-string)
     (subseq str (1+ start-zone) (length str)))))

(defun target-string-target-id (target-string target-id)
  (assert (and (macptrp target-id) ; really needs to be a ptr not a handle
               (stringp target-string)))
  (if (string= target-string $local-target-name)
    (setf (pref target-id :TargetID.location.locationKindSelector)
          #$ppcNoLocation) 
    (multiple-value-bind (object-str type-str zone-str)
                         (parse-zone-str target-string)
      (setf (pref target-id :TargetID.location.locationKindSelector)
            #$ppcNBPLocation)
      (setf (pref target-id :TargetID.location.NBPEntity.ObjStr)
            object-str)
      (when type-str
        (setf (pref target-id :TargetID.location.NBPEntity.TypeStr)
              type-str))
      (setf (pref target-id :TargetID.location.NBPEntity.ZoneStr)
            zone-str))))

(defun app-str-port-info (app-str port-info)
  (assert (and (stringp app-str)
               (macptrp port-info)))
  (setf (pref port-info :PortInfoRec.name.nameScript) #$smRoman)
  (setf (pref port-info :PortInfoRec.name.name) app-str)
  (setf (pref port-info :PortInfoRec.name.PortKindSelector) #$ppcByString)
  (setf (pref port-info :PortInfoRec.name.PortTypeStr) $your-ppc-type-name))
  
(defun choose-AE-target-with-defaults (the-desc 
                                      &key prompt title
                                       default-target-str
                                       default-app-str)
  (rlet ((port-info :PortInfoRec)
         (target-id :TargetID))
    (when (and default-target-str default-app-str)
      (target-string-target-id default-target-str target-ID) ; fill in
target-id
      (app-str-port-info default-app-str port-info))
    (choose-process-dialog 
     :prompt prompt :title title 
     :location-name-record (pref target-id TargetID.location)
     :port-info-record port-info
     :default-specified (and default-target-str default-app-str))
    (setf (pref target-id TargetID.name) (pref port-info PortInfoRec.name))
    (ae-error (#_AECreateDesc #$typeTargetID target-id 
               #.(record-length :TargetID) the-desc))
    the-desc))

(defun remote-send-dosc-with-PPC (command-string machine-name program-name)
  (with-aedescs (appleevent reply target)
    (choose-AE-target-with-defaults target :default-target-str machine-name
:default-app-str program-name)
    (create-dosc appleevent target command-string)
    (send-appleevent appleevent reply :reply-mode :wait-reply)
    (ae-get-parameter-char reply #$keyDirectObject nil)))

(defun create-appleevent-target (the-desc target-str app-str)
  (rlet ((port-info :PortInfoRec)
         (target-id :TargetID))
    (when (and target-str app-str)
      (target-string-target-id target-str target-ID) ; fill in target-id
      (app-str-port-info app-str port-info))
    (setf (pref target-id TargetID.name) (pref port-info PortInfoRec.name))
    (ae-error (#_AECreateDesc #$typeTargetID target-id 
               #.(record-length :TargetID) the-desc))
    the-desc))

(defun remote-send-dosc (command-string machine-name program-name)
  (with-aedescs (appleevent reply target)
    (create-appleevent-target target machine-name program-name)
    (create-dosc appleevent target command-string)
    (send-appleevent appleevent reply :reply-mode :wait-reply)
    (ae-get-parameter-char reply #$keyDirectObject nil)))

#|
(parse-zone-str "Peter@EtherTalk2")
(parse-zone-str "Peter:PPCToolBox@EtherTalk2")

(remote-send-dosc-with-PPC "(format t \"Howdydooditime\")" "Peter@EtherTalk2"
"MCL 2.0")
(remote-send-dosc  "(play-snd \"Wild Eep\")" "John's Mac:PPCToolBox@EtherTalk2"
"MCL 2.0")

(remote-send-dosc  "go card 2" "bram:PPCToolBox@EtherTalk2" "Hypercard")
(remote-send-dosc-with-PPC  "go card 2" "bram:PPCToolBox@EtherTalk2"
"Hypercard")
|#