/* ced grep an expanded filestack macro :
 * (p) Eniac 4/91
 * 
 * get a filelist
 * choose files to edit
 * leave them and save their contents and the cursor position
 *       load their environment, if specified
 *       i.e. execute commands for that file
 * execute commands on chosen files
 */

/* test the search options ! */
/* ced laedt mit OPEN auch wenn ein lf am namen haengt */



parse arg command arguments
address 'rexx_ced'
options results

startup:

call getenvironment

SELECT

	WHEN command = 'RESULT'  then EXIT
	WHEN command = 'SETUP'   then CALL xsetup
	WHEN command = 'XFIND'   then CALL xfinditem
	WHEN command = 'XLAST'   then CALL xlastitem
	WHEN command = 'XFIRST'  then CALL xfirstitem
	WHEN command = 'XPREV'   then CALL xprevitem
	WHEN command = 'XNEXT'   then CALL xnextitem
	WHEN command = 'FFILE'   then CALL myffile
	WHEN command = 'FILE'    then CALL myfile
	WHEN command = 'OPEN'    then CALL myopen

	WHEN command = 'CLEAR'   then CALL myclear
	WHEN command = 'LIST'    then CALL myinclude
	WHEN command = 'SHOW'    then CALL showmylist
	WHEN command = 'DELETE'  then CALL mydelete
	WHEN command = 'NAME'    then CALL myrename
	WHEN command = 'COPY'    then CALL mycopy
	WHEN command = 'UPDT'    then CALL mysave

	WHEN command = 'CMD'     then CALL mycmd
        WHEN command = 'CEDCMD'  then CALL mycedcmd
	WHEN command = 'SAVE'    then CALL myfilesave
	WHEN command = 'BACK'    then CALL myback
	WHEN command = 'QUIT'    then CALL myquit
	WHEN command = 'POS'     then CALL mypos
	WHEN command = 'MARK'    then CALL mymark
        WHEN command = 'BOTTOM'  then CALL setclip 'CEDGREPBOTTOM', command

	WHEN command = 'FIND'    then CALL finditem
	WHEN command = 'LAST'    then CALL lastitem
	WHEN command = 'FIRST'   then CALL firstitem
	WHEN command = 'PREV'    then CALL previtem
	WHEN command = 'NEXT'    then CALL nextitem

        WHEN command = 'SEARCH'  then CALL mysearch

	WHEN command = 'EGREP'   then DO ; call 'ced/egrep' arguments ; arguments = '' ; END
	WHEN command = 'INTER'   then DO ; call setenvironment ; getstring '*' 'My_Arguments_for_GREP' ; arguments = strip(result,'B','*') ; END
	OTHERWISE okay1 'INVALID COMMAND 'command
END
IF strip(arguments) ~= '' then			/* parse the next command */
DO
	call setenvironment
	parse var arguments command arguments
	signal startup
END
call setenvironment
exit 0

/* ---------------------  subroutines ----------------------------*/

getenvironment: 			/* get the current stats */
	grepmode   = getclip('CEDGREPMode')
        nline      = getclip('CEDGREPSEARCHL')
	ListName   = getclip('CEDGREPList')
	if nline   = '' then do ; call setclip 'CEDGREPSEARCHL', 1 ; nline=1 ; end
	if ListName= '' then ListName = 'CEDGREPList'
	if grepmode= '' then grepmode = 'FILE AUTOQUIT UNCHANGED'
			/* X<command> -> for Fileview, do not quit active view, not even if its unchanged */
	upper command
	upper arguments
	tempfile   = 't:'||ListName
	status 18
	changes     = result
	status 55
	currentline = result
	status 46
	cursorx     = result + 1
	status 47
	cursory     = result + 1
	status 19
	filename    = result
	status 20
	filepath    = result
	status 21
	windowname  = result
RETURN

setenvironment:				/* set the current stats */
	call setclip 'CEDGREPList', ListName
	call setclip 'CEDGREPMode', GrepMode
