dcl dans lisp

[Jipicad]

Salut a tous

Voila j'étais tanné de toujours créer un .dcl et un .lisp c'est maintenant du passé voici des fonctions de mon cru qui permet de tout faire en .lisp

 

Retourne le chemin d'accès du fichier dcl

(defun get_filename (ID / STRINGLEN POS STRLIST ID)
   (setq STRINGLEN (strlen " ")
	  POS 		(vl-string-search " " (Vl-Princ-to-string ID))
	  STRLIST  	(append STRLIST (list (substr (Vl-Princ-to-string ID) 1 POS)))
	  ID       	(substr (Vl-Princ-to-string ID) (+ (1+ STRINGLEN) POS) nil)
)
 	(vl-string-right-trim ">" ID)
)

 

Commence l'écriture du dcl dans une temp file

(defun dcl_startdialog (NAME LABEL / ID)
(setq ID (open (strcat (vl-filename-mktemp) ".dcl") "w"))
 	(write-line (strcat NAME " : dialog {") ID)
 	(write-line (strcat "    label = \"" LABEL "\" ;") ID)
 	ID
)

 

Termine l'écriture du dcl et close la file

 
(defun dcl_enddialog (ID / FILEDIRECT)
 	(setq FILEDIRECT  (get_filename ID))
 	(write-line "}" ID)
 	(close ID)
 	FILEDIRECT
)

 

Écris du text dans le dcl

 
(defun dcl_add_text (INDENT COMMENT ID KEY LABEL HEIGHT WIDTH FIXEDHEIGHT FIXEDWIDTH ALIGNMENT
				 ISBOLD VALUE / INDENTSTRING
				)
(setq INDENTSTRING    "")
(repeat INDENT (setq INDENTSTRING (strcat INDENTSTRING "    ")))

(if COMMENT (write-line (strcat INDENTSTRING "//" COMMENT) ID))
(write-line (strcat INDENTSTRING ": text {") ID)

(if KEY               (write-line (strcat INDENTSTRING "    " "key = "                "\"" KEY "\""                           " ;") ID))
(if LABEL             (write-line (strcat INDENTSTRING "    " "label = "              "\"" LABEL "\""                         " ;") ID))
(if HEIGHT            (write-line (strcat INDENTSTRING "    " "height = "             (vl-Princ-to-string HEIGHT)             " ;") ID))
(if WIDTH             (write-line (strcat INDENTSTRING "    " "width = "              (vl-Princ-to-string WIDTH)              " ;") ID))
(if FIXEDHEIGHT       (write-line (strcat INDENTSTRING "    " "fixed_height = "       "true"                                  " ;") ID))
(if FIXEDWIDTH        (write-line (strcat INDENTSTRING "    " "fixed_width = "        "true"                                  " ;") ID))
(if ALIGNMENT         (write-line (strcat INDENTSTRING "    " "alignment = "          ALIGNMENT                               " ;") ID))
(if ISBOLD            (write-line (strcat INDENTSTRING "    " "is_bold = "            "true"                                  " ;") ID))
(if VALUE             (write-line (strcat INDENTSTRING "    " "value = "              "\"" VALUE "\""                         " ;") ID))

(write-line (strcat INDENTSTRING "}") ID)

)

 

