source: cprs/branches/tmg-cprs/m_files/TMGIOUT2.m@ 1547

Last change on this file since 1547 was 796, checked in by Kevin Toppenberg, 14 years ago

Initial upload

File size: 12.8 KB
Line 
1TMGIOUTL ;TMG/kst/IO Utilities -- File browser ;05/16/09
2 ;;1.0;TMG-LIB;**1**;05/16/09
3
4 ;"TMG IO UTILITIES
5 ;"Kevin Toppenberg MD
6 ;"GNU General Public License (GPL) applies
7 ;"5/16/09
8
9 ;"=======================================================================
10 ;" API -- Public Functions.
11 ;"=======================================================================
12 ;"FBrowse(Option,OutPath,OutName) query the user to select a filename
13
14 ;"=======================================================================
15 ;"Private API calls
16 ;"=======================================================================
17 ;"LoadDir(pArray,curDir,TMGMask,Option) -- load curDir entries into pArray
18 ;"HndOnSel(pArray,Option,Info) -- handle ON SELECT event from Scroller
19 ;"HndlOnCmd(pArray,Option,Info) -- handle ON SELECT event from Scroller
20 ;"ShowHelp -- show help for file browser
21
22 ;"=======================================================================
23
24test
25 new option
26 set option("MSG")="Hello there!"
27 set option("PATH")="/home/kdt0p"
28 set option("SELECT DIR")=0
29 write $$FBrowse(.option)
30 quit
31
32FBrowse(Option,OutPath,OutName)
33 ;"SCOPE: PUBLIC
34 ;"Purpose: To query the user, to get a filename back
35 ;" Supplies optional directory listing.
36 ;"Input: Option [OPTIONAL]. Format as follows. All entries are optional
37 ;" Option("MSG") A message to show user prior to name prompt.
38 ;" May contain "\n" character for line wrapping.
39 ;" Option("PATH") Initial default path
40 ;" Option("NAME") Initial default filename
41 ;" Option("NodeDiv") The character that separates folders (e.g. "/")
42 ;" If not supplied, then default value is "/"
43 ;" Option("MATCH","*.m")="" -- e.g. use filter '*.m'
44 ;" Option("MATCH","*.txt")="" -- e.g. use filter '*.txt"
45 ;" NOTE: Filters are combined by AND, i.e. files matching one of the specified matches
46 ;" Option("PROMPT") A prompt for user to enter filename/directory name
47 ;" Option("SHOW HIDDEN")=1 Show files hidden (e.g. '.name')
48 ;" Option("SELECT DIR")=1 if 1 then mode is to select directories, not files
49 ;" OutPath: [OPTIONAL] Pass by reference, filled with selected path
50 ;" OutName: [OPTIONAL] Pass by reference, filled with selected name
51 ;"Result: returns user specified filename (with path), or "" if aborted
52
53 write # ;"clear screen
54 new ScrlFiles,done
55 new selDir set selDir=+$get(Option("SELECT DIR"))
56 new width set width=60
57 new line set $piece(line,"-",width-2)="-"
58 set Option("HEADER",1)="+"_line_"+"
59 new banner set banner="--== Please Select "_$select(selDir:"Directory",1:"File")_" ==--"
60 set Option("HEADER",2)="|"_$$CJ^XLFSTR(banner,width-2)_"|"
61 set Option("FOOTER",1)="Enter ? for help"
62 if $get(Option("PROMPT"))'="" set Option("FOOTER",2)=Option("PROMPT")
63 set Option("SCRN WIDTH")=width
64 set Option("ON SELECT")="HndOnSel^TMGIOUT2" ;"code to call based on user input
65 set Option("ON CMD")="HndlOnCmd^TMGIOUT2" ;"code to execute for number entry
66
67 new msg set msg=$get(Option("MSG"))
68 if msg'="" do
69 . do PopupBox^TMGUSRIF("Message:",msg)
70 . do PressToCont^TMGUSRIF
71
72 new StackCaller set StackCaller=$$Caller^TMGMISC
73 new nodeDiv set nodeDiv=$get(Option("nodeDiv"),"/")
74 set Option("nodeDiv")=nodeDiv ;" in case it wasn't there initially
75 new curDir set curDir=$get(Option("PATH"))
76 if (curDir="")&($data(^TMG("TMP","SETTINGS","FBrowse",StackCaller))) do
77 . set curDir=$get(^TMG("TMP","SETTINGS","FBrowse",StackCaller))
78 if curDir="" set curDir=nodeDiv
79 set curDir=$$EnsureTrailDiv^TMGIOUTL(curDir,nodeDiv)
80 if $$IsDir^TMGKERNL(curDir)=0 set curDir=nodeDiv
81
82 new TMGSelect set TMGSelect=""
83L1 do LoadDir("ScrlFiles",curDir,.Option)
84 set Option("HEADER",3)="|"_$$CJ^XLFSTR("Current Dir: "_curDir,width-2)_"|"
85 set TMGSelect=""
86 do Scroller^TMGUSRIF("ScrlFiles",.Option) ;"Event handler should set TMGSelect
87 if TMGSelect="" goto LQ
88 if selDir set done=0 do goto:done LQ
89 . new Menu,UsrSlct
90 . set Menu(0)="What do you want to do with this directory?"
91 . set Menu(1)="Choose "_TMGSelect_" as selected directory"_$char(9)_"done"
92 . set Menu(2)="Browse INTO it"_$char(9)_"into"
93 . write !
94 . set UsrSlct=$$Menu^TMGUSRIF(.Menu,2)
95 . write #
96 . if UsrSlct="done" set done=1
97 if $$IsDir^TMGKERNL(TMGSelect) set curDir=TMGSelect goto L1 ;"browse into directory
98 do SplitFNamePath^TMGIOUTL(TMGSelect,.OutPath,.OutName,nodeDiv)
99
100 set ^TMG("TMP","SETTINGS","FBrowse",StackCaller)=OutPath ;"store for future use.
101LQ write # ;"clear screen
102 quit TMGSelect
103
104LoadDir(pArray,curDir,Option)
105 ;"Purpose: load curDir entries into pArray
106 ;"Input: pArray -- PASS BY NAME. An OUT PARAMETER. Filled in as follows
107 ;" @pArray@(1,DisplayText)=Return Text <-- note: must be numbered 1,2,3 etc.
108 ;" @pArray@(2,DisplayText)=Return Text
109 ;" @pArray@(3,DisplayText)=Return Text
110 ;" curDir -- the directory to get files from
111 ;" TMGMask -- PASS BY REFERENCE. The mask array (See FBrowse)
112 ;" Option [OPTIONAL]. Format as follows. All entries are optional
113 ;" Option("MATCH","*.m")="" -- e.g. use filter '*.m'
114 ;" Option("MATCH","*.txt")="" -- e.g. use filter '*.txt"
115 ;" NOTE: Filters are combined by AND, i.e. files matching one of the specified matches
116 ;" Option("NodeDiv") The character that separates folders (e.g. "/")
117 ;" If not supplied, then default value is "/"
118 ;" Option("SHOW HIDDEN")=1 Show files hidden (e.g. '.name')
119 ;" Option("SELECT DIR")=1 if 1 then mode is to select directories, not files
120 ;" nodeDiv -- The character that separates folders (e.g. "/")
121 ;" ShowHidden -- OPTIONAL. Default=0 If 1, then show hidden files
122 ;"Results: none
123 ;
124 new TMGFiles,tempFiles
125 new count set count=1
126 kill @pArray
127 new nodeDiv set nodeDiv=$get(Option("nodeDiv"),"/")
128 set nodeDiv=$get(nodDiv,"/")
129 set ShowHidden=+$get(Option("SHOW HIDDEN"))
130 new selDir set selDir=+$get(Option("SELECT DIR"))
131 set curDir=$get(curDir,nodeDiv)
132 set curDir=$$EnsureTrailDiv^TMGIOUTL(curDir,nodeDiv)
133 if $$IsDir^TMGKERNL(curDir)=0 goto LDQuit
134 ;"Note: Filter/Mask would apply to directory names too, so must
135 ;" ask for list of files with mask applied **AND** also with
136 ;" a mask of '*' to be sure to get directory names
137 new tempMask set tempMask("*")=""
138 if $$LIST^%ZISH(curDir,"tempMask","TMGFiles")=0 goto LDQuit
139 new index set index=""
140 for set index=$order(TMGFiles(index)) quit:(index="") do
141 . if ($extract(index,1)=".")&(ShowHidden=0) quit
142 . new FName,FPName
143 . set FName=index
144 . set FPName=curDir_FName
145 . if $$IsDir^TMGKERNL(FPName) set tempFiles("DIRS","<"_FName_">")=FPName
146 . else set tempFiles("FILES",FName)=FPName
147 ;
148 ;"Now get files again with user-supplied filter
149 merge TMGMask=Option("MATCH")
150 if $data(TMGMask)=0 goto LD2 ;"use FILES node already created
151 kill tempFiles("FILES") ;"needs to be reloaded with mask applied.
152 if $$LIST^%ZISH(curDir,"TMGMask","TMGFiles")=0 goto LDQuit
153 new index set index=""
154 for set index=$order(TMGFiles(index)) quit:(index="") do
155 . if ($extract(index,1)=".")&(ShowHidden=0) quit
156 . new FName,FPName
157 . set FName=index
158 . set FPName=curDir_FName
159 . if $get(tempFiles("DIRS","<"_FName_">"))'="" quit
160 . set tempFiles("FILES",FName)=FPName
161 ;
162LD2 set index=""
163 if curDir'=nodeDiv do
164 . set @pArray@(count,".. <UP>")=$$UpPath^TMGIOUTL(curDir)
165 . set count=count+1
166 for set index=$order(tempFiles("DIRS",index)) quit:(index="") do
167 . set @pArray@(count,index)=$get(tempFiles("DIRS",index))
168 . set count=count+1
169 if selDir=1 goto LDQuit ;"skip showing files.
170 ;
171 set index=""
172 for set index=$order(tempFiles("FILES",index)) quit:(index="") do
173 . set @pArray@(count,index)=$get(tempFiles("FILES",index))
174 . set count=count+1
175 ;
176LDQuit quit
177
178HndOnSel(pArray,Option,Info)
179 ;"Purpose: handle ON SELECT event from Scroller
180 ;"Input: pArray,Option,Info -- see documentation in Scroller
181 ;" Info has this:
182 ;" Info("CURRENT LINE","NUMBER")=number currently highlighted line
183 ;" Info("CURRENT LINE","TEXT")=Text of currently highlighted line
184 ;" Info("CURRENT LINE","RETURN")=return value of currently highlighted line
185 ;"Globally-scoped var used: TMGSelect,TMGSCLRMSG
186 new text set text=$get(Info("CURRENT LINE","TEXT"))
187 set TMGSelect=$get(Info("CURRENT LINE","RETURN"))
188 set TMGSCLRMSG="^"
189 quit
190
191HndlOnCmd(pArray,Option,Info)
192 ;"Purpose: handle ON SELECT event from Scroller
193 ;"Input: pArray,Option,Info -- see documentation in Scroller
194 ;" Info has this:
195 ;" Info("USER INPUT")=input
196 ;" Info("CURRENT LINE","NUMBER")=number currently highlighted line
197 ;" Info("CURRENT LINE","TEXT")=Text of currently highlighted line
198 ;" Info("CURRENT LINE","RETURN")=return value of currently highlighted line
199 new done set done=0
200 new rtn set rtn=$get(Info("CURRENT LINE","RETURN"))
201 new path set path=rtn
202 new UsrInput set UsrInput=$get(Info("USER INPUT"))
203 new cmd set cmd=$$UP^XLFSTR($piece(UsrInput," ",1))
204 if $extract(path,$length(path))'=nodeDiv do
205 . set path=$$UpPath^TMGIOUTL(path) ;"Trim off filename
206 if cmd="CD" do goto:done HOCDone
207 . new newDir set newDir=$piece(UsrInput," ",2)
208 . if newDir=".." set UsrInput=".." quit
209 . set done=1
210 . if $extract(newDir,1)'="/" set newDir=path_newDir
211 . if $$IsDir^TMGKERNL(newDir)=0 do quit
212 . . write newDir," is not a valid existing directory.",!
213 . . do PressToCont^TMGUSRIF
214 . set TMGSelect=newDir
215 . set TMGSCLRMSG="^"
216 if cmd="MKDIR" do goto:done HOCDone
217 . new newDir set newDir=$piece(UsrInput," ",2)
218 . set done=1
219 . if $extract(newDir,1)'="/" set newDir=path_newDir
220 . write !,"Create NEW directory: ",newDir
221 . new % set %=2
222 . do YN^DICN write !
223 . if %=1 if $$mkdir^TMGKERNL(newDir)
224 . write #
225 . set TMGSelect=path
226 . set TMGSCLRMSG="^"
227 if cmd="RMDIR" do goto:done HOCDone
228 . new newDir set newDir=$piece(UsrInput," ",2)
229 . set done=1
230 . if $extract(newDir,1)'="/" set newDir=path_newDir
231 . write !,"DELETE directory: ",newDir
232 . new % set %=2
233 . do YN^DICN write !
234 . if %=1 if $$rmdir^TMGKERNL(newDir)
235 . set TMGSelect=path
236 . set TMGSCLRMSG="^"
237 . write #
238 if (UsrInput="{LEFT}")!(UsrInput="..") do goto HOCDone
239 . new nodeDiv set nodeDiv=$get(Option("nodeDiv"),"/") ;"extra info passed
240 . set TMGSelect=$$UpPath^TMGIOUTL(path)
241 . set TMGSCLRMSG="^"
242 if UsrInput="{RIGHT}" do goto HOCDone
243 . set TMGSelect=$get(Info("CURRENT LINE","RETURN"))
244 . set TMGSCLRMSG="^"
245 ;"Later, I could put some stuff here to let the command line choose filters etc.
246 ;"or perhaps jump to a given directory etc. Perhaps later...
247 if UsrInput["?" do goto HOCDone
248 . do ShowHelp(.Option)
249 else do
250 . new newName set newName=path_UsrInput
251 . new % set %=2
252 . if $$FileExists^TMGIOUTL(newName) set %=1
253 . else do
254 . . write !,"Use NEW filename: ",newName
255 . . do YN^DICN write !
256 . . if %'=1 write #
257 . if %=1 do
258 . . set TMGSelect=newName
259 . . set TMGSCLRMSG="^"
260HOCDone quit
261
262
263ShowHelp(Option)
264 ;"Purpose: show help for file browser
265 ;"Input: Option -- see documentation in Scroller
266 write !
267 write "Use [UP], [DOWN], [PgUp], or [PgDown] keys to scroll",!
268 write "Use [ENTER] to select file name",!
269 write "Use [ENTER] or [RIGHT] key to browse into a directory",!
270 write "Use [LEFT] key to back up one level",!
271 write "Use ^ to abort without selecting a file",!
272 if $get(Option("SELECT DIR"))'=1 do
273 . write "To create/select a NEW file, just type new name and [ENTER]",!
274 write "type: 'cd <DirName>' to change directory",!
275 write "type: 'mkdir <DirName>' to create a NEW directory",!
276 write "type: 'rmdir <DirName>' to DELETE a new directory",!
277 do PressToCont^TMGUSRIF
278 write #
279 quit
Note: See TracBrowser for help on using the repository browser.