(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED "11-Dec-87 19:18:17" {QV}<BURWELL>LISP>MULTIPLE-HARDCOPY.;2 12364
changes to%: (FNS MULTIPLE.HARDCOPY)
previous date%: "12-Oct-87 17:35:22" {QV}<BURWELL>LISP>MULTIPLE-HARDCOPY.;1)
(* "
Copyright (c) 1987 by Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT MULTIPLE-HARDCOPYCOMS)
(RPAQQ MULTIPLE-HARDCOPYCOMS [(FNS MH.GET.INPUT.FILE MH.MAKE.GLOSSARY MULTIPLE.HARDCOPY
MH.SET.STARTINGPAGE# TOC)
(P (TEDIT.ADD.MENUITEM TEDIT.DEFAULT.MENU '(Multiple% Hardcopy
'MULTIPLE.HARDCOPY
"Hardcopy a list of files setting starting page numbers."
])
(DEFINEQ
(MH.GET.INPUT.FILE
[LAMBDA (FILE) (* ; "Edited 12-Oct-87 17:32 by Becky:")
(* Returns the file if the file is accessible or otherwise pesters the
unwitting user until an existing file is supplied or nil to abort)
(PROG NIL
LOOP
(OR FILE (RETURN))
(AND (INFILEP FILE)
(RETURN FILE))
(printout T (CONCAT FILE " [not found.] ")
T "Type another input file (NIL to abort): ")
(SETQ FILE (READ T))
(OR FILE (RETURN))
(GO LOOP])
(MH.MAKE.GLOSSARY
[LAMBDA (FILENAME) (* ; "Edited 12-Oct-87 17:33 by Becky:")
(* This function relies on the function TOC
(written by Nick Briggs) to produce a table of contents.
It just takes the TEdit stream returned by TOC and TEDIT.PUTs it to a file.)
(COND
((BOUNDP 'MULTIPLE.HARDCOPY.LIST)
(TEDIT.PUT (TOC MULTIPLE.HARDCOPY.LIST)
FILENAME))
(T (PRINTOUT T "MULTIPLE.HARDCOP must be run first" T])
(MULTIPLE.HARDCOPY
[LAMBDA (STREAM FILES GLOSSARY.FILE TOFILE? DONTSEND UNFORMATTED? BREAKPAGETITLE SERVER
PRINTOPTIONS) (* ; "Edited 11-Dec-87 19:17 by Burwell")
(* ;; "HARDCOPIES all the files in FILES making sure that the files are numbered consecutively. If STREAM is supplied then it should be a TEdit stream. The intent is that one could set up one's desired page looks in a TEdit window and then pass that TEdit stream to MULTIPLE.HARDCOPY which will use those page looks. If a STREAM is not given then a fresh TEdit window is started. FILES should be a list of files to hardcopy in the order that they should be numbered. GLOSSARY.FILE, if given, should be the name of a file. If given then after MULTIPLE.HARDCOPY is done hardcopying it will use the MH.MAKE.GLOSSARY to make a table of contents for the files and save the table of contents in GLOSSARY.FILE. If TOFILE? is NON-NIL then an IP file will be created for each file in FILES that is the same name as the file but with extension IP. If DONTSEND is NON-NIL then the files will not be sent to the printer (this only makes sense if you're creating IP files). If UNFORMATTED? is NON-NIL then the files will be hardcopied without formatting information. BREAKPAGETITLE, SERVER and PRINTOPTIONS are the same as per TEDIT.HARDCOPY. After MULTIPLE.HARDCOPY is done, it returns a variable MULTIPLE.HARDCOPY.LIST which is a useful list of information about this hardcopy process. The list is of the form: (<starting page#> . <list of pairs>) where each pair is of the form (<name of file> <start page# of file>)")
(RESETVAR NSPRINT.WATCHERFLG NIL (PROG* (FRAME LOCALINFO INITIAL.DEFAULTPG PG)
(OR FILES (SETQ FILES (TTYIN "files to hardcopy>>"))
(RETURN (PRINTOUT T "No files specified.")))
[OR STREAM (SETQ STREAM
(TEXTSTREAM (PROCESSPROP
(TEDIT (MH.GET.INPUT.FILE
(CAR FILES)))
'WINDOW]
(COND
((ATOM FILES)
(SETQ FILES (LIST FILES)))
(FILES))
(SETQ FRAME (OR (fetch TXTPAGEFRAMES of (TEXTOBJ STREAM))
TEDIT.PAGE.FRAMES))
[SETQ LOCALINFO (fetch REGIONLOCALINFO
of (COND
((LISTP FRAME)
(CAR FRAME))
(T FRAME]
[SETQ INITIAL.DEFAULTPG (AND (LISTGET LOCALINFO
'STARTINGPAGE#)
(SUB1 (LISTGET LOCALINFO
'STARTINGPAGE#]
(SETQ PG (OR INITIAL.DEFAULTPG 0))
(SETQ MULTIPLE.HARDCOPY.LIST NIL)
[ADVISE 'NEWPAGE.IP 'AFTER
'(PROG NIL
(DECLARE%: (SPECVARS PG))
(ADD PG 1)
(RETURN !VALUE]
[for FILE in FILES
do (PROGN (SETQ FILE (MH.GET.INPUT.FILE FILE))
(OR FILE (RETURN))
(PROMPTPRINT "MULTIPLE.HARDCOPY: "
(FULLNAME FILE))
(TEDIT.GET (TEXTOBJ STREAM)
FILE UNFORMATTED?)
(replace TXTPAGEFRAMES of (TEXTOBJ STREAM)
with FRAME)
(MH.SET.STARTINGPAGE# (ADD1 PG)
FRAME)
(TEDIT.HARDCOPY STREAM
(COND
(TOFILE? (PACKFILENAME
'EXTENSION
'IP
'BODY FILE))
(T NIL))
DONTSEND BREAKPAGETITLE SERVER
PRINTOPTIONS)
(SETQ MULTIPLE.HARDCOPY.LIST
(NCONC1 MULTIPLE.HARDCOPY.LIST
(CONS FILE PG]
(UNADVISE NEWPAGE.IP)
(MH.SET.STARTINGPAGE# (AND INITIAL.DEFAULTPG (ADD1
INITIAL.DEFAULTPG
))
FRAME)
(RETURN (COND
(MULTIPLE.HARDCOPY.LIST
(SETQ MULTIPLE.HARDCOPY.LIST
(CONS (OR (AND INITIAL.DEFAULTPG
(ADD1 INITIAL.DEFAULTPG))
1)
MULTIPLE.HARDCOPY.LIST))
(COND
(GLOSSARY.FILE (MH.MAKE.GLOSSARY
GLOSSARY.FILE)
(PRINTOUT T (CONCAT
"Glossary file in: "
(FULLNAME
GLOSSARY.FILE
))
T)))
MULTIPLE.HARDCOPY.LIST])
(MH.SET.STARTINGPAGE#
[LAMBDA (PG# PAGE.FRAMES) (* edited%: "22-Aug-86 12:15")
(* Sets the starting page of a
PAGE.FRAME.)
[COND
((LISTP PAGE.FRAMES)
(SETQ PAGE.FRAMES (CAR PAGE.FRAMES]
(LET ((LOCAL.INFO (fetch REGIONLOCALINFO of PAGE.FRAMES)))
(COND
(LOCAL.INFO (LISTPUT (fetch REGIONLOCALINFO of PAGE.FRAMES)
'STARTINGPAGE# PG#))
(T (replace REGIONLOCALINFO of PAGE.FRAMES with (LIST 'STARTINGPAGE# PG#])
(TOC
[LAMBDA (FILE) (* edited%: "22-Aug-86 11:48")
(* (* N.H.Briggs " 8-Apr-86 11:23"))
(LET (TOCSTREAM TOCINFO TOCOUTSTREAM STARTPAGE)
(if (LISTP FILE)
then (SETQ TOCINFO FILE)
else [SETQ TOCINFO (READ (SETQ TOCSTREAM (OPENSTREAM FILE 'INPUT]
(CLOSEF TOCSTREAM))
(SETQ TOCOUTSTREAM (OPENTEXTSTREAM ""))
(SETQ STARTPAGE (CAR TOCINFO))
[for TOCENTRY in (CDR TOCINFO) do (TEDIT.INSERT TOCOUTSTREAM (FILENAMEFIELD (CAR TOCENTRY)
'NAME))
(TEDIT.INSERT TOCOUTSTREAM (CHARACTER (CHARCODE TAB)))
(TEDIT.INSERT TOCOUTSTREAM (MKSTRING STARTPAGE))
(TEDIT.INSERT TOCOUTSTREAM (CHARACTER (CHARCODE CR)))
(SETQ STARTPAGE (ADD1 (CDR TOCENTRY]
(TEDIT.PARALOOKS TOCOUTSTREAM '(TABS (NIL (360 . DOTTEDLEFT))
RIGHTMARGIN 456) 1 (GETEOFPTR TOCOUTSTREAM))
TOCOUTSTREAM])
)
(TEDIT.ADD.MENUITEM TEDIT.DEFAULT.MENU '(Multiple% Hardcopy 'MULTIPLE.HARDCOPY
"Hardcopy a list of files setting starting page numbers."
))
(PUTPROPS MULTIPLE-HARDCOPY COPYRIGHT ("Xerox Corporation" 1987))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (913 12043 (MH.GET.INPUT.FILE 923 . 1544) (MH.MAKE.GLOSSARY 1546 . 2100) (
MULTIPLE.HARDCOPY 2102 . 10048) (MH.SET.STARTINGPAGE# 10050 . 10749) (TOC 10751 . 12041)))))
STOP