Topic: Hierarchical print ...

[JohnK]

I think the point was for [you] to create it.
[ http://www.theswamp.org/index.php?topic=10398.msg132473#msg132473 ]
(read the last sentence in that post)

[taner]

creat dcl file

Code: [Select]

(defun creatdcl (x / _printitem _printlist _main acadfn fn)
  (setq acadfn (findfile "ACAD.PAT")
fn (strcat (substr acadfn 1 (- (strlen acadfn) 8)) "temp.dcl")
fn (open fn "w")
  )
  (defun _printitem (item)
    (cond
      (item (princ (strcat "  " item) fn) (write-line "" fn))
      (t
(princ "  { }" fn)
(write-line "" fn)
      )
    )
    (princ)
  )
  (defun _printlist (lst indents)
    (if (< -1 indents)
      (_printitem "{")
    )
    ((lambda (i)
       (foreach x lst
(_main x i)
       )
     )
     (1+ indents)
    )
    (if (< -1 indents)
      (_printitem "}")
      (princ)
    )
  )
  (defun _main (x indents)
    (if (vl-consp x)
      (if ((lambda (x)
     (and
       x
       (atom x)
     )
   )
(cdr x)
)
(_printitem x)        
(_printlist x indents)
      )
      (_printitem x)        
    )
  )
  (_main x -1)
  (close fn)
  (princ)
)


[Lee Mac]

All you have to do is code up functions to achieve steps 1 - 3.

I actually found this quite a bit more difficult than I had first anticipated...

Anyway, here is what I came up with:

Code: [Select]

(defun c:FormatDCL ( / _Read _PrinDCL _Main )
   
    (defun _Read ( file / _break line cpos alst )

        (defun _break ( line chrs / _breakit )

            (defun _breakit ( strn delm / cpos )
                (if (setq cpos (vl-string-search delm strn))
                    (vl-remove ""
                        (cons (substr strn 1 cpos)
                            (cons delm (_breakit (substr strn (+ 2 cpos)) delm))
                        )
                    )
                    (list strn)
                )
            )

            (if (cdr chrs)
                (apply 'append
                    (mapcar '(lambda ( x ) (_break x (cdr chrs))) (_breakit line (car chrs)))
                )
                (_breakit line (car chrs))
            )
        )
       
        (if (setq file (open file "r"))
            (progn
                (while (setq line (read-line file))
                    (cond
                        (   (setq cpos (vl-string-search "//" line))
                            (setq line (substr line 1 cpos))
                        )
                        (   (setq cpos (vl-string-search "/*" line))
                            (setq _str (substr line 1 cpos))
                            (while
                                (and line
                                    (not (setq cpos (vl-string-search "*/" line)))
                                )
                                (setq line (read-line file))
                            )
                            (if line
                                (setq str_ (substr line (+ 3 cpos)))
                                (setq str_ "")
                            )
                            (setq line (strcat _str str_))
                        )
                    )
                    (setq alst
                        (append alst
                            (vl-remove-if 'null
                                (mapcar
                                    (function
                                        (lambda ( x )
                                            (setq x (vl-string-trim " " x))
                                            (cond
                                                (   (member x '("{" "}"))
                                                    x
                                                )
                                                (   (< 0 (strlen x))
                                                    (vl-prin1-to-string (vl-string-trim " " x))
                                                )
                                            )
                                        )
                                    )
                                    (_break line '("{" "}"))
                                )
                            )
                        )
                    )
                )
                (setq file (close file))
            )
        )
        alst
    )

    ;; _PrinDcl by MP
    ;; http://www.theswamp.org/index.php?topic=10398.msg132473#msg132473

    (defun _PrinDcl ( x / _PrintItem _PrintList _Main )

        (defun _PrintItem ( _PrintMethod item indents )
            (cond
                (   item
                    (princ "\n")
                    (repeat indents (princ "    "))
                    (_PrintMethod item)
                )
                (   (princ " { }")  )
            )   
            (princ)
        )
       
        (defun _PrintList ( _PrintMethod lst indents )
            (if (< -1 indents) (_PrintItem _PrintMethod "{" indents))
            ((lambda ( i ) (foreach x lst (_Main x i))) (1+ indents))
            (if (< -1 indents) (_PrintItem _PrintMethod "}" indents) (princ))
        )
       
        (defun _Main ( x indents )   
            (if (vl-consp x)
                (if ((lambda ( x ) (and x (atom x))) (cdr x))
                    (_PrintItem princ x indents)
                    (_PrintList princ x indents)
                )   
                (_PrintItem princ x indents)
            )
        )

        (_Main x -1)
       
    )

    (defun _Main ( / file )
        (if (setq file (getfiled "Select DCL File" "" "dcl" 16))
            (_PrinDCL
                (read
                    (strcat "(" (vl-string-translate "{}" "()" (apply 'strcat (_Read file))) ")")
                )
            )
            (princ "\n*Cancel*")
        )
        (princ)
    )

    (_Main)
)

Function will read a selected DCL file and print a formatted version to the command-line.

@MP: Fantastic work with the Prin* functions, I really like the cross-recursive call. 

[MP]

Bwaaaaaa, lmao ... 5 years later proves useful. 

Nice work + thanks for the nod Lee.

[Lee Mac]

Bwaaaaaa, lmao ... 5 years later proves useful. 

Better late than never 

Nice work + thanks for the nod Lee.

Thanks dude