Commit e33fbaa2 authored by Erick's avatar Erick

Added UTF-8 support to most of the string functions (string-ref string-set!,...

Added UTF-8 support to most of the string functions (string-ref string-set!, string-upcase, string-downcase, ...). Comparisons are not done yet
parent f1f00e4a
;;;;
;;;; lib.stk -- Library for STklos Documentation Building
;;;;
;;;; Copyright 2003-2010 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
;;;;
;;;;
;;;; lib.stk -- Library for STklos Documentation Building
;;;;
;;;; Copyright 2003-2011 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
;;;;
;;;;
;;;; 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, write to the Free Software
;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
;;;; USA.
;;;;
;;;;
;;;; Author: Erick Gallesio [eg@essi.fr]
;;;; Creation date: 20-Dec-2003 23:23 (eg)
;;;; Last file update: 10-Aug-2010 09:19 (eg)
;;;; Last file update: 27-May-2011 23:16 (eg)
;;;;
(load "srfi.stk")
......@@ -30,7 +30,7 @@
;;;;
;;;; Customization
;;;;
;;;;
(define *doc* '()) ;; The documentation datbase when in memory
(define *stderr* (current-error-port))
(define *verbose* (getenv "DEBUG"))
......@@ -43,7 +43,7 @@
;======================================================================
;
;
; read-database
;
;======================================================================
......@@ -57,7 +57,7 @@
(when *verbose* (format *stderr* " Done\n")))
;======================================================================
;
;
; rewrite-for-skribe
;
;======================================================================
......@@ -71,7 +71,7 @@
(define R4RS-rgxp (string->regexp "R4RS"))
(define R5RS-rgxp (string->regexp "R5RS"))
(define STklos-rgxp (string->regexp "STklos"))
(define linebrk-rgxp (string->regexp ""))
(define linebrk-rgxp (string->regexp "@l"))
(define (fontified-code code)
(blockquote
......@@ -90,8 +90,8 @@
(define (rewrite-for-skribe def)
;; rewrite |f| and |t|
(set! def (regexp-replace-all "\\|(f|t)\\|" def "|#\\1|"))
;; rewrite |%f| and |%t|
(set! def (regexp-replace-all "\\|%(f|t)\\|" def "|#\\1|"))
;; rewrite |xxx| in @code{xxx}
(set! def (regexp-replace-all var-rgxp def ",(code [\\1])"))
;; rewrite => in an arrow
......@@ -112,13 +112,13 @@
(set! def (regexp-replace-all STklos-rgxp def ",(stklos)"))
;; rewrite linebreak
(set! def (regexp-replace-all linebrk-rgxp def ",(linebreak 2)"))
def)
;======================================================================
;
;
; insert-documentation
;
;======================================================================
......@@ -165,9 +165,9 @@
((extended-syntax) [,(stklos) ,(linebreak) syntax])
((procedure) [,(rfive) ,(linebreak) procedure])
((extended) [,(stklos) ,(linebreak) procedure])))))
(list
(color :width 100. :border 0 :bg *header-bg* :margin 3
(color :width 100. :border 0 :bg *header-bg* :margin 3
;; Put marks for all the functions defined in this entry
(map (lambda (x) (mark (format "~A" x)))
(cons name similar))
......@@ -184,7 +184,7 @@
(else
(Loop (cdr l) (cons (list (show-form (car l))
(! "\\\\\n") )
res))))))
res))))))
;; Display the description text
(blockquote (eval (read-from-string
(string-append "["
......@@ -198,7 +198,7 @@
(unless lst
(format *stderr* "Error: no documentation for item ~S\n" item)
(exit 1))
(when *verbose*
(format *stderr* "Documentation of ~S\n" item))
(let ((infos (cdr lst)))
......@@ -216,7 +216,7 @@
(doc item type syn sim desc))))))
;======================================================================
;
;
; show-undocumented
;
;======================================================================
......
This diff is collapsed.
;;;;
;;;; c o m p i l e r . s t k -- STklos Compiler
;;;;
;;;; Copyright 2000-2010 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
;;;; Copyright 2000-2011 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
;;;;
;;;;
;;;; This program is free software; you can redistribute it and/or modify
......@@ -21,7 +21,7 @@
;;;;
;;;; Author: Erick Gallesio [eg@unice.fr]
;;;; Creation date: 26-Feb-2000 10:47 (eg)
;;;; Last file update: 23-Dec-2010 20:16 (eg)
;;;; Last file update: 23-Jun-2011 20:21 (eg)
;;;;
(define-module STKLOS-COMPILER
......@@ -404,7 +404,7 @@ doc>
* value of the first expression that evaluates to a false value is
* returned. Any remaining expressions are not evaluated. If all the
* expressions evaluate to true values, the value of the last expression
* is returned. If there are no expressions then |t| is returned.
* is returned. If there are no expressions then |%t| is returned.
*
* @lisp
* (and (= 2 2) (> 2 1)) => #t
......@@ -445,7 +445,7 @@ doc>
* value of the first expression that evaluates to a true value is
* returned. Any remaining expressions are not evaluated. If all
* expressions evaluate to false values, the value of the last expression
* is returned. If there are no expressions then |f| is returned.
* is returned. If there are no expressions then |%f| is returned.
*
* @lisp
* (or (= 2 2) (> 2 1)) => #t
......@@ -1015,7 +1015,7 @@ doc>
(memq fct '(fx+ fx*))) ; commutative only
(oper2 (if (eq? fct 'fx+)
'IN-SINT-FXADD2
'INT-SINT-FXMUL2)
'IN-SINT-FXMUL2)
b a))
((small-integer-constant? b)
(oper2 (case fct
......
;;;;
;;;; date.stk -- Date and Time Operations
;;;;
;;;; Copyright 2002-2006 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
;;;;
;;;;
;;;;
;;;; Copyright 2002-2011 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
;;;;
;;;;
;;;; 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, write to the Free Software
;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
;;;; USA.
;;;;
;;;;
;;;; Author: Erick Gallesio [eg@unice.fr]
;;;; Creation date: 3-Apr-2002 10:06 (eg)
;;;; Last file update: 3-Feb-2006 17:47 (eg)
;;;; Last file update: 27-May-2011 23:01 (eg)
;;;;
;;;; ======================================================================
......@@ -31,10 +31,10 @@
;;;; ======================================================================
#|
<doc EXT time?
<doc EXT time?
* (time? obj)
*
* Return |t| if |obj| is a time object, othererwise returns |f|.
* Return |%t| if |obj| is a time object, othererwise returns |%f|.
doc>
|#
(define (time? obj)
......@@ -46,7 +46,7 @@ doc>
* (time->seconds time)
*
* Convert the time object |time| into an inexact real number representing
* the number of seconds elapsed since the Epoch.
* the number of seconds elapsed since the Epoch.
* @lisp
* (time->seconds (current-time)) ==> 1138983411.09337
* @end lisp
......@@ -92,7 +92,7 @@ doc>
#|
<doc EXT make-date
* (make-date :key second minute hour day month year)
*
*
* Build a date from its argument. |hour|, |minute|, |second| default to 0;
* |day| and |month| default to 1; |year| defaults to 1970
doc>
......@@ -108,7 +108,7 @@ doc>
<doc EXT date?
* (date? obj)
*
* Return |t| if |obj| is a date, and otherwise returns |f|.
* Return |%t| if |obj| is a date, and otherwise returns |%f|.
doc>
|#
(define (date? obj)
......@@ -205,10 +205,10 @@ doc>
#|
<doc EXT seconds->list
* (seconds->list sec)
*
* Returns a keyword list for the date given by |sec| (a date based on the
*
* Returns a keyword list for the date given by |sec| (a date based on the
* Epoch). The keyed values returned are
* ,(itemize
* ,(itemize
* (item [second : 0 to 59 (but can be up to 61 to allow for leap seconds)])
* (item [minute : 0 to 59])
* (item [hour : 0 to 23])
......@@ -222,7 +222,7 @@ doc>
* (UTC) and local standard time in seconds.])
* )
* @lisp
* (seconds->list (current-second))
* (seconds->list (current-second))
* => (:second 51 :minute 26 :hour 19
* :day 5 :month 11 :year 2004
* :week-day 5 :year-day 310
......@@ -337,7 +337,7 @@ doc>
(define (date->string format date)
(unless (string? format)
(error 'date->string "bad string ~S" format))
(seconds->string format (date->seconds date)))
......
;;;;
;;;; ffi.stk -- FFI support
;;;;
;;;; Copyright © 2007-2010 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
;;;;
;;;;
;;;;
;;;; Copyright © 2007-2011 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
;;;;
;;;;
;;;; 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, write to the Free Software
;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
;;;; USA.
;;;;
;;;;
;;;; Author: Erick Gallesio [eg@essi.fr]
;;;; Creation date: 14-Bun-2007 09:24 (eg)
;;;; Last file update: 21-Aug-2010 14:16 (eg)
;;;; Last file update: 27-May-2011 23:21 (eg)
;;;;
(define make-external-function #f)
......@@ -42,7 +42,7 @@
(:boolean 12)
(:pointer 13)
(:string 14)
(:int8 15)
(:int8 15)
(:int16 16)
(:int32 17)
(:int64 18)
......@@ -56,7 +56,7 @@
(error 'define-external "parameter of type :void are forbidden")
(cadr info)))
(error 'define-external "bad type name ~S" k))))
(define (parse-parameters lst)
(map (lambda (x)
(cond
......@@ -98,11 +98,11 @@
* element is the name of the parameter, and the second one is a type
* keyword. All the types defined in the above table, except
* |:void|, are allowed for the parameters of a foreign function.
* £
* @linebreak
* |Define-external| accepts several options:
* ,(itemize
* (item [
* |:return-type| is used to define the type of the value returned
* |:return-type| is used to define the type of the value returned
* by the foreign function. The type returned must be chosen in the types specified
* in the table. For instance:
* @lisp
......@@ -113,12 +113,12 @@
* returns an integer result. Omitting this option default to a result
* type equal to |:void| (i.e. the returned value is ,(emph "undefined")).
* ])
*
*
* (item [
* |:entry-name| is used to specify the name of the foreign
* function in the C world. If this option is omitted, the entry-name is
* supposed to be |name|. For instance:
* @lisp
* @lisp
* (define-external minimum((a :int) (b :int))
* :return-type :int
* :entry-name "min")
......@@ -127,15 +127,15 @@
* executes the C function called |min|.
* ])
* (item [
* |:library-name| is used to specify the library which contains the
* foreign-function. If necessary, the library is loaded before calling the
* C function. So,
* @lisp
* |:library-name| is used to specify the library which contains the
* foreign-function. If necessary, the library is loaded before calling the
* C function. So,
* @lisp
* (define-external minimum((a :int) (b :int))
* :return-type :int
* :entry-name "min"
* :library-name "libminmax")
* @end lisp
* @end lisp
* defines a function which will execute the function |min|
* located in the library |libminmax.xx| (where |xx| is the suffix used
* for shared libraries on the running system (generally |so|))
......
;;;;
;;;; getopt.stk -- getopt
;;;;
;;;; Copyright © 2001-2006 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
;;;;
;;;;
;;;; getopt.stk -- getopt
;;;;
;;;; Copyright © 2001-2011 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
;;;;
;;;;
;;;; 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, write to the Free Software
;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
;;;; USA.
;;;;
;;;; Author: Erick Gallesio [eg@unice.fr]
;;;; Creation date: 26-Oct-2001 08:40 (eg)
;;;; Last file update: 5-Dec-2006 13:50 (eg)
;;;; Last file update: 27-May-2011 22:50 (eg)
;;;;
;;;;
;;;;
;;;; %PRINT--USAGE
;;;;
;;;; pretty print options usage
;;;;
;;;; pretty print options usage
;;;;
#|
<doc EXT arg-usage
......@@ -37,10 +37,10 @@
* This procedure is only bound inside a |parse-arguments| form.
* It pretty prints the help associated to the clauses of the
* |parse-arguments| form on the given port. If the argument
* |as-sexpr| is passed and is notf|, the help strings are
* |as-sexpr| is passed and is not| #f|, the help strings are
* printed on |port| as ,(emph "S-expr")s. This is useful if the help
* strings need to be manipulated by a program.
*
*
doc>
|#
(define (%print-usage port clauses sexpr)
......@@ -93,7 +93,7 @@ doc>
(len (apply max (map (lambda (x)
(if (pair? x) (string-length (car x)) 0))
lines))))
;; lines contains the line to be displayed and len is the length of the
;; longest option. Pretty print the options from those values
(for-each (lambda (x)
......@@ -106,9 +106,9 @@ doc>
(format port "~A\n" x))))
lines))))
;;;;
;;;;
;;;; PARSE-ARGUMENTS
;;;;
;;;;
;;;; Do argument parsing using GNU getopt
;;;;
......@@ -130,9 +130,9 @@ doc>
* the arguments as it scans, so that eventually all the non-options are
* at the end. However, if the shell environment variable |POSIXLY_CORRECT|
* is set, then option processing stops as soon as a non-option argument
* is encountered.
* is encountered.
* £
* A clause must follow the syntax:
* A clause must follow the syntax:
* ,(raw-code [
* <clause> => string @pipe <list-clause>
* <list clause> => (<option descr> <expr> ...) @pipe (else <expr> ...)
......@@ -140,7 +140,7 @@ doc>
* <option name> => string
* <keyword> => :alternate @pipe :arg @pipe :help
* ])
*
*
* A string clause is used to build the help associated to the command.
* A list clause must follow the syntax describes an option. The |<expr>|s
* associated to a list clauses are executed when the option is recognized.
......@@ -148,7 +148,7 @@ doc>
* The |:alternate| key permits to have an alternate name for an option
* (generally a short or long name if the option name is a
* short or long name). The |:help| is used to provide help about the
* the option. The |:arg| is used when the option admit a parameter:
* the option. The |:arg| is used when the option admit a parameter:
* the symbol given after |:arg| will be bound to the value of the option
* argument when the corresponding |<expr>|s will be executed.
* £
......@@ -157,10 +157,10 @@ doc>
* £
* The following example shows a rather complete usage of the
* |parse-arguments| form
*
*
* @lisp
* #!/usr/bin/env stklos-script
*
*
* (define (main args)
* (parse-arguments args
* "Usage: foo [options] [parameter ...]"
......@@ -183,17 +183,17 @@ doc>
* :help "provides help for the command")
* (arg-usage (current-error-port))
* (exit 1))
* (else
* (else
* (format #t
* "All options parsed. Remaining arguments are ~S~%"
* other-arguments))))
* @end lisp
*
*
* The following program invocation
* @lisp
* foo -vs --input in -o out arg1 arg2
* @end lisp
*
*
* produces the following output
* ,(raw-code [
* Seen the verbose option
......@@ -202,7 +202,7 @@ doc>
* Seen the output option with "out" argument
* All options parsed. Remaining arguments are ("arg1" "arg2")
* ])
*
*
* Finally, the program invocation
* @lisp
* foo --help
......@@ -235,7 +235,7 @@ doc>
* an option, even if it starts with a '-' or '--'.])
* (item [Option with a parameter can be written in several ways. For instance
* to set the output in the |bar| file for the previous example can be expressed as
* ,(itemize
* ,(itemize
* (item [|--output=bar|])
* (item [|-o bar|])
* (item [|-obar|]))])
......@@ -252,13 +252,13 @@ doc>
(opt2 (key-get (cdr descr) :alternate #f))
(err (lambda (o) (error 'parse-arguments "bad option name ~S" o))))
(cond
((not (string? opt1))
((not (string? opt1))
(err opt1))
((not opt2)
(if (> (string-length opt1) 1)
(cons opt1 opt2)
(cons opt2 opt1)))
((not (string? opt2))
((not (string? opt2))
(err opt2))
(else
(let ((len1 (string-length opt1))
......@@ -273,10 +273,10 @@ doc>
opt1 opt2))))))))
(define (make-getopt-parameters clauses)
;; This function is too much complicated ;-<
;; This function is too much complicated ;-<
;; It returns a list of length 3 whose elements are
;; - the value of the longopts parameter of the C function getopt
;; Note: if the option is just a short opt, an entry is created but with
;; - the value of the longopts parameter of the C function getopt
;; Note: if the option is just a short opt, an entry is created but with
;; the key ""
;; - the value of the optstring parameter of the C function getopt
;; - an Alist for short options which maps them in the longopt parameter.
......@@ -290,7 +290,7 @@ doc>
((or (null? l) (and (pair? (car l)) (eq? (caar l) 'else)))
;; We have finished; return SHORT, ASSOC and LONG values in a list
(list short (reverse! long) assoc))
((string? (car l))
;; Skip this help string
(Loop (cdr l) long short assoc pos))
......@@ -299,11 +299,11 @@ doc>
(let* ((descr (caar l))
(names (option-names descr))
(lg (if (car names)
;; We had a long name
;; We had a long name
(cons (car names) (key-get (cdr descr) :arg #f))
(cons "" #f)))
(sht (if (cdr names)
;; We had a short name
;; We had a short name
(string-append (cdr names)
(if (key-get (cdr descr) :arg #f)
":"
......@@ -315,16 +315,16 @@ doc>
#f)))
;; We have new values for long and short for this item. Iterate
(Loop (cdr l)
(cons lg long)
(Loop (cdr l)
(cons lg long)
(string-append short sht)
(if ass (cons ass assoc) assoc)
(+ pos 1))))
(else (error 'parse-arguments "bad clause ~S" (car l))))))
;;;
;;; Macro body starts here
;;; Macro body starts here
;;;
(let* ((actions (gensym "actions"))
(Loop (gensym "Loop"))
......@@ -332,7 +332,7 @@ doc>
(opts (make-getopt-parameters clauses))
(clauses* (map (lambda (z) (if (pair? z) (list (car z)) z))
clauses))) ;; clauses without code (=> shorter constant)
`(let* ((arg-usage (lambda (port :optional sexpr)
(%print-usage port ',clauses* sexpr)))
(,alist ',(caddr opts))
......@@ -370,7 +370,7 @@ doc>
((vector-ref ,actions (car x)) (cdr x))
(,Loop (%getopt)))
(else
;; Special case for the ELSE clause (if it exists)
;; Special case for the ELSE clause (if it exists)
,(let ((end (last-pair clauses)))
(if (eq? (caar end) 'else)
`((vector-ref ,actions (- (vector-length ,actions) 1))
......
;;;;
;;;; load.stk -- Extended load function
;;;;
;;;; Copyright 2000-2010 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
;;;;
;;;;
;;;;
;;;; Copyright 2000-2011 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
;;;;
;;;;
;;;; 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, write to the Free Software
;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
;;;; USA.
;;;;
;;;;
;;;; Author: Erick Gallesio [eg@unice.fr]
;;;; Creation date: 17-May-2000 14:55 (eg)
;;;; Last file update: 16-Oct-2010 16:07 (eg)
;;;; Last file update: 27-May-2011 23:03 (eg)
;;;;
......@@ -32,7 +32,7 @@
(define *path-separator* (if (eqv? (running-os) 'windows) ";" ":"))
(define *load-suffixes* (list "so" "ostk" "spi" "stk" "scm"))
(define *load-verbose* #f)
(define *load-path* '()) ;; initialized later
(define *load-path* '()) ;; initialized later
;;
......@@ -42,7 +42,7 @@
(make-parameter (or (getenv "STKLOS_CONFDIR")
(make-path (getenv "HOME") ".stklos"))
expand-file-name))
(define (%stklos-conf-file name)
(make-path (%stklos-conf-dir) name))
......@@ -61,7 +61,7 @@ doc>
;======================================================================
;
; *load-path* construction
; *load-path* construction
;
;======================================================================
(set! *load-path*
......@@ -81,17 +81,17 @@ doc>
* (load-path)
* (load-path value)
*
* |load-path| is a parameter object. It
* returns the current load path. The load path is a list of strings
* which correspond to the directories in which a file must be searched for
* |load-path| is a parameter object. It
* returns the current load path. The load path is a list of strings
* which correspond to the directories in which a file must be searched for
* loading. Directories of the load path are ,(emph "prepended") (in
* their apparition
* order) to the file name given to |load| or |try-load| until the file
* their apparition
* order) to the file name given to |load| or |try-load| until the file
* can be loaded.
*
* The initial value of the current load path can be set from the shell, by
* @l
* The initial value of the current load path can be set from the shell, by
* setting the |STKLOS_LOAD_PATH| shell variable.
*
* @l
* Giving a |value| to the parameter |load-path| permits to change the
* current list of paths.
doc>
......@@ -102,8 +102,8 @@ doc>
;; Sanity check
(unless (list? new-path)
(error 'load-path "bad list of path names ~S" new-path))
(for-each (lambda (x)
(unless (string? x)
(for-each (lambda (x)
(unless (string? x)
(error 'load-path "bad path name ~S" x)))
new-path)
;; Set the load path
......@@ -114,12 +114,12 @@ doc>
<doc EXT load-suffixes
* (load-suffixes)
* (load-suffixes value)
*
*
* |load-suffixes| is a parameter object. It
* returns the list of possible suffixes for a Scheme file. Each suffix,
* must be a string. Suffixes are appended (in their apparition order)
* to a file name is appended to a file name given to |load| or |try-load|
* until the file can be loaded.
* must be a string. Suffixes are appended (in their apparition order)
* to a file name is appended to a file name given to |load| or |try-load|
* until the file can be loaded.
doc>
|#
(define load-suffixes
......@@ -128,8 +128,8 @@ doc>
;; Sanity check
(unless (list? new)
(error 'load-path "bad list of suffixes ~S" new))
(for-each (lambda (x)
(unless (string? x)
(for-each (lambda (x)
(unless (string? x)
(error 'load-path "bad path name ~S" x)))
new)
;; Set the load suffixes
......@@ -140,11 +140,11 @@ doc>
<doc EXT load-verbose
* (load-verbose)
* (load-verbose value)
*
*
* |load-verbose| is a parameter object. It permits to display the
* path name of the files which are loaded by |load| or |try-load| on
* the current error port, when set to a true value. If |load-verbose|
* is set to |f|, no message is printed.
* is set to |%f|, no message is printed.
doc>
|#
(define load-verbose
......@@ -166,8 +166,8 @@ doc>
;=============================================================================
;
; GUESS-PATHNAME
;
; Try to guess the full pathname of a scheme file using *load-path* and
;
; Try to guess the full pathname of a scheme file using *load-path* and
; *load-suffix*
;=============================================================================
......@@ -180,14 +180,14 @@ doc>
(file-is-readable? f)
(not (file-is-directory? f))
f))
(define (try-load-with-suffixes name suffixes)
(let Loop ((s suffixes))
(if (null? s)
#f
(or (try (string-append name "." (car s)))
(Loop (cdr s))))))
(define (try-load-from-path name paths suffixes)
(let Loop ((dir paths))
(if (null? dir)
......@@ -208,7