Patch title: Release 96 bulk changes
Abstract:
File: /pliant/graphic/ui/server/context.pli
Key:
    Removed line
    Added line
module "/pliant/language/compiler.pli"
module "/pliant/language/stream.pli"
module "/pliant/language/type/misc/blob.pli"

public

  type UIServerContext
    field Link:Stream connection
    field Int inside_para <- 0
    field Str url subpath
    field Link:Dictionary env
    field Link:Sem env_sem
    field Str user_name
    field CBool user_is_admin <- false ; field Int user_auth_level <- 0
    field Dictionary user_rights
    field Str current_section
    field Str event key ; field Int buttons <- undefined
    field Float pointer_x pointer_y <- undefined
    field Str pointer_section ; field Int pointer_index <- undefined
    field Float hook_size_x hook_size_y <- undefined
    field Str focus_section ; field Int focus_index <- undefined
    field Str event_options
    field Link:Stream clipboard
    field Blob clipboard_content
    field DelayedAction clipboard_handler
    field Arrow client_console # only for the windows manager

  type UIServerVariable
    field Arrow variable
    field Str data_path

  type UIServerSection
    field DelayedAction refresh
    field CBool inside <- false
    field Dictionary env

  type UIPendingThread
    field DelayedAction action
    field Link:Sem env_sem
    field Link:Dictionary env

  gvar Sem ui_thread_sem
  gvar (Dictionary Str UIPendingThread) ui_thread_dict


#-------------------------------------------------------------------------------


gvar Dictionary ui_server_instructions

named_expression ui_server_instruction_prototype
  function 'pliant ui server instruction function' context
    arg_rw UIServerContext context
    implicit context
      body

meta ui_server_instruction e
  if e:size>=2 and e:0:is_pure_ident and (e e:size-1):ident="{}"
    var Address mark := e:module mark
    var Link:Expression ee :> expression duplicate ui_server_instruction_prototype substitute parameters (e 1 e:size-2) substitute body (e e:size-1) substitute instruction (expression constant e:0:ident near e:0) near e
    error_push_record (var ErrorRecord er) error_filter_all
    ee compile
    if er:id<>error_id_noerror
      console er:message eol
      er id := error_id_noerror
      e suckup_error ee
    error_pull_record er
    var Link:Function f :> (pliant_general_dictionary first "pliant ui server instruction function") map Function
    e:module rewind mark
    if exists:f
      ui_server_instructions insert e:0:ident true addressof:f
      e set_void_result

export ui_server_instruction ui_server_instructions


#-------------------------------------------------------------------------------


gvar Dictionary ui_tree_functions
gvar Sem ui_tree_sem
gvar List:Str ui_modules

gvar Str recompile_module
gvar Dictionary backup_symbols
gvar CBool restored := true

function restore_symbols
  if restored
    return
  var Link:Module m :> (pliant_module_dictionary first recompile_module) map Module
  if not exists:m
    m :> new Module
    m name := recompile_module
    pliant_module_dictionary insert recompile_module true addressof:m
    # console "  restore module " m:name eol
  each a backup_symbols getkey k
    if entry_type:a=Type
      # console "  restore type " k eol
      pliant_general_dictionary insert2 k false a m
    eif entry_type:a=Function
      var Pointer:Function f :> a map Function
      if (f:properties first "field")<>null
        # console "  restore field " k " (" ((f:properties first "field") map Int) ")" eol
        pliant_general_dictionary insert2 k false a m
  restored := true


named_expression ui_type_prototype
  public
    type name
      body

meta ui_type e
  restore_symbols
  if e:size=2
    var Str file := e:module name ; file := file 0 (file search " (internals)" file:len)
    if recompile_module=file
      e set_void_result
    else
      e compile_as (expression duplicate ui_type_prototype substitute name e:0 substitute body e:1)


method f file -> file
  arg Function f ; arg Str file
  file := f:position:module_name ; file := file 0 (file search " (internals)" file:len)

function declare_ui_function f
  arg Function f
  var Pointer:Module m :> (pliant_module_dictionary first f:file) map Module
  if (m:properties first "datetime")<>null
    return
  m:properties insert "datetime" true addressof:(new DateTime (file_query f:file standard):datetime)
  if recompile_module=f:file
    return
  var Pointer:Str pm :> ui_modules first
  while exists:pm and pm<>recompile_module
    pm :> ui_modules next pm
  if exists:pm
    ui_modules insert_before pm f:file
  else
    ui_modules += f file

