Check-in [557d941bc0]
Not logged in

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:More fixes for chat structure
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 557d941bc098d518be00f0add1a365b6a6172af7
User & Date: bernd 2019-06-21 12:43:23
Context
2019-06-21
20:33
GUI changes to reflect new chat data types check-in: a1fda02aed user: bernd tags: trunk
12:43
More fixes for chat structure check-in: 557d941bc0 user: bernd tags: trunk
2019-06-20
22:13
Replace msg-logs by msg:log[] check-in: 2326543d3a user: bernd tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to dvcs.fs.

911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
$20 /sync-files * Constant /sync-reqs

: dvcs-sync-none ( -- )
    -1 dvcs-request# +!@ 0<= IF  dvcs-request# off  THEN ;

event: :>dvcs-sync-done ( o -- ) >o
    file-reg# off  file-count off
    msg-group$ $@ ?save-msg  0 dvcs-request# !
    msg( ." === metadata sync done ===" forth:cr ) o> ;

: dvcs-sync-done ( -- )
    msg( ." dvcs-sync-done" forth:cr )
    net2o:close-all
    msg( ." dvcs-sync-done closed" forth:cr )
    <event o elit, :>dvcs-sync-done wait-task @ event> ;







|







911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
$20 /sync-files * Constant /sync-reqs

: dvcs-sync-none ( -- )
    -1 dvcs-request# +!@ 0<= IF  dvcs-request# off  THEN ;

event: :>dvcs-sync-done ( o -- ) >o
    file-reg# off  file-count off
    msg-group$ $@ >group ?save-msg  0 dvcs-request# !
    msg( ." === metadata sync done ===" forth:cr ) o> ;

: dvcs-sync-done ( -- )
    msg( ." dvcs-sync-done" forth:cr )
    net2o:close-all
    msg( ." dvcs-sync-done closed" forth:cr )
    <event o elit, :>dvcs-sync-done wait-task @ event> ;

Changes to msg.fs.

79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
...
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
...
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
...
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
      cell +LOOP ;]
    gen-cmd ;

Variable saved-msg$
64Variable saved-msg-ticks

: save-msgs ( group-o -- ) to msg-group-o
    msg( ." Save messages" cr )
    ?.net2o/chats  net2o:new-msging >o
    msg-log@ over >r  serialize-log enc-file $!buf
    r> free throw  dispose o>
    msg-group-o .msg:name$ >chatid .chats/ enc-filename $!
    pk-off  key-list encfile-rest ;

: save-all-msgs ( -- )
................................................................................
	dup 0= IF  drop ?file-task  THEN  event>  THEN ;

: !save-all-msgs ( -- )
    syncfile( save-all-msgs )else(
    <event :>save-all-msgs ?file-task event| ) ;

: save-msgs& ( -- )
    syncfile( last# saved-msg$ +unique$ )else(
    <event msg-group-o elit, :>save-msgs ?file-task event> ) ;

0 Value log#
2Variable last-msg

: +msg-log ( addr u -- addr' u' / 0 0 )
    [: msg-group-o .msg:log[] $ins[]date  dup  dup 0< xor to log#
	log# msg-group-o .msg:log[] $[]@ last-msg 2!
	0< IF  #0.  ELSE  last-msg 2@  THEN
    ;] msglog-sema c-section ;
: ?save-msg ( addr u -- )
    >group
    otr-mode @ replay-mode @ or 0= IF  save-msgs&  THEN ;

Sema queue-sema

\ peer queue, in msg context

: peer> ( -- addr / 0 )
................................................................................
\ events

msg-class class end-class msg-notify-class

msg-notify-class ' new static-a with-allocater Constant msg-notify-o

: >msg-log ( addr u -- addr' u )
    last# >r +msg-log last# ?dup-IF  $@ ?save-msg  THEN  r> to last# ;

: do-msg-nestsig ( addr u -- )
    2dup msg-group-o .msg:display
    msg-notify-o .msg:display ;

: display-lastn ( n -- )
    msg-group-o .msg:redisplay ;
................................................................................
    ." === sync done ===" forth:cr sync-done-xt ;
event: :>msg-eval ( parent $pack $addr -- )
    { w^ buf w^ group }
    group $@ 2 64s /string { d: gname }
    gname >group
    msg-group-o .msg:log[] $[]# u.
    buf $@ true replay-mode ['] msg-eval !wrapper
    buf $free gname ?save-msg
    group $@ .chat-file ."  saved "
    msg-group-o .msg:log[] $[]# u. forth:cr
    >o -1 file-count +!@ 1 =
    IF  gname chat-sync-done  THEN  group $free
    o> ;
: msg-file-done ( -- )
    fs-path $@len IF







|







 







|










|
|







 







|







 







|







79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
...
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
...
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
...
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
      cell +LOOP ;]
    gen-cmd ;

Variable saved-msg$
64Variable saved-msg-ticks

: save-msgs ( group-o -- ) to msg-group-o
    msg( ." Save messages in group " msg-group-o dup hex. .msg:name$ type cr )
    ?.net2o/chats  net2o:new-msging >o
    msg-log@ over >r  serialize-log enc-file $!buf
    r> free throw  dispose o>
    msg-group-o .msg:name$ >chatid .chats/ enc-filename $!
    pk-off  key-list encfile-rest ;

: save-all-msgs ( -- )
................................................................................
	dup 0= IF  drop ?file-task  THEN  event>  THEN ;

: !save-all-msgs ( -- )
    syncfile( save-all-msgs )else(
    <event :>save-all-msgs ?file-task event| ) ;

: save-msgs& ( -- )
    syncfile( msg-group-o saved-msg$ +unique$ )else(
    <event msg-group-o elit, :>save-msgs ?file-task event> ) ;

0 Value log#
2Variable last-msg

: +msg-log ( addr u -- addr' u' / 0 0 )
    [: msg-group-o .msg:log[] $ins[]date  dup  dup 0< xor to log#
	log# msg-group-o .msg:log[] $[]@ last-msg 2!
	0< IF  #0.  ELSE  last-msg 2@  THEN
    ;] msglog-sema c-section ;
: ?save-msg ( -- )
    msg( ." saving messages in group " msg-group-o dup hex. .msg:name$ type cr )
    otr-mode @ replay-mode @ or 0= IF  save-msgs&  THEN ;

Sema queue-sema

\ peer queue, in msg context

: peer> ( -- addr / 0 )
................................................................................
\ events

msg-class class end-class msg-notify-class

msg-notify-class ' new static-a with-allocater Constant msg-notify-o

: >msg-log ( addr u -- addr' u )
    +msg-log ?save-msg ;

: do-msg-nestsig ( addr u -- )
    2dup msg-group-o .msg:display
    msg-notify-o .msg:display ;

: display-lastn ( n -- )
    msg-group-o .msg:redisplay ;
................................................................................
    ." === sync done ===" forth:cr sync-done-xt ;
event: :>msg-eval ( parent $pack $addr -- )
    { w^ buf w^ group }
    group $@ 2 64s /string { d: gname }
    gname >group
    msg-group-o .msg:log[] $[]# u.
    buf $@ true replay-mode ['] msg-eval !wrapper
    buf $free ?save-msg
    group $@ .chat-file ."  saved "
    msg-group-o .msg:log[] $[]# u. forth:cr
    >o -1 file-count +!@ 1 =
    IF  gname chat-sync-done  THEN  group $free
    o> ;
: msg-file-done ( -- )
    fs-path $@len IF