fendo.addon.source_code.fs

.( fendo.addon.source_code.fs) cr

\ This file is part of Fendo
\ (http://programandala.net/en.program.fendo.html).

\ This file is the source code addon.

\ Last modified  20260206T1535+0100.
\ See change log at the end of the file.

\ Copyright (C) 2013,2014,2015,2017,2018,2020,2025,2026, Marcos Cruz (programandala.net)

\ Fendo is free software; you can redistribute it and/or modify it
\ under the terms of the GNU General Public License as published by
\ the Free Software Foundation; either version 2 of the License, or
\ (at your option) any later version.

\ Fendo is distributed in the hope that it will be useful, but WITHOUT
\ ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
\ or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
\ License for more details.

\ You should have received a copy of the GNU General Public License
\ along with this program; if not, see <http://gnu.org/licenses>.

\ Fendo is written in Forth (http://forth-standard.org)
\ with Gforth (http://gnu.org/software/gforth).

\ ==============================================================
\ Requirements {{{1

forth_definitions

require string.fs  \ Gforth's dynamic strings

require galope/dollar-variable.fs \ `$variable`
require galope/minus-leading.fs \ `-leading`
require galope/package.fs \ `package`, `private`, `public`, `end-package`
require galope/s-constant.fs \ `sconstant`
require galope/string-suffix-question.fs \ `string-suffix?`

fendo_definitions

require ./fendo.addon.source_code.common.fs  \ XXX TMP

\ ==============================================================
\ Code {{{1

package fendo.addon.source_code

: (filename>filetype) ( ca1 len1 -- ca2 len2 )
  basename  \ remove the path, because some comparations use the whole filename
  { D: filename }

  filename s" .free.bas" string-suffix? if  s" freebasic" exit  then

  filename s" .4th" string-suffix? if  s" forth" exit  then
  filename s" .8th" string-suffix? if  s" 8th" exit  then
  filename s" .acef" string-suffix? if  s" aceforth" exit  then
  filename s" .acefs" string-suffix? if  s" aceforth" exit  then
  filename s" .adb" string-suffix? if  s" ada" exit  then
  filename s" .art" string-suffix? if  s" arturo" exit  then
  filename s" .asm" string-suffix? if  s" z80" exit  then
  filename s" .bac" string-suffix? if  s" bacon" exit  then
  filename s" .bas" string-suffix? if  s" basic" exit  then
  filename s" .bb" string-suffix? if  s" betabasic" exit  then
  filename s" .bbas" string-suffix? if  s" betabasic" exit  then
  filename s" .bbim" string-suffix? if  s" bbim" exit  then
  filename s" .betabas" string-suffix? if  s" betabasic" exit  then
  filename s" .c3" string-suffix? if  s" c3" exit  then
  filename s" .chpl" string-suffix? if  s" chpl" exit  then
  filename s" .clj" string-suffix? if  s" clojure" exit  then
  filename s" .cr" string-suffix? if  s" crystal" exit  then
  filename s" .cs" string-suffix? if  s" cs" exit  then
  filename s" .d" string-suffix? if  s" d" exit  then
  filename s" .dylan" string-suffix? if  s" dylan" exit  then
  filename s" .eu" string-suffix? if  s" euphoria" exit  then
  filename s" .ex" string-suffix? if  s" elixir" exit  then
  filename s" .factor" string-suffix? if  s" factor" exit  then
  filename s" .fish" string-suffix? if  s" fish" exit  then

  \ XXX REMARK ".fs" is common to Gforth and F#; therefore F# must
  \ use `s" fsharp" programming_language"` before calling
  \ `source_code`.
  \
  \ filename s" .fs" string-suffix? if  s" fsharp" exit  then // XXX OLD

  filename s" .fs" string-suffix? if  s" gforth" exit  then
  filename s" .fsharp" string-suffix? if  s" fsharp" exit  then \ alternative to .fs, just in case
  filename s" .gforth" string-suffix? if  s" gforth" exit  then \ alternative to .fs, just in case

  filename s" .gleam" string-suffix? if  s" gleam" exit  then
  filename s" .go" string-suffix? if  s" go" exit  then
  filename s" .gnuplot" string-suffix? if  s" gnuplot" exit  then
  filename s" .ha" string-suffix? if  s" hare" exit  then
  filename s" .hs" string-suffix? if  s" haskell" exit  then
  filename s" .hx" string-suffix? if  s" haxe" exit  then
  filename s" .icn" string-suffix? if  s" icon" exit  then
  filename s" .ini" string-suffix? if  s" dosini" exit  then
  filename s" .io" string-suffix? if  s" io" exit  then
  filename s" .janet" string-suffix? if  s" janet" exit  then
  filename s" .jl" string-suffix? if  s" julia" exit  then
  filename s" .kt" string-suffix? if  s" kotlin" exit  then
  filename s" .lisp" string-suffix? if  s" lisp" exit  then
  filename s" .lobster" string-suffix? if  s" lobster" exit  then
  filename s" .lua" string-suffix? if  s" lua" exit  then
  filename s" .masterbas" string-suffix? if  s" masterbasic" exit  then
  filename s" .mb" string-suffix? if  s" masterbasic" exit  then
  filename s" .mbas" string-suffix? if  s" masterbasic" exit  then
  filename s" .mbim" string-suffix? if  s" mbim" exit  then
  filename s" .ml" string-suffix? if  s" ocaml" exit  then
  filename s" .n" string-suffix? if  s" nature" exit  then
  filename s" .neko" string-suffix? if  s" neko" exit  then
  filename s" .nelua" string-suffix? if  s" nelua" exit  then
  filename s" .nim" string-suffix? if  s" nim" exit  then
  filename s" .nit" string-suffix? if  s" nit" exit  then
  filename s" .nt" string-suffix? if  s" neat" exit  then
  filename s" .obn" string-suffix? if  s" oberon-07" exit  then
  filename s" .odin" string-suffix? if  s" odin" exit  then
  filename s" .opl" string-suffix? if  s" oplplus" exit  then
  filename s" .opl.txt" string-suffix? if  s" oplplus" exit  then
  filename s" .opp" string-suffix? if  s" oplplus" exit  then
  filename s" .php" string-suffix? if  s" php" exit  then
  filename s" .pike" string-suffix? if  s" pike" exit  then
  filename s" .pl" string-suffix? if  s" prolog" exit  then
  filename s" .prg" string-suffix? if  s" clipper" exit  then
  filename s" .py" string-suffix? if  s" python" exit  then
  filename s" .raku" string-suffix? if  s" raku" exit  then
  filename s" .ratpoisonrc" str=  if  s" ratpoison" exit  then
  filename s" .red" string-suffix? if  s" red" exit  then
  filename s" .retro" string-suffix? if  s" retro" exit  then
  filename s" .rexx" string-suffix? if  s" rexx" exit  then
  filename s" .ring" string-suffix? if  s" ring" exit  then
  filename s" .rkt" string-suffix? if  s" racket" exit  then
  filename s" .rs" string-suffix? if  s" rust" exit  then
  filename s" .sbim" string-suffix? if  s" sbim" exit  then
  filename s" .scala" string-suffix? if  s" scala" exit  then
  filename s" .scm" string-suffix? if  s" scheme" exit  then
  filename s" .sdlbas" string-suffix? if  s" sdlbasic" exit  then
  filename s" .seq" string-suffix? if  s" forth" exit  then
  filename s" .sh" string-suffix? if  s" sh" exit  then
  filename s" .sinclairbas" string-suffix? if  s" sinclairbasic" exit  then
  filename s" .swift" string-suffix? if  s" swift" exit  then
  filename s" .sx" string-suffix? if  s" styx" exit  then
  filename s" .unexpanded_llist" string-suffix? if  s" sinclairbasic" exit  then
  filename s" .v" string-suffix? if  s" vlang" exit  then
  filename s" .vala" string-suffix? if  s" vala" exit  then
  filename s" .vale" string-suffix? if  s" vale" exit  then
  filename s" .vbas" string-suffix? if  s" vimclairbasic" exit  then
  filename s" .vim" string-suffix? if  s" vim" exit  then
  filename s" .vimbas" string-suffix? if  s" vimclairbasic" exit  then
  filename s" .vimclairbas" string-suffix? if  s" vimclairbasic" exit  then
  filename s" .xbas" string-suffix? if  s" x11basic" exit  then
  filename s" .yab" string-suffix? if  s" yabasic" exit  then
  filename s" .z80s" string-suffix? if  s" z80" exit  then
  filename s" .zig" string-suffix? if  s" zig" exit  then
  filename s" .zxbas" string-suffix? if  s" zxbasic" exit  then
  filename s" Makefile" str=  if  s" make" exit  then
  filename s" _bas" string-suffix? if  s" superbasic" exit  then
  filename s" _sbim" string-suffix? if  s" sbim" exit  then
  filename s" boot" str=  if  s" superbasic" exit  then
  filename s" ratpoisonrc" str=  if  s" ratpoison" exit  then \ XXX OLD ? XXX FIXME ?
\  filename s" _cmd" string-suffix? if  s" text" exit  then  \ XXX TODO
\  filename s" _scr" string-suffix? if  s" forth" exit  then  \ XXX TODO
  s" text" ;

: filename>filetype ( ca1 len1 -- ca2 len2 )
  \ Convert a filename to a Vim's filetype, if needed.
  \ If `programming_language$` has been set, use it; this let the application
  \ to override the default guessing based on the filename.
\  cr ." In filename>filetype " 2dup type ."  --> "  \ XXX INFORMER
  programming_language$ $@ dup if  2nip  else  2drop (filename>filetype)  then
  2dup previous_programming_language$ $!
\  2dup type cr cr cr  \ XXX INFORMER
  ;
  \ Convert a filename to a Vim's filetype.
  \ XXX TODO make all this configurable by the application
  \ XXX TODO use a data structure instead of conditionals

public
0 value source_code_fid
: read_source_code_line ( -- ca len f )
  source_code_fid read_fid_line ;
  \ Note: `read_fid_line` is defined in
  \ <fendo/fendo_wiki_markup_wiki.fs>.

: slurp_source_code ( -- ca len )
  new_source_code
  begin   read_source_code_line
  while   append_source_code_line
  repeat  2drop source_code@ ;
  \ Slurp the content of the opened source code file,
  \ from its current file position.
  \ ca len = source code read from the current file

: noop_translation_table ( -- 0 0 )
  0 dup ;
  \ Fake translation table that does nothing.

0 [if]

\ XXX TMP -- moved from <fendo.addon.source_code.fs>:

defer source_code_pretranslated ( ca len -- ca' len' )
  \ Translate the source code before the highlighting.
  \ This must be vectored by a specific addon.
  \ This is used to translate 8-bit chars to UTF-8 chars;
  \ otherwise the code of those chars would be converted
  \ to text by the highlighting.

defer source_code_posttranslated ( ca len -- ca' len' )
  \ Translate the source code after the highlighting.
  \ This must be vectored by a specific addon.
  \ This is used to translate strings to HTML entities or tags;
  \ otherwise the highlighting would ruin them.

: no_source_code_translation ( -- )
  ['] noop dup
  is source_code_pretranslated
  is source_code_posttranslated ;
  \ Deactivate the source code translations.

[then]

no_source_code_translation

: open_source_code ( ca len -- )
  file>local r/o open-file throw  to source_code_fid ;
  \ ca len = file name

: close_source_code ( -- )
  source_code_fid close-file throw  source_code_finished
\  [<p>] s" At the end of `close_source_code` `programming_language` = " echo   \ XXX INFORMER
\  s" «" programming_language@ s" »" s+ s+ echo [</p>]  \ XXX INFORMER
  ;

: >source_code< ( ca len -- ca' len' )
\  cr ." In >source_code<"  \ XXX INFORMER
  source_code_pretranslated highlighted source_code_posttranslated ;
  \ Translate and highlight a source code.

: echo_source_code ( ca len -- )
  block_source_code{ >source_code< echo }block_source_code ;
  \ Echo a source code.

: (opened_source_code) ( -- )
\  slurp_source_code translate_source_code echo_source_code close_source_code  \ XXX TMP
  slurp_source_code echo_source_code close_source_code ;
  \ Read and echo the content of the opened source code file.

: (source_code) ( ca len -- )
  open_source_code (opened_source_code) ;
  \ Read and echo the content of a source code file.
  \ ca len = file name

: source_code ( ca len -- )
  2dup filename>filetype programming_language!  (source_code) ;
  \ Read and echo the content of a source code file.
  \ The Vim filetype is guessed from the filename, unless
  \ already set in the `programming_language$` dynamic string.
  \ ca len = file name

: unsorted_source_code_files_by_dir_and_regex ( ca1 len1 ca2 len2 -- )
  programming_language$ $@ { D: filetype$ }  \ save the current value
  >regex 2dup { D: directory$ } file>local open-dir throw ( dirid )
  begin   dup pad 256 rot read-dir throw ( dirid len f )
  while   pad over ( dirid len ca len ) regex rgx-wcmatch?
          if    pad swap directory$ s" /" s+ 2swap s+ source_code
                filetype$ programming_language!  \ restore for the next file
          else  drop  then
  repeat  drop close-dir throw ;
  \ Read and echo the content of source code files
  \ in local target files directory ca1 len1 that match
  \ regex ca2 len2. The files will be unsorted.
  \ The Vim filetype is guessed from the filenames, unless
  \ already set in the `programming_language$` dynamic string.
  \ ca1 len1 = path under the target <files> directory,
  \   with or without ending slash
  \ ca2 len2 = regex supported by the rgx module
  \   of the Forth Foundation Library

: (sorted_source_code_files_by_dir_and_regex) ( ca1 len1 ca2 len2 -- )
  programming_language$ $@ { D: filetype$ } \ save the current value
  >regex 2dup { D: directory$ } file>local open-dir throw ( dirid )
  begin   dup pad 256 rot read-dir throw ( dirid len f )
  while   pad over ( dirid len ca len ) regex rgx-wcmatch?
          if    \ Create a line of code.
                s\" s\" " type
                filetype$ type
                s\" \" programming_language! " type
                s\" s\" " type
                directory$ type s" /" type pad swap type [char] " emit
                s"  source_code" type cr
          else  drop  then
  repeat  drop close-dir throw ;
  \ Type Forth code that will read and echo the content of source code
  \ files in local target files directory ca1 len1 that match regex
  \ ca2 len2. The files will be unsorted. The output is already
  \ redirected to a temporary file, so this work actually creates a
  \ Forth source file that will be sorted and interpreted later.
  \
  \ The Vim filetype is guessed from the filenames, unless
  \ already set in the `programming_language$` dynamic string.
  \ ca1 len1 = path under the target <files> directory,
  \   with or without ending slash
  \ ca2 len2 = regex supported by the rgx module
  \   of the Forth Foundation Library

s" /tmp/fendo.source_codes_by_dir_and_regex.txt" sconstant tmp_raw_file$

s" .fs" sconstant tmp_sorted_file_extension$

tmp_raw_file$ tmp_sorted_file_extension$ s+ sconstant tmp_sorted_file$

: sorted_source_code_files_by_dir_and_regex ( ca1 len1 ca2 len2 -- )
  ['] (sorted_source_code_files_by_dir_and_regex)
  tmp_raw_file$ w/o create-file throw  dup >r outfile-execute
  r> close-file throw
    \ First, create a file with the required commands,
    \ by executing `(sorted_source_codes_by_dir_and_regex)` with
    \ the output redirected to the file.

  s" sort " tmp_raw_file$ s+ s"  > " s+ tmp_sorted_file$ s+ system
    \ Second, sort the file, using the OS shell.

  tmp_sorted_file$ included ;
  \ Read and echo the content of source code files
  \ in local target files directory ca1 len1 that match
  \ regex ca2 len2. The files will be sorted.
  \
  \ The Vim filetype is guessed from the filenames, unless
  \ already set in the `programming_language$` dynamic string.
  \
  \ ca1 len1 = path under the target <files> directory,
  \   with or without ending slash
  \ ca2 len2 = regex supported by the rgx module
  \   of the Forth Foundation Library
  \
  \ XXX TODO -- use previous_programming_language$

end-package

.( fendo.addon.source_code.fs compiled) cr

\ ==============================================================
\ Change log {{{1

\ 2013-07-21: Start, with noop definitions from
\ <fendo-programandala.fs>; only the basic `source_code` works.
\
\ 2013-07-26: New: BASin and Forth blocks.
\
\ 2013-07-26: Fix: now source files are closed at the end.
\
\ 2013-07-28: Fix: `basin_source_code` called `echo_source_code`
\ instead of `(echo_source_code)`.
\
\ 2013-11-07: Change: Forth blocks are printed apart; empty blocks are
\ omited; no line number are printed.
\
\ 2013-11-08: Change: source code is not echoed by lines anymore; this
\ is a first step towards syntax highlighting.
\
\ 2013-11-08: Fix: The rubbish byte at the end of the last block of an
\ Abersoft Forth blocks file is removed.
\
\ 2013-11-09: First working version with syntax highlighting.  Addon
\ moved from Fendo-programandala to Fendo, because part of the code is
\ required to implement optional syntax highlighting in the `###`
\ markup.
\
\ 2013-11-09: The BASin-specific code is moved to its own file.
\
\ 2013-11-09: The Forth-blocks-specific code is moved to its own file.
\
\ 2013-11-18: `open_source_code` factored out to `file>local` (defined
\ in <fendo_files.fs>.
\
\ 2013-11-18: Change: `programming_language` renamed to
\ `programming_language!`.
\
\ 2013-11-18: New: `programming_language@`.
\
\ 2013-11-18: Change: All words related to syntax highlighting are
\ moved to <addons/source_code_common.fs>, because they are needed
\ also by the "###" markup.
\
\ 2013-12-10: Character set translation implemented with
\ <galope/translated.fs>: the default noop translation table must be
\ changed by the specific addons.
\
\ 2013-12-11: Character set translation improved: two translations can
\ be done: one before the highlighting and other after it; this
\ prevents the highlighting from ruining some translations. Besides,
\ an xt is used instead of a translation table created with
\ <galope/translated.fs>; this way any tool can be used for the task.
\
\ 2014-02-06: New: `source_code_finished` now does all reseting final
\ task.  This fixes some obscure issues too.
\
\ 2014-02-15: Fix: path of the Fendo addons is converted to relative.
\
\ 2014-03-12: Change: module renamed after the filename;
\ "fendo.addon.source_code.common.fs" filename updated.
\
\ 2014-10-13: New: `zx_spectrum_source_code`.
\
\ 2014-10-17: Change: `zx_spectrum_source_code` is moved to its own
\ file <fendo.addon.zx_spectrum_source_code.fs>.
\
\ 2014-10-17: Improvement: `(filename>filetype)` is updated with
\ Vimclair BASIC filetype, and alternative extensions for MasterBASIC
\ and Beta BASIC.
\
\ 2014-10-19: New: `programming_language?!`.
\
\ 2014-12-07: Change: `source_code_finished` and related words have
\ been moved to <fendo.addon.source_code.common.fs>, in order to use
\ that word in <fendo.markup.fendo.code.fs>.
\
\ 2014-12-07: Change: removed old useless code about specific-platform
\ encodings.
\
\ 2015-01-30: New: ".sinclairbas" extension for Sinclair BASIC.
\
\ 2015-01-31: New: additional extensions: `.vimbas` and `vimclairbas`
\ for Vimclair BASIC; `.unexpanded_llist` for Sinclair BASIC.
\
\ 2015-02-04: Fix: removed the definition of `source_code_finished`,
\ already moved to to <fendo.addon.source_code.common.fs>.
\
\ 2015-05-02: New: `unsorted_source_codes_by_dir_and_regex`,
\ "Makefile" support in `(filename>filetype)`.
\ `sorted_source_codes_by_dir_and_regex`.
\
\ 2015-05-05: Fix: `(filename>filetype)` didn't recognize whole
\ filenames, only suffixes, because the path was not removed.
\
\ 2017-06-22: Update source style, layout and header.
\
\ 2017-12-04: Update requirements.
\
\ 2018-09-27: Use `package` instead of `module:`.
\
\ 2018-12-08: Update notation of Forth words in comments and strings.
\
\ 2020-04-14: Define strings constants with `sconstant` and instead of
\ `2constant`.
\
\ 2025-06-02: update `(filename>filetype)` with many new languages,
\ which will be used in new contents of programandala.net.
\
\ 2025-06-09: fix v language filetype; add fish language.
\
\ 2025-06-10: fix chapel language filetype.
\
\ 2025-08-15: add retro and rexx to `(filename>filetype)`.
\
\ 2025-12-18: deactivate recognition of ".fs" for F#.
\
\ 2025-12-25: add recognition of ".n" (nature), ".nt" (neat) and
\ ".janet" (janet). fix recognition of ".ml" (ocaml).
\
\ 2026-02-06: add recognition of ".ex" (elixir), ".gleam" (gleam),
\ ".hs" (haskell), and ".sx" (styx).

\ vim: filetype=gforth