[原创]：弄着玩玩，改造"setq"

aeo

2. 
   
3. (defun nsetq(sym foo / $$aeo-swap)
   
4.   (if(eval sym)
   
5.        (setq $$aeo-swap(vl-princ-to-string(eval sym))
   
6.              foo(mapcar '(lambda(x)(if(eq 'str(type x))(strcat x "("$$aeo-swap"): ")x))foo)
   
7.        )
   
8.   )
   
9.   (setq $$aeo-swap(eval foo))
   
10.   (if(and $$aeo-swap(/= $$aeo-swap ""))(set sym $$aeo-swap))
    
11. )
    

<br /> (defun nsetq(sym foo / $$aeo-swap)<br />   (if(eval sym)<br />        (setq $$aeo-swap(vl-princ-to-string(eval sym))<br />              foo(mapcar '(lambda(x)(if(eq 'str(type x))(strcat x "("$$aeo-swap"): ")x))foo)<br />        )<br />   )<br />   (setq $$aeo-swap(eval foo))<br />   (if(and $$aeo-swap(/= $$aeo-swap ""))(set sym $$aeo-swap))<br /> )<br />

用法和setq + getXXX完全相同
看例子就明白:

2. 
   
3. 命令: (setq abc nil)
   
4. nil
   
5. 
   
6. 命令: (nsetq 'abc '(getint "\n输入整数: "))
   
7. 
   
8. 输入整数: 123
   
9. 123
   
10. 
    
11. 命令: (nsetq 'abc '(getint "\n输入整数: "))
    
12. 
    
13. 输入整数: (123): 567
    
14. 567
    
15. 
    
16. 命令: !abc
    
17. 567
    
18. 
    
19. -------------------------------------------
    
20. 命令: (initget 6 "A B C")
    
21. nil
    
22. 
    
23. 命令: (nsetq 'abc '(getint "\n输入整数: "))
    
24. 
    
25. 输入整数: (567): -5
    
26. 
    
27. 值必须为正且非零。
    
28. 
    
29. 输入整数: (567): 0
    
30. 
    
31. 值必须为正且非零。
    
32. 
    
33. 输入整数: (567): A
    
34. "A"
    
35. 
    
36. 命令: !abc
    
37. "A"
    
38. 
    
39. --------------------------------------------------------
    
40. 命令: (setq abc 1000)
    
41. 1000
    
42. 
    
43. 命令: (nsetq 'abc '(getdist "\n输入距离"))
    
44. 
    
45. 输入距离(1000): 指定第二点: 1660.65
    
46. 
    
47. 命令: !abc
    
48. 1660.65
    
49. 
    
50. --------------------------------------------------------
    
51. 命令: (setq abc "Yes")
    
52. "Yes"
    
53. 
    
54. 命令: (initget "Yes No")
    
55. nil
    
56. 
    
57. 命令: (nsetq 'abc '(getkword "\nYes or No"))
    
58. 
    
59. Yes or No(Yes):
    
60. nil
    
61. 
    
62. 命令: !abc
    
63. "Yes"
    
64. 
    
65. 命令: (initget "Yes No")
    
66. nil
    
67. 
    
68. 命令: (nsetq 'abc '(getkword "\nYes or No"))
    
69. 
    
70. Yes or No(Yes): n
    
71. "No"
    
72. 
    
73. 命令: !abc
    
74. "No"
    

<br /> 命令: (setq abc nil)<br /> nil<br /> <br /> 命令: (nsetq 'abc '(getint "\n输入整数: "))<br /> <br /> 输入整数: 123<br /> 123<br /> <br /> 命令: (nsetq 'abc '(getint "\n输入整数: "))<br /> <br /> 输入整数: (123): 567<br /> 567<br /> <br /> 命令: !abc<br /> 567<br /> <br /> -------------------------------------------<br /> 命令: (initget 6 "A B C")<br /> nil<br /> <br /> 命令: (nsetq 'abc '(getint "\n输入整数: "))<br /> <br /> 输入整数: (567): -5<br /> <br /> 值必须为正且非零。<br /> <br /> 输入整数: (567): 0<br /> <br /> 值必须为正且非零。<br /> <br /> 输入整数: (567): A<br /> "A"<br /> <br /> 命令: !abc<br /> "A"<br /> <br /> --------------------------------------------------------<br /> 命令: (setq abc 1000)<br /> 1000<br /> <br /> 命令: (nsetq 'abc '(getdist "\n输入距离"))<br /> <br /> 输入距离(1000): 指定第二点: 1660.65<br /> <br /> 命令: !abc<br /> 1660.65<br /> <br /> --------------------------------------------------------<br /> 命令: (setq abc "Yes")<br /> "Yes"<br /> <br /> 命令: (initget "Yes No")<br /> nil<br /> <br /> 命令: (nsetq 'abc '(getkword "\nYes or No"))<br /> <br /> Yes or No(Yes):<br /> nil<br /> <br /> 命令: !abc<br /> "Yes"<br /> <br /> 命令: (initget "Yes No")<br /> nil<br /> <br /> 命令: (nsetq 'abc '(getkword "\nYes or No"))<br /> <br /> Yes or No(Yes): n<br /> "No"<br /> <br /> 命令: !abc<br /> "No"<br />

用法总结:

1. 
   
2. (initget 6 "Abc Ghi") ;;如果需要
   
3. (nsetq 'your-symbol  '(GETXXX "Msg"))
   