RETURN

mypos:					/* save the current pos */					
	call setclip 'CEDGREPOldWindow',windowname
	call setclip 'CEDGREPOldFile',filename
	call setclip 'CEDGREPCursorX',cursorx
	call setclip 'CEDGREPCursorY',cursory
RETURN

myposrestore:				/* jump back to the var pos */
	jump to file windowname
	if result = 0 then 
	DO
		open new
		open filename
	END
	jumpto cursory cursorx
RETURN

myshrink:
	if datatype(viewlines)='CHAR' then RETURN
	if viewlines < 2 then RETURN
	DO viewlines - 1
		shrink view
	END
RETURN

mygrow:
	if datatype(viewlines)~='NUM' then RETURN
	DO abs(viewlines%2 -1)+0	
		grow view
	END
RETURN

showmylist:				/* show the current GREP - list */
	jump to file ListName
	if result = 0 then open new
	else 
	DO
		status 18	/* number of changes ? */
		if result ~= 0 then /* there is a ced bug not liking to open new within a macro ? */
			open new                
	END
	open tempfile
	call mypos			/* save my position */
	status 51
	viewlines = result
RETURN

myshow:
	jump to file ListName
	if result = 0 then 
	DO
		open new
		open tempfile
	END
	call mypos			/* save my position */
	status 51
	viewlines = result
RETURN

/* ------------------------------------------------------------ */

xsetup:					/* setup the file/search flags */
	okay2 'FileView or Grep Expressions'
	if result = 1 then grepmode='FILE '||delword(grepmode,1)
	else do
		grepmode='EXPR '||delword(grepmode,1)
		okay2 'Clear GrepExpressions ?'
		if result = 1 then
		do
			call setclip 'CEDGREPSEARCH' ,'FORWARD'
			call setclip 'CEDGREPSEARCHF','ALL'
			call setclip 'CEDGREPLASTSEARCH',0
			call setclip 'CEDGREPSEARCHL',1
		end
	end

	/* Autofile : tries to quit active file, if a new file is loaded by the given command */

	okay2 'Do you want AutoFile ?'
	if result = 1 then grepmode=word(grepmode,1)||' AUTOQUIT '||delword(grepmode,1,2)
	else grepmode=word(grepmode,1)||' NOAUTOQUIT '||delword(grepmode,1,2)
	if word(grepmode,2)='AUTOQUIT' then do
		okay2 'AutoFile all files or Quit unchanged files'
		if result = 1 then grepmode=subword(grepmode,1,2)||' ALL '||delword(grepmode,1,3)
		else grepmode=subword(grepmode,1,2)||' UNCHANGED '||delword(grepmode,1,3)
	end 
return

xfinditem:	/* open file by name /search */
	if word(grepmode,1)='FILE' then call finditem
	else do ; arguments=' # ACTIVE # '||arguments ; call mysearch ; end
return

xlastitem:	/* open last file/repeat search backward */
	if word(grepmode,1)='FILE' then call lastitem
	else do ; arguments=' # REVERSE REPEAT ALL LAST # '||arguments ; call mysearch ; end
return

xfirstitem:	/* open last file/repeat search backward */
	if word(grepmode,1)='FILE' then call firstitem
	else do ; arguments=' # FORWARD REPEAT ALL FIRST # '||arguments ; call mysearch ; end
return

xprevitem:	/* open last file/repeat search backward */
	if word(grepmode,1)='FILE' then call previtem
	else do ; arguments=' # REVERSE REPEAT # '||arguments ; call mysearch ; end
return

xnextitem:	/* open last file/repeat search backward */
	if word(grepmode,1)='FILE' then call nextitem
	else do ; arguments=' # FORWARD REPEAT # '||arguments ; call mysearch ; end
return

myclear:				/* erase old list */
	delete(tempfile)
RETURN

