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

Text File | 1993-06-19 | 81.3 KB | 2,168 lines

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

Submitted-by: [e-mail] (Jeff Kingston)
Posting-number: Volume 37, Issue 111
Archive-name: lout/part13
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/z01.c lout/z04.c lout/z05.c lout/z12.c lout/z18.c
# Wrapped by kent@sparky on Sun May 30 19:43:57 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 13 (of 30)."'
if test -f 'lout/z01.c' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'lout/z01.c'\"
else
  echo shar: Extracting \"'lout/z01.c'\" \(16696 characters\)
  sed "s/^X//" >'lout/z01.c' <<'END_OF_FILE'
X/*@z01.c:Supervise:main()@****************************************************/
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:         z01.c                                                      */
X/*  MODULE:       Supervise                                                  */
X/*  EXTERNS:      main()                                                     */
X/*                                                                           */
X/*****************************************************************************/
X#include "externs"
X
X/*****************************************************************************/
X/*                                                                           */
X/*  BOOLEAN StringBeginsWith(str, pattern)                                   */
X/*  BOOLEAN StringContains(str, pattern)                                     */
X/*                                                                           */
X/*  Check whether str begins with (or contains within it) pattern.  This     */
X/*  could be done by the standard function "strstr" except that not all      */
X/*  systems have it and in at least one case the implementation has a bug.   */
X/*                                                                           */
X/*****************************************************************************/
X
XBOOLEAN StringBeginsWith(str, pattern)
Xunsigned char *str, *pattern;
X{ unsigned char *sp, *pp;
X  sp = str;  pp = pattern;
X  while( *sp != '\0' && *pp != '\0' )
X  { if( *sp++ != *pp++ )  return FALSE;
X  }
X  return (*pp == '\0');
X} /* end StringBeginsWith */
X
XBOOLEAN StringContains(str, pattern)
Xunsigned char *str, *pattern;
X{ unsigned char *sp;
X  for( sp = str;  *sp != '\0';  sp++ )
X  { if( StringBeginsWith(sp, pattern) )  return TRUE;
X  }
X  return FALSE;
X} /* end StringContains */
X
X
X/*****************************************************************************/
X/*                                                                           */
X/*  StartSym      the symbol table entry for \Start (overall scope)          */
X/*  GalleySym     the symbol table entry for @Galley                         */
X/*  InputSym      the symbol table entry for @Input@                         */
X/*  PrintSym      the symbol table entry for \Print (root target)            */
X/*                                                                           */
X/*****************************************************************************/
X
XOBJECT StartSym, GalleySym, InputSym, PrintSym;
X
X/*****************************************************************************/
X/*                                                                           */
X/*  AllowCrossDb        Allow references to OldCrossDb and NewCrossDb        */
X/*                                                                           */
X/*****************************************************************************/
X
XBOOLEAN AllowCrossDb;
X
X/*****************************************************************************/
X/*                                                                           */
X/*  Encapsulated        Produce a one-page encapsulated PostScript file      */
X/*                                                                           */
X/*****************************************************************************/
X
XBOOLEAN Encapsulated;
X
X
X/*****************************************************************************/
X/*                                                                           */
X/*  OBJECT load(xstr, xpredefined, xleft, xright, xindef, xprec)             */
X/*                                                                           */
X/*  Load a predefined operator with these attributes into the symbol table.  */
X/*  If the operator has parameters, load symbols for those also.             */
X/*                                                                           */
X/*****************************************************************************/
X
Xstatic OBJECT load(xstr, xpre, xleft, xright, xindef, xprec)
Xunsigned char *xstr;  unsigned  xpre;  BOOLEAN xleft, xright, xindef;
Xunsigned char xprec;
X{ OBJECT s;
X  s = InsertSym(xstr, LOCAL, no_fpos, xprec, xindef, FALSE, xpre, StartSym,nil);
X  if( xleft )
X    InsertSym("pa", LPAR, no_fpos, DEFAULT_PREC, FALSE, FALSE, 0, s, nil);
X  if( xright )
X    InsertSym("pb", RPAR, no_fpos, DEFAULT_PREC, FALSE, FALSE, 0, s, nil);
X  if( xleft && xright )  right_assoc(s) = TRUE;
X  return s;
X} /* end load */
X
X
X/*@@**************************************************************************/
X/*                                                                           */
X/*  main(argc, argv)                                                         */
X/*                                                                           */
X/*  Read command line, initialise everything, read definitions, read         */
X/*  galleys, clean up and exit.                                              */
X/*                                                                           */
X/*****************************************************************************/
X
Xmain(argc, argv)
Xint argc; unsigned char *argv[];
X{ int i;
X  OBJECT t, res, s;                /* current token, parser o/p */
X  BOOLEAN stdin_seen;                /* TRUE when stdin file seen */
X  unsigned char *cross_db;            /* name of cross ref database*/
X  unsigned char *outfile;            /* name of output file       */
X  FILE *out_fp;
X
X  /* initialise various modules, add current directory to search paths */
X  AllowCrossDb = TRUE;
X  Encapsulated = FALSE;
X  InitSym();
X  LexInit();
X  MemInit();
X  InitFiles();
X  AddToPath(FONT_PATH,     "");
X  AddToPath(SOURCE_PATH,   "");
X  AddToPath(DATABASE_PATH, "");
X  AddToPath(INCLUDE_PATH,  "");
X
X  /* read command line */
X  stdin_seen = FALSE;
X  cross_db = (unsigned char *) CROSS_DB;
X  outfile = (unsigned char *) "-";
X  for( i = 1;  i < argc;  i++ )
X  {  if( *argv[i] == '-' ) switch( *(argv[i]+1) )
X     {
X    case 'o':    /* read name of output file */
X            if( *(argv[i]+2) == '\0' )
X                Error(FATAL, no_fpos, "usage: -o<filename>");
X            outfile = argv[i]+2;
X            break;
X
X    case 's':    /* suppress references to OldCrossDb and NewCrossDb */
X            AllowCrossDb = FALSE;
X            break;
X
X    case 'c':    /* read name of cross reference database */
X            cross_db = argv[i]+2;
X            break;
X
X    case 'e':    /* read log file name */
X            if( *(argv[i]+2) == '\0' )
X                Error(FATAL, no_fpos, "usage: -e<filename>");
X            ErrorInit(argv[i]+2);
X            break;
X
X    case 'E':    /* -EPS produces encapsulated PostScript output */
X            if( strcmp(argv[i]+1, "EPS") != 0 )
X              Error(FATAL, no_fpos, "usage: -EPS");
X            Encapsulated = TRUE;
X            break;
X
X    case 'D':    /* add directory to database and sysdatabase paths */
X            if( *(argv[i]+2) == '\0' )
X                Error(FATAL, no_fpos, "usage: -D<dirname>");
X            AddToPath(DATABASE_PATH, argv[i]+2);
X            AddToPath(SYSDATABASE_PATH, argv[i]+2);
X            break;
X
X    case 'F':    /* add directory to font path */
X            if( *(argv[i]+2) == '\0' )
X                Error(FATAL, no_fpos, "usage: -F<dirname>");
X            AddToPath(FONT_PATH, argv[i]+2);
X            break;
X
X    case 'I':    /* add directory to include and sysinclude paths */
X            if( *(argv[i]+2) == '\0' )
X                Error(FATAL, no_fpos, "usage: -I<dirname>");
X            AddToPath(INCLUDE_PATH, argv[i]+2);
X            AddToPath(SYSINCLUDE_PATH, argv[i]+2);
X            break;
X
X    case 'i':    /* read sysinclude file */
X            if( *(argv[i]+2) == '\0' )
X                Error(FATAL, no_fpos, "usage: -i<filename>");
X            t = MakeWord(argv[i]+2, no_fpos);
X            DefineFile(t, SOURCE_FILE, SYSINCLUDE_PATH);
X            break;
X
X    case 'h':    /* declare hyphenation file */
X            if( FirstFile(HYPH_FILE) != NO_FILE )
X              Error(FATAL, no_fpos, "two -h options illegal");
X            if( *(argv[i]+2) == '\0' )
X              Error(FATAL, no_fpos, "usage: -h<filename>");
X            if( strlen(argv[i]+2) + strlen(HYPH_SUFFIX) >= MAX_LINE)              Error(FATAL, no_fpos, "-h option too long");
X            t = MakeWord(argv[i] + 2, no_fpos);
X            DefineFile(t, HYPH_FILE, INCLUDE_PATH);
X            t = MakeWordTwo(string(t), HYPH_SUFFIX, no_fpos);
X            DefineFile(t, HYPH_PACKED_FILE, INCLUDE_PATH);
X            break;
X
X    case 'V':    fprintf(stderr, "%s\n", LOUT_VERSION);
X            break;
X
X    case 'd':    debug_init(argv[i]);
X            break;
X
X    case '\0':    /* read stdin as file name */
X            if( stdin_seen )
X                Error(FATAL, no_fpos, "stdin read twice!");
X            stdin_seen = TRUE;
X            t = MakeWord("-", no_fpos);
X            DefineFile(t, SOURCE_FILE, SOURCE_PATH);
X            break;
X
X    default:    Error(FATAL, no_fpos,
X                "unknown command line flag %s", argv[i]);
X            break;
X     }
X     else DefineFile(MakeWord(argv[i], no_fpos), SOURCE_FILE, SOURCE_PATH);
X  } /* for */
X
X  /* define hyphenation file if not done already by -h flag */
X  if( FirstFile(HYPH_FILE) == NO_FILE )
X  { t = MakeWord(HYPH_FILENAME, no_fpos);
X    DefineFile(t, HYPH_FILE, SYSINCLUDE_PATH);
X    t = MakeWordTwo(HYPH_FILENAME, HYPH_SUFFIX, no_fpos);
X    DefineFile(t, HYPH_PACKED_FILE, SYSINCLUDE_PATH);
X  }
X
X  /* start timing if required */
X  ifdebug(DPP, D, ProfileOn("main"));
X
X  /* open output file, or stdout if none specified, and initialize printer */
X  if( strcmp(outfile, "-") == 0 )  out_fp = stdout;
X  else if( (out_fp = fopen(outfile, "w")) == null )
X    Error(FATAL, no_fpos, "cannot open output file %s", outfile);
X  PrintInit(out_fp);
X
X  /* append default directories to file search paths */
X  AddToPath(FONT_PATH,         FONT_DIR);
X  AddToPath(SYSDATABASE_PATH,  DATA_DIR);
X  AddToPath(DATABASE_PATH,     DATA_DIR);
X  AddToPath(SYSINCLUDE_PATH,   INCL_DIR);
X  AddToPath(INCLUDE_PATH,      INCL_DIR);
X
X  /* use stdin if no source files were mentioned */
X  if( FirstFile(SOURCE_FILE) == NO_FILE )
X    DefineFile(MakeWord("-", no_fpos), SOURCE_FILE, SOURCE_PATH);
X
X  /* load predefined symbols into symbol table */
X  StartSym = nil;
X  StartSym  = load("\\Start",   0,     FALSE,  FALSE,  TRUE,  NO_PREC     );
X  GalleySym = load(KW_GALLEY,   0,     FALSE,  FALSE,  TRUE,  NO_PREC     );
X  InputSym  = load(KW_INPUT,    0,     FALSE,  FALSE,  TRUE,  NO_PREC     );
X  PrintSym  = load("\\Print",   0,     FALSE,  FALSE,  TRUE,  NO_PREC     );
X
X  load(KW_BEGIN,       BEGIN,          FALSE,  FALSE,  FALSE, BEGIN_PREC  );
X  load(KW_END,         END,            FALSE,  FALSE,  FALSE, END_PREC    );
X  load(KW_ENV,         ENV,            FALSE,  FALSE,  FALSE, NO_PREC     );
X  load(KW_CLOS,        CLOS,           FALSE,  FALSE,  FALSE, NO_PREC     );
X  load(KW_LVIS,        LVIS,           FALSE,  FALSE,  FALSE, NO_PREC     );
X  load(KW_LBR,         LBR,            FALSE,  FALSE,  FALSE, LBR_PREC    );
X  load(KW_RBR,         RBR,            FALSE,  FALSE,  FALSE, RBR_PREC    );
X  load(KW_INCLUDE,     INCLUDE,        FALSE,  FALSE,  FALSE, NO_PREC     );
X  load(KW_SYSINCLUDE,  SYS_INCLUDE,    FALSE,  FALSE,  FALSE, NO_PREC     );
X  load(KW_PREPEND,     PREPEND,        FALSE,  FALSE,  FALSE, NO_PREC     );
X  load(KW_SYSPREPEND,  SYS_PREPEND,    FALSE,  FALSE,  FALSE, NO_PREC     );
X  load(KW_DATABASE,    DATABASE,       FALSE,  FALSE,  FALSE, NO_PREC     );
X  load(KW_SYSDATABASE, SYS_DATABASE,   FALSE,  FALSE,  FALSE, NO_PREC     );
X  load(KW_USE,         USE,            FALSE,  FALSE,  FALSE, NO_PREC     );
X  load(KW_CASE,        CASE,           TRUE,   TRUE,   FALSE, DEFAULT_PREC);
X  load(KW_YIELD,       YIELD,          TRUE,   TRUE,   FALSE, DEFAULT_PREC);
X  load(KW_FONT,        FONT,           TRUE,   TRUE,   FALSE, DEFAULT_PREC);
X  load(KW_SPACE,       SPACE,          TRUE,   TRUE,   FALSE, DEFAULT_PREC);
X  load(KW_BREAK,       BREAK,          TRUE,   TRUE,   FALSE, DEFAULT_PREC);
X  load(KW_NEXT,        NEXT,           FALSE,  TRUE,   FALSE, DEFAULT_PREC);
X  load(KW_OPEN,        OPEN,           TRUE,   TRUE,   FALSE, DEFAULT_PREC);
X  load(KW_TAGGED,      TAGGED,         TRUE,   TRUE,   FALSE, DEFAULT_PREC);
X  load(KW_HIGH,        HIGH,           TRUE,   TRUE,   FALSE, DEFAULT_PREC);
X  load(KW_WIDE,        WIDE,           TRUE,   TRUE,   FALSE, DEFAULT_PREC);
X  load(KW_ONE_COL,     ONE_COL,        FALSE,  TRUE,   FALSE, DEFAULT_PREC);
X  load(KW_ONE_ROW,     ONE_ROW,        FALSE,  TRUE,   FALSE, DEFAULT_PREC);
X  load(KW_HSCALE,      HSCALE,         FALSE,  TRUE,   FALSE, DEFAULT_PREC);
X  load(KW_VSCALE,      VSCALE,         FALSE,  TRUE,   FALSE, DEFAULT_PREC);
X  load(KW_SCALE,       SCALE,          TRUE,   TRUE,   FALSE, DEFAULT_PREC);
X  load(KW_HCONTRACT,   HCONTRACT,      FALSE,  TRUE,   FALSE, DEFAULT_PREC);
X  load(KW_VCONTRACT,   VCONTRACT,      FALSE,  TRUE,   FALSE, DEFAULT_PREC);
X  load(KW_HEXPAND,     HEXPAND,        FALSE,  TRUE,   FALSE, DEFAULT_PREC);
X  load(KW_VEXPAND,     VEXPAND,        FALSE,  TRUE,   FALSE, DEFAULT_PREC);
X  load(KW_PADJUST,     PADJUST,        FALSE,  TRUE,   FALSE, DEFAULT_PREC);
X  load(KW_HADJUST,     HADJUST,        FALSE,  TRUE,   FALSE, DEFAULT_PREC);
X  load(KW_VADJUST,     VADJUST,        FALSE,  TRUE,   FALSE, DEFAULT_PREC);
X  load(KW_ROTATE,      ROTATE,         TRUE,   TRUE,   FALSE, DEFAULT_PREC);
X  load(KW_INCGRAPHIC,  INCGRAPHIC,     FALSE,  TRUE,   FALSE, DEFAULT_PREC);
X  load(KW_SINCGRAPHIC, SINCGRAPHIC,    FALSE,  TRUE,   FALSE, DEFAULT_PREC);
X  load(KW_GRAPHIC,     GRAPHIC,        TRUE,   TRUE,   FALSE, DEFAULT_PREC);
X  load(KW_CROSS,       CROSS,          TRUE,   TRUE,   FALSE, CROSSOP_PREC);
X  load(KW_NULL,        NULL_CLOS,      FALSE,  FALSE,  TRUE,  NO_PREC     );
X
X#define setcat(s, mk, jn)  has_mark(s)=mk, has_join(s)=jn
X
X  s=load(KW_VCAT_NN, VCAT, TRUE, TRUE, FALSE, VCAT_PREC); setcat(s,FALSE,FALSE);
X  s=load(KW_VCAT_MN, VCAT, TRUE, TRUE, FALSE, VCAT_PREC); setcat(s,TRUE, FALSE);
X  s=load(KW_VCAT_NJ, VCAT, TRUE, TRUE, FALSE, VCAT_PREC); setcat(s,FALSE,TRUE);
X  s=load(KW_VCAT_MJ, VCAT, TRUE, TRUE, FALSE, VCAT_PREC); setcat(s,TRUE, TRUE);
X  s=load(KW_HCAT_NN, HCAT, TRUE, TRUE, FALSE, HCAT_PREC); setcat(s,FALSE,FALSE);
X  s=load(KW_HCAT_MN, HCAT, TRUE, TRUE, FALSE, HCAT_PREC); setcat(s,TRUE, FALSE);
X  s=load(KW_HCAT_NJ, HCAT, TRUE, TRUE, FALSE, HCAT_PREC); setcat(s,FALSE,TRUE);
X  s=load(KW_HCAT_MJ, HCAT, TRUE, TRUE, FALSE, HCAT_PREC); setcat(s,TRUE, TRUE);
X  s=load(KW_ACAT_NJ, ACAT, TRUE, TRUE, FALSE, ACAT_PREC); setcat(s,FALSE,TRUE);
X  s=load(KW_ACAT_MJ, ACAT, TRUE, TRUE, FALSE, ACAT_PREC); setcat(s,TRUE, TRUE);
X
X  /* intialize current time and load @Moment symbol */
X  InitTime();
X
X  /* initialise scope chain to <StartSym> */
X  PushScope(StartSym, FALSE, FALSE);
X
X  /* initialise lexical analyser */
X  LexPush(FirstFile(SOURCE_FILE), 0, SOURCE_FILE);
X
X  /* process input files */
X  InitParser(cross_db);
X  t = NewToken(BEGIN, no_fpos, 0, 0, BEGIN_PREC, StartSym);
X  res = Parse(&t, StartSym, TRUE, TRUE);
X  TransferEnd(res);
X  TransferClose();
X
X  /* close various  modules */
X  PrintClose();
X  CrossClose();
X  CloseFiles();
X
X  /* wrapup */
X  ifdebug(DST, D, CheckSymSpread() );
X  debug0(ANY, D, "commencing deletes");
X  ifdebug(ANY, D, DeleteEverySym() );
X  ifdebug(DMA, D, DebugMemory() );
X  ifdebug(DPP, D, ProfileOff("main"));
X  ifdebug(DPP, D, ProfilePrint());
X  exit(0);
X  return 0;
X} /* end main */
END_OF_FILE
  if test 16696 -ne `wc -c <'lout/z01.c'`; then
    echo shar: \"'lout/z01.c'\" unpacked with wrong size!
  fi
  # end of 'lout/z01.c'
