Commit fb3f43d9 authored by Bernd Paysan's avatar Bernd Paysan

Implement /logstyle for GUI

parent 4bfef09b
......@@ -626,6 +626,7 @@ Variable last-bubble-pk
0 Value last-otr?
0 Value last-bubble
64#0 64Value last-tick
64#-1 64Value end-tick
#300 #1000000000 um* d>64 64Constant delta-bubble
: >bubble-border ( o me? -- )
......@@ -834,11 +835,43 @@ 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#-date-token ( log-mask -- o ) >r
{{
[: '#' emit log# 0 u.r ;] $tmp }}text /left
>r {{ r> }}v 25%bv "log#" name! r@ log#num and 0= IF /flip THEN
[: '<' emit last-tick .ticks ;] $tmp }}text /left
>r {{ r> }}v 25%bv
r@ log#perm and IF "perm#" ELSE "date#" THEN name!
r@ log#date and 0= IF /flip THEN
[: '>' emit end-tick .ticks ;] $tmp }}text /left
>r {{ r> }}v 25%bv "end#" name! r> log#end and 0= IF /flip THEN
}}v box[] ;
: ?flip ( flag -- ) IF o /flop ELSE o /flip THEN drop ;
Variable re-indent#
: re-box-run ( -- ) recursive
gui( re-indent# @ spaces name$ type cr )
log-mask @ >r
name$ "log#" str= IF r> log#num and ?flip EXIT THEN
name$ "date#" str= IF r> log#date and ?flip EXIT THEN
name$ "end#" str= IF r> log#end and ?flip EXIT THEN
rdrop
hbox vbox zbox o cell- @ tuck = >r tuck = >r = r> r> or or IF
1 re-indent# +! ['] re-box-run do-childs
-1 re-indent# +!
THEN ;
: re-log#-token ( -- )
['] re-box-run msgs-box .do-childs
[: +resize +sync ;] msgs-box .vp-needed ;
' re-log#-token is update-log
: new-msg-par ( -- )
{{ }}p "msg-par" name!
dup .subbox box[] drop box[] cbl >bl
dup .subbox "msg-box" name!
to msg-box to msg-par ;
to msg-box to msg-par
\script cbl re-green log-mask @ +log#-date-token msg-box .child+
\normal cbl ;
:noname { d: pk -- o }
pk key| to msg:id$ pk startdate@ to msg:timestamp
pk [: .simple-id ." : " ;] $tmp notify-nick!
......@@ -846,6 +879,7 @@ Variable emojis$ "👍👎🤣😍😘😛🤔😭😡😱🔃" emojis$ $! \
pk enddate@ otr? { otr }
pk key| last-bubble-pk $@ str= otr last-otr? = and
pk startdate@ last-tick 64over to last-tick
pk enddate@ to end-tick
64- delta-bubble 64< and
IF
new-msg-par
......@@ -950,7 +984,7 @@ Variable emojis$ "👍👎🤣😍😘😛🤔😭😡😱🔃" emojis$ $! \
{{
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
log#date log#perm or +log#-date-token
}}z "chain" name! msg-box .child+
; wmsg-class is msg:chain
:noname { d: pk -- o }
......@@ -1182,7 +1216,7 @@ wmsg-o >o msg-table @ token-table ! o>
+sync +resize o> ;
' wmsg-display wmsg-class is msg:display
#128 Value gui-msgs# \ display last 128 messages
#200 Value gui-msgs# \ display last 200 messages
0 Value chat-edit \ chat edit field
0 Value chat-edit-bg \ chat edit background
......@@ -1195,6 +1229,7 @@ wmsg-o >o msg-table @ token-table ! o>
load-msg msg-log@
{ log u } u gui-msgs# cells - 0 max { u' } log u' wmsg-o .?search-lock
log u u' /string bounds ?DO
I log - cell/ to log#
I $@ { d: msgt }
msgt ['] wmsg-display wmsg-o .catch IF
<err> ." invalid entry" <default> 2drop
......
......@@ -321,7 +321,7 @@ Forward msg:last
over le-64@ 64#1 64+ date>i' >r [ 1 64s ]L /string
r> r> U+DO
c:0key I msg-group-o .msg:log[] $[]@ sigonly@ >hash
2dup hashtmp over str= IF 2drop true UNLOOP EXIT
2dup hashtmp over str= IF I to log# 2drop true UNLOOP EXIT
ELSE ( 2dup 85type ." <> " hashtmp over 85type ) THEN
LOOP
2drop false ;
......@@ -381,12 +381,20 @@ msg-table $save
' context-table is gen-table
\ Code for displaying messages
\ 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
: .otr-info ( -- )
<info> ." [otr] " <default> "[otr] " notify+ notify-otr? on ;
: .otr-err ( -- )
......@@ -399,14 +407,21 @@ Defer .log-end
2dup printable? IF forth:type ELSE ." @" .key-id THEN ;
scope: logstyles
: +num [: '#' emit log# u. ;] is .log-num ;
: -num ['] noop is .log-num ;
: +date [: .ticks space ;] is .log-date ;
: -date ['] 64drop is .log-date ;
: +end [: 64dup .ticks space .otr ;] is .log-end ;
: -end ['] .otr is .log-end ;
: +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 ;
+date -num -end
log-mask off
}scope
:noname ( addr u -- )
......@@ -1441,8 +1456,9 @@ umethod /log ( addr u -- )
umethod /logstyle ( addr u -- )
\U logstyle [+-style] set log style
\G logstyle: set log styles, the following settings exist:
\G logstyle: +date a date per log line
\G logstyle: +num a message number per log line
\G logstyle: +num the message number per log line
\G logstyle: +date the date per log line
\G logstyle: +end the end date per log line
umethod /otrify ( addr u -- )
\U otrify #line[s] otrify message
\G otrify: turn an older message of yours into an OTR message
......@@ -1567,7 +1583,9 @@ is /help
r> display-lastn ; is /log
:noname ( addr u -- )
['] logstyles evaluate-in ; is /logstyle
['] logstyles ['] evaluate-in catch IF
2drop drop "logstyle" /help
THEN ; is /logstyle
:noname ( addr u -- )
[: BEGIN bl $split 2>r dup WHILE s>number? WHILE
......@@ -1686,7 +1704,7 @@ forward hash-in
4 /string save-mem over >r 2dup jpeg? IF
2dup >thumbnail
?dup-IF over >r hash-in
[: forth:type img-orient @ 1- forth:emit ;] $tmp
[: forth:type img-orient @ 1- 0 max forth:emit ;] $tmp
r> free throw THEN
ELSE #0. THEN
2swap slurp-file over >r hash-in r> free throw 2swap
......
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