fhp - paths
Descripción del contenido de la página
Módulo del programa fhp para gestionar rutas, nombres y extensiones de fichero.
Código fuente
CR .( fhp-paths )
\ Copyright (C) 2006,2007,2010 Marcos Cruz (programandala.net)
\ This file is part of
\ fhp ("Forth HTML Preprocessor") version B-00-201206
\ (http://programandala.net/en.program.fhp).
\ This module provides the paths, filenames and file tools.
\ fhp 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.
\
\ fhp 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 fhp; if not, see <http://gnu.org/licenses>.
\ fhp is written in the Forth language
\ with Gforth (http://gnu.org/software/gforth/).
\ .............................................................
\ History (in reversed order)
\ 2015-02-04: Header updated; layout a bit changed.
\
\ 2010-10-07: First support for Simplilo's format output.
\
\ 2007-04-08: Used the new constant LOCAL-SLASH . It is initialized in
\ the fhp loader.
\
\ 2007-01-22: Improved with +ARC-DISK-PATH and +ARC-URL-PATH .
\
\ 2006-08-08: Created with code written for the program alinome-bici.
\ .............................................................
\ Init
MARKER fhp-paths
\ .............................................................
\ File extensions
: +".html" ( c-addr1 u1 -- c-addr2 u2 )
\ 2006-03-14
\ 2007-02-07 Moved from the module fhp-ml.
\ 2010-10-07 Support for Simplilo's format.
simplilo? 0= IF
S" .html" str+
THEN
;
defer +extension \ 2007-02-07 Moved from the module fhp-ml and defered, in order to make it accessible also in monolingual webs.
' +".html" is +extension
\ .............................................................
\ Labels
: (+label) ( c-addr1 u1 c-addr2 u2 -- c-addr3 u3 )
\ Join a file name and a label.
\ c-addr1 u1 = label
\ c-addr2 u2 = file name with extension
\ 2007-04-07
S" #" str+ 2SWAP str+
;
: +label ( c-addr1 u1 c-addr2 u2 -- c-addr3 u3 )
\ Joins a file name and a label
\ c-addr1 u1 = file name with extension
\ c-addr2 u2 = label
\ 2007-04-06
2SWAP (+label)
;
: file+label ( c-addr1 u1 c-addr2 u2 -- c-addr3 u3 )
\ Join a file name and a label.
\ c-addr1 u1 = file name without extension
\ c-addr2 u2 = label
\ 2007-04-04 First version
\ 2SWAP +extension (+label)
\ 2007-05-07 Added conditions, to make the word more general
\ Now it is used by the calculated field >PAGE-FILE#LABEL .
2SWAP DUP IF +extension THEN
2 PICK IF (+label) ELSE 2SWAP 2DROP THEN
;
\ .............................................................
\ Paths
\ Image directories:
svariable img-dir \ image base directory under html-path
svariable img-subdir 0 img-subdir C! \ optional img subdirectory under img-dir
svariable img-path \ image local directory while building the site
\ Archive directories for downloadable files:
svariable arc-dir \ archive base directory under html-path
svariable arc-subdir 0 arc-subdir C! \ optional archive subdirectory under img-dir
svariable arc-path \ archive local directory while building the site
: (cpath+) ( c-addr1 u1 c-addr2 u2 b -- c-addr4 u4 )
\ Join two file paths (with a join sign between them, if it is not already at the join).
\ c-addr1 u1 = left string
\ c-addr2 u2 = right string
\ b = join char (generally a slash or a back slash)
\ 2007-06-03 Factored from PATH+ .
\ 2008-01-19 Renamed (formerly (PATH+) ) because of the gforth word PATH+ .
>R
OVER C@ >R \ first char of the right string
2SWAP 2DUP 1- + C@ \ last char of the left string
R> R@ <> SWAP R@ <> AND \ are both chars different than the join char?
IF R> b>str str+ 2SWAP str+
ELSE R> DROP 2SWAP str+
THEN
;
: cpath+ ( c-addr1 u1 c-addr2 u2 b -- c-addr4 u4 )
\ Join two file paths (with a join char between them, if it is not already at the join)
\ if no string is empty.
\ c-addr1 u1 = left string
\ c-addr2 u2 = right string
\ b = join char (generally a slash or a back slash)
\ 2006-07-02
\ 2007-06-03 Improved. Now it controls also if the first string is empty.
\ That fixes a bug detected when w3c icons files joined their empty subdir:
\ the result was a file with a slash at the start, what made the final result had two slashes.
\ That made Forth 5mx (not WinForth) fail when trying to open the local image file to get its measures.
\ 2008-01-19 Renamed (formerly PATH+ ) because of the gforth word PATH+ .
OVER 0=
IF \ the second string is empty
DROP 2DROP \ return the first string
ELSE
>R 2SWAP DUP >R 2SWAP R> 0= R> SWAP
IF \ the first string is empty
DROP 2SWAP 2DROP \ return the second string
ELSE
(cpath+)
THEN
THEN
;
: disk-path+ ( c-addr1 u1 c-addr2 u2 -- c-addr3 u3 )
\ Join two parts of a local path.
\ 2006-07-02
local-slash cpath+
;
: url-path+ ( c-addr1 u1 c-addr2 u2 -- c-addr3 u3 )
\ Join two parts of a web path.
\ 2006-07-02
[CHAR] / cpath+
;
: />\ ( c-addr u -- c-addr u )
\ Change "slashes" into "back slashes".
2DUP 0 DO
DUP I + C@ [CHAR] / =
IF DUP I + [CHAR] \ SWAP C! THEN
LOOP DROP
;
: \>/ ( c-addr u -- c-addr u )
\ Change "back slashes" into "slashes".
2DUP 0 DO
DUP I + C@ [CHAR] \ =
IF DUP I + [CHAR] / SWAP C! THEN
LOOP DROP
;
: +img-disk-path ( c-addr1 u1 -- c-addr2 u2 )
\ Add the whole local path to an image file.
\ c-addr1 u1 = filename without arc-dir and arc-subdir
\ c-addr2 u2 = whole local path to the archive
\ 2006-07-12
\ 2006-08-10 Modified to use IMG-SUBDIR ; renamed: former name was WHOLE-IMG-PATH .
\ 2007-03-21 Bug fixed, difficult to find: the word />\ was at the beginning, and that modified the original parameter in the stack,
\ what made problems with -URL-PATH . Now the slash translation is made at the end, on the result string stored iun the string buffer.
\ 2008-01-20 Modified. The slash conversion is not done when the OS class is Unix.
img-path COUNT
img-subdir COUNT disk-path+
2SWAP disk-path+
[ unix? 0= ] [IF] \ the word unix? is defined in the file from_5mx.f
/>\ \ translate slashes that could be in the original parameter into back slahses
[THEN]
;
: +img-url-path ( c-addr1 u1 -- c-addr2 u2 )
\ Add the whole web path to an image file.
\ c-addr1 u1 = filename without arc-dir and arc-subdir
\ c-addr2 u2 = whole web path to the archive
\ 2006-08-10
\>/ \ because of a possible local directory included
img-dir COUNT img-subdir COUNT url-path+
2SWAP url-path+
;
: +arc-disk-path ( c-addr1 u1 -- c-addr2 u2 )
\ Add the local path to a downloadable file.
\ c-addr1 u1 = filename without arc-dir and arc-subdir
\ c-addr2 u2 = whole web path to the archive
\ 2007-01-22
\ 2008-01-20 Modified. The slash conversion is not done when the OS class is Unix.
[ unix? 0= ] [IF] \ the word unix? is defined in the file from_5mx.f
/>\ \ because of a possible local directory included
[THEN]
arc-path COUNT arc-subdir COUNT disk-path+
2SWAP disk-path+
;
: +arc-url-path ( c-addr1 u1 -- c-addr2 u2 )
\ Add the whole web path to a downloadable file.
\ c-addr1 u1 = filename without arc-dir and arc-subdir
\ c-addr2 u2 = whole web path to the archive
\ 2007-01-22
\>/ \ because of a possible local directory included
arc-dir COUNT arc-subdir COUNT url-path+
2SWAP url-path+
;
\ .............................................................
\ Extract from paths
: only-one ( c-addr1 u1 c-addr2 u2 -- c-addr1 u1 | c-addr2 u2 )
\ If the top string is not empty, keep it. Otherwise drop it.
\ 2007-01-16
\ 2007-03-21 Moved here from the fhp-links module.
DUP IF 2SWAP THEN 2DROP
;
: -extension ( c-addr1 u1 -- c-addr2 u2 )
\ Take off the file name extension.
\ c-addr1 u1 = file name with extensions
\ c-addr2 u2 = file name without extensions
\ 2007-02-24 Migrated from the aplication alinome-bici
\ [CHAR] . /char-in-str 2SWAP 2DROP
\ 2007-03-21 Bug fixed. ONLY-ONE used instead of 2SWAP and 2DROP .
[CHAR] . /last-char-in-str only-one
;
: -url-path ( c-addr1 u1 -- c-addr2 u2 )
\ Take off the URL-like path (that is, with slashes).
\ 2007-02-24
\ c-addr1 u1 = file name with URL-like path
\ c-addr2 u2 = file name without path
[CHAR] / /last-char-in-str 2DROP
;
: path-only ( c-addr1 u1 -- c-addr2 u2 )
\ c-addr1 u1 = URL
\ c-addr2 u2 = URL without parameteres
\ 2007-01-16
\ 2007-04-05 Moved here from the upper layer, from the forthCMS-links module
[CHAR] ? /char-in-str only-one
;
: domain-only ( c-addr1 u1 -- c-addr2 u2 )
\ c-addr1 u1 = URL
\ c-addr2 u2 = domain
\ 2007-01-16
\ 2007-04-05 Moved here from the upper layer, from the forthCMS-links module
[CHAR] / /char-in-str only-one
;
: (.fhp-path) ( c-addr1 u1 c-addr2 u2 -- )
\ Show a path: name, description and content.
\ c-addr1 u1 = name of the string variable
\ c-addr2 u2 = description
\ 2007-12-09
CR TYPE [CHAR] : EMIT
2DUP CR TYPE ." = "
EVALUATE COUNT TYPE
;
: .fhp-paths ( -- )
\ Show the current paths.
\ 2007-12-08
CR CR ." Current fhp paths:" CR
S" html-path"
S" Main path for the HTML pages"
(.fhp-path)
CR CR ." Directories for images:" CR
S" img-dir"
S" Image base directory under html-path "
(.fhp-path)
S" img-subdir"
S" Optional image subdirectory under img-dir "
(.fhp-path)
S" img-path"
S" Image local directory while building the site (used to read the image properties)"
(.fhp-path)
CR CR ." Directories for files (downloadable, media...):" CR
S" arc-dir"
S" Archive base directory under html-path "
(.fhp-path)
S" arc-subdir"
S" Optional archive subdirectory under arc-dir "
(.fhp-path)
S" arc-path"
S" Archive local directory while building the site (used to read the file properties)"
(.fhp-path)
CR CR
;
.( fhp-paths ok!)