;;; -*- Mode: Common-Lisp; Package: PRINTER; Base: 10.; Patch-File: T -*-
;;; Written 06/02/89 07:14:31 by BERGER,
;;; Reason: I had to patch in print-server-function because chaosnet was not installed when this function was loaded, therefore the compiler used si:listen instead of chaos:listen.
;;; while running on ARIES from band LOD1
;;; With SYSTEM 6.2, VIRTUAL-MEMORY 6.1, EH 6.0, MAKE-SYSTEM 6.0, MICRONET 6.0, LOCAL-FILE 6.0,
;;;  BASIC-PATHNAME 6.0, NETWORK-SUPPORT-COLD 6.0, BASIC-NAMESPACE 6.0, NETWORK-NAMESPACE 6.0,
;;;  DISK-IO 6.0, DISK-LABEL 6.0, BASIC-FILE 6.0, MAC-PATHNAME 6.0, NETWORK-PATHNAME 6.0,
;;;  COMPILER 6.2, TV 6.6, DATALINK 6.0, CHAOSNET 6.0, GC 6.0, MEMORY-AUX 6.0, NVRAM 6.0,
;;;  SYSLOG 6.0, STREAMER-TAPE 6.0, UCL 6.0, INPUT-EDITOR 6.0, METER 6.0, ZWEI 6.0,
;;;  DEBUG-TOOLS 6.0, NETWORK-SUPPORT 6.0, NETWORK-SERVICE 6.0, DATALINK-DISPLAYS 6.0,
;;;  FONT-EDITOR 6.0, SERIAL 6.0, PRINTER 6.0, MAC-PRINTER-TYPES 6.1, PRINTER-TYPES 6.0,
;;;  IMAGEN 6.0, SUGGESTIONS 6.0, MAIL-DAEMON 6.2, MAIL-READER 6.0, TELNET 6.0, VT100 6.0,
;;;  NAMESPACE-EDITOR 6.0, PROFILE 6.1, VISIDOC 6.0, TI-CLOS 6.5, CLEH 6.0, IP 3.45,
;;;  Experimental BUG 11.6, CLX 6.0, CLUE 6.0, X11M 6.0, VISIDOC-SERVER 5.0, RPC 6.1,
;;;   microcode 429, Band Name: Release 6.0 + SLE 5/22

#!C
; From file SERVER.LISP#> PRINTER; SYS:
#10R PRINTER#:
(COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "PRINTER"))
                          (SI:*LISP-MODE* :COMMON-LISP)
                          (*READTABLE* SYS:COMMON-LISP-READTABLE)
                          (SI:*READER-SYMBOL-SUBSTITUTIONS* SYS::*COMMON-LISP-SYMBOL-SUBSTITUTIONS*))
  (COMPILER#:PATCH-SOURCE-FILE "SYS: PRINTER; SERVER.#"


(DEFUN PRINT-SERVER-FUNCTION (&AUX CONN)
  "Print server expects a function keyword of MESSAGE or QUEUE-FILE from another host;
and will then execute the dispatch function"
  (SETQ CONN (CHAOS:LISTEN "PRINT"))
  (CHAOS:ACCEPT CONN)
  (PUSH CONN *PRINT-SERVER-CONNECTIONS*)
  (IF (BOUNDP 'TV:WHO-LINE-FILE-STATE-SHEET)
    (SEND TV:WHO-LINE-FILE-STATE-SHEET :ADD-SERVER CONN "PRINT"))
  (CONDITION-CALL (CONDITION-INSTANCE)
     (LET (FUNCTION-KEYWORD
	   DISPATCH-FUNCTION
	   FOREIGN-HOST
	   CHAOS-STREAM
	   (USER-ID "PRINTER"))
       (UNWIND-PROTECT (PROGN
			(SETQ CHAOS-STREAM (CHAOS:MAKE-STREAM CONN))
			(SETQ FOREIGN-HOST
			      (SI:GET-HOST-FROM-ADDRESS (CHAOS:FOREIGN-ADDRESS CONN) :CHAOS))
			(SETQ FUNCTION-KEYWORD (INTERN (SEND CHAOS-STREAM :LINE-IN) 'PRINTER))
			(COND
			  ((SETQ DISPATCH-FUNCTION
				 (ASSOC FUNCTION-KEYWORD *DISPATCH-FUNCTION-TABLE* :TEST #'EQ))
			   ;; a valid dispatch-function, 
			   ;; execute it after sending a positive response
			   (SEND CHAOS-STREAM :LINE-OUT "+Function keyword valid.")
			   (SEND CHAOS-STREAM :FORCE-OUTPUT)
			   (FUNCALL (CDR DISPATCH-FUNCTION) CHAOS-STREAM FOREIGN-HOST))
			  (T
			   ;; no valid function, so send an error response
			   (SEND CHAOS-STREAM :LINE-OUT "-Error, function keyword not valid.")
			   (SEND CHAOS-STREAM :FORCE-OUTPUT))))
	 (SEND CHAOS-STREAM :FINISH)
	 (IF CONN
	   (CHAOS:close-CONN CONN))))
     ((NOT (SEND CONDITION-INSTANCE :DANGEROUS-CONDITION-P))
      (NOTIFY-NICELY () (FORMAT () "Error from Print-Server: ~A" CONDITION-INSTANCE))))
  ())
))