CMUCL commit: intl-branch src/code (6 files)

Raymond Toy rtoy at common-lisp.net
Tue Mar 2 14:45:54 CET 2010


    Date: Tuesday, March 2, 2010 @ 08:45:54
  Author: rtoy
    Path: /project/cmucl/cvsroot/src/code
     Tag: intl-branch

Modified: array.lisp format.lisp multi-proc.lisp room.lisp serve-event.lisp
          time.lisp

Convert strings containing ~:P to use ngettext for proper
translations. 


------------------+
 array.lisp       |   18 +++++++++++-------
 format.lisp      |   11 ++++++++---
 multi-proc.lisp  |    6 ++++--
 room.lisp        |   27 ++++++++++++++++++++-------
 serve-event.lisp |    7 +++++--
 time.lisp        |   33 ++++++++++++++++++++++-----------
 6 files changed, 70 insertions(+), 32 deletions(-)


Index: src/code/array.lisp
diff -u src/code/array.lisp:1.51.2.3 src/code/array.lisp:1.51.2.4
--- src/code/array.lisp:1.51.2.3	Fri Feb 12 09:46:55 2010
+++ src/code/array.lisp	Tue Mar  2 08:45:54 2010
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /project/cmucl/cvsroot/src/code/array.lisp,v 1.51.2.3 2010-02-12 14:46:55 rtoy Exp $")
+  "$Header: /project/cmucl/cvsroot/src/code/array.lisp,v 1.51.2.4 2010-03-02 13:45:54 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -447,10 +447,12 @@
 		      (incf index))
 		     (t
 		      (unless (typep contents 'sequence)
-			(error _"Malformed :initial-contents.  ~S is not a ~
-			        sequence, but ~D more layer~:P needed."
-			       contents
-			       (- (length dimensions) axis)))
+			(error (intl:ngettext "Malformed :initial-contents.  ~S is not a ~
+			                       sequence, but ~D more layer needed."
+					      "Malformed :initial-contents.  ~S is not a ~
+			                       sequence, but ~D more layers needed."
+					      (- (length dimensions) axis))
+			       contents))
 		      (unless (= (length contents) (car dims))
 			(error _"Malformed :initial-contents.  Dimension of ~
 			        axis ~D is ~D, but ~S is ~D long."
@@ -728,8 +730,10 @@
 	   (simple-program-error _"Vector axis is not zero: ~S" axis-number))
 	 (length (the (simple-array * (*)) array)))
 	((>= axis-number (%array-rank array))
-	 (simple-program-error _"~D is too big; ~S only has ~D dimension~:P"
-		axis-number array (%array-rank array)))
+	 (simple-program-error (intl:ngettext "~D is too big; ~S only has ~D dimension"
+					      "~D is too big; ~S only has ~D dimensions"
+					      (%array-rank array))
+			       axis-number array))
 	(t
 	 (%array-dimension array axis-number))))
 
Index: src/code/format.lisp
diff -u src/code/format.lisp:1.93.10.4 src/code/format.lisp:1.93.10.5
--- src/code/format.lisp:1.93.10.4	Sat Feb 13 22:06:41 2010
+++ src/code/format.lisp	Tue Mar  2 08:45:54 2010
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /project/cmucl/cvsroot/src/code/format.lisp,v 1.93.10.4 2010-02-14 03:06:41 rtoy Exp $")
+  "$Header: /project/cmucl/cvsroot/src/code/format.lisp,v 1.93.10.5 2010-03-02 13:45:54 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -2809,7 +2809,9 @@
 	     ;; ANSI specifies that "an error is signalled" in this
 	     ;; situation.
 	     (error 'format-error
-		    :complaint _"~D illegal directive~:P found inside justification block"
+		    :complaint (intl:ngettext "~D illegal directive found inside justification block"
+					      "~D illegal directives found inside justification block"
+					      count)
 		    :arguments (list count)))
 	   (expand-format-justification segments colonp atsignp
 				      first-semi params)))
