perm filename MAKDRA[1,LMM] blob sn#022520 filedate 1973-02-02 generic text, type T, neo UTF8
  (PROGN (LISPXPRIN1 (QUOTE "FILE CREATED ")
                     T)
         (LISPXPRIN1 (QUOTE " 2-FEB-73  4:21:28")
                     T)
         (LISPXTERPRI T))
  (LISPXPRINT (QUOTE MAKDRAWVARS)
              T)
  (RPAQQ MAKDRAWVARS ((FNS FOO PRINN)))
(DEFINEQ

(FOO
  [LAMBDA (FILIN FILOUT)
    (PROG (X)
          (SETQ STRUCNUM 0)
          (INFILE FILIN)
          (OUTFILE FILOUT)
      LP  (SETQ X (NLSETQ (READ)))
          [COND
            ((NOT X)
              (RETURN (QUOTE DONE.]
          (SETQ X (CAR X))
          [PROG ([Y (MAPCAR (CADR (CAR X))
                            (FUNCTION (LAMBDA (Z)
                                (CAR (CADDR Z]
                 (CNT 0))
                (MAPC
                  X
                  (FUNCTION (LAMBDA (XX)
                      (PRINN (LENGTH (CADR XX))
                             5)
                      (TERPRI)
                      [MAPC (CADR XX)
                            (FUNCTION (LAMBDA (Z)
                                (PRINN (CAR (CDR Z))
                                       3)
                                (SPACES 1)
                                [PRIN1 (CAR (CADR (CDR Z]
                                (TAB 6)
                                [MAPC (CDDR (CDR Z))
                                      (FUNCTION (LAMBDA (ZZ)
                                          (PRINN ZZ 3]
                                (TERPRI]
                      (COND
                        (Y
                          (PRIN1 "  ")
                          (PRIN1 (LENGTH X))
                          (PRIN1 " STRUCTURES WITH ")
                          [MAP
                            (SORT Y)
                            (FUNCTION (LAMBDA (K)
                                (COND
                                  ((EQ (CAR K)
                                       (CADR K))
                                    (SETQ CNT (ADD1 CNT)))
                                  (T (COND
                                       ((NOT (ZEROP CNT))
                                         (PRIN1 (ADD1 CNT))
                                         (SPACES 1)
                                         (PRIN1 (CAR K))
                                         (PRIN1 "'S, "))
                                       (T (PRIN1 "1 ")
                                          (PRIN1 (CAR K))
                                          (PRIN1 ", ")))
                                     (SETQ CNT 0]
                          (SETQ Y)
                          (PRIN1 
                     "
------------------------------------------
")))
                      (PRIN1 " STRUCTURE #")
                      (PRINT (SETQ STRUCNUM (IPLUS 1 STRUCNUM)))
                      (PRIN1 "END*
"]
          (GO LP])

(PRINN
  [LAMBDA (N L)
    (SPACES (IDIFFERENCE L (NCHARS N)))
    (PRIN1 N])
)
STOP