- bknr-cvs@common-lisp.net - mailman3.common-lisp.net

[bknr-cvs] r1938 - branches/xml-class-rework/projects/bos/m2
by bknr＠bknr.net 17 Mar '06

17 Mar '06

Author: hhubner Date: 2006-03-17 14:20:46 -0500 (Fri, 17 Mar 2006) New Revision: 1938 Modified: branches/xml-class-rework/projects/bos/m2/cert-daemon.lisp Log: Properly close pipes generated by the cert generator. Modified: branches/xml-class-rework/projects/bos/m2/cert-daemon.lisp =================================================================== --- branches/xml-class-rework/projects/bos/m2/cert-daemon.lisp 2006-03-17 19:20:10 UTC (rev 1937) +++ branches/xml-class-rework/projects/bos/m2/cert-daemon.lisp 2006-03-17 19:20:46 UTC (rev 1938) @@ -1,13 +1,15 @@ (in-package :bos.m2.cert-generator) (defun run-tool (program &optional program-args &rest args) - (let ((process (apply #'run-program program program-args :output :stream args))) + (let* ((process (apply #'run-program program program-args :output :stream args)) + (error-message (unless (zerop (process-exit-code process)) + (with-output-to-string (*standard-output*) + (with-open-stream (output-stream (process-output process)) + (princ (read-line output-stream))))))) + (process-close process) (unless (zerop (process-exit-code process)) - (let ((error-message (with-output-to-string (*standard-output*) - (with-open-stream (output-stream (process-output process)) - (princ (read-line output-stream)))))) - (error "Error executing ~A - Exit code ~D~%Error message: ~A" - (format nil "\"~A~{ ~A~}\"" program program-args) (process-exit-code process) error-message))))) + (error "Error executing ~A - Exit code ~D~%Error message: ~A" + (format nil "\"~A~{ ~A~}\"" program program-args) (process-exit-code process) error-message)))) (defun fill-form (fdf-pathname pdf-pathname output-pathname) (handler-case

1 0

[bknr-cvs] r1937 - branches/xml-class-rework/projects/mah-jongg/website
by bknr＠bknr.net 17 Mar '06

17 Mar '06

Author: hhubner Date: 2006-03-17 14:20:10 -0500 (Fri, 17 Mar 2006) New Revision: 1937 Modified: branches/xml-class-rework/projects/mah-jongg/website/game.xsl Log: Select existing input when navigating to a 'doubles' field - as requested by Julia. Modified: branches/xml-class-rework/projects/mah-jongg/website/game.xsl =================================================================== --- branches/xml-class-rework/projects/mah-jongg/website/game.xsl 2006-03-17 18:56:13 UTC (rev 1936) +++ branches/xml-class-rework/projects/mah-jongg/website/game.xsl 2006-03-17 19:20:10 UTC (rev 1937) @@ -140,7 +140,11 @@ <input autocomplete="off" id="{@wind}-score" tabindex="1" class="score-input" onchange="return check_new_game_inputs();" value=""/> </td> <td> - <input autocomplete="off" id="{@wind}-doubles" tabindex="1" class="score-input" onchange="return check_new_game_inputs();" value="0"/> + <input autocomplete="off" id="{@wind}-doubles" tabindex="1" class="score-input" + onchange="return check_new_game_inputs();" + onfocus="this.select()" + onclick="this.select()" + value="0"/> </td> <td> <input autocomplete="off" id="{@wind}" name="{@wind}" class="score-input" readonly="readonly" value=""/>

1 0

[bknr-cvs] r1936 - branches/xml-class-rework/projects/bos/m2
by bknr＠bknr.net 17 Mar '06

17 Mar '06

Author: hhubner Date: 2006-03-17 13:56:13 -0500 (Fri, 17 Mar 2006) New Revision: 1936 Modified: branches/xml-class-rework/projects/bos/m2/cert-daemon.lisp Log: Generate proper messages for stray fdf files Modified: branches/xml-class-rework/projects/bos/m2/cert-daemon.lisp =================================================================== --- branches/xml-class-rework/projects/bos/m2/cert-daemon.lisp 2006-03-17 18:41:27 UTC (rev 1935) +++ branches/xml-class-rework/projects/bos/m2/cert-daemon.lisp 2006-03-17 18:56:13 UTC (rev 1936) @@ -13,14 +13,16 @@ (handler-case (progn (ignore-errors (run-tool "recode" (list "utf-8..latin-1" (unix-namestring fdf-pathname)))) - (if (unix-namestring pdf-pathname) - (run-tool "pdftk" (list (unix-namestring pdf-pathname) - "fill_form" (unix-namestring fdf-pathname) - "output" (namestring output-pathname) - "flatten")) - (warn "Warning, stray FDF file ~A deleted, no such contract exists" fdf-pathname)) - (delete-file fdf-pathname) - (format t "; generated ~A~%" output-pathname)) + (cond + ((unix-namestring pdf-pathname) + (run-tool "pdftk" (list (unix-namestring pdf-pathname) + "fill_form" (unix-namestring fdf-pathname) + "output" (namestring output-pathname) + "flatten")) + (format t "; generated ~A~%" output-pathname)) + (t + (warn "Warning, stray FDF file ~A deleted, no such contract exists" fdf-pathname))) + (delete-file fdf-pathname)) (error (e) (warn "While filling form ~A with ~A:~%~A" pdf-pathname fdf-pathname e))))

1 0

[bknr-cvs] r1935 - branches/xml-class-rework/projects/bos/m2
by bknr＠bknr.net 17 Mar '06

17 Mar '06

Author: hhubner Date: 2006-03-17 13:41:27 -0500 (Fri, 17 Mar 2006) New Revision: 1935 Modified: branches/xml-class-rework/projects/bos/m2/cert-daemon.lisp Log: Make certificate generation more robus Modified: branches/xml-class-rework/projects/bos/m2/cert-daemon.lisp =================================================================== --- branches/xml-class-rework/projects/bos/m2/cert-daemon.lisp 2006-03-17 15:59:16 UTC (rev 1934) +++ branches/xml-class-rework/projects/bos/m2/cert-daemon.lisp 2006-03-17 18:41:27 UTC (rev 1935) @@ -12,11 +12,13 @@ (defun fill-form (fdf-pathname pdf-pathname output-pathname) (handler-case (progn - (run-tool "recode" (list "utf-8..latin-1" (unix-namestring fdf-pathname))) - (run-tool "pdftk" (list (unix-namestring pdf-pathname) - "fill_form" (unix-namestring fdf-pathname) - "output" (namestring output-pathname) - "flatten")) + (ignore-errors (run-tool "recode" (list "utf-8..latin-1" (unix-namestring fdf-pathname)))) + (if (unix-namestring pdf-pathname) + (run-tool "pdftk" (list (unix-namestring pdf-pathname) + "fill_form" (unix-namestring fdf-pathname) + "output" (namestring output-pathname) + "flatten")) + (warn "Warning, stray FDF file ~A deleted, no such contract exists" fdf-pathname)) (delete-file fdf-pathname) (format t "; generated ~A~%" output-pathname)) (error (e) @@ -35,11 +37,15 @@ template-pathname) output-pathname))))) +(defun generate-certs () + (fill-forms *cert-mail-directory* *cert-mail-template*) + (fill-forms *cert-download-directory* *cert-download-template*) + (fill-forms *receipt-mail-directory* *receipt-mail-template*) + (fill-forms *receipt-download-directory* *receipt-download-template*)) + (defun cert-daemon () (ensure-directories-exist *cert-mail-directory*) (ensure-directories-exist *cert-download-directory*) - (loop (fill-forms *cert-mail-directory* *cert-mail-template*) - (fill-forms *cert-download-directory* *cert-download-template*) - (fill-forms *receipt-mail-directory* *receipt-mail-template*) - (fill-forms *receipt-download-directory* *receipt-download-template*) - (sleep *cert-daemon-poll-seconds*))) \ No newline at end of file + (loop + (generate-certs) + (sleep *cert-daemon-poll-seconds*))) \ No newline at end of file

