;;; -*- Mode: Common-Lisp; Package: PRINTER; Base: 10.; Patch-File: T -*-

;;; Reason: Added new defvar *Suppress-printer-notifications* to allow user to suppress messages from print-daemon.

;;;                           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 05/22/90 10:29:02 by BERGER,
;;; while running on Pasteur from band LOD2
;;; With SYSTEM 6.31, VIRTUAL-MEMORY 6.3, EH 6.7, MAKE-SYSTEM 6.3, MICRONET 6.0, LOCAL-FILE 6.2,
;;;  BASIC-PATHNAME 6.4, NETWORK-SUPPORT-COLD 6.2, BASIC-NAMESPACE 6.7, NETWORK-NAMESPACE 6.1,
;;;  DISK-IO 6.3, DISK-LABEL 6.0, BASIC-FILE 6.10, MAC-PATHNAME 6.0, NETWORK-PATHNAME 6.2,
;;;  COMPILER 6.14, TV 6.25, DATALINK 6.0, CHAOSNET 6.6, GC 6.3, MEMORY-AUX 6.0, NVRAM 6.2,
;;;  SYSLOG 6.2, STREAMER-TAPE 6.5, UCL 6.0, INPUT-EDITOR 6.0, METER 6.1, ZWEI 6.16,
;;;  DEBUG-TOOLS 6.4, NETWORK-SUPPORT 6.1, NETWORK-SERVICE 6.2, DATALINK-DISPLAYS 6.0,
;;;  FONT-EDITOR 6.1, SERIAL 6.0, PRINTER 6.5, MAC-PRINTER-TYPES 6.2, PRINTER-TYPES 6.2,
;;;  IMAGEN 6.1, SUGGESTIONS 6.1, MAIL-DAEMON 6.6, MAIL-READER 6.8, TELNET 6.1, VT100 6.0,
;;;  NAMESPACE-EDITOR 6.4, PROFILE 6.3, VISIDOC 6.7, TI-CLOS 6.46, CLEH 6.5, IP 3.62,
;;;  Experimental CLX 6.11, CLUE 6.104, X11M 6.24, Experimental BUG 11.19,  microcode 648,
;;;  Band Name: rel6.0 1/23

#!C
; From file UTILITIES.LISP#> PRINTER; Hotel:
#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; UTILITIES.#"


(defvar *Suppress-printer-notifications* NIL 
  "When T, the printer notifications will be suppressed.")


(DEFUN NOTIFY-USER-AT-HOST (MESSAGE HOST)
  "Send notification message to host"
  (COND
    ((AND HOST (NEQ (PARSE-HOST-NAME HOST T T) SI:LOCAL-HOST)
	(FBOUNDP 'NOTIFY-REMOTE-PRINT-SERVER))
     ;;  send message to remote host 
     (NOTIFY-REMOTE-PRINT-SERVER HOST MESSAGE))
    (T
     ;; just use tv:notify
     (unless *Suppress-printer-notifications*   ; DAB 05-22-90 Dont notify if suppressed.
       (IF TV:SELECTED-WINDOW
	   (LET ((OLD-MORE-P (SEND TV:SELECTED-WINDOW :MORE-P)))
	     (UNWIND-PROTECT (PROGN
			  (SEND TV:SELECTED-WINDOW :SET-MORE-P ())
			  (TV:NOTIFY () "~a" MESSAGE))  ;10-04-88 DAB Added "~a". Otherwise, file-names like lm:~; would 
	       ;cause FORMAT to barf, causing print-daemon to go in wait-forever.
	       (SEND TV:SELECTED-WINDOW :SET-MORE-P OLD-MORE-P)))
	   (TV:NOTIFY () "~a" MESSAGE))
       )
       )))



))

#!C
; From file SERVER.LISP#> PRINTER; Hotel:
#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-RECEIVE-MESSAGE (CHAOS-STREAM IGNORE &AUX MESSAGE)
  "Get error message from chaos stream and send an error notification"
  (SETQ MESSAGE (SEND CHAOS-STREAM :LINE-IN t))
  (unless *Suppress-printer-notifications*  ; DAB 05-22-90
    (process-run-function "Notification from Print Daemon " #'NOTIFY-NICELY () "~A" MESSAGE))    ;10-10-88  DAB
  )

(DEFUN  PRINT-LOGIN-REQUEST-HANDLER (CHAOS-STREAM ignore)
  "Prompt the user for login information and send the information back to the printer host."
  (unless *Suppress-printer-notifications* 
    (NOTIFY-NICELY NIL "Processing remote-login request from printer host."))
  (let ((arg-list (READ-FROM-STRING (SEND CHAOS-STREAM :LINE-IN t) T))
	result-list) 
    (setq result-list
	  (WITH-TIMEOUT ((* 60 90)    ;delay 90 seconds
			 (NOTIFY-NICELY NIL "Printer login request timed out. Print request will be cancelled.")
			 nil)
			(format nil "~s" 
				(MULTIPLE-VALUE-LIST (APPLY 'FS:FILE-GET-PASSWORD-ETC arg-list))
				)))
    (if result-list
	(send chaos-stream :line-out result-list)
	(SEND CHAOS-STREAM :LINE-OUT (format nil "-ERROR: Login timeout")))
    (send chaos-stream :force-output)))



))