(FILECREATED "19-May-84 23:33:58" {PHYLUM}<TEDIT>TFBRAVO.;52 34909
changes to: (FNS \NAMEDTABSIZE APPLYPARALOOKS WRITEPARAGRAPH)
previous date: " 2-May-84 15:47:19" {DSK}TFBRAVO.;1)
(PRETTYCOMPRINT TFBRAVOCOMS)
(RPAQQ TFBRAVOCOMS [(FILES TEDIT TEXTOFD)
[DECLARE: EVAL@COMPILE DONTCOPY
(COMS (* Compile-time needs)
(RECORDS FONT PARA RUN)
(CONSTANTS (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 COPY.NAMED.TAB POSITION.AT.LAST.TRAILER PUT.NAMED.TAB GET.NAMED.TAB FONTSIZE FONTSTYLE
TFBRAVOWRITERUN ADD.NAMED.TAB \NAMEDTABNYET \NAMEDTABSIZE \REVBIN \SHIFT.DOCUMENT
\TEDIT.BRAVOFILE? \TEDIT.READBRAVOFILE \TEST.CHARACTER.LOOKS \TEST.PARAGRAPH.LOOKS
\NAMEDTAB.INIT)
(FNS APPLYPARALOOKS TEDITFROMBRAVO WRITEPARAGRAPH WRITERUNS SPREADLOOKS PARSEPARAGRAPH
INITPARAGRAPHLOOKS READPARAGRAPHLOOKS READCHARACTERLOOKS READUSER.CM GETPARAMS
PARAMNAMEP EOLS LCASER)
(INITVARS (USER.CM.RDTBL (COPYREADTABLE)))
(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 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 (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
(COPY.NAMED.TAB
[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])
(POSITION.AT.LAST.TRAILER
[LAMBDA (FILE) (* gbn "18-Apr-84 11:56")
(* 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 (if (IGREATERP (GETFILEPTR STREAM)
0)
then (if (NEQ (\REVBIN STREAM)
(CHARCODE CR))
then (* last character of a trailer must be a carriage
return)
NIL
else (while (AND (MEMB (CHARACTER (\REVBIN STREAM))
BRAVO.TRAILER.CHARS)
(IGEQ (GETFILEPTR STREAM)
0))
do NIL)
(if (EQ (\PEEKBIN STREAM)
(CHARCODE ↑Z))
then (* this is a potentially legal trailer)
T
else NIL))
else (* empty files are not Bravo files.
It says here!)
NIL])
(PUT.NAMED.TAB
[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])
(GET.NAMED.TAB
[LAMBDA (CHARSTREAM TEXTSTREAM) (* jds " 8-Feb-84 19:59")
(* should read the position, create an obj and return
it)
(IMAGEOBJCREATE (RATOM CHARSTREAM)
\NAMEDTAB.IMAGEFNS])
(FONTSIZE
[LAMBDA (FONT) (* gbn " 9-NOV-83 19:01")
(* ADD DECLARATION TO ADMIT THAT YOU ARE USING L FREE,
BEST TO REPLACE WITH AN ARRAY IN FACT)
(CADDR (FASSOC FONT (FASSOC (QUOTE Font)
LUSER])
(FONTSTYLE
[LAMBDA (FONT) (* gbn " 9-NOV-83 19:01")
(* ADD DECLARATION TO ADMIT THAT YOU ARE USING L FREE,
BEST TO REPLACE WITH AN ARRAY IN FACT)
(CADR (FASSOC FONT (FASSOC (QUOTE Font)
LUSER])
(TFBRAVOWRITERUN
[LAMBDA (RUN LOOKS IN PARALOOKS TEXTOBJ) (* gbn "30-Apr-84 19:04")
(PROG (START END NAMEDTABNUMBER)
(SETQ NAMEDTABNUMBER (ASSOC (QUOTE TabColor)
(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!)
(ADD.NAMED.TAB TEXTOBJ (CDR NAMEDTABNUMBER)
PARALOOKS))
(T (SETQ END (IPLUS (SETQ START (GETFILEPTR IN))
(fetch RUNLENGTH of RUN)
-1))
(\TEDIT.INCLUDE.SPAN TEXTOBJ IN START END)
(TEDIT.LOOKS TEXTOBJ LOOKS])
(ADD.NAMED.TAB
[LAMBDA (TEXTOBJ TABNO PARALOOKS) (* jds " 8-Feb-84 19:59")
[COND
((NEQ TABNO 0)
(BIN) (* Advance the input stream past the tab character)
(TEDIT.INSERT.OBJECT (IMAGEOBJCREATE (IQUOTIENT (CDR (ASSOC (SUB1 TABNO)
(ASSOC (QUOTE Tabs)
PARALOOKS)))
35)
\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])
(\REVBIN
[LAMBDA (STREAM) (* gbn " 6-Apr-84 00:19")
(* reads a character from the char behind the filepos.
decrements the filepos)
(SETFILEPTR FILE (SUB1 (GETFILEPTR STREAM)))
(\PEEKBIN STREAM])
(\SHIFT.DOCUMENT
[LAMBDA (PCTB DELTAX) (* gbn "23-Apr-84 05:16")
(* 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)
(while PC
do [if (NEQ (fetch PPARALOOKS of PC)
LASTPARALOOKS)
then (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))
(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]
(SETQ LASTPARALOOKS (fetch PPARALOOKS of PC))
(SETQ PC (fetch NEXTPIECE of PC])
(\TEDIT.BRAVOFILE?
[LAMBDA (FILE A B C) (* gbn " 6-Apr-84 01:08")
(* 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 (POSITION.AT.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 (if (EQ (CAR PLOOKS)
(QUOTE \))
then (REPEAT NIL UNTIL (\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}])
(\TEDIT.READBRAVOFILE
[LAMBDA (BRAVOFILE USER.CM TEXTOBJ) (* jds "13-Dec-83 15:38")
(* Given a Bravo-format file and a USER.CM to control
fonts &c, convert the bravo file to TEdit format.)
(PROG (SIZE STYLE THICKNESS SLANT UNDERLINE SUPERSCRIPT SUBSCRIPT OLDPLOOKS L LUSER START END
TEDITWINDOW)
(DECLARE (SPECVARS SIZE STYLE THICKNESS SLANT UNDERLINE SUPERSCRIPT NOUT))
(INFILE USER.CM)
(SETQ LUSER (READUSER.CM USER.CM))
(CLOSEF (INPUT IN)) (* Close USER.CM)
(INITPARAGRAPHLOOKS LUSER)
(SETFILEPTR IN 0)
(SETQ TEDITWINDOW (fetch \WINDOW of TEXTOBJ))
(replace \WINDOW of TEXTOBJ with NIL)
(CLEARW TEDITWINDOW)
[ERSETQ (first (SETQ START (GETFILEPTR IN))
(SETQ L (PARSEPARAGRAPH OLDPLOOKS)) while (fetch RUNS of L)
do (SETQ END (GETFILEPTR IN))
(SETFILEPTR IN START)
(WRITEPARAGRAPH L)
(SETFILEPTR IN END)
(SETQ OLDPLOOKS (fetch PARALOOKS of L))
(SETQ START (GETFILEPTR IN))
(SETQ L (PARSEPARAGRAPH OLDPLOOKS]
(CLOSEF (INPUT))
(replace \WINDOW of TEXTOBJ with TEDITWINDOW])
(\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])
(\NAMEDTAB.INIT
[LAMBDA NIL (* jds " 1-Mar-84 16:20")
(SETQ \NAMEDTAB.IMAGEFNS (IMAGEFNSCREATE (QUOTE NILL)
(QUOTE \NAMEDTABSIZE)
(QUOTE PUT.NAMED.TAB)
(QUOTE GET.NAMED.TAB)
(QUOTE COPY.NAMED.TAB)
(QUOTE NILL)
(QUOTE NILL)
(QUOTE MOVE.NAMED.TAB)
(QUOTE NILL)
(QUOTE NILL)
(QUOTE NILL)
(QUOTE NILL)
(QUOTE NIL])
)
(DEFINEQ
(APPLYPARALOOKS
[LAMBDA (PARALOOKS LENGTH TEXTOBJ MARGIN.CANDIDATE) (* gbn "19-May-84 23:04")
(* Returns the smaller of: the left margin so far, the
smallest left margin in this para)
(USEDFREE NONFEATURES)
(PROG (NLOOKS TABPHRASE (SMALLEST.MARGIN MARGIN.CANDIDATE))
[for PAIR PROP in PARALOOKS
do (* translate from the general names from the form that
PARSEPARAGRAPH returns to those that TEDIT likes)
(COND
((SETQ PROP (SELECTQ (CAR PAIR)
(LeftMargin (QUOTE LEFTMARGIN))
(FirstLineLeftMargin (QUOTE 1STLEFTMARGIN))
(RightMargin (QUOTE RIGHTMARGIN))
NIL)) (* Convert from micas to pts)
(SETQ NLOOKS (NCONC (LIST PROP (SETQ MARGIN (IQUOTIENT (CDR PAIR)
35)))
NLOOKS))
(if (ILESSP MARGIN SMALLEST.MARGIN)
then (SETQ SMALLEST.MARGIN MARGIN)))
((SETQ PROP (SELECTQ (CAR PAIR)
(LineLeading (QUOTE LINELEADING))
(ParagraphLeading (QUOTE PARALEADING))
NIL))
(SETQ NLOOKS (NCONC (LIST PROP (CDR PAIR))
NLOOKS)))
(T (SELECTQ (CAR PAIR)
[Justify (COND
((CDR PAIR)
(SETQ NLOOKS (NCONC (LIST (QUOTE QUAD)
(QUOTE JUST))
NLOOKS]
[Center (COND
((CDR PAIR)
(SETQ NLOOKS (NCONC (LIST (QUOTE QUAD)
(QUOTE CENTERED))
NLOOKS]
[Profile (* this shouldn't be called anymore since profile
paragraphs are excluded in writeparagraph)
(COND
((CDR PAIR)
(PROMPTPRINT
"Profile paragraphs not supported. Text included for reference.")
(TEDIT.LOOKS TEXTOBJ (QUOTE (WEIGHT BOLD]
(Font)
(Tabs [SETQ TABPHRASE
(COND
[(FIXP (CDR PAIR)) (* Just set the default tab width)
(LIST (QUOTE TABS)
(LIST (IQUOTIENT (CDR PAIR)
35]
(T (LIST (QUOTE TABS)
(CONS NIL (for TABPAIR in (CDR PAIR)
when (NEQ (CDR TABPAIR)
(QUOTE DeleteTab))
collect (CONS (IQUOTIENT (CDR TABPAIR)
35)
(QUOTE LEFT]
(SETQ NLOOKS (NCONC (COPY TABPHRASE)
NLOOKS)))
(SETQ NONFEATURES (UNION (LIST (CAR PAIR))
NONFEATURES]
(* the last run in the para is still selected)
(TEDIT.PARALOOKS TEXTOBJ NLOOKS (ADD1 (IDIFFERENCE (fetch TEXTLEN of TEXTOBJ)
LENGTH))
LENGTH)
(TEDIT.SETSEL TEXTOBJ (fetch TEXTLEN of TEXTOBJ)
1
(QUOTE RIGHT))
(RETURN (IMIN SMALLEST.MARGIN MARGIN.CANDIDATE)) (* now return the smallest margin)
])
(TEDITFROMBRAVO
[LAMBDA (FILIN USER.CM) (* gbn " 1-May-84 22:59")
(INFILE FILIN)
(PROG (SIZE STYLE THICKNESS SLANT UNDERLINE SUPERSCRIPT SUBSCRIPT OLDPLOOKS L LUSER START EOFPTR
TEDITWINDOW TEXTOBJ (NONFEATURES NIL)
(SMALLEST.MARGIN MAX.FIXP)
(IN (INPUT))
(NEWSTREAM (OPENTEXTSTREAM "")))
(DECLARE (SPECVARS SIZE STYLE THICKNESS SLANT UNDERLINE SUPERSCRIPT NOUT))
(SETQ TEXTOBJ (TEXTOBJ NEWSTREAM))
(SETQ LUSER (READUSER.CM USER.CM))
(CLOSEF? USER.CM) (* Close USER.CM)
(INITPARAGRAPHLOOKS LUSER)
(SETFILEPTR IN 0)
[ERSETQ (first (SETQ START (GETFILEPTR IN))
(SETQ L (PARSEPARAGRAPH OLDPLOOKS IN)) while (fetch RUNS of L)
do (SETQ EOFPTR (GETFILEPTR IN))
(SETFILEPTR IN START)
(SETQ SMALLEST.MARGIN (WRITEPARAGRAPH L IN TEXTOBJ SMALLEST.MARGIN))
(SETFILEPTR IN EOFPTR)
(SETQ OLDPLOOKS (fetch PARALOOKS of L))
(SETQ START (GETFILEPTR IN))
(SETQ L (PARSEPARAGRAPH OLDPLOOKS IN))
finally (\SHIFT.DOCUMENT (fetch PCTB of TEXTOBJ)
(MINUS SMALLEST.MARGIN]
(CLOSEF (INPUT))
(COND
(NONFEATURES (printout (OR (fetch PROMPTWINDOW of TEXTOBJ)
PROMPTWINDOW)
"Unsupported features in the Bravo document:" .PPVTL NONFEATURES)))
(RETURN NEWSTREAM])
(WRITEPARAGRAPH
[LAMBDA (PARA INFILE TEXTOBJ MARGIN.CANDIDATE) (* gbn "19-May-84 23:10")
(* outputs the character runs, writes an EOL, then apply
paragraph looks. Returns the smallest left margin seen
to date)
(DECLARE (USEDFREE STYLE SIZE SLANT THICKNESS SUPERSCRIPT SUBSCRIPT UNDERLINE OVERSTRIKE))
(if [NOT (CDR (ASSOC (QUOTE Profile)
(fetch PARALOOKS of PARA]
then (* don't write out profile paragraphs)
(PROG ((LOOKS (LIST (QUOTE FAMILY)
(FONTSTYLE 0)
(QUOTE SIZE)
(FONTSIZE 0)
(QUOTE SLOPE)
(QUOTE REGULAR)
(QUOTE WEIGHT)
(QUOTE MEDIUM)
(QUOTE UNDERLINE)
(QUOTE OFF)
(QUOTE SUPERSCRIPT)
0
(QUOTE SUBSCRIPT)
0))
LENGTH)
(SETQ LENGTH (ADD1 (WRITERUNS PARA INFILE TEXTOBJ LOOKS)))
(EOLS 1 TEXTOBJ)
(RETURN (APPLYPARALOOKS (fetch PARALOOKS of PARA)
LENGTH TEXTOBJ MARGIN.CANDIDATE)))
else MARGIN.CANDIDATE])
(WRITERUNS
[LAMBDA (PARA INFILE TEXTOBJ CHARLOOKS) (* gbn "23-Apr-84 03:28")
(DECLARE (USEDFREE UNDERLINE SUPERSCRIPT))
(PROG ((RUNS (fetch RUNS of PARA))
(PARALOOKS (fetch PARALOOKS of PARA))
(LENGTH 0))
(for RUN in old RUNS
do (SETQ CHARLOOKS (SPREADLOOKS RUN CHARLOOKS))
(TFBRAVOWRITERUN RUN CHARLOOKS INFILE PARALOOKS TEXTOBJ)
(SETQ LENGTH (IPLUS (fetch RUNLENGTH of RUN)
LENGTH)))
(RETURN LENGTH])
(SPREADLOOKS
[LAMBDA (RUN LOOKS) (* jds "15-Dec-83 15:55")
(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)
(FONTSIZE (CDR INSTR)))
(LISTPUT LOOKS (QUOTE FAMILY)
(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])
(PARSEPARAGRAPH
[LAMBDA (OLDPLOOKS FILE) (* jds "15-Dec-83 14:36")
(* 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 (LIST DefaultParagraphLooks]
(SETQ LEN (IDIFFERENCE LEN ORIGPTR)) (* BIN past the ↑z)
(BIN FILE)
(SETQ PLOOKS (READPARAGRAPHLOOKS OLDPLOOKS FILE))
[COND
((NEQ [CAR (PROG1 PLOOKS (SETQ PLOOKS (CDR PLOOKS]
(QUOTE \))
(RETURN (create PARA
PARALOOKS ← PLOOKS
RUNS ←(LIST (create RUN
RUNLENGTH ← LEN]
CLP [while [fetch RUNLENGTH of (CAR (push RUNS (READCHARACTERLOOKS 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])
(INITPARAGRAPHLOOKS
[LAMBDA (USER.CM.LOOKS) (* gbn "10-Jan-84 21:55")
(SETQ HardwareWidth (IDIFFERENCE HardwareRightMargin HardwareLeftMargin))
(SETQ DefaultParagraphLooks USER.CM.LOOKS)
(if (FASSOC (QUOTE LeftMargin)
DefaultParagraphLooks)
then (if (FASSOC (QUOTE FirstLineLeftMargin)
DefaultParagraphLooks)
else (PUTASSOC (QUOTE FirstLineLeftMargin)
(CDR (FASSOC (QUOTE LeftMargin)
DefaultParagraphLooks))
DefaultParagraphLooks))
else (PUTASSOC (QUOTE LeftMargin)
DefaultLeftMargin DefaultParagraphLooks)
(PUTASSOC (QUOTE FirstLineLeftMargin)
DefaultFirstLineLeftMargin DefaultParagraphLooks))
(if (FASSOC (QUOTE LineLeading)
DefaultParagraphLooks)
else (PUTASSOC (QUOTE LineLeading)
1 DefaultParagraphLooks))
(if (FASSOC (QUOTE ParagraphLeading)
DefaultParagraphLooks)
else (PUTASSOC (QUOTE ParagraphLeading)
0 DefaultParagraphLooks))
(if (FASSOC (QUOTE RightMargin)
DefaultParagraphLooks)
else (PUTASSOC (QUOTE RightMargin)
DefaultRightMargin DefaultParagraphLooks])
(READPARAGRAPHLOOKS
[LAMBDA (OLDLOOKS FILE) (* gbn "10-Jan-84 23:06")
(PROG [(ALIST (COPY DefaultParagraphLooks))
LMFLAG FLLMFLAG PROPERTY CHAR TABINDEX TEM (VALUE 0)
(TABS (CDR (FASSOC (QUOTE Tabs)
OLDLOOKS]
LP (while [NUMBERP (SETQ CHAR (FCHARACTER (BIN FILE] do (SETQ VALUE (IPLUS (ITIMES VALUE 10)
CHAR)))
[COND
((SETQ TEM (SELECTQ PROPERTY
(l (SETQQ LMFLAG LeftMargin))
(d (SETQQ FLLMFLAG FirstLineLeftMargin))
(z (QUOTE RightMargin))
(x (QUOTE LineLeading))
(e (QUOTE ParagraphLeading))
(y (COND
((IEQP VALUE 65535)
(SETQ VALUE NIL)))
(QUOTE VerticalTab))
(k (QUOTE Keep))
NIL))
(PUTASSOC TEM VALUE ALIST))
((SETQ TEM (SELECTQ PROPERTY
(j (QUOTE (Justify . T)))
(c (QUOTE (Center . T)))
(q (QUOTE (Profile . T)))
NIL)) (* these values are not included in the
defaultparagraphlooks so they can just be cons'ed onto
the list.)
(SETQ ALIST (CONS TEM ALIST)))
(T (SELECTQ PROPERTY
[%( (SELECTQ CHAR
(%) (SETQ TABS VALUE))
(, [COND
((IGREATERP VALUE 14)
(HELP VALUE (QUOTE " is not a legal tab #"]
(SETQ TABINDEX VALUE))
(HELP CHAR (QUOTE " is not legal after ("]
[, (SETQ TABS (CONS (CONS TABINDEX (COND
((IEQP VALUE 65535)
(QUOTE DeleteTab))
(T VALUE)))
(LISTP TABS]
((%) 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))
(PUTASSOC (QUOTE FirstLineLeftMargin)
(CDR (FASSOC (QUOTE LeftMargin)
ALIST))
ALIST)))
(COND
(TABS (PUTASSOC (QUOTE Tabs)
TABS ALIST)))
(RETURN (CONS CHAR ALIST])
(READCHARACTERLOOKS
[LAMBDA (FILE) (* jds "15-Dec-83 14:38")
(PROG (ALIST PROPERTY VALFLAG PAIR TEM (VALUE 0)
CHAR)
LP (while [NUMBERP (SETQ CHAR (FCHARACTER (BIN FILE]
do (SETQ VALUE (IPLUS (ITIMES VALUE 10)
CHAR))
(SETQ VALFLAG T))
[COND
(PROPERTY [COND
((NULL VALFLAG)
(HELP PROPERTY (QUOTE "- no value for character look")))
((SETQ PAIR (FASSOC PROPERTY ALIST))
(FRPLACD PAIR VALUE))
(T (SETQ ALIST (CONS (CONS PROPERTY VALUE)
ALIST]
(SETQ PROPERTY NIL))
(VALFLAG (* the idiff here used to be IBOXed)
[SETFILEPTR FILE (IDIFFERENCE (GETFILEPTR FILE)
(COND
([EQ CHAR (CONSTANT (CHARACTER (CHARCODE EOL]
2)
(T 1]
(RETURN (CONS VALUE ALIST]
[COND
((SETQ TEM (SELECTQ CHAR
(s (QUOTE (Overstrike . T)))
(S (QUOTE (Overstrike)))
(u (QUOTE (Underline . T)))
(U (QUOTE (Underline)))
(b (QUOTE (Bold . T)))
(B (QUOTE (Bold)))
(i (QUOTE (Italic . T)))
(I (QUOTE (Italic)))
(g (QUOTE (Graphic . T)))
(G (QUOTE (Graphic)))
(v (QUOTE (Visible . T)))
(V (QUOTE (Visible)))
NIL))
[COND
((SETQ PAIR (FASSOC (CAR TEM)
ALIST))
(FRPLACA (FMEMB PAIR ALIST)
TEM))
(T (SETQ ALIST (CONS TEM ALIST]
(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 ALIST)))
((NEQ CHAR (QUOTE % ))
(HELP CHAR (QUOTE " is not a legal character look"]
(SETQ VALUE 0)
(SETQ VALFLAG NIL)
(GO LP])
(READUSER.CM
[LAMBDA (FILE) (* gbn "23-Apr-84 02:01")
(* 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 [GETPARAMS LINE (QUOTE ((Tabs standard tab width]
ALIST)))
(MARGINS (SETQ ALIST (NCONC [GETPARAMS LINE (QUOTE ((LeftMargin left margin)
(RightMargin right margin]
ALIST)))
(LEAD (SETQ ALIST (NCONC [GETPARAMS LINE (QUOTE ((ParagraphLeading paragraph
leading)
(LineLeading line leading]
ALIST)))
NIL)
(GO LLP])
(GETPARAMS
[LAMBDA (LIS NAMES) (* lmm " 8-AUG-77 12:29")
(PROG ((L LIS)
ALIST TEST REST)
[MAP L (FUNCTION (LAMBDA (WORDL)
(COND
((LITATOM (CAR WORDL))
(FRPLACA WORDL (LCASER (CAR WORDL]
LP (COND
((NULL L)
(RETURN ALIST)))
(SETQ TEST NAMES)
NLP (COND
((SETQ REST (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])
(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])
(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])
(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])
)
(RPAQ? USER.CM.RDTBL (COPYREADTABLE))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS \NAMEDTAB.IMAGEFNS)
)
(DECLARE: DONTEVAL@LOAD DOCOPY
(ADDTOVAR TEDIT.INPUT.FORMATS (\TEDIT.BRAVOFILE? TEDITFROMBRAVO))
(\NAMEDTAB.INIT)
)
(DECLARE: DONTCOPY
(FILEMAP (NIL (2333 16320 (COPY.NAMED.TAB 2343 . 2786) (POSITION.AT.LAST.TRAILER 2788 . 3895) (
PUT.NAMED.TAB 3897 . 4235) (GET.NAMED.TAB 4237 . 4552) (FONTSIZE 4554 . 4891) (FONTSTYLE 4893 . 5236)
(TFBRAVOWRITERUN 5238 . 6076) (ADD.NAMED.TAB 6078 . 6800) (\NAMEDTABNYET 6802 . 6962) (\NAMEDTABSIZE
6964 . 7633) (\REVBIN 7635 . 7970) (\SHIFT.DOCUMENT 7972 . 10139) (\TEDIT.BRAVOFILE? 10141 . 12020) (
\TEDIT.READBRAVOFILE 12022 . 13385) (\TEST.CHARACTER.LOOKS 13387 . 14519) (\TEST.PARAGRAPH.LOOKS 14521
. 15825) (\NAMEDTAB.INIT 15827 . 16318)) (16321 34649 (APPLYPARALOOKS 16331 . 19262) (TEDITFROMBRAVO
19264 . 20750) (WRITEPARAGRAPH 20752 . 21925) (WRITERUNS 21927 . 22464) (SPREADLOOKS 22466 . 24060) (
PARSEPARAGRAPH 24062 . 25402) (INITPARAGRAPHLOOKS 25404 . 26597) (READPARAGRAPHLOOKS 26599 . 28633) (
READCHARACTERLOOKS 28635 . 30473) (READUSER.CM 30475 . 33077) (GETPARAMS 33079 . 33702) (PARAMNAMEP
33704 . 33999) (EOLS 34001 . 34259) (LCASER 34261 . 34647)))))
STOP