fi
if test -f 'lout/z04.c' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'lout/z04.c'\"
else
  echo shar: Extracting \"'lout/z04.c'\" \(7382 characters\)
  sed "s/^X//" >'lout/z04.c' <<'END_OF_FILE'
X/*@z04.c:Token Service:NewToken(), CopyTokenList(), EchoToken()@**************/
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:         z04.c                                                      */
X/*  MODULE:       Token Service                                              */
X/*  EXTERNS:      NewToken(), CopyTokenList(), EchoCatOp(), EchoToken()      */
X/*                                                                           */
X/*****************************************************************************/
X#include "externs"
X
X
X/*****************************************************************************/
X/*                                                                           */
X/*  OBJECT NewToken(xtype, xfpos, xvspace, xhspace, xprec, xactual)          */
X/*                                                                           */
X/*  Returns a new non-WORD token initialised as the parameters indicate.     */
X/*                                                                           */
X/*****************************************************************************/
X
XOBJECT NewToken(xtype, xfpos, xvspace, xhspace, xprec, xactual)
Xunsigned char xtype;  FILE_POS *xfpos;  unsigned char xvspace, xhspace;  unsigned char xprec;
XOBJECT xactual;
X{ OBJECT res;
X  debug1(DTS, DDD, "NewToken(%s, ...)", Image(xtype));
X  res = New(xtype);
X  FposCopy(fpos(res), *xfpos);
X  vspace(res) = xvspace;
X  hspace(res) = xhspace;
X  precedence(res) = xprec;
X  actual(res) = xactual;
X  debug1(DTS, DDD, "NewToken returning %s", EchoToken(res));
X  return res;
X} /* end NewToken */
X
X
X/*****************************************************************************/
X/*                                                                           */
X/*  OBJECT CopyTokenList(x, pos)                                             */
X/*                                                                           */
X/*  Returns a copy of the list of tokens pointed to by x.                    */
X/*  All file positions in the copy are set to *pos.                          */
X/*                                                                           */
X/*****************************************************************************/
X
XOBJECT CopyTokenList(x, pos)
XOBJECT x;  FILE_POS *pos;
X{ OBJECT y, z, res;
X  res = nil;
X  y = x;
X  if( x != nil )
X  do
X  { if( type(y) == WORD )
X    { z = MakeWord(string(y), pos);
X      vspace(z) = vspace(y);
X      hspace(z) = hspace(y);
X    }
X    else z = NewToken(type(y), pos,vspace(y),hspace(y),precedence(y),actual(y));
X    res = Append(res, z, PARENT);
X    y = succ(y, PARENT);
X  } while( y != x );
X  return res;
X} /* end CopyTokenList */
X
X
X/*@@**************************************************************************/
X/*                                                                           */
X/*  unsigned char *EchoCatOp(xtype, xmark, xjoin)                            */
X/*                                                                           */
X/*  Return the catenation operator with this type, mark and join.            */
X/*                                                                           */
X/*****************************************************************************/
X
Xunsigned char *EchoCatOp(xtype, xmark, xjoin)
Xunsigned xtype;  BOOLEAN xmark, xjoin;
X{ switch( xtype )
X  {
X      case VCAT:   return (unsigned char *)
X            (xmark    ? xjoin    ? KW_VCAT_MJ : KW_VCAT_MN
X                : xjoin    ? KW_VCAT_NJ : KW_VCAT_NN);
X
X      case HCAT:   return (unsigned char *)
X            (xmark    ? xjoin    ? KW_HCAT_MJ : KW_HCAT_MN
X                : xjoin    ? KW_HCAT_NJ : KW_HCAT_NN);
X
X      case ACAT:   return (unsigned char *)
X            (xmark    ? xjoin    ? KW_ACAT_MJ : "??"
X                : xjoin    ? KW_ACAT_NJ : "??");
X
X      default:       Error(INTERN, no_fpos, "EchoCatOp: xtype = %d", xtype);
X           return (unsigned char *) "";
X
X  } /* end switch */
X} /* end EchoCatOp */
X
X
X#if DEBUG_ON
X/*****************************************************************************/
X/*                                                                           */
X/*  unsigned char *EchoToken(x)                                              */
X/*                                                                           */
X/*  Return an image of token x.  Do not worry about preceding space.         */
X/*                                                                           */
X/*****************************************************************************/
X
Xunsigned char *EchoToken(x)
XOBJECT x;
X{ switch( type(x) )
X  {
X    case WORD:
X
X      return string(x);
X      break;
X
X
X    case TSPACE:
X    case TJUXTA:
X    case USE:
X    case GSTUB_EXT:
X    case GSTUB_INT:
X    case GSTUB_NONE:
X
X      return Image(type(x));
X      break;
X
X
X    case BEGIN:
X    case END:
X    case ENV:
X    case CLOS:
X    case LBR:
X    case RBR:
X    case NULL_CLOS:
X    case CROSS:
X    case ONE_COL:
X    case ONE_ROW:
X    case WIDE:
X    case HIGH:
X    case HSCALE:
X    case VSCALE:
X    case SCALE:
X    case HCONTRACT:
X    case VCONTRACT:
X    case HEXPAND:
X    case VEXPAND:
X    case PADJUST:
X    case HADJUST:
X    case VADJUST:
X    case ROTATE:
X    case CASE:
X    case YIELD:
X    case FONT:
X    case SPACE:
X    case BREAK:
X    case NEXT:
X    case OPEN:
X    case TAGGED:
X    case INCGRAPHIC:
X    case SINCGRAPHIC:
X    case GRAPHIC:
X    case ACAT:
X    case HCAT:
X    case VCAT:
X    case CLOSURE:
X
X      return SymName(actual(x));
X      break;
X
X
X    default:
X
X      Error(INTERN, &fpos(x), "EchoToken: %s", Image(type(x)));
X      break;
X  }
X  return (unsigned char *) "";
X} /* end EchoToken */
X#endif
END_OF_FILE
  if test 7382 -ne `wc -c <'lout/z04.c'`; then
    echo shar: \"'lout/z04.c'\" unpacked with wrong size!
  fi
  # end of 'lout/z04.c'
