(FILECREATED "29-Nov-84 13:38:06" {IVY}<TEDIT>TFBRAVO.;8 49312
changes to: (VARS TFBRAVOCOMS)
(FNS \TFBRAVO.READ.CHARLOOKS \TFBRAVO.FONT.FROM.CHARLOOKS \TFBRAVO.INIT.CHARLOOKS
\TFBRAVO.WRITE.RUN \TFBRAVO.INIT.PARALOOKS)
previous date: "21-Nov-84 15:44:10" {IVY}<TEDIT>TFBRAVO.;7)
(* Copyright (c) 1984 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT TFBRAVOCOMS)
(RPAQQ TFBRAVOCOMS [(FILES TEDIT TEXTOFD)
[DECLARE: EVAL@COMPILE DONTCOPY
(COMS (* Compile-time needs)
(RECORDS FONT PARA RUN)
(CONSTANTS (PTSPERINCH 72)
(DefaultLeftMargin 2540)
(DefaultFirstLineLeftMargin 2540)
(DefaultRightMargin 19050)
(HardwareLeftMargin 2540)
(HardwareRightMargin (ITIMES 8 2540))
(BRAVO.TRAILER.CHARS (QUOTE (l d z x e y k j c q %( %) , s S u U b
B i I g G v V t f o % \ 0 1 2 3 4
5 6 7 8 9]
(FNS \TFBRAVO.FIND.LAST.TRAILER \TFBRAVO.HANDLE.HEADING \TFBRAVO.INIT.CHARLOOKS
\TFBRAVO.PARSE.PROFILE.PARA \TFBRAVO.PARSE.PROFILE.VALUE \TFBRAVO.GET.FONTSIZE
\TFBRAVO.GET.FONTSTYLE \TFBRAVO.WRITE.RUN \TFBRAVO.ASSERT \SHIFT.DOCUMENT
\TEDIT.BRAVOFILE? \TEST.CHARACTER.LOOKS \TEST.PARAGRAPH.LOOKS)
(FNS \TFBRAVO.COPY.NAMEDTAB \TFBRAVO.PUT.NAMEDTAB \TFBRAVO.GET.NAMEDTAB \TFBRAVO.ADD.NAMEDTAB
\NAMEDTABNYET \NAMEDTABSIZE \NAMEDTAB.INIT)
(FNS \TFBRAVO.APPLY.PARALOOKS TEDITFROMBRAVO \TFBRAVO.WRITE.PARAGRAPH \TFBRAVO.WRITE.RUNS
\TFBRAVO.SPREAD.LOOKS \TFBRAVO.PARSE.PARA \TFBRAVO.INIT.PARALOOKS
\TFBRAVO.READ.PARALOOKS \TFBRAVO.READ.CHARLOOKS \TFBRAVO.READ.USER.CM \TFBRAVO.GETPARAMS
\TFBRAVO.PARAMNAMEP \TFBRAVO.EOLS \TFBRAVO.LCASER \TFBRAVO.FONT.FROM.CHARLOOKS)
(INITVARS (USER.CM.RDTBL (COPYREADTABLE))
(PROFILE.PARA.RDTBL (COPYREADTABLE)))
(P (SETSYNTAX (CHARCODE :)
(QUOTE SEPRCHAR)
PROFILE.PARA.RDTBL)
(SETSYNTAX (CHARCODE EOL)
(QUOTE BREAKCHAR)
PROFILE.PARA.RDTBL)
(SETSYNTAX (CHARCODE ↑Z)
(QUOTE SEPRCHAR)
PROFILE.PARA.RDTBL))
(GLOBALVARS \NAMEDTAB.IMAGEFNS)
(DECLARE: DONTEVAL@LOAD DOCOPY (P (ADDTOVAR TEDIT.INPUT.FORMATS (\TEDIT.BRAVOFILE?
TEDITFROMBRAVO))
(\NAMEDTAB.INIT])
(FILESLOAD TEDIT TEXTOFD)
(DECLARE: EVAL@COMPILE DONTCOPY
(* Compile-time needs)
[DECLARE: EVAL@COMPILE
(RECORD FONT (SIZE STYLE THICKNESS . SLANT))
(RECORD PARA (PARALOOKS . RUNS))
(RECORD RUN (RUNLENGTH . RUNLOOKS))
]
(DECLARE: EVAL@COMPILE
(RPAQQ PTSPERINCH 72)
(RPAQQ DefaultLeftMargin 2540)
(RPAQQ DefaultFirstLineLeftMargin 2540)
(RPAQQ DefaultRightMargin 19050)
(RPAQQ HardwareLeftMargin 2540)
(RPAQ HardwareRightMargin (ITIMES 8 2540))
(RPAQQ BRAVO.TRAILER.CHARS (l d z x e y k j c q %( %) , s S u U b B i I g G v V t f o % \ 0 1 2 3 4
5 6 7 8 9))
[CONSTANTS (PTSPERINCH 72)
(DefaultLeftMargin 2540)
(DefaultFirstLineLeftMargin 2540)
(DefaultRightMargin 19050)
(HardwareLeftMargin 2540)
(HardwareRightMargin (ITIMES 8 2540))
(BRAVO.TRAILER.CHARS (QUOTE (l d z x e y k j c q %( %) , s S u U b B i I g G v V t f o %
\ 0 1 2 3 4 5 6 7 8 9]
)
)
(DEFINEQ
(\TFBRAVO.FIND.LAST.TRAILER
[LAMBDA (FILE) (* jds "22-Aug-84 14:33")
(* scans backwards from the end of the file trying to find the beginning of the last Bravo trailer.
Returns NIL if not found, otherwise T)
(PROG ((STREAM (GETSTREAM FILE)))
(SETFILEPTR STREAM -1)
(RETURN (COND
[(IGREATERP (GETFILEPTR STREAM)
0)
(COND
((NEQ (\BACKBIN STREAM)
(CHARCODE CR)) (* last character of a trailer must be a carriage
return)
NIL)
(T (while (AND (IGREATERP (GETFILEPTR STREAM)
0)
(MEMB (CHARACTER (\BACKBIN STREAM))
BRAVO.TRAILER.CHARS))
do NIL)
(COND
((EQ (\PEEKBIN STREAM)
(CHARCODE ↑Z)) (* this is a potentially legal trailer)
T)
(T NIL]
(T (* empty files are not Bravo files.
It says here!)
NIL])
(\TFBRAVO.HANDLE.HEADING
[LAMBDA (INPUT TEXTOBJ) (* gbn "18-Oct-84 21:56")
(* Called from \tfbravo.parse.profile.para)
(DECLARE: USEDFREE NEXTPARAPTR)
(PROG ((AFTERHEADINGPTR)
PARALOOKS)
(SETFILEPTR IN NEXTPARAPTR)
(SETQ HEADINGPARA (\TFBRAVO.PARSE.PARA USER.CM.PARALOOKS IN))
(SETQ AFTERHEADINGPTR (GETFILEPTR IN))
(SETQ PARALOOKS (fetch PARALOOKS of HEADINGPARA))
(replace FMTPARATYPE of PARALOOKS with (QUOTE PAGEHEADING))
(* This is where the vertical tab info is placed for the heading, remove the special x and y and use them as the
position for the descriptor)
(SETQ HEADINGDESC (LIST (GENSYM (QUOTE PageHeading))
(OR (fetch FMTSPECIALX of PARALOOKS)
0)
(OR (fetch FMTSPECIALY of PARALOOKS)
0)))
(replace FMTPARASUBTYPE of PARALOOKS with (CAR HEADINGDESC))
(replace FMTSPECIALX of PARALOOKS with NIL)
(replace FMTSPECIALY of PARALOOKS with NIL) (* now write out the paragraph)
(SETFILEPTR IN NEXTPARAPTR)
(\TFBRAVO.WRITE.PARAGRAPH HEADINGPARA IN TEXTOBJ MAX.FIXP)
(SETQ NEXTPARAPTR AFTERHEADINGPTR)
(RETURN HEADINGDESC])
(\TFBRAVO.INIT.CHARLOOKS
[LAMBDA NIL (* jds "29-Nov-84 13:15")
(* * Creates the charlooks instance which is used as the template for the rest)
(PROG ((LOOKS (create CHARLOOKS)))
(replace CLSIZE of LOOKS with (\TFBRAVO.GET.FONTSIZE 0))
(replace CLNAME of LOOKS (\TFBRAVO.GET.FONTSTYLE 0))
(* (FONTCREATE (\TFBRAVO.GET.FONTSTYLE)
(fetch CLSIZE of LOOKS)))
(replace CLOFFSET of LOOKS with 0)
(RETURN LOOKS])
(\TFBRAVO.PARSE.PROFILE.PARA
[LAMBDA (IN PARA TEXTOBJ) (* jds "21-Nov-84 10:43")
(* * Parse a Bravo profile paragraph, and set up the corresponding TEdit page looks, headings, page numbers, &c)
(DECLARE: USEDFREE NEXTPARAPTR)
(PROG (TOKEN TOKENS (FIRSTPAGENO 1)
(PARAEND NEXTPARAPTR)
(PAGENUMBERS T)
(PAGENUMBERX 307)
(PAGENUMBERY 756)
(TOPMARGIN 72)
(BOTTOMMARGIN 73)
(PAGENUMBER.NOTONFIRSTPAGE T)
NUMBEROFCOLUMNS EDGEMARGIN BETWEENCOLUMNS COLUMNWIDTH BINDING
ODDHEADING.NOTONFIRSTPAGE EVENHEADING.NOTONFIRSTPAGE ODDHEADINGPARA EVENHEADINGPARA
HEADINGPARA HEADING.NOTONFIRSTPAGE HEADINGDESC ODDHEADINGDESC EVENHEADINGDESC
ODDPAGEFRAME PAGEFRAME EVENPAGEFRAME (PTSPERINCH 72.27))
(* * check that the positioning takes into account binding and edgemargin etc.)
(while (ILESSP (GETFILEPTR IN)
PARAEND)
do (SETQ TOKENS (U-CASE (RATOMS (CHARACTER (CHARCODE EOL))
IN PROFILE.PARA.RDTBL)))
(SELECTQ (SETQ TOKEN (pop TOKENS))
[PAGE (* parse the page numbers stuff)
(\TFBRAVO.ASSERT (QUOTE NUMBERS)
(pop TOKENS))
(while TOKENS do (SELECTQ (SETQ TOKEN (pop TOKENS))
(NO (SETQ PAGENUMBERS NIL))
(YES
(* this is default))
(FIRST (\TFBRAVO.ASSERT (QUOTE PAGE)
(pop TOKENS))
(* If a first page is specified, we can't handle that yet, but at least number the first page, since the only way to
number the first page in Bravo is to specify the number for the first page. Not-on-first-page is assumed)
(SETQ PAGENUMBER.NOTONFIRSTPAGE NIL)
(SETQ FIRSTPAGENO (pop TOKENS)))
(NOT-ON-FIRST-PAGE (SETQ
PAGENUMBER.NOTONFIRSTPAGE T))
(X (SETQ PAGENUMBERX (
\TFBRAVO.PARSE.PROFILE.VALUE TOKENS)))
(Y (SETQ PAGENUMBERY (
\TFBRAVO.PARSE.PROFILE.VALUE TOKENS)))
(ROMAN
(* tough, I don't do Roman Numerals)
NIL)
(PROGN
(* otherwise, just presume we've hit the end of the
page number stuff)
NIL]
[COLUMNS (* parse the columns numbers stuff)
(SETQ NUMBEROFCOLUMNS (pop TOKENS))
(while TOKENS do (SELECTQ (SETQ TOKEN (pop TOKENS))
(EDGE (\TFBRAVO.ASSERT (QUOTE MARGIN)
(pop TOKENS))
(SETQ EDGEMARGIN (
\TFBRAVO.PARSE.PROFILE.VALUE
TOKENS)))
(BETWEEN (\TFBRAVO.ASSERT (QUOTE COLUMNS)
(pop TOKENS))
(SETQ BETWEENCOLUMNS
(\TFBRAVO.PARSE.PROFILE.VALUE
TOKENS)))
(PROGN NIL]
[MARGINS (* parse the margins stuff)
(while TOKENS do (SELECTQ (SETQ TOKEN (pop TOKENS))
(TOP (SETQ TOPMARGIN (
\TFBRAVO.PARSE.PROFILE.VALUE
TOKENS)))
(BOTTOM (SETQ BOTTOMMARGIN (
\TFBRAVO.PARSE.PROFILE.VALUE
TOKENS)))
(BINDING (SETQ BINDING (
\TFBRAVO.PARSE.PROFILE.VALUE
TOKENS)))
(PROGN
(* otherwise, just presume we've hit the end of the
page number stuff)
NIL]
(ODD (\TFBRAVO.ASSERT (pop TOKENS)
(QUOTE HEADING))
(COND
((AND TOKENS (EQ (CAR TOKENS)
(QUOTE NOT-ON-FIRST-PAGE)))
(pop TOKENS)
(SETQ ODDHEADING.NOTONFIRSTPAGE T)))
(SETQ ODDHEADINGDESC (\TFBRAVO.HANDLE.HEADING IN TEXTOBJ)))
(EVEN (\TFBRAVO.ASSERT (pop TOKENS)
(QUOTE HEADING))
(COND
((AND TOKENS (EQ (CAR TOKENS)
(QUOTE NOT-ON-FIRST-PAGE)))
(pop TOKENS)
(SETQ EVENHEADING.NOTONFIRSTPAGE T)))
(SETQ EVENHEADINGDESC (\TFBRAVO.HANDLE.HEADING IN TEXTOBJ)))
(HEADING (COND
((AND TOKENS (EQ (CAR TOKENS)
(QUOTE NOT-ON-FIRST-PAGE)))
(pop TOKENS)
(SETQ HEADING.NOTONFIRSTPAGE T)))
(SETQ HEADINGDESC (\TFBRAVO.HANDLE.HEADING IN TEXTOBJ)))
(LINE (* don't support Line Numbers)
NIL)
(PRIVATE (* private data stamp bull, ignore)
NIL)
(PROGN (* do nothing with this line,)
NIL))) (* The left margin is 0 for all bravo relative
measurements)
(if NUMBEROFCOLUMNS
then (* if this is to be printed multicolumn then determine
the column width from the numberofcolumns and the space
between them)
(SETQ COLUMNWIDTH (IQUOTIENT (IDIFFERENCE (IDIFFERENCE (CONSTANT (TIMES 8.5
PTSPERINCH))
(ITIMES 2 EDGEMARGIN))
(ITIMES (SUB1 NUMBEROFCOLUMNS)
BETWEENCOLUMNS))
NUMBEROFCOLUMNS)))
(SETQ DEFAULTPAGEFRAME (TEDIT.SINGLE.PAGEFORMAT (AND PAGENUMBERS (NOT
PAGENUMBER.NOTONFIRSTPAGE))
PAGENUMBERX PAGENUMBERY NIL NIL 0 0
TOPMARGIN BOTTOMMARGIN NUMBEROFCOLUMNS NIL
BETWEENCOLUMNS (COND
(HEADING.NOTONFIRSTPAGE NIL)
(HEADINGDESC (LIST HEADINGDESC))
(T NIL))
(QUOTE POINTS)))
[COND
((OR ODDHEADINGDESC HEADING.NOTONFIRSTPAGE PAGENUMBER.NOTONFIRSTPAGE)
(SETQ ODDPAGEFRAME (TEDIT.SINGLE.PAGEFORMAT PAGENUMBERS PAGENUMBERX PAGENUMBERY NIL NIL
0 0 TOPMARGIN BOTTOMMARGIN NUMBEROFCOLUMNS
NIL BETWEENCOLUMNS (COND
(ODDHEADINGDESC (LIST ODDHEADINGDESC))
(HEADINGDESC (LIST HEADINGDESC))
(T NIL))
(QUOTE POINTS]
[COND
((OR EVENHEADINGDESC HEADING.NOTONFIRSTPAGE PAGENUMBER.NOTONFIRSTPAGE)
(SETQ EVENPAGEFRAME (TEDIT.SINGLE.PAGEFORMAT PAGENUMBERS PAGENUMBERX PAGENUMBERY NIL
NIL 0 0 TOPMARGIN BOTTOMMARGIN
NUMBEROFCOLUMNS NIL BETWEENCOLUMNS
(COND
(EVENHEADINGDESC (LIST EVENHEADINGDESC))
(HEADINGDESC (LIST HEADINGDESC))
(T NIL))
(QUOTE POINTS]
(RETURN (replace TXTPAGEFRAMES of TEXTOBJ with (LIST DEFAULTPAGEFRAME (OR ODDPAGEFRAME
DEFAULTPAGEFRAME)
(OR EVENPAGEFRAME DEFAULTPAGEFRAME])
(\TFBRAVO.PARSE.PROFILE.VALUE
[LAMBDA (TOKENLIST) (* gbn "15-Nov-84 13:48")
(* * returns a value always specified in pts, regardless of whether it was that way in the token list
(NB since RPLNODE is being used, there must always be a token after the value and/or inches sign))
(PROG ([VALUE (PROG1 (CAR TOKENLIST)
(RPLNODE2 TOKENLIST (CDR TOKENLIST]
(POINTSPERINCH 72.27)
(INCHES (QUOTE %")))
(if (EQ (CAR TOKENLIST)
INCHES)
then (SETQ VALUE (TIMES VALUE POINTSPERINCH))
(RPLNODE2 TOKENLIST (CDR TOKENLIST)))
(RETURN (FIX VALUE])
(\TFBRAVO.GET.FONTSIZE
[LAMBDA (FONT) (* gbn "19-Sep-84 01:47")
(* ADD DECLARATION TO ADMIT THAT YOU ARE USING L FREE,
BEST TO REPLACE WITH AN ARRAY IN FACT)
(CADDR (FASSOC FONT (FASSOC (QUOTE Font)
USER.CM.ALIST])
(\TFBRAVO.GET.FONTSTYLE
[LAMBDA (FONT) (* gbn "19-Sep-84 01:46")
(* ADD DECLARATION TO ADMIT THAT YOU ARE USING
USER.CM.ALIST FREE, BEST TO REPLACE WITH AN ARRAY IN
FACT)
(CADR (FASSOC FONT (FASSOC (QUOTE Font)
USER.CM.ALIST])
(\TFBRAVO.WRITE.RUN
[LAMBDA (RUN IN PARALOOKS TEXTOBJ) (* jds "29-Nov-84 13:20")
(PROG (START END NAMEDTABNUMBER (LOOKS (fetch RUNLOOKS of RUN)))
(SETQ NAMEDTABNUMBER (fetch CLUSERINFO of (fetch RUNLOOKS of RUN)))
(COND
((ILEQ (fetch RUNLENGTH of RUN)
0)
(RETURN))
([AND NAMEDTABNUMBER (EQUAL (PEEKC)
(CHARACTER (CHARCODE ↑I]
(* only treat the run like a tab if it has charcode 9, even if it has a tab number. Color is overloaded onto tab
numbers in BRAVO. Jerks! Jerks!)
(\TFBRAVO.ADD.NAMEDTAB TEXTOBJ NAMEDTABNUMBER PARALOOKS))
(T (SETQ END (IPLUS (SETQ START (GETFILEPTR IN))
(fetch RUNLENGTH of RUN)))
(TEDIT.RAW.INCLUDE TEXTOBJ IN START END)
(TEDIT.LOOKS TEXTOBJ LOOKS])
(\TFBRAVO.ASSERT
[LAMBDA (X Y) (* gbn "19-Sep-84 21:39")
(if (NEQ X Y)
then (HELP "While parsing profile paragraph, " (CONCAT X " was expected, but " Y
" was found."])
(\SHIFT.DOCUMENT
[LAMBDA (PCTB DELTAX) (* jds "28-Aug-84 14:47")
(* shifts all tabs, left and right margins by deltax.
DOES NOT VERIFY that this produces reasonable values)
(* a change for DFNFLG)
(PROG ((PC (\EDITELT PCTB (ADD1 \FirstPieceOffset)))
TSPEC LASTPARALOOKS PARALOOKS)
(while PC
do (COND
[(NEQ (fetch PPARALOOKS of PC)
LASTPARALOOKS) (* This is a new set of looks -- go ahead and change
it.)
(COND
((SETQ TAB.OBJECT (fetch POBJ of PC))
(* shift the tabspec by deltax)
(IMAGEOBJPROP TAB.OBJECT (QUOTE OBJECTDATUM)
(IPLUS (fetch OBJECTDATUM of TAB.OBJECT)
DELTAX)))
((SETQ PARALOOKS (fetch PPARALOOKS of PC))
(SETQ PARALOOKS (replace PPARALOOKS of PC with (create FMTSPEC using
PARALOOKS)))
(replace 1STLEFTMAR of PARALOOKS with (IPLUS (fetch 1STLEFTMAR of PARALOOKS)
DELTAX))
(replace LEFTMAR of PARALOOKS with (IPLUS (fetch LEFTMAR of PARALOOKS)
DELTAX))
(replace RIGHTMAR of PARALOOKS with (IPLUS (fetch RIGHTMAR of PARALOOKS)
DELTAX))
(SETQ TSPEC (fetch TABSPEC of PARALOOKS))
(* only subtract the deltax from the absolute positions,
not from the relative tabstop
(the car of the tabspec))
(* this has too much leeway. I think tabspecs are fixed
format. Check!)
(replace TABSPEC of PARALOOKS
with (CONS (CAR TSPEC)
(for ELEMENT in (CDR TSPEC)
collect (SELECTQ (TYPENAME ELEMENT)
(FIXP (IPLUS DELTAX ELEMENT))
(LISTP (CONS (IPLUS DELTAX (CAR ELEMENT))
(CDR ELEMENT)))
(NILL]
(T (replace PPARALOOKS of PC with LASTPARALOOKS)))
(SETQ LASTPARALOOKS (fetch PPARALOOKS of PC))
(SETQ PC (fetch NEXTPIECE of PC])
(\TEDIT.BRAVOFILE?
[LAMBDA (FILE A B C) (* jds "28-Aug-84 14:46")
(* Test a file to see if it is a BRAVO file, asking if
it is to be converted)
(* Returns the name of the user.cm file to be used in
the conversion of this file)
(PROG (PLOOKS ENDCONDITION (ORIGINAL.FILE.POSITION (GETFILEPTR FILE)))
(* first look for a ↑z, (beginning of a Bravo trailer))
(COND
((NOT (\TFBRAVO.FIND.LAST.TRAILER FILE))
(SETFILEPTR FILE ORIGINAL.FILE.POSITION)
(RETURN NIL))) (* BIN past the ↑z)
(BIN FILE)
(SETQ PLOOKS (\TEST.PARAGRAPH.LOOKS FILE)) (* if the next symbol is a slash then check if the
character looks are valid)
[SETQ ENDCONDITION (COND
((EQ (CAR PLOOKS)
(QUOTE \))
(repeatuntil (\TEST.CHARACTER.LOOKS FILE]
(COND
((EQ ENDCONDITION (QUOTE BADLOOKS))
(SETFILEPTR FILE ORIGINAL.FILE.POSITION)
(RETURN NIL))
(T (SETFILEPTR FILE ORIGINAL.FILE.POSITION) (* look for user.cm files in the following order, the
directory the file came from, the connected directory,
the login dir, {dsk} device)
(RETURN (MKATOM (TEDIT.GETINPUT TEXTOBJ
"USER.CM file:(NIL to suppress BRAVO conversion) "
(FINDFILE (QUOTE USER.CM)
T
(LIST (ASSOC (QUOTE DIRECTORY)
(UNPACKFILENAME (fetch
FULLFILENAME
of FILE)))
(QUOTE T)
(QUOTE NIL)
(QUOTE {DSK}])
(\TEST.CHARACTER.LOOKS
[LAMBDA (FILE) (* gbn " 6-Feb-84 19:11")
(* returns nil until done when it returns BADLOOKS or T)
(PROG (PROPERTY VALFLAG TEM (VALUE 0)
CHAR)
LP (while [NUMBERP (SETQ CHAR (FCHARACTER (BIN FILE]
do (SETQ VALUE CHAR)
(SETQ VALFLAG T))
(COND
(PROPERTY (COND
((NULL VALFLAG)
(RETURN (QUOTE BADLOOKS)))
(T NIL))
(SETQ PROPERTY NIL))
(VALFLAG [SETFILEPTR FILE (IDIFFERENCE (GETFILEPTR FILE)
(COND
([EQ CHAR (CONSTANT (CHARACTER (CHARCODE EOL]
2)
(T 1]
(RETURN NIL)))
[COND
((SETQ TEM (SELECTQ CHAR
((s u b i g v S U B I G V)
T)
NIL))
T
(SETQ PROPERTY T))
((SETQ TEM (SELECTQ CHAR
((t f o)
T)
NIL))
T)
([EQ CHAR (CONSTANT (CHARACTER (CHARCODE EOL]
(RETURN T))
((NEQ CHAR (QUOTE % ))
(RETURN (QUOTE BADLOOKS]
(SETQ VALUE 0)
(SETQ VALFLAG NIL)
(GO LP])
(\TEST.PARAGRAPH.LOOKS
[LAMBDA (FILE) (* gbn " 6-Feb-84 18:30")
(* test if the sequence form valid paragraph looks, do
not allow empty paragraph looks)
(PROG ((VALUE 0)
CHAR PROPERTY (TABS)
NONEMPTY)
LP (while [NUMBERP (SETQ CHAR (FCHARACTER (BIN FILE] do (SETQ VALUE CHAR))
[COND
((SELECTQ PROPERTY
((l d z x e y k j c q)
(SETQ NONEMPTY T))
NIL) (* keep going, these are all ok)
NIL)
(T (SELECTQ PROPERTY
(%( (SELECTQ CHAR
(%) (SETQ NONEMPTY T))
(, (COND
((IGREATERP VALUE 14)
(* not a legal tab no)
(RETURN NIL))
(T (SETQ NONEMPTY T)))
T)
(* not legal after)
(RETURN NIL)))
(, (SETQ NONEMPTY T))
((%) (SETQ NONEMPTY T)))
(* not a legal paragraph look)
(RETURN NIL]
(COND
((AND [NEQ CHAR (CONSTANT (CHARACTER (CHARCODE EOL]
(NEQ CHAR (QUOTE \)))
(SETQ PROPERTY CHAR)
(SETQ VALUE 0)
(GO LP)))
(IF NONEMPTY
THEN (RETURN CHAR)
ELSE (RETURN])
)
(DEFINEQ
(\TFBRAVO.COPY.NAMEDTAB
[LAMBDA (OBJ PIECE OLDCH NEWCH) (* jds " 8-Feb-84 19:58")
(* just creates a named tab stop with the same value as
the original)
(* Note that the USING phrase will create a new TEDITOBJ
as well as a TEDITUSEROBJ)
(COPY OBJ])
(\TFBRAVO.PUT.NAMEDTAB
[LAMBDA (OBJ CHARSTREAM FMTSTREAM) (* jds " 8-Feb-84 19:59")
(* just writes the position of the tab so that a new one
can be created on read)
(PRINT (IMAGEOBJPROP OBJ (QUOTE OBJECTDATUM))
CHARSTREAM])
(\TFBRAVO.GET.NAMEDTAB
[LAMBDA (CHARSTREAM TEXTSTREAM) (* jds " 8-Feb-84 19:59")
(* should read the position, create an obj and return
it)
(IMAGEOBJCREATE (RATOM CHARSTREAM)
\NAMEDTAB.IMAGEFNS])
(\TFBRAVO.ADD.NAMEDTAB
[LAMBDA (TEXTOBJ TABNO PARALOOKS) (* gbn "19-Sep-84 23:29")
[COND
((NEQ TABNO 0)
(BIN) (* Advance the input stream past the tab character)
(TEDIT.INSERT.OBJECT (IMAGEOBJCREATE (LISTGET (fetch FMTUSERINFO of PARALOOKS)
(SUB1 TABNO))
\NAMEDTAB.IMAGEFNS)
TEXTOBJ
(ADD1 (fetch TEXTLEN of TEXTOBJ]
(* one is subtracted from the tabno because BRAVO seems
to specify there numbers differently in the run from
the paragraph looks)
])
(\NAMEDTABNYET
[LAMBDA NIL (* gbn "30-Dec-83 17:23")
(PROMPTPRINT "Can't do that to a named tab!"])
(\NAMEDTABSIZE
[LAMBDA (TABOBJECT IMAGESTREAM CURRENTX RIGHTMARGIN MODE)
(* gbn "19-May-84 22:52")
(PROG [(PTSIZE (IMAGEOBJPROP TABOBJECT (QUOTE OBJECTDATUM)))
(MODE (if (STKPOS (QUOTE \FORMATLINE))
then (QUOTE DISPLAY)
else (QUOTE HARDCOPY] (* hack until I get called with the right mode.
SHit!)
(RETURN (create IMAGEBOX
XSIZE ←(IMAX 1 (IDIFFERENCE (COND
((EQ MODE (QUOTE DISPLAY))
PTSIZE)
(T (ITIMES PTSIZE 35)))
CURRENTX))
YSIZE ← 1
YDESC ← 0
XKERN ← 0])
(\NAMEDTAB.INIT
[LAMBDA NIL (* jds "22-Aug-84 14:49")
(SETQ \NAMEDTAB.IMAGEFNS (IMAGEFNSCREATE (QUOTE NILL)
(QUOTE \NAMEDTABSIZE)
(QUOTE \TFBRAVO.PUT.NAMEDTAB)
(QUOTE \TFBRAVO.GET.NAMEDTAB)
(QUOTE \TFBRAVO.COPY.NAMEDTAB)
(QUOTE NILL)
(QUOTE NILL)
(QUOTE MOVE.NAMED.TAB)
(QUOTE NILL)
(QUOTE NILL)
(QUOTE NILL)
(QUOTE NILL)
(QUOTE NIL])
)
(DEFINEQ
(\TFBRAVO.APPLY.PARALOOKS
[LAMBDA (PARALOOKS LENGTH TEXTOBJ MARGIN.CANDIDATE) (* gbn "19-Sep-84 00:37")
(* Returns the smaller of: the left margin so far, the
smallest left margin in this para)
(PROG (TABPHRASE (SMALLEST.MARGIN MARGIN.CANDIDATE))
(TEDIT.PARALOOKS TEXTOBJ PARALOOKS (ADD1 (IDIFFERENCE (fetch TEXTLEN of TEXTOBJ)
LENGTH))
LENGTH)
(TEDIT.SETSEL TEXTOBJ (fetch TEXTLEN of TEXTOBJ)
1
(QUOTE RIGHT)) (* now return the smallest margin)
(RETURN (IMIN (fetch RIGHTMAR of PARALOOKS)
(fetch LEFTMAR of PARALOOKS)
(fetch 1STLEFTMAR of PARALOOKS)
MARGIN.CANDIDATE])
(TEDITFROMBRAVO
[LAMBDA (FILIN USER.CM TEXTSTREAM) (* jds "29-Oct-84 09:22")
(* * Top level entry for conversion from Bravo to a Textstream which is returned)
(INFILE FILIN)
(PROG (OLDPLOOKS CURRENT.PARAGRAPH USER.CM.ALIST START NEXTPARAPTR TEDITWINDOW TEXTOBJ
(NONFEATURES NIL)
(SMALLEST.MARGIN MAX.FIXP)
(NEWSTREAM (OR TEXTSTREAM (OPENTEXTSTREAM "")))
USER.CM.PARALOOKS USER.CM.CHARLOOKS)
(DECLARE (SPECVARS NOUT))
(SETQ TEXTOBJ (TEXTOBJ NEWSTREAM))
(SETQ USER.CM.ALIST (\TFBRAVO.READ.USER.CM USER.CM))
(CLOSEF? USER.CM)
(SETQ OLDPLOOKS (SETQ USER.CM.PARALOOKS (\TFBRAVO.INIT.PARALOOKS USER.CM.ALIST)))
(SETQ USER.CM.CHARLOOKS (\TFBRAVO.INIT.CHARLOOKS))
(SETFILEPTR FILIN 0)
(ERSETQ (first (SETQ START (GETFILEPTR FILIN))
(SETQ CURRENT.PARAGRAPH (\TFBRAVO.PARSE.PARA OLDPLOOKS FILIN))
while (fetch RUNS of CURRENT.PARAGRAPH)
do (SETQ NEXTPARAPTR (GETFILEPTR FILIN))
(SETFILEPTR FILIN START)
(SETQ SMALLEST.MARGIN (\TFBRAVO.WRITE.PARAGRAPH CURRENT.PARAGRAPH FILIN
TEXTOBJ SMALLEST.MARGIN))
(SETFILEPTR FILIN NEXTPARAPTR)
(SETQ OLDPLOOKS (fetch PARALOOKS of CURRENT.PARAGRAPH))
(SETQ START (GETFILEPTR FILIN))
(SETQ CURRENT.PARAGRAPH (\TFBRAVO.PARSE.PARA OLDPLOOKS FILIN))
finally (* (\SHIFT.DOCUMENT (fetch PCTB of TEXTOBJ)
(MINUS SMALLEST.MARGIN)))
NIL))
(CLOSEF (INPUT))
(RETURN NEWSTREAM])
(\TFBRAVO.WRITE.PARAGRAPH
[LAMBDA (PARA INFILE TEXTOBJ MARGIN.CANDIDATE) (* gbn "18-Oct-84 21:26")
(* outputs the character runs, writes an EOL, then
apply paragraph looks. Returns the smallest left margin
seen to date)
(* * this is not a guaranteed free field. Perhaps later the profile bit will have to be elsewhere.)
(SELECTQ (fetch FMTPARATYPE of (fetch PARALOOKS of PARA))
(PROFILE (replace FMTPARATYPE of (fetch PARALOOKS of PARA) with NIL)
(\TFBRAVO.PARSE.PROFILE.PARA INFILE PARA TEXTOBJ)
MARGIN.CANDIDATE)
(PROG (LENGTH)
(SETQ LENGTH (ADD1 (\TFBRAVO.WRITE.RUNS PARA INFILE TEXTOBJ)))
(\TFBRAVO.EOLS 1 TEXTOBJ)
(RETURN (\TFBRAVO.APPLY.PARALOOKS (fetch PARALOOKS of PARA)
LENGTH TEXTOBJ MARGIN.CANDIDATE])
(\TFBRAVO.WRITE.RUNS
[LAMBDA (PARA INFILE TEXTOBJ) (* gbn "18-Sep-84 16:29")
(DECLARE (USEDFREE UNDERLINE SUPERSCRIPT))
(PROG ((RUNS (fetch RUNS of PARA))
(PARALOOKS (fetch PARALOOKS of PARA))
(LENGTH 0))
(for RUN in old RUNS
do (\TFBRAVO.WRITE.RUN RUN INFILE PARALOOKS TEXTOBJ)
(SETQ LENGTH (IPLUS (fetch RUNLENGTH of RUN)
LENGTH)))
(RETURN LENGTH])
(\TFBRAVO.SPREAD.LOOKS
[LAMBDA (RUN LOOKS) (* jds "22-Aug-84 14:53")
(DECLARE (USEDFREE STYLE SLANT THICKNESS SIZE OVERSTRIKE UNDERLINE SUPERSCRIPT))
(for INSTR in (fetch RUNLOOKS of RUN) do (SELECTQ (CAR INSTR)
[Bold (LISTPUT LOOKS (QUOTE WEIGHT)
(COND
((CDR INSTR)
(QUOTE BOLD))
(T (QUOTE MEDIUM]
[Font (LISTPUT LOOKS (QUOTE SIZE)
(\TFBRAVO.GET.FONTSIZE
(CDR INSTR)))
(LISTPUT LOOKS (QUOTE FAMILY)
(\TFBRAVO.GET.FONTSTYLE
(CDR INSTR]
[Italic (LISTPUT LOOKS (QUOTE SLOPE)
(COND
((CDR INSTR)
(QUOTE ITALIC))
(T (QUOTE REGULAR]
(Overstrike (add OVERSTRIKE 1))
[Underline (LISTPUT LOOKS (QUOTE UNDERLINE)
(COND
((CDR INSTR)
(QUOTE ON))
(T (QUOTE OFF]
[Superscript (COND
((IGREATERP (CDR INSTR)
127)
(* turn off subscripting and set superscripting, though
possibly to zero)
(LISTPUT LOOKS (QUOTE
SUBSCRIPT)
(IDIFFERENCE
256
(CDR INSTR)))
(LISTPUT LOOKS (QUOTE
SUPERSCRIPT)
NIL))
(T (LISTPUT LOOKS (QUOTE
SUPERSCRIPT)
(CDR INSTR))
(LISTPUT LOOKS (QUOTE
SUBSCRIPT)
NIL]
NIL))
LOOKS])
(\TFBRAVO.PARSE.PARA
[LAMBDA (OLDPLOOKS FILE) (* gbn "12-Oct-84 16:51")
(* PLOOKS are the paragraph looks, and RUNi are the character runs in the form returned by READCHARACTERLOOKS,
except that the character count for the last run has been filled in correctly. Leaves the input file pointer at the
end of the trailer, after the EOL.)
(PROG (LEN PLOOKS RUNS ORIGPTR)
(SETQ ORIGPTR (GETFILEPTR FILE))
(SETQ LEN (FILEPOS (CHARACTER (CHARCODE ↑Z))
FILE))
[COND
((NOT LEN)
(RETURN (create PARA
PARALOOKS ← DefaultParagraphLooks
RUNS ← NIL]
(SETQ LEN (IDIFFERENCE LEN ORIGPTR)) (* BIN past the ↑z)
(BIN FILE)
(SETQ PLOOKS (\TFBRAVO.READ.PARALOOKS OLDPLOOKS FILE))
[COND
((NEQ [CAR (PROG1 PLOOKS (SETQ PLOOKS (CDR PLOOKS]
(QUOTE \))
(RETURN (create PARA
PARALOOKS ← PLOOKS
RUNS ←(LIST (create RUN
RUNLENGTH ← LEN
RUNLOOKS ← USER.CM.CHARLOOKS]
CLP [while [fetch RUNLENGTH of (CAR (push RUNS (\TFBRAVO.READ.CHARLOOKS FILE]
do (SETQ LEN (IDIFFERENCE LEN (fetch RUNLENGTH of (CAR RUNS]
(replace RUNLENGTH of (CAR RUNS) with LEN)
(RETURN (create PARA
PARALOOKS ← PLOOKS
RUNS ←(DREVERSE RUNS])
(\TFBRAVO.INIT.PARALOOKS
[LAMBDA (USER.CM.LOOKS) (* jds "29-Nov-84 13:00")
(* * creates the first paragraph looks from the USER.CM)
(PROG ((INITPARALOOKS (create FMTSPEC using TEDIT.DEFAULT.FMTSPEC))
LM VALUE 1LM (MICASPERPOINT 35))
(SETQ HardwareWidth (IDIFFERENCE HardwareRightMargin HardwareLeftMargin))
(* Basic page width)
(SETQ DefaultParagraphLooks USER.CM.LOOKS)
(COND
((SETQ LM (ASSOC (QUOTE LeftMargin)
DefaultParagraphLooks)))
(T (SETQ LM HardwareLeftMargin)))
(COND
((SETQ 1LM (ASSOC (QUOTE FirstLineLeftMargin)
DefaultParagraphLooks)))
(T (SETQ 1LM LM)))
(replace LEFTMAR of INITPARALOOKS with (IQUOTIENT (CDR LM)
MICASPERPOINT))
(replace 1STLEFTMAR of INITPARALOOKS with (IQUOTIENT (CDR 1LM)
MICASPERPOINT))
(replace LINELEAD of INITPARALOOKS with (COND
((SETQ VALUE (ASSOC (QUOTE LineLeading)
DefaultParagraphLooks))
(CDR VALUE))
(T 1)))
(replace LEADBEFORE of INITPARALOOKS with (COND
((SETQ VALUE (ASSOC (QUOTE ParagraphLeading)
DefaultParagraphLooks))
(CDR VALUE))
(T 1)))
(replace RIGHTMAR of INITPARALOOKS with (IQUOTIENT (COND
((SETQ VALUE (ASSOC (QUOTE RightMargin)
DefaultParagraphLooks))
(CDR VALUE))
(T DefaultRightMargin))
MICASPERPOINT))
(replace LEADAFTER of INITPARALOOKS with 0)
(replace TABSPEC of INITPARALOOKS with (LIST NIL))
(replace FMTSPECIALX of INITPARALOOKS with 0)
(replace FMTSPECIALY of INITPARALOOKS with 0)
(RETURN INITPARALOOKS])
(\TFBRAVO.READ.PARALOOKS
[LAMBDA (OLDLOOKS FILE) (* gbn "19-Oct-84 18:23")
(PROG ((TEDITPARALOOKS (create FMTSPEC using USER.CM.PARALOOKS))
LMFLAG FLLMFLAG PROPERTY CHAR TABINDEX TEM (VALUE 0)
(MICASPERPOINT 35))
(replace TABSPEC of TEDITPARALOOKS with (COPY (fetch TABSPEC of OLDLOOKS)))
(replace FMTUSERINFO of TEDITPARALOOKS with (COPY (fetch FMTUSERINFO of OLDLOOKS)))
LP (while [NUMBERP (SETQ CHAR (FCHARACTER (BIN FILE] do (SETQ VALUE (IPLUS (ITIMES VALUE 10)
CHAR)))
[COND
((SELECTQ PROPERTY
(l (SETQQ LMFLAG LeftMargin)
(replace LEFTMAR of TEDITPARALOOKS with (IQUOTIENT VALUE MICASPERPOINT)))
(d (SETQQ FLLMFLAG FirstLineLeftMargin)
(replace 1STLEFTMAR of TEDITPARALOOKS with (IQUOTIENT VALUE MICASPERPOINT)))
(z (replace RIGHTMAR of TEDITPARALOOKS with (IQUOTIENT VALUE MICASPERPOINT)))
(x (replace LINELEAD of TEDITPARALOOKS with VALUE))
(e (replace LEADAFTER of TEDITPARALOOKS with 0)
(replace LEADBEFORE of TEDITPARALOOKS with VALUE))
(y (* (COND ((IEQP VALUE 65535)
(SETQ VALUE NIL))))
(* vertical tabs are supported)
(replace FMTSPECIALX of TEDITPARALOOKS with 0)
(replace FMTSPECIALY of TEDITPARALOOKS with VALUE))
(k (* same with Keep)
(QUOTE Keep))
NIL))
((SETQ TEM (SELECTQ PROPERTY
(j (replace QUAD of TEDITPARALOOKS with (QUOTE JUSTIFIED)))
(c (replace QUAD of TEDITPARALOOKS with (QUOTE CENTERED)))
(q (* not a legal value for FMTPARATYPE But it signals
that this is a profile paragraph)
(replace FMTPARATYPE of TEDITPARALOOKS with (QUOTE PROFILE)))
NIL)))
(T (SELECTQ PROPERTY
[%( (SELECTQ CHAR
(%) (RPLACA (fetch TABSPEC of TEDITPARALOOKS)
(IQUOTIENT VALUE MICASPERPOINT)))
(, [COND
((IGREATERP VALUE 14)
(HELP VALUE (QUOTE " is not a legal tab #"]
(SETQ TABINDEX VALUE))
(HELP CHAR (QUOTE " is not legal after ("]
[, (if (NOT (IEQP VALUE 65535))
then (* this is not a delete tab, record it)
(SETQ VALUE (IQUOTIENT VALUE MICASPERPOINT))
(* I no longer gratuitously add a normal tab at the position of each named tab. Turns out that, in some cases, that
will change the meaning of an already present unnamed tab. (RPLACD (fetch TABSPEC of TEDITPARALOOKS)
(CONS (CONS VALUE (QUOTE LEFT)) (CDR (fetch TABSPEC of TEDITPARALOOKS)))))
(replace FMTUSERINFO of TEDITPARALOOKS
with (NCONC (LIST TABINDEX VALUE)
(fetch FMTUSERINFO of TEDITPARALOOKS]
((%) NIL))
(HELP CHAR (QUOTE " is not a legal paragraph look"]
(COND
((AND [NEQ CHAR (CONSTANT (CHARACTER (CHARCODE EOL]
(NEQ CHAR (QUOTE \)))
(SETQ PROPERTY CHAR)
(SETQ VALUE 0)
(GO LP)))
[COND
((AND LMFLAG (NOT FLLMFLAG)) (* If there was a Left margin but no firstline left
then default it)
(replace 1STLEFTMAR of TEDITPARALOOKS with (fetch LEFTMAR of TEDITPARALOOKS]
(RETURN (CONS CHAR TEDITPARALOOKS)) (* return the looks together with the indication of how
the looks ended)
])
(\TFBRAVO.READ.CHARLOOKS
[LAMBDA (FILE) (* jds "29-Nov-84 13:19")
(* this function reads the character looks trailer building a TEDIT charlooks record. Most fields are immediately
valid, however, the tabcolor is stored in the cluserinfo field of the looks, and the font is still in numeric form)
(PROG ((TEDITCHARLOOKS (create CHARLOOKS using USER.CM.CHARLOOKS))
PROPERTY VALFLAG TEM (VALUE 0)
CHAR)
(RETURN (while T
do (* Keep going until we run out of things to read)
(while [NUMBERP (SETQ CHAR (FCHARACTER (BIN FILE]
do (* If we're looking at digits, read them as a number)
(SETQ VALUE (IPLUS (ITIMES VALUE 10)
CHAR))
(SETQ VALFLAG T))
[COND
(PROPERTY [COND
((NULL VALFLAG)
(HELP PROPERTY (QUOTE "- no value for character look")))
(T (SELECTQ PROPERTY
(TabColor
(* Hide the named tab in the user field of the looks
where writerun can look for it)
(replace CLUSERINFO of TEDITCHARLOOKS
with VALUE))
(Font (replace CLSIZE of TEDITCHARLOOKS
with (\TFBRAVO.GET.FONTSIZE VALUE))
(replace CLNAME of TEDITCHARLOOKS
with (\TFBRAVO.GET.FONTSTYLE VALUE)))
[Superscript (replace CLOFFSET of TEDITCHARLOOKS
with (COND
((IGREATERP VALUE 127)
(* is a negative numero)
(IDIFFERENCE VALUE 256))
(T VALUE]
(HELP PROPERTY
" is unknown property in \TFBRAVO.READ.CHARLOOKS"]
(SETQ PROPERTY NIL))
(VALFLAG [SETFILEPTR FILE (IDIFFERENCE
(GETFILEPTR FILE)
(COND
([EQ CHAR (CONSTANT (CHARACTER (CHARCODE EOL]
2)
(T 1]
(RETURN (CONS VALUE (\TFBRAVO.FONT.FROM.CHARLOOKS TEDITCHARLOOKS]
(COND
((SELECTQ CHAR
(s (replace CLSTRIKE of TEDITCHARLOOKS with T))
(S (replace CLSTRIKE of TEDITCHARLOOKS with NIL)
T)
(u (replace CLULINE of TEDITCHARLOOKS with T))
(U (replace CLULINE of TEDITCHARLOOKS with NIL)
T)
(b (replace CLBOLD of TEDITCHARLOOKS with T))
(B (replace CLBOLD of TEDITCHARLOOKS with NIL)
T)
(i (replace CLITAL of TEDITCHARLOOKS with T))
(I (replace CLITAL of TEDITCHARLOOKS with NIL)
T)
(g (QUOTE (Graphic . T)))
(G (QUOTE (Graphic)))
(v (replace CLINVISIBLE of TEDITCHARLOOKS with NIL)
T)
(V (replace CLINVISIBLE of TEDITCHARLOOKS with T))
NIL)
(SETQ PROPERTY NIL))
((SETQ TEM (SELECTQ CHAR
(t (QUOTE TabColor))
(f (QUOTE Font))
(o (QUOTE Superscript))
NIL))
(SETQ PROPERTY TEM))
[[EQ CHAR (CONSTANT (CHARACTER (CHARCODE EOL]
(RETURN (CONS NIL (\TFBRAVO.FONT.FROM.CHARLOOKS TEDITCHARLOOKS]
((NEQ CHAR (QUOTE % ))
(HELP CHAR " is not a legal character look")))
(SETQ VALUE 0)
(SETQ VALFLAG NIL])
(\TFBRAVO.READ.USER.CM
[LAMBDA (FILE) (* gbn "17-Sep-84 18:53")
(* digests a user.cm file returning an alist of
contents. Returns ((Font)) if no bravo section of
user.cm file)
(PROG ((RDTBL USER.CM.RDTBL)
[ALIST (LIST (LIST (QUOTE Font]
LINE)
(* (ERRORTYPELST (CONS (QUOTE (16 (RETFROM (QUOTE RATOM) (QUOTE END.OF.FILE)))) ERRORTYPELST)) The errortypelist
inclusion guarantees that eof's will return from RATOM as (CHARCODE 13))
(* (DECLARE (SPECVARS ERRORTYPELST)))
(SETBRK (CHARCODE (, : = EOL))
NIL RDTBL)
(SETSEPR (QUOTE (% ))
NIL RDTBL)
[OR (OPENP FILE)
(SETQ FILE (OPENSTREAM FILE (QUOTE INPUT)
(QUOTE OLD]
(COND
((NOT (FILEPOS [CONCAT (QUOTE "[BRAVO]")
(CONSTANT (CHARACTER (CHARCODE EOL]
FILE NIL NIL NIL T))
(RETURN ALIST)))
(* Read lines of the user.cm file until getting the empty line caused by eof (and the errortypelst entry) or until a
line starts with "[".)
LLP (COND
([NOT (NLSETQ (SETQ LINE (RATOMS (CONSTANT (CHARACTER (CHARCODE EOL)))
FILE RDTBL]
(RETURN ALIST))) (* If the "[BRAVO]" section is the last one)
(COND
((NULL LINE) (* ignore blank lines)
(GO LLP))
((EQ (CAR LINE)
(QUOTE END.OF.FILE))
(RETURN ALIST))
((EQ (NTHCHAR (CAR LINE)
1)
(QUOTE %[))
(* if "[" is the first character of the line, return the alist so far, because this is the beginning of the next
section of the user.cm)
(RETURN ALIST))
((NEQ (CADR LINE)
(QUOTE :))
(GO LLP)))
(SELECTQ (PROG1 (CAR LINE)
(SETQ LINE (CDDR LINE)))
[FONT (COND
((NUMBERP (CAR LINE))
(NCONC1 (FASSOC (QUOTE Font)
ALIST)
(LIST (CAR LINE)
(CADR LINE)
(CADDR LINE]
(TABS (SETQ ALIST (NCONC [\TFBRAVO.GETPARAMS LINE (QUOTE ((Tabs standard tab width]
ALIST)))
(MARGINS (SETQ ALIST (NCONC [\TFBRAVO.GETPARAMS LINE (QUOTE ((LeftMargin left
margin)
(RightMargin right
margin]
ALIST)))
(LEAD (SETQ ALIST (NCONC [\TFBRAVO.GETPARAMS LINE (QUOTE ((ParagraphLeading
paragraph
leading)
(LineLeading line
leading]
ALIST)))
NIL)
(GO LLP])
(\TFBRAVO.GETPARAMS
[LAMBDA (LIS NAMES) (* jds "27-Aug-84 09:37")
(PROG ((L LIS)
ALIST TEST REST)
[MAP L (FUNCTION (LAMBDA (WORDL)
(COND
((LITATOM (CAR WORDL))
(FRPLACA WORDL (\TFBRAVO.LCASER (CAR WORDL]
LP (COND
((NULL L)
(RETURN ALIST)))
(SETQ TEST NAMES)
NLP (COND
((SETQ REST (\TFBRAVO.PARAMNAMEP L (CDAR TEST)))
(SETQ ALIST (CONS (CONS (CAAR TEST)
(CAR REST))
ALIST)))
((SETQ TEST (CDR TEST))
(GO NLP)))
(SETQ L (CDR (FMEMB (QUOTE ,)
L)))
(GO LP])
(\TFBRAVO.PARAMNAMEP
[LAMBDA (LIS NAME) (* lpd "16-JUL-77 19:55")
(PROG ((L LIS))
(RETURN (AND [EVERY NAME (FUNCTION (LAMBDA (WORD)
(PROG1 (EQ WORD (CAR L))
(SETQ L (CDR L]
(EQ (CAR L)
(QUOTE =))
(CDR L])
(\TFBRAVO.EOLS
[LAMBDA (N TEXTOBJ) (* gbn "23-Apr-84 07:40")
(for I=1 to N do (TEDIT.INSERT TEXTOBJ (CHARCODE EOL)))
(TEDIT.SETSEL TEXTOBJ (fetch TEXTLEN of TEXTOBJ)
1
(QUOTE RIGHT])
(\TFBRAVO.LCASER
[LAMBDA (WORD) (* lpd "23-SEP-77 14:40")
(PROG ((LST (CHCON WORD))
Z)
[MAP LST (FUNCTION (LAMBDA (L)
(COND
((AND (IGREATERP (SETQ Z (CAR L))
64)
(ILESSP Z 91)) (* Z is an uppercase character)
(FRPLACA L (IPLUS Z 32]
(RETURN (PACKC LST])
(\TFBRAVO.FONT.FROM.CHARLOOKS
[LAMBDA (CHARLOOKS) (* jds "29-Nov-84 11:43")
(* Takes a CHARLOOKS with fields filled in
(CLNAME = family name) and creates the font to fill
it.)
[replace CLFONT of CHARLOOKS with (FONTCREATE (fetch CLNAME of CHARLOOKS)
(fetch CLSIZE of CHARLOOKS)
(LIST (COND
((fetch CLBOLD of CHARLOOKS)
(QUOTE BOLD))
(T (QUOTE MEDIUM)))
(COND
((fetch CLITAL of CHARLOOKS)
(QUOTE ITALIC))
(T (QUOTE REGULAR)))
(QUOTE REGULAR]
CHARLOOKS])
)
(RPAQ? USER.CM.RDTBL (COPYREADTABLE))
(RPAQ? PROFILE.PARA.RDTBL (COPYREADTABLE))
(SETSYNTAX (CHARCODE :)
(QUOTE SEPRCHAR)
PROFILE.PARA.RDTBL)
(SETSYNTAX (CHARCODE EOL)
(QUOTE BREAKCHAR)
PROFILE.PARA.RDTBL)
(SETSYNTAX (CHARCODE ↑Z)
(QUOTE SEPRCHAR)
PROFILE.PARA.RDTBL)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \NAMEDTAB.IMAGEFNS)
)
(DECLARE: DONTEVAL@LOAD DOCOPY
(ADDTOVAR TEDIT.INPUT.FORMATS (\TEDIT.BRAVOFILE? TEDITFROMBRAVO))
(\NAMEDTAB.INIT)
)
(PUTPROPS TFBRAVO COPYRIGHT ("Xerox Corporation" 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (3179 22970 (\TFBRAVO.FIND.LAST.TRAILER 3189 . 4230) (\TFBRAVO.HANDLE.HEADING 4232 .
5735) (\TFBRAVO.INIT.CHARLOOKS 5737 . 6393) (\TFBRAVO.PARSE.PROFILE.PARA 6395 . 13564) (
\TFBRAVO.PARSE.PROFILE.VALUE 13566 . 14285) (\TFBRAVO.GET.FONTSIZE 14287 . 14661) (
\TFBRAVO.GET.FONTSTYLE 14663 . 15072) (\TFBRAVO.WRITE.RUN 15074 . 15999) (\TFBRAVO.ASSERT 16001 .
16263) (\SHIFT.DOCUMENT 16265 . 18656) (\TEDIT.BRAVOFILE? 18658 . 20528) (\TEST.CHARACTER.LOOKS 20530
. 21662) (\TEST.PARAGRAPH.LOOKS 21664 . 22968)) (22971 26197 (\TFBRAVO.COPY.NAMEDTAB 22981 . 23432) (
\TFBRAVO.PUT.NAMEDTAB 23434 . 23780) (\TFBRAVO.GET.NAMEDTAB 23782 . 24105) (\TFBRAVO.ADD.NAMEDTAB
24107 . 24845) (\NAMEDTABNYET 24847 . 25007) (\NAMEDTABSIZE 25009 . 25678) (\NAMEDTAB.INIT 25680 .
26195)) (26198 48746 (\TFBRAVO.APPLY.PARALOOKS 26208 . 27037) (TEDITFROMBRAVO 27039 . 28809) (
\TFBRAVO.WRITE.PARAGRAPH 28811 . 29823) (\TFBRAVO.WRITE.RUNS 29825 . 30338) (\TFBRAVO.SPREAD.LOOKS
30340 . 32000) (\TFBRAVO.PARSE.PARA 32002 . 33566) (\TFBRAVO.INIT.PARALOOKS 33568 . 35699) (
\TFBRAVO.READ.PARALOOKS 35701 . 39693) (\TFBRAVO.READ.CHARLOOKS 39695 . 43352) (\TFBRAVO.READ.USER.CM
43354 . 46342) (\TFBRAVO.GETPARAMS 46344 . 46994) (\TFBRAVO.PARAMNAMEP 46996 . 47300) (\TFBRAVO.EOLS
47302 . 47569) (\TFBRAVO.LCASER 47571 . 47966) (\TFBRAVO.FONT.FROM.CHARLOOKS 47968 . 48744)))))
STOP