(FILECREATED " 2-Feb-86 17:19:24" {DSK}<LISPFILES2>FINDPRED.LSP;2 9581
changes to: (VARS FINDPREDCOMS))
(* Copyright (c) 1986 by Quintus Computer Systems, Inc. All rights reserved.)
(PRETTYCOMPRINT FINDPREDCOMS)
(RPAQQ FINDPREDCOMS ((FNS QP.BEGINNING.OF.LINE QP.END.OF.LINE QP.FIND.BOTTOM QP.FIND.END
QP.FIND.FIRST.PREDICATE QP.FIND.FIRST.PREDICATE.AUX
QP.FIND.NEXT.PRED.DOWN QP.FIND.PREDICATE QP.FIND.TOP QP.GET.NEXT.CHAR
QP.GET.PRED.NAME)))
(DEFINEQ
(QP.BEGINNING.OF.LINE
(LAMBDA (STREAM)
(LET ((POS (ADD1 (\TEXTGETFILEPTR STREAM)))
CHAR)
(if (IGREATERP POS 1)
then (REPEATUNTIL (OR (EQ CHAR 13)
(EQ POS 1))
DO (SETQ CHAR (\BACKBIN STREAM))
(SETQ POS (SUB1 POS))))
(if (EQ CHAR 13)
then (\BIN STREAM)))))
(QP.END.OF.LINE
(LAMBDA (STREAM)
(UNTIL (OR (EOFP STREAM)
(EQ (\BIN STREAM)
13))
DO T)))
(QP.FIND.BOTTOM
(LAMBDA (STREAM START NAME ARITY)
(LET ((TEXT (TEXTOBJ STREAM))
(STOP NIL)
(NEW.NAME NIL)
(NEW.BOTTOM NIL)
TOP BOTTOM NEW.TOP)
(\SETUPGETCH START TEXT)
(if (QP.FIND.END STREAM)
then (SETQ TOP START)
(SETQ BOTTOM (\TEXTGETFILEPTR STREAM))
(QP.END.OF.LINE STREAM)
(SETQ NEW.TOP (QP.FIND.NEXT.PRED.DOWN STREAM))
(if (NEQ NEW.TOP NIL)
then (SETQ NEW.NAME (QP.GET.PRED.NAME STREAM))
(\BACKBIN STREAM)
else (SETQ STOP T))
else (SETQ BOTTOM START)
(SETQ STOP T))
(WHILE (AND (NOT STOP)
(EQUAL NAME NEW.NAME)
(EQ ARITY (QP.FIND.ARITY.AUX STREAM TEXT NEW.TOP)))
DO (QP.FIND.END STREAM)
(SETQ BOTTOM (\TEXTGETFILEPTR STREAM))
(QP.END.OF.LINE STREAM)
(SETQ TOP NEW.TOP)
(SETQ NEW.TOP (QP.FIND.NEXT.PRED.DOWN STREAM))
(if (NEQ NEW.TOP NIL)
then (SETQ NEW.NAME (QP.GET.PRED.NAME STREAM))
(\BACKBIN STREAM)
else (SETQ STOP T)))
BOTTOM)))
(QP.FIND.END
(LAMBDA (STREAM)
(LET ((ORI.POSITION (ADD1 (\TEXTGETFILEPTR STREAM)))
(CHAR.COUNT 0)
(STOP.COUNT QP.MAX.STRING.LENGTH)
(TMP.COUNT 0)
(STOP.CHAR 0)
(STOP 0)
(PREV.CHAR 0)
(ERR NIL)
CHAR)
(WHILE (AND (ILESSP CHAR.COUNT STOP.COUNT)
(EQ STOP 0)
(NOT (EOFP STREAM)))
DO (SETQ CHAR (\BIN STREAM))
(SETQ CHAR.COUNT (ADD1 CHAR.COUNT))
(if (EQ CHAR 46)
then (SETQ STOP 1)
elseif (AND (EQ CHAR 39)
(AND (IGEQ PREV.CHAR 48)
(ILEQ PREV.CHAR 57)))
then NIL
elseif (OR (EQ CHAR 34)
(EQ CHAR 39))
then (SETQ STOP.CHAR CHAR)
(SETQ PREV.CHAR CHAR)
(SETQ CHAR (\BIN STREAM))
(SETQ TMP.COUNT 0)
(WHILE (AND (NEQ CHAR STOP.CHAR)
(ILESSP TMP.COUNT STOP.COUNT)
(NOT (EOFP STREAM)))
DO (SETQ PREV.CHAR CHAR)
(SETQ CHAR (\BIN STREAM))
(SETQ TMP.COUNT (ADD1 TMP.COUNT)))
(if (OR (EQ TMP.COUNT STOP.COUNT)
(EOFP STREAM))
then (SETQ ERR (LIST 3 (SUB1 STOP.COUNT)
STREAM))
(SETQ STOP 1))
elseif (AND (EQ CHAR 42)
(EQ PREV.CHAR 47))
then (SETQ CHAR (\BIN STREAM))
(SETQ TMP.COUNT 0)
(WHILE (AND (NOT (AND (EQ CHAR 47)
(EQ PREV.CHAR 42)))
(NOT (EOFP STREAM))
(ILESSP TMP.COUNT STOP.COUNT))
(SETQ PREV.CHAR CHAR)
(SETQ CHAR (\BIN STREAM))
(SETQ TMP.COUNT (ADD1 TMP.COUNT)))
(if (OR (EQ TMP.COUNT STOP.COUNT)
(EOFP STREAM))
then (SETQ ERR (LIST 4 (SUB1 STOP.COUNT)
STREAM))
(SETQ STOP 1))
elseif (EQ CHAR 37)
then (QP.END.OF.LINE STREAM))
(SETQ PREV.CHAR CHAR))
(if (OR ERR (AND (EOFP STREAM)
(NEQ CHAR 46)))
then (\SETUPGETCH ORI.POSITION (TEXTOBJ STREAM))
(QP.TEDIT.ERROR.MESSAGE ERR)
elseif (EOFP STREAM)
then (\TEXTGETFILEPTR STREAM)
else (ADD1 (\TEXTGETFILEPTR STREAM))))))
(QP.FIND.FIRST.PREDICATE
(LAMBDA (SELECTION)
(LET* ((TEXT (fetch (SELECTION \TEXTOBJ) of SELECTION))
(STREAM (fetch (TEXTOBJ STREAMHINT) of TEXT))
(LINE.DESC (CAR (fetch (SELECTION LN) of SELECTION)))
(FIRST (fetch (LINEDESCRIPTOR CHAR1) of LINE.DESC)))
(\SETUPGETCH (IMIN FIRST (fetch (TEXTOBJ TEXTLEN) of TEXT))
TEXT)
(QP.FIND.FIRST.PREDICATE.AUX STREAM))))
(QP.FIND.FIRST.PREDICATE.AUX
(LAMBDA (STREAM)
(LET* ((FOUND NIL)
CHAR POS)
(SETQ POS (ADD1 (\TEXTGETFILEPTR STREAM)))
(SETQ CHAR (\BIN STREAM))
(\BACKBIN STREAM)
(WHILE (AND (NEQ POS 1)
(OR (EQ CHAR 13)
(EQ CHAR 32)
(EQ CHAR 9)
(EQ CHAR 37)
(EQ CHAR 47)))
DO (\BACKBIN STREAM)
(QP.BEGINNING.OF.LINE STREAM)
(SETQ CHAR (\BIN STREAM))
(\BACKBIN STREAM)
(SETQ POS (ADD1 (\TEXTGETFILEPTR STREAM))))
(if (AND (NEQ CHAR 42)
(OR (NEQ POS 1)
(AND (EQ POS 1)
(NEQ CHAR 13)
(NEQ CHAR 32)
(NEQ CHAR 9)
(NEQ CHAR 37)
(NEQ CHAR 47))))
then (SETQ FOUND POS)
else (QP.END.OF.LINE STREAM)
(WHILE (AND (NOT (EOFP STREAM))
(OR (EQ CHAR 13)
(EQ CHAR 32)
(EQ CHAR 9)
(EQ CHAR 37)
(EQ CHAR 47)
(EQ CHAR 42)))
(SETQ CHAR (\BIN STREAM))
(\BACKBIN STREAM)
(QP.END.OF.LINE STREAM))
(if (EOFP STREAM)
then (QP.BEGINNING.OF.LINE STREAM)
else (\BACKBIN STREAM)
(QP.BEGINNING.OF.LINE STREAM)
(SETQ FOUND (ADD1 (\TEXTGETFILEPTR STREAM)))))
FOUND)))
(QP.FIND.NEXT.PRED.DOWN
(LAMBDA (STREAM)
(LET ((CHAR (QP.GET.NEXT.CHAR STREAM)))
(\BACKBIN STREAM)
(WHILE (AND (NEQ CHAR NIL)
(OR (EQ CHAR (CHARCODE EOL))
(EQ CHAR (CHARCODE SPACE))
(EQ CHAR (CHARCODE TAB))
(EQ CHAR (CHARCODE %%))
(EQ CHAR (CHARCODE /))))
DO (QP.END.OF.LINE STREAM)
(SETQ CHAR (QP.GET.NEXT.CHAR STREAM))
(\BACKBIN STREAM))
(if (NOT (NULL CHAR))
then (ADD1 (\TEXTGETFILEPTR STREAM))))))
(QP.FIND.PREDICATE
(LAMBDA (STREAM SELECTION)
(LET ((TEXT (TEXTOBJ STREAM))
(START (QP.FIND.FIRST.PREDICATE SELECTION))
(NAME (QP.GET.PRED.NAME STREAM)))
(if (NOT (EOFP STREAM))
then (\BACKBIN STREAM))
(LET* ((ARITY (QP.FIND.ARITY.AUX STREAM TEXT START))
(TOP (QP.FIND.TOP STREAM START NAME ARITY))
(BOTTOM (QP.FIND.BOTTOM STREAM START NAME ARITY)))
(TEDIT.SETSEL STREAM TOP (ADD1 (IDIFFERENCE BOTTOM TOP))
(QUOTE RIGHT))))))
(QP.FIND.TOP
(LAMBDA (STREAM TOP NAME ARITY)
(LET ((ORI.POSITION (\TEXTGETFILEPTR STREAM))
(TEXT (TEXTOBJ STREAM))
(STOP NIL)
NEW.ARITY NEW.TOP TMP)
(if (NEQ TOP 1)
then (\SETUPGETCH (SUB1 TOP)
TEXT)
(QP.BEGINNING.OF.LINE STREAM)
(WHILE (AND (NOT STOP)
(SETQ NEW.TOP (QP.FIND.FIRST.PREDICATE.AUX STREAM))
(EQUAL NAME (QP.GET.PRED.NAME STREAM)))
DO (\BACKBIN STREAM)
(SETQ NEW.ARITY (QP.FIND.ARITY.AUX STREAM TEXT NEW.TOP))
(if (AND (EQ NEW.ARITY ARITY)
(NEQ NEW.TOP TOP))
then (SETQ TOP NEW.TOP)
(if (NEQ NEW.TOP 1)
then (\SETUPGETCH (SUB1 NEW.TOP)
TEXT)
else (SETQ STOP T)
(SETQ TOP 1))
else (SETQ STOP T))))
TOP)))
(QP.GET.NEXT.CHAR
(LAMBDA (STREAM)
(if (NOT (EOFP STREAM))
then (\BIN STREAM))))
(QP.GET.PRED.NAME
(LAMBDA (STREAM)
(LET ((NAME.LIST NIL)
CHAR RESULT)
(SETQ RESULT (WHILE (AND (SETQ CHAR (\BIN STREAM))
(NOT (OR (EQ CHAR (CHARCODE %())
(EQ CHAR (CHARCODE SPACE))
(EQ CHAR (CHARCODE :))
(EQ CHAR (CHARCODE %.))
(EQ CHAR (CHARCODE LF))
(EQ CHAR (CHARCODE EOL))
(EQ CHAR (CHARCODE TAB))
(EQ CHAR (CHARCODE ,))
(EQ CHAR (CHARCODE -))
(EQ CHAR (CHARCODE %;))))
(NOT (EOFP STREAM)))
collect CHAR))
(if (NOT (EOFP STREAM))
then RESULT
else NIL))))
)
(PUTPROPS FINDPRED.LSP COPYRIGHT ("Quintus Computer Systems, Inc" 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (492 9486 (QP.BEGINNING.OF.LINE 502 . 893) (QP.END.OF.LINE 895 . 1033) (QP.FIND.BOTTOM
1035 . 2210) (QP.FIND.END 2212 . 4599) (QP.FIND.FIRST.PREDICATE 4601 . 5074) (
QP.FIND.FIRST.PREDICATE.AUX 5076 . 6534) (QP.FIND.NEXT.PRED.DOWN 6536 . 7144) (QP.FIND.PREDICATE 7146
. 7693) (QP.FIND.TOP 7695 . 8607) (QP.GET.NEXT.CHAR 8609 . 8720) (QP.GET.PRED.NAME 8722 . 9484)))))
STOP