Ajoute un bouton dans le dcl

 
(defun dcl_addbutton (INDENT COMMENT ID ACTION KEY LABEL HEIGHT WIDTH FIXEDHEIGHT FIXEDWIDTH
				  ALIGNMENT ISENABLED ISTABSTOP MNEMONIC ISCANCEL ISDEFAULT / INDENTSTRING
				 )
 
 	(setq INDENTSTRING "")
 	(repeat INDENT (setq INDENTSTRING (strcat INDENTSTRING "    ")))

 	(if COMMENT (write-line (strcat INDENTSTRING "//" COMMENT) ID))
 	(write-line (strcat INDENTSTRING ": button {") ID)

 	(if ACTION            (write-line (strcat INDENTSTRING "    " "action = "             "\"" ACTION "\""                        " ;") ID))
 	(if KEY               (write-line (strcat INDENTSTRING "    " "key = "                "\"" KEY "\""                           " ;") ID))
 	(if LABEL             (write-line (strcat INDENTSTRING "    " "label = "              "\"" LABEL "\""                         " ;") ID))
 	(if HEIGHT            (write-line (strcat INDENTSTRING "    " "height = "             (vl-Princ-to-string HEIGHT)             " ;") ID))
 	(if WIDTH             (write-line (strcat INDENTSTRING "    " "width = "              (vl-Princ-to-string WIDTH)              " ;") ID))
 	(if ALIGNMENT         (write-line (strcat INDENTSTRING "    " "alignment = "           ALIGNMENT                              " ;") ID))
 	(if FIXEDHEIGHT       (write-line (strcat INDENTSTRING "    " "fixed_height = "       "true"                                  " ;") ID))
 	(if FIXEDWIDTH        (write-line (strcat INDENTSTRING "    " "fixed_width = "        "true"                                  " ;") ID))
 	(if ISENABLED         (write-line (strcat INDENTSTRING "    " "is_enabled = "         "true"                                  " ;") ID))
 	(if ISTABSTOP         (write-line (strcat INDENTSTRING "    " "is_tab_stop = "        "true"                                  " ;") ID))
 	(if MNEMONIC          (write-line (strcat INDENTSTRING "    " "mnemonic = "           "\"" MNEMONIC "\""                      " ;") ID))
 	(if ISCANCEL          (write-line (strcat INDENTSTRING "    " "is_cancel = "          "true"                                  " ;") ID))
 	(if ISDEFAULT         (write-line (strcat INDENTSTRING "    " "is_default = "         "true"                                  " ;") ID))

 	(write-line (strcat INDENTSTRING "}") ID)
 
)

 

Et voici une petit fonction qui test le tout créer une simple boite de dialogue qui dit bonjour et avec un bouton ok

 

quelque précision la variable indent sert a l'indentation du file dcl mais ce n'est pas nécessaire au bon fonctionnement de la fonction

seulement pour raison de debug si on doit entrer dans le file dcl vaut mieux que l'indentation soit bien fait sa aide grandement a la compréhension du code

 

donc sa fonction qui faut incrémenter la variable INDENT au debut de chaque call de fonction dcl_ et vis versa exemple

(setq INDENT 1)
(dcl_start_columm INDENT COMMENT ID)
(setq INDENT (1+ INDENT))
.....code.....
(setq INDENT (1- INDENT))
(dcl_close_columm INDENT COMMENT ID)

 

 
(defun c:test ( / ID INDENT DCLFILE DCLID PROCEED)
	(setq ID 	 (dcl_startdialog "Bonjour" "Test no. 1")
         INDENT 1
 	)
   (dcl_add_text  ;|Indentation|;INDENT 	;|Comment|;nil 			;|FileId|;ID
  			   ;|Key|;nil 		    	;|Label|;nil   			;|height|;nil
   		  	   ;|width|;nil 			;|fixed_height|;nil 	;|fixed_width|;nil
  			   ;|alignment|;nil 		;|is_bold|;nil 			;|value|;"Bonjour"
)
   (dcl_addbutton ;|Indentation|;INDENT 	;|Comment|;nil 			;|FileId|;ID
  			   ;|Action|;nil		    ;|Key|;"accept" 		;|Label|;"OK"
               ;|height|;nil            ;|width|;nil 			;|fixed_height|;nil
               ;|fixed_width|;nil       ;|alignment|;nil 		;|is_enabled|;nil
               ;|is_tab_stop|;nil       ;|mnemonic|;nil         ;|is_cancel|;nil
               ;|is_default|;"true"
)
   (setq DCLFILE (dcl_enddialog ID)
	  DCLID   (load_dialog DCLFILE)
   )
   (if (not (new_dialog "Bonjour" DCLID))
  	(exit)
)
 	(setq PROCEED (start_dialog))	(unload_dialog DCLID)
 	(vl-file-delete DCLFILE)
)

 

possibilité d'ajouter des row, column, radio button, toggle button, boxed_row, boxed_column, ok_only ......

 

ENJOY

[(gile)]

Salut et merci pour cette contribution.

 

Une petite remarque toutefois, je crains que ta méthode ne fasse perdre un peu de la souplesse que donne le fait d'écrire le fichier DCL depuis le LISP.

Définir la boite de dialogue dans la routine qui l'utilise permet de l'adapter au besoin immédiat.

 

Par exemple dans SSD, l'utilisateur sélectionne un bloc dynamique source puis choisit dans une boite de dialogues les propriétés dynamiques à filtrer pour faire une sélection.

La boite de dialogue est créée après sélection du bloc source elle peut ainsi être différente suivant le bloc sélectionné.