;;;CLG Doctor main lsp file (a dialog CLG management tool).
;;;
;;;
;;;
;;;
;;;***************************** NOTICE *******************************
;;;Use of this software is NOT free!  License to use this software
;;;If you obtained this file by download from the internet after
;;;of that agreement.  If you have a licensed copy of PARAPIPE this
;;;software is also licensed to you under your license to use PARAPIPE.
;;;Unlicensed use is forbidden and subject to severe penalties of law!
;;;
;;;>	Author:	Henry C. Francis
;;;>		425 N. Ashe St.
;;;>		Southern Pines, NC 28387
;;;>		http://paracadd.com
;;;>		All rights reserved.
;;;
;;;>		COPYRIGHT: 1997-2004
;;;>		   EDITED: 01-15-2007
;;;
(defun c:clg (/)			;clg_mj clg_ltype clg_minor clg_color clg_modif clg_user; clgmaj clgllt clgmin clgcol clgmod clgusr
  (setq quit_clg nil)
  (setq	clg_mj (if mjrg
		 mjrg
		 "M"
	       ) ;_ end of if
  ) ;_ end of setq
  (setq	clg_ltype (if (AND llt (/= llt ""))
		    llt
		    "-"
		  ) ;_ end of if
  ) ;_ end of setq
  (setq	clg_minor (if (AND prod (EQ (STRLEN prod) 4))
		    prod
		    "PROC"
		  ) ;_ end of if
  ) ;_ end of setq
  (if colr
    (setq clg_color colr)
    (if	colra
      (setq clg_color colra)
      (setq clg_color "-")
    ) ;_ end of if
  ) ;_ end of if
  (setq	clg_modif (if modf
		    modf
		    ""
		  ) ;_ end of if
  ) ;_ end of setq
  (setq	clg_user (if usdf
		   usdf
		   ""
		 ) ;_ end of if
  ) ;_ end of setq
  (setq tmp_clg_mj clg_mj)
  (setq tmp_clg_ltype clg_ltype)
  (setq tmp_clg_minor clg_minor)
  (setq tmp_clg_color clg_color)
  (setq tmp_clg_modif clg_modif)
  (setq tmp_clg_user clg_user)
  (setq tmp_clgmaj clgmaj)
  (setq tmp_clgllt clgllt)
  (setq tmp_clgmin clgmin)
  (setq tmp_clgcol clgcol)
  (setq tmp_clgmod clgmod)
  (setq tmp_clgusr clgusr)
  (setq count 0)
  (setq clg_num (load_dialog "clg"))
  (new_dialog
    "clg"
    clg_num
    ""
    (if	clg_loc
      clg_loc
      '(-1 -1)
    ) ;_ end of if
  ) ;_ end of new_dialog
  (if clglen
    nil
    (setq clglen "clg_long")
  ) ;_ end of if
  (if clg_err
    (progn
      (set_tile "clg_err" clg_err)
      (setq clg_err nil)
    ) ;_ end of progn
  ) ;_ end of if
  (setq clg_funct nil)
  (action_tile
    "Set_exlayr"
    "(clr_err)(setq curlay (get_tile \"Exist_lay\"))(setq clg_loc(done_dialog 1))"
  ) ;_ end of action_tile
  (action_tile
    "accept"
    "(clr_err)(setq clglay (get_tile \"clg_layer\") curlay nil)(set_hist)(setq clg_loc(done_dialog 1))"
  ) ;_ end of action_tile
  (action_tile
    "cancel"
    "(clr_err)(setq clglay nil curlay nil quit_clg T)(setq clg_loc(done_dialog 2))"
  ) ;_ end of action_tile
  (action_tile
    "clg_length"
    "(clr_err)(setq clglen $value)(f_cc)"
  ) ;_ end of action_tile
  (action_tile
    "clg_layer"
    "(clr_err)(setq clglay $value)(f_layer_list)"
  ) ;_ end of action_tile
  (action_tile
    "Edit_major"
    "(clr_err)(setq whlst \"major\")(edat)(f_major)"
  ) ;_ end of action_tile
  (action_tile
    "Major"
    "(clr_err)(setq clgmaj (get_tile \"Major\"))(setq mjrg(substr(nth(atoi clgmaj)major_list)1 1))(setq clg_mj mjrg)(f_major)(f_cc)"
  ) ;_ end of action_tile
  (action_tile
    "use_ltypes"
    "(clr_err)(if(= $value \"0\")(progn(set_tile\"Ltype\" \"0\")(setq use_ltyp nil))(res_llt))(set_hist)(f_ltype)(f_cc)"
  ) ;_ end of action_tile
  (action_tile
    "Ltype"
    "(clr_err)(if(/= $value \"0\")(set_tile \"use_ltypes\" \"1\")(set_tile \"use_ltypes\" \"0\"))(setq clgllt (if $value $value \"0\"))(set_hist)(f_ltype)(f_cc)"
  ) ;_ end of action_tile
  (action_tile
    "Edit_minor"
    "(setq whlst \"minor\")(edat)(f_minor)"
  ) ;_ end of action_tile
  (action_tile
    "Minor"
    "(clr_err)(setq clgmin (get_tile \"Minor\"))(setq prod(substr(nth(atoi clgmin)minor_list)1 4))(setq clg_minor prod)(set_hist)(f_minor)(f_cc)"
  ) ;_ end of action_tile
  (action_tile
    "use_colors"
    "(clr_err)(if(= $value \"0\")(progn(set_tile\"Color\"\"0\")(setq use_colr nil))(res_col))(set_hist)(f_color)(f_cc)"
  ) ;_ end of action_tile
  (action_tile
    "Color"
    "(clr_err)(if(/= $value \"0\")(set_tile \"use_colors\" \"1\")(set_tile \"use_colors\" \"0\"))(setq clgcol $value)(set_hist)(f_color)(f_cc)"
  ) ;_ end of action_tile
  (action_tile
    "Edit_modif"
    "(clr_err)(setq whlst \"modif\")(edat)(f_modif)"
  ) ;_ end of action_tile
  (action_tile
    "Modifier"
    "(clr_err)(setq clgmod $value)(set_hist)(f_modif)(f_cc)"
  ) ;_ end of action_tile
  (action_tile
    "Edit_user"
    "(clr_err)(setq whlst \"user\")(edat)(f_user)"
  ) ;_ end of action_tile
  (action_tile
    "User_defined"
    "(clr_err)(setq clgusr $value)(set_hist)(f_user)(f_cc)"
  ) ;_ end of action_tile
  (action_tile
    "manip_layers"
;;;    "(manip_layers)"
    "(clr_err)(setmansets)(setq clg_funct \"(c:manclg)\")(setq clglay nil curlay nil quit_clg T)(setq clg_loc(done_dialog 2))"
  ) ;_ end of action_tile
  (action_tile "help" "(browser_help \"clg\")")
  (set_tile "clg_length" clglen)
;;;  (set_tile "clg_long" "1")
;;;  (setq clglen (get_tile "clg_length"))
  (if from_para
    (progn
      (mode_tile "Set_exlayr" 1)
      (mode_tile "exlaname" 1)
      (mode_tile "user_txt" 1)
      (mode_tile "modif_txt" 1)
      (mode_tile "Exist_lay" 1)
      (mode_tile "clg_length" 1)
      (mode_tile "use_ltypes" 1)
      (mode_tile "Ltype" 1)
      (mode_tile "use_colors" 1)
      (mode_tile "Color" 1)
      (mode_tile "Edit_modif" 1)
      (mode_tile "Modifier" 1)
      (mode_tile "Edit_user" 1)
      (mode_tile "User_defined" 1)
      (mode_tile "manip_layers" 1)
      (set_tile "Ltype" "0")
      (set_tile "Color" "0")
    ) ;_ end of progn
  ) ;_ end of if
  (set_lay_list)			;Constructs a list of layers in the drawing
  (if clg_hist
    (setq old_clg_hist clg_hist)
  ) ;_ end of if
  (if from_para
    (progn
      (setq clg_mj pipe_mjrg)
      (f_major)
      (setq clg_ltype " ")
      (setq clg_minor pipe_minr)
      (start_list "Minor")
      (mapcar 'add_list minor_list)
      (end_list)
      (set_list minor_list "Minor" clg_minor 4)
      (setq clg_color "")
      (setq clg_modif " ")
      (setq clg_user "")
      (f_cc)
    ) ;_ end of progn
    (progn
      (f_all)
      (res_hist)
    ) ;_ end of progn
  ) ;_ end of if
  (setq sd_result (start_dialog))
  (if (and clg_funct (EQ quit_clg T))
    (eval (read clg_funct))
    (clg_done sd_result)
  ) ;_ end of if
  (princ)
)					;end defun clg
(defun setmansets ()
  (setq
    clg_major (substr (nth (read (get_tile "Major")) major_list) 1 1)
  ) ;_ end of setq
  (setq
    clg_ltype (substr (nth (read (get_tile "Ltype")) ltype_list) 1 1)
  ) ;_ end of setq
  (setq
    clg_minor (substr (nth (read (get_tile "Minor")) minor_list) 1 4)
  ) ;_ end of setq
  (setq
    clg_color (substr (nth (read (get_tile "Color")) color_list) 1 1)
  ) ;_ end of setq
  (setq	clg_modif
	 (substr (nth (read (get_tile "Modifier")) modif_list) 1 4)
  ) ;_ end of setq
  (setq
    clg_userd (substr (nth (read (get_tile "User_defined")) user_list)
		      1
		      4
	      ) ;_ end of substr
  ) ;_ end of setq
  (setq lay_onoff (get_tile "lay_onoff"))
  (setq lay_frzthw (get_tile "lay_frzthw"))
  (setq lay_vpfthw (get_tile "lay_vpfthw"))
  (setq lay_lckunl (get_tile "lay_lckunl"))
  (setq lay_pltnop (get_tile "lay_pltnop"))
) ;_ end of defun
(defun c:manclg ()
  (setq quit_manip nil)
  (setq manip_num (load_dialog "clg"))
  (new_dialog
    "clg_manip"
    manip_num
    ""
    (if	manip_loc
      manip_loc
      '(-1 -1)
    ) ;_ end of if
  ) ;_ end of new_dialog
;;;  (strmanstr)
  (set_tile "clg_select" (if (and clg_select(eq(type clg_select)'STR))clg_select "0"))
  (set_tile "clg_major" (if (and clg_major(eq(type clg_major)'STR))clg_major ""))
  (set_tile "clg_ltype" (if (and clg_ltype(eq(type clg_ltype)'STR))clg_ltype ""))
  (set_tile "clg_minor" (if (and clg_minor(eq(type clg_minor)'STR))clg_minor ""))
  (set_tile "clg_color" (if (and clg_color(eq(type clg_color)'STR))clg_color ""))
  (set_tile "clg_modif" (if (and clg_modif(eq(type clg_modif)'STR))clg_modif ""))
  (set_tile "clg_userd" (if (and clg_userd(eq(type clg_userd)'STR))clg_userd ""))
  (set_tile "lay_onoff" (if lay_onoff lay_onoff "0"))
  (set_tile "lay_frzthw" (if lay_frzthw lay_frzthw "0"))
  (set_tile "lay_vpfthw" (if lay_vpfthw lay_vpfthw "0"))
  (set_tile "lay_lckunl" (if lay_lckunl lay_lckunl "0"))
  (set_tile "lay_pltnop" (if lay_pltnop lay_pltnop "0"))
  (action_tile "clg_major" "(strmanstr)")
  (action_tile "clg_ltype" "(strmanstr)")
  (action_tile "clg_minor" "(strmanstr)")
  (action_tile "clg_color" "(strmanstr)")
  (action_tile "clg_modif" "(strmanstr)")
  (action_tile "clg_userd" "(strmanstr)")
  (action_tile "help" "(browser_help \"clg-manip\")")
  (action_tile
    "accept"
    "(clr_err)(manipsets)(setq manip_loc(done_dialog 1))"
  ) ;_ end of action_tile
  (action_tile
    "cancel"
    "(clr_err)(setq quit_manip T)(setq manip_loc(done_dialog 2))"
  ) ;_ end of action_tile
  (strmanstr)
  (setq manip_result (start_dialog))
  (if quit_manip
    nil
    (progn
      (if (eq clg_select "1")
	(progn
	  (setq clgss (ssget "x" (list (cons 8 laymanstr))))
	  (if clgss
	    (command ".select" clgss "")
	  )
	)
      ) ;_ end of if
      (cond
	((eq lay_onoff "0") nil)
	((eq lay_onoff "1") (command ".layer" "on" laymanstr ""))
	((eq lay_onoff "2") (if
			      (wcmatch (getvar "clayer") laymanstr)
			      (command ".layer" "off" laymanstr "Y" "")
			      (command ".layer" "off" laymanstr "")
			    ))
      ) ;_ end of cond
      (cond
	((eq lay_frzthw "0") nil)
	((eq lay_frzthw "1")
	 (if (wcmatch (getvar "clayer") laymanstr)
	   (progn
	     (princ (strcat "\nCannot freeze "
			    (strcase (getvar "clayer"))
			    ".  It is the CURRENT layer. "
		    ) ;_ end of strcat
	     ) ;_ end of princ
	     (command ".layer"
		      "freeze"
		      (strcat "~"(getvar "clayer")","laymanstr)
		      ""
	     ) ;_ end of command
	   ) ;_ end of progn
	   (command ".layer" "freeze" laymanstr "")
	 ) ;_ end of if
	)
	((eq lay_frzthw "2") (command ".layer" "thaw" laymanstr ""))
      ) ;_ end of cond
      (cond
	((eq lay_vpfthw "0") nil)
	((eq lay_vpfthw "1")
	 (command ".vplayer" "freeze" laymanstr "" "" "")
	)
	((eq lay_vpfthw "2")
	 (command ".vplayer" "thaw" laymanstr "" "" "")
	)
      ) ;_ end of cond
      (cond
	((eq lay_lckunl "0") nil)
	((eq lay_lckunl "1") (command ".layer" "lo" laymanstr ""))
	((eq lay_lckunl "2") (command ".layer" "u" laymanstr ""))
      ) ;_ end of cond
      (cond
	((eq lay_pltnop "0") nil)
	((eq lay_pltnop "1")
	 (command ".layer" "p" "p" laymanstr "")
	)
	((eq lay_pltnop "2")
	 (command ".layer" "p" "n" laymanstr "")
	)
      ) ;_ end of cond
    ) ;_ end of progn
  ) ;_ end of if
  (princ)
) ;_ end of defun
;;;********************************************************************
(defun strmanstr ()
  (manipsets)
  (setq
	laymanstr (strcat (if (and clg_major (not (eq clg_major ""))(not (eq clg_major "    "))) clg_major "?")
			  (if (and clg_ltype (not (eq clg_ltype ""))(not (eq clg_ltype " ")))
			    clg_ltype
			    "-"
			  )
			  (if (and clg_minor (not (eq clg_minor ""))(not (eq clg_minor "    "))) clg_minor "????")
			  (if (and clg_color (not (eq clg_color ""))(not (eq clg_color " ")))
			    clg_color
			    (if (or
				  (and clg_modif (not (eq clg_modif ""))(not (eq clg_modif "    ")))
				  (and clg_userd (not (eq clg_userd ""))(not (eq clg_userd "    ")))
				)
			      "-"
			      ""
			    )
			  )
			  (if (and clg_modif (not (eq clg_modif ""))(not (eq clg_modif "    ")))
			    clg_modif
			    (IF (and clg_userd (not (eq clg_userd ""))(not (eq clg_userd "    ")))
			      "????"
			      ""
			    )
			  )
			  (if (and clg_userd (not (eq clg_userd ""))(not (eq clg_userd "    ")))
			    "-"
			    ""
			  ) ;_ end of if
			  (if (and clg_userd (not (eq clg_userd ""))(not (eq clg_userd "    "))) clg_userd "")
		  ) ;_ end of strcat
      ) ;_ end of setq
      (set_tile "man_str" (strcat "String: " laymanstr))
;;;      (setq mymsg (STRCAT "\nLAYMANSTR = " laymanstr))
;;;      (princ mymsg)
;;;      (PRINC "      ")
;;;      (PRINC)
)
(defun manipsets ()
  (setq clg_select (get_tile "clg_select"))
  (setq clg_major (get_tile "clg_major"))
  (setq clg_ltype (get_tile "clg_ltype"))
  (setq clg_minor (get_tile "clg_minor"))
  (setq clg_color (get_tile "clg_color"))
  (setq clg_modif (get_tile "clg_modif"))
  (setq clg_userd (get_tile "clg_userd"))
  (if (eq clg_major "")
    (setq clg_major "?")
  ) ;_ end of if
;;;  (if (eq clg_ltype "")
;;;    (setq clg_ltype "?")
;;;  ) ;_ end of if
  (if (eq clg_minor "")
    (setq clg_minor "????")
  ) ;_ end of if
;;;  (if (eq clg_color "")
;;;    (setq clg_color "?")
;;;  ) ;_ end of if
  (setq lay_onoff (get_tile "lay_onoff"))
  (setq lay_frzthw (get_tile "lay_frzthw"))
  (setq lay_vpfthw (get_tile "lay_vpfthw"))
  (setq lay_lckunl (get_tile "lay_lckunl"))
  (setq lay_pltnop (get_tile "lay_pltnop"))
  (princ)
) ;_ end of defun
;;;********************************************************************
(defun clg_done	(sd_result /)
  (if (and (= sd_result 1) (not from_para)) ;Accept CLG Settings
    (progn
      (if curlay
	(manylay)
	(if
	  (and clglay
	       (not
		 (or
		   (eq (substr clglay 1 1) " ")
		   (eq (substr clglay 2 1) " ")
		   (eq (substr clglay 3 1) " ")
		   (eq (substr clglay 4 1) " ")
		   (eq (substr clglay 5 1) " ")
		   (eq (substr clglay 6 1) " ")
		   (eq (substr clglay 7 1) " ")
		   (eq (substr clglay 8 1) " ")
		   (eq (substr clglay 9 1) " ")
		   (eq (substr clglay 10 1) " ")
		   (eq (substr clglay 11 1) " ")
		   (eq (substr clglay 12 1) " ")
		   (eq (substr clglay 13 1) " ")
		   (eq (substr clglay 14 1) " ")
		   (eq (substr clglay 15 1) " ")
		   (eq (substr clglay 16 1) " ")
		   (eq (substr clglay 17 1) " ")
		   (eq (substr clglay 18 1) " ")
		   (eq (substr clglay 19 1) " ")
		   (eq (substr clglay 20 1) " ")
		   (eq (substr clglay 21 1) " ")
		   (eq (substr clglay 22 1) " ")
		   (eq (substr clglay 23 1) " ")
		   (eq (substr clglay 24 1) " ")
		   (eq (substr clglay 25 1) " ")
		 ) ;_ end of or
	       ) ;_ end of not
	  ) ;_ end of and
	   (mlay)
	   (if (or quit_clg (= sd_result 3))
	     nil
	     (progn
	       (setq clg_err "Invalid, blank characters in layer name.")
	       (unload_dialog clg_num)
	       (c:clg)
	     ) ;_ end of progn
	   ) ;_ end of if
	) ;_ end of if
      ) ;_ end of if
      (pcpyrt)
    ) ;_ end of progn
    (if	(eq sd_result 1)
      (progn
	(setq from_para	nil
	      pipe_mjrg	clg_mj
	      pipe_minr	clg_minor
	      clg_mj	tmp_clg_mj
	      clg_minor	tmp_clg_minor
	) ;_ end of setq
	(unload_dialog clg_num)
	(set_tile "base_layer"
		  (strcat (if pipe_mjrg
			    pipe_mjrg
			    "?"
			  ) ;_ end of if
			  " "
			  (if pipe_minr
			    pipe_minr
			    "????"
			  ) ;_ end of if
			  (if stat_char
			    stat_char
			    "?"
			  ) ;_ end of if
		  ) ;_ end of strcat
	) ;_ end of set_tile
      ) ;_ end of progn
      (if (eq sd_result 2)		;Cancel CLG
	(progn
	  (setq clg_mj tmp_clg_mj)
	  (setq clg_ltype tmp_clg_ltype)
	  (setq clg_minor tmp_clg_minor)
	  (setq clg_color tmp_clg_color)
	  (setq clg_modf tmp_clg_modf)
	  (setq clg_user tmp_clg_user)
	  (setq clgmaj tmp_clgmaj)
	  (setq clgllt tmp_clgllt)
	  (setq clgmin tmp_clgmin)
	  (setq clgcol tmp_clgcol)
	  (setq clgmod tmp_clgmod)
	  (setq clgusr tmp_clgusr)
	  (setq mjrg clg_mj)
	  (setq llt clg_ltype)
	  (setq prod clg_minor)
	  (if (and clg_color (eq (type (read clg_color)) 'INT))
	    (setq colr clg_color)
	    (setq colra clg_color)
	  ) ;_ end of if
	  (setq modf clg_modif)
	  (setq usdf clg_user)
	  (if old_clg_hist
	    (setq clg_hist old_clg_hist)
	  ) ;_ end of if
	  (if from_para
	    (progn
	      (setq from_para nil)
	      (unload_dialog clg_num)
	    ) ;_ end of progn
	  ) ;_ end of if
	) ;_ end of progn
      ) ;_ end of if
    ) ;_ end of if
  ) ;_ end of if
  (princ)
) ;_ end of defun
;;;********************************************************************
(defun f_all (/)
  (if from_para
    (progn
      (f_major)
      (f_cc)
    ) ;_ end of progn
    (progn
      (f_layer_list)
      (f_major)
      (f_ltype)
      (f_color)
      (f_modif)
      (f_user)
      (f_cc)
    ) ;_ end of progn
  ) ;_ end of if
  (setq init T)
  (princ)
) ;_ end of defun
;;;********************************************************************
(defun f_major (/)
  (set_major_list)
  (start_list "Major")
  (mapcar 'add_list major_list)
  (end_list)
;;;  (if (and major_list clgmaj)
;;;    (if	(>= (atoi clgmaj) (length major_list))
;;;      (setq clgmaj (itoa (1- (length major_list))))
;;;    ) ;_ end of if
;;;    (setq clgmaj "0")
;;;  )					;if
;;;  (if init
;;;    (if	(= clgmaj "0")
;;;      (setq mjrg nil)
;;;      (setq mjrg (substr (nth (atoi clgmaj) major_list) 1 1))
;;;    )					;if
;;;  )					;if
;;;  (setq maj_idx nil)
;;;  (foreach n major_list
;;;    (setq maj_idx (append maj_idx (list (substr n 1 1))))
;;;  ) ;_ end of foreach
;;;  (if (setq maj_ils (member mjrg maj_idx))
;;;    (setq clgmaj (itoa (- (length major_list) (length maj_ils))))
;;;  )					;if
;;;  (if (and clgmaj (/= clgmaj "0"))
;;;    (setq clg_mj (substr (nth (atoi clgmaj) major_list) 1 1))
;;;    (setq clg_mj "")
;;;  )					;if
  (set_list major_list "Major" clg_mj 1)
  (f_minor)
  (res_hist)
) ;_ end of defun
;;;********************************************************************
(defun f_layer_list (/)
  (set_lay_list)
  (start_list "Exist_lay")
  (mapcar 'add_list newlist)
  (end_list)
  (if (member (getvar "clayer") newlist)
    (progn
      (setq clg_lay (getvar "clayer"))
      (set_list newlist "Exist_lay" clg_lay (strlen clg_lay))
    ) ;_ end of progn
  ) ;_ end of if
  (princ)
) ;_ end of defun
;;;********************************************************************
(defun f_ltype (/)
  (if (and ltype_list clgllt)
    (if	(>= (atoi clgllt) (length ltype_list))
      (setq clgllt (itoa (1- (length ltype_list))))
    ) ;_ end of if
    (setq clgllt "0")
  ) ;_ end of if
  (set_ltype_list)
  (start_list "Ltype")
  (mapcar 'add_list ltype_list)
  (end_list)
  (if init
    (if	(= clgllt "0")
      (setq llt nil)
      (setq llt (substr (nth (atoi clgllt) ltype_list) 1 1))
    ) ;_ end of if
  ) ;_ end of if
  (setq llt_idx nil)
  (foreach n ltype_list
    (setq llt_idx (append llt_idx (list (substr n 1 1))))
  ) ;_ end of foreach
  (if (setq llt_ils (member llt llt_idx))
    (setq clgllt (itoa (- (length ltype_list) (length llt_ils))))
  ) ;_ end of if
  (if (and clgllt (/= clgllt "0"))
    (setq clg_ltype (substr (nth (atoi clgllt) ltype_list) 1 1)
	  use_ltyp  T
    ) ;_ end of setq
    (progn
      (setq clg_ltype "-"
	    use_ltyp nil
      ) ;_ end of setq
      (set_tile "use_ltypes" "0")
    ) ;_ end of progn
  ) ;_ end of if
  (set_list ltype_list "Ltype" clg_ltype 1)
  (princ)
) ;_ end of defun
;;;********************************************************************
(defun f_minor (/)
  (if (and mj_file clg_mj (read clg_mj) (/=(TYPE(READ clg_mj))'INT))
    (setq minor_file
	   (strcat (substr mj_file 1 (- (strlen mj_file) 9))
		   "min"
		   clg_mj
		   ".dat"
	   ) ;_ end of strcat
    ) ;_ end of setq
    (setq minor_file "clgmin.dat")
  ) ;_ end of if
;;;  (if init
  (if (findfile minor_file)
    (progn
      (set_minor_list)
      (start_list "Minor")
      (mapcar 'add_list minor_list)
      (end_list)
    ) ;_ end of progn
    (progn
      (setq tmpfile (open minor_file "w"))
      (write-line
	(strcat	"    \t-\tNo "
		(substr (nth (atoi clgmaj) major_list) 8)
		" Minor Group Active"
	) ;_ end of strcat
	tmpfile
      ) ;_ end of write-line
      (write-line "DETL\t-\tDetail" tmpfile)
      (write-line "ELEV\t-\tElevation" tmpfile)
      (write-line "PLAN\t-\tPlan" tmpfile)
      (write-line "SCHD\t-\tSchedule" tmpfile)
      (write-line "SECT\t-\tSection" tmpfile)
      (write-line "SHBD\t-\tSheet Border" tmpfile)
      (close tmpfile)
      (if minor_list
	nil
	(set_minor_list)
      ) ;_ end of if
      (start_list "Minor")
      (mapcar 'add_list minor_list)
      (end_list)
    ) ;_ end of progn
  ) ;_ end of if
;;;    (set_minor_list)
;;;  )
;;;  (if init
;;;    (if	(= clgmin "0")
;;;      (setq prod nil)
;;;      (setq prod (substr (nth (atoi clgmin) minor_list) 1 4))
;;;    )
;;;  )
;;;  (setq min_idx nil)
;;;  (foreach n minor_list
;;;    (setq min_idx (append min_idx (list (substr n 1 4))))
;;;  ) ;_ end of foreach
;;;  (if (setq min_ils (member prod min_idx))
;;;    (setq clgmin (itoa (- (length minor_list) (length min_ils))))
;;;  )
;;;  (if (and clgmin (> (length minor_list) 1) (not (= clgmaj "0")))
;;;    (setq clg_minor (substr (nth (atoi clgmin) minor_list) 1 4))
;;;    (setq clg_minor "    ")
;;;  )
;;;  (start_list "Minor")
;;;  (mapcar 'add_list minor_list)
;;;  (end_list)
  (set_list minor_list "Minor" clg_minor 4)
  (princ)
) ;_ end of defun
;;;;********************************************************************
(defun f_color (/)
  (if (and color_list clgcol)
    (if	(>= (atoi clgcol) (length color_list))
      (setq clgcol (itoa (1- (length color_list))))
    ) ;_ end of if
    (setq clgcol "0")
  ) ;_ end of if
  (set_color_list)
  (start_list "Color")
  (mapcar 'add_list color_list)
  (end_list)
  (if init
    (if	(= clgcol "0")
      (setq colr nil
	    colra nil
      ) ;_ end of setq
      (progn
	(setq wcolr (substr (nth (atoi clgcol) color_list) 1 1))
	(if (eq (type (read wcolr)) 'INT)
	  (progn
	    (setq colr	wcolr
		  colra	nil
		  colri	nil
	    ) ;_ end of setq
	  ) ;_ end of progn
	  (progn
	    (setq colra	wcolr
		  colr	nil
	    ) ;_ end of setq
	    (cond
	      ((eq wcolr "A") (setq colri "10"))
	      ((eq wcolr "B") (setq colri "11"))
	      ((eq wcolr "C") (setq colri "12"))
	      ((eq wcolr "D") (setq colri "13"))
	      ((eq wcolr "E") (setq colri "14"))
	      ((eq wcolr "F") (setq colri "15"))
	      ((eq wcolr "G") (setq colri "16"))
	      ((eq wcolr "H") (setq colri "17"))
	      ((eq wcolr "I") (setq colri "18"))
	      ((eq wcolr "J") (setq colri "19"))
	      ((eq wcolr "K") (setq colri "20"))
	      ((eq wcolr "L") (setq colri "21"))
	      ((eq wcolr "M") (setq colri "22"))
	      ((eq wcolr "N") (setq colri "23"))
	      ((eq wcolr "O") (setq colri "24"))
	      ((eq wcolr "P") (setq colri "25"))
	      ((eq wcolr "Q") (setq colri "26"))
	      ((eq wcolr "R") (setq colri "27"))
	      ((eq wcolr "S") (setq colri "28"))
	      ((eq wcolr "T") (setq colri "29"))
	      ((eq wcolr "U") (setq colri "250"))
	      ((eq wcolr "V") (setq colri "251"))
	      ((eq wcolr "W") (setq colri "252"))
	      ((eq wcolr "X") (setq colri "253"))
	      ((eq wcolr "Y") (setq colri "254"))
	      ((eq wcolr "Z") (setq colri "255"))
	    ) ;_ end of cond
	  ) ;_ end of progn
	) ;_ end of if
      ) ;_ end of progn
    ) ;_ end of if
  ) ;_ end of if
  (setq col_idx nil)
  (foreach n color_list
    (if	col_idx
      (setq col_idx (append col_idx (list (substr n 1 1))))
      (setq col_idx (list (substr n 1 1)))
    ) ;_ end of if
  ) ;_ end of foreach
  (cond
    ((setq col_ils (member colr col_idx))
     (setq clgcol (itoa (- (length color_list) (length col_ils))))
     (set_tile "Color" clgcol)
    )
    ((setq col_ils (member colra col_idx))
     (setq clgcol (itoa (- (length color_list) (length col_ils))))
     (set_tile "Color" clgcol)
    )
  ) ;_ end of cond
  (setq cucolr (substr (nth (atoi clgcol) color_list) 1 1))
  (if (and clgcol (/= clgcol "0"))
    (progn
      (setq clg_color cucolr
	    use_colr T
      ) ;_ end of setq
      (set_tile "use_colors" "1")
    ) ;_ end of progn
    (progn
      (setq clg_color "-"
	    use_colr nil
      ) ;_ end of setq
      (set_tile "use_colors" "0")
    ) ;_ end of progn
  ) ;_ end of if
  (set_list color_list "Color" clg_color 1)
  (princ)
) ;_ end of defun
;;;********************************************************************
(defun f_modif (/)
  (if (and modif_list clgmod)
    (if	(>= (atoi clgmod) (length modif_list))
      (setq clgmod (itoa (1- (length modif_list))))
    ) ;_ end of if
    (setq clgmod "0")
  ) ;_ end of if
  (set_modif_list)
  (start_list "Modifier")
  (mapcar 'add_list modif_list)
  (end_list)
  (if init
    (if	(= clgmod "0")
      (setq modf nil)
      (setq modf (substr (nth (atoi clgmod) modif_list) 1 4))
    ) ;_ end of if
  ) ;_ end of if
  (setq mod_idx nil)
  (foreach n modif_list
    (setq mod_idx (append mod_idx (list (substr n 1 4))))
  ) ;_ end of foreach
  (if (setq mod_ils (member modf mod_idx))
    (progn
      (setq clgmod (itoa (- (length modif_list) (length mod_ils))))
      (set_tile "Modifier" clgmod)
    ) ;_ end of progn
  ) ;_ end of if
  (if clgmod
    (setq clg_modif (substr (nth (atoi clgmod) modif_list) 1 4))
  ) ;_ end of if
  (set_list modif_list "Modifier" clg_modif 4)
  (princ)
) ;_ end of defun
;;;********************************************************************
(defun f_user (/)
  (if (and user_list clgusr)
    (if	(>= (atoi clgusr) (length user_list))
      (setq clgusr (itoa (1- (length user_list))))
    ) ;_ end of if
    (setq clgusr "0")
  ) ;_ end of if
  (set_user_list)
  (start_list "User_defined")
  (mapcar 'add_list user_list)
  (end_list)
  (if init
    (if	(= clgusr "0")
      (setq usrd nil)
      (setq usrd (substr (nth (atoi clgusr) user_list) 1 4))
    ) ;_ end of if
  ) ;_ end of if
  (setq usr_idx nil)
  (foreach n user_list
    (setq usr_idx (append usr_idx (list (substr n 1 4))))
  ) ;_ end of foreach
  (if (setq usr_ils (member usrd usr_idx))
    (progn
      (setq clgusr (itoa (- (length user_list) (length usr_ils))))
      (set_tile "User_defined" clgusr)
    ) ;_ end of progn
  ) ;_ end of if
  (if
    clgusr
     (setq clg_user (substr (nth (atoi clgusr) user_list) 1 4))
  ) ;_ end of if
  (set_list user_list "User_defined" clg_user 4)
  (princ)
) ;_ end of defun
;;;********************************************************************
(defun f_cc (/)
  (if (= clglen "clg_long")
    (setq lstr
	   (strcat
	     (if (and clg_mj (not (= clg_mj "")))
	       clg_mj
	       " "
	     ) ;_ end of if
	     (if use_ltyp
	       (if clg_ltype
		 clg_ltype
		 "-"
	       ) ;_ end of if
	       "-"
	     ) ;_ end of if
	     (if clg_minor
	       clg_minor
	       "    "
	     ) ;_ end of if
	     (if use_colr
	       (if clg_color
		 (substr clg_color 1 1)
		 "-"
	       ) ;_ end of if
	       (if (= (ascii (substr clg_modif 1 1)) 32)
		 (if (or
		       (= (ascii (substr clg_user 1 1)) 32)
		       (= (ascii (substr clg_user 1 1)) 0)
		     ) ;_ end of or
		   ""
		   "-"
		 ) ;_ end of if
		 "-"
	       ) ;_ end of if
	     ) ;_ end of if
	     (if (= (ascii (substr clg_modif 1 1)) 32)
	       (if (or
		     (= (ascii (substr clg_user 1 1)) 32)
		     (= (ascii (substr clg_user 1 1)) 0)
		   ) ;_ end of or
		 ""
		 (strcat "    -" clg_user)
	       ) ;_ end of if
	       (if (or
		     (= (ascii (substr clg_user 1 1)) 32)
		     (= (ascii (substr clg_user 1 1)) 0)
		   ) ;_ end of or
		 clg_modif
		 (strcat clg_modif "-" clg_user)
	       ) ;_ end of if
	     ) ;_ end of if
	   ) ;_ end of strcat
    ) ;_ end of setq
    (setq lstr
	   (strcat
	     (if (and clg_mj (not (= clg_mj "")))
	       clg_mj
	       " "
	     ) ;_ end of if
	     (if clg_minor
	       (substr clg_minor 1 2)
	       "  "
	     ) ;_ end of if
	     (if (not (= (ascii (substr clg_modif 1 1)) 32))
	       (substr clg_modif 1 2)
	       (if (or use_ltyp
		       use_colr
		       (and
			 (not (= (ascii (substr clg_user 1 1)) 32))
			 (not (= (ascii (substr clg_user 1 1)) 0))
		       ) ;_ end of and
		   ) ;_ end of or
		 "-"
		 ""
	       ) ;_ end of if
	     ) ;_ end of if
	     (if use_ltyp
	       (if use_colr
		 (if clg_ltype
		   (strcat clg_ltype
			   (if clg_color
			     clg_color
			     "-"
			   ) ;_ end of if
		   ) ;_ end of strcat
		   (strcat "-"
			   (if clg_color
			     clg_color
			     "-"
			   ) ;_ end of if
		   ) ;_ end of strcat
		 ) ;_ end of if
		 (if clg_ltype
		   clg_ltype
		   "-"
		 ) ;_ end of if
	       ) ;_ end of if
	       (if use_colr
		 (strcat "-"
			 (if clg_color
			   clg_color
			   "-"
			 ) ;_ end of if
		 ) ;_ end of strcat
		 ""
	       ) ;_ end of if

	     ) ;_ end of if
	     (if (or
		   (= (ascii (substr clg_user 1 1)) 32)
		   (= (ascii (substr clg_user 1 1)) 0)
		 ) ;_ end of or
	       ""
	       (strcat "-" (substr clg_user 1 2))
	     ) ;_ end of if
	   ) ;_ end of strcat
    ) ;_ end of setq
  ) ;_ end of if
  (set_tile "clg_layer" lstr)
  (if clglen
    (set_tile clglen "1")
  ) ;_ end of if
  (princ)
) ;_ end of defun
;;;********************************************************************
;;;Constructs the list of Major Groups
(defun set_major_list (/)
  (setq major_list nil)
  (setq mj_file (findfile "clgmajor.dat"))
  (if mj_file
    (progn
      (setq mj_dat (open mj_file "r"))
      (while
	(setq str (read-line mj_dat))
	 (setq major_list (append major_list (list str)))
      )					;while
      (close mj_dat)
      (if (setq mj_lst (acad_strlsort major_list))
	(setq major_list mj_lst)
	(setq clg_err "Not enough memory to sort major group list.")
      ) ;_ end of if
    ) ;_ end of progn
    (IF	dos_msgbox
      (dos_msgbox
	(STRCAT
	  "File \"clgmajor.dat\" not found!\n" "\n"
	  "This and all of the \"*.dat\" files included with this application must\n"
	  "be placed in a folder that is included in the AutoCAD search path.  To\n"
	  "include the folder they are in within AutoCAD's search path, add it to\n"
	  "the \"Support file search path\" in the \"Files\" tab under \"Preferences\"") ;_ end of STRCAT
 ;_ end of STRCAT
	"Missing Data File"
	1
	1
      ) ;_ end of dos_msgbox
      (ALERT
	(STRCAT
	  "File \"clgmajor.dat\" not found!\n" "\n"
	  "This and all of the \"*.dat\" files included with this application must\n"
	  "be placed in a folder that is included in the AutoCAD search path.  To\n"
	  "include the folder they are in within AutoCAD's search path, add it to\n"
	  "the \"Support file search path\" in the \"Files\" tab under \"Preferences\"") ;_ end of STRCAT
 ;_ end of STRCAT
      ) ;_ end of ALERT
    ) ;_ end of IF

  ) ;_ end of if
  (princ)
) ;_ end of defun
;;;********************************************************************
(defun set_ltype_list (/)
  (setq ltype_list nil)
  (setq ltype_file (findfile "clgltype.dat"))
  (setq ltype_dat (open ltype_file "r"))
  (while (setq str (read-line ltype_dat))
    (setq ltype_list (append ltype_list (list str)))
  ) ;_ end of while
  (close ltype_dat)
  (if (setq lt_lst (acad_strlsort ltype_list))
    (setq ltype_list lt_lst)
    (setq clg_err "Not enough memory to sort linetype list.")
  ) ;_ end of if
  (princ)
) ;_ end of defun
;;;********************************************************************
;;;Constructs Minor Group List associated with the current Major Group
(defun set_minor_list (/)
  (setq minor_list nil)
  (if clg_mj
    nil
    (setq clg_mj "")
  ) ;_ end of if
  (if (findfile minor_file)
    (progn
      (setq minor_dat (open (findfile minor_file) "r"))
      (while (setq str (read-line minor_dat))
	(setq minor_list (append minor_list (list str)))
      ) ;_ end of while
      (close minor_dat)
      (if (setq mn_lst (acad_strlsort minor_list))
	(setq minor_list mn_lst)
	(setq clg_err "Not enough memory to sort minor group list.")
      ) ;_ end of if
    ) ;_ end of progn
    (setq clg_err (strcat "\nFile " minor_file " not found! "))
  ) ;_ end of if
  (princ)
) ;_ end of defun
;;;********************************************************************
(defun set_color_list (/)
  (setq color_list nil)
  (setq color_file (findfile "clgcolor.dat"))
  (setq color_dat (open color_file "r"))
  (while (setq str (read-line color_dat))
    (setq color_list (append color_list (list str)))
  ) ;_ end of while
  (close color_dat)
  (if (setq co_lst (acad_strlsort color_list))
    (setq color_list co_lst)
    (setq clg_err "Not enough memory to sort color list. ")
  ) ;_ end of if
  (princ)
) ;_ end of defun
;;;********************************************************************
(defun set_modif_list (/)
  (setq modif_list nil)
  (setq modif_file (findfile "clgmodif.dat"))
  (setq modif_dat (open modif_file "r"))
  (while (setq str (read-line modif_dat))
    (setq modif_list (append modif_list (list str)))
  ) ;_ end of while
  (close modif_dat)
  (if (setq mo_lst (acad_strlsort modif_list))
    (setq modif_list mo_lst)
    (setq clg_err "Not enough memory to sort modifier list. ")
  ) ;_ end of if
  (princ)
) ;_ end of defun
;;;********************************************************************
(defun set_user_list (/)
  (setq user_list nil)
  (setq user_file (findfile "clg_user.dat"))
  (setq user_dat (open user_file "r"))
  (while (setq str (read-line user_dat))
    (setq user_list (append user_list (list str)))
  ) ;_ end of while
  (close user_dat)
  (if (setq us_lst (acad_strlsort user_list))
    (setq user_list us_lst)
    (setq clg_err "Not enough memory to sort user defined list. ")
  ) ;_ end of if
  (princ)
) ;_ end of defun
;;;********************************************************************
;;;Constructs a list of layers in the drawing.
(defun set_lay_list (/)
  (progn
    (setq it (tblnext "layer" "T"))
    (setq itn (cdr (assoc 2 it)))
    (setq newlist (list itn))
    (while
      (setq it (tblnext "layer"))
       (progn
	 (setq itn (cdr (assoc 2 it)))
	 (setq newlist (append newlist (list itn)))
       ) ;_ end of progn
    ) ;_ end of while
;;;    (setq newlist (acad_strlsort newlist))
;;;    (if	(>= (ATOF(getvar "acadver")) 14.00)
;;;      (setq
;;;	lay_f (open (strcat (substr (getvar "dwgname")
;;;				    1
;;;				    (- (strlen (getvar "dwgname")) 4)
;;;			    ) ;_ end of substr
;;;			    ".LST"
;;;		    ) ;_ end of strcat
;;;		    "w"
;;;	      ) ;_ end of open
;;;      ) ;_ end of setq
;;;      (setq lay_f (open (strcat (getvar "dwgname") ".LST") "w"))
;;;    ) ;_ end of if
;;;    (foreach n newlist (write-line n lay_f))
;;;    (close lay_f)
    (if	(setq nw_lst (acad_strlsort newlist))
      (setq newlist nw_lst)
      (setq clg_err "Not enough memory to sort layer list. ")
    ) ;_ end of if
  ) ;_ end of progn
  (princ)
) ;_ end of defun
;;;********************************************************************
;;;Sets current selection in a listbox to a specified value
(defun set_list	(aalist key value slno /)
  (setq count 0)
  (while (< count (length aalist))
    (if
      (eq (substr (nth count aalist) 1 slno) value)
       (progn
	 (set_tile key (itoa count))
	 (setq count (length aalist))
       ) ;_ end of progn
       (progn
	 (set_tile key "0")
	 (setq count (1+ count))
       ) ;_ end of progn
    ) ;_ end of if
  ) ;_ end of while
  (princ)
) ;_ end of defun
;;;********************************************************************
(defun edat (/)
  (setq newitem nil)
  (cond
    ((= whlst "major")
     (setq keyname "major_add"
	   whsl	   "maj"
     ) ;_ end of setq
     (setq major_file (findfile "clgmajor.dat"))
    )
    ((= whlst "minor")
     (setq keyname "minor_add"
	   whsl	   "min"
     ) ;_ end of setq
     (setq minor_file (findfile (strcat "clg" whsl clg_mj ".dat")))
    )
    ((= whlst "modif")
     (setq keyname "modif_add"
	   whsl	   "mod"
     ) ;_ end of setq
     (setq modif_file (findfile "clgmodif.dat"))
    )
    ((= whlst "user")
     (setq keyname "user_add"
	   whsl	   "usr"
     ) ;_ end of setq
     (setq modif_file (findfile "clg_user.dat"))
    )
  ) ;_ end of cond
  (new_dialog (strcat "clg_" whlst) clg_num)
  (mode_tile "new_item" 2)
  (action_tile (strcat whlst "_add") "(set_edit_box)")
  (action_tile
    "Add_more"
    "(setq newitem (get_tile \"new_item\"))(add_item)(set_tile \"new_item\" \"\")(mode_tile \"new_item\" 2)"
  ) ;_ end of action_tile
  (action_tile
    "Repl_line"
    "(setq repl_key (get_tile(strcat whlst \"_add\")))(repl_item)"
  ) ;_ end of action_tile
  (action_tile
    "Delete_line"
    "(setq del_key (get_tile (strcat whlst \"_add\")))(del_lines)(set_tile\"new_item\" \"\")"
  ) ;_ end of action_tile
  (action_tile
    "insert_tab"
    "(set_tile \"new_item\"(strcat(get_tile\"new_item\")\"\t-\t\"))(mode_tile\"new_item\" 2)"
  ) ;_ end of action_tile
  (action_tile
    "Add_done"
    "(setq newitem (get_tile \"new_item\"))(add_done)(done_dialog)"
  ) ;_ end of action_tile
  (action_tile
    "Add_cancel"
    "(eval(strcat \"f_\" whlst))(done_dialog 0)"
  ) ;_ end of action_tile
  (eval (read (strcat "set_" whlst "_list")))
  (start_list (strcat whlst "_add"))
  (mapcar 'add_list (eval (read (strcat whlst "_list"))))
  (end_list)
  (set_list (eval (read (strcat whlst "_list")))
	    (strcat whlst "_add")
	    "0"
	    1
  ) ;_ end of set_list
  (if (and (= clgmaj "0") (= whlst "minor"))
    (progn
      (mode_tile "new_item" 1)
      (mode_tile "Add_more" 1)
      (mode_tile "Repl_line" 1)
      (mode_tile "Delete_line" 1)
      (mode_tile "insert_tab" 1)
      (mode_tile "Add_done" 1)
    ) ;_ end of progn
  ) ;_ end of if
  (start_dialog)
  (f_all)
) ;_ end of defun
;;;********************************************************************
(defun set_edit_box (/)
  (setq del_key (get_tile (strcat whlst "_add")))
  (if (eq (strlen del_key) 1)
    (set_tile "new_item"
	      (nth (atoi del_key) (eval (read (strcat whlst "_list"))))
    ) ;_ end of set_tile
    (set_tile "new_item" "")
  ) ;_ end of if
  (princ)
) ;_ end of defun
;;;********************************************************************
;;;(defun repl_item (/)
;;;  (if (eq (strlen repl_key) 1)
;;;    (progn
;;;      (setq exst_str (nth (atoi repl_key)
;;;			  (eval (read (strcat whlst "_list")))
;;;		     ) ;_ end of nth
;;;	    repl_str (get_tile "new_item")
;;;      ) ;_ end of setq
;;;      (set (read (strcat "new_" whlst "_list"))
;;;	   (subst repl_str
;;;		  exst_str
;;;		  (eval (read (strcat whlst "_list")))
;;;	   ) ;_ end of subst
;;;      ) ;_ end of set
;;;      (set_tile "new_item" "")
;;;      (mode_tile "new_item" 2)
;;;      (start_list (strcat whlst "_add") 1 (atoi repl_key))
;;;      (add_list repl_str)
;;;      (end_list)
;;;    ) ;_ end of progn
;;;  ) ;_ end of if
;;;  (princ)
;;;) ;_ end of defun
;;;********************************************************************
(DEFUN repl_item (/)
  (IF (EQ (TYPE (READ repl_key)) 'INT)
    (PROGN
      (SETQ exst_str (NTH (ATOI repl_key)
			  (eval (read (strcat whlst "_list")))
		     ) ;_ end of NTH
	    repl_str (GET_TILE "new_item")
	    rslen    (STRLEN repl_str)
	    chrcnt   1
      ) ;_ end of setq
      (SETQ new_list (SUBST repl_str
			    exst_str
			    (eval (read (strcat whlst "_list")))
		     ) ;_ end of SUBST
      ) ;_ end of SETQ
      (SET (read (strcat whlst "_list")) new_list)
      (SET_TILE "new_item" "")
      (MODE_TILE "new_item" 2)
      (start_list (strcat whlst "_add") 1 (atoi repl_key))
      (add_list repl_str)
      (end_list)
      (SET_TILE (strcat whlst "_add") repl_key)
      (SET_TILE
	"new_item"
	(NTH (ATOI repl_key) (eval (read (strcat whlst "_list"))))
      ) ;_ end of SET_TILE
      (MODE_TILE "new_item" 3)
    ) ;_ end of progn
  ) ;_ end of if
  (PRINC)
) ;_ end of DEFUN
;;;********************************************************************
(defun add_item	(/)
  (if (eq newitem "")
    nil
    (progn
      (start_list keyname 2)
      (add_list newitem)
      (set (read (strcat whlst "_list"))
	   (append (eval (read (strcat whlst "_list"))) (list newitem))
      ) ;_ end of set
      (set (read (strcat "new_" whlst "_list"))
	   (eval (read (strcat whlst "_list")))
      ) ;_ end of set
      (setq newitem nil)
      (end_list)
    ) ;_ end of progn
  ) ;_ end of if
  (princ)
) ;_ end of defun
;;;********************************************************************
(defun add_done	(/)
  (if (eval (read (strcat "new_" whlst "_list")))
    (progn
      (set (read (strcat whlst "_dat"))
	   (open (eval (read (strcat whlst "_file"))) "w")
      ) ;_ end of set
      (foreach n (eval (read (strcat "new_" whlst "_list")))
	(write-line n (eval (read (strcat whlst "_dat"))))
      ) ;_ end of foreach
      (close (eval (read (strcat whlst "_dat"))))
    ) ;_ end of progn
  ) ;_ end of if
  (if (= newitem "")
    nil
    (progn
      (start_list keyname 2)
      (add_list newitem)
      (set (read (strcat whlst "_list"))
	   (append (eval (read (strcat whlst "_list"))) (list newitem))
      ) ;_ end of set
      (if (member newitem (eval (read (strcat "new_" whlst "_list"))))
	nil
	(set (read (strcat "new_" whlst "_list"))
	     (append (eval (read (strcat "new_" whlst "_list")))
		     (list newitem)
	     ) ;_ end of append
	) ;_ end of set
      ) ;_ end of if
      (set (read (strcat "clg" whsl))
	   (itoa (1- (length (eval (read (strcat whlst "_list"))))))
      ) ;_ end of set
      (set (read (strcat whlst "_dat"))
	   (open (eval (read (strcat whlst "_file"))) "a")
      ) ;_ end of set
      (write-line newitem (eval (read (strcat whlst "_dat"))))
      (close (eval (read (strcat whlst "_dat"))))
      (setq newitem nil)
      (end_list)
    ) ;_ end of progn
  ) ;_ end of if
  (princ)
) ;_ end of defun
;;;********************************************************************
(defun manylay (/)
  (setq thislayer (nth (atoi curlay) newlist))
  (command ".layer" "m" thislayer "")
  (if (and (not (wcmatch thislayer "???-*"))
	   (not (wcmatch thislayer "?????-*"))
	   (> (strlen thislayer) 10)
      ) ;_ end of and
    (progn
      (if (> (strlen thislayer) 10)
	(setq thisform "Long"
	      no_usr nil
	) ;_ end of setq
	(setq thisform (ukword 1
			       "Long Short"
			       (strcat "Is layer "
				       thislayer
				       " Long or Short format?"
			       ) ;_ end of strcat
			       (If thisform
				 thisform
			       ) ;_ end of If
		       ) ;_ end of ukword
	) ;_ end of setq
      ) ;_ end of if
      (cond
	((eq thisform "Long") (setq layform "long"))
	((eq thisform "Short")
	 (setq layform "short")
	 (if (wcmatch thislayer "???-*")
	   (setq no_mod T)
	   (setq no_mod nil)
	 ) ;_ end of if
	 (if (wcmatch thislayer "*-*-??")
	   (setq no_usr nil)
	   (setq no_usr T)
	 ) ;_ end of if
	)
      ) ;_ end of cond
    ) ;_ end of progn
    (progn
      (setq layform "short")
      (if (wcmatch thislayer "???-*")
	(setq no_mod T)
	(setq no_mod nil)
      ) ;_ end of if
      (if (wcmatch thislayer "???-?-??")
	(setq no_usr nil
	      oneclt T
	      twoclt nil
	) ;_ end of setq
	(setq no_usr T
	      oneclt nil
	      twoclt nil
	) ;_ end of setq
      ) ;_ end of if
      (if (wcmatch thislayer "???-??-??")
	(setq no_usr nil
	      oneclt nil
	      twoclt T
	) ;_ end of setq
	(setq no_usr T
	      oneclt nil
	      twoclt nil
	) ;_ end of setq
      ) ;_ end of if
      (if (wcmatch thislayer "?????-??")
	(setq no_usr nil
	      oneclt nil
	      twoclt nil
	) ;_ end of setq
	(setq no_usr T
	      oneclt nil
	      twoclt nil
	) ;_ end of setq
      ) ;_ end of if
      (if (wcmatch thislayer "??????-??")
	(setq no_usr nil
	      oneclt T
	      twoclt nil
	) ;_ end of setq
	(setq no_usr T
	      oneclt nil
	      twoclt nil
	) ;_ end of setq
      ) ;_ end of if
      (if (wcmatch thislayer "???????-??")
	(setq no_usr nil
	      oneclt nil
	      twoclt T
	) ;_ end of setq
	(setq no_usr T
	      oneclt nil
	      twoclt nil
	) ;_ end of setq
      ) ;_ end of if
    ) ;_ end of progn
  ) ;_ end of if
  (setq maj_key nil)
  (foreach n major_list
    (if	maj_key
      (setq maj_key (append maj_key (list (substr n 1 1))))
      (setq maj_key (list (substr n 1 1)))
    ) ;_ end of if
  ) ;_ end of foreach
  (if (setq memlst (member (substr thislayer 1 1) maj_key))
    (progn
      (setq mjrg   (car memlst)
	    clg_mj mjrg
      ) ;_ end of setq
      (setq clgmaj (itoa (- (length maj_key) (length memlst))))
    ) ;_ end of progn
    (setq clgmaj "0")
  ) ;_ end of if
  (setq mj_file (findfile "clgmajor.dat"))
  (f_minor)
  (setq llt_key nil)
  (foreach n ltype_list
    (if	llt_key
      (setq llt_key (append llt_key (list (substr n 1 1))))
      (setq llt_key (list (substr n 1 1)))
    ) ;_ end of if
  ) ;_ end of foreach
  (cond
    ((eq layform "long") (setq llt_idx 2))
    (no_mod (setq llt_idx 5))
    (T (setq llt_idx 6))
  ) ;_ end of cond
  (if (setq memlst (member (substr thislayer llt_idx 1) llt_key))
    (progn
      (setq llt	(car memlst)
	    clg_ltype llt
      ) ;_ end of setq
      (setq clgllt (itoa (- (length llt_key) (length memlst))))
    ) ;_ end of progn
    (setq clgllt "0")
  ) ;_ end of if
  (setq min_key nil)
  (foreach n minor_list
    (if	min_key
      (setq min_key (append min_key (list (substr n 1 4))))
      (setq min_key (list (substr n 1 4)))
    ) ;_ end of if
  ) ;_ end of foreach
  (cond
    ((eq layform "long")
     (setq min_idx 3
	   min_dur 4
     ) ;_ end of setq
    )
    (T
     (setq min_idx 2
	   min_dur 2
     ) ;_ end of setq
    )
  ) ;_ end of cond
  (setq mincnt 0)
  (while
    (and
      (< mincnt (length min_key))
      (not
	(wcmatch (nth mincnt min_key)
		 (strcat (substr thislayer min_idx min_dur) "*")
	) ;_ end of wcmatch
      ) ;_ end of not
    ) ;_ end of and
     (setq mincnt (1+ mincnt))
  ) ;_ end of while
  (if (setq memlst (member (nth mincnt min_key) min_key))
    (progn
      (setq prod (car memlst)
	    clg_minor prod
      ) ;_ end of setq
      (setq clgmin (itoa (- (length min_key) (length memlst))))
    ) ;_ end of progn
    (setq clgmin "0")
  ) ;_ end of if
  (setq col_key nil)
  (foreach n color_list
    (if	col_key
      (setq col_key (append col_key (list (substr n 1 1))))
      (setq col_key (list (substr n 1 1)))
    ) ;_ end of if
  ) ;_ end of foreach
  (cond
    ((eq layform "long") (setq col_idx 7))
    ((eq clgcol "0") (setq col_idx 6))
    (T (setq col_idx 7))
  ) ;_ end of cond
  (if (setq memlst (member (substr thislayer col_idx 1) col_key))
    (progn
      (setq clgcol (itoa (- (length col_key) (length memlst))))
      (if (eq (type (read (nth 0 memlst))) 'INT)
	(setq colr	(substr thislayer col_idx 1)
	      clg_color	colr
	      colra	nil
	      colri	nil
	) ;_ end of setq
	(progn
	  (setq	colra	  (substr thislayer col_idx 1)
		clg_color colra
	  ) ;_ end of setq
	  (cond
	      ((eq colra "A") (setq colri "10"))
	      ((eq colra "B") (setq colri "11"))
	      ((eq colra "C") (setq colri "12"))
	      ((eq colra "D") (setq colri "13"))
	      ((eq colra "E") (setq colri "14"))
	      ((eq colra "F") (setq colri "15"))
	      ((eq colra "G") (setq colri "16"))
	      ((eq colra "H") (setq colri "17"))
	      ((eq colra "I") (setq colri "18"))
	      ((eq colra "J") (setq colri "19"))
	      ((eq colra "K") (setq colri "20"))
	      ((eq colra "L") (setq colri "21"))
	      ((eq colra "M") (setq colri "22"))
	      ((eq colra "N") (setq colri "23"))
	      ((eq colra "O") (setq colri "24"))
	      ((eq colra "P") (setq colri "25"))
	      ((eq colra "Q") (setq colri "26"))
	      ((eq colra "R") (setq colri "27"))
	      ((eq colra "S") (setq colri "28"))
	      ((eq colra "T") (setq colri "29"))
	      ((eq colra "U") (setq colri "250"))
	      ((eq colra "V") (setq colri "251"))
	      ((eq colra "W") (setq colri "252"))
	      ((eq colra "X") (setq colri "253"))
	      ((eq colra "Y") (setq colri "254"))
	      ((eq colra "Z") (setq colri "255"))
	  ) ;_ end of cond
	) ;_ end of progn
      ) ;_ end of if
    ) ;_ end of progn
    (setq clgcol "0")
  ) ;_ end of if
  (setq	mod_key	nil
	mod_idx	nil
	mod_dur	nil
  ) ;_ end of setq
  (foreach n modif_list
    (if	mod_key
      (setq mod_key (append mod_key (list (substr n 1 4))))
      (setq mod_key (list (substr n 1 4)))
    ) ;_ end of if
  ) ;_ end of foreach
  (cond
    ((eq layform "long")
     (setq mod_idx 8
	   mod_dur 4
     ) ;_ end of setq
    )
    (no_mod
     (setq modf	""
	   clg_modif "-"
	   clgmod "0"
     ) ;_ end of setq
    )
    (T
     (setq mod_idx 4
	   mod_dur 2
     ) ;_ end of setq
    )
  ) ;_ end of cond
  (if (not no_mod)
    (progn
      (setq modcnt 0)
      (while
	(and
	  (< modcnt (length mod_key))
	  (not
	    (wcmatch (nth modcnt mod_key)
		     (strcat (substr thislayer mod_idx mod_dur) "*")
	    ) ;_ end of wcmatch
	  ) ;_ end of not
	) ;_ end of and
	 (setq modcnt (1+ modcnt))
      ) ;_ end of while
      (if (setq memlst (member (nth modcnt mod_key) mod_key))
	(progn
	  (setq	modf (car memlst)
		clg_modif modf
	  ) ;_ end of setq
	  (setq clgmod (itoa (- (length mod_key) (length memlst))))
	) ;_ end of progn
	(setq clgmod "0")
      ) ;_ end of if
    ) ;_ end of progn
  ) ;_ end of if
  (setq	usr_key	nil
	usr_idx	nil
	usr_dur	nil
  ) ;_ end of setq
  (foreach n user_list
    (if	usr_key
      (setq usr_key (append usr_key (list (substr n 1 4))))
      (setq usr_key (list (substr n 1 4)))
    ) ;_ end of if
  ) ;_ end of foreach
  (cond
    (no_usr
     (setq usdf	""
	   clg_user ""
	   clgusr "0"
     ) ;_ end of setq
    )
    ((eq layform "long")
     (setq usr_idx 13
	   usr_dur 4
     ) ;_ end of setq
    )
    (no_mod
     (cond
       (oneclt
	(setq usr_idx 7
	      usr_dur 2
	) ;_ end of setq
       )
       (twoclt
	(setq usr_idx 8
	      usr_dur 2
	) ;_ end of setq
       )
       (T
	(setq usr_idx 6
	      usr_dur 2
	) ;_ end of setq
       )
     ) ;_ end of cond
    )
    (T
     (cond
       (oneclt
	(setq usr_idx 8
	      usr_dur 2
	) ;_ end of setq
       )
       (twoclt
	(setq usr_idx 9
	      usr_dur 2
	) ;_ end of setq
       )
       (T
	(setq usr_idx 7
	      usr_dur 2
	) ;_ end of setq
       )
     ) ;_ end of cond
    )
  ) ;_ end of cond
  (setq	oneclt nil
	twoclt nil
  ) ;_ end of setq
  (if (not no_usr)
    (progn
      (setq usrcnt 0)
      (while
	(and
	  (< usrcnt (length usr_key))
	  (not
	    (wcmatch (nth usrcnt usr_key)
		     (strcat (substr thislayer usr_idx usr_dur) "*")
	    ) ;_ end of wcmatch
	  ) ;_ end of not
	) ;_ end of and
	 (setq usrcnt (1+ usrcnt))
      ) ;_ end of while
      (if (setq memlst (member (nth usrcnt usr_key) usr_key))
	(progn
	  (setq	usdf	 (car memlst)
		clg_user usdf
	  ) ;_ end of setq
	  (setq clgusr (itoa (- (length usr_key) (length memlst))))
	) ;_ end of progn
	(setq clgusr "0")
      ) ;_ end of if
    ) ;_ end of progn
  ) ;_ end of if
  (setq do_manylay T)
  (set_hist)
  (setq do_manylay nil)
  (princ)
) ;_ end of defun
;;;********************************************************************
(defun mlay (/)
  (if clglay
    (progn
      (if (= clgcol "0")
	(setq clgcol "1"
	      recolr T
	) ;_ end of setq
	(setq recolr nil)
      ) ;_ end of if
      (command ".layer"
	       "m"
	       clglay
	       "c"
	       (cond ((eq clgcol "30") "250")
		     ((eq clgcol "31") "251")
		     ((eq clgcol "32") "252")
		     ((eq clgcol "33") "253")
		     ((eq clgcol "34") "254")
		     ((eq clgcol "35") "255")
		     (T clgcol)
	       ) ;_ end of cond
	       ""
	       "lt"
	       (substr (nth (atoi clgllt) ltype_list) 8 10)
	       ""
	       ""
      ) ;_ end of command
      (if recolr
	(setq clgcol "0"
	      recolr nil
	) ;_ end of setq
      ) ;_ end of if
    ) ;_ end of progn
  ) ;_ end of if
  (setq clglay nil)
  (princ)
) ;_ end of defun
;;;********************************************************************
					;(defun f_newlay ( / )
					;  (done_dialog)
					;  (setq clglay (get_tile "clg_layer"))
					;  (setq latexl (strlen clglay))
					;  (if(= clglen "clg_long")
					;    (progn
					;      (if(>= latexl 1)(setq mjrg(substr clglay 1 1)))
					;      (if(> latexl 1)(setq llt(substr clglay 2 1)))
					;      (if(> latexl 5)(setq prod(substr clglay 3 4)))
					;      (if(> latexl 6)(setq colr(substr clglay 7 1)))
					;      (if(> latexl 7)(setq modf(substr clglay 8 4)))
					;      (if(> latexl 14)(setq usrd(substr clglay 12 4)))
					;    );progn
					;    (progn
					;       (if(>= latexl 1)(setq clg_mj(substr clglay 1 1)))
					;       (if(> latexl 5)(setq clg_minor(substr clglay 2 2)))
					;       (if(> latexl 6)(setq clg_modf(substr clglay 4 2)))
					;       (if(> latexl 7)(setq clg_user(substr clglay 6 3)))
					;    );progn
					;  );if
					;  (c:mklayr)
					;);defun
;;;********************************************************************
(defun intchk (ivar /)
  (if (atoi ivar)
    nil
    (setq ivar "0")
  ) ;_ end of if
) ;_ end of defun
;;;********************************************************************
(defun c:nvars (/)
  (princ (strcat "\nclg_mj = "
		 (if clg_mj
		   clg_mj
		   "NIL"
		 ) ;_ end of if
		 "\nclg_ltype = "
		 (if clg_ltype
		   clg_ltype
		   "NIL"
		 ) ;_ end of if
		 "\nclg_minor = "
		 (if clg_minor
		   clg_minor
		   "NIL"
		 ) ;_ end of if
		 "\nclg_color = "
		 (if clg_color
		   clg_color
		   "NIL"
		 ) ;_ end of if
		 "\nclg_modif = "
		 (if clg_modif
		   clg_modif
		   "NIL"
		 ) ;_ end of if
		 "\nclg_user = "
		 (if clg_user
		   clg_user
		   "NIL"
		 ) ;_ end of if
		 "\nclgmaj = "
		 (if clgmaj
		   clgmaj
		   "NIL"
		 ) ;_ end of if
		 "\nclgllt = "
		 (if clgllt
		   clgllt
		   "NIL"
		 ) ;_ end of if
		 "\nclgmin = "
		 (if clgmin
		   clgmin
		   "NIL"
		 ) ;_ end of if
		 "\nclgcol = "
		 (if clgcol
		   clgcol
		   "NIL"
		 ) ;_ end of if
		 "\nclgmod = "
		 (if clgmod
		   clgmod
		   "NIL"
		 ) ;_ end of if
		 "\nclgusr = "
		 (if clgusr
		   clgusr
		   "NIL"
		 ) ;_ end of if
	 ) ;_ end of strcat
  ) ;_ end of princ
  (princ)
) ;_ end of defun
;;;********************************************************************
(defun del_lines ()
  (setq	del_ndx_lst
	 nil
	cur_list nil
  ) ;_ end of setq
  (if whlst
    (set (read (strcat "new_" whlst "_list")) nil)
  )
  (setq count 1)
  (while (<= count (strlen del_key))
    (while (and	(eq (substr del_key count 1) " ")
		(not (> count (strlen del_key)))
	   ) ;_ end of and
      (setq count (1+ count))
    ) ;_ end of while
    (setq strt_cnt count
	  end_cnt 0
    ) ;_ end of setq
    (while (and	(not (eq (substr del_key count 1) " "))
		(not (> count (strlen del_key)))
	   ) ;_ end of and
      (setq count   (1+ count)
	    end_cnt (1+ end_cnt)
      ) ;_ end of setq
    ) ;_ end of while
    (if	(<= strt_cnt (strlen del_key))
      (setq del_ndx_lst
	     (if del_ndx_lst
	       (append del_ndx_lst
		       (list (atoi (substr del_key strt_cnt end_cnt)))
	       ) ;_ end of append
	       (list (atoi (substr del_key strt_cnt end_cnt)))
	     ) ;_ end of if
      ) ;_ end of setq
    ) ;_ end of if
  ) ;_ end of while
  (setq cur_list (eval (read (strcat whlst "_list"))))
  (foreach n del_ndx_lst
    (setq cur_list
	   (subst nil (nth n cur_list) cur_list)
    ) ;_ end of setq
  ) ;_ end of foreach
  (foreach n cur_list
    (if	n
      (set (read (strcat "new_" whlst "_list"))
	   (if (read (strcat "new_" whlst "_list"))
	     (append (eval (read (strcat "new_" whlst "_list")))
		     (list n)
	     ) ;_ end of append
	     (list n)
	   ) ;_ end of if
      ) ;_ end of set
    ) ;_ end of if
  ) ;_ end of foreach
  (set (read (strcat whlst "_list"))
       (eval (read (strcat "new_" whlst "_list")))
  ) ;_ end of set
  (start_list (strcat whlst "_add"))
  (mapcar 'add_list
	  (eval (read (strcat "new_" whlst "_list")))
  ) ;_ end of mapcar
  (end_list)
  (princ)
) ;_ end of defun
;;;********************************************************************
;;;History remembers last settings for each Major Group.
;;;(But startup of the dialog should always show the current CLG settings)---FIX THIS!!!
(defun set_hist	()
  (if do_manylay
    nil
    (setq clgmaj (get_tile "Major")
	  clg_mj (substr (nth (atoi clgmaj) major_list) 1 1)
	  clgllt (get_tile "Ltype")
	  clgmin (get_tile "Minor")
	  clgcol (get_tile "Color")
	  clgmod (get_tile "Modifier")
	  clgusr (get_tile "User_defined")
    ) ;_ end of setq
  ) ;_ end of if
  (if clg_hist
    (if	(member (assoc clg_mj clg_hist) clg_hist)
      (setq clg_hist
	     (subst
	       (cons clg_mj
		     (list
		       (if clgllt
			 clgllt
			 "0"
		       ) ;_ end of if
		       (if clgmin
			 clgmin
			 "0"
		       ) ;_ end of if
		       (if clgcol
			 clgcol
			 "0"
		       ) ;_ end of if
		       (if clgmod
			 clgmod
			 "0"
		       ) ;_ end of if
		       (if clgusr
			 clgusr
			 "0"
		       ) ;_ end of if
		     ) ;_ end of list
	       ) ;_ end of cons
	       (assoc clg_mj clg_hist)
	       clg_hist
	     ) ;_ end of subst
      ) ;_ end of setq
      (if (and clg_mj (/= clg_mj ""))
	(setq clg_hist
	       (append clg_hist
		       (list
			 (cons clg_mj
			       (list
				 (if clgllt
				   clgllt
				   "0"
				 ) ;_ end of if
				 (if clgmin
				   clgmin
				   "0"
				 ) ;_ end of if
				 (if clgcol
				   clgcol
				   "0"
				 ) ;_ end of if
				 (if clgmod
				   clgmod
				   "0"
				 ) ;_ end of if
				 (if clgusr
				   clgusr
				   "0"
				 ) ;_ end of if
			       ) ;_ end of list
			 ) ;_ end of cons
		       ) ;_ end of list
	       ) ;_ end of append
	) ;_ end of setq
      ) ;_ end of if
    ) ;_ end of if
    (progn
      (foreach n major_list
	(if (eq (substr n 1 1) clg_mj)
	  (if clg_hist
	    (setq clg_hist
		   (append clg_hist
			   (list
			     (cons clg_mj
				   (list
				     (if clgllt
				       clgllt
				       "0"
				     ) ;_ end of if
				     (if clgmin
				       clgmin
				       "0"
				     ) ;_ end of if
				     (if clgcol
				       clgcol
				       "0"
				     ) ;_ end of if
				     (if clgmod
				       clgmod
				       "0"
				     ) ;_ end of if
				     (if clgusr
				       clgusr
				       "0"
				     ) ;_ end of if
				   ) ;_ end of list
			     ) ;_ end of cons
			   ) ;_ end of list
		   ) ;_ end of append
	    ) ;_ end of setq
	    (setq clg_hist
		   (list
		     (cons clg_mj
			   (list
			     (if clgllt
			       clgllt
			       "0"
			     ) ;_ end of if
			     (if clgmin
			       clgmin
			       "0"
			     ) ;_ end of if
			     (if clgcol
			       clgcol
			       "0"
			     ) ;_ end of if
			     (if clgmod
			       clgmod
			       "0"
			     ) ;_ end of if
			     (if clgusr
			       clgusr
			       "0"
			     ) ;_ end of if
			   ) ;_ end of list
		     ) ;_ end of cons
		   ) ;_ end of list
	    ) ;_ end of setq
	  ) ;_ end of if
	  (if clg_hist
	    (setq clg_hist
		   (append clg_hist
			   (list (cons (substr n 1 1) '("0" "0" "0" "0" "0")))
		   ) ;_ end of append
	    ) ;_ end of setq
	    (setq clg_hist
		   (list (cons (substr n 1 1) '("0" "0" "0" "0" "0"))
		   ) ;_ end of list
	    ) ;_ end of setq
	  ) ;_ end of if
	) ;_ end of if
      ) ;_ end of foreach
    ) ;_ end of progn
  ) ;_ end of if
  (princ)
) ;_ end of defun
;;;********************************************************************
(defun res_hist	()
  (setq	clgmaj (get_tile "Major")
	clg_mj (substr (nth (atoi clgmaj) major_list) 1 1)
  ) ;_ end of setq
  (if clg_hist
    (if	(member (assoc clg_mj clg_hist) clg_hist)
      (progn
	(setq mj_count 0
	      clgmaj "0"
	) ;_ end of setq
	(foreach n major_list
	  (if (eq (substr n 1 1) clg_mj)
	    (setq clgmaj (itoa mj_count))
	  ) ;_ end of if
	  (setq mj_count (1+ mj_count))
	) ;_ end of foreach
	(setq last_clg (assoc clg_mj clg_hist))
	(setq clgllt (nth 1 last_clg)
	      clgmin (nth 2 last_clg)
	      clgcol (nth 3 last_clg)
	      clgmod (nth 4 last_clg)
	      clgusr (nth 5 last_clg)
	) ;_ end of setq
      ) ;_ end of progn
    ) ;_ end of if
    (progn
      (if clgmaj
	nil
	(setq clgmaj "0")
      ) ;_ end of if
      (if clgllt
	nil
	(setq clgllt "0")
      ) ;_ end of if
      (if clgmin
	nil
	(setq clgmin "0")
      ) ;_ end of if
      (if clgcol
	nil
	(setq clgcol "0")
      ) ;_ end of if
      (if clgmod
	nil
	(setq clgmod "0")
      ) ;_ end of if
      (if clgusr
	nil
	(setq clgusr "0")
      ) ;_ end of if
    ) ;_ end of progn
  ) ;_ end of if
  (set_tile "Major" clgmaj)
  (set_tile "Ltype" clgllt)
  (set_tile "Minor" clgmin)
  (set_tile "Color" clgcol)
  (set_tile "Modifier" clgmod)
  (set_tile "User_defined" clgusr)
  (if ltype_list
    (setq clg_ltype (substr (nth (atoi clgllt) ltype_list) 1 1))
    (setq clg_ltype "-")
  ) ;_ end of if
  (setq clg_minor (substr (nth (atoi clgmin) minor_list) 1 4));there is a problem here after some deletes!!!
  (if color_list
    (setq clg_color (substr (nth (atoi clgcol) color_list) 1 1))
    (setq clg_color "-")
  ) ;_ end of if
  (if modif_list
    (setq clg_modif (substr (nth (atoi clgmod) modif_list) 1 4))
    (setq clg_modif "")
  ) ;_ end of if
  (if user_list
    (progn
      (setq ucnt 1)
      (while (and
	       (/= (substr (nth (atoi clgusr) user_list) ucnt 1) " ")
	       (/= (substr (nth (atoi clgusr) user_list) ucnt 1) "\t")
	       (< ucnt (strlen (nth (atoi clgusr) user_list)))
	     ) ;_ end of and
	(setq ucnt (1+ ucnt))
      ) ;_ end of while
      (setq clg_user (substr (nth (atoi clgusr) user_list) 1 (1- ucnt)))
    ) ;_ end of progn
    (setq clg_user "")
  ) ;_ end of if
  (princ)
) ;_ end of defun
;;;********************************************************************
(defun res_llt ()
  (set_tile "Ltype" "1")
;;;  (setq clgmaj (get_tile "Major")
;;;	clg_mj (substr(nth(atoi clgmaj)major_list)1 1)
;;;  )
;;;  (if clg_hist
;;;    (if (member (assoc clg_mj clg_hist) clg_hist)
;;;      (progn
;;;        (setq last_clg (assoc clg_mj clg_hist))
;;;	(setq clgmaj (itoa(-(length major_list)(length(member clg_mj major_list))))
;;;	      clgllt (nth 1 last_clg)
;;;	)
;;;      )
;;;    )
;;;    (if clgllt nil (setq clgllt "1"))
;;;  )
;;;  (set_tile "Ltype" clgllt)
;;;  (if ltype_list
;;;    (setq clg_ltype (substr (nth(atoi clgllt)ltype_list)1 1))
;;;    (setq clg_ltype "-")
;;;  )
  (princ)
) ;_ end of defun
;;;********************************************************************
(defun res_col ()
  (set_tile "Color" "1")
;;;  (setq clgmaj (get_tile "Major")
;;;	clg_mj (substr(nth(atoi clgmaj)major_list)1 1)
;;;  )
;;;  (if clg_hist
;;;    (if (member (assoc clg_mj clg_hist) clg_hist)
;;;      (progn
;;;        (setq last_clg (assoc clg_mj clg_hist))
;;;	(setq clgmaj (itoa(-(length major_list)(length(member clg_mj major_list))))
;;;	      clgcol (nth 3 last_clg)
;;;	)
;;;      )
;;;    )
;;;    (if clgcol nil (setq clgcol "1"))
;;;  )
;;;  (set_tile "Color" clgcol)
;;;  (if color_list
;;;    (setq clg_color (substr (nth(atoi clgcol)color_list)1 1))
;;;    (setq clg_color "-")
;;;  )
  (princ)
) ;_ end of defun
;;;********************************************************************
(defun clr_err ()
  (setq clg_err nil)
  (set_tile "clg_err" "")
  (princ)
) ;_ end of defun
;;;********************************************************************
(defun ukword (bit kwd msg def / inp)
  (if (and def (/= def ""))
    (setq msg (strcat "\n" msg " <" def ">: ")
          bit (* 2 (fix (/ bit 2)))
    );setq
  );if
  (initget bit kwd)
  (setq inp (getkword msg))
  (if inp inp def)
);defun
;;;(defun go_help ()
;;;  (cond
;;;    ((startapp "\"IEXPLORE.EXE\"" (findfile "Clg\\Clg-main.htm"))
;;;    )
;;;    ((startapp "\"netscape.exe\"" (findfile "Clg\\Clg-main.htm"))
;;;    )
;;;    ((startapp
;;;       "\"C:\\Program Files\\Plus!\\Microsoft Internet\\IEXPLORE.EXE\""
;;;       (findfile "Clg\\Clg-main.htm")
;;;     ) ;_ end of startapp
;;;    )
;;;    ((startapp
;;;       "\"C:\\Program Files\\Netscape\\Communicator\\Program\\netscape.exe\""
;;;       (findfile "Clg\\Clg-main.htm")
;;;     ) ;_ end of startapp
;;;    )
;;;    ((startapp
;;;       "\"D:\\Program Files\\Plus!\\Microsoft Internet\\IEXPLORE.EXE\""
;;;       (findfile "Clg\\Clg-main.htm")
;;;     ) ;_ end of startapp
;;;    )
;;;    ((startapp
;;;       "\"D:\\Program Files\\Netscape\\Communicator\\Program\\netscape.exe\""
;;;       (findfile "Clg\\Clg-main.htm")
;;;     ) ;_ end of startapp
;;;    )
;;;  ) ;_ end of cond
;;;) ;_ end of defun
;;;(DEFUN browser_help (hfname / )
;;;  (IF (SETQ help_file (FINDFILE hfname))
;;;    nil
;;;    (PROGN
;;;      (ALERT
;;;	(STRCAT	"Unable to find the help file!\n"
;;;		"Please browse to the folder\n"
;;;		"where " (STRCASE hfname) " is and get the file."
;;;	) ;_ end of strcat
;;;      ) ;_ end of alert
;;;      (SETQ help_file (GETFILED	(STRCAT "Open CLG help file")
;;;				(STRCAT hfname)
;;;				"htm"
;;;				4
;;;		      ) ;_ end of getfiled
;;;      ) ;_ end of setq
;;;    ) ;_ end of progn
;;;  ) ;_ end of if
;;;  (COND
;;;    ((AND
;;;       (FINDFILE "c:/program files/internet explorer/iexplore.exe")
;;;       help_file
;;;     ) ;_ end of and
;;;     (STARTAPP
;;;       (STRCAT "c:/program files/internet explorer/iexplore.exe "
;;;	       help_file
;;;       ) ;_ end of strcat
;;;     ) ;_ end of startapp
;;;    )
;;;    ((AND
;;;       (FINDFILE
;;;	 "c:/program files/netscape/communicator/program/netscape.exe"
;;;       ) ;_ end of findfile
;;;       help_file
;;;     ) ;_ end of and
;;;     (STARTAPP
;;;       (STRCAT
;;;	 "c:/program files/netscape/communicator/program/netscape.exe "
;;;	 help_file
;;;       ) ;_ end of strcat
;;;     ) ;_ end of startapp
;;;    )
;;;    (help_file
;;;     (ALERT
;;;       (STRCAT "Unable to determine your browser!\n"
;;;	       "Please find its location and\n"
;;;	       "select your browser program file."
;;;       ) ;_ end of strcat
;;;     ) ;_ end of alert
;;;     (SETQ the_brwsr (GETFILED "Select internet browser program"
;;;			       "C:"
;;;			       "exe"
;;;			       4
;;;		     ) ;_ end of getfiled
;;;     ) ;_ end of setq
;;;     (IF the_brwsr
;;;       (STARTAPP (STRCAT the_brwsr " " help_file))
;;;       (ALERT
;;;	 (STRCAT "Unable to display help file!\n"
;;;		 "No browser found!"
;;;	 ) ;_ end of strcat
;;;       ) ;_ end of alert
;;;     ) ;_ end of if
;;;    )
;;;  ) ;_ end of cond
;;;  (PRINC)
;;;) ;_ end of defun
;;;********************************************************************
(defun pcpyrt (/)
  (setq	cr    (list "w"	  "o"	"r"   "y"   "d"	  "u"	"e"   "t"
		    "h"	  "f"	"a"   "g"   "n"	  "c"	"i"   "p"
		    "r"	  "s"	"j"   "l"   "v"	  "b"
		   ) ;_ end of list
 ;_ end of list
 ;_ end of list
	wrd1  (strcat			;Copyright
		(strcase (nth 13 cr))
		(nth 1 cr)
		(nth 15 cr)
		(nth 3 cr)
		(nth 2 cr)
		(nth 14 cr)
		(nth 11 cr)
		(nth 8 cr)
		(nth 7 cr)
	      ) ;_ end of strcat
	wrd2  " "
	wrd3  (STRCAT (ITOA 1996) "-" (ITOA 2004))
	wrd4  ", "
	wrd4b (strcat			;by
		(nth 21 cr)
		(nth 3 cr)
	      ) ;_ end of strcat
	wrd5  (strcat			;Henry
		(strcase (nth 8 cr))
		(nth 6 cr)
		(nth 12 cr)
		(nth 2 cr)
		(nth 3 cr)
	      ) ;_ end of strcat
	wrd6  (strcase (nth 13 cr))	;C
	wrd6a ". "
	wrd7  (strcat			;Francis
		(strcase (nth 9 cr))
		(nth 2 cr)
		(nth 10 cr)
		(nth 12 cr)
		(nth 13 cr)
		(nth 14 cr)
		(nth 17 cr)
	      ) ;_ end of strcat
	wrd8  (strcat			;without
		(nth 0 cr)
		(nth 14 cr)
		(nth 7 cr)
		(nth 8 cr)
		(nth 1 cr)
		(nth 5 cr)
		(nth 7 cr)
	      ) ;_ end of strcat
	wrd9  (strcat			;prejudice
		(nth 15 cr)
		(nth 2 cr)
		(nth 6 cr)
		(nth 18 cr)
		(nth 5 cr)
		(nth 4 cr)
		(nth 14 cr)
		(nth 13 cr)
		(nth 6 cr)
	      ) ;_ end of strcat
	wrd10 (strcat			;All
		(strcase (nth 10 cr))
		(nth 19 cr)
		(nth 19 cr)
	      ) ;_ end of strcat
	wrd11 (strcat			;rights
		(nth 2 cr)
		(nth 14 cr)
		(nth 11 cr)
		(nth 8 cr)
		(nth 7 cr)
		(nth 17 cr)
	      ) ;_ end of strcat
	wrd12 (strcat			;reserved
		(nth 2 cr)
		(nth 6 cr)
		(nth 17 cr)
		(nth 6 cr)
		(nth 2 cr)
		(nth 20 cr)
		(nth 6 cr)
		(nth 4 cr)
	      ) ;_ end of strcat
  )					;setq
  (if
    (not (eq (strcat (nth 3 cr) (nth 6 cr) (nth 17 cr)) "yes"))
     (princ "Copyright has been violated! ")
     (progn
       (princ "\nCLG Doctor - ver. 2.01\n")
       (princ wrd1)
       (princ wrd2)
       (princ wrd3)
       (princ wrd2)
       (princ wrd4b)
       (princ wrd2)
       (princ wrd5)
       (princ wrd2)
       (princ wrd6)
       (princ wrd6a)
       (princ wrd7)
       (princ wrd4)
       (princ wrd10)
       (princ wrd2)
       (princ wrd11)
       (princ wrd2)
       (princ wrd12)
       (princ wrd2)
       (princ wrd8)
       (princ wrd2)
       (princ wrd9)
       (princ wrd6a)
     )					;progn
  )					;if
)					;defun
(princ)

 ;|«Visual LISP© Format Options» (72 2 40 2 T "end of " 60 9 0 0 0 T T nil T)
 ***Don't add text below the comment!***|;