fi
if test -f 'lout/z05.c' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'lout/z05.c'\"
else
  echo shar: Extracting \"'lout/z05.c'\" \(18300 characters\)
  sed "s/^X//" >'lout/z05.c' <<'END_OF_FILE'
X/*@z05.c:Read Definitions:ReadDefinitions()@**********************************/
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:         z05.c                                                      */
X/*  MODULE:       Read Definitions                                           */
X/*  EXTERNS:      ReadDefinitions()                                          */
X/*                                                                           */
X/*****************************************************************************/
X#include "externs"
X
X/*****************************************************************************/
X/*                                                                           */
X/*  check(typ, str, arg1, arg2)                                              */
X/*                                                                           */
X/*  If type(t) != typ, exit with error message.                              */
X/*                                                                           */
X/*****************************************************************************/
X
X#define check(typ, str, arg1, arg2)                    \
Xif( type(t) != typ )                            \
X{ Error(WARN, &fpos(t), str, arg1, arg2);                \
X  debug1(ANY, D, "offending type is %s", Image(type(t)));        \
X  UnSuppressScope();                            \
X  *token = t;                                \
X  return;                                \
X} else
X
X
X/*****************************************************************************/
X/*                                                                           */
X/*  word_check(word, str, arg1, arg2)                                        */
X/*                                                                           */
X/*  If t is not the given word, exit with error message.                     */
X/*                                                                           */
X/*****************************************************************************/
X
X#define word_check(word, str, arg1, arg2)                \
Xif( type(t) != WORD || strcmp(string(t), word) != 0 )            \
X{ Error(WARN, &fpos(t), str, arg1, arg2);                \
X  debug1(ANY, D, "offending object is %s",                \
X    type(t) == WORD ? string(t) : Image(type(t)));            \
X  UnSuppressScope();                            \
X  *token = t;                                \
X  return;                                \
X} else
X
X
X/*****************************************************************************/
X/*                                                                           */
X/*  is_word(t, str)                                                          */
X/*                                                                           */
X/*  If t is a token denoting word str, return TRUE.                          */
X/*                                                                           */
X/*****************************************************************************/
X
X#define is_word(t, str)        (type(t) == WORD && strcmp(string(t), str) == 0)
X
X
X/*****************************************************************************/
X/*                                                                           */
X/*  static ReadFontDef(token, encl)                                          */
X/*                                                                           */
X/*  Read one font definition and pass it on to the font module.  The         */
X/*  syntax is  fontdef <family> <face> { <word> }.                           */
X/*                                                                           */
X/*****************************************************************************/
X
Xstatic ReadFontDef(token, encl)
XOBJECT *token, encl;
X{ OBJECT t, res[5];  int i;
X
X  Dispose(*token);
X  SuppressScope();
X  for( i = 0;  i < 5;  i++ )
X  { t = LexGetToken();
X    check(WORD, "syntax error in %s", KW_FONTDEF, 0);
X    if( type(t) == WORD && string(t)[0] == '"' )
X      FontStripQuotes(string(t), &fpos(t));
X    res[i] = t;
X  }
X  if( strcmp(string(res[2]), KW_LBR) != 0 )
X    Error(WARN, &fpos(res[2]), "missing %s in fontdef", KW_LBR);
X  if( strcmp(string(res[4]), KW_RBR) != 0 )
X    Error(WARN, &fpos(res[4]), "missing %s in fontdef", KW_RBR);
X  Dispose(res[2]);  Dispose(res[4]);
X  FontDefine(res[0], res[1], res[3]);
X  *token = nil;
X  UnSuppressScope();
X  return;
X} /* end ReadFontDef */
X
X
X/*@@**************************************************************************/
X/*                                                                           */
X/*  static ReadTokenList(res)                                                */
X/*                                                                           */
X/*  Read a list of tokens from input and append them to sym_body(res).       */
X/*  The list is assumed to begin immediately after an LBR, and input is      */
X/*  to be read up to and including the matching RBR.                         */
X/*                                                                           */
X/*****************************************************************************/
X#define NextToken(t, res)                        \
X  t = LexGetToken(); sym_body(res) = Append(sym_body(res), t, PARENT);
X
Xstatic ReadTokenList(res)
XOBJECT res;
X{ OBJECT t, xsym, new_par;
X  NextToken(t, res);
X  for(;;) switch(type(t))
X  {
X    case WORD:
X
X      if( string(t)[0] == '@' )
X    Error(WARN, &fpos(t), "symbol %s unknown", string(t));
X      NextToken(t, res);
X      break;
X
X
X    case VCAT:
X    case HCAT:
X    case ACAT:
X    case CROSS:
X    case NULL_CLOS:
X    case ONE_COL:
X    case ONE_ROW:
X    case WIDE:
X    case HIGH:
X    case HSCALE:
X    case VSCALE:
X    case SCALE:
X    case HCONTRACT:
X    case VCONTRACT:
X    case HEXPAND:
X    case VEXPAND:
X    case PADJUST:
X    case HADJUST:
X    case VADJUST:
X    case ROTATE:
X    case CASE:
X    case YIELD:
X    case FONT:
X    case SPACE:
X    case BREAK:
X    case NEXT:
X    case TAGGED:
X    case INCGRAPHIC:
X    case SINCGRAPHIC:
X    case GRAPHIC:
X
X      NextToken(t, res);
X      break;
X
X
X    case LVIS:
X    case ENV:
X    case USE:
X    case BEGIN:
X    case END:
X    case OPEN:
X
X      Error(WARN,&fpos(t),"symbol %s not allowed in macro", SymName(actual(t)));
X      NextToken(t, res);
X      break;
X
X
X    case LBR:
X
X      ReadTokenList(res);
X      NextToken(t, res);
X      break;
X
X
X    case RBR:
X
X      return;
X
X
X    case CLOSURE:
X
X      xsym = actual(t);
X      PushScope(xsym, TRUE, FALSE);
X      NextToken(t, res);
X      PopScope();
X      if( type(t) == CROSS )
X      { NextToken(t, res);
X    break;
X      }
X
X      /* read named parameters */
X      while( type(t) == CLOSURE && enclosing(actual(t)) == xsym &&
X         type(actual(t)) == NPAR )
X      {    new_par = t;
X    NextToken(t, res);
X    if( type(t) != LBR )
X    { Error(WARN, &fpos(new_par), "%s must follow name parameter %s",
X        KW_LBR, SymName(actual(new_par)));
X      break;
X    }
X    PushScope(actual(new_par), FALSE, FALSE);
X    ReadTokenList(res);
X    PopScope();
X
X    /* get next token, possibly another named parameter */
X    PushScope(xsym, TRUE, FALSE);
X    NextToken(t, res);
X    PopScope();
X      }
X
X      /* read body parameter, if any */
X      if( has_body(xsym) )
X      {    if( type(t) == LBR )
X    { PushScope(xsym, FALSE, TRUE);
X      PushScope(ChildSym(xsym, RPAR), FALSE, FALSE);
X      ReadTokenList(res);
X      PopScope();
X      PopScope();
X      NextToken(t, res);
X    }
X    else Error(WARN, &fpos(t), "right parameter of %s must begin with %s",
X        SymName(xsym), KW_LBR);
X      }
X      break;
X
X    default:
X
X
X      Error(INTERN, &fpos(t), "unknown token type %s", Image(type(t)));
X      break;
X
X  }
X} /* end ReadTokenList */
X
X
X/*@@**************************************************************************/
X/*                                                                           */
X/*  static ReadMacro(token, encl)                                            */
X/*                                                                           */
X/*  Read a macro from input and insert into symbol table.                    */
X/*  Token *token contains the "macro" keyword.  Input is read up to and      */
X/*  including the closing right brace, and nil is returned in *token if OK.  */
X/*  The proper scope for reading the macro body is open at entry and exit.   */
X/*                                                                           */
X/*****************************************************************************/
X
Xstatic OBJECT ReadMacro(token, encl)
XOBJECT *token, encl;
X{ OBJECT t, res;  int depth;
X
X  /* find macro name and insert into symbol table */
X  SuppressScope();
X  Dispose(*token);  t = LexGetToken();
X  check(WORD, "%s ignored - can't find name", KW_MACRO, 0);
X  res = InsertSym(string(t), MACRO, &fpos(t), 0, FALSE, TRUE, 0, encl, nil);
X
X  /* find opening left brace */
X  t = LexGetToken();
X  word_check(KW_LBR, "%s ignored - can't find opening %s", KW_MACRO, KW_LBR);
X  Dispose(t);
X
X  /* read macro body */
X  UnSuppressScope();
X  ReadTokenList(res);
X
X  /* clean up (kill final RBR, dispose macro name) and exit */
X  sym_body(res) = DeleteAndDispose(pred(sym_body(res), PARENT), PARENT);
X  recursive(res) = FALSE;
X  *token = nil;
X  return res;
X} /* end ReadMacro */
X
X
X/*@@**************************************************************************/
X/*                                                                           */
X/*  ReadDefinitions(token, encl, res_type)                                   */
X/*                                                                           */
X/*  Read a sequence of definitions and insert them into the symbol table.    */
X/*  Either a sequence of local definitions (res_type == LOCAL) or named      */
X/*  parameters (res_type == NPAR) is expected; *token is the first def etc.  */
X/*  A scope appropriate for reading the bodies of the definitions is open.   */
X/*  The parent definition is encl.                                           */
X/*                                                                           */
X/*****************************************************************************/
X
XReadDefinitions(token, encl, res_type)
XOBJECT *token, encl;  unsigned char res_type;
X{ OBJECT t, res, res_target, export_list, import_list, link, y, z;
X  t = *token;
X
X
X  while( res_type != LOCAL ? is_word(t, KW_NAMED) :
X        is_word(t, KW_DEF) || is_word(t, KW_MACRO) || is_word(t, KW_FONTDEF)
X      || is_word(t, KW_IMPORT) || is_word(t, KW_EXPORT) )
X  {
X    if( is_word(t, KW_FONTDEF) )
X    { ReadFontDef(&t, encl);
X      if( t == nil ) t = LexGetToken();
X      continue;  /* next definition */
X    }
X
X    /* get import list and change scope appropriately */
X    BodyParNotAllowed();
X    import_list = New(ACAT);
X    if( is_word(t, KW_IMPORT) )
X    { Dispose(t);
X      t = LexGetToken();
X      while( type(t) == CLOSURE ||
X           (type(t)==WORD && !is_word(t,KW_EXPORT) && !is_word(t,KW_DEF)
X           && !is_word(t, KW_MACRO)) )
X      {    if( type(t) == CLOSURE )
X    { if( type(actual(t)) == LOCAL )
X      { PushScope(actual(t), FALSE, TRUE);
X        Link(import_list, t);
X      }
X      else
X      { Error(WARN, &fpos(t), "import name expected here");
X        Dispose(t);
X      }
X    }
X    else
X    { Error(WARN, &fpos(t), "import %s not in scope", string(t));
X      Dispose(t);
X    }
X    t = LexGetToken();
X      }
X    }
X
X    /* get export list and store for setting visible flags below */
X    export_list = New(ACAT);
X    if( is_word(t, KW_EXPORT) )
X    { Dispose(t);
X      SuppressScope();
X      t = LexGetToken();
X      while( type(t) == WORD && !is_word(t, KW_DEF) )
X      {    if( string(t)[0] == '"' )  FontStripQuotes(string(t), &fpos(t));
X    Link(export_list, t);
X    t = LexGetToken();
X      }
X      UnSuppressScope();
X    }
X
X
X    if( res_type == LOCAL && !is_word(t, KW_DEF) && !is_word(t, KW_MACRO) )
X    { Error(WARN,&fpos(t),"keyword %s or %s expected here", KW_DEF, KW_MACRO);
X      break;
X    }
X    if( res_type == NPAR && !is_word(t, KW_NAMED) )
X    { Error(WARN, &fpos(t), "keyword %s expected here", KW_NAMED);
X      break;
X    }
X
X    if( is_word(t, KW_MACRO) )
X    { if( Down(export_list) != export_list )
X    Error(WARN, &fpos(t), "ignoring %s list of %s", KW_EXPORT, KW_MACRO);
X      res = ReadMacro(&t, encl);
X    }
X    else
X    {
X      SuppressScope();  Dispose(t);  t = LexGetToken();
X
X      /* find name of symbol and insert it */
X      check(WORD, "can't find symbol name", 0, 0);
X      res = InsertSym(string(t), res_type, &fpos(t), DEFAULT_PREC,
X        FALSE, FALSE, 0, encl, nil);
X      t = LexGetToken();
X
X      /* find force, if any */
X      if( is_word(t, KW_FORCE) )
X      {    force_target(res) = TRUE;
X    Dispose(t);  t = LexGetToken();
X    if( !is_word(t, KW_INTO) )
X       Error(WARN, &fpos(t), "%s expected after %s", KW_INTO, KW_FORCE);
X      }
X
X      /* find into clause, if any */
X      res_target = nil;
X      if( is_word(t, KW_INTO) )
X      { UnSuppressScope();
X    Dispose(t);  t = LexGetToken();
X    check(LBR, "%s expected after %s", KW_LBR, KW_INTO);
X    res_target = Parse(&t, encl, FALSE, FALSE);
X    SuppressScope();
X    if( t == nil )  t = LexGetToken();
X      }
X
X      /* find precedence clause, if any */
X      if( is_word(t, KW_PRECEDENCE) )
X      {    int prec = 0;
X    Dispose(t);
X    t = LexGetToken();
X    while( type(t) == WORD && string(t)[0] >= '0' && string(t)[0] <= '9' )
X    {
X      /* check(WORD, "can't find value of %s", KW_PRECEDENCE, 0); */
X      prec = prec * 10 + string(t)[0] - '0';
X      Dispose(t);  t = LexGetToken();
X    }
X
X    if( prec < MIN_PREC )
X    { Error(WARN, &fpos(t), "%s is too low - %d substituted",
X        KW_PRECEDENCE, MIN_PREC );
X      prec = MIN_PREC;
X    }
X    else if( prec > MAX_PREC )
X    { Error(WARN, &fpos(t), "%s is too high - %d substituted",
X            KW_PRECEDENCE, MAX_PREC );
X      prec = MAX_PREC;
X    }
X    precedence(res) = prec;
X      }
X
X      /* find associativity clause, if any */
X      if( is_word(t, KW_ASSOC) )
X      {    Dispose(t);  t = LexGetToken();
X    if( is_word(t, KW_LEFT) )  right_assoc(res) = FALSE;
X    else if( !is_word(t, KW_RIGHT) )
X      Error(WARN, &fpos(t), "%s replaced by %s", KW_ASSOC, KW_RIGHT);
X    Dispose(t);  t = LexGetToken();
X      }
X
X      /* find left parameter, if any */
X      if( is_word(t, KW_LEFT) )
X      {    Dispose(t);  t = LexGetToken();
X    check(WORD, "can't find %s parameter name", KW_LEFT, 0);
X    InsertSym(string(t), LPAR, &fpos(t), DEFAULT_PREC,
X      FALSE, FALSE, 0, res, nil);
X    Dispose(t);  t = LexGetToken();
X      }
X
X      /* find named parameters, if any */
X      UnSuppressScope();
X      ReadDefinitions(&t, res, NPAR);
X
X      /* find right or body parameter, if any */
X      if( is_word(t, KW_RIGHT) || is_word(t, KW_BODY) )
X      {    has_body(res) = is_word(t, KW_BODY);
X    SuppressScope();
X    Dispose(t);  t = LexGetToken();
X    check(WORD, "can't find %s parameter name", KW_RIGHT, 0);
X    InsertSym(string(t), RPAR, &fpos(t), DEFAULT_PREC,
X      FALSE, FALSE, 0, res, nil);
X    UnSuppressScope();
X    Dispose(t);  t = LexGetToken();
X      }
X
X      /* read local definitions and body */
X      if( res_target != nil )
X    InsertSym(KW_TARGET, LOCAL, &fpos(res_target), DEFAULT_PREC,
X            FALSE, FALSE, 0, res, res_target);
X      if( type(t) == WORD && strcmp(string(t), KW_LBR) == 0 )
X      {    z = NewToken(LBR, &fpos(t), 0, 0, LBR_PREC, StartSym);
X    Dispose(t);
X    t = z;
X      }
X      else if( type(t) == WORD && strcmp(string(t), KW_BEGIN) == 0 )
X      {    z = NewToken(BEGIN, &fpos(t), 0, 0, BEGIN_PREC, StartSym);
X    Dispose(t);
X    t = z;
X      }
X      else if( type(t) != LBR && type(t) != BEGIN )
X    Error(FATAL, &fpos(t), "opening %s or %s of %s expected",
X      KW_LBR, KW_BEGIN, SymName(res));
X      if( type(t) == BEGIN )  actual(t) = res;
X      PushScope(res, FALSE, FALSE);
X      BodyParAllowed();
X      sym_body(res) = Parse(&t, res, TRUE, FALSE);
X
X      /* set visible flag of the exported symbols */
X      for( link=Down(export_list);  link != export_list;  link=NextDown(link) )
X      {    Child(y, link);
X    z = SearchSym(string(y), strlen(string(y)));
X    if( z == nil || enclosing(z) != res )
X      Error(WARN, &fpos(y), "exported symbol %s not defined in %s",
X        string(y), SymName(res));
X    else if( has_body(res) && type(z) == RPAR )
X      Error(WARN, &fpos(y), "body parameter %s may not be exported",
X        string(y));
X    else if( visible(z) )
X      Error(WARN, &fpos(y), "symbol %s exported twice", string(y));
X    else visible(z) = TRUE;
X      }
X      DisposeObject(export_list);
X
X      /* pop scope of res */
X      PopScope();
X    }
X
X    /* pop import scopes and store imports in sym tab */
X    for( link=Down(import_list);  link != import_list;  link=NextDown(link) )
X      PopScope();
X    if( Down(import_list) == import_list )
X    { Dispose(import_list);
X      import_list = nil;
X    }
X    imports(res) = import_list;
X
X    BodyParAllowed();
X    if( t == nil ) t = LexGetToken();
X
X  } /* end while */
X
X  *token = t;
X  return;
X} /* end ReadDefinitions */
END_OF_FILE
  if test 18300 -ne `wc -c <'lout/z05.c'`; then
    echo shar: \"'lout/z05.c'\" unpacked with wrong size!
  fi
  # end of 'lout/z05.c'
