Commit 806a49d0 authored by Bernd Paysan's avatar Bernd Paysan

Show output of chat commands in GUI

parent fb3f43d9
......@@ -36,6 +36,7 @@ $FFFFBBFF re-text-color link-blue
$88FF88FF re-text-color re-green
$FF8888FF re-text-color obj-red
$444444FF re-color edit-bg
$202020C0 re-color log-bg
$408040FF re-color send-color
$333333FF re-color users-color#
$000000CC re-color album-bg-col#
......
......@@ -374,6 +374,7 @@ $33883366 new-color: day-color
$88333366 new-color: hour-color
$FFFFFFFF text-color: realwhite
$FFFFFFFF new-color: edit-bg
$808080C0 new-color: log-bg
$80FF80FF new-color: send-color
$00FF0020 new-color: pet-color
$FFFF80FF new-color, fvalue users-color#
......@@ -835,6 +836,9 @@ Variable emojis$ "👍👎🤣😍😘😛🤔😭😡😱🔃" emojis$ $! \
0 Value nobody-online-text \ nobody is online warning
:noname 2e nobody-online-text [: f2* sin-t .fade +sync ;] >animate
; wmsg-class is msg:.nobody
log-mask off \ in GUI mode, default is no marking
: +log#-date-token ( log-mask -- o ) >r
{{
[: '#' emit log# 0 u.r ;] $tmp }}text /left
......@@ -1241,11 +1245,13 @@ wmsg-o >o msg-table @ token-table ! o>
: gui-msgs ( gaddr u -- )
2dup msg-group$ $! (gui-msgs) ;
: re-msg-box ( -- )
msgs-box >o [: +sync +resize ;] vp-needed vp-bottom
+sync +resize o> ;
: msg-wredisplay ( n -- )
drop 0 msg-group-o .msg:mode
[: msg-group$ $@ (gui-msgs) ;] !wrapper
msgs-box >o [: +sync +resize ;] vp-needed vp-bottom
+sync +resize o> ;
re-msg-box ;
' msg-wredisplay wmsg-class is msg:redisplay
[IFDEF] android also android [THEN]
......@@ -1315,6 +1321,58 @@ wmsg-o >o msg-table @ token-table ! o>
[IFDEF] android previous [THEN]
\ chat command redirection
align
here
' (type) A,
' (emit) A,
' (cr) A,
' (form) A,
' noop A, \ page
' 2drop A, \ at-xy
' 2drop A, \ at-deltaxy
' drop A, \ attr!
A, here AConstant simple-out
: simple-outfile-execute ( ... xt file-id -- ... ) \ gforth
\G execute @i{xt} with the output of @code{type} etc. redirected to
\G @i{file-id}.
op-vector @ outfile-id { oldout oldfid } try
simple-out op-vector !
to outfile-id execute 0
restore
oldfid to outfile-id
oldout op-vector !
endtry
throw ;
: createfile-execute ( ... xt addr u -- ...' )
r/w create-file throw >r
r@ ['] simple-outfile-execute catch
r> close-file throw throw ;
Variable gui-log[]
: chat-gui-exec ( xt -- )
"gui-cmd.log" .net2o-cache/ createfile-execute
"gui-cmd.log" .net2o-cache/ gui-log[] $[]slurp-file
{{
glue*lll log-bg x-color font-size# 40% f* }}frame dup .button3
\normal \mono blackish
{{
gui-log[] [: }}text /left ;] $[]map
}}v box[] 25%b
{{
s" " $444444FF new-color, }}text 25%b /right dup { closer }
glue*ll }}glue
}}v box[]
}}z box[] >r
closer [: data msgs-box .childs[] del$cell re-msg-box ;] r@ click[] drop
r> msgs-box .child+ re-msg-box ;
' chat-gui-exec is chat-cmd-file-execute
\ top box
box-actor class
......@@ -1413,13 +1471,16 @@ Variable invitation-stack
pw-field engage
1e ambient% sf! set-uniforms ;
: net2o-gui ( -- )
[IFDEF] x11
[IFDEF] x11
: set-net2o-hints ( -- )
dpy win l" net2o GUI" locale@ x11:XStoreName drop
{ | net2o-wm-class[ x11:XClassHint ] }
"net2o-gui\0" drop dup net2o-wm-class[ 2!
dpy win net2o-wm-class[ x11:XSetClassHint drop
[THEN]
dpy win net2o-wm-class[ x11:XSetClassHint drop ;
[THEN]
: net2o-gui ( -- )
[IFDEF] set-net2o-hints set-net2o-hints [THEN]
n2o-frame to top-widget
"PASSPHRASE" getenv 2dup d0= IF 2drop
ELSE
......
......@@ -383,15 +383,6 @@ msg-table $save
\ Code for displaying messages: logstyle for TUI deferred-based
Defer .log-num
Defer .log-date
Defer .log-end
\ logstyle for GUI bitmask-based
Defer update-log
' noop is update-log
Variable log-mask
1 4 bits: log#num log#date log#end log#perm
......@@ -403,25 +394,31 @@ Variable log-mask
64dup 64#-1 64= IF 64drop notify-otr? off EXIT THEN
ticks 64- 64dup fuzzedtime# 64negate 64< IF 64drop .otr-err EXIT THEN
otrsig-delta# fuzzedtime# 64+ 64< IF .otr-info THEN ;
: .log-num ( -- )
log-mask @ log#num and IF '#' emit log# u. THEN ;
: .log-date ( 64ticks -- )
log-mask @ log#date and IF .ticks space ELSE 64drop THEN ;
: .log-end ( 64ticks -- )
log-mask @ log#end and IF 64dup .ticks space THEN .otr ;
\ logstyle for GUI bitmask-based
Defer update-log
' noop is update-log
: .group ( addr u -- )
2dup printable? IF forth:type ELSE ." @" .key-id THEN ;
scope: logstyles
: +num [: '#' emit log# u. ;] is .log-num
log#num log-mask or! update-log ;
: -num ['] noop is .log-num
log#num invert log-mask and! update-log ;
: +date [: .ticks space ;] is .log-date
log#date log-mask or! update-log ;
: -date ['] 64drop is .log-date
log#date invert log-mask and! update-log ;
: +end [: 64dup .ticks space .otr ;] is .log-end
log#end log-mask or! update-log ;
: -end ['] .otr is .log-end
log#end invert log-mask and! update-log ;
: +num log#num log-mask or! update-log ;
: -num log#num invert log-mask and! update-log ;
: +date log#date log-mask or! update-log ;
: -date log#date invert log-mask and! update-log ;
: +end log#end log-mask or! update-log ;
: -end log#end invert log-mask and! update-log ;
+date -num -end
log-mask off
}scope
:noname ( addr u -- )
......@@ -1632,11 +1629,15 @@ msg:troll# 't' permchar>bits + c!
: ?slash ( addr u -- addr u flag )
over c@ dup '/' = swap '\' = or ;
Defer chat-cmd-file-execute
' execute is chat-cmd-file-execute
: do-chat-cmd? ( addr u -- t / addr u f )
?slash dup 0= ?EXIT drop
over '/' swap c! bl $split 2swap
2dup ['] /chat >body find-name-in
?dup-IF nip nip name>int execute true
bl $split 2swap
2dup save-mem over >r '/' r@ c!
['] /chat >body find-name-in r> free throw
?dup-IF nip nip name>int chat-cmd-file-execute true
ELSE drop 1- -rot + over - false
THEN ;
......
......@@ -156,15 +156,8 @@ Defer run-gui
Defer run-scan-qr
:noname ." scan-qur not implemented" cr ; is run-scan-qr
$Variable gui.fs$
"gui.fs" open-fpath-file 0= [IF] rot close-file throw gui.fs$ $! [THEN]
$Variable qrscan.fs$
"qrscan.fs" open-fpath-file 0= [IF] rot close-file throw qrscan.fs$ $! [THEN]
$Variable parser.fs$
"json/parser.fs" open-fpath-file 0= [IF] rot close-file throw parser.fs$ $! [THEN]
scope: importer
: g+ parser.fs$ $@ required
: g+ [ "json/parser.fs" ]path required
?nextarg 0= IF "." THEN "g+-import" evaluate ;
}scope
......@@ -203,7 +196,7 @@ scope{ n2o
\G keyscan: scan a key in color QR form
?.net2o-config
reset-net2o-cmds
qrscan.fs$ $@ dup IF required ELSE no-file# throw THEN run-scan-qr
[ "qrscan.fs" ]path required run-scan-qr
save-net2o-cmds set-net2o-cmds ;
: keysearch ( -- )
......@@ -781,7 +774,7 @@ warnings !
\G gui: start net2o's graphical user interface
?.net2o-config
reset-net2o-cmds
gui.fs$ $@ dup IF required ELSE no-file# throw THEN run-gui
[ "gui.fs" ]path required run-gui
save-net2o-cmds set-net2o-cmds ;
: ... ( -- )
......
......@@ -456,6 +456,9 @@ $1000.0000. patchlimit& 2! \ 256MB patch limit size
#50.000.000.000. beacon-ticks& 2!
#2.000.000.000. beacon-short-ticks& 2!
: ]path ( addr u -- )
open-fpath-file throw rot close-file throw ] ]] sliteral [[ ;
: .net2o-config/ ( addr u -- addr' u' ) [: .net2o-config$ $. '/' emit type ;] $tmp ;
: .net2o-cache/ ( addr u -- addr' u' ) [: .net2o-cache$ $. '/' emit type ;] $tmp ;
: ~net2o-cache/ ( addr u -- )
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment