#pragma TextEncoding = "UTF-8"
#pragma rtGlobals=3
#pragma version=1.06
#pragma igorVersion=7
#pragma IndependentModule=UserProcLoader

// https://www.wavemetrics.com/user/tony

// provides an easy way to load and unload procedure files from the User 
// Procedures or Wavemetrics Procedures folders. See also Thomas Braun's 
// code to do the same thing at https://www.wavemetrics.com/node/8189 

// requires Igor Pro 8 for full functionality
// in Igor 7 it's possible to select procedures that cannot be unloaded

// trying to load a procedure that won't compile could lead to confusion.
// UserProcLoader won't be able to unload the file until compilation is completed.

menu "Macros"
	"Load or Unload...",/Q, makeProcLoaderPanel()
end

function makeProcLoaderPanel()
	dowindow /k LoaderPanel
	NewDataFolder /O root:Packages
	NewDataFolder /O root:Packages:procLoader
	DFREF dfr=root:Packages:procLoader
	
	// prepare waves for two listboxes			
	make /o /n=0 dfr:w_loadedSelection /WAVE=w_loadedSelection, dfr:w_unloadedSelection /WAVE=w_unloadedSelection
	make /o /n=0/T dfr:w_loadedProcs, 	dfr:w_unloadedProcs, dfr:w_loadedTitle, dfr:w_unloadedTitle
	wave /SDFR=dfr/T w_loadedProcs, w_unloadedProcs, w_loadedTitle, w_unloadedTitle
	w_loadedTitle={"loaded"}; w_unloadedTitle={"unloaded"}
				
	// create panel	
	NewPanel /K=1/N=LoaderPanel/W=(20,20,520,380) as "Load or Unload Procedures"
	ModifyPanel /W=LoaderPanel fixedSize=1, noedit=1
	
	// popup to select procedures folder on disk
	popupMenu popupFolder, win=LoaderPanel, pos={20, 10}, value="User Procedures;Wavemetrics Procedures", proc=loaderPopMenuProc
	
	// button to open Procedure Browser window (useful if you want to open procedure after loading)
	button buttonBrowser, win=LoaderPanel, pos={460, 15}, size={15,14}, picture=thumb, labelBack=0, title="", proc=loaderButtonProc, help={"Open Procedure Browser"}

	// listbox for procedure files in folder that are not currently loaded
	ListBox listboxUnloaded,win=LoaderPanel, pos={20, 40},size={200, 300}, listwave=w_unloadedProcs, selwave=w_unloadedSelection, mode=9
	ListBox listboxUnloaded,win=LoaderPanel, fsize=12, proc=loaderListBoxProc, titleWave=w_unloadedTitle
	
	// buttons to be enabled when a valid selection is made from a listbox
	button buttonLoad win=LoaderPanel, pos={230,120},size={40,40},title=">", proc=loaderButtonProc, disable=2
	button buttonUnload win=LoaderPanel, pos={230,170},size={40,40},title="<", proc=loaderButtonProc, disable=2
	
	// listbox for procedure files in folder that ARE currently loaded
	ListBox listboxLoaded,win=LoaderPanel, mode=9, selwave=w_loadedSelection, pos={280, 40},size={200, 300}, editstyle=1
	ListBox listboxLoaded,win=LoaderPanel, listwave=w_loadedProcs,fsize=12, proc=loaderListBoxProc, titleWave=w_loadedTitle
	
	// populate listbox waves
	updateListboxWaves()

	return 1
end

function loaderButtonProc(ba)
	STRUCT WMButtonAction &ba
	
	if(ba.eventCode!=2)
		return 0
	endif
	
	if(stringmatch(ba.ctrlName, "buttonBrowser"))
		doigorMenu "Windows", "Procedure Browser"
		return 0
	endif
	
	DFREF dfr=root:Packages:procLoader
	wave /SDFR=dfr w_loadedProcs, w_loadedSelection, w_unloadedProcs, w_unloadedSelection
	variable i
	string cmd
	
	if(stringmatch(ba.ctrlName, "buttonLoad"))
		wave w_sel=dfr:w_unloadedSelection
		wave /T w_list=dfr:w_unloadedProcs
		cmd="INSERTINCLUDE"
	else
		wave w_sel=dfr:w_loadedSelection
		wave /T w_list=dfr:w_loadedProcs
		cmd="DELETEINCLUDE"
	endif
	
	string startquote=selectString(SelectedFolder()-1, "\"", "<")
	string endquote=selectString(SelectedFolder()-1, "\"", ">")
	string strExct
	
	for(i=0;i<numpnts(w_sel);i+=1)
		if( (w_sel[i]&2^0) || (w_sel[i]&2^3) )
			sprintf strExct, "%s %s%s%s", cmd, startquote, w_list[i], endquote 			
			Execute/P/Q/Z strExct
		endif
	endfor
	Execute/P/Q/Z "COMPILEPROCEDURES "	
	Execute/P/Q/Z getindependentModuleName()+"#updateListboxWaves()"
	return 0	
