OXYGENHUB
◆ main openmsx / share / scripts / _filepool.tcl
2.9 KiB · Tcl · last changed chore(): initial commit 1 month ago source blame history raw
1 
namespace eval filepool {
2
3 
set_help_text filepool \
4 
{Manage filepool settings
5
6 
  filepool list
7 
    Shows the currently defined filepool entries.
8
9 
  filepool add -path <path> -types <typelist> [-position <pos>]
10 
    Add a new entry. Each entry must have a directory and a list of filetypes.
11 
    Possible filetypes are 'system_rom', 'rom', 'disk' and 'tape'. Optionally
12 
    you can specify the position of this new entry in the list of existing
13 
    entries (by default new entries are added at the end).
14
15 
  filepool remove <position>
16 
    Remove the filepool entry at the given position.
17
18 
  filepool reset
19 
    Reset the filepool settings to the default values.
20 
}
21
22 
proc filepool_completion {args} {
23 
	if {[llength $args] == 2} {
24 
		return [list list add remove reset]
25 
	}
26 
	return [list -path -types -position system_rom rom disk tape]
27 
}
28 
set_tabcompletion_proc filepool [namespace code filepool_completion]
29
30
31 
proc filepool {args} {
32 
	set cmd [lindex $args 0]
33 
	set args [lrange $args 1 end]
34 
	switch -- $cmd {
35 
		"list"   {filepool_list}
36 
		"add"    {filepool_add {*}$args}
37 
		"remove" {filepool_remove $args}
38 
		"reset"  {filepool_reset}
39 
		"default" {
40 
			error "Invalid subcommand, expected one of 'list add remove reset', but got '$cmd'"
41 
		}
42 
	}
43 
}
44
45 
proc filepool_list {} {
46 
	set result ""
47 
	set i 1
48 
	foreach pool $::__filepool {
49 
		append result "$i: [dict get $pool -path]  \[[dict get $pool -types]\]\n"
50 
		incr i
51 
	}
52 
	return $result
53 
}
54
55 
proc filepool_checktypes {types} {
56 
	set valid [list "system_rom" "rom" "disk" "tape"]
57 
	foreach type $types {
58 
		if {$type ni $valid} {
59 
			error "Invalid type, expected one of '$valid', but got '$type'"
60 
		}
61 
	}
62 
}
63
64 
proc filepool_add {args} {
65 
	set pos [llength $::__filepool]
66 
	set path ""
67 
	set types ""
68 
	foreach {name value} $args {
69 
		if {$name eq "-position"} {
70 
			set pos [expr {$value - 1}]
71 
		} elseif {$name eq "-path"} {
72 
			set path $value
73 
		} elseif {$name eq "-types"} {
74 
			filepool_checktypes $value
75 
			set types $value
76 
		} else {
77 
			error "Unknown option: $name"
78 
		}
79 
	}
80 
	if {($pos < 0) || ($pos > [llength $::__filepool])} {
81 
		error "Value out of range: [expr {$pos + 1}]"
82 
	}
83 
	if {$path eq ""} {
84 
		error "Missing -path"
85 
	}
86 
	if {$types eq ""} {
87 
		error "Missing -types"
88 
	}
89
90 
	set newpool [dict create -path $path -types $types]
91 
	if {$pos == [llength $::__filepool]} {
92 
		lappend ::__filepool $newpool
93 
	} else {
94 
		set ::__filepool [lreplace $::__filepool $pos -1 $newpool]
95 
	}
96 
	return ""
97 
}
98
99 
proc filepool_remove {id} {
100 
	if {($id < 1) || ($id > [llength $::__filepool])} {
101 
		error "Value out of range: $id"
102 
	}
103 
	set idx [expr {$id - 1}]
104 
	set ::__filepool [lreplace $::__filepool $idx $idx]
105 
	return ""
106 
}
107
108 
proc filepool_reset {}  {
109 
	unset ::__filepool
110 
}
111
112 
proc get_paths_for_type {type} {
113 
	set result [list]
114 
	foreach pool $::__filepool {
115 
		set types [dict get $pool -types]
116 
		if {$type in $types} {
117 
			lappend result [dict get $pool -path]
118 
		}
119 
	}
120 
	return $result
121 
}
122
123 
namespace export filepool
124
125 
} ;# namespace filepool
126
127 
namespace import filepool::*