Check-in [c34b95db43]
Not logged in

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

Overview
Comment:Show emojis/+ones
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: c34b95db4383c99ac8ba5d788f5cbd80500d6767
User & Date: bernd 2019-04-03 22:22:51
Context
2019-04-04
14:22
Bump version number check-in: c2c151379f user: bernd tags: trunk, 0.8.8-20190404
2019-04-03
22:22
Show emojis/+ones check-in: c34b95db43 user: bernd tags: trunk
2019-04-02
22:08
Fixes with g+ importer check-in: 088e7f93c4 user: bernd tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to gui.fs.

286
287
288
289
290
291
292
293
294

295
296
297
298
299
300
301
302
303
304
305
306
307
...
637
638
639
640
641
642
643


644
645
646


647
648
649

650

651
652
653
654










655
656
657
658
659
660
661
662
...
685
686
687
688
689
690
691






















692
693
694
695
696
697
698
699
700
701
702


703
704
705
706
707
708
709
		    {{
			pw-text-col# to x-color
			"" }}pw dup to pw-field
			25%b >o config:passmode# @ to pw-mode o o>
			glue*lll }}glue
		    }}h
		    pw-field ' pw-done edit[] ' entropy-colorize filter[]
		    {{
			\large \sans whitish "๐Ÿ‘" }}text

			\normal \bold show-sign-color# to x-color "๏ผผ" }}text dup value show-pw-sign /center blackish
		    }}z \regular
		    : pw-show/hide ( flag -- )
			dup IF  ['] transparent >body f@
			ELSE  show-sign-color#  THEN
			show-pw-sign >o to text-color o>
			2 config:passmode# @ 1 min rot select pw-field >o to pw-mode o>
			pw-field engage +sync ;
		    ' pw-show/hide config:passmode# @ 1 > toggle[]
		    \normal
		}}h box[]
	    }}z box[] bx-tab
	    {{
................................................................................

: .project ( addr u -- )
    2dup keysize /string
    2dup printable? IF  '[' emit type '@' emit
    ELSE  ." #["  85type ." /@"  THEN
    key| .key-id? ;



scope{ dvcs
dvcs-log-class class
end-class project-log-class



:noname ( addr u -- )
    + sigpksize# - [ keysize $10 + ]L dvcs-log:id$ $!

; project-log-class is msg:start

' 2drop project-log-class is msg:tag
' 2drop project-log-class is msg:id
' 2drop project-log-class is msg:text
' 2drop project-log-class is msg:action










' 2drop project-log-class is msg:chain
:noname ( addr u -- )
    [: dvcs-log:id$ $. forth:type ;] dvcs-log:urls[] dup $[]# swap $[] $exec
; project-log-class is msg:url

: new-project-log ( -- o )
    project-log-class new >o msg-table @ token-table ! o o> ;
}scope
................................................................................
	>o "project-slider" to name$ o o>
    }}v box[]
    >o "project-vbox" to name$ o o>
}}z box[]
>o "project-zbox" to name$ o o>
to post-frame























: display-title { d: prj | ki -- }
    prj key>o ?dup-IF  .ke-imports @ >im-color# sfloats to ki  THEN
    {{
	glue*l imports#rgb-bg ki + sf@ slide-frame dup .button1
	{{
	    prj key| ?avatar
	    \large imports#rgb-fg ki + sf@ to x-color
	    prj key| ['] .key-id? $tmp }}text 25%b
	    glue*ll }}glue
	    \small prj drop keysize + le-64@ [: .ticks space ;] $tmp }}text 25%b
	    \normal blackish


	}}h box[]
    }}z box[] project-vp .child+ ;

: display-file { d: prj -- }
    prj display-title
    prj [ keysize $10 + ]L safe/string
    2dup "file:" string-prefix? IF







<
|
>
|
|

<
<
|







 







>
>



>
>



>

>




>
>
>
>
>
>
>
>
>
>
|







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>











>
>







286
287
288
289
290
291
292

293
294
295
296
297