end

function loaderListBoxProc(lba) : ListBoxControl
	STRUCT WMListboxAction &lba
	
	DFREF dfr=root:Packages:procLoader	
	
	if(datafolderRefStatus(dfr)==0)
		return 0
	endif
	
	if(lba.eventCode==-1) // clean up
		killDataFolder /Z dfr
		return 1
	endif
	
	if (lba.eventCode==4 && lba.eventMod&2^4) // right click in listbox cell
		if (stringmatch(lba.ctrlName, "listboxUnloaded"))
			return 0 // allow context menu for loaded files
		endif
		string procWinStr=lba.listWave[lba.row]+".ipf"
		wave /T w_normalProcs=ListToTextWave(winlist("*",";","WIN:128,INDEPENDENTMODULE:0"),";")
		if (isInTextWave(procWinStr,w_normalProcs)==0)
			// cell contains an independent module, user will have to find another way to open :)
			return 0 
		endif
		string popupStr="show "+ procWinStr
		PopupContextualMenu  popupStr
		if(V_flag)
			DisplayProcedure/W=$procWinStr
		endif
		return 0
	endif	
	
	wave /SDFR=dfr w_loadedSelection, w_unloadedSelection
	
	// are we selecting procedures to load or to unload?
	variable load=stringmatch(nameofwave(lba.selWave), "w_unloadedSelection")
	
	if(lba.eventCode==4 || lba.eventCode==5)
		if(load)
			w_loadedSelection=w_loadedSelection & ~1 
			w_loadedSelection=w_loadedSelection & ~8 // clear selection in other listbox
		else
			w_unloadedSelection=0
		endif
		// don't allow disabled cells to be selected
		// (can be done by shift-click or using arrow keys)
		lba.selWave = (lba.selWave&129)==129 ? lba.selWave & ~1 : lba.selWave
		lba.selWave = (lba.selWave&136)==136 ? lba.selWave & ~8 : lba.selWave
	endif
	
	// enable buttons based on selection	
	variable selections=0
	if (numpnts(w_unloadedSelection))
		selections=sum(w_unloadedSelection)
	endif
	button buttonLoad win=LoaderPanel, disable=2*(selections==0)
	// examine first bit of each point in w_loadedSelection
	if (numpnts(w_loadedSelection))
		duplicate /free w_loadedSelection w_testSel
		w_testSel=w_testSel&1	
		selections=sum(w_testSel)
	endif
	button buttonUnload win=LoaderPanel, disable=2*(selections==0)
	
	return 0
end

function loaderPopMenuProc(pa) : PopupMenuControl
	STRUCT WMPopupAction &pa

	if(pa.eventCode==2)
		print pa.popNum
		updateListboxWaves()
	endif
	return 0
end

