(XD::DCL:ToggleAction)可选控件批量设定与Action

Free-Lancer

1. (defun XD::DCL:ToggleAction (klst syml)
   
2.   (mapcar '(lambda (x)
   
3.              (if (member x (vl-symbol-value syml))
   
4.                (set_tile x "1")
   
5.                (set_tile x "0")
   
6.              )
   
7.            )
   
8.           klst
   
9.   )
   
10.   (if (listp klst)
    
11.     (mapcar '(lambda (x)
    
12.                (action_tile
    
13.                  x
    
14.                  (strcat "(if (= $value \"0\")"
    
15.                          "(setq "
    
16.                          (vl-symbol-name syml)
    
17.                          "(vl-remove $key "
    
18.                          (vl-symbol-name syml)
    
19.                          "))(if (not (member $key "
    
20.                          (vl-symbol-name syml)
    
21.                          "))(setq "
    
22.                          (vl-symbol-name syml)
    
23.                          "(cons $key "
    
24.                          (vl-symbol-name syml)
    
25.                          "))))"
    
26.                  )
    
27.                )
    
28.              )
    
29.             klst
    
30.     )
    
31.     (action_tile
    
32.       klst
    
33.       (strcat "(if (= $value \"1\")(setq "
    
34.               (vl-symbol-name syml)
    
35.               " $key)(setq "
    
36.               (vl-symbol-name syml)
    
37.               " nil))"
    
38.       )
    
39.     )
    
40.   )
    
41. )

(defun XD::DCL:ToggleAction (klst syml)<br />   (mapcar '(lambda (x)<br />              (if (member x (vl-symbol-value syml))<br />                (set_tile x "1")<br />                (set_tile x "0")<br />              )<br />            )<br />           klst<br />   )<br />   (if (listp klst)<br />     (mapcar '(lambda (x)<br />                (action_tile<br />                  x<br />                  (strcat "(if (= $value \"0\")"<br />                          "(setq "<br />                          (vl-symbol-name syml)<br />                          "(vl-remove $key "<br />                          (vl-symbol-name syml)<br />                          "))(if (not (member $key "<br />                          (vl-symbol-name syml)<br />                          "))(setq "<br />                          (vl-symbol-name syml)<br />                          "(cons $key "<br />                          (vl-symbol-name syml)<br />                          "))))"<br />                  )<br />                )<br />              )<br />             klst<br />     )<br />     (action_tile<br />       klst<br />       (strcat "(if (= $value \"1\")(setq "<br />               (vl-symbol-name syml)<br />               " $key)(setq "<br />               (vl-symbol-name syml)<br />               " nil))"<br />       )<br />     )<br />   )<br /> )

Free-Lancer

测试代码

1. (defun c:tt (/ strl fn id)
   
2.   (setq        strl '("temp:dialog {"
   
3.                " label = \"toggle test\";"
   
4.                " : row {"
   
5.                "  : boxed_column {"
   
6.                "    label = \"选项\";"
   
7.                "    :toggle { label = \"选项1\"; key = \"k1\";}"
   
8.                "    :toggle { label = \"选项2\"; key = \"k2\";}"
   
9.                "    :toggle { label = \"选项3\"; key = \"k3\";}"
   
10.                "    }"
    
11.                "  : boxed_column {"
    
12.                "    label = \"选项\";"
    
13.                "    :toggle { label = \"选项4\"; key = \"k4\";}"
    
14.                "    :toggle { label = \"选项5\"; key = \"k5\";}"
    
15.                "    :toggle { label = \"选项6\"; key = \"k6\";}"
    
16.                "    }"
    
17.                "  }"
    
18.                " ok_cancel;}"
    
19.               )
    
20.         fn   (xd::dcl:make strl);_写出 DCL
    
21.         id   (xd::dcl:load fn "temp");_加载 DCL
    
22.   )
    
23.   (xd::Dcl:toggleaction
    
24.     '("k1" "k2" "k3" "k4" "k5" "k6");_key 列表
    
25.     'status;_记录 勾选项 的变量，做全局变量时下次有默认值
    
26.   );_设置 Toggle  并定义 Action
    
27.   (if (= (xd::dcl:start id fn) 1);_确定
    
28.     (princ status)
    
29.   )
    
30.   (princ)
    
31. )

(defun c:tt (/ strl fn id)<br />   (setq        strl '("temp:dialog {"<br />                " label = \"toggle test\";"<br />                " : row {"<br />                "  : boxed_column {"<br />                "    label = \"选项\";"<br />                "    :toggle { label = \"选项1\"; key = \"k1\";}"<br />                "    :toggle { label = \"选项2\"; key = \"k2\";}"<br />                "    :toggle { label = \"选项3\"; key = \"k3\";}"<br />                "    }"<br />                "  : boxed_column {"<br />                "    label = \"选项\";"<br />                "    :toggle { label = \"选项4\"; key = \"k4\";}"<br />                "    :toggle { label = \"选项5\"; key = \"k5\";}"<br />                "    :toggle { label = \"选项6\"; key = \"k6\";}"<br />                "    }"<br />                "  }"<br />                " ok_cancel;}"<br />               )<br />         fn   (xd::dcl:make strl);_写出 DCL<br />         id   (xd::dcl:load fn "temp");_加载 DCL<br />   )<br />   (xd::Dcl:toggleaction<br />     '("k1" "k2" "k3" "k4" "k5" "k6");_key 列表<br />     'status;_记录 勾选项 的变量，做全局变量时下次有默认值<br />   );_设置 Toggle  并定义 Action<br />   (if (= (xd::dcl:start id fn) 1);_确定<br />     (princ status)<br />   )<br />   (princ)<br /> )