myinclude:				/* include a few new files into the list: */
	call mysave
					/* the pattern is ' # part # ' of the command */
					/* line, from the arp requester, or from a */
					/* line of the filelistwindow  '... ;dir # dir dir #' */
	parse var arguments arg1 ' # ' directory ' # ' arg2
					/* this should allow #? patterns */
	if (directory ~= '') & (strip(arg1) = '') then arguments = arg2 
	else if windowname = ListName then parse var currentline . ' ;dir' . '#' directory '#' .
	call myincludesub
	call showmylist 
RETURN	

myincludesub:
	err = 0
	if directory = '' then
	DO
		screentofront()
		status 75      		/* the current dir */
		searchpath = strip(result,'B','/') 
		directory = strip(getfile(10,10,searchpath,,"Select Directory"),'B','/')
		if directory ~= '' then address command 'ls >>'tempfile' -PHIFf "%50n  ;len %8s \n" 'Directory  
		cedtofront
	END
	else
	DO
		if open(tempfilehandle,tempfile,'A') = 0 then 
			if open(tempfilehandle,tempfile,'W') = 0 then RETURN
		DO while Directory ~=''
			parse var directory nnew directory
			num = filelist(nnew, newfiles, 'F', 'E')
			DO i = 1 to newfiles.0
				writeln(tempfilehandle,newfiles.i)
			END
		END	
		call close tempfilehandle
	END
RETURN 

mycedcmd:				/* execute a ced cmd on the active view */
	parse var arguments arg1 '#' mycommand '#' arg2
	if (mycommand ~= '') & (strip(arg1) = '') then 
	DO
		arguments = arg2 
                mycommand = strip(mycommand)
		okay1 mycommand
		mycommand
	END
RETURN

mysearch:				/* look up tag procedure - uses myword */
					/* 1. on the commandline : args 'cmd' # command1 ` command2 `... # args */
	parse var arguments arg1 '#' mycommand '#' arg2
	target = ''
	thisfile = 0
	nfsflag=0			/* i loaded this file - so i can kill it */
	if (mycommand ~= '') & (strip(arg1) = '') then 
	DO
		arguments = arg2 
		DO forever
			parse var mycommand xsearch mycommand
			xsearch = strip(xsearch)
			if xsearch = '' then leave
			upper xsearch
			SELECT	
				WHEN xsearch = 'REPEAT'   then target = getclip('CEDGREPSearchString')
				WHEN xsearch = 'REVERSE'  then call setclip 'CEDGREPSEARCH' ,xsearch
				WHEN xsearch = 'FORWARD'  then call setclip 'CEDGREPSEARCH' ,xsearch 
				WHEN xsearch = 'ACTIVE'   then thisfile = 1
				WHEN xsearch = 'ALL'      then do;thisfile = 0;call setclip 'CEDGREPSEARCHF',xsearch; call setclip 'CEDGREPLASTSEARCH', 0;end
				WHEN xsearch = 'THISFILE' then thisfile = 1         /* current filelist file */
				WHEN xsearch = 'FIRST'    then do;call setclip 'CEDGREPSEARCHL',1; call setclip 'CEDGREPLASTSEARCH', 0;end
				WHEN xsearch = 'LAST'     then do;call setclip 'CEDGREPSEARCHL',-1; call setclip 'CEDGREPLASTSEARCH', 0;end
				WHEN xsearch = 'PREV'     then do;call setclip 'CEDGREPSEARCHL',abs(getclip('CEDGREPSEARCHL')-1)+0; call setclip 'CEDGREPLASTSEARCH', 0;end
				WHEN xsearch = 'NEXT'     then do;call setclip 'CEDGREPSEARCHL',getclip('CEDGREPSEARCHL')+1; call setclip 'CEDGREPLASTSEARCH', 0;end
			OTHERWISE okay1 'INVALID KEY FOR SEARCH'
			END
		END
	END
	status 21
	if (thisfile = 1) then
	DO 
		if (result = ListName) then
		DO		/* this file from the list view */
			status 47 /* currentline */
			nline = result +1
			call setclip 'CEDGREPSEARCHL', nline 
			call setclip 'CEDGREPSEARCHF','ALL'
			call setclip 'CEDGREPLASTSEARCH', 0
			target = getclip('CEDGREPSearchString')	/* use the last target ! */
		END				
		else
		DO		/* active instead of all */
			call setclip 'CEDGREPSEARCHF','ACTIVE'
			call setclip 'CEDGREPLASTSEARCH', 0
		END
	END
	if target ='' then call myword
	call setclip 'CEDGREPSearchString', target 
	searchmode = getclip('CEDGREPSEARCH')
	searchfile = getclip('CEDGREPSEARCHF')
	lastsearch = getclip('CEDGREPLASTSEARCH')	
	searchline = getclip('CEDGREPSEARCHL')	

	if searchfile = 'ALL' then
	DO
		if searchmode = 'REVERSE' then call setclip 'CEDGREPBOTTOM', 'BOTTOM'
		if searchline ~= lastsearch then 
		DO
			call myshow 
			jumpto searchline 1 
			if searchline = -1 then 'END OF FILE'
			call mydisplaysearch 
		END
	END
	do while target~='' 
		nline = getclip('CEDGREPSEARCHL')
		if searchfile = 'ALL' then CALL setclip 'CEDGREPLASTSEARCH', nline    
		if searchmode = 'REVERSE' then 'search for' '"'target'"' 1 0 0 0
		else 'search for' '"'target'"' 1 0 1 0
		if result = 0 then
		do
			status 66
			w1=result
			status 18
			w2=result
			if (w1>1) then
			do 
				if (nfsflag=1) & (w2=0) then 'quit'
				else if word(grepmode,2)='AUTOQUIT' then
				do
					if w2=0 then 'QUIT'
					else if word(grepmode,3)='ALL' then 'menu 0 16 0'
				end
			end
			call nextfilesearch
			nfsflag=1
		end
		else leave
	END
RETURN

nextfilesearch:
	if thisfile=1 then 
	DO 
		target = ''
		RETURN
	END
	'lastkey' 					/* breakkey: escape */
	if word(result,1)='69' then target = ''
	CALL myshow
	nline = getclip('CEDGREPSEARCHL')
	CALL setclip 'CEDGREPLASTSEARCH', nline    
	if searchmode = 'REVERSE' then
	DO 
		CALL setclip 'CEDGREPBOTTOM', 'BOTTOM'
		nline = nline -1 
		if nline < 1 then
		DO 
			nline = 1
			target = ''
		END	
	END
	else 
	DO
		nline = nline + 1
		status 17
		lastline=result
		if nline > lastline then 
		DO
			nline = lastline
			target = ''
		END
	END
	jumpto nline 1 
	call setclip 'CEDGREPSEARCHL', nline
	call mydisplaysearch 
RETURN

mydisplaysearch:			/* display the file from the act. line */
	status 17
	lastline = result
        nline=getclip('CEDGREPSEARCHL')
	if nline > lastline then nline = lastline  
	if nline = 0 then nline = 1
	if nline = -1 then do ; nline = lastline ; jumpto nline 1 ; end
	call setclip 'CEDGREPSEARCHL', nline
	status 55
	curline = result
	filename = strip(word(curline,1),'B','0A'x)
	if strip(filename) = '' then 
	do
		'up 1'
        	status 55
		curline = result
		filename = word(curline,1)
	end
	parse var curline' ;pos 'curx cury .
/*	if (curx = '') | (cury = '') then 
 *	DO		
 */		curx = 1
		cury = 1
/*	END
 */	open new
	open filename
	nfsflag=1
	jumpto cury curx 			
        command = getclip('CEDGREPBOTTOM')
	if command = 'BOTTOM' then /* display the end of the file */
	DO
		command = 'NONSENSE'
		if curx*cury=1 then 'END OF FILE'
		CALL setclip 'CEDGREPBOTTOM' , command
        END
RETURN

