Convert dcl file to lisp file

[rlx]

One lisp file is better than two : a lisp file and a dcl file. But I have tons of dcl files so just for fun (Grrr knows all about fun) decided to make a tiny lisp in my lunch break to make this just a little bit more easier for me, myself and I. Probably not the first with this idea , haven't checked it (maybe I should have...) , also haven't tested it much (also should have done this) but hey , almost weekend... so go check youself!

; RLX - 25 Jan 2019 - just another luchtime fun
(defun RLX_Convert_Dcl ( / dcl-fn dcl-fp lsp-fn lsp-fp dir base inp)
  (if (and (setq dcl-fn (getfiled "Select DCL file" "" "dcl" 0)) (setq dcl-fp (open dcl-fn "r"))
    (setq lsp-fn (strcat (setq dir (car (fnsplitl dcl-fn))) (setq base (cadr (fnsplitl dcl-fn))) "_dcl.lsp"))
    (setq lsp-fp (open lsp-fn "w")))
    (progn
      (princ (strcat "(defun " base "_Write_Dialog ( )\n  (if (and (setq " base "-fn " "(vl-filename-mktemp ") lsp-fp)
      (prin1 (strcat base ".dcl") lsp-fp) (princ (strcat ")) (setq " base "-fp (open " base "-fn \"w\")))\n") lsp-fp)
      (princ (strcat "    (mapcar \n      '(lambda (x)(write-line x " base "-fp))\n       (list\n") lsp-fp)
      (while (setq inp (read-line dcl-fp)) (princ "         " lsp-fp)(prin1 inp lsp-fp)(princ "\n" lsp-fp))
      (princ (strcat "      )\n    )\n  )\n  (if " base "-fp (close " base "-fp))\n)") lsp-fp)
      (close dcl-fp)(close lsp-fp)(gc)
    )
  )
  (if (and lsp-fn (findfile lsp-fn))(startapp "notepad" lsp-fn))
  (princ)
)

 

; (RLX_Convert_Dcl)

 

 

; original dcl file name : rlx.dcl
; rlx : dialog
;   { label = "RLX (RLX Jan'19)";
;   : list_box { key = "lb"; }
;   ok_cancel;
;   }

 

 

; converted to rlx_dcl.lsp:
;(defun rlx_Write_Dialog ( )
;  (if (and (setq rlx-fn (vl-filename-mktemp "rlx.dcl")) (setq rlx-fp (open rlx-fn "w")))
;    (mapcar
;      '(lambda (x)(write-line x rlx-fp))
;       (list
;         "rlx : dialog"
;         "  { label = \"RLX (RLX Jan'19)\";"
;         "  : list_box { key = \"lb\"; }"
;         "  ok_cancel;"
;         "  }"
;      )
;    )
;  )
;  (if rlx-fp (close rlx-fp))
; )

 

[Grrr]

Nice idea, Rlx!   :exitedmaniacemoji:

If I remember correctly you had a similar routine for DCL previewing.. .

And I never attempted something like that so here it goes -

