(FILECREATED " 4-Aug-86 16:22:07" {ERIS}<TEDIT>TFBRAVO.;4 55106
changes to: (VARS TFBRAVOCOMS)
previous date: " 3-Jun-85 21:31:21" {ERIS}<TEDIT>TFBRAVO.;3)
(* Copyright (c) 1984, 1985, 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT TFBRAVOCOMS)
(RPAQQ TFBRAVOCOMS
[[DECLARE: EVAL@COMPILE DONTCOPY
(COMS (* Compile-time needs)
(RECORDS FONT PARA RUN TFBRAVOPAGEFRAMES)
(CONSTANTS (PTSPERINCH 72.27)
(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 w W 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.INIT.PAGEFORMAT \TFBRAVO.INSTALL.PAGEFORMAT \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])
(DECLARE: EVAL@COMPILE DONTCOPY
(* Compile-time needs)
[DECLARE: EVAL@COMPILE
(RECORD FONT (SIZE STYLE THICKNESS . SLANT))
(RECORD PARA (PARALOOKS . RUNS))
(RECORD RUN (RUNLENGTH . RUNLOOKS))
(RECORD TFBRAVOPAGEFRAMES (TFBRAVODEFAULT TFBRAVOODD TFBRAVOEVEN))
]
(DECLARE: EVAL@COMPILE
(RPAQQ PTSPERINCH 72.27)
(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 w W t f o % \ 0 1 2 3 4 5 6 7 8 9))
[CONSTANTS (PTSPERINCH 72.27)
(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 w W t f o %
\ 0 1 2 3 4 5 6 7 8 9]
)
)
(DEFINEQ
(\TFBRAVO.FIND.LAST.TRAILER
[LAMBDA (FILE) (* jds "27-Dec-84 19:13")
(* 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)
(FMEMB (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 "20-May-85 17:14")
(* Called from \tfbravo.parse.profile.para)
(DECLARE: USEDFREE NEXTPARAPTR)
(PROG ((AFTERHEADINGPTR)
PARALOOKS HEADINGDESC)
(SETFILEPTR IN NEXTPARAPTR) (* skip over the trailer of the profile para)
(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.INIT.PAGEFORMAT
[LAMBDA (TEXTOBJ) (* gbn "31-May-85 17:13")
(* * installs the default values of the page formatting nonsense as textprops)
(TEXTPROP TEXTOBJ (QUOTE PAGENUMBERS)
T)
(TEXTPROP TEXTOBJ (QUOTE PAGENUMBERX)
307)
(TEXTPROP TEXTOBJ (QUOTE PAGENUMBERY)
756)
(TEXTPROP TEXTOBJ (QUOTE TOPMARGIN)
72)
(TEXTPROP TEXTOBJ (QUOTE BOTTOMMARGIN)
72)
(TEXTPROP TEXTOBJ (QUOTE PAGENUMBER.NOTONFIRSTPAGE)
T])
(\TFBRAVO.INSTALL.PAGEFORMAT
[LAMBDA (TEXTOBJ) (* gbn " 3-Jun-85 17:20")
(* * using the information from the profile paragraphs, this function installs the pageframes)
(PROG (PAGENUMBERS PAGENUMBERX PAGENUMBERY TOPMARGIN BOTTOMMARGIN NUMBEROFCOLUMNS BETWEENCOLUMNS
ODDHEADINGDESC HEADINGDESC EVENHEADINGDESC HEADING.NOTONFIRSTPAGE
PAGENUMBER.NOTONFIRSTPAGE EVENHEADING.NOTONFIRSTPAGE ODDHEADING.NOTONFIRSTPAGE
PAGEFRAMES)
(for VAR
in (QUOTE (PAGENUMBERS PAGENUMBERX PAGENUMBERY TOPMARGIN BOTTOMMARGIN NUMBEROFCOLUMNS
BETWEENCOLUMNS ODDHEADINGDESC HEADINGDESC EVENHEADINGDESC
HEADING.NOTONFIRSTPAGE PAGENUMBER.NOTONFIRSTPAGE
EVENHEADING.NOTONFIRSTPAGE ODDHEADING.NOTONFIRSTPAGE))
do (SET VAR (TEXTPROP TEXTOBJ VAR)))
(SETQ PAGEFRAMES (replace TXTPAGEFRAMES of TEXTOBJ with (create TFBRAVOPAGEFRAMES)))
(* this assumes that TEdit does not build a default
page spec. If it ever does, then this logic must
change.)
(* * the default page frame is always built. It is sometimes built as the only page frame when there is no headings
specified. However, if heading is specified with the not-on-first-page specified, then we must build the default
page frame simply for that reason)
(replace (TFBRAVOPAGEFRAMES TFBRAVODEFAULT) of PAGEFRAMES
with (TEDIT.SINGLE.PAGEFORMAT (AND PAGENUMBERS (NOT PAGENUMBER.NOTONFIRSTPAGE))
PAGENUMBERX PAGENUMBERY NIL NIL 0 0 TOPMARGIN BOTTOMMARGIN
NUMBEROFCOLUMNS NIL BETWEENCOLUMNS
[COND
(HEADINGDESC (if HEADING.NOTONFIRSTPAGE
then NIL
else (LIST HEADINGDESC)))
(ODDHEADINGDESC (if ODDHEADING.NOTONFIRSTPAGE
then NIL
else (LIST HEADINGDESC)))
(EVENHEADINGDESC (if EVENHEADING.NOTONFIRSTPAGE
then NIL
else (LIST EVENHEADINGDESC]
(QUOTE POINTS)))
[COND
((OR ODDHEADINGDESC HEADING.NOTONFIRSTPAGE PAGENUMBER.NOTONFIRSTPAGE)
(replace TFBRAVOODD of PAGEFRAMES
with (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)
(replace TFBRAVOEVEN of PAGEFRAMES
with (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])
(\TFBRAVO.PARSE.PROFILE.PARA
[LAMBDA (IN PARA TEXTOBJ) (* gbn " 3-Jun-85 17:23")
(* * Parse a Bravo profile paragraph, and set up the corresponding TEdit page looks, headings, page numbers, Much of
the state for building the pageframe must be stuffed on the textstream, so that after this fn has been called for
the last time, the pageframe can be built)
(DECLARE: USEDFREE NEXTPARAPTR)
(PROG (TOKEN TOKENS (PARAEND NEXTPARAPTR))
(* * 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 (TEXTPROP TEXTOBJ (QUOTE PAGENUMBERS)
(QUOTE 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)
(TEXTPROP TEXTOBJ (QUOTE
PAGENUMBER.NOTONFIRSTPAGE)
(QUOTE NIL))
(TEXTPROP TEXTOBJ (QUOTE FIRSTPAGENO)
(pop TOKENS)))
(NOT-ON-FIRST-PAGE (TEXTPROP TEXTOBJ
(QUOTE
PAGENUMBER.NOTONFIRSTPAGE)
(QUOTE T)))
(X (TEXTPROP TEXTOBJ (QUOTE PAGENUMBERX)
(\TFBRAVO.PARSE.PROFILE.VALUE
TOKENS)))
(Y (TEXTPROP TEXTOBJ (QUOTE 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)
(TEXTPROP TEXTOBJ (QUOTE NUMBEROFCOLUMNS)
(pop TOKENS))
(while TOKENS do (SELECTQ (SETQ TOKEN (pop TOKENS))
(EDGE (\TFBRAVO.ASSERT (QUOTE MARGIN)
(pop TOKENS))
(TEXTPROP TEXTOBJ (QUOTE EDGEMARGIN)
(
\TFBRAVO.PARSE.PROFILE.VALUE TOKENS)))
(BETWEEN (\TFBRAVO.ASSERT (QUOTE COLUMNS)
(pop TOKENS))
(TEXTPROP TEXTOBJ (QUOTE
BETWEENCOLUMNS)
(
\TFBRAVO.PARSE.PROFILE.VALUE TOKENS)))
(PROGN NIL]
[MARGINS (* parse the margins stuff)
(while TOKENS do (SELECTQ (SETQ TOKEN (pop TOKENS))
(TOP (TEXTPROP TEXTOBJ (QUOTE TOPMARGIN)
(
\TFBRAVO.PARSE.PROFILE.VALUE TOKENS)))
(BOTTOM (TEXTPROP TEXTOBJ (QUOTE
BOTTOMMARGIN)
(
\TFBRAVO.PARSE.PROFILE.VALUE TOKENS)))
(BINDING (TEXTPROP TEXTOBJ (QUOTE 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)
(TEXTPROP TEXTOBJ (QUOTE ODDHEADING.NOTONFIRSTPAGE)
T)))
(TEXTPROP TEXTOBJ (QUOTE 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)
(TEXTPROP TEXTOBJ (QUOTE EVENHEADING.NOTONFIRSTPAGE)
T)))
(TEXTPROP TEXTOBJ (QUOTE EVENHEADINGDESC)
(\TFBRAVO.HANDLE.HEADING IN TEXTOBJ)))
(HEADING (COND
((AND TOKENS (EQ (CAR TOKENS)
(QUOTE NOT-ON-FIRST-PAGE)))
(pop TOKENS)
(TEXTPROP TEXTOBJ (QUOTE HEADING.NOTONFIRSTPAGE)
T)))
(TEXTPROP TEXTOBJ (QUOTE 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)
(COND
((TEXTPROP TEXTOBJ (QUOTE NUMBEROFCOLUMNS)) (* if this is to be printed multicolumn then determine
the column width from the numberofcolumns and the space
between them)
(TEXTPROP TEXTOBJ (QUOTE COLUMNWIDTH)
(IQUOTIENT [IDIFFERENCE [IDIFFERENCE (CONSTANT (TIMES 8.5 PTSPERINCH))
(ITIMES 2 (TEXTPROP TEXTOBJ
(QUOTE EDGEMARGIN]
(ITIMES (SUB1 (TEXTPROP TEXTOBJ (QUOTE
NUMBEROFCOLUMNS)))
(TEXTPROP TEXTOBJ (QUOTE BETWEENCOLUMNS]
(TEXTPROP TEXTOBJ (QUOTE NUMBEROFCOLUMNS])
(\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 "30-Jan-85 17:19")
(* 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]
(replace PPARALOOKS of PC with (\TEDIT.UNIQUIFY.PARALOOKS PARALOOKS TEXTOBJ]
(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) (* gbn " 3-Jun-85 21:06")
(* 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))
NAME DIRS) (* 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)
(SETQ NAME (FULLNAME FILE))
(SETQ DIRS (QUOTE (T NIL {DSK})))
(if (LITATOM NAME)
then (push DIRS (PACKFILENAME (QUOTE NAME)
NIL
(QUOTE EXTENSION)
NIL
(QUOTE VERSION)
NIL
(QUOTE BODY)
NAME)))
(RETURN (MKATOM (TEDIT.GETINPUT TEXTOBJ
"USER.CM file:(NIL to suppress BRAVO conversion) "
(FINDFILE (QUOTE USER.CM)
T DIRS])
(\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) (* gbn "31-May-85 18:18")
(* * 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))
(* read the user.cm file and produce the alist of
default values)
(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)
(\TFBRAVO.INIT.PAGEFORMAT TEXTOBJ)
(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))
(\TFBRAVO.INSTALL.PAGEFORMAT TEXTOBJ)
(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 "31-May-85 22:08")
(* 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 FILE) (* BIN past the ↑z)
(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 ←(\TFBRAVO.FONT.FROM.CHARLOOKS
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 "25-Feb-85 17:06")
(* * 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 (CDR (ASSOC (QUOTE LeftMargin)
DefaultParagraphLooks]
(T (SETQ LM HardwareLeftMargin)))
(COND
[(SETQ 1LM (CDR (ASSOC (QUOTE FirstLineLeftMargin)
DefaultParagraphLooks]
(T (SETQ 1LM LM)))
(replace LEFTMAR of INITPARALOOKS with (IQUOTIENT LM MICASPERPOINT))
(replace 1STLEFTMAR of INITPARALOOKS with (IQUOTIENT 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 " 3-Jun-85 16:57")
(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))
(w (QUOTE HardcopyMode))
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 ("]
[, (COND
((NOT (IEQP VALUE 65535)) (* this is not a delete tab, record it)
(SETQ VALUE (IQUOTIENT VALUE MICASPERPOINT))
(* * returning to adding a normal tab as well, since there are docs, e.b. refreminder.bravo which do not have named
tab looks on the tab chars (* 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)))))
)
[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) (* gbn "31-May-85 22:10")
(* 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))
(* (* a hack so that font is cumulative. Change the "default charlooks" to reflect this font each time)
(replace CLSIZE of USER.CM.CHARLOOKS with (fetch CLSIZE of TEDITCHARLOOKS)) (replace CLNAME of USER.CM.CHARLOOKS
with (fetch CLNAME of TEDITCHARLOOKS)))
]
[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 1985 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (3800 27261 (\TFBRAVO.FIND.LAST.TRAILER 3810 . 4937) (\TFBRAVO.HANDLE.HEADING 4939 .
6527) (\TFBRAVO.INIT.CHARLOOKS 6529 . 7185) (\TFBRAVO.INIT.PAGEFORMAT 7187 . 7787) (
\TFBRAVO.INSTALL.PAGEFORMAT 7789 . 11000) (\TFBRAVO.PARSE.PROFILE.PARA 11002 . 17112) (
\TFBRAVO.PARSE.PROFILE.VALUE 17114 . 17833) (\TFBRAVO.GET.FONTSIZE 17835 . 18209) (
\TFBRAVO.GET.FONTSTYLE 18211 . 18620) (\TFBRAVO.WRITE.RUN 18622 . 19547) (\TFBRAVO.ASSERT 19549 .
19811) (\SHIFT.DOCUMENT 19813 . 22436) (\TEDIT.BRAVOFILE? 22438 . 24502) (\TEST.CHARACTER.LOOKS 24504
. 25813) (\TEST.PARAGRAPH.LOOKS 25815 . 27259)) (27262 30633 (\TFBRAVO.COPY.NAMEDTAB 27272 . 27727) (
\TFBRAVO.PUT.NAMEDTAB 27729 . 28088) (\TFBRAVO.GET.NAMEDTAB 28090 . 28421) (\TFBRAVO.ADD.NAMEDTAB
28423 . 29161) (\NAMEDTABNYET 29163 . 29327) (\NAMEDTABSIZE 29329 . 30054) (\NAMEDTAB.INIT 30056 .
30631)) (30634 54512 (\TFBRAVO.APPLY.PARALOOKS 30644 . 31473) (TEDITFROMBRAVO 31475 . 33494) (
\TFBRAVO.WRITE.PARAGRAPH 33496 . 34508) (\TFBRAVO.WRITE.RUNS 34510 . 35023) (\TFBRAVO.SPREAD.LOOKS
35025 . 36848) (\TFBRAVO.PARSE.PARA 36850 . 38484) (\TFBRAVO.INIT.PARALOOKS 38486 . 40582) (
\TFBRAVO.READ.PARALOOKS 40584 . 44917) (\TFBRAVO.READ.CHARLOOKS 44919 . 48878) (\TFBRAVO.READ.USER.CM
48880 . 51868) (\TFBRAVO.GETPARAMS 51870 . 52632) (\TFBRAVO.PARAMNAMEP 52634 . 52994) (\TFBRAVO.EOLS
52996 . 53279) (\TFBRAVO.LCASER 53281 . 53732) (\TFBRAVO.FONT.FROM.CHARLOOKS 53734 . 54510)))))
STOP