298
299
300
301
302
303
304
305
...
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
...
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
		    {{
			pw-text-col# to x-color
			"" }}pw dup to pw-field
			25%b >o config:passmode# @ to pw-mode o o>
			glue*lll }}glue
		    }}h
		    pw-field ' pw-done edit[] ' entropy-colorize filter[]

		    \normal \sans whitish
		    "๏ฐ" }}text blackish
		    dup value show-pw-sign
		    \regular
		    : pw-show/hide ( flag -- )


			dup IF  "๏ฎ"  ELSE  "๏ฐ"  THEN  show-pw-sign >o to text$ o>
			2 config:passmode# @ 1 min rot select pw-field >o to pw-mode o>
			pw-field engage +sync ;
		    ' pw-show/hide config:passmode# @ 1 > toggle[]
		    \normal
		}}h box[]
	    }}z box[] bx-tab
	    {{
................................................................................

: .project ( addr u -- )
    2dup keysize /string
    2dup printable? IF  '[' emit type '@' emit
    ELSE  ." #["  85type ." /@"  THEN
    key| .key-id? ;

hash: chain-tags#

scope{ dvcs
dvcs-log-class class
end-class project-log-class

Variable like-char

:noname ( addr u -- )
    + sigpksize# - [ keysize $10 + ]L dvcs-log:id$ $!
    like-char off
; project-log-class is msg:start
:noname ( xchar -- )  like-char ! ; project-log-class is msg:like
' 2drop project-log-class is msg:tag
' 2drop project-log-class is msg:id
' 2drop project-log-class is msg:text
' 2drop project-log-class is msg:action
:noname ( addr u -- )
    like-char @ 0= IF  2drop  EXIT  THEN
    8 umin { | w^ id+like }
    like-char @ dvcs-log:id$ $@ [: forth:type forth:xemit ;] id+like $exec
    id+like cell
    2over chain-tags# #@ d0= IF
	2swap chain-tags# #!
    ELSE
	2nip last# cell+ $+!
    THEN
; project-log-class is msg:chain
:noname ( addr u -- )
    [: dvcs-log:id$ $. forth:type ;] dvcs-log:urls[] dup $[]# swap $[] $exec
; project-log-class is msg:url

: new-project-log ( -- o )
    project-log-class new >o msg-table @ token-table ! o o> ;
}scope
................................................................................
	>o "project-slider" to name$ o o>
    }}v box[]
    >o "project-vbox" to name$ o o>
}}z box[]
>o "project-zbox" to name$ o o>
to post-frame

hash: buckets#

: #!+ ( addr u hash -- ) >r
    2dup r@ #@ IF
	1 swap +!  rdrop 2drop
    ELSE
	drop 1 { w^ one }
	one cell 2swap r> #!
    THEN ;

Variable emojis$ "๐Ÿ‘๐Ÿ‘Ž๐Ÿคฃ๐Ÿ˜๐Ÿ˜˜๐Ÿ˜›๐Ÿค”๐Ÿ˜ญ๐Ÿ˜ก๐Ÿ˜ฑ๐Ÿ”ƒ๏‡ " emojis$ $! \ list need to be bigger

: chain-string ( addr u -- addr' u' )
    buckets# #frees
    bounds U+DO
	I $@ [ keysize 2 64s + ]L /string buckets# #!+
    cell +LOOP
    emojis$ $@ bounds DO
	I dup I' over - x-size 2dup buckets# #@
	IF    @ >r tuck type r> .
	ELSE  drop nip  THEN
    +LOOP ;
: display-title { d: prj | ki -- }
    prj key>o ?dup-IF  .ke-imports @ >im-color# sfloats to ki  THEN
    {{
	glue*l imports#rgb-bg ki + sf@ slide-frame dup .button1
	{{
	    prj key| ?avatar
	    \large imports#rgb-fg ki + sf@ to x-color
	    prj key| ['] .key-id? $tmp }}text 25%b
	    glue*ll }}glue
	    \small prj drop keysize + le-64@ [: .ticks space ;] $tmp }}text 25%b
	    \normal blackish
	    prj drop keysize + 8 chain-tags# #@
	    ['] chain-string $tmp }}text 25%b
	}}h box[]
    }}z box[] project-vp .child+ ;

: display-file { d: prj -- }
    prj display-title
    prj [ keysize $10 + ]L safe/string
    2dup "file:" string-prefix? IF

Changes to json/g+-import.fs.

364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
	[: '๐Ÿ‘' ulit, msg-like ;] add-message o>
    cell +LOOP ;

: add-reshares { dvcs -- }
    comments:reshares[] $@ bounds U+DO
	sigdate+
	I @ .reshares:resharer{} .author:mapped-key dvcs >o to my-key
	[: '๐Ÿ”ƒ' ( '๐Ÿ™' ) ulit, msg-like ;] add-message o>
    cell +LOOP ;

: add-votes { dvcs -- }
    comments:poll{} ?dup-IF
	0 { n }
	.poll:choices[] $@ bounds U+DO
	    I @ .choices:votes[] $@ bounds U+DO







|







364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
	[: '๐Ÿ‘' ulit, msg-like ;] add-message o>
    cell +LOOP ;

: add-reshares { dvcs -- }
    comments:reshares[] $@ bounds U+DO
	sigdate+
	I @ .reshares:resharer{} .author:mapped-key dvcs >o to my-key
	[: '๏‡ ' ( '๐Ÿ”ƒ' or '๐Ÿ™' ) ulit, msg-like ;] add-message o>
    cell +LOOP ;

: add-votes { dvcs -- }
    comments:poll{} ?dup-IF
	0 { n }
	.poll:choices[] $@ bounds U+DO
	    I @ .choices:votes[] $@ bounds U+DO