$!/* acf4:comp.os.vms / jj1h+@andrew.cmu.edu (Joseph Jackson) /  2:21 am  Jul  4, 1990 */
$!Here's the command procedure to build a LASERWRITER_DEVCTL text
$!library, as described in my previous message.  To unpack it, copy the
$!lines below into a file and execute it (@filename).
$!
$!Joe Jackson
$!
$! ------------------ CUT HERE -----------------------
$ v='f$verify(f$trnlnm("SHARE_VERIFY"))'
$!
$! This archive created by VMS_SHARE Version 7.1-004  3-AUG-1989
$!   On  4-JUL-1990 02:19:26.96   By user JJ1H 
$!
$! This VMS_SHARE Written by:
$!    Andy Harper, Kings College London UK
$!
$! Acknowledgements to:
$!    James Gray       - Original VMS_SHARE
$!    Michael Bednarek - Original Concept and implementation
$!
$! TO UNPACK THIS SHARE FILE, CONCATENATE ALL PARTS IN ORDER
$! AND EXECUTE AS A COMMAND PROCEDURE  (  @name  )
$!
$! THE FOLLOWING FILE(S) WILL BE CREATED AFTER UNPACKING:
$!       1. BUILD_LIBRARY.COM;1
$!
$set="set"
$set symbol/scope=(nolocal,noglobal)
$f=f$parse("SHARE_TEMP","SYS$SCRATCH:.TMP_"+f$getjpi("","PID"))
$e="write sys$error  ""%UNPACK"", "
$w="write sys$output ""%UNPACK"", "
$ if f$trnlnm("SHARE_LOG") then $ w = "!"
$ if f$getsyi("version") .ges. "V4.4" then $ goto START
$ e "-E-OLDVER, Must run at least VMS 4.4"
$ v=f$verify(v)
$ exit 44
$UNPACK: SUBROUTINE ! P1=filename, P2=checksum
$ if f$search(P1) .eqs. "" then $ goto file_absent
$ e "-W-EXISTS, File ''P1' exists. Skipped."
$ delete/nolog 'f'*
$ exit
$file_absent:
$ if f$parse(P1) .nes. "" then $ goto dirok
$ dn=f$parse(P1,,,"DIRECTORY")
$ w "-I-CREDIR, Creating directory ''dn'."
$ create/dir 'dn'
$ if $status then $ goto dirok
$ e "-E-CREDIRFAIL, Unable to create ''dn'. File skipped."
$ delete/nolog 'f'*
$ exit
$dirok:
$ w "-I-PROCESS, Processing file ''P1'."
$ define/user sys$output nl:
$ EDIT/TPU/NOSEC/NODIS/COM=SYS$INPUT 'f'/OUT='P1'
PROCEDURE Unpacker ON_ERROR ENDON_ERROR;SET(FACILITY_NAME,"UNPACK");SET(
SUCCESS,OFF);SET(INFORMATIONAL,OFF);f:=GET_INFO(COMMAND_LINE,"file_name");
buff:=CREATE_BUFFER(f,f);p:=SPAN(" ")@r&LINE_END;POSITION(BEGINNING_OF(buff))
;LOOP EXITIF SEARCH(p,FORWARD)=0;POSITION(r);ERASE(r);ENDLOOP;POSITION(
BEGINNING_OF(buff));g:=0;LOOP EXITIF MARK(NONE)=END_OF(buff);x:=
ERASE_CHARACTER(1);IF g = 0 THEN IF x="X" THEN MOVE_VERTICAL(1);ENDIF;IF x=
"V" THEN APPEND_LINE;MOVE_HORIZONTAL(-CURRENT_OFFSET);MOVE_VERTICAL(1);ENDIF;
IF x="+" THEN g:=1;ERASE_LINE;ENDIF;ELSE IF x="-" THEN g:=0;ENDIF;ERASE_LINE;
ENDIF;ENDLOOP;p:="`";POSITION(BEGINNING_OF(buff));LOOP r:=SEARCH(p,FORWARD);
EXITIF r=0;POSITION(r);ERASE(r);COPY_TEXT(ASCII(INT(ERASE_CHARACTER(3))));
ENDLOOP;o:=GET_INFO(COMMAND_LINE,"output_file");WRITE_FILE(buff,o);
ENDPROCEDURE;Unpacker;EXIT;
$ delete/nolog 'f'*
$ CHECKSUM 'P1'
$ IF CHECKSUM$CHECKSUM .eqs. P2 THEN $ EXIT
$ e "-E-CHKSMFAIL, Checksum of ''P1' failed."
$ ENDSUBROUTINE
$START:
$ create/nolog 'f'
X$! Build_library.com
X$!
X$! Joe Jackson,  3-JUL-1990
X$!
X$! Build a LASERWRITER_DEVCTL based on ScriptPrinter's CPS$DEVCTL by inserti
Vng some
X$! new code into the LPS$$ExitServerLoop and LPS$$SystemPages modules.
X$!
X$ ON ERROR THEN EXIT
X$ Default = "SYS$COMMON:`091SYSLIB`093"
X$ Prompt  = "Destination directory for LASERWRITER_DEVCTL `091 ''Default' `0
V93? "
X$ IF P1 .EQS. "" THEN INQUIRE P1 "''Prompt'"
X$ IF P1 .EQS. "" THEN P1 = Default
X$!
X$ COPY SYS$LIBRARY:CPS$DEVCTL.TLB 'P1'LASERWRITER_DEVCTL.TLB
X$!
X$ LIBRARY/TEXT /EXTRACT=LPS$$EXITSERVERLOOP /OUTPUT=LPS$$EXITSERVERLOOP 'P1'
VLASERWRITER_DEVCTL
X$ LIBRARY/TEXT /EXTRACT=LPS$$SYSTEMPAGES /OUTPUT=LPS$$SYSTEMPAGES 'P1'LASERW
VRITER_DEVCTL
X$!
X$ EDIT /EDT /COMMAND=SYS$INPUT LPS$$EXITSERVERLOOP.TXT
XSET NOSUMMARY
XFIND "% Copyright"+1
XINSERT ;%++
XINSERT ;% 1-July-1990, Joe Jackson, Carnegie Mellon University, jj1h+@andrew
V.cmu.edu
XINSERT ;% Changes to support Apple LaserWriter (tm) class printers
XINSERT ;% LN03Rs use string passwords, LWs use integer passwords.
XINSERT ;% Replace the string with 0 for my printer.
XINSERT ;pop 0
XINSERT ;%--
XEXIT
X$ EDIT /EDT /COMMAND=SYS$INPUT LPS$$SYSTEMPAGES.TXT
XSET NOSUMMARY
XFIND "% Copyright"+1
XINSERT ;%++
XINSERT ;% 1-July-1990, Joe Jackson, Carnegie Mellon University, jj1h+@andrew
V.cmu.edu
XINSERT ;% Changes to support Apple LaserWriter (tm) class printers; if neces
Vsary,
XINSERT ;% define PostScript extensions present on LN03R but normally absent
V on LWs.
XINSERT ;%`009papersize: always report "/lettertray true"
XINSERT ;%`009`091set`093defaultjobtimeout: define in terms of `091set`093def
Vaultimeouts
XINSERT ;%`009setvmlimit: pop the argument, ignoring the operator completely
XINSERT ;statusdict begin
XINSERT ;/papersize where `123pop`125 `123/papersize `123/lettertray true`125
V def`125 ifelse
XINSERT ;/defaultjobtimeout where `123pop`125 `123/defaultjobtimeout`032
XINSERT ; `123defaulttimeouts pop pop`125 def`125 ifelse
XINSERT ;/setdefaultjobtimeout where `123pop`125 `123/setdefaultjobtimeout`03
V2
XINSERT ; `123defaulttimeouts 3 2 roll pop setdefaulttimeouts`125 def`125 ife
Vlse
XINSERT ;/setvmlimit where `123pop`125 `123/setvmlimit `123pop`125 def`125 if
Velse
XINSERT ;end
XINSERT ;%--
XEXIT
X$!
X$ LIBRARY/TEXT/REPLACE 'P1'LASERWRITER_DEVCTL LPS$$EXITSERVERLOOP
X$ LIBRARY/TEXT/REPLACE 'P1'LASERWRITER_DEVCTL LPS$$SYSTEMPAGES
X$ LIBRARY/TEXT/LIST/HISTORY 'P1'LASERWRITER_DEVCTL
X$ EXIT
$ CALL UNPACK BUILD_LIBRARY.COM;1 1275727498
$ v=f$verify(v)
$ EXIT
/* ---------- */