;;; MAIN.LSP
;;; ===============================================================
;;; GLOBAL FUNCTIONS for ARES Lisp Routines
;;; ===============================================================
;;; (C)opyright Gräbert GmbH (CadAnywhere) 1995-2013
;;; ===============================================================
;;; Created: Jan 20, 1996 vp
;;; Changed: Jan 12, 1997 vp
;;; Changed: Jul 26, 1998 vp
;;; Added: language independent developer section at the end of 
;;; this file
;;; Changed: Aug. 30, 2002 cK
;;; Changed: Mar 15, 2004 HTh
;;;   Added often used general functions from batproc.lsp:
;;;   flx_langstr flx_langalert flx_errexit
;;;   flx_strtok flx_splitfn flx_pfnnrm
;;;   flx_env2dir flx_ffany flx_appff flx_loaddll
;;;   Changed: Apr.16, 2007 cK:
;;;   New setfunhelp links assigned for new html/chm help of PowerCAD Pro 7.
;;; Changed: July 17, 2008 HTh adapted for ARES
;;; Changed: March 24, 2011 HTh
;;;    added: flx_strtrim
;;;    added: inc dec
;;;    added: IsFcn?
;;;    added: alertexit
;;;    added: DepReqFcnLspLoad
;;;    extended:  flx_strtok - flag bit 3 added
;;; Changed Aug 10, 2012 HTh: 
;;;    fx_filefind replaced by findfile, so this works also, if fdt is not available
;;;
;;; Changed Dec 07, 2012 HTh: checking if fdt available, related function
;;; Changed Apr 10, 2013 HTh: Platform depended adpation for path delimiter
;;;
;;; ===============================================================
;;; This file is called by Start.LSP
;;; 
;;; Obsolete:
;;;    Global variable FLX$DIRECTORY for application search path 
;;;      is set in Start.LSP
;;; ===============================================================
;;;
;;;
;;; ***************************************************************
;;; FUNCTION LIBRARY: INIT and EXIT functions & Error Handling
;;;                   ### Note: Use only with tested functions!
;;; ***************************************************************
;;; ***************************************************************
;;; AutoLOAD functions for LISP and FDT
;;; (autolaod "LSPFILE" '("cmd1" "cmd2" ... "cmdn"))
;;; (autoxload "FDTDLL" '("cmd1" "cmd2" ... "cmdn"))
;;; Note that the LSPFILE and the FDTDLL must'nt have the
;;; extension ".LSP" ".DLL"
;;; Moreover remove the C: prefix from the command definition
;;;
;;;
;;; AutoLoad.LSP
;;; ======================================================================
;;; GLOBAL FUNCTIONS for Lisp Routines
;;; ======================================================================
;;; Created: Jan 20, 1996 vp
;;; 
;;; ======================================================================
;;; This file is called from xx_STUP.LSP
;;; ======================================================================


;; function to test if something is a function or if bound on a function
(defun isfcn?( targ / tfcn head )
	(if (= 'SYM (type targ))
		(setq tfcn (eval targ))
		(setq tfcn targ)
	)
	(setq fcntyp (type tfcn))
	(cond
		((= 'EXSUBR fcntyp) 'EXSUBR)
		((= 'SUBR fcntyp) 'SUBR)
		(	(and tfcn
				(listp tfcn)
				(listp (setq head (car tfcn)))
				(listp head)
				(setq head (if head head '(/)))
				(apply '= (cons 'SYM (mapcar 'type head)))
				(cdr tfcn)
			)
			(if 
				(setq arglst (member '/ (reverse head)))
				(reverse arglst)
				head
			)
		)
		(T nil)
	)
)
;


; Function to check if fdt is available
(defun ChckFDT( / SNStr GDENoStr)
	(and xload 
		(isfcn? xload)
		(setq snstr (getvar "SERNUMBER"))
		(= 'STR (type snstr))
		(setq GDENoStr (substr snstr 1 3))
		(wcmatch GDENoStr "###")           ; Test if readable GDE-No (DS with no fdt has "-" here)
		(not (member GDENoStr '("607")))   ; test if not Ares Commander
	)
)
;

;
(cond 
	((and 
		(setq *PlatForm* (getvar "PLATFORM"))
		(setq *PlatForm* (strcase *PlatForm*))
		(wcmatch *PlatForm* "MICROSOFT WINDOWS NT*")
	 )
	 (setq *PathDelimChar* "\\")
	 (setq *FDTFlag* (ChckFDT))
	)
	((wcmatch *PlatForm* "MAC OSX*") 
		(setq *PathDelimChar* "/")
		(setq *FDTFlag* ())
	)
	((wcmatch *PlatForm* "LINUX*") 
		(setq *PathDelimChar* "/")
		(setq *FDTFlag* ())		
	)
)
;



; Function to select a string from list
; the function will return the string selected by lidx
; if lidx is not given it is determined by the system variable
; "LANGUAGE"
; sample: 
; (flx_langstr '("English" "German" "Turkish" "Hungarian" ..) 3)
; -> returns Turkish
; If lidx specify a non existant list item for strlst, the first
; item of strlst (english) is returned.
(defun flx_langstr( strlst lidx / lidx res )
	(cond
		((not strlst) nil)
		((equal 'STR (type strlst)) strlst)
		((equal 'LIST (type strlst))
			(if (not lidx) (setq lidx (getvar "LANGUAGE")))
			(if (not (equal 'INT (type lidx))) (setq lidx 0))
			(if (= 2 lidx) (setq lidx 0))
			(if (< 2 lidx) (setq lidx (1- lidx)))
			(if 
				(and 
					(setq res (nth lidx strlst))
					(equal 'STR (type res))
					(/= "" res)
				)
				res
				(setq res (car strlst))
			)
		)
		(T (print "Error calling flx_langstr!"))
	)
)
;


; Function (FLX_LangAlert [msg [titel [mode]]] / )
; Function for providing an error/warning/msg dialog window 
; which use (alert msg titel mode) but can be use for multi-
;	lingual output
; msg: message string or list of message strings or nil
; titel: message string or list of message strings or nil
; mode: mode string or nil
; e.g.:	
;	(flx_langangalert 
;	 '("english msg" "german msg" ...)
;	 '("english titel" "german titel" ...)
;		"STOP"
; )	
;------=============================---------------------
(defun flx_langalert( msg titel mode / msg titel mode al)
;------=============================---------------------
	(setq msg (flx_langstr msg))
	(setq titel (flx_langstr titel))
	(setq al (if mode (list mode) ()))
	(if titel (setq al (cons titel al)))
	(if msg (setq al (cons msg al)))
	(apply 'alert al)
)
;


; Function flx_SplitFn to split a filename into its parts
; (flx_splitfn "L:/path/fname.ext" 15) returns ("L:" "\\path\\" "fname" ".ext")
; flag1 (=1) convert all letters to upper
;------==================------------------------------------------------------
(defun flx_splitfn( fn fl / fl len pos ptpos bslpos fnpos fdrive fpath fname 
														ch fext fnlst)
;------==================------------------------------------------------------
	
	(if (not fl) (setq fl 0))
	(if	(/= 0 (logand 1 fl)) (setq fn (strcase fn)))
	(setq fn (flx_pfnnrm fn))
	
	; obtaining the drive, if specified
	(if
		(= ":" (substr fn 2 1))
		(setq fdrive (substr fn 1 2)
					fn (substr fn 3)
		)
		(setq fdrive "")
	)

	; obtaining the networkname, if specified
	(if
		(= (strcat *PathDelimChar* *PathDelimChar*) (substr fn 1 2))
		(progn
			(setq len (strlen fn))
			(setq pos 2)
			(while
				(and 
					(<= (setq pos (1+ pos)) len)
					(/= *PathDelimChar* (substr fn pos 1))
				)
			)
			(setq fdrive (substr fn 1 (1- pos)))
			(setq fn (substr fn pos))
		)
	)			

	; obtaining the ext/path/basname
	(setq len (strlen fn)	pos len)
	(while
		(< 0 pos)
		(setq ch (substr fn pos 1))
		(cond
			(	(and (not bslpos) (not ptpos) (= ch "."))
				(setq ptpos pos)
			)
			(	(or (= ch *PathDelimChar*))
				(setq bslpos pos)
				(setq pos 1)
			)
		)
		(setq pos (1- pos))
	)
	(if (not bslpos) (setq bslpos 0))
  (setq fnpos (1+ bslpos))
	(setq len (1+ len))
	(if (not ptpos)	(setq ptpos len) )
	(setq fpath (substr fn 1 bslpos))
	(setq fname (substr fn fnpos (- ptpos fnpos)))
	(setq fext (substr fn ptpos (- len ptpos)))
	(setq fnlst	(list fdrive fpath fname fext))
)	;end flx_splitfn
;


; Function flx_pfnnrm to normalize a file or pathname
; "/" will be replaced by "\\" or "\\" will replaced by "/"
; fl: 
; if fl nil or 0: char at last position unchanged
; if fl=1: \\ will be appended if necessary 
; if fl=2: \\ will be deleted at last position - this will have the higher priority than fl=1
; if fl=4: use "/" instead of "\\" 
;------==================------------------------------------------------------
(defun flx_pfnnrm( pfn fl / fl pos sl resstr ch cho chn)
;------==================------------------------------------------------------
	(if (not fl) (setq fl 0))
	(if (/= 0 (logand fl 4))
		(setq cho *PathDelimChar* chn "/")
		(setq cho "/" chn *PathDelimChar*)
	)
	(setq pos 0
				sl  (strlen pfn)
				resstr ""
	)
	(while
		(<= (setq pos (1+ pos)) sl)
		(if 
			(= cho (setq ch (substr pfn pos 1)))
			(setq ch chn)
		)					
		(if
			(or		
				(/= pos sl)  (/= chn ch) (= 0 (logand fl 2))
			)
			(setq resstr (strcat resstr ch))
		)
	)
	(if 
		(and ch
			(/= 0 (logand fl 1))
			(/= "" ch) (/= chn ch)
		)
		(setq resstr (strcat resstr chn))
	)
	resstr
)	;end flx_pfnnrm
;


; Function for quick exit without print the exit msg
; if msg is given, a dialog box appears 
;	( see "(alert ...)" for more details
;------============================-----------------
(defun flx_errexit( msg titel mode / msg titel mode)
;------============================-----------------
	(defun *error*( / )
		(setq *error* ())
		(princ)
	)
	(if (not mode) (setq mode "STOP"))
	(if (not titel) (setq titel "STOP"))
	(if msg	(flx_langalert msg titel mode))
	(exit)
)	;end flx_errexit
;


; Function to remove spaces/tabs from the begin/end of a string
; flag | 1: at the begin
; flag | 2: at the end
; if flag is not give, flag=3 is assumed, i.e. trimming at the beg and at the end
;------====================--------------------------
(defun flx_strtrim( s flag / ch pos begpos endpos sl)
;------====================--------------------------
	(if (not flag) (setq flag 3))
	(setq pos 1)
	(setq sl (strlen s))
	(if 
		(/= 0 (logand flag 1))
		(while
			(and
				(<= pos sl)
				(setq ch (substr s pos 1))
				(member ch '(" " "\t"))
			)
			(setq pos (1+ pos))
		)
	)
	(setq begpos pos)
	(setq pos sl)
	(if
		(/= 0 (logand flag 2))
		(while
			(and
				(< 0 pos)
				(setq ch (substr s pos 1))
				(member ch '(" " "\t"))
			)
			(setq pos (1- pos))
		)
	)
	(setq endpos (1+ pos))
	(substr s begpos (- endpos begpos))
)
;


; function, which splits the string tstr in a
; list of substrings determined by the seperation
; characters which a part of chs
;	fl determines if empty strings will be returned
; if fl: at least one empty string is returned
; if fl | 2: all empty strings will returned
; if fl | 4: substrings are not splitted
; if fl | 8: the original delimiter is added as an item in the list
;------====================----------------------------------------------------
(defun flx_strtok( ts cs fl / cs ch chs p1 p2 sl res strchr)
;------====================----------------------------------------------------

	(if (not fl) (setq fl 0))

	;local function, uses cs from calling function
	;to check, if ch is in the string cs
	(defun StrChr( ch / pos)
		(setq pos (strlen cs))
		(while
			(and
				(< 0 pos)
				(/= ch (substr cs pos 1))
			)
			(setq pos (1- pos))
		)
		(if (< 0 pos) ch nil)
	)
	
	(setq p1 (1+ (strlen ts)) 	p2 p1)
	(if 
		(and ts (/= "" ts)) ;testing if empty string [bug in (substr "" ...)]
		(while
			(<= 0 (setq p1 (1- p1)))
			(setq ch (substr ts p1 1))
			
			(if
				(and 
					(= ch "\"")
					(/= 0 (logand fl 4))
				)
				(progn
					;(print "String ")
					(while
						(and
							(<= 0 (setq p1 (1- p1)))
							(setq chs (substr ts p1 1))
							(/= chs "\"")
						)
					)
					(setq p1 (1- p1))
					(if (< p1 0) (setq p1 0))
					(setq ch (substr ts p1 1))
				)
			)
			
			(if
				(or (= 0 p1) (setq pch (strchr ch)))
				(progn
					(setq sl (- p2 p1 1))
					(if
						(or (< 0 sl) (/= 0 (logand fl 2)))
						(setq res (cons (substr ts (1+ p1) sl) res))
					)
					(if (and pch (/= 0 p1) (/= 0 (logand 8 fl))) (setq res (cons pch res)))
					(setq p2 p1)
				)
			)
		)
	)
	(if 
		(and (not res) (/= 0 fl)) 
		'("")
		res
	)
)
;


; (flx_env2dir envstr|envlst)
; envlst: list of enviroment variables
; envstr: if the first argument is a string but not a list,
; 				the list of related paths (original splitted by ";")
;					is returned
; 	e.g. '("CADSUP" "CADSYS" "CADCMD" "CADDWG" "CADMNU")
;   or   '("CADCFG" "CADTMP" "CADFONT")
; Flag: normalize pathnames, convert to upper strings
;       and remove double entries
;       Bit 0,1,2 (1+2+4) are direct submitted to flx_pfnnrm
; 			Bit 3 (8) checks if the directory exists
;       Only the following combinations make sense:
;				Flag = 0: returns all found items without checking for anything
;       Flag = 1: list of (uppercase) directories which does not contain double entries
;									last "\\" is removed
;				Flag =10: list of uppercase items which are existing directories, rm double entries
;------======================------------------------------------
(defun flx_env2dir( envlst flag / flag dl envs reslst chckfl)
;------======================------------------------------------
	
	(if (eq 'STR (type envlst)) (setq envlst (list envlst))) ;not beatyfull but it works
	(or (eq 'INT (type flag)) (setq flag 0))
	(if (/= 0 flag)
		(progn
			(foreach itm envlst
				(if
					(and
						(eq 'STR (type (setq envs (getenv itm))))
						(/= "" envs)
						(setq dl (flx_strtok envs ";"))
					)
					(foreach dir dl
						(setq dir (strcase (flx_pfnnrm dir (logand 7 (logior flag 2)))))
						(if
							(and dir
								(not (member dir reslst))
								(or
									(/= flag 10)
									(findfile (strcat dir *PathDelimChar*))   ;;	check if the directory exists (fx_filefind dir 2 16 0)
								)
							)
							(setq reslst (cons dir reslst))
						)
					)
				)
			)
			(reverse reslst)
		)
		(setq reslst
			(apply 'append
				(mapcar 
				 '(lambda (env / envs envl ) 
						(if 
							(setq envs (getenv env))
							(flx_strtok envs ";")
						)
					)
					envlst
				)
			)
		)
	)
)
;;


; (flx_ffany fn|fnlst path|pathlst)
; function for seraching a file / any file of a list inside of the
; list of given directories or a single directory
; sample1: (flx_ffany "MyFile" "MyPath")
; sample2: (flx_ffany "MyFile" '("MyPath1" "MyPath2" "MyPath3"))
; sample3: (flx_ffany '("MyFile1" "MyFile2" "MyFile3") "MyPath"))
; sample4: (flx_ffany '("MyFile1" "MyFile2" "MyFile3") '("MyPath1" "MyPath2" "MyPath3"))
; The function returns the first file (inc. path) which will be found
; It's well suited to work again with the (flx_env2dir envstr|envlst flag) function
; If the list of paths conatins an empty string, a simple (findfile fn) will also
; be applied to the fn / each fn of fnlst
; sample5: (flx_ffany "MyAppfn" (cons "" (flx_env2dir '("CADDWG" "CADCFG" "CADTMP" "CADFONT"))))
;   this will search for MyAppfn via a normal (findfile "MyAppfn") and if not found
;   it will serach in each path given by the enviroment variables inside of the list
; The sequency for searching is first file in first directory, first file in second
; directory ..., second file in first directory second file in second directory....
;------==================------------------------------------------
(defun flx_ffany(fnarg dirarg / fnarg dirarg a1typ a2typ dir fn respfn)  
;------==================------------------------------------------  
 ; (print fnarg) (prin1 dirarg)
  (setq a1typ (type fnarg))
  (setq a2typ (type dirarg))
  (cond
  	((and (eq a1typ 'STR) (eq a2typ 'STR))
  		(findfile (strcat (flx_pfnnrm dirarg 1) fnarg))
  	)
  	((eq a1typ 'LIST)
  		(while
  			(and
  				(setq fn (car fnarg))
  				(not (setq respfn (flx_ffany fn dirarg))) ;recursive call of ffany
  			)
  			(setq fnarg (cdr fnarg))
  		)
  		respfn
  	)
  	((eq a2typ 'LIST)
  		(while
  			(and
  				(setq dir (car dirarg))
  				(not (setq respfn (flx_ffany fnarg dir))) ;recursive call of ffany
  			)
  			(setq dirarg (cdr dirarg))
  		)
  		respfn
  	)
  	(T
  		(print "Error calling (ffany filename|filenamelst dir|dirlst)! ")
  		()
  	)
  )
)
;


; Function to find a file in the searchpath which will determined by the
; envkeylst
; If envkeylst is nil (or not given), only a simple (findfile fn) will be
; done
; Otherwise for each key of envkeylst a findfile to the related 
; enviromentstring is applied. In this case relative path statements
; are allowed too.
; examples:
; 1. (flx_appff( "myfonts\\myfnt1" '("CADFONT")))
; 2. (flx_appff( "mybin\\mylib.dll" '("CADSUP" "CADSYS")))
; In the second sample the function searches in each pathname pn
; given by (getenv "FCADSUP") than in those given by (getenv "CADSYS")
; for the file pn\\mybin\\mylib.dll
; The sequency of searching is the same like in list EnvKeyLst
;------====================-------------------------------------
(defun flx_appff( Fn EnvKeyLst DefExt / envkeylst envstr key kl rkl pfn spl rspl spstr)
;------====================-------------------------------------
	(setq fn (flx_pfnnrm fn))
	(if 
		(and DefExt
			(equal 'STR (type DefExt))
			(= "" (last (flx_splitfn fn)))
		)
		(if (= "." (substr DefExt 1 1))
			(setq fn (strcat fn DefExt))
			(setq fn (strcat fn "." DefExt))
		)
	)
	
	(setq spl ())
	(if
		(setq pfn (findfile fn))
		pfn
		(progn
			(setq rkl envkeylst)
			(while
				(and
					(setq key (car rkl))
					(not
						(progn
							(if (setq envstr (getenv key))
								(setq spl (flx_strtok envstr ";"))
							)
							(setq rspl spl)
							(while
								(and
									(setq spstr (car rspl))
									(not (setq pfn (findfile (strcat (flx_pfnnrm spstr 1) fn))))
								)
								(setq rspl (cdr rspl))
							)
							pfn
						)
					)
				)
				(setq rkl (cdr rkl))
			)
			pfn
		)
	)
)		
;;


; function for loading a dll if necessary 
; loading can be forced by setting loadfl=1
; dllfn is the name of the dll (can also contain relative path statements)
; fcnl is the list of functions inside the dll to check for
(if *FDTFlag*
	;------==============================------------------------------------------
	(defun flx_loaddll( dllfn fcnl loadfl / fcnl loadfl spstr spl dllpfn dllitmlst dllfnl failfcn rl testfcnl)
	;------==============================------------------------------------------ 

		(defun testfcnl( fcnl / fcn)
			(while
				(and 
					(setq fcn (car fcnl))
					(equal 'EXSUBR (type (eval fcn)))
				)
				(setq fcnl (cdr fcnl))
			)
			fcnl
		)

		(setq dllfn (strcase dllfn))

		(if 
			(or loadfl (not fcnl) (testfcnl fcnl))
			(progn
				(if
					(not 
						(setq dllpfn (flx_appff dllfn '("CADSUP" "CADSYS") "DLL"))
					)
					(flx_errexit 
						(list
							(strcat "The dynamic link library \"" dllfn "\" could not be found!")
							(strcat "Die DLL \"" dllfn "\" konnte im Suchpfad nicht gefunden werden!")
						)
					)
				)
				(setq dllitmlst
					(mapcar 
					 '(lambda(dllitm / pfnlst )
							(setq pfnlst (flx_splitfn dllitm))
							(cons (strcase (strcat (caddr pfnlst) (cadddr pfnlst))) dllitm)
						)
						(fdt)
					)
				)
					 
				(if 
					(not (assoc (strcase dllfn) dllitmlst))
					(xload dllpfn (flx_errexit (strcat "Error loading DLL: " dllpfn) "Application Error / DLL"))
					(if loadfl 
						(progn 
							(xunload dllpfn) 
							(xload dllpfn (flx_errexit (strcat "Error loading DLL: " dllpfn) "Application Error / DLL"))
						)
					)
				)
				(if (setq failfcn (car (testfcnl fcnl)))
					(flx_errexit
						(list
							(strcat	"Missing function \"" (symbtos failfcn) "\" in the dynamic link library \"" dllpfn "\" !")
							(strcat	"Funktion \"" (symbtos failfcn) "\" fehlt in der DLL \"" dllpfn "\" !")
						)
					 '("Fatal error!" "Schwerer Fehler")
					)
				)
			)
		)
	)
)
;;


; Function to read out the information of a FLK-file
; Parameter: FlkPfn is the full qualified file name of the flk file
; Returns: (LIST DateStr UserNameStr)
;------====================----------------------------------------
(defun flx_ReadFlk( FlkPfn / lstr1 lstr2 FlkFp reslst)
;------====================----------------------------------------
	(if
		(setq FlkFp (open FlkPfn "r+b"))
		(progn
			(and
				(setq lstr1 (read-line FlkFp)) ; 1st line
				(read-char FlkFp)  ; ignoring the '\0' character
				(setq lstr2 (read-line FlkFp)) ; 2nd line
				(setq reslst (list lstr1 lstr2))
			)
			(setq FlkFp (close FlkFp))
		)
	)
	reslst
)
;


;;; some often needed general functions
;; increment the numerical value, bound to a symbol
;; returns the incremented value
(defun inc( #numsym# / )
	(if (numberp #numsym#)	
		(1+ #numsym#)
		(if
			(= 'SYM (type #numsym#))
			(if 
				(numberp (eval #numsym#))
				(set #numsym# (1+ (eval #numsym#)))
			)
		)
	)
)
;


;; decrement the numerical value, bound to a symbol
;; returns the incremented value
(defun dec( #numsym# / )
	(if (numberp #numsym#)	
		(1- #numsym#)
		(if
			(= 'SYM (type #numsym#))
			(if 
				(numberp (eval #numsym#))
				(set #numsym# (1- (eval #numsym#)))
			)
		)
	)
)
;

; Function to exit after showing an alert box
(defun alertexit( msg title / msg title)
	(if (/= 'STR (type msg)) (setq msg (symbtos msg)))
	(if (/= 'STR (type title)) (setq title ""))
	(defun *error*(msg / msg) (setq *error* ()) (princ))
	(alert msg title)
	(setq *LspDepLoadLst* ())
	(exit)
)
;


; Function to load a LISP file on demand
(defun DepReqFcnLspLoad(lspfn fcnlst / fcnlst lspfn lsppfn errstr lsppfnup)
	(if
		(not (apply 'and (mapcar 'isfcn? fcnlst)))
		(progn
			(cond
				((not lspfn)
					(alertexit "Error: Missing argument submitted to (DepReqFcnLspLoad FcnLst LspFileName)!" "Error")
				)
				((/= 'STR (type lspfn))
					(alertexit "Error: Invalid argument submitted to (DepReqFcnLspLoad FcnLst LspFileName)!" "Error")
				)
				((not (setq lsppfn (findfile lspfn)))
					(alertexit (strcat "Error: Can't find LISP file \"" lspfn "\" in support serach path! " "Error"))
				)
				((member (setq lsppfnup (strcase lsppfn)) *LspDepLoadLst*)
					(alertexit (strcat "Error: Trial of Recursive Loading \"" lsppfn "\" Canceled!"))
				)
				(T
					(setq *LspLoadLst* (cons lsppfnup *LspDepLoadLst*))
					(load lsppfn (alert (strcat "Error loading LISP File \"" lsppfn "\"!")))
					(if (setq lr (member lsppfnup *LspDepLoadLst*))
						(setq
							ll (cdr (member (reverse *LspDepLoadLst*)))
							*LspDepLoadLst* (append (reverse ll) (cdr lr))
						)
					)
				)
			)
			(setq errstr "Error: Missing function definition(s): \n")
			(if
				(not (apply 'and (mapcar 'isfcn? fcnlst)))
				(progn
					(foreach itm fcnlst
						(if (not (isfcn? itm)) (setq errstr (strcat errstr (symbtos itm) " ")))
					)
					(setq errstr (strcat errstr "\nin " lsppfn))
					(alertexit errstr "Error")
				)
			)
		)
	)
	(princ)
)
;


; Function to check the ability to write the temporary file tmpfn
; For a given tmpfn the function will test if this file can be
; written. tmpfn MUST NOT be a complete Path but only the filename.
; The path is detected by the function itself.
; The complete filename including the path is returned.
; If no argument is submitted, the function searches for the first
; writable path and will return it.
(defun Flx_ChckTmpDir4Wr( tmpfn / testfn  testpfn testfp pfn wrokfl rmflag)
	
	(if tmpfn (setq testfn tmpfn) 
		(setq 
			testfn "$AresDummy$.$$$"
			rmflag T
		)
	)
	
	(setq dirlst (mapcar 'getenv '("CADTMP" "TMP" "TEMP" "CADDWG")))
	(setq dirlst (append dirlst (list "")))
	(while (and dirlst (not wrokfl))
		(setq 	dir (car dirlst) 	dirlst (cdr dirlst))
		(if
			(equal 'STR (type dir))
			(progn
				(if
					(and (/= "" dir)
						(/= "/" (setq ch (substr dir (strlen dir))))
						(/= ch *PathDelimChar*)
					)
					(setq dir (strcat dir *PathDelimChar*))
				)
				(setq wrokfl
					(and
						(findfile (strcat dir "*.*") 1)
						(setq testfp (open (setq testpfn (strcat dir testfn)) "w"))
						(progn
							(setq pfn (findfile testpfn))
							(setq testfp (close testfp))
							pfn
						) 
					)
				)
			)
		)
	)
	(if (and rmflag wrokfl (isfcn? 'fx_rmfile)) (fx_rmfile testpfn))   ; rm tmpfile only possible if fdt is available
	(if wrokfl (if tmpfn pfn dir))
)
;


; Function to register LISP defined commands for automatical
; loading, during the first call of the command
; Usage:
;		(autoload LISPFILE '("cmd1" "cmd2" ... "cmdn") flag)
;		The Flag is not neceesary here, it's only for output
;		during the loading procedure via autoload. Meanings
;		are:	
; 		bit 0 (1): insert a "\n" before loading
;			bit 1 (2): inform about loading and finishing it
;			bit 2	(4): insert a "\n" after loading
;			bit 3 (8): print the command name
; Note, that the LISPFILE must not have the extension ".LSP"
; and the command have to be given without the prefix C:
; (e.g.: (autoload "3D.LSP" '("3DBOX" "3DONE" "3DMIR" ...))
(defun autoload( lspfn cmdlst flag / cmdstr cmdnam langcmdnam flag tmp autoloadreg)
	
	(defun autoloadreg(cmdnam /)
		(setq cmdnam (strcase cmdnam))
		(if
			(not (wcmatch cmdnam "C:*"))
			(setq cmdstr (strcat "C:" cmdnam))
		)
		(eval
			(list 'defun
				(read cmdstr) '(/)
				(list 'autoload_fcn lspfn cmdnam flag)
		 	 '(princ)
			)
		)
	)

	(if (not flag) (setq flag 0))
	(if
		(not (= ".LSP" (strcase (substr lspfn (- (strlen lspfn) 3)))))
		(setq lspfn (strcat lspfn ".LSP"))
	)
	(if (findfile lspfn)
		(foreach cmditm cmdlst
			(if (listp cmditm)
				(progn
					(autoloadreg (setq cmdnam (car cmditm)))
					(if
						(and
							(setq langcmdnam (flx_langstr cmditm))
							(/= (strcase cmdnam) (strcase langcmdnam))
						)
						(autoloadreg langcmdnam)
					)
				)
				(autoloadreg cmditm)
			)
		)

		(alert
			(strcat "Error: The LISP file \"" lspfn "\" not found!")
			"Error!" "STOP"
		)
	)
)
;


; Function which is only called by autoload and will start
; the load process
; Could be integrated inside of the function autoload, but
; this ways has some advantages. The main is, that not all
; of the function below has to be built using strings and
; the (eval (read (strcat .....))) combination.
(defun autoload_fcn( lspfn cmdnam flag / cmdsym cmdstr lspfnf errfcn autolsploaderrflg)

	(if (not flag) (setq flag 0))
	
	(defun errfcn( title msg )
		(defun *error*( msg / )
			(setq *error* ())
			(princ)
		)
		
		(setq autolsploaderrflg 1)
		(alert msg title "STOP")
	)
	
	(setq cmdstr (strcat "C:" (strcase cmdnam)))
	(setq cmdsym (read cmdstr))
	(setq prev (eval cmdsym))
	(if
		(and 
			(setq lspfnf (findfile lspfn))
			(progn
				(if (/= 0 (logand 1 flag)) (princ "\n"))
				(if (/= 0 (logand 2 flag)) (princ (strcat "Loading " lspfnf "...")))
				(load lspfnf (errfcn "Error" (strcat "\nThe file \"" lspfnf "\" contains errors!")))
				(not autolsploaderrflg)
			)
		)
		(progn 
			(setq lspfnf (strcase lspfnf))
			(if (/= 0 (logand 2 flag))
				(princ 
					(strcat "\r                                                             \r"
						"LISP file " lspfnf " loaded "
					)
				)
			)
			(if (/= 0 (logand 4 flag))	(princ "\n"))					
			(if
				(equal (eval cmdsym) prev)
				(progn
					(errfcn "Command not found!"
						(strcat "Missing definition of " cmdstr " in the LISP file: " lspfn " !")
					)
					(set cmdsym ())
				)
				(progn
					(if (/= 0 (logand 8 flag))
						(princ (strcat "\n> " cmdstr "\n"))
					)
					(progn
						;(defun *error*(msg) (setq *error* ()) (*settrace* 0) (princ))
						(eval (list cmdsym))
					)
				)
			)
		)
		(if (not lspfnf)
			(errfcn "Missing LISP file!" 
				(strcat "The LISP file " lspfn " could not be found!")
			)
		)
	)
	(princ)
)
;


;;
(if *FDTFlag*
	(defun autoxload( dllfn cmdlst flag / cmdstr flag tmp)
		(if (not flag) (setq flag 0))
		(setq dllfn (strcat dllfn ".DLL"))
		(if (findfile dllfn)
			(foreach cmd cmdlst
				(setq cmd (strcase cmd))
				(if 
					(not (wcmatch cmd "C:*"))
					(setq cmdstr (strcat "C:" cmd))
				)
				(eval
					(read
						(strcat
							"(defun " cmdstr  "( / ) (autoxload_fcn "
							"\"" dllfn "\" \"" cmd "\" " (itoa flag) ") (princ))"
						)
					)
				)
			)
			(alert
				(strcat "Error: The dynamic link library \"" dllfn "\" could not be found!")
				"Error!" "STOP"
			)
		)
	)
)
;;



; Function which is only called by autoload and will start
; the load process
; Could be integrated inside of the function autoload, but
; this ways has some advantages. The main is, that not all
; of the function below has to be built using strings and
; the (eval (read (strcat .....))) combination.
(if *FDTFlag*
	(defun autoxload_fcn( dllfn cmdnam flag / errfcn cmdstr dllfnf)

		(defun errfcn( title msg )
			(defun *error*( msg / )
				(setq *error* ())
				(princ)
			)
			
			(if 
				(and 
					(equal 'STR (type title))
					(equal 'STR (type msg))
				)
				(alert msg title "STOP")
			)
			(exit)
		)

		(setq cmdstr (strcat "C:" (strcase cmdnam)))
		(setq prev (eval (read cmdstr)))
		(if
			(setq dllfnf (findfile dllfn))
			(progn
				(setq dllfnf (strcase dllfnf))
				(if 
					(member dllfnf (fdt))
					(if 
						(alert
							(strcat "The Dynamic Link Library \"" dllfnf "\" already loaded!\n"
											"Do you wan't to reload it (It's recommended)?"
							)
							"Warning!?"
							"QUESTION"
						)
						(xunload dllfnf)
						(errfcn)
					)
				)
				(if (/= 0 (logand 1 flag)) (princ "\n"))
				(if (/= 0 (logand 2 flag)) 
					(princ (strcat "Loading " dllfnf "..."))
				)
				(xload dllfnf)
				(if (/= 0 (logand 2 flag))
					(princ 
						(strcat "\r                                                             \r"
							"Dynamic Link Library file " dllfnf " loaded "
						)
					)
				)
				(if (/= 0 (logand 4 flag))	(princ "\n"))					
				(if
					(equal (eval (read cmdstr)) prev)
					(progn
						(errfcn "Command not found!"
							(strcat "Missing definition of " cmdstr " in the DLL file: " dllfnf " !")
						)
						(set (read cmdstr) ())
					)
					(progn
						(if (/= 0 (logand 8 flag))
							(princ (strcat "\n> " cmdstr "\n"))
						)
						(apply (read cmdstr) ())
					)
				)
			)
			(errfcn "Missing DLL file!" 
				(strcat "The dynamic link library file: \"" dllfn "\" could not be found!")
			)
		)
		(princ)
	)
)
;;


;;; ===============================================================
;;; FLX_FUNC_INIT <>
;;; ===============================================================
(defun FLX_FUNC_INIT()
   (if (< (getvar "ACTDB") 0)
      (progn 
          (defun *error*(msg)
             (setq *error* nil)     ;;; CMDECHO ### ???
             (princ)
          )
          (EXIT)                    ;;; Warning: Program terminated by EXIT
          (setq *error* nil)
      )
      (progn                        ;;; User break etc.
          (defun *error*(msg) 
             (setvar "CMDECHO" 1)   ;;;### !!!
             (setvar "FILEDIA" 1)   ;;;### !!!
             (setvar "ATTDIA"  1)   ;;;### !!!
             (setq *error* nil)
             (princ)
          )
      )     
   ) 
   (princ)
)
;

;;; ===============================================================
;;; FLX_FUNC_EXIT <>
;;; ===============================================================
(defun FLX_FUNC_EXIT() 
   (setvar "CMDECHO" 1)
   (setvar "FILEDIA" 1)
   (setvar "ATTDIA"  1)   
   (setq *error* nil)
   (princ)
)
;

;;; ===============================================================
;;; FLX_ALERT_EXCLAMATION <message=string>
;;; ===============================================================
(defun FLX_ALERT_EXCLAMATION (msg / msg lang) 
    (setq lang (getvar "LANGUAGE"))
    (ALERT
      msg
      (cond
       ((= lang 1) "Achtung")
       ((= lang 2) "Alert")
       ((= lang 3) "Alert")
       ((= lang 4) "Alert")
       ((= lang 5) "Uwaga")
       (T          "Alert")
      )
      "EXCLAMATION"
    )
)
;

;;; ===============================================================
;;; DEFUN: CALL_WINEXE 
;;; ---------------------------------------------------------------
;;; Call a Windows Executable Program
;;;   (CALL_WINEXE <program_name>)
;;;
;;; Directory Search Path:
;;; - Current Directory
;;; - Windows Directory (win.com)
;;; - Windows System Directory
;;; - Directory of PCAD.EXE        
;;; - Directories as set by PATH environment variable
;;; - Mapped Network directories
;;; ===============================================================
(if *FDTFlag*
	(defun CALL_WINEXE (prog / lang prog flx_dll)
		 (flx_loaddll "PCLspTools.dll" '(Fx_ShExec))
		 (fx_shexec prog)
		 (princ)
	)
)
;

;;; ===============================================================
;;; Hourglass Cursor
;;; (HOURGLASS  <1|0> ) ; Argument: 1=On / 0=OFF 
;;; ===============================================================
(if *FDTFlag*
	(defun HOURGLASS (x / x)
		(flx_loaddll "PCLspTools.dll" '(Fx_HourGlassOn Fx_HourGlassOff))
		(if Fx_HourGlassOn (if (= x 1)
			(Fx_HourGlassOn)
			(Fx_HourGlassOff))
		)
		(princ)
	)
)
;


;;; ===============================================================
;;; CLIPCOPY 
;;; ... copies any string from the supplied list to the clipboard
;;; (CLIPCOPY <string-list> )
;;; ===============================================================
(if *FDTFlag*
	(defun CLIPCOPY (copylst / copylst)
		(if copylst
			(progn
				(flx_loaddll "PCLspTools.dll" '(Fx_CopyClip))
				(Fx_CopyClip copylst)
			)
		)
		(princ)
	)
)
;


;;; ***************************************************************
;;; Lisp / FDT Loading Functions
;;; ***************************************************************

;;; ===============================================================
;;; FLX_LOADLISP <function_name> <lisp_filename>
;;; ===============================================================
(defun FLX_LOADLISP (func_name lisp_file / lang tmp func_name lisp_file)

  (setq lang (getvar "LANGUAGE"))
  (if (eval (read func_name))
     (eval (read (strcat "(" func_name ")")))
     (progn
        (if (setq tmp (findfile (strcat FLX$DIRECTORY "flx" lisp_file ".lsp")))   
           (progn 
              (princ (strcat 
                (cond
                 ((= lang 1) "Lade "   )
                 ((= lang 2) "Loading ")
                 ((= lang 3) "Loading ")
                 ((= lang 4) "Loading ")
                 ((= lang 5) "£aduj "  )
                 (T          "Loading ")
                )
                tmp "..."
              ))      
              (load tmp)
              (princ " OK.")
              (terpri)
              (eval (read (strcat "(" func_name ")")))
           ) 
           (FLX_ALERT_EXCLAMATION (strcat 
                (cond
                 ((= lang 1) "Datei nicht gefunden: ")
                 ((= lang 2) "File not found:       ")
                 ((= lang 3) "File not found:       ")
                 ((= lang 4) "File not found:       ")
                 ((= lang 5) "Nie znaleziono pliku: ")
                 (T          "File not found:       ")
                )
                "\nflx" 
                lisp_file 
                ".lsp"
           ))
        )
     )
  )
  (princ)
)
;

;;; ===============================================================
;;; FLX_XLOAD <function> <DLL_filename> 
;;; ===============================================================
(if *FDTFlag*
	(defun FLX_XLOAD(s1 s2 / s1 s2)
		(if (/= (type (eval (read s1))) 'EXSUBR)
				(if (= (xload s2 T) T) (progn (xunload s2) (xload s2)))
		)
	)
)
;;


;;; ***************************************************************
;;; GENERAL DIALOG FUNCTIONS
;;; ***************************************************************

;;; ===============================================================
;;; Dlg_ListAction 
;;; ===============================================================
(defun Dlg_ListAction (box_id box_list / box_id box_list)
   (Dlg_ListStart box_id)
   (mapcar 'Dlg_ListAdd box_list)
   (Dlg_ListEnd)
)
;

;;; ===============================================================
;;; FLX_DLGDSP: Display Dialog 
;;; Note:  * from certain PCAD directory: FLX$DIRECTORY  *
;;; ===============================================================
(defun FLX_DLGDSP (dlg_file dlg_name callbk_new callbk_start /
                   dlg_id dlg_fname lang lang1 lang2
                   dlg_file1 dlg_file2 return)

    (setq lang (getvar "LANGUAGE"))  
    (if (= lang 2)
        (setq lang1 ""
              lang2 (itoa lang)
        )
        (setq lang1 (itoa lang)
              lang2 ""
        )
    )
    (setq dlg_file1 (strcat dlg_file lang1 ".dlg"))
    (setq dlg_fname (findfile (strcat FLX$DIRECTORY dlg_file1)))    
    (if (not dlg_fname) (progn
        (setq dlg_file2 (strcat dlg_file lang2 ".dlg"))
        (setq dlg_fname (findfile (strcat FLX$DIRECTORY dlg_file2)))
    ))
    (if dlg_fname 
      (progn
        (setq dlg_id (Dlg_DialogLoad dlg_fname))
        (Dlg_DialogNew dlg_name dlg_id)  ;;; ### callbk_new
        (Dlg_DialogStart callbk_start)
        (Dlg_DialogUnload dlg_id)
        (setq return T)
      )
      (progn 
        (ALERT
           (strcat
             (cond
              ((= lang 1) "Dialog Datei nicht gefunden: ")
              ((= lang 2) "Dialog file not found: ")
              ((= lang 3) "Dialog file not found: ")
              ((= lang 4) "Dialog file not found: ")
              ((= lang 5) "Nie znaleziono pliku dialog: ")
              (T          "Dialog file not found: ")
             )
             dlg_file1
           )
           (cond
            ((= lang 1) "Achtung")
            ((= lang 2) "Alert")
            ((= lang 3) "Alert")
            ((= lang 4) "Alert")
            ((= lang 5) "Uwaga")
            (T          "Alert")
           )
           "EXCLAMATION"
        )
        (setq return nil)
      )
    )
)
;


;;; ===============================================================
;;; FLX_DefaultAction
;;; ===============================================================
(defun FLX_DefaultAction ()
    (setq value $value data $data key $key reason $reason var_x $x var_y $y) 
    (if FLX$TESTDIALOG     
     (progn
        (terpri)
        (princ "\n$key:       ")(princ $key)
        (princ " --- Type: ")   (princ (type $key))
        (princ "\n$value:     ")(princ $value)
        (princ " --- Type: ")   (princ (type $value))
        (princ "\n   $reason: ")(princ $reason)
        (princ " --- Type: ")   (princ (type $reason))
        (princ "\n   $x:      ")(princ $x)
        (princ " --- Type: ")   (princ (type $x))
        (princ "\n   $y:      ")(princ $y)
        (princ " --- Type: ")   (princ (type $y))
        (princ "\n   $data:   ")(princ $data)
        (princ " --- Type: ")   (princ (type $data))
     )
     (princ)
    )
    (princ)
)
;


;;; ***************************************************************
;;; (ZOOMPAGE)
;;; ***************************************************************
(defun ZOOMPAGE()
    (defun *error* (msg) (setq *error* nil)
       (setvar "CMDECHO" 1)
       (princ)
    )
    (setvar "CMDECHO" 0)
    (command "._ZOOMWIN"  (getvar "LIMMIN") (getvar "LIMMAX") )
    (setvar "CMDECHO" 1)
    (setq *error* nil) 
    (princ)
)
;


;;; ***************************************************************
;;; Load additional lisp file(s)...
;;; ***************************************************************
(if (not FLX_AF)
   (if (setq tmp (findfile (strcat FLX$DIRECTORY "flx_test.lsp")))
       (load tmp)
   )
)
(setq tmp nil)
;


;
(defun Flx_LangDepAutoLoad( LspBasFn cmdlst flag / LangNoStr)
	(setq 	LangNoStr (itoa (getvar "LANGUAGE")) 	*FLX_LangNoStr* LangNoStr)
	(if (not flag) (setq flag 8))
	(if 
		(and
			(= 'STR (type LspBasFn))
			(= 'INT (type flag))
			(listp cmdlst)
			(apply '= (cons 'STR (mapcar 'type cmdlst)))
		)
		(if
			(or
				(setq lsppfn (findfile (strcat lspbasfn LangNoStr ".LSP")))
				(setq lsppfn (findfile (strcat LspBasFn "2.LSP")))
				(setq lsppfn (findfile (strcat LspBasFn ".LSP")))
			)
			(autoload lsppfn cmdlst flag)
			(princ (strcat "\nWarning: " LspBasFn "*.LSP could not be loaded! "))
		)
		(princ "Error: Invalid argument list for (LangDepAutoLoad LspBasFn CmdLst [Flag])! ")
	)
)
;

(if *FDTFlag* (Flx_LoadDll "PcLspTools" '(fx_shexec fx_command)))
(if (findfile "OptAppsStart.Lsp") (load "OptAppsStart.lsp"))

(princ)
(setq *LastLspLoaded* "main.lsp")

