| [796] | 1 | TMGIOUTL ;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 |
|
|---|
| 24 | test
|
|---|
| 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 |
|
|---|
| 32 | FBrowse(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=""
|
|---|
| 83 | L1 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.
|
|---|
| 101 | LQ write # ;"clear screen
|
|---|
| 102 | quit TMGSelect
|
|---|
| 103 |
|
|---|
| 104 | LoadDir(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 | ;
|
|---|
| 162 | LD2 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 | ;
|
|---|
| 176 | LDQuit quit
|
|---|
| 177 |
|
|---|
| 178 | HndOnSel(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 |
|
|---|
| 191 | HndlOnCmd(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="^"
|
|---|
| 260 | HOCDone quit
|
|---|
| 261 |
|
|---|
| 262 |
|
|---|
| 263 | ShowHelp(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
|
|---|
