bknr-cvs

bknr-cvs@common-lisp.net

1964 discussions

[bknr-cvs] edi changed tags/thirdparty/flexi-streams-1.0.4/
by BKNR Commits 25 Jul '08

25 Jul '08

Revision: 3630 Author: edi URL: http://bknr.net/trac/changeset/3630 Tag 1.0.4 A tags/thirdparty/flexi-streams-1.0.4/ Copied: tags/thirdparty/flexi-streams-1.0.4 (from rev 3629, trunk/thirdparty/flexi-streams)

1 0

[bknr-cvs] edi changed trunk/thirdparty/flexi-streams/
by BKNR Commits 25 Jul '08

25 Jul '08

Revision: 3629 Author: edi URL: http://bknr.net/trac/changeset/3629 Update to release 1.0.4 U trunk/thirdparty/flexi-streams/CHANGELOG U trunk/thirdparty/flexi-streams/doc/index.html U trunk/thirdparty/flexi-streams/flexi-streams.asd Modified: trunk/thirdparty/flexi-streams/CHANGELOG =================================================================== --- trunk/thirdparty/flexi-streams/CHANGELOG 2008-07-25 09:53:42 UTC (rev 3628) +++ trunk/thirdparty/flexi-streams/CHANGELOG 2008-07-25 09:56:14 UTC (rev 3629) @@ -1,3 +1,7 @@ +Version 1.0.4 +2008-07-25 +Cosmetic surgery on test suite + Version 1.0.3 2008-05-30 Better checks for invalid UTF-8 data Modified: trunk/thirdparty/flexi-streams/doc/index.html =================================================================== --- trunk/thirdparty/flexi-streams/doc/index.html 2008-07-25 09:53:42 UTC (rev 3628) +++ trunk/thirdparty/flexi-streams/doc/index.html 2008-07-25 09:56:14 UTC (rev 3629) @@ -229,7 +229,7 @@ <p> FLEXI-STREAMS together with this documentation can be downloaded from <a href="http://weitz.de/files/flexi-streams.tar.gz">http://weitz.de/files/flexi-streams.tar.gz</a>. The -current version is 1.0.3. +current version is 1.0.4. <p> Before you install FLEXI-STREAMS you first need to install the <a @@ -1114,7 +1114,7 @@ his work on making FLEXI-STREAMS faster. <p> -$Header: /usr/local/cvsrep/flexi-streams/doc/index.html,v 1.122 2008/05/30 08:38:23 edi Exp $ +$Header: /usr/local/cvsrep/flexi-streams/doc/index.html,v 1.123 2008/07/25 09:57:00 edi Exp $ <p><a href="http://weitz.de/index.html">BACK TO MY HOMEPAGE</a> </body> Modified: trunk/thirdparty/flexi-streams/flexi-streams.asd =================================================================== --- trunk/thirdparty/flexi-streams/flexi-streams.asd 2008-07-25 09:53:42 UTC (rev 3628) +++ trunk/thirdparty/flexi-streams/flexi-streams.asd 2008-07-25 09:56:14 UTC (rev 3629) @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/flexi-streams.asd,v 1.74 2008/05/30 08:38:21 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/flexi-streams.asd,v 1.76 2008/07/25 09:56:58 edi Exp $ ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved. @@ -35,7 +35,7 @@ (in-package :flexi-streams-system) (defsystem :flexi-streams - :version "1.0.3" + :version "1.0.4" :serial t :components ((:file "packages") (:file "mapping")

1 0

[bknr-cvs] edi changed trunk/thirdparty/flexi-streams/
by BKNR Commits 25 Jul '08

25 Jul '08

Revision: 3628 Author: edi URL: http://bknr.net/trac/changeset/3628 Spice up test suite U trunk/thirdparty/flexi-streams/flexi-streams.asd U trunk/thirdparty/flexi-streams/test/packages.lisp U trunk/thirdparty/flexi-streams/test/test.lisp Change set too large, please see URL above

1 0

[bknr-cvs] ksprotte changed trunk/projects/bos/payment-website/i
by BKNR Commits 25 Jul '08

25 Jul '08

