001.
002.
003.
004.
005.
006.
007.
008.
009.
010.
011.
012.
013.
014.
015.
016.
017.
018.
019.
020.
021.
022.
023.
024.
025.
026.
027.
028.
029.
030.
031.
032.
033.
034.
035.
036.
037.
038.
039.
040.
041.
042.
043.
044.
045.
046.
047.
048.
049.
050.
051.
052.
053.
054.
055.
056.
057.
058.
059.
060.
061.
062.
063.
064.
065.
066.
067.
068.
069.
070.
071.
072.
073.
074.
075.
076.
077.
078.
079.
080.
081.
082.
083.
084.
085.
086.
087.
088.
089.
090.
091.
092.
093.
094.
095.
096.
097.
098.
099.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
132.
133.
134.
135.
136.
137.
138.
139.
140.
141.
142.
143.
144.
145.
146.
147.
148.
149.
150.
151.
152.
153.
154.
155.
156.
157.
158.
159.
160.
161.
162.
163.
164.
165.
166.
167.
168.
169.
170.
171.
172.
173.
174.
175.
176.
177.
178.
179.
180.
181.
182.
183.
184.
185.
186.
187.
188.
189.
190.
191.
192.
193.
194.
195.
196.
197.
198.
199.
200.
201.
202.
203.
204.
205.
206.
207.
208.
209.
210.
211.
212.
213.
214.
215.
216.
217.
218.
219.
220.
221.
222.
223.
224.
225.
226.
227.
228.
229.
230.
231.
232.
233.
234.
235.
236.
237.
238.
239.
240.
241.
242.
243.
244.
245.
246.
247.
248.
249.
250.
251.
252.
253.
254.
255.
256.
257.
258.
259.
260.
261.
262.
263.
264.
265.
266.
267.
268.
269.
270.
271.
272.
273.
274.
275.
276.
277.
278.
279.
280.
281.
282.
283.
284.
285.
286.
287.
288.
289.
290.
291.
292.
293.
294.
295.
296.
297.
298.
299.
300.
301.
302.
303.
304.
305.
306.
307.
308.
309.
310.
311.
312.
313.
314.
315.
316.
317.
318.
319.
320.
321.
322.
323.
324.
325.
326.
327.
328.
329.
330.
331.
332.
333.
334.
335.
336.
337.
338.
339.
340.
341.
342.
343.
344.
345.
346.
347.
348.
349.
350.
351.
352.
353.
354.
355.
356.
357.
358.
359.
360.
361.
362.
363.
364.
365.
366.
367.
368.
369.
370.
371.
372.
373.
374.
375.
376.
377.
378.
379.
380.
381.
382.
383.
384.
385.
386.
387.
388.
389.
390.
391.
392.
393.
394.
395.
396.
397.
398.
399.
400.
401.
402.
403.
404.
405.
406.
407.
408.
409.
410.
411.
412.
413.
414.
415.
416.
417.
418.
419.
420.
421.
422.
423.
424.
425.
426.
427.
428.
429.
430.
431.
432.
433.
434.
435.
436.
437.
438.
439.
440.
441.
442.
443.
444.
445.
446.
447.
448.
449.
450.
451.
452.
453.
454.
455.
456.
457.
458.
459.
460.
461.
462.
463.
464.
465.
466.
467.
468.
469.
470.
471.
472.
473.
474.
475.
476.
477.
478.
479.
480.
481.
482.
483.
484.
485.
486.
487.
488.
489.
490.
491.
492.
493.
494.
495.
496.
497.
498.
499.
500.
501.
502.
503.
504.
505.
506.
507.
508.
509.
510.
511.
512.
513.
514.
515.
516.
517.
518.
519.
520.
521.
522.
523.
524.
525.
526.
527.
528.
529.
530.
531.
532.
533.
534.
535.
536.
537.
538.
539.
540.
541.
542.
543.
544.
545.
546.
547.
548.
549.
550.
551.
552.
553.
554.
555.
556.
557.
558.
559.
560.
561.
562.
563.
564.
565.
566.
567.
568.
569.
570.
571.
572.
573.
574.
575.
576.
577.
578.
579.
580.
581.
582.
583.
584.
585.
586.
587.
588.
589.
590.
591.
592.
593.
594.
595.
596.
597.
598.
599.
600.
601.
602.
603.
604.
605.
606.
607.
608.
609.
610.
611.
612.
613.
614.
615.
616.
617.
618.
619.
620.
621.
622.
623.
624.
625.
626.
627.
628.
629.
630.
631.
632.
633.
634.
635.
636.
637.
638.
639.
640.
641.
642.
643.
644.
645.
646.
647.
648.
649.
650.
651.
652.
653.
654.
| ;| Lisp转换Html ☆[七月·信] 修改版
改进信息:
1.原版程序复制到论坛上可能会出现行合并的问题,现在应该不会了
2.原版程序行号会影响复制,现在复制可以避开行号了
3.原版程序对仅对特定开头的函数进行超链接定位,现在对所有的函数都进行了超链接
4.增加批量处理
|;
;;; ==================================
;;; | LISP文件转换成HTML文件程序 |
;;; | ★[七月·信]修改版★ |
;;; | [[晓东论坛]] |
;;; | [[同是土木人论坛]] |
;;; | [[它山之石图形工作室]图形工作室] |
;;; | [七月·信]修改版 |
;;; ==================================
;|
1、此程序仅作为一种应用上的参考,更多功能请自
行定制或关注作者发布的应用程序。
2、程序主框架来自于[晓东论坛],原作者为snoopychen,
参考了zml84的一小部分代码(html文件头部)。
3、原程序未对行内注释进行处理,增加此功能。
4、有特殊前缀的自定义函数颜色设定为特殊着色,
主要用来与内部函数进行区分。
5、增加链接跳转功能,文件中的外部链接会指向特定的网页,
内部链接会指向子函数的定义处。
6、增加了行号,方便阅读。缩进好象变得有问题,待查。
7、原程序需手工输入目录,修改为对话框选择的方式。
8、原程序为将整个目录(含子目录)下的LISP文件全部转换,
增加了只转换一个文件的命令。
9、对原程序增加了部分简单的注释说明,不一定正确。
10、增加了个显示程序正在运行的小把戏,纯属好玩而已。
11、将LISP转换为HTML方便网络发布及程序的管理。
目前还有些想法没有实现,慢慢研究。
|;
;;;命令一,仅转换选择的一个LSP文件
(defun C:LISP2HTML (/ file)
(princ
"\nLISP2HTML转换器 ★[七月·信]★修改版 ver 1.0 原作者:[它山之石图形工作室]"
)
(setq file (getfiled "Select Lisp File" (getvar "dwgprefix") "lsp" 0))
(setq file (EF_Lisp2Html:Lisp->Html file))
(startapp "explorer" file)
(princ)
) ;_ 结束defun
;;;命令二,转换选择的目录下(包括子目录)的所有LSP文件
(defun C:LISPS2HTML (/ direc directree x y direcfile)
(setq direc (EF_Lisp2Html:GetDir))
(setq directree (EF_Lisp2Html:GetSubFolders direc))
(foreach x directree
(setq direcfile (EF_Lisp2Html:GetOnlyFiles x))
(foreach y direcfile
(if (= (vl-filename-extension y) ".lsp")
(EF_Lisp2Html:Lisp->Html y)
) ;_ 结束if
) ;_ 结束foreach
) ;_ 结束foreach
(princ
"\n*** LISP文件转换为HTML文件软件 [七月·信]修改版 <原作者:[它山之石图形工作室]> ***"
)
(princ "\n [[七月·信]]修改")
(princ)
) ;_ 结束defun
;自动将指定字符串替换为超链接
(defun EF_Lisp2Html:AddHref (str / lstTrans)
(setq lstTrans
'(("[晓东论坛]"
.
"<a href=\"http://www.xdcad.net\" target=\"_blank\">[[晓东论坛]]</a>"
)
("[同是土木人论坛]"
.
"<a href=\"http://www.tstmr.com\" target=\"_blank\">[[同是土木人论坛]]</a>"
)
("[它山之石图形工作室]"
.
"<a href=\"http://StoneDWG.ys168.com\" target=\"_blank\">[[它山之石图形工作室]图形工作室]</a>"
)
("[七月·信]"
.
"<a href=\"http://elitefish.ys168.com\" target=\"_blank\">[[七月·信]]</a>"
)
("[信·CAD]"
.
"<a href=\"http://elitefish.ys168.com\" target=\"_blank\">[[信·CAD]]</a>"
)
)
)
(foreach e lstTrans
(setq str (vl-string-subst (cdr e) (car e) str))
)
str
)
;;;子函数,定义程序进度条的显示
(defun EF_Lisp2Html:Spinner ( /)
(if
(not #spin)
(setq #spin "-")
) ;_ 结束if
(cond
((equal #spin "-") (setq #spin "\\"))
((equal #spin "\\") (setq #spin "|"))
((equal #spin "|") (setq #spin "/"))
(T (setq #spin "-"))
) ;_ 结束cond
(princ (strcat (chr 8) #spin))
(princ)
) ;_ 结束defun
;;子函数,只得到一个目录下的所有文件
(defun EF_Lisp2Html:GetOnlyFiles (path / lst res)
(setq lst (vl-directory-files path))
(setq lst (mapcar
'(lambda (x)
(strcat path "\\" x)
) ;_ 结束lambda
lst
) ;_ 结束mapcar
) ;_ 结束setq
(foreach x lst
(if (not (vl-file-directory-p x))
(setq res (append
res
(list x)
) ;_ 结束append
) ;_ 结束setq
) ;_ 结束if
) ;_ 结束foreach
res
) ;_ 结束defun
;;子函数,得到一个目录下的所有子目录
;;返回一个列表,如:("E:\\TEST1" "E:\\TEST1\\TEST2")
(defun EF_Lisp2Html:GetSubFolders
(Path / Folders EF_Lisp2Html:GetSubFolders@Dirs)
(defun EF_Lisp2Html:GetSubFolders@Dirs (Path / Dir Dirs)
(and
(= (type Path) 'STR)
(if (wcmatch Path ",*/,*\\")
(setq Dir Path)
(setq Dir (strcat Path "\\"))
) ;_ 结束if
(setq Dirs (vl-directory-files Dir "*.*" -1))
(setq Folders (cons Path Folders))
(setq Dirs (vl-remove-if
'(lambda (x)
(vl-position x '("." ".."))
) ;_ 结束lambda
Dirs
) ;_ 结束vl-remove-if
) ;_ 结束setq
(mapcar
'EF_Lisp2Html:GetSubFolders@Dirs
(mapcar
'(lambda (x)
(strcat Dir x)
) ;_ 结束lambda
Dirs
) ;_ 结束mapcar
) ;_ 结束mapcar
) ;_ 结束and
) ;_ 结束defun
(EF_Lisp2Html:GetSubFolders@Dirs Path)
(reverse Folders)
) ;_ 结束defun
;将字符串修正为指定长度(左侧加空格)
(defun EF_Lisp2Html:FixNum (str ;字符串
iMax ;字符
/ iLen i strList)
(setq iLen (strlen str))
(if (> iLen iMax)
(progn
(setq strList (vl-string->list str))
(setq i 0)
(repeat iMax
(if (> (car strList) 128)
(setq i (1+ i))
)
(setq strList (cdr strList))
)
(if (= (rem i 2) 1)
(setq str (substr str 1 (1- iMax)))
(setq str (substr str 1 iMax))
)
)
(repeat (- iMax iLen) (setq str (strcat "0" str)))
)
(strcat str ".")
)
;计算正整数的数位
(defun EF_Lisp2Html:NumBit (iNum / i)
(setq i 1)
(while (> (setq iNum (/ iNum 10)) 0)
(setq i (1+ i))
)
i
)
;获取单个字符(中文为双字节)
(defun EF_Lisp2Html:GetChar (str i)
(if (> (ascii (substr str i 1)) 128)
(substr str i 2)
(substr str i 1)
)
)
;;子函数
;;利用WSH得到目录,返回如:"E;\\TEST"
(defun EF_Lisp2Html:GetDir (/ catchit msg path rtn shfolder winshell)
(if (null MSG)
(setq MSG "请选择文件夹(LISP->HTML)")
) ;_ 结束if
(if (setq winshell (vlax-create-object "Shell.Application"))
(progn
(setq shFolder (vlax-invoke-method WinShell 'BrowseForFolder 0 msg 1)
catchit (vl-catch-all-apply
'(lambda ()
(setq shFolder (vlax-get-property shFolder 'self))
(setq path (vlax-get-property shFolder 'path))
) ;_ 结束lambda
) ;_ 结束vl-catch-all-apply
) ;_ 结束setq
(vlax-release-object shFolder)
(vlax-release-object winshell)
(if (vl-catch-all-error-p catchit)
(setq rtn nil)
(setq rtn path)
) ;_ 结束if
) ;_ 结束progn
) ;_ 结束if
rtn
) ;_ 结束defun
;;子函数
(defun EF_Lisp2Html:Format (str)
(setq
;str (vl-string-subst "<" "<" str)
str (vl-string-subst "&" "&" str)
str (vl-string-subst " " " " str)
str (vl-string-subst " " "\t" str)
) ;_ 结束vl-string-subst
) ;_ 结束defun
;将字符串字符串以 给定 Key 分解成
;例:(EF:String->list "a,b,c" ",") →("a" "b" "c")
(defun EF_Lisp2Html:String->list
(sSource sDelimiter / lenSource lenDelimiter iPos lstResult)
(if (= sDelimiter "")
(progn (princ "EF:String->list 分割参数不能为空字符\"\"")
(exit)
)
)
(setq
lenSource (strlen sSource)
lenDelimiter (strlen sDelimiter)
)
(while (setq iPos (vl-string-search sDelimiter sSource))
(setq
lstResult (cons (substr sSource 1 iPos) lstResult)
sSource (substr sSource (+ 1 iPos lenDelimiter))
)
)
(reverse (cons sSource lstResult))
) ;_ end EF:String->list
;将字符串列表以 给定 字符串连接
;例:(EF:List->string ("a" "b" "c") ",") →"a,b,c"
(defun EF_Lisp2Html:List->String (lstString Delimiter / str return)
(setq return (car lstString)
lstString (cdr lstString)
)
(foreach str lstString
(setq return (strcat return Delimiter str))
) ;_ end of foreach
return
) ;end EF:List->string
;将字符串中所有目标字符替换为指定字符串
;sNew 用于替换的字符串
;sOld 将被全部替换的字符串
;sSource 源字符串
(defun EF_Lisp2Html:String-Replace (sNew sOld sSource /)
(EF_Lisp2Html:List->String
(EF_Lisp2Html:String->List sSource sOld)
sNew
)
)
(defun EF_Lisp2Html:Format2 (str)
(setq str (EF_Lisp2Html:String-Replace "&" "&" str))
(setq str (EF_Lisp2Html:String-Replace "<" "<" str))
(setq str (EF_Lisp2Html:String-Replace " " " " str))
(setq str (EF_Lisp2Html:String-Replace "<" "<" str))
;(while (/= str (setq str (vl-string-subst "&" "&" str))))
(setq str (EF_Lisp2Html:String-Replace " " " " str))
(setq str (EF_Lisp2Html:String-Replace
" "
"\t"
str
)
)
)
;;主函数
(defun EF_Lisp2Html:Lisp->Html (file / No rf
strNum wf t1 str
char i f argument
strtest hnzhsh-s hnzhsh-e strr
str_stonedwg str_tstmr
str_xd word str1 str2
lstFun
)
(princ (strcat "\n" file))
(princ "\n正在转换成HTML文件,请稍等... ")
;;打开准备读写的文件
(setq lstFun (EF_Lisp2Html:getFunList file))
(setq rf (open file "r")
wf (open (strcat (vl-filename-directory file)
"/"
(vl-filename-base file)
".html"
) ;_ 结束strcat
"w"
) ;_ 结束open
) ;_ 结束setq
;;初始化行号
(setq No 1)
;;以下逐行处理
(setq str1 "")
(while (setq t1 (read-line rf))
(princ "\n")
(princ t1)
(setq str ""
No (1+ No)
i 1
) ;_ 结束setq
(while (<= i (strlen t1))
(setq word "")
;;以下得到一个单词
(while (not (member (setq char (EF_Lisp2Html:GetChar t1 i))
'("" " " ";" "(" ")" "\"" "\t")
) ;_ 结束member
) ;_ 结束not
;(EF_Lisp2Html:Spinner)
(setq word (strcat word char)
i (+ i (strlen char))
) ;_ 结束setq
) ;_ 结束while
;;如果为空行
(if (= word "")
(setq word char
i (+ i (strlen char))
) ;_ 结束setq
) ;_ 结束if
(if (or strtest (= word ";"))
;;如果是注释
;;20070620实际上需要处理行间注释
(progn
;;20070621解决行间注释不在一行内的情况
(if strtest
(if (setq hnzhsh-e (vl-string-search "|;" t1))
(setq strr (substr t1 1 (+ 2 hnzhsh-e))
i (+ hnzhsh-e 3)
strtest nil
) ;_ 结束setq
(setq strr t1
i (1+ (strlen t1))
) ;_ 结束setq
) ;_ 结束if
;;20070621解决行间注释在一行内的情况
(if (setq hnzhsh-s (vl-string-search ";|" t1))
(if (setq hnzhsh-e (vl-string-search "|;" t1))
(setq strr (substr t1
(+ hnzhsh-s 1)
(+ 2 (- hnzhsh-e hnzhsh-s))
) ;_ 结束substr
i (+ hnzhsh-e 3)
) ;_ 结束setq
(setq strr (substr t1 (+ hnzhsh-s 1))
i (1+ (strlen t1))
strtest T
) ;_ 结束setq
) ;_ 结束if
(setq strr (substr t1 (1- i))
i (1+ (strlen t1))
) ;_ 结束setq
) ;_ 结束if
) ;_ 结束if
(setq str
(strcat
str
"<font color=#6C6C6C><span style=\"background-color:#D0D0D0\">"
(EF_Lisp2Html:Format strr)
"</span></font>"
) ;_ 结束strcat
) ;_ 结束setq
) ;_ 结束progn
;;如果不是注释
; (if (= No 88) (princ no))
(cond
((member word '("(" ")"))
;;★★如果是括号
(setq str (strcat str "<font color=red>")
i (1- i)
) ;_ 结束setq
;;继续处理括号
(while (member (setq char (EF_Lisp2Html:GetChar t1 i))
'("(" ")")
) ;_ 结束member
(setq str (strcat str char)
i (+ i (strlen char))
) ;_ 结束setq
) ;_ 结束while
(setq str (strcat str "</font>")
f (= (substr t1 (1- i) 1) "(")
) ;_ 结束setq
)
;;★★如果是引号(字符串)
((= word "\"")
(setq str (strcat str "<font color=#C000C0>" word))
(setq str2 "")
(while (and (/= (setq char (EF_Lisp2Html:GetChar t1 i)) "") ;_ 结束/=
(or (/= char "\"")
(and (> i 1)
(= (substr t1 (1- i) 1) "\\")
(or
(= i 2)
(/= (substr t1 (- i 2) 1) "\\")
) ;_ 结束or
) ;_ 结束and
) ;_ 结束or
) ;_ 结束and
(setq i (+ i (strlen char))
str2 (strcat str2 char)
; (EF_Lisp2Html:Format char))
) ;_ 结束setq
) ;_ 结束while
;(setq str1 (strcat str (
(setq str2 (EF_Lisp2Html:Format2 str2))
;对引号类特殊符号处理
(setq str (strcat str str2 char "</font>")
i (1+ i)
) ;_ 结束setq
)
;;★★
((= word "'")
(setq str (strcat str "<font color=#800000>'</font>"))
)
;;★★
((= word "/")
(setq str (strcat str "<font color=blue>/</font>")
argument nil
f nil
) ;_ 结束setq
)
;;★★
((= word ".")
(setq str (strcat str word))
)
;;★★如果是整数
((numberp (read word))
(setq str (strcat str "<font color=green>" word "</font>")
f nil
) ;_ 结束setq
)
;;★★如果是左括号之后的字符串
(f
(if argument
;;★★★如果之前的字符串是"DEFUN"(全局变量),则为黑色
(setq str (strcat str (EF_Lisp2Html:Format word))
argument nil
f nil
) ;_ 结束setq
;;★★★如果之前的字符串不是"DEFUN"(函数名),则为蓝色
(setq str (if ;(wcmatch (strcase word) "EF_*,EF-*,EF:,7Xin:,7Xin-,7Xin_")
(member (strcase word) lstFun)
;;20070626自定义函数为青色并增加链接跳转到定义处之功能
;;因为原程序为读一行处理完接着写入,不方便对全文统一处理加链接
;;只能先针对有特定前缀的自定义函数进行链接
;;另外如何在函数定义处增加链接回跳到上页链接处有待研究
;;可跳转到顶部
(strcat str
"<a href=\"#"
(strcase word)
"\">"
"<font color=DarkBlue>"
(EF_Lisp2Html:Format word)
"</font>"
"</a>"
) ;_ 结束strcat
(strcat str
"<font color=blue>"
(EF_Lisp2Html:Format word)
"</font>"
) ;_ 结束strcat
) ;_ 结束if
argument (= (strcase word) "DEFUN")
f nil
) ;_ 结束setq
) ;_ 结束if
)
;;★★
(T
(if (and argument (/= word " ")) ;;★★★20070626 如果之前的字符串是"DEFUN",则增加标签,为链接作准备
(setq str (strcat str
"<a name=\""
(strcase word)
"\">"
(EF_Lisp2Html:Format word)
"</a>"
) ;_ 结束strcat
) ;_ 结束setq
(setq str (strcat str (EF_Lisp2Html:Format word)))
) ;_ 结束if
) ;_ 结束T
) ;_ 结束cond
) ;_ 结束if
) ;_ 结束while
;;此处可以用表来批量处理
;;也可以将论坛网址、程序作者的主页或博客等写在一个文件里
;;或者将收集的程序原下载网址自动转换为链接
;;以下仅为参考
(setq str (EF_Lisp2Html:AddHref str))
(setq str1 (strcat str1 str "<br>"))
) ;_ 结束while
;;组织序号
(setq i 0
strNum "<font color=green>"
)
(while (< (setq i (1+ i)) NO)
(setq strNum (strcat strNum
(if (= (rem i 10) 0)
(strcat "<font color=red>"
(EF_Lisp2Html:FixNum
(rtos i 2 0)
(EF_Lisp2Html:NumBit No)
)
"</font><br>"
)
(strcat (EF_Lisp2Html:FixNum
(rtos i 2 0)
(EF_Lisp2Html:NumBit No)
)
"<br>"
)
)
)
)
)
(setq strNum (strcat strNum "</font>"))
;写入文件
;;★1写入htm文件头部
(write-line
(STRCAT
"<Html>\n<Head><Title>"
FILE
"</Title></Head>\n<Body>"
"\n<Center><H2>"
(VL-FILENAME-BASE FILE)
(VL-FILENAME-EXTENSION FILE)
"</H2></Center>"
"\n"
) ;_ 结束strcat
wf
) ;_ 结束write-line
;★2正式写入
(setq str (strcat
"<table>"
"<tr><th>序号</th><th align = left>代码</th>"
"<tr>"
"<td valign = Top align = right>"
"<P style=\"LINE-HEIGHT:16px\">"
"<font face=Fixedsys>" strNum
"</font>" "</P>"
"</td>" "<td valign = Top>"
"<P style=\"LINE-HEIGHT:16px\">"
"<font face=Fixedsys>" str1
"</font>" "</P>"
"</td>" "</table>"
)
)
(write-line str wf)
(write-line "</Body></Html>" wf)
(close rf)
(close wf)
(strcat (vl-filename-directory file)
"\\"
(vl-filename-base file)
".html"
)
) ;_ 结束defun
;获取所有自定义函数列表
(defun EF_Lisp2Html:getFunList (sFile / rf t1 str i n char sFun lstFun)
(setq rf (open sFile "r"))
(while (setq t1 (read-line rf))
(setq t1 (strcase t1))
(setq t1 (EF_Lisp2Html:String->List t1 "DEFUN"))
(while (cadr t1)
(if (wcmatch (car t1) "* ,*\t,*(")
(progn
(setq str (vl-string-left-trim " \t" (cadr t1))
i 1
sFun ""
)
(while (not (member (setq char (EF_Lisp2Html:GetChar str i))
'("" " " ";" "(" ")" "\"" "\t")
)
)
(setq sFun (strcat sFun char)
i (+ i (strlen char))
)
)
(setq lstFun (cons sFun lstFun))
)
)
(setq t1 (cdr t1))
)
)
(close rf)
lstFun
)
|