| #!/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 |