Menu
▾
▴
clisp-cvs Digest, Vol 27, Issue 32
|
From: <cli...@li...> - 2008-07-17 21:15:27
|
Send clisp-cvs mailing list submissions to cli...@li... To subscribe or unsubscribe via the World Wide Web, visit https://lists.sourceforge.net/lists/listinfo/clisp-cvs or, via email, send a message with subject or body 'help' to cli...@li... You can reach the person managing the list at cli...@li... When replying, please edit your Subject line so it is more specific than "Re: Contents of clisp-cvs digest..." CLISP CVS commits for today Today's Topics: 1. clisp/src ChangeLog,1.6396,1.6397 pathname.d,1.461,1.462 (Sam Steingold) 2. clisp/doc impent.xml,1.320,1.321 impext.xml,1.533,1.534 (Sam Steingold) 3. clisp/tests ChangeLog,1.567,1.568 ext-clisp.tst,1.4,1.5 (Sam Steingold) 4. clisp/src ChangeLog, 1.6397, 1.6398 NEWS, 1.471, 1.472 macros3.lisp, 1.19, 1.20 (Sam Steingold) 5. clisp/tests path.tst,1.79,1.80 (Sam Steingold) 6. clisp/src ChangeLog, 1.6398, 1.6399 dfloat.d, 1.19, 1.20 ffloat.d, 1.19, 1.20 sfloat.d, 1.17, 1.18 (Sam Steingold) 7. clisp/tests ChangeLog,1.568,1.569 number2.tst,1.52,1.53 (Sam Steingold) 8. clisp/doc impext.xml,1.534,1.535 (Sam Steingold) 9. clisp/modules/clx/new-clx clx.f,2.131,2.132 clx.lisp,1.34,1.35 (Sam Steingold) ---------------------------------------------------------------------- Message: 1 Date: Thu, 17 Jul 2008 19:39:37 +0000 From: Sam Steingold <sd...@us...> Subject: clisp/src ChangeLog,1.6396,1.6397 pathname.d,1.461,1.462 To: cli...@li... Message-ID: <E1K...@ma...> Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv23445/src Modified Files: ChangeLog pathname.d Log Message: (assure_dir_exists) [PATHNAME_UNIX]: fix a GC-safety bug introduced on 2008-07-11 (get_path_info is GC-unsafe) (classify_namestring): GC-safe Index: pathname.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/pathname.d,v retrieving revision 1.461 retrieving revision 1.462 diff -u -d -r1.461 -r1.462 --- pathname.d 17 Jul 2008 16:03:35 -0000 1.461 +++ pathname.d 17 Jul 2008 19:39:33 -0000 1.462 @@ -5711,10 +5711,13 @@ } fs->fs_namestring = whole_namestring(*(fs->fs_pathname)); /* concat */ /* get information: */ + pushSTACK(fs->fs_namestring); /* save for get_path_info() */ + var bool done; with_sstring_0(fs->fs_namestring,O(pathname_encoding),namestring_asciz, { - if (get_path_info(fs,namestring_asciz,&allowed_links)) - return; + done = get_path_info(fs,namestring_asciz,&allowed_links); }); + fs->fs_namestring = popSTACK(); /* restore */ + if (done) return; } } @@ -5939,7 +5942,7 @@ < return 0 if namestring does not name an existing file or directory 1: regular file -1: directory */ -local maygc signean classify_namestring (char* namestring, char *resolved) { +local signean classify_namestring (char* namestring, char *resolved) { #if defined(UNIX) struct stat status; int ret; Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.6396 retrieving revision 1.6397 diff -u -d -r1.6396 -r1.6397 --- ChangeLog 17 Jul 2008 15:58:55 -0000 1.6396 +++ ChangeLog 17 Jul 2008 19:39:33 -0000 1.6397 @@ -1,5 +1,11 @@ 2008-07-17 Sam Steingold <sd...@gn...> + * pathname.d (assure_dir_exists) [PATHNAME_UNIX]: fix a GC-safety + bug introduced on 2008-07-11 (get_path_info is gc-unsafe) + (classify_namestring): GC-safe + +2008-07-17 Sam Steingold <sd...@gn...> + * pathname.d: more robust HAVE_SHELL conditional handling 2008-07-17 Sam Steingold <sd...@gn...> ------------------------------ Message: 2 Date: Thu, 17 Jul 2008 19:51:30 +0000 From: Sam Steingold <sd...@us...> Subject: clisp/doc impent.xml,1.320,1.321 impext.xml,1.533,1.534 To: cli...@li... Message-ID: <E1K...@ma...> Update of /cvsroot/clisp/clisp/doc In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv28014/doc Modified Files: impent.xml impext.xml Log Message: New function EXT:CANONICALIZE lets you easily canonicalize a value before processing it. Index: impext.xml =================================================================== RCS file: /cvsroot/clisp/clisp/doc/impext.xml,v retrieving revision 1.533 retrieving revision 1.534 diff -u -d -r1.533 -r1.534 --- impext.xml 17 Jul 2008 16:19:32 -0000 1.533 +++ impext.xml 17 Jul 2008 19:51:28 -0000 1.534 @@ -1755,7 +1755,13 @@ If no <literal role="data">#\:</literal> is present, &pass-r; (or &port-r;) is &nil;.</para> <para>Use function <code>(EXT:HTTP-PROXY &optional-amp; (&string-t; - (&getenv; "http_proxy")))</code> to reset &http-proxy;.</para></section> + (&getenv; "http_proxy")))</code> to reset + &http-proxy;.</para></section> + +<section id="canonicalize"><title>Function &canonicalize;</title> +<para>If you want to canonicalize a value before further processing it, + you can pass it to &canonicalize; together with a list of canonicalizers. +</para></section> </section> <section id="customize"><title>Customizing &clisp; behavior</title> Index: impent.xml =================================================================== RCS file: /cvsroot/clisp/clisp/doc/impent.xml,v retrieving revision 1.320 retrieving revision 1.321 diff -u -d -r1.320 -r1.321 --- impent.xml 17 Jul 2008 16:19:32 -0000 1.320 +++ impent.xml 17 Jul 2008 19:51:28 -0000 1.321 @@ -461,6 +461,7 @@ <!ENTITY err-pr-bt '<olink targetdoc="impnotes" targetptr="err-pr-bt"><varname>CUSTOM:*REPORT-ERROR-PRINT-BACKTRACE*</varname></olink>'> <!ENTITY http-proxy '<link linkend="http-proxy"><varname>CUSTOM:*HTTP-PROXY*</varname></link>'> <!ENTITY argv '<link linkend="argv"><function>EXT:ARGV</function></link>'> +<!ENTITY canonicalize '<link linkend="canonicalize"><function>EXT:CANONICALIZE</function></link>'> <!ENTITY mod-expt '<link linkend="mod-expt"><function>EXT:MOD-EXPT</function></link>'> <!ENTITY compiled-file-p '<link linkend="compiled-file-p"><function>EXT:COMPILED-FILE-P</function></link>'> <!ENTITY help '<olink targetdoc="impnotes" targetptr="debugger-main-deb-step"><command>help</command></olink>'> ------------------------------ Message: 3 Date: Thu, 17 Jul 2008 19:51:32 +0000 From: Sam Steingold <sd...@us...> Subject: clisp/tests ChangeLog,1.567,1.568 ext-clisp.tst,1.4,1.5 To: cli...@li... Message-ID: <E1K...@ma...> Update of /cvsroot/clisp/clisp/tests In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv28014/tests Modified Files: ChangeLog ext-clisp.tst Log Message: New function EXT:CANONICALIZE lets you easily canonicalize a value before processing it. Index: ext-clisp.tst =================================================================== RCS file: /cvsroot/clisp/clisp/tests/ext-clisp.tst,v retrieving revision 1.4 retrieving revision 1.5 diff -u -d -r1.4 -r1.5 --- ext-clisp.tst 30 Sep 2007 05:32:43 -0000 1.4 +++ ext-clisp.tst 17 Jul 2008 19:51:30 -0000 1.5 @@ -234,3 +234,15 @@ (locally (declare (compile)) (ethe (values float integer) (truncate 3.2 2))) ERROR + +(canonicalize 1 `(,#'1+)) ERROR +(canonicalize "foo" `(,#'string-upcase) :test 'equal) "FOO" +(canonicalize "iso1234" + `(,(lambda (s) + (if (and (<= 4 (length s)) + (string-equal s "iso" :end1 3) + (not (char= #\- (char s 3)))) + (concatenate 'string "ISO-" (subseq s 3)) + s))) + :test 'equal) +"ISO-1234" Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/tests/ChangeLog,v retrieving revision 1.567 retrieving revision 1.568 diff -u -d -r1.567 -r1.568 --- ChangeLog 17 Jul 2008 04:01:15 -0000 1.567 +++ ChangeLog 17 Jul 2008 19:51:30 -0000 1.568 @@ -1,3 +1,7 @@ +2008-07-17 Sam Steingold <sd...@gn...> + + * ext-clisp.tst: test canonicalize + 2008-07-16 Sam Steingold <sd...@gn...> * path.tst: namespace cleanup (string -> my-string &c) ------------------------------ Message: 4 Date: Thu, 17 Jul 2008 19:51:32 +0000 From: Sam Steingold <sd...@us...> Subject: clisp/src ChangeLog, 1.6397, 1.6398 NEWS, 1.471, 1.472 macros3.lisp, 1.19, 1.20 To: cli...@li... Message-ID: <E1K...@ma...> Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv28014/src Modified Files: ChangeLog NEWS macros3.lisp Log Message: New function EXT:CANONICALIZE lets you easily canonicalize a value before processing it. Index: NEWS =================================================================== RCS file: /cvsroot/clisp/clisp/src/NEWS,v retrieving revision 1.471 retrieving revision 1.472 diff -u -d -r1.471 -r1.472 --- NEWS 17 Jul 2008 17:01:23 -0000 1.471 +++ NEWS 17 Jul 2008 19:51:29 -0000 1.472 @@ -5,6 +5,10 @@ pathname refers to a file or a directory. See <http://clisp.cons.org/impnotes/files.html#probe-path> for details. +* New function EXT:CANONICALIZE lets you easily canonicalize a value + before processing it. + See <http://clisp.cons.org/impnotes/macros3.html#canonicalize> for details. + * LOAD now uses DIRECTORY only for wild *LOAD-PATHS* components, thus speeding up the most common cases and preventing the denial-of-service attack whereas CLISP would not start if a file with a name Index: macros3.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/macros3.lisp,v retrieving revision 1.19 retrieving revision 1.20 diff -u -d -r1.19 -r1.20 --- macros3.lisp 20 Feb 2008 00:23:59 -0000 1.19 +++ macros3.lisp 17 Jul 2008 19:51:30 -0000 1.20 @@ -1,5 +1,6 @@ (in-package "EXT") -(export '(ethe letf letf* with-collect compiled-file-p compile-time-value)) +(export '(ethe letf letf* with-collect compiled-file-p compile-time-value + canonicalize)) (in-package "SYSTEM") ;;; --------------------------------------------------------------------------- ;;; Wie THE, nur dass auch im compilierten Code der Typtest durchgeführt wird. @@ -371,7 +372,7 @@ ;;; --------------------------------------------------------------------------- (defun compiled-file-p (file-name) - "Return non-NIL is FILE-NAME names a CLISP-compiled file + "Return non-NIL if FILE-NAME names a CLISP-compiled file with compatible bytecodes." (with-open-file (in file-name :direction :input :if-does-not-exist nil) (handler-bind ((error (lambda (c) (declare (ignore c)) @@ -397,3 +398,24 @@ (eval-when (compile load eval) (macrolet ((ctv () ,result)) (eval-when (load eval) (ctv))))))) + +;;; --------------------------------------------------------------------------- +(defun canonicalize (value functions &key (test 'eql) (max-iter 1024)) + "Call FUNCTIONS on VALUE until it stabilizes according to TEST. +TEST should be a avalid HASH-TABLE-TEST. +MAX-ITER limits the number of iteration over the FUNCTIONS (defaults to 1024). +Returns the canonicalized value and the number of iterations it required." + (if functions + (let ((ht (make-hash-table :test test)) (prev value) next (count 0)) + (setf (gethash value ht) 0) + (loop (setq next (reduce (lambda (v f) (funcall f v)) functions + :initial-value prev)) + (when (funcall test next prev) (return (values next count))) + (let ((old (gethash next ht))) + (when old + (error "~S(~S ~S): circular computation: value ~S appears at steps ~:D and ~:D" 'canonicalize value functions next old (1+ count)))) + (when (and max-iter (= count max-iter)) + (error "~S(~S ~S): maximum number of iterations exceeded ~:D, last two values were ~S and ~S" 'canonicalize value functions max-iter prev next)) + (setq prev next) + (setf (gethash next ht) (incf count)))) + value)) Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.6397 retrieving revision 1.6398 diff -u -d -r1.6397 -r1.6398 --- ChangeLog 17 Jul 2008 19:39:33 -0000 1.6397 +++ ChangeLog 17 Jul 2008 19:51:28 -0000 1.6398 @@ -1,7 +1,11 @@ 2008-07-17 Sam Steingold <sd...@gn...> + * macros3.lisp (canonicalize): new function + +2008-07-17 Sam Steingold <sd...@gn...> + * pathname.d (assure_dir_exists) [PATHNAME_UNIX]: fix a GC-safety - bug introduced on 2008-07-11 (get_path_info is gc-unsafe) + bug introduced on 2008-07-11 (get_path_info is GC-unsafe) (classify_namestring): GC-safe 2008-07-17 Sam Steingold <sd...@gn...> ------------------------------ Message: 5 Date: Thu, 17 Jul 2008 20:42:40 +0000 From: Sam Steingold <sd...@us...> Subject: clisp/tests path.tst,1.79,1.80 To: cli...@li... Message-ID: <E1K...@ma...> Update of /cvsroot/clisp/clisp/tests In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv14544/tests Modified Files: path.tst Log Message: use symbol-cleanup Index: path.tst =================================================================== RCS file: /cvsroot/clisp/clisp/tests/path.tst,v retrieving revision 1.79 retrieving revision 1.80 diff -u -d -r1.79 -r1.80 --- path.tst 17 Jul 2008 04:19:31 -0000 1.79 +++ path.tst 17 Jul 2008 20:42:37 -0000 1.80 @@ -1147,17 +1147,17 @@ (delete-file weird))) #+clisp (T NIL T T) -(flet ((kill (s) (makunbound s) (unintern s))) - (kill '*dir*) - (kill 'a) - (kill 'test) - (kill 'my-string) - (kill 'my-symbol) - (kill 'pathstring) - (kill 'pathsymbol) - (kill 'pathpath) - (kill 'my-path) - (kill 'path=) - (kill 'my-stream) - (kill 'my-file)) +(progn + (symbol-cleanup '*dir*) + (symbol-cleanup 'a) + (symbol-cleanup 'test) + (symbol-cleanup 'my-string) + (symbol-cleanup 'my-symbol) + (symbol-cleanup 'pathstring) + (symbol-cleanup 'pathsymbol) + (symbol-cleanup 'pathpath) + (symbol-cleanup 'my-path) + (symbol-cleanup 'path=) + (symbol-cleanup 'my-stream) + (symbol-cleanup 'my-file)) t ------------------------------ Message: 6 Date: Thu, 17 Jul 2008 21:01:04 +0000 From: Sam Steingold <sd...@us...> Subject: clisp/src ChangeLog, 1.6398, 1.6399 dfloat.d, 1.19, 1.20 ffloat.d, 1.19, 1.20 sfloat.d, 1.17, 1.18 To: cli...@li... Message-ID: <E1K...@ma...> Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv21213/src Modified Files: ChangeLog dfloat.d ffloat.d sfloat.d Log Message: * dfloat.d (RA_to_DF): clean up the STACK before error_overflow() * ffloat.d (RA_to_FF): ditto * sfloat.d (RA_to_SF): ditto These bugs are probably ~20 years old. Index: sfloat.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/sfloat.d,v retrieving revision 1.17 retrieving revision 1.18 diff -u -d -r1.17 -r1.18 --- sfloat.d 13 Dec 2007 21:32:38 -0000 1.17 +++ sfloat.d 17 Jul 2008 21:01:02 -0000 1.18 @@ -726,7 +726,7 @@ var sintL lendiff = I_integer_length(x) # (integer-length a) - I_integer_length(STACK_1); # (integer-length b) if (lendiff > SF_exp_high-SF_exp_mid) { # Exponent >= n-m > Obergrenze ? - error_overflow(); # -> Overflow + skipSTACK(2); error_overflow(); /* -> Overflow */ } if (lendiff < SF_exp_low-SF_exp_mid-2) { # Exponent <= n-m+2 < Untergrenze ? if (underflow_allowed()) { Index: dfloat.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/dfloat.d,v retrieving revision 1.19 retrieving revision 1.20 diff -u -d -r1.19 -r1.20 --- dfloat.d 14 Dec 2007 19:07:42 -0000 1.19 +++ dfloat.d 17 Jul 2008 21:01:02 -0000 1.20 @@ -1506,8 +1506,9 @@ /* stack layout: b, a. */ var sintL lendiff = I_integer_length(x) /* (integer-length a) */ - I_integer_length(STACK_1); /* (integer-length b) */ - if (lendiff > DF_exp_high-DF_exp_mid) /* exponent >= n-m > upper limit ? */ - error_overflow(); /* -> Overflow */ + if (lendiff > DF_exp_high-DF_exp_mid) { /* exponent >= n-m > upper limit ? */ + skipSTACK(2); error_overflow(); /* -> Overflow */ + } if (lendiff < DF_exp_low-DF_exp_mid-2) { /* Exponent <= n-m+2 < lower limit ? */ if (underflow_allowed()) { error_underflow(); /* -> Underflow */ Index: ffloat.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/ffloat.d,v retrieving revision 1.19 retrieving revision 1.20 diff -u -d -r1.19 -r1.20 --- ffloat.d 13 Dec 2007 21:32:38 -0000 1.19 +++ ffloat.d 17 Jul 2008 21:01:02 -0000 1.20 @@ -833,7 +833,7 @@ var sintL lendiff = I_integer_length(x) # (integer-length a) - I_integer_length(STACK_1); # (integer-length b) if (lendiff > FF_exp_high-FF_exp_mid) { # Exponent >= n-m > Obergrenze ? - error_overflow(); # -> Overflow + skipSTACK(2); error_overflow(); /* -> Overflow */ } if (lendiff < FF_exp_low-FF_exp_mid-2) { # Exponent <= n-m+2 < Untergrenze ? if (underflow_allowed()) { Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.6398 retrieving revision 1.6399 diff -u -d -r1.6398 -r1.6399 --- ChangeLog 17 Jul 2008 19:51:28 -0000 1.6398 +++ ChangeLog 17 Jul 2008 21:01:01 -0000 1.6399 @@ -1,5 +1,12 @@ 2008-07-17 Sam Steingold <sd...@gn...> + * dfloat.d (RA_to_DF): clean up the STACK before error_overflow() + * ffloat.d (RA_to_FF): ditto + * sfloat.d (RA_to_SF): ditto + These bugs are probably ~20 years old. + +2008-07-17 Sam Steingold <sd...@gn...> + * macros3.lisp (canonicalize): new function 2008-07-17 Sam Steingold <sd...@gn...> ------------------------------ Message: 7 Date: Thu, 17 Jul 2008 21:01:04 +0000 From: Sam Steingold <sd...@us...> Subject: clisp/tests ChangeLog,1.568,1.569 number2.tst,1.52,1.53 To: cli...@li... Message-ID: <E1K...@ma...> Update of /cvsroot/clisp/clisp/tests In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv21213/tests Modified Files: ChangeLog number2.tst Log Message: * dfloat.d (RA_to_DF): clean up the STACK before error_overflow() * ffloat.d (RA_to_FF): ditto * sfloat.d (RA_to_SF): ditto These bugs are probably ~20 years old. Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/tests/ChangeLog,v retrieving revision 1.568 retrieving revision 1.569 diff -u -d -r1.568 -r1.569 --- ChangeLog 17 Jul 2008 19:51:30 -0000 1.568 +++ ChangeLog 17 Jul 2008 21:01:02 -0000 1.569 @@ -1,5 +1,10 @@ 2008-07-17 Sam Steingold <sd...@gn...> + * number2.tst (float-rational-cmp): also compare x with ~10x to + check the overflow handling + +2008-07-17 Sam Steingold <sd...@gn...> + * ext-clisp.tst: test canonicalize 2008-07-16 Sam Steingold <sd...@gn...> Index: number2.tst =================================================================== RCS file: /cvsroot/clisp/clisp/tests/number2.tst,v retrieving revision 1.52 retrieving revision 1.53 diff -u -d -r1.52 -r1.53 --- number2.tst 9 Jul 2008 15:31:48 -0000 1.52 +++ number2.tst 17 Jul 2008 21:01:02 -0000 1.53 @@ -550,26 +550,37 @@ (let* ((r (rational x)) (n (numerator r)) (d (denominator r)) - (y (/ (1+ (* scale n)) (1+ (* scale d))))) + (y (/ (1+ (* scale n)) (1+ (* scale d)))) + (z (/ (1+ (* scale scale n)) (1+ (* scale d))))) (list (= y x) ; nil + (or (< (- x) x z) (> (- x) x z)) (or (< 1 y x) (> 1 y x))))) ; t float-rational-cmp -(float-rational-cmp pi) (NIL T) -(float-rational-cmp (float pi 1d0)) (NIL T) -(float-rational-cmp (float pi 1f0)) (NIL T) -(float-rational-cmp (float pi 1s0)) (NIL T) -(float-rational-cmp (/ pi)) (NIL T) -(float-rational-cmp (float (/ pi) 1d0)) (NIL T) -(float-rational-cmp (float (/ pi) 1f0)) (NIL T) -(float-rational-cmp (float (/ pi) 1s0)) (NIL T) +(float-rational-cmp pi) (NIL T T) +(float-rational-cmp (float pi 1d0)) (NIL T T) +(float-rational-cmp (float pi 1f0)) (NIL T T) +(float-rational-cmp (float pi 1s0)) (NIL T T) +(float-rational-cmp (float pi -1d0)) (NIL T T) +(float-rational-cmp (float pi -1f0)) (NIL T T) +(float-rational-cmp (float pi -1s0)) (NIL T T) +(float-rational-cmp (/ pi)) (NIL T T) +(float-rational-cmp (float (/ pi) 1d0)) (NIL T T) +(float-rational-cmp (float (/ pi) 1f0)) (NIL T T) +(float-rational-cmp (float (/ pi) 1s0)) (NIL T T) -(float-rational-cmp most-positive-short-float) (NIL T) -(float-rational-cmp least-positive-short-float) (NIL T) -(float-rational-cmp most-positive-single-float) (NIL T) -(float-rational-cmp least-positive-single-float) (NIL T) -(float-rational-cmp most-positive-double-float) (NIL T) -(float-rational-cmp least-positive-double-float) (NIL T) +(float-rational-cmp most-positive-short-float) (NIL T T) +(float-rational-cmp least-positive-short-float) (NIL T T) +(float-rational-cmp most-positive-single-float) (NIL T T) +(float-rational-cmp least-positive-single-float) (NIL T T) +(float-rational-cmp most-positive-double-float) (NIL T T) +(float-rational-cmp least-positive-double-float) (NIL T T) +(float-rational-cmp most-negative-short-float) (NIL T T) +(float-rational-cmp least-negative-short-float) (NIL T T) +(float-rational-cmp most-negative-single-float) (NIL T T) +(float-rational-cmp least-negative-single-float) (NIL T T) +(float-rational-cmp most-negative-double-float) (NIL T T) +(float-rational-cmp least-negative-double-float) (NIL T T) (progn (symbol-cleanup 'check-xgcd) (symbol-cleanup 'check-sqrt) ------------------------------ Message: 8 Date: Thu, 17 Jul 2008 21:14:50 +0000 From: Sam Steingold <sd...@us...> Subject: clisp/doc impext.xml,1.534,1.535 To: cli...@li... Message-ID: <E1K...@ma...> Update of /cvsroot/clisp/clisp/doc In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv26380/doc Modified Files: impext.xml Log Message: (*canonicalize-encoding*): defvar and export from XLIB (get_font_info_and_display): use it together with EXT:CANONICALIZE instead of the C ad-hoc-ery Index: impext.xml =================================================================== RCS file: /cvsroot/clisp/clisp/doc/impext.xml,v retrieving revision 1.534 retrieving revision 1.535 diff -u -d -r1.534 -r1.535 --- impext.xml 17 Jul 2008 19:51:28 -0000 1.534 +++ impext.xml 17 Jul 2008 21:14:48 -0000 1.535 @@ -1761,7 +1761,14 @@ <section id="canonicalize"><title>Function &canonicalize;</title> <para>If you want to canonicalize a value before further processing it, you can pass it to &canonicalize; together with a list of canonicalizers. +</para><para>E.g., &new-clx; uses it together with + <varname>XLIB:*CANONICALIZE-ENCODING*</varname> to fix the + broken encoding names returned by &X; (e.g., convert + <literal>"iso8859-1"</literal> to <literal>"ISO-8859-1"</literal>) + before passing them over to &make-encoding;. If you encounter an + encoding error in &new-clx;, you can augment this variable to avoid it. </para></section> + </section> <section id="customize"><title>Customizing &clisp; behavior</title> ------------------------------ Message: 9 Date: Thu, 17 Jul 2008 21:14:50 +0000 From: Sam Steingold <sd...@us...> Subject: clisp/modules/clx/new-clx clx.f,2.131,2.132 clx.lisp,1.34,1.35 To: cli...@li... Message-ID: <E1K...@ma...> Update of /cvsroot/clisp/clisp/modules/clx/new-clx In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv26380/modules/clx/new-clx Modified Files: clx.f clx.lisp Log Message: (*canonicalize-encoding*): defvar and export from XLIB (get_font_info_and_display): use it together with EXT:CANONICALIZE instead of the C ad-hoc-ery Index: clx.f =================================================================== RCS file: /cvsroot/clisp/clisp/modules/clx/new-clx/clx.f,v retrieving revision 2.131 retrieving revision 2.132 diff -u -d -r2.131 -r2.132 --- clx.f 10 Jul 2008 15:40:38 -0000 2.131 +++ clx.f 17 Jul 2008 21:14:48 -0000 2.132 @@ -1124,18 +1124,16 @@ status = XGetAtomNames (dpy, xatoms, 2, names); /* X11R6 */ # endif if (status) { - /* this encoding canonicalization was requested by - Pascal J.Bourguignon <pj...@in...> - in <http://article.gmane.org/gmane.lisp.clisp.general:7794> */ - char* whole = (char*) alloca(strlen(names[0])+strlen(names[1])+3); - if (!strncasecmp(names[0],"iso",3) && names[0][3] != '-') { - strcpy(whole,"ISO-"); - strcat(whole,names[0]+3); - } else strcpy(whole,names[0]); + char* whole = (char*) alloca(strlen(names[0])+strlen(names[1])+2); + strcpy(whole,names[0]); strcat(whole,"-"); strcat(whole,names[1]); end_x_call(); - pushSTACK(S(Kcharset)); + pushSTACK(asciz_to_string(whole,GLO(misc_encoding))); + pushSTACK(Symbol_value(`XLIB:*CANONICALIZE-ENCODING*`)); + pushSTACK(S(Ktest)); pushSTACK(S(equal)); + funcall(`EXT:CANONICALIZE`,4); + pushSTACK(S(Kcharset)); pushSTACK(value1); pushSTACK(asciz_to_string(whole,GLO(misc_encoding))); pushSTACK(S(Koutput_error_action)); pushSTACK(fixnum(info->default_char)); Index: clx.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/modules/clx/new-clx/clx.lisp,v retrieving revision 1.34 retrieving revision 1.35 diff -u -d -r1.34 -r1.35 --- clx.lisp 26 Jun 2008 18:53:15 -0000 1.34 +++ clx.lisp 17 Jul 2008 21:14:48 -0000 1.35 @@ -172,6 +172,7 @@ ;; extensions open-default-display with-open-display display-get-default display-resource-manager-string screen-resource-string + *canonicalize-encoding* ;;; Only when using libXt: ;; last-event-processed last-timestamp-processed ;;; Only when using the native resource database, not resource.lisp: @@ -1768,3 +1769,15 @@ (undefined TRANSLATE-DEFAULT) (undefined QUEUE-EVENT) ) + +;; canonicalize encodings supplied by X, see clx.f:get_font_info_and_display() +(defvar *canonicalize-encoding* + ;; this encoding canonicalization was requested by + ;; Pascal J.Bourguignon <pj...@in...> + ;; in <http://article.gmane.org/gmane.lisp.clisp.general:7794> + `(,(lambda (s) + (if (and (<= 4 (length s)) + (string-equal s "iso" :end1 3) + (not (char= #\- (char s 3)))) + (concatenate 'string "ISO-" (subseq s 3)) + s)))) ------------------------------ ------------------------------------------------------------------------- This SF.Net email is sponsored by the Moblin Your Move Developer's challenge Build the coolest Linux based applications with Moblin SDK & win great prizes Grand prize is a trip for two to an Open Source event anywhere in the world http://moblin-contest.org/redirect.php?banner_id=100&url=/ ------------------------------ _______________________________________________ clisp-cvs mailing list cli...@li... https://lists.sourceforge.net/lists/listinfo/clisp-cvs End of clisp-cvs Digest, Vol 27, Issue 32 ***************************************** |