; LispWrapperForDCL
(defun C:test ( / *error* src Sdes lsp Ddes row L tmp )
  
  (defun *error* ( m )
    (and (eq 'FILE (type Sdes)) (close Sdes))
    (and (eq 'FILE (type Ddes)) (close Ddes))
    (and (eq 'STR (type lsp)) (findfile lsp) (vl-file-delete lsp))
    (and m (princ m)) (princ)
  ); defun *error*
  
  (cond 
    ( (not (setq src (getfiled "Specify DCL file" (strcat (getenv "userprofile") "\\Desktop\\") "dcl" 16))) (prompt "\nDCL file not specified.") )
    ( (not (setq Sdes (open src "R"))) (prompt "\nUnable to open the DCL file for reading.") )
    (
      (not
        (princ ""
          (setq Ddes
            (open
              (setq lsp
                ( (lambda (s / i tmp) (setq i 0) (while (findfile (setq tmp (strcat s "_" (itoa i) ".lsp"))) (setq i (1+ i))) tmp)
                  (apply (function (lambda (a b c) (vl-string-translate "/" "\\" (strcat a b)))) (fnsplitl src)) 
                )
              ); setq lsp
              "W"
            ); open
          ); setq Ddes
        ); princ
      ); not 
      (if lsp 
        (prompt (strcat "\nUnable to open '" lsp "' for writing."))
        (prompt "\nUnable to generate the '.lsp' file.")
      )
    )
    (t
      ;|
      (while (setq row (read-line Sdes)) 
        (write-line 
          (if (/= "" row) 
            (vl-list->string (append '(34) (apply 'append (subst '(92 34) '(34) (mapcar 'list (vl-string->list row)))) '(34)))
            row
          ); if
          Ddes
        ); write-line
      ); while 
      |;
      
      (while (setq row (read-line Sdes)) 
        (setq L
          (cons
            (if (/= "" row) 
              (vl-list->string (append '(34) (apply 'append (subst '(92 34) '(34) (mapcar 'list (vl-string->list row)))) '(34)))
              ; (vl-list->string (append '(34) (vl-string->list row) '(34)))
              row
            ); if
            L
          )
        ); L
      ); while 
      (setq L (reverse L))
      
      
      (foreach x 
        '("(defun C:test_LispWrapperForDCL ( / *error* dcl des dch dcf )" 
          (defun *error* ( m )
            (and (< 0 dch) (unload_dialog dch))
            (and (eq 'FILE (type des)) (close des))
            (and (eq 'STR (type dcl)) (findfile dcl) (vl-file-delete dcl))
            (and m (princ m)) (princ)
          ); defun *error*
          "(and"
          (setq dcl (vl-filename-mktemp nil nil ".dcl")) 
          (setq des (open dcl "W"))
          "(progn"
          "(foreach x " L
          (write-line x des)
          "); foreach"
          "T"
          "); progn"
          (not (setq des (close des)))
          (setq dch (load_dialog dcl))
          (new_dialog "test" dch)
          (= 1 (setq dcf (start_dialog)))
          "); and"
          (*error* null) ; <- use "null" instead of "nil", else its buggy!
          (princ)
          "); defun"
        ); list
        (cond 
          ( (eq 'STR (type x)) 
            (and (setq tmp (vl-string->list x)) (not (apply '= (cons 32 tmp))) (write-line x Ddes) )
          )
          ( (= x 'L) (foreach x (append '("'(") (eval x) '(")")) (write-line x Ddes)) )
          ( (vl-consp x) 
            (princ "(" Ddes)
            (foreach x (list (car x) (cadr x) (caddr x))
              (if x
                (princ (strcat (strcase (vl-prin1-to-string x) t) " ") Ddes)
              )
            ) 
            (mapcar '(lambda (x) (write-line (strcase (vl-prin1-to-string x) t) Ddes)) (cdddr x))
            (write-line ")" Ddes)
          )
        )
      ); foreach 
      
      ((lambda (L) (mapcar 'set L (mapcar 'close (mapcar 'eval L)))) '(Sdes Ddes))
      
      (
        (lambda ( fpath / shell )
          (if fpath
            (vl-catch-all-apply
              (function
                (lambda nil
                  (setq shell (vlax-get-or-create-object "Shell.Application"))
                  (vlax-invoke-method shell 'Open fpath)
                )
              )
            )
          )
          (vl-catch-all-apply 'vlax-release-object (list shell))
        )
        lsp
      )
      (load lsp)
      (if C:test_LispWrapperForDCL 
        (C:test_LispWrapperForDCL)
        (alert "Unable to define the generated lisp!")
      )
      (setq lsp nil)
      
    ); t
  )
  (*error* nil) (princ)
); defun 

 

 test.dcl :

// original dcl file name : "test.dcl"
/*
rlx: "Arbeit macht SpaB"
*/
test : dialog
{ label = "RLX (RLX Jan'19)";
: list_box { key = "lb"; }
  ok_cancel;
}  

 

test.lsp (converted) :

(defun C:test_LispWrapperForDCL ( / *error* dcl des dch dcf )
(defun *error* (m) (and (< 0 dch) (unload_dialog dch))
(and (eq (quote file) (type des)) (close des))
(and (eq (quote str) (type dcl)) (findfile dcl) (vl-file-delete dcl))
(and m (princ m))
(princ)
)
(and
(setq dcl (vl-filename-mktemp nil nil ".dcl") )
(setq des (open dcl "w") )
(progn
(foreach x 
'(
"// original dcl file name : \"test.dcl\""
"/*"
"  rlx: \"Arbeit macht SpaB\""
"*/"
"test : dialog"
"{ label = \"RLX (RLX Jan'19)\";"
"  : list_box { key = \"lb\"; }"
"  ok_cancel;"
"}  "
)
(write-line x des )
); foreach
T
); progn
(not (setq des (close des)) )
(setq dch (load_dialog dcl) )
(new_dialog "test" dch )
(= 1 (setq dcf (start_dialog)) )
); and
(*error* null )
(princ )
); defun

 

I like the ideas you share from your lunch brakes! 

[rlx]

20 minutes ago, Grrr said:

Nice idea, Rlx!   :exitedmaniacemoji:

If I remember correctly you had a similar routine for DCL previewing.. .

And I never attempted something like that so here it goes -

 

 test.dcl :

 

test.lsp (converted) :

 

I like the ideas you share from your lunch brakes! 

 

Nice coding (I knew you couldn't resist )

Have a couple of program's with large / huge dcl files and lazy as I am , didn't want to manually edit them into the parent lisp file. That's why lazy dragons, excuse me, people, are among the most creative. So when you say I sometimes have a good idea, you're really saying how lazy I am   Just hope some people find our codes usefull

Edited January 25, 2019 by rlx

[Grrr]

30 minutes ago, rlx said:

Nice coding (I knew you couldn't resist )

 

Thanks, and you were dang right! 

 

31 minutes ago, rlx said:

That's why lazy dragons, excuse me, people, are among the most creative.

 

I think that in terms of programming, the lazy programmer is an effective programmer. 

 

BTW as it goes in your case, I use such DCL-wrapper template that I batched-up from Lee's perfect codes,

so everytime I just do a copy of it and place inside the string-formatted DCL code, then assign the keys and actions.

Hence you can turn some code wrappers (or codes in general) into templates, so you won't bother on the repetitive coding and focus more on your idea.

[rlx]

27 minutes ago, Grrr said:

 

Thanks, and you were dang right! 

 

 

I think that in terms of programming, the lazy programmer is an effective programmer. 

 

BTW as it goes in your case, I use such DCL-wrapper template that I batched-up from Lee's perfect codes,

so everytime I just do a copy of it and place inside the string-formatted DCL code, then assign the keys and actions.

Hence you can turn some code wrappers (or codes in general) into templates, so you won't bother on the repetitive coding and focus more on your idea.

 

you lazy dog you! oh I mean , you brilliant creative person!

[BIGAL]

There is an old fashioned DOS command you can join two files together using the copy command so you could write just the dcl part then add it to your original lisp.

 

If I remember correct copy abcdcl/lsp+mylispabc.lsp newabc.lsp.

 

You can do Dos commands from lisp.

 

Maybe use lisp to write the dcl code then read and write the original lisp so making a new file with the two combined.

Edited January 27, 2019 by BIGAL

[rlx]

Thank you for the tip BIGAL