网上下载了一程序，就是用不起来，求高手指点

品茗新秀

网上下载了一程序，就是用不起来，求高手指点

;|;=====================================================================
功能： 将LSP文件转换成htm文件     
  按照语法着色，以便于在网页上发布。   
by zml84
|;
;|;====================================================================
;;全局变量：颜色      
0 "#FF0000" 红色 括号   
1 "#0000FF" 蓝色 符号   
2 "#FF00FF" 粉红 字符串   
3 "#CCCCCC" 灰色 注释背景色   
4 "#990099" 黑红色 注释   
5 "#009999" 兰色 实数   
6 "#009900" 绿色 整数   
|;
(setq lsp2htm-col
  '("#FF0000" "#0000FF" "#FF00FF" "#CCCCCC" "#990099" "#009999"
    "#009900")
)
;;;=====================================================================
;;全局变量：系统保留字
(setq lsp2htm-blz
  '("="    "/="
    "/"    "*"
    "+"    "-"
    "<"    "<="
    ">"    ">="
    "~"    "1+"
    "1-"    "abs"
    "acad-pop-dbmod"  "acad-push-dbmod"
    "acad_colordlg"  "acad_helpdlg"
    "acad_strlsort"  "action_tile"
    "add_list"   "ads"
    "alert"   "alloc"
    "and"   "angle"
    "angtof"   "angtos"
    "append"   "apply"
    "arx"   "arxload"
    "arxunload"   "ascii"
    "assoc"   "atan"
    "atof"   "atoi"
    "atom"   "atoms-family"
    "autoarxload"  "autoload"
    "autoxload"   "boole"
    "boundp"   "caaar"
    "caadr"   "caar"
    "cadddr"   "caddr"
    "cadr"   "car"
    "cdddr"   "cddr"
    "cdr"   "chr"
    "client_data_tile"  "close"
    "command"   "cond"
    "cons"   "cos"
    "cvunit"   "defun"
    "defun-q"   "defun-q-List-ref"
    "defun-q-List-set"  "dictadd"
    "dictnext"   "dictremove"
    "dictrename"   "dictsearch"
    "dimx_tile"   "dimy_tile"
    "distance"   "distof"
    "done_dialog"  "end_image"
    "end_list"   "entdel"
    "entget"   "entlast"
    "entmake"   "entmakex"
    "entmod"   "entnext"
    "entsel"   "entupd"
    "eq"    "equal"
    "eval"   "exit"
    "exp"   "expand"
    "expt"   "fill_image"
    "findfile"   "fix"
    "float"   "foreach"
    "gc"    "gcd"
    "get_attr"   "get_tile"
    "getangle"   "getcfg"
    "getcname"   "getcorner"
    "getdist"   "getenv"
    "getfiled"   "getint"
    "getkword"   "getorient"
    "getpoint"   "getreal"
    "getstring"   "getvar"
    "graphscr"   "grclear"
    "grdraw"   "grread"
    "grtext"   "grvecs"
    "handent"   "help"
    "if"    "initget"
    "intdia"   "inters"
    "itoa"   "lambda"
    "last"   "length"
    "list"   "listp"
    "load"   "load_dialog"
    "log"   "logand"
    "logior"   "lsh"
    "mapcar"   "max"
    "mem"   "member"
    "menucmd"   "menugroup"
    "min"   "minusp"
    "mode_tile"   "namedobjdict"
    "nentsel"   "nentselp"
    "new_dialog"   "nil"
    "not"   "nth"
    "null"   "numberp"
    "open"   "or"
    "osnap"   "pause"
    "polar"   "pragma"
    "prin1"   "princ"
    "print"   "progn"
    "prompt"   "quit"
    "quote"   "read"
    "read-char"   "read-line"
    "redraw"   "regapp"
    "rem"   "repeat"
    "reverse"   "rtos"
    "set"   "set_tile"
    "setcfg"   "setenv"
    "setfunhelp"   "setq"
    "setvar"   "setview"
    "sin"   "slide_image"
    "snvalid"   "sqrt"
    "ssadd"   "ssdel"
    "ssget"   "ssgetfirst"
    "sslength"   "ssmemb"
    "ssname"   "ssnamex"
    "sssetfirst"   "start_dialog"
    "start_image"  "start_list"
    "startapp"   "strcase"
    "strcat"   "strlen"
    "subst"   "substr"
    "t"    "tablet"
    "tblnext"   "tblobjname"
    "tblsearch"   "term_dialog"
    "terpri"   "textbox"
    "textpage"   "textscr"
    "trace"   "trans"
    "type"   "unload_dialog"
    "untrace"   "vector_image"
    "ver"       "vports"
    "wcmatch"   "while"
    "write-char"   "write-line"
    "xdroom"   "xdsize"
    "xload"   "xunload"
    "zerop"

   )
)
;;;=====================================================================
;;;主程序
(defun c:tt (/ ii file-lsp file-htm f1 f2 tmp 当前模式 str str-tmp
      stri i j)
    (princ "\nlsp-to-htm")
    (if (setq file-lsp (getfiled "选择要转换的lsp文件"
     ""
     "lsp"
     4
         )
)
(progn
     ;;显示提示信息
     (princ (strcat "\n文件: \"" file-lsp "\""))
     (princ "\n正在转换...\n")
     (setq ii -1)
     ;;★一、打开文件
     ;;读模式打开lsp文件
     (setq f1 (open file-lsp "r"))
     ;;写模式打开htm文件
     (setq file-htm (substr
          file-lsp
          1
          (- (strlen
          file-lsp
      )
      3
          )
      )
    file-htm (strcat file-htm
       "htm"
      )
    f2    (open file-htm "w")
     )
     ;;★二、写入htm文件头部
     (setq tmp
       (strcat
    "<HTML>\n<HEAD><TITLE>"
    file-lsp
    "</TITLE></HEAD>\n<BODY >"
    "\n<CENTER><H1>"
    (last (str-fg file-lsp '("\\")))
    "</H1></CENTER>"
    "\n<SCRIPT LANGUAGE=\"JavaScript\">document.write"
    "(\"最后修改时间: \" + document.lastModified)"
    "\n</SCRIPT>"
    "\n<HR SIZE=5><PRE>"
       )
     )
     (princ tmp f2)

     ;;★三、处理代码写入
     ;;初始化当前模式
     ;;　　　约定为：0----代码; 1----字符串; 2----注释
     (setq 当前模式 0)
     ;;读取lsp文件，逐行处理
     (while (setq str (read-line f1))
  ;;★打印调试信息
  ;;(princ "\n")
  ;;(princ str)
  ;;逐个元素进行处理
  (setq lst-tmp
    (str-fg str
     '("(" ")" " " "\t" ";" "|" "\"" "\\"
       "'")
    )
  )
  (setq i 0)
  (while (setq stri (nth i lst-tmp))
      (cond
   ;;★3.0代码模式
   ((= 当前模式 0)
    (cond
        ;;圆括号
        ((or (= stri "(")
      (= stri ")")
         )
         (setq
      tmp
         (strcat
      "<FONT face=\"Fixedsys\" COLOR=\""
      (nth 0
           lsp2htm-col
      )
      "\">"
      stri
      "</FONT>"
         )
         )
         (princ tmp f2)
        )


        ;;空格、Tab
        ((or (= stri " ")
      (= stri "\t")
         )
         (setq
      tmp
         stri
         )
         (princ tmp
         f2
         )
        )

        ;;LISP系统保留字符
        ((and (= (type stri) 'STR)
       (or (member
        (strcase stri t)
        lsp2htm-blz
           )
           (wcmatch
        (strcase stri t)
        "vl-*"
           )
           (wcmatch
        (strcase stri t)
        "vlax-*"
           )
           (wcmatch
        (strcase stri t)
        "vlr-*"
           )
           (and
        (> i 0)
        (= (nth
        (1- i
        )
        lst-tmp
           )
           "("
        )
        (wcmatch
            (strcase
         stri
         t
            )
            "zml-*"
        )
           )

       )
         )
         (setq
      tmp
         (strcat
      "<FONT face=\"Fixedsys\" COLOR=\""
      (nth 1
           lsp2htm-col
      )
      "\">"
      stri
      "</FONT>"
         )
         )
         (princ tmp f2)
        )

        ;;注释 ;
        ((= stri ";")
         (if (= (nth (1+ i) lst-tmp)
         "|"
      )
      ;;多行注释(例如 ;|  )
      (progn
          (setq tmp ";|")
          (setq i (1+ i))
          ;;将模式设置为注释
          (setq 当前模式 2)
      )
      ;;单行注释(例如 ;  ;;  ;;; )
      (progn
          (setq tmp "")
          (while
       (setq stri
         (nth
             i
             lst-tmp
         )
       )
          (setq tmp (strcat
          tmp
          stri
             )
         i   (1+ i)
          )
          )
          (setq tmp
            (strcat
         "<FONT face=\"Fixedsys\" COLOR="
         (nth 4
       lsp2htm-col
         )
         "><SPAN STYLE=\"BACKGROUND-COLOR: "
         (nth 3
       lsp2htm-col
         )
         "\">"
         tmp
         "</SPAN></FONT>"
            )
          )
          (princ tmp f2)
      )
         )
        )

        ;;字符串
        ((= stri "\"")
         (setq tmp "\"")
         ;;将模式设置为字符串
         (setq 当前模式 1)
        )

        ;;实数
        ((= (type (read stri)) 'REAL)
         (setq
      tmp
         (strcat
      "<FONT face=\"Fixedsys\" COLOR=\""
      (nth 5
           lsp2htm-col
      )
      "\">"
      stri
      "</FONT>"
         )
         )
         (princ tmp f2)
        )

        ;;整数
        ((= (type (read stri)) 'INT)
         (setq
      tmp
         (strcat
      "<FONT face=\"Fixedsys\" COLOR=\""
      (nth 6
           lsp2htm-col
      )
      "\">"
      stri
      "</FONT>"
         )
         )
         (princ tmp f2)
        )

        ;;截断处理
        (t
         (setq
      tmp
         (strcat
      "<FONT face=\"Fixedsys\">"
      stri
      "</FONT>"
         )
         )
         (princ tmp f2)
        )
    )
   ) ;_结束 代码模式

   ;;★3.1字符串模式
   ((= 当前模式 1)
    (cond
        ;;以 & 开头的htm格式符号
        ((wcmatch stri "&*")
         (setq tmp
           (strcat
        tmp
        "&"
        (substr stri 2)
           )
         )
        )
        ;;转义字符 \
        ((= stri "\\")
         (setq tmp (strcat
         tmp
         stri
         (nth (+ i 1)
       lst-tmp
         )

     )
        i (1+ i)
         )
        )
        ;;字符串结束符 "
        ((= stri "\"")
         (setq
      tmp    (strcat tmp stri)
      当前模式 0
         )
        )
        (t
         (setq
      tmp (strcat tmp stri)
         )
        )
    ) ;_结束 cond
    ;;判断是否写入文件
    (if (or (= 当前模式 0)
     ;;本行最后一个
     (= i
        (1- (length
         lst-tmp
     )
        )
     )
        )
        (progn
     ;;将字符串中的htm关键字替换
     (if (or (wcmatch
          tmp
          "*<*"
      )
      (wcmatch
          tmp
          "*>*"
      )
         )
         (setq
      tmp
         (str-th
      tmp
      '(("<"
         "<"
        )
        (">"
         ">"
        )
       )
         )
         )
     )
     ;;附加上格式信息
     (setq tmp
       (strcat
           "<FONT face=\"Fixedsys\" COLOR=\""
           (nth
        2
        lsp2htm-col
           )
           "\">"
           tmp
           "</FONT>"
       )
     )
     (princ tmp f2)
     (setq tmp "")
        )
    ) ;_结束 写入文件判断
   ) ;_结束 字符串模式

   ;;★3.2多行注释模式
   ((= 当前模式 2)
    (setq tmp (strcat tmp stri))

    (if (or (= i (1- (length lst-tmp)))
     (and (= stri "|")
          (= (nth (1+ i)
           lst-tmp
      )
      ";"
          )
     )
        )
        (progn
     ;;若遇到注释结束符 |; 则返回代码模式
     (if (and (= stri "|")
       (= (nth (1+ i)
        lst-tmp
          )
          ";"
       )
         )
         (setq tmp (strcat tmp
             ";"
            )
        i (1+ i)
        当前模式 0
         )
     )
     (setq tmp
       (strcat
           "<FONT size=2 face=\"Fixedsys\" COLOR="
           (nth 4 lsp2htm-col)
           "><SPAN STYLE=\"BACKGROUND-COLOR: "
           (nth 3 lsp2htm-col)
           "\">"
           tmp
           "</SPAN></FONT>"
       )
     )
     (princ tmp f2)
     (setq tmp "")
        )
    )
   ) ;_结束 注释模式
      ) ;_结束 cond

      (setq i (1+ i))
  )
  ;;显示提示信息
  (if (= ii 3)
      (setq ii 0)
      (setq ii (1+ ii))
  )
  (princ (strcat "\r  "
          (nth ii '("---" " / " " | " " \\ "))
         )
  )

  (princ "\n" f2)
     ) ;_结束 while

     ;;★四、写入htm文件尾部
     (setq tmp "</PRE></BODY></HTML>")
     (princ tmp f2)
     ;;★五、关闭文件
     (close f2)
     (close f1)
     ;;★六、使用打开htm文档
     (princ "\r>>>成功操作完成!!\n")
     ;;(zml-speak "成功操作完成，感谢使用!!")
     (startapp "notepad" file-htm)
) ;_结束 progn
    ) ;_结束 if
    (princ)
) ;_结束 defun

;|;=====================================================================
定义函数：分割字符串      
参数说明： str---欲分割的字符串     
   lst---分割符表，参数类型：表   
返回值：分割后的字符串表(包含分隔符)   
    类型：表；原子类型:字符串   
示  例：(str-fg "(200~400)x5" '("(" "~" ")" "x"))  
   返回：("(" "200" "~" "400" ")" "x" "5")   
  (str-fg "(setq a 123)" '("(" ")" " " "'"))  
   返回：("(" "setq" " " "a" " " "123")      
日　期：zml84 于2007-05-08     
|;
(defun str-fg
       (str lst / xx i j stri test01 n ni jg)
    (if (or (= str "")
     (= lst "")
)
(setq jg (list str))
(progn
     ;;★第一步、计算截取的位置
     (setq xx '()
    i  1
     )
     (repeat (strlen str)
  (setq stri   (substr str i 1)
        j      0
        test01 T
  )
  (while test01
      (if (= j (length lst))
   (setq test01 nil)
   (if (= stri (nth j lst))
       (setq
    xx     (cons i xx)
    test01 nil
       )
       (setq j (1+ j))
   )
      )
  ) ;_ 结束while
  (setq i (1+ i))
     ) ;_ 结束repeat
     ;;★第二步、截取字符串
     (if (= xx nil)
  (setq jg (list str))
  (progn
      ;;将表倒置
      (setq xx (reverse xx))
      ;;下面截取字符串
      (setq jg '()
     n  0
      )
      ;;1.判断第一个
      (if (= (car xx) 1)
   ()
   (setq
       jg (cons
       (substr
           str
           1
           (1- (car xx
        )
           )
       )
       jg
          )
   )
      )
      ;;2.中间部分
      (repeat (1- (length xx))
   (setq i (nth n xx)
         j (nth (1+ n) xx)
   )
   (setq
       jg (cons (substr str
          i
          1
         )
         jg
          )
   )
   (if (> (- j i) 1)
       (setq
    jg (cons (substr
          str
          (1+ i)
          (- j
      i
      1
          )
      )
      jg
       )
       )
   )
   (setq n (1+ n))
      )
      ;;3.判断最后一个
      (setq jg (cons (substr str
        (last xx)
        1
       )
       jg
        )
      )
      (if (= (last xx) (strlen str))
   ()
   (setq jg (cons
         (substr
      str
      (1+ (last xx
          )
      )
      (- (strlen
      str
         )
         (last xx
         )
      )
         )
         jg
     )
   )
      )
      (setq jg (reverse jg))
  )
     )
) ;_结束 progn
    ) ;_结束 if
    jg
) ;_ 结束defun

;|;=====================================================================
定义函数：替换字符串      
参数说明： str---欲替换的字符串   
   lst---分割符表，参数类型：表   
返回值：替换后的字符串      
类  型：字符串      
示  例：(str-th "<HTML>" '(("<" "<") (">" ">")))  
   返  回："<HTML>"   
日  期：zml84 于2007-05-08     
|;
(defun str-th (str lst / i a b len-a tmp j strj)
    (if (and str lst)
(progn
     (setq i 0)
     (repeat (length lst)
  (setq a     (car (nth i lst))
        len-a (strlen a)
        b     (cadr (nth i lst))
        tmp   ""
  )

  (if (>= (strlen str) len-a)
      (progn
   (setq j 1)
   (repeat (- (strlen str)
       len-a
       -1
    )
       (setq
    strj (substr str
          j
          1
         )
       )
       (if (= strj a)
    (setq tmp
      (strcat tmp
       b
      )
    )
    (setq tmp
      (strcat
          tmp
          strj
      )
    )
       )
       (setq j (1+ j))
   )
      )
  )

  (setq i   (1+ i)
        str tmp
  )
     )
)
    ) ;_结束 if
    str
) ;_ 结束defun

;;;=====================================================================
;;;加载后的提示信息
(princ "\nlsp转换htm 加载完成!!")
(princ "\n★输入命令TT开始运行\n")
(princ)

xyp1964

你用不上，没用！

cnks

xyp1964 发表于 2014-3-27 14:15
你用不上，没用！

院长很直接

品茗新秀

cnks 发表于 2014-3-27 18:39
院长很直接

感觉这个对初学者非常好，顶出高手来

llsheng_73

沙发和板凳上的都是高手，他们给你说了这个东东没用