/usr/share/openmsx/scripts/filepool.tcl is in openmsx-data 0.8.2-2.1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
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 | namespace eval filepool {
set_help_text filepool \
{Manage filepool settings
filepool list
Shows the currently defined filepool entries.
filepool add -path <path> -types <typelist> [-position <pos>]
Add a new entry. Each entry must have a directory and a list of filetypes.
Possible filetypes are 'system_rom', 'rom', 'disk' and 'tape'. Optionally
you can specify the position of this new entry in the list of existing
entries (by default new entries are added at the end).
filepool remove <position>
Remove the filepool entry at the given position.
filepool reset
Reset the filepool settings to the default values.
}
proc filepool_completion {args} {
if {[llength $args] == 2} {
return [list list add remove reset]
}
return [list -path -types -position system_rom rom disk tape]
}
set_tabcompletion_proc filepool [namespace code filepool_completion]
proc filepool {args} {
set cmd [lindex $args 0]
set args [lrange $args 1 end]
switch -- $cmd {
"list" {filepool_list}
"add" {filepool_add {*}$args}
"remove" {filepool_remove $args}
"reset" {filepool_reset}
"default" {
error "Invalid subcommand, expected one of 'list add remove reset', but got '$cmd'"
}
}
}
proc filepool_list {} {
set result ""
set i 1
foreach pool $::__filepool {
append result "$i: [dict get $pool -path] \[[dict get $pool -types]\]\n"
incr i
}
return $result
}
proc filepool_checktypes {types} {
set valid [list "system_rom" "rom" "disk" "tape"]
foreach type $types {
if {$type ni $valid} {
error "Invalid type, expected one of '$valid', but got '$type'"
}
}
}
proc filepool_add {args} {
set pos [llength $::__filepool]
set path ""
set types ""
foreach {name value} $args {
if {$name eq "-position"} {
set pos [expr {$value - 1}]
} elseif {$name eq "-path"} {
set path $value
} elseif {$name eq "-types"} {
filepool_checktypes $value
set types $value
} else {
error "Unknown option: $name"
}
}
if {($pos < 0) || ($pos > [llength $::__filepool])} {
error "Value out of range: [expr {$pos + 1}]"
}
if {$path eq ""} {
error "Missing -path"
}
if {$types eq ""} {
error "Missing -types"
}
set newpool [dict create -path $path -types $types]
if {$pos == [llength $::__filepool]} {
lappend ::__filepool $newpool
} else {
set ::__filepool [lreplace $::__filepool $pos -1 $newpool]
}
return ""
}
proc filepool_remove {id} {
if {($id < 1) || ($id > [llength $::__filepool])} {
error "Value out of range: $id"
}
set idx [expr {$id - 1}]
set ::__filepool [lreplace $::__filepool $idx $idx]
return ""
}
proc filepool_reset {} {
unset ::__filepool
}
namespace export filepool
} ;# namespace filepool
namespace import filepool::*
|