4. ;;如果 your-symbol  有值，提示里面会自动加入.(回车缺省值)
   

复制代码

dandee

有新意 ！ 学到一招
斑竹的斑竹  来给斑竹加积分

狂刀

写的不错！建议加分

WHGF

真好，可用于输入表达式或函数，楼主应做一些这方面的例子，让大家进一步了解掌握。
谢谢!

ohmylove

不错，很精益求精了，我只把aeo去掉了，嘿嘿。其它的改不动了。
不过有一个吹毛求疵的地方，一般默认值都是用尖括号括起来的。

doubao

技巧性太强了

aeo

最初由 ohmylove 发布
[B]不错，很精益求精了，我只把aeo去掉了，嘿嘿。其它的改不动了。
不过有一个吹毛求疵的地方，一般默认值都是用尖括号括起来的。 [/B]

里面的那个名称和以后的变量名不要重名

所以我有意弄上aeo，你不会没事把我的名字往程序里放吧.
反正重名时不行，我试过.

ohmylove

学习了aeo的代码并尝试着解释一下：

[php]
;;;
;;;(defun nsetq (sym foo / $$swap)

;;;nsetq:    由setq改进而来，故取名nsetq
;;;sym:      symbol的简写，欲赋值的符号，记得一定要在前面加撇号，
;;;          这样就可以像参数的引用传递一样改变传入符号的值，而不
;;;          是仅仅改变本函数中公共临时变量sym的值。
;;;foo:      表示欲调用的get族函数的表，前面也是要加撇号的，否则
;;;          foo得到只是get族函数的返回值，而不是调用语句本身。
;;;          至于foo这个词的来源可以见下面的链接：
;;;          http://www.faqs.org/rfcs/rfc3092.html
;;;$$swap    函数内局部临时变量，加两个美元符号以保证唯一性，原作
;;;          者aeo还加了aeo在前面，也是这个作用，同时也算签名了。
;;;          swap是交换的意思。

;;;        (if        (eval sym)

;;;计算传入符号的值，如果非空，将在下面加到提示中去作为默认值。

;;;                (setq        $$swap (vl-princ-to-string (eval sym))

;;;将传入符号的值变成字符串，赋给$$swap

;;;                                        foo                                 (mapcar '(lambda        (x)
;;;                                                                                                                                (if        (eq 'str (type x))
;;;                                                                                                                                        (strcat x "(" $$swap "): ")
;;;                                                                                                                                        x
;;;                                                                                                                                )
;;;                                                                                                                        )
;;;                                                                                                                 foo
;;;                                                                                 )

;;;这里是对get族函数的调用语句本身进行处理，以加入默认值的提示。
;;;由于get族函数的参数数目不定，用mapcar处理最省事，只要找到提示
;;;字符串，加上默认值就可以了。当然get族函数的参数也不多，一个或
;;;两个，你单独判断处理也行，但是肯定不如上面的简洁。还有一个细节，
;;;一般提示信息最后都是冒号，按上面的语句加上默认值后，提示信息里
;;;面就有两个冒号了。可是如果提示信息后面不冒号，恰好没有默认值，
;;;则显示的提示信息将没有冒号。

;;;                )
;;;        )

;;;        (setq $$swap (eval foo))

;;;eval函数用来执行get族语句，然后将返回值赋给$$swap

;;;        (if        (and $$swap (/= $$swap ""))

;;;判断$$swap是否为null或空字符串

;;;                (set sym $$swap)

;;;如果非空，将新的值赋给传入符号。一定要用set而不是setq。set会
;;;对每个参数求值，再进行赋值，这样就可以给传入符号赋值了。而setq
;;;不会对sym求值，结果只是给临时变量sym赋值，而不是给sym所指的符号
;;;赋值。
;;;        )

;;;这里没有(princ)语句，这样可以传回结果值。

;;;)
[/php]

我打算使用的代码(vlisp的代码一过来就乱了：（)：

[php]
(defun nsetq (sym foo / $$swap)
(if (eval sym)
(setq $$swap (vl-princ-to-string (eval sym))  
foo (mapcar '(lambda        (x)
        (if        (eq 'str (type x))
                (progn
                (setq x (vl-string-right-trim " " x)
        n (strlen x)
                        )
        (cond
        ( (= (substr x n 1) ":")
        (setq x (strcat (substr x 1 (1- n)) "<" $$swap ">: "))
)
( (= (substr x (1- n) 2) "：")
(setq x (strcat (substr x 1 (- n 2)) "<" $$swap ">： "))
)
( T
(setq x (strcat x "<" $$swap ">: "))
)
);cond
);progn
x
);if
)
foo
)  
)
)
        (setq $$swap (eval foo))  
        (if        (and $$swap (/= $$swap ""))
                (set sym $$swap)
        )
)
[/php]

MJJ3468

(defun nsetq(sym foo / $$aeo-swap)
  (if(eval sym)
       (setq $$aeo-swap(vl-princ-to-string(eval sym))
             foo(mapcar '(lambda(x)(if(eq 'str(type x))(strcat x "("$$aeo-swap"): ")x))foo)
       )
  )
  (setq $$aeo-swap(eval foo))
  (if(and $$aeo-swap(/= $$aeo-swap ""))(set sym $$aeo-swap))
)
直接用这个就行了吗，好象不行，我不懂了。
楼主举个例子好了，要么干脆做成函数了下载了。555··
想用
不好意思，昨天弄了下，已经搞好了，原来要加引号。
楼主真是小程序解决大问题。>*_*<