(FILECREATED "17-Oct-85 16:29:45" {DSK}<LISPFILES>IMERR>IRMUPDATE.;2 17752
changes to: (VARS IRMUPDATECOMS)
(FNS IRM.UPDATE IRM.DUMP)
previous date: "17-Oct-85 14:49:19" {DSK}<LISPFILES>IMERR>IRMUPDATE.;1)
(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT IRMUPDATECOMS)
(RPAQQ IRMUPDATECOMS ((FILES HELPSYS DINFO (FROM {ERIS}<SANNELLA>LISP>)
IMTRAN IMTEDIT IMNAME)
(FNS IRM.UPDATE IRM.SEND.INFO DINFO.SEND.INFO HELPSYS.SEND.INFO)
(* Functions from IMTEDIT that needed to be slightly changed. These are
MOVDed to their IRM-less counterparts in IRM.UPDATE)
(FNS IRM.DUMP IRM.SUBSEC#TOPROG IRM.FORMAT.DEF)
(* need record definitions to compile this file)
(VARS (IM.HOST (QUOTE {ERINYES}))
(IM.DIR (QUOTE <LISPMANUAL>))
(DIRECTORIES (CONS (PACKFILENAME (QUOTE HOST)
IM.HOST
(QUOTE DIRECTORY)
IM.DIR)
DIRECTORIES))
IRM.TEXT.PROPS IRM.CHAPTERS)))
(FILESLOAD HELPSYS DINFO (FROM {ERIS}<SANNELLA>LISP>)
IMTRAN IMTEDIT IMNAME)
(DEFINEQ
(IRM.UPDATE
[LAMBDA NIL (* mjs "17-Oct-85 16:29")
(LET [(IRM.HFILE (CREATEHASHFILE (OR IRM.HASHFILE.NAME (PACKFILENAME (QUOTE DIRECTORY)
IRM.HOST&DIR
(QUOTE NAME)
(QUOTE IRM)
(QUOTE EXTENSION)
(QUOTE HASHFILE)))
(QUOTE EXPR]
(RESETLST (RESETSAVE NIL (LIST (QUOTE CLOSEHASHFILE)
IRM.HASHFILE.NAME))
(IMNAME.RESETSAVE.MOVD (FUNCTION IRM.DUMP)
(FUNCTION DUMP))
(IMNAME.RESETSAVE.MOVD (FUNCTION IRM.SEND.INFO)
(FUNCTION SEND.INFO))
(IMNAME.RESETSAVE.MOVD (FUNCTION IRM.FORMAT.DEF)
(FUNCTION FORMAT.DEF))
(IMNAME.RESETSAVE.MOVD (FUNCTION IRM.SUBSEC#TOPROG)
(FUNCTION SUBSEC#TOPROG))
(* have to turn off all formatting)
(IMNAME.RESETSAVE.MOVD (FUNCTION NILL)
(FUNCTION CREATE.FOLIO.OBJECT))
(IMNAME.RESETSAVE.MOVD (FUNCTION NILL)
(FUNCTION DUMP.HEADERS.FOOTERS))
(IMNAME.RESETSAVE.MOVD (FUNCTION NILL)
(FUNCTION IM.BOUT.IMAGEOBJ))
(IMNAME.RESETSAVE.MOVD (FUNCTION NILL)
(FUNCTION TEDIT.INSERT.OBJECT))
(IMNAME.RESETSAVE.MOVD (FUNCTION NILL)
(FUNCTION TEDIT.LOOKS))
(IMNAME.RESETSAVE.MOVD (FUNCTION NILL)
(FUNCTION TEDIT.PARALOOKS))
(IMNAME.RESETSAVE.MOVD (FUNCTION NILL)
(FUNCTION TEDIT.PAGEFORMAT))
(IMNAME.RESETSAVE.MOVD (FUNCTION NILL)
(FUNCTION TEDIT.COMPOUND.PAGEFORMAT))
(IMNAME.RESETSAVE.MOVD (FUNCTION NILL)
(FUNCTION TEDIT.SINGLE.PAGEFORMAT))
(for IRM.CHAPTER in (MAPCAR IRM.CHAPTERS (FUNCTION CAR))
bind IM.FILE TED.FILE DINFO.PREVIOUS DINFO.TOP DINFO.NODELST IRM.KEYWORDS
declare: (SPECVARS IRM.CHAPTER IRM.HFILE IM.FILE TED.FILE DINFO.PREVIOUS
DINFO.TOP DINFO.NODELST IRM.KEYWORDS)
first ([SETQ DINFO.PREVIOUS (SETQ DINFO.TOP (create DINFONODE
ID ←(QUOTE
IRM.TOP)
LABEL ← "IRM Top"
FILE ←(QUOTE
IRM-TOP.TXT]
(push DINFO.NODELST DINFO.TOP))
do (SETQ IM.FILE (PACKFILENAME (QUOTE HOST)
IM.HOST
(QUOTE DIRECTORY)
IM.DIR
(QUOTE NAME)
IRM.CHAPTER
(QUOTE EXTENSION)
(QUOTE IM)))
(SETQ TED.FILE (PACKFILENAME (QUOTE HOST)
(FILENAMEFIELD IRM.HOST&DIR
(QUOTE HOST))
(QUOTE DIRECTORY)
(FILENAMEFIELD IRM.HOST&DIR
(QUOTE DIRECTORY))
(QUOTE NAME)
IRM.CHAPTER
(QUOTE EXTENSION)
(QUOTE TXT)))
(SETQ GLOBAL.CHAPTER.NUMBER (CADR (FASSOC IRM.CHAPTER IRM.CHAPTERS)
))
(PRINTOUT T T "*** Updating " IRM.CHAPTER " ***" T T)
(LET ((STREAM (IM.TEDIT IM.FILE T)))
(TEDIT.INSERT STREAM (CONCAT "
Copyright (c) " (SUBSTRING (DATE (DATEFORMAT NO.TIME YEAR.LONG))
8)
" Xerox Corporation. All rights reserved.
")
(fetch (TEXTOBJ TEXTLEN) of (TEXTOBJ STREAM)
))
(TEDIT.PUT STREAM TED.FILE NIL T))
(CLOSEF? TED.FILE)
(PRINTOUT T T "*** Finished updating " IRM.CHAPTER " ***" T T)
finally (PRINTOUT T T "*** Done processing manual files ***" T T)
(PRINTOUT T T "*** Saving keyword list in hashfile ***" T T)
(PUTHASHFILE (QUOTE irm.keywords)
IRM.KEYWORDS IRM.HFILE)
(* lowercasing these makes them "internal", as all
keyword lookup is upper case.
Maybe they should be in a separate file...)
(PUTHASHFILE (QUOTE irm.chapters)
IRM.CHAPTERS IRM.HFILE)
(PRINTOUT T T "*** Writing DInfo Graph ***" T T)
(DINFO.WRITE.GRAPH (create DINFOGRAPH
NODELST ← DINFO.NODELST
TOPNODEID ←(fetch (DINFONODE
ID)
of DINFO.TOP)
TEXTPROPS ← IRM.TEXT.PROPS
LOOKUPFN ←(QUOTE DINFO.IRM.LOOKUP))
(PACKFILENAME (QUOTE HOST)
(FILENAMEFIELD IRM.HOST&DIR
(QUOTE
HOST))
(QUOTE DIRECTORY)
(FILENAMEFIELD IRM.HOST&DIR
(QUOTE
DIRECTORY))
(QUOTE NAME)
(QUOTE IRM)
(QUOTE EXTENSION)
(QUOTE DINFOGRAPH])
(IRM.SEND.INFO
[LAMBDA (NAME TYPE SAV INFO) (* drc: "19-Jul-85 15:23")
(OR (ATOM TYPE)
(SETQ TYPE (PACK TYPE)))
(SELECTQ TYPE
((CHAPTER SUBSEC)
(DINFO.SEND.INFO NAME TYPE SAV INFO))
(HELPSYS.SEND.INFO NAME TYPE SAV INFO])
(DINFO.SEND.INFO
[LAMBDA (NAME TYPE SAV INFO) (* drc: "23-Aug-85 23:07")
(* Uses: IM.OUTFILE IRM.CHAPTER SUBSEC.COUNT.LIST
DINFO.PREVIOUS DINFO.NODELST DINFO.TOP)
(LET* ((LABEL (PACKC (CAR SAV)))
(DINFO.CURRENT (create DINFONODE
ID ←[PACK (CDR (REVERSE (for X in SUBSEC.COUNT.LIST
join (LIST X (QUOTE -]
LABEL ← LABEL
PREVIOUSNODE ←(fetch (DINFONODE ID) of DINFO.PREVIOUS)
FILE ←(PACKFILENAME (QUOTE NAME)
IRM.CHAPTER
(QUOTE EXTENSION)
(QUOTE TXT))
FROMBYTE ←(GETFILEPTR IM.OUTFILE)))
(DINFO.PARENT (if (CDR SUBSEC.COUNT.LIST)
then (* This is here because it shouldn't be done on top
level nodes)
(replace (DINFONODE TOBYTE) of DINFO.PREVIOUS with (GETFILEPTR
IM.OUTFILE))
(FASSOC [PACK (CDR (REVERSE (for X in (CDR SUBSEC.COUNT.LIST)
join (LIST X (QUOTE -]
DINFO.NODELST)
else DINFO.TOP)))
(replace (DINFONODE PARENT) of DINFO.CURRENT with (fetch (DINFONODE ID) of DINFO.PARENT))
(replace (DINFONODE CHILDREN) of DINFO.PARENT with (CONS (fetch (DINFONODE ID)
of DINFO.CURRENT)
(fetch (DINFONODE CHILDREN)
of DINFO.PARENT)))
(replace (DINFONODE NEXTNODE) of DINFO.PREVIOUS with (fetch (DINFONODE ID) of DINFO.CURRENT)
)
(push DINFO.NODELST DINFO.CURRENT)
(SETQ DINFO.PREVIOUS DINFO.CURRENT])
(HELPSYS.SEND.INFO
[LAMBDA (NAME TYPE SAV INFO) (* drc: "11-Sep-85 00:12")
(* uses: IRM.HFILE IRM.CHAPTER IM.OUTFILE IRM.KEYWORDS)
(SETQ NAME (U-CASE NAME))
(OR (FMEMB NAME IRM.KEYWORDS)
(SETQ IRM.KEYWORDS (CONS NAME IRM.KEYWORDS)))
(LET [(OTHER.REFS (for REF in (GETHASHFILE NAME IRM.HFILE)
join (if (EQ (FILENAMEFIELD OUTFILE.NAME (QUOTE VERSION))
(FILENAMEFIELD (fetch (IRMREFERENCE CHAPTER) of REF)
(QUOTE VERSION)))
then (LIST REF)
else NIL]
(PUTHASHFILE NAME
(if [for REF in OTHER.REFS do (COND
((AND (EQ SAV (QUOTE END))
(EQ T (fetch (IRMREFERENCE TO#)
of REF)))
(replace (IRMREFERENCE TO#) of REF
with (GETFILEPTR IM.OUTFILE))
(RETURN T]
then OTHER.REFS
else (CONS (create IRMREFERENCE
TYPE ← TYPE
CHAPTER ← IRM.CHAPTER
ITEM ← NAME
FROM# ←(GETFILEPTR IM.OUTFILE)
TO# ←(EQ SAV (QUOTE BEGINNING))
PRIMARYFLG ←(OR (FMEMB (QUOTE *DEF*)
INFO)
(FMEMB (QUOTE *PRIMARY*)
INFO)))
OTHER.REFS))
IRM.HFILE])
)
(* Functions from IMTEDIT that needed to be slightly changed. These are MOVDed to their
IRM-less counterparts in IRM.UPDATE)
(DEFINEQ
(IRM.DUMP
[LAMBDA (C) (* mjs "17-Oct-85 16:28")
(if (EQ C (CHARCODE CR))
then (IM.TEDIT.DUMP.COMMANDS (QUOTE (CR)))
elseif (ZEROP C)
then (* flush null chars)
NIL
elseif (LISTP C)
then (* treat lists as Dump Commands)
(IM.TEDIT.DUMP.COMMANDS C)
elseif IM.TEDIT.CR.FLG
then (if (EQ C (CHARCODE SPACE))
then (* ignore spaces after a CR)
(NILL)
elseif (EQ IM.TEDIT.CR.FLG (QUOTE ONE))
then (* if there was only one CR, put out a space and the
following char)
(BOUT IM.OUTFILE (CHARCODE SPACE))
(SETQ IM.TEDIT.CR.FLG NIL)
(DUMP C)
elseif (EQ IM.TEDIT.CR.FLG (QUOTE MANY))
then (* time to start a new para)
(SETQ IM.TEDIT.CR.FLG NIL)
(DUMP C))
elseif (SMALLP C)
then (BOUT IM.OUTFILE (if (LESSP C 256)
then C
else (CHARCODE SPACE])
(IRM.SUBSEC#TOPROG
[LAMBDA NIL (* drc: "18-Jul-85 14:38")
(* I moved the call to SEND.INFO so that it is called
before the title is printed.
-doug)
(SAVE.ARGS TITLE)
(PROG ((SUBSEC.COUNT.LIST (CONS (SETQ SUBSEC.LAST.SUB (ADD1 SUBSEC.LAST.SUB))
SUBSEC.COUNT.LIST))
(SUBSEC.LAST.SUB 0)
PRINTING.TITLE SEC.STRING SEC.LIST)
(DECLARE (SPECVARS SUBSEC.COUNT.LIST SUBSEC.LAST.SUB))
(* SUBSEC.COUNT.LIST is a reverse list of the subsec numbers and chapter num, so if this is subsec 3.5.7,
SUBSEC.COUNT.LIST = (7 5 3))
(* set SUBSEC.SKIP.STRING to skip before header
(<<<DELETED IN IM.TEDIT>>>))
(* set PRINTING.TITLE to subsec title <u-case if
1st-level subsec)
(SETQ PRINTING.TITLE (GET.ARG.SAV TITLE))
(SETQ SEC.STRING "")
(SETQ SEC.LIST (REVERSE SUBSEC.COUNT.LIST))
(if (EQ (CAR SEC.LIST)
0)
then (SETQ SEC.LIST (CDR SEC.LIST)))
[for X on SEC.LIST do (SETQ SEC.STRING (CONCAT SEC.STRING (CAR X)
(if (CDR X)
then "."
else ""]
(SEND.INFO [U-CASE (MKATOM (PARSE.STRING (GET.ARG.SAV TITLE]
(QUOTE SUBSEC)
(GET.ARG.SAV TITLE))
[if (EQ 2 (LENGTH SUBSEC.COUNT.LIST))
then (* major heading)
(DUMP.HEADERS.FOOTERS (U-CASE (PARSE.STRING PRINTING.TITLE))
NIL)
(DUMP.HRULE 2 55
(QUOTE (QUAD LEFT 1STLEFTMARGIN 0 LEFTMARGIN 0 LINELEADING 0
PARALEADING 0 POSTPARALEADING 0)))
(DUMPOUT FONT (QUOTE (FAMILY MODERN SIZE 14 FACE BRR))
PARALOOKS
[QUOTE (QUAD LEFT 1STLEFTMARGIN 0 LEFTMARGIN 0 LINELEADING 0 PARALEADING
0 POSTPARALEADING 0 TABS (18 (40 . LEFT]
DUMP.CHARS SEC.STRING DUMP.CHARS " " TAB DUMP.CHARS PRINTING.TITLE CR CR)
(DUMP.HRULE 1 NIL
(QUOTE (QUAD LEFT 1STLEFTMARGIN 0 LEFTMARGIN 0 LINELEADING 0
PARALEADING 0 POSTPARALEADING 0)))
elseif (EQ 3 (LENGTH SUBSEC.COUNT.LIST))
then (* important heading)
(DUMPOUT FONT (QUOTE (FAMILY MODERN SIZE 12 FACE BRR))
PARALOOKS
[QUOTE (QUAD LEFT 1STLEFTMARGIN 0 LEFTMARGIN 0 LINELEADING 0 PARALEADING
12 POSTPARALEADING 0 TABS (18 (40 . LEFT]
DUMP.CHARS SEC.STRING DUMP.CHARS " " TAB DUMP.CHARS PRINTING.TITLE CR CR)
(DUMP.HRULE 1 NIL
(QUOTE (QUAD LEFT 1STLEFTMARGIN 0 LEFTMARGIN 0 LINELEADING 0
PARALEADING 0 POSTPARALEADING 0)))
else (* plain heading for 3rd or greater level headings)
(DUMPOUT FONT (QUOTE (FAMILY MODERN SIZE 10 FACE BRR))
PARALOOKS
[QUOTE (QUAD LEFT 1STLEFTMARGIN 0 LEFTMARGIN 0 LINELEADING 0 PARALEADING 12
POSTPARALEADING 0 TABS (18 (40 . LEFT]
DUMP.CHARS SEC.STRING DUMP.CHARS " " TAB DUMP.CHARS PRINTING.TITLE CR CR)
(DUMP.HRULE 1 NIL
(QUOTE (QUAD LEFT 1STLEFTMARGIN 0 LEFTMARGIN 0 LINELEADING 0 PARALEADING
0 POSTPARALEADING 0]
(if (EQ TO.ARG.NAME (QUOTE TEXT))
then (DUMP.ARG)
(DUMPOUT CR CR])
(IRM.FORMAT.DEF
[LAMBDA (NAME TYPE SAV TYPESTRING) (* drc: "18-Jul-85 14:43")
(* SEND.INFO is called both before and after here indicating the beginning and end of the definition <needed by
HELPSYS>. FORMAT.DEF from IMTEDIT does not do this. -doug)
(IM.HOLD.FOOTNOTES (DUMPOUT CR CR)
(SEND.INFO (U-CASE NAME)
TYPE
(QUOTE BEGINNING)
(QUOTE (*DEF*)))
(DUMPOUT PARALOOKS
[QUOTE (QUAD LEFT 1STLEFTMARGIN 75 LEFTMARGIN 204 LINELEADING 0
PARALEADING 20 POSTPARALEADING 0 TABS
(18 (504 . RIGHT]
DUMP.CHARS SAV DUMP.CHARS " " TAB FONT NIL DUMP.CHARS "[" DUMP.CHARS
(if TYPESTRING
else (LIST.TO.STRING TYPE))
DUMP.CHARS "]" CR CR)
(DUMPOUT CR CR PARALOOKS (QUOTE (PARALEADING 0)))
(if (EQ TO.ARG.NAME (QUOTE TEXT))
then (DUMPOUT DUMP.ARG CR CR)
(DUMP.HRULE 1 NIL)
elseif TO.ARG.NAME
then (ERROR "FORMAT.DEF called when not at {TEXT or End of TO"))
(SEND.INFO (U-CASE NAME)
TYPE
(QUOTE END)
(QUOTE (*DEF*])
)
(* need record definitions to compile this file)
(RPAQQ IM.HOST {ERINYES})
(RPAQQ IM.DIR <LISPMANUAL>)
(RPAQ DIRECTORIES (CONS (PACKFILENAME (QUOTE HOST)
IM.HOST
(QUOTE DIRECTORY)
IM.DIR)
DIRECTORIES))
(RPAQQ IRM.TEXT.PROPS (CLEARGET T PARALOOKS (PARALEADING 5 POSTPARALEADING 5 QUAD JUSTIFIED)))
(RPAQQ IRM.CHAPTERS ((ChapAck 0 "Background and Acknowlegements")
(ChapIntro 1 "Introduction")
(ChapLitatoms 2 "Litatoms")
(ChapLists 3 "Lists")
(ChapStrings 4 "Strings")
(ChapArrays 5 "Arrays")
(ChapHashArrays 6 "Hash Arrays")
(ChapNumbers 7 "Numbers")
(ChapRecordPackage 8 "Record Package")
(ChapControlFns 9 "Conditionals and Iterative Statements")
(ChapFnDef 10 "Function Definition, Manipulation, and Evaluation")
(ChapStack 11 "Variable Bindings and the Interlisp Stack")
(ChapMisc 12 "Miscellaneous")
(ChapExec 13 "Interlisp Executive")
(ChapErrors 14 "Errors")
(ChapBreaking 15 "Breaking")
(ChapEditor 16 "Editor")
(ChapFP 17 "File Package")
(ChapCompiler 18 "Compiler")
(ChapMasterScope 19 "Master Scope")
(ChapDWIM 20 "DWIM")
(ChapCLISP 21 "CLISP")
(ChapPerformance 22 "Performance")
(ChapProcesses 23 "Processes")
(ChapFiles 24 "Files")
(ChapIO 25 "Input/Output")
(ChapUserIO 26 "User IO")
(ChapGraphics 27 "Graphics")
(ChapWindows 28 "Windows")
(ChapHardcopy 29 "Hardcopy")
(ChapTerminal 30 "Terminal")
(ChapEther 31 "Ethernet")))
(PUTPROPS IRMUPDATE COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1099 9649 (IRM.UPDATE 1109 . 6061) (IRM.SEND.INFO 6063 . 6381) (DINFO.SEND.INFO 6383 .
8211) (HELPSYS.SEND.INFO 8213 . 9647)) (9784 16000 (IRM.DUMP 9794 . 11101) (IRM.SUBSEC#TOPROG 11103 .
14808) (IRM.FORMAT.DEF 14810 . 15998)))))
STOP