home *** CD-ROM | disk | FTP | other *** search
/ Source Code 1994 March / Source_Code_CD-ROM_Walnut_Creek_March_1994.iso / compsrcs / misc / volume38 / lout / part07 < prev    next >
Encoding:
Text File  |  1993-08-11  |  72.4 KB  |  1,735 lines

  1. Newsgroups: comp.sources.misc
  2. From: jeff@joyce.cs.su.oz.au (Jeff Kingston)
  3. Subject: v38i075:  lout - Lout document formatting system, v2.05, Part07/35
  4. Message-ID: <1993Aug8.180734.11487@sparky.sterling.com>
  5. X-Md4-Signature: c405c80b03104d544f8611d2f2bef066
  6. Sender: kent@sparky.sterling.com (Kent Landfield)
  7. Organization: Sterling Software
  8. Date: Sun, 8 Aug 1993 18:07:34 GMT
  9. Approved: kent@sparky.sterling.com
  10.  
  11. Submitted-by: jeff@joyce.cs.su.oz.au (Jeff Kingston)
  12. Posting-number: Volume 38, Issue 75
  13. Archive-name: lout/part07
  14. Environment: UNIX
  15. Supersedes: lout: Volume 37, Issue 99-128
  16.  
  17. #! /bin/sh
  18. # This is a shell archive.  Remove anything before this line, then feed it
  19. # into a shell via "sh file" or similar.  To overwrite existing files,
  20. # type "sh file -c".
  21. # Contents:  doc/tr.over/s2 z03.c z36.c
  22. # Wrapped by kent@sparky on Sun Aug  8 12:29:22 1993
  23. PATH=/bin:/usr/bin:/usr/ucb:/usr/local/bin:/usr/lbin ; export PATH
  24. echo If this archive is complete, you will see the following message:
  25. echo '          "shar: End of archive 7 (of 35)."'
  26. if test -f 'doc/tr.over/s2' -a "${1}" != "-c" ; then 
  27.   echo shar: Will not clobber existing file \"'doc/tr.over/s2'\"
  28. else
  29.   echo shar: Extracting \"'doc/tr.over/s2'\" \(1739 characters\)
  30.   sed "s/^X//" >'doc/tr.over/s2' <<'END_OF_FILE'
  31. X@Section
  32. X   @Title { The non-expert's view }
  33. X@Begin
  34. X@PP
  35. XThe non-expert user perceives Lout as text interspersed with special
  36. Xsymbols, in a style reminiscent of many other batch formatters:
  37. X@ID @Code {
  38. X"@Doc @Text @Begin"
  39. X"@Heading { Standard Integrals }"
  40. X"@PP"
  41. X"The following list of standard"
  42. X"integrals should be memorized:"
  43. X"@NumberList"
  44. X"@Item @Eq {int e sup x dx = e sup x}"
  45. X"@Item @Eq {int dx over"
  46. X"   sqrt { 1 - x sup 2 } = arc sin x}"
  47. X"@EndList"
  48. X"@End @Text"
  49. X}
  50. XBraces are used for grouping parameters to the features.  The symbols
  51. Xare all taken from two of the standard packages:  DocumentLayout, which
  52. Xprovides headings, paragraphs, lists, footnotes, sections, and so on,
  53. Xand Eq, which provides mathematical typesetting in a style copied from
  54. Xthe eqn language of Kernighan and Cherry [{@Ref kernighan75}].
  55. X@PP
  56. XAt the time of writing, packages exist for formatting general documents,
  57. Xtechnical reports, and books, the latter providing an automatic table of
  58. Xcontents, running page headers and footers, access to bibliographic
  59. Xdatabases, and a sorted index, among many other features.  Specialized
  60. Xpackages exist for mathematical typesetting, drawing figures, and
  61. Xformatting Pascal programs.
  62. X@PP
  63. XThe advanced features maintain the simple style established above.  To
  64. Xproduce a footnote, for example, one simply types
  65. X@ID @Code "@FootNote { ... }"
  66. Xat the appropriate point, and it will be numbered and placed at the
  67. Xbottom of the page; to add an item to the index,
  68. X@ID @Code "expert @Index { Expert user }"
  69. Xis typed, and the right parameter will appear in the index, with a page
  70. Xnumber, at a place determined by the alphabetical ranking of the left
  71. Xparameter.  No technical knowledge is required to use these features.
  72. X@End @Section
  73. END_OF_FILE
  74.   if test 1739 -ne `wc -c <'doc/tr.over/s2'`; then
  75.     echo shar: \"'doc/tr.over/s2'\" unpacked with wrong size!
  76.   fi
  77.   # end of 'doc/tr.over/s2'
  78. fi
  79. if test -f 'z03.c' -a "${1}" != "-c" ; then 
  80.   echo shar: Will not clobber existing file \"'z03.c'\"
  81. else
  82.   echo shar: Extracting \"'z03.c'\" \(37186 characters\)
  83.   sed "s/^X//" >'z03.c' <<'END_OF_FILE'
  84. X/*@z03.c:File Service:Declarations, no_fpos@******************************** */
  85. X/*                                                                           */
  86. X/*  LOUT: A HIGH-LEVEL LANGUAGE FOR DOCUMENT FORMATTING (VERSION 2.05)       */
  87. X/*  COPYRIGHT (C) 1993 Jeffrey H. Kingston                                   */
  88. X/*                                                                           */
  89. X/*  Jeffrey H. Kingston (jeff@cs.su.oz.au)                                   */
  90. X/*  Basser Department of Computer Science                                    */
  91. X/*  The University of Sydney 2006                                            */
  92. X/*  AUSTRALIA                                                                */
  93. X/*                                                                           */
  94. X/*  This program is free software; you can redistribute it and/or modify     */
  95. X/*  it under the terms of the GNU General Public License as published by     */
  96. X/*  the Free Software Foundation; either version 1, or (at your option)      */
  97. X/*  any later version.                                                       */
  98. X/*                                                                           */
  99. X/*  This program is distributed in the hope that it will be useful,          */
  100. X/*  but WITHOUT ANY WARRANTY; without even the implied warranty of           */
  101. X/*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the            */
  102. X/*  GNU General Public License for more details.                             */
  103. X/*                                                                           */
  104. X/*  You should have received a copy of the GNU General Public License        */
  105. X/*  along with this program; if not, write to the Free Software              */
  106. X/*  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.                */
  107. X/*                                                                           */
  108. X/*  FILE:         z03.c                                                      */
  109. X/*  MODULE:       File Service                                               */
  110. X/*  EXTERNS:      InitFiles(), AddToPath(), DefineFile(), FirstFile(),       */
  111. X/*                NextFile(), FileNum(), FileName(), EchoFilePos(),          */
  112. X/*                PosOfFile(), OpenFile(), OpenIncGraphicFile(),             */
  113. X/*                ReadFromFile(), AppendToFile(), CloseFiles()               */
  114. X/*                                                                           */
  115. X/*****************************************************************************/
  116. X#include "externs"
  117. X#define MAX_TYPES     10            /* number of file types      */
  118. X#define MAX_PATHS      7            /* number of search paths    */
  119. X#define    TAB_MASK    0xFF            /* mask forces <= MAX_FILES  */
  120. X
  121. X#define    file_number(x)    word_font(x)        /* file number of file x     */
  122. X#define    updated(x)    broken(x)        /* TRUE when x is updated    */
  123. X#define    path(x)        back(x, COL)        /* search path for file x    */
  124. X
  125. Xstatic    int    file_count;            /* total number of files     */
  126. Xstatic    OBJECT    fvec[MAX_FILES] = { nil };    /* the file table            */
  127. Xstatic    OBJECT    file_list[MAX_TYPES];        /* files of each type        */
  128. Xstatic    OBJECT    file_path[MAX_PATHS];        /* the search paths          */
  129. X#if DEBUG_ON
  130. Xstatic    char    *file_types[]        /* the type names for debug  */
  131. X        = { "source", "include", "incgraphic", "database", "index",
  132. X            "font", "prepend", "hyph", "hyphpacked", "encoding" };
  133. X#endif
  134. X
  135. X
  136. X/*****************************************************************************/
  137. X/*                                                                           */
  138. X/*  no_fpos                                                                  */
  139. X/*                                                                           */
  140. X/*  A null file position value.                                              */
  141. X/*                                                                           */
  142. X/*****************************************************************************/
  143. X
  144. Xstatic FILE_POS no_file_pos = {0, 0, 0};
  145. XFILE_POS *no_fpos = &no_file_pos;
  146. X
  147. X/*****************************************************************************/
  148. X/*                                                                           */
  149. X/*  #define hash(str, val)                                                   */
  150. X/*                                                                           */
  151. X/*  Hash the string str and return its value in val.                         */
  152. X/*                                                                           */
  153. X/*****************************************************************************/
  154. X
  155. X#define hash(str, val)                            \
  156. X{ p = str;                                \
  157. X  val = *p++;                                \
  158. X  while( *p ) val += *p++;                        \
  159. X  val = (val * 8) & TAB_MASK;                        \
  160. X}
  161. X
  162. X/*@::InitFiles(), AddToPath(), DefineFile()@**********************************/
  163. X/*                                                                           */
  164. X/*  InitFiles()                                                              */
  165. X/*                                                                           */
  166. X/*  Initialize this module.                                                  */
  167. X/*                                                                           */
  168. X/*****************************************************************************/
  169. X
  170. XInitFiles()
  171. X{ int i;
  172. X  for( i = 0;  i < MAX_TYPES; i++ )  file_list[i]  = New(ACAT);
  173. X  for( i = 0;  i < MAX_PATHS; i++ )  file_path[i] = New(ACAT);
  174. X  fvec[0] = file_list[0];    /* so that no files will be given slot 0 */
  175. X  file_count = 1;
  176. X} /* end InitFiles */
  177. X
  178. X
  179. X/*****************************************************************************/
  180. X/*                                                                           */
  181. X/*  AddToPath(fpath, dirname)                                                */
  182. X/*                                                                           */
  183. X/*  Add the directory dirname to the end of search path fpath.               */
  184. X/*                                                                           */
  185. X/*****************************************************************************/
  186. X
  187. XAddToPath(fpath, dirname)
  188. Xint fpath; FULL_CHAR *dirname;
  189. X{ OBJECT x;
  190. X  x = MakeWord(WORD, dirname, no_fpos);
  191. X  Link(file_path[fpath], x);
  192. X} /* end AddToPath */
  193. X
  194. X
  195. X/*****************************************************************************/
  196. X/*                                                                           */
  197. X/*  FILE_NUM DefineFile(str, suffix, xfpos, ftype, fpath)                    */
  198. X/*                                                                           */
  199. X/*  Declare a file whose name is str plus suffix and whose fpos is xfpos.    */
  200. X/*  The file type is ftype, and its search path is fpath.                    */
  201. X/*                                                                           */
  202. X/*****************************************************************************/
  203. X
  204. XFILE_NUM DefineFile(str, suffix, xfpos, ftype, fpath)
  205. XFULL_CHAR *str, *suffix; FILE_POS *xfpos;  int ftype, fpath;
  206. X{ register FULL_CHAR *p;
  207. X  register int i;
  208. X  assert( ftype < MAX_TYPES, "DefineFile: ftype!" );
  209. X  debug5(DFS, D, "DefineFile(%s, %s,%s, %s, %d)",
  210. X    str, suffix, EchoFilePos(xfpos), file_types[ftype], fpath);
  211. X  if( ftype == SOURCE_FILE && (i = StringLength(str)) >= 3 )
  212. X  {
  213. X    /* check that file name does not end in ".li" or ".ld" */
  214. X    if( StringEqual(&str[i-StringLength(DATA_SUFFIX)], DATA_SUFFIX) )
  215. X      Error(FATAL, xfpos,
  216. X    "database file %s where source file expected", str);
  217. X    if( StringEqual(&str[i-StringLength(INDEX_SUFFIX)], INDEX_SUFFIX) )
  218. X      Error(FATAL, xfpos,
  219. X    "database index file %s where source file expected", str);
  220. X  }
  221. X  if( ++file_count >= MAX_FILES ) Error(FATAL, xfpos, "too many file names");
  222. X  hash(str, i);
  223. X  while( fvec[i] != nil )
  224. X    if( ++i >= MAX_FILES ) i = 0;
  225. X  if( StringLength(str) + StringLength(suffix) >= MAX_LINE )
  226. X    Error(FATAL, no_fpos, "file name %s%s too long", str, suffix);
  227. X  fvec[i] = MakeWordTwo(WORD, str, suffix, xfpos);
  228. X  Link(file_list[ftype], fvec[i]);
  229. X  file_number(fvec[i]) = i;
  230. X  path(fvec[i]) = fpath;
  231. X  debug1(DFS, D, "DefineFile returning %s",
  232. X    i == NO_FILE ? STR_NONE : FileName( (FILE_NUM) i));
  233. X  return (FILE_NUM) i;
  234. X} /* end DefineFile */
  235. X
  236. X
  237. X/*@::FirstFile(), NextFile(), FileNum()@**************************************/
  238. X/*                                                                           */
  239. X/*  FILE_NUM FirstFile(ftype)                                                */
  240. X/*                                                                           */
  241. X/*  Returns first file of type ftype, else NO_FILE.                          */
  242. X/*                                                                           */
  243. X/*****************************************************************************/
  244. X
  245. XFILE_NUM FirstFile(ftype)
  246. Xint ftype;
  247. X{ FILE_NUM i;
  248. X  OBJECT link, y;
  249. X  debug1(DFS, D, "FirstFile( %s )", file_types[ftype]);
  250. X  link = Down(file_list[ftype]);
  251. X  if( type(link) == ACAT )  i = NO_FILE;
  252. X  else
  253. X  { Child(y, link);
  254. X    i = file_number(y);
  255. X  }
  256. X  debug1(DFS, D, "FirstFile returning %s", i==NO_FILE ? STR_NONE : FileName(i));
  257. X  return i;
  258. X} /* end FirstFile */
  259. X
  260. X
  261. X/*****************************************************************************/
  262. X/*                                                                           */
  263. X/*  FILE_NUM NextFile(i)                                                     */
  264. X/*                                                                           */
  265. X/*  Returns the next file after file i of the type of i, else NO_FILE.       */
  266. X/*                                                                           */
  267. X/*****************************************************************************/
  268. X
  269. XFILE_NUM NextFile(i)
  270. XFILE_NUM i;
  271. X{ OBJECT link, y;
  272. X  debug1(DFS, D, "NextFile( %s )", EchoObject(fvec[i]));
  273. X  link = NextDown(Up(fvec[i]));
  274. X  if( type(link) == ACAT )  i = NO_FILE;
  275. X  else
  276. X  { Child(y, link);
  277. X    i = file_number(y);
  278. X  }
  279. X  debug1(DFS, D, "NextFile returning %s", i==NO_FILE ? STR_NONE : FileName(i));
  280. X  return i;
  281. X} /* end NextFile */
  282. X
  283. X
  284. X/*****************************************************************************/
  285. X/*                                                                           */
  286. X/*  FILE_NUM FileNum(str, suffix)                                            */
  287. X/*                                                                           */
  288. X/*  Return the number of the file with name str plus suffix, else NO_FILE.   */
  289. X/*                                                                           */
  290. X/*****************************************************************************/
  291. X
  292. XFILE_NUM FileNum(str, suffix)
  293. XFULL_CHAR *str, *suffix;
  294. X{ register FULL_CHAR *p;
  295. X  register int i;
  296. X  FULL_CHAR buff[MAX_LINE];
  297. X  debug2(DFS, D, "FileNum(%s, %s)", str, suffix);
  298. X  hash(str, i);
  299. X  if( StringLength(str) + StringLength(suffix) >= MAX_LINE )
  300. X    Error(FATAL, no_fpos, "file name %s%s too long", str, suffix);
  301. X  StringCopy(buff, str);
  302. X  StringCat(buff, suffix);
  303. X  while( fvec[i] != nil && !StringEqual(string(fvec[i]), buff) )
  304. X    if( ++i >= MAX_FILES ) i = 0;
  305. X  if( fvec[i] == nil ) i = 0;
  306. X  debug1(DFS, D, "FileNum returning %s",
  307. X    i == NO_FILE ? STR_NONE : FileName( (FILE_NUM) i));
  308. X  return (FILE_NUM) i;
  309. X} /* end FileNum */
  310. X
  311. X
  312. X/*@::FileName(), EchoFilePos(), PosOfFile()@**********************************/
  313. X/*                                                                           */
  314. X/*  FULL_CHAR *FileName(fnum)                                                */
  315. X/*                                                                           */
  316. X/*  Return the string name of this file.  This is as given to DefineFile     */
  317. X/*  until OpenFile is called, after which it is the full path name.          */
  318. X/*                                                                           */
  319. X/*****************************************************************************/
  320. X
  321. XFULL_CHAR *FileName(fnum)
  322. XFILE_NUM fnum;
  323. X{ OBJECT x;
  324. X  assert( fnum > 0 && fvec[fnum] != nil, "FileName: fvec[fnum] == nil!" );
  325. X  x = fvec[fnum];  if( Down(x) != x )  Child(x, Down(x));
  326. X  return string(x);
  327. X} /* end FileName */
  328. X
  329. X
  330. X/*****************************************************************************/
  331. X/*                                                                           */
  332. X/*  FULL_CHAR *EchoFilePos(pos)                                              */
  333. X/*                                                                           */
  334. X/*  Returns a string reporting the value of file position pos.               */
  335. X/*                                                                           */
  336. X/*****************************************************************************/
  337. X
  338. Xstatic FULL_CHAR buff[2][MAX_LINE];  static bp = 1;
  339. X
  340. Xstatic append_fpos(pos)
  341. XFILE_POS *pos;
  342. X{ OBJECT x;
  343. X  x = fvec[file_num(*pos)];
  344. X  assert( x != nil, "EchoFilePos: fvec[] entry is nil!" );
  345. X  if( file_num(fpos(x)) > 0 )
  346. X  { append_fpos( &fpos(x) );
  347. X    if( StringLength(buff[bp]) + 2 >= MAX_LINE )
  348. X      Error(FATAL,no_fpos,"file position %s... is too long to print", buff[bp]);
  349. X    StringCat(buff[bp], STR_SPACE);
  350. X    StringCat(buff[bp], AsciiToFull("/"));
  351. X  }
  352. X  if( StringLength(buff[bp]) + StringLength(string(x)) + 13 >= MAX_LINE )
  353. X    Error(FATAL, no_fpos, "file position %s... is too long to print", buff[bp]);
  354. X  StringCat(buff[bp], STR_SPACE);
  355. X  StringCat(buff[bp], STR_QUOTE);
  356. X  StringCat(buff[bp], string(x));
  357. X  StringCat(buff[bp], STR_QUOTE);
  358. X  if( line_num(*pos) != 0 )
  359. X  { StringCat(buff[bp], STR_SPACE);
  360. X    StringCat(buff[bp], StringInt(line_num(*pos)));
  361. X    StringCat(buff[bp], AsciiToFull(","));
  362. X    StringCat(buff[bp], StringInt( (int) col_num(*pos)));
  363. X  }
  364. X} /* end append_fpos */
  365. X
  366. XFULL_CHAR *EchoFilePos(pos)
  367. XFILE_POS *pos;
  368. X{ bp = (bp + 1) % 2;
  369. X  StringCopy(buff[bp], STR_EMPTY);
  370. X  if( file_num(*pos) > 0 )  append_fpos(pos);
  371. X  return buff[bp];
  372. X} /* end EchoFilePos */
  373. X
  374. X
  375. X/*****************************************************************************/
  376. X/*                                                                           */
  377. X/*  FILE_POS *PosOfFile(fnum)                                                */
  378. X/*                                                                           */
  379. X/*  Returns a pointer to the file position where file fnum was encountered.  */
  380. X/*                                                                           */
  381. X/*****************************************************************************/
  382. X
  383. XFILE_POS *PosOfFile(fnum)
  384. XFILE_NUM fnum;
  385. X{ OBJECT  x = fvec[fnum];
  386. X  assert( x != nil, "PosOfFile: fvec[] entry is nil!" );
  387. X  return &fpos(x);
  388. X}
  389. X
  390. X/*@::SearchPath()@************************************************************/
  391. X/*                                                                           */
  392. X/*  static FILE *SearchPath(str, fpath, check_ld, check_lt, full_name, xfpos)*/
  393. X/*                                                                           */
  394. X/*  Search the given path for a file whose name is str.  If found, open      */
  395. X/*  it; return the resulting FILE *.                                         */
  396. X/*                                                                           */
  397. X/*  If check_ld is TRUE, it means that the file to be opened is a .li file   */
  398. X/*  and OpenFile() is required to check whether the corresponding .ld file   */
  399. X/*  is present.  If it is, then the search must stop.                        */
  400. X/*                                                                           */
  401. X/*  If check_lt is TRUE, it means that the file to be opened is a source     */
  402. X/*  file and OpenFile() is required to check for a .lt suffix version if     */
  403. X/*  the file does not open.                                                  */
  404. X/*                                                                           */
  405. X/*  Also return the full path name in object *full_name if reqd, else nil.   */
  406. X/*                                                                           */
  407. X/*****************************************************************************/
  408. X
  409. Xstatic FILE *SearchPath(str, fpath, check_ld, check_lt, full_name, xfpos)
  410. XFULL_CHAR *str;  OBJECT fpath;  BOOLEAN check_ld, check_lt;
  411. XOBJECT *full_name;  FILE_POS *xfpos;
  412. X{ 
  413. X  FULL_CHAR buff[MAX_LINE];  OBJECT link, y;  FILE *fp;
  414. X  debug4(DFS, DD, "SearchPath(%s, %s, %s, %s, -)", str, EchoObject(fpath),
  415. X    bool(check_ld), bool(check_lt));
  416. X  *full_name = nil;
  417. X  if( StringEqual(str, STR_STDIN) )
  418. X  { fp = stdin;
  419. X    debug0(DFS, DD, "  opened stdin");
  420. X  }
  421. X  else if( StringBeginsWith(str, AsciiToFull("/")) )
  422. X  { fp = StringFOpen(str, "r");
  423. X    debug1(DFS, DD, fp==null ? "  failed on %s" : "  succeeded on %s", str);
  424. X  }
  425. X  else
  426. X  { fp = null;
  427. X    for( link = Down(fpath);  fp==null && link != fpath; link = NextDown(link) )
  428. X    { Child(y, link);
  429. X      if( StringLength(string(y)) == 0 )
  430. X      { StringCopy(buff, str);
  431. X    fp = StringFOpen(str, "r");
  432. X    debug1(DFS, DD, fp==null ? "  failed on %s" : "  succeeded on %s", str);
  433. X      }
  434. X      else
  435. X      {    if( StringLength(string(y)) + 1 + StringLength(str) >= MAX_LINE )
  436. X      Error(FATAL, &fpos(y), "file path name %s/%s is too long",
  437. X        string(y), str);
  438. X    StringCopy(buff, string(y));
  439. X    StringCat(buff, AsciiToFull("/"));
  440. X    StringCat(buff, str);
  441. X    fp = StringFOpen(buff, "r");
  442. X    debug1(DFS, DD, fp==null ? "  failed on %s" : "  succeeded on %s",buff);
  443. X    if( fp != null ) *full_name = MakeWord(WORD, buff, xfpos);
  444. X      }
  445. X      if( fp == null && check_ld )
  446. X      {    StringCopy(&buff[StringLength(buff) - StringLength(INDEX_SUFFIX)],
  447. X      DATA_SUFFIX);
  448. X    fp = StringFOpen(buff, "r");
  449. X    debug1(DFS,DD,fp==null ? "  failed on %s" : "  succeeded on %s", buff);
  450. X    if( fp != null )
  451. X    { fclose(fp);
  452. X      debug0(DFS, D, "SearchPath returning null (adjacent .ld file)");
  453. X      return null;
  454. X    }
  455. X      }
  456. X      if( fp == null && check_lt )
  457. X      {    StringCopy(&buff[StringLength(buff)], SOURCE_SUFFIX);
  458. X    fp = StringFOpen(buff, "r");
  459. X    debug1(DFS,DD,fp==null ? "  failed on %s" : "  succeeded on %s", buff);
  460. X    StringCopy(&buff[StringLength(buff) - StringLength(SOURCE_SUFFIX)], STR_EMPTY);
  461. X    if( fp != null ) *full_name = MakeWord(WORD, buff, xfpos);
  462. X      }
  463. X    }
  464. X  }
  465. X  debug1(DFS, DD, "SearchPath returning (fp %s null)", fp==null ? "==" : "!=");
  466. X  return fp;
  467. X} /* end SearchPath */
  468. X
  469. X
  470. X/*@::OpenFile(), OpenIncGraphicFile()@****************************************/
  471. X/*                                                                           */
  472. X/*  FILE *OpenFile(fnum, check_ld, check_lt)                                 */
  473. X/*                                                                           */
  474. X/*  Open for reading the file whose number is fnum.  This involves           */
  475. X/*  searching for it along its path if not previously opened.                */
  476. X/*                                                                           */
  477. X/*  If check_ld is TRUE, it means that the file to be opened is a .li file   */
  478. X/*  and OpenFile() is required to check whether the corresponding .ld file   */
  479. X/*  is present.  If it is, then the search must stop.                        */
  480. X/*                                                                           */
  481. X/*  If check_lt is TRUE, it means that the file to be opened is a source     */
  482. X/*  file and OpenFile() is required to check for a .lout suffix version      */
  483. X/*  if the file does not open without it.                                    */
  484. X/*                                                                           */
  485. X/*****************************************************************************/
  486. X
  487. XFILE *OpenFile(fnum, check_ld, check_lt)
  488. XFILE_NUM fnum;  BOOLEAN check_ld, check_lt;
  489. X{ FILE *fp;  OBJECT full_name, y;
  490. X  ifdebug(DPP, D, ProfileOn("OpenFile"));
  491. X  debug2(DFS, D, "OpenFile(%s, %s)", FileName(fnum), bool(check_ld));
  492. X  if( Down(fvec[fnum]) != fvec[fnum] )
  493. X  { Child(y, Down(fvec[fnum]));
  494. X    fp = StringFOpen(string(y), "r");
  495. X    debug1(DFS,DD,fp==null ? "  failed on %s" : "  succeeded on %s", string(y));
  496. X  }
  497. X  else
  498. X  { fp = SearchPath(string(fvec[fnum]), file_path[path(fvec[fnum])],
  499. X       check_ld, check_lt, &full_name, &fpos(fvec[fnum]));
  500. X    if( full_name != nil )  Link(fvec[fnum], full_name);
  501. X  }
  502. X  ifdebug(DPP, D, ProfileOff("OpenFile"));
  503. X  debug1(DFS, D, "OpenFile returning (fp %s null)", fp==null ? "==" : "!=");
  504. X  return fp;
  505. X} /* end OpenFile */
  506. X
  507. X
  508. X/*****************************************************************************/
  509. X/*                                                                           */
  510. X/*  FILE *OpenIncGraphicFile(str, typ, full_name, xfpos)                     */
  511. X/*                                                                           */
  512. X/*  Open for reading the @IncludeGraphic file str; typ is INCGRAPHIC or      */
  513. X/*  SINCGRAPHIC.  Return the full name in full_name.                         */
  514. X/*                                                                           */
  515. X/*****************************************************************************/
  516. X
  517. XFILE *OpenIncGraphicFile(str, typ, full_name, xfpos)
  518. XFULL_CHAR *str;  unsigned char typ;  OBJECT *full_name;  FILE_POS *xfpos;
  519. X{ FILE *fp;  int p;
  520. X  debug2(DFS, D, "OpenIncGraphicFile(%s, %s, -)", str, Image(typ));
  521. X  assert( typ == INCGRAPHIC || typ == SINCGRAPHIC, "OpenIncGraphicFile!" );
  522. X  p = (typ == INCGRAPHIC ? INCLUDE_PATH : SYSINCLUDE_PATH);
  523. X  fp = SearchPath(str, file_path[p], FALSE, FALSE, full_name, xfpos);
  524. X  if( *full_name == nil )  *full_name = MakeWord(WORD, str, xfpos);
  525. X  debug2(DFS, D, "OpenIncGraphicFile returning (fp %s null, *full_name = %s)",
  526. X    fp==null ? "==" : "!=", string(*full_name));
  527. X  return fp;
  528. X} /* end OpenIncGraphicFile */
  529. X
  530. X
  531. X/*@::ReadFromFile()@**********************************************************/
  532. X/*                                                                           */
  533. X/*  OBJECT ReadFromFile(fnum, pos, sym)                                      */
  534. X/*                                                                           */
  535. X/*  Read an object from file fnum starting at position pos.                  */
  536. X/*  The object may include @Env operators defining its environment.          */
  537. X/*  If sym != nil, sym is the symbol which is to be read in.                 */
  538. X/*                                                                           */
  539. X/*****************************************************************************/
  540. X
  541. XOBJECT ReadFromFile(fnum, pos, sym)
  542. XFILE_NUM fnum; long pos;  OBJECT sym;
  543. X{ OBJECT t, res; int ipos;
  544. X  ifdebug(DPP, D, ProfileOn("ReadFromFile"));
  545. X  ifdebug(DFS, D, ipos = (int) pos);
  546. X  debug3(DFS, D, "ReadFromFile(%s, %d, %s)", FileName(fnum), ipos,SymName(sym));
  547. X  LexPush(fnum, (int) pos, DATABASE_FILE);
  548. X  SwitchScope(sym);
  549. X  t = LexGetToken();
  550. X  if( type(t) != LBR )
  551. X  { debug1(DFS, D, "  following because type(t) = %s", Image(type(t)));
  552. X    Error(FATAL, &fpos(t),"syntax error (missing %s) in database file", KW_LBR);
  553. X  }
  554. X  res = Parse(&t, StartSym, FALSE, FALSE);
  555. X  if( t != nil || type(res) != CLOSURE )
  556. X  { debug1(DFS, D, "  following because of %s", t != nil ? "t" : "type(res)");
  557. X    Error(FATAL, &fpos(res), "syntax error in database file");
  558. X  }
  559. X  UnSwitchScope(sym);
  560. X  LexPop();
  561. X  debug1(DFS, D, "ReadFromFile returning %s", EchoObject(res));
  562. X  ifdebug(DPP, D, ProfileOff("ReadFromFile"));
  563. X  return res;
  564. X} /* end ReadFromFile */
  565. X
  566. X
  567. Xstatic FILE_NUM    last_write_fnum = NO_FILE;
  568. Xstatic FILE    *last_write_fp  = null;
  569. X
  570. X
  571. X/*@::WriteClosure()@**********************************************************/
  572. X/*                                                                           */
  573. X/*  static WriteClosure(x)                                                   */
  574. X/*                                                                           */
  575. X/*  Write closure x to file last_write_fp, without enclosing braces and      */
  576. X/*  without any environment attached.                                        */
  577. X/*                                                                           */
  578. X/*****************************************************************************/
  579. X
  580. Xstatic BOOLEAN need_lvis(sym)        /* true if @LVis needed before sym */
  581. XOBJECT sym;
  582. X{ return !visible(sym) &&
  583. X     enclosing(sym) != StartSym &&
  584. X     type(enclosing(sym)) == LOCAL;
  585. X} /* end need_lvis */
  586. X
  587. Xstatic WriteClosure(x)
  588. XOBJECT x;
  589. X{ OBJECT y, link, z, sym;
  590. X  BOOLEAN npar_seen, name_printed;
  591. X  static WriteObject();
  592. X
  593. X  sym = actual(x);  npar_seen = FALSE;  name_printed = FALSE;
  594. X  for( link = Down(x);  link != x;  link = NextDown(link) )
  595. X  { Child(y, link);
  596. X    if( type(y) == PAR )  switch( type(actual(y)) )
  597. X    {
  598. X      case LPAR:
  599. X      
  600. X    assert( Down(y) != y, "WriteObject/CLOSURE: LPAR!" );
  601. X    Child(z, Down(y));
  602. X    WriteObject(z, (int) precedence(sym));
  603. X    StringFPuts(STR_SPACE, last_write_fp);
  604. X    break;
  605. X
  606. X
  607. X      case NPAR:
  608. X      
  609. X    assert( Down(y) != y, "WriteObject/CLOSURE: NPAR!" );
  610. X    Child(z, Down(y));
  611. X    if( !name_printed )
  612. X    { if( need_lvis(sym) )
  613. X      { StringFPuts(KW_LVIS, last_write_fp);
  614. X        StringFPuts(STR_SPACE, last_write_fp);
  615. X      }
  616. X      StringFPuts(SymName(sym), last_write_fp);
  617. X      name_printed = TRUE;
  618. X    }
  619. X    StringFPuts(STR_NEWLINE, last_write_fp);
  620. X    StringFPuts(STR_SPACE, last_write_fp);
  621. X    StringFPuts(STR_SPACE, last_write_fp);
  622. X    StringFPuts(STR_SPACE, last_write_fp);
  623. X    StringFPuts(SymName(actual(y)), last_write_fp);
  624. X    StringFPuts(STR_SPACE, last_write_fp);
  625. X    StringFPuts(KW_LBR, last_write_fp);
  626. X    StringFPuts(STR_SPACE, last_write_fp);
  627. X    WriteObject(z, NO_PREC);
  628. X    StringFPuts(STR_SPACE, last_write_fp);
  629. X    StringFPuts(KW_RBR, last_write_fp);
  630. X    npar_seen = TRUE;
  631. X    break;
  632. X
  633. X
  634. X      case RPAR:
  635. X      
  636. X    assert( Down(y) != y, "WriteObject/CLOSURE: RPAR!" );
  637. X    Child(z, Down(y));
  638. X    if( !name_printed )
  639. X    { if( need_lvis(sym) )
  640. X      { StringFPuts(KW_LVIS, last_write_fp);
  641. X        StringFPuts(STR_SPACE, last_write_fp);
  642. X      }
  643. X      StringFPuts(SymName(sym), last_write_fp);
  644. X      name_printed = TRUE;
  645. X    }
  646. X    StringFPuts(npar_seen ? STR_NEWLINE : STR_SPACE, last_write_fp);
  647. X    if( has_body(sym) )
  648. X    {
  649. X      StringFPuts(KW_LBR, last_write_fp);
  650. X      StringFPuts(STR_SPACE, last_write_fp);
  651. X      WriteObject(z, NO_PREC);
  652. X      StringFPuts(STR_SPACE, last_write_fp);
  653. X      StringFPuts(KW_RBR, last_write_fp);
  654. X    }
  655. X    else WriteObject(z, (int) precedence(sym));
  656. X    break;
  657. X
  658. X
  659. X      default:
  660. X      
  661. X    Error(INTERN, &fpos(y), "WriteClosure: %s", Image(type(actual(y))) );
  662. X    break;
  663. X
  664. X    } /* end switch */
  665. X  } /* end for each parameter */
  666. X  if( !name_printed )
  667. X  { if( need_lvis(sym) )
  668. X    { StringFPuts(KW_LVIS, last_write_fp);
  669. X      StringFPuts(STR_SPACE, last_write_fp);
  670. X    }
  671. X    StringFPuts(SymName(sym), last_write_fp);
  672. X    name_printed = TRUE;
  673. X  }
  674. X} /* end WriteClosure */
  675. X
  676. X
  677. X/*@::WriteObject()@***********************************************************/
  678. X/*                                                                           */
  679. X/*  static WriteObject(x, outer_prec)                                        */
  680. X/*                                                                           */
  681. X/*  Write object x to file last_write_fp, assuming it is a subobject of an   */
  682. X/*  object and the precedence of operators enclosing it is outer_prec.       */
  683. X/*                                                                           */
  684. X/*****************************************************************************/
  685. X
  686. Xstatic WriteObject(x, outer_prec)
  687. XOBJECT x;  int outer_prec;
  688. X{ OBJECT link, y, gap_obj, sym, env;  FULL_CHAR *name;
  689. X  int prec, i, last_prec;  BOOLEAN braces_needed;
  690. X  switch( type(x) )
  691. X  {
  692. X
  693. X    case WORD:
  694. X
  695. X      if( StringLength(string(x)) == 0 && outer_prec > ACAT_PREC )
  696. X      { StringFPuts(KW_LBR, last_write_fp);
  697. X    StringFPuts(KW_RBR, last_write_fp);
  698. X      }
  699. X      else StringFPuts(string(x), last_write_fp);
  700. X      break;
  701. X
  702. X    
  703. X    case QWORD:
  704. X
  705. X      StringFPuts(StringQuotedWord(x), last_write_fp);
  706. X      break;
  707. X
  708. X    
  709. X    case VCAT:  prec = VCAT_PREC;  goto ETC;
  710. X    case HCAT:  prec = HCAT_PREC;  goto ETC;
  711. X    case ACAT:  prec = ACAT_PREC;  goto ETC;
  712. X
  713. X      ETC:
  714. X      if( prec < outer_prec )  StringFPuts(KW_LBR, last_write_fp);
  715. X      last_prec = prec;
  716. X      for( link = Down(x);  link != x;  link = NextDown(link) )
  717. X      {    Child(y, link);
  718. X    if( type(y) == GAP_OBJ )
  719. X    { if( Down(y) == y )
  720. X      { assert( type(x) == ACAT, "WriteObject: Down(y) == y!" );
  721. X        for( i = 1;  i <= vspace(y);  i++ )
  722. X          StringFPuts(STR_NEWLINE, last_write_fp);
  723. X        for( i = 1;  i <= hspace(y);  i++ )
  724. X          StringFPuts(STR_SPACE,  last_write_fp);
  725. X        last_prec = (vspace(y) + hspace(y) == 0) ? JUXTA_PREC : ACAT_PREC;
  726. X      }
  727. X      else
  728. X      { Child(gap_obj, Down(y));
  729. X        StringFPuts(type(x)==ACAT ? STR_SPACE : STR_NEWLINE, last_write_fp);
  730. X        StringFPuts(EchoCatOp(type(x), mark(gap(y)), join(gap(y))),
  731. X          last_write_fp);
  732. X        if( !is_word(type(gap_obj)) || StringLength(string(gap_obj)) != 0 )
  733. X        WriteObject(gap_obj, FORCE_PREC);
  734. X        StringFPuts(STR_SPACE, last_write_fp);
  735. X        last_prec = prec;
  736. X      }
  737. X    }
  738. X    else
  739. X    { if( type(x) == ACAT )
  740. X      { OBJECT next_gap;  int next_prec;
  741. X        if( NextDown(link) != x )
  742. X        { Child(next_gap, NextDown(link));
  743. X          assert( type(next_gap) == GAP_OBJ, "WriteObject: next_gap!" );
  744. X          next_prec = (vspace(next_gap) + hspace(next_gap) == 0)
  745. X                ? JUXTA_PREC : ACAT_PREC;
  746. X        }
  747. X        else next_prec = prec;
  748. X        WriteObject(y, max(last_prec, next_prec));
  749. X      }
  750. X      else WriteObject(y, prec);
  751. X    }
  752. X      }
  753. X      if( prec < outer_prec )  StringFPuts(KW_RBR, last_write_fp);
  754. X      break;
  755. X
  756. X
  757. X    case ENV:
  758. X
  759. X      if( Down(x) == x )
  760. X      { /* do nothing */
  761. X      }
  762. X      else if( Down(x) == LastDown(x) )
  763. X      {    Child(y, Down(x));
  764. X    assert( type(y) == CLOSURE, "WriteObject: ENV/CLOSURE!" );
  765. X    assert( LastDown(y) != y, "WriteObject: ENV/LastDown(y)!" );
  766. X    Child(env, LastDown(y));
  767. X    assert( type(env) == ENV, "WriteObject: ENV/env!" );
  768. X    WriteObject(env, NO_PREC);
  769. X    StringFPuts(KW_LBR, last_write_fp);
  770. X    WriteClosure(y);
  771. X    StringFPuts(KW_RBR, last_write_fp);
  772. X    StringFPuts(STR_NEWLINE, last_write_fp);
  773. X      }
  774. X      else
  775. X      {    Child(env, LastDown(x));
  776. X    assert( type(env) == ENV, "WriteObject: ENV/ENV!" );
  777. X    WriteObject(env, NO_PREC);
  778. X    Child(y, Down(x));
  779. X    assert( type(y) == CLOSURE, "WriteObject: ENV/ENV+CLOSURE!" );
  780. X    WriteObject(y, NO_PREC);
  781. X      }
  782. X      break;
  783. X
  784. X
  785. X    case CLOSURE:
  786. X
  787. X      sym = actual(x);  env = nil;
  788. X      if( LastDown(x) != x )
  789. X      {    Child(y, LastDown(x));
  790. X    if( type(y) == ENV )  env = y;
  791. X      }
  792. X
  793. X      braces_needed = env != nil ||
  794. X    (precedence(sym) <= outer_prec && (has_lpar(sym) || has_rpar(sym)));
  795. X
  796. X      /* print environment */
  797. X      if( env != nil )
  798. X      {    StringFPuts(KW_ENV, last_write_fp);
  799. X          StringFPuts(STR_NEWLINE, last_write_fp);
  800. X    WriteObject(env, NO_PREC);
  801. X      }
  802. X
  803. X      /* print left brace if needed */
  804. X      if( braces_needed )  StringFPuts(KW_LBR, last_write_fp);
  805. X    
  806. X      /* print the closure proper */
  807. X      WriteClosure(x);
  808. X
  809. X      /* print closing brace if needed */
  810. X      if( braces_needed )  StringFPuts(KW_RBR, last_write_fp);
  811. X
  812. X      /* print closing environment if needed */
  813. X      if( env != nil )
  814. X      { StringFPuts(STR_NEWLINE, last_write_fp);
  815. X    StringFPuts(KW_CLOS, last_write_fp);
  816. X          StringFPuts(STR_NEWLINE, last_write_fp);
  817. X      }
  818. X      break;
  819. X
  820. X
  821. X    case CROSS:
  822. X
  823. X      Child(y, Down(x));
  824. X      assert( type(y) == CLOSURE, "WriteObject/CROSS: type(y) != CLOSURE!" );
  825. X      StringFPuts(SymName(actual(y)), last_write_fp);
  826. X      StringFPuts(KW_CROSS, last_write_fp);
  827. X      Child(y, LastDown(x));
  828. X      WriteObject(y, FORCE_PREC);
  829. X      break;
  830. X
  831. X
  832. X    case NULL_CLOS:    name = KW_NULL;        goto SETC;
  833. X    case ONE_COL:    name = KW_ONE_COL;    goto SETC;
  834. X    case ONE_ROW:    name = KW_ONE_ROW;    goto SETC;
  835. X    case WIDE:        name = KW_WIDE;        goto SETC;
  836. X    case HIGH:        name = KW_HIGH;        goto SETC;
  837. X    case HSCALE:    name = KW_HSCALE;    goto SETC;
  838. X    case VSCALE:    name = KW_VSCALE;    goto SETC;
  839. X    case SCALE:        name = KW_SCALE;    goto SETC;
  840. X    case HCONTRACT:    name = KW_HCONTRACT;    goto SETC;
  841. X    case VCONTRACT:    name = KW_VCONTRACT;    goto SETC;
  842. X    case HEXPAND:    name = KW_HEXPAND;    goto SETC;
  843. X    case VEXPAND:    name = KW_VEXPAND;    goto SETC;
  844. X    case PADJUST:    name = KW_PADJUST;    goto SETC;
  845. X    case HADJUST:    name = KW_HADJUST;    goto SETC;
  846. X    case VADJUST:    name = KW_VADJUST;    goto SETC;
  847. X    case ROTATE:    name = KW_ROTATE;    goto SETC;
  848. X    case CASE:        name = KW_CASE;        goto SETC;
  849. X    case YIELD:        name = KW_YIELD;    goto SETC;
  850. X    case XCHAR:        name = KW_XCHAR;    goto SETC;
  851. X    case FONT:        name = KW_FONT;        goto SETC;
  852. X    case SPACE:        name = KW_SPACE;    goto SETC;
  853. X    case BREAK:        name = KW_BREAK;    goto SETC;
  854. X    case NEXT:        name = KW_NEXT;        goto SETC;
  855. X    case OPEN:        name = KW_OPEN;        goto SETC;
  856. X    case TAGGED:    name = KW_TAGGED;    goto SETC;
  857. X    case INCGRAPHIC:    name = KW_INCGRAPHIC;    goto SETC;
  858. X    case SINCGRAPHIC:    name = KW_SINCGRAPHIC;    goto SETC;
  859. X    case GRAPHIC:    name = KW_GRAPHIC;    goto SETC;
  860. X
  861. X      /* print left parameter, if present */
  862. X      SETC:
  863. X      if( DEFAULT_PREC <= outer_prec )  StringFPuts(KW_LBR, last_write_fp);
  864. X      if( Down(x) != LastDown(x) )
  865. X      {    Child(y, Down(x));
  866. X    WriteObject(y, DEFAULT_PREC);
  867. X    StringFPuts(STR_SPACE, last_write_fp);
  868. X      }
  869. X
  870. X      /* print the name of the symbol */
  871. X      StringFPuts(name, last_write_fp);
  872. X
  873. X      /* print right parameter, if present */
  874. X      if( LastDown(x) != x )
  875. X      {    Child(y, LastDown(x));
  876. X    StringFPuts(STR_SPACE, last_write_fp);
  877. X    if( type(x) == OPEN )
  878. X    { StringFPuts(KW_LBR, last_write_fp);
  879. X      WriteObject(y, NO_PREC);
  880. X      StringFPuts(KW_RBR, last_write_fp);
  881. X    }
  882. X    else WriteObject(y, DEFAULT_PREC);
  883. X      }
  884. X      if( DEFAULT_PREC <= outer_prec )
  885. X    StringFPuts(KW_RBR, last_write_fp);
  886. X      break;
  887. X
  888. X
  889. X    default:
  890. X
  891. X      Error(INTERN, &fpos(x), "WriteObject: type(x) = %s", Image(type(x)));
  892. X      break;
  893. X
  894. X  } /* end switch */
  895. X} /* end WriteObject */
  896. X
  897. X
  898. X/*@::AppendToFile(), CloseFiles()@********************************************/
  899. X/*                                                                           */
  900. X/*  AppendToFile(x, fnum, pos)                                               */
  901. X/*                                                                           */
  902. X/*  Append object x to file fnum, returning its fseek position in *pos.      */
  903. X/*  Record the fact that this file has been updated.                         */
  904. X/*                                                                           */
  905. X/*****************************************************************************/
  906. X
  907. XAppendToFile(x, fnum, pos)
  908. XOBJECT x;  FILE_NUM fnum;  int *pos;
  909. X{ FULL_CHAR buff[MAX_LINE], *str;
  910. X  debug2(DFS, D, "AppendToFile( %s, %s )", EchoObject(x), FileName(fnum));
  911. X
  912. X  /* open file fnum for writing */
  913. X  if( last_write_fnum != fnum )
  914. X  { if( last_write_fnum != NO_FILE )  fclose(last_write_fp);
  915. X    str = FileName(fnum);
  916. X    if( StringLength(str) + StringLength(NEW_DATA_SUFFIX) >= MAX_LINE )
  917. X      Error(FATAL, PosOfFile(fnum), "file name %s%s is too long",
  918. X    str, NEW_DATA_SUFFIX);
  919. X    StringCopy(buff, str);  StringCat(buff, NEW_DATA_SUFFIX);
  920. X    last_write_fp = StringFOpen(buff, "a");
  921. X    if( last_write_fp == null )  Error(FATAL, &fpos(fvec[fnum]),
  922. X        "cannot append to database file %s", buff);
  923. X    last_write_fnum = fnum;
  924. X  }
  925. X
  926. X  /* write x out and record the fact that fnum has changed */
  927. X  *pos = (int) ftell(last_write_fp);
  928. X  StringFPuts(KW_LBR, last_write_fp);
  929. X  WriteObject(x, NO_PREC);
  930. X  StringFPuts(KW_RBR, last_write_fp);
  931. X  StringFPuts(STR_NEWLINE, last_write_fp);
  932. X  StringFPuts(STR_NEWLINE, last_write_fp);
  933. X  updated(fvec[fnum]) = TRUE;
  934. X  debug0(DFS, D, "AppendToFile returning.");
  935. X} /* end AppendToFile */
  936. X
  937. X
  938. X/*****************************************************************************/
  939. X/*                                                                           */
  940. X/*  CloseFiles()                                                             */
  941. X/*                                                                           */
  942. X/*  Close all files and move new versions to the names of old versions.      */
  943. X/*                                                                           */
  944. X/*****************************************************************************/
  945. X
  946. XCloseFiles()
  947. X{ FILE_NUM fnum;  FULL_CHAR buff[MAX_LINE];
  948. X  ifdebug(DPP, D, ProfileOn("CloseFiles"));
  949. X  debug0(DFS, D, "CloseFiles()");
  950. X
  951. X  /* close off last file opened by AppendToFile above */
  952. X  if( last_write_fnum != NO_FILE )  fclose(last_write_fp);
  953. X
  954. X  /* get rid of old database files */
  955. X  for( fnum = FirstFile(SOURCE_FILE);  fnum != NO_FILE;  fnum = NextFile(fnum) )
  956. X  { StringCopy(buff, FileName(fnum));
  957. X    StringCat(buff, DATA_SUFFIX);  StringUnlink(buff);
  958. X  }
  959. X
  960. X  /* move any new database files to the old names, if updated */
  961. X  for( fnum = FirstFile(DATABASE_FILE); fnum != NO_FILE; fnum = NextFile(fnum) )
  962. X  { if( updated(fvec[fnum]) )
  963. X    { StringCopy(buff, string(fvec[fnum]));
  964. X      StringCat(buff, NEW_DATA_SUFFIX);
  965. X      debug1(DFS, D, "unlink(%s)", string(fvec[fnum]));
  966. X      StringUnlink(string(fvec[fnum])); /* may fail if no old version */
  967. X      debug2(DFS, D, "link(%s, %s)", buff, string(fvec[fnum]));
  968. X      if( StringLink(buff, string(fvec[fnum])) != 0 )
  969. X        Error(INTERN, no_fpos, "link(%s, %s) failed", buff, string(fvec[fnum]));
  970. X      debug1(DFS, D, "unlink(%s)", buff);
  971. X      if( StringUnlink(buff) != 0 )  Error(INTERN, no_fpos, "unlink(%s)", buff);
  972. X    }
  973. X  }
  974. X  debug0(DFS, D, "CloseFiles returning.");
  975. X  ifdebug(DPP, D, ProfileOff("CloseFiles"));
  976. X} /* end CloseFiles */
  977. END_OF_FILE
  978.   if test 37186 -ne `wc -c <'z03.c'`; then
  979.     echo shar: \"'z03.c'\" unpacked with wrong size!
  980.   fi
  981.   # end of 'z03.c'
  982. fi
  983. if test -f 'z36.c' -a "${1}" != "-c" ; then 
  984.   echo shar: Will not clobber existing file \"'z36.c'\"
  985. else
  986.   echo shar: Extracting \"'z36.c'\" \(30891 characters\)
  987.   sed "s/^X//" >'z36.c' <<'END_OF_FILE'
  988. X/*@z36.c:Hyphenation: Declarations@*******************************************/
  989. X/*                                                                           */
  990. X/*  LOUT: A HIGH-LEVEL LANGUAGE FOR DOCUMENT FORMATTING (VERSION 2.05)       */
  991. X/*  COPYRIGHT (C) 1993 Jeffrey H. Kingston                                   */
  992. X/*                                                                           */
  993. X/*  Jeffrey H. Kingston (jeff@cs.su.oz.au)                                   */
  994. X/*  Basser Department of Computer Science                                    */
  995. X/*  The University of Sydney 2006                                            */
  996. X/*  AUSTRALIA                                                                */
  997. X/*                                                                           */
  998. X/*  This program is free software; you can redistribute it and/or modify     */
  999. X/*  it under the terms of the GNU General Public License as published by     */
  1000. X/*  the Free Software Foundation; either version 1, or (at your option)      */
  1001. X/*  any later version.                                                       */
  1002. X/*                                                                           */
  1003. X/*  This program is distributed in the hope that it will be useful,          */
  1004. X/*  but WITHOUT ANY WARRANTY; without even the implied warranty of           */
  1005. X/*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the            */
  1006. X/*  GNU General Public License for more details.                             */
  1007. X/*                                                                           */
  1008. X/*  You should have received a copy of the GNU General Public License        */
  1009. X/*  along with this program; if not, write to the Free Software              */
  1010. X/*  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.                */
  1011. X/*                                                                           */
  1012. X/*  FILE:         z36.c                                                      */
  1013. X/*  MODULE:       Hyphenation                                                */
  1014. X/*  EXTERNS:      Hyphenate()                                                */
  1015. X/*                                                                           */
  1016. X/*****************************************************************************/
  1017. X#include "externs"
  1018. X#define MAX_CHAR    256        /* max chars represented in one char */
  1019. X#define TRIE_MAGIC    5361534
  1020. X#define KILL_CLASS    0        /* characters preventing hyphenation */
  1021. X#define PUNCT_CLASS    1        /* characters delimiting hyphenation */
  1022. X
  1023. Xtypedef struct trie_rec
  1024. X{ int        magic;            /* a magic number to make sure ok    */
  1025. X  int        class_count;        /* the number of character classes   */
  1026. X  unsigned char    class[MAX_CHAR];    /* the character classes             */
  1027. X  short        *node_mem;        /* the node memory                   */
  1028. X  int        node_lim;        /* top of node memory                */
  1029. X  int        node_free;        /* first free space in node memory   */
  1030. X  FULL_CHAR    *string_mem;        /* the string memory                 */
  1031. X  int        string_lim;        /* top of string memory              */
  1032. X  int        string_first;        /* the first (last inserted) string  */
  1033. X} *TRIE;
  1034. X
  1035. X
  1036. X/*****************************************************************************/
  1037. X/*                                                                           */
  1038. X/*  static TRIE T                                                            */
  1039. X/*                                                                           */
  1040. X/*  The packed hyphenation table, or NULL if not yet read in.                */
  1041. X/*                                                                           */
  1042. X/*****************************************************************************/
  1043. X
  1044. Xstatic TRIE    T = (TRIE) NULL;    /* the compressed hyphenation table  */
  1045. X
  1046. X
  1047. X/*****************************************************************************/
  1048. X/*                                                                           */
  1049. X/*  ClassConvert(in, out, T)                                                 */
  1050. X/*                                                                           */
  1051. X/*  Set out[i] to the character class of in[i] in T, for all i.              */
  1052. X/*                                                                           */
  1053. X/*****************************************************************************/
  1054. X
  1055. X#define ClassConvert(in, out, T)                    \
  1056. X{ int i;                                \
  1057. X  for( i = 0;  in[i] != '\0';  i++ )                    \
  1058. X    if( T->class[in[i]] != 0 )  out[i] = T->class[in[i]];        \
  1059. X    else Error(INTERN, no_fpos, "hyph: \"%s\" has illegal class", in);    \
  1060. X  out[i] = '\0';                            \
  1061. X} /* end ClassConvert */
  1062. X
  1063. X
  1064. X/*@::findrep(), TrieRetrieve(), ShowRate()@***********************************/
  1065. X/*                                                                           */
  1066. X/*  findrep(i, T)     Returns one character whose class in T is i.           */
  1067. X/*                                                                           */
  1068. X/*****************************************************************************/
  1069. X#if DEBUG_ON
  1070. X
  1071. Xstatic FULL_CHAR findrep(i, T)
  1072. Xint i;  TRIE T;
  1073. X{ int ch;
  1074. X  for( ch = 0;  ch < MAX_CHAR;  ch++ )
  1075. X    if( T->class[ch] == i ) return (FULL_CHAR) ch;
  1076. X  Error(INTERN, no_fpos, "hyph DoTriePrint: findrep failed");
  1077. X} /* end findrep */
  1078. X
  1079. X
  1080. X/*****************************************************************************/
  1081. X/*                                                                           */
  1082. X/*  static FULL_CHAR *TrieRetrieve(key, T)                                   */
  1083. X/*                                                                           */
  1084. X/*  Retrieve the value associated with key in T, or NULL if not present.     */
  1085. X/*                                                                           */
  1086. X/*****************************************************************************/
  1087. X
  1088. Xstatic FULL_CHAR *TrieRetrieve(key, T)
  1089. XFULL_CHAR *key;  TRIE T;
  1090. X{ FULL_CHAR str[MAX_LINE];  int i, curr_node, next_node, pos;
  1091. X  debug1(DHY, DD, "TrieRetrieve(%s, T)", key);
  1092. X  ClassConvert(key, str, T);
  1093. X
  1094. X  /* invariant: curr_node is an existing node of T with prefix str[0..i-1] */
  1095. X  curr_node = i = 0;
  1096. X  for(;;)
  1097. X  {
  1098. X    /* if next_node is 0, the string was never inserted */
  1099. X    next_node = T->node_mem[curr_node + str[i]];
  1100. X    if( next_node == 0 )  return (FULL_CHAR *) NULL;
  1101. X
  1102. X    /* if next_node < 0 it represents an offset into the string memory */
  1103. X    if( next_node < 0 )
  1104. X    { pos = - next_node;
  1105. X      if( str[i] != '\0' )
  1106. X      {    do
  1107. X    { if( str[++i] != T->string_mem[pos++] )  return (FULL_CHAR *) NULL;
  1108. X    } while( str[i] != '\0' );
  1109. X      }
  1110. X      return &(T->string_mem[pos]);
  1111. X    }
  1112. X
  1113. X    /* otherwise next_node is the trie node to be searched next */
  1114. X    curr_node = 2*next_node;  i++;
  1115. X  }
  1116. X} /* end TrieRetrieve */
  1117. X
  1118. X
  1119. X/*****************************************************************************/
  1120. X/*                                                                           */
  1121. X/*  static ShowRate(key, start, stop, rate, fp)                              */
  1122. X/*                                                                           */
  1123. X/*  Debug print of key[] and rate[] on file fp.                              */
  1124. X/*                                                                           */
  1125. X/*****************************************************************************/
  1126. X
  1127. Xstatic ShowRate(key, start, stop, rate, fp)
  1128. XFULL_CHAR *key;  int start, stop;  FULL_CHAR *rate;  FILE *fp;
  1129. X{ int i;
  1130. X  fprintf(fp, "key:    ");
  1131. X  for( i = start;  i < stop;  i++ )  fprintf(fp, " %c", key[i]);
  1132. X  fprintf(fp, "\nrate:");
  1133. X  for( i = 0;  rate[i] != '\0';  i++ )  fprintf(fp, " %c", rate[i]);
  1134. X  fprintf(fp, "\n");
  1135. X} /* end ShowRate */
  1136. X
  1137. X
  1138. X/*@::DoTriePrint(), TriePrint()@**********************************************/
  1139. X/*                                                                           */
  1140. X/*  static DoTriePrint(T, node, len, fp)                                     */
  1141. X/*                                                                           */
  1142. X/*  Print on file fp the subset of the entries of trie T stored in node and  */
  1143. X/*  its descendants.  The node has prefix prefix[0..len-1].                  */
  1144. X/*                                                                           */
  1145. X/*****************************************************************************/
  1146. X
  1147. Xstatic FULL_CHAR prefix[MAX_LINE];
  1148. X
  1149. Xstatic DoTriePrint(T, node, len, fp)
  1150. XTRIE T; int node, len; FILE *fp;
  1151. X{ int i, next_node, pos;
  1152. X  for( i = 0;  i < T->class_count;  i++ )
  1153. X  {
  1154. X    /* if next_node < 0, have string to print */
  1155. X    next_node = T->node_mem[node + i];
  1156. X    if( next_node < 0 )
  1157. X    {
  1158. X      prefix[len] = '\0';
  1159. X      fprintf(fp, "%s", prefix);
  1160. X      pos = - next_node;
  1161. X      if( i != 0 )
  1162. X      {
  1163. X    fprintf(fp, "%c", findrep(i, T));
  1164. X    while( T->string_mem[pos] != '\0' )
  1165. X    { fprintf(fp, "%c", findrep(T->string_mem[pos], T));
  1166. X      pos++;
  1167. X    }
  1168. X    pos++;
  1169. X      }
  1170. X      fprintf(fp, " %s\n", &(T->string_mem[pos]));
  1171. X    }
  1172. X
  1173. X    /* else if next_node > 0 have a child node to explore */
  1174. X    else if( next_node > 0 )
  1175. X    { assert( i > 0, "DoTriePrint: i == 0!" );
  1176. X      prefix[len] = findrep(i, T);
  1177. X      prefix[len+1] = '\0';
  1178. X      DoTriePrint(T, 2*next_node, len+1, fp);
  1179. X    }
  1180. X  }
  1181. X} /* end DoTriePrint */
  1182. X
  1183. X
  1184. X/*****************************************************************************/
  1185. X/*                                                                           */
  1186. X/*  static TriePrint(T, fp)                                                  */
  1187. X/*                                                                           */
  1188. X/*  Print trie T on file fp.                                                 */
  1189. X/*                                                                           */
  1190. X/*****************************************************************************/
  1191. X
  1192. Xstatic TriePrint(T, fp)
  1193. XTRIE T;  FILE *fp;
  1194. X{ int i, j, ch;
  1195. X  assert( T-> magic == TRIE_MAGIC, "TriePrint: magic!" );
  1196. X  fprintf(fp, "Classes:");
  1197. X  for( i = 1;  i < T->class_count;  i++ )
  1198. X  { fprintf(fp, " ");
  1199. X    for( ch = 0;  ch < MAX_CHAR;  ch++ )
  1200. X      if( T->class[ch] == i )  fprintf(fp, "%c", ch);
  1201. X  }
  1202. X  fprintf(fp, "\n");
  1203. X  fprintf(fp, "Node space: %d capacity, %d used\n", T->node_lim, T->node_free);
  1204. X  fprintf(fp, "String space: %d capacity, %d used\n", T->string_lim,
  1205. X    T->string_lim - T->string_first);
  1206. X  prefix[0] = '\0';
  1207. X  DoTriePrint(T, 0, 0, fp);
  1208. X} /* end TriePrint */
  1209. X#endif
  1210. X
  1211. X
  1212. X/*@::NewTrie(), ClassConvert(), NewTrieString(), NewTrieNode()@***************/
  1213. X/*                                                                           */
  1214. X/*  static TRIE NewTrie(node_lim, string_lim)                                */
  1215. X/*                                                                           */
  1216. X/*  Initialize a new trie with the this much space for nodes and strings.    */
  1217. X/*                                                                           */
  1218. X/*****************************************************************************/
  1219. X
  1220. Xstatic TRIE NewTrie(node_lim, string_lim)
  1221. Xunsigned node_lim, string_lim;
  1222. X{ TRIE T;  int i;  char *malloc();
  1223. X  debug2(DHY, D, "NewTrie(%d, %d)", node_lim, string_lim);
  1224. X  T = (TRIE) malloc( sizeof(struct trie_rec)
  1225. X             + node_lim*sizeof(short) + string_lim*sizeof(char));
  1226. X  if( T == (TRIE) NULL )  Error(FATAL, no_fpos,
  1227. X    "run out of memory while constructing hyphenation table");
  1228. X  T->magic = TRIE_MAGIC;  T->class_count = 1;
  1229. X  for( i = 0;  i < MAX_CHAR;  i++ )  T->class[i] = 0;
  1230. X  T->node_mem = (short *) ( (char *) T + sizeof(struct trie_rec));
  1231. X  T->node_lim = node_lim;  T->node_free = 0;
  1232. X  T->string_mem = (FULL_CHAR *) &(T->node_mem[node_lim]);
  1233. X  T->string_lim = T->string_first = string_lim;
  1234. X  debug0(DHY, D, "NewTrie returning.");
  1235. X  return T;
  1236. X} /* end NewTrie */
  1237. X
  1238. X
  1239. X/*****************************************************************************/
  1240. X/*                                                                           */
  1241. X/*  static short NewTrieString(str, T)                                       */
  1242. X/*                                                                           */
  1243. X/*  Copy a new string into T, and return its offset in string_mem;           */
  1244. X/*                                                                           */
  1245. X/*****************************************************************************/
  1246. X
  1247. Xstatic short NewTrieString(str, T)
  1248. XFULL_CHAR *str;  TRIE T;
  1249. X{ short res = T->string_first - StringLength(str) - 1;
  1250. X  if( res < 0 )  Error(INTERN, no_fpos, "hyph: trie string limit exceeded");
  1251. X  T->string_first = res;  StringCopy(&(T->string_mem[res]), str);
  1252. X  return res;
  1253. X} /* end NewTrieString */
  1254. X
  1255. X
  1256. X/*****************************************************************************/
  1257. X/*                                                                           */
  1258. X/*  ststic int NewTrieNode(T)                                                */
  1259. X/*                                                                           */
  1260. X/*  Allocate a new empty trie node in T, and return its offset in node_mem.  */
  1261. X/*                                                                           */
  1262. X/*****************************************************************************/
  1263. X
  1264. Xstatic int NewTrieNode(T)
  1265. XTRIE T;
  1266. X{ int i;  int res;
  1267. X  if( T->node_free + T->class_count > T->node_lim )
  1268. X    Error(INTERN, no_fpos, "hyph: trie node limit exceeded");
  1269. X  res = T->node_free;  T->node_free += T->class_count;
  1270. X  for( i = res;  i < T->node_free;  i++ )  T->node_mem[i] = 0;
  1271. X  return res;
  1272. X} /* end NewTrieNode */
  1273. X
  1274. X
  1275. X/*@::AddClassToTrie(), TrieInsert()@******************************************/
  1276. X/*                                                                           */
  1277. X/*  static AddClassToTrie(str, T)                                            */
  1278. X/*                                                                           */
  1279. X/*  Add a new character class, whose members are the characters of str, to   */
  1280. X/*  trie T.  This cannot occur after the first insertion.                    */
  1281. X/*                                                                           */
  1282. X/*****************************************************************************/
  1283. X
  1284. Xstatic AddClassToTrie(str, T)
  1285. XFULL_CHAR *str; TRIE T;
  1286. X{ int i;
  1287. X  if( T->string_first != T-> string_lim )
  1288. X    Error(INTERN, no_fpos, "hyph AddClassToTrie after first insertion!");
  1289. X  for( i = 0;  str[i] != '\0';  i++ )
  1290. X    if( T->class[str[i]] == 0 ) T->class[str[i]] = T->class_count;
  1291. X    else Error(INTERN,no_fpos, "hyph: class of %c may not be changed!", str[i]);
  1292. X  T->class_count++;
  1293. X} /* end AddClassToTrie */
  1294. X
  1295. X
  1296. X/*****************************************************************************/
  1297. X/*                                                                           */
  1298. X/*  static TrieInsert(key, value, T)                                         */
  1299. X/*                                                                           */
  1300. X/*  Insert a new key and value into trie T.                                  */
  1301. X/*                                                                           */
  1302. X/*****************************************************************************/
  1303. X
  1304. Xstatic TrieInsert(key, value, T)
  1305. XFULL_CHAR *key, *value;  TRIE T;
  1306. X{ FULL_CHAR str[MAX_LINE];  int i, curr_node, next_node, pos, ch;
  1307. X  debug2(DHY, D, "TrieInsert(%s, %s, T)", key, value);
  1308. X
  1309. X  /* if first insertion, add one node after making sure class_count is even */
  1310. X  if( T->node_free == 0 )
  1311. X  { T->class_count = 2 * ceiling(T->class_count, 2);
  1312. X    ch = NewTrieNode(T);
  1313. X  }
  1314. X
  1315. X  /* invariant: curr_node is an existing node of T with prefix str[0..i-1] */
  1316. X  ClassConvert(key, str, T);
  1317. X  curr_node = i = 0;
  1318. X  for(;;)
  1319. X  {
  1320. X    /* if str is ended, add value only to string memory */
  1321. X    if( str[i] == '\0' )
  1322. X    { if( T->node_mem[curr_node] != 0 )
  1323. X    Error(INTERN, no_fpos, "hyph string %s already inserted", key);
  1324. X      else T->node_mem[curr_node] = - NewTrieString(value, T);
  1325. X      debug0(DHY, D, "TrieInsert returning (empty suffix).");
  1326. X      return;
  1327. X    }
  1328. X
  1329. X    /* if next position is unoccupied, store remainder of str and value */
  1330. X    next_node = T->node_mem[curr_node + str[i]];
  1331. X    if( next_node == 0 )
  1332. X    { ch = NewTrieString(value, T);
  1333. X      T->node_mem[curr_node + str[i]] = - NewTrieString(&str[i+1], T);
  1334. X      debug0(DHY, D, "TrieInsert returning (non-empty suffix).");
  1335. X      return;
  1336. X    }
  1337. X
  1338. X    /* if next position is occupied by a non-empty string, move that */
  1339. X    /* string down one level and replace it by a trie node           */
  1340. X    if( next_node < 0 )
  1341. X    { pos = - next_node;
  1342. X      ch = T->string_mem[pos];
  1343. X      if( T->string_first == pos )  T->string_first++;
  1344. X      T->node_mem[curr_node + str[i]] = next_node = NewTrieNode(T)/2;
  1345. X      T->node_mem[2*next_node + ch] = -(pos+1);
  1346. X    }
  1347. X
  1348. X    /* now next is the offset of the next node to be searched */
  1349. X    curr_node = 2*next_node;  i++;
  1350. X  }
  1351. X} /* end TrieInsert */
  1352. X
  1353. X
  1354. X/*@::BeGetChar(), BePutChar(), BeGetShort(), BePutShort(), etc.@**************/
  1355. X/*                                                                           */
  1356. X/*  BeGetChar(fp, pv)                                                        */
  1357. X/*  BePutChar(fp, v)                                                         */
  1358. X/*  BeGetShort(fp, pv)                                                       */
  1359. X/*  BePutShort(fp, v)                                                        */
  1360. X/*  BeGetInt(fp, pv)                                                         */
  1361. X/*  BePutInt(fp, v)                                                          */
  1362. X/*                                                                           */
  1363. X/*  Get char, short, or int pv from file fp, and put char, short, or int     */
  1364. X/*  onto file fp.  These routines are designed so that the file can be       */
  1365. X/*  written or read safely by big-endian and little-endian architectures;    */
  1366. X/*  this is accomplished by reading and writing one byte at a time to and    */
  1367. X/*  from a big-endian format file.  All return 0 on success, -1 on failure.  */
  1368. X/*  Thanks to David W. Sanderson for this code.                              */
  1369. X/*                                                                           */
  1370. X/*****************************************************************************/
  1371. X
  1372. X#define BeGetChar(fp, pv)  ( (c = getc(fp)) == EOF ? -1 : (*pv = c & 0xFF, 0) )
  1373. X#define BePutChar(fp, v)   ( putc( (char) (v & 0xFF), fp), 0 )
  1374. X
  1375. X#define BeGetShort(fp, pv)                        \
  1376. X(  (c = getc(fp)) == EOF ? -1 :                        \
  1377. X   (  *pv = (c & 0xFF) << 8,                        \
  1378. X      (c = getc(fp)) == EOF ? -1 : (*pv |= c & 0xFF, 0)            \
  1379. X   )                                    \
  1380. X)
  1381. X
  1382. X#define BePutShort(fp, v)                        \
  1383. X( putc((v >> 8) & 0xFF, fp), putc(v & 0xFF, fp), 0 )
  1384. X
  1385. Xint BeGetInt(fp, pv)
  1386. XFILE *fp; int *pv;
  1387. X{ int c;
  1388. X  if ((c = getc(fp)) == EOF) return -1;
  1389. X  *pv = (c & 0xFF) << 24;
  1390. X  if ((c = getc(fp)) == EOF) return -1;
  1391. X  *pv |= (c & 0xFF) << 16;
  1392. X  if ((c = getc(fp)) == EOF) return -1;
  1393. X  *pv |= (c & 0xFF) << 8;
  1394. X  if ((c = getc(fp)) == EOF) return -1;
  1395. X  *pv |= c & 0xFF;
  1396. X  return 0;
  1397. X}
  1398. X
  1399. Xint BePutInt(fp, v)
  1400. XFILE *fp; int v;
  1401. X{
  1402. X  putc((v >> 24) & 0xFF, fp);
  1403. X  putc((v >> 16) & 0xFF, fp);
  1404. X  putc((v >> 8) & 0xFF, fp);
  1405. X  putc(v & 0xFF, fp);
  1406. X  return 0;
  1407. X}
  1408. X
  1409. X
  1410. X/*@::CompressTrie(), TrieRead(), AccumulateRating()@**************************/
  1411. X/*                                                                           */
  1412. X/*  static CompressTrie(T)                                                   */
  1413. X/*                                                                           */
  1414. X/*  Compress trie T and return its length in characters.                     */
  1415. X/*                                                                           */
  1416. X/*****************************************************************************/
  1417. X
  1418. Xstatic CompressTrie(T)
  1419. XTRIE T;
  1420. X{ FULL_CHAR *p, *q;  int len, i;
  1421. X  debug0(DHY, D, "CompressTrie(T), T =");
  1422. X  ifdebug(DHY, DD, TriePrint(T, stderr));
  1423. X  T->node_lim = T->node_free;
  1424. X  for( i = 0;  i < T->node_lim;  i++ )
  1425. X    if( T->node_mem[i] < 0 )
  1426. X      T->node_mem[i] = - ( -T->node_mem[i] - T->string_first);
  1427. X  p = (FULL_CHAR *) &(T->node_mem[T->node_free]);
  1428. X  q = &(T->string_mem[T->string_first]);
  1429. X  len = T->string_lim - T->string_first;
  1430. X  for( i = 0;  i < len;  i++ )  *p++ = *q++;
  1431. X  T->string_mem = (FULL_CHAR *) &(T->node_mem[T->node_lim]);
  1432. X  T->string_first = 0;
  1433. X  T->string_lim = len;
  1434. X  len = sizeof(struct trie_rec) + T->node_lim * sizeof(short)
  1435. X                + T->string_lim * sizeof(FULL_CHAR);
  1436. X  debug1(DHY, D, "CompressTrie returning; len = %d, T =", len);
  1437. X  ifdebug(DHY, DD, TriePrint(T, stderr));
  1438. X} /* end CompressTrie */
  1439. X
  1440. X
  1441. X/*****************************************************************************/
  1442. X/*                                                                           */
  1443. X/*  static TRIE TrieRead()                                                   */
  1444. X/*                                                                           */
  1445. X/*  Read in a packed trie if possible, otherwise pack an unpacked one.       */
  1446. X/*                                                                           */
  1447. X/*****************************************************************************/
  1448. X
  1449. Xstatic TRIE TrieRead()
  1450. X{ TRIE T;  FILE_NUM unpacked_fnum, packed_fnum;
  1451. X  FILE *unpacked_fp, *packed_fp;  unsigned len; int prev, i, j, c;
  1452. X  char *malloc();
  1453. X  debug0(DHY, D, "TrieRead()");
  1454. X
  1455. X  /* open file, using name stored in file handler */
  1456. X  packed_fnum = FirstFile(HYPH_PACKED_FILE);
  1457. X  assert( packed_fnum != NO_FILE, "TrieRead: packed_fnum!" );
  1458. X  packed_fp = OpenFile(packed_fnum, FALSE, FALSE);
  1459. X  if( packed_fp == NULL )
  1460. X  {
  1461. X    /* no packed file, so open unpacked one instead */
  1462. X    FULL_CHAR str[MAX_LINE], key[MAX_LINE], value[MAX_LINE],
  1463. X          buff[MAX_LINE+10];
  1464. X    unpacked_fnum = FirstFile(HYPH_FILE);
  1465. X    assert( unpacked_fnum != NO_FILE, "TrieRead: unpacked unpacked_fnum!" );
  1466. X    unpacked_fp = OpenFile(unpacked_fnum, FALSE, FALSE);
  1467. X    if( unpacked_fp == NULL )
  1468. X    { Error(WARN, no_fpos, "cannot open hyphenation file %s",
  1469. X    FileName(unpacked_fnum));
  1470. X      return (TRIE) NULL;
  1471. X    }
  1472. X
  1473. X    /* read in unpacked hyphenation trie from unpacked_fp and compress it */
  1474. X    T = NewTrie( (unsigned) 60000,  (unsigned) 32767);
  1475. X    while( StringFGets(str, MAX_LINE, unpacked_fp) != NULL &&
  1476. X        str[0] != CH_NEWLINE )
  1477. X    { str[StringLength(str)-1] = '\0';
  1478. X      debug1(DHY, D, "adding class %s", str);
  1479. X      AddClassToTrie(str, T);
  1480. X    }
  1481. X    while( StringFGets(str, MAX_LINE, unpacked_fp) != NULL &&
  1482. X        str[0] != CH_NEWLINE )
  1483. X    { prev = CH_ZERO; j = 0;
  1484. X      for( i = 0;  str[i] != CH_NEWLINE && str[i] != '\0';  i++ )
  1485. X      { if( decimaldigit(str[i]) )  prev = str[i];
  1486. X        else key[j] = str[i], value[j++] = prev, prev = CH_ZERO;
  1487. X      }
  1488. X      key[j] = '\0';  value[j] = prev;  value[j+1] = '\0';
  1489. X      TrieInsert(key, value, T);
  1490. X    }
  1491. X    fclose(unpacked_fp);
  1492. X    CompressTrie(T);
  1493. X
  1494. X    /* write the compressed trie out to the packed file */
  1495. X    StringCopy(buff, FileName(unpacked_fnum));
  1496. X    StringCat(buff, HYPH_SUFFIX);
  1497. X    packed_fp = StringFOpen(buff, "w");
  1498. X    if( packed_fp == NULL )  Error(FATAL, no_fpos,
  1499. X      "cannot write to hyphenation file %s", buff);
  1500. X    BePutInt(packed_fp, T->magic);
  1501. X    BePutInt(packed_fp, T->class_count);
  1502. X    for( i = 0; i < MAX_CHAR; i++ )  BePutChar(packed_fp, T->class[i]);
  1503. X    BePutInt(packed_fp, 0);  /* placeholder for node_mem */
  1504. X    BePutInt(packed_fp, T->node_lim);
  1505. X    BePutInt(packed_fp, T->node_free);
  1506. X    BePutInt(packed_fp, 0);  /* placeholder for string_mem */
  1507. X    BePutInt(packed_fp, T->string_lim);
  1508. X    BePutInt(packed_fp, T->string_first);
  1509. X    for( i = 0; i < T->node_free; i++ )  BePutShort(packed_fp, T->node_mem[i]);
  1510. X    for( i = 0; i < T->string_lim; i++)  BePutChar(packed_fp, T->string_mem[i]);
  1511. X    fclose(packed_fp);
  1512. X
  1513. X    /* now try again to open packed_fnum, the file just written */
  1514. X    packed_fp = OpenFile(packed_fnum, FALSE, FALSE);
  1515. X    if( packed_fp == NULL )  Error(FATAL, no_fpos,
  1516. X      "cannot open hyphenation file %s", FileName(packed_fnum));
  1517. X  }
  1518. X
  1519. X  /* now packed hyphenation file is open, read it in */
  1520. X  fseek(packed_fp,0L,2);  len = (unsigned) ftell(packed_fp);  rewind(packed_fp);
  1521. X  T = (TRIE) malloc(len);
  1522. X  if( T == (TRIE) NULL )  Error(FATAL, no_fpos,
  1523. X    "run out of memory while reading hyphenation table");
  1524. X  if( BeGetInt(packed_fp, &T->magic) != 0 )  Error(FATAL, no_fpos,
  1525. X      "error on read from packed hyphenation file %s", FileName(packed_fnum));
  1526. X  if( T->magic != TRIE_MAGIC )  Error(FATAL, no_fpos,
  1527. X      "bad magic number in hyphenation file %s", FileName(packed_fnum));
  1528. X  BeGetInt(packed_fp, &T->class_count);
  1529. X  for( i = 0; i < MAX_CHAR; i++ )  BeGetChar(packed_fp, &T->class[i]);
  1530. X  BeGetInt(packed_fp, &i);  /* placeholder for node_mem */
  1531. X  BeGetInt(packed_fp, &T->node_lim);
  1532. X  BeGetInt(packed_fp, &T->node_free);
  1533. X  BeGetInt(packed_fp, &i);  /* placeholder for string_mem */
  1534. X  BeGetInt(packed_fp, &T->string_lim);
  1535. X  BeGetInt(packed_fp, &T->string_first);
  1536. X  T->node_mem = (short *) ( (char *) T + sizeof(struct trie_rec) );
  1537. X  T->string_mem = (FULL_CHAR *) &(T->node_mem[T->node_lim]);
  1538. X  for( i = 0; i < T->node_free; i++ )  BeGetShort(packed_fp, &T->node_mem[i]);
  1539. X  for( i = 0; i < T->string_lim; i++ ) BeGetChar(packed_fp, &T->string_mem[i]);
  1540. X
  1541. X  /* debug and exit */
  1542. X  debug0(DHY, D, "TrieRead returning, T =");
  1543. X  ifdebug(DHY, DD, TriePrint(T, stderr));
  1544. X  return T;
  1545. X} /* end TrieRead */
  1546. X
  1547. X
  1548. X/*****************************************************************************/
  1549. X/*                                                                           */
  1550. X/*  AccumulateRating(x, y)                                                   */
  1551. X/*                                                                           */
  1552. X/*  Accumulate the hyphenation rating string x into y.                       */
  1553. X/*                                                                           */
  1554. X/*****************************************************************************/
  1555. X
  1556. X#define AccumulateRating(x, y)                        \
  1557. X{ FULL_CHAR *p = x, *q = y;                        \
  1558. X  while( *p )                                \
  1559. X  { if( *p > *q )  *q = *p;                        \
  1560. X    p++, q++;                                \
  1561. X  }                                    \
  1562. X} /* end AccumulateRating */
  1563. X
  1564. X
  1565. X/*@::Hyphenate@***************************************************************/
  1566. X/*                                                                           */
  1567. X/*  OBJECT Hyphenate(x)                                                      */
  1568. X/*                                                                           */
  1569. X/*  Hyphenate ACAT object x, returning the hyphenated result.                */
  1570. X/*                                                                           */
  1571. X/*****************************************************************************/
  1572. X
  1573. XOBJECT Hyphenate(x)
  1574. XOBJECT x;
  1575. X{ OBJECT link, y, z, next_link;
  1576. X  FULL_CHAR str[MAX_LINE+2], rate[MAX_LINE+3], *class, *key, *ss, *s, *p, *rem;
  1577. X  int start, stop, i, curr_node, next_node, pos;
  1578. X  BOOLEAN hyphenated;  static ShowRate();
  1579. X  static BOOLEAN tried_file = FALSE;
  1580. X  assert( type(x) == ACAT, "Hyphenate: type(x) != ACAT!" );
  1581. X  debug1(DHY, DD, "Hyphenate(%s)", EchoObject(x));
  1582. X
  1583. X  /* if no trie is present, try to get it from a file */
  1584. X  if( T == (TRIE) NULL )
  1585. X  { if( !tried_file )  T = TrieRead();
  1586. X    tried_file = TRUE;
  1587. X    if( T == (TRIE) NULL )
  1588. X    { debug0(DHY, DD, "Hyphenate returning (no trie).");
  1589. X      return x;
  1590. X    }
  1591. X  }
  1592. X
  1593. X  /* for each word y of x, try to hyphenate it */
  1594. X  for( link = Down(x);  link != x;  link = NextDown(link) )
  1595. X  { Child(y, link);
  1596. X    if( !is_word(type(y)) )  continue;
  1597. X    debug1(DHY, DD, "Hyphenate() examining %s", EchoObject(y));
  1598. X
  1599. X    /* start := index of first letter of y, stop := index following last */
  1600. X    key = string(y);  class = T->class;
  1601. X    for( start = 0;  class[key[start]] == PUNCT_CLASS;  start++ );
  1602. X    for( stop = start;  class[key[stop]] > PUNCT_CLASS;  stop++ );
  1603. X
  1604. X    /* if a - ended the run, hyphenate there only */
  1605. X    if( key[stop] == CH_HYPHEN )
  1606. X    { next_link = NextDown(link);
  1607. X      z = MakeWord(WORD, &key[stop+1], &fpos(y));
  1608. X      word_font(z) = word_font(y);
  1609. X      FontWordSize(z);
  1610. X      Link(NextDown(link), z);
  1611. X      z = New(GAP_OBJ);
  1612. X      SetGap(gap(z), FALSE, TRUE, FIXED_UNIT, HYPH_MODE, 0);
  1613. X      Link(NextDown(link), z);
  1614. X      Link(z, MakeWord(WORD, STR_GAP_ZERO_HYPH, &fpos(y)));
  1615. X      key[stop + 1] = '\0';
  1616. X      FontWordSize(y);
  1617. X      link = PrevDown(next_link);
  1618. X      continue;
  1619. X    }
  1620. X
  1621. X    /* do not hyphenate if less than 5 letters, or a kill char is nearby */
  1622. X    if( stop - start < 5 )  continue;
  1623. X    if( key[stop] != '\0' && class[key[stop]] == KILL_CLASS )  continue;
  1624. X
  1625. X    /* let str[] be the converted substring, let rate[] be all CH_ZERO */
  1626. X    str[0] = PUNCT_CLASS;  rate[0] = CH_ZERO;
  1627. X    for( i = 0;  i < stop - start;  i++ )
  1628. X    { str[i+1] = class[key[start + i]];
  1629. X      rate[i+1] = CH_ZERO;
  1630. X    }
  1631. X    str[i+1] = PUNCT_CLASS;  rate[i+1] = CH_ZERO;
  1632. X    str[i+2] = '\0';  rate[i+2] = CH_ZERO;
  1633. X    rate[i+3] = '\0';
  1634. X    ifdebug(DHY, DD, ShowRate(key, start, stop, rate, stderr));
  1635. X
  1636. X    /* for each suffix of str[], accumulate patterns matching its prefixes */
  1637. X    ss = str;
  1638. X    do
  1639. X    {
  1640. X      ifdebug(DHY, DD,
  1641. X    fprintf(stderr, "trying suffix \"");
  1642. X    for( p = ss; *p != 0;  p++ )  fprintf(stderr, "%c", findrep(*p, T));
  1643. X    fprintf(stderr, "\"\n");
  1644. X      );
  1645. X    
  1646. X      /* accumulate all prefixes of ss */
  1647. X      curr_node = 0;  s = ss;
  1648. X      for(;;)
  1649. X      {
  1650. X    /* if curr_node has empty string, that is one prefix */
  1651. X    pos = T->node_mem[curr_node];
  1652. X    if( pos < 0 )
  1653. X    { AccumulateRating(&T->string_mem[- pos], rate+(ss-str));
  1654. X      debug1(DHY, DD, " found %s", &(T->string_mem[- pos]));
  1655. X    }
  1656. X
  1657. X    /* if ss is finished, no other prefixes are possible */
  1658. X    if( *s == '\0' )  break;
  1659. X
  1660. X    /* determine next_node and break if empty */
  1661. X    next_node = T->node_mem[curr_node + *s];
  1662. X    if( next_node == 0 )  break;
  1663. X
  1664. X    /* if next_node is a string, check whether it is a prefix of ss */
  1665. X    if( next_node < 0 )
  1666. X    { rem = &(T->string_mem[-next_node]);
  1667. X      do
  1668. X      { if( *rem == '\0' )
  1669. X        { AccumulateRating(rem+1, rate+(ss-str));
  1670. X          debug1(DHY, DD, " found %s", rem+1);
  1671. X          break;
  1672. X        }
  1673. X      } while( *++s == *rem++ );
  1674. X      break;
  1675. X    }
  1676. X
  1677. X    /* otherwise go on to the next trie node */
  1678. X    curr_node = 2*next_node;  s++;
  1679. X      }
  1680. X    } while( *(++ss + 1) != PUNCT_CLASS );
  1681. X    ifdebug(DHY, DD, ShowRate(key, start, stop, rate, stderr));
  1682. X
  1683. X    /* now rate[] has accumulated ratings; use it to perform hyphenations */
  1684. X    hyphenated = FALSE;
  1685. X    next_link = NextDown(link);
  1686. X    for( i = stop - start - 1;  i >= 3;  i-- )
  1687. X    {
  1688. X      /* hyphenate at i if rate[i] is odd */
  1689. X      if( is_odd(rate[i]) )
  1690. X      {    z = MakeWord(WORD, &key[start+i-1], &fpos(y));
  1691. X    word_font(z) = word_font(y);
  1692. X    FontWordSize(z);
  1693. X    Link(NextDown(link), z);
  1694. X    z = New(GAP_OBJ);
  1695. X    SetGap(gap(z), FALSE, TRUE, FIXED_UNIT, HYPH_MODE, 0);
  1696. X    Link(NextDown(link), z);
  1697. X    Link(z, MakeWord(WORD, STR_GAP_ZERO_HYPH, &fpos(y)));
  1698. X    key[start + i - 1] = '\0';
  1699. X    hyphenated = TRUE;
  1700. X      }
  1701. X    }
  1702. X    if( hyphenated )
  1703. X    { FontWordSize(y);
  1704. X      link = PrevDown(next_link);
  1705. X    }
  1706. X
  1707. X  } /* end for each word */
  1708. X
  1709. X  debug1(DHY, DD, "Hyphenate returning %s", EchoObject(x));
  1710. X  return x;
  1711. X} /* end Hyphenate */
  1712. END_OF_FILE
  1713.   if test 30891 -ne `wc -c <'z36.c'`; then
  1714.     echo shar: \"'z36.c'\" unpacked with wrong size!
  1715.   fi
  1716.   # end of 'z36.c'
  1717. fi
  1718. echo shar: End of archive 7 \(of 35\).
  1719. cp /dev/null ark7isdone
  1720. MISSING=""
  1721. 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 31 32 33 34 35 ; do
  1722.     if test ! -f ark${I}isdone ; then
  1723.     MISSING="${MISSING} ${I}"
  1724.     fi
  1725. done
  1726. if test "${MISSING}" = "" ; then
  1727.     echo You have unpacked all 35 archives.
  1728.     rm -f ark[1-9]isdone ark[1-9][0-9]isdone
  1729. else
  1730.     echo You still must unpack the following archives:
  1731.     echo "        " ${MISSING}
  1732. fi
  1733. exit 0
  1734. exit 0 # Just in case...
  1735.