Revision: 3627 Author: ksprotte URL: http://bknr.net/trac/changeset/3627 one more change to site headers before rollback U trunk/projects/bos/payment-website/images/site_header-de.gif U trunk/projects/bos/payment-website/images/site_header-en.gif U trunk/projects/bos/payment-website/infosystem/da/satellitenkarte.htm U trunk/projects/bos/payment-website/infosystem/de/satellitenkarte.htm U trunk/projects/bos/payment-website/infosystem/en/satellitenkarte.htm Modified: trunk/projects/bos/payment-website/images/site_header-de.gif =================================================================== (Binary files differ) Modified: trunk/projects/bos/payment-website/images/site_header-en.gif =================================================================== (Binary files differ) Modified: trunk/projects/bos/payment-website/infosystem/da/satellitenkarte.htm =================================================================== --- trunk/projects/bos/payment-website/infosystem/da/satellitenkarte.htm 2008-07-25 08:56:07 UTC (rev 3626) +++ trunk/projects/bos/payment-website/infosystem/da/satellitenkarte.htm 2008-07-25 09:52:39 UTC (rev 3627) @@ -36,7 +36,7 @@ <body> <table width="740" height="500" border="0" cellpadding="0" cellspacing="0"> <tr> - <td height="50" colspan="3"><img src="../bilder/head.gif" width="740" height="50"/></td> + <td height="50" colspan="3"><img src="../../images/site_header-en.gif" width="740" height="87"/></td> </tr> <tr> <td height="20" class="BreadCrumbs"><img src="../bilder/spacer.gif" width="1" height="1"/></td> @@ -464,4 +464,4 @@ </div> <script language="JavaScript">init();</script> </body> -</html> \ No newline at end of file +</html> Modified: trunk/projects/bos/payment-website/infosystem/de/satellitenkarte.htm =================================================================== --- trunk/projects/bos/payment-website/infosystem/de/satellitenkarte.htm 2008-07-25 08:56:07 UTC (rev 3626) +++ trunk/projects/bos/payment-website/infosystem/de/satellitenkarte.htm 2008-07-25 09:52:39 UTC (rev 3627) @@ -36,7 +36,7 @@ <body> <table width="740" height="500" border="0" cellpadding="0" cellspacing="0"> <tr> - <td height="50" colspan="3"><img src="../bilder/head.gif" width="740" height="50"/></td> + <td height="50" colspan="3"><img src="../../images/site_header-de.gif" height="75"/></td> </tr> <tr> <td height="20" class="BreadCrumbs"><img src="../bilder/spacer.gif" width="1" height="1"/></td> @@ -464,4 +464,4 @@ </div> <script language="JavaScript">init();</script> </body> -</html> \ No newline at end of file +</html> Modified: trunk/projects/bos/payment-website/infosystem/en/satellitenkarte.htm =================================================================== --- trunk/projects/bos/payment-website/infosystem/en/satellitenkarte.htm 2008-07-25 08:56:07 UTC (rev 3626) +++ trunk/projects/bos/payment-website/infosystem/en/satellitenkarte.htm 2008-07-25 09:52:39 UTC (rev 3627) @@ -36,7 +36,7 @@ <body> <table width="740" height="500" border="0" cellpadding="0" cellspacing="0"> <tr> - <td height="50" colspan="3"><img src="../bilder/head.gif" width="740" height="50"/></td> + <td height="50" colspan="3"><img src="../../images/site_header-en.gif" width="740" height="87"/></td> </tr> <tr> <td height="20" class="BreadCrumbs"><img src="../bilder/spacer.gif" width="1" height="1"/></td> @@ -464,4 +464,4 @@ </div> <script language="JavaScript">init();</script> </body> -</html> \ No newline at end of file +</html>

1 0

[bknr-cvs] ksprotte changed trunk/projects/bos/payment-website/
by BKNR Commits 25 Jul '08

25 Jul '08

