-
Notifications
You must be signed in to change notification settings - Fork 1
/
Copy pathfendo.data.fs
1233 lines (1074 loc) · 40.1 KB
/
fendo.data.fs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
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
677
678
679
680
681
682
683
684
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
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
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
.( fendo.data.fs ) cr
\ This file is part of Fendo
\ (http://programandala.net/en.program.fendo.html).
\ This file defines the page data tools.
\ Last modified 20220308T2342+0100.
\ See change log at the end of the file.
\ Copyright (C) 2013,2014,2015,2017,2018,2019,2021,2022 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>.
\ ==============================================================
\ Requirements {{{1
forth_definitions
require ./fendo.addon.traverse_pids.fs
\ From Galope
require galope/char-count.fs \ `char-count`
require galope/minus-common-prefix.fs \ `-common-prefix`
require galope/minus-extension.fs \ `-extension`
require galope/slash-ssv.fs \ `/ssv`
require galope/file-mtime.fs \ `file-mtime`
require galope/file-exists-question.fs \ `file-exists?`
\ From Fourth Foundation Library
require ffl/str.fs \ dynamic strings
fendo_definitions
\ ==============================================================
\ Page data engine {{{1
variable data_fields \ counter
64 constant max_data_fields
max_data_fields cells buffer: fields_body_table
: erase_data ( -- )
\ XXX TODO
fields_body_table max_data_fields bounds ?do
-1 i !
cell +loop ;
variable current_data \ address of the latest created data
: parse_datum ( u "text<nl>" -- )
>r 0 parse \ parse the rest of the current input line
trim
\ dup if ." Parsed datum: " 2dup type cr then \ XXX INFORMER
current_data @ r> + $! ;
\ Parse a datum and store it.
\ u = datum offset
variable in_data_header?
\ flag to let the data fields to disguise the context
variable /datum
\ offset of the current datum; at the end, length of the data
defer get_datum ( a u -- ca len )
: (get_datum) ( a u -- ca len )
\ ." Input of `(get_datum)` :" .s cr \ XXX INFORMER
+ $@
\ ." Output of `(get_datum)` :" 2dup type cr \ XXX INFORMER
;
' (get_datum) is get_datum
: :datum ( ca len -- )
nextname create
cell /datum dup @ , +! \ store the offset and increment it
does> ( a1 | "text<nl>" -- ca len | )
\ a1 = page data address
\ ca len = datum
\ dfa = data field address of the datum word
\ u = datum offset
( a1 dfa | dfa "text<nl>" )
@ in_data_header? @ ( u f )
if ( u "datum<nl>" ) parse_datum
else ( a1 u ) get_datum then ;
\ Create a page metadatum that parses or returns its value.
\ This is the normal version of the metadatum: when executed in the
\ metadata header (between `data{` and `}data`), it will get its
\ datum from the input stream, until the end of the line, and will
\ store it; when executed out of the metadata header, it will return
\ the datum string.
\ ca len = datum name
: :datum>address ( ca len -- )
s" '" 2swap s+ nextname
latestxt \ of the word previously created by `:datum`
create ( xt ) >body ,
does> ( a1 -- a2 )
( a1 dfa ) @ @ ( a1 u ) + ;
\ Create a page metadatum word that returns the address of its data.
\ The new name will have a tick at the start.
\ ca len = datum name
\ a1 = page data address
\ a2 = datum address (a dynamic string that can be updated by `$!`)
\ dfa = data field address of the datum word
\ u = datum offset
: datum: ( "name" -- )
parse-name 2dup :datum :datum>address ;
\ Create a page metadatum.
\ ==============================================================
\ Page data fields {{{1
datum: source_file
\ This field contains the source filename. It is set automatically
\ by `(set_default_data)` when the page is accessed the first time.
\ XXX TODO -- handling of markups in the data fields depend on the
\ application
datum: language \ ISO code of the page's language
datum: title \ page title; can include markups
datum: menu_title \ short title used menus and navigation bars
datum: breadcrumb_title \ short title used in breadcrumb navigation
datum: description \ page description
\ Dates in ISO format:
datum: created \ when the contents were created (written)
datum: published \ when the contents were published (online)
datum: modified \ when the contents were modified (updated)
' modified alias modifed
datum: file_modified \ file modification date; if not specified, `modified` is used
datum: access_key \ access key (one char)
\ Hierarchy data, indicated with a page ID (a page name):
datum: upper_page
datum: previous_page
datum: next_page
datum: first_page
datum: last_page
datum: keywords \ list of HTML meta keywords, separated by commas
datum: tags \ list of tag IDs, separated by spaces
datum: properties \ list of properties, separated by commas
datum: edit_summary \ description of the latest changes
datum: related \ list of page IDs, separated by commas
datum: filename_extension \ alternative target filename extension (with dot)
\ Design and template
\ Note: The actual design and template will be the default ones
\ unless the current page defines its own in its metadata:
datum: design_subdir \ target relative path to the design, with final slash
datum: template \ HTML template filename in the design subdir
\ .( /datum = ) /datum ? cr key drop \ XXX INFORMER
\ ==============================================================
\ File names {{{1
0 value current_page \ page ID of the current page
: target_extension ( a -- ca len )
filename_extension dup 0=
if 2drop html_extension $@ then ;
\ Return the target filename extension of page ID _a_.
: current_target_extension ( -- ca len )
current_page target_extension ;
: -forth_extension ( ca len -- ca' len' )
forth_extension $@ -suffix ;
\ Remove the Forth extension from a filename.
: +forth_extension ( ca len -- ca' len' )
forth_extension $@ s+ ;
\ Add the Forth extension to a filename.
: source>current_target_extension ( ca1 len1 -- ca2 len2 )
-forth_extension current_target_extension s+ ;
\ Change the Forth extension to the current target extension.
\ ca1 len1 = Forth source page filename
\ ca2 len2 = target HTML page filename
: /sourcefilename ( -- ca len )
sourcefilename basename ;
\ Return the current source filename, without path.
: pid#>pid$ ( a -- ca len )
source_file -forth_extension ;
\ Convert a numerical page ID to its string form.
\ a = page ID
\ ca len = page ID
: target_file ( a -- ca len )
\ ." `link_anchor` in `target_file` = " link_anchor $@ type cr \ XXX INFORMER
\ XXX TODO -- `link_anchor+` should not be here
dup >r pid#>pid$ r> target_extension s+ link_anchor+
\ ." Result in `target_file` = " 2dup type cr \ XXX INFORMER
;
\ Return a target HTML page filename.
\ a = page ID
\ ca len = target HTML page file name
: current_target_file ( -- ca len )
current_page target_file ;
\ Return the target HTML page filename of the current page.
\ ca len = target HTML page file name
: domain¤t_target_file ( -- ca len )
domain s" /" s+ current_target_file s+ ;
: domain_url ( -- ca len )
s" http://" domain s+ ;
: current_target_file_url ( -- ca len )
s" http://" domain¤t_target_file s+ ;
: +domain_url ( ca len -- ca' len' )
domain_url s" /" s+ 2swap s+ ;
: pid#>url ( a -- ca len )
target_file +domain_url ;
: +target_dir ( ca1 len1 -- ca2 len2 )
target_dir $@ 2swap s+ ;
\ Add the target path to a file name.
\ ca1 len1 = file name
\ ca2 len2 = file name, with its target local path
: target_path/file ( a -- ca len )
target_file +target_dir
\ 2dup type cr \ XXX INFORMER
;
\ Return a target HTML page filename, with its local path.
\ a = page ID
\ ca len = target HTML page file name, with its local path
\ ==============================================================
\ Page ID {{{1
\ The first time a page is interpreted, its data is parsed and
\ created (even if the content doesn't has to be parsered, e.g.
\ when the data has been required by other page). Then a
\ page ID is created: it's the source filename without path
\ or extension. The execution of the page ID returns the address of
\ the page data.
: current_pid$ ( -- ca len )
/sourcefilename -extension ;
\ Return the name of the current page ID.
\ XXX TODO -- combine with `current_page_pid$`?
: known_pid$? ( ca len -- 0 | xt +-1 )
-anchor fendo_pid_wid search-wordlist ;
: new_page_data_space ( -- )
here dup current_data ! /datum @ dup allot erase ;
\ Create and init data space for a new page.
: (:pid) ( ca len -- )
get-current >r fendo_pid_wid set-current
:create new_page_data_space
r> set-current ;
\ Create a new page ID and its data space.
: :pid ( -- )
current_pid$ 2dup known_pid$?
if drop 2drop else (:pid) then ;
\ Create the current page ID and its data space, if needed.
: pid$>pid#? ( ca len -- a true | false )
known_pid$? if execute true else 0 false then ;
\ doc{
\
\ pid$>pid#? ( ca len -- a true | 0 false )
\
\ If string page ID _ca len_ is known, return its equivalent page ID
\ _a_ and _true_. Otherwise return _0_ and _false_.
\
\ See also: `pid$>pid#`.
\
\ }doc
: current_page_pid$ ( -- ca len )
current_page pid#>pid$
\ current_page ?dup if pid#>pid$ else pad 0 then
;
\ Return the string page ID of the current page,
\ XXX TODO -- combine with `current_pid$`?
\ XXX TODO `current_page` can be zero during debugging tasks,
\ for example while using `echo>screen` to check the
\ engine without files. But this alternative creates new
\ problems because of the empty page ID:
\ ca len = page ID or empty string
: descendant? ( ca1 len1 ca2 len2 -- f )
s" ." s+ 2swap s" ." s+ \
{ D: descendant D: ancestor }
\ descendant ancestor str= ?dup if 0= exit then \ XXX OLD
descendant ancestor string-prefix? ;
\ Is the page whose ID is _ca2 len2_ a descendant of the page whose
\ ID is _ca1 len1_?
: pid$>level ( ca len -- n )
[char] . char-count ;
\ Return the hierarchy level of the given page ID.
\ The top level is 0.
: pid#>level ( a -- n )
pid#>pid$ pid$>level ;
\ Return the hierarchy level of the given page ID.
\ The top level is 0.
: (brother_pages?) ( ca1 len1 ca2 len2 -- f )
-common-prefix pid$>level -rot pid$>level or 0= ;
\ doc{
\
\ (brother_pages?) ( ca1 len1 ca2 len2 -- f )
\
\ Are the pages whose IDs are _ca1 len1_ and _ca2 len2_ brothers?
\ I.e. do the last part (level) of their IDs is preceded by a common
\ ancestor (hierarchy)?
\
\ Example:
\
\ - "en.text.2018.my_first_post" and "en.text.2018.my_second_post"
\ are brothers, because "my_first_post" and "my_second_post" share
\ a common ancestor: "en.text.20128".
\ - "en.text.2018.my_first_post" and "en.text.2017.my_old_post" are not
\ brothers.
\
\ ``(brother_pages?)`` is the default behaviour of `brother_pages?`.
\
\ See also: `pid$>level`.
\
\ }doc
defer brother_pages? ( ca1 len1 ca2 len2 -- f )
' (brother_pages?) is brother_pages?
\ doc{
\
\ defer brother_pages? ( ca1 len1 ca2 len2 -- f )
\
\ Are the pages whose IDs are _ca1 len1_ and _ca2 len2_ brothers?
\ I.e., do they belong to the same section?
\
\ ``brother_pages?`` is a a deferred word that can be reconfigured
\ by the application. Its default behaviour is `(brother_pages?)`.
\
\ }doc
\ ==============================================================
\ Debugging tools {{{1
: .data { pageID -- }
." data of pid# " pageID . cr
." source_file = " pageID 'source_file $@ type cr
." title = " pageID 'title $@ type cr
\ ." project_status = " pageID project_status type cr
\ ." project_start = " pageID project_start type cr
\ ." project_end = " pageID project_end type cr
\ ." project_completion = " pageID project_completion type cr
." related = " pageID 'related $@ type cr ;
: .current_data ( -- )
current_page .data ;
\ ==============================================================
\ Page data header {{{1
defer set_default_data ( -- )
\ Set the default values of the page data.
: (set_default_data) ( -- )
/sourcefilename
\ 2dup ." «" type ." »" \ XXX INFORMER
current_data @ 'source_file $! ;
\ Set the default values of the page data.
\ XXX TODO finish
' (set_default_data) is set_default_data
: (}data) ( -- )
\ ." }data executed; data before defaults:" cr \ XXX INFORMER
\ .current_data \ XXX INFORMER
set_default_data in_data_header? off
\ ." data after defaults:" cr \ XXX INFORMER
\ .current_data \ XXX INFORMER
\ ." )))))))))))))))))))))))))))))))))))))))))))))))" cr \ XXX INFORMER
\ key drop \ XXX INFORMER
;
: }data ( -- )
in_data_header? @ if (}data) then
\ cr cr ." =========== }data" cr key drop \ XXX INFORMER
\ ." `argc` in `}data`= " argc ? cr \ XXX INFORMER
;
\ Mark the end of the page data header and complete it.
: skip_data{ ( xt "<text><space>}data" -- )
execute to current_page
\ ." skip_data{" cr \ XXX INFORMER
begin parse-name dup 0=
if 2drop refill 0= dup abort" Missing `}data`"
else s" }data" str= then
until }data ;
\ Skip the page data.
\ xt = execution token of the current page ID
: get_data{ ( "<text><space>}data" -- )
\ ." `argc` in `get-data{` (start)= " argc ? cr \ XXX INFORMER
\ ." (((((((((((((((((((((((((((((((((((((((((((((((" cr \ XXX INFORMER
\ ." get_data{" cr \ XXX INFORMER
:pid current_data @
\ ." current_data copied to current_page = " dup . cr \ XXX INFORMER
to current_page
\ .current_data \ XXX INFORMER
in_data_header? on
\ ." `argc` in `get-data{` (end)= " argc ? cr \ XXX INFORMER
;
\ Get the page data.
: data_already_got? ( -- 0 | xt +-1 )
current_pid$ known_pid$? ;
\ XXX FIXME This check means pids of draft can not be created...
\ XXX ...but they are useful to do some checkings, e.g. in...
\ XXX ...Fendo-programandala's related_pages.
\ XXX Already solved?
: data{ ( "<text><spaces>}data" -- )
\ cr cr ." =========== data{" cr key drop \ XXX INFORMER
\ cr cr ." ===========" current_target_file type s" data{" cr key drop \ XXX INFORMER
\ ." `argc` in `data{` (start)= " argc ? cr \ XXX INFORMER
data_already_got? if skip_data{ else get_data{ then
\ ." `argc` in `data{` (end)= " argc ? cr \ XXX INFORMER
;
\ Mark the start of the page data.
\ XXX TODO how to access the page IDs in the markup?...
\ XXX ...INCLUDE them in the markup wordlist? create a wordlist?
variable do_content? do_content? on
\ flag: do the page content? (otherwise, skip it)
: +source_dir ( ca1 len1 -- ca2 len2 )
source_dir $@ 2swap s+ ;
\ Complete a source page filename with its path.
: +current_dir ( ca1 len1 -- ca2 len2 ) \ XXX TMP
s" ./" 2swap s+ ;
: .required_data_error ( ca len -- )
\ order cr \ XXX INFORMER
cr ." Error requiring the data of the page <" type ." >" cr ;
: required_data_error ( ca len ior -- )
>r .required_data_error r> throw ;
: (required_data) ( ca len -- )
\ ." parameter in `(required_data)` = " 2dup type cr key drop \ XXX INFORMER
do_content? off
\ .included key drop \ XXX INFORMER
\ cr ." before catch " .s cr key drop \ XXX INFORMER
2dup ['] required catch ?dup
\ cr ." after catch " .s cr key drop \ XXX INFORMER
if nip nip required_data_error
else 2drop then
\ ." end of (required_data) " .s cr \ XXX INFORMER
;
\ Require a page file _ca len_ in order to get its data.
: required_data ( ca len -- )
\ ." parameter in `required_data` = " 2dup type cr \ XXX INFORMER
\ ." related = " current_page related type cr \ XXX INFORMER
do_content? @ >r current_page >r
(required_data)
r> to current_page r> do_content? !
\ ." end of `required_data`" cr \ XXX INFORMER
\ ." related = " current_page related type cr \ XXX INFORMER
\ ." >>>>>>>>" cr \ XXX INFORMER
\ key drop \ XXX INFORMER
;
\ Require a page file _ca len_ in order to get its data.
: required_data<pid# ( a -- )
source_file required_data ;
\ Require a page file in order to get its data.
\ a = page ID (address of its data)
: (required_data<pid$) ( ca len -- )
\ ." Stack at the start of `(required_data<pid$)` : " .s cr key drop \ XXX INFORMER
\ ." Parameter in `(required_data<pid$)` = " 2dup type cr key drop \ XXX INFORMER
\ ." `link_anchor` in `(required_data<pid$)` = " link_anchor $@ type cr \ XXX INFORMER
-anchor?! +forth_extension
\ ." Stack before `required_data` in `(required_data<pid$)` : " .s cr key drop \ XXX INFORMER
required_data
\ ." Stack after `required_data` in `(required_data<pid$)` : " .s cr key drop \ XXX INFORMER
\ ." Stack at the end of `(required_data<pid$)` : " .s cr key drop \ XXX INFORMER
;
\ Require a page file in order to get its data.
\ ca len = page ID
: required_data<pid$ ( ca len -- )
\ ." Parameter in `required_data<pid$` before `unshortcut` = " 2dup type cr \ XXX INFORMER
unshortcut
\ ." Parameter in `required_data<pid$` after `unshortcut` = " 2dup type cr \ XXX INFORMER
(required_data<pid$) ;
\ Require a page file in order to get its data.
\ ca len = page ID
: required_data<target ( ca len -- )
\ ." required_data<target " 2dup type cr \ XXX INFORMER
-extension required_data<pid$ ;
\ Require a page file in order to get its data.
\ ca len = target file, without path
: require_data ( "name" -- )
parse-name? abort" File name expected in `require_data`"
required_data ;
\ Require a page file in order to get its data.
\ "name" = filename
: (pid$>pid#) ( ca len -- a )
\ ." Parameter of `(pid$>pid#)` : " 2dup type cr key drop \ XXX INFORMER
\ ." Stack at the start of `(pid$>pid#)` : " .s cr key drop \ XXX INFORMER
\ -anchor \ XXX TMP
\ ." `link_anchor` in `(pid$>pid#)` = " link_anchor $@ type cr \ XXX INFORMER
2dup (required_data<pid$) pid$>pid#? drop
\ ." Stack at the end of `(pid$>pid#` : " .s cr key drop \ XXX INFORMER
;
\ doc{
\
\ (pid$>pid#) ( ca len -- a )
\
\ Convert page ID _ca len_ into its equivalent _a_.
\
\ See also: `pid$>pid#`
\
\ }doc
: pid$>pid# ( ca len -- a )
\ ." Parameter in `pid$>pid#` before `dry_unshortcut` = " 2dup type cr \ XXX INFORMER
\ key drop \ XXX INFORMER
\ ." `href=` in `pid$>pid#` before `dry_unshortcut` = " s" href=@" evaluate .s ." = " type cr \ XXX INFORMER
\ ." `link_anchor` in `pid$>pid#` before `dry_unshortcut` = " link_anchor $@ type cr \ XXX INFORMER
dry_unshortcut \ XXX TMP
\ ." >> `href=` in `pid$>pid#` after `dry_unshortcut` = " s" href=@" evaluate .s ." = " type cr \ XXX INFORMER
\ ." Parameter in `pid$>pid#` after `dry_unshortcut` = " 2dup type cr \ XXX INFORMER
\ ." `link_anchor` in `pid$>pid#` after `dry_unshortcut` = " link_anchor $@ type cr \ XXX INFORMER
dup 0= abort" Empty page-id" \ XXX TMP
(pid$>pid#)
\ find-name name>int execute \ XXX SECOND version; no difference, same corruption of the input stream
\ cr ." end of data<pid$>pid" \ XXX INFORMER
;
\ doc{
\
\ pid$>pid# ( ca len -- a )
\
\ If string page ID _ca len_ is unknown, get its data from the
\ corresponding source page. Then return the equivalent page
\ ID _a_.
\
\ See also: `pid$>pid#?`.
\
\ }doc
: pid$>(data>)pid# ( ca len -- a )
\ ." Parameter in `pid$>(data>)pid#` = " 2dup type cr \ XXX INFORMER
dup if pid$>pid# else 2drop current_page then ;
\ Return a number page ID from a string page ID;
\ if it's different from the current page, require its data.
\ This word is needed to manage links to the current page
\ (href attributes that contain just an anchor).
: pid$>url ( ca1 len1 -- ca2 len2 )
pid$>pid# target_file +domain_url ;
: source>pid$ ( ca1 len1 -- ca2 len2 )
basename -forth_extension ;
\ Convert a source page to a page ID.
\ ca1 len1 = Forth source page filename with path
\ ca2 len2 = page ID
: source>pid# ( ca len -- a )
source>pid$ pid$>pid# ;
\ Convert a source page to a page ID.
\ ca len = Forth source page filename with path
\ a = page ID
: pid$>target ( ca1 len1 -- ca2 len2 )
2dup pid$>pid# target_extension s+ +target_dir ;
\ Convert a page ID to a target filename.
\ ==============================================================
\ Calculated data {{{1
: file_mtime ( a -- ca len )
dup file_modified dup
if rot drop else 2drop modified then ;
\ ISO time string used to set the mtime (modification time) of the
\ target files. The `file_modified` datum is the first choice,
\ then `modified`.
: newer? ( a -- f )
dup target_path/file 2dup file-exists?
if file-mtime rot file_mtime str<
else 2drop drop true then
\ dup if ." newer" else ." older" then cr \ XXX INFORMER
;
\ Is the given page newer than its target?
: description|title ( a -- ca len )
dup >r description dup if rdrop else 2drop r> title then ;
\ Description or (if it's empty) title of the given page ID _a_.
\ This is used as link title when no one has been specified.
: property? ( ca len a -- f )
{ D: property page_id }
\ XXX TODO change the properties system: make it similar to tags:...
\ XXX TODO ...make properties executable; they should trigger a flag.
page_id properties false { result }
/ssv 0 ?do
property str= result or to result
loop result ;
\ ca len = property to check
\ a = page ID (address of its data)
\ f = is the property in the properties field of the page?
\ `ignore_draft_property?` is a flag for the application
\ that does what its name suggets:
\ When it's true, the "draft" status will be ignored,
\ so draft pages will be built as definitive pages.
false value ignore_draft_property?
: draft? ( a -- f )
s" draft" rot property? ignore_draft_property? 0= and ;
\ doc{
\
\ draft? ( a -- f )
\
\ Is page ID _a_ a draft? I.e., is "draft" in its properties field?
\
\ See also: `unlistable?`.
\
\ }doc
: unlistable? ( a -- f )
s" unlistable" rot property? ;
\ doc{
\
\ unlistable? ( a -- f )
\
\ Is page ID _a_ unlistable? I.e., is "unlistable" in its properties
\ field?
\
\ See also: `lioc`, `draft?`.
\
\ }doc
: pid$>draft? ( ca len -- f )
\ ." Stack at the start of `pid$>draft?` : " .s cr key drop \ XXX INFORMER
pid$>pid# draft?
\ ." Stack at the end of `pid$>draft?` : " .s cr key drop \ XXX INFORMER
;
\ Is page ID _ca len_ a draft page?
: pid$>hierarchy ( ca len -- u )
0 rot rot \ counter
bounds ?do i c@ [char] . = abs + loop ;
\ Return the hierarchy level of a page (0 is the top level).
\ ca len = page ID (source page filename without extension)
: filename>hierarchy ( ca len -- u )
pid$>hierarchy 1- ;
\ Return the hierarchy level of a page (0 is the top level).
\ ca len = filename (without path; with extension)
: pid#>hierarchy ( a -- u )
pid#>pid$ pid$>hierarchy ;
\ Return the hierarchy level of a page (0 is the top level).
\ a = page ID (address of its data)
defer calculated_field_mark$ ( -- ca len )
:noname ( -- ca len ) s" [calculated]" ;
is calculated_field_mark$
\ doc{
\
\ calculated_field_mark$ ( -- ca len )
\
\ String _ca len_ is the contents of calculated fields, used by
\ `calculaled_field?`. ``calculaled_field_mark$`` is a deferred
\ word whose default output is "[calculated]". It can be configured
\ by the application.
\
\ }doc
: calculated_field? ( ca len -- f )
calculated_field_mark$ str= ;
\ doc{
\
\ calculated_field? ( ca len -- f )
\
\ Is _ca len_ the contents of a calculated field, as returned by
\ `calculated_field_mark$`?
\
\ }doc
variable this_page \ dynamic string
variable a_previous_page \ dynamic string
: (pid$>previous) ( ca1 len1 -- true | ca2 len2 false )
{: D: pid$ :}
pid$ pid$>pid# draft? ?dup ?exit
pid$ this_page $@ str=
if a_previous_page $@ false
else pid$ this_page $@ brother_pages?
if pid$ a_previous_page $! then true
then ;
\ doc{
\
\ (pid$>previous) ( ca1 len1 -- true | ca2 len2 false )
\
\ The execution token of this word is passed to `traverse_pids` by
\ `pid$>previous` in order to find the previous page of `this_page`
\ in the hierarchy.
\
\ If page ID _ca1 len1_ (local _pid$_) is the previous page of
\ `this_page`, return it as _ca2 len2_ with _false_ on TOS in order
\ to stop the traversing. Otherwise return just _true_ to continue
\ the traversing.
\
\ }doc
: pid$>previous ( ca1 len1 -- ca2 len2 )
this_page $! a_previous_page off
['] (pid$>previous) traverse_pids ;
\ doc{
\
\ pid$>previous ( ca1 len1 -- ca2 len2 )
\
\ Search for the previous brother page ID _ca2 len2_ of page ID _ca1
\ len1_. If no previous page is found in the hierarchy, _ca2 len2_
\ is an empty string.
\
\ ``pid$>previous`` stores _ca1 len1_ into `this_page`, then empties
\ `a_previous_page` and finally calls `traverse_pids` with
\ `(pid$>previous)`.
\
\ }doc
: ?previous_page ( a -- ca len )
dup previous_page 2dup calculated_field?
if 2drop pid#>pid$ pid$>previous
else rot drop
then ;
\ Return the previous brother page ID _ca2 len2_ of page ID _ca1 len1_.
\ If no previous page exists, _ca2 len2_ is an empty string.
\ doc{
\
\ ?previous_page ( a -- ca len )
\
\ If field `previous_page` of page ID _a_ is calculated, calculate
\ it and return the result in string _ca len_; otherwise return the
\ field contents.
\
\ See also: `calculated_field?`, `?first_page`, `?next_page`,
\ `?upper_page`.
\
\ }doc
variable a_next_page \ flag
: (pid$>next) ( ca1 len1 -- true | ca1 len1 false )
{: D: pid$ :}
\ ." `(pid$>next)` : " pid$ type cr \ XXX INFORMER
pid$ pid$>pid# draft? ?dup ?exit
\ ." not a draft" cr \ XXX INFORMER
this_page $@ pid$ brother_pages? 0= ?dup ?exit
\ this_page $@ pid$ relative_pages? 0= ?dup ?exit \ XXX TODO --
\ ." a brother" cr \ XXX INFORMER
this_page $@ pid$ -common-prefix
\ 2over ." this_page = " type cr 2dup ." pid$ = " type \ XXX INFORMER
str<
\ ." str<" .s cr \ XXX INFORMER
if a_next_page on pid$ false else true then ;
\ Is _ca1 len1_ (local _pid$_) the next brother page of the page
\ whose page ID is contained in the dynamic string _this_page_?
\ If so, return _ca1 len1_ and _false_ (to stop the traversing);
\ otherwise return just _true_ (to continue the traversion).
: pid$>next ( ca1 len1 -- ca2 len2 )
\ ." Input of `pid$>next`: «" 2dup type ." »" cr \ XXX INFORMER
a_next_page off
this_page $!
['] (pid$>next) traverse_pids
a_next_page @ 0= if 0 0 then
\ ." Output of `pid$>next`: «" 2dup type ." »" cr \ XXX INFORMER
;
\ Return the next brother page ID _ca2 len2_ of page ID _ca1 len1_.
\ If no next page exists, _ca2 len2_ is an empty string.
: ?next_page ( a -- ca len )
dup next_page 2dup calculated_field?
if 2drop pid#>pid$ pid$>next
else rot drop
then ;
\ doc{
\
\ ?next_page ( a -- ca len )
\
\ If field `next_page` of page ID _a_ is calculated, calculate it
\ and return the result in string _ca len_; otherwise return the
\ field contents.
\
\ See also: `calculated_field?`, `?first_page`, `?previous_page`,
\ `?upper_page`.
\
\ }doc
: pid$>source ( ca1 len1 -- ca2 len2 )
+forth_extension +source_dir ;
\ Convert a page id to a source filename.
\
\ XXX REMARK -- 2014-03-03: This word was tried in
\ `(required_dat<pid$)`, but adding the path to the filename makes
\ the pages to be included into the list of included files (shown by
\ `.included`) with an absolute path. The solution is: the
\ application has to add `source_dir` to `fpath`.
: pid$>upper ( ca1 len1 -- ca2 len2 )
-extension
\ begin -extension 2dup pid$>source dup 0= file-exists? or until
\ 2drop
;
\ Return the upper page ID _ca2 len2_ of page ID _ca1 len1_.
\ If no upper page exists, _ca2 len2_ is an empty string.
\
\ XXX FIXME -- Make this smarter: ignore pages that don't exist.
: ?upper_page ( a -- ca len )
dup upper_page 2dup calculated_field?
if 2drop pid#>pid$ pid$>upper
else rot drop
then ;
\ doc{
\
\ ?upper_page ( a -- ca len )
\
\ If field `upper_page` of page ID _a_ is calculated, calculate it
\ and return the result in string _ca len_; otherwise return the
\ field contents.
\
\ See also: `calculated_field?`, `?first_page`, `?previous_page`,
\ `?next_page`.
\
\ }doc
: (pid$>first) ( ca1 len1 -- true | ca2 len2 false )
{: D: pid$ :}
pid$ pid$>pid# draft? ?dup ?exit
pid$ this_page $@ brother_pages? 0= ?dup ?exit
pid$ false ;
\ Is page ID _ca1 len1_ (local _pid$_) contained in the dynamic string
\ _this_page_? If so, return the page ID _ca2 len2_ of its first brother
\ page in the hierarchy (page ID which was saved in the first execution)
\ and _false_ (to stop the traversing); otherwise return just _true_ (to
\ continue the traversing).
: pid$>first ( ca1 len1 -- ca2 len2 )
this_page $!
['] (pid$>first) traverse_pids ;
\ Return the first brother page ID _ca2 len2_ of page ID _ca1 len1_.
\ If no first page exists, _ca2 len2_ is an empty string.
: ?first_page ( a -- ca len )
dup first_page 2dup calculated_field?
if 2drop pid#>pid$ pid$>first
else rot drop
then ;
\ doc{
\
\ ?first_page ( a -- ca len )
\
\ If field `first_page` of page ID _a_ is calculated, calculate it
\ and return the result in string _ca len_; otherwise return the
\ field contents.
\
\ See also: `calculated_field?`, `?previous_page`,
\ `?next_page`, `?upper_page`.
\
\ }doc
\ ==============================================================
\ Data manipulation {{{1
: (file-mtime>modified) ( ca len -- )
file-mtime 2dup current_page modified
str< if 2drop else current_page 'modified $! then ;
\ If the modification time of the given file is more recent
\ than the current page `modified` datum, update the page datum with
\ the file modification time.
true value included_files_update_the_page_date?
\ Config flag for the application.
: file-mtime>modified ( ca len -- )
included_files_update_the_page_date?
if (file-mtime>modified) else 2drop then ;
\ If the modification time of the given file is more recent
\ than the current page `modified` datum, update the page datum with
\ the file modification time.
\ This is used by addons that include contents file into the page,
\ in order to update the page `modified` datum with the date of
\ the most recent file used.
.( fendo.data.fs compiled) cr
\ ==============================================================
\ Change log {{{1
\ 2013-04-28: Start.
\
\ 2013-05-01: Fixed and finished the data system.
\
\ 2013-05-17: Fix: There were two words with the name `>datum`; it
\ caused no problem in practice, but was confusing.
\
\ 2013-05-17: Improvement: `data{` gets the data only the first time.
\
\ 2013-05-17: New: `require_data` is moved here from its own file, and
\ simplified.
\
\ 2013-05-18: Change: data fields return their offset, not their
\ content (neccessary to write `datum!`; `>datum` removed (now `+` can
\ be used instead). `datum!` is necessary in order to set default
\ values to certain fields.
\
\ 2013-05-18: New: `parse_datum` is rewriten and factored out to
\ `datum!`.
\
\ 2013-06-07: Fix: The check in `data{` was obsolete; it has been
\ rewritten.
\
\ 2013-06-08: Fix: The leading spaces of parsed data were not removed.
\
\ 2013-06-08: Fix: now `datum@` returns an empty string if the datum
\ was not set.
\
\ 2013-06-08: Fix: `@` missing in `default_data`; beside, renamed to
\ "set_default_data'.
\
\ 2013-06-08: Change: `datum@` and `datum!` are removed; `$@` and `$!`
\ are used instead (from Gforth's <string.fs>)).
\
\ 2013-06-08: Fix: name clash (old `source_filename` > `+source_path`;
\ new `source_filename` > `/sourcefilename`).
\
\ 2013-06-23: Change: design and template fields are renamed after the
\ changes in the config module.
\
\ 2013-06-28: Change: hierarchy metadata fields are renamed with the