@::dev-panel-dialog

说明:

用法:

 (@::dev-panel-dialog)

参数:

返回值:

示例:

(defun @::dev-panel-dialog (/ dcl-tmp dcl_fp dcl_id pkg para% run-function after-panel after-panel-cmd *error* )
  (defun *error* (msg)
    (term_dialog)
    (unload_dialog dcl_id)
    (if (= 'file (type dcl_fp))(close dcl_fp))
    (if (and (= 'str (type dcl-tmp)) (findfile dcl-tmp)) (vl-file-delete dcl-tmp))
    (@::*error* msg)
    )
  (if (= "" (@::get-config '@::user-email))
      (@::set-user-info)
    (if (= "" (@::get-config '@::user-token))
	(progn (@::load-module 'pkgman)
	       (@::get-token))
      ))
  (defun after-panel (func)
    ;; TODO: 这里加统计代码    (if (= 'str (type func))
	(if (= 'list (type (read func)))
	    (eval (read func))
	  (if (= 'subr (type (eval(read(strcat "C:"func)))))
	      (eval(read(strcat "(C:"func")")))
	    (@::cmd func)))
      ))

(defun run-function (func)
    (done_dialog 10)
    (setq after-panel-cmd func))
  (if @::*devmenu*
      (progn
	;; 生成 dcl 文件	(setq dcl-tmp (vl-filename-mktemp nil nil ".dcl" ))
	(setq dcl_fp (open dcl-tmp "w"))
	(write-line (strcat "panel : dialog {"
			    "label = \"" (_"Develop Panel") "\"; "
			    ":column{label=\""(_"CurrProject")"\";"
			    ":text{value=\""(_"Name:")""
			    (if (and (/= (@::get-config '@::current-pkg) "")
				     (@::pkg (@::get-local-pkg-info (@::get-config '@::current-pkg)) ':full-name))
				(@::pkg (@::get-local-pkg-info (@::get-config '@::current-pkg)) ':full-name) "")
			    "\";}"
			    ":text{value=\""(_"Version:")""
			    (if (and (/= (@::get-config '@::current-pkg) "")
				     (@::pkg (@::get-local-pkg-info (@::get-config '@::current-pkg)) ':full-name))
				(@::pkg (@::get-local-pkg-info (@::get-config '@::current-pkg)) ':version) "")
			    "\";}"
			    "}:row {label=\"\"; ")
		    dcl_fp
		    )
	(setq i% 1)(setq bt-width 20)
	(foreach rb-menu (mapcar 'car @::*devmenu*)
		 (write-line (strcat ":radio_button{ fixed_width=true; width="
				     (itoa bt-width)
				     ";key=\"S_"(itoa i%)"\";label=\""rb-menu"\";}")
			     dcl_fp)
		 (setq i% (1+ i%))
		 )
	(write-line "}:image{ height=0.1; color=250; fixed_height=true;}:row{label=\"\";" dcl_fp)
	(setq i% 1)
	(setq max-menus
	      (apply 'max (mapcar '(lambda (x)
				    (length (vl-remove-if '(lambda (x) (= "--" (car x)))(cdr x))))
				  @::*devmenu*)))
	
	(foreach bt-menu-column @::*devmenu*
		 (write-line ":column{label=\"\";children_alignment=top;" dcl_fp)
		 (foreach bt-menu (cdr bt-menu-column)
			  ;;(setq bt-menu (vl-remove-if '(lambda (x) (= "--" (car x))) bt-menu))			  (if (/= "--" (car bt-menu))
			      (progn
				(write-line (strcat ":button{ fixed_width=true; children_alignment=left;width="
						    (itoa bt-width)";fixed_height=true;"
						    " key=\"c_"(itoa i%)"\"; label=\""(car bt-menu)"\"; "
						    " action=\"(run-function \\\""
						    (@::string-subst "\\\\\\\"" "\"" (@::cmd2str (cadr bt-menu)))
						    "\\\")\";}")
					    dcl_fp)
				(setq i% (1+ i%)))))
		 (repeat (- max-menus (length (vl-remove-if '(lambda (x) (= "--" (car x))) (cdr bt-menu-column))))
			 (write-line (strcat ":button{ fixed_width=true; width="(itoa bt-width)"; is_enabled=false; }") dcl_fp))
		 (write-line "}" dcl_fp)
		 )
	(write-line (strcat "}" 
			    ":image{ height=0.1; color=250; fixed_height=true;}"
			    " : spacer {} ok_cancel; }")
		    dcl_fp)
	(close dcl_fp)
	
	(setq dcl_id (load_dialog dcl-tmp))
	(if (not (new_dialog "panel" dcl_id))
	    (exit))
	
	(action_tile "accept" "(done_dialog 1)")
	(start_dialog)
	(unload_dialog dcl_id)
	(vl-file-delete dcl-tmp)
	(after-panel after-panel-cmd))
      (progn 
	(alert (_"No package is installed. Please select packages that you needed to install."))
	(@::package-manager-dialog))
      ))

@lisp 函数库

介绍

调用函数

安装教程

快速上手：

@::dev-panel-dialog

上传记录