;;; -*- Mode: Common-Lisp; Package: User; Base: 10.; Patch-File: T -*- ;;; Reason: Allow rel5 toolbox servers to work with rel6. ;;; RESTRICTED RIGHTS LEGEND ;;; ;;; Use, duplication, or disclosure by the Government is subject to ;;; restrictions as set forth in subdivision (c)(1)(ii) of the Rights in ;;; Technical Data and Computer Software clause at 52.227-7013. ;;; ;;; TEXAS INSTRUMENTS INCORPORATED ;;; P.O. BOX 2909, M/S 2151 ;;; AUSTIN, TEXAS 78769 ;;; ;;; Copyright (C) 1989 Texas Instruments Incorporated. ;;; All rights reserved. ;;; Written 06/14/89 16:36:12 by jones, ;;; while running on HOBBS from band LOD1 ;;; With SYSTEM 6.5, GC 6.2, VIRTUAL-MEMORY 6.1, MICRONET 6.0, MICRONET-COMM 6.1, ;;; DISK-IO 6.0, DISK-LABEL 6.0, BASIC-PATHNAME 6.0, MAC-PATHNAME 6.0, NETWORK-SUPPORT-COLD 6.0, ;;; BASIC-NAMESPACE 6.0, BASIC-FILE 6.2, RPC 6.1, NFS 6.0, EH 6.2, MAKE-SYSTEM 6.0, ;;; MEMORY-AUX 6.0, COMPILER 6.2, TV 6.6, NVRAM 6.0, UCL 6.0, INPUT-EDITOR 6.0, MACTOOLBOX 2.0, ;;; METER 6.0, ZWEI 6.1, DEBUG-TOOLS 6.0, WINDOW-MX 6.2, PRINTER 6.1, MAC-PRINTER-TYPES 6.1, ;;; CLIPBOARD 6.0, NETWORK-PATHNAME 6.0, NETWORK-NAMESPACE 6.0, DATALINK 6.0, CHAOSNET 6.0, ;;; NETWORK-SUPPORT 6.0, NETWORK-SERVICE 6.0, DATALINK-DISPLAYS 6.0, MX-DATALINK 6.0, ;;; NAMESPACE-EDITOR 6.0, IP 3.46, NFS-SERVER 6.0, MX-SERIAL 6.0, PRINTER-TYPES 6.0, ;;; IMAGEN 6.0, MAIL-DAEMON 6.2, MAIL-READER 6.0, TELNET 6.0, VT100 6.0, STREAMER-TAPE 6.2, ;;; DECNET 1.67, VISIDOC 6.1, PROFILE 6.1, TI-CLOS 6.5, CLEH 6.3, CLX 6.0, CLUE 6.0, ;;; Experimental BUG 11.5, Experimental ACTION 2.0, microcode 137, Band Name: p526*1 #!C ; From file MAC-APPLICATIONS.LISP#> JONES; HEYERDAHL: #10R MACTOOLBOX#: (COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "MACTOOLBOX")) (SI:*LISP-MODE* :Common-lisp) (*READTABLE* Sys:Common-lisp-readtable) (SI:*READER-SYMBOL-SUBSTITUTIONS* Sys::*common-lisp-symbol-substitutions*)) (COMPILER#:PATCH-SOURCE-FILE "SYS: toolbox-interface; MAC-APPLICATIONS.#" (defconstant *tb-command-not-handled* 1 "The error code sent back from the tbserver when a command was not handled. ") (defmethod (mac-application-internal :set-async-event-mode) (&optional (mode async-events)) "Add or delete channel to the async-event handler's list of channels to service." ;; Ayn server that has the evts resource will handle async events. (cond ((not (zerop (send (!GetResource "evts" 0) :handle))) (let ((acb (add:get-acb-fast 2))) (setf (add:opcode acb) *set-async-event-mode-opcode*) (setf (add:requestor-complete acb) nil) (setf (add:parm-8b acb 0) (if mode 1 0)) (setf (add:error-code acb) *tb-command-not-handled*) (tb:tb-transmit-packet-and-wait acb) (cond ((zerop (add:error-code acb)) (if mode (add-async-event-channel *application-channel* self) (delete-async-event-channel *application-channel*)) (setf async-events (not (null mode)))) ((= (add:error-code acb) *tb-command-not-handled*) (delete-async-event-channel *application-channel*) (setf async-events nil)) (t (ferror 'unknown-error-from-tbserver "An unknown error code (~s) was returned from the toolbox server." (add:error-code acb)) )) (setf (add:requestor-complete acb) t) (add:return-acb-fast acb))) (t (delete-async-event-channel *application-channel*) (setf async-events nil)))) ;; Return opcode 15 to its original functionality and add an opcode 14 handler for the extended functionality. (defun misc-handler-opcode-15 (cmd) ;; Args from the Mac ;; 1) Function name length. This can be nil in which case there will be no process associated with this application. ;; 2) Function name. ;; 3) Name or keyword length. ;; 4) Name or keyword value to pass to process-run-function. ;; 5) Args length. ;; 6) Args value to pass to process-run-function. ;; ;; Return values ;; 1) Application number. ;; ;; If application can not be started a code will be put in the error-code field of the acb and as much of ;; an explanation as possible in the body of the acb (length in parm 0, text in parm 1 - n). (condition-call (condition) (let* ((application-name-start 0) (application-string (add:get-acb-string cmd application-name-start)) (application (read-from-string application-string nil)) ; (process-options-start (1+ (add:parm-8b cmd 0))) ; (process-options-string (add:get-acb-string cmd process-options-start)) ; (process-options (read-from-string process-options-string nil)) ; (args-start (1+ (add:parm-8b cmd process-options-start))) ; (args-string (add:get-acb-string cmd args-start)) ; (args (read-from-string args-string nil)) (application-instance (make-instance application :no-launch-server t)) (application-number (process-wait-with-timeout "Waiting For Application" nil #'(lambda (appl) (let ((ch (send appl :*application-channel*))) (when ch (add:channel-number ch)))) application-instance))) (setf (add:parm-8b cmd 0) application-number) (setf (add:error-code cmd) 0)) ((null *debug-mac-toolbox-launcher*) (let* ((error-string (send condition :report-string)) (error-string-length (min (1- (add:data-bytes cmd)) (length error-string) 255)) (error-code *misc-error-while-launching-mac-application*)) (setf (add:error-code cmd) error-code) (add:put-acb-string cmd 0 (subseq error-string 0 error-string-length)))))) (defun misc-handler-opcode-14 (cmd) ;; Args from the Mac ;; 1) Function name length. This can be nil in which case there will be no process associated with this application. ;; 2) Function name. ;; 3) Name or keyword length. ;; 4) Name or keyword value to pass to process-run-function. ;; 5) Args length. ;; 6) Args value to pass to process-run-function. ;; ;; Return values ;; 1) Application number. ;; ;; If application can not be started a code will be put in the error-code field of the acb and as much of ;; an explanation as possible in the body of the acb (length in parm 0, text in parm 1 - n). (condition-call (condition) (case (add:subopcode cmd) (0 ; Application being launched. (let* ((application-name-start 0) (application-string (add:get-acb-string cmd application-name-start)) (application (read-from-string application-string nil)) ; (process-options-start (1+ (add:parm-8b cmd 0))) ; (process-options-string (add:get-acb-string cmd process-options-start)) ; (process-options (read-from-string process-options-string nil)) ; (args-start (1+ (add:parm-8b cmd process-options-start))) ; (args-string (add:get-acb-string cmd args-start)) ; (args (read-from-string args-string nil)) (application-instance (make-instance application :no-launch-server t)) (application-number (process-wait-with-timeout "Waiting For Application" nil #'(lambda (appl) (let ((ch (send appl :*application-channel*))) (when ch (add:channel-number ch)))) application-instance))) (setf (add:parm-8b cmd 0) application-number) (setf (add:error-code cmd) 0))) (1 ; Application being killed (let* ((application-channel (add:parm-8b cmd 0)) (application (find application-channel *mac-applications* :key #'(lambda (app) (send (add:find-channel (mac-application-*application-channel* app)) :number)) :test #'eql))) (when application (send application :kill))) )) ((null *debug-mac-toolbox-launcher*) (let* ((error-string (send condition :report-string)) (error-string-length (min (1- (add:data-bytes cmd)) (length error-string) 255)) (error-code *misc-error-while-launching-mac-application*)) (setf (add:error-code cmd) error-code) (add:put-acb-string cmd 0 (subseq error-string 0 error-string-length)))))) )) #!C ; From file TOOLBOX-INIT.LISP#> TOOLBOX-INTERFACE; MR-X: #10R MACTOOLBOX#: (COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "MACTOOLBOX")) (SI:*LISP-MODE* :Common-lisp) (*READTABLE* Sys:Common-lisp-readtable) (SI:*READER-SYMBOL-SUBSTITUTIONS* Sys::*common-lisp-symbol-substitutions*)) (COMPILER#:PATCH-SOURCE-FILE "SYS: TOOLBOX-INTERFACE; TOOLBOX-INIT.#" (defmethod (add:MISC-HANDLER :CASE :HANDLE-OPCODE 14) (cmd) (misc-handler-opcode-14 cmd)) (compile-flavor-methods add:misc-handler) ))