Revision: 3626 Author: ksprotte URL: http://bknr.net/trac/changeset/3626 updated header to site_header-{de,en}.gif A trunk/projects/bos/payment-website/images/site_header-de.gif A trunk/projects/bos/payment-website/images/site_header-en.gif U trunk/projects/bos/payment-website/templates/da/quittung.xml U trunk/projects/bos/payment-website/templates/da/sponsor_canceled.xml U trunk/projects/bos/payment-website/templates/da/toplevel.xml U trunk/projects/bos/payment-website/templates/da/toplevel_main.xml U trunk/projects/bos/payment-website/templates/da/versand_geschenk.xml U trunk/projects/bos/payment-website/templates/da/versand_info.xml U trunk/projects/bos/payment-website/templates/de/quittung.xml U trunk/projects/bos/payment-website/templates/de/sponsor_canceled.xml U trunk/projects/bos/payment-website/templates/de/toplevel.xml U trunk/projects/bos/payment-website/templates/de/toplevel_main.xml U trunk/projects/bos/payment-website/templates/de/toplevel_news.xml U trunk/projects/bos/payment-website/templates/de/versand_geschenk.xml U trunk/projects/bos/payment-website/templates/de/versand_info.xml U trunk/projects/bos/payment-website/templates/en/quittung.xml U trunk/projects/bos/payment-website/templates/en/sponsor_canceled.xml U trunk/projects/bos/payment-website/templates/en/toplevel.xml U trunk/projects/bos/payment-website/templates/en/toplevel_main.xml U trunk/projects/bos/payment-website/templates/en/versand_geschenk.xml U trunk/projects/bos/payment-website/templates/en/versand_info.xml Added: trunk/projects/bos/payment-website/images/site_header-de.gif =================================================================== (Binary files differ) Property changes on: trunk/projects/bos/payment-website/images/site_header-de.gif ___________________________________________________________________ Name: svn:mime-type + application/octet-stream Added: trunk/projects/bos/payment-website/images/site_header-en.gif =================================================================== (Binary files differ) Property changes on: trunk/projects/bos/payment-website/images/site_header-en.gif ___________________________________________________________________ Name: svn:mime-type + application/octet-stream Modified: trunk/projects/bos/payment-website/templates/da/quittung.xml =================================================================== --- trunk/projects/bos/payment-website/templates/da/quittung.xml 2008-07-24 19:30:56 UTC (rev 3625) +++ trunk/projects/bos/payment-website/templates/da/quittung.xml 2008-07-25 08:56:07 UTC (rev 3626) @@ -17,7 +17,7 @@ <div id="menue_banner"> <a href="index"> - <img src="../images/header_ganzneu.gif" border="0"></img> + <img src="../images/site_header-en.gif" border="0"></img> </a> </div> Modified: trunk/projects/bos/payment-website/templates/da/sponsor_canceled.xml =================================================================== --- trunk/projects/bos/payment-website/templates/da/sponsor_canceled.xml 2008-07-24 19:30:56 UTC (rev 3625) +++ trunk/projects/bos/payment-website/templates/da/sponsor_canceled.xml 2008-07-25 08:56:07 UTC (rev 3626) @@ -17,7 +17,7 @@ <div id="menue_banner"> <a href="index"> - <img src="../images/header_ganzneu.gif" border="0"></img> + <img src="../images/site_header-en.gif" border="0"></img> </a> </div> Modified: trunk/projects/bos/payment-website/templates/da/toplevel.xml =================================================================== --- trunk/projects/bos/payment-website/templates/da/toplevel.xml 2008-07-24 19:30:56 UTC (rev 3625) +++ trunk/projects/bos/payment-website/templates/da/toplevel.xml 2008-07-25 08:56:07 UTC (rev 3626) @@ -19,7 +19,7 @@ <div id="menue_banner"> <a href="index"> - <img src="../images/header_ganzneu.gif" border="0"></img> + <img src="../images/site_header-en.gif" border="0"></img> </a> </div> Modified: trunk/projects/bos/payment-website/templates/da/toplevel_main.xml =================================================================== --- trunk/projects/bos/payment-website/templates/da/toplevel_main.xml 2008-07-24 19:30:56 UTC (rev 3625) +++ trunk/projects/bos/payment-website/templates/da/toplevel_main.xml 2008-07-25 08:56:07 UTC (rev 3626) @@ -16,7 +16,7 @@ <div id="menue_banner"> <a href="index"> - <img src="../images/header_ganzneu.gif" border="0"></img> + <img src="../images/site_header-en.gif" border="0"></img> </a> </div> Modified: trunk/projects/bos/payment-website/templates/da/versand_geschenk.xml =================================================================== --- trunk/projects/bos/payment-website/templates/da/versand_geschenk.xml 2008-07-24 19:30:56 UTC (rev 3625) +++ trunk/projects/bos/payment-website/templates/da/versand_geschenk.xml 2008-07-25 08:56:07 UTC (rev 3626) @@ -21,7 +21,7 @@  <div id="header"> <div id="menue_banner"> - <img src="../images/header_ganzneu.gif" border="0" /> + <img src="../images/site_header-en.gif" border="0" /> </div> <div id="menue_header_left"> Modified: trunk/projects/bos/payment-website/templates/da/versand_info.xml =================================================================== --- trunk/projects/bos/payment-website/templates/da/versand_info.xml 2008-07-24 19:30:56 UTC (rev 3625) +++ trunk/projects/bos/payment-website/templates/da/versand_info.xml 2008-07-25 08:56:07 UTC (rev 3626) @@ -16,7 +16,7 @@ <div id="header"> <div id="menue_banner"> - <img src="../images/header_ganzneu.gif" border="0"></img> + <img src="../images/site_header-en.gif" border="0"></img> </div> <div id="menue_header_left"> Modified: trunk/projects/bos/payment-website/templates/de/quittung.xml =================================================================== --- trunk/projects/bos/payment-website/templates/de/quittung.xml 2008-07-24 19:30:56 UTC (rev 3625) +++ trunk/projects/bos/payment-website/templates/de/quittung.xml 2008-07-25 08:56:07 UTC (rev 3626) @@ -23,7 +23,7 @@ <div id="menue_banner"> <a href="index"> - <img src="/images/header_ganzneu.gif" border="0" /> + <img src="/images/site_header-de.gif" border="0" /> </a> </div> Modified: trunk/projects/bos/payment-website/templates/de/sponsor_canceled.xml =================================================================== --- trunk/projects/bos/payment-website/templates/de/sponsor_canceled.xml 2008-07-24 19:30:56 UTC (rev 3625) +++ trunk/projects/bos/payment-website/templates/de/sponsor_canceled.xml 2008-07-25 08:56:07 UTC (rev 3626) @@ -23,7 +23,7 @@ <div id="menue_banner"> <a href="index"> - <img src="/images/header_ganzneu.gif" border="0" /> + <img src="/images/site_header-de.gif" border="0" /> </a> </div> Modified: trunk/projects/bos/payment-website/templates/de/toplevel.xml =================================================================== --- trunk/projects/bos/payment-website/templates/de/toplevel.xml 2008-07-24 19:30:56 UTC (rev 3625) +++ trunk/projects/bos/payment-website/templates/de/toplevel.xml 2008-07-25 08:56:07 UTC (rev 3626) @@ -22,7 +22,7 @@ <div id="menue_banner"> <a href="index"> - <img src="/images/header_ganzneu.gif" border="0" /> + <img src="/images/site_header-de.gif" border="0" /> </a> </div> Modified: trunk/projects/bos/payment-website/templates/de/toplevel_main.xml =================================================================== --- trunk/projects/bos/payment-website/templates/de/toplevel_main.xml 2008-07-24 19:30:56 UTC (rev 3625) +++ trunk/projects/bos/payment-website/templates/de/toplevel_main.xml 2008-07-25 08:56:07 UTC (rev 3626) @@ -22,7 +22,7 @@ <div id="menue_banner"> <a href="/de/index"> - <img src="/images/header_ganzneu.gif" border="0" /> + <img src="/images/site_header-de.gif" border="0" /> </a> </div> Modified: trunk/projects/bos/payment-website/templates/de/toplevel_news.xml =================================================================== --- trunk/projects/bos/payment-website/templates/de/toplevel_news.xml 2008-07-24 19:30:56 UTC (rev 3625) +++ trunk/projects/bos/payment-website/templates/de/toplevel_news.xml 2008-07-25 08:56:07 UTC (rev 3626) @@ -20,7 +20,7 @@ <div id="menue_banner"> <a href="../index"> - <img src="/images/header_ganzneu.gif" border="0" /> + <img src="/images/site_header-de.gif" border="0" /> </a> </div> Modified: trunk/projects/bos/payment-website/templates/de/versand_geschenk.xml =================================================================== --- trunk/projects/bos/payment-website/templates/de/versand_geschenk.xml 2008-07-24 19:30:56 UTC (rev 3625) +++ trunk/projects/bos/payment-website/templates/de/versand_geschenk.xml 2008-07-25 08:56:07 UTC (rev 3626) @@ -21,7 +21,7 @@  <div id="header"> <div id="menue_banner"> - <img src="/images/header_ganzneu.gif" border="0" /> + <img src="/images/site_header-de.gif" border="0" /> </div> <div id="menue_header_left"> Modified: trunk/projects/bos/payment-website/templates/de/versand_info.xml =================================================================== --- trunk/projects/bos/payment-website/templates/de/versand_info.xml 2008-07-24 19:30:56 UTC (rev 3625) +++ trunk/projects/bos/payment-website/templates/de/versand_info.xml 2008-07-25 08:56:07 UTC (rev 3626) @@ -22,7 +22,7 @@ <div id="header"> <div id="menue_banner"> - <img src="/images/header_ganzneu.gif" border="0" /> + <img src="/images/site_header-de.gif" border="0" /> </div> <div id="menue_header_left"> Modified: trunk/projects/bos/payment-website/templates/en/quittung.xml =================================================================== --- trunk/projects/bos/payment-website/templates/en/quittung.xml 2008-07-24 19:30:56 UTC (rev 3625) +++ trunk/projects/bos/payment-website/templates/en/quittung.xml 2008-07-25 08:56:07 UTC (rev 3626) @@ -23,7 +23,7 @@ <div id="menue_banner"> <a href="index"> - <img src="../images/header_ganzneu.gif" border="0" /> + <img src="../images/site_header-en.gif" border="0" /> </a> </div> Modified: trunk/projects/bos/payment-website/templates/en/sponsor_canceled.xml =================================================================== --- trunk/projects/bos/payment-website/templates/en/sponsor_canceled.xml 2008-07-24 19:30:56 UTC (rev 3625) +++ trunk/projects/bos/payment-website/templates/en/sponsor_canceled.xml 2008-07-25 08:56:07 UTC (rev 3626) @@ -23,7 +23,7 @@ <div id="menue_banner"> <a href="index"> - <img src="../images/header_ganzneu.gif" border="0" /> + <img src="../images/site_header-en.gif" border="0" /> </a> </div> Modified: trunk/projects/bos/payment-website/templates/en/toplevel.xml =================================================================== --- trunk/projects/bos/payment-website/templates/en/toplevel.xml 2008-07-24 19:30:56 UTC (rev 3625) +++ trunk/projects/bos/payment-website/templates/en/toplevel.xml 2008-07-25 08:56:07 UTC (rev 3626) @@ -24,7 +24,7 @@ <div id="menue_banner"> <a href="index"> - <img src="../images/header_ganzneu.gif" border="0" /> + <img src="../images/site_header-en.gif" border="0" /> </a> </div> Modified: trunk/projects/bos/payment-website/templates/en/toplevel_main.xml =================================================================== --- trunk/projects/bos/payment-website/templates/en/toplevel_main.xml 2008-07-24 19:30:56 UTC (rev 3625) +++ trunk/projects/bos/payment-website/templates/en/toplevel_main.xml 2008-07-25 08:56:07 UTC (rev 3626) @@ -21,7 +21,7 @@ <div id="menue_banner"> <a href="index"> - <img src="../images/header_ganzneu.gif" border="0" /> + <img src="../images/site_header-en.gif" border="0" /> </a> </div> Modified: trunk/projects/bos/payment-website/templates/en/versand_geschenk.xml =================================================================== --- trunk/projects/bos/payment-website/templates/en/versand_geschenk.xml 2008-07-24 19:30:56 UTC (rev 3625) +++ trunk/projects/bos/payment-website/templates/en/versand_geschenk.xml 2008-07-25 08:56:07 UTC (rev 3626) @@ -21,7 +21,7 @@  <div id="header"> <div id="menue_banner"> - <img src="../images/header_ganzneu.gif" border="0" /> + <img src="../images/site_header-en.gif" border="0" /> </div> <div id="menue_header_left"> Modified: trunk/projects/bos/payment-website/templates/en/versand_info.xml =================================================================== --- trunk/projects/bos/payment-website/templates/en/versand_info.xml 2008-07-24 19:30:56 UTC (rev 3625) +++ trunk/projects/bos/payment-website/templates/en/versand_info.xml 2008-07-25 08:56:07 UTC (rev 3626) @@ -22,7 +22,7 @@ <div id="header"> <div id="menue_banner"> - <img src="../images/header_ganzneu.gif" border="0" /> + <img src="../images/site_header-en.gif" border="0" /> </div> <div id="menue_header_left">

