split need.fs into provides.fs

Author: forthy42

minos2/bidi.fs

@@ -20,9 +20,10 @@
 
 \ Description: https://unicode.org/reports/tr9/
 
+require set-compsem.fs
+[IFDEF] <provides <provides [THEN]
 require unicode/bidi-db.fs
 require unicode/brackets.fs
-require set-compsem.fs
 
 : (b') ( "name" -- n )
     parse-name [: ." .." type ;] $tmp
@@ -550,3 +551,4 @@ Defer skip-bidi? ' (skip-bidi?) is skip-bidi?
     x1-rest x1-start bidi-rest ;
 
 previous
+[IFDEF] provides> provides> [THEN]

minos2/ftgl-helper.fs

@@ -23,6 +23,8 @@
 require unix/freetype_gl.fs
 require unix/harfbuzz.fs
 
+debug: time(    \ +db time( \ )
+
 also freetype-gl
 also opengl
 

minos2/widgets.fs

@@ -21,23 +21,24 @@
 \ A MINOS2 widget is composed of drawable elements, boxes and actors.
 \ to make things easier, neither drawable elements nor boxes need an actor.
 
-debug: time(    \ +db time( \ )
-debug: gui(     \ +db gui( \ )
-debug: click(   \ +db click( \ )
-debug: click-o( \ +db click-o( \ )
-debug: resize(  \ +db resize( \ )
-debug: dispose( \ +db dispose( \ )
+require ../i18n.fs \ localization
+require ../mini-oof2.fs
+require ../config.fs
+require gl-terminal.fs
+require ftgl-helper.fs
+
+[IFDEF] <provides <provides [THEN]
 
 [IFUNDEF] no-file#
     2 Constant ENOENT
     #-512 ENOENT - Constant no-file#
 [THEN]
 
-require ../i18n.fs \ localization
-require gl-terminal.fs
-require ftgl-helper.fs
-require ../mini-oof2.fs
-require ../config.fs
+debug: gui(     \ +db gui( \ )
+debug: click(   \ +db click( \ )
+debug: click-o( \ +db click-o( \ )
+debug: resize(  \ +db resize( \ )
+debug: dispose( \ +db dispose( \ )
 
 Variable minos2-debug$
 ${MINOS2_DEBUGS} minos2-debug$ $!
@@ -1917,3 +1918,5 @@ previous
 
 previous previous previous
 set-current
+
+[IFDEF] provides> provides> [THEN]

need.fs

@@ -18,42 +18,13 @@
 \ You should have received a copy of the GNU General Public License
 \ along with this program. If not, see http://www.gnu.org/licenses/.
 
-\ create database for what sources provide
-
-2variable last-loadfilename
-0 Value provides.fd
-
-: provides-header ( -- )
-    provides.fd 0= latest 0= or get-current >voc xt? 0= or ?EXIT
-    [:  sourcefilename last-loadfilename 2@ d<>
-	IF
-	    sourcefilename last-loadfilename 2!
-	    cr sourcefilename type ':' emit
-	THEN
-	space
-	get-current forth-wordlist <> IF
-	    get-current >voc name>string type ':' emit
-	THEN
-	latest name>string type
-    ;] provides.fd outfile-execute ;
-
-: provides-file ( -- addr u )
-    ${XDG_DATA_HOME} dup 0= IF  2drop "~/.local/share"  THEN
-    [: type ." /gforth/provides" ;] $tmp ;
-
-\ to generate the database, call
-\ gforth need.fs -e 'provides' <files>
-\ and to add more infos to the data base
-\ gforth need.fs -e 'provides+' <more-files>
-
-: provides ( -- )
-    provides-file w/o create-file throw to provides.fd
-    ['] provides-header IS header-extra ;
-: provides+ ( -- )
-    provides-file w/o open-file throw to provides.fd
-    ['] provides-header IS header-extra ;
-
-\ read said database matching need query
+\ read povides database matching need query
+
+[IFUNDEF] provides-file
+    : provides-file ( -- addr u )
+	${XDG_DATA_HOME} dup 0= IF  2drop "~/.local/share"  THEN
+	[: type ." /gforth/provides" ;] $tmp ;
+[THEN]
 
 $[]variable $need[]
 $[]variable $require[]
@@ -84,11 +55,16 @@ $Variable last-require
 : checkneeds ( addr u -- nt )
     rec-checkneeds dup IF drop THEN ;
 
-: read-needs ( -- )
-    provides-file r/o open-file throw
+: (read-needs) ( fd -- )
     [: ['] rec-needs ['] forth-recognize ['] read-loop wrap-xt ;]
     execute-parsing-file ;
 
+: read-needs ( -- )
+    "provides" [: ofile $@ r/o open-file
+	IF  drop  ELSE  (read-needs)  THEN false ;]
+    fpath execute-path-file
+    provides-file r/o open-file throw (read-needs) ;
+
 : parse-needs ( "need1" .. "needn" "close-paren" -- )
     BEGIN   parse-name 2dup ")" str= 0= WHILE
 	    dup 0= IF

provides.fs

@@ -0,0 +1,68 @@
+\ need database generator
+
+\ Authors: Bernd Paysan
+\ Copyright (C) 2024 Free Software Foundation, Inc.
+
+\ This file is part of Gforth.
+
+\ Gforth 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 3
+\ of the License, or (at your option) any later version.
+
+\ This program 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://www.gnu.org/licenses/.
+
+\ create database for what sources provide
+
+2variable last-provider
+2variable provider-file
+0 Value provides.fd
+
+: <provides ( -- ) ." <provides " sourcefilename type cr
+    sourcefilename provider-file 2! ;
+: provides> ( -- ) ." provides>" cr #0. provider-file 2! ;
+: source-provider ( -- addr u )
+    provider-file 2@ 2dup d0= IF  2drop sourcefilename  THEN ;
+
+[IFUNDEF] provides-file
+    : provides-file ( -- addr u )
+	${XDG_DATA_HOME} dup 0= IF  2drop "~/.local/share"  THEN
+	[: type ." /gforth/provides" ;] $tmp ;
+[THEN]
+
+: provides-header ( -- )
+    provides.fd 0= latest 0= or get-current >voc xt? 0= or ?EXIT
+    [:  source-provider last-provider 2@ d<>
+	IF
+	    source-provider last-provider 2!
+	    cr source-provider type ':' emit
+	THEN
+	space
+	get-current forth-wordlist <> IF
+	    get-current >voc name>string type ':' emit
+	THEN
+	latest name>string type
+    ;] provides.fd outfile-execute ;
+
+: provides-file ( -- addr u )
+    ${GFORTH_PROVIDES} dup ?EXIT
+    ${XDG_DATA_HOME} dup 0= IF  2drop "~/.local/share"  THEN
+    [: type ." /gforth/provides" ;] $tmp ;
+
+\ to generate the database, call
+\ gforth need.fs -e 'provides' <files>
+\ and to add more infos to the data base
+\ gforth need.fs -e 'provides+' <more-files>
+
+: provides ( -- )
+    provides-file w/o create-file throw to provides.fd
+    ['] provides-header IS header-extra ;
+: provides+ ( -- )
+    provides-file w/o open-file throw to provides.fd
+    ['] provides-header IS header-extra ;