Commit 17e4d2f2 authored by Bernd Paysan's avatar Bernd Paysan

Start presentation mode for markdown

parent 17f60feb
Pipeline #869 passed with stage
in 10 minutes and 1 second
...@@ -646,7 +646,7 @@ vpath %.fs $(srcdir):.:$(srcdir)/unix:$(srcdir)/test:unix ...@@ -646,7 +646,7 @@ vpath %.fs $(srcdir):.:$(srcdir)/unix:$(srcdir)/test:unix
.SUFFIXES: .SUFFIXES:
.SUFFIXES: .c .o .SUFFIXES: .c .o
all: kernel/version.fs more @NO_CHECKX@ doc check extras all: kernel/version.fs more @NO_CHECKX@ doc start-gforth.el check extras
# use this dependency for phony targets just as mostlyclean,... # use this dependency for phony targets just as mostlyclean,...
FORCE: ; FORCE: ;
......
...@@ -326,7 +326,7 @@ PARSED-TYPE specifies what kind of text is parsed. It should be on of 'name', ...@@ -326,7 +326,7 @@ PARSED-TYPE specifies what kind of text is parsed. It should be on of 'name',
"+field" "value:" "cvalue:" "scvalue:" "wvalue:" "swvalue:" "+field" "value:" "cvalue:" "scvalue:" "wvalue:" "swvalue:"
"lvalue:" "slvalue:" "2value:" "fvalue:" "sfvalue:" "dfvalue:" "lvalue:" "slvalue:" "2value:" "fvalue:" "sfvalue:" "dfvalue:"
"$value:" "defer:" "value[]:" "$value[]:" "$value:" "defer:" "value[]:" "$value[]:"
"wrap+value:") "wrap+value:" "method" "umethod")
non-immediate (font-lock-type-face . 2) non-immediate (font-lock-type-face . 2)
"[ \t\n]" t name (font-lock-variable-name-face . 3)) "[ \t\n]" t name (font-lock-variable-name-face . 3))
("\\S-+%" non-immediate (font-lock-type-face . 2)) ("\\S-+%" non-immediate (font-lock-type-face . 2))
...@@ -394,7 +394,7 @@ PARSED-TYPE specifies what kind of text is parsed. It should be on of 'name', ...@@ -394,7 +394,7 @@ PARSED-TYPE specifies what kind of text is parsed. It should be on of 'name',
"[ \t\n]" t name (font-lock-function-name-face . 3)) "[ \t\n]" t name (font-lock-function-name-face . 3))
(("inst-var" "inst-value") non-immediate (font-lock-type-face . 2) (("inst-var" "inst-value") non-immediate (font-lock-type-face . 2)
"[ \t\n]" t name (font-lock-variable-name-face . 3)) "[ \t\n]" t name (font-lock-variable-name-face . 3))
(("method" "selector") (("method" "selector" "umethod")
non-immediate (font-lock-type-face . 1) non-immediate (font-lock-type-face . 1)
"[ \t\n]" t name (font-lock-function-name-face . 3)) "[ \t\n]" t name (font-lock-function-name-face . 3))
(("end-class" "end-interface") (("end-class" "end-interface")
...@@ -479,7 +479,7 @@ INDENT1 and INDENT2 are indentation specifications of the form ...@@ -479,7 +479,7 @@ INDENT1 and INDENT2 are indentation specifications of the form
"[if]" "[ifdef]" "[ifundef]" "[begin]" "[for]" "[do]" "[?do]" "[:" "[if]" "[ifdef]" "[ifundef]" "[begin]" "[for]" "[do]" "[?do]" "[:"
"[n:l" "[n:h" "[n:d" "[d:l" "[d:h" "[d:d" "[f:l" "[f:h" "[f:d" "[{:") "[n:l" "[n:h" "[n:d" "[d:l" "[d:h" "[d:d" "[f:l" "[f:h" "[f:d" "[{:")
(0 . 2) (0 . 2)) (0 . 2) (0 . 2))
((":" ":noname" "code" "abi-code" "struct" "m:" ":m" "class" ((":" ":noname" "code" "abi-code" "struct" "m:" ":m" "class" "uclass"
"interface" "c-library" "c-library-name" "comp:" "opt:" "post:" "interface" "c-library" "c-library-name" "comp:" "opt:" "post:"
"begin-structure" "extend-structure" "event:" "to-opt:" "defer@-opt:" "to:" "defer@:") "begin-structure" "extend-structure" "event:" "to-opt:" "defer@-opt:" "to:" "defer@:")
(0 . 2) (0 . 2) non-immediate) (0 . 2) (0 . 2) non-immediate)
...@@ -799,7 +799,7 @@ End:\" construct).") ...@@ -799,7 +799,7 @@ End:\" construct).")
'("VARIABLE" "CONSTANT" "2VARIABLE" "2CONSTANT" "FVARIABLE" "FCONSTANT" '("VARIABLE" "CONSTANT" "2VARIABLE" "2CONSTANT" "FVARIABLE" "FCONSTANT"
"USER" "VALUE" "2Value" "field" "end-struct" "VOCABULARY" "CREATE" ":" "CODE" "USER" "VALUE" "2Value" "field" "end-struct" "VOCABULARY" "CREATE" ":" "CODE"
"DEFER" "ALIAS" "interpret/compile:" "debug:" "field:" "2field:" "ffield:" "DEFER" "ALIAS" "interpret/compile:" "debug:" "field:" "2field:" "ffield:"
"sffield:" "dffield:" "uvar" "uvalue" "voctable") "sffield:" "dffield:" "uvar" "uvalue" "voctable" "method" "umethod")
"List of words, that define the following word. "List of words, that define the following word.
Used for imenu index generation.") Used for imenu index generation.")
......
...@@ -33,6 +33,12 @@ Variable fontname[] \ array of fontnames ...@@ -33,6 +33,12 @@ Variable fontname[] \ array of fontnames
16e FValue baseline# \ basic baseline size 16e FValue baseline# \ basic baseline size
1e FValue pixelsize# \ basic pixel size 1e FValue pixelsize# \ basic pixel size
: update-size# { f: lines -- }
dpy-w @ s>f lines f/ fround to font-size#
font-size# 16e f/ m2c:curminwidth% f!
font-size# 133% f* fround to baseline#
dpy-w @ s>f 1280e f/ to pixelsize# ;
: fontsize: ( n "name" -- n+1 ) : fontsize: ( n "name" -- n+1 )
Create dup , 1+ DOES> @ to font-size ; Create dup , 1+ DOES> @ to font-size ;
: fontshape: ( n "name" -- n+1 ) : fontshape: ( n "name" -- n+1 )
......
...@@ -27,12 +27,6 @@ ctx 0= [IF] window-init [THEN] ...@@ -27,12 +27,6 @@ ctx 0= [IF] window-init [THEN]
require minos2/font-style.fs require minos2/font-style.fs
: update-size# { f: lines -- }
dpy-w @ s>f lines f/ fround to font-size#
font-size# 16e f/ m2c:curminwidth% f!
dpy-h @ s>f dpy-w @ s>f f/ 45% f/ font-size# f* fround to baseline#
dpy-w @ s>f 1280e f/ to pixelsize# ;
84e update-size# 84e update-size#
require minos2/text-style.fs require minos2/text-style.fs
......
...@@ -20,19 +20,36 @@ ...@@ -20,19 +20,36 @@
\ Inspiration: wf.fs, a markdown-like parser, which converts to HTML \ Inspiration: wf.fs, a markdown-like parser, which converts to HTML
require jpeg-exif.fs require jpeg-exif.fs
require user-object.fs
get-current also minos definitions get-current also minos definitions
Defer .char Defer .char
Variable md-text$ uval-o md-style
Variable preparse$
Variable last-cchar object uclass md-style
Variable last-emph-flags cell uvar md-text$
Variable emph-flags \ emphasis flags cell uvar preparse$
Variable up-emph cell uvar last-cchar
Variable count-emph cell uvar last-emph-flags
Variable us-state cell uvar emph-flags \ emphasis flags
cell uvar up-emph
cell uvar count-emph
cell uvar us-state
cell uvar imgs#
umethod .md-text
umethod .h1
umethod .h2
umethod .h3
umethod .#.
umethod .##.
umethod .item
umethod .desc
umethod .image
umethod .link
umethod .pagebreak
end-class md-styler
: reset-emph ( -- ) : reset-emph ( -- )
last-emph-flags off last-emph-flags off
...@@ -77,10 +94,6 @@ glue*\\ >o 0e 0g 1fill hglue-c glue! 0glue dglue-c glue! 1glue vglue-c glue! o> ...@@ -77,10 +94,6 @@ glue*\\ >o 0e 0g 1fill hglue-c glue! 0glue dglue-c glue! 1glue vglue-c glue! o>
{{ }}p box[] >bl dup v-box .child+ {{ }}p box[] >bl dup v-box .child+
dup >o "p-box" to name$ o> dup >o "p-box" to name$ o>
dup .subbox >o to parent-w "subbox" to name$ o o> box[] to p-box ; dup .subbox >o to parent-w "subbox" to name$ o o> box[] to p-box ;
: .md-text ( -- )
md-text$ $@len IF
us-state @ md-text$ $@ }}text-us p-box .child+ md-text$ $free
THEN ;
: /source ( -- addr u ) : /source ( -- addr u )
source >in @ safe/string ; source >in @ safe/string ;
...@@ -96,7 +109,6 @@ glue*\\ >o 0e 0g 1fill hglue-c glue! 0glue dglue-c glue! 1glue vglue-c glue! o> ...@@ -96,7 +109,6 @@ glue*\\ >o 0e 0g 1fill hglue-c glue! 0glue dglue-c glue! 1glue vglue-c glue! o>
>thumb-scan img-orient 1- 0 max >thumb-scan img-orient 1- 0 max
ELSE 2drop 0 THEN ; ELSE 2drop 0 THEN ;
Variable imgs#
-1 Value imgs#max -1 Value imgs#max
: load/thumb { w^ fn$ -- w h res flag } : load/thumb { w^ fn$ -- w h res flag }
...@@ -138,6 +150,18 @@ Variable imgs# ...@@ -138,6 +150,18 @@ Variable imgs#
: >lhang ( o -- o ) : >lhang ( o -- o )
p-box .parent-w >o dup to lhang o> ; p-box .parent-w >o dup to lhang o> ;
\ style class implementation
md-styler new Constant default-md-styler
default-md-styler to md-style
:noname ( -- )
md-text$ $@len IF
us-state @ md-text$ $@ }}text-us p-box .child+ md-text$ $free
THEN ; is .md-text
\ interpretation
: default-char ( char -- ) : default-char ( char -- )
emph-flags @ last-emph-flags @ over last-emph-flags ! <> IF emph-flags @ last-emph-flags @ over last-emph-flags ! <> IF
.md-text emph-flags @ +emphs .md-text emph-flags @ +emphs
...@@ -195,20 +219,23 @@ md-char: \ ( char -- ) ...@@ -195,20 +219,23 @@ md-char: \ ( char -- )
drop /source IF c@ .char 1 >in +! ELSE drop THEN ; drop /source IF c@ .char 1 >in +! ELSE drop THEN ;
md-char: ! ( char -- ) md-char: ! ( char -- )
/source "[" string-prefix? IF /source "[" string-prefix? IF
drop 1 >in +! ]-parse drop 1 >in +! ]-parse .image
.md-text dark-blue
dup 0= IF 2drop " " THEN
1 -rot }}text-us +image p-box .child+ blackish
ELSE .char THEN ; ELSE .char THEN ;
:noname ( desc-addr u1 img-addr u2 -- )
.md-text ( dark-blue )
dup 0= IF 2drop " " THEN
1 -rot }}text-us +image p-box .child+ ( blackish ) ; is .image
md-char: [ ( char -- ) md-char: [ ( char -- )
drop ]-parse 2dup "![" search nip nip IF drop ]-parse 2dup "![" search nip nip IF
drop ')' parse 2drop ]-parse + over - THEN drop ')' parse 2drop ]-parse + over - THEN
.link ;
:noname ( link-addr u1 desc-addr u2 -- )
.md-text .md-text
dup 0= IF 2drop " " THEN dup 0= IF 2drop " " THEN
us-state @ >r p-box >r {{ }}h box[] to p-box us-state @ >r p-box >r {{ }}h box[] to p-box
[ underline #dark-blue or ]L render-line .md-text [ underline #dark-blue or ]L render-line .md-text
p-box r> to p-box r> us-state ! blackish p-box r> to p-box r> us-state ! blackish
+link p-box .child+ ; +link p-box .child+ ; is .link
md-char: : ( char -- ) md-char: : ( char -- )
drop /source ":" string-prefix? IF drop /source ":" string-prefix? IF
>in @ >r >in @ >r
...@@ -220,11 +247,12 @@ md-char: : ( char -- ) ...@@ -220,11 +247,12 @@ md-char: : ( char -- )
THEN ':' .char ; THEN ':' .char ;
md-char: ( tab -- ) md-char: ( tab -- )
drop dark-blue ['] wspace md-text$ $exec drop dark-blue ['] wspace md-text$ $exec
" " md-text$ 0 $ins " " md-text$ 0 $ins md-text$ $@ .desc md-text$ $free ;
:noname ( addr u -- ) 2>r
{{ {{
{{ us-state @ md-text$ $@ }}text-us glue*l }}glue }}h box[] {{ us-state @ 2r> }}text-us glue*l }}glue }}h box[]
}}z box[] bx-tab >lhang }}z box[] bx-tab >lhang
p-box .child+ blackish md-text$ $free ; p-box .child+ blackish ; is .desc
$10 cells buffer: indent#s $10 cells buffer: indent#s
0 Value cur#indent 0 Value cur#indent
...@@ -249,91 +277,76 @@ get-current also markdown definitions ...@@ -249,91 +277,76 @@ get-current also markdown definitions
\ headlines limited to h1..h3 \ headlines limited to h1..h3
: # ( -- ) : # ( -- )
/source 2dup + 2 - 2 " #" str= -2 and + /source 2dup + 2 - 2 " #" str= -2 and + .h1 ;
\huge cbl bold render-line .md-text .\\ \normal \regular ; :noname
\huge cbl bold render-line .md-text .\\ \normal \regular ; is .h1
: ## ( -- ) : ## ( -- )
/source 2dup + 3 - 3 " ##" str= -3 and + /source 2dup + 3 - 3 " ##" str= -3 and + .h2 ;
\large cbl bold render-line .md-text .\\ \normal \regular ; :noname
\large cbl bold render-line .md-text .\\ \normal \regular ; is .h2
: ### ( -- ) : ### ( -- )
/source 2dup + 4 - 4 " ###" str= -4 and + /source 2dup + 4 - 4 " ###" str= -4 and + .h3 ;
\normal cbl bold render-line .md-text .\\ \normal \regular ; :noname
\normal cbl bold render-line .md-text .\\ \normal \regular ; is .h3
: 1. ( -- ) : 1. ( -- )
\ render counted line \ render counted line
-3 >indent dark-blue -3 >indent .#. ;
:noname ( -- ) dark-blue
{{ 0 [: cur#indent 2* 2 + spaces indent# 0 .r ." . " ;] {{ 0 [: cur#indent 2* 2 + spaces indent# 0 .r ." . " ;]
$tmp }}text-us $tmp }}text-us
}}z /hfix box[] >lhang p-box .child+ blackish }}z /hfix box[] >lhang p-box .child+ blackish
/source 0 render-line .md-text .\\ ; /source 0 render-line .md-text .\\ ; is .#.
synonym 2. 1. 10 2 [DO] [I] 0 <# '.' hold #S #> nextname synonym 1. [LOOP]
synonym 3. 1.
synonym 4. 1.
synonym 5. 1.
synonym 6. 1.
synonym 7. 1.
synonym 8. 1.
synonym 9. 1.
: 10. ( -- ) : 10. ( -- )
\ render counted line \ render counted line
-4 >indent dark-blue -4 >indent .##. ;
:noname ( -- ) dark-blue
{{ 0 [: cur#indent 2* 1+ spaces indent# 0 .r ." . " ;] {{ 0 [: cur#indent 2* 1+ spaces indent# 0 .r ." . " ;]
$tmp }}text-us }}z /hfix box[] >lhang p-box .child+ blackish $tmp }}text-us }}z /hfix box[] >lhang p-box .child+ blackish
/source 0 render-line .md-text .\\ ; /source 0 render-line .md-text .\\ ; is .##.
synonym 11. 10. 100 11 [DO] [I] 0 <# '.' hold #S #> nextname synonym 10. [LOOP]
synonym 12. 10.
synonym 13. 10. : * ( -- )33
synonym 14. 10. -2 >indent cur#indent bullet-char .item ;
synonym 15. 10. :noname { bchar -- } dark-blue
synonym 16. 10. {{ 0 bchar [: cur#indent 1+ wspaces xemit wspace ;] $tmp }}text-us
synonym 17. 10.
synonym 18. 10.
synonym 19. 10.
synonym 20. 10.
synonym 21. 10.
synonym 22. 10.
synonym 23. 10.
synonym 24. 10.
synonym 25. 10.
synonym 26. 10.
synonym 27. 10.
synonym 28. 10.
synonym 29. 10.
synonym 30. 10.
: * ( -- )
-2 >indent dark-blue
{{ 0 [: cur#indent 1+ wspaces
cur#indent bullet-char xemit wspace ;] $tmp }}text-us
}}z /hfix box[] >lhang p-box .child+
blackish /source 0 render-line .md-text .\\ ;
: + ( -- )
-2 >indent dark-blue
{{ 0 [: cur#indent 1+ wspaces
'+' xemit wspace ;] $tmp }}text-us
}}z /hfix box[] >lhang p-box .child+
blackish /source 0 render-line .md-text .\\ ;
: - ( -- )
-2 >indent dark-blue
{{ 0 [: cur#indent 1+ wspaces
'' xemit wspace ;] $tmp }}text-us
}}z /hfix box[] >lhang p-box .child+
blackish /source 0 render-line .md-text .\\ ;
: ± ( -- )
-2 >indent dark-blue
{{ 0 [: cur#indent 1+ wspaces
'±' xemit wspace ;] $tmp }}text-us
}}z /hfix box[] >lhang p-box .child+
blackish /source 0 render-line .md-text .\\ ;
: > ( -- )
-2 >indent dark-blue
{{ 0 [: cur#indent 1+ wspaces
'|' xemit wspace ;] $tmp }}text-us
}}z /hfix box[] >lhang p-box .child+ }}z /hfix box[] >lhang p-box .child+
blackish /source 0 render-line .md-text .\\ ; blackish /source 0 render-line .md-text .\\ ; is .item
: + ( -- ) -2 >indent '+' .item ;
: - ( -- ) -2 >indent '' .item ;
: ± ( -- ) -2 >indent '±' .item ;
: > ( -- ) -2 >indent '|' .item ;
: ::album:: ( -- ) : ::album:: ( -- )
imgs# @ 1+ to imgs#max ; imgs# @ 1+ to imgs#max ;
: --- ( -- )
.pagebreak ;
synonym *** ---
synonym ___ ---
previous set-current previous set-current
warnings ! warnings !
md-styler uclass md-style
end-class md-presenter
md-presenter new Constant presenter-md-styler
: presentation-size
44e update-size# ;
get-current also markdown definitions
: ::presentation::
presentation-size
presenter-md-styler to md-style ;
::presentation::
previous set-current
84e update-size#
\ generic formatting
: p-format ( rw -- ) : p-format ( rw -- )
[{: f: rw :}l rw par-split ;] v-box .do-childs ; [{: f: rw :}l rw par-split ;] v-box .do-childs ;
...@@ -395,6 +408,7 @@ warnings ! ...@@ -395,6 +408,7 @@ warnings !
REPEAT ; REPEAT ;
: markdown-parse ( addr u -- ) : markdown-parse ( addr u -- )
default-md-styler to md-style
-1 to imgs#max imgs# off -1 to imgs#max imgs# off
{{ }}v box[] to v-box nt open-fpath-file throw {{ }}v box[] to v-box nt open-fpath-file throw
['] markdown-loop execute-parsing-named-file ['] markdown-loop execute-parsing-named-file
......
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