TheSwamp

Code Red => AutoLISP (Vanilla / Visual) => Topic started by: MP on June 01, 2006, 11:21:02 PM

Title: Hierarchical print ...
Post by: MP on June 01, 2006, 11:21:02 PM
I needed a quick function today to print a list's hierarchy (data in native format; i.e. prin1) so I could discern a deeply nested structure. I wrote it quick and dirty and it surely could be optimized (example don't calculate (chr 40|41) each call, use foreach instead of mapcar ... ). You're welcome | invited to do so if you're inclined but it's been a long day for me so I'm opting out.

Without further blather --

Code: [Select]
(defun Prinh ( x / _PrintItem _PrintList _Main )

    (defun _PrintItem ( _PrintMethod item indents )
        (princ "\n")
        (repeat indents (princ "    "))
        (_PrintMethod item)
        (princ)
    )
   
    (defun _PrintList ( _PrintMethod lst indents )
        (_PrintItem _PrintMethod (chr 40) indents)
        (mapcar '(lambda (x) (_Main x (1+ indents))) lst)
        (_PrintItem _PrintMethod (chr 41) indents)
    )
   
    (defun _Main ( x indents )   
        (if (vl-consp x)
            (if ((lambda (x) (and x (atom x))) (cdr x))
                (_PrintItem prin1 x indents)
                (_PrintList princ x indents)
            )   
            (_PrintItem prin1 x indents)
        )
    )

    (_Main x 0)
   
)

Examples --

Code: [Select]
;;  print a non list item

(prinh pi)

3.14159

Code: [Select]
;;  print a simple flat list --

(prinh '(0 1 2))

(
    0
    1
    2
)

Code: [Select]
;;  print a nested list --

(prinh '(0 (1 (2 (3 (4 (5 (6 (7)))))))))

(
    0
    (
        1
        (
            2
            (
                3
                (
                    4
                    (
                        5
                        (
                            6
                            (
                                7
                            )
                        )
                    )
                )
            )
        )
    )
)

fwiw; cheers.
Title: Re: Hierarchical print ...
Post by: FengK on June 02, 2006, 02:13:39 AM
Interesting, MP.  I'm trying to picture when I'll need something like this.  Thanks.
Title: Re: Hierarchical print ...
Post by: MP on June 02, 2006, 06:55:53 AM
One example could be entity data, in particular when xdata, xdictionaries or xrecords are involved.

Here's a simple example using a viewport with frozen layers (cut down a bit in the interests of brevity) --

Code: [Select]
(defun c:ListH ( / ename )
(if (setq ename (car (entsel)))
(prinh (entget ename '("*")))
)
)

Code: [Select]
(
(-1 . <Entity name: 7ef84f98>)
(0 . "VIEWPORT")
(330 . <Entity name: 7ef84d40>)
(5 . "AB")
(100 . "AcDbEntity")
(67 . 1)
(410 . "Layout1")
(8 . "0")
(100 . "AcDbViewport")
(
10
2.72966
2.78451
0.0
)
(40 . 2.35338)
...
(72 . 1000)
(331 . <Entity name: 7ef84c80>)
(331 . <Entity name: 7ef88090>)
(331 . <Entity name: 7ef88098>)
...
(170 . 0)
(
-3
(
"ACAD"
(1000 . "MVIEW")
(1002 . "{")
(1070 . 16)
(
1010
0.0
0.0
0.0
)
...
(1070 . 0)
(1002 . "{")
(1003 . "Lions")
(1003 . "Tigers")
(1003 . "And")
(1003 . "Bears")
(1003 . "Oh")
(1003 . "My!")
(1002 . "}")
(1002 . "}")
)
)
)
Title: Re: Hierarchical print ...
Post by: Sdoman on June 02, 2006, 08:10:11 AM
Interesting code MP.  Makes me think about a having a routine to pretty print a lisp file.
Title: Re: Hierarchical print ...
Post by: MP on June 02, 2006, 08:18:19 AM
Interesting code MP.  Makes me think about a having a routine to pretty print a lisp file.

Code: [Select]
(defun-q Prinh ( x / _PrintItem _PrintList _Main )

    (defun _PrintItem ( _PrintMethod item indents )
        (princ "\n")
        (repeat indents (princ "    "))
        (_PrintMethod item)
        (princ)
    )
   
    (defun _PrintList ( _PrintMethod lst indents )
        (_PrintItem _PrintMethod (chr 40) indents)
        (mapcar '(lambda (x) (_Main x (1+ indents))) lst)
        (_PrintItem _PrintMethod (chr 41) indents)
    )
   
    (defun _Main ( x indents )   
        (if (vl-consp x)
            (if ((lambda (x) (and x (atom x))) (cdr x))
                (_PrintItem prin1 x indents)
                (_PrintList princ x indents)
            )   
            (_PrintItem prin1 x indents)
        )
    )

    (_Main x 0)
   
)

(prinh prinh)

Code: [Select]
(
    (
        X
        /
        _PRINTITEM
        _PRINTLIST
        _MAIN
    )
    (
        DEFUN
        _PRINTITEM
        (
            _PRINTMETHOD
            ITEM
            INDENTS
        )
        (
            PRINC
            "\n"
        )
        (
            REPEAT
            INDENTS
            (
                PRINC
                "    "
            )
        )
        (
            _PRINTMETHOD
            ITEM
        )
        (
            PRINC
        )
    )
    (
        DEFUN
        _PRINTLIST
        (
            _PRINTMETHOD
            LST
            INDENTS
        )
        (
            _PRINTITEM
            _PRINTMETHOD
            (
                CHR
                40
            )
            INDENTS
        )
        (
            MAPCAR
            (
                QUOTE
                (
                    LAMBDA
                    (
                        X
                    )
                    (
                        _MAIN
                        X
                        (
                            1+
                            INDENTS
                        )
                    )
                )
            )
            LST
        )
        (
            _PRINTITEM
            _PRINTMETHOD
            (
                CHR
                41
            )
            INDENTS
        )
    )
    (
        DEFUN
        _MAIN
        (
            X
            INDENTS
        )
        (
            IF
            (
                VL-CONSP
                X
            )
            (
                IF
                (
                    (
                        LAMBDA
                        (
                            X
                        )
                        (
                            AND
                            X
                            (
                                ATOM
                                X
                            )
                        )
                    )
                    (
                        CDR
                        X
                    )
                )
                (
                    _PRINTITEM
                    PRIN1
                    X
                    INDENTS
                )
                (
                    _PRINTLIST
                    PRINC
                    X
                    INDENTS
                )
            )
            (
                _PRINTITEM
                PRIN1
                X
                INDENTS
            )
        )
    )
    (
        _MAIN
        X
        0
    )
)

Funny, almost looks like my vertical coding style; bwaaa!

 :-D
Title: Re: Hierarchical print ...
Post by: Sdoman on June 02, 2006, 08:36:54 AM

Funny, almost looks like my vertical coding style; bwaaa!


Niceness.  It does resemble your formatting style a little.  Just noticed too, the subtle change of switching to Defun-q so that the actual code can be manipulated.
Title: Re: Hierarchical print ...
Post by: MP on June 02, 2006, 09:49:44 AM
Just noticed too, the subtle change of switching to Defun-q so that the actual code can be manipulated.

Wasn't that I wanted to be able to manipulate prinh, I just wanted to demonstrate you could walk a function's code if were defuned by defun-q. Rather than pen a contrived sample function using defun-q for prinh to examine, I thought it would be fun to have prinh look up its own skirt.

:)
Title: Re: Hierarchical print ...
Post by: JohnK on June 02, 2006, 10:05:33 AM
Command: (defun prinh_2 (x)
(_>    (if (atom x)
((_>      x
((_>      (cons (prinh_2 (car x))
(((_>            (prinh_2 (cdr x)))) )
PRINH_2

Command: (prinh_2 pi)
3.14159

Command: (prinh_2 '(1 2 3 (4 5 (6 7)) 8 9 (0)))
(1 2 3 (4 5 (6 7)) 8 9 (0))

Command: (prinh_2 3.14)
3.14
Title: Re: Hierarchical print ...
Post by: MP on June 02, 2006, 10:14:30 AM
Command: (defun prinh_2 (x)
(_>    (if (atom x)
((_>      x
((_>      (cons (prinh_2 (car x))
(((_>            (prinh_2 (cdr x)))) )
PRINH_2

Command: (prinh_2 pi)
3.14159

Command: (prinh_2 '(1 2 3 (4 5 (6 7)) 8 9 (0)))
(1 2 3 (4 5 (6 7)) 8 9 (0))

Command: (prinh_2 3.14)
3.14

??
Title: Re: Hierarchical print ...
Post by: MP on June 02, 2006, 10:18:28 AM
fwiw, this is what I ended up putting in my library. It's not the most concise but it seems to run reliably, reasonably quickly AND I can understand it.

Code: [Select]
(defun Prinh ( x / _PrintItem _PrintList _Main )

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

    (_Main x 0)
   
)
Title: Re: Hierarchical print ...
Post by: GDF on June 02, 2006, 11:39:36 AM
Michael

This maybe a stupid question on my part, but I will ask anyway. Could this routine be used on a dcl code?

Gary
Title: Re: Hierarchical print ...
Post by: MP on June 02, 2006, 07:23:19 PM
Hi Gary.

It's not a stupid question, I could see how a function that hiearchically displays dcl code might be useful for development / debugging purposes. However, as currently coded, prinh could not be used on dcl code directly.

- Michael.
Title: Re: Hierarchical print ...
Post by: MP on June 03, 2006, 12:45:57 PM
Hey Gary --

IF you preprocessed a dcl definition a slight mod to prinh might work for you.

Example, a standard AutoCAD dcl definition (from tblname.dcl) --

Code: [Select]
tblname : dialog
{
 label = "";
 key="dlgTitle";
 : column
 {
  : spacer {}
  : text_part
  {
    key="msg";
    label="";
  }
 
  : boxed_column {

     fixed_width=true;
     width=50;

     : list_box {
        key="name_list";
     }
     : row {
       : button {
         fixed_width=true;
         width=5;
         key="pickit";
         label= "&Pick<";
         alignment=left;
       }
       : edit_box {
         key="name";
         is_default=true;
         edit_limit=256;
         alignment=left;
         fixed_width=true;
         width=41;
       }
     } //row
     : spacer {}
  } // boxed column

  : row
  {
     : spacer {}
     : button {
        fixed_width=true;
        width=11;
        key="accept";
        label= "OK";
      }
     : button {
        fixed_width=true;
        width=11;
        is_cancel=true;
        key="cancel";
        label= "Cancel";
      }
     : button {
        fixed_width=true;
        width=11;
        key="help";
        label= "&Help";
        is_help=true;
     }
     : spacer {}
  } // row

  : text_part
  {
    key="error";
    label="";
  }
 } // column
}

Step 1:
trim leading/trailing space
force statements / braces to their own line
delete comments
replace quotes (") with backslash quote (\")

Code: [Select]
tblname : dialog
{
label = \"\";
key=\"dlgTitle\";
: column
{
: spacer
{
}
: text_part
{
key=\"msg\";
label=\"\";
}
: boxed_column
{
fixed_width=true;
width=50;
: list_box
{
key=\"name_list\";
}
: row
{
: button
{
fixed_width=true;
width=5;
key=\"pickit\";
label= \"&Pick<\";
alignment=left;
}
: edit_box
{
key=\"name\";
is_default=true;
edit_limit=256;
alignment=left;
fixed_width=true;
width=41;
}
}
: spacer
{
}
}
: row
{
: spacer
{
}
: button
{
fixed_width=true;
width=11;
key=\"accept\";
label= \"OK\";
}
: button
{
fixed_width=true;
width=11;
is_cancel=true;
key=\"cancel\";
label= \"Cancel\";
}
: button
{
fixed_width=true;
width=11;
key=\"help\";
label= \"&Help\";
is_help=true;
}
: spacer
{
}
}
: text_part
{
key=\"error\";
label=\"\";
}
}
}

Step 2:
enclose all lines in quotes except brace lines
convert braces { } to parenthesis ( )

Code: [Select]
"tblname : dialog"
(
"label = \"\";"
"key=\"dlgTitle\";"
": column"
(
": spacer"
(
)
": text_part"
(
"key=\"msg\";"
"label=\"\";"
)
": boxed_column"
(
"fixed_width=true;"
"width=50;"
": list_box"
(
"key=\"name_list\";"
)
": row"
(
": button"
(
"fixed_width=true;"
"width=5;"
"key=\"pickit\";"
"label= \"&Pick<\";"
"alignment=left;"
)
": edit_box"
(
"key=\"name\";"
"is_default=true;"
"edit_limit=256;"
"alignment=left;"
"fixed_width=true;"
"width=41;"
)
)
": spacer"
(
)
)
": row"
(
": spacer"
(
)
": button"
(
"fixed_width=true;"
"width=11;"
"key=\"accept\";"
"label= \"OK\";"
)
": button"
(
"fixed_width=true;"
"width=11;"
"is_cancel=true;"
"key=\"cancel\";"
"label= \"Cancel\";"
)
": button"
(
"fixed_width=true;"
"width=11;"
"key=\"help\";"
"label= \"&Help\";"
"is_help=true;"
)
": spacer"
(
)
)
": text_part"
(
"key=\"error\";"
"label=\"\";"
)
)
)

Step 3
enclose the whole mess in quoted list '( ... )
assign to a variable

Code: [Select]
(setq dcldef
   '(
        "tblname : dialog"
        (
        "label = \"\";"
        "key=\"dlgTitle\";"
        ": column"
        (
        ": spacer"
        (
        )
        ": text_part"
        (
        "key=\"msg\";"
        "label=\"\";"
        )
        ": boxed_column"
        (
        "fixed_width=true;"
        "width=50;"
        ": list_box"
        (
        "key=\"name_list\";"
        )
        ": row"
        (
        ": button"
        (
        "fixed_width=true;"
        "width=5;"
        "key=\"pickit\";"
        "label= \"&Pick<\";"
        "alignment=left;"
        )
        ": edit_box"
        (
        "key=\"name\";"
        "is_default=true;"
        "edit_limit=256;"
        "alignment=left;"
        "fixed_width=true;"
        "width=41;"
        )
        )
        ": spacer"
        (
        )
        )
        ": row"
        (
        ": spacer"
        (
        )
        ": button"
        (
        "fixed_width=true;"
        "width=11;"
        "key=\"accept\";"
        "label= \"OK\";"
        )
        ": button"
        (
        "fixed_width=true;"
        "width=11;"
        "is_cancel=true;"
        "key=\"cancel\";"
        "label= \"Cancel\";"
        )
        ": button"
        (
        "fixed_width=true;"
        "width=11;"
        "key=\"help\";"
        "label= \"&Help\";"
        "is_help=true;"
        )
        ": spacer"
        (
        )
        )
        ": text_part"
        (
        "key=\"error\";"
        "label=\"\";"
        )
        )
        )
    )   
)

Step 4
message the prinh function to suit (a very fast stab)

Code: [Select]
(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) ;; formerly prin1
                (_PrintList princ x indents)
            )   
            (_PrintItem princ x indents) ;; formerly prin1
        )
    )

    (_Main x -1)
   
)

Step 5
Run it

Code: [Select]
(PrinDCL dcldef)
Result

Code: [Select]
tblname : dialog
{
    label = "";
    key="dlgTitle";
    : column
    {
        : spacer ()
        : text_part
        {
            key="msg";
            label="";
        }
        : boxed_column
        {
            fixed_width=true;
            width=50;
            : list_box
            {
                key="name_list";
            }
            : row
            {
                : button
                {
                    fixed_width=true;
                    width=5;
                    key="pickit";
                    label= "&Pick<";
                    alignment=left;
                }
                : edit_box
                {
                    key="name";
                    is_default=true;
                    edit_limit=256;
                    alignment=left;
                    fixed_width=true;
                    width=41;
                }
            }
            : spacer { }
        }
        : row
        {
            : spacer { }
            : button
            {
                fixed_width=true;
                width=11;
                key="accept";
                label= "OK";
            }
            : button
            {
                fixed_width=true;
                width=11;
                is_cancel=true;
                key="cancel";
                label= "Cancel";
            }
            : button
            {
                fixed_width=true;
                width=11;
                key="help";
                label= "&Help";
                is_help=true;
            }
            : spacer { }
        }
        : text_part
        {
            key="error";
            label="";
        }
    }
}

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

:)
Title: Re: Hierarchical print ...
Post by: GDF on June 05, 2006, 10:30:31 AM
Michael

Thanks...I was hoping this could be done.

Gary
Title: Re: Hierarchical print ...
Post by: taner on June 19, 2008, 09:20:45 AM
Hi Gary.

It's not a stupid question, I could see how a function that hiearchically displays dcl code might be useful for development / debugging purposes. However, as currently coded, prinh could not be used on dcl code directly.

- Michael.

Dear MP,

Could you please change the code to automatively creat dcl file? tks!
Title: Re: Hierarchical print ...
Post by: JohnK on June 19, 2008, 09:44:04 AM
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)
Title: Re: Hierarchical print ...
Post by: taner on June 19, 2008, 10:10:24 PM
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)
)
Title: Re: Hierarchical print ...
Post by: Lee Mac on August 14, 2011, 06:54:01 PM
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.  :-)
Title: Re: Hierarchical print ...
Post by: MP on August 15, 2011, 08:17:45 AM
Bwaaaaaa, lmao ... 5 years later proves useful.  :lmao:

Nice work + thanks for the nod Lee. :)
Title: Re: Hierarchical print ...
Post by: Lee Mac on August 15, 2011, 09:56:09 AM
Bwaaaaaa, lmao ... 5 years later proves useful.  :lmao:

Better late than never  :lol:

Nice work + thanks for the nod Lee. :)

Thanks dude  :-)