OptionBox et ListBox

[(gile)]

Salut,

 

Deux nouvelles petites boites de dialogue pour le choix d'une ou plusieurs options.

Le fichier DCL temporaire est créé par le LISP en fonction des arguments (voir commentaires en en-tête des routines).

 

La première fonctionne avec des cases à cocher ou des boutons radio.

 

;; OptionBox (gile)
;; Boite de dialogue permettant de choisir une ou plusieurs options
;;
;; Arguments
;; title : le titre de la boite de dialogue (chaîne)
;; msg ; message (chaîne), "" ou nil por aucun
;; keylab : une liste d'association du type ((key1 . label1) (key2 . label2) ...)
;; mult : T (choix multiple) ou nil (choix unique)
;;
;; Retour : la clé de l'option (mult = nil) ou la liste des clés des options (mult = T)
;;
;; Exemples d'utilisations
;; (OptionBox "Type de fichier"  nil '(("lin" . "Type de ligne") ("pat" . "Motif de hachure")) nil)
;; (OptionBox "Types d'entités" "Choisir les types d'entité" '(("LINE" . "Lignes") ("CIRCLE" . "Cercles")) T)

(defun OptionBox (title msg keylab mult / tmp file dcl_id choice)
 (setq	tmp  (vl-filename-mktemp "tmp.dcl")
file (open tmp "w")
 )
 (write-line
   (strcat "OptionBox:dialog{label=\"" title "\";")
   file
 )
 (write-line
   (strcat (if	mult
      ":boxed_column{"
      ":boxed_radio_column{key=\"choice\";"
    )
   )
   file
 )
 (if (and msg (/= msg ""))
   (write-line (strcat "label=\"" msg "\";") file)
 )
 (mapcar
   (function
     (lambda (p)
(write-line
  (strcat (if mult
	    ":toggle{key=\""
	    ":radio_button{key=\""
	  )
	  (car p)
	  "\";label=\""
	  (cdr p)
	  "\";}"
  )
  file
)
     )
   )
   keylab
 )
 (if mult
   (write-line
     "spacer;:button{label=\"Tout sélectionner\";
     key=\"all\";fixed_width=true;alignment=centered;}"
     file
   )
 )
 (write-line "}spacer;ok_cancel;}" file)
 (close file)
 (setq dcl_id (load_dialog tmp))
 (if (not (new_dialog "OptionBox" dcl_id))
   (exit)
 )
 (if mult
   (progn
     (action_tile
"all"
"(foreach k (mapcar 'car keylab)
       (set_tile k\"1\"))"
     )
     (action_tile
"none"
"(foreach k (mapcar 'car keylab)
       (set_tile k\"0\"))"
     )
     (action_tile
"accept"
"(foreach k (mapcar 'car keylab)
       (if (= \"1\" (get_tile k))
       (setq choice (cons k choice))))
       (setq choice (reverse choice))
       (done_dialog)"
     )
   )
   (progn
     (set_tile "choice" (caar keylab))
     (action_tile
"accept"
"(setq choice (get_tile \"choice\")) (done_dialog)"
     )
   )
 )
 (start_dialog)
 (unload_dialog dcl_id)
 (vl-file-delete tmp)
 choice
) 

 

Exemples en image

 

(OptionBox "OptionBox"
   "Types d'entité"
   '(("ARC" . "Arc")
     ("CIRCLE" . "Cercle")
     ("ELLIPSE" . "Ellipse")
     ("LINE" . "Ligne")
     ("LWPOLYLINE" . "Polyligne")
    )
   T
) 

http://img367.imageshack.us/img367/8478/optionboxtsx7.png

Retourne : ("ARC" "LINE")

 

(OptionBox "Type d'entité"
   nil
   '(("ARC" . "Arc")
     ("CIRCLE" . "Cercle")
     ("ELLIPSE" . "Ellipse")
     ("LINE" . "Ligne")
     ("LWPOLYLINE" . "Polyligne")
    )
   nil
) 

http://img367.imageshack.us/img367/4924/optionboxnildi7.png

Retourne : "ELLIPSE"

 

La seconde fonctionne avec une liste ou liste déroulante

 

;; ListBox (gile)
;; Boite de dialogue permettant un ou plusieurs choix dans une liste
;;
;; Arguments
;; title : le titre de la boite de dialogue (chaîne)
;; msg ; message (chaîne), "" ou nil pour aucun
;; keylab : une liste d'association du type ((key1 . label1) (key2 . label2) ...)
;; flag : 0 = liste déroulante
;;        1 = liste choix unique
;;        2 = liste choix multipes
;;
;; Retour : la clé de l'option (flag = 0 ou 1) ou la liste des clés des options (flag = 2)
;;
;; Exemple d'utilisation
;; (listbox "Présentation" "Choisir une présentation" (mapcar 'cons (layoutlist) (layoutlist)) 1)

(defun ListBox (title msg keylab flag / tmp file dcl_id choice)
 (setq	tmp  (vl-filename-mktemp "tmp.dcl")
file (open tmp "w")
 )
 (write-line
   (strcat "ListBox:dialog{label=\"" title "\";")
   file
 )
 (if (and msg (/= msg ""))
   (write-line (strcat ":text{label=\"" msg "\";}") file)
 )
 (write-line
   (cond
     ((= 0 flag) "spacer;:popup_list{key=\"lst\";")
     ((= 1 flag) "spacer;:list_box{key=\"lst\";")
     (T "spacer;:list_box{key=\"lst\";multiple_select=true;")
   )
   file
 )
 (write-line "}spacer;ok_cancel;}" file)
 (close file)
 (setq dcl_id (load_dialog tmp))
 (if (not (new_dialog "ListBox" dcl_id))
   (exit)
 )
 (start_list "lst")
 (mapcar 'add_list (mapcar 'cdr keylab))
 (end_list)
 (action_tile
   "accept"
   "(or (= (get_tile \"lst\") \"\")
   (if (= 2 flag) (progn
   (foreach n (str2lst (get_tile \"lst\") \" \")
   (setq choice (cons (nth (atoi n) (mapcar 'car keylab)) choice)))
   (setq choice (reverse choice)))
   (setq choice (nth (atoi (get_tile \"lst\")) (mapcar 'car keylab)))))
   (done_dialog)"
 )
 (start_dialog)
 (unload_dialog dcl_id)
 (vl-file-delete tmp)
 choice
)

;; str2lst
;; Transforme un chaine avec séparateur en liste de chaines
;;
;; Arguments
;; str : la chaine à transformer en liste
;; sep : le séparateur
;;
;; Exemples
;; (str2lst "a b c" " ") -> ("a" "b" "c")
;; (str2lst "1,2,3" ",") -> ("1" "2" "3")
;; (mapcar 'read (str2lst "1,2,3" ",")) -> (1 2 3)

(defun str2lst (str sep / pos)
 (if (setq pos (vl-string-search sep str))
   (cons (substr str 1 pos)
  (str2lst (substr str (+ (strlen sep) pos 1)) sep)
   )
   (list str)
 )
) 

 

Exemples en image

 

(ListBox "ListBox"
   "Choisir les types d'entité"
   '(("ARC" . "Arc")
     ("CIRCLE" . "Cercle")
     ("ELLIPSE" . "Ellipse")
     ("LINE" . "Ligne")
     ("XLINE" . "Droite")
     ("RAY" . "Demi-droite")
     ("LWPOLYLINE" . "Polyligne")
    )
   2
) 

http://img68.imageshack.us/img68/7037/listbox2lu8.png

Retourne : ("XLINE" "RAY")

 

(ListBox "Type d'entité"
   nil
   '(("ARC" . "Arc")
     ("CIRCLE" . "Cercle")
     ("ELLIPSE" . "Ellipse")
     ("LINE" . "Ligne")
     ("XLINE" . "Droite")
     ("RAY" . "Demi-droite")
     ("LWPOLYLINE" . "Polyligne")
    )
   0
) 

http://img247.imageshack.us/img247/6516/listbox0pm9.png

Retourne : "CIRCLE"

 

[Edité le 28/7/2008 par (gile)]

[Matt666]

Impressionnant, comme d'habitude...

 

Merci pour tous ces efforts de travail !

[bseb67]

Ben, chapeau :D,

 

En plus ca tombe super bien, car c'est justement ce que je voulais faire pour un de mes

lisps: dcl avec un nombre différent de checkbox. Le plus simple est la dcl avec la liste

déroulante, mais celle avec les checkbox me plait beaucoup plus.

 

Il manque juste un truc Gile, tu as mis:

 (action_tile
		"none"
		"(foreach k (mapcar 'car keylab)
		(set_tile k\"0\"))"
		)

 

Une action pour tout désélectionner,

mais le bouton n'est pas là.

 

[Edité le 28/7/2008 par bseb67]

[bonuscad]

Bonjour (gile)

 

Juste testée les fonctions avec les exemples.

Pour Listbox, il manque la fonction str2list.

On peut la retrouver ici par exemple, et l'intégrer. ;)

 

Ton exemple fourni texto dans le lisp ne fonctionne pas (pour info)

(listbox "Présentation" "Choisir une présentation" (layoutlist) 1)

 

(layoutlist n'étant une liste de paire pointée)

 

L'exemple devrait être:

(listbox "Présentation" "Choisir une présentation" (mapcar 'cons (layoutlist) (layoutlist)) 1) 

 

Mise à part ces détails, tout à l'air de fonctionner correctement.

 

[Edité le 28/7/2008 par bonuscad]

[(gile)]

Merci Bonuscad pour ce retour/correction.

 

J'ia modifié le code en conséquence.

[Bred]

Salut (gile),

déjà encore merci pour tous ces outils.

 

Serait-il possible pour listbox de ne pas avoir les touches OK et ANNULER, mais que pour le choix "unique", la validation se fasse lors de la sélection de la ligne, et donc que la sortie ce fasse pour une validation sans aucune sélection ?

 

merci d'avance.

[Bred]

... pffffff...

désolé, mais en faite je viens de me rendre compte que mon souhait s'avert être identique à créer un menu contextuel.... laisse tombé....

merci encore !

[(gile)]

Salut,

 

laisse tombé....

 

Trop tard...

 

(defun ListBox (title msg keylab flag / tmp file dcl_id choice)
 (setq	tmp  (vl-filename-mktemp "tmp.dcl")
file (open tmp "w")
 )
 (write-line
   (strcat "ListBox:dialog{label=\"" title "\";")
   file
 )
 (if (and msg (/= msg ""))
   (write-line (strcat ":text{label=\"" msg "\";}") file)
 )
 (write-line
   (cond
     ((= 0 flag) "spacer;:popup_list{key=\"lst\";")
     ((= 1 flag) "spacer;:list_box{key=\"lst\";")
     (T "spacer;:list_box{key=\"lst\";multiple_select=true;")
   )
   file
 )
 (write-line
   (if	(= 2 flag)
     "}spacer;ok_cancel;}"
     "}spacer;cancel_button;}"
   )
   file
 )
 (close file)
 (setq dcl_id (load_dialog tmp))
 (if (not (new_dialog "ListBox" dcl_id))
   (exit)
 )
 (start_list "lst")
 (mapcar 'add_list (mapcar 'cdr keylab))
 (end_list)
 (if (    (action_tile "lst" "(setq choice (nth (atoi (get_tile \"lst\")) (mapcar 'car keylab))) (done_dialog)")
   (action_tile
     "accept"
     "(or (= (get_tile \"lst\") \"\")
     (progn
     (foreach n (str2lst (get_tile \"lst\") \" \")
     (setq choice (cons (nth (atoi n) (mapcar 'car keylab)) choice)))
     (setq choice (reverse choice))))
     (done_dialog)"
   )
 )
 (start_dialog)
 (unload_dialog dcl_id)
 (vl-file-delete tmp)
 choice
) 

[Bred]

Ben merci !!!... ;)