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 ;;;; lib.stk -- Library for STklos Documentation Building
;;;; ;;;;
;;;; Copyright 2003-2010 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr> ;;;; Copyright 2003-2011 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
;;;; ;;;;
;;;; ;;;;
;;;; This program is free software; you can redistribute it and/or modify ;;;; 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 ;;;; it under the terms of the GNU General Public License as published by
;;;; the Free Software Foundation; either version 2 of the License, or ;;;; the Free Software Foundation; either version 2 of the License, or
;;;; (at your option) any later version. ;;;; (at your option) any later version.
;;;; ;;;;
;;;; This program is distributed in the hope that it will be useful, ;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;;; GNU General Public License for more details. ;;;; GNU General Public License for more details.
;;;; ;;;;
;;;; You should have received a copy of the GNU General Public License ;;;; You should have received a copy of the GNU General Public License
;;;; along with this program; if not, write to the Free Software ;;;; 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. ;;;; USA.
;;;; ;;;;
;;;; Author: Erick Gallesio [eg@essi.fr] ;;;; Author: Erick Gallesio [eg@essi.fr]
;;;; Creation date: 20-Dec-2003 23:23 (eg) ;;;; 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") (load "srfi.stk")
...@@ -30,7 +30,7 @@ ...@@ -30,7 +30,7 @@
;;;; ;;;;
;;;; Customization ;;;; Customization
;;;; ;;;;
(define *doc* '()) ;; The documentation datbase when in memory (define *doc* '()) ;; The documentation datbase when in memory
(define *stderr* (current-error-port)) (define *stderr* (current-error-port))
(define *verbose* (getenv "DEBUG")) (define *verbose* (getenv "DEBUG"))
...@@ -43,7 +43,7 @@ ...@@ -43,7 +43,7 @@
;====================================================================== ;======================================================================
; ;
; read-database ; read-database
; ;
;====================================================================== ;======================================================================
...@@ -57,7 +57,7 @@ ...@@ -57,7 +57,7 @@
(when *verbose* (format *stderr* " Done\n"))) (when *verbose* (format *stderr* " Done\n")))
;====================================================================== ;======================================================================
; ;
; rewrite-for-skribe ; rewrite-for-skribe
; ;
;====================================================================== ;======================================================================
...@@ -71,7 +71,7 @@ ...@@ -71,7 +71,7 @@
(define R4RS-rgxp (string->regexp "R4RS")) (define R4RS-rgxp (string->regexp "R4RS"))
(define R5RS-rgxp (string->regexp "R5RS")) (define R5RS-rgxp (string->regexp "R5RS"))
(define STklos-rgxp (string->regexp "STklos")) (define STklos-rgxp (string->regexp "STklos"))
(define linebrk-rgxp (string->regexp "")) (define linebrk-rgxp (string->regexp "@l"))
(define (fontified-code code) (define (fontified-code code)
(blockquote (blockquote
...@@ -90,8 +90,8 @@ ...@@ -90,8 +90,8 @@
(define (rewrite-for-skribe def) (define (rewrite-for-skribe def)
;; rewrite |f| and |t| ;; rewrite |%f| and |%t|
(set! def (regexp-replace-all "\\|(f|t)\\|" def "|#\\1|")) (set! def (regexp-replace-all "\\|%(f|t)\\|" def "|#\\1|"))
;; rewrite |xxx| in @code{xxx} ;; rewrite |xxx| in @code{xxx}
(set! def (regexp-replace-all var-rgxp def ",(code [\\1])")) (set! def (regexp-replace-all var-rgxp def ",(code [\\1])"))
;; rewrite => in an arrow ;; rewrite => in an arrow
...@@ -112,13 +112,13 @@ ...@@ -112,13 +112,13 @@
(set! def (regexp-replace-all STklos-rgxp def ",(stklos)")) (set! def (regexp-replace-all STklos-rgxp def ",(stklos)"))
;; rewrite linebreak ;; rewrite linebreak
(set! def (regexp-replace-all linebrk-rgxp def ",(linebreak 2)")) (set! def (regexp-replace-all linebrk-rgxp def ",(linebreak 2)"))
def) def)
;====================================================================== ;======================================================================
; ;
; insert-documentation ; insert-documentation
; ;
;====================================================================== ;======================================================================
...@@ -165,9 +165,9 @@ ...@@ -165,9 +165,9 @@
((extended-syntax) [,(stklos) ,(linebreak) syntax]) ((extended-syntax) [,(stklos) ,(linebreak) syntax])
((procedure) [,(rfive) ,(linebreak) procedure]) ((procedure) [,(rfive) ,(linebreak) procedure])
((extended) [,(stklos) ,(linebreak) procedure]))))) ((extended) [,(stklos) ,(linebreak) procedure])))))
(list (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 ;; Put marks for all the functions defined in this entry
(map (lambda (x) (mark (format "~A" x))) (map (lambda (x) (mark (format "~A" x)))
(cons name similar)) (cons name similar))
...@@ -184,7 +184,7 @@ ...@@ -184,7 +184,7 @@
(else (else
(Loop (cdr l) (cons (list (show-form (car l)) (Loop (cdr l) (cons (list (show-form (car l))
(! "\\\\\n") ) (! "\\\\\n") )
res)))))) res))))))
;; Display the description text ;; Display the description text
(blockquote (eval (read-from-string (blockquote (eval (read-from-string
(string-append "[" (string-append "["
...@@ -198,7 +198,7 @@ ...@@ -198,7 +198,7 @@
(unless lst (unless lst
(format *stderr* "Error: no documentation for item ~S\n" item) (format *stderr* "Error: no documentation for item ~S\n" item)
(exit 1)) (exit 1))
(when *verbose* (when *verbose*
(format *stderr* "Documentation of ~S\n" item)) (format *stderr* "Documentation of ~S\n" item))
(let ((infos (cdr lst))) (let ((infos (cdr lst)))
...@@ -216,7 +216,7 @@ ...@@ -216,7 +216,7 @@
(doc item type syn sim desc)))))) (doc item type syn sim desc))))))
;====================================================================== ;======================================================================
; ;
; show-undocumented ; show-undocumented
; ;
;====================================================================== ;======================================================================
......
This diff is collapsed.
;;;; ;;;;
;;;; c o m p i l e r . s t k -- STklos Compiler ;;;; 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 ;;;; This program is free software; you can redistribute it and/or modify
...@@ -21,7 +21,7 @@ ...@@ -21,7 +21,7 @@
;;;; ;;;;
;;;; Author: Erick Gallesio [eg@unice.fr] ;;;; Author: Erick Gallesio [eg@unice.fr]
;;;; Creation date: 26-Feb-2000 10:47 (eg) ;;;; 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 (define-module STKLOS-COMPILER
...@@ -404,7 +404,7 @@ doc> ...@@ -404,7 +404,7 @@ doc>
* value of the first expression that evaluates to a false value is * value of the first expression that evaluates to a false value is
* returned. Any remaining expressions are not evaluated. If all the * returned. Any remaining expressions are not evaluated. If all the
* expressions evaluate to true values, the value of the last expression * 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 * @lisp
* (and (= 2 2) (> 2 1)) => #t * (and (= 2 2) (> 2 1)) => #t
...@@ -445,7 +445,7 @@ doc> ...@@ -445,7 +445,7 @@ doc>
* value of the first expression that evaluates to a true value is * value of the first expression that evaluates to a true value is
* returned. Any remaining expressions are not evaluated. If all * returned. Any remaining expressions are not evaluated. If all
* expressions evaluate to false values, the value of the last expression * 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 * @lisp
* (or (= 2 2) (> 2 1)) => #t * (or (= 2 2) (> 2 1)) => #t
...@@ -1015,7 +1015,7 @@ doc> ...@@ -1015,7 +1015,7 @@ doc>
(memq fct '(fx+ fx*))) ; commutative only (memq fct '(fx+ fx*))) ; commutative only
(oper2 (if (eq? fct 'fx+) (oper2 (if (eq? fct 'fx+)
'IN-SINT-FXADD2 'IN-SINT-FXADD2
'INT-SINT-FXMUL2) 'IN-SINT-FXMUL2)
b a)) b a))
((small-integer-constant? b) ((small-integer-constant? b)
(oper2 (case fct (oper2 (case fct
......
;;;; ;;;;
;;;; date.stk -- Date and Time Operations ;;;; 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 ;;;; 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 ;;;; it under the terms of the GNU General Public License as published by
;;;; the Free Software Foundation; either version 2 of the License, or ;;;; the Free Software Foundation; either version 2 of the License, or
;;;; (at your option) any later version. ;;;; (at your option) any later version.
;;;; ;;;;
;;;; This program is distributed in the hope that it will be useful, ;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;;; GNU General Public License for more details. ;;;; GNU General Public License for more details.
;;;; ;;;;
;;;; You should have received a copy of the GNU General Public License ;;;; You should have received a copy of the GNU General Public License
;;;; along with this program; if not, write to the Free Software ;;;; 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. ;;;; USA.
;;;; ;;;;
;;;; Author: Erick Gallesio [eg@unice.fr] ;;;; Author: Erick Gallesio [eg@unice.fr]
;;;; Creation date: 3-Apr-2002 10:06 (eg) ;;;; 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 @@ ...@@ -31,10 +31,10 @@
;;;; ====================================================================== ;;;; ======================================================================
#| #|
<doc EXT time? <doc EXT time?
* (time? obj) * (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> doc>
|# |#
(define (time? obj) (define (time? obj)
...@@ -46,7 +46,7 @@ doc> ...@@ -46,7 +46,7 @@ doc>
* (time->seconds time) * (time->seconds time)
* *
* Convert the time object |time| into an inexact real number representing * 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 * @lisp
* (time->seconds (current-time)) ==> 1138983411.09337 * (time->seconds (current-time)) ==> 1138983411.09337
* @end lisp * @end lisp
...@@ -92,7 +92,7 @@ doc> ...@@ -92,7 +92,7 @@ doc>
#| #|
<doc EXT make-date <doc EXT make-date
* (make-date :key second minute hour day month year) * (make-date :key second minute hour day month year)
* *
* Build a date from its argument. |hour|, |minute|, |second| default to 0; * Build a date from its argument. |hour|, |minute|, |second| default to 0;
* |day| and |month| default to 1; |year| defaults to 1970 * |day| and |month| default to 1; |year| defaults to 1970
doc> doc>
...@@ -108,7 +108,7 @@ doc> ...@@ -108,7 +108,7 @@ doc>
<doc EXT date? <doc EXT date?
* (date? obj) * (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> doc>
|# |#
(define (date? obj) (define (date? obj)
...@@ -205,10 +205,10 @@ doc> ...@@ -205,10 +205,10 @@ doc>
#| #|
<doc EXT seconds->list <doc EXT seconds->list
* (seconds->list sec) * (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 * 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 [second : 0 to 59 (but can be up to 61 to allow for leap seconds)])
* (item [minute : 0 to 59]) * (item [minute : 0 to 59])
* (item [hour : 0 to 23]) * (item [hour : 0 to 23])
...@@ -222,7 +222,7 @@ doc> ...@@ -222,7 +222,7 @@ doc>
* (UTC) and local standard time in seconds.]) * (UTC) and local standard time in seconds.])
* ) * )
* @lisp * @lisp
* (seconds->list (current-second)) * (seconds->list (current-second))
* => (:second 51 :minute 26 :hour 19 * => (:second 51 :minute 26 :hour 19
* :day 5 :month 11 :year 2004 * :day 5 :month 11 :year 2004
* :week-day 5 :year-day 310 * :week-day 5 :year-day 310
...@@ -337,7 +337,7 @@ doc> ...@@ -337,7 +337,7 @@ doc>
(define (date->string format date) (define (date->string format date)
(unless (string? format) (unless (string? format)
(error 'date->string "bad string ~S" format)) (error 'date->string "bad string ~S" format))
(seconds->string format (date->seconds date))) (seconds->string format (date->seconds date)))
......
;;;; ;;;;
;;;; ffi.stk -- FFI support ;;;; 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 ;;;; 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 ;;;; it under the terms of the GNU General Public License as published by
;;;; the Free Software Foundation; either version 2 of the License, or ;;;; the Free Software Foundation; either version 2 of the License, or
;;;; (at your option) any later version. ;;;; (at your option) any later version.
;;;; ;;;;
;;;; This program is distributed in the hope that it will be useful, ;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;;; GNU General Public License for more details. ;;;; GNU General Public License for more details.
;;;; ;;;;
;;;; You should have received a copy of the GNU General Public License ;;;; You should have received a copy of the GNU General Public License
;;;; along with this program; if not, write to the Free Software ;;;; 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. ;;;; USA.
;;;; ;;;;
;;;; Author: Erick Gallesio [eg@essi.fr] ;;;; Author: Erick Gallesio [eg@essi.fr]
;;;; Creation date: 14-Bun-2007 09:24 (eg) ;;;; 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) (define make-external-function #f)
...@@ -42,7 +42,7 @@ ...@@ -42,7 +42,7 @@
(:boolean 12) (:boolean 12)
(:pointer 13) (:pointer 13)
(:string 14) (:string 14)
(:int8 15) (:int8 15)
(:int16 16) (:int16 16)
(:int32 17) (:int32 17)
(:int64 18) (:int64 18)
...@@ -56,7 +56,7 @@ ...@@ -56,7 +56,7 @@
(error 'define-external "parameter of type :void are forbidden") (error 'define-external "parameter of type :void are forbidden")
(cadr info))) (cadr info)))
(error 'define-external "bad type name ~S" k)))) (error 'define-external "bad type name ~S" k))))
(define (parse-parameters lst) (define (parse-parameters lst)
(map (lambda (x) (map (lambda (x)
(cond (cond
...@@ -98,11 +98,11 @@ ...@@ -98,11 +98,11 @@
* element is the name of the parameter, and the second one is a type * element is the name of the parameter, and the second one is a type
* keyword. All the types defined in the above table, except * keyword. All the types defined in the above table, except
* |:void|, are allowed for the parameters of a foreign function. * |:void|, are allowed for the parameters of a foreign function.
* £ * @linebreak
* |Define-external| accepts several options: * |Define-external| accepts several options:
* ,(itemize * ,(itemize
* (item [ * (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 * by the foreign function. The type returned must be chosen in the types specified
* in the table. For instance: * in the table. For instance:
* @lisp * @lisp
...@@ -113,12 +113,12 @@ ...@@ -113,12 +113,12 @@
* returns an integer result. Omitting this option default to a result * returns an integer result. Omitting this option default to a result
* type equal to |:void| (i.e. the returned value is ,(emph "undefined")). * type equal to |:void| (i.e. the returned value is ,(emph "undefined")).
* ]) * ])
* *
* (item [ * (item [
* |:entry-name| is used to specify the name of the foreign * |: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 * function in the C world. If this option is omitted, the entry-name is
* supposed to be |name|. For instance: * supposed to be |name|. For instance:
* @lisp * @lisp
* (define-external minimum((a :int) (b :int)) * (define-external minimum((a :int) (b :int))
* :return-type :int * :return-type :int
* :entry-name "min") * :entry-name "min")
...@@ -127,15 +127,15 @@ ...@@ -127,15 +127,15 @@
* executes the C function called |min|. * executes the C function called |min|.
* ]) * ])
* (item [ * (item [
* |:library-name| is used to specify the library which contains the * |:library-name| is used to specify the library which contains the
* foreign-function. If necessary, the library is loaded before calling the * foreign-function. If necessary, the library is loaded before calling the
* C function. So, * C function. So,
* @lisp * @lisp
* (define-external minimum((a :int) (b :int)) * (define-external minimum((a :int) (b :int))
* :return-type :int * :return-type :int
* :entry-name "min" * :entry-name "min"
* :library-name "libminmax") * :library-name "libminmax")
* @end lisp * @end lisp
* defines a function which will execute the function |min| * defines a function which will execute the function |min|
* located in the library |libminmax.xx| (where |xx| is the suffix used * located in the library |libminmax.xx| (where |xx| is the suffix used
* for shared libraries on the running system (generally |so|)) * for shared libraries on the running system (generally |so|))
......
;;;; ;;;;
;;;; getopt.stk -- getopt ;;;; getopt.stk -- getopt
;;;; ;;;;
;;;; Copyright © 2001-2006 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr> ;;;; Copyright © 2001-2011 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
;;;; ;;;;
;;;; ;;;;
;;;; This program is free software; you can redistribute it and/or modify ;;;; 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 ;;;; it under the terms of the GNU General Public License as published by
;;;; the Free Software Foundation; either version 2 of the License, or ;;;; the Free Software Foundation; either version 2 of the License, or
;;;; (at your option) any later version. ;;;; (at your option) any later version.
;;;; ;;;;
;;;; This program is distributed in the hope that it will be useful, ;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;;; GNU General Public License for more details. ;;;; GNU General Public License for more details.
;;;; ;;;;
;;;; You should have received a copy of the GNU General Public License ;;;; You should have received a copy of the GNU General Public License
;;;; along with this program; if not, write to the Free Software ;;;; 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. ;;;; USA.
;;;; ;;;;
;;;; Author: Erick Gallesio [eg@unice.fr] ;;;; Author: Erick Gallesio [eg@unice.fr]
;;;; Creation date: 26-Oct-2001 08:40 (eg) ;;;; 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 ;;;; %PRINT--USAGE
;;;; ;;;;
;;;; pretty print options usage ;;;; pretty print options usage
;;;; ;;;;
#| #|
<doc EXT arg-usage <doc EXT arg-usage
...@@ -37,10 +37,10 @@ ...@@ -37,10 +37,10 @@
* This procedure is only bound inside a |parse-arguments| form. * This procedure is only bound inside a |parse-arguments| form.
* It pretty prints the help associated to the clauses of the * It pretty prints the help associated to the clauses of the
* |parse-arguments| form on the given port. If the argument * |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 * printed on |port| as ,(emph "S-expr")s. This is useful if the help
* strings need to be manipulated by a program. * strings need to be manipulated by a program.
* *
doc> doc>
|# |#
(define (%print-usage port clauses sexpr) (define (%print-usage port clauses sexpr)
...@@ -93,7 +93,7 @@ doc> ...@@ -93,7 +93,7 @@ doc>
(len (apply max (map (lambda (x) (len (apply max (map (lambda (x)
(if (pair? x) (string-length (car x)) 0)) (if (pair? x) (string-length (car x)) 0))
lines)))) lines))))
;; lines contains the line to be displayed and len is the length of the ;; lines contains the line to be displayed and len is the length of the
;; longest option. Pretty print the options from those values ;; longest option. Pretty print the options from those values
(for-each (lambda (x) (for-each (lambda (x)
...@@ -106,9 +106,9 @@ doc> ...@@ -106,9 +106,9 @@ doc>
(format port "~A\n" x)))) (format port "~A\n" x))))
lines)))) lines))))
;;;; ;;;;
;;;; PARSE-ARGUMENTS ;;;; PARSE-ARGUMENTS
;;;; ;;;;
;;;; Do argument parsing using GNU getopt ;;;; Do argument parsing using GNU getopt
;;;; ;;;;
...@@ -130,9 +130,9 @@ doc> ...@@ -130,9 +130,9 @@ doc>
* the arguments as it scans, so that eventually all the non-options are * the arguments as it scans, so that eventually all the non-options are
* at the end. However, if the shell environment variable |POSIXLY_CORRECT| * 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 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 [ * ,(raw-code [
* <clause> => string @pipe <list-clause> * <clause> => string @pipe <list-clause>
* <list clause> => (<option descr> <expr> ...) @pipe (else <expr> ...) * <list clause> => (<option descr> <expr> ...) @pipe (else <expr> ...)
...@@ -140,7 +140,7 @@ doc> ...@@ -140,7 +140,7 @@ doc>
* <option name> => string * <option name> => string
* <keyword> => :alternate @pipe :arg @pipe :help * <keyword> => :alternate @pipe :arg @pipe :help
* ]) * ])
* *
* A string clause is used to build the help associated to the command. * 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 * 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. * associated to a list clauses are executed when the option is recognized.
...@@ -148,7 +148,7 @@ doc> ...@@ -148,7 +148,7 @@ doc>
* The |:alternate| key permits to have an alternate name for an option * The |:alternate| key permits to have an alternate name for an option
* (generally a short or long name if the option name is a * (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 * 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 * the symbol given after |:arg| will be bound to the value of the option
* argument when the corresponding |<expr>|s will be executed. * argument when the corresponding |<expr>|s will be executed.
* £ * £
...@@ -157,10 +157,10 @@ doc> ...@@ -157,10 +157,10 @@ doc>
* £ * £
* The following example shows a rather complete usage of the * The following example shows a rather complete usage of the
* |parse-arguments| form * |parse-arguments| form
* *
* @lisp * @lisp
* #!/usr/bin/env stklos-script * #!/usr/bin/env stklos-script
* *
* (define (main args) * (define (main args)
* (parse-arguments args * (parse-arguments args
* "Usage: foo [options] [parameter ...]" * "Usage: foo [options] [parameter ...]"
...@@ -183,17 +183,17 @@ doc> ...@@ -183,17 +183,17 @@ doc>
* :help "provides help for the command") * :help "provides help for the command")
* (arg-usage (current-error-port)) * (arg-usage (current-error-port))
* (exit 1)) * (exit 1))
* (else * (else
* (format #t * (format #t
* "All options parsed. Remaining arguments are ~S~%" * "All options parsed. Remaining arguments are ~S~%"
* other-arguments)))) * other-arguments))))
* @end lisp * @end lisp
* *
* The following program invocation * The following program invocation
* @lisp * @lisp
* foo -vs --input in -o out arg1 arg2 * foo -vs --input in -o out arg1 arg2
* @end lisp * @end lisp
* *
* produces the following output * produces the following output
* ,(raw-code [ * ,(raw-code [
* Seen the verbose option * Seen the verbose option
...@@ -202,7 +202,7 @@ doc> ...@@ -202,7 +202,7 @@ doc>
* Seen the output option with "out" argument * Seen the output option with "out" argument
* All options parsed. Remaining arguments are ("arg1" "arg2") * All options parsed. Remaining arguments are ("arg1" "arg2")
* ]) * ])
* *
* Finally, the program invocation * Finally, the program invocation
* @lisp * @lisp
* foo --help * foo --help
...@@ -235,7 +235,7 @@ doc> ...@@ -235,7 +235,7 @@ doc>
* an option, even if it starts with a '-' or '--'.]) * an option, even if it starts with a '-' or '--'.])
* (item [Option with a parameter can be written in several ways. For instance * (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 * to set the output in the |bar| file for the previous example can be expressed as
* ,(itemize * ,(itemize
* (item [|--output=bar|]) * (item [|--output=bar|])
* (item [|-o bar|]) * (item [|-o bar|])
* (item [|-obar|]))]) * (item [|-obar|]))])
...@@ -252,13 +252,13 @@ doc> ...@@ -252,13 +252,13 @@ doc>
(opt2 (key-get (cdr descr) :alternate #f)) (opt2 (key-get (cdr descr) :alternate #f))
(err (lambda (o) (error 'parse-arguments "bad option name ~S" o)))) (err (lambda (o) (error 'parse-arguments "bad option name ~S" o))))
(cond (cond
((not (string? opt1))