Source Code 1994 March/Source_Code_CD-ROM_Walnut_Creek_March_1994.iso/compsrcs/misc/volume37/lout/part07

Text File | 1993-06-19 | 81.2 KB | 2,190 lines

Newsgroups: comp.sources.misc
From: [e-mail] (Jeff Kingston)
Subject: v37i105:  lout - Lout document formatting system, v2, Part07/30
Message-ID: <[e-mail]>
X-Md4-Signature: de533b7ce682aaab837348390588ad3e
Sender: [e-mail] (Kent Landfield)
Organization: Sterling Software
Date: Tue, 1 Jun 1993 05:17:36 GMT
Approved: [e-mail]

Submitted-by: [e-mail] (Jeff Kingston)
Posting-number: Volume 37, Issue 105
Archive-name: lout/part07
Environment: UNIX

#! /bin/sh
# This is a shell archive.  Remove anything before this line, then feed it
# into a shell via "sh file" or similar.  To overwrite existing files,
# type "sh file -c".
# Contents:  lout/doc/tr.eq/s2 lout/z03.c lout/z08.c
# Wrapped by kent@sparky on Sun May 30 19:43:55 1993
PATH=/bin:/usr/bin:/usr/ucb:/usr/local/bin:/usr/lbin ; export PATH
echo If this archive is complete, you will see the following message:
echo '          "shar: End of archive 7 (of 30)."'
if test -f 'lout/doc/tr.eq/s2' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'lout/doc/tr.eq/s2'\"
else
  echo shar: Extracting \"'lout/doc/tr.eq/s2'\" \(6731 characters\)
  sed "s/^X//" >'lout/doc/tr.eq/s2' <<'END_OF_FILE'
