programrootdir.pro
9.13 KB
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
;*****************************************************************************************************
;+
; NAME:
; ProgramRootDir
;
; PURPOSE:
;
; The purpose of this function is to provide a portable way of finding
; the root directory of a program distribution. The directory that is returned
; is the directory in which the source file using ProgramRootDir resides.
; The program is useful for distributing applications that have a large number
; of files in specific program directories.
;
;
; AUTHOR:
;
; FANNING SOFTWARE CONSULTING
; 1645 Sheely Drive
; Fort Collins, CO 80526 USA
; Phone: 970-221-0438
; E-mail: david@idlcoyote.com
;
; SYNTAX:
;
; theDirectory = ProgramRootDir()
;
; RETURN_VALUE:
;
; theDirectory: The directory in which the program module running ProgramRootDir resides.
;
; ARGUMENTS:
;
; None.
;
; KEYWORDS:
;
; NOMARK: Normally, the directory that is returned contains a path separator at its
; end, so that the directory can easily be concatinated with other file names.
; If this keyword is set, the final path separator mark is removed from the
; directory name.
;
; ONEUP: Set this keyword if you want to start your search one directory
; *above* where your source program resides (i.e., "../Source").
; This allows you, for example, to put your source files in a Source
; directory that it at the same level as your Data directory, Utility
; directory, etc. See the example below.
;
; TWOUP: Set this keyword if you want to start your search two directories
; *above* where your source program resides (i.e., "../../Source").
;
;
; EXAMPLE:
;
; Assume that your application files (and source programs) reside in this root directory:
;
; ../app
;
; You have placed a DATA directory immediately under the APP directiory, and a RESOURCES
; directory immedately under the DATA directory. Your directory structure looks like this:
;
; ../app ; Contains your application and source (*.pro) files.
; ../app/data ; Contains your application data files.
; ...app/data/resources ; Contains your application resource files.
;
; The end user can install the APP directory wherever he or she likes. In your
; program, you will identify the DATA and RESOURCES directory like this:
;
; ; Get icon image in resources directory.
; filename = Filepath(Root_Dir=ProgramRootDir(), Subdirectory=['data','resources'], 'myicon.tif')
;
; ; Get default image in data directory.
; filename = Filepath(Root_Dir=ProgramRootDir(), Subdirectory='data', 'ctscan.tif')
;
; Alternatively, you might set up an application directory structure like this:
;
; ../app ; Contains your application files.
; ../app/source ; Contains your application source (*.pro) files.
; ../app/data ; Contains your application data files.
; ...app/data/resources ; Contains your application resource files.
;
; In this case, you would use the ONEUP keyword to find your data and resource files, like this:
;
; ; Get icon image in resources directory.
; filename = Filepath(Root_Dir=ProgramRootDir(/ONEUP), Subdirectory=['data','resources'], 'myicon.tif')
;
; ; Get default image in data directory.
; filename = Filepath(Root_Dir=ProgramRootDir(/ONEUP), Subdirectory='data', 'ctscan.tif')
;
;
;
; MODIFICATION_HISTORY:
;
; Written by: David W. Fanning, 23 November 2003. Based on program SOURCEROOT, written by
; Jim Pendleton at RSI (http://www.rsinc.com/codebank/search.asp?FID=35).
; Added ONEUP keyword. 10 December 2003. DWF.
; Added TWOUP keyword. 8 June 2007. DWF.
; Added NOMARK keyword. 8 June 2007. DWF.
;-
;******************************************************************************************;
; Copyright (c) 2008, by Fanning Software Consulting, Inc. ;
; All rights reserved. ;
; ;
; Redistribution and use in source and binary forms, with or without ;
; modification, are permitted provided that the following conditions are met: ;
; ;
; * Redistributions of source code must retain the above copyright ;
; notice, this list of conditions and the following disclaimer. ;
; * Redistributions in binary form must reproduce the above copyright ;
; notice, this list of conditions and the following disclaimer in the ;
; documentation and/or other materials provided with the distribution. ;
; * Neither the name of Fanning Software Consulting, Inc. nor the names of its ;
; contributors may be used to endorse or promote products derived from this ;
; software without specific prior written permission. ;
; ;
; THIS SOFTWARE IS PROVIDED BY FANNING SOFTWARE CONSULTING, INC. ''AS IS'' AND ANY ;
; EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES ;
; OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT ;
; SHALL FANNING SOFTWARE CONSULTING, INC. BE LIABLE FOR ANY DIRECT, INDIRECT, ;
; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED ;
; TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; ;
; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ;
; ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT ;
; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ;
; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ;
;******************************************************************************************;
FUNCTION ProgramRootDir, OneUp=oneup, TwoUp=twoup, NoMark=nomark
; Return to caller on an error.
On_Error, 2
; Get the current call stack.
Help, Calls=callStack
; Get the name of the calling routine.
callingRoutine = (StrSplit(StrCompress(callStack[1])," ", /Extract))[0]
; We don't know if the calling routine is a procedure or a function,
; and we don't have a way to get information without knowing this. So,
; we are going to try first to see if it is a procedure. If not, we
; will try it as a function. Unfortunately, if it is *not* a procedure,
; we will cause an error. We have to catch that and handle it silently.
Catch, theError
IF theError NE 0 THEN BEGIN
Catch, /Cancel
Message, /Reset
thisRoutine = Routine_Info(callingRoutine, /Functions, /Source)
ENDIF
IF N_Elements(thisRoutine) EQ 0 THEN $
thisRoutine = Routine_Info(callingRoutine, /Source)
; If there are no path separators, you are here.
IF ( StrPos(thisRoutine.Path, Path_Sep()) ) EQ -1 THEN BEGIN
CD, Current=thisDir
sourcePath = FilePath(thisRoutine.Path, Root_Dir=thisDir)
ENDIF ELSE BEGIN
sourcePath = thisRoutine.Path
ENDELSE
; Strip the root directory off the source path.
root = StrMid(sourcePath, 0, StrPos(sourcePath, Path_Sep(), /Reverse_Search) + 1)
; If ONEUP is set, then climb up the root directory by one directory. This will
; be the *second* path separator, since the root directory has a path separator
; as its end.
IF Keyword_Set(oneup) THEN BEGIN
i = Where( Byte(root) EQ (Byte(Path_Sep()))[0], count)
IF count GE 2 THEN BEGIN
sourcePath = StrMid(root, 0, StrLen(root)-1)
root = StrMid(sourcePath, 0, StrPos(sourcePath, Path_Sep(), /Reverse_Search) + 1)
ENDIF
ENDIF
; If TWOUP is set, then climb up the root directory by two directories. This will
; be the *third* path separator, since the root directory has a path separator
; as its end.
IF Keyword_Set(twoup) THEN BEGIN
i = Where( Byte(root) EQ (Byte(Path_Sep()))[0], count)
IF count GE 3 THEN BEGIN
sourcePath = StrMid(root, 0, StrLen(root)-1)
root = StrMid(sourcePath, 0, StrPos(sourcePath, Path_Sep(), /Reverse_Search) + 1)
sourcePath = StrMid(root, 0, StrLen(root)-1)
root = StrMid(sourcePath, 0, StrPos(sourcePath, Path_Sep(), /Reverse_Search) + 1)
ENDIF
ENDIF
; Remove last path separation mark, if requested.
IF Keyword_Set(nomark) THEN RETURN, StrMid(root, 0, StrLen(root)-1) ELSE RETURN, root
END