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

(FILECREATED " 8-Jan-88 18:02:00" {ERINYES}<LISPUSERS>LYRIC>REGISTER-MACHINE.;2
 4471   

      changes to%:  (FNS Requst-NS-Registry AmIRegistered)
                    (VARS REGISTER-MACHINECOMS)

      previous date%: "13-Feb-87 16:07:50" {PHYLUM}<ISLINFO>FORMS>REGISTER-MACHINE.;3)


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

(PRETTYCOMPRINT REGISTER-MACHINECOMS)

(RPAQQ REGISTER-MACHINECOMS
 (
(* ;;; "Add a Lafite form that will request that the current machine be registered with the local Clearinghouse")


                             (FNS Requst-NS-Registry AmIRegistered)
                             (ADDVARS (LAFITESPECIALFORMS ("Clearinghouse registry request"
                                                           'Requst-NS-Registry 
           "Make a form to request that the current machine be registered on the local Clearinghouse"
                                                           )))
                             (P (UNMARKASCHANGED 'LAFITESPECIALFORMS 'VARS)
                                (SETQ LAFITEFORMSMENU NIL))))



(* ;;; 
"Add a Lafite form that will request that the current machine be registered with the local Clearinghouse"
)


(DEFINEQ

(Requst-NS-Registry

  [LAMBDA NIL
                                             (* ; "Edited  8-Jan-88 18:00 by Masinter")


(* ;;; 

"Format a nice note requsting that the current machine be registered on the local Clearinghouse.")


    (LET ((*STANDARD-OUTPUT* (OPENTEXTSTREAM "" NIL NIL NIL (LIST 'FONT LAFITEEDITORFONT)))
          (netNumber (fetch
 NSNET \MY.NSADDRESS))
          (me (FULLUSERNAME))
          (CURRENTLY (AmIRegistered
)))
         (CL:FORMAT T "To: UserAdministration~A~A~&" (SELECTQ (LAFITEMODE)
                                                         (GV ".")
                                                         ":")
                CH.DEFAULT.DOMAIN)
         (CL:FORMAT T "Cc: ~A~%%Reply-to: ~A~%%~%%" me me)
         (if
 CURRENTLY
             then
 (CL:FORMAT T ">>This machine is already registered as ~A <<~%%~%%" CURRENTLY))
         (printout NIL "Primary User:  " me T T)
         (printout NIL "Name:  %"" (OR (ETHERHOSTNAME)
                                       ">>Desired machine name<<")
                "%"" T)
         (CL:FORMAT T "Network Number: ~5,,'-:D~&" (fetch
 NSNET \MY.NSADDRESS))
         (CL:FORMAT T "Processor Number: ~5,,'-:D~&" (+ (LSH (fetch
 NSHNM0 \MY.NSADDRESS)
                                                             32)
                                                        (LSH (fetch
 NSHNM1 \MY.NSADDRESS)
                                                             16)
                                                        (fetch
 NSHNM2 \MY.NSADDRESS)))
         (printout NIL "Description:  A " (L-CASE (MACHINETYPE)
                                                 T)
                " (typically running Lisp)" T)
         (printout NIL T T "Thank you." T T "-- " FIRSTNAME T)
         (LET ((field (TEDIT.FIND *STANDARD-OUTPUT* ">>*<<" 1 NIL T)))
              (if
 field
                  then
 (TEDIT.SETSEL *STANDARD-OUTPUT* (CAR field)
                              (ADD1 (DIFFERENCE (CADR field)
                                           (CAR field)))
                              'LEFT T)))
         *STANDARD-OUTPUT*])

(AmIRegistered

  [LAMBDA NIL
                                             (* ; "Edited  8-Jan-88 18:00 by Masinter")


    (CL:FLET [(OK (NAMES)
                  (for
 wsn in
 (CH.LIST.OBJECTS NAMES 'WORKSTATION) when
 (EQUALALL \MY.NSADDRESS
                                                                               (LOOKUP.NS.SERVER
                                                                                wsn))
                     do
 (RETURN (LIST wsn]
           (OR (AND (ETHERHOSTNAME)
                    (OK (ETHERHOSTNAME)))
               (OK "*"])
)

(ADDTOVAR LAFITESPECIALFORMS
 ("Clearinghouse registry request" 'Requst-NS-Registry 
           "Make a form to request that the current machine be registered on the local Clearinghouse"
                                    ))
(UNMARKASCHANGED 'LAFITESPECIALFORMS 'VARS)
(SETQ LAFITEFORMSMENU NIL)
(PUTPROPS REGISTER-MACHINE COPYRIGHT ("Xerox Corporation" 1986 1987 1988))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (1298 4072 (Requst-NS-Registry 1308 . 3473) (AmIRegistered 3475 . 4070)))))
STOP