| #!/usr/bin/env tclsh | |
| ############################################################################### | |
| # BRLTTY - A background process providing access to the console screen (when in | |
| # text mode) for a blind person using a refreshable braille display. | |
| # | |
| # Copyright (C) 1995-2023 by The BRLTTY Developers. | |
| # | |
| # BRLTTY comes with ABSOLUTELY NO WARRANTY. | |
| # | |
| # This is free software, placed under the terms of the | |
| # GNU Lesser General Public License, as published by the Free Software | |
| # Foundation; either version 2.1 of the License, or (at your option) any | |
| # later version. Please see the file LICENSE-LGPL for details. | |
| # | |
| # Web Page: http://brltty.app/ | |
| # | |
| # This software is maintained by Dave Mielke <dave@mielke.cc>. | |
| ############################################################################### | |
| source [file join [file dirname [info script]] "prologue.tcl"] | |
| proc loadProperties {file names} { | |
| set properties [dict create] | |
| set comment # | |
| set pattern {^} | |
| append pattern "${comment}([join $names |])" | |
| append pattern "\\s+(\[^\\s${comment}\]+)" | |
| append pattern "\\s*(?:${comment}\\s*(.*?))?" | |
| append pattern {\s*$} | |
| forEachLine record $file { | |
| if {[regexp $pattern $record x name code label]} { | |
| if {[string length $label] == 0} { | |
| set label $code | |
| } elseif {[set index [string first ";" $label]] >= 0} { | |
| set label [string replace $label $index end] | |
| } | |
| dict set properties $name $code $label | |
| } | |
| } | |
| return $properties | |
| } | |
| proc compareKeys {dictionary key1 key2} { | |
| set text1 [dict get $dictionary $key1] | |
| set text2 [dict get $dictionary $key2] | |
| set capitalized1 [string is upper -strict [string index $text1 0]] | |
| set capitalized2 [string is upper -strict [string index $text2 0]] | |
| if {!$capitalized1 && $capitalized2} { | |
| return -1 | |
| } | |
| if {$capitalized1 && !$capitalized2} { | |
| return 1 | |
| } | |
| return [string compare $key1 $key2] | |
| } | |
| proc makeStringArray {name items} { | |
| set lines [list] | |
| lappend lines " <string-array name=\"$name\">" | |
| foreach item $items { | |
| lappend lines " <item>$item</item>" | |
| } | |
| lappend lines " </string-array>" | |
| return $lines | |
| } | |
| proc makeResourceLines {properties name} { | |
| set property [dict get $properties $name] | |
| set prefix "[string toupper [string map {- _} $name]]_" | |
| set lines [list] | |
| lappend lines {<?xml version="1.0" encoding="utf-8"?>} | |
| lappend lines "" | |
| lappend lines "<!-- generated from $::inputFile by [file tail [info script]] -->" | |
| lappend lines "<!-- changes made here will be overwritten -->" | |
| lappend lines "" | |
| lappend lines "<resources>" | |
| set codes [list] | |
| set labels [list] | |
| foreach code [lsort -command [list compareKeys $property] [dict keys $property]] { | |
| set translatable "true" | |
| if {![string equal $code "auto"]} { | |
| if {[string equal $name "braille-driver"]} { | |
| set translatable "false" | |
| } | |
| } | |
| if {[string equal $code off]} { | |
| lvarpush codes $code | |
| lvarpush labels "@string/setting_state_$code" | |
| continue | |
| } | |
| set label "${prefix}LABEL_[string map {- _} $code]" | |
| lappend labels "@string/$label" | |
| lappend codes $code | |
| lappend lines " <string name=\"$label\" translatable=\"$translatable\">[dict get $property $code]</string>" | |
| } | |
| lappend lines "" | |
| lvarcat lines [makeStringArray "${prefix}LABELS" $labels] | |
| lappend lines "" | |
| lvarcat lines [makeStringArray "${prefix}VALUES" $codes] | |
| lappend lines "</resources>" | |
| return $lines | |
| } | |
| set optionDefinitions { | |
| } | |
| processProgramArguments optionValues $optionDefinitions positionalArguments "\[property ...\]" | |
| set propertyNames $positionalArguments | |
| if {[llength $propertyNames] == 0} { | |
| lappend propertyNames "braille-driver" | |
| lappend propertyNames "text-table" | |
| lappend propertyNames "attributes-table" | |
| lappend propertyNames "contraction-table" | |
| lappend propertyNames "keyboard-table" | |
| } | |
| if {[llength $propertyNames] == 0} { | |
| syntaxError "property names not specified" | |
| } | |
| set inputFile "brltty.conf.in" | |
| set inputPath [file join $sourceRoot Documents $inputFile] | |
| logNote "loading properties: $inputPath" | |
| set properties [loadProperties $inputPath $propertyNames] | |
| foreach name $propertyNames { | |
| if {![dict exists $properties $name]} { | |
| syntaxError "unknown property name: $name" | |
| } | |
| } | |
| set updated 0 | |
| foreach propertyName $propertyNames { | |
| set resourceFile "[string tolower $propertyName].xml" | |
| set resourcePath [file join $applicationDirectory res values $resourceFile] | |
| logNote "writing resource file: $resourcePath" | |
| if {[updateFile $resourcePath "[join [makeResourceLines $properties $propertyName] \n]\n"]} { | |
| set updated 1 | |
| } | |
| } | |
| if {!$updated} { | |
| logMessage task "no files updated" | |
| } | |
| exit 0 |