;dBRIEF Generate  - v3.10
;Copyright (c) 1991 - Global Technologies Corporation
;ALL RIGHTS RESERVED
#include "dbrief.h"
(macro stor
	(
		(if (_get_dialect_info dbr_dialect 6)
			(
				(string			scatter_file
				)
				(if (get_parm 0 scatter_file "Database file to store to memars: ")
					(_generate_fields scatter_file "S")
				)
			)
		;else
			(
				(_display_popup_message "STORE not supported in %s!" (_get_dialect_info dbr_dialect 1) 1)
				(return 0)
			)
		)
	)
)
(macro scat
	(
		(if (_get_dialect_info dbr_dialect 6)
			(
				(string			scatter_file
				)
				(if (get_parm 0 scatter_file "Database file to scatter: ")
					(_generate_fields scatter_file "=")
				)
			)
		;else
			(
				(_display_popup_message "SCATTER not supported in %s!" (_get_dialect_info dbr_dialect 1) 1)
				(return 0)
			)
		)
	)
)
(macro gath
	(
		(if (_get_dialect_info dbr_dialect 6)
			(
				(string			gather_file
				)
				(if (get_parm 0 gather_file "Database file to gather: ")
					(_generate_fields gather_file "R")
				)
			)
		;else
			(
				(_display_popup_message "GATHER not supported in %s!" (_get_dialect_info dbr_dialect 1) 1)
				(return 0)
			)
		)
	)
)
(macro init
	(
		(if (_get_dialect_info dbr_dialect 6)
			(
				(string		_dbf_file
				)
				(if (get_parm 0 _dbf_file "Database file name: ")
					(_generate_fields _dbf_file "I")
				)
			)
		;else
			(
				(_display_popup_message "INITIALIZE not supported in %s!" (_get_dialect_info dbr_dialect 1) 1)
				(return 0)
			)
		)
	)
)
(macro _create_routine_from_block
	(
		(int				function_column
							routine_line
							routine_col
							routine_start_line
							routine_start_col
							routine_end_line
							routine_end_col
							routine_orig_buffer
							routine_dest_buffer
		)
		(string			routine_name
							routine_prompt
							routine_return
							routine_mask
							routine_exec
							routine_comment
							header_file
							routine_temp_str
							routine_destination
							routine_suffix
		)
		(get_parm 0 routine_prompt)
		(get_parm 1 routine_return)
		(get_parm 2 header_file)
		(get_parm 3 routine_mask)
		(get_parm 4 routine_exec)
		(inq_names NULL NULL temp_str)
		(if (get_parm 5 routine_name (+ routine_prompt " name: "))
			(
				(if (! (get_parm 6 routine_comment "Comment: "))
					(return)
				)
				(if (! (get_parm 7 routine_destination "Destination file: " NULL temp_str))
					(return)
				)
				(inq_marked routine_start_line routine_start_col routine_end_line routine_end_col)
				(raise_anchor)
				(if (|| (== (upper temp_str) (upper (+ routine_name (+ "." (_get_dialect_info dbr_dialect 3))))) (search_fwd (+ (+ (+ "<" routine_mask) "*{ @}|{\\t@}") routine_name) 1 0))
					(
						(_display_popup_message (+ routine_prompt " %s already exists as a file or function!") (upper routine_name) 1)
						(move_abs routine_start_line routine_start_col)
						(mark 4)
						(move_abs (+ routine_end_line 1) 1)
					)
				;else
					(
						(move_abs routine_start_line routine_start_col)
						(drop_anchor)
						(move_abs routine_end_line routine_end_col)
						(cut)
						(save_position)
						(up)
						(end_of_line)
						(insert "\n")
						(inq_position routine_start_line routine_start_col)
						(if (== routine_prompt "Procedure")
							(_case_insert (+ (+ (_execute_command) (+ routine_exec " ")) routine_name) 0 0)
						;else
							(_case_insert (+ routine_name "()") 0 0)
						)
						(if (!= (upper routine_destination) (upper temp_str))
							(
								(= routine_orig_buffer (inq_buffer))
								(edit_file routine_destination)
								(= routine_dest_buffer (inq_buffer))
							)
						)
						(end_of_buffer)
						(insert "\n\n")
						(save_position)
						(inq_position routine_line NULL)
						(if (& (inq_kbd_flags) 0x40)
							(_procedure_header (upper routine_prompt) routine_return header_file)
						;else
							(_procedure_header (lower routine_prompt) routine_return header_file)
						)
						(if (== dbr_dialect 9)
							(_case_insert (+ " " (+ routine_name "()\n")) 0 0)
						;else
							(_case_insert (+ " " (+ routine_name "\n")) 0 0)
						)
						(paste)
						(delete_line)
						(delete_line)
						(if (strlen ProcSuffix)
							(
								(end_of_line)
								(sprintf routine_suffix ProcSuffix routine_name routine_name)
								(insert routine_suffix)
								(up)
								(up)
							)
						)
						(up)
						(beginning_of_line)
						(search_fwd "<*\\c[~ \\t\\n]")
						(inq_position NULL function_column)
						(search_back (+ "<" routine_mask) 1 0)
						(beginning_of_line)
						(drop_anchor)
						(search_fwd (+ "<" routine_return) 1 0)
						(down)
						(rein 0)
						(restore_position)
						(if (!= (upper routine_destination) (upper temp_str))
							(
								(write_buffer)
								(set_buffer routine_orig_buffer)
								(attach_buffer routine_orig_buffer)
								(if (!= routine_orig_buffer routine_dest_buffer)
									(delete_buffer routine_dest_buffer)
								)
							)
						;else
							(if (== dbr_dialect 9)
								(
									(drop_anchor 3)
									(end_of_buffer)
									(cut)
								)
							)
						)
						(restore_position)
						(= routine_temp_str (read))
						(beginning_of_line)
						(delete_to_eol)
						(move_abs 0 function_column)
						(insert routine_temp_str)
						(delete_line)
						(up)
						(end_of_line)
						(if (== routine_prompt "Procedure")
							(move_rel 0 1)
						;else
							(move_rel 0 -1)
						)
						(if (strlen routine_comment)
							(_write_comment routine_comment)
						)
				  		(move_abs routine_start_line routine_col)
						(if (&& (== dbr_dialect 9)(== (upper routine_destination) (upper temp_str)))
							(
								(top_of_buffer)
								(paste)
								(move_rel (- routine_start_line 1) 0)
								(= routine_line 1)
							)
						)
						(sprintf routine_temp_str "%s %s created at line %d in %s." routine_prompt (upper routine_name) routine_line routine_destination)
						(_display_popup_message routine_temp_str "" 0)
					)
				)
			)
		)
	)
)
(macro _write_comment
	(
		(string			comment_string
							comment_read
		)
		(get_parm 0 comment_string)
		(save_position)
		(beginning_of_line)
		(= comment_read (read))
		(if (|| (== comment_read " ")(== comment_read "\n"))
			(
				(delete_to_eol)
				(insert (+ (_comment_character 2) (+ " " comment_string)))
			)
		;else
			(
				(if (|| (== dbr_comment_tab 0)(> (strlen comment_read) dbr_comment_tab))
					(
						(end_of_line)
						(right)
						(right)
					)
				;else
					(move_abs 0 dbr_comment_tab)
				)
				(delete_to_eol)
				(insert (+ (+ (_comment_character 1) " ") comment_string))
			)
		)
		(restore_position)
	)
)
(macro _substitute_window_coordinates
	(
		(int				beg_line
							beg_col
							end_line
							end_col
							top_line
							current_line
							current_column
		)
		(string			coordinate_string
		)
		(if (== (inq_marked) 2)
			(
				(drop_bookmark 5 "y")
				(top_of_window)
				(inq_position top_line NULL)
				(goto_bookmark 5)
				(inq_marked beg_line beg_col end_line end_col)
				(-= beg_line top_line)
				(-= end_line top_line)
				(-- beg_col)
				(-- end_col)
				(raise_anchor)
				(top_of_buffer)
				(if (search_fwd "^UX,^UY*^LX,^LY" 1 0)
					(
						(inq_position current_line current_column)
						(sprintf coordinate_string "%02d" beg_line)
						(translate "^ux" coordinate_string 1 0 0)
						(sprintf coordinate_string "%02d" beg_col)
						(translate "^uy" coordinate_string 1 0 0)
						(sprintf coordinate_string "%02d" end_line)
						(translate "^lx" coordinate_string 1 0 0)
						(sprintf coordinate_string "%02d" end_col)
						(translate "^ly" coordinate_string 1 0 0)
						(move_abs current_line current_column)
					)
				;else
					(_display_popup_message "Window coordinates not found!" "" 1)
				)
			)
		;else
			(_display_popup_message "No column mark present!" "" 1)
		)
	)
)
(macro _reverse_window_coordinates
	(
		(int  			top_line
							current_line
							current_column
							beg_line
							beg_col
							end_line
							end_col
							coord_position
		)
		(string			coordinate_string
		)
		(save_position)
		(beginning_of_line)
		(= coordinate_string (read))
		(restore_position)
		(if (search_string "{ CLEA TO }|{ CLEAR TO }|{ FILL TO }|{ TO }|{[0-9][0-9],[0-9][0-9],[0-9][0-9],[0-9][0-9]}" (upper coordinate_string) NULL 1)
			(
				(beginning_of_line)
				(drop_anchor)
				(end_of_line)
				(if (index (upper coordinate_string) " CLEAR TO ")
					(
						(= coordinate_string (ltrim (trim (substr coordinate_string (- (index (upper coordinate_string) " CLEAR TO ") 5) 20))))
						(translate coordinate_string "^ux,^uy clear to ^lx,^ly" 0 0 0 1)
						(= coord_position 16)
					)
				;else
					(if (index (upper coordinate_string) " CLEA TO ")
						(
							(= coordinate_string (ltrim (trim (substr coordinate_string (- (index (upper coordinate_string) " CLEA TO ") 5) 19))))
							(translate coordinate_string "^ux,^uy clea to ^lx,^ly" 0 0 0 1)
							(= coord_position 15)
						)
					;else
						(if (index (upper coordinate_string) " FILL TO ")
							(
								(= coordinate_string (ltrim (trim (substr coordinate_string (- (index (upper coordinate_string) " FILL TO ") 5) 19))))
								(translate coordinate_string "^ux,^uy fill to ^lx,^ly" 0 0 0 1)
								(= coord_position 15)
							)
						;else
							(if (index (upper coordinate_string) " TO ")
								(
									(= coordinate_string (ltrim (trim (substr coordinate_string (- (index (upper coordinate_string) " TO ") 5) 14))))
									(translate coordinate_string "^ux,^uy to ^lx,^ly" 0 0 0 1)
									(= coord_position 10)
								)
							;else
								(if (search_string "{[0-9][0-9],[0-9][0-9],[0-9][0-9],[0-9][0-9]}" coordinate_string NULL 1)
									(
										(= coord_position (search_string "{[0-9][0-9],[0-9][0-9],[0-9][0-9],[0-9][0-9]}" coordinate_string NULL 1))
										(= coordinate_string (ltrim (trim (substr coordinate_string coord_position 11))))
										(translate coordinate_string "^ux,^uy,^lx,^ly" 0 0 0 1)
										(= coord_position 7)
									)
								)
							)
						)
					)
				)
				(raise_anchor)
				(= beg_line (atoi (substr coordinate_string 1 2) 1))
				(= beg_col (atoi (substr coordinate_string 4 2) 1))
				(= end_line (atoi (substr coordinate_string coord_position 2) 1))
				(= end_col (atoi (substr coordinate_string (+ coord_position 3) 2) 1))
				(drop_bookmark 5 "y")
				(top_of_window)
				(inq_position top_line NULL)
				(goto_bookmark 5)
				(+= beg_line top_line)
				(+= end_line top_line)
				(++ beg_col)
				(++ end_col)
				(move_abs beg_line beg_col)
				(drop_anchor 2)
				(move_abs end_line end_col)
				(return 1)
			)
		;else
			(return 0)
		)
	)
)
(macro coor
	(
		(switch dbr_dialect
			1  NULL
			2  NULL
			6  NULL
			7  NULL
			11 NULL
			13 NULL
			12
				(_case_insert "^UX,^UY,^LX,^LY" 0 0)
			3  NULL
			4  NULL
			5  NULL
			8  NULL
			9  NULL
			10
				(_case_insert "^UX,^UY TO ^LX,^LY" 0 0)
		)
	)
)
