@dev::compat-cl

说明:组件

用法:

 (@dev::compat-cl)

参数:

返回值:

示例:

(defun @dev::compat-cl ()
  "生成cl兼容包和函数定义"
  (if (findfile (setq funlib-srcdir (strcat (@::get-config '@dev::src) "lib\\src")))
      (foreach
       dir (vl-remove ".." (vl-remove "." (directory funlib-srcdir nil -1)))
       (setq fp (open (strcat @::*prefix* "../projects/atlisp-lsp/src/compat/autolisp/" dir".lisp")"w" "utf8"))
       (if (findfile (strcat (system:dir funlib-srcdir) dir))
	   (progn
	     (setq files (directory (strcat (system:dir funlib-srcdir) dir) "*.lsp" 1))
	     (write-line (strcat "(defpackage :"(strcase dir t)) fp)
	     (write-line "(:use :cl)" fp)
	     (write-line "(:export " fp)
	     (foreach
	      lspfile files
	      (if(and
		  (/= 126 (last (vl-string->list lspfile)))
		  (findfile (strcat (system:dir funlib-srcdir) dir "/" lspfile))
		  )
		 (write-line (strcat "#:"(strcase (vl-filename-base lspfile)t))
			     fp)))
	     (write-line "))" fp)
	     (write-line (strcat "(in-package :"(strcase dir t)")") fp)
	     (foreach
	      lspfile files
	      (if(and
		  (/= 126 (last (vl-string->list lspfile)))
		  (findfile (strcat (system:dir funlib-srcdir) dir "/" lspfile))
		  (setq funsym (cadr (setq fun-expr (read (file:read-stream (strcat (system:dir funlib-srcdir) dir "/" lspfile) "utf-8")))))
		  )
		 (progn
		   (if (not (member (read (vl-filename-base lspfile))
				    '(list length get set sort cos cosh sin sinh
				      get-internal-real-time get-universal-time
				      open close error block sort merge delete
				      + - equal fill member remove-duplicates
				      subst union acos asin evenp gcd random
				      tan tanh consp functionp listp realp stringp
				      replace search print return case format
				      numberp reverse sort-by-number export
				      quit save write-line delete 
				      ))) ;; 与 common-lisp-user 冲突的函数名		       (write-line (strcat "(defun "
					   (strcase (vl-filename-base lspfile)t)
					   " "
					   (vl-prin1-to-string
					    (setq paras
						  (if (member '/ (nth 2 fun-expr))
						      (cdr (reverse(cdr (member '/ (reverse(nth 2 fun-expr))))))
						      (nth 2 fun-expr)
						      )))
					   "\n \""
					   (string:subst-all "\\\"" "\""
							     (strcat (if (p:stringp (nth 3 fun-expr))(nth 3 fun-expr)"")
								     "\n返回值:"
								     (if (p:stringp (nth 4 fun-expr))(nth 4 fun-expr)"")
								     "\n示例:"
								     (if (p:stringp (nth 5 fun-expr))(nth 5 fun-expr)"")))
					   "\" "
					   (vl-string-trim "()" (vl-prin1-to-string paras))
					   ")")
				   fp)
		       ;; (princ funsym)(princ"\n")		       ;; (eval (cons 'defun-q (cdr fun-expr)))		       ))))))
       (close fp)
       )
      ))

@lisp 函数库

介绍

调用函数

安装教程

快速上手：

@dev::compat-cl

上传记录