[Author Prev][Author Next][Thread Prev][Thread Next][Author Index][Thread Index]
gEDA-cvs: gaf.git: branch: master updated (1.7.1-20110619-258-g4a1b54f)
The branch, master has been updated
via 4a1b54fdf119538e90f5b0dbc73a5a9d8ddc56da (commit)
from ce4662cfda106f037b02e165a97d73121f0ea195 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
=========
Summary
=========
docs/scheme-api/geda-scheme.texi | 11 ++++
libgeda/scheme/Makefile.am | 1 +
libgeda/scheme/geda/os.scm | 25 +++++++++-
.../unit-tests/t0401-os-expand-env-variables.scm | 50 ++++++++++++++++++++
4 files changed, 86 insertions(+), 1 deletions(-)
create mode 100644 libgeda/scheme/unit-tests/t0401-os-expand-env-variables.scm
=================
Commit Messages
=================
commit 4a1b54fdf119538e90f5b0dbc73a5a9d8ddc56da
Author: Luigi S. Palese <quadword@xxxxxxxxx>
Commit: Peter TB Brett <peter@xxxxxxxxxxxxx>
scheme-api: Added expand-env-variables function to the os module.
Reviewed-by: Peter TB Brett <peter@xxxxxxxxxxxxx>
:100644 100644 2ac727e... fe33768... M docs/scheme-api/geda-scheme.texi
:100644 100644 9195ef3... eb6c3fd... M libgeda/scheme/Makefile.am
:100644 100644 8430e6e... 80a5772... M libgeda/scheme/geda/os.scm
:000000 100644 0000000... b20fd9c... A libgeda/scheme/unit-tests/t0401-os-expand-env-variables.scm
=========
Changes
=========
commit 4a1b54fdf119538e90f5b0dbc73a5a9d8ddc56da
Author: Luigi S. Palese <quadword@xxxxxxxxx>
Commit: Peter TB Brett <peter@xxxxxxxxxxxxx>
scheme-api: Added expand-env-variables function to the os module.
Reviewed-by: Peter TB Brett <peter@xxxxxxxxxxxxx>
diff --git a/docs/scheme-api/geda-scheme.texi b/docs/scheme-api/geda-scheme.texi
index 2ac727e..fe33768 100644
--- a/docs/scheme-api/geda-scheme.texi
+++ b/docs/scheme-api/geda-scheme.texi
@@ -1641,6 +1641,17 @@ Returns the directory in which to store user-specific gEDA
configuration information.
@end defun
+@defun expand-env-variables str
+Recursively expands @var{str} until no more environment variables can be
+expanded, and return the expanded string. Environment variables are in
+the form @samp{$@{VAR@}}.
+
+@example
+(expand-env-variables "$@{HOME@}/path/to/dir")
+@end example
+
+@end defun
+
@node gschem API Reference
@chapter gschem API Reference
diff --git a/libgeda/scheme/Makefile.am b/libgeda/scheme/Makefile.am
index 9195ef3..eb6c3fd 100644
--- a/libgeda/scheme/Makefile.am
+++ b/libgeda/scheme/Makefile.am
@@ -32,6 +32,7 @@ TESTS = unit-tests/t0001-geda-conf-lib.scm \
unit-tests/t0300-attribute.scm \
unit-tests/t0301-promotable-attributes.scm \
unit-tests/t0400-os.scm \
+ unit-tests/t0401-os-expand-env-variables.scm \
unit-tests/t1000-deprecated.scm
XFAIL_TESTS = \
diff --git a/libgeda/scheme/geda/os.scm b/libgeda/scheme/geda/os.scm
index 8430e6e..80a5772 100644
--- a/libgeda/scheme/geda/os.scm
+++ b/libgeda/scheme/geda/os.scm
@@ -22,7 +22,9 @@
; Import C procedures and variables
#:use-module (geda core os)
- #:use-module (srfi srfi-1))
+ #:use-module (srfi srfi-1)
+
+ #:use-module (ice-9 regex))
(define-public platform %platform)
@@ -55,3 +57,24 @@
(string-join (list (getenv "HOME") ".gEDA") separator))
(define-public user-config-dir user-data-dir)
+
+(define-public expand-env-variables
+ ;; Only compile regular expression once
+ (let ((rx (make-regexp "\\$\\{(\\w*)\\}")))
+ ;; This is the actual expand-env-variables function -- it's a
+ ;; closure around rx.
+ (lambda (str)
+ ;; Returns result of expanding the environment variable name
+ ;; found in match, or "".
+ (define (match-getenv m)
+ (or (getenv (match:substring m 1)) ""))
+ ;; Carries out a single round of environment variable expansion
+ ;; on str
+ (define (expand-once str)
+ (regexp-substitute/global #f rx str 'pre match-getenv 'post))
+ ;; Tail-recursively expands str until no more environment variables
+ ;; can be expanded.
+ (let ((result (expand-once str)))
+ (if (string=? str result)
+ result
+ (expand-env-variables result))))))
diff --git a/libgeda/scheme/unit-tests/t0401-os-expand-env-variables.scm b/libgeda/scheme/unit-tests/t0401-os-expand-env-variables.scm
new file mode 100644
index 0000000..b20fd9c
--- /dev/null
+++ b/libgeda/scheme/unit-tests/t0401-os-expand-env-variables.scm
@@ -0,0 +1,50 @@
+; -*-Scheme-*-
+; This program 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.
+;
+; 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/>.
+;
+;
+; Copyright (C) 2011 L.S.P. <ultrabit@xxxxxxxxx>
+;
+(use-modules (unit-test)
+ (geda os))
+
+(begin-test 'expand-env-variables
+ (and
+ ; Bad expression samples
+ (setenv "USER" "myuser")
+ (setenv "HOME" "myhome")
+ (assert-equal "/a/${USER myhome }/b/c"
+ (expand-env-variables "/a/${USER ${HOME} }/b/c"))
+ (assert-equal "/a/${USER=myhome }/b/c"
+ (expand-env-variables "/a/${USER=${HOME} }/b/c"))
+ (assert-equal "/a/${USER=myhome}/b/c"
+ (expand-env-variables "/a/${USER=${HOME}}/b/c"))
+ (assert-equal "/a/${=USER=}/b/c"
+ (expand-env-variables "/a/${=USER=}/b/c"))
+ (assert-equal "/a//b/c"
+ (expand-env-variables "/a/${}/b/c"))
+ (assert-equal "/a/${-USER-}/b/c"
+ (expand-env-variables "/a/${-USER-}/b/c"))
+ ; Good expression samples
+ (setenv "EXPAND_ENV_VARS_TEST" "abc")
+ (setenv "VARS_TEST" "_VARS_TEST")
+ (assert-equal "/a/abc/b/c"
+ (expand-env-variables "/a/${EXPAND_ENV_VARS_TEST}/b/c"))
+ (assert-equal "/a/abcabc/b/c"
+ (expand-env-variables "/a/${EXPAND_ENV_VARS_TEST}${EXPAND_ENV_VARS_TEST}/b/c"))
+ (assert-equal "/a/abc/abc/b/c"
+ (expand-env-variables "/a/${EXPAND_ENV_VARS_TEST}/${EXPAND_ENV_VARS_TEST}/b/c"))
+ ; Recursed expansion
+ (assert-equal "/a/abc/abc/b/c"
+ (expand-env-variables "/a/${EXPAND_ENV${VARS_TEST}}/${EXPAND_ENV_VARS_TEST}/b/c"))
+ ))
_______________________________________________
geda-cvs mailing list
geda-cvs@xxxxxxxxxxxxxx
http://www.seul.org/cgi-bin/mailman/listinfo/geda-cvs