---

fhp - paths

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!)