@@ -2836,7 +2838,10 @@
 		  ;; ANSI specifies that "an error is signalled" in this
 		  ;; situation.
 		  (error 'format-error
-			 :complaint _"~D illegal directive~:P found inside justification block"
+			 :complaint (intl:ngettext
+				     "~D illegal directive found inside justification block"
+				     "~D illegal directives found inside justification block"
+				     count)
 			 :arguments (list count)))
 		(interpret-format-justification stream orig-args args
 						segments colonp atsignp
Index: src/code/multi-proc.lisp
diff -u src/code/multi-proc.lisp:1.44.14.3 src/code/multi-proc.lisp:1.44.14.4
--- src/code/multi-proc.lisp:1.44.14.3	Fri Feb 26 10:32:49 2010
+++ src/code/multi-proc.lisp	Tue Mar  2 08:45:54 2010
@@ -5,7 +5,7 @@
 ;;; the Public domain, and is provided 'as is'.
 ;;;
 (ext:file-comment
-  "$Header: /project/cmucl/cvsroot/src/code/multi-proc.lisp,v 1.44.14.3 2010-02-26 15:32:49 rtoy Exp $")
+  "$Header: /project/cmucl/cvsroot/src/code/multi-proc.lisp,v 1.44.14.4 2010-03-02 13:45:54 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -1230,7 +1230,9 @@
 	    (push process destroyed-processes)))
 	(unless (rest *all-processes*)
 	  (return))
-	(format t "Destroyed ~d process~:P; remaining ~d~%"
+	(format t (intl:ngettext "Destroyed ~d process; remaining ~d~%"
+				 "Destroyed ~d processes; remaining ~d~%"
+				 (length destroyed-processes))
 		(length destroyed-processes) (length *all-processes*))
 	(process-yield)))
 
Index: src/code/room.lisp
diff -u src/code/room.lisp:1.37.10.3 src/code/room.lisp:1.37.10.4
--- src/code/room.lisp:1.37.10.3	Mon Mar  1 19:39:17 2010
+++ src/code/room.lisp	Tue Mar  2 08:45:54 2010
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /project/cmucl/cvsroot/src/code/room.lisp,v 1.37.10.3 2010-03-02 00:39:17 rtoy Exp $")
+  "$Header: /project/cmucl/cvsroot/src/code/room.lisp,v 1.37.10.4 2010-03-02 13:45:54 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -509,7 +509,9 @@
 		  (incf total-bytes (first total))
 		  (incf total-objects (second total))
 		  (spaces (cons (car space-total) (first total)))))
-	      (format t _"~%~A:~%    ~:D bytes, ~:D object~:P"
+	      (format t (intl:ngettext "~%~A:~%    ~:D bytes, ~:D object"
+				       "~%~A:~%    ~:D bytes, ~:D objects"
+				       total-objects)
 		      name total-bytes total-objects)
 	      (dolist (space (spaces))
 		(format t ", ~D% ~(~A~)"
@@ -746,16 +748,23 @@
 		(objects (cadr what)))
 	    (incf printed-bytes bytes)
 	    (incf printed-objects objects)
-	    (format t _"  ~32A: ~7:D bytes, ~5D object~:P.~%" (car what)
+	    (format t (intl:ngettext "  ~32A: ~7:D bytes, ~5D object.~%"
+				     "  ~32A: ~7:D bytes, ~5D objects.~%"
+				     objects)
+		    (car what)
 		    bytes objects)))
 
 	(let ((residual-objects (- total-objects printed-objects))
 	      (residual-bytes (- total-bytes printed-bytes)))
 	  (unless (zerop residual-objects)
-	    (format t _"  Other types: ~:D bytes, ~D: object~:P.~%"
+	    (format t (intl:ngettext "  Other types: ~:D bytes, ~D: object~:P.~%"
+				     "  Other types: ~:D bytes, ~D: object~:P.~%"
+				     residual-objects)
 		    residual-bytes residual-objects))))
 
-      (format t _"  ~:(~A~) instance total: ~:D bytes, ~:D object~:P.~%"
+      (format t (intl:ngettext "  ~:(~A~) instance total: ~:D bytes, ~:D object.~%"
+			       "  ~:(~A~) instance total: ~:D bytes, ~:D objects.~%"
+			       total-objects)
 	      space total-bytes total-objects)))
 
   (values))