1 0

[bknr-cvs] ksprotte changed trunk/projects/bos/web/kml-handlers.lisp
by BKNR Commits 24 Jul '08

24 Jul '08

Revision: 3625 Author: ksprotte URL: http://bknr.net/trac/changeset/3625 finished kml-root handler, performing necessary string replacements in given kml template U trunk/projects/bos/web/kml-handlers.lisp Modified: trunk/projects/bos/web/kml-handlers.lisp =================================================================== --- trunk/projects/bos/web/kml-handlers.lisp 2008-07-24 15:19:13 UTC (rev 3624) +++ trunk/projects/bos/web/kml-handlers.lisp 2008-07-24 19:30:56 UTC (rev 3625) @@ -1,6 +1,8 @@ ;;; -*- coding: utf-8 -*- (in-package :bos.web) +(enable-interpol-syntax) + (defpersistent-class kml-root-data () ((language :initarg :language :reader language :type string :index-type string-unique-index @@ -69,6 +71,50 @@ (let ((kml-root-data (kml-root-data-with-language lang))) (kml-string kml-root-data)))) +(defclass kml-root-handler (object-handler) + ()) + +(defun replace-all-url-hosts (string new-host) + "Replaces all hostnames in STRING by NEW-HOST." + (ppcre:regex-replace-all #?r"((?:https?|ftp)://)\w+(?:\.\w+)*" string #?r"\1${new-host}")) + +(defun replace-lang-query-params (string new-lang) + (ppcre:regex-replace-all #?r"(?i)(lang=)[a-z]{2,2}" string #?r"\1${new-lang}")) + +(defun replace-personalized-contract-placeholder (string sponsor lang) + (if (null sponsor) + string + (let ((contract (first (sponsor-contracts sponsor)))) + (ppcre:regex-replace #?r"" + string + (cxml:with-xml-output (cxml:make-string-sink :omit-xml-declaration-p t) + (write-personalized-contract-placemark-kml contract lang)))))) + +(defun serve-kml-root-data (&optional sponsor) + (with-query-params ((lang "en")) + (let* ((kml-root-data (kml-root-data-with-language lang)) + (last-modified (store-object-last-change kml-root-data 0))) + (hunchentoot:handle-if-modified-since last-modified ) + (setf (hunchentoot:header-out :last-modified) + (hunchentoot:rfc-1123-date last-modified) + (hunchentoot:header-out :content-type) + "application/vnd.google-earth.kml+xml" + (hunchentoot:header-out :content-disposition) + (format nil "attachment; filename=kml-root-~A.kml" lang)) + (let ((kml-string (kml-string kml-root-data))) + (setq kml-string (replace-all-url-hosts kml-string (website-host)) + kml-string (replace-lang-query-params kml-string lang) + kml-string (replace-personalized-contract-placeholder kml-string sponsor lang)))))) + +(defmethod handle-object ((handler kml-root-handler) (object sponsor)) + (serve-kml-root-data object)) + +(defmethod handle-object ((handler kml-root-handler) (object contract)) + (serve-kml-root-data (contract-sponsor object))) + +(defmethod handle-object ((handler kml-root-handler) (object null)) + (serve-kml-root-data)) + ;;; kml-format utils (defun kml-format-points (points stream) (mapc #'(lambda (point) (kml-format-point point stream)) points)) @@ -124,6 +170,16 @@ (defclass kml-root-dynamic-handler (object-handler) ((timestamp :accessor timestamp :initform (get-universal-time)))) +(defun write-personalized-contract-placemark-kml (contract lang) + (with-element "Style" + (attribute "id" "contractPlacemarkIcon") + (with-element "IconStyle" + (with-element "color" (text "ff0000ff")) + (with-element "Icon" + ;; (with-element "href" (text "http://maps.google.com/mapfiles/kml/pal3/icon23.png")) + (with-element "href" (text (format nil "http://~a/static/Orang_weiss.png" (website-host))))))) + (write-contract-placemark-kml contract lang)) + (defun write-root-kml (handler sponsor) (let ((*print-case* :downcase) (contract (when sponsor (first (sponsor-contracts sponsor))))) @@ -138,14 +194,7 @@ (with-element "name" (text "BOS")) (with-element "open" (text "1")) (when contract - (with-element "Style" - (attribute "id" "contractPlacemarkIcon") - (with-element "IconStyle" - (with-element "color" (text "ff0000ff")) - (with-element "Icon" - ;; (with-element "href" (text "http://maps.google.com/mapfiles/kml/pal3/icon23.png")) - (with-element "href" (text (format nil "http://~a/static/Orang_weiss.png" (website-host))))))) - (write-contract-placemark-kml contract lang)) + (write-personalized-contract-placemark-kml contract lang)) (with-element "LookAt" (with-element "longitude" (text "116.988156014724")) (with-element "latitude" (text "-1.045791509671129"))

