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