Patch title: Release 95 bulk changes
Abstract:
File: /pliant/language/type/text/language.pli
Key:
    Removed line
    Added line
# Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx

module "/pliant/language/compiler.pli"
module "/pliant/language/schedule/threads_engine.pli"
module "/pliant/language/parser.pli"
module "/pliant/admin/file.pli"
module "/pliant/language/stream.pli"

gvar Array:Str languages
gvar (Dictionary Str Int) mapping
gvar Sem sem

languages += "en"
mapping insert "en" 0


function language_declare name -> index
  arg Str name ; arg Int index
  sem request
  var Pointer:Int pindex :> mapping first name
  if exists:pindex
    index := pindex
  else
    index := mapping size
    languages += name
    mapping insert name index
  sem release

function language_index name -> index
  arg Str name ; arg Int index
  sem rd_request
  var Pointer:Int pindex :> mapping first name
  index := shunt exists:pindex pindex (cast undefined Int)
  sem rd_release

function language_list -> langs
  arg Array:Str langs
  sem rd_request
  langs := languages
  sem rd_release


type lStr
  field Address buffer
  field Int nlang


function build l
  arg_w lStr l
  l buffer := null
  l nlang := 0

function destroy l
  arg_w lStr l
  memory_free l:buffer

function copy s d
  arg lStr s ; arg_w lStr d
  var Int size := s:nlang*Int:size+(shunt s:nlang=0 0 (s:buffer map Int s:nlang-1))
  memory_free d:buffer
  d buffer := memory_allocate size addressof:d
  memory_copy s:buffer d:buffer size
  d nlang := s nlang


method l set lang value
  arg_rw lStr l ; arg Int lang ; arg Str value
  check lang>=0 and lang<mapping:size
  var Int len
  if lang>=0 and lang<l:nlang
    var Int off := shunt lang<>0 (l:buffer map Int lang-1) 0
    len := (l:buffer map Int lang)-off
  else
    len := 0
  len := (shunt l:nlang=0 0 (l:buffer map Int l:nlang-1))+value:len-len
  var Int nlang := max l:nlang lang+1
  var Address buffer := memory_allocate nlang*Int:size+len addressof:l
  var Int offset := 0
  for (var Int i) 0 nlang-1
    var Address src ; var Int len
    if i=lang
      len := value len
      src := value characters
    eif i<l:nlang
      var Int off := shunt i<>0 (l:buffer map Int i-1) 0
      len := (l:buffer map Int i)-off
      src := (l:buffer translate Int l:nlang) translate Char off
    else
      len := 0
    memory_copy src ((buffer translate Int nlang) translate Char offset) len
    offset += len
    buffer map Int i := offset
  memory_free l:buffer
  l buffer := buffer
  l nlang := nlang


method l set lang value
  arg_rw lStr l ; arg Str lang ; arg Str value
  var Int index := language_index lang
  if index<>undefined
    l set index value


method l get lang -> s
  arg lStr l ; arg Int lang ; arg Str s
  check lang>=0
  if lang<l:nlang
    var Int offset := shunt lang<>0 (l:buffer map Int lang-1) 0
    var Int len := (l:buffer map Int lang)-offset
    s set ((l:buffer translate Int l:nlang) translate Char offset) len false
  else
    s := ""
((the_function '. get' lStr Int -> Str) arg 2) maps := 1

method l get lang -> value
  arg lStr l ; arg Str lang ; arg Str value
  var Int index := language_index lang
  if index<>undefined
    value := l get index
  else
    value := ""
((the_function '. get' lStr Str -> Str) arg 2) maps := 1


function 'cast Str' l -> s
  arg lStr l ; arg Str s
  extension
  var Int index := current_thread_header language_index
  s := l get index
  if s:len=0 and index<>0
    s := l get 0
((the_function 'cast Str' lStr -> Str) arg 1) maps := 1


export language_declare language_index language_list
export lStr '. get' '. set'
export 'cast Str'


function parse_lstr context line parameter
  arg_rw ParserContext context ; arg Str line ; arg Address parameter
  if (line 0 1)<>"[dq]"
    return
  var Int i := 1
  var Link:lStr l :> new lStr
  var Str lang := "en"
  var CBool some := false
  while i<line:len
    if line:i="[dq]"
      if some
        var Str name := context:module name
        name := name 0 (name search_last "." name:len)
        var Array:FileInfo files := file_list (name 0 (name search_last "/" name:len)+1) standard
        for (var Int j) 0 files:size-1
          var Str ext := files:j:extension
          if (files:j:name 0 name:len)=name and files:j:name<>context:module:name and (ext 0 1)="."
            (var Stream file) open files:j:name in+safe
            while not file:atend
              if (file:readline parse (var Str en) (var Str translation))
                if en=(l get 0)
                  language_declare (ext 1 ext:len)
                  l set (ext 1 ext:len) translation
        context add_token addressof:l
        context forward i+1
      return
    eif line:i="[lb]"
      if ((line i line:len) eparse "[lb]" any:(var Str code) "[rb]" any)
        if code="l"
          some := true
        eif code:len>0 and (code code:len-1)=":"
          lang := code 0 code:len-1 ; language_declare lang ; some := true
        eif ("[dq][lb]"+code+"[rb][dq]" parse (var Str char))
          l set lang (l get lang)+char
        else
          return
        i += 2+code:len
      else
        return
    else
      l set lang (l get lang)+line:i
      i += 1

gvar ParserFilter lstr_filter
lstr_filter function :> the_function parse_lstr ParserContext Str Address
constant 'pliant parser basic types' lstr_filter
export 'pliant parser basic types'


function language_encode l -> s
  arg lStr l ; arg Str s
  s := ""
  for (var Int i) 0 l:nlang-1
    var Str v := l get i
    if v:len>0
      s += (shunt s:len>0 " " "")+languages:i+" "+string:v

function language_decode s create_langs -> l
  arg Str s ; arg CBool create_langs ; arg lStr l
  l := var lStr empty_string
  var Str all := s
  while (all parse any:(var Str lang) _ (var Str value) any:(var Str remain))
    if create_langs
      l set lang value
    else
      var Int index := language_index lang
      if index<>undefined
        l set index value
    all := remain

export language_encode language_decode


method data 'to string' options -> string
  arg lStr data ; arg Str options ; arg Str string
  if options="raw"
    string := language_encode data
  eif options="db" or options="con"
    string := cast data Str
  else
    string := string (cast data Str)

method data 'from string' string options may_skip skiped offset -> status
  arg_w lStr data ; arg Str string options ; arg CBool may_skip ; arg_w Int skiped offset ; arg Status status
  if options="raw"
    data := language_decode string false
    skiped := 0
    offset := string len
    return success
  eif options="db" or options="con"
    data set (current_thread_header language_index) string
    skiped := 0
    offset := string len
    return success
  else
    var Link:Str s :> new Str
    status := s 'from string' string options may_skip skiped offset
    data set (current_thread_header language_index) s