Topic: Hierarchical print ...

[MP]

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.

[FengK]

Interesting, MP.  I'm trying to picture when I'll need something like this.  Thanks.

[MP]

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 . "}")
        )
    )
)

[Sdoman]

Interesting code MP.  Makes me think about a having a routine to pretty print a lisp file.

[MP]

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!

 

[Sdoman]

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.

[MP]

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.

[JohnK]

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

[MP]

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

??

[MP]

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)
   
)

[GDF]

Michael

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

Gary

[MP]

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.

[MP]

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.

[GDF]

Michael

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

Gary

[taner]

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!