@dev::make-compat-cl

说明:组件

用法:

 (@dev::make-compat-cl)

参数:

返回值:

示例:

(defun @dev::make-compat-cl(/ fp *error* prefix page str-pre
				str-pre-title qqq
				)
  (defun *error*(msg)
    (if fp (close fp))
    (if fi (close fi))
    (princ msg))
  (defun write-fun (body str-desc fp)
    (setq paras (cdr body))
    (if (eq '&rest (last paras))
	(setq paras
	      (append 
	       (reverse (cddr (reverse paras)))
	       (list '&rest)
	       (list (cadr (reverse paras))))))
    (setq str-paras (vl-prin1-to-string paras))
    
    (write-line (strcat "(defun "
			(string:subst-all
			 "\\\"" "\""
			 (strcat
			  (strcase (vl-symbol-name (car body)) t)
			  " "
			  str-paras))
			)
		fp)
    ;;函数文档    (write-line (strcat
		 "\""
		 (string:subst-all
		  " " "\n" (string:subst-all
			    "\\\"" "\""str-desc))
		 "\"")
		fp)
    ;; 参数用于去除未使用参数警告    (write-line (vl-string-trim "() "(vl-prin1-to-string (vl-remove '&rest paras))) fp)
    (write-line ")" fp)
    )
  
  (setq file-src (getfiled "要生成 compat-cl 的源文件" (strcat (@::get-config '@dev::src)  "docs/aibot/") "org" 8))
  (setq prefix "")(setq qprefix "")
  (setq fi (open file-src "r"))
  (if(> (@::acadver) 24)
     (setq fp (open (strcat (@::get-config '@dev::src) "../projects/atlisp-lsp/src/compat/autolisp/" (vl-filename-base file-src) "-tmp.lisp")"w" "utf8"))
     (setq fp (open (strcat (@::get-config '@dev::src) "../projects/atlisp-lsp/src/compat/autolisp/" (vl-filename-base file-src) "-tmp.lisp")"w"))
     )
  
  (setq str-pre-title "")
  (setq body nil)
  (setq str-desc "") (setq page 0)

(while (setq str-line (read-line fi))
    (cond
     
     ((= "#+"  (substr str-line 1 2))
      )
     ((= "* " (substr str-line 1 2))
      (cond
       ((and (/= "" str-pre-title)
	     (/= "" str-desc)
	     (/= "" str-body)
	     (listp body)
	     (> (length body) 0)
	     )
	(princ str-pre-title)
	(setq qqq (@dev::parse-question str-pre-title))
	
	(write-fun body str-desc fp)
	
	;; (write-line (strcat  "\"" (vl-string-left-trim "函数" (car qqq))"\": {") fp)	;; (write-line (strcat "\"prefix\" : \"" (vl-string-left-trim "函数" (car qqq)) "\",") fp)	;; (write-line (strcat "\"body\": [") fp)	;; (write-line (strcat "\"("	;; 		    (string:subst-all	;; 		     "\\\"" "\""	;; 		     (strcat	;; 		      (if (= (strcase (vl-symbol-name (car body)) t)	;; 			     (strcase (vl-string-left-trim "函数" (car qqq)) t))	;; 			  (vl-string-left-trim "函数" (car qqq))	;; 			(strcase (vl-symbol-name (car body)) t)	;; 			)	;; 		      str-paras))	;; 		    ")\"")	;; 	    fp)	;; (write-line "],"fp)	;; (write-line (strcat	;; 	     "\"description\":"	;; 	     "\""	;; 	     (string:subst-all	;; 	      " " "\n" (string:subst-all	;; 			"\\\"" "\""str-desc))	;; 	     "\"")	;; 	    fp)	;; (write-line "}," fp)	(setq str-pre-title str-line)
	(setq str-body "")(setq body nil)
	(setq str-desc "")
	)
       ;; 无代码的关键字       ((and (/= "" str-pre-title)
	     (/= "" str-desc)
	     ;;(/= "" str-body)	     (null body)
	     )
	(princ str-pre-title)
	(setq qqq (@dev::parse-question str-pre-title))
	(write-fun body str-desc fp)

(setq str-pre-title str-line)
	(setq str-body "")(setq body nil)
	(setq str-desc "")
	)
       (t
	(setq str-pre-title str-line))
       )
      )
     ((= "** " (substr str-line 1 3))
      (setq str-body (substr str-line 4))
      (princ str-line)
      (if (listp (read str-body))
	  (setq body (read str-body))
	))
     (t
      (if (/= "" (vl-string-trim " " str-line))
	  (if (= "" str-desc)
	      (setq str-desc str-line)
	    (setq str-desc (strcat str-desc "\\n " str-line) )))
      ))
    )
  ;; 写最后一个  (cond
   ((and (/= "" str-pre-title)
	   (/= "" str-desc)
	   (/= "" str-desc)
	   (/= "" str-body)
	   (listp body)
	   (> (length body) 0)
	   )
      (progn 
	(setq qqq (@dev::parse-question str-pre-title))

(write-fun body str-desc fp)
    	
	(setq str-pre-title str-line)
	(setq str-body "")(setq body nil)
	(setq str-desc "")
	))
   ;; 无代码的关键字   ((and (/= "" str-pre-title)
	 (/= "" str-desc)
	 ;;(/= "" str-body)	 (null body)
	 )
    (princ str-pre-title)
    (setq qqq (@dev::parse-question str-pre-title))
    (write-fun body str-desc fp)
    (setq str-pre-title str-line)
    (setq str-body "")(setq body nil)
    (setq str-desc "")
    ))
  ;; (write-line "}" fp)  (close fp)
  (close fi)
  ;;(@::speak "已生成聊天数据库，请到微信对话开放平台导入。")  )

@lisp 函数库

介绍

调用函数

安装教程

快速上手：

@dev::make-compat-cl

上传记录