支持文件搜索路径

jiucheng01

制作工具箱时，采用的“支持文件搜索路径”，本代码由网上的整合而成，感谢分享代码的各位大大。
代码写得比较粗糙，如有更好的请帮忙指正。

2. (defun 支持文件搜索路径_lst()
   
3. (setq acad_lst (getenv "ACAD"))
   
4. ;将字符串字符串以 给定 Key 分解成
   
5. ;例：(EF:String->list "a,b,c" ",") →("a" "b" "c")
   
6. (defun EF:String->list (sSource sDelimiter / lenSource lenDelimiter iPos lstResult)
   
7.   (if (= sDelimiter "") (progn (princ "EF:String->list 分割参数不能为空字符""") (exit)))
   
8.   (setq
   
9.     lenSource (strlen sSource)
   
10.     lenDelimiter (strlen sDelimiter)
    
11.   )
    
12.   (while (setq iPos (vl-string-search sDelimiter sSource))
    
13.     (setq
    
14.       lstResult (cons (substr sSource 1 iPos) lstResult)
    
15.       sSource (substr sSource (+ 1 iPos lenDelimiter))
    
16.     )
    
17.   )
    
18.   (reverse (cons sSource lstResult))
    
19. ) ;_ end EF:String->list
    
20. 
    
21. ;从列表中移去指定的元素
    
22. (defun drop (lst item)
    
23.   (append (reverse (cdr (member item (reverse lst))))
    
24.     (cdr (member item lst))
    
25.   )
    
26. )
    
27. 
    
28. (defun GetMyApplicationPath  (AppID)
    
29.   (vl-registry-read
    
30.     (strcat
    
31.       "HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\Uninstall\"
    
32.       AppID
    
33.       "_is1"
    
34.       )
    
35.     "Inno Setup: App Path"
    
36.     )
    
37.   )
    
38. 
    
39. 
    
40. (defun EC:Stru:GT:GetPath  ()
    
41.   (GetMyApplicationPath "Gavin")
    
42. )
    
43. 
    
44. 
    
45. (setq acad_lsts (EF:String->list acad_lst ";"))
    
46. (setq acad_lsts1 (foreach x (list ""
    
47.       (EC:Stru:GT:GetPath)
    
48.       (strcat (EC:Stru:GT:GetPath) "\\LISP")
    
49.       (strcat (EC:Stru:GT:GetPath) "\\菜单")
    
50.       (strcat (EC:Stru:GT:GetPath) "\\其它")
    
51.       (strcat (EC:Stru:GT:GetPath) "\\其它\\Vlisp 开发小助手2010版")
    
52.       (strcat (EC:Stru:GT:GetPath) "\\书籍")
    
53.       (strcat (EC:Stru:GT:GetPath) "\\EXE")
    
54.           )
    
55.           (setq acad_lsts (drop acad_lsts x))))
    
56. 
    
57. ;将字符串列表以 给定 字符串连接
    
58. ;例：(EF:List->string ("a" "b" "c") ",") →"a,b,c"
    
59. (defun EF:List->String (lstString Delimiter / str return)
    
60.   (setq return (car lstString)
    
61.   lstString (cdr lstString)
    
62.   )
    
63.   (foreach str lstString
    
64.     (setq return (strcat return Delimiter str))
    
65.     ) ;_ end of foreach
    
66.   return
    
67. );end EF:List->string
    
68. 
    
69. (setq acad_lsts2 (EF:List->string acad_lsts1 ";"))
    
70. (setq tmp (strcat (EC:Stru:GT:GetPath) ";"
    
71.     (strcat (EC:Stru:GT:GetPath) "\\LISP") ";"
    
72.     (strcat (EC:Stru:GT:GetPath) "\\菜单") ";"
    
73.     (strcat (EC:Stru:GT:GetPath) "\\其它") ";"
    
74.     (strcat (EC:Stru:GT:GetPath) "\\其它\\Vlisp 开发小助手2010版") ";"
    
75.     (strcat (EC:Stru:GT:GetPath) "\\书籍") ";"
    
76.     (strcat (EC:Stru:GT:GetPath) "\\EXE") ";"
    
77.     acad_lsts2 ";"))
    
78. (setenv "ACAD" tmp)
    
79. )
    
80. (支持文件搜索路径_lst)
    
81. (princ)