fi
if test -f 'lout/z12.c' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'lout/z12.c'\"
else
  echo shar: Extracting \"'lout/z12.c'\" \(18672 characters\)
  sed "s/^X//" >'lout/z12.c' <<'END_OF_FILE'
X/*@z12.c:Size Finder:MinSize()@***********************************************/
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:         z12.c                                                      */
X/*  MODULE:       Size Finder                                                */
X/*  EXTERNS:      MinSize()                                                  */
X/*                                                                           */
X/*****************************************************************************/
X#include "externs"
X#define IG_LOOKING    0
X#define IG_NOFILE    1
X#define IG_BADFILE    2
X#define IG_BADSIZE    3
X#define    IG_OK        4
X
X
X/*****************************************************************************/
X/*                                                                           */
X/*  OBJECT MinSize(x, dim, extras)                                           */
X/*                                                                           */
X/*  Set fwd(x, dim) and back(x, dim) to their minimum possible values.       */
X/*  If dim == ROW, construct an extras list and return it in *extras.        */
X/*                                                                           */
X/*****************************************************************************/
X
XOBJECT MinSize(x, dim, extras)
XOBJECT x;  int dim;  OBJECT *extras;
X{ OBJECT y, z, link, prev, t, g, full_name;
X  int b, f, dble_fwd, llx, lly, urx, ury, status;
X  float fllx, flly, furx, fury;
X  BOOLEAN dble_found, found, will_expand, first_line;
X  FILE *fp;  float scale_factor; unsigned char buff[MAX_LINE];
X
X  debug2(DSF, DD, "[ MinSize( %s, %s, extras )", EchoObject(null,x),dimen(dim));
X  ifdebug(DSF, DDD, EchoObject(stderr, x));
X
X  switch( type(x) )
X  {
X
X    case WORD:
X
X      if( dim == COL )  FontAtomSize(x);
X      break;
X
X
X    case CROSS:
X
X      /* add index to the cross-ref */
X      if( dim == ROW )
X      {    z = New( (int) cross_type(x));
X    actual(z) = x;
X    Link(*extras, z);
X    debug1(DCR, DDD, "  MinSize: %s", EchoObject(null, z));
X      }
X      back(x, dim) = fwd(x, dim) = 0;
X      break;
X
X
X    case NULL_CLOS:
X
X      back(x, dim) = fwd(x, dim) = 0;
X      break;
X
X
X    case HEAD:
X
X      if( dim == ROW )
X      {
X    /* replace the galley x by a dummy closure y */
X    y = New(NULL_CLOS);
X    FposCopy(fpos(y), fpos(x));
X    ReplaceNode(y, x);
X
X    if( has_key(actual(x)) )
X    {
X      /* galley is sorted, make insinuated cross-reference */
X      z = backward(x) ? New(GALL_PREC) : New(GALL_FOLL);
X      Child(t, Down(x));
X      actual(z) = CrossMake(whereto(x), t, (int) type(z));
X      Link(*extras, z);
X      DisposeObject(x);
X      debug1(DCR, DDD, "  MinSize: %s", EchoObject(null, z));
X    }
X    else
X    {
X      /* galley is following, make UNATTACHED */
X      z = New(UNATTACHED);  Link(z, x);
X      Link(*extras, z);
X      debug1(DCR, DDD, "  MinSize: %s", EchoObject(null, z));
X    }
X    x = y;    /* now sizing y, not x */
X      }
X      else external(x) = FALSE;
X      back(x, dim) = fwd(x, dim) = 0;
X      break;
X
X
X    case CLOSURE:
X
X      assert( !has_target(actual(x)), "MinSize: CLOSURE has target!" );
X      if( dim == ROW )
X      { if( indefinite(actual(x)) )
X    { z = New(RECEPTIVE);
X      actual(z) = x;
X      Link(*extras, z);
X      debug1(DCR, DDD, "  MinSize: %s", EchoObject(null, z));
X    }
X    else if( recursive(actual(x)) )
X    { z = New(RECURSIVE);
X      actual(z) = x;
X      Link(*extras, z);
X      debug1(DCR, DDD, "  MinSize: %s", EchoObject(null, z));
X    }
X    else Error(INTERN,&fpos(x), "MinSize: definite non-recursive CLOSURE!");
X      }
X      else external(x) = FALSE;        /*  nb must be done just here! */
X      back(x, dim) = fwd(x, dim) = 0;
X      break;
X
X
X    case ONE_COL:
X    case ONE_ROW:
X    case PADJUST:
X    case HADJUST:
X    case VADJUST:
X    case HCONTRACT:
X    case VCONTRACT:
X
X      Child(y, Down(x));
X      y = MinSize(y, dim, extras);
X      back(x, dim) = back(y, dim);
X      fwd(x, dim)  = fwd(y, dim);
X      break;
X
X
X    case HEXPAND:
X    case VEXPAND:
X
X      Child(y, Down(x));
X      y = MinSize(y, dim, extras);
X      back(x, dim) = back(y, dim);
X      fwd(x, dim)  = fwd(y, dim);
X
X      /* insert index into *extras for expanding later */
X      if( dim == ROW )
X      {    z = New(EXPAND_IND);
X    actual(z) = x;
X    Link(*extras, z);
X    debug1(DCR, DDD, "  MinSize: %s", EchoObject(null, z));
X      }
X      break;
X
X
X    case GRAPHIC:
X
X      Child(y, LastDown(x));
X      y = MinSize(y, dim, extras);
X      back(x, dim) = back(y, dim);
X      fwd(x, dim)  = fwd(y, dim);
X      break;
X
X
X    case HSCALE:
X    case VSCALE:
X
X      /* work out size and set to 0 if parallel */
X      Child(y, Down(x));
X      y = MinSize(y, dim, extras);
X      if( (dim == COL) == (type(x) == HSCALE) )
X    back(x, dim) = fwd(x, dim) = 0;
X      else
X      {    back(x, dim) = back(y, dim);
X    fwd(x, dim)  = fwd(y, dim);
X      }
X      break;
X
X
X    case ROTATE:
X
X      Child(y, Down(x));
X      if( dim == COL )
X      {    y = MinSize(y, COL, extras);
X    whereto(x) = New(ACAT);
X    y = MinSize(y, ROW, &whereto(x));
X    RotateSize(&back(x, COL), &fwd(x, COL), &back(x, ROW), &fwd(x, ROW),
X      y, sparec(constraint(x)));
X      }
X      else
X      {    TransferLinks(Down(whereto(x)), whereto(x), *extras);
X    Dispose(whereto(x));
X      }
X      break;
X
X
X    case SCALE:
X
X      Child(y, Down(x));
X      y = MinSize(y, dim, extras);
X      if( dim == COL )
X      { back(x, dim) = (back(y, dim) * bc(constraint(x))) / SF;
X        fwd(x, dim)  = (fwd(y, dim)  * bc(constraint(x))) / SF;
X      }
X      else
X      { back(x, dim) = (back(y, dim) * fc(constraint(x))) / SF;
X        fwd(x, dim)  = (fwd(y, dim)  * fc(constraint(x))) / SF;
X      }
X      break;
X
X
X    case WIDE:
X
X      Child(y, Down(x));
X      y = MinSize(y, dim, extras);
X      if( dim == COL )
X      { y = BreakObject(y, &constraint(x));
X        assert( FitsConstraint(back(y, dim), fwd(y, dim), constraint(x)),
X        "MinSize: BreakObject failed to fit!" );
X        back(x, dim) = back(y, dim);
X    fwd(x, dim)  = fwd(y, dim);
X    EnlargeToConstraint(&back(x, dim), &fwd(x, dim), &constraint(x));
X      }
X      else
X      {    back(x, dim) = back(y, dim);
X    fwd(x, dim)  = fwd(y, dim);
X      }
X      break;
X
X
X    case HIGH:
X
X      Child(y, Down(x));
X      y = MinSize(y, dim, extras);
X      if( dim == ROW )
X      { if( !FitsConstraint(back(y, dim), fwd(y, dim), constraint(x)) )
X        { Error(WARN, &fpos(x), "forced to enlarge %s", KW_HIGH);
X      debug0(DSF, D, "offending object was:");
X      ifdebug(DSF, D, EchoObject(stderr, y));
X      SetConstraint(constraint(x), MAX_LEN, size(y, dim), MAX_LEN);
X        }
X        back(x, dim) = back(y, dim);
X    fwd(x, dim)  = fwd(y, dim);
X    EnlargeToConstraint(&back(x, dim), &fwd(x, dim), &constraint(x));
X      }
X      else
X      {    back(x, dim) = back(y, dim);
X    fwd(x, dim)  = fwd(y, dim);
X      }
X      break;
X
X
X    case SPLIT:
X
X      link = DownDim(x, dim);  Child(y, link);
X      y = MinSize(y, dim, extras);
X      back(x, dim) = back(y, dim);
X      fwd(x, dim)  = fwd(y, dim);
X      break;
X
X
X    case ACAT:
X    case HCAT:
X    case VCAT:
X
X      if( (dim == ROW) == (type(x) == VCAT) )
X      {
X    /********************************************************************/
X    /*                                                                  */
X    /*  Calculate sizes parallel to join direction; loop invariant is:  */
X    /*                                                                  */
X    /*     If prev == nil, there are no definite children equal to or   */
X    /*        to the left of Child(link).                               */
X    /*     If prev != nil, prev is the rightmost definite child to the  */
X    /*        left of Child(link), and (b, f) is the total size up to   */
X    /*        the mark of prev i.e. not including fwd(prev).            */
X    /*     g is the most recent gap, or nil if none found yet.          */
X    /*     will_expand == TRUE when a gap is found that is likely to    */
X    /*        enlarge when ActualGap is called later on.                */
X    /*                                                                  */
X    /********************************************************************/
X
X    prev = g = nil;  will_expand = FALSE;  must_expand(x) = FALSE;
X    for( link = Down(x);  link != x;  link = NextDown(link) )
X    { Child(y, link);
X      if( is_index(type(y)) )
X      { if( dim == ROW )
X        { link = PrevDown(link);
X          MoveLink(NextDown(link), *extras, PARENT);
X        }
X        continue;
X      }
X      else if( type(y) == type(x) )
X      { link = PrevDown(link);
X        TransferLinks(Down(y), y, NextDown(link));
X        DisposeChild(Up(y));
X        continue;
X      }
X      else if( type(y) == GAP_OBJ )  g = y;
X      else /* calculate size of y and accumulate it */
X      { if( type(y) == WORD )
X        { if( dim == COL )
X          {    FontAtomSize(y);
X        debug4(DSF, DD, "FontAtomSize( %s ) font %d = %s,%s",
X        EchoObject(null, y), word_font(y),
X        EchoLength(back(y, COL)), EchoLength(fwd(y, COL)));
X          }
X        }
X        else y = MinSize(y, dim, extras);
X
X        if( is_indefinite(type(y)) )
X        {
X          /* error if preceding gap has mark */
X          if( g != nil && mark(gap(g)) )
X          {    Error(WARN, &fpos(y), "catenation modifier ^ deleted (%s)",
X            "it may not precede this object");
X        mark(gap(g)) = FALSE;
X          }
X
X          /* error if next unit is used in preceding gap */
X          if( g != nil && units(gap(g)) == NEXT_UNIT )
X          {    Error(WARN, &fpos(y), "gap replaced by 0i (%s)",
X            "unit n may not precede this object");
X        units(gap(g)) = FIXED_UNIT;
X        width(gap(g)) = 0;
X          }
X        }
X        else
X        {
X          /* calculate running total length */
X          if( prev == nil )  b = back(y, dim), f = 0;
X          else
X          {
X        assert( g!=nil && mode(gap(g))!=NO_MODE, "MinSize: NO_MODE!" );
X        f += MinGap(fwd(prev, dim), back(y, dim), fwd(y, dim), &gap(g));
X        if( units(gap(g)) == FRAME_UNIT && width(gap(g)) > FR )
X            will_expand = TRUE;
X        if( mark(gap(g)) )  b += f, f = 0;
X          }
X          prev = y;
X        }
X        debug2(DSF,DD,"  b = %s, f = %s",EchoLength(b),EchoLength(f));
X      }
X    } /* end for */
X
X    if( prev == nil )  b = f = 0;
X    else f += fwd(prev, dim);
X    back(x, dim) = min(MAX_LEN, b);
X    fwd(x, dim)  = min(MAX_LEN, f);
X
X    if( type(x) == ACAT && will_expand )  fwd(x, COL) = MAX_LEN;
X      }
X      else
X      {
X    /********************************************************************/
X    /*                                                                  */
X    /*  Calculate sizes perpendicular to join direction                 */
X    /*                                                                  */
X    /*  Loop invariant:                                                 */
X    /*                                                                  */
X    /*     if found, (b, f) is the size of x, from the last // or from  */
X    /*     the start, up to link exclusive.  Else no children yet.      */
X    /*     If dble_found, a previous // exists, and (0, dble_fwd) is    */
X    /*     the size of x from the start up to that //.                  */
X    /*                                                                  */
X    /********************************************************************/
X
X    dble_found = found = FALSE;  dble_fwd = 0;
X    for( link = Down(x);  link != x;  link = NextDown(link) )
X    { Child(y, link);
X      if( is_index(type(y)) )
X      { if( dim == ROW )
X        { link = PrevDown(link);
X          MoveLink(NextDown(link), *extras, PARENT);
X        }
X        continue;
X      }
X      else if( type(y) == type(x) )
X      { link = PrevDown(link);
X        TransferLinks(Down(y), y, NextDown(link));
X        DisposeChild(Up(y));
X        continue;
X      }
X      else if( type(y) == GAP_OBJ )
X      { assert( found, "MinSize/VCAT/perp: !found!" );
X        if( !join(gap(y)) )
X        {
X          /* found // or || operator, so end current group */
X          dble_found = TRUE;
X          dble_fwd = max(dble_fwd, b + f);
X          debug1(DSF, DD, "  endgroup, dble_fwd: %s", EchoLength(dble_fwd));
X          found = FALSE;
X        }
X      }
X      else /* found object */
X      {
X        /* calculate size of subobject y */
X        if( type(y) == WORD )
X        { if( dim == COL )  FontAtomSize(y);
X        }
X        else y = MinSize(y, dim, extras);
X        if( found )
X        { b = max(b, back(y, dim));
X          f = max(f, fwd(y, dim));
X        }
X        else
X        { b = back(y, dim);
X          f = fwd(y, dim);
X          found = TRUE;
X        }
X        debug2(DSF,DD, "  b: %s, f: %s", EchoLength(b), EchoLength(f));
X      }
X    } /* end for */
X    assert( found, "MinSize/VCAT/perp: !found (2)!" );
X
X    /* finish off last group */
X    if( dble_found )
X    { back(x, dim) = 0;
X      dble_fwd = max(dble_fwd, b + f);
X      fwd(x, dim) = min(MAX_LEN, dble_fwd);
X      debug1(DSF, DD, "  end group, dble_fwd: %s", EchoLength(dble_fwd));
X    }
X    else
X    { back(x, dim) = b;
X      fwd(x, dim)  = f;
X    }
X      } /* end else */
X      break;
X
X
X    case COL_THR:
X    case ROW_THR:
X
X      assert( (type(x) == COL_THR) == (dim == COL), "Manifest/COL_THR: dim!" );
X      if( thr_state(x) == NOTSIZED )
X      {    assert( Down(x) != x, "Manifest/COL_THR: Down(x)!" );
X    Child(y, Down(x));
X    y = MinSize(y, dim, extras);
X    b = back(y, dim);
X    f = fwd(y, dim);
X    for( link = NextDown(Down(x));  link != x;  link = NextDown(link) )
X    { Child(y, link);
X      assert( type(y) != GAP_OBJ, "Manifest/COL_THR: GAP_OBJ!" );
X      y = MinSize(y, dim, extras);
X      b = max(b, back(y, dim));
X      f = max(f, fwd(y, dim));
X    }
X    back(x, dim) = b;
X    fwd(x, dim)  = f;
X    thr_state(x) = SIZED;
X      }
X      break;
X
X
X    case INCGRAPHIC:
X    case SINCGRAPHIC:
X
X      /* open file, check for initial %!, and hunt for %%BoundingBox line */
X      /* according to DSC Version 3.0, the BoundingBox parameters must be */
X      /* integers; but we read them as floats and truncate since files    */
X      /* with fractional values seem to be common in the real world       */
X      if( dim == ROW )  break;
X      status = IG_LOOKING;
X      Child(y, Down(x));
X      fp = OpenIncGraphicFile(string(y), type(x), &full_name, &fpos(y));
X      /* *** fp = OpenFile(fnum = sparec(constraint(x)), FALSE); */
X      if( fp == NULL )  status = IG_NOFILE;
X      first_line = TRUE;
X      while( status == IG_LOOKING && fgets(buff, MAX_LINE, fp) != NULL )
X      {
X    if( first_line && (buff[0] != '%' || buff[1] != '!') )
X      status = IG_BADFILE;
X    else
X    { first_line = FALSE;
X      if( buff[0] == '%' &&
X          StringBeginsWith(buff, (unsigned char *) "%%BoundingBox:") &&
X          !StringContains(buff, "(atend)") )
X      { if( sscanf(buff, "%%%%BoundingBox: %f %f %f %f",
X        &fllx, &flly, &furx, &fury) == 4 )
X        {
X          status = IG_OK;
X          llx = fllx;
X          lly = flly;
X          urx = furx;
X          ury = fury;
X        }
X        else status = IG_BADSIZE;
X      }
X    }
X      }
X
X      /* report error or calculate true size, depending on status */
X      switch( status )
X      {
X    case IG_LOOKING:
X
X      Error(WARN, &fpos(x), "%s given zero size: format error in file %s%s",
X        type(x) == INCGRAPHIC ? KW_INCGRAPHIC : KW_SINCGRAPHIC,
X        string(full_name), " (missing %%BoundingBox: line)");
X      back(y, COL) = fwd(y, COL) = back(y, ROW) = fwd(y, ROW) = 0;
X      back(x, COL) = fwd(x, COL) = back(x, ROW) = fwd(x, ROW) = 0;
X      sparec(constraint(x)) = TRUE;
X      fclose(fp);
X      break;
X
X    case IG_NOFILE:
X
X      Error(WARN, &fpos(x), "%s deleted: cannot open file %s",
X        type(x) == INCGRAPHIC ? KW_INCGRAPHIC : KW_SINCGRAPHIC,
X        string(full_name));
X      sparec(constraint(x)) = FALSE;
X      back(x, COL) = fwd(x, COL) = back(x, ROW) = fwd(x, ROW) = 0;
X      break;
X
X    case IG_BADFILE:
X
X      Error(WARN, &fpos(x), "%s deleted: format error in file %s %s",
X        type(x) == INCGRAPHIC ? KW_INCGRAPHIC : KW_SINCGRAPHIC,
X        string(full_name), "(bad first line)");
X      sparec(constraint(x)) = FALSE;
X      back(x, COL) = fwd(x, COL) = back(x, ROW) = fwd(x, ROW) = 0;
X      fclose(fp);
X      break;
X
X    case IG_BADSIZE:
X
X      Error(WARN, &fpos(x), "%s given zero size: format error in file %s%s",
X        type(x) == INCGRAPHIC ? KW_INCGRAPHIC : KW_SINCGRAPHIC,
X        string(full_name), " (bad %%BoundingBox: line)");
X      back(y, COL) = fwd(y, COL) = back(y, ROW) = fwd(y, ROW) = 0;
X      back(x, COL) = fwd(x, COL) = back(x, ROW) = fwd(x, ROW) = 0;
X      sparec(constraint(x)) = TRUE;
X      fclose(fp);
X      break;
X
X    case IG_OK:
X
X      Child(y, Down(x));
X      back(y, COL) = llx;  fwd(y, COL) = urx;
X      back(y, ROW) = lly;  fwd(y, ROW) = ury;
X      b = (urx - llx) * PT;
X      b = max(0, min(b, MAX_LEN));
X      back(x, COL) = fwd(x, COL) = b / 2;
X      b = (ury - lly) * PT;
X      b = max(0, min(b, MAX_LEN));
X      back(x, ROW) = fwd(x, ROW) = b / 2;
X      sparec(constraint(x)) = TRUE;
X      fclose(fp);
X      break;
X
X      }
X      DisposeObject(full_name);
X      break;
X
X
X    default:
X
X      Error(INTERN, &fpos(x), "MinSize: type(x): %s", Image(type(x)));
X      break;
X
X
X  } /* end switch */
X  debug1(DSF, DD,  "] MinSize returning, x = %s", EchoObject(null, x));
X  debug3(DSF, DD, "  (%s size is %s, %s)", dimen(dim),
X        EchoLength(back(x, dim)), EchoLength(fwd(x, dim)) );
X  ifdebug(DSF, DDD, EchoObject(stderr, x));
X
X  assert( type(x) == WORD || back(x, dim) >= 0, "MinSize: back(x, dim) < 0!" );
X  assert( type(x) == WORD || fwd(x, dim)  >= 0, "MinSize: fwd(x, dim)  < 0!" );
X
X  return x;
X} /* end MinSize */
END_OF_FILE
  if test 18672 -ne `wc -c <'lout/z12.c'`; then
    echo shar: \"'lout/z12.c'\" unpacked with wrong size!
  fi
  # end of 'lout/z12.c'
