@::pack-vlx

说明:

用法:

 (@::pack-vlx)

参数:

返回值:

示例:

(defun @::pack-vlx (/ dcl_id pkg-name create-package callback-create-package Select-vlx)
  ;;(@::help (strcat "创建应用包,需输入用于区别其它应用包的英文名称。中文名称及其它项可在生成的 pkg.lsp 文件中修改。\n"))  (if(null (@::check-userinfo))(progn (alert (_"User infomation is invalid."))(exit)))
  (@::package-update)
  (defun check-package-name (pkg-name)
    "check package name is valid."
    (if (member pkg-name
		(mapcar '(lambda (x) (cdr (assoc ':name x)))
			(vl-remove nil (append @::*pkgs*
					       @::*pkgs-release*
					       (mapcar 'cdr @::*local-pkgs*)))))
	(progn (alert (strcat "The package name '" pkg-name "' is duplicate.")) nil)
      (if (apply 'or (mapcar '(lambda (x) (vl-string-search x pkg-name)) '(":" "\\" "/" "|" "?" "*")))
	  (progn (alert (strcat "The package name '" pkg-name "' include invalid char.")) nil)
	T)
      ))
  (defun callback-create-package (/ dcl-tmp dcl_fp dcl_id )
    (setq pkg-name (strcase (get_tile "name") T))
    (if (check-package-name pkg-name)
	(if (and (= 'str (type pkg-name))
		 (< 0 (strlen pkg-name)))
	    (progn
	      (@::create-pkg pkg-name
			    (get_tile "fullname")
			    (if (> (atoi (get_tile "category")) 0)
				(nth (1- (atoi (get_tile "category"))) @::*pkgs-category*)
			      "Uncategorized")
			    (get_tile "description")
			    (if (= "1" (get_tile "multifiles"))
				T
			      nil)
			    (get_tile "vlxname")
			    (get_tile "vlxcommand")
			    )
	      )
	  (alert (stract "The package name '" pkg-name "' have invalid word."))
	  )))
  (defun Select-vlx ()
    (set_tile "vlxname" (getfiled "Please select a vlx file" "D:\\" "vlx" 8)))
  "创建包信息"
  (setq dcl-tmp (vl-filename-mktemp nil nil ".dcl" ))
  (setq dcl_fp (open dcl-tmp "w"))
  (write-line (strcat "createPackage : dialog {label=\"" (_"Create Package for other vlx") "\";" ) dcl_fp)
  (write-line (strcat ":column {:row {:edit_box {label=\""
		      (_"PKG Name")":\";key=\"name\";width=36;fixed_width=true;edit_width=20;alignment=right;}")
	      dcl_fp)
  (write-line (strcat ":text {label=\""(_"English name") "\";key =\"name_desc\";width=50; } }")dcl_fp)
  (write-line (strcat  ":row {: edit_box {label=\""(_"Full Name")":\";" ) dcl_fp)
  (write-line "key=\"fullname\";width=36;fixed_width=true;edit_width=20;alignment=right; }" dcl_fp)
  (write-line (strcat ":text_part {label=\""
		      (_"The name in your local language.")
		      "\";key =\"fullname_desc\";width=50;}}")
	      dcl_fp)
  (write-line (strcat ":row{:button{key=\"vlxbtn\";label=\""
		      "SelectVlx"
		      "\";width=36;fixed_width=true;} :text{key=\"vlxname\";value=\""
		      "Please select a vlx file" "\";width=50;}}")
	      dcl_fp)
  (write-line (strcat ":row{:edit_box{label=\""
		      "vlx Command"
		      "\";key=\"vlxcommand\"; width=36;fixed_width=true;}:text_part{label=\""
		      (_"Please input command to start vlx")
		      "\";key =\"vlx-command-desc\";width=50;}}")
	      dcl_fp)
  (write-line (strcat ":row {:popup_list{label=\""
		      (_"Category")
		      ":\";key=\"category\";width=36;fixed_width=true;edit_width=20;alignment=right;}")
	      dcl_fp)
  (write-line (strcat  ": text_part {	label=\""
		       (_"The package in category.")
		       "\";key =\"category-desc\";width=50;}}")
	      dcl_fp)
  (write-line (strcat ": row {: edit_box {label=\""
		      (_"Description")
		      ":\";key=\"description\";width=95;fixed_width=true;edit_width=80;alignment=right;}}" )
	      dcl_fp)
  (write-line (strcat ": row {: toggle {label=\""
		      (_"Multi Files:include menus,hotkey etc.")
		      "\";key=\"multifiles\";width=95;fixed_width=true;edit_width=80;alignment=right;}}")
	      dcl_fp)
  (write-line "} ok_cancel;}" dcl_fp)
  
  (close dcl_fp)
  (setq dcl_id (load_dialog dcl-tmp))
  (if (not (new_dialog "createPackage" dcl_id))
      (exit))
  (start_list "category")
  (add_list "Uncategorized")
  (mapcar 'add_list @::*pkgs-category*)
  (end_list)
  (action_tile "vlxbtn" "(select-vlx)")
  (action_tile "accept" "(callback-create-package)(done_dialog)")
  (start_dialog)
  (unload_dialog dcl_id)
  (vl-file-delete dcl-tmp)
  (princ)
  )

@lisp 函数库

介绍

调用函数

安装教程

快速上手：

@::pack-vlx

上传记录