Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
Comment: | Add better chain support |
---|---|
Timelines: | family | ancestors | descendants | both | trunk |
Files: | files | file ages | folders |
SHA1: |
985b47981cab9b74a7ec11a02079317e |
User & Date: | bernd 2019-07-05 14:51:28.521 |
Context
2019-07-05
| ||
15:01 | Add better chain support check-in: 8afee7be22 user: bernd tags: trunk | |
14:51 | Add better chain support check-in: 985b47981c user: bernd tags: trunk | |
2019-07-04
| ||
21:50 | Start implementing commands in GUI mode check-in: 581eb4c544 user: bernd tags: trunk | |
Changes
Changes to classes.fs.
︙ | ︙ | |||
138 139 140 141 142 143 144 | $value: name$ \ group name $value: id$ field: peers[] field: keys[] field: log[] field: mode \ mode bits: | | < | 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 | $value: name$ \ group name $value: id$ field: peers[] field: keys[] field: log[] field: mode \ mode bits: 1 4 bits: otr# redate# lock# visible# : bit-ops: ( bit -- ) parse-name [{: d: name :}l name rot [: emit type ;] $tmp nextname ;] {: xt: gen-name :} '+' gen-name create dup , [: @ mode or! ;] set-does> '-' gen-name create dup , [: @ invert mode and! ;] set-does> '?' gen-name create , [: @ mode @ and 0<> ;] set-does> ; otr# bit-ops: otr redate# bit-ops: redate lock# bit-ops: lock visible# bit-ops: visible method start method tag method chain |
︙ | ︙ |
Changes to gui.fs.
︙ | ︙ | |||
406 407 408 409 410 411 412 413 414 415 416 417 418 419 | $33883366 new-color: day-color $88333366 new-color: hour-color $FFFFFFFF text-color: realwhite $FFFFFFFF new-color: edit-bg $80FF80FF new-color: send-color $00FF0020 new-color: pet-color $FFFF80FF new-color, fvalue users-color# : nick[] ( box o:nick -- box ) [: data >o ." clicked on " ke-nick $. cr o> ;] o click[] ; Hash: avatar# glue new Constant glue*avatar | > > | 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 | $33883366 new-color: day-color $88333366 new-color: hour-color $FFFFFFFF text-color: realwhite $FFFFFFFF new-color: edit-bg $80FF80FF new-color: send-color $00FF0020 new-color: pet-color $FFFF80FF new-color, fvalue users-color# $FFCCCCFF new-color, fvalue gps-color# $000077FF new-color, fvalue chain-color# : nick[] ( box o:nick -- box ) [: data >o ." clicked on " ke-nick $. cr o> ;] o click[] ; Hash: avatar# glue new Constant glue*avatar |
︙ | ︙ | |||
886 887 888 889 890 891 892 | [: data >o text$ o> open-url ;] over click[] click( ." url: " dup ..parents cr ) "url" name! msg-box .child+ ; wmsg-class to msg:url :noname { d: string -- o } {{ | | > > > > > > > | 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 | [: data >o text$ o> open-url ;] over click[] click( ." url: " dup ..parents cr ) "url" name! msg-box .child+ ; wmsg-class to msg:url :noname { d: string -- o } {{ glue*l gps-color# slide-frame dup .button1 string [: ." GPS: " .coords ;] $tmp }}text 25%b }}z "gps" name! msg-box .child+ ; wmsg-class to msg:coord :noname { d: string -- o } {{ glue*l chain-color# slide-frame dup .button1 string sighash? IF re-green ELSE obj-red THEN string [: ." <" drop le-64@ .ticks ;] $tmp }}text 25%b }}z "chain" name! msg-box .child+ ; wmsg-class to msg:chain :noname { d: pk -- o } {{ x-color { f: xc } pk key| 2dup 0 .pk@ key| str= last-otr? IF IF my-signal-otr ELSE other-signal-otr THEN ELSE IF my-signal ELSE other-signal THEN THEN |
︙ | ︙ |
Changes to msg.fs.
︙ | ︙ | |||
343 344 345 346 347 348 349 | $20 net2o: msg-start ( $:pksig -- ) \g start message 1 !!>order? $> msg:start ; +net2o: msg-tag ( $:tag -- ) \g tagging (can be anywhere) $> msg:tag ; +net2o: msg-id ( $:id -- ) \g a hash id 2 !!>=order? $> msg:id ; +net2o: msg-chain ( $:dates,sighash -- ) \g chained to message[s] | | | 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 | $20 net2o: msg-start ( $:pksig -- ) \g start message 1 !!>order? $> msg:start ; +net2o: msg-tag ( $:tag -- ) \g tagging (can be anywhere) $> msg:tag ; +net2o: msg-id ( $:id -- ) \g a hash id 2 !!>=order? $> msg:id ; +net2o: msg-chain ( $:dates,sighash -- ) \g chained to message[s] ( $10 !!>=order? ) $> msg:chain ; +net2o: msg-signal ( $:pubkey -- ) \g signal message to one person $> msg:signal ; +net2o: msg-re ( $:hash ) \g relate to some object 4 !!>=order? $> msg:re ; +net2o: msg-text ( $:msg -- ) \g specify message string 8 !!>=order? $> msg:text ; +net2o: msg-object ( $:object type -- ) \g specify an object, e.g. an image |
︙ | ︙ | |||
1165 1166 1167 1168 1169 1170 1171 | also net2o-base \ chain messages to one previous message : chain, ( msgaddr u -- ) [: 2dup startdate@ 64#0 { 64^ sd } sd le-64! sd 1 64s forth:type c:0key sigonly@ >hash hashtmp hash#128 forth:type ;] $tmp $, msg-chain ; | < < < < < | | 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 | also net2o-base \ chain messages to one previous message : chain, ( msgaddr u -- ) [: 2dup startdate@ 64#0 { 64^ sd } sd le-64! sd 1 64s forth:type c:0key sigonly@ >hash hashtmp hash#128 forth:type ;] $tmp $, msg-chain ; : (send-avalanche) ( xt -- addr u flag ) [: 0 >o [: sign[ msg-start execute msg> ;] gen-cmd$ o> +last-signed msg-log, ;] [group] ; previous : send-avalanche ( xt -- ) msg-group-o .msg:?otr IF now>otr ELSE now>never THEN (send-avalanche) >r .chat r> 0= IF .nobody THEN ; |
︙ | ︙ | |||
1310 1311 1312 1313 1314 1315 1316 | \G me: send remaining string as action umethod /away ( addr u -- ) \U away [<action>] send string or "away from keyboard" as action \G away: send string or "away from keyboard" as action synonym /back /away umethod /otr ( addr u -- ) \U otr on|off|message turn otr mode on/off (or one-shot) | < < | 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 | \G me: send remaining string as action umethod /away ( addr u -- ) \U away [<action>] send string or "away from keyboard" as action \G away: send string or "away from keyboard" as action synonym /back /away umethod /otr ( addr u -- ) \U otr on|off|message turn otr mode on/off (or one-shot) umethod /peers ( addr u -- ) \U peers list peers \G peers: list peers in all groups umethod /gps ( addr u -- ) \U gps send coordinates \G gps: send your coordinates synonym /here /gps |
︙ | ︙ | |||
1411 1412 1413 1414 1415 1416 1417 | ." otr mode ===" <default> forth:cr ELSE rdrop msg-group-o .msg:mode @ >r msg-group-o .msg:+otr avalanche-text r> msg-group-o .msg:mode ! THEN ; is /otr | < < < < < < < < < | 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 | ." otr mode ===" <default> forth:cr ELSE rdrop msg-group-o .msg:mode @ >r msg-group-o .msg:+otr avalanche-text r> msg-group-o .msg:mode ! THEN ; is /otr :noname ( addr u -- ) 2drop [: msg:name$ .group ." : " msg:peers[] $@ bounds ?DO space I @ >o .con-id space ack@ .rtdelay 64@ 64>f 1n f* (.time) o> cell +LOOP forth:cr ;] group#map ; is /peers |
︙ | ︙ | |||
1556 1557 1558 1559 1560 1561 1562 1563 1564 1565 1566 1567 1568 1569 1570 | 2>r over ?flush-text + to last->in 2r> [: \ ." signal: '" 85type ''' forth:emit forth:cr $, msg-signal ;] rectype-name THEN ELSE 2drop rectype-null THEN ; : http-rec ( addr u -- ) 2dup "https://" string-prefix? >r 2dup "http://" string-prefix? r> or IF over ?flush-text 2dup + to last->in [: $, msg-url ;] rectype-name ELSE 2drop rectype-null THEN ; $Variable msg-recognizer | > > > > > > > > > > > > > > > > | | 1540 1541 1542 1543 1544 1545 1546 1547 1548 1549 1550 1551 1552 1553 1554 1555 1556 1557 1558 1559 1560 1561 1562 1563 1564 1565 1566 1567 1568 1569 1570 1571 1572 1573 1574 1575 1576 1577 1578 | 2>r over ?flush-text + to last->in 2r> [: \ ." signal: '" 85type ''' forth:emit forth:cr $, msg-signal ;] rectype-name THEN ELSE 2drop rectype-null THEN ; : chain-rec ( addr u -- ) over c@ '!' = IF 2dup 1 /string dup 0= IF 2drop rectype-null EXIT THEN snumber? case 0 of endof -1 of msg-group-o .msg:log[] $[]# over abs over u< IF over 0< IF + ELSE drop THEN >r over ?flush-text + to last->in r> [: msg-group-o .msg:log[] $[]@ chain, ;] rectype-name EXIT THEN endof 2drop endcase THEN 2drop rectype-null ; : http-rec ( addr u -- ) 2dup "https://" string-prefix? >r 2dup "http://" string-prefix? r> or IF over ?flush-text 2dup + to last->in [: $, msg-url ;] rectype-name ELSE 2drop rectype-null THEN ; $Variable msg-recognizer ' text-rec ' http-rec ' chain-rec ' tag-rec ' pk-rec 5 msg-recognizer set-stack : parse-text ( addr u -- ) last# >r forth-recognizer >r 0 to last->in msg-recognizer to forth-recognizer 2dup evaluate last->in IF + last->in tuck - THEN dup IF \ ." text: '" forth:type ''' forth:emit forth:cr $, msg-text |
︙ | ︙ |