// search recursively for ipf files
// returns list of files
function /T recursiveProcList()
		
	variable maxLevels=20 // quit after recursion through this many sublevels
	variable folderLimit=1000 // quit after looking in this many folders.
	Variable folderIndex, fileIndex, subfolderIndex, folderCount=1, sublevels=0
	string folderList, indexFileName
	string fileList=""
			
	make /free/T/n=0 w_folders, w_subfolders
	
	if (SelectedFolder()==1)
		w_folders={SpecialDirPath("Igor Pro User Files",0,0,0)} // search recursively starting in this folder
	elseif(SelectedFolder()==2)
		w_folders={SpecialDirPath("Igor Application",0,0,0)+"Wavemetrics Procedures:"} 
	else
		return ""
	endif

	do
		for(folderIndex=0;folderIndex<numpnts(w_folders);folderIndex+=1)
			// check files at current level
			newPath /O/Q/Z tempPathFF, w_folders[folderIndex]

			fileindex=0
			do	
				indexFileName=IndexedFile(tempPathFF, fileindex, "????")
				if(stringmatch(indexFileName, "*.ipf"))
					fileList=AddListItem(removeending(indexFileName, ".ipf"), fileList)
				endif
				fileindex+=1
			while(strlen(indexFileName))
			// make a list of subfolders in current folder
			folderList=IndexedDir(tempPathFF, -1, 0)
			for (subfolderIndex=0;subfolderIndex<itemsinList(folderList);subfolderIndex+=1)
				w_subfolders[numpnts(w_subfolders)]={w_folders[folderIndex]+stringfromlist(subfolderIndex,folderList)+":"}				
				folderCount+=1
			endfor			
		endfor
		duplicate /T/O/free w_subfolders, w_folders
		redimension /N=0 w_subfolders
		sublevels+=1
		
		if(numpnts(w_folders)==0)
			break
		endif
		
		if((maxlevels && sublevels>maxLevels) || (folderLimit && (folderCount-folderIndex)>folderLimit))
			break
		endif

	while(1)
	killpath /Z tempPathFF
	return fileList
end

// returns item selected in popup
// 1: User Procedures 2: Wavemetrics Procedures
function SelectedFolder()
	controlinfo /W=LoaderPanel  popupFolder
	if (V_flag<1)
		return 0
	endif
	return V_Value
end

// strip trailing stuff in the output from winlist
function /S filenameFromString(s)
	string s
	
	SplitString/E=".*\.ipf" s // remove module names
	return removeending(s_value, ".ipf")
end

// extract quoted filename from include statement
function /S filenameFromIncludeStatement(s)
	string s

	if (numtype(strlen(s))==2)
		return ""
	endif
	
	string startquote=selectString(SelectedFolder()-1, "\"", "<")
	string endquote=selectString(SelectedFolder()-1, "\"", ">")
	
	variable start, stop
	start=strsearch(s, startquote, 0)
	stop=strsearch(s, endquote, start+1)
	if (start==-1 || stop==-1)
		return ""
	endif
	return s[start+1,stop-1]
end

// truth that string s is a member of textwave w
function isInTextWave(s, w)
	string s
	wave /T w
	
	if(numtype(strlen(s))==2)
		return 0
	endif
	
	FindValue /TEXT=s/TXOP=4 /Z w		
	return (V_Value>-1)
end

// remove empty points from textwave w
function zapBlanks(w)
	wave /T w
	
	if(numpnts(w)==0)
		return 0
	endif
	variable i=0
	do
		if(stringmatch(w[i],""))
			deletepoints i,1,w
		else	
			i+=1
		endif
	while(i<numpnts(w))
	return 1
end

function updateListboxWaves()
	
	DFREF dfr=root:Packages:procLoader
	wave /SDFR=dfr w_loadedSelection, w_unloadedSelection
	
	// create a free text wave containing a list of procedure files in the selected source folder	
	wave /T w_unloadedProcs=ListToTextWave(RecursiveProcList(),";")
	// create a free text wave containing a list of all procedure files in the experiment
	wave /T w_loadedProcs=ListToTextWave(winlist("*",";","WIN:128,INDEPENDENTMODULE:1"),";")
	w_loadedProcs=FilenameFromString(w_loadedProcs) // some points may be blank
	
	// remove procedures that aren't in selected source folder from loaded list
	w_loadedProcs=selectstring(isInTextWave(w_loadedProcs, w_unloadedProcs),"",w_loadedProcs)
	// remove already loaded procedures from unloaded list
	w_unloadedProcs=selectstring(isInTextWave(w_unloadedProcs, w_loadedProcs),w_unloadedProcs,"")
	
	// figure out which procedures can be unloaded
	// using INCLUDE:2 with winlist gets all included files, not just those that we can DELETEINCLUDE
	// load procedure file lines into text wave
	wave /T w_includedProcs=ListToTextWave(ProcedureText("",0,"procedure"), "\r")
	// find lines that start with #include
	grep /E="^#include[\s]*[<\"]"/Z w_includedProcs as w_includedProcs
	zapBlanks(w_includedProcs)
	// extract file names from between quotes
	w_includedProcs=filenameFromIncludeStatement(w_includedProcs)
  	
  	zapBlanks(w_unloadedProcs)
  	zapBlanks(w_loadedProcs) 		
  	sort w_loadedProcs, w_loadedProcs
	sort w_unloadedProcs, w_unloadedProcs
	
	// copy free waves into the package folder
	duplicate /o/T w_unloadedProcs dfr:w_unloadedProcs /wave=w_unloadedProcs
	duplicate /o/T w_loadedProcs dfr:w_loadedProcs /wave=w_loadedProcs
	
	redimension /N=(numpnts(w_loadedProcs)) w_loadedSelection
	redimension /N=(numpnts(w_unloadedProcs)) w_unloadedSelection
	
	// disable cells containing procedures that cannot be unloaded using DELETEINCLUDE	
	w_loadedSelection=(1-isInTextWave(w_loadedProcs, w_includedProcs))*2^7
	w_unloadedSelection=0	
	
	// nothing is selected, so disable load and unload buttons
	button /Z buttonLoad win=LoaderPanel, disable=2
	button /Z buttonUnload win=LoaderPanel, disable=2
	return 1
