Subject: Re: Q 4 LISP GURUs: EED retreival Date: Wed, 29 Jan 1997 00:00:00 GMT From: Serge Volkov Organization: Basis Software, Inc. To: Vladimir Nesterovsky Newsgroups: comp.cad.autocad Vladimir Nesterovsky wrote: > > Hello to all LISP gurus! > > Consider xdata put/retreival system capable of storing list > of ANY structure in EED (R12 compatible, so no fancy xrecords here!). > > Storage is simple with automatic type detection i.e. > (defun make-xlist(val) > (cond > ((null val) '(1000 . "*NIL*")) > ((atom val) > (case (type val) '( ;;in AutoLISP > ('INT (cons 1070 val)) > ('REAL (cons 1040 val)) > ('STR (cons 1000 val)) ))) > ((atom (cdr val)) val) ;;keep it as it is (MUST be valid DXF group) > (T (append > '((1002 . "{")) > (mapcar 'make-xlist val) > '((1002 . "}") )))) > and then obvious manipulations. > > When receiving data from EED, after some MAPCAR 'CDR etc, > I eventually get i.e. for '("some" ("data" 1 2 (3.0))) list > -->> '("{" "some" "{" "data" 1 2 "{" 3.0 "}" "}" "}") > (OR you may see an example for it in ACAD EED on VIEWPORT > entity with a list of CV frozen layers). > > NOW THE _BIG_ QUESTION: > how can I translate the curly braces BACK into parens ??? > > I gave up on doing this in LISP, and did it in ADS with > plain resbuf substitution, but it would be nice to see > how it can be done in LISP, with all the recursions, MAPCARs and LAMBDAs. :) > > Any takers?? > > The winner gets the glory and admiration of us all. :) > (this is also a FAQ candidate). You asked it! There two solutions below, choose one -- up to your taste :) Regards Serge Volkov ;;; ;;; (DE-PLAIN LST) ;;; (DE-PLAIN-TR LST) ;;; Reads tokens from list stream LST to ;;; build (first) list (with sublists) enclosed ;;; with "{" and "}" ;;; ;|{ Example: _$ (DE-PLAIN '("{" "some" "{" "data" 1 2 "{" 3.0 "}" "}" "}")) ("some" ("data" 1 2 (3.0))) }|; ;;; ;;; Constants ;;; (setq *LEFT-PAR* "{" *RIGHT-PAR* "}" ) ;;; ;;; Error signaling helper ;;; (defun error-exit (msg-list / *error*) (setq *error* (lambda (s) (princ))) (princ "; ERROR:") (foreach e msg-list (princ " ") (princ e)) (terpri) (exit) ) ;;; ;;; Natural solution ;;; (defun de-plain (lst / sublists res) (if (not (= (car lst) *LEFT-PAR*)) (error-exit (list "must be left brace:" (car lst))) ) (setq sublists (list nil)) (foreach e (cdr lst) (cond ((null sublists) ;; just ignore extra item nil ) ((= e *LEFT-PAR*) ;; push new (empty) sublist on stack (setq sublists (cons nil sublists)) ) (t (if (= e *RIGHT-PAR*) ;; pop current sublist from top of stack (setq e (reverse (car sublists)) sublists (cdr sublists) ) ) (if (null sublists) ;; then ;; store the result (setq res e) ;; else ;; add the item to the current sublist (setq sublists (cons (cons e (car sublists)) (cdr sublists) ) ) ) ) ;_ ) ;_ end of cond ) ;_ end of foreach (if (not (null sublists)) (error-exit (list (length sublists) "unmatched left brace(s)" ) ) ) res ) ;;; ;;; DE-PLAIN-TR: tail recursion implementation ;;; (defun de-plain-tr (lst) (if (= (car lst) *LEFT-PAR*) (_4de-plain (cdr lst) (list nil)) (error-exit (list "must be left brace:" (car lst))) ;_ ) ;_ ) (defun _4de-plain (lst sub / e) (cond ((null lst) (error-exit (list (length sub) ;_ "unmatched left brace(s)" ) ) ) ((= (setq e (car lst)) *LEFT-PAR*) (_4de-plain (cdr lst) (cons nil sub)) ) (t (if (= e *RIGHT-PAR*) (setq e (reverse (car sub)) sub (cdr sub) ) ) (if (null sub) e ; the result (_4de-plain (cdr lst) (cons (cons e (car sub)) (cdr sub)) ) ) ) ;_ ) ;_ end of cond ) ;;; EOF