; ********************************
; DDPURGE.LSP (DDPRG-14.LSP)
; Copyright (c) 1997 Erik Murray
; Last modified 5/14/97
; ********************************

(defun C:ddpurge (/ 	SBAR		;current state of spinning progress bar
			BLOCKS		;dialog flag
			DIMS		;dialog flag
			LAYERS		;dialog flag
			LTYPES		;dialog flag
			SHAPES		;dialog flag
			STYLES		;dialog flag
			MLINES		;dialog flag
			DCL_FILE	;DCL File
			GO		;cancel dialog flag
		) ;end local variable definitions

;******** Embedded Functions ********

; -- error handling --
	(defun my_error (s)
		(if (not (member s '("Function cancelled" "console break" "quit / exit abort")))
			(princ (strcat "\nFunction error: " s))
		)
		(lisp_unset)
	) ;end defun my_error

; -- begin clean --
	(defun lisp_set ()
		(if (or (wcmatch (getvar "ACADVER") "13*") (wcmatch (getvar "ACADVER") "14*"))	
			(command "_.undo" "_begin")
			(command "_.undo" "_group")
		) ; end if
		(setq sysvars
			(mapcar '(lambda (a b) (setq var (getvar a)) (setvar a b) (list a var))
				'("cmdecho")
				'(0)
			)
		)
		(setq old_error *error* *error* my_error)
	) ;end defun lisp_set

; -- finish clean --
	(defun lisp_unset()
		(if sysvars
			(foreach var sysvars
				(apply 'setvar var)
			)
		)
		(if old_error
			(setq *error* old_error)
		)
		(if dcl_file (unload_dialog dcl_file))
		(command "_.undo" "_end")
		(setq my_error nil old_error nil sysvars nil)
	) ;end defun lisp_unset

; -- set all purge toggles --
	(defun set_all (/ n)
		(foreach n '("blocks" "dims" "layers" "ltypes" "shapes" "styles" "mlines")
			(set_tile n "1")
		) ;end foreach
		(setq blocks 1
			dims 1
			layers 1
			ltypes 1
			shapes 1
			styles 1
			mlines 1
		) ;end setq
	) ;end defun set_all

; -- clear all purge toggles --
	(defun set_clear (/ n)
		(foreach n '("blocks" "dims" "layers" "ltypes" "shapes" "styles" "mlines")
			(set_tile n "0")
		) ;end foreach
		(setq blocks 0
			dims 0
			layers 0
			ltypes 0
			shapes 0
			styles 0
			mlines 0
		) ;end setq
	) ;end defun set_clear

; -- dialog box interactive input --
	(defun get_dialog_input (/ choice)
		(setq choice nil
                      go T
                ) ;end setq
		(progn 
			(if (setq dcl_file (load_dialog "DDPURGE.DCL")) ;test 1
				(while (not (or (= 1 choice) (= 0 choice)))
					(if (new_dialog "main"  dcl_file) ;test 2
						(progn
							(action_tile "blocks" "(setq blocks (atoi $value))")
							(action_tile "dims" "(setq dims (atoi $value))")
							(action_tile "layers" "(setq layers (atoi $value))")
							(action_tile "ltypes" "(setq ltypes (atoi $value))")
							(action_tile "shapes" "(setq shapes (atoi $value))")
							(action_tile "styles" "(setq styles (atoi $value))")
							(action_tile "mlines" "(setq mlines (atoi $value))")
							(action_tile "all" "(set_all)")
							(action_tile "clear" "(set_clear)")
							(action_tile "accept" "(done_dialog 1)")
							(action_tile "cancel" "(done_dialog 0)")
							(setq choice (start_dialog))
							(cond 
								((= choice 1) (progn
											(if (null blocks) (setq blocks 0))
											(if (null dims) (setq dims 0))
											(if (null layers) (setq layers 0))
											(if (null ltypes) (setq ltypes 0))
											(if (null shapes) (setq shapes 0))
											(if (null styles) (setq styles 0))
											(if (null mlines) (setq mlines 0))
										   ) ;end progn
								) ;end choice 1
								((= choice 0) (progn
											(princ "\nFunction cancelled.")
											(setq go nil)
										   ) ;end progn
								) ;end choice 0
								(t nil)
							) ;end cond 
						) ;end progn and then 2
						(progn
							(alert "Could not find dialog definition: MAIN")
							(lisp_unset)
							(exit)
						) ;else 3 and end progn
					) ;end if 2
				) ;end while and then 1
				(progn
					(alert "Could not find file: DDPURGE.DCL")
					(lisp_unset)
					(exit)
				) ;else 1 and end progn
			) ;end if 1
			(unload_dialog dcl_file)
			(setq dcl_file nil)
		) ;end progn
	) ;end defun get_dialog_input

; -- Reiterative purge routine --
;(defun purge_type (type / ctr)
;	(prompt (strcat "\n Purging " type "...\n"))
;	(command "purge" type "" "n")
;	(princ)
;) ;end defun

; -- Reiterative purge routine --
(defun purge_type (type / ctr)

	(defun apurge( / done)
	   (setq done T)
	   (command "purge" type "" "y")
	   (while (= (getvar "CMDNAMES") "PURGE")
	      (command "y" )
	      (setq done nil ctr (1+ ctr))
	   );end while
	   (if (not done) (apurge))
	   (if done 
		(progn
			(if (= ctr 1) (setq type (substr type 1 (1- (strlen type)))))
			(prompt (strcat " ...Done!  Purged " (itoa ctr) " " type ".\n"))
		) ;end progn
	   ) ;end if
	   (princ)
	);end defun

	(prompt (strcat "\n Purging " type "..."))
	(setq ctr 0)
	(apurge)
	(princ)
) ;end defun

; *********** Main Program ************

	(lisp_set)
	(get_dialog_input)
	(if go
		(progn
			(if (= 1 blocks)
				(purge_type "blocks") ;then
			) ;end if
			(if (= 1 dims)
				(purge_type "dimstyles") ;then
			) ;end if
			(if (= 1 layers)
				(purge_type "layers") ;then
			) ;end if
			(if (= 1 ltypes)
				(purge_type "ltypes") ;then
			) ;end if
			(if (= 1 shapes)
				(purge_type "shapes") ;then
			) ;end if
			(if (= 1 styles)
				(purge_type "styles") ;then
			) ;end if
			(if (= 1 mlines)
				(purge_type "mlinestyles") ;then
			) ;end if
		) ;end progn
	) ;end if
	(lisp_unset)
	(princ)
) ;end defun LS

(defun c:ddp () (c:ddpurge))

(princ)