(FILECREATED " 8-Feb-86 15:23:59" {DSK}<LISPFILES2>IMPROVEDDCOMS>FINDPRED.;1 6699
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 COPYRIGHT ("Quintus Computer Systems, Inc" 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (481 6608 (QP.BEGINNING.OF.LINE 491 . 751) (QP.END.OF.LINE 753 . 845) (QP.FIND.BOTTOM
847 . 1698) (QP.FIND.END 1700 . 3278) (QP.FIND.FIRST.PREDICATE 3280 . 3646) (
QP.FIND.FIRST.PREDICATE.AUX 3648 . 4578) (QP.FIND.NEXT.PRED.DOWN 4580 . 4989) (QP.FIND.PREDICATE 4991
. 5424) (QP.FIND.TOP 5426 . 6052) (QP.GET.NEXT.CHAR 6054 . 6138) (QP.GET.PRED.NAME 6140 . 6606)))))
STOP