Menu
▾
▴
clisp-cvs digest, Vol 1 #423 - 2 msgs
|
From: <cli...@li...> - 2004-03-29 14:00:05
|
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 charstrg.d,1.102,1.103 encoding.d,1.108,1.109 error.d,1.97,1.98 hashtabl.d,1.67,1.68 lisparit.d,1.62,1.63 record.d,1.69,1.70 stream.d,1.425,1.426 backquote.lisp,2.4,2.5 clos.lisp,1.69,1.70 compiler.lisp,1.179,1.180 defs1.lisp,1.30,1.31 defs2.lisp,1.24,1.25 init.lisp,1.119,1.120 trace.lisp,1.22,1.23 spvw.d,1.270,1.271 describe.lisp,1.41,1.42 pprint.lisp,1.10,1.11 savemem.lisp,1.16,1.17 ChangeLog,1.2795,1.2796 (Bruno Haible) 2. clisp/src ChangeLog,1.2796,1.2797 (Bruno Haible) --__--__-- Message: 1 From: Bruno Haible <ha...@us...> To: cli...@li... Subject: clisp/src charstrg.d,1.102,1.103 encoding.d,1.108,1.109 error.d,1.97,1.98 hashtabl.d,1.67,1.68 lisparit.d,1.62,1.63 record.d,1.69,1.70 stream.d,1.425,1.426 backquote.lisp,2.4,2.5 clos.lisp,1.69,1.70 compiler.lisp,1.179,1.180 defs1.lisp,1.30,1.31 defs2.lisp,1.24,1.25 init.lisp,1.119,1.120 trace.lisp,1.22,1.23 spvw.d,1.270,1.271 describe.lisp,1.41,1.42 pprint.lisp,1.10,1.11 savemem.lisp,1.16,1.17 ChangeLog,1.2795,1.2796 Date: Mon, 29 Mar 2004 13:44:53 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv24961/src Modified Files: charstrg.d encoding.d error.d hashtabl.d lisparit.d record.d stream.d backquote.lisp clos.lisp compiler.lisp defs1.lisp defs2.lisp init.lisp trace.lisp spvw.d describe.lisp pprint.lisp savemem.lisp ChangeLog Log Message: Change error messages so as to allow proper French and German localization. Index: record.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/record.d,v retrieving revision 1.69 retrieving revision 1.70 diff -u -d -r1.69 -r1.70 --- record.d 23 Feb 2004 17:08:39 -0000 1.69 +++ record.d 29 Mar 2004 13:44:35 -0000 1.70 @@ -91,9 +91,9 @@ /* STACK_0 = length, TYPE-ERROR slot DATUM */ pushSTACK(O(type_posint16)); /* TYPE-ERROR slot EXPECTED-TYPE */ pushSTACK(O(type_posint16)); /* type */ - pushSTACK(STACK_2); pushSTACK(S(length)); /* length */ + pushSTACK(STACK_2); /* length */ pushSTACK(TheSubr(subr_self)->name); /* function name */ - fehler(type_error,GETTEXT("~: ~ ~ should be of type ~")); + fehler(type_error,GETTEXT("~: length ~ should be of type ~")); } /* =========================================================================== @@ -765,9 +765,9 @@ nonreturning_function(local, fehler_keine_klasse, (object obj)) { pushSTACK(obj); /* TYPE-ERROR slot DATUM */ pushSTACK(S(class)); /* CLOS:CLASS, TYPE-ERROR slot EXPECTED-TYPE */ - pushSTACK(S(class)); pushSTACK(obj); + pushSTACK(obj); pushSTACK(TheSubr(subr_self)->name); /* function name */ - fehler(type_error,GETTEXT("~: ~ is not a ~")); + fehler(type_error,GETTEXT("~: ~ is not a class")); } /* (CLOS::ALLOCATE-STD-INSTANCE class n) returns a CLOS-instance of length n, Index: describe.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/describe.lisp,v retrieving revision 1.41 retrieving revision 1.42 diff -u -d -r1.41 -r1.42 --- describe.lisp 22 Mar 2004 10:18:24 -0000 1.41 +++ describe.lisp 29 Mar 2004 13:44:50 -0000 1.42 @@ -442,11 +442,9 @@ (format stream (TEXT " (a string)")) #+UNICODE (multiple-value-bind (bits ro-p realloc) (sys::string-info obj) - (write-string (TEXT " (a ") stream) - (when ro-p (write-string (TEXT "immutable ") stream)) - (when realloc (write-string (TEXT "reallocated ") stream)) - (format stream (TEXT "~A string)") - (case bits (8 "ISO-8859-1") (16 "UCS-2") (32 "UCS-4"))))) + (format stream (TEXT " (a~:[~;n immutable~] ~:[~;reallocated ~]~A string)") + ro-p realloc + (case bits (8 "ISO-8859-1") (16 "UCS-2") (32 "UCS-4"))))) (format stream (TEXT ".")))) (:method ((obj generic-function) (stream stream)) (format stream (TEXT "a generic function.")) @@ -544,15 +542,13 @@ (defun arglist (func) (sig-to-list (get-signature func))) -(defun describe-signature (s req-anz opt-anz rest-p keyword-p keywords +(defun describe-signature (stream req-anz opt-anz rest-p keyword-p keywords allow-other-keys) - (when s - (format s (TEXT "~%Argument list: "))) - (prog1 - (format s "(~{~A~^ ~})" - (signature-to-list req-anz opt-anz rest-p keyword-p keywords - allow-other-keys)) - (when s (format s ".")))) + (terpri stream) + (format stream (TEXT "Argument list: ~A.") + (format nil "(~{~A~^ ~})" + (signature-to-list req-anz opt-anz rest-p keyword-p keywords + allow-other-keys)))) ;;----------------------------------------------------------------------------- ;; auxiliary functions for CLISP metadata Index: error.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/error.d,v retrieving revision 1.97 retrieving revision 1.98 diff -u -d -r1.97 -r1.98 --- error.d 21 Mar 2004 17:25:07 -0000 1.97 +++ error.d 29 Mar 2004 13:44:35 -0000 1.98 @@ -747,8 +747,8 @@ nonreturning_function(global, fehler_list, (object obj)) { pushSTACK(obj); /* TYPE-ERROR slot DATUM */ pushSTACK(S(list)); /* TYPE-ERROR slot EXPECTED-TYPE */ - pushSTACK(S(list)); pushSTACK(obj); pushSTACK(TheSubr(subr_self)->name); - fehler(type_error,GETTEXT("~: ~ is not a ~")); + pushSTACK(obj); pushSTACK(TheSubr(subr_self)->name); + fehler(type_error,GETTEXT("~: ~ is not a list")); } /* ditto - recoverable can trigger GC */ @@ -757,8 +757,8 @@ pushSTACK(NIL); /* no PLACE */ pushSTACK(obj); /* TYPE-ERROR slot DATUM */ pushSTACK(S(list)); /* TYPE-ERROR slot EXPECTED-TYPE */ - pushSTACK(S(list)); pushSTACK(obj); pushSTACK(TheSubr(subr_self)->name); - check_value(type_error,GETTEXT("~: ~ is not a ~")); + pushSTACK(obj); pushSTACK(TheSubr(subr_self)->name); + check_value(type_error,GETTEXT("~: ~ is not a list")); obj = value1; } return obj; @@ -788,8 +788,8 @@ pushSTACK(NIL); /* no PLACE */ pushSTACK(sy); /* TYPE-ERROR slot DATUM */ pushSTACK(S(symbol)); /* TYPE-ERROR slot EXPECTED-TYPE */ - pushSTACK(S(symbol)); pushSTACK(sy); pushSTACK(caller); - check_value(type_error,GETTEXT("~: ~ is not a ~")); + pushSTACK(sy); pushSTACK(caller); + check_value(type_error,GETTEXT("~: ~ is not a symbol")); sy = value1; } return sy; @@ -851,8 +851,8 @@ nonreturning_function(global, fehler_vector, (object obj)) { pushSTACK(obj); /* TYPE-ERROR slot DATUM */ pushSTACK(S(vector)); /* TYPE-ERROR slot EXPECTED-TYPE */ - pushSTACK(S(vector)); pushSTACK(obj); pushSTACK(TheSubr(subr_self)->name); - fehler(type_error,GETTEXT("~: ~ is not a ~")); + pushSTACK(obj); pushSTACK(TheSubr(subr_self)->name); + fehler(type_error,GETTEXT("~: ~ is not a vector")); } /* error-message, if an object is not an environment. @@ -896,9 +896,9 @@ pushSTACK(NIL); /* no PLACE */ pushSTACK(obj); /* TYPE-ERROR slot DATUM */ pushSTACK(S(integer)); /* TYPE-ERROR slot EXPECTED-TYPE */ - pushSTACK(S(integer)); pushSTACK(obj); + pushSTACK(obj); pushSTACK(TheSubr(subr_self)->name); - check_value(type_error,GETTEXT("~: ~ is not a ~")); + check_value(type_error,GETTEXT("~: ~ is not an integer")); obj = value1; } return obj; @@ -908,9 +908,9 @@ pushSTACK(NIL); /* no PLACE */ pushSTACK(obj); /* TYPE-ERROR slot DATUM */ pushSTACK(O(type_posinteger)); /* TYPE-ERROR slot EXPECTED-TYPE */ - pushSTACK(S(integer)); pushSTACK(obj); + pushSTACK(obj); pushSTACK(TheSubr(subr_self)->name); - check_value(type_error,GETTEXT("~: ~ is not a non-negative ~")); + check_value(type_error,GETTEXT("~: ~ is not a non-negative integer")); obj = value1; } return obj; @@ -922,9 +922,9 @@ nonreturning_function(global, fehler_char, (object obj)) { pushSTACK(obj); /* TYPE-ERROR slot DATUM */ pushSTACK(S(character)); /* TYPE-ERROR slot EXPECTED-TYPE */ - pushSTACK(S(character)); pushSTACK(obj); + pushSTACK(obj); pushSTACK(TheSubr(subr_self)->name); - fehler(type_error,GETTEXT("~: argument ~ is not a ~")); + fehler(type_error,GETTEXT("~: argument ~ is not a character")); } /* can trigger GC */ global object check_char (object obj) { @@ -932,9 +932,9 @@ pushSTACK(NIL); /* no PLACE */ pushSTACK(obj); /* TYPE-ERROR slot DATUM */ pushSTACK(S(character)); /* TYPE-ERROR slot EXPECTED-TYPE */ - pushSTACK(S(character)); pushSTACK(obj); + pushSTACK(obj); pushSTACK(TheSubr(subr_self)->name); - check_value(type_error,GETTEXT("~: argument ~ is not a ~")); + check_value(type_error,GETTEXT("~: argument ~ is not a character")); obj = value1; } return obj; @@ -947,8 +947,8 @@ pushSTACK(NIL); /* no PLACE */ pushSTACK(obj); /* TYPE-ERROR slot DATUM */ pushSTACK(S(string)); /* TYPE-ERROR slot EXPECTED-TYPE */ - pushSTACK(S(string)); pushSTACK(obj); pushSTACK(TheSubr(subr_self)->name); - check_value(type_error,GETTEXT("~: argument ~ is not a ~")); + pushSTACK(obj); pushSTACK(TheSubr(subr_self)->name); + check_value(type_error,GETTEXT("~: argument ~ is not a string")); obj = value1; } return obj; @@ -1000,8 +1000,8 @@ nonreturning_function(global, fehler_stream, (object obj)) { pushSTACK(obj); /* TYPE-ERROR slot DATUM */ pushSTACK(S(stream)); /* TYPE-ERROR slot EXPECTED-TYPE */ - pushSTACK(S(stream)); pushSTACK(obj); pushSTACK(TheSubr(subr_self)->name); - fehler(type_error,GETTEXT("~: argument ~ is not a ~")); + pushSTACK(obj); pushSTACK(TheSubr(subr_self)->name); + fehler(type_error,GETTEXT("~: argument ~ is not a stream")); } /* error-message, if an argument is not a Stream of required stream type: @@ -1094,9 +1094,9 @@ nonreturning_function(global, fehler_key_notkw, (object kw, object caller)) { pushSTACK(kw); /* KEYWORD-ERROR slot DATUM */ pushSTACK(S(symbol)); /* KEYWORD-ERROR slot EXPECTED-TYPE */ - pushSTACK(S(symbol)); pushSTACK(kw); pushSTACK(S(LLkey)); pushSTACK(caller); + pushSTACK(kw); pushSTACK(S(LLkey)); pushSTACK(caller); fehler(keyword_error, - GETTEXT("~: ~ marker ~ is not a ~")); + GETTEXT("~: ~ marker ~ is not a symbol")); } /* error-message for flawed keyword @@ -1131,9 +1131,9 @@ pushSTACK(NIL); /* no PLACE */ pushSTACK(obj); /* TYPE-ERROR slot DATUM */ pushSTACK(S(function)); /* TYPE-ERROR slot EXPECTED-TYPE */ - pushSTACK(S(function)); pushSTACK(obj); + pushSTACK(obj); pushSTACK(TheSubr(subr_self)->name); - check_value(type_error,GETTEXT("~: ~ is not a ~")); + check_value(type_error,GETTEXT("~: ~ is not a function")); if (symbolp(value1)) obj = Symbol_function(value1); else if (funnamep(value1)) { Index: trace.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/trace.lisp,v retrieving revision 1.22 retrieving revision 1.23 diff -u -d -r1.22 -r1.23 --- trace.lisp 22 Mar 2004 10:17:06 -0000 1.22 +++ trace.lisp 29 Mar 2004 13:44:49 -0000 1.23 @@ -81,7 +81,7 @@ (unless (closurep closure) (error-of-type 'type-error :datum closure :expected-type 'closure - (TEXT "~S: ~S must name a closure") 'local name)) + (TEXT "~S: ~S does not name a closure") 'local name)) (if (sys::%compiled-function-p closure) closure (fdefinition (compile name closure))))) @@ -100,7 +100,7 @@ (unless (closurep new-def) (error-of-type 'type-error :datum new-def :expected-type 'closure - (TEXT "~S: ~S must be a closure") `(setf (local ,@spec) ,new-def))) + (TEXT "~S: ~S is not a closure") `(setf (local ,@spec)) new-def)) (multiple-value-bind (clo pos) (local-helper spec) (sys::%record-store clo pos (if (sys::%compiled-function-p new-def) Index: stream.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/stream.d,v retrieving revision 1.425 retrieving revision 1.426 diff -u -d -r1.425 -r1.426 --- stream.d 26 Mar 2004 11:16:41 -0000 1.425 +++ stream.d 29 Mar 2004 13:44:35 -0000 1.426 @@ -1295,8 +1295,8 @@ if (!symbolp(arg)) { pushSTACK(arg); # TYPE-ERROR slot DATUM pushSTACK(S(symbol)); # TYPE-ERROR slot EXPECTED-TYPE - pushSTACK(arg); pushSTACK(S(symbol)); pushSTACK(TheSubr(subr_self)->name); - fehler(type_error,GETTEXT("~: argument should be a ~, not ~")); + pushSTACK(arg); pushSTACK(TheSubr(subr_self)->name); + fehler(type_error,GETTEXT("~: argument should be a symbol, not ~")); } VALUES1(make_synonym_stream(arg)); } @@ -2240,9 +2240,9 @@ && (TheStream(stream)->strmtype == strmtype_str_in))) { pushSTACK(stream); /* TYPE-ERROR slot DATUM */ pushSTACK(S(string_stream)); /* TYPE-ERROR slot EXPECTED-TYPE */ - pushSTACK(S(string_stream)); pushSTACK(stream); + pushSTACK(stream); pushSTACK(TheSubr(subr_self)->name); - fehler(type_error,GETTEXT("~: ~ is not an input ~")); + fehler(type_error,GETTEXT("~: ~ is not a string input stream")); } var object index = TheStream(stream)->strm_str_in_index; /* if a Character was pushed back with UNREAD-CHAR, @@ -2369,7 +2369,7 @@ pushSTACK(S(string_stream)); /* TYPE-ERROR slot EXPECTED-TYPE */ pushSTACK(S(string_stream)); pushSTACK(STACK_2); pushSTACK(TheSubr(subr_self)->name); - fehler(type_error,GETTEXT("~: ~ is not an output ~")); + fehler(type_error,GETTEXT("~: ~ is not a string output stream")); } /* the collected stuff is the value */ VALUES1(get_output_stream_string(&STACK_0)); @@ -8661,10 +8661,9 @@ # around with sys::completion. pushSTACK(mlist); # slot DATUM of TYPE-ERROR pushSTACK(S(list)); # slot EXPECTED-TYPE of TYPE-ERROR - pushSTACK(S(list)); pushSTACK(S(completion)); pushSTACK(mlist); - fehler(type_error,GETTEXT("Return value ~ of call to ~ is not a ~.")); + fehler(type_error,GETTEXT("Return value ~ of call to ~ is not a list.")); } begin_system_call(); var char** array = (char**) malloc((llength(mlist)+1)*sizeof(char*)); @@ -13765,10 +13764,9 @@ if (!(TheStream(obj)->strmflags & strmflags_open_B)) { pushSTACK(obj); # TYPE-ERROR slot DATUM pushSTACK(S(stream)); # TYPE-ERROR slot EXPECTED-TYPE - pushSTACK(S(stream)); pushSTACK(obj); pushSTACK(TheSubr(subr_self)->name); - fehler(type_error,GETTEXT("~: argument ~ is not an open ~")); + fehler(type_error,GETTEXT("~: argument ~ is not an open stream")); } switch (TheStream(obj)->strmtype) { case strmtype_terminal: @@ -14146,7 +14144,7 @@ pushSTACK(O(type_socket_option)); /* TYPE-ERROR slot EXPECTED-TYPE */ pushSTACK(O(type_socket_option)); pushSTACK(kwd); pushSTACK(S(socket_options)); - fehler(type_error,GETTEXT("~: argument ~ should be ~.")); + fehler(type_error,GETTEXT("~: argument ~ should be of type ~.")); } end_system_call(); } @@ -14320,8 +14318,8 @@ if ( (READ_P(dir) && ((fcntl_flags & O_ACCMODE) == O_WRONLY)) || (WRITE_P(dir) && ((fcntl_flags & O_ACCMODE) == O_RDONLY))) { pushSTACK(STACK_5); /* FILE-ERROR slot PATHNAME */ - pushSTACK(direction); pushSTACK(STACK_1); /* handle */ - fehler(file_error,GETTEXT("Invalid direction ~ for handle ~")); + pushSTACK(STACK_0); pushSTACK(direction); + fehler(file_error,GETTEXT("Invalid direction ~ for accessing ~")); } } #endif @@ -14346,8 +14344,9 @@ fd = stream_lend_handle(STACK_4,READ_P(dir),NULL); } else { pushSTACK(NIL); /* no PLACE */ - pushSTACK(STACK_(4+1)); pushSTACK(TheSubr(subr_self)->name); - check_value(error,GETTEXT("~: ~ should be a handle, handle stream, or direction")); + pushSTACK(S(Kerror)); pushSTACK(S(Koutput)); pushSTACK(S(Kinput)); + pushSTACK(STACK_(4+4)); pushSTACK(TheSubr(subr_self)->name); + check_value(error,GETTEXT("~: ~ should be a handle, handle stream, or one of ~, ~, ~")); STACK_4 = value1; goto restart_make_stream; } @@ -15426,10 +15425,9 @@ if (!stringp(value1)) { pushSTACK(value1); # TYPE-ERROR slot DATUM pushSTACK(S(string)); # TYPE-ERROR slot EXPECTED-TYPE - pushSTACK(S(string)); pushSTACK(S(stream_read_line)); pushSTACK(value1); - fehler(type_error,GETTEXT("Return value ~ of call to ~ is not a ~.")); + fehler(type_error,GETTEXT("Return value ~ of call to ~ is not a string.")); } var bool eofp = (mv_count >= 2 && !nullp(value2)); # Add the line to the buffer: @@ -16442,10 +16440,9 @@ fehler_bad_obj: pushSTACK(obj); # TYPE-ERROR slot DATUM pushSTACK(O(type_open_file_stream)); # TYPE-ERROR slot EXPECTED-TYPE - pushSTACK(S(file_stream)); pushSTACK(obj); pushSTACK(TheSubr(subr_self)->name); - fehler(type_error,GETTEXT("~: argument ~ is not an open ~")); + fehler(type_error,GETTEXT("~: argument ~ is not an open file stream")); } /* for syscall module */ Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.2795 retrieving revision 1.2796 diff -u -d -r1.2795 -r1.2796 --- ChangeLog 27 Mar 2004 04:03:35 -0000 1.2795 +++ ChangeLog 29 Mar 2004 13:44:50 -0000 1.2796 @@ -1,3 +1,64 @@ +2004-03-14 Bruno Haible <br...@cl...> + + Internationalization fixes: + - Use entire sentences instead of pieces of sentences. + - Let the translator translate terms like STRING, SYMBOL, INTEGER, + CHARACTER, VECTOR, PACKAGE, STREAM, CLASS. On the other hand, type + names like RANDOM-STATE can remain uninternationalized. + - Prefixes like "READ: " must be internationalized as well, because in + French, a space is put before the colon. + * charstrg.d (MAKE-STRING): Improve error message. + * encoding.d (encoding_from_name): Call GETTEXT for warning message. + (init_dependent_encodings): Likewise. + * error.d (fehler_list, check_list): Make error message localizable. + (check_symbol): Likewise. + (fehler_vector): Likewise. + (check_integer, check_pos_integer): Likewise. + (fehler_char, check_char): Likewise. + (check_string): Likewise. + (fehler_stream): Likewise. + (fehler_key_notkw): Likewise. + (check_function): Likewise. + * hashtabl.d (check_hashtable): Likewise. + * lisparit.d (check_number, check_real, check_float): Likewise. + (check_rational): Likewise. + * record.d (fehler_record_length): Likewise. + (fehler_keine_klasse): Likewise. + * stream.d (MAKE-SYNONYM-STREAM): Likewise. + (SYSTEM::STRING-INPUT-STREAM-INDEX): Likewise. + (GET-OUTPUT-STREAM-STRING): Likewise. + (lisp_completion): Likewise. + (stream_handles): Likewise. + (SOCKET-OPTIONS): Improve error message. + (handle_to_stream): Fix order of arguments passed to error message. + (MAKE-STREAM): Improve error message. + (read_line): Make error message localizable. + (check_open_file_stream): Likewise. + * spvw.d (usage): Split message into two. + * backquote.lisp (bq-non-list-splice-error, bq-dotted-splice-error): + Make error message more understandable. Make the prefix localizable. + * clos.lisp (make-instances-obsolete): Improve error message. + (invalid-method-error): Fix error message: "~:%" is undefined. + (method-combination-error): Pass the right arguments to the error + message. + * compiler.lisp (set-check-lock): Fix error message. + (disassemble-closure): Make message localizable. Print the variable + lists without surrounding parentheses. + * defs1.lisp (load-lpt-many, load-lpt-one): Make the verbose message + localizable. + * defs2.lisp (define-hash-table-test): Make error message localizable. + * describe.lisp (describe-object): Make string description localizable. + (describe-signature): Assume stream argument is non-NIL. Make message + localizable. + * init.lisp (open-for-load): Change error message to reflect the user's + point of view, not the implementor's. + (load): Make the verbose message localizable. + * pprint.lisp (set-pprint-dispatch, pprint-logical-block): Make error + message localizable. + * savemem.lisp (saveinitmem): Make the verbose message localizable. + * trace.lisp (force-cclosure): Improve error message. + (%local-set): Pass the right arguments to the error message. + 2004-03-26 Will Newton <wi...@mi...> * eval.d (interpret_bytecode_): avoid a compiler warning by Index: savemem.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/savemem.lisp,v retrieving revision 1.16 retrieving revision 1.17 diff -u -d -r1.16 -r1.17 --- savemem.lisp 11 Dec 2002 19:59:26 -0000 1.16 +++ savemem.lisp 29 Mar 2004 13:44:50 -0000 1.17 @@ -62,7 +62,14 @@ (savemem fn) (when verbose (fresh-line) - (write-string (TEXT "Wrote the memory image into ")) - (princ fn) + (let* ((msg (TEXT "Wrote the memory image into ~A")) + ; We cannot use FORMAT here (bootstrapping constraint). + (pos (sys::search-string-equal "~A" msg))) + (if pos + (progn + (write-string (substring msg 0 pos)) + (princ fn) + (write-string (substring msg (+ pos 2)))) + (write-string msg))) (terpri))) (room nil)) Index: hashtabl.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/hashtabl.d,v retrieving revision 1.67 retrieving revision 1.68 diff -u -d -r1.67 -r1.68 --- hashtabl.d 21 Mar 2004 16:26:52 -0000 1.67 +++ hashtabl.d 29 Mar 2004 13:44:35 -0000 1.68 @@ -1472,9 +1472,9 @@ pushSTACK(NIL); /* no PLACE */ pushSTACK(obj); /* TYPE-ERROR slot DATUM */ pushSTACK(S(hash_table)); /* TYPE-ERROR slot EXPECTED-TYPE */ - pushSTACK(S(hash_table)); pushSTACK(obj); + pushSTACK(obj); pushSTACK(TheSubr(subr_self)->name); - check_value(type_error,GETTEXT("~: argument ~ is not a ~")); + check_value(type_error,GETTEXT("~: argument ~ is not a hash table")); obj = value1; } return obj; Index: backquote.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/backquote.lisp,v retrieving revision 2.4 retrieving revision 2.5 diff -u -d -r2.4 -r2.5 --- backquote.lisp 1 Mar 2004 14:37:36 -0000 2.4 +++ backquote.lisp 29 Mar 2004 13:44:37 -0000 2.5 @@ -174,26 +174,25 @@ (list 'NSPLICE (read stream t nil t))) (t (list 'UNQUOTE (read stream t nil t)))))) -;;; Signal error for `,.form or `,@form. If :in-reader is t, then -;;; add the prefix "READ: ", to flag the error as coming from the reader. +;;; Signal error for `,.form or `,@form. +;;; It's undefined behaviour; we signal an error for it. +;;; If :in-reader is t, then add the prefix "READ: ", to flag the error as +;;; coming from the reader. (defun bq-non-list-splice-error (sym &key in-reader) - (if (eq sym 'SPLICE) - (error-of-type 'reader-error - (TEXT "~athe syntax `,@form is undefined behavior") - (if in-reader "READ: " "")) - (error-of-type 'reader-error - (TEXT "~athe syntax `,.form is undefined behavior") - (if in-reader "READ: " "")))) + (error-of-type 'reader-error + (if in-reader (TEXT "READ: ~@?") "~@?") + (if (eq sym 'SPLICE) + (TEXT "the syntax `,@form is invalid") + (TEXT "the syntax `,.form is invalid")))) ;;; Signal error for `(... . ,@form) or `(... . ,.form). +;;; It's undefined behaviour; we signal an error for it. (defun bq-dotted-splice-error (sym &key in-reader) - (if (eq sym 'SPLICE) - (error-of-type 'reader-error - (TEXT "~athe syntax `( ... . ,@form) is undefined behavior") - (if in-reader "READ: " "")) - (error-of-type 'reader-error - (TEXT "~athe syntax `( ... . ,.form) is undefined behavior") - (if in-reader "READ: " "")))) + (error-of-type 'reader-error + (if in-reader (TEXT "READ: ~@?") "~@?") + (if (eq sym 'SPLICE) + (TEXT "the syntax `( ... . ,@form) is invalid") + (TEXT "the syntax `( ... . ,.form) is invalid")))) ;;; Like MEMBER but handles improper lists without error. (defun bq-member (elem list &key (test #'eql)) Index: defs1.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/defs1.lisp,v retrieving revision 1.30 retrieving revision 1.31 diff -u -d -r1.30 -r1.31 --- defs1.lisp 20 Jan 2004 11:32:09 -0000 1.30 +++ defs1.lisp 29 Mar 2004 13:44:49 -0000 1.31 @@ -414,22 +414,18 @@ (unless fi (return-from load-lpt-many nil)) (when *load-verbose* (fresh-line) (write-string ";; ") - (write-string (TEXT "Loading logical hosts from file ")) - (princ file) - (write-string " ...") + (format t (TEXT "Loading logical hosts from file ~A ...") file) (terpri)) (do* ((eof (gensym)) (host (read fi nil eof) (read fi nil eof))) ((eq host eof) (write-string ";; ") - (write-string (TEXT "Loaded file ")) - (princ file) + (format t (TEXT "Loaded file ~A") file) (terpri)) (setq host (string-upcase host)) (set-logical-pathname-translations host (eval (read fi))) (when *load-verbose* (fresh-line) (write-string ";; ") - (write-string (TEXT "Defined logical host ")) - (write-string host) + (format t (TEXT "Defined logical host ~A") host) (terpri)))) (gethash host *logical-pathname-translations*)) ;; load a single host from a file, CMUCL-style @@ -438,11 +434,7 @@ (unless fi (return-from load-lpt-one nil)) (when *load-verbose* (fresh-line) (write-string ";; ") - (write-string (TEXT "Loading logical host ")) - (write-string host) - (write-string (TEXT " from file ")) - (princ file) - (write-string " ...")) + (format t (TEXT "Loading logical host ~S from file ~A ...") host file)) (set-logical-pathname-translations host (read fi)) (when *load-verbose* (write-string (TEXT " done")) Index: charstrg.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/charstrg.d,v retrieving revision 1.102 retrieving revision 1.103 diff -u -d -r1.102 -r1.103 --- charstrg.d 22 Mar 2004 12:50:28 -0000 1.102 +++ charstrg.d 29 Mar 2004 13:44:35 -0000 1.103 @@ -2988,7 +2988,7 @@ pushSTACK(S(character)); /* TYPE-ERROR slot EXPECTED-TYPE */ pushSTACK(S(character)); pushSTACK(initial_element); pushSTACK(S(Kinitial_element)); pushSTACK(TheSubr(subr_self)->name); - fehler(type_error,GETTEXT("~: ~ ~ should be of type ~")); + fehler(type_error,GETTEXT("~: ~ argument ~ should be of type ~")); } else { var chart ch = char_code(initial_element); #ifdef HAVE_SMALL_SSTRING Index: defs2.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/defs2.lisp,v retrieving revision 1.24 retrieving revision 1.25 diff -u -d -r1.24 -r1.25 --- defs2.lisp 23 Mar 2004 16:13:02 -0000 1.24 +++ defs2.lisp 29 Mar 2004 13:44:49 -0000 1.25 @@ -611,8 +611,7 @@ ;; check-value will be defined in condition.lisp (setq name (check-value nil (make-condition 'simple-type-error - :format-control (TEXT "~S: ~S should be a ~S") - :format-arguments - (list 'define-hash-table-test name 'symbol) + :format-control (TEXT "~S: ~S should be a symbol") + :format-arguments (list 'define-hash-table-test name) :datum name :expected-type 'symbol)))) `(progn (setf (get ',name 'hash-table-test) (cons #',test #',hash)) ',name)) Index: encoding.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/encoding.d,v retrieving revision 1.108 retrieving revision 1.109 diff -u -d -r1.108 -r1.109 --- encoding.d 21 Mar 2004 16:26:53 -0000 1.108 +++ encoding.d 29 Mar 2004 13:44:35 -0000 1.109 @@ -2316,11 +2316,11 @@ pushSTACK(Symbol_value(value1)); else { /* Use a reasonable default. */ if (asciz_equal(context,"*FOREIGN-ENCODING*")) { - fprintf(stderr,"WARNING: %s: no encoding %s, using ASCII\n", + fprintf(stderr,GETTEXT("WARNING: %s: no encoding %s, using ASCII\n"), context,name); pushSTACK(Symbol_value(S(ascii))); } else { - fprintf(stderr,"WARNING: %s: no encoding %s, using UTF-8\n", + fprintf(stderr,GETTEXT("WARNING: %s: no encoding %s, using UTF-8\n"), context,name); pushSTACK(Symbol_value(S(utf_8))); } @@ -2385,7 +2385,7 @@ (argv_encoding_foreign == NULL ? (object)STACK_0 : encoding_from_name(argv_encoding_foreign,"*FOREIGN-ENCODING*")); if (TheEncoding(O(foreign_encoding))->max_bytes_per_char != 1) { - fprintf(stderr,"WARNING: *FOREIGN-ENCODING*: reset to ASCII\n"); + fprintf(stderr,GETTEXT("WARNING: *FOREIGN-ENCODING*: reset to ASCII\n")); O(foreign_encoding) = Symbol_value(S(ascii)); } #endif Index: compiler.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/compiler.lisp,v retrieving revision 1.179 retrieving revision 1.180 diff -u -d -r1.179 -r1.180 --- compiler.lisp 24 Mar 2004 20:40:14 -0000 1.179 +++ compiler.lisp 29 Mar 2004 13:44:37 -0000 1.180 @@ -4506,7 +4506,7 @@ (defun set-check-lock (caller symbol) (when (and (not (memq (symbol-package symbol) *compiler-unlocked-packages*)) (symbol-value-lock symbol)) - (c-warn (TEXT "~S: assignment to the internal special symbol ~S") + (c-warn (TEXT "~S: assignment to the internal special variable ~S") caller symbol))) ;; compile (SETQ {symbol form}*) @@ -10513,8 +10513,7 @@ (defun disassemble-closure (closure &optional (stream *standard-output*)) (terpri stream) (terpri stream) - (write-string (TEXT "Disassembly of function ") stream) - (prin1 (closure-name closure) stream) + (format stream (TEXT "Disassembly of function ~S") (closure-name closure)) (multiple-value-bind (req-anz opt-anz rest-p key-p keyword-list allow-other-keys-p byte-list const-list) @@ -10555,11 +10554,11 @@ ((SETVALUE) (pushnew (nth (caddr L) const-list) special-vars-write))))) (when special-vars-read - (format stream (TEXT "~%reads special variable~P: ~S") - (length special-vars-read) special-vars-read)) + (format stream (TEXT "~%reads special variable~P: ~{~S~^ ~}") + (length special-vars-read) special-vars-read)) (when special-vars-write - (format stream (TEXT "~%writes special variable~P : ~S") - (length special-vars-write) special-vars-write)) + (format stream (TEXT "~%writes special variable~P: ~{~S~^ ~}") + (length special-vars-write) special-vars-write)) (format stream (TEXT "~%~S byte-code instruction~:P:") (length lap-list)) (dolist (L lap-list) (let ((PC (car L)) (instr (cdr L))) Index: spvw.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/spvw.d,v retrieving revision 1.270 retrieving revision 1.271 diff -u -d -r1.270 -r1.271 --- spvw.d 24 Mar 2004 20:38:47 -0000 1.270 +++ spvw.d 29 Mar 2004 13:44:49 -0000 1.271 @@ -1516,7 +1516,9 @@ # print usage and exit nonreturning_function (local, usage, (int exit_code)) { printf(PACKAGE_NAME " (" PACKAGE_BUGREPORT ") "); - printf(GETTEXTL("is an ANSI Common Lisp.\nUsage: ")); + printf(GETTEXTL("is an ANSI Common Lisp.")); + printf("\n"); + printf(GETTEXTL("Usage: ")); printf(program_name); printf(GETTEXTL(" [options] [lispfile [argument ...]]\n" " When `lispfile' is given, it is loaded and `*ARGS*' is set\n" Index: init.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/init.lisp,v retrieving revision 1.119 retrieving revision 1.120 diff -u -d -r1.119 -r1.120 --- init.lisp 26 Mar 2004 17:02:12 -0000 1.119 +++ init.lisp 29 Mar 2004 13:44:49 -0000 1.120 @@ -1264,7 +1264,7 @@ (or (= 2 (length obj)) (bad last-p stream (TEXT "~s: compiled file ~s has a corrupt version marker ~s"))) (or (equal (system::version) (eval (second obj))) - (bad last-p stream (TEXT "~s: compiled file ~s has an older version marker")))))) + (bad last-p stream (TEXT "~s: compiled file ~s was created by an older CLISP version and needs to be recompiled")))))) (setq filename (pathname filename) path filename stream (my-open path)) (tagbody proceed (when (and stream @@ -1337,9 +1337,15 @@ (fresh-line) (write-string ";;") (write-string indent) - (write-string (TEXT "Loading file ")) - (princ filename) - (write-string " ...")) + (let* ((msg (TEXT "Loading file ~A ...")) + ; We cannot use FORMAT here (bootstrapping constraint). + (pos (sys::search-string-equal "~A" msg))) + (if pos + (progn + (write-string (substring msg 0 pos)) + (princ filename) + (write-string (substring msg (+ pos 2)))) + (write-string msg)))) (when *load-compiling* (compiler::c-reset-globals)) (sys::allow-read-eval input-stream t) ;; see `with-compilation-unit' -- `:compiling' sets a compilation unit @@ -1372,8 +1378,15 @@ (fresh-line) (write-string ";;") (write-string indent) - (write-string (TEXT "Loaded file ")) - (princ filename)) + (let* ((msg (TEXT "Loaded file ~A")) + ; We cannot use FORMAT here (bootstrapping constraint). + (pos (sys::search-string-equal "~A" msg))) + (if pos + (progn + (write-string (substring msg 0 pos)) + (princ filename) + (write-string (substring msg (+ pos 2)))) + (write-string msg)))) t)) (sys::%putd 'check-symbol Index: lisparit.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/lisparit.d,v retrieving revision 1.62 retrieving revision 1.63 diff -u -d -r1.62 -r1.63 --- lisparit.d 19 Mar 2004 12:36:29 -0000 1.62 +++ lisparit.d 29 Mar 2004 13:44:35 -0000 1.63 @@ -330,9 +330,9 @@ pushSTACK(NIL); /* no PLACE */ pushSTACK(obj); /* TYPE-ERROR slot DATUM */ pushSTACK(S(number)); /* TYPE-ERROR slot EXPECTED-TYPE */ - pushSTACK(S(number)); pushSTACK(obj); + pushSTACK(obj); pushSTACK(TheSubr(subr_self)->name); - check_value(type_error,GETTEXT("~: ~ is not a ~")); + check_value(type_error,GETTEXT("~: ~ is not a number")); obj = value1; } return obj; @@ -347,9 +347,9 @@ pushSTACK(NIL); /* no PLACE */ pushSTACK(obj); /* TYPE-ERROR slot DATUM */ pushSTACK(S(real)); /* TYPE-ERROR slot EXPECTED-TYPE */ - pushSTACK(S(real)); pushSTACK(obj); + pushSTACK(obj); pushSTACK(TheSubr(subr_self)->name); - check_value(type_error,GETTEXT("~: ~ is not a ~")); + check_value(type_error,GETTEXT("~: ~ is not a real number")); obj = value1; goto restart; }); @@ -364,9 +364,9 @@ pushSTACK(NIL); /* no PLACE */ pushSTACK(obj); /* TYPE-ERROR slot DATUM */ pushSTACK(S(float)); /* TYPE-ERROR slot EXPECTED-TYPE */ - pushSTACK(S(float)); pushSTACK(obj); + pushSTACK(obj); pushSTACK(TheSubr(subr_self)->name); - check_value(type_error,GETTEXT("~: ~ is not a ~")); + check_value(type_error,GETTEXT("~: ~ is not a floating-point number")); obj = value1; } return obj; @@ -381,9 +381,9 @@ pushSTACK(NIL); /* no PLACE */ pushSTACK(obj); /* TYPE-ERROR slot DATUM */ pushSTACK(S(rational)); /* TYPE-ERROR slot EXPECTED-TYPE */ - pushSTACK(S(rational)); pushSTACK(obj); + pushSTACK(obj); pushSTACK(TheSubr(subr_self)->name); - check_value(type_error,GETTEXT("~: ~ is not a ~")); + check_value(type_error,GETTEXT("~: ~ is not a rational number")); obj = value1; goto restart; }); Index: pprint.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/pprint.lisp,v retrieving revision 1.10 retrieving revision 1.11 diff -u -d -r1.10 -r1.11 --- pprint.lisp 28 Feb 2004 03:41:57 -0000 1.10 +++ pprint.lisp 29 Mar 2004 13:44:50 -0000 1.11 @@ -80,8 +80,8 @@ (unless (realp priority) (error-of-type 'type-error :datum priority :expected-type 'real - (TEXT "~S: priority must be a ~S, not ~S") - 'set-pprint-dispatch 'real priority)) + (TEXT "~S: priority must be a real number, not ~S") + 'set-pprint-dispatch priority)) (let ((rec (member type-specifier (cdr table) :test #'equal :key #'car))) (if rec (if function @@ -131,18 +131,18 @@ (when (and ,pre (not (stringp ,pre))) (error-of-type 'type-error :datum ,pre :expected-type 'string - (TEXT "~S: ~S must be a ~S, not ~S") - 'pprint-logical-block :prefix 'string ,pre)) + (TEXT "~S: ~S must be a string, not ~S") + 'pprint-logical-block :prefix ,pre)) (when (and ,suf (not (stringp ,suf))) (error-of-type 'type-error :datum ,suf :expected-type 'string - (TEXT "~S: ~S must be a ~S, not ~S") - 'pprint-logical-block :suffix 'string ,suf)) + (TEXT "~S: ~S must be a string, not ~S") + 'pprint-logical-block :suffix ,suf)) (when (and *prin-line-prefix* (not (stringp *prin-line-prefix*))) (error-of-type 'type-error :datum *prin-line-prefix* :expected-type 'string - (TEXT "~S: ~S must be a ~S, not ~S") - 'pprint-logical-block :prefix 'string *prin-line-prefix*)) + (TEXT "~S: ~S must be a string, not ~S") + 'pprint-logical-block :prefix *prin-line-prefix*)) (%pprint-logical-block (lambda (,out obj) (declare (ignorable obj)) Index: clos.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/clos.lisp,v retrieving revision 1.69 retrieving revision 1.70 diff -u -d -r1.69 -r1.70 --- clos.lisp 19 Mar 2004 14:43:23 -0000 1.69 +++ clos.lisp 29 Mar 2004 13:44:37 -0000 1.70 @@ -3862,7 +3862,7 @@ (defgeneric make-instances-obsolete (class) (:method ((class standard-class)) (let ((name (class-name class))) - (warn (TEXT "~S: Class ~S (or its ancestor) is being redefined, instances are obsolete") + (warn (TEXT "~S: Class ~S (or one of its ancestors) is being redefined, instances are obsolete") 'defclass name) (mapc #'make-instances-obsolete (class-direct-subclasses class))) class) @@ -4043,7 +4043,7 @@ ;;; error functions (defun invalid-method-error (method format-string &rest args) (error-of-type 'sys::source-program-error - (TEXT "for function ~s applied to ~s:~%while computing the effective method for ~s~:%invalid method: ~s~%~?") + (TEXT "for function ~s applied to ~s:~%while computing the effective method through ~s:~%invalid method: ~s~%~?") *method-combination-generic-function* *method-combination-arguments* *method-combination* @@ -4051,11 +4051,11 @@ (defun method-combination-error (format-string &rest args) (error-of-type 'sys::source-program-error - (TEXT "for function ~s applied to ~s:~%while computing the effective method for ~s~%invalid combination: ~s~%~?") + (TEXT "for function ~s applied to ~s:~%while computing the effective method through ~s:~%invalid method combination: ~s~%~?") *method-combination-generic-function* *method-combination-arguments* *method-combination* - format-string args)) + *method-combination* format-string args)) ;;; utility functions (defun qualifiers-match-p (qualifiers pattern) --__--__-- Message: 2 From: Bruno Haible <ha...@us...> To: cli...@li... Subject: clisp/src ChangeLog,1.2796,1.2797 Date: Mon, 29 Mar 2004 13:46:35 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv25610/src Modified Files: ChangeLog Log Message: Modernize PO file header. Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.2796 retrieving revision 1.2797 diff -u -d -r1.2796 -r1.2797 --- ChangeLog 29 Mar 2004 13:44:50 -0000 1.2796 +++ ChangeLog 29 Mar 2004 13:46:33 -0000 1.2797 @@ -1,5 +1,12 @@ 2004-03-14 Bruno Haible <br...@cl...> + Modernize PO file header. + * po/po_header.txt: Add license clause and Report-Msgid-Bugs-To field. + * po/po_header: Likewise. Use the official format for the timezone in + the header. Make it work with newer versions of GNU ls. + +2004-03-14 Bruno Haible <br...@cl...> + Internationalization fixes: - Use entire sentences instead of pieces of sentences. - Let the translator translate terms like STRING, SYMBOL, INTEGER, --__--__-- _______________________________________________ clisp-cvs mailing list cli...@li... https://lists.sourceforge.net/lists/listinfo/clisp-cvs End of clisp-cvs Digest |