1 0

[bknr-cvs] r1934 - branches/xml-class-rework/projects/bos/worldpay-test
by bknr＠bknr.net 17 Mar '06

17 Mar '06

Author: hhubner Date: 2006-03-17 10:59:16 -0500 (Fri, 17 Mar 2006) New Revision: 1934 Modified: branches/xml-class-rework/projects/bos/worldpay-test/tags.lisp branches/xml-class-rework/projects/bos/worldpay-test/worldpay-test.lisp Log: Repair language marks for certificates. Repair logout button in satellite application. Modified: branches/xml-class-rework/projects/bos/worldpay-test/tags.lisp =================================================================== --- branches/xml-class-rework/projects/bos/worldpay-test/tags.lisp 2006-03-16 18:31:23 UTC (rev 1933) +++ branches/xml-class-rework/projects/bos/worldpay-test/tags.lisp 2006-03-17 15:59:16 UTC (rev 1934) @@ -36,10 +36,9 @@ (mapc #'emit-template-node children)) (define-bknr-tag generate-cert () - (with-template-vars (gift email name address lang) - (format t "generate-cert: param 'lang': ~A template-var :language: ~A template-var :lang: ~A~%" lang (get-template-var :language) (get-template-var :lang)) + (with-template-vars (gift email name address) (let ((contract (find-store-object (parse-integer (get-template-var :contract-id))))) - (contract-issue-cert contract name :address address :language lang) + (contract-issue-cert contract name :address address :language (session-variable :language)) (bknr.web::redirect-request :target (if gift "index" (format nil "profil_setup?name=~A&email=~A&sponsor-id=~A" (uriencode-string name) (uriencode-string email) Modified: branches/xml-class-rework/projects/bos/worldpay-test/worldpay-test.lisp =================================================================== --- branches/xml-class-rework/projects/bos/worldpay-test/worldpay-test.lisp 2006-03-16 18:31:23 UTC (rev 1933) +++ branches/xml-class-rework/projects/bos/worldpay-test/worldpay-test.lisp 2006-03-17 15:59:16 UTC (rev 1934) @@ -108,8 +108,8 @@ (with-query-params (req logout) (when logout (bknr.web::drop-session (bknr-request-session req)))) - (redirect "/infosystem/satellitenkarte.htm" - req)) + (let ((language (session-variable :language))) + (redirect #?"/infosystem/$(language)/satellitenkarte.htm" req))) (defclass certificate-handler (object-handler) ()

1 0

[bknr-cvs] r1933 - branches/xml-class-rework/projects/bos/worldpay-test
by bknr＠bknr.net 16 Mar '06

16 Mar '06

Author: hhubner Date: 2006-03-16 13:31:23 -0500 (Thu, 16 Mar 2006) New Revision: 1933 Modified: branches/xml-class-rework/projects/bos/worldpay-test/tags.lisp Log: Use "lang" parameter as passed in by worldpay Modified: branches/xml-class-rework/projects/bos/worldpay-test/tags.lisp =================================================================== --- branches/xml-class-rework/projects/bos/worldpay-test/tags.lisp 2006-03-16 18:21:20 UTC (rev 1932) +++ branches/xml-class-rework/projects/bos/worldpay-test/tags.lisp 2006-03-16 18:31:23 UTC (rev 1933) @@ -36,9 +36,10 @@ (mapc #'emit-template-node children)) (define-bknr-tag generate-cert () - (with-template-vars (gift email name address language) + (with-template-vars (gift email name address lang) + (format t "generate-cert: param 'lang': ~A template-var :language: ~A template-var :lang: ~A~%" lang (get-template-var :language) (get-template-var :lang)) (let ((contract (find-store-object (parse-integer (get-template-var :contract-id))))) - (contract-issue-cert contract name :address address :language language) + (contract-issue-cert contract name :address address :language lang) (bknr.web::redirect-request :target (if gift "index" (format nil "profil_setup?name=~A&email=~A&sponsor-id=~A" (uriencode-string name) (uriencode-string email)

1 0

[bknr-cvs] r1932 - branches/xml-class-rework/projects/bos/payment-website/infosystem/en
by bknr＠bknr.net 16 Mar '06

16 Mar '06

Author: hhubner Date: 2006-03-16 13:21:20 -0500 (Thu, 16 Mar 2006) New Revision: 1932 Modified: branches/xml-class-rework/projects/bos/payment-website/infosystem/en/satellitenkarte.htm Log: Fix broken logout link Modified: branches/xml-class-rework/projects/bos/payment-website/infosystem/en/satellitenkarte.htm =================================================================== --- branches/xml-class-rework/projects/bos/payment-website/infosystem/en/satellitenkarte.htm 2006-03-16 18:06:09 UTC (rev 1931) +++ branches/xml-class-rework/projects/bos/payment-website/infosystem/en/satellitenkarte.htm 2006-03-16 18:21:20 UTC (rev 1932) @@ -120,7 +120,7 @@ </tr> </table> <div id="SponsorInfoInhalt" style="position:absolute; width:138px; z-index:20; left: 0px; top: 50px; visibility: inherit;"> - <form id="form1" name="form1" action="/infosystem/en/satellitenkarte.html" method="post"> + <form id="form1" name="form1" action="/infosystem" method="post"> <input name="logout" type="hidden" value="1"/> <table width="138" border="0" cellspacing="0" cellpadding="0"> <tr>

1 0

[bknr-cvs] r1931 - branches/xml-class-rework/projects/bos/worldpay-test
by bknr＠bknr.net 16 Mar '06

16 Mar '06

Author: hhubner Date: 2006-03-16 13:06:09 -0500 (Thu, 16 Mar 2006) New Revision: 1931 Modified: branches/xml-class-rework/projects/bos/worldpay-test/sponsor-handlers.lisp branches/xml-class-rework/projects/bos/worldpay-test/tags.lisp Log: pass language parameter down to cert generator. Modified: branches/xml-class-rework/projects/bos/worldpay-test/sponsor-handlers.lisp =================================================================== --- branches/xml-class-rework/projects/bos/worldpay-test/sponsor-handlers.lisp 2006-03-13 11:02:35 UTC (rev 1930) +++ branches/xml-class-rework/projects/bos/worldpay-test/sponsor-handlers.lisp 2006-03-16 18:06:09 UTC (rev 1931) @@ -182,6 +182,11 @@ (:td (:princ-safe (format-date-time (contract-date contract))))) (:tr (:td "Country code (2 chars)") (:td (text-field "country" :size 2 :value "DE"))) + (:tr (:td "Language") + (:td ((:select :name "language") + (loop + for (language-symbol language-name) in (website-languages) + do (html ((:option :value language-symbol) (:princ-safe language-name))))))) (:tr (:td "Name for certificate") (:td (text-field "name" :size 50))) (:tr (:td "Email-Address") @@ -191,7 +196,7 @@ (:tr (:td (submit-button "process" "process" :formcheck "javascript:return check_complete_sale()")))))))))) (defmethod handle-object-form ((handler complete-transfer-handler) (action (eql :process)) contract req) - (with-query-params (req email name postaladdress country) + (with-query-params (req email name postaladdress country language) (with-bos-cms-page (req :title "Square meter sale completion") (if (contract-paidp contract) (html (:h2 "This sale has already been completed")) @@ -199,7 +204,7 @@ (html (:h2 "Completing square meter sale")) (sponsor-set-country (contract-sponsor contract) country) (contract-set-paidp contract t) - (contract-issue-cert contract name :address postaladdress) + (contract-issue-cert contract name :address postaladdress :language language) (when email (html (:p "Sending instruction email to " (:princ-safe email))) (mail-instructions-to-sponsor contract email)))) Modified: branches/xml-class-rework/projects/bos/worldpay-test/tags.lisp =================================================================== --- branches/xml-class-rework/projects/bos/worldpay-test/tags.lisp 2006-03-13 11:02:35 UTC (rev 1930) +++ branches/xml-class-rework/projects/bos/worldpay-test/tags.lisp 2006-03-16 18:06:09 UTC (rev 1931) @@ -36,9 +36,9 @@ (mapc #'emit-template-node children)) (define-bknr-tag generate-cert () - (with-template-vars (gift email name address) + (with-template-vars (gift email name address language) (let ((contract (find-store-object (parse-integer (get-template-var :contract-id))))) - (contract-issue-cert contract name :address address) + (contract-issue-cert contract name :address address :language language) (bknr.web::redirect-request :target (if gift "index" (format nil "profil_setup?name=~A&email=~A&sponsor-id=~A" (uriencode-string name) (uriencode-string email)

1 0

[bknr-cvs] r1930 - branches/xml-class-rework/projects/lisp-ecoop/website/templates
by bknr＠bknr.net 13 Mar '06

13 Mar '06

Author: pcostanza Date: 2006-03-13 06:02:35 -0500 (Mon, 13 Mar 2006) New Revision: 1930 Modified: branches/xml-class-rework/projects/lisp-ecoop/website/templates/news.xml Log: Minor improvements. Modified: branches/xml-class-rework/projects/lisp-ecoop/website/templates/news.xml =================================================================== --- branches/xml-class-rework/projects/lisp-ecoop/website/templates/news.xml 2006-03-13 09:44:13 UTC (rev 1929) +++ branches/xml-class-rework/projects/lisp-ecoop/website/templates/news.xml 2006-03-13 11:02:35 UTC (rev 1930) @@ -8,9 +8,9 @@ <h3>March 13, 2006</h3> <ul> -<li>Nick Levine will be giving a keynote presentation at the European Lisp Workshop. He has been a professional Lisp consultant for over two decades and is the organizer of the upcoming International Lisp Conference 2007 in Cambridge / UK. We are grateful to <a href="http://www.ravenbrook.com/">Ravenbrook Limited</a> for sponsoring the keynote presentation.</li> +<li>Nick Levine will be giving a keynote presentation at the European Lisp Workshop. He has been a professional Lisp consultant for over two decades and is the organizer of the upcoming International Lisp Conference 2007 in Cambridge, UK. We are grateful to <a href="http://www.ravenbrook.com/">Ravenbrook Limited</a> for sponsoring the keynote presentation.</li> <br/> -<li>The <a href="http://www.alu.org/">Association of Lisp Users</a> has kindly sponsored a $500 prize fund for exceptional papers, selected from the submissions to this year's European Lisp Workshop. Both the ALU and the ELW organizers are looking forward to your submissions.</li> +<li>The <a href="http://www.alu.org/">Association of Lisp Users</a> has kindly sponsored a $500 prize fund for exceptional papers submitted to this year's European Lisp Workshop. Both the ALU and the workshop organizers are looking forward to your submissions.</li> </ul> <h3>February 23, 2006</h3>

1 0

[bknr-cvs] r1929 - branches/xml-class-rework/projects/lisp-ecoop/website/templates
by bknr＠bknr.net 13 Mar '06

13 Mar '06

Author: pcostanza Date: 2006-03-13 04:44:13 -0500 (Mon, 13 Mar 2006) New Revision: 1929 Modified: branches/xml-class-rework/projects/lisp-ecoop/website/templates/home.xml Log: Corrected the news link in the homepage. Modified: branches/xml-class-rework/projects/lisp-ecoop/website/templates/home.xml =================================================================== --- branches/xml-class-rework/projects/lisp-ecoop/website/templates/home.xml 2006-03-13 09:42:47 UTC (rev 1928) +++ branches/xml-class-rework/projects/lisp-ecoop/website/templates/home.xml 2006-03-13 09:44:13 UTC (rev 1929) @@ -19,7 +19,7 @@ <li>Nick Levine is going to give a keynote presentation.</li> <li>The ALU has kindly sponsored a $500 prize fund for exceptional papers.</li> </ul> -<p>Please see the <a href="news.xml">News section</a> for more details.</p> +<p>Please see the <a href="news">News section</a> for more details.</p> <h2>Important Dates</h2> <ul>

1 0