Listes dépendantes

[danb]

Bonjour

 

Il y a quelques temps j'ai testé un lisp utilisant des listes dépendantes ( "ListTileDependencyV1-0.lsp" et "ListTileDependencyDemo.lsp" de Lee Mac).

 

Lors du test j'ai remarqué que cette démo contenait un bug dans son fonctionnement.

 

exemple sur la fonction AA:

 

si vous selectionnez "C, C3, C3a, C3aa"

 

puis que vous revenez sur votre choix et que vous voulez selectionner "A"

le lisp s'arrete ...

 

Je mets les 2 lisp et l'analyse rétrospective à la fin de ce message

 

J'ai cherché une solution à ce problème...sans succès jusqu'a présent.

 

On peut contourner le problème en insérant des éléments "fantôme" (vides) dans les listes mais j'aimerai quand même savoir corriger cela "dans les règle de l'art".

 

Avez vous une idée pour résoudre cette erreur?

d'avance, merci beaucoup !

 

Dan

 

nota: edit du 25/04 , dans un soucis de lecture, simplification des listes.

 

   ;; DCL List-Tile Dependency  -  Lee Mac
   ;; Configures action_tile statements for the list of keys to enabled dependency between the DCL tiles.
   ;; key     - [lst] List of DCL tile keys in order of dependency
   ;; lst-sym - [sym] Quoted variable containing list data
   ;; rtn-sym - [sym] Quoted variable containing initial selection indexes
    
   (defun LM:dcld:action ( key lst-sym rtn-sym )
       
       (defun LM:dcld:addlist ( key lst )
           (start_list key)
           (foreach itm lst (add_list itm))
           (end_list)
       )
       (defun LM:dcld:getlists ( idx lst )
           (if (cdr idx)
               (cons (mapcar 'car lst) (LM:dcld:getlists (cdr idx) (cdr (nth (car idx) lst))))
               lst
           )
       )
       (defun LM:substnth ( itm idx lst )
           (if lst
               (if (zerop idx)
                   (cons itm (cdr lst))
                   (cons (car lst) (LM:substnth itm (1- idx) (cdr lst)))
               )
           )
       )
       (defun LM:dcld:actions ( key lst-sym rtn-sym lvl / fun )
           (setq fun
               (if (cdr key)
                   (list 'lambda '( val lst / tmp )
                       (list 'setq  rtn-sym  (list 'LM:substnth '(atoi val) lvl rtn-sym)
                                   'tmp      (list 'LM:dcld:getlists rtn-sym 'lst)
                       )
                       (list 'LM:dcld:addlist (cadr key) (list 'nth (1+ lvl) 'tmp))
                       (list 'if (list '<= (list 'length (list 'nth (1+ lvl) 'tmp)) (list 'nth (1+ lvl) rtn-sym))
                           (list 'setq rtn-sym (list 'LM:substnth 0 (1+ lvl) rtn-sym))
                       )
                       (list
                           (LM:dcld:actions (cdr key) lst-sym rtn-sym (1+ lvl))
                           (list 'set_tile (cadr key) (list 'itoa (list 'nth (1+ lvl) rtn-sym))) 'lst
                       )
                   )
                   (list 'lambda '( val lst )
                       (list 'setq rtn-sym (list 'LM:substnth '(atoi val) lvl rtn-sym))
                   )
               )
           )
           (action_tile (car key) (vl-prin1-to-string (list fun '$value lst-sym)))
           fun
       )
       (mapcar 'LM:dcld:addlist key (LM:dcld:getlists (eval rtn-sym) (eval lst-sym)))
       (   (eval (LM:dcld:actions key lst-sym rtn-sym 0))
           (set_tile (car key) (itoa (car (eval rtn-sym))))
           (eval lst-sym)
       )
       (princ)
   )
    
   ;; DCL List-Tile Dependency  -  Get Items  -  Lee Mac
   ;; Returns a list of the items selected from each dependent list tile.
   ;; idx - [lst] List of selection indexes
   ;; lst - [lst] List data
    
   (defun LM:dcld:getitems ( idx lst / tmp )
       (if (cdr idx)
           (cons (car (setq tmp (nth (car idx) lst))) (LM:dcld:getitems (cdr idx) (cdr tmp)))
           (list (nth (car idx) (car lst)))
       )
   )

 

 

 
;; Five List Tile Dependency Example  -  Lee Mac
;; Requires ListTileDependency.lsp to be loaded.

(defun c:aa ( / *error* dch dcl des lst rtn )

   (defun *error* ( msg )
       (if (= 'file (type des))
           (close des)
       )
       (if (< 0 dch)
           (unload_dialog dch)
       )
       (if (and (= 'str (type dcl)) (findfile dcl))
           (vl-file-delete dcl)
       )
       (if (and msg (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")))
           (princ (strcat "\nError: " msg))
       )
     (vl-bt)
       (princ)
   )

   (setq lst
  '(			
 ("A" ("A1" ("A1a" ("A1aa")) ("A1b" ("---")))
      ("A2" ("A2a" ("A2aa"))  )) 
  ("C" ("C1" ("C1a" (""))	  )
       ("C2" ("C2a" ("C2aa"))
	     ("C2c" ("C2ca" "C2cb" "C2cc" "C2cd")))
   ("C3" ("C3a" ("C3aa ")))
   )
   ))

   (if
       (and
           (setq dcl (vl-filename-mktemp "tmp.dcl"))
           (setq des (open dcl "w"))
           (foreach str
              '(
                   "lbx : list_box"
                   "{"
                   "    alignment = centered;"
                   "    fixed_width = true;"
                   "    fixed_height = true;"
                   "    width = 20;"
                   "    height = 15;"
                   "}"
                   "test : dialog"
                   "{"
                   "    label = \"List Box Dependency Example\";"
                   "    spacer;"
                   "    : row"
                   "    {"
                   "        : lbx { key = \"lb0\"; label = \"List Box 1\"; }"
                   "        : lbx { key = \"lb1\"; label = \"List Box 2\"; }"
                   "        : lbx { key = \"lb2\"; label = \"List Box 3\"; }"
                   "        : lbx { key = \"lb3\"; label = \"List Box 4\"; }"
                   "    }"
                   "    spacer;"
                   "    ok_cancel;"
                   "}"
               )
               (write-line str des)
           )
           (not (setq des (close des)))
           (< 0 (setq dch (load_dialog dcl)))
           (new_dialog "test" dch)
       )
       (progn           
           (setq rtn '(0 0 0 0 ))
           (LM:dcld:action '("lb0" "lb1" "lb2" "lb3") 'lst 'rtn)
           (if (= 1 (start_dialog))
               (princ
                   (strcat "\nThe user selected:"
                       (substr
                           (apply 'strcat
                               (mapcar '(lambda ( x ) (strcat ", " x))
                                   (LM:dcld:getitems rtn lst)
                               )
                           )
                           2
                       )
                   )
               )
               (princ "\n*Cancel*")
           )
       )
   )
   (*error* nil)
   (princ)
)

 

 

et voici l'analyse:

 

 

Commande: AA

Error: type d'argument incorrect: consp nil

Analyse rétrospective:

[0.124] (VL-BT)

[1.120] (*ERROR* "type d'argument incorrect: consp nil") LAP+252

[2.114] (_call-err-hook #<USUBR @000000004f688340 *ERROR*> "type d'argument incorrect: consp nil")

[3.108] (sys-error "type d'argument incorrect: consp nil")

:ERROR-BREAK.103 "type d'argument incorrect: consp nil"

[4.100] (NTH 0 nil)

[5.94] (LM:DCLD:GETLISTS (0 0) nil) LAP+68

[6.87] (LM:DCLD:GETLISTS (2 0 0) (("A1" ("A1a" ("A1aa")) ("A1b" ("---"))) ("A2" ("A2a" ("A2aa"))))) LAP+82

[7.80] (LM:DCLD:GETLISTS (0 2 0 0) (("A" ("A1" ("A1a" ("A1aa")) ("A1b" ("---"))) ("A2" ("A2a" ("A2aa")))) ("C" ("C1" ("C1a" (""))) ("C2" ("C2a" ("C2aa")) ("C2c" ("C2ca" "C2cb" "C2cc" "C2cd"))) ("C3" ("C3a" ("C3aa ")))))) LAP+82

[8.73] (#<USUBR @000000004f7fa1b0 -lambda-> "0" (("A" ("A1" ("A1a" ("A1aa")) ("A1b" ("---"))) ("A2" ("A2a" ("A2aa")))) ("C" ("C1" ("C1a" (""))) ("C2" ("C2a" ("C2aa")) ("C2c" ("C2ca" "C2cb" "C2cc" "C2cd"))) ("C3" ("C3a" ("C3aa ")))))) LAP+43

[9.67] (#<USUBR @000000004f7fa1d8 -lambda-> "lb0" "0" "" 1 81 8) LAP+15

[10.57] (#<SUBR @000000004e11f480 -application-envelope->)

:ENTRY-NAMESPACE.54 (:ENTRY-NAMESPACE)

[11.51] (#<SUBR @000000004e11f4d0 -unwind-protect->)

[12.48] (_lisplet-apply #<Document-LISPLET> #<SUBR @000000004e11f480 -application-envelope-> nil nil)

[13.40] (_lisplet-app-apply #<Document-LISPLET> #<USUBR @000000004f7fa1d8 -lambda-> ("lb0" "0" "" 1 81 8))

[14.33] (dcl-call-back ("lb0" "0" "" 1 81 8) T)

:DCL-ACTION.27 (((:DCL-ACTION "test" "lb0" 1)))

[15.24] (START_DIALOG)

[16.20] (C:AA) LAP+323

[17.15] (#<SUBR @000000004fadae30 -rts_top->)

[18.12] (#<SUBR @000000004e118700 veval-str-body> "(C:AA)" T #<FILE internal>)

:CALLBACK-ENTRY.6 (:CALLBACK-ENTRY)

:ARQ-SUBR-CALLBACK.3 (nil 0)

Modifié le 25 avril 2019 par danb

[didier]

Coucou

 

Peu de personnes sont capables "d'améliorer" un code de Lee-Mac

Poser la question sur CadXP est étonnant, à la rigueur sur "theSwamp" mais pas ici assurément

Pourquoi ne pas plutôt demander directement à l'auteur ?

Il est assez disponible en général, en tous cas : moi il m'a répondu à chaque fois que je l'ai interrogé.

 

Amicalement

 

 

[danb]

Bonjour

 

Merci de votre réponse. :)

 

effectivement une demande auprès de l'auteur est déjà en cours et comme conseillé sur le site Lee Mac j'ai posté sur Cadtutor où un post sur ces mêmes lisp était déjà ouvert.

 

 

Ensuite je pensais plus à une correction qu'à une amélioraion, raison pour laquelle je poste également ici au cas où quelqu'un aurait déja eu un problème similaire

 

Cdlt,

[(gile)]

Salut,

 

Juste pour faire mentir didier (qui a néanmoins raison en disant que le mieux est de contacter l'auteur).

 

Remplace la fonction LM:substnth par :

  (defun LM:substnth (itm idx lst)
   (if lst
     (if (zerop idx)
       (cons itm (mapcar '(lambda (x) 0) (cdr lst)))
       (cons (car lst) (LM:substnth itm (1- idx) (cdr lst)))
     )
   )
 )

[danb]

Bonjour (Gile)

 

Suite aux premiers tests l'erreur ne se produit plus !

 

Je t'en remercie beaucoup !! :)

 

N'etant malheureusement qu'un "bricoleur", je n'aurai pas su régler ce bug seul...

 

Ce bug vient-il du fait qu'il veut, à la base, conserver la position des items selectionnés avant le changement et que si le nombre d'éléments n'etait pas suffisant il y avait, alors, plantage ???

Ta solution reinitialise la position à O a chaque fois, si j'ai bien compris ...

 

Si d'autres solutions me parviennent je les partagerai ici,

 

encore merci !

[didier]

Coucou

 

Tu ne me fais pas mentir (gile)

Lorsque j’écrivais "peu de personnes" il faut bien avoir à l'esprit que tu es le tout début de ce "peu"

 

Amicalement

 

[(gile)]

Ce bug vient-il du fait qu'il veut, à la base, conserver la position des items selectionnés avant le changement et que si le nombre d'éléments n'etait pas suffisant il y avait, alors, plantage ???

Ta solution reinitialise la position à O a chaque fois, si j'ai bien compris ...

 

C'est ça.

Dans la routine originale, si on choisit une autre branche de l'arborescence, le schéma de la descendance de la branche première branche est conservé, même s'il n'a pas d'équivalent dans la nouvelle branche.

Dans ce que tu décris,tu choisis C/C3/C3a/C3aa, soit en utilisant les indices des branches : (2 2 0 0) mais en choisissant ensuite la branche A (index 0), la routine conservait le reste de la liste soit (0 2 0 0) or, la branche A n'a que deux sous-branches (indice 0 et 1) d'où l'erreur.

 

La correction que j'ai fait remet tous les indices descendant de la branche changée à 0 ce qui m'a semblé pertinent.

[danb]

Bonjour

 

Merci pour ces précisions !

 

Pour info et pour ceux que cela interesse, Lee Mac a actualisé son site avec cette correction.