end

// I used a screenshot to steal the procedure browser button from the control bar!
// make non-uniform grey background at edge of button transparent:
// •thumb[28,][][3] = (thumb[p][q][0]==thumb[p][q][1] && thumb[p][q][0]==thumb[p][q][2]) ? 0 : thumb[p][q][r]
// •thumb[][24,][3] = (thumb[p][q][0]==thumb[p][q][1] && thumb[p][q][0]==thumb[p][q][2]) ? 0 : thumb[p][q][r]
// create stacked images for button:
// •redimension /N=(90,-1,-1) thumb 
// •thumb[30,59][][]=thumb[mod(p,30)][q][r]
// then use Pictures dialog (misc - pictures) to create proc picture

// PNG: width= 90, height= 28
Picture thumb
	ASCII85Begin
	M,6r;%14!\!!!!.8Ou6I!!!"&!!!!=#R18/!9'oUErZ1?&TgHDFAm*iFE_/6AH5;7DfQssEc39jTBQ
	=U#OG#M5u_NK`L;'g'_`?_5JPn)_d:C()V]%S0h9%3pu4-+e;tk,")Zj,2$t(u:^^!26PP,C#]8!<9
	mWaQ8X-SSBWG/hC(;G*#S&af\J(Vo(h3i=JdEa20h9%Bm_&NRbPIltcZl$<dZ3HKn$CpGHi)smgJt<
	2g*[<'Xa;<t!BdsaPsOO"h=u=#@$P%=i-3?c*Ydi'%Ab)j+3>HX.,7PocZV:W6E^l,aImEkaM]:*'m
	bL`L6pfSJJc63O+3ANeuTl'kA,hOWe93S-G[q*-P6FrcH'TnrT4.>cLlR_KAXsdKjN",$]&0nO+B&R
	">RL]CN;`9._&d][6h'7(^>`1g1:YEMd]WVWriKZkEi[R2%1^O9gfP#?=&qC%a9eZ(_EhMq:"*r[P(
	KYl.*a,BQsH@RWK&3?uap)g+'eI@0A8Pps!/h+sK/DUP6@0D;B_m<dJ-;i7BXaD/V`L"ShK%.6s9po
	k[6<D&EoQbc$+'I\kk\>,>;ai(")=K[B&aRSE%6V,0L-n&sp<gjpr?RaQf%,in^6N4(uiYXT#H/=d<
	="ari;0Dbn$'\G6r;P6kA]QME!=TX0"2;/TMK\=g09eO;AaD^g4$Rg.Y$Or)TjQC*,J.Z>J1TU05@M
	f319f>^S[jh"m35c&+[WA_9$^@M3L;Cr>M0ud?+mCG\D)[i!6,-,m$C_6lSZh0D=ZLU`^-jE(L_/a+
	@f3_e&j>Z+=DRP`\rK#QD&4D5Whg)JX6sW6K#Te`(hHA'h=\a7nTbMA)&$++2'5n%3),AA>ckQTTDn
	[.T'-Fq5Ptp$CkW#c*j.arR/OEDrcr-lYIG0j,k7=iA&VI'^(DJ2.>=jc*pe%TXfX21WitUGK?%te4
	%&aEV)R%LR&uYtK$hc9'lJ(K_DRcVlV"d84.NhbMo_HN78f(sE/-nMMo!p_PPO:X(_.>Mk+uG"-8.R
	WPVW-g@/EC]CSaC>1;k6[M;iS52`f"sQc\`]A>7m@%\'1=+PaWqkMMU>3+#\%bW-',UhH[38oH,Q="
	_UMT\pp3]\I#$;cf3KSY5,^QcpuT(,I#S_&),;?$A@f7XJEo4d:R20_fV17S<CsP'_WLbc,36(1<TC
	k;?Gpi(D7*l>)m1(cR/r&,M(gf0e.1\fs>\Nr;6cL'X^#Nq23XINefNoU6ZRT;&.r>INp.<*Bdb3LR
	g=leH?k^JTssf?)=[jEsr;H]%PBL@fE8TbM)"'uYHIpj>ZC*B%+!p\T"nD"rBLe6_`D=nNZ3^)<7#%
	;#1$Kt@qJT.\7Kn$cWe0fM1',%mr013<Fogs5p1]k;5\:80CqI:\0FYp0=H7k5//)cJLPgpjK,ggo"
	jY1;'bQ8o#EDPObMCT^UF&Ja]lCeZcfkm_3GW+P^2\!rjjEP'+B6tgBGTPFn2<9UoLi"+*5h!Qkb>P
	s<*&L@,dRGb.&RD1V0_s+rJTeuh=B!thc/qRN!\f=HMIX_?uoS,-tn\t)"ZY"XcJX:ZkNH!U-N;/4k
	L:]G4-HpC!W2FJsCN.uBbmek'%s-+MBKcj&k@TCW\ZYfWHsN.5f/V]i`8B"%h.C[:"&KWihV1-(:#U
	#)`o5:L8oMIW*WCSN0fG<^$g2NTai!4^FLeiZ\V5qX/hh$nO1NeAqUNmr"Hno\W2m$h+$1CQDX2=[X
	$8jTD(Tb41&[\doMohnS)K*Gp)kP1Ir$1p2Z0:>:k`A30o?;/LU5sih&JJ'N.Uu?0%ZGS*ol%D10,u
	6bi)KSLqs""Va2GDEX'Qf[eEV$@YhsbOr;Goh%a1n^;RP*;-g?-3`jRUs&6h:l+('.88kD/L\/*K<@
	HiI?G(#$s*3QKE\^+jFk\g_mf"%tr'Z;(TgKJXRs1.'D>SMI->,)ZdWe3"W-"*ToAiq?lB+KniR<3f
	n0KAW?=$BP`As/"\EpZNTu>krVp8.gZCFe0PBm,7ou\bt\fp2G0E'`I^jJBuEkU*WfVrXG[/auCY9M
	heaJ?pV\9N9LKc:C[GiUhe)<lC?,H/A&LJt+O\5[m2Of<&r=S;h#k%mCQQo8r#8G!&^_JZoq9qa)rK
	2(h)J3/Ws_a[I(?cJ5'7laq)RH,VHmVitd)k-R"l8@kmXt_3<bI5[aRp:mDp1`+:ZF<+E4c,u3A[6;
	c+[]1_Z$Q),m+kUYi<+G;Fo)YGOV*OH:LhN+kBZZiI;M`<hY.o]G!QUZ7hP2ak3+0_n9AE11OCH].P
	%J^?U\I''4EL0M2>Q9k2oV=C"n]T<p<VFY'IY"=JZ]\?4R^tOt$>#)[m`ARae]<8r@fMNeg#VN:#3:
	+.li7!9QK=<%k8*_@me^MDp9b#PR*o&l6/!M6iJFE&b`X,-b>ga,15K^H#Dl='`Ri]r0YI/RPb\ieO
	Bd-9[9M4kgk=MrX!dSlOV(fk.LoZ/%(uAE,'!8n:Ts$&Qc'SN]VM9E`=]MgE@M9!@+MP)f7SP>=igc
	r<olZR@9f)mh7V0mBWc7)bQ[Y3]ASqdKZ(=6o5_QS2\h0farNU)f1d*h4>TeCWS#.b\A:3I5Xr$j3E
	:f7@8?k%T]s^!E))hE_N)5lR9V<)jpY)]LYJ6&'s>q`j;pX7,UPN#_lu!!#SZ:.26O@"J
	ASCII85End
End