Author Topic: Load Dialog On The Fly  (Read 1641 times)

0 Members and 1 Guest are viewing this topic.

Grrr1337

  • Swamp Rat
  • Posts: 708
Load Dialog On The Fly
« on: January 10, 2017, 10:39:39 AM »
Hi, DCL Dudes and Dudettes!  :idea:

Recently Lee Mac wrote some nice DCL example and I was impressed by some fragment of it:

Code - Auto/Visual Lisp: [Select]
  1. (action_tile "accept"
  2.     '(cond
  3.       (   (not (and (distof len) (< 0.0 (distof len))))
  4.         (set_tile "error" "Please enter a positive numerical length.")
  5.       )
  6.       (   (not (and (distof wid) (< 0.0 (distof wid))))
  7.         (set_tile "error" "Please enter a positive numerical width.")
  8.       )
  9.       (   (done_dialog 1))
  10.     )
  11.   )
  12. )

So I thought for a lazy'er way to write dialogs on the fly.
Its not that effective as the existing on-the-fly methods, due some restrictions that cause risk of semantic errors. But I just wanted to leave it as an idea/option:

Code - Auto/Visual Lisp: [Select]
  1. ; Remarks:
  2. ; DO NOT USE ":" inside the keys/labels strings
  3. ; @ are substituted with ; (semicolons) inside the string, since they can be recognized in the .lsp code
  4. ; everything in the DCL code (keys/labels) is re-written in lowercase
  5. ; Returns the DCL ID if successful, else nil
  6. (defun LoadDialogOnTheFly ( dcl LstDCL / *error* opn dch )
  7.   (defun *error* ( msg ) (if (= 'FILE (type opn)) (close opn)) (print msg) (princ))
  8.   (if (and (eq 'STR (type dcl)) (eq (last (fnsplitl dcl)) ".dcl") (vl-consp LstDCL))
  9.     (progn
  10.       (setq opn (open dcl "w"))
  11.       (write-line
  12.         (
  13.           (lambda (x) (vl-string-left-trim "(" (vl-string-right-trim ")" x)))
  14.           (apply 'strcat
  15.             (mapcar '(lambda (x) (if (= x ":") "\n:" (strcase x t)))
  16.               (mapcar 'chr
  17.                 (vl-string->list
  18.                   (vl-string-translate "@" ";"
  19.                     (vl-prin1-to-string
  20.                       LstDCL
  21.                     )
  22.                   )
  23.                 )
  24.               )
  25.             )
  26.           )
  27.         )
  28.         opn
  29.       )
  30.       (close opn)
  31.       (if (< 0 (setq dch (load_dialog dcl))) dch)
  32.     )
  33.   )
  34. ); defun LoadDialogOnTheFly


Heres an usage example:
Code - Auto/Visual Lisp: [Select]
  1. ; Test function for (LoadDialogOnTheFly)
  2. (defun c:test ( / *error* dcl dch des txt dlgRtn )
  3.   (and
  4.     (setq *error*
  5.       '(   ( m )
  6.         (if (< 0 dch) (unload_dialog dch))
  7.         (if (and (= 'str (type dcl)) (findfile dcl)) (vl-file-delete dcl))
  8.       )
  9.     )
  10.     (setq dcl (vl-filename-mktemp nil nil ".dcl")) ; (setq dcl (getfiled "Create DCL File" "" "dcl" 1))
  11.     (setq dch
  12.       (LoadDialogOnTheFly dcl
  13.         '( ; @ will be substituted with ";" - obviously, and everything in the code is written lowercase, because it will be converted to lwcase anyway
  14.           test : dialog
  15.           { label = "edit text" @ initial_focus = "edit1" @ spacer @ ; separate the @ from other strings (esp from numbers) with space
  16.             : row
  17.             {
  18.               : column
  19.               { width = 5.09 @ fixed_width = true @ spacer @
  20.                 : text
  21.                 { key = "prompt" @ label = "type text" @ }
  22.               }
  23.               : edit_box
  24.               { key = "edit1" @ edit_width = 26.42 @ fixed_width = true @ }
  25.             }
  26.             spacer @
  27.             : row
  28.             { fixed_width = true @ alignment = centered @
  29.               : ok_button
  30.               { key = "ok-key" @ width = 11 @ }
  31.               : cancel_button
  32.               { key = "cancel-key" @ width = 11 @ }
  33.             }
  34.           }
  35.         )
  36.       ); LoadDialogOnTheFly
  37.     ); setq dch
  38.     (new_dialog "test" dch)
  39.     (setq txt "Type text here")
  40.     (set_tile "edit1" txt)
  41.     (action_tile "edit1"  "(setq txt $value)")
  42.     (setq dlgRtn (start_dialog))
  43.     (cond
  44.       ((= 1 dlgRtn) (alert (strcat "You typed:\n" txt)))
  45.     )
  46.   ); and
  47.   (*error* nil) (princ)
  48. ); defun C:test for (LoadDialogOnTheFly)
(apply ''((a b c)(a b c))
  '(
    (( f L ) (apply 'strcat (f L)))
    (( L ) (if L (cons (chr (car L)) (f (cdr L)))))
    (72 101 108 108 111 32 87 111 114 108 100)
  )
)