@@ -1004,12 +1013,16 @@
 	    
       (loop for (pkg (pkg-count . pkg-size) . files) in
 	    (sort res #'> :key #'(lambda (x) (cdr (second x)))) do
-	(format t _"~%Package ~A: ~32T~9:D bytes, ~9:D object~:P.~%"
+	(format t (intl:ngettext "~%Package ~A: ~32T~9:D bytes, ~9:D object.~%"
+				 "~%Package ~A: ~32T~9:D bytes, ~9:D objects.~%"
+				 pkg-count)
 		pkg pkg-size pkg-count)
 	(when (eq how :file)
 	  (loop for (file (file-count . file-size)) in
 	        (sort files #'> :key #'(lambda (x) (cdr (second x)))) do
-	    (format t _"~30 at A: ~9:D bytes, ~9:D object~:P.~%"
+	    (format t (intl:ngettext "~30 at A: ~9:D bytes, ~9:D object.~%"
+				     "~30 at A: ~9:D bytes, ~9:D objects.~%"
+				     file-count)
 		    (file-namestring file) file-size file-count))))))
 
   (values))
Index: src/code/serve-event.lisp
diff -u src/code/serve-event.lisp:1.28.12.4 src/code/serve-event.lisp:1.28.12.5
--- src/code/serve-event.lisp:1.28.12.4	Sat Feb 13 12:10:09 2010
+++ src/code/serve-event.lisp	Tue Mar  2 08:45:54 2010
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /project/cmucl/cvsroot/src/code/serve-event.lisp,v 1.28.12.4 2010-02-13 17:10:09 rtoy Exp $")
+  "$Header: /project/cmucl/cvsroot/src/code/serve-event.lisp,v 1.28.12.5 2010-03-02 13:45:54 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -238,7 +238,10 @@
 		  (unix:unix-fstat (handler-descriptor handler)))
 	(setf (handler-bogus handler) t)
 	(push handler bogus-handlers)))
-    (restart-case (error "~S ~[have~;has a~:;have~] bad file descriptor~:P."
+    ;; TRANSLATORS:  This needs more work.
+    (restart-case (error (intl:ngettext "~S ~[have~;has a~:;have~] bad file descriptor."
+					"~S ~[have~;has a~:;have~] bad file descriptors."
+					(length bogus-handlers))
 			 bogus-handlers (length bogus-handlers))
       (remove-them ()
 	:report (lambda (stream)
Index: src/code/time.lisp
diff -u src/code/time.lisp:1.30.10.3 src/code/time.lisp:1.30.10.4
--- src/code/time.lisp:1.30.10.3	Fri Feb 26 01:23:25 2010
+++ src/code/time.lisp	Tue Mar  2 08:45:54 2010
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /project/cmucl/cvsroot/src/code/time.lisp,v 1.30.10.3 2010-02-26 06:23:25 rtoy Exp $")
+  "$Header: /project/cmucl/cvsroot/src/code/time.lisp,v 1.30.10.4 2010-03-02 13:45:54 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -379,24 +379,35 @@
 	  (pprint-logical-block (*trace-output* nil :per-line-prefix "; ")
 	    (format *trace-output*
 		    _"Evaluation took:~%  ~
-		     ~S second~:P of real time~%  ~
-		     ~S second~:P of user run time~%  ~
-		     ~S second~:P of system run time~%  ~
-                     ~:D ~A cycles~%  ~
-		     ~@[[Run times include ~S second~:P GC run time]~%  ~]~
-		     ~S page fault~:P and~%  ~
-		     ~:D bytes consed.~%"
+		     ~S seconds of real time~%  ~
+		     ~S seconds of user run time~%  ~
+		     ~S seconds of system run time~%  "
 		    (max (/ (- new-real-time old-real-time)
 			    (float internal-time-units-per-second))
 			 0.0)
 		    (max (/ (- new-run-utime old-run-utime) 1000000.0) 0.0)
-		    (max (/ (- new-run-stime old-run-stime) 1000000.0) 0.0)
+		    (max (/ (- new-run-stime old-run-stime) 1000000.0) 0.0))
+	    (format *trace-output*
+		    (intl:ngettext
+		     "~:D ~A cycle~%  ~
+		     ~@[[Run times include ~S seconds GC run time]~%  ~]"
+		     "~:D ~A cycles~%  ~
+		     ~@[[Run times include ~S seconds GC run time]~%  ~]"
+		     (truncate cycle-count))
 		    (truncate cycle-count)
 		    "CPU"
 		    (unless (zerop gc-run-time)
 		      (/ (float gc-run-time)
-			 (float internal-time-units-per-second)))
-		    (max (- new-page-faults old-page-faults) 0)
+			 (float internal-time-units-per-second))))
+	    (format *trace-output*
+		    (intl:ngettext "~S page fault and~%  "
+				   "~S page faults and~%  "
+				   (max (- new-page-faults old-page-faults) 0))
+		    (max (- new-page-faults old-page-faults) 0))
+	    (format *trace-output*
+		    (intl:ngettext "~:D byte consed.~%"
+				   "~:D bytes consed.~%"
+				   (max (- bytes-consed (or *time-consing* 0)) 0))
 		    (max (- bytes-consed (or *time-consing* 0)) 0)))
 	  (terpri *trace-output*))
 	(setq *last-time-consing* bytes-consed))))))



More information about the cmucl-commit mailing list