meta ui_function_declare e
  if e:size<>0
    return
  var Pointer:Function f :> (pliant_general_dictionary first "pliant function") map Function
  if exists:f or (entry_type addressof:f)=Function
    declare_ui_function f
    e set_void_result

named_expression ui_function_prototype
  method context name params
    arg_rw UIServerContext context
    ui_function_declare
    implicit context
      body
  export name2

meta ui_function e
  if e:size>=2
    e compile_as (expression duplicate ui_function_prototype substitute name e:0 substitute name2 (expression ident ". "+e:0:ident near e:0) substitute params (e 1 e:size-2) substitute body (e e:size-1))


named_expression ui_path_prototype
  function 'pliant ui path function' context
    arg_rw UIServerContext context
    implicit context
      body

meta ui_path e
  if e:size=2 and (e:0 constant Str)<>null and e:1:ident="{}"
    var Address mark := e:module mark
    var Link:Expression ee :> expression duplicate ui_path_prototype substitute body e:1 near e
    error_push_record (var ErrorRecord er) error_filter_all
    ee compile
    if er:id<>error_id_noerror
      console er:message eol
      er id := error_id_noerror
      e suckup_error ee
    error_pull_record er
    var Link:Function f :> (pliant_general_dictionary first "pliant ui path function") map Function
    e:module rewind mark
    if exists:f
      declare_ui_function f
      var Str path := (e:0 constant Str) map Str
      ui_tree_sem request
      ui_tree_functions remove path null
      ui_tree_functions insert path true addressof:f
      ui_tree_sem release
      e set_void_result

function module_recompile file errors
  arg Str file ; arg_rw List:Str errors
  console "recompiling " file eol
  recompile_module := file
  backup_symbols := var Dictionary empty_dictionary
  var Address ma := pliant_module_dictionary first file
  each a pliant_general_dictionary getkey k
    if ((addressof:a translate Arrow 1) map Address)=ma
      backup_symbols insert k false a
  each a backup_symbols getkey k
    pliant_general_dictionary remove k a
  pliant_module_dictionary remove file null
  error_push_record (var ErrorRecord e) error_filter_all
  restored := false
  pliant_load_module file the_module:"/pliant/language/basic/safe.pli" 0 (null map Module)
  if e:id<>error_id_noerror
    errors += e message
    e id := error_id_noerror
    restored := false
  error_pull_record e
  restore_symbols
  backup_symbols := var Dictionary empty_dict
  recompile_module := ""

function cascade f recompiled -> c
  arg Function f ; arg (Dictionary Str Void) recompiled ; arg CBool c
  if f:externals<>null and (entry_type f:externals)=Array
    var Pointer:Array a :> f:externals map Array
    for (var Int i) 0 a:size-1
      if (entry_type a:i)=Function
        var Pointer:Function f2 :> a:i map Function
        if (exists f2:position:module_name) and exists:(recompiled first f2:file)
          return true
  c := false

function ui_recompile -> errors
  arg List:Str errors
  errors := var List:Str empty_list
  var (Dictionary Str Void) recompiled
  pliant_compiler_semaphore request
  each file ui_modules
    var Pointer:Module m :> (pliant_module_dictionary first file) map Module
    var CBool modified := (m:properties first "datetime")=null or (file_query file standard):datetime<>((m:properties first "datetime") map DateTime)
    if not modified
      each a pliant_general_dictionary getkey k
        if ((addressof:a translate Arrow 1) map Address)=addressof:m
          if entry_type:a=Function
            if (cascade (a map Function) recompiled)
              modified := true
    if not modified
      ui_tree_sem request
      each a ui_tree_functions
        if (a map Function):file=file
          if (cascade (a map Function) recompiled)
            modified := true
      ui_tree_sem release
    if modified
      module_recompile file errors
      recompiled insert file void
  pliant_compiler_semaphore release
  

export ui_type
export ui_function ui_function_declare
export ui_path ui_tree_functions ui_tree_sem ui_recompile