mycmd:					/* execute a command on file within the filelist display */
					/* 1. on the commandline : args 'cmd' # command1 ` command2 `... # args */
					/* 2. online :   ''        args 'cmd' args  -> fires a requester */
					/* 3. on the line : as 2. -> filename ;dos # commands # ... is the current line */

	if windowname ~= ListName then RETURN
	parse var arguments arg1 '#' mycommand '#' arg2
	if (mycommand ~= '') & (strip(arg1) = '') then 
	DO
		arguments = arg2 
		call myexecute
	END
	else 
	DO
		parse var currentline . ' ;dos' . '#' mycommand '#' .
		if mycommand ~= '' then call myexecute
		else
		DO
			getstring 'type' 'which_command_?'
			mycommand = result		
			if mycommand ~= '' then call myexecute
		END
	END 
RETURN

finditem:				/* display a file by name */
	call automyfilesub
	jumpto 1 1
	parse var arguments arg1 '#' arg2 '#' arg3
	if (arg1 = '') & (arg2 ~='') then
	DO 
		arguments = arg3
		arg1 = arg2
	END
	else
	DO
		getstring '*' 'What_do_you_want_to_search?'
		arg1 = strip(result,'B','*') 
	END		
	search for arg1
	if result = 0 then okay1 'not found'
	else call mydisplay 
RETURN

myopen:					/* open this file */
	viewlines = 'test'
	call mydisplay
	expand view
RETURN

lastitem:				/* display the last file */
	call automyfilesub
	status 17
	nline = result /* + 1 */
	jumpto nline 1               /* debug */ 
	call mydisplay 
RETURN

firstitem:				/* display the first file */
	call automyfilesub
	jumpto 1 1
	call mydisplay 
RETURN

previtem:				/* display the prev file */
	xline = getclip('CEDGREPLine')
	if datatype(xline) = 'CHAR' then RETURN
	call automyfilesub 
	if xline <1 then xline = 2
	jumpto xline-1 1
	call mydisplay 
RETURN

nextitem:				/* display the next file */
	xline = getclip('CEDGREPLine') 
	if datatype(xline) = 'CHAR' then RETURN
	call automyfilesub 
	jumpto xline+1 1
	call mydisplay 
RETURN

mydisplay:				/* display the file from the act. line */
	flag = 0
	status 21
	if result = ListName then
	DO
		flag = 1
		status 47
		call setclip 'CEDGREPLine' , result + 1
	END
	status 55
	curline = result
	filename = strip(strip(word(curline,1),'B','0A'x))
	if filename = '' then RETURN
	parse var curline' ;pos 'curx cury .
	if (curx = '') | (cury = '') then 
	DO
		curx = 1
		cury = 1
	END

	open new
	open filename
	jumpto cury curx 			
	if flag then call mygrow
        command = getclip('CEDGREPBOTTOM')
	if command = 'BOTTOM' then /* display the end of the file */
	DO
		command = 'NONSENSE'
		if (curx=1) & (cury=1) then 'END OF FILE'
		CALL setclip 'CEDGREPBOTTOM' , command
        END
RETURN

mysave:					/* save the list file */
	jump to file ListName
	if result = 0 then RETURN
	save
	call myposrestore 
RETURN

myback:					/* go to the last position */
	oldfile = getclip('CEDGREPOldWindow')
	if oldfile = '' then RETURN
	windowname = oldfile
	filename= getclip('CEDGREPOldFile')
	cursorx = getclip('CEDGREPCursorX')
	cursory = getclip('CEDGREPCursorY')
	call myposrestore
RETURN

myquit:					/* close the list file */
	jump to file ListName
	if result = 0 then RETURN
	quit
	call myposrestore 
RETURN					

myfile:					/* save the active file and quit and include its pos in the list */
	save
	quit
	call myfilesub
RETURN

myfilesave:				/* save the active view ... */
	save
	call myfilesub
	call myposrestore 
RETURN

myffile:				/* save the file and erase the entry */
	save
	quit
	call myshow
	jumpto 1 1
	search for filename
	if result = 1 then 
		'delete line'
	save				/* optional */