1 0

[bknr-cvs] edi changed trunk/thirdparty/cl-unicode/util.lisp
by BKNR Commits 24 Jul '08

24 Jul '08

Revision: 3624 Author: edi URL: http://bknr.net/trac/changeset/3624 Add docstring U trunk/thirdparty/cl-unicode/util.lisp Modified: trunk/thirdparty/cl-unicode/util.lisp =================================================================== --- trunk/thirdparty/cl-unicode/util.lisp 2008-07-24 14:58:53 UTC (rev 3623) +++ trunk/thirdparty/cl-unicode/util.lisp 2008-07-24 15:19:13 UTC (rev 3624) @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-UNICODE; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/cl-unicode/util.lisp,v 1.29 2008/07/24 14:46:20 edi Exp $ +;;; $Header: /usr/local/cvsrep/cl-unicode/util.lisp,v 1.30 2008/07/24 15:19:43 edi Exp $ ;;; Copyright (c) 2008, Dr. Edmund Weitz. All rights reserved. @@ -167,8 +167,12 @@ code-point))) (defmacro define-hangul-constant (name value) + "Simple helper macro to define some constants needed for the Hangul +algorithm below." (flet ((create-symbol (name) (intern (format nil "+~:@(~C-~A~)+" (char name 0) (subseq name 1)) :cl-unicode))) + ;; use EVAL-WHEN so the following definitions can refer to the + ;; value already `(eval-when (:compile-toplevel :load-toplevel :execute) (defconstant ,(create-symbol name) ,value ,(format nil "The constant `~A' from chapter 3 of the Unicode book." name)))))

