1# This file is an aid in sourcing other tcl files.  It provides the following
2# advantages:
3# - It shortens the number of lines of code needed to intelligently source
4# files.
5# - Its my_source procedure provides several benefits (see my_source prolog
6# below).
7
8# By convention, this file, or a link to this file, must exist in one of the
9# directories named in the PATH environment variable.
10
11# Example use:
12# source [exec bash -c "which source.tcl"]
13# my_source [list print.tcl opt.tcl]
14
15set path_list [split $::env(PATH) :]
16
17
18proc tcl_which { file_name } {
19
20  # Search the PATH environment variable for the first executable instance of
21  # $file_name and return the full path.  On failure, return a blank string.
22
23  # This procedure runs much faster than [exec bash -c "which $file_name"].
24
25  # Description of argument(s):
26  # file_name                       The name of the file to be found.
27
28  global path_list
29
30  foreach path $path_list {
31    set file_path $path/$file_name
32    if { [file executable $file_path] } { return $file_path }
33  }
34
35  return ""
36
37}
38
39
40if { ![info exists sourced_files] } {
41  set sourced_files [list]
42}
43
44proc my_source { source_files } {
45
46  # Source each file in the source_files list.
47
48  # This procedure provides the following benefits verses just using the
49  # source command directly.
50  # - Use of PATH environment variable to locate files.
51  # - Better error handling.
52  # - Will only source each file once.
53  # - If "filex" is not found, this procedure will try to find "filex.tcl".
54
55  # Description of argument(s):
56  # source_files                    A list of file names to be sourced.
57
58  global sourced_files
59  global env
60
61  foreach file_name $source_files {
62
63    set file_path [tcl_which $file_name]
64    if { $file_path == "" } {
65      # Does the user specify a ".tcl" extension for this file?
66      set tcl_ext [regexp -expanded {\.tcl$} $file_name]
67      if { $tcl_ext } {
68        append message "**ERROR** Programmer error - Failed to find"
69        append message " \"${file_name}\" source file:\n"
70        append message $::env(PATH)
71        puts stderr $message
72        exit 1
73      }
74
75      set file_path [tcl_which ${file_name}.tcl]
76      if { $file_path == "" } {
77        append message "**ERROR** Programmer error - Failed to find either"
78        append message " \"${file_name}\" or \"${file_name}.tcl\" source file:"
79        append message $::env(PATH)
80        puts stderr $message
81        exit 1
82      }
83    }
84
85    # Adjust name (in case we found the .tcl version of a file).
86    set full_file_name "[file tail $file_path]"
87
88    # Have we already attempted to source this file?
89    if { [lsearch -exact $sourced_files $full_file_name] != -1 } { continue }
90    # Add the file name to the list of sourced files.  It is important to add
91    # this file to the list BEFORE we source the file.  Otherwise, if there is
92    # a recursive source (a sources b, b sources c, c sources a), we will get
93    # into an infinite loop.
94    lappend sourced_files $full_file_name
95
96    if { [catch { uplevel 1 source $file_path } result] } {
97      append message "**ERROR** Programmer error - Failed to source"
98      append message " \"${file_path}\":\n${result}"
99      puts stderr $message
100
101      exit 1
102    }
103  }
104
105}
106