RETURN

myfilesub:
	call myshow
	call myshrink
	jumpto 1 1
	search for filename
	if result = 1 then
	DO 
		status 55
		nline = result
		nline = left(nline,length(nline)-1)
		'delete line'
		parse var nline arg1' ;pos' . . arg2
		if arg2 = '' then arg2 = '0A'X
		nline = arg1' ;pos 'cursorx cursory arg2 
	END
	else
	DO
		nline = filename ' ;pos 'cursorx cursory '0A'X			
	END		
	text nline	
	'up 1'
	'save'
RETURN

automyfilesub:					/* autoquit active file */
	/* !!! to be called from the view of the last getenvironment !!! */
	w=0
	if word(grepmode,2)='AUTOQUIT' then
	do
		if changes=0 then do ; w = 1 ; 'QUIT' ; end	/* quit or save&quit */
		else if word(grepmode,3)='ALL' then do ; w = 1 ; 'menu 0 16 0' ; end
	end
	call myshow
	if w=1 then
	do
		jumpto 1 1
		search for filename
		if result = 1 then
		DO 
			status 55
			nline = result
			nline = left(nline,length(nline)-1)
			'delete line'
			parse var nline arg1' ;pos' . . arg2
			if arg2 = '' then arg2 = '0A'X
			nline = arg1' ;pos 'cursorx cursory arg2 
			'text 'nline	
			'up 1'
/* ? */			'save'
		END
	end
RETURN

mydelete:				/* delete the current line */
	if windowname ~= ListName then RETURN
	'delete line'
RETURN	

myrename:				/* change the name of the internal list */
	if arguments = '' then RETURN
	parse var arguments ListName arguments
	tempfile = 't:'||ListName
RETURN

mycopy:					/* copy the list and rename */
	if arguments = '' then RETURN
	call myshow
	call myshrink
	parse var arguments ListName arguments
	tempfile = 't:'||ListName
	'save as 'tempfile	
	call myposrestore	
RETURN

mymark:					/* as file but append line & 10 chars of contents */
	call myshow
	if datatype(viewlines)~='CHAR' then viewlines = viewlines - 1
	call myshrink
	'end of file'
	nline = filename ' ;pos 'cursorx cursory ' ;con 'currentline			
	if index(nline,'0A'x)=0 then nline = nline||'0A'x
	text nline	
	call myposrestore 
RETURN

myexecute:				/* a recursive command parser */
	mycommand = strip(mycommand)
	if mycommand = '' then RETURN 
	parse var mycommand cmd'`'mycommand
	DO while index(cmd,'%%')~=0
		parse var cmd cmd1'%%'cmd2
		cmd=cmd1||'"'||word(currentline,1)||'"'||cmd2
	END
	address command cmd
	call myexecute
RETURN

myword:						/* get the word under the cursor */
procedure expose target				/* adapted from Peter Cherna */
	tabchar = '09'X
	status 55
	line = result
	status 46
	cur = result + 1
	status 7
	tabline = result
	j = 0
	DO i = 1 to length(line)
		j = j + 1
		if i >= cur then leave
		if substr(line,i,1)~=tabchar then iterate
		cur = cur - index(tabline,'T',j) + j
		j = index(tabline,'T',j)
	END
	char = substr(line,cur,1)
	if (~(datatype(char,'A') | char = '_') & cur > 1) then
		cur = cur - 1
	right = cur - 1
	left = cur + 1
	char = 'A'
	DO while (datatype(char,'A') | char = '_') & (left > 0)
	 	left = left - 1
		if left > 0 then
			char = substr(line,left,1)
	END
	char = 'A'
	DO while (datatype(char,'A') | (char = '_'))
		right = right + 1
		char = substr(line,right,1)
	END
	if right-left <= 1 then
	DO
		getstring
		target = result
		if (target = 'RESULT') then
			exit
	END
	else target = substr(line,left+1,right-left-1)
RETURN