1 0

[bknr-cvs] edi changed tags/thirdparty/cl-unicode-0.1.1/
by BKNR Commits 24 Jul '08

24 Jul '08

Revision: 3623 Author: edi URL: http://bknr.net/trac/changeset/3623 Tag version 0.1.1 A tags/thirdparty/cl-unicode-0.1.1/ Copied: tags/thirdparty/cl-unicode-0.1.1 (from rev 3622, trunk/thirdparty/cl-unicode)

1 0

[bknr-cvs] edi changed trunk/thirdparty/cl-unicode/
by BKNR Commits 24 Jul '08

24 Jul '08

Revision: 3622 Author: edi URL: http://bknr.net/trac/changeset/3622 Update to 0.1.1 U trunk/thirdparty/cl-unicode/CHANGELOG.txt U trunk/thirdparty/cl-unicode/api.lisp U trunk/thirdparty/cl-unicode/cl-unicode.asd U trunk/thirdparty/cl-unicode/doc/index.html U trunk/thirdparty/cl-unicode/packages.lisp U trunk/thirdparty/cl-unicode/specials.lisp U trunk/thirdparty/cl-unicode/util.lisp Modified: trunk/thirdparty/cl-unicode/CHANGELOG.txt =================================================================== --- trunk/thirdparty/cl-unicode/CHANGELOG.txt 2008-07-24 14:50:37 UTC (rev 3621) +++ trunk/thirdparty/cl-unicode/CHANGELOG.txt 2008-07-24 14:58:40 UTC (rev 3622) @@ -1,3 +1,7 @@ +Version 0.1.1 +2008-07-24 +Make ADD-HANGUL-NAMES faster for ClozureCL + Version 0.1.0 2008-07-24 Initial release Modified: trunk/thirdparty/cl-unicode/api.lisp =================================================================== --- trunk/thirdparty/cl-unicode/api.lisp 2008-07-24 14:50:37 UTC (rev 3621) +++ trunk/thirdparty/cl-unicode/api.lisp 2008-07-24 14:58:40 UTC (rev 3622) @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-UNICODE; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/cl-unicode/api.lisp,v 1.30 2008/07/22 02:42:13 edi Exp $ +;;; $Header: /usr/local/cvsrep/cl-unicode/api.lisp,v 1.31 2008/07/24 14:46:20 edi Exp $ ;;; Copyright (c) 2008, Dr. Edmund Weitz. All rights reserved. @@ -39,6 +39,7 @@ (unicode-name (char-code char))) (:method ((code-point integer)) (or (gethash code-point *code-points-to-names*) + (maybe-compute-hangul-syllable-name code-point) (maybe-compute-cjk-name code-point)))) (defgeneric unicode1-name (c) @@ -102,6 +103,7 @@ (setq scripts-to-try (list scripts-to-try))) (let* ((canonicalized-name (canonicalize-name name)) (code-point (or (gethash canonicalized-name *names-to-code-points*) + (maybe-find-hangul-syllable-code-point canonicalized-name) (maybe-find-cjk-code-point canonicalized-name) (and try-unicode1-names-p (gethash canonicalized-name *unicode1-names-to-code-points*)) Modified: trunk/thirdparty/cl-unicode/cl-unicode.asd =================================================================== --- trunk/thirdparty/cl-unicode/cl-unicode.asd 2008-07-24 14:50:37 UTC (rev 3621) +++ trunk/thirdparty/cl-unicode/cl-unicode.asd 2008-07-24 14:58:40 UTC (rev 3622) @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/cl-unicode/cl-unicode.asd,v 1.21 2008/07/21 22:09:22 edi Exp $ +;;; $Header: /usr/local/cvsrep/cl-unicode/cl-unicode.asd,v 1.22 2008/07/24 14:56:31 edi Exp $ ;;; Copyright (c) 2008, Dr. Edmund Weitz. All rights reserved. @@ -63,7 +63,7 @@ (call-next-method)) (defsystem :cl-unicode - :version "0.1.0" + :version "0.1.1" :serial t :depends-on (:cl-ppcre) :components ((:file "packages") Modified: trunk/thirdparty/cl-unicode/doc/index.html =================================================================== --- trunk/thirdparty/cl-unicode/doc/index.html 2008-07-24 14:50:37 UTC (rev 3621) +++ trunk/thirdparty/cl-unicode/doc/index.html 2008-07-24 14:58:40 UTC (rev 3622) @@ -72,7 +72,7 @@ CL-UNICODE together with this documentation can be downloaded from <a href="http://weitz.de/files/cl-unicode.tar.gz">http://weitz.de/files/cl-unicode.tar.gz</a>. The -current version is 0.1.0. +current version is 0.1.1. <p> The library comes with a system definition for <a href="http://www.cliki.net/asdf">ASDF</a> and you compile and @@ -1270,7 +1270,7 @@ This documentation was prepared with <a href="http://weitz.de/documentation-template/">DOCUMENTATION-TEMPLATE</a>. </p> <p> -$Header: /usr/local/cvsrep/cl-unicode/doc/index.html,v 1.12 2008/07/23 14:55:26 edi Exp $ +$Header: /usr/local/cvsrep/cl-unicode/doc/index.html,v 1.13 2008/07/24 14:56:33 edi Exp $ <p><a href="http://weitz.de/index.html">BACK TO MY HOMEPAGE</a> </body> Modified: trunk/thirdparty/cl-unicode/packages.lisp =================================================================== --- trunk/thirdparty/cl-unicode/packages.lisp 2008-07-24 14:50:37 UTC (rev 3621) +++ trunk/thirdparty/cl-unicode/packages.lisp 2008-07-24 14:58:40 UTC (rev 3622) @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/cl-unicode/packages.lisp,v 1.23 2008/07/22 02:42:13 edi Exp $ +;;; $Header: /usr/local/cvsrep/cl-unicode/packages.lisp,v 1.24 2008/07/24 14:46:20 edi Exp $ ;;; Copyright (c) 2008, Dr. Edmund Weitz. All rights reserved. @@ -31,7 +31,9 @@ (defpackage :cl-unicode (:use :cl) - (:import-from :cl-ppcre :with-rebinding) + (:import-from :cl-ppcre + :*standard-optimize-settings* + :with-rebinding) (:export :+code-point-limit+ :*scripts-to-try* :*try-abbreviations-p* Modified: trunk/thirdparty/cl-unicode/specials.lisp =================================================================== --- trunk/thirdparty/cl-unicode/specials.lisp 2008-07-24 14:50:37 UTC (rev 3621) +++ trunk/thirdparty/cl-unicode/specials.lisp 2008-07-24 14:58:40 UTC (rev 3622) @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-UNICODE; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/cl-unicode/specials.lisp,v 1.14 2008/07/23 01:08:24 edi Exp $ +;;; $Header: /usr/local/cvsrep/cl-unicode/specials.lisp,v 1.16 2008/07/24 14:50:37 edi Exp $ ;;; Copyright (c) 2008, Dr. Edmund Weitz. All rights reserved. @@ -36,7 +36,7 @@ "A hash tables which maps property symbols \(see PROPERTY-SYMBOL) to their \"canonical names\", i.e. to strings.") -(defvar *names-to-code-points* (make-hash-table :test 'equalp :size 31000) +(defvar *names-to-code-points* (make-hash-table :test 'equalp :size 20000) "A hash table which \(case-insensitively) maps \"canonicalized\" character names to their code points.") @@ -44,7 +44,7 @@ "A hash table which \(case-insensitively) maps \"canonicalized\" Unicode 1.0 character names to their code points.") -(defvar *code-points-to-names* (make-hash-table :size 31000) +(defvar *code-points-to-names* (make-hash-table :size 20000) "A hash table which maps code points to the corresponding character names.") @@ -85,6 +85,10 @@ "A hash table which maps code points to their Jamo short names. Needed to compute Hangul syllable names - see COMPUTE-HANGUL-NAME.") +(defvar *hangul-syllables-to-code-points* (make-hash-table :test 'equalp :size 12000) + "A hash table which \(case-insensitively) maps Hangul syllable name +parts to their code points.") + (defvar *try-unicode1-names-p* t "This is the default value for the :TRY-UNICODE1-NAMES-P keyword argument to CHARACTER-NAMED.") Modified: trunk/thirdparty/cl-unicode/util.lisp =================================================================== --- trunk/thirdparty/cl-unicode/util.lisp 2008-07-24 14:50:37 UTC (rev 3621) +++ trunk/thirdparty/cl-unicode/util.lisp 2008-07-24 14:58:40 UTC (rev 3622) @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-UNICODE; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/cl-unicode/util.lisp,v 1.27 2008/07/23 14:11:40 edi Exp $ +;;; $Header: /usr/local/cvsrep/cl-unicode/util.lisp,v 1.29 2008/07/24 14:46:20 edi Exp $ ;;; Copyright (c) 2008, Dr. Edmund Weitz. All rights reserved. @@ -166,45 +166,75 @@ (when (cjk-unified-ideograph-p code-point) code-point))) -(defconstant +s-base+ #xac00 - "The constant `SBase' from chapter 3 of the Unicode book.") -(defconstant +l-base+ #x1100 - "The constant `LBase' from chapter 3 of the Unicode book.") -(defconstant +v-base+ #x1161 - "The constant `VBase' from chapter 3 of the Unicode book.") -(defconstant +t-base+ #x11a7 - "The constant `TBase' from chapter 3 of the Unicode book.") -(defconstant +v-count+ 21 - "The constant `VCount' from chapter 3 of the Unicode book.") -(defconstant +t-count+ 28 - "The constant `TCount' from chapter 3 of the Unicode book.") -(define-symbol-macro +n-count+ - ;; the constant `NCount' from chapter 3 of the Unicode book - (* +v-count+ +t-count+)) +(defmacro define-hangul-constant (name value) + (flet ((create-symbol (name) + (intern (format nil "+~:@(~C-~A~)+" (char name 0) (subseq name 1)) :cl-unicode))) + `(eval-when (:compile-toplevel :load-toplevel :execute) + (defconstant ,(create-symbol name) ,value + ,(format nil "The constant `~A' from chapter 3 of the Unicode book." name))))) +(define-hangul-constant "SBase" #xac00) +(define-hangul-constant "LBase" #x1100) +(define-hangul-constant "VBase" #x1161) +(define-hangul-constant "TBase" #x11a7) +(define-hangul-constant "VCount" 21) +(define-hangul-constant "TCount" 28) +(define-hangul-constant "NCount" (* +v-count+ +t-count+)) + +(declaim (inline compute-hangul-name)) (defun compute-hangul-name (code-point) - "Algorithmically derives the Hangul syllable name of the character -with code point CODE-POINT as described in section 3.12 of the Unicode -book." + "Algorithmically derives the Hangul syllable name \(the part behind +\"HANGUL SYLLABLE \") of the character with code point CODE-POINT as +described in section 3.12 of the Unicode book." + (declare #.*standard-optimize-settings*) + (declare (fixnum code-point)) (let* ((s-index (- code-point +s-base+)) (l-value (+ +l-base+ (floor s-index +n-count+))) (v-value (+ +v-base+ (floor (mod s-index +n-count+) +t-count+))) (t-value (+ +t-base+ (mod s-index +t-count+)))) - (format nil "HANGUL SYLLABLE ~A~A~@[~A~]" + (declare (fixnum s-index t-value)) + (format nil "~A~A~@[~A~]" (gethash l-value *jamo-short-names*) (gethash v-value *jamo-short-names*) (and (/= t-value +t-base+) (gethash t-value *jamo-short-names*))))) +(defconstant +first-hangul-syllable+ #xac00 + "The code point of the first Hangul syllable the name of which can +be algorithmically derived.") +(defconstant +last-hangul-syllable+ #xd7a3 + "The code point of the last Hangul syllable the name of which can be +algorithmically derived.") + (defun add-hangul-names () "Computes the names for all Hangul syllables and registers them in -the appropriate hash tables." +the *HANGUL-SYLLABLES-TO-CODE-POINTS* hash table. Used for +CHARACTER-NAMED." + (declare #.*standard-optimize-settings*) (format t "~&;;; Computing Hangul syllable names") - (loop for code-point from #xac00 to #xd7a3 + (loop for code-point from +first-hangul-syllable+ to +last-hangul-syllable+ for name = (compute-hangul-name code-point) - do (setf (gethash (canonicalize-name name) *names-to-code-points*) code-point - (gethash code-point *code-points-to-names*) name))) + do (setf (gethash name *hangul-syllables-to-code-points*) code-point))) +(defun hangul-syllable-p (code-point) + "Returns a true value if CODE-POINT is the code point of a Hangul +syllable for which we can algorithmically derive the name." + (<= +first-hangul-syllable+ code-point +last-hangul-syllable+)) + +(defun maybe-compute-hangul-syllable-name (code-point) + "Computes the name for CODE-POINT if CODE-POINT denotes a Hangul +syllable the name of which can be algorithmically derived." + (when (hangul-syllable-p code-point) + (format nil "HANGUL SYLLABLE ~X" (compute-hangul-name code-point)))) + +(defun maybe-find-hangul-syllable-code-point (name) + "Computes the code point for NAME if NAME is the name of a Hangul +syllable the name of which can be algorithmically derived." + (ppcre:register-groups-bind (name) + ;; canonicalized + ("(?i)^HANGULSYLLABLE([A-Z]*)$" name) + (gethash name *hangul-syllables-to-code-points*))) + (defmacro ensure-code-point (c) "Helper macro so that C can be treated like a code point even if it is a Lisp character." @@ -214,7 +244,7 @@ (character (char-code ,c))))) (defun unicode-name-reader (stream char arg) - "The reader functino used when the alternative character syntax is + "The reader function used when the alternative character syntax is enabled." (declare (ignore char arg)) (let ((name (with-output-to-string (out)