fi
if test -f 'lout/z18.c' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'lout/z18.c'\"
else
  echo shar: Extracting \"'lout/z18.c'\" \(16726 characters\)
  sed "s/^X//" >'lout/z18.c' <<'END_OF_FILE'
X/*@z18.c:Galley Transfer:TransferBegin(), TransferComponent()@****************/
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:         z18.c                                                      */
X/*  MODULE:       Galley Transfer                                            */
X/*  EXTERNS:      TransferInit(), TransferBegin(), TransferComponent(),      */
X/*                TransferEnd(), TransferClose()                             */
X/*                                                                           */
X/*****************************************************************************/
X#include "externs"
X
X#define    MAX_DEPTH      30            /* max depth of galleys      */
Xstatic OBJECT        root_galley = nil;    /* the root galley           */
Xstatic OBJECT        targets[MAX_DEPTH];    /* currently open \Inputs    */
Xstatic CONSTRAINT    constraints[MAX_DEPTH];    /* their COL constraints     */
Xstatic int        itop;            /* stack top                 */
Xstatic CONSTRAINT    initial_constraint;    /* initial COL constraint    */
Xstatic STYLE        InitialStyle;        /* initial style             */
X
X#if DEBUG_ON
Xstatic debug_targets()
X{ int i;  OBJECT tmp;
X  for( i = 0;  i <= itop;  i++ )
X  { if( targets[i] == nil || Down(targets[i]) == targets[i] )  tmp = nil;
X    else Child(tmp, Down(targets[i]));
X    debug3(DGT, D, "  target[%d] %s = %s", i,
X      EchoConstraint(&constraints[i]), EchoObject(null, tmp));
X  }
X} /* end debug_targets */
X#endif
X
X
X/*@@**************************************************************************/
X/*                                                                           */
X/*  TransferInit(InitEnv)                                                    */
X/*                                                                           */
X/*  Initialise this module.  The initial environment is InitEnv.             */
X/*                                                                           */
X/*****************************************************************************/
X
XTransferInit(InitEnv)
XOBJECT InitEnv;
X{ OBJECT dest, x, y, recs, inners, nothing, dest_index, up_hd;
X  debug1(DGT, D, "TransferInit( %s )", EchoObject(null, InitEnv));
X  SetConstraint(initial_constraint, MAX_LEN-1, MAX_LEN-1, MAX_LEN-1);
X
X  /* save initial environment and style */
X  SetGap( line_gap(InitialStyle), FALSE, FALSE, FIXED_UNIT, MARK_MODE, 18*PT);
X  SetGap(space_gap(InitialStyle), FALSE, TRUE,  FIXED_UNIT, EDGE_MODE,  1*EM);
X  font(InitialStyle)            = 0;
X  hyph_style(InitialStyle)      = HYPH_UNDEF;
X  fill_style(InitialStyle)      = FILL_UNDEF;
X  display_style(InitialStyle)   = DISPLAY_UNDEF;
X
X  /* construct destination for root galley */
X  up_hd = New(HEAD);
X  dest_index = New(RECEIVING);
X  dest = New(CLOSURE);  actual(dest) = PrintSym;
X  actual(dest_index) = dest;
X  external(dest) = TRUE;
X  threaded(dest) = FALSE;
X  blocked(dest_index) = FALSE;
X  Link(up_hd, dest_index);
X
X  /* construct root galley */
X  root_galley = New(HEAD);
X  FposCopy(fpos(root_galley), *no_fpos);
X  actual(root_galley) = whereto(root_galley) = ready_galls(root_galley) = nil;
X  backward(root_galley) = must_expand(root_galley) = sized(root_galley) = FALSE;
X  x = New(CLOSURE);  actual(x) = InputSym;
X  Link(root_galley, x);
X  SizeGalley(root_galley, InitEnv, TRUE, FALSE, FALSE, FALSE, &InitialStyle,
X        &initial_constraint, nil, ¬hing, &recs, &inners);
X  assert( recs   == nil , "TransferInit: recs   != nil!" );
X  assert( inners == nil , "TransferInit: inners != nil!" );
X  Link(dest_index, root_galley);
X
X  /* initialise target and constraint stacks */
X  Child(y, Down(root_galley));
X  assert( type(y) == RECEPTIVE && type(actual(y)) == CLOSURE &&
X    actual(actual(y)) == InputSym, "TransferInit: initial galley!" );
X  assert( external(actual(y)), "TransferInit: input sym not external!" );
X  blocked(y) = TRUE;
X  targets[itop = 0] = New(ACAT);
X  Link(targets[itop], y);
X  Constrained(actual(y), &constraints[itop], COL);
X  debug2(DSC, D, "Constrained( %s, COL ) = %s",
X    EchoObject(null, y), EchoConstraint(&constraints[itop]));
X
X  debug0(DGT, D, "TransferInit returning.");
X  ifdebug(DGT, DD, debug_targets());
X} /* end TransferInit */
X
X
X/*@@**************************************************************************/
X/*                                                                           */
X/*  OBJECT TransferBegin(x)                                                  */
X/*                                                                           */
X/*  Commence the transfer of a new galley whose header is invokation x.      */
X/*                                                                           */
X/*****************************************************************************/
X
XOBJECT TransferBegin(x)
XOBJECT x;
X{ OBJECT xsym, index, y, link, env, new_env, hold_env, res, hd, target;
X  CONSTRAINT c;
X  debug1(DGT, D, "TransferBegin( %s )", EchoObject(null, x));
X  ifdebug(DGT, DD, debug_targets());
X  assert( type(x) == CLOSURE, "TransferBegin: non-CLOSURE!" );
X
X  /* construct new (inner) env chain */
X  if( Down(targets[itop]) == targets[itop] )
X      Error(FATAL, &fpos(x), "cannot attach galley %s", SymName(actual(x)));
X  Child(target, Down(targets[itop]));
X  xsym = actual(x);
X  env = GetEnv(actual(target));
X  debug1(DGT, DD, "  current env chain: %s", EchoObject(null, env));
X  if( has_body(xsym) )
X  {
X    /* prepare a copy of x for inclusion in environment */
X    y = CopyObject(x, no_fpos);
X
X    /* attach its environment */
X    AttachEnv(env, y);
X
X    /* now the new environment is y catenated with the old one */
X    new_env = SetEnv(y, nil);
X  }
X  else new_env = env;
X  hold_env = New(ACAT);  Link(hold_env, new_env);
X  debug1(DGT, DD, "  new env chain: %s", EchoObject(null, new_env));
X
X  /* convert x into an unsized galley called hd */
X  index = New(UNATTACHED);
X  hd = New(HEAD);
X  FposCopy(fpos(hd), fpos(x));
X  actual(hd) = xsym;
X  backward(hd) = TargetSymbol(x, &whereto(hd));
X  ready_galls(hd) = nil;
X  must_expand(hd) = TRUE;
X  sized(hd) = FALSE;
X  Link(index, hd);
X  Link(hd, x);
X  AttachEnv(env, x);
X
X  /* search for destination for hd and release it */
X  Link(Up(target), index);
X  debug0(DGF, D, "  calling FlushGalley from TransferBegin");
X  FlushGalley(hd);
X
X  /* if failed to flush, undo everything and exit */
X  Parent(index, Up(hd));
X  if( type(index) == UNATTACHED && !sized(hd) )
X  { DeleteNode(index);
X    DisposeObject(hold_env);
X    if( LastDown(x) != x )
X    { Child(env, LastDown(x));
X      if( type(env) == ENV )  DisposeChild(LastDown(x));
X    }
X    debug1(DGT,D, "TransferBegin returning failed, x: %s", EchoObject(null, x));
X    return x;
X  }
X
X  if( has_rpar(actual(hd)) )
X  {
X    /* set up new target to be inner \InputSym, or nil if none */
X    if( ++itop >= MAX_DEPTH ) Error(FATAL, &fpos(x),
X    "galley nested too deeply (max is %d)", MAX_DEPTH);
X    targets[itop] = New(ACAT);  target = nil;
X    for( link = Down(hd);  link != hd;  link = NextDown(link) )
X    { Child(y, link);
X      if( type(y) == RECEPTIVE && actual(actual(y)) == InputSym )
X      {
X    Constrained(actual(y), &constraints[itop], COL);
X    if( FitsConstraint(0, 0, constraints[itop]) )
X    { Link(targets[itop], y);  target = y;
X      debug2(DSC, D, "Constrained( %s, COL ) = %s",
X        EchoObject(null, y), EchoConstraint(&constraints[itop]));
X      env = DetachEnv(actual(y));
X      AttachEnv(new_env, actual(y));
X    }
X    else
X    { Error(WARN, &fpos(hd), "galley %s deleted (target too narrow)",
X        SymName(actual(hd)));
X    }
X    break;
X      }
X    }
X
X    /* return a token appropriate to the new target */
X    if( target == nil || external(actual(target)) )
X      res = NewToken(GSTUB_EXT, no_fpos, 0, 0, precedence(xsym), nil);
X    else
X    { Constrained(actual(target), &c, ROW);
X      if( constrained(c) )  Error(FATAL, &fpos(target),
X        "right parameter of %s is vertically constrained", SymName(xsym));
X      else res = NewToken(GSTUB_INT, no_fpos, 0, 0, precedence(xsym), nil);
X    }
X  }
X  else res = NewToken(GSTUB_NONE, no_fpos, 0, 0, precedence(xsym), nil);
X
X  DisposeObject(hold_env);
X  debug1(DGT, D, "TransferBegin returning %s", Image(type(res)));
X  ifdebug(DGT, DD, debug_targets());
X  return res;
X} /* end TransferBegin */
X
X
X/*@@**************************************************************************/
X/*                                                                           */
X/*  TransferComponent(x)                                                     */
X/*                                                                           */
X/*  Transfer component x of a galley.                                        */
X/*                                                                           */
X/*****************************************************************************/
X
XTransferComponent(x)
XOBJECT x;
X{ OBJECT y, env, start_search, recs, inners, nothing, hd, dest, dest_index;
X  debug1(DGT, D, "TransferComponent( %s )", EchoObject(null, x));
X  ifdebug(DGT, DD, debug_targets());
X
X  /* if no dest_index, discard x and exit */
X  if( Down(targets[itop]) == targets[itop] )
X  { DisposeObject(x);
X    debug0(DGT, D, "TransferComponent returning (no target).");
X    return;
X  }
X  Child(dest_index, Down(targets[itop]));
X  assert( external(actual(dest_index)), "TransferComponent: internal!" );
X
X  /* make the component into a galley */
X  hd = New(HEAD);
X  FposCopy(fpos(hd), fpos(x));
X  actual(hd) = whereto(hd) = ready_galls(hd) = nil;
X  backward(hd) = must_expand(hd) = sized(hd) = FALSE;
X  Link(hd, x);
X  dest = actual(dest_index);
X  env = GetEnv(dest);
X  debug1(DGT, DD, "  current env chain: %s", EchoObject(null, env));
X  SizeGalley(hd, env, TRUE, threaded(dest), FALSE, TRUE, &save_style(dest),
X    &constraints[itop], nil, ¬hing, &recs, &inners);
X  if( recs != nil )  ExpandRecursives(recs);
X
X  /* promote the components, remembering where old spot was */
X  start_search = PrevDown(Up(dest_index));
X  debug0(DSA, D, "  calling AdjustSize from TransferComponent");
X  AdjustSize(dest, back(hd, COL), fwd(hd, COL), COL);
X  Promote(hd, hd, dest_index);
X  DeleteNode(hd);
X
X  /* flush any widowed galleys attached to \Input */
X  if( Down(dest_index) != dest_index )
X  { OBJECT tinners, index;
X    tinners = New(ACAT);
X    while( Down(dest_index) != dest_index )
X    { Child(y, Down(dest_index));
X      assert( type(y) == HEAD, "TransferComponent: input child!" );
X      DetachGalley(y);
X      Parent(index, Up(y));
X      MoveLink(Up(index), NextDown(start_search), PARENT);
X      Link(tinners, index);
X    }
X    FlushInners(tinners, nil);
X  }
X
X  /* flush any galleys inside hd */
X  if( inners != nil )  FlushInners(inners, nil);
X
X  /* flush parent galley, if needed */
X  if( blocked(dest_index) )
X  { blocked(dest_index) = FALSE;
X    Parent(y, Up(dest_index));
X    debug0(DGF, D, "  calling FlushGalley from TransferComponent");
X    FlushGalley(y);
X  }
X
X  debug0(DGT, D, "TransferComponent returning.");
X  ifdebug(DGT, DD, debug_targets());
X} /* end TransferComponent */
X
X
X/*@@**************************************************************************/
X/*                                                                           */
X/*  TransferEnd(x)                                                           */
X/*                                                                           */
X/*  End the transfer of a galley.                                            */
X/*                                                                           */
X/*****************************************************************************/
X
XTransferEnd(x)
XOBJECT x;
X{ OBJECT recs, inners, nothing, z, env, dest, hd, dest_index, y, start_search;
X  debug1(DGT, D, "TransferEnd( %s )", EchoObject(null, x));
X  ifdebug(DGT, DD, debug_targets());
X
X  /* if no dest_index, discard x and exit */
X  if( Down(targets[itop]) == targets[itop] )
X  { DisposeObject(x);  DisposeObject(targets[itop--]);
X    debug0(DGT, D, "TransferEnd returning: no dest_index");
X    return;
X  }
X  Child(dest_index, Down(targets[itop]));
X
X  /* make the component into a galley */
X  hd = New(HEAD);  FposCopy(fpos(hd), fpos(x));
X  actual(hd) = whereto(hd) = ready_galls(hd) = nil;
X  backward(hd) = must_expand(hd) = sized(hd) = FALSE;
X  Link(hd, x);  dest = actual(dest_index);  env = GetEnv(dest);
X  debug1(DGT, DD, "  current env chain: %s", EchoObject(null, env));
X  SizeGalley(hd, env, external(dest), threaded(dest), FALSE, TRUE,
X    &save_style(dest), &constraints[itop], nil, ¬hing, &recs, &inners);
X  if( recs != nil )  ExpandRecursives(recs);
X
X  /* promote the components, remembering where old spot was */
X  start_search = PrevDown(Up(dest_index));
X  debug0(DSA, D, "calling AdjustSize from TransferEnd (a)");
X  AdjustSize(dest, back(hd, COL), fwd(hd, COL), COL);
X  if( !external(dest) )
X  { Child(z, LastDown(hd));
X    debug0(DSA, D, "calling AdjustSize from TransferEnd (b)");
X    AdjustSize(dest, back(z, ROW), fwd(z, ROW), ROW);
X    Interpose(dest, VCAT, hd, z);
X  }
X  Promote(hd, hd, dest_index);  DeleteNode(hd);
X
X  /* flush any widowed galleys attached to \Input */
X  if( Down(dest_index) != dest_index )
X  { OBJECT tinners, index;
X    tinners = New(ACAT);
X    while( Down(dest_index) != dest_index )
X    { Child(y, Down(dest_index));
X      assert( type(y) == HEAD, "TransferComponent: input child!" );
X      DetachGalley(y);
X      Parent(index, Up(y));
X      MoveLink(Up(index), NextDown(start_search), PARENT);
X      Link(tinners, index);
X    }
X    FlushInners(tinners, nil);
X  }
X
X  /* flush any galleys inside hd */
X  if( inners != nil )  FlushInners(inners, nil);
X
X  /* close dest_index, and flush parent galley if needed */
X  if( blocked(dest_index) )
X  { Parent(y, Up(dest_index));
X    DeleteNode(dest_index);
X    debug0(DGF, D, "  calling FlushGalley from TransferEnd");
X    FlushGalley(y);
X  }
X  else DeleteNode(dest_index);
X
X  /* pop target stack and exit */
X  DisposeObject(targets[itop--]);
X  debug0(DGT, D, "TransferEnd returning.");
X  ifdebug(DGT, DD, debug_targets());
X} /* end TransferEnd */
X
X
X/*****************************************************************************/
X/*                                                                           */
X/*  TransferClose()                                                          */
X/*                                                                           */
X/*  Close this module.                                                       */
X/*                                                                           */
X/*****************************************************************************/
X
XTransferClose()
X{ OBJECT inners;
X  debug0(DGT, D, "TransferClose()");
X  debug0(DGA, D, "  calling FreeGalley from TransferClose");
X  if( LastDown(root_galley) != root_galley )
X  { inners = nil;
X    FreeGalley(root_galley, root_galley, &inners, nil, nil);
X    if( inners != nil )  FlushInners(inners, nil);
X    debug0(DGF, D, "  calling FlushGalley from TransferClose");
X    FlushGalley(root_galley);
X  }
X  debug0(DGT, D, "TransferClose returning.");
X}
END_OF_FILE
  if test 16726 -ne `wc -c <'lout/z18.c'`; then
    echo shar: \"'lout/z18.c'\" unpacked with wrong size!
  fi
  # end of 'lout/z18.c'
fi
echo shar: End of archive 13 \(of 30\).
cp /dev/null ark13isdone
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...