(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")

(FILECREATED " 7-Jun-93 15:34:58" {DSK}<project>medley2.0>lispusers>SETDEFAULTPRINTER.;7
 7525   

      changes to%:  (VARS SETDEFAULTPRINTERCOMS)
                    (FNS \sdp.menu.subitems)

      previous date%: "29-May-93 15:44:06" {DSK}<project>medley2.0>lispusers>SETDEFAULTPRINTER.;6)


(* ; "
Copyright (c) 1985, 1986, 1987, 1993 by Xerox Corporation.  All rights reserved.
")

(PRETTYCOMPRINT SETDEFAULTPRINTERCOMS)

(RPAQQ SETDEFAULTPRINTERCOMS

       (

(* ;;; "the regular DEFAULTSUBITEMFN modified to recognize EVAL as a key to EVAL the CADR of the list to get the subitems")


        (FILES DEFAULTSUBITEMFN)
        

(* ;;; "the setdefaultprinter functions")


        (FNS \sdp.menu.subitems \sdp.set.printer)
        

(* ;;; "SDP.PRINTERINFO is the place to look up things like printer location, it also looks on the name of the printer for a LOCATION property")


        (INITVARS (SDP.PRINTERINFO NIL))
        

(* ;;; "insinuate self into background menu")


        [ADDVARS (BackgroundMenuCommands ("Set Default Printer" (\sdp.set.printer (
                                                                                GetNewPrinterFromUser
                                                                                   ))
                                                
                    "Asks for (new) default printer name.  <cr> without entering name aborts change."
                                                (EVAL (\sdp.menu.subitems]
        

(* ;;; "reset the background menu so our change takes effect, and remove space from the separators when reading printer names")


        (P (SETQ BackgroundMenu))))



(* ;;; 
"the regular DEFAULTSUBITEMFN modified to recognize EVAL as a key to EVAL the CADR of the list to get the subitems"
)



(FILESLOAD DEFAULTSUBITEMFN)



(* ;;; "the setdefaultprinter functions")


(DEFINEQ

(\sdp.menu.subitems

  [LAMBDA NIL
                                            (* ; "Edited  7-Jun-93 15:30 by rmk:")

                                                             (* N.H.Briggs "24-Mar-86 16:09")

    (NCONC1 [FOR
 P PNAME INSIDE
 DEFAULTPRINTINGHOST
               COLLECT
 (LIST (IF
 (NLISTP P)
                                     THEN
 P
                                   ELSEIF
 (CADDR P)
                                     THEN
 (CONCAT (CADR P)
                                                     " "
                                                     (CADDR P))
                                   ELSE
 (CADR P))
                                 (LIST '\sdp.set.printer (KWOTE P))
                                 (OR (GETPROP (U-CASE P)
                                            'LOCATION)
                                     (CDR (ASSOC (U-CASE P)
                                                 SDP.PRINTERINFO]
           (LIST "Other..." '(\sdp.set.printer
 (GetNewPrinterFromUser))
                 "Asks for (new) default printer name.  <cr> without entering name aborts change."])

(\sdp.set.printer

  [LAMBDA (PRINTER)
                                      (* ; "Edited 29-May-93 15:11 by rmk:")

                                                             (* N.H.Briggs " 8-Jul-86 12:29")


    (* ;; "CANONICAL.HOSTNAME is NIL except for XNS hosts")


    (SETQ DEFAULTPRINTINGHOST (MKLIST DEFAULTPRINTINGHOST))
    [IF
 PRINTER
        THEN


        (* ;; "Convert to canonical name")


        (SETQ PRINTER (IF
 (LISTP PRINTER)
                          THEN
 (LIST (CAR PRINTER)
                                         (OR (CANONICAL.HOSTNAME (CADR PRINTER))
                                             (CADR PRINTER))
                                         (CADDR PRINTER))
                        ELSE
 (OR (CANONICAL.HOSTNAME PRINTER)
                                     PRINTER)))
        (LET ((TOP (CAR DEFAULTPRINTINGHOST))
              (CANONICALPRINTERNAME (IF
 (LISTP PRINTER)
                                        THEN
 (CADR PRINTER)
                                      ELSE
 PRINTER)))
             (IF
 (IF
 (LISTP PRINTER)
                         THEN
 [AND (LISTP TOP)
                                       (EQ (CAR TOP)
                                           (CAR PRINTER))
                                       (EQ (CADDR TOP)
                                           (CADDR PRINTER))
                                       (STRING-EQUAL CANONICALPRINTERNAME (OR (CANONICAL.HOSTNAME
                                                                               (CADR TOP))
                                                                              (CADR TOP]
                       ELSE
 (AND (NLISTP TOP)
                                     (STRING-EQUAL (OR (CANONICAL.HOSTNAME TOP)
                                                       TOP)
                                            CANONICALPRINTERNAME)))
                 THEN
 (PROMPTPRINT "default printer not changed")
               ELSE
 [SETQ DEFAULTPRINTINGHOST
                         (CONS PRINTER
                               (IF
 (LISTP PRINTER)
                                   THEN
 (FOR
 P IN
 DEFAULTPRINTINGHOST
                                               UNLESS
 [AND (LISTP P)
                                                               (EQ (CAR P)
                                                                   (CAR PRINTER))
                                                               (EQ (CADDR P)
                                                                   (CADDR PRINTER))
                                                               (STRING-EQUAL
                                                                CANONICALPRINTERNAME
                                                                (OR (CANONICAL.HOSTNAME (CADR P))
                                                                    (CADR P] COLLECT
 P)
                                 ELSE
 (FOR
 P IN
 DEFAULTPRINTINGHOST
                                             UNLESS
 (AND (NLISTP P)
                                                             (STRING-EQUAL CANONICALPRINTERNAME
                                                                    (OR (CANONICAL.HOSTNAME P)
                                                                        P))) COLLECT
 P]
                     (PROMPTPRINT "default printer set to " PRINTER]
    NIL])
)



(* ;;; 
"SDP.PRINTERINFO is the place to look up things like printer location, it also looks on the name of the printer for a LOCATION property"
)



(RPAQ? SDP.PRINTERINFO
 NIL)



(* ;;; "insinuate self into background menu")



(ADDTOVAR BackgroundMenuCommands
 ("Set Default Printer" (\sdp.set.printer (GetNewPrinterFromUser)
                                                                   )
                                            
                    "Asks for (new) default printer name.  <cr> without entering name aborts change."
                                            (EVAL (\sdp.menu.subitems))))



(* ;;; 
"reset the background menu so our change takes effect, and remove space from the separators when reading printer names"
)



(SETQ BackgroundMenu)
(PUTPROPS SETDEFAULTPRINTER COPYRIGHT ("Xerox Corporation" 1985 1986 1987 1993))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (1960 6625 (\sdp.menu.subitems 1970 . 3132) (\sdp.set.printer 3134 . 6623)))))
STOP