Revision: 3486 Author: ksprotte URL: http://bknr.net/trac/changeset/3486

new macro do-countries and some bugfixes to contract-stats U trunk/projects/bos/m2/m2.lisp U trunk/projects/bos/m2/packages.lisp

Modified: trunk/projects/bos/m2/m2.lisp =================================================================== --- trunk/projects/bos/m2/m2.lisp 2008-07-17 12:22:38 UTC (rev 3485) +++ trunk/projects/bos/m2/m2.lisp 2008-07-17 12:50:50 UTC (rev 3486) @@ -603,21 +603,23 @@ (let* ((area (contract-area contract)) (sponsor (contract-sponsor contract)) (new-sponsor-p (alexandria:length= 1 (sponsor-contracts sponsor))) - (country (string-upcase (sponsor-country sponsor)))) + (%country (sponsor-country sponsor)) + (country (and %country (string-upcase %country)))) (with-slots (sold-m2s paying-sponsors country-sponsors last-contracts) - *contract-stats* + *contract-stats* ;; sold-m2s (incf sold-m2s area) ;; paying-sponsors (when new-sponsor-p - (incf paying-sponsors)) + (incf paying-sponsors)) ;; country-sponsors - (let ((country-stat (gethash country country-sponsors))) - (unless country-stat - (setq country-stat (setf (gethash country country-sponsors) (make-country-stat)))) - (when new-sponsor-p - (incf (country-stat-paying-sponsors country-stat))) - (incf (country-stat-sold-m2s country-stat) area)) + (when country + (let ((country-stat (gethash country country-sponsors))) + (unless country-stat + (setq country-stat (setf (gethash country country-sponsors) (make-country-stat)))) + (when new-sponsor-p + (incf (country-stat-paying-sponsors country-stat))) + (incf (country-stat-sold-m2s country-stat) area))) ;; last-contracts (setf last-contracts (nbutlast last-contracts)) (push contract last-contracts)))) @@ -641,6 +643,17 @@ (object-destroyed-p contract))) (contract-stats-last-contracts *contract-stats*)))

+(defun invoke-with-countries (function as-keyword) + (alexandria:maphash-keys + (if as-keyword + (lambda (country) (funcall function (make-keyword-from-string country))) + function) + (contract-stats-country-sponsors *contract-stats*))) + +(defmacro do-countries ((country &key as-keyword) &body body) + (check-type country symbol) + `(invoke-with-countries (lambda (,country) ,@body) ,as-keyword)) + (register-store-transient-init-function 'initialize-contract-stats)

(defun string-safe (string)

Modified: trunk/projects/bos/m2/packages.lisp =================================================================== --- trunk/projects/bos/m2/packages.lisp 2008-07-17 12:22:38 UTC (rev 3485) +++ trunk/projects/bos/m2/packages.lisp 2008-07-17 12:50:50 UTC (rev 3486) @@ -170,6 +170,7 @@ #:number-of-paying-sponsors #:contract-stats-for-country #:last-paid-contracts + #:do-countries #:make-m2-javascript #:recolorize-contracts