1 0

[bknr-cvs] ksprotte changed trunk/projects/bos/web/
by BKNR Commits 24 Jul '08

24 Jul '08

Revision: 3621 Author: ksprotte URL: http://bknr.net/trac/changeset/3621 renamed old kml-root handler to kml-root-dynamic U trunk/projects/bos/web/kml-handlers.lisp U trunk/projects/bos/web/webserver.lisp Modified: trunk/projects/bos/web/kml-handlers.lisp =================================================================== --- trunk/projects/bos/web/kml-handlers.lisp 2008-07-24 14:43:28 UTC (rev 3620) +++ trunk/projects/bos/web/kml-handlers.lisp 2008-07-24 14:50:37 UTC (rev 3621) @@ -121,7 +121,7 @@ (when (sponsor-info-text sponsor) (text (sponsor-info-text sponsor)))))))) -(defclass kml-root-handler (object-handler) +(defclass kml-root-dynamic-handler (object-handler) ((timestamp :accessor timestamp :initform (get-universal-time)))) (defun write-root-kml (handler sponsor) @@ -187,13 +187,13 @@ :name (dictionary-entry "Country-Stats" lang) :hide-children t)))))) -(defmethod handle-object ((handler kml-root-handler) (object sponsor)) +(defmethod handle-object ((handler kml-root-dynamic-handler) (object sponsor)) (write-root-kml handler object)) -(defmethod handle-object ((handler kml-root-handler) (object contract)) +(defmethod handle-object ((handler kml-root-dynamic-handler) (object contract)) (handle-object handler (contract-sponsor object))) -(defmethod handle-object ((handler kml-root-handler) (object null)) +(defmethod handle-object ((handler kml-root-dynamic-handler) (object null)) (write-root-kml handler nil)) (defclass country-stats-handler (page-handler) Modified: trunk/projects/bos/web/webserver.lisp =================================================================== --- trunk/projects/bos/web/webserver.lisp 2008-07-24 14:43:28 UTC (rev 3620) +++ trunk/projects/bos/web/webserver.lisp 2008-07-24 14:50:37 UTC (rev 3621) @@ -200,6 +200,7 @@ ("/edit-poi-image" edit-poi-image-handler) ("/edit-sponsor" edit-sponsor-handler) ("/kml-upload" kml-upload-handler) + ("/kml-root-dynamic" kml-root-dynamic-handler) ("/kml-root" kml-root-handler) ("/country-stats" country-stats-handler) ("/contract-tree-kml" contract-tree-kml-handler)

1 0

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

bknr-cvs