X@Section
X   @Title { Symbols }
X@Begin
X@PP
XEq prints characters in the fonts appropriate for mathematics:
X@ID {
X@Code "x - 2"
X|7ct
X@Eq { x-2 }
X}
XHere @Eq {x} is in Italic, @Eq { 2 } is in Roman, and @Eq { minus } is
Xfrom the Symbol font.  The character @Code "-" is a @I symbol which
Xstands for {@Eq {minus}}, and @Code "2" is also a symbol, standing for
X{@Eq { 2 }}.  Eq includes a vast number of symbols:
X@ID {
X@Code "Omega delta int partial club"
X|7ct
X@Eq { Omega delta int partial club }
X}
XThe summary at the end of this report has the complete list.
X@PP
XSymbols whose names are made from letters should be separated from each
Xother by at least one space or end of line, as was done above, or else
XEq will become confused:
X@ID {
X@Code "Omegadelta"
X|7ct
X@Eq { Omegadelta }
X}
XSymbols whose names are made from digits and punctuation characters can,
Xhowever, be run together with each other and with symbols made from
Xletters:
X@ID {
X@Code "Omega-delta<=2"
X|7ct
X@Eq { Omega-delta<=2 }
X}
XThis rule applies throughout the Lout world.
X@PP
XSome symbols join objects together in mathematical ways:
X@ID {
X@Code "x sub 2"
X|7ct
X@Eq { x sub 2 }
X}
XHere the @Code "sub" symbol has taken the object just to its left, and
Xthe object just to its right, and joined them into one object in the
Xform of a subscript.  The two objects are called the left and right
Xparameters of {@Code "sub"}, and they may be arbitrary Lout objects.
X@PP
XOther symbols of a similar kind include {@Code "sup"} for
Xsuperscripting, @Code "over" for built-up fractions, and @Code "from"
Xand @Code "to" for the lower and upper limits of sums, products,
Xetc.  These symbols may be used together to produce complicated
Xequations with astonishing ease:
X@ID {
X@Code {
X"big sum from i=0 to n r sup i"
X"= {r sup n+1 - 1} over r-1"
X}
X||7ct
X@Eq { big sum from i=0 to n r sup i
X= {r sup n+1 - 1} over r-1
X}
X}
XHere @Code "sum" is just the @Eq { summation } symbol; @Code "from" and
X@Code "to" do all the work of placing the limits.  They are quite
Xindependent, so either or both may be omitted.  To get a superscript
Xdirectly over a subscript, use the @Code "supp" and @Code "on" symbols:
X@ID {
X@Code "A supp 2 on 1"
X|7ct
X@Eq { A supp 2 on 1 }
X}
XThese two symbols should always be used together as shown.
X@PP
XAs usual in Lout, braces are used to group something into an indivisible
Xobject.  Leaving them out creates ambiguities:
X@ID @Code "a  sup  b  over  c"
XThere are two possible interpretations for this:
X@IndentedList
X@LI {
X@Code "{a  sup  b}  over  c"
X|7ct
X@Eq {  {a  sup  b}  over  c }
X}
X@LI {
X@Code "a  sup  {b  over  c}"
X|7ct
X@Eq {  a  sup  {b  over  c} }
X}
X@EndList
XEq chooses between them in the following way.  Every symbol that takes a
Xparameter also has a {@I precedence}, which is a number.  For example,
X@Code "sup" has precedence 60 and @Code "over" has precedence 54.  The
Xsymbol with the highest precedence wins the object lying between them,
Xso in the above case the first interpretation is chosen.  If two symbols
Xof equal precedence compete for an object, the association is towards
Xthe left:
X@ID {
X@Code "a sup b sub 2"
X|7ct
X@Eq { a sup b sub 2 }
X}
XIn this case it is more probable that the following right association
Xwas actually wanted:
X@ID {
X@Code "a sup { b sub 2 }"
X|7ct
X@Eq { a sup { b sub 2 } }
X}
X@PP
XWhite space between two objects is considered to be a symbol with
Xprecedence 7, which is lower than the precedence of any Eq symbol; but
Xif the two objects are immediately adjacent the precedence is 102, which
Xis higher than the precedence of any Eq symbol.  Compare these three
Xexamples:
X@IL
X@LI {
X@Code "big sum from i=0 to n"
X|7ct
X@Eq {  big sum from i=0 to n }
X}
X@LI {
X@Code "big sum from {i = 0} to n"
X|7ct
X@Eq {  big sum from {i = 0} to n }
X}
X@LI {
X@Code "big sum from i = 0 to n"
X|7ct
X@Eq {  big sum from i = 0 to n }
X}
X@EL
Xand you will see that some care is needed on this point.  Braces can
Xalways be used to override precedence and associativity,
Xand when in doubt the easiest course is to insert them.  Although
XLout allows symbols to associate towards the left or right, Eq chooses
Xto have only left associative symbols.  The summary at the end of this
Xreport gives the precedence of every symbol.
X@PP
XThe @I matrix symbol {@PageMark matrix} builds an array of objects:
X@ID {
X@Code {
X"matrix"
X"   atleft { blpar }"
X"   atright { brpar }"
X"{ x sup 2 above x above 1"
X"  nextcol"
X"  y sup 2 above y above 1"
X"  nextcol"
X"  z sup 2 above z above 1"
X"}"
X}
X||7ct
X@Eq {
Xmatrix
X   atleft { blpar }
X   atright { brpar }
X{ x sup 2 above x above 1
X  nextcol
X  y sup 2 above y above 1
X  nextcol
X  z sup 2 above z above 1
X}
X}
X}
XThe @Code atleft and @Code atright options place vertically scaled
Xversions of their
Xvalues at each side; if either is omitted the value is taken to be an
Xempty object of zero width by default.  The right parameter of @Code
Xmatrix is the array itself.  It is a sequence of columns separated by
X@Code nextcol symbols; each column is a sequence of objects separated by
X@Code above symbols.
X@PP
XThe @Code nextcol and @Code above symbols have low precedence, but not
Xas low as white space between two objects.  Therefore, unless the
Xentries in the array are very simple, it is safest to enclose each of
Xthem in braces.
X@PP
XColumns built with the @Code above symbol have their objects centred in
Xthe column.  Also available are @Code labove for left-justified columns,
X@Code cabove meaning the same as {@Code above}, @Code rabove for
Xright-justified columns, and @Code mabove for alignment along column
Xmarks.  Each column should contain only one kind of @Code above symbol
X(although adventurous users might be able to get some mixtures to work), but
Xdifferent columns may differ.  For example,
X@ID @Code {
X"@R \"Chain rule:\"  labove  @R \"Product rule:\""
X"nextcol"
X"{df over dx ^= df over dy cdot dy over dx}"
X"mabove"
X"{dfg over dy ^= f ` dg over dx + g df over dx}"
X}
Xhas result
X@ID @Eq {
X   @R "Chain rule:" labove @R "Product rule:"
X   nextcol
X   {df over dx ^= df over dy cdot dy over dx}
X   mabove
X   {dfg over dy ^= f ` dg over dx + g df over dx}
X}
XAs this last example shows, it is @Code nextcol and the various @Code
Xabove symbols that lay out the array; @Code matrix attaches the @Code
Xatleft and @Code atright options and makes sure the result appears in
Xthe correct vertical position relative to the rest of the equation.  So
Xthe right parameter of @Code matrix may be any object.
X@PP
XEach of the Eq symbols that takes parameters also has a @Code gap
Xoption, which controls the amount of space inserted by the symbol:
X@IL
X@LI {
X@Code "x over y"
X|7ct
X@Eq { x over y }
X}
X@LI {
X6c @Wide @Code "x over gap { 3p } y"
X|7ct
X@Eq { x over gap { 3p } y }
X}
X@EL
XEq usually gets the spacing right without help.
X@End @Section
END_OF_FILE
  if test 6731 -ne `wc -c <'lout/doc/tr.eq/s2'`; then
    echo shar: \"'lout/doc/tr.eq/s2'\" unpacked with wrong size!
  fi
  # end of 'lout/doc/tr.eq/s2'
fi
if test -f 'lout/z03.c' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'lout/z03.c'\"
else
  echo shar: Extracting \"'lout/z03.c'\" \(35079 characters\)
  sed "s/^X//" >'lout/z03.c' <<'END_OF_FILE'
X/*@z03.c:File Service:DefineFile(), FirstFile()@**************************** */
X/*                                                                           */
X/*  LOUT: A HIGH-LEVEL LANGUAGE FOR DOCUMENT FORMATTING (VERSION 2.03)       */
X/*  COPYRIGHT (C) 1993 Jeffrey H. Kingston                                   */
X/*                                                                           */
X/*  Jeffrey H. Kingston ([e-mail])                                   */
X/*  Basser Department of Computer Science                                    */
X/*  The University of Sydney 2006                                            */
X/*  AUSTRALIA                                                                */
X/*                                                                           */
X/*  This program is free software; you can redistribute it and/or modify     */
X/*  it under the terms of the GNU General Public License as published by     */
X/*  the Free Software Foundation; either version 1, or (at your option)      */
X/*  any later version.                                                       */
X/*                                                                           */
X/*  This program is distributed in the hope that it will be useful,          */
X/*  but WITHOUT ANY WARRANTY; without even the implied warranty of           */
X/*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the            */
X/*  GNU General Public License for more details.                             */
X/*                                                                           */
X/*  You should have received a copy of the GNU General Public License        */
X/*  along with this program; if not, write to the Free Software              */
X/*  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.                */
X/*                                                                           */
X/*  FILE:         z03.c                                                      */
X/*  MODULE:       File Service                                               */
X/*  EXTERNS:      InitFiles(), AddToPath(), DefineFile(), FirstFile(),       */
X/*                NextFile(), FileNum(), FileName(), EchoFilePos(),          */
X/*                OpenFile(), ReadFromFile(), AppendToFile(), CloseFiles()   */
X/*                                                                           */
X/*****************************************************************************/
X#include "externs"
X#define MAX_TYPES      9            /* number of file types      */
X#define MAX_PATHS      6            /* number of search paths    */
X#define    TAB_MASK    0xFF            /* mask forces <= MAX_FILES  */
X
X#define    file_number(x)    word_font(x)        /* file number of file x     */
X#define    updated(x)    broken(x)        /* TRUE when x is updated    */
X#define    path(x)        back(x, COL)        /* search path for file x    */
X
Xstatic    int    file_count;            /* total number of files     */
Xstatic    OBJECT    fvec[MAX_FILES] = { nil };    /* the file table            */
Xstatic    OBJECT    file_list[MAX_TYPES];        /* files of each type        */
Xstatic    OBJECT    file_path[MAX_PATHS];        /* the search paths          */
X#ifdef DEBUG_ON
Xstatic    char    *file_types[]        /* the type names for debug  */
X        = { "source", "include", "incgraphic", "database",
X            "index", "font", "prepend", "hyph", "hyphpacked" };
X#endif
X
X
X/*****************************************************************************/
X/*                                                                           */
X/*  no_fpos                                                                  */
X/*                                                                           */
X/*  A null file position value.                                              */
X/*                                                                           */
X/*****************************************************************************/
X
Xstatic FILE_POS no_file_pos = {0, 0, 0};
XFILE_POS *no_fpos = &no_file_pos;
X
X
X/*****************************************************************************/
X/*                                                                           */
X/*  #define hash(str, val)                                                   */
X/*                                                                           */
X/*  Hash the string str and return its value in val.                         */
X/*                                                                           */
X/*****************************************************************************/
X
X#define hash(str, val)                            \
X{ p = str;                                \
X  val = *p++;                                \
X  while( *p ) val += *p++;                        \
X  val = (val * 8) & TAB_MASK;                        \
X}
X
X
X/*****************************************************************************/
X/*                                                                           */
X/*  InitFiles()                                                              */
X/*                                                                           */
X/*  Initialize this module.                                                  */
X/*                                                                           */
X/*****************************************************************************/
X
XInitFiles()
X{ int i;
X  for( i = 0;  i < MAX_TYPES; i++ )  file_list[i]  = New(ACAT);
X  for( i = 0;  i < MAX_PATHS; i++ )  file_path[i] = New(ACAT);
X  fvec[0] = file_list[0];    /* so that no files will be given slot 0 */
X  file_count = 1;
X} /* end InitFiles */
X
X
X/*@@**************************************************************************/
X/*                                                                           */
X/*  AddToPath(fpath, dirname)                                                */
X/*                                                                           */
X/*  Add the directory dirname to the end of search path fpath.               */
X/*                                                                           */
X/*****************************************************************************/
X
XAddToPath(fpath, dirname)
Xint fpath; unsigned char *dirname;
X{ OBJECT x;
X  x = MakeWord(dirname, no_fpos);
X  Link(file_path[fpath], x);
X} /* end AddToPath */
X
X
X/*****************************************************************************/
X/*                                                                           */
X/*  FILE_NUM DefineFile(x, ftype, fpath)                                     */
X/*                                                                           */
X/*  Declare file x, which is a WORD object containing the file name.         */
X/*  ftype is the file's type; fpath is its search path.                      */
X/*                                                                           */
X/*****************************************************************************/
X
XFILE_NUM DefineFile(x, ftype, fpath)
XOBJECT x;  int ftype, fpath;
X{ register unsigned char *p;
X  register int i;
X  assert( type(x) == WORD, "DefineFile: type(x) != WORD!" );
X  assert( ftype < MAX_TYPES, "DefineFile: ftype!" );
X  debug3(DFS, D, "DefineFile( %s, %s, %d )",
X    EchoObject(null,x), file_types[ftype], fpath);
X  if( ftype == SOURCE_FILE && (i = strlen(string(x))) >= 3 )
X  {
X    /* check that file name does not end in ".li" or ".ld" */
X    if( strcmp(&string(x)[i-strlen(DATA_SUFFIX)], DATA_SUFFIX) == 0 )
X      Error(FATAL, &fpos(x),
X    "database file %s where source file expected", string(x));
X    if( strcmp(&string(x)[i-strlen(INDEX_SUFFIX)], INDEX_SUFFIX) == 0 )
X      Error(FATAL, &fpos(x),
X    "database index file %s where source file expected", string(x));
X  }
X  if( ++file_count >= MAX_FILES ) Error(FATAL, &fpos(x), "too many file names");
X  hash(string(x), i);
X  while( fvec[i] != nil )
X    if( ++i >= MAX_FILES ) i = 0;
X  fvec[i] = x;
X  Link(file_list[ftype], x);
X  file_number(x) = i;
X  path(x) = fpath;
X  debug1(DFS, D, "DefineFile returning %s",
X    i == NO_FILE ? (unsigned char *) "none" : FileName( (FILE_NUM) i));
X  return (FILE_NUM) i;
X} /* end DefineFile */
X
X
X/*****************************************************************************/
X/*                                                                           */
X/*  FILE_NUM FirstFile(ftype)                                                */
X/*                                                                           */
X/*  Returns first file of type ftype, else NO_FILE.                          */
X/*                                                                           */
X/*****************************************************************************/
X
XFILE_NUM FirstFile(ftype)
Xint ftype;
X{ FILE_NUM i;
X  OBJECT link, y;
X  debug1(DFS, D, "FirstFile( %s )", file_types[ftype]);
X  link = Down(file_list[ftype]);
X  if( type(link) == ACAT )  i = NO_FILE;
X  else
X  { Child(y, link);
X    i = file_number(y);
X  }
X  debug1(DFS, D, "FirstFile returning %s",
X    i == NO_FILE ? (unsigned char *) "none" : FileName(i));
X  return i;
X} /* end FirstFile */
X
X
X/*@@**************************************************************************/
X/*                                                                           */
X/*  FILE_NUM NextFile(i)                                                     */
X/*                                                                           */
X/*  Returns the next file after file i of i's type, else NO_FILE.            */
X/*                                                                           */
X/*****************************************************************************/
X
XFILE_NUM NextFile(i)
XFILE_NUM i;
X{ OBJECT link, y;
X  debug1(DFS, D, "NextFile( %s )", EchoObject(null, fvec[i]));
X  link = NextDown(Up(fvec[i]));
X  if( type(link) == ACAT )  i = NO_FILE;
X  else
X  { Child(y, link);
X    i = file_number(y);
X  }
X  debug1(DFS, D, "NextFile returning %s",
X    i == NO_FILE ? (unsigned char *) "none" : FileName(i));
X  return i;
X} /* end NextFile */
X
X
X/*****************************************************************************/
X/*                                                                           */
X/*  FILE_NUM FileNum(str)                                                    */
X/*                                                                           */
X/*  Return the file number of the file with name str, else NO_FILE.          */
X/*                                                                           */
X/*****************************************************************************/
X
XFILE_NUM FileNum(str)
Xunsigned char *str;
X{ register unsigned char *p;
X  register int i;
X  debug1(DFS, D, "FileNum( %s )", str);
X  hash(str, i);
X  while( fvec[i] != nil && strcmp(string(fvec[i]), str) != 0 )
X    if( ++i >= MAX_FILES ) i = 0;
X  if( fvec[i] == nil ) i = 0;
X  debug1(DFS, D, "FileNum returning %s",
X    i == NO_FILE ? (unsigned char *) "none" : FileName( (FILE_NUM) i));
X  return (FILE_NUM) i;
X} /* end FileNum */
X
X
X/*****************************************************************************/
X/*                                                                           */
X/*  unsigned char *FileName(fnum)                                            */
X/*                                                                           */
X/*  Return the string name of the file with this number.  This is the name   */
X/*  provided by DefineFile until OpenFile is called, after which it is the   */
X/*  full path name.                                                          */
X/*                                                                           */
X/*****************************************************************************/
X
Xunsigned char *FileName(fnum)
XFILE_NUM fnum;
X{ OBJECT x;
X  assert( fnum > 0 , "FileName: num!" );
X  assert( fvec[fnum] != nil, "FileName: fvec[fnum] == nil!" );
X  x = fvec[fnum];
X  if( Down(x) != x )  Child(x, Down(x));
X  return string(x);
X} /* end FileName */
X
X
X/*@@**************************************************************************/
X/*                                                                           */
X/*  unsigned char *EchoFilePos(pos)                                          */
X/*                                                                           */
X/*  Returns a string reporting the value of file position pos.               */
X/*                                                                           */
X/*****************************************************************************/
X
Xstatic unsigned char buff[2][MAX_LINE];  static bp = 1;
X
Xstatic append_fpos(pos)
XFILE_POS *pos;
X{ OBJECT x;
X  x = fvec[file_num(*pos)];
X  assert( x != nil, "EchoFilePos: fvec[] entry is nil!" );
X  if( file_num(fpos(x)) > 0 )
X  { append_fpos( &fpos(x) );
X    if( strlen(buff[bp]) + 2 >= MAX_LINE )
X      Error(FATAL,no_fpos,"file position %s... is too long to print", buff[bp]);
X    strcat(buff[bp], " /");
X  }
X  if( strlen(buff[bp]) + strlen(string(x)) + 13 >= MAX_LINE )
X    Error(FATAL, no_fpos, "file position %s... is too long to print", buff[bp]);
X  sprintf(&buff[bp][strlen(buff[bp])], " \"%s\"", string(x));
X  if( line_num(*pos) != 0 )
X    sprintf(&buff[bp][strlen(buff[bp])]," %d,%d",line_num(*pos), col_num(*pos));
X} /* end append_fpos */
X
Xunsigned char *EchoFilePos(pos)
XFILE_POS *pos;
X{ bp = (bp + 1) % 2;
X  strcpy(buff[bp], "");
X  if( file_num(*pos) > 0 )  append_fpos(pos);
X  return buff[bp];
X} /* end EchoFilePos */
X
X
X/*****************************************************************************/
X/*                                                                           */
X/*  FILE_POS *PosOfFile(fnum)                                                */
X/*                                                                           */
X/*  Returns a pointer to the file position where file fnum was encountered.  */
X/*                                                                           */
X/*****************************************************************************/
X
XFILE_POS *PosOfFile(fnum)
XFILE_NUM fnum;
X{ OBJECT x;
X  x = fvec[fnum];
X  assert( x != nil, "PosOfFile: fvec[] entry is nil!" );
X  return &fpos(x);
X}
X
X
X/*****************************************************************************/
X/*                                                                           */
X/*  FILE *SearchPath(str, fpath, check_ld, full_name, xfpos)                 */
X/*                                                                           */
X/*  Search the given path for a file whose name is str.  If found, open      */
X/*  it; return the resulting FILE *.                                         */
X/*                                                                           */
X/*  If check_ld is TRUE, it means that the file to be opened is a .li file   */
X/*  and OpenFile() is required to check whether the corresponding .ld file   */
X/*  is present.  If it is, then the search must stop.                        */
X/*                                                                           */
X/*  Also return the full path name in object *full_name if reqd, else nil.   */
X/*                                                                           */
X/*****************************************************************************/
X
Xstatic FILE *SearchPath(str, fpath, check_ld, full_name, xfpos)
Xunsigned char *str;  OBJECT fpath;  BOOLEAN check_ld;
XOBJECT *full_name;  FILE_POS *xfpos;
X{
X  unsigned char buff[MAX_LINE];  OBJECT link, y;  FILE *fp;
X  debug3(DFS, DD, "SearchPath(%s, %s, %s, -)", str, EchoObject(null, fpath),
X    bool(check_ld));
X  *full_name = nil;
X  if( strcmp(str, "-") == 0 )
X  { fp = stdin;
X    debug0(DFS, DD, "  opened stdin");
X  }
X  else if( str[0] == '/' )
X  { fp = fopen(str, "r");
X    debug1(DFS, DD, fp==null ? "  failed on %s" : "  succeeded on %s", str);
X  }
X  else
X  { fp = null;
X    for( link = Down(fpath);  fp==null && link != fpath; link = NextDown(link) )
X    { Child(y, link);
X      if( string(y)[0] == '\0' )
X      { strcpy(buff, str);
X    fp = fopen(str, "r");
X    debug1(DFS, DD, fp==null ? "  failed on %s" : "  succeeded on %s", str);
X      }
X      else
X      {    if( strlen(string(y)) + 1 + strlen(str) >= MAX_LINE )
X      Error(FATAL, &fpos(y), "file path name %s/%s is too long",
X        string(y), str);
X    sprintf(buff, "%s/%s", string(y), str);
X    fp = fopen(buff, "r");
X    debug1(DFS, DD, fp==null ? "  failed on %s" : "  succeeded on %s",buff);
X    if( fp != null ) *full_name = MakeWord(buff, xfpos);
X      }
X      if( fp == null && check_ld )
X      {    strcpy(&buff[strlen(buff) - strlen(INDEX_SUFFIX)], DATA_SUFFIX);
X    fp = fopen(buff, "r");
X    debug1(DFS,DD,fp==null ? "  failed on %s" : "  succeeded on %s", buff);
X    if( fp != null )
X    { fclose(fp);
X      debug0(DFS, D, "SearchPath returning null (adjacent .ld file)");
X      return null;
X    }
X      }
X    }
X  }
X  debug1(DFS, DD, "SearchPath returning (fp %s null)", fp==null ? "==" : "!=");
X  return fp;
X} /* end SearchPath */
X
X
X/*****************************************************************************/
X/*                                                                           */
X/*  FILE *OpenFile(fnum, check_ld)                                           */
X/*                                                                           */
X/*  Open for reading the file whose number is fnum.  This involves           */
X/*  searching for it along its path if not previously opened.                */
X/*                                                                           */
X/*  If check_ld is TRUE, it means that the file to be opened is a .li file   */
X/*  and OpenFile() is required to check whether the corresponding .ld file   */
X/*  is present.  If it is, then the search must stop.                        */
X/*                                                                           */
X/*****************************************************************************/
X
XFILE *OpenFile(fnum, check_ld)
XFILE_NUM fnum;  BOOLEAN check_ld;
X{ FILE *fp;  OBJECT full_name, y;
X  ifdebug(DPP, D, ProfileOn("OpenFile"));
X  debug2(DFS, D, "OpenFile(%s, %s)", FileName(fnum), bool(check_ld));
X  if( Down(fvec[fnum]) != fvec[fnum] )
X  { Child(y, Down(fvec[fnum]));
X    fp = fopen(string(y), "r");
X    debug1(DFS,DD,fp==null ? "  failed on %s" : "  succeeded on %s", string(y));
X  }
X  else
X  { fp = SearchPath(string(fvec[fnum]), file_path[path(fvec[fnum])],
X        check_ld, &full_name, &fpos(fvec[fnum]));
X    if( full_name != nil )  Link(fvec[fnum], full_name);
X  }
X  ifdebug(DPP, D, ProfileOff("OpenFile"));
X  debug1(DFS, D, "OpenFile returning (fp %s null)", fp==null ? "==" : "!=");
X  return fp;
X} /* end OpenFile */
X
X
X/*****************************************************************************/
X/*                                                                           */
X/*  FILE *OpenIncGraphicFile(str, typ, full_name, xfpos)                     */
X/*                                                                           */
X/*  Open for reading the @IncludeGraphic file str; typ is INCGRAPHIC or      */
X/*  SINCGRAPHIC.  Return the full name in full_name.                         */
X/*                                                                           */
X/*****************************************************************************/
X
XFILE *OpenIncGraphicFile(str, typ, full_name, xfpos)
Xunsigned char *str;  unsigned char typ;  OBJECT *full_name;  FILE_POS *xfpos;
X{ FILE *fp;  int p;
X  debug2(DFS, D, "OpenIncGraphicFile(%s, %s, -)", str, Image(typ));
X  assert( typ == INCGRAPHIC || typ == SINCGRAPHIC, "OpenIncGraphicFile!" );
X  p = (typ == INCGRAPHIC ? INCLUDE_PATH : SYSINCLUDE_PATH);
X  fp = SearchPath(str, file_path[p], FALSE, full_name, xfpos);
X  if( *full_name == nil )  *full_name = MakeWord(str, xfpos);
X  debug2(DFS, D, "OpenIncGraphicFile returning (fp %s null, *full_name = %s)",
X    fp==null ? "==" : "!=", string(*full_name));
X  return fp;
X} /* end OpenIncGraphicFile */
X
X
X/*@@**************************************************************************/
X/*                                                                           */
X/*  OBJECT ReadFromFile(fnum, pos, sym)                                      */
X/*                                                                           */
X/*  Read an object from file fnum starting at position pos.                  */
X/*  The object may include @Env operators defining its environment.          */
X/*  If sym != nil, sym is the symbol which is to be read in.                 */
X/*                                                                           */
X/*****************************************************************************/
X
XOBJECT ReadFromFile(fnum, pos, sym)
XFILE_NUM fnum; long pos;  OBJECT sym;
X{ OBJECT t, res; int ipos;
X  ifdebug(DPP, D, ProfileOn("ReadFromFile"));
X  ifdebug(DFS, D, ipos = (int) pos);
X  debug3(DFS, D, "ReadFromFile(%s, %d, %s)", FileName(fnum), ipos,SymName(sym));
X  LexPush(fnum, (int) pos, DATABASE_FILE);
X  SwitchScope(sym);
X  t = LexGetToken();
X  if( type(t) != LBR )
X  { debug1(DFS, D, "  following because type(t) = %s", Image(type(t)));
X    Error(FATAL, &fpos(t),"syntax error (missing %s) in database file", KW_LBR);
X  }
X  res = Parse(&t, StartSym, FALSE, FALSE);
X  if( t != nil || type(res) != CLOSURE )
X  { debug1(DFS, D, "  following because of %s", t != nil ? "t" : "type(res)");
X    Error(FATAL, &fpos(res), "syntax error in database file");
X  }
X  UnSwitchScope(sym);
X  LexPop();
X  debug1(DFS, D, "ReadFromFile returning %s", EchoObject(null, res));
X  ifdebug(DPP, D, ProfileOff("ReadFromFile"));
X  return res;
X} /* end ReadFromFile */
X
X
Xstatic FILE_NUM    last_write_fnum = NO_FILE;
Xstatic FILE    *last_write_fp  = null;
X
X
X/*****************************************************************************/
X/*                                                                           */
X/*  static WriteClosure(x)                                                   */
X/*                                                                           */
X/*  Write closure x to file last_write_fp, without enclosing braces and      */
X/*  without any environment attached.                                        */
X/*                                                                           */
X/*****************************************************************************/
X
Xstatic BOOLEAN need_lvis(sym)        /* true if @LVis needed before sym */
XOBJECT sym;
X{ return !visible(sym) &&
X     enclosing(sym) != StartSym &&
X     type(enclosing(sym)) == LOCAL;
X} /* end need_lvis */
X
Xstatic WriteClosure(x)
XOBJECT x;
X{ OBJECT y, link, z, sym;
X  BOOLEAN npar_seen, name_printed;
X  static WriteObject();
X
X  sym = actual(x);  npar_seen = FALSE;  name_printed = FALSE;
X  for( link = Down(x);  link != x;  link = NextDown(link) )
X  { Child(y, link);
X    if( type(y) == PAR )  switch( type(actual(y)) )
X    {
X      case LPAR:
X
X    assert( Down(y) != y, "WriteObject/CLOSURE: LPAR!" );
X    Child(z, Down(y));
X    WriteObject(z, (int) precedence(sym));
X    fputs(" ", last_write_fp);
X    break;
X
X
X      case NPAR:
X
X    assert( Down(y) != y, "WriteObject/CLOSURE: NPAR!" );
X    Child(z, Down(y));
X    if( !name_printed )
X    { if( need_lvis(sym) )
X      { fputs(KW_LVIS, last_write_fp);
X        fputs(" ", last_write_fp);
X      }
X      fputs(SymName(sym), last_write_fp);
X      name_printed = TRUE;
X    }
X    fputs("\n   ", last_write_fp);
X    fputs(SymName(actual(y)), last_write_fp);
X    fprintf(last_write_fp, " %s ", KW_LBR);
X    WriteObject(z, NO_PREC);
X    fprintf(last_write_fp, " %s", KW_RBR);
X    npar_seen = TRUE;
X    break;
X
X
X      case RPAR:
X
X    assert( Down(y) != y, "WriteObject/CLOSURE: RPAR!" );
X    Child(z, Down(y));
X    if( !name_printed )
X    { if( need_lvis(sym) )
X      { fputs(KW_LVIS, last_write_fp);
X        fputs(" ", last_write_fp);
X      }
X      fputs(SymName(sym), last_write_fp);
X      name_printed = TRUE;
X    }
X    fputs(npar_seen ? "\n" : " ", last_write_fp);
X    if( has_body(sym) )
X    { fputs(KW_LBR, last_write_fp);
X      fputs(" ", last_write_fp);
X      WriteObject(z, NO_PREC);
X      fputs(" ", last_write_fp);
X      fputs(KW_RBR, last_write_fp);
X    }
X    else WriteObject(z, (int) precedence(sym));
X    break;
X
X
X      default:
X
X    Error(INTERN, &fpos(y), "WriteClosure: %s", Image(type(actual(y))) );
X    break;
X
X    } /* end switch */
X  } /* end for each parameter */
X  if( !name_printed )
X  { if( need_lvis(sym) )
X    { fputs(KW_LVIS, last_write_fp);
X      fputs(" ", last_write_fp);
X    }
X    fputs(SymName(sym), last_write_fp);
X    name_printed = TRUE;
X  }
X} /* end WriteClosure */
X
X/*****************************************************************************/
X/*                                                                           */
X/*  static WriteObject(x, outer_prec)                                        */
X/*                                                                           */
X/*  Write object x to file last_write_fp, assuming it is a subobject of an   */
X/*  object and the precedence of operators enclosing it is outer_prec.       */
X/*                                                                           */
X/*****************************************************************************/
X
Xstatic WriteObject(x, outer_prec)
XOBJECT x;  int outer_prec;
X{ OBJECT link, y, gap_obj, sym, env;  unsigned char *name;
X  int prec, i, last_prec;  BOOLEAN braces_needed;
X  switch( type(x) )
X  {
X
X    case WORD:
X
X      if( strlen(string(x)) == 0 && outer_prec > ACAT_PREC )
X      {    fputs(KW_LBR, last_write_fp);
X    fputs(KW_RBR, last_write_fp);
X      }
X      else fputs(string(x), last_write_fp);
X      break;
X
X
X    case VCAT:  prec = VCAT_PREC;  goto ETC;
X    case HCAT:  prec = HCAT_PREC;  goto ETC;
X    case ACAT:  prec = ACAT_PREC;  goto ETC;
X
X      ETC:
X      if( prec < outer_prec )  fputs(KW_LBR, last_write_fp);
X      last_prec = prec;
X      for( link = Down(x);  link != x;  link = NextDown(link) )
X      {    Child(y, link);
X    if( type(y) == GAP_OBJ )
X    { if( Down(y) == y )
X      { assert( type(x) == ACAT, "WriteObject: Down(y) == y!" );
X        for( i = 1;  i <= vspace(y);  i++ )  fputs("\n", last_write_fp);
X        for( i = 1;  i <= hspace(y);  i++ )  fputs(" ",  last_write_fp);
X        last_prec = (vspace(y) + hspace(y) == 0) ? JUXTA_PREC : ACAT_PREC;
X      }
X      else
X      { Child(gap_obj, Down(y));
X        fprintf(last_write_fp, type(x) == ACAT ? " %s" : "\n%s",
X        EchoCatOp( (unsigned) type(x), mark(gap(y)), join(gap(y))));
X        if( type(gap_obj) != WORD || strlen(string(gap_obj)) != 0 )
X        WriteObject(gap_obj, FORCE_PREC);
X        fputs(" ", last_write_fp);
X        last_prec = prec;
X      }
X    }
X    else
X    { if( type(x) == ACAT )
X      { OBJECT next_gap;  int next_prec;
X        if( NextDown(link) != x )
X        { Child(next_gap, NextDown(link));
X          assert( type(next_gap) == GAP_OBJ, "WriteObject: next_gap!" );
X          next_prec = (vspace(next_gap) + hspace(next_gap) == 0)
X                ? JUXTA_PREC : ACAT_PREC;
X        }
X        else next_prec = prec;
X        WriteObject(y, max(last_prec, next_prec));
X      }
X      else WriteObject(y, prec);
X    }
X      }
X      if( prec < outer_prec )  fputs(KW_RBR, last_write_fp);
X      break;
X
X
X    case ENV:
X
X      if( Down(x) == x )
X      { /* do nothing */
X      }
X      else if( Down(x) == LastDown(x) )
X      {    Child(y, Down(x));
X    assert( type(y) == CLOSURE, "WriteObject: ENV/CLOSURE!" );
X    assert( LastDown(y) != y, "WriteObject: ENV/LastDown(y)!" );
X    Child(env, LastDown(y));
X    assert( type(env) == ENV, "WriteObject: ENV/env!" );
X    WriteObject(env, NO_PREC);
X    fputs(KW_LBR, last_write_fp);
X    WriteClosure(y);
X    fputs(KW_RBR, last_write_fp);
X    fputs("\n",   last_write_fp);
X      }
X      else
X      {    Child(env, LastDown(x));
X    assert( type(env) == ENV, "WriteObject: ENV/ENV!" );
X    WriteObject(env, NO_PREC);
X    Child(y, Down(x));
X    assert( type(y) == CLOSURE, "WriteObject: ENV/ENV+CLOSURE!" );
X    WriteObject(y, NO_PREC);
X      }
X      break;
X
X
X    case CLOSURE:
X
X      sym = actual(x);  env = nil;
X      if( LastDown(x) != x )
X      {    Child(y, LastDown(x));
X    if( type(y) == ENV )  env = y;
X      }
X
X      braces_needed = env != nil ||
X    (precedence(sym) <= outer_prec && (has_lpar(sym) || has_rpar(sym)));
X
X      /* print environment */
X      if( env != nil )
X      {    fputs(KW_ENV, last_write_fp);
X          fputs("\n", last_write_fp);
X    WriteObject(env, NO_PREC);
X      }
X
X      /* print left brace if needed */
X      if( braces_needed )  fputs(KW_LBR, last_write_fp);
X
X      /* print the closure proper */
X      WriteClosure(x);
X
X      /* print closing brace if needed */
X      if( braces_needed )  fputs(KW_RBR, last_write_fp);
X
X      /* print closing environment if needed */
X      if( env != nil )
X      { fputs("\n", last_write_fp);
X    fputs(KW_CLOS, last_write_fp);
X          fputs("\n", last_write_fp);
X      }
X      break;
X
X
X    case CROSS:
X
X      Child(y, Down(x));
X      assert( type(y) == CLOSURE, "WriteObject/CROSS: type(y) != CLOSURE!" );
X      fputs(SymName(actual(y)), last_write_fp);
X      fputs(KW_CROSS, last_write_fp);
X      Child(y, LastDown(x));
X      WriteObject(y, FORCE_PREC);
X      break;
X
X
X    case NULL_CLOS:    name = (unsigned char *) KW_NULL;    goto SETC;
X    case ONE_COL:    name = (unsigned char *) KW_ONE_COL;    goto SETC;
X    case ONE_ROW:    name = (unsigned char *) KW_ONE_ROW;    goto SETC;
X    case WIDE:        name = (unsigned char *) KW_WIDE;    goto SETC;
X    case HIGH:        name = (unsigned char *) KW_HIGH;    goto SETC;
X    case HSCALE:    name = (unsigned char *) KW_HSCALE;    goto SETC;
X    case VSCALE:    name = (unsigned char *) KW_VSCALE;    goto SETC;
X    case SCALE:        name = (unsigned char *) KW_SCALE;    goto SETC;
X    case HCONTRACT:    name = (unsigned char *) KW_HCONTRACT;    goto SETC;
X    case VCONTRACT:    name = (unsigned char *) KW_VCONTRACT;    goto SETC;
X    case HEXPAND:    name = (unsigned char *) KW_HEXPAND;    goto SETC;
X    case VEXPAND:    name = (unsigned char *) KW_VEXPAND;    goto SETC;
X    case PADJUST:    name = (unsigned char *) KW_PADJUST;    goto SETC;
X    case HADJUST:    name = (unsigned char *) KW_HADJUST;    goto SETC;
X    case VADJUST:    name = (unsigned char *) KW_VADJUST;    goto SETC;
X    case ROTATE:    name = (unsigned char *) KW_ROTATE;    goto SETC;
X    case CASE:        name = (unsigned char *) KW_CASE;    goto SETC;
X    case YIELD:        name = (unsigned char *) KW_YIELD;    goto SETC;
X    case FONT:        name = (unsigned char *) KW_FONT;    goto SETC;
X    case SPACE:        name = (unsigned char *) KW_SPACE;    goto SETC;
X    case BREAK:        name = (unsigned char *) KW_BREAK;    goto SETC;
X    case NEXT:        name = (unsigned char *) KW_NEXT;    goto SETC;
X    case OPEN:        name = (unsigned char *) KW_OPEN;    goto SETC;
X    case TAGGED:    name = (unsigned char *) KW_TAGGED;    goto SETC;
X    case INCGRAPHIC:    name = (unsigned char *) KW_INCGRAPHIC;    goto SETC;
X    case SINCGRAPHIC:    name = (unsigned char *) KW_SINCGRAPHIC;goto SETC;
X    case GRAPHIC:    name = (unsigned char *) KW_GRAPHIC;    goto SETC;
X
X      /* print left parameter, if present */
X      SETC:
X      if( DEFAULT_PREC <= outer_prec )  fputs(KW_LBR, last_write_fp);
X      if( Down(x) != LastDown(x) )
X      {    Child(y, Down(x));
X    WriteObject(y, DEFAULT_PREC);
X    fputs(" ", last_write_fp);
X      }
X
X      /* print the symbol's name */
X      fputs(name, last_write_fp);
X
X      /* print right parameter, if present */
X      if( LastDown(x) != x )
X      {    Child(y, LastDown(x));
X    fputs(" ", last_write_fp);
X    if( type(x) == OPEN )
X    { fputs(KW_LBR, last_write_fp);
X      WriteObject(y, NO_PREC);
X      fputs(KW_RBR, last_write_fp);
X    }
X    else WriteObject(y, DEFAULT_PREC);
X      }
X      if( DEFAULT_PREC <= outer_prec )  fputs(KW_RBR, last_write_fp);
X      break;
X
X
X    default:
X
X      Error(INTERN, &fpos(x), "WriteObject: type(x) = %s", Image(type(x)));
X      break;
X
X  } /* end switch */
X} /* end WriteObject */
X
X
X/*****************************************************************************/
X/*                                                                           */
X/*  AppendToFile(x, fnum, pos)                                               */
X/*                                                                           */
X/*  Append object x to file fnum, returning its fseek position in *pos.      */
X/*  Record the fact that this file has been updated.                         */
X/*                                                                           */
X/*****************************************************************************/
X
XAppendToFile(x, fnum, pos)
XOBJECT x;  FILE_NUM fnum;  int *pos;
X{ unsigned char buff[MAX_LINE], *str;
X  ifdebug(DPP, D, ProfileOn("AppendToFile"));
X  debug2(DFS, D, "AppendToFile( %s, %s )", EchoObject(null, x), FileName(fnum));
X
X  /* open file fnum for writing */
X  if( last_write_fnum != fnum )
X  { if( last_write_fnum != NO_FILE )  fclose(last_write_fp);
X    str = FileName(fnum);
X    if( strlen(str) + strlen(NEW_DATA_SUFFIX) >= MAX_LINE )
X      Error(FATAL, PosOfFile(fnum), "file name %s%s is too long",
X    str, NEW_DATA_SUFFIX);
X    sprintf(buff, "%s%s", str, NEW_DATA_SUFFIX);
X    last_write_fp = fopen(buff, "a");
X    if( last_write_fp == null )  Error(FATAL, &fpos(fvec[fnum]),
X        "cannot append to database file %s", buff);
X    last_write_fnum = fnum;
X  }
X
X  /* write x out */
X  *pos = (int) ftell(last_write_fp);
X  fputs(KW_LBR, last_write_fp);
X  WriteObject(x, NO_PREC);
X  fprintf(last_write_fp, "%s\n\n", KW_RBR);
X
X  /* record the fact that fnum has changed */
X  updated(fvec[fnum]) = TRUE;
X  ifdebug(DPP, D, ProfileOff("AppendToFile"));
X  debug0(DFS, D, "AppendToFile returning.");
X} /* end AppendToFile */
X
X
X/*@@**************************************************************************/
X/*                                                                           */
X/*  CloseFiles()                                                             */
X/*                                                                           */
X/*  Close all files and move new versions to the names of old versions.      */
X/*                                                                           */
X/*****************************************************************************/
X
XCloseFiles()
X{ FILE_NUM fnum;
X  unsigned char buff[MAX_LINE];
X  ifdebug(DPP, D, ProfileOn("CloseFiles"));
X  debug0(DFS, D, "CloseFiles()");
X
X  /* close off last file opened by AppendToFile above */
X  if( last_write_fnum != NO_FILE )  fclose(last_write_fp);
X
X  /* get rid of old database files */
X  for( fnum = FirstFile(SOURCE_FILE);  fnum != NO_FILE;  fnum = NextFile(fnum) )
X  { sprintf(buff, "%s%s", FileName(fnum), DATA_SUFFIX);
X    unlink(buff);
X  }
X
X  /* move any new database files to the old names, if updated */
X  for( fnum = FirstFile(DATABASE_FILE); fnum != NO_FILE; fnum = NextFile(fnum) )
X  { if( updated(fvec[fnum]) )
X    { sprintf(buff, "%s%s", string(fvec[fnum]), NEW_DATA_SUFFIX);
X      debug1(DFS, D, "unlink(%s)", string(fvec[fnum]));
X      unlink(string(fvec[fnum])); /* may fail if old version does not exist */
X      debug2(DFS, D, "link(%s, %s)", buff, string(fvec[fnum]));
X      if( link(buff, string(fvec[fnum])) != 0 )
X        Error(INTERN, no_fpos, "link(%s, %s) failed", buff, string(fvec[fnum]));
X      debug1(DFS, D, "unlink(%s)", buff);
X      if( unlink(buff) != 0 )
X           Error(INTERN, no_fpos, "unlink(%s) failed", buff);
X    }
X  }
X  debug0(DFS, D, "CloseFiles returning.");
X  ifdebug(DPP, D, ProfileOff("CloseFiles"));
X} /* end CloseFiles */
END_OF_FILE
  if test 35079 -ne `wc -c <'lout/z03.c'`; then
    echo shar: \"'lout/z03.c'\" unpacked with wrong size!
  fi
  # end of 'lout/z03.c'
fi
if test -f 'lout/z08.c' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'lout/z08.c'\"
else
  echo shar: Extracting \"'lout/z08.c'\" \(36495 characters\)
  sed "s/^X//" >'lout/z08.c' <<'END_OF_FILE'
X/*@z08.c:Object Manifest:Manifest()@******************************************/
X/*                                                                           */
X/*  LOUT: A HIGH-LEVEL LANGUAGE FOR DOCUMENT FORMATTING (VERSION 2.03)       */
X/*  COPYRIGHT (C) 1993 Jeffrey H. Kingston                                   */
X/*                                                                           */
X/*  Jeffrey H. Kingston ([e-mail])                                   */
X/*  Basser Department of Computer Science                                    */
X/*  The University of Sydney 2006                                            */
X/*  AUSTRALIA                                                                */
X/*                                                                           */
X/*  This program is free software; you can redistribute it and/or modify     */
X/*  it under the terms of the GNU General Public License as published by     */
X/*  the Free Software Foundation; either version 1, or (at your option)      */
X/*  any later version.                                                       */
X/*                                                                           */
X/*  This program is distributed in the hope that it will be useful,          */
X/*  but WITHOUT ANY WARRANTY; without even the implied warranty of           */
X/*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the            */
X/*  GNU General Public License for more details.                             */
X/*                                                                           */
X/*  You should have received a copy of the GNU General Public License        */
X/*  along with this program; if not, write to the Free Software              */
X/*  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.                */
X/*                                                                           */
X/*  FILE:         z08.c                                                      */
X/*  MODULE:       Object Manifest                                            */
X/*  EXTERNS:      Manifest()                                                 */
X/*                                                                           */
X/*****************************************************************************/
X#include "externs"
X
X#define errorcase()                            \
X                                    \
X    y = MakeWord("", &fpos(x));                        \
X    ReplaceNode(y, x);                            \
X    DisposeObject(x);                            \
X    x = Manifest(y, env, style, bthr, fthr, target, crs, ok, FALSE);    \
X    break;
X
X
X/*****************************************************************************/
X/*                                                                           */
X/*  static ReplaceWithSplit(x, bthr, fthr)                                   */
X/*                                                                           */
X/*  Replace object x with a SPLIT object, if threads for this object are     */
X/*  requested by bthr and/or fthr.                                           */
X/*                                                                           */
X/*****************************************************************************/
X
X#define ReplaceWithSplit(x, bthr, fthr)                    \
X   if( bthr[ROW] || bthr[COL] || fthr[ROW] || fthr[COL] )        \
X    x = insert_split(x, bthr, fthr)
X
Xstatic OBJECT insert_split(x, bthr, fthr)
XOBJECT x;  OBJECT bthr[2], fthr[2];
X{ OBJECT res, new_op;  int dim;
X  debug1(DOM, DD, "ReplaceWithSplit(%s, -)", EchoObject(null, x));
X  assert( type(x) != SPLIT, "ReplaceWithSplit: type(x) already SPLIT!" );
X  res = New(SPLIT);
X  FposCopy(fpos(res), fpos(x));
X  ReplaceNode(res, x);
X  for( dim = COL;  dim <= ROW;  dim++ )
X  { if( bthr[dim] || fthr[dim] )
X    { new_op = New(dim == COL ? COL_THR : ROW_THR);
X      thr_state(new_op) = NOTSIZED;
X      fwd(new_op, 1-dim) = 0;    /* will hold max frame_size */
X      back(new_op, 1-dim) = 0;    /* will hold max frame_origin */
X      FposCopy(fpos(new_op), fpos(x));
X      Link(res, new_op);
X      Link(new_op, x);
X      if( bthr[dim] )  Link(bthr[dim], new_op);
X      if( fthr[dim] )  Link(fthr[dim], new_op);
X    }
X    else Link(res, x);
X  }
X
X  debug1(DOM, DD, "ReplaceWithSplit returning %s", EchoObject(null, res));
X  return res;
X} /* end insert_split */
X
X
X/*@@**************************************************************************/
X/*                                                                           */
X/*  OBJECT ReplaceWithTidy(x)                                                */
X/*                                                                           */
X/*  Replace object x with a tidier version in which juxtapositions are       */
X/*  folded, etc.  If this is not possible, return the original object.       */
X/*                                                                           */
X/*****************************************************************************/
X
XOBJECT ReplaceWithTidy(x)
XOBJECT x;
X{
X  static unsigned char buff[MAX_LINE];
X  static int buff_len;
X  static FILE_POS buff_pos;
X
X  OBJECT link, y, tmp, res;
X  debug1(DOM, DD, "ReplaceWithTidy( %s )", EchoObject(null, x));
X  switch( type(x) )
X  {
X    case ACAT:
X
X      /* flatten any sub-acats, recursively */
X      for( link = Down(x);  link != x;  link = NextDown(link) )
X      {    Child(y, link);
X    if( type(y) == ACAT )
X    { tmp = Down(y);
X      TransferLinks(tmp, y, link);
X      DisposeChild(link);
X      link = PrevDown(tmp);
X    }
X      }
X
X      /* now scan along and do the tidying */
X      res = nil;
X      buff_len = 0;
X      FposCopy(buff_pos, fpos(x));
X      for( link = Down(x); link != x; link = NextDown(link) )
X      {    Child(y, link);
X    if( type(y) == WORD )
X    { if( buff_len + strlen(string(y)) >= MAX_LINE )
X        Error(WARN, &fpos(y),"word is too long");
X      else
X      { if( buff_len == 0 )  FposCopy(buff_pos, fpos(y));
X        strcpy(&buff[buff_len], string(y));
X        buff_len += strlen(string(y));
X      }
X    }
X    else if( type(y) == GAP_OBJ )
X    { if( Down(y) != y || hspace(y) + vspace(y) > 0 )
X      { FontStripQuotes(buff, &buff_pos);
X        if( strlen(buff) > 0 )
X        { tmp = MakeWord(buff, &buff_pos);
X          buff_len = 0;
X          if( res == nil )
X          {    res = New(ACAT);
X        FposCopy(fpos(res), fpos(x));
X          }
X          Link(res, tmp);
X          Link(res, y);
X        }
X      }
X    }
X    else /* error */
X    { if( res != nil )  DisposeObject(res);
X      debug1(DOM, DD, "ReplaceWithTidy returning %s (unchanged)",
X            EchoObject(null, x));
X      return x;
X    }
X      }
X      FontStripQuotes(buff, &buff_pos);
X      tmp = MakeWord(buff, &buff_pos);
X      if( res == nil )  res = tmp;
X      else Link(res, tmp);
X      ReplaceNode(res, x);
X      DisposeObject(x);
X      debug1(DOM, DD, "ReplaceWithTidy returning %s", EchoObject(null, res));
X      return res;
X
X
X    case WORD:
X
X      FontStripQuotes(string(x), &fpos(x));
X      debug1(DOM, DD, "ReplaceWithTidy returning %s", EchoObject(null, x));
X      return x;
X
X
X    default:
X
X      debug1(DOM, DD, "ReplaceWithTidy returning %s (unchanged)",
X        EchoObject(null, x));
X      return x;
X
X  }
X} /* end ReplaceWithTidy */
X
X
X/*@@**************************************************************************/
X/*                                                                           */
X/*  static float GetScaleFactor(x, str)                                      */
X/*                                                                           */
X/*  Find a scale factor in object x and return it as a float, after checks.  */
X/*  Incorporate str in any error messages generated.                         */
X/*                                                                           */
X/*****************************************************************************/
X
Xstatic float GetScaleFactor(x, str)
XOBJECT x;  unsigned char *str;
X{ float scale_factor;
X  if( type(x) != WORD )
X  { Error(WARN, &fpos(x), "replacing invalid %s by 1.0", str);
X    scale_factor = 1.0;
X  }
X  else if( sscanf(string(x), "%f", &scale_factor) != 1 )
X  { Error(WARN, &fpos(x), "replacing invalid %s %s by 1.0", str, string(x));
X    scale_factor = 1.0;
X  }
X  else if( scale_factor < 0.01 )
X  { Error(WARN, &fpos(x), "replacing undersized %s %s by 1.0", str, string(x));
X    scale_factor = 1.0;
X  }
X  else if( scale_factor > 100 )
X  { Error(WARN, &fpos(x), "replacing oversized %s %s by 1.0", str, string(x));
X    scale_factor = 1.0;
X  }
X  return scale_factor;
X} /* GetScaleFactor */
X
X
Xstatic OBJECT nbt[2] = { nil, nil };        /* constant nil threads      */
Xstatic OBJECT nft[2] = { nil, nil };        /* constant nil threads      */
Xstatic OBJECT ntarget = nil;            /* constant nil target       */
X
X/*@@**************************************************************************/
X/*                                                                           */
X/*  OBJECT Manifest(x, env, style, bthr, fthr, target, crs, ok, need_expand) */
X/*                                                                           */
X/*  Manifest object x, interpreted in environment env and style style.       */
X/*  The result replaces x, and is returned also.                             */
X/*  The manifesting operation converts x from a pure parse tree object       */
X/*  containing closures and no threads, to an object ready for sizing,       */
X/*  with fonts propagated to the words, fill styles propagated to the        */
X/*  ACATs, and line spacings propagated to all interested parties.           */
X/*  All non-recursive, non-indefinite closures are expanded.                 */
X/*  Threads joining objects on a mark are constructed, and SPLIT objects     */
X/*  inserted, so that sizing becomes a trivial operation.                    */
X/*                                                                           */
X/*  Manifest will construct threads and pass them up as children of bthr[]   */
X/*  and fthr[] whenever non-nil values of these variables are passed in:     */
X/*                                                                           */
X/*      bthr[COL]            protrudes upwards from x                        */
X/*      fthr[COL]            protrudes downwards from x                      */
X/*      bthr[ROW]            protrudes leftwards from x                      */
X/*      fthr[ROW]            protrudes rightwards from x                     */
X/*                                                                           */
X/*  If *target != nil, Manifest will expand indefinite closures leading to   */
X/*  the first @Galley lying within an object of type *target.                */
X/*                                                                           */
X/*  Some objects x are not "real" in the sense that they do not give rise    */
X/*  to rectangles in the final printed document.  The left parameter of      */
X/*  @Wide and similar operators, and the gap following a concatenation       */
X/*  operator, are examples of such non-real objects.  The ok flag is true    */
X/*  when x is part of a real object.  This is needed because some things,    */
X/*  such as the insinuation of cross references and the breaking of          */
X/*  lines @Break ACAT objects, only apply to real objects.                   */
X/*                                                                           */
X/*  If *crs != nil, it points to a list of indexes to cross-references       */
X/*  which are to be insinuated into the manifested form of x if x is real.   */
X/*                                                                           */
X/*  If need_expand is TRUE it forces closure x to expand.                    */
X/*                                                                           */
X/*****************************************************************************/
X
XOBJECT Manifest(x, env, style, bthr, fthr, target, crs, ok, need_expand)
XOBJECT x, env;  STYLE *style;
XOBJECT bthr[2], fthr[2]; OBJECT *target, *crs;
XBOOLEAN ok, need_expand;
X{ OBJECT bt[2], ft[2], y, link, sym, tag, gaplink, g, ylink, yield, ytag, zlink;
X  OBJECT res, res_env, res_env2, hold_env, hold_env2, first_bt, last_ft, z;
X  OBJECT firsttag, firstres, prev;  float scale_factor;
X  int par, perp;  GAP res_gap;  unsigned res_inc;  STYLE new_style;
X  BOOLEAN still_backing, done, multiline, symbol_free;
X
X  debug2(DOM, D,   "[Manifest(%s %s )", Image(type(x)), EchoObject(null, x));
X  debug1(DOM, DD,  "  environment: %s", EchoObject(null, env));
X  debug6(DOM, DD,  "  style: %s;  target: %s;  threads: %s%s%s%s",
X    EchoStyle(style), SymName(*target),
X    bthr[COL] ? " up"    : "",  fthr[COL] ? " down"  : "",
X    bthr[ROW] ? " left"  : "",  fthr[ROW] ? " right" : "");
X
X  if( type(x) <= ACAT ) switch( type(x) )    /* breaks up oversize switch */
X  {
X
X    case CLOSURE:
X
X      sym = actual(x);
X      StyleCopy(save_style(x), *style);
X      debug1(DOM, DD,  "  closure; sym = %s", SymName(sym));
X
X      /* expand parameters where possible, and find if they are all free */
X      symbol_free = TRUE;
X      for( link = Down(x);  link != x;  link = NextDown(link) )
X      { Child(y, link);
X    assert( type(y) == PAR, "Manifest/CLOSURE: type(y) != PAR!" );
X    Child(z, Down(y));
X    if( type(z) != WORD && !has_par(actual(y)) )
X    { if( is_tag(actual(y)) || is_key(actual(y)) || type(z) == NEXT )
X      { z = Manifest(z, env, style, nbt, nft, &ntarget, crs, FALSE, FALSE);
X        z = ReplaceWithTidy(z);
X      }
X    }
X    if( type(z) != WORD )  symbol_free = FALSE;
X      }
X
X      /* if all parameters are free of symbols, optimize environment */
X      if( symbol_free && imports(sym) == nil && enclosing(sym) != StartSym )
X      {    y = SearchEnv(env, enclosing(sym));
X    if( y != nil && type(y) == CLOSURE )
X    { env = SetEnv(y, nil);
X      hold_env2 = New(ACAT);  Link(hold_env2, env);
X    }
X    else
X    { Error(WARN, &fpos(x), "symbol %s used outside %s",
X        SymName(sym), SymName(enclosing(sym)));
X      hold_env2 = nil;
X    }
X      }
X      else hold_env2 = nil;
X
X      if( has_target(sym) && !need_expand )
X      {
X    /* convert symbols with targets to unsized galleys */
X    OBJECT hd = New(HEAD);
X    FposCopy(fpos(hd), fpos(x));
X    actual(hd) = sym;
X    backward(hd) = TargetSymbol(x, &whereto(hd));
X    ready_galls(hd) = nil;
X    must_expand(hd) = TRUE;
X    sized(hd) = FALSE;
X    ReplaceNode(hd, x);
X    Link(hd, x);
X    AttachEnv(env, x);
X    x = hd;
X          threaded(x) = bthr[COL] != nil || fthr[COL] != nil;
X    ReplaceWithSplit(x, bthr, fthr);
X      }
X      else if(
X        *target == sym                ? (*target = nil, TRUE) :
X        need_expand                ? TRUE  :
X        uses_galley(sym) && !recursive(sym) ? TRUE  :
X        !indefinite(sym) && !recursive(sym) ? TRUE  :
X        indefinite(sym)  && *target != nil  ? SearchUses(sym, *target)
X                            : FALSE
X         )
X      {
X    /* expand the closure and manifest the result */
X    debug1(DOM, DD, "expanding; style: %s", EchoStyle(style));
X    x = ClosureExpand(x, env, style, TRUE, crs, &res_env);
X    hold_env = New(ACAT);  Link(hold_env, res_env);
X    debug1(DOM, DD, "recursive call; style: %s", EchoStyle(style));
X    x = Manifest(x, res_env, style, bthr, fthr, target, crs, ok, FALSE);
X    DisposeObject(hold_env);
X      }
X      else
X      {
X    /* indefinite symbol, leave unexpanded */
X    AttachEnv(env, x);
X    threaded(x) = bthr[COL] != nil || fthr[COL] != nil;
X    debug0(DOM, DD,  "  closure; calling ReplaceWithSplit");
X    ReplaceWithSplit(x, bthr, fthr);
X      }
X      if( hold_env2 != nil )  DisposeObject(hold_env2);
X      break;
X
X
X    case NULL_CLOS:
X
X      StyleCopy(save_style(x), *style);
X      ReplaceWithSplit(x, bthr, fthr);
X      break;
X
X
X    case CROSS:
X
X      assert( Down(x) != x && LastDown(x) != Down(x), "Manifest: CROSS child!");
X      debug0(DCR, DD, "  calling CrossExpand from Manifest/CROSS");
X      x = CrossExpand(x, env, style, TRUE, crs, &res_env);
X      assert( type(x) == CLOSURE, "Manifest/CROSS: type(x)!" );
X      hold_env = New(ACAT);  Link(hold_env, res_env);
X      /* expand here (calling Manifest immediately makes unwanted cr) */
X      x = ClosureExpand(x, res_env, style, FALSE, crs, &res_env2);
X      hold_env2 = New(ACAT);  Link(hold_env2, res_env2);
X      x = Manifest(x, res_env2, style, bthr, fthr, target, crs, ok, TRUE);
X      DisposeObject(hold_env);
X      DisposeObject(hold_env2);
X      break;
X
X
X    case WORD:
X
X      if( !ok || *crs == nil )
X      {    word_font(x) = font(*style);
X    ReplaceWithSplit(x, bthr, fthr);
X    break;
X      }
X      y = New(ACAT);
X      FposCopy(fpos(y), fpos(x));
X      ReplaceNode(y, x);
X      Link(y, x);  x = y;
X      /* NB NO BREAK! */
X
X
X    case ACAT:
X
X      StyleCopy(save_style(x), *style);
X      assert(Down(x) != x, "Manifest: ACAT!" );
X      link = Down(x);  Child(y, link);
X      assert( type(y) != GAP_OBJ, "Manifest ACAT: GAP_OBJ is first!" );
X      multiline = FALSE;
X
X      /* manifest first child and insert any cross references */
X      if( type(y) == WORD )  word_font(y) = font(*style);
X      else y = Manifest(y, env, style, nbt, nft, target, crs, ok, FALSE);
X      if( ok && *crs != nil )
X      {
X    debug1(DCR, D, "  insinuating %s", EchoObject(null, *crs));
X    TransferLinks(Down(*crs), *crs, link);
X    DisposeObject(*crs);
X    *crs = nil;
X      }
X      prev = y;
X
X      for( gaplink = Down(link);  gaplink != x;  gaplink = NextDown(link) )
X      {
X    Child(g, gaplink);
X    assert( type(g) == GAP_OBJ, "Manifest ACAT: no GAP_OBJ!" );
X    link = NextDown(gaplink);
X    assert( link != x, "Manifest ACAT: GAP_OBJ is last!" );
X    Child(y, link);
X    assert( type(y) != GAP_OBJ, "Manifest ACAT: double GAP_OBJ!" );
X
X    /* manifest the next child */
X        debug1(DOM, DD, "  in ACAT (3), style = %s", EchoStyle(style));
X    if( type(y) == WORD ) word_font(y) = font(*style);
X    else y = Manifest(y, env, style, nbt, nft, target, crs, ok, FALSE);
X
X    /* manifest the gap object */
X    if( Down(g) != g )
X    {
X      /* explicit & operator whose value is g's child */
X      Child(z, Down(g));
X      z = Manifest(z, env, style, nbt, nft, &ntarget, crs, FALSE, FALSE);
X      z = ReplaceWithTidy(z);
X      GetGap(z, style, &gap(g), &res_inc);
X      vspace(g) = hspace(g) = 0;
X    }
X    else
X    {
X      /* implicit & operator */
X      GapCopy(gap(g), space_gap(*style));
X      width(gap(g)) = width(gap(g)) * (vspace(g) + hspace(g));
X      if( vspace(g) > 0 && is_definite(type(y)) )  multiline = TRUE;
X    }
X        debug1(DOM, DD, "  in ACAT, gap = %s", EchoLength(width(gap(g))));
X
X    /* compress adjacent juxtaposed words of equal font */
X    if( type(y) == WORD && width(gap(g)) == 0 && vspace(g)+hspace(g) == 0 )
X    { if( units(gap(g)) == FIXED_UNIT && mode(gap(g)) == EDGE_MODE )
X      { if( prev!=nil && type(prev)==WORD && word_font(prev)==word_font(y) )
X        { if( !mark(gap(g)) )
X          {    if( strlen(string(prev)) + strlen(string(y)) >= MAX_LINE )
X          Error(FATAL, &fpos(prev), "word %s%s is too long",
X            string(prev), string(y));
X        z = y;
X        y = MakeWordTwo(string(prev), string(y), &fpos(prev));
X        word_font(y) = word_font(prev);
X        MoveLink(link, y, CHILD);
X        DisposeObject(z);
X        DisposeChild(Up(prev));
X        DisposeChild(gaplink);
X          }
X        }
X      }
X    }
X    prev = y;
X
X    /* insinuate any cross-references */
X    if( ok && *crs != nil )
X    {
X      debug1(DCR, D, "  insinuating %s", EchoObject(null, *crs));
X      TransferLinks(Down(*crs), *crs, link);
X      DisposeObject(*crs);
X      *crs = nil;
X    }
X
X      }
X
X      /* implement FILL_OFF break option if required */
X      if( ok && multiline && fill_style(*style) == FILL_UNDEF )
X    Error(FATAL, &fpos(x), "missing %s operator or option", KW_BREAK);
X      if( ok && multiline && fill_style(*style) == FILL_OFF )
X      {    OBJECT last_acat = x, new_acat;
X    x = New(VCAT);
X    ReplaceNode(x, last_acat);
X    Link(x, last_acat);
X    for( link = Down(last_acat); link != last_acat; link = NextDown(link) )
X    { Child(g, link);
X      if( type(g) == GAP_OBJ && mode(gap(g)) != NO_MODE && vspace(g) > 0 )
X      { link = PrevDown(link);
X        MoveLink(NextDown(link), x, PARENT);
X        GapCopy(gap(g), line_gap(*style));
X        width(gap(g)) *= vspace(g);
X        new_acat = New(ACAT);
X        if( hspace(g) > 0 )
X        { z = MakeWord("", &fpos(g));
X          Link(new_acat, z);
X          z = New(GAP_OBJ);
X          hspace(z) = hspace(g);
X          vspace(z) = 0;
X          GapCopy(gap(z), space_gap(*style));
X          width(gap(z)) *= hspace(z);
X          Link(new_acat, z);
X        }
X        TransferLinks(NextDown(link), last_acat, new_acat);
X        StyleCopy(save_style(new_acat), *style);
X        Link(x, new_acat);
X        last_acat = new_acat;
X        link = last_acat;
X      }
X    }
X      }
X
X      ReplaceWithSplit(x, bthr, fthr);
X      break;
X
X
X    default:
X
X      Error(INTERN, &fpos(x), "Manifest: no case for type %s", Image(type(x)));
X      break;
X
X  } /* end <= ACAT */
X  else if( type(x) <= VCAT )  switch( type(x) )
X  {
X
X    case HCAT:
X    case VCAT:
X
X      par = type(x) == HCAT ? ROW : COL;
X      perp = 1 - par;
X      link = Down(x);
X      gaplink = NextDown(link);
X      assert( link!=x && gaplink!=x, "Manifest/VCAT: less than two children!" );
X      Child(y, link);  Child(g, gaplink);
X
X      /* set bt and ft threads for y */
X      bt[perp] = bthr[perp];
X      ft[perp] = fthr[perp];
X      first_bt = bt[par] = bthr[par] ? New(THREAD) : nil;
X      ft[par] = join(gap(g)) ? New(THREAD) : nil;
X      still_backing = first_bt != nil;
X
X      /* manifest y and insinuate any cross-references */
X      y = Manifest(y, env, style, bt, ft, target, crs, ok, FALSE);
X      if( type(x) == VCAT && ok && *crs != nil )
X      {
X    debug1(DCR, D, "  insinuating %s", EchoObject(null, *crs));
X    TransferLinks(Down(*crs), *crs, link);
X    DisposeObject(*crs);
X    *crs = nil;
X      }
X
X      /* manifest the remaining children */
X      while( g != nil )
X      {
X    /* manifest the gap object, store it in gap(g), add perp threads */
X    assert( type(g) == GAP_OBJ, "Manifest/VCAT: type(g) != GAP_OBJECT!" );
X    assert( Down(g) != g, "Manifest/VCAT: GAP_OBJ has no child!" );
X    Child(z, Down(g));
X    debug1(DOM, DD, "manifesting gap, style = %s", EchoStyle(style));
X    z = Manifest(z, env, style, nbt, nft, &ntarget, crs, FALSE, FALSE);
X    debug1(DOM, DD, "replacing with tidy, style = %s", EchoStyle(style));
X    z = ReplaceWithTidy(z);
X    debug1(DOM, DD, "calling GetGap, style = %s", EchoStyle(style));
X    GetGap(z, style, &gap(g), &res_inc);
X    if( bt[perp] )  Link(bt[perp], g);
X    if( ft[perp] )  Link(ft[perp], g);
X
X    /* find the next child y, and following gap if any */
X    link = NextDown(gaplink);
X    assert( link != x, "Manifest/VCAT: GAP_OBJ is last child!" );
X    Child(y, link);
X    gaplink = NextDown(link);
X    if( gaplink == x )  g = nil;
X    else Child(g, gaplink);
X
X    /* set bt and ft threads for y */
X    last_ft = ft[par];
X    bt[par] = ft[par] ? New(THREAD) : nil;
X    ft[par] = g != nil ? join(gap(g)) ? New(THREAD) : nil
X               : fthr[par]    ? New(THREAD) : nil;
X
X    /* manifest y and insinuate any cross references */
X    y = Manifest(y, env, style, bt, ft, target, crs, ok, FALSE);
X    if( type(x) == VCAT && ok && *crs != nil )
X        {
X      debug1(DCR, D, "  insinuating %s", EchoObject(null, *crs));
X      TransferLinks(Down(*crs), *crs, link);
X      DisposeObject(*crs);
X      *crs = nil;
X        }
X
X    if( bt[par] )    /* then thread lists last_ft and bt[par] must merge */
X    { OBJECT llink, rlink, lthread, rthread;  BOOLEAN goes_through;
X      assert( Down(bt[par]) != bt[par], "Manifest: bt[par] no children!" );
X      assert( last_ft!=nil && Down(last_ft)!=last_ft, "Manifest:last_ft!" );
X
X      /* check whether marks run right through y in par direction */
X      goes_through = FALSE;
X      if( ft[par] )
X      { assert( Down(ft[par]) != ft[par], "Manifest: ft[par] child!" );
X        Child(lthread, LastDown(bt[par]));
X        Child(rthread, LastDown(ft[par]));
X        goes_through = lthread == rthread;
X      }
X
X      /* merge the thread lists */
X      llink = Down(last_ft);  rlink = Down(bt[par]);
X      while( llink != last_ft && rlink != bt[par] )
X      { Child(lthread, llink);
X        Child(rthread, rlink);
X        assert( lthread != rthread, "Manifest: lthread == rthread!" );
X        MergeNode(lthread, rthread);
X        llink = NextDown(llink);
X        rlink = NextDown(rlink);
X      }
X
X      /* attach leftover back threads to first_bt if required */
X      if( rlink != bt[par] )
X      {
X        /* ***
X        Error(WARN, &fpos(y), type(x) == VCAT ?
X          "number of columns above exceeds number here" :
X          "number of rows to left exceeds number here");
X        *** */
X        if( still_backing )  TransferLinks(rlink, bt[par], first_bt);
X      }
X      DisposeObject(bt[par]);
X
X      /* attach leftover forward threads to ft[par] if required */
X      if( llink != last_ft )
X      {
X        /* ***
X        Error(WARN, &fpos(y), type(x) == VCAT ?
X          "number of columns here exceeds number above" :
X          "number of rows here exceeds number to left");
X        *** */
X        if( goes_through )  TransferLinks(llink, last_ft, ft[par]);
X      }
X      DisposeObject(last_ft);
X
X      if( !goes_through )  still_backing = FALSE;
X
X    }
X    else still_backing = FALSE;
X
X      } /* end while */
X
X      /* export par threads */
X      if( fthr[par] )  MergeNode(fthr[par], ft[par]);
X      if( bthr[par] )  MergeNode(bthr[par], first_bt);
X      break;
X
X
X    default:
X
X      Error(INTERN, &fpos(x), "Manifest: no case for type %s", Image(type(x)));
X      break;
X
X  }
X  else switch( type(x) )
X  {
X
X    case WIDE:
X    case HIGH:
X
X      Child(y, Down(x));
X      y = Manifest(y, env, style, nbt, nft, &ntarget, crs, FALSE, FALSE);
X      y = ReplaceWithTidy(y);
X      GetGap(y, style, &res_gap, &res_inc);
X      if( res_inc != ABS || mode(res_gap) != EDGE_MODE ||
X    units(res_gap) != FIXED_UNIT )
X      {    Error(WARN, &fpos(y), "replacing invalid left parameter of %s by 2i",
X            Image(type(x)) );
X    units(res_gap) = FIXED_UNIT;
X    width(res_gap) = 2*IN;
X      }
X      SetConstraint(constraint(x), MAX_LEN, width(res_gap), MAX_LEN);
X      DisposeChild(Down(x));
X      /* NB NO BREAK! */
X
X
X    case HCONTRACT:
X    case VCONTRACT:
X    case HEXPAND:
X    case VEXPAND:
X    case PADJUST:
X    case HADJUST:
X    case VADJUST:
X    case ONE_COL:
X    case ONE_ROW:
X
X      par = (type(x)==ONE_COL || type(x)==HEXPAND || type(x) == HCONTRACT ||
X         type(x)==PADJUST || type(x)==HADJUST || type(x)==WIDE) ? COL : ROW;
X      Child(y, Down(x));
X
X      /* manifest the child, propagating perp threads and suppressing pars */
X      bt[par] = ft[par] = nil;
X      bt[1-par] = bthr[1-par];  ft[1-par] = fthr[1-par];
X      y = Manifest(y, env, style, bt, ft, target, crs, ok, FALSE);
X
X      /* replace with split object if par threads needed */
X      bt[par] = bthr[par];  ft[par] = fthr[par];
X      bt[1-par] = ft[1-par] = nil;
X      ReplaceWithSplit(x, bt, ft);
X      break;
X
X
X    case ROTATE:
X
X      Child(y, Down(x));
X      y = Manifest(y, env, style, nbt, nft, &ntarget, crs, FALSE, FALSE);
X      y = ReplaceWithTidy(y);
X      GetGap(y, style, &res_gap, &res_inc);
X      if( res_inc != ABS || mode(res_gap) != EDGE_MODE ||
X        units(res_gap) != DEG_UNIT )
X      {    Error(WARN, &fpos(y), "replacing invalid left parameter of %s by 0d",
X            Image(type(x)) );
X    units(res_gap) = DEG_UNIT;
X    width(res_gap) = 0;
X      }
X      sparec(constraint(x)) = width(res_gap);
X      DisposeChild(Down(x));
X      Child(y, Down(x));
X      y = Manifest(y, env, style, nbt, nft, target, crs, ok, FALSE);
X      ReplaceWithSplit(x, bthr, fthr);
X      break;
X
X
X    case HSCALE:
X    case VSCALE:
X
X      Child(y, Down(x));
X      y = Manifest(y, env, style, nbt, nft, target, crs, ok, FALSE);
X      ReplaceWithSplit(x, bthr, fthr);
X      break;
X
X
X    case SCALE:
X
X      Child(y, Down(x));
X      y = Manifest(y, env, style, nbt, nft, &ntarget, crs, FALSE, FALSE);
X      y = ReplaceWithTidy(y);
X      if( type(y) != ACAT )
X      { scale_factor = GetScaleFactor(y, "scale factor");
X        bc(constraint(x)) = fc(constraint(x)) = scale_factor * SF;
X      }
X      else
X      {
X    /* get horizontal scale factor */
X    Child(z, Down(y));
X    scale_factor = GetScaleFactor(z, "horizontal scale factor");
X        bc(constraint(x)) = scale_factor * SF;
X
X    /* get vertical scale factor */
X    Child(z, LastDown(y));
X    scale_factor = GetScaleFactor(z, "vertical scale factor");
X        fc(constraint(x)) = scale_factor * SF;
X      }
X      DisposeChild(Down(x));
X      Child(y, LastDown(x));
X      y = Manifest(y, env, style, nbt, nft, target, crs, ok, FALSE);
X      ReplaceWithSplit(x, bthr, fthr);
X      break;
X
X
X    case YIELD:
X
X      Error(FATAL, &fpos(x), "%s outside of %s", KW_YIELD, KW_CASE);
X      break;
X
X
X    case CASE:
X
X      /* make sure left parameter (the tag) is in order */
X      debug0(DOM, DD, "  manifesting CASE now");
X      Child(tag, Down(x));
X      debug1(DOM, DD, "  manifesting CASE tag %s now", EchoObject(null, tag));
X      tag = Manifest(tag, env, style, nbt, nft, &ntarget, crs, FALSE, FALSE);
X      tag = ReplaceWithTidy(tag);
X      /* *** allowing this now; non-word matches "else" only ***
X      if( type(tag) != WORD )
X      {    Error(WARN, &fpos(tag), "%s deleted: left parameter is not a word",
X      KW_CASE);
X    errorcase();
X      }
X      *** */
X
X      /* make sure the right parameter is an ACAT */
X      Child(y, LastDown(x));
X      if( type(y) == YIELD )
X      {    z = New(ACAT);
X    MoveLink(Up(y), z, PARENT);
X    Link(x, z);
X    y = z;
X      }
X      if( type(y) != ACAT )
X      {    Error(WARN, &fpos(y), "%s deleted: right parameter is malformed",
X      KW_CASE);
X    errorcase();
X      }
X
X      /* hunt through right parameter for res, the selected case */
X      res = nil;  firsttag = nil;
X      for( ylink = Down(y); ylink != y && res == nil; ylink = NextDown(ylink) )
X      {    Child(yield, ylink);
X    if( type(yield) == GAP_OBJ )  continue;
X    if( type(yield) != YIELD )
X    { Error(WARN, &fpos(yield), "%s contains non-%s", KW_CASE, KW_YIELD);
X      break;
X    }
X    Child(ytag, Down(yield));
X    ytag = Manifest(ytag, env, style, nbt, nft, &ntarget, crs, FALSE,FALSE);
X    ytag = ReplaceWithTidy(ytag);
X    if( type(ytag) == WORD )
X    { if( firsttag == nil )
X      { firsttag = ytag;
X        Child(firstres, LastDown(yield));
X      }
X      if( (type(tag) == WORD && strcmp(string(ytag), string(tag)) == 0) ||
X          strcmp(string(ytag), "else"     ) == 0 )
X      { Child(res, LastDown(yield));
X        break;
X      }
X    }
X    else if( type(ytag) == ACAT )
X    { z = ytag;
X      for( zlink = Down(z);  zlink != z;  zlink = NextDown(zlink) )
X      { Child(ytag, zlink);
X        if( type(ytag) == GAP_OBJ )  continue;
X        if( type(ytag) != WORD )
X        { Error(WARN,&fpos(ytag),"error in left parameter of %s",KW_YIELD);
X          break;
X        }
X        if( firsttag == nil )
X        { firsttag = ytag;
X          Child(firstres, LastDown(yield));
X        }
X        if( (type(tag) == WORD && strcmp(string(ytag), string(tag)) == 0) ||
X            strcmp(string(ytag), "else"     ) == 0 )
X        { Child(res, LastDown(yield));
X          break;
X        }
X      }
X    }
X    else Error(WARN,&fpos(ytag),"error in left parameter of %s",KW_YIELD);
X      }
X      if( res == nil )
X      { if( firsttag != nil )
X    { Error(WARN, &fpos(tag), "replacing unkown %s option %s by %s",
X        KW_CASE, string(tag), string(firsttag));
X      res = firstres;
X    }
X    else
X    { Error(WARN, &fpos(tag), "%s deleted: selection %s unknown",
X        KW_CASE, string(tag));
X      errorcase();
X    }
X      }
X
X      /* now manifest the result and replace x with it */
X      DeleteLink(Up(res));
X      ReplaceNode(res, x);
X      DisposeObject(x);
X      x = Manifest(res, env, style, bthr, fthr, target, crs, ok, FALSE);
X      break;
X
X
X    case FONT:
X    case SPACE:
X    case BREAK:
X
X      assert( Down(x) != x && NextDown(Down(x)) != x, "Manifest: FONT!" );
X      StyleCopy(new_style, *style);
X      Child(y, Down(x));
X      y = Manifest(y, env, style, nbt, nft, &ntarget, crs, FALSE, FALSE);
X      y = ReplaceWithTidy(y);
X      if( type(x) == FONT )       FontChange(&new_style, y);
X      else if( type(x) == SPACE ) SpaceChange(&new_style, y);
X      else              BreakChange(&new_style, y);
X      DisposeChild(Down(x));
X      Child(y, Down(x));
X      y = Manifest(y, env, &new_style, bthr, fthr, target, crs, ok, FALSE);
X      DeleteLink(Down(x));
X      MergeNode(y, x);  x = y;
X      break;
X
X
X    case NEXT:
X
X      assert( Down(x) != x, "Manifest/NEXT: Down(x) == x!" );
X      Child(y, Down(x));
X      debug1(DCS, D, "  Manifesting Next( %s, 1 )", EchoObject(null, y));
X      y = Manifest(y, env, style, bthr, fthr, target, crs, FALSE, FALSE);
X      debug1(DCS, D, "  calling Next( %s, 1 )", EchoObject(null, y));
X      done = FALSE;
X      y = Next(y, 1, &done);
X      debug2(DCS, D, "  Next(done = %s) returning %s",
X            bool(done), EchoObject(null, y));
X      DeleteLink(Down(x));
X      MergeNode(y, x);  x = y;
X      break;
X
X
X    case OPEN:
X
X      Child(y, Down(x));
X      Child(res, LastDown(x));
X      if( type(y) == CLOSURE )
X      { AttachEnv(env, y);
X    StyleCopy(save_style(y), *style);
X    res_env = SetEnv(y, nil);
X    hold_env = New(ACAT);  Link(hold_env, res_env);
X    res = Manifest(res, res_env, style, bthr, fthr, target, crs, ok, FALSE);
X    DisposeObject(hold_env);
X      }
X      else if( type(y) == CROSS )
X      {    debug0(DCR, DD, "  calling CrossExpand from Manifest/OPEN");
X    y = CrossExpand(y, env, style, TRUE, crs, &res_env);
X    AttachEnv(res_env, y);
X    res_env = SetEnv(y, env);
X    hold_env = New(ACAT);  Link(hold_env, res_env);
X    res = Manifest(res, res_env, style, bthr, fthr, target, crs, ok, FALSE);
X    DisposeObject(hold_env);
X      }
X      else
X      {    Error(WARN, &fpos(y), "invalid left parameter of %s", KW_OPEN);
X    res = Manifest(res, env, style, bthr, fthr, target, crs, ok, FALSE);
X      }
X      ReplaceNode(res, x);
X      DisposeObject(x);
X      x = res;
X      break;
X
X
X    case TAGGED:
X
X      /* make sure first argument is a cross-reference */
X      assert( Down(x) != x && NextDown(Down(x)) != x &&
X    NextDown(NextDown(Down(x))) == x, "Manifest TAGGED: children!" );
X      Child(y, Down(x));
X      if( type(y) != CROSS )
X      {    Error(WARN, &fpos(y), "left parameter of %s is not a cross-reference",
X                    KW_TAGGED);
X    errorcase();
X      }
X
X      /* make sure the arguments of the cross-reference are OK */
X      Child(z, Down(y));
X      if( type(z) != CLOSURE )
X      {    Error(WARN,&fpos(y),"left parameter of %s must be a symbol", KW_TAGGED);
X    errorcase();
X      }
X      if( !has_tag(actual(z)) )
X      {    Error(WARN, &fpos(z), "symbol %s illegal with %s since it has no %s",
X            SymName(actual(z)), KW_TAGGED, KW_TAG);
X    errorcase();
X      }
X      Child(z, NextDown(Down(y)));
X      z = Manifest(z, env, style, nbt, nft, &ntarget, crs, FALSE, FALSE);
X      if( type(z) == WORD && strcmp(string(z), KW_PRECEDING) == 0 )
X    cross_type(y) = CROSS_PREC;
X      else if( type(z) == WORD && strcmp(string(z), KW_FOLLOWING) == 0 )
X    cross_type(y) = CROSS_FOLL;
X      else
X      {    Error(WARN, &fpos(z), "%s of left parameter of %s must be %s or %s",
X        KW_TAG, KW_TAGGED, KW_PRECEDING, KW_FOLLOWING);
X    errorcase();
X      }
X
X      /* make sure second argument (the new key) is ok */
X      Child(tag, LastDown(x));
X      tag = Manifest(tag, env, style, nbt, nft, &ntarget, crs, FALSE, FALSE);
X      tag = ReplaceWithTidy(tag);
X      if( type(tag) != WORD )
X      {    Error(WARN, &fpos(tag), "right parameter of %s must be a simple word",
X                                KW_TAGGED);
X    ifdebug(DOM, D, EchoObject(stderr, tag));
X    errorcase();
X      }
X
X      /* assemble insinuated cross reference which replaces x */
X      ReplaceNode(tag, z);
X      DisposeObject(z);
X      ReplaceNode(y, x);
X      DisposeObject(x);
X      x = y;
X      ReplaceWithSplit(x, bthr, fthr);
X      break;
X
X
X    case GRAPHIC:
X
X      debug1(DRS, DD, "  graphic style in Manifest = %s", EchoStyle(style));
X      Child(y, LastDown(x));
X      y = Manifest(y, env, style, nbt, nft, target, crs, ok, FALSE);
X      StyleCopy(save_style(x), *style);
X      Child(y, Down(x));
X      y = Manifest(y, env, style, nbt, nft, &ntarget, crs, FALSE, FALSE);
X      ReplaceWithSplit(x, bthr, fthr);
X      break;
X
X
X    case INCGRAPHIC:
X    case SINCGRAPHIC:
X
X      Child(y, Down(x));
X      y = Manifest(y, env, style, nbt, nft, &ntarget, crs, FALSE, FALSE);
X      y = ReplaceWithTidy(y);
X      if( type(y) != WORD )
X      { Error(WARN, &fpos(y), "%s deleted: invalid right parameter",
X      type(x) == INCGRAPHIC ? KW_INCGRAPHIC : KW_SINCGRAPHIC);
X    errorcase();
X      }
X      /* *** no longer defining these files (uses too many file numbers) ***
X      sparec(constraint(x)) = DefineFile(MakeWord(string(y), &fpos(y)),
X    INCGRAPHIC_FILE, type(x)==INCGRAPHIC ? INCLUDE_PATH : SYSINCLUDE_PATH);
X      *** */
X      ReplaceWithSplit(x, bthr, fthr);
X      break;
X
X
X    default:
X
X      Error(INTERN, &fpos(x), "Manifest: no case for type %s", Image(type(x)));
X      break;
X
X  } /* end switch */
X
X  debug2(DOM,D,"]Manifest returning %s %s",Image(type(x)),EchoObject(null, x));
X  debug1(DOM, DD, "  at exit, style = %s", EchoStyle(style));
X  debug1(DOM, DDD, "up:    ", EchoObject(null, bthr[COL]) );
X  debug1(DOM, DDD, "down:  ", EchoObject(null, fthr[COL]) );
X  debug1(DOM, DDD, "left:  ", EchoObject(null, bthr[ROW]) );
X  debug1(DOM, DDD, "right: ", EchoObject(null, fthr[ROW]) );
X  return x;
X} /* end Manifest */
END_OF_FILE
  if test 36495 -ne `wc -c <'lout/z08.c'`; then
    echo shar: \"'lout/z08.c'\" unpacked with wrong size!
  fi
  # end of 'lout/z08.c'
fi
echo shar: End of archive 7 \(of 30\).
cp /dev/null ark7isdone
MISSING=""
for I in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 ; do
    if test ! -f ark${I}isdone ; then
    MISSING="${MISSING} ${I}"
    fi
done
if test "${MISSING}" = "" ; then
    echo You have unpacked all 30 archives.
    rm -f ark[1-9]isdone ark[1-9][0-9]isdone
else
    echo You still must unpack the following archives:
    echo "        " ${MISSING}
fi
exit 0
exit 0 # Just in case...