(defun 支持文件搜索路径_lst()<br /> (setq acad_lst (getenv "ACAD"))<br /> ;将字符串字符串以 给定 Key 分解成<br /> ;例：(EF:String->list "a,b,c" ",") →("a" "b" "c")<br /> (defun EF:String->list (sSource sDelimiter / lenSource lenDelimiter iPos lstResult)<br />   (if (= sDelimiter "") (progn (princ "EF:String->list 分割参数不能为空字符""") (exit)))<br />   (setq<br />     lenSource (strlen sSource)<br />     lenDelimiter (strlen sDelimiter)<br />   )<br />   (while (setq iPos (vl-string-search sDelimiter sSource))<br />     (setq <br />       lstResult (cons (substr sSource 1 iPos) lstResult)<br />       sSource (substr sSource (+ 1 iPos lenDelimiter))<br />     )<br />   )<br />   (reverse (cons sSource lstResult))<br /> ) ;_ end EF:String->list<br /> <br /> ;从列表中移去指定的元素 <br /> (defun drop (lst item)<br />   (append (reverse (cdr (member item (reverse lst))))<br />     (cdr (member item lst))<br />   )<br /> )<br /> <br /> (defun GetMyApplicationPath  (AppID)<br />   (vl-registry-read<br />     (strcat<br />       "HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\Uninstall\"<br />       AppID<br />       "_is1"<br />       )<br />     "Inno Setup: App Path"<br />     )<br />   )<br /> <br /> <br /> (defun EC:Stru:GT:GetPath  ()<br />   (GetMyApplicationPath "Gavin")<br /> )<br /> <br /> <br /> (setq acad_lsts (EF:String->list acad_lst ";"))<br /> (setq acad_lsts1 (foreach x (list ""<br />       (EC:Stru:GT:GetPath) <br />       (strcat (EC:Stru:GT:GetPath) "\\LISP")<br />       (strcat (EC:Stru:GT:GetPath) "\\菜单")<br />       (strcat (EC:Stru:GT:GetPath) "\\其它")<br />       (strcat (EC:Stru:GT:GetPath) "\\其它\\Vlisp 开发小助手2010版")<br />       (strcat (EC:Stru:GT:GetPath) "\\书籍")<br />       (strcat (EC:Stru:GT:GetPath) "\\EXE")<br />           )<br />           (setq acad_lsts (drop acad_lsts x))))<br /> <br /> ;将字符串列表以 给定 字符串连接<br /> ;例：(EF:List->string ("a" "b" "c") ",") →"a,b,c"<br /> (defun EF:List->String (lstString Delimiter / str return)<br />   (setq return (car lstString)<br />   lstString (cdr lstString)<br />   )<br />   (foreach str lstString<br />     (setq return (strcat return Delimiter str))<br />     ) ;_ end of foreach<br />   return<br /> );end EF:List->string<br /> <br /> (setq acad_lsts2 (EF:List->string acad_lsts1 ";"))<br /> (setq tmp (strcat (EC:Stru:GT:GetPath) ";"<br />     (strcat (EC:Stru:GT:GetPath) "\\LISP") ";"<br />     (strcat (EC:Stru:GT:GetPath) "\\菜单") ";"<br />     (strcat (EC:Stru:GT:GetPath) "\\其它") ";"<br />     (strcat (EC:Stru:GT:GetPath) "\\其它\\Vlisp 开发小助手2010版") ";"<br />     (strcat (EC:Stru:GT:GetPath) "\\书籍") ";"<br />     (strcat (EC:Stru:GT:GetPath) "\\EXE") ";"<br />     acad_lsts2 ";"))<br /> (setenv "ACAD" tmp)<br /> )<br /> (支持文件搜索路径_lst)<br /> (princ)

laibinwu

支持源码，这个不错。

1. ;从列表中移去指定的元素
   
2. (defun drop (lst item)
   
3.   (append (reverse (cdr (member item (reverse lst))))
   
4.     (cdr (member item lst))
   
5.   )
   
6. )

;从列表中移去指定的元素 <br /> (defun drop (lst item)<br />   (append (reverse (cdr (member item (reverse lst))))<br />     (cdr (member item lst))<br />   )<br /> )

1. ;;最简单的
   
2. (defun mRemoveItem (item lst)
   
3.   (vl-remove-if '(lambda (x) (= x item)) lst)
   
4. )
   

;;最简单的<br /> (defun mRemoveItem (item lst)<br />   (vl-remove-if '(lambda (x) (= x item)) lst)<br /> )<br />

Free-Lancer

drop在这个指定元素有重复时可能出现非期望结果来自: Android客户端

GTJ116600

楼上高手，说得非常对，有重复元素时，可能出现非期望结果:lol

sicky111

楼主这个有点复杂哦。