bknr-cvs October 2007

bknr-cvs@common-lisp.net

1 participants
67 discussions

[bknr-cvs] r2193 - in branches/trunk-reorg: . bknr
by bknr＠bknr.net 04 Oct '07

04 Oct '07

Author: hhubner Date: 2007-10-04 13:10:36 -0400 (Thu, 04 Oct 2007) New Revision: 2193 Added: branches/trunk-reorg/bknr/datastore/ Removed: branches/trunk-reorg/datastore/ Log: checkpoint Copied: branches/trunk-reorg/bknr/datastore (from rev 2190, branches/trunk-reorg/datastore)

1 0

[bknr-cvs] r2192 - branches/trunk-reorg
by bknr＠bknr.net 04 Oct '07

04 Oct '07

Author: hhubner Date: 2007-10-04 13:09:57 -0400 (Thu, 04 Oct 2007) New Revision: 2192 Added: branches/trunk-reorg/bknr/ Log: checkpoint

1 0

[bknr-cvs] r2191 - branches/trunk-reorg/xhtmlgen
by bknr＠bknr.net 04 Oct '07

04 Oct '07

Author: hhubner Date: 2007-10-04 13:08:38 -0400 (Thu, 04 Oct 2007) New Revision: 2191 Added: branches/trunk-reorg/xhtmlgen/xhtmlgen.asd Log: checkpoint Added: branches/trunk-reorg/xhtmlgen/xhtmlgen.asd =================================================================== --- branches/trunk-reorg/xhtmlgen/xhtmlgen.asd 2007-10-04 16:49:32 UTC (rev 2190) +++ branches/trunk-reorg/xhtmlgen/xhtmlgen.asd 2007-10-04 17:08:38 UTC (rev 2191) @@ -0,0 +1,6 @@ +(in-package :cl-user) + +(defsystem :xhtmlgen + :serial t + :components ((:file "package") + (:file "xhtmlgen"))) \ No newline at end of file

1 0

[bknr-cvs] r2189 - branches/trunk-reorg/thirdparty
by bknr＠bknr.net 04 Oct '07

04 Oct '07

Author: hhubner Date: 2007-10-04 12:42:21 -0400 (Thu, 04 Oct 2007) New Revision: 2189 Removed: branches/trunk-reorg/thirdparty/cffi/ branches/trunk-reorg/thirdparty/cl-base64/ branches/trunk-reorg/thirdparty/cl-ppcre/ branches/trunk-reorg/thirdparty/md5/ Log: update thirdparty stuff

1 0

[bknr-cvs] r2188 - in branches/trunk-reorg: datastore/src web/src xhtmlgen
by bknr＠bknr.net 04 Oct '07

04 Oct '07

Author: hhubner Date: 2007-10-04 12:25:24 -0400 (Thu, 04 Oct 2007) New Revision: 2188 Added: branches/trunk-reorg/web/src/packages.lisp branches/trunk-reorg/web/src/sysclasses/ branches/trunk-reorg/xhtmlgen/package.lisp Removed: branches/trunk-reorg/datastore/src/packages.lisp branches/trunk-reorg/datastore/src/sysclasses/ Log: checkpoint Deleted: branches/trunk-reorg/datastore/src/packages.lisp =================================================================== --- branches/trunk-reorg/datastore/src/packages.lisp 2007-10-04 16:20:09 UTC (rev 2187) +++ branches/trunk-reorg/datastore/src/packages.lisp 2007-10-04 16:25:24 UTC (rev 2188) @@ -1,464 +0,0 @@ -(in-package :cl-user) - -(defpackage :xhtml-generator - (:use :common-lisp) - (:export #:html - #:html-stream - #:*html-sink* - #:set-string-encoding)) - -(defpackage :bknr.sysparams - (:use :cl :cl-user :bknr.indices :bknr.datastore) - (:export #:sysparam - #:set-sysparam)) - -(defpackage :bknr.htmlize - (:use :cl :cl-user :bknr.utils) - (:export #:to-html - #:htmlize-file - #:htmlize-string - #:htmlize)) - -(defpackage :bknr.cron - (:use :cl :cl-user :bknr.utils :bknr.indices :bknr.datastore) - (:export #:make-cron-job - #:cron-job-with-name - #:start-cron)) - -(defpackage :bknr.rss - (:use :cl :cl-user :cl-ppcre :bknr.utils :bknr.xml :puri :cxml-xmls :bknr.datastore :bknr.indices :cxml) - (:export #:xml-escape - #:*img-src-scanner* - #:*a-href-scanner* - #:*link-href-scanner* - #:replace-relative-links - #:make-absolute-url - - #:rss-to-xml - #:merge-feeds - - ;; channel - #:rss-channel - #:find-rss-channel - #:make-rss-channel - #:rss-channel-cleanup - #:rss-channel-about - #:rss-channel-title - #:rss-channel-link - #:rss-channel-desc - #:rss-channel-image - #:rss-channel-textinput - #:rss-channel-items - #:rss-channel-xml - - ;; image - #:rss-image - #:rss-image-about - #:rss-image-title - #:rss-image-url - #:rss-image-link - - ;; item - #:rss-item - #:rss-item-channel - #:rss-item-published - #:rss-item-pub-date - #:rss-item-title - #:rss-item-link - #:rss-item-description - #:rss-item-author - #:rss-item-category - #:rss-item-comments - #:rss-item-enclosure - #:rss-item-guid - #:rss-item-source - - ;; textinput - #:rss-textinput - #:rss-textinput-about - #:rss-textinput-title - #:rss-textinput-desc - #:rss-textinput-link - #:rss-textinput-name - - #:parse-rss091-feed - #:parse-rss10-feed - #:parse-rss20-feed - #:parse-atom-feed - - #:*base-url*)) - -(defpackage :bknr.events - (:use :cl - :xhtml-generator - :bknr.utils - :bknr.datastore - :cl-ppcre) - (:documentation "events framework, currently exports all defined symbols until refactoring") - (:export #:event - #:event-time - #:event-handler - #:event-argument - #:event-class-name - - #:make-event - #:find-events - #:all-events - - #:handle-event - #:generate-event-xml)) - -(defpackage :bknr.user - (:use :cl - :cl-user - :cl-interpol - :cl-ppcre - :md5 - :bknr.datastore - :bknr.indices - :bknr.utils - :bknr.events - :xhtml-generator) - (:shadowing-import-from :cl-interpol #:quote-meta-chars) - (:export #:user - - #:user-full-name - #:user-last-login - #:user-email - #:user-login - #:user-password - #:user-flags - #:user-preferences - #:user-subscriptions - #:user-editable-p - - ;; Export slot names so that derived classes can overload - ;; slots (e.g. to add XML impex attributes) - #:login - #:flags - #:email - #:full-name - #:last-login - #:password - #:preferences - #:subscriptions - #:mail-error - - #:find-user - #:user-with-email - #:admin-p - #:anonymous-p - - #:user-has-flag - #:user-add-flags - #:user-remove-flags - #:all-user-flags - #:define-user-flag - - #:user-reachable-by-mail-p - #:user-mail-error-p - #:verify-password - #:user-disabled - #:user-preferences - #:user-preference - #:set-user-preference - #:all-users - #:get-flag-users - #:make-user - #:delete-user - #:set-user-password - - #:set-user-last-login - - #:owned-object - #:owned-object-owners - #:store-objects-owned-by - - #:message-event)) - -(defpackage :bknr.web - (:use :cl - :cl-user - :cl-gd - :cl-interpol - :cl-ppcre - :net.aserve - :cxml-xmls - :xhtml-generator - :puri - :md5 - :js - :bknr.datastore - :bknr.indices - :bknr.impex - :bknr.utils - :bknr.xml - :bknr.events - :bknr.user) - (:shadowing-import-from :cl-interpol #:quote-meta-chars) - (:import-from :net.html.generator #:*html-stream*) - (:export #:*req* - #:*ent* - #:*user* - #:session-variable - #:request-variable - #:with-query-params - #:define-bknr-tag - #:with-bknr-page - #:cmslink - - #:web-server-log-event-referer - #:web-server-log-event-url - #:web-server-log-event-user-agent - - #:web-visitor-event-host - #:web-visitor-event-session-id - #:web-visitor-event-user - - #:web-server-error-event - #:web-server-error-event-error - #:all-web-server-error-events - - #:;; web-utils - #:*upload-file-size-limit* - #:all-request-params - #:request-uploaded-files - #:request-uploaded-file - #:query-param - #:query-param-list - #:cookie-value - #:http-error - #:keywords-from-query-param-list - #:html-quote - #:parse-url - #:parse-uri - #:text-to-html - #:make-wiki-hrefs - #:html-link - #:html-edit-link - #:object-url - #:edit-object-url - #:xmls-emit - #:emit-html - #:make-self-reference-url - #:html-warn - #:redirect - #:redirect-uri - #:emit-html - #:error-404 - #:encode-urlencoded - #:submit-button - #:text-field - #:textarea-field - #:checkbox-field - #:select-box - #:date-field - #:parse-date-field - #:keyword-choose-dialog - #:navi-button - #:with-bknr-http-response - - #:upload - #:upload-name - #:upload-pathname - #:upload-size - #:upload-content-type - - #:bknr-url-path - - ;; templates - #:expand-template - #:get-template-var - #:with-template-vars - #:emit-template-node - #:user-error - #:find-template-pathname - #:initial-template-environment - #:with-tag-expanders - - #:*html-variables* - #:*template-dtd-catalog* - - ;; handlers - #:parse-handler-url - #:*website* - #:website - #:website-name - #:website-hosts - #:website-authorizer - #:website-show-page - #:website-show-error-page - #:website-handler-definitions - #:website-admin-navigation - #:website-navigation - #:website-menu - #:website-url - #:website-session-info - #:website-base-href - #:website-make-path - #:website-rss-feed-url - #:host - #:publish-site - #:publish-handler - - #:handle-object - #:handle-object-form - #:handle-form - #:object-handler-object-class - #:object-handler-get-object - - #:bknr-authorizer - #:find-user-from-request-parameters - #: - #:handle - #:object-handler - #:edit-object-handler - #:template-handler - #:page-handler - #:page-handler-prefix - #:page-handler-site - #:page-handler-url - #:authorized-p - #:admin-only-handler - #:prefix-handler - #:form-handler - #:login-handler - #:logout-handler - #:redirect-handler - #:directory-handler - #:file-handler - - #:keyword-handler - #:keywords-handler - - #:rss-handler - - #:define-bknr-webserver-module - - #:ensure-form-field - #:form-field-missing-condition - #:form-field-missing-condition-field - - #:handler-path - #:decoded-handler-path - - ;; misc tags xxx should be revised xxx - #:next-days-list - #:previous-days-list - #:reset-results - - ;; choice (html menus) - #:make-choice - #:choice-link - #:choice-title - #:choice-submenu - - ;; object-list-handler - #:object-list-handler - #:object-list-handler-get-objects - #:object-list-handler-title - #:object-list-handler-rss-link - #:object-list-handler-show-object-xml - #:object-date-list-handler - #:object-date-list-handler-grouped-objects - #:object-date-list-handler-date - - ;; xml-object-handler - #:xml-object-handler - #:xml-object-handler-show-object - #:xml-object-list-handler - #:xml-image-browser-handler - - ;; blob-handler - #:blob-handler - - ;; sessions - #:bknr-session - #:bknr-session-user - #:bknr-session-start-time - #:bknr-session-last-used - #:bknr-session-variables - - #:http-session - #:http-session-host - #:host-name - #:bknr-request-user - #:bknr-request - #:bknr-request-session - #:*session* - #:anonymous-session - - ;; site - #:*default-billboard* - #:*thumbnail-max-height* - #:*thumbnail-max-width* - #:*user-spool-directory-root* - - ;; import-handler - #:import-handler - #:import-handler-spool-dir - #:import-handler-spool-files - #:import-handler-import-files - #:import-handler-import-pathname)) - -(defpackage :bknr.images - (:use :cl - :cl-user - :cl-gd - :cl-interpol - :cl-ppcre - :net.aserve - :puri - :xhtml-generator - :bknr.rss - :bknr.web - :bknr.datastore - :bknr.indices - :bknr.utils - :bknr.user) - (:shadowing-import-from :cl-interpol #:quote-meta-chars) - (:import-from :net.html.generator #:*html-stream*) - (:export #:imageproc - #:define-imageproc-handler - #:image-handler ; plain images only - #:imageproc-handler ; image with processing - - #:banner ; tag to display the site's banner image - #:user-image - #:user-images - - #:parse-color - #:get-keyword-store-images - #:get-keywords-intersection-store-images - - #:emit-image-to-browser - #:image-collection - #:image-keyword-choose-dialog - #:image-thumbnail-page - - #:store-image-with-name - - #:store-image - #:make-store-image - #:with-store-image - #:with-store-image* - #:with-store-image-from-id - #:image-type-keyword - - #:store-image-name - #:store-image-height - #:store-image-width - #:store-image-aspect-ratio - #:store-image-keywords - - #:emit-image-to-browser - - #:import-image)) - -(defpackage :bknr.site-menu - (:use :cl - :cl-user - :cxml - :bknr.web - :bknr.impex - :xhtml-generator)) Copied: branches/trunk-reorg/web/src/packages.lisp (from rev 2185, branches/trunk-reorg/datastore/src/packages.lisp) =================================================================== --- branches/trunk-reorg/datastore/src/packages.lisp 2007-10-04 16:18:54 UTC (rev 2185) +++ branches/trunk-reorg/web/src/packages.lisp 2007-10-04 16:25:24 UTC (rev 2188) @@ -0,0 +1,457 @@ +(in-package :cl-user) + +(defpackage :bknr.sysparams + (:use :cl :cl-user :bknr.indices :bknr.datastore) + (:export #:sysparam + #:set-sysparam)) + +(defpackage :bknr.htmlize + (:use :cl :cl-user :bknr.utils) + (:export #:to-html + #:htmlize-file + #:htmlize-string + #:htmlize)) + +(defpackage :bknr.cron + (:use :cl :cl-user :bknr.utils :bknr.indices :bknr.datastore) + (:export #:make-cron-job + #:cron-job-with-name + #:start-cron)) + +(defpackage :bknr.rss + (:use :cl :cl-user :cl-ppcre :bknr.utils :bknr.xml :puri :cxml-xmls :bknr.datastore :bknr.indices :cxml) + (:export #:xml-escape + #:*img-src-scanner* + #:*a-href-scanner* + #:*link-href-scanner* + #:replace-relative-links + #:make-absolute-url + + #:rss-to-xml + #:merge-feeds + + ;; channel + #:rss-channel + #:find-rss-channel + #:make-rss-channel + #:rss-channel-cleanup + #:rss-channel-about + #:rss-channel-title + #:rss-channel-link + #:rss-channel-desc + #:rss-channel-image + #:rss-channel-textinput + #:rss-channel-items + #:rss-channel-xml + + ;; image + #:rss-image + #:rss-image-about + #:rss-image-title + #:rss-image-url + #:rss-image-link + + ;; item + #:rss-item + #:rss-item-channel + #:rss-item-published + #:rss-item-pub-date + #:rss-item-title + #:rss-item-link + #:rss-item-description + #:rss-item-author + #:rss-item-category + #:rss-item-comments + #:rss-item-enclosure + #:rss-item-guid + #:rss-item-source + + ;; textinput + #:rss-textinput + #:rss-textinput-about + #:rss-textinput-title + #:rss-textinput-desc + #:rss-textinput-link + #:rss-textinput-name + + #:parse-rss091-feed + #:parse-rss10-feed + #:parse-rss20-feed + #:parse-atom-feed + + #:*base-url*)) + +(defpackage :bknr.events + (:use :cl + :xhtml-generator + :bknr.utils + :bknr.datastore + :cl-ppcre) + (:documentation "events framework, currently exports all defined symbols until refactoring") + (:export #:event + #:event-time + #:event-handler + #:event-argument + #:event-class-name + + #:make-event + #:find-events + #:all-events + + #:handle-event + #:generate-event-xml)) + +(defpackage :bknr.user + (:use :cl + :cl-user + :cl-interpol + :cl-ppcre + :md5 + :bknr.datastore + :bknr.indices + :bknr.utils + :bknr.events + :xhtml-generator) + (:shadowing-import-from :cl-interpol #:quote-meta-chars) + (:export #:user + + #:user-full-name + #:user-last-login + #:user-email + #:user-login + #:user-password + #:user-flags + #:user-preferences + #:user-subscriptions + #:user-editable-p + + ;; Export slot names so that derived classes can overload + ;; slots (e.g. to add XML impex attributes) + #:login + #:flags + #:email + #:full-name + #:last-login + #:password + #:preferences + #:subscriptions + #:mail-error + + #:find-user + #:user-with-email + #:admin-p + #:anonymous-p + + #:user-has-flag + #:user-add-flags + #:user-remove-flags + #:all-user-flags + #:define-user-flag + + #:user-reachable-by-mail-p + #:user-mail-error-p + #:verify-password + #:user-disabled + #:user-preferences + #:user-preference + #:set-user-preference + #:all-users + #:get-flag-users + #:make-user + #:delete-user + #:set-user-password + + #:set-user-last-login + + #:owned-object + #:owned-object-owners + #:store-objects-owned-by + + #:message-event)) + +(defpackage :bknr.web + (:use :cl + :cl-user + :cl-gd + :cl-interpol + :cl-ppcre + :net.aserve + :cxml-xmls + :xhtml-generator + :puri + :md5 + :js + :bknr.datastore + :bknr.indices + :bknr.impex + :bknr.utils + :bknr.xml + :bknr.events + :bknr.user) + (:shadowing-import-from :cl-interpol #:quote-meta-chars) + (:import-from :net.html.generator #:*html-stream*) + (:export #:*req* + #:*ent* + #:*user* + #:session-variable + #:request-variable + #:with-query-params + #:define-bknr-tag + #:with-bknr-page + #:cmslink + + #:web-server-log-event-referer + #:web-server-log-event-url + #:web-server-log-event-user-agent + + #:web-visitor-event-host + #:web-visitor-event-session-id + #:web-visitor-event-user + + #:web-server-error-event + #:web-server-error-event-error + #:all-web-server-error-events + + #:;; web-utils + #:*upload-file-size-limit* + #:all-request-params + #:request-uploaded-files + #:request-uploaded-file + #:query-param + #:query-param-list + #:cookie-value + #:http-error + #:keywords-from-query-param-list + #:html-quote + #:parse-url + #:parse-uri + #:text-to-html + #:make-wiki-hrefs + #:html-link + #:html-edit-link + #:object-url + #:edit-object-url + #:xmls-emit + #:emit-html + #:make-self-reference-url + #:html-warn + #:redirect + #:redirect-uri + #:emit-html + #:error-404 + #:encode-urlencoded + #:submit-button + #:text-field + #:textarea-field + #:checkbox-field + #:select-box + #:date-field + #:parse-date-field + #:keyword-choose-dialog + #:navi-button + #:with-bknr-http-response + + #:upload + #:upload-name + #:upload-pathname + #:upload-size + #:upload-content-type + + #:bknr-url-path + + ;; templates + #:expand-template + #:get-template-var + #:with-template-vars + #:emit-template-node + #:user-error + #:find-template-pathname + #:initial-template-environment + #:with-tag-expanders + + #:*html-variables* + #:*template-dtd-catalog* + + ;; handlers + #:parse-handler-url + #:*website* + #:website + #:website-name + #:website-hosts + #:website-authorizer + #:website-show-page + #:website-show-error-page + #:website-handler-definitions + #:website-admin-navigation + #:website-navigation + #:website-menu + #:website-url + #:website-session-info + #:website-base-href + #:website-make-path + #:website-rss-feed-url + #:host + #:publish-site + #:publish-handler + + #:handle-object + #:handle-object-form + #:handle-form + #:object-handler-object-class + #:object-handler-get-object + + #:bknr-authorizer + #:find-user-from-request-parameters + #: + #:handle + #:object-handler + #:edit-object-handler + #:template-handler + #:page-handler + #:page-handler-prefix + #:page-handler-site + #:page-handler-url + #:authorized-p + #:admin-only-handler + #:prefix-handler + #:form-handler + #:login-handler + #:logout-handler + #:redirect-handler + #:directory-handler + #:file-handler + + #:keyword-handler + #:keywords-handler + + #:rss-handler + + #:define-bknr-webserver-module + + #:ensure-form-field + #:form-field-missing-condition + #:form-field-missing-condition-field + + #:handler-path + #:decoded-handler-path + + ;; misc tags xxx should be revised xxx + #:next-days-list + #:previous-days-list + #:reset-results + + ;; choice (html menus) + #:make-choice + #:choice-link + #:choice-title + #:choice-submenu + + ;; object-list-handler + #:object-list-handler + #:object-list-handler-get-objects + #:object-list-handler-title + #:object-list-handler-rss-link + #:object-list-handler-show-object-xml + #:object-date-list-handler + #:object-date-list-handler-grouped-objects + #:object-date-list-handler-date + + ;; xml-object-handler + #:xml-object-handler + #:xml-object-handler-show-object + #:xml-object-list-handler + #:xml-image-browser-handler + + ;; blob-handler + #:blob-handler + + ;; sessions + #:bknr-session + #:bknr-session-user + #:bknr-session-start-time + #:bknr-session-last-used + #:bknr-session-variables + + #:http-session + #:http-session-host + #:host-name + #:bknr-request-user + #:bknr-request + #:bknr-request-session + #:*session* + #:anonymous-session + + ;; site + #:*default-billboard* + #:*thumbnail-max-height* + #:*thumbnail-max-width* + #:*user-spool-directory-root* + + ;; import-handler + #:import-handler + #:import-handler-spool-dir + #:import-handler-spool-files + #:import-handler-import-files + #:import-handler-import-pathname)) + +(defpackage :bknr.images + (:use :cl + :cl-user + :cl-gd + :cl-interpol + :cl-ppcre + :net.aserve + :puri + :xhtml-generator + :bknr.rss + :bknr.web + :bknr.datastore + :bknr.indices + :bknr.utils + :bknr.user) + (:shadowing-import-from :cl-interpol #:quote-meta-chars) + (:import-from :net.html.generator #:*html-stream*) + (:export #:imageproc + #:define-imageproc-handler + #:image-handler ; plain images only + #:imageproc-handler ; image with processing + + #:banner ; tag to display the site's banner image + #:user-image + #:user-images + + #:parse-color + #:get-keyword-store-images + #:get-keywords-intersection-store-images + + #:emit-image-to-browser + #:image-collection + #:image-keyword-choose-dialog + #:image-thumbnail-page + + #:store-image-with-name + + #:store-image + #:make-store-image + #:with-store-image + #:with-store-image* + #:with-store-image-from-id + #:image-type-keyword + + #:store-image-name + #:store-image-height + #:store-image-width + #:store-image-aspect-ratio + #:store-image-keywords + + #:emit-image-to-browser + + #:import-image)) + +(defpackage :bknr.site-menu + (:use :cl + :cl-user + :cxml + :bknr.web + :bknr.impex + :xhtml-generator)) Copied: branches/trunk-reorg/web/src/sysclasses (from rev 2185, branches/trunk-reorg/datastore/src/sysclasses) Added: branches/trunk-reorg/xhtmlgen/package.lisp =================================================================== --- branches/trunk-reorg/xhtmlgen/package.lisp 2007-10-04 16:20:09 UTC (rev 2187) +++ branches/trunk-reorg/xhtmlgen/package.lisp 2007-10-04 16:25:24 UTC (rev 2188) @@ -0,0 +1,9 @@ +(in-package :cl-user) + +(defpackage :xhtml-generator + (:use :common-lisp) + (:export #:html + #:html-stream + #:*html-sink* + #:set-string-encoding)) +

1 0

[bknr-cvs] r2187 - in branches/trunk-reorg: datastore/src web/src
by bknr＠bknr.net 04 Oct '07

04 Oct '07

Author: hhubner Date: 2007-10-04 12:20:09 -0400 (Thu, 04 Oct 2007) New Revision: 2187 Added: branches/trunk-reorg/web/src/bknr-web.asd Removed: branches/trunk-reorg/datastore/src/bknr-web.asd Log: checkpoint Deleted: branches/trunk-reorg/datastore/src/bknr-web.asd =================================================================== --- branches/trunk-reorg/datastore/src/bknr-web.asd 2007-10-04 16:19:28 UTC (rev 2186) +++ branches/trunk-reorg/datastore/src/bknr-web.asd 2007-10-04 16:20:09 UTC (rev 2187) @@ -1,133 +0,0 @@ -(in-package :cl-user) - -(defpackage :bknr.system - (:use :cl :asdf) - (:export :*bknr-directory*)) - -(in-package :bknr.system) - -(defparameter *bknr-directory* - (make-pathname :name nil :type nil :version nil - :defaults (parse-namestring *load-truename*))) - -(defsystem :bknr - :name "Baikonour - Base modules" - :author "Hans Huebner <hans(a)huebner.org>" - :author "Manuel Odendahl <manuel(a)bl0rg.net>" - :version "0" - :maintainer "Manuel Odendahl <manuel(a)bl0rg.net>" - :licence "BSD" - :description "Baikonour - Launchpad for LISP satellites - Base system" - - :depends-on (:cl-interpol - :cl-ppcre - :cl-gd - :aserve - ;:net.post-office - :md5 - :cxml - :unit-test - :bknr-utils - :bknr-xml - :puri - ;:stem - ;:mime - :klammerscript - :bknr-datastore - :bknr-data-impex - :kmrcl - :iconv - #+(not allegro) - :acl-compat) - - :components ((:file "packages") - - (:module "xhtmlgen" :components ((:file "xhtmlgen")) - :depends-on ("packages")) - - (:module "sysclasses" :components ((:file "event") - (:file "user" :depends-on ("event")) - (:file "cron") - (:file "sysparam")) - :depends-on ("xhtmlgen")) - - (:module "htmlize" :components ((:file "hyperspec") - (:file "htmlize" - :depends-on ("hyperspec"))) - :depends-on ("packages")) - - (:module "rss" :components ((:file "rss") - (:file "parse-xml") - (:file "parse-rss10" - :depends-on ("parse-xml" "rss")) - (:file "parse-rss091" - :depends-on ("parse-xml" "rss")) - (:file "parse-atom" - :depends-on ("parse-xml" "rss")) - (:file "parse-rss20" - :depends-on ("parse-xml" "rss"))) - :depends-on ("packages")) - - (:module "web" :components ((:file "site") - ;; data - (:file "host") - (:file "web-server-event" - :depends-on ("host")) - (:file "web-visitor" - :depends-on ("host")) - - ;; web stuff - (:file "tag-functions") - (:file "web-macros" - :depends-on ("site" - "tag-functions")) - (:file "sessions" - :depends-on ("web-macros" - "site")) - (:file "authorizer" - :depends-on ("sessions" - "host")) - (:file "web-utils" - :depends-on ("web-macros" - "sessions" - "site" - "handlers")) - (:file "menu" :depends-on ("web-macros")) - - ;; handlers - (:file "handlers" - :depends-on ("authorizer" - "web-macros" - "sessions" - "site")) - - (:file "templates" - :depends-on ("handlers")) - (:file "rss-handlers" - :depends-on ("handlers")) - - (:file "user-handlers" - :depends-on ("handlers")) - (:file "user-tags" - :depends-on ("handlers")) - - (:file "tags" - :depends-on ("handlers" - "templates" - "site" - "web-utils"))) - :depends-on ("sysclasses" "packages" "xhtmlgen" "rss")) - - (:module "images" :components ((:file "image") - - (:file "image-tags" :depends-on ("image")) - (:file "image-handlers" - :depends-on ("image-tags" "image")) - (:file "imageproc-handler" - :depends-on ("image-handlers")) - (:file "edit-image-handler" - :depends-on ("image-handlers")) - (:file "import-images-handler" - :depends-on ("image-tags" "image")) - (:file "session-image")) - :depends-on ("web")))) Copied: branches/trunk-reorg/web/src/bknr-web.asd (from rev 2185, branches/trunk-reorg/datastore/src/bknr-web.asd)

1 0

[bknr-cvs] r2186 - in branches/trunk-reorg: datastore web
by bknr＠bknr.net 04 Oct '07

04 Oct '07

Author: hhubner Date: 2007-10-04 12:19:28 -0400 (Thu, 04 Oct 2007) New Revision: 2186 Added: branches/trunk-reorg/web/etc/ Removed: branches/trunk-reorg/datastore/etc/ Log: checkpoint Copied: branches/trunk-reorg/web/etc (from rev 2185, branches/trunk-reorg/datastore/etc)

1 0

[bknr-cvs] r2185 - in branches/trunk-reorg: . datastore/experimental/xml-schema datastore/experimental/xml-schema/examples
by bknr＠bknr.net 04 Oct '07

04 Oct '07

Author: hhubner Date: 2007-10-04 12:18:54 -0400 (Thu, 04 Oct 2007) New Revision: 2185 Added: branches/trunk-reorg/datastore/ branches/trunk-reorg/web/ Removed: branches/trunk-reorg/bknr-web/ branches/trunk-reorg/bknr/ Modified: branches/trunk-reorg/datastore/experimental/xml-schema/examples/test-schema.xml branches/trunk-reorg/datastore/experimental/xml-schema/examples/test-schema2.xml branches/trunk-reorg/datastore/experimental/xml-schema/xml-schema.lisp Log: checkpoint Copied: branches/trunk-reorg/datastore (from rev 2184, branches/trunk-reorg/bknr) Modified: branches/trunk-reorg/datastore/experimental/xml-schema/examples/test-schema.xml =================================================================== --- branches/trunk-reorg/bknr/experimental/xml-schema/examples/test-schema.xml 2007-10-04 15:50:09 UTC (rev 2184) +++ branches/trunk-reorg/datastore/experimental/xml-schema/examples/test-schema.xml 2007-10-04 16:18:54 UTC (rev 2185) @@ -1,65 +1,65 @@ -<?xml version="1.0"?> -<xs:schema xmlns:xs="http://www.w3.org/2001/XMLSchema"> - <xs:element name="name" type="xs:string"/> - <xs:element name="qualification" type="xs:string"/> - <xs:element name="born" type="xs:date"/> - <xs:element name="dead" type="xs:date"/> - <xs:element name="isbn" type="xs:string"/> - <xs:attribute name="id" type="xs:ID"/> - <xs:attribute name="available" type="xs:boolean"/> - <xs:attribute name="lang" type="xs:language"/> - - <xs:element name="title"> - <xs:complexType> - <xs:simpleContent> - <xs:extension base="xs:string"> - <xs:attribute ref="lang"/> - </xs:extension> - </xs:simpleContent> - </xs:complexType> - </xs:element> - - <xs:element name="library"> - <xs:complexType> - <xs:sequence> - <xs:element ref="book" maxOccurs="unbounded"/> - </xs:sequence> - </xs:complexType> - </xs:element> - - <xs:element name="author"> - <xs:complexType> - <xs:sequence> - <xs:element ref="name"/> - <xs:element ref="born"/> - <xs:element ref="dead" minOccurs="0"/> - </xs:sequence> - <xs:attribute ref="id"/> - </xs:complexType> - </xs:element> - - <xs:element name="book"> - <xs:complexType> - <xs:sequence> - <xs:element ref="isbn"/> - <xs:element ref="title"/> - <xs:element ref="author" minOccurs="0" maxOccurs="unbounded"/> - <xs:element ref="character" minOccurs="0" maxOccurs="unbounded"/> - </xs:sequence> - <xs:attribute ref="id"/> - <xs:attribute ref="available"/> - </xs:complexType> - </xs:element> - - <xs:element name="character"> - <xs:complexType> - <xs:sequence> - <xs:element ref="name"/> - <xs:element ref="born"/> - <xs:element ref="qualification"/> - </xs:sequence> - <xs:attribute ref="id"/> - </xs:complexType> - </xs:element> - +<?xml version="1.0"?> +<xs:schema xmlns:xs="http://www.w3.org/2001/XMLSchema"> + <xs:element name="name" type="xs:string"/> + <xs:element name="qualification" type="xs:string"/> + <xs:element name="born" type="xs:date"/> + <xs:element name="dead" type="xs:date"/> + <xs:element name="isbn" type="xs:string"/> + <xs:attribute name="id" type="xs:ID"/> + <xs:attribute name="available" type="xs:boolean"/> + <xs:attribute name="lang" type="xs:language"/> + + <xs:element name="title"> + <xs:complexType> + <xs:simpleContent> + <xs:extension base="xs:string"> + <xs:attribute ref="lang"/> + </xs:extension> + </xs:simpleContent> + </xs:complexType> + </xs:element> + + <xs:element name="library"> + <xs:complexType> + <xs:sequence> + <xs:element ref="book" maxOccurs="unbounded"/> + </xs:sequence> + </xs:complexType> + </xs:element> + + <xs:element name="author"> + <xs:complexType> + <xs:sequence> + <xs:element ref="name"/> + <xs:element ref="born"/> + <xs:element ref="dead" minOccurs="0"/> + </xs:sequence> + <xs:attribute ref="id"/> + </xs:complexType> + </xs:element> + + <xs:element name="book"> + <xs:complexType> + <xs:sequence> + <xs:element ref="isbn"/> + <xs:element ref="title"/> + <xs:element ref="author" minOccurs="0" maxOccurs="unbounded"/> + <xs:element ref="character" minOccurs="0" maxOccurs="unbounded"/> + </xs:sequence> + <xs:attribute ref="id"/> + <xs:attribute ref="available"/> + </xs:complexType> + </xs:element> + + <xs:element name="character"> + <xs:complexType> + <xs:sequence> + <xs:element ref="name"/> + <xs:element ref="born"/> + <xs:element ref="qualification"/> + </xs:sequence> + <xs:attribute ref="id"/> + </xs:complexType> + </xs:element> + </xs:schema> \ No newline at end of file Modified: branches/trunk-reorg/datastore/experimental/xml-schema/examples/test-schema2.xml =================================================================== --- branches/trunk-reorg/bknr/experimental/xml-schema/examples/test-schema2.xml 2007-10-04 15:50:09 UTC (rev 2184) +++ branches/trunk-reorg/datastore/experimental/xml-schema/examples/test-schema2.xml 2007-10-04 16:18:54 UTC (rev 2185) @@ -1,47 +1,47 @@ -<?xml version="1.0"?> -<xs:schema xmlns:xs="http://www.w3.org/2001/XMLSchema"> - <xs:element name="library"> - <xs:complexType> - <xs:sequence> - <xs:element name="book" maxOccurs="unbounded"> - <xs:complexType> - <xs:sequence> - <xs:element name="isbn" type="xs:integer"/> - <xs:element name="title"> - <xs:complexType> - <xs:simpleContent> - <xs:extension base="xs:string"> - <xs:attribute name="lang" type="xs:language"/> - </xs:extension> - </xs:simpleContent> - </xs:complexType> - </xs:element> - <xs:element name="author" minOccurs="0" maxOccurs="unbounded"> - <xs:complexType> - <xs:sequence> - <xs:element name="name" type="xs:string"/> - <xs:element name="born" type="xs:date"/> - <xs:element name="dead" type="xs:date"/> - </xs:sequence> - <xs:attribute name="id" type="xs:ID"/> - </xs:complexType> - </xs:element> - <xs:element name="character" minOccurs="0" maxOccurs="unbounded"> - <xs:complexType> - <xs:sequence> - <xs:element name="name" type="xs:string"/> - <xs:element name="born" type="xs:date"/> - <xs:element name="qualification" type="xs:string"/> - </xs:sequence> - <xs:attribute name="id" type="xs:ID"/> - </xs:complexType> - </xs:element> - </xs:sequence> - <xs:attribute name="id" type="xs:ID"/> - <xs:attribute name="available" type="xs:boolean"/> - </xs:complexType> - </xs:element> - </xs:sequence> - </xs:complexType> - </xs:element> -</xs:schema> +<?xml version="1.0"?> +<xs:schema xmlns:xs="http://www.w3.org/2001/XMLSchema"> + <xs:element name="library"> + <xs:complexType> + <xs:sequence> + <xs:element name="book" maxOccurs="unbounded"> + <xs:complexType> + <xs:sequence> + <xs:element name="isbn" type="xs:integer"/> + <xs:element name="title"> + <xs:complexType> + <xs:simpleContent> + <xs:extension base="xs:string"> + <xs:attribute name="lang" type="xs:language"/> + </xs:extension> + </xs:simpleContent> + </xs:complexType> + </xs:element> + <xs:element name="author" minOccurs="0" maxOccurs="unbounded"> + <xs:complexType> + <xs:sequence> + <xs:element name="name" type="xs:string"/> + <xs:element name="born" type="xs:date"/> + <xs:element name="dead" type="xs:date"/> + </xs:sequence> + <xs:attribute name="id" type="xs:ID"/> + </xs:complexType> + </xs:element> + <xs:element name="character" minOccurs="0" maxOccurs="unbounded"> + <xs:complexType> + <xs:sequence> + <xs:element name="name" type="xs:string"/> + <xs:element name="born" type="xs:date"/> + <xs:element name="qualification" type="xs:string"/> + </xs:sequence> + <xs:attribute name="id" type="xs:ID"/> + </xs:complexType> + </xs:element> + </xs:sequence> + <xs:attribute name="id" type="xs:ID"/> + <xs:attribute name="available" type="xs:boolean"/> + </xs:complexType> + </xs:element> + </xs:sequence> + </xs:complexType> + </xs:element> +</xs:schema> Modified: branches/trunk-reorg/datastore/experimental/xml-schema/xml-schema.lisp =================================================================== --- branches/trunk-reorg/bknr/experimental/xml-schema/xml-schema.lisp 2007-10-04 15:50:09 UTC (rev 2184) +++ branches/trunk-reorg/datastore/experimental/xml-schema/xml-schema.lisp 2007-10-04 16:18:54 UTC (rev 2185) @@ -1,197 +1,197 @@ -(in-package :cl-user) - -;;; general helpers ;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defmacro awhen (test-form &rest then-forms) - `(let ((it ,test-form)) - (when it ,@then-forms))) - -(defmacro aif (pred then-form &optional else-form) - `(let ((it ,pred)) (if it ,then-form ,else-form))) - -(defun string-null (string) - (string-equal string "")) - -(defconstant +whitespace-chars+ - '(#\Space #\Newline #\Tab #\Linefeed)) - -(defun whitespace-char-p (c) - (member c +whitespace-chars+)) - -(defun whitespace-p (c-or-s) - (cond ((stringp c-or-s) - (every #'whitespace-char-p c-or-s)) - ((characterp c-or-s) - (whitespace-char-p c-or-s)) - (t nil))) - -(defun make-keyword-from-string (string) - (if (keywordp string) - string - (nth-value 0 (intern (string-upcase - (substitute-if #\- #'(lambda (char) - (or (whitespace-char-p char) - (eql #\: char))) - string)) 'keyword)))) - - -;;; cxml helpers ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun child-elements (node) - (coerce (remove-if-not #'dom:element-p (dom:child-nodes node)) 'list)) - -(defmacro with-attributes (attributes node &rest body) - `(let ,(loop for attr in attributes - when (symbolp attr) - collect `(,attr (dom:get-attribute ,node ,(string-downcase (symbol-name attr)))) - when (listp attr) - collect `(,(car attr) (dom:get-attribute ,node ,(cadr attr)))) - ,@(loop for attr in attributes - when (symbolp attr) - collect `(when (string-null ,attr) - (error ,(format nil "Attribute ~S is empty." - (string-downcase (symbol-name attr))))) - when (listp attr) - collect `(when (string-null ,(car attr)) - (error ,(format nil "Attribute ~S is empty." (cadr attr))))) - ,@body)) - - -;;; xml schema parser ;;;;;;;;;;;;;;;;;;;;;;;;; - -;;; element and attribute environment - -(defvar *xml-schema-envs* nil - "This special variables holds the list of the current xml schema -element definition environments. Environments can be nested, the list -holds them in top to bottom order (the toplevel environment is first.") - -(defun get-xml-schema-ref (ref) - "Get the definition of REF from the current environment stack." - (dolist (env *xml-schema-envs*) - (awhen (gethash ref env) - (return it)))) - -(defun (setf get-xml-schema-ref) (newvalue ref) - "Set the definition of REF in the current environment." - (let ((env (first *xml-schema-envs*))) - (awhen (gethash ref env) - (error "There already is an XML Schema element named ~A: ~A." ref it)) - (setf (gethash ref env) newvalue))) - -;;; xml schema types - -(defgeneric parse-xs-type (type elt) - (:documentation "Parse ELT according to TYPE. TYPE can be a keyword -to identify base datatypes, or a class derived from XS-TYPE.")) - -(defmacro define-xs-type (name (elt) &rest body) - "Define a base XML Schema type, named by a keyword. For example, -\"xs:string\" is identified by :XS-STRING." - (let ((n (gensym))) - `(defmethod parse-xs-type (,(if (keywordp name) - `(,n (eql ,name)) - name) - ,elt) - ,@body))) - -(defmacro define-xs-type-error (name (elt) &rest body) - "Define the default error function called when ELT could not be -parsed as a value of type NAME." - `(define-xs-type ,name ((,elt t)) - ,@body)) - -;;; Einfach XML Schema typen, wie primitive Types, einfach Elements -;;; und Attributes werden direkt zu Lisp primitive geparst. - -(define-xs-type :xs-string ((elt dom-impl::text)) - (dom:node-value elt)) - -(define-xs-type :xs-string ((elt dom-impl::node)) - (let ((children (dom:child-nodes elt))) - (if (and (= (length children) 1) - (dom:text-node-p (aref children 0))) - (dom:node-value (aref children 0)) - ""))) - -(define-xs-type-error :xs-string (elt) - (error "~s could not be parsed as xs:string." elt)) - -(defclass xs-elt () - ((name :initarg :name :initform nil :reader xs-elt-name) - (type :initarg :type :initform nil :reader xs-elt-type))) - -(defun create-xs-elt (node) - (unless (= (length (dom:child-nodes node)) 0) - (error "~a is not a simple XML Scheme element node." node)) - (with-attributes (name type) node - (setf (get-xml-schema-ref name) - (make-instance 'xs-elt - :name name - :type (make-keyword-from-string type))))) - -(defclass xs-attribute (xs-elt) - ()) - -(defun create-xs-attribute (node) - (unless (= (length (dom:child-nodes node)) 0) - (error "~a is not an XML Scheme attribute node." node)) - (with-attributes (name type) node - (setf (get-xml-schema-ref name) - (make-instance 'xs-attribute - :name name - :type (make-keyword-from-string type))))) - -(define-xs-type (type xs-elt) (elt) - (parse-xs-type (xs-elt-type type) elt)) - - -(defclass xs-complex-type (xs-type) - ((attrs :initarg :attrs :reader xs-ctype-attrs) - (children :initarg :children :reader xs-ctype-children) - (content :initarg :content :reader xs-ctype-content))) - - -(defclass xs-element () - ((name :initarg :name :reader xs-type-name) - (type :initarg :type :reader xs-type-type))) - -(defun xs-attribute-p (node) - (string-equal (dom:node-name node) "xs:attribute")) - -(defun xs-element-p (node) - (string-equal (dom:node-name node) "xs:element")) - -(defun xs-simple-type-p (node) - (or (xs-attribute-p node) - (and (xs-element-p node) - (null (child-elements node))))) - -(defun xs-complex-type-p (node) - (let ((children (child-elements node))) - (and (xs-element-p node) - (not (null children)) - (let ((child (first children))) - (string-equal (dom:node-name node) - "xs:complexType"))))) - -(defun parse-schema-node (elt) - (cond ((xs-attribute-p elt) - (create-xs-attribute elt)) - ((xs-simple-type-p elt) - (create-xs-simple-type elt)) - #+nil - ((xs-complex-type-p elt) - (create-xs-complex-type elt)) - (t (error "Unknown top-level XML Schema node: ~A." (dom:node-name elt))))) - -(defun parse-schema-file (filename) - "Returns the toplevel XML schema environment." - (let* ((dom (cxml:parse-file filename (dom:make-dom-builder))) - (root (dom:document-element dom)) - (*xml-schema-envs* (list (make-hash-table)))) - (unless (string-equal (dom:node-name root) "xs:schema") - (error "Document is not an XML Schema document.")) - (dolist (elt (child-elements root)) - (parse-schema-node elt)) +(in-package :cl-user) + +;;; general helpers ;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defmacro awhen (test-form &rest then-forms) + `(let ((it ,test-form)) + (when it ,@then-forms))) + +(defmacro aif (pred then-form &optional else-form) + `(let ((it ,pred)) (if it ,then-form ,else-form))) + +(defun string-null (string) + (string-equal string "")) + +(defconstant +whitespace-chars+ + '(#\Space #\Newline #\Tab #\Linefeed)) + +(defun whitespace-char-p (c) + (member c +whitespace-chars+)) + +(defun whitespace-p (c-or-s) + (cond ((stringp c-or-s) + (every #'whitespace-char-p c-or-s)) + ((characterp c-or-s) + (whitespace-char-p c-or-s)) + (t nil))) + +(defun make-keyword-from-string (string) + (if (keywordp string) + string + (nth-value 0 (intern (string-upcase + (substitute-if #\- #'(lambda (char) + (or (whitespace-char-p char) + (eql #\: char))) + string)) 'keyword)))) + + +;;; cxml helpers ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun child-elements (node) + (coerce (remove-if-not #'dom:element-p (dom:child-nodes node)) 'list)) + +(defmacro with-attributes (attributes node &rest body) + `(let ,(loop for attr in attributes + when (symbolp attr) + collect `(,attr (dom:get-attribute ,node ,(string-downcase (symbol-name attr)))) + when (listp attr) + collect `(,(car attr) (dom:get-attribute ,node ,(cadr attr)))) + ,@(loop for attr in attributes + when (symbolp attr) + collect `(when (string-null ,attr) + (error ,(format nil "Attribute ~S is empty." + (string-downcase (symbol-name attr))))) + when (listp attr) + collect `(when (string-null ,(car attr)) + (error ,(format nil "Attribute ~S is empty." (cadr attr))))) + ,@body)) + + +;;; xml schema parser ;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; element and attribute environment + +(defvar *xml-schema-envs* nil + "This special variables holds the list of the current xml schema +element definition environments. Environments can be nested, the list +holds them in top to bottom order (the toplevel environment is first.") + +(defun get-xml-schema-ref (ref) + "Get the definition of REF from the current environment stack." + (dolist (env *xml-schema-envs*) + (awhen (gethash ref env) + (return it)))) + +(defun (setf get-xml-schema-ref) (newvalue ref) + "Set the definition of REF in the current environment." + (let ((env (first *xml-schema-envs*))) + (awhen (gethash ref env) + (error "There already is an XML Schema element named ~A: ~A." ref it)) + (setf (gethash ref env) newvalue))) + +;;; xml schema types + +(defgeneric parse-xs-type (type elt) + (:documentation "Parse ELT according to TYPE. TYPE can be a keyword +to identify base datatypes, or a class derived from XS-TYPE.")) + +(defmacro define-xs-type (name (elt) &rest body) + "Define a base XML Schema type, named by a keyword. For example, +\"xs:string\" is identified by :XS-STRING." + (let ((n (gensym))) + `(defmethod parse-xs-type (,(if (keywordp name) + `(,n (eql ,name)) + name) + ,elt) + ,@body))) + +(defmacro define-xs-type-error (name (elt) &rest body) + "Define the default error function called when ELT could not be +parsed as a value of type NAME." + `(define-xs-type ,name ((,elt t)) + ,@body)) + +;;; Einfach XML Schema typen, wie primitive Types, einfach Elements +;;; und Attributes werden direkt zu Lisp primitive geparst. + +(define-xs-type :xs-string ((elt dom-impl::text)) + (dom:node-value elt)) + +(define-xs-type :xs-string ((elt dom-impl::node)) + (let ((children (dom:child-nodes elt))) + (if (and (= (length children) 1) + (dom:text-node-p (aref children 0))) + (dom:node-value (aref children 0)) + ""))) + +(define-xs-type-error :xs-string (elt) + (error "~s could not be parsed as xs:string." elt)) + +(defclass xs-elt () + ((name :initarg :name :initform nil :reader xs-elt-name) + (type :initarg :type :initform nil :reader xs-elt-type))) + +(defun create-xs-elt (node) + (unless (= (length (dom:child-nodes node)) 0) + (error "~a is not a simple XML Scheme element node." node)) + (with-attributes (name type) node + (setf (get-xml-schema-ref name) + (make-instance 'xs-elt + :name name + :type (make-keyword-from-string type))))) + +(defclass xs-attribute (xs-elt) + ()) + +(defun create-xs-attribute (node) + (unless (= (length (dom:child-nodes node)) 0) + (error "~a is not an XML Scheme attribute node." node)) + (with-attributes (name type) node + (setf (get-xml-schema-ref name) + (make-instance 'xs-attribute + :name name + :type (make-keyword-from-string type))))) + +(define-xs-type (type xs-elt) (elt) + (parse-xs-type (xs-elt-type type) elt)) + + +(defclass xs-complex-type (xs-type) + ((attrs :initarg :attrs :reader xs-ctype-attrs) + (children :initarg :children :reader xs-ctype-children) + (content :initarg :content :reader xs-ctype-content))) + + +(defclass xs-element () + ((name :initarg :name :reader xs-type-name) + (type :initarg :type :reader xs-type-type))) + +(defun xs-attribute-p (node) + (string-equal (dom:node-name node) "xs:attribute")) + +(defun xs-element-p (node) + (string-equal (dom:node-name node) "xs:element")) + +(defun xs-simple-type-p (node) + (or (xs-attribute-p node) + (and (xs-element-p node) + (null (child-elements node))))) + +(defun xs-complex-type-p (node) + (let ((children (child-elements node))) + (and (xs-element-p node) + (not (null children)) + (let ((child (first children))) + (string-equal (dom:node-name node) + "xs:complexType"))))) + +(defun parse-schema-node (elt) + (cond ((xs-attribute-p elt) + (create-xs-attribute elt)) + ((xs-simple-type-p elt) + (create-xs-simple-type elt)) + #+nil + ((xs-complex-type-p elt) + (create-xs-complex-type elt)) + (t (error "Unknown top-level XML Schema node: ~A." (dom:node-name elt))))) + +(defun parse-schema-file (filename) + "Returns the toplevel XML schema environment." + (let* ((dom (cxml:parse-file filename (dom:make-dom-builder))) + (root (dom:document-element dom)) + (*xml-schema-envs* (list (make-hash-table)))) + (unless (string-equal (dom:node-name root) "xs:schema") + (error "Document is not an XML Schema document.")) + (dolist (elt (child-elements root)) + (parse-schema-node elt)) (pop *xml-schema-envs*))) \ No newline at end of file Copied: branches/trunk-reorg/web (from rev 2184, branches/trunk-reorg/bknr-web)

1 0

[bknr-cvs] r2184 - in branches/trunk-reorg: . bknr/experimental bknr-web bknr-web/src
by bknr＠bknr.net 04 Oct '07

04 Oct '07

Author: hhubner Date: 2007-10-04 11:50:09 -0400 (Thu, 04 Oct 2007) New Revision: 2184 Added: branches/trunk-reorg/bknr-web/site/ branches/trunk-reorg/bknr-web/src/images/ branches/trunk-reorg/bknr/experimental/dump-core.lisp Removed: branches/trunk-reorg/bknr-web/images/ branches/trunk-reorg/bknr-web/src/xhtmlgen/ branches/trunk-reorg/site/ Log: More reorganization Added: branches/trunk-reorg/bknr/experimental/dump-core.lisp =================================================================== --- branches/trunk-reorg/bknr/experimental/dump-core.lisp 2007-10-04 15:45:02 UTC (rev 2183) +++ branches/trunk-reorg/bknr/experimental/dump-core.lisp 2007-10-04 15:50:09 UTC (rev 2184) @@ -0,0 +1,34 @@ +(in-package :bknr.datastore) + +(defun save-cmucl-clean-slime-debugger () + "Called in *after-save-initializations* because cores dumped +when slime is running has this bound. TODO" + (format t "~&clearing debugger hook (~A)" cl:*debugger-hook*) + (setf cl:*debugger-hook* nil)) + +(defun save-cmucl-close-fd-handlers () + (loop for handler in lisp::*descriptor-handlers* + when (> (lisp::handler-descriptor handler) 2) + do (SYSTEM:REMOVE-FD-HANDLER handler))) + +(defun save-cmucl-inits (corefilepath) + "called in the child process" + (save-cmucl-close-fd-handlers) + (mp::shutdown-multi-processing) + (when cl:*debugger-hook* + (warn "CHILD: setting debugger-hook to NIL") + (setf cl:*debugger-hook* nil) ; does not work! + (pushnew 'save-cmucl-clean-slime-debugger ext:*after-save-initializations*)) + (pushnew 'system::reinitialize-global-table ext:*after-save-initializations*) + (ext:save-lisp corefilepath) + (warn "CHILD: strangely survived. killing.") + (unix:unix-exit 1)) + +(defun snapshot-core (&optional (corefilepath "/tmp/bknr.core")) + (cond ((zerop (unix:unix-fork)) + (save-cmucl-inits corefilepath)) + (t (alien:alien-funcall + (alien:extern-alien "wait" + (alien:function alien:unsigned alien:unsigned)) + 0))) + (warn "PARENT saved")) Copied: branches/trunk-reorg/bknr-web/site (from rev 2182, branches/trunk-reorg/site) Copied: branches/trunk-reorg/bknr-web/src/images (from rev 2183, branches/trunk-reorg/bknr-web/images)

1 0

[bknr-cvs] r2183 - in branches/trunk-reorg: . bknr/src bknr-web bknr-web/src bknr-web/src/xhtmlgen
by bknr＠bknr.net 04 Oct '07

04 Oct '07

Author: hhubner Date: 2007-10-04 11:45:02 -0400 (Thu, 04 Oct 2007) New Revision: 2183 Added: branches/trunk-reorg/bknr-web/ branches/trunk-reorg/bknr-web/images/ branches/trunk-reorg/bknr-web/src/ branches/trunk-reorg/bknr-web/src/html-match/ branches/trunk-reorg/bknr-web/src/htmlize/ branches/trunk-reorg/bknr-web/src/rss/ branches/trunk-reorg/bknr-web/src/web/ branches/trunk-reorg/bknr-web/src/xhtmlgen/ branches/trunk-reorg/bknr/src/bknr-web.asd branches/trunk-reorg/xhtmlgen/ Removed: branches/trunk-reorg/bknr-web/src/xhtmlgen/xhtmlgen.lisp branches/trunk-reorg/bknr/src/bknr.asd branches/trunk-reorg/bknr/src/html-match/ branches/trunk-reorg/bknr/src/htmlize/ branches/trunk-reorg/bknr/src/images/ branches/trunk-reorg/bknr/src/js/ branches/trunk-reorg/bknr/src/rss/ branches/trunk-reorg/bknr/src/web/ branches/trunk-reorg/bknr/src/xhtmlgen/ Log: began reorganizing the source tree so that the store components are seperated from the web cruft. Copied: branches/trunk-reorg/bknr/src/bknr-web.asd (from rev 2181, trunk/bknr/src/bknr.asd) Deleted: branches/trunk-reorg/bknr/src/bknr.asd =================================================================== --- branches/trunk-reorg/bknr/src/bknr.asd 2007-10-04 15:39:18 UTC (rev 2182) +++ branches/trunk-reorg/bknr/src/bknr.asd 2007-10-04 15:45:02 UTC (rev 2183) @@ -1,133 +0,0 @@ -(in-package :cl-user) - -(defpackage :bknr.system - (:use :cl :asdf) - (:export :*bknr-directory*)) - -(in-package :bknr.system) - -(defparameter *bknr-directory* - (make-pathname :name nil :type nil :version nil - :defaults (parse-namestring *load-truename*))) - -(defsystem :bknr - :name "Baikonour - Base modules" - :author "Hans Huebner <hans(a)huebner.org>" - :author "Manuel Odendahl <manuel(a)bl0rg.net>" - :version "0" - :maintainer "Manuel Odendahl <manuel(a)bl0rg.net>" - :licence "BSD" - :description "Baikonour - Launchpad for LISP satellites - Base system" - - :depends-on (:cl-interpol - :cl-ppcre - :cl-gd - :aserve - ;:net.post-office - :md5 - :cxml - :unit-test - :bknr-utils - :bknr-xml - :puri - ;:stem - ;:mime - :klammerscript - :bknr-datastore - :bknr-data-impex - :kmrcl - :iconv - #+(not allegro) - :acl-compat) - - :components ((:file "packages") - - (:module "xhtmlgen" :components ((:file "xhtmlgen")) - :depends-on ("packages")) - - (:module "sysclasses" :components ((:file "event") - (:file "user" :depends-on ("event")) - (:file "cron") - (:file "sysparam")) - :depends-on ("xhtmlgen")) - - (:module "htmlize" :components ((:file "hyperspec") - (:file "htmlize" - :depends-on ("hyperspec"))) - :depends-on ("packages")) - - (:module "rss" :components ((:file "rss") - (:file "parse-xml") - (:file "parse-rss10" - :depends-on ("parse-xml" "rss")) - (:file "parse-rss091" - :depends-on ("parse-xml" "rss")) - (:file "parse-atom" - :depends-on ("parse-xml" "rss")) - (:file "parse-rss20" - :depends-on ("parse-xml" "rss"))) - :depends-on ("packages")) - - (:module "web" :components ((:file "site") - ;; data - (:file "host") - (:file "web-server-event" - :depends-on ("host")) - (:file "web-visitor" - :depends-on ("host")) - - ;; web stuff - (:file "tag-functions") - (:file "web-macros" - :depends-on ("site" - "tag-functions")) - (:file "sessions" - :depends-on ("web-macros" - "site")) - (:file "authorizer" - :depends-on ("sessions" - "host")) - (:file "web-utils" - :depends-on ("web-macros" - "sessions" - "site" - "handlers")) - (:file "menu" :depends-on ("web-macros")) - - ;; handlers - (:file "handlers" - :depends-on ("authorizer" - "web-macros" - "sessions" - "site")) - - (:file "templates" - :depends-on ("handlers")) - (:file "rss-handlers" - :depends-on ("handlers")) - - (:file "user-handlers" - :depends-on ("handlers")) - (:file "user-tags" - :depends-on ("handlers")) - - (:file "tags" - :depends-on ("handlers" - "templates" - "site" - "web-utils"))) - :depends-on ("sysclasses" "packages" "xhtmlgen" "rss")) - - (:module "images" :components ((:file "image") - - (:file "image-tags" :depends-on ("image")) - (:file "image-handlers" - :depends-on ("image-tags" "image")) - (:file "imageproc-handler" - :depends-on ("image-handlers")) - (:file "edit-image-handler" - :depends-on ("image-handlers")) - (:file "import-images-handler" - :depends-on ("image-tags" "image")) - (:file "session-image")) - :depends-on ("web")))) Copied: branches/trunk-reorg/bknr-web/images (from rev 2181, trunk/bknr/src/images) Copied: branches/trunk-reorg/bknr-web/src/html-match (from rev 2181, trunk/bknr/src/html-match) Copied: branches/trunk-reorg/bknr-web/src/htmlize (from rev 2181, trunk/bknr/src/htmlize) Copied: branches/trunk-reorg/bknr-web/src/rss (from rev 2181, trunk/bknr/src/rss) Copied: branches/trunk-reorg/bknr-web/src/web (from rev 2181, trunk/bknr/src/web) Copied: branches/trunk-reorg/bknr-web/src/xhtmlgen (from rev 2181, trunk/bknr/src/xhtmlgen) Deleted: branches/trunk-reorg/bknr-web/src/xhtmlgen/xhtmlgen.lisp =================================================================== --- trunk/bknr/src/xhtmlgen/xhtmlgen.lisp 2007-10-04 15:27:54 UTC (rev 2181) +++ branches/trunk-reorg/bknr-web/src/xhtmlgen/xhtmlgen.lisp 2007-10-04 15:45:02 UTC (rev 2183) @@ -1,386 +0,0 @@ -;; xhtmlgen.lisp -;; This version by david(a)lichteblau.com for headcraft (http://headcraft.de/) -;; -;; Derived from htmlgen.cl: -;; copyright (c) 1986-2000 Franz Inc, Berkeley, CA -;; -;; This code is free software; you can redistribute it and/or -;; modify it under the terms of the version 2.1 of -;; the GNU Lesser General Public License as published by -;; the Free Software Foundation, as clarified by the AllegroServe -;; prequel found in license-allegroserve.txt. -;; -;; This code is distributed in the hope that it will be useful, -;; but without any warranty; without even the implied warranty of -;; merchantability or fitness for a particular purpose. See the GNU -;; Lesser General Public License for more details. -;; -;; Version 2.1 of the GNU Lesser General Public License is in the file -;; license-lgpl.txt that was distributed with this file. -;; If it is not present, you can access it from -;; http://www.gnu.org/copyleft/lesser.txt (until superseded by a newer -;; version) or write to the Free Software Foundation, Inc., 59 Temple Place, -;; Suite 330, Boston, MA 02111-1307 USA - -(in-package :xhtml-generator) - -;; fixme -(defvar *html-sink*) - -;; html generation - -(defstruct (html-process (:type list) (:constructor - make-html-process (key macro special - name-attr - ))) - key ; keyword naming this tag - macro ; the macro to define this - special ; if true then call this to process the keyword and return - ; the macroexpansion - name-attr ; attribute symbols which can name this object for subst purposes - ) - - -(defparameter *html-process-table* - (make-hash-table :test #'equal) ; #'eq is accurate but want to avoid rehashes - ) - -;; support for strings encoded in latin-1 or utf-8 on non-unicode lisps - -#-rune-is-character -(defun make-sink-for-utf8-strings (stream) - (cxml:make-recoder (cxml:make-character-stream-sink stream :canonical nil :indentation 3) - #'cxml::utf8-string-to-rod)) - -#-rune-is-character -(defun make-sink-for-latin1-strings (stream) - (cxml:make-recoder (cxml:make-character-stream-sink stream :canonical nil :indentation 3) - #'cxml::string-rod)) - -#-rune-is-character -(defvar *make-sink-for-internal-strings-fn* #'make-sink-for-utf8-strings) - -#-rune-is-character -(defun make-sink-for-internal-strings (stream) - (funcall *make-sink-for-internal-strings-fn* stream)) - -#-rune-is-character -(defun set-string-encoding (encoding) - (ecase encoding - (:latin-1 (setf *make-sink-for-internal-strings-fn* #'make-sink-for-latin1-strings)) - (:utf-8 (setf *make-sink-for-internal-strings-fn* #'make-sink-for-utf8-strings)))) - -(defmacro html (&rest forms &environment env) - ;; just emit html to the current stream - `(let ((*html-sink* (if (boundp '*html-sink*) - *html-sink* - #+rune-is-character - (cxml:make-character-stream-sink net.html.generator:*html-stream* :canonical nil :indentation 3) - #-rune-is-character - (make-sink-for-internal-strings net.html.generator:*html-stream*)))) - ,(process-html-forms forms env))) - -(defmacro html-stream (stream &rest forms &environment env) - `(let ((*html-sink* - #+rune-is-character - (cxml:make-character-stream-sink ,stream :canonical nil :indentation 3) - #-rune-is-character - (make-sink-for-internal-strings ,stream))) - ,(process-html-forms forms env))) - -(defun get-process (form) - (let ((ent (gethash form *html-process-table*))) - (unless ent - (error "unknown html keyword ~s" form)) - ent)) - -(defun process-html-forms (forms env) - (let (res) - (flet ((do-ent (ent args argsp body) - ;; ent is an html-process object associated with the - ;; html tag we're processing - ;; args is the list of values after the tag in the form - ;; ((:tag &rest args) ....) - ;; argsp is true if this isn't a singleton tag (i.e. it has - ;; a body) .. (:tag ...) or ((:tag ...) ...) - ;; body is the body if any of the form - ;; - (let ((special (html-process-special ent))) - (push (if special - (funcall special ent args argsp body) - `(,(html-process-macro ent) - ,args - ,(process-html-forms body env))) - res)))) - (do* ((xforms forms (cdr xforms)) - (form (car xforms) (car xforms))) - ((null xforms)) - - (setq form (macroexpand form env)) - - (if (atom form) - (typecase form - (keyword (do-ent (get-process form) nil nil nil)) - (string (push `(sax:characters *html-sink* ,form) res)) - (t (push form res))) - (let ((first (car form))) - (cond - ((keywordp first) - ;; (:xxx . body) form - (do-ent (get-process (car form)) nil t (cdr form))) - ((and (consp first) (keywordp (car first))) - ;; ((:xxx args ) . body) - (do-ent (get-process (caar form)) (cdr first) t (cdr form))) - (t - (push form res))))))) - `(progn ,@(nreverse res)))) - -(defun html-body-key-form (string-code args body) - (unless (evenp (length args)) - (error "attribute list ~S isn't even" args)) - `(let ((.tagname. ,string-code)) - (sax:start-element *html-sink* nil nil .tagname. - (list - ,@(loop - for (name value) on args by #'cddr - collect - `(sax:make-attribute - :qname ,(etypecase name - ; fixme: all attribute names converted to lower case, this won't work - ; all the time. - (symbol (string-downcase (symbol-name name))) - (string name)) - :value (format nil "~A" ,value) - :specified-p t)))) - ,@body - (sax:end-element *html-sink* nil nil .tagname.))) - -(defun emit-without-quoting (str) - ;; das ist fuer WPDISPLAY - (let ((s (cxml::chained-handler *html-sink*))) - (cxml::maybe-close-tag s) - (map nil (lambda (c) (cxml::write-rune (char-code c) s)) str))) - -(defun princ-http (val) - #+(or) - (warn "use of deprecated :PRINC (use :PRINC-SAFE instead?)") - (emit-without-quoting (princ-to-string val))) - -(defun prin1-http (val) - #+(or) - (warn "use of deprecated :PRIN1 (use :PRIN1-SAFE instead?)") - (emit-without-quoting (prin1-to-string val))) - -(defun princ-safe-http (val) - (sax:characters *html-sink* (princ-to-string val))) - -(defun prin1-safe-http (val) - (sax:characters *html-sink* (prin1-to-string val))) - - -;; -- defining how html tags are handled. -- -;; -;; most tags are handled in a standard way and the def-std-html -;; macro is used to define such tags -;; -;; Some tags need special treatment and def-special-html defines -;; how these are handled. The tags requiring special treatment -;; are the pseudo tags we added to control operations -;; in the html generator. -;; -;; -;; tags can be found in three ways: -;; :br - singleton, no attributes, no body -;; (:b "foo") - no attributes but with a body -;; ((:a href="foo") "balh") - attributes and body -;; - -(defmacro def-special-html (kwd fcn) - ;; kwd - the tag we're defining behavior for. - ;; fcn - function to compute the macroexpansion of a use of this - ;; tag. args to fcn are: - ;; ent - html-process object holding info on this tag - ;; args - list of attribute-values following tag - ;; argsp - true if there is a body in this use of the tag - ;; body - list of body forms. - `(setf (gethash ,kwd *html-process-table*) - (make-html-process ,kwd nil ,fcn nil))) - -(def-special-html :newline - #'(lambda (ent args argsp body) - (declare (ignore ent args argsp)) - (when body - (error "can't have a body with :newline -- body is ~s" body)) - (emit-without-quoting (string #\newline)))) - -(def-special-html :princ - #'(lambda (ent args argsp body) - (declare (ignore ent args argsp)) - `(progn ,@(mapcar #'(lambda (bod) - `(princ-http ,bod)) - body)))) - -(def-special-html :princ-safe - #'(lambda (ent args argsp body) - (declare (ignore ent args argsp)) - `(progn ,@(mapcar #'(lambda (bod) - `(princ-safe-http ,bod)) - body)))) - -(def-special-html :prin1 - #'(lambda (ent args argsp body) - (declare (ignore ent args argsp)) - `(progn ,@(mapcar #'(lambda (bod) - `(prin1-http ,bod)) - body)))) - -(def-special-html :prin1-safe - #'(lambda (ent args argsp body) - (declare (ignore ent args argsp)) - `(progn ,@(mapcar #'(lambda (bod) - `(prin1-safe-http ,bod)) - body)))) - -(def-special-html :comment - #'(lambda (ent args argsp body) - (declare (ignore ent args argsp body)) - `(warn ":COMMENT in html macro not supported yet"))) - -(defmacro def-std-html (kwd name-attrs) - (let ((mac-name (intern (format nil "~a-~a" :with-html kwd))) - (string-code (string-downcase (string kwd)))) - `(progn (setf (gethash ,kwd *html-process-table*) - (make-html-process ,kwd - ',mac-name - nil - ',name-attrs)) - (defmacro ,mac-name (args &rest body) - (html-body-key-form ,string-code args body))))) - -(def-std-html :a nil) -(def-std-html :abbr nil) -(def-std-html :acronym nil) -(def-std-html :address nil) -(def-std-html :applet nil) -(def-std-html :area nil) - -(def-std-html :b nil) -(def-std-html :base nil) -(def-std-html :basefont nil) -(def-std-html :bdo nil) -(def-std-html :bgsound nil) -(def-std-html :big nil) -(def-std-html :blink nil) -(def-std-html :blockquote nil) -(def-std-html :body nil) -(def-std-html :br nil) -(def-std-html :button nil) - -(def-std-html :caption nil) -(def-std-html :center nil) -(def-std-html :cite nil) -(def-std-html :code nil) -(def-std-html :col nil) -(def-std-html :colgroup nil) - -(def-std-html :dd nil) -(def-std-html :del nil) -(def-std-html :dfn nil) -(def-std-html :dir nil) -(def-std-html :div nil) -(def-std-html :dl nil) -(def-std-html :dt nil) - -(def-std-html :em nil) -(def-std-html :embed nil) - -(def-std-html :fieldset nil) -(def-std-html :font nil) -(def-std-html :form :name) -(def-std-html :frame nil) -(def-std-html :frameset nil) - -(def-std-html :h1 nil) -(def-std-html :h2 nil) -(def-std-html :h3 nil) -(def-std-html :h4 nil) -(def-std-html :h5 nil) -(def-std-html :h6 nil) -(def-std-html :head nil) -(def-std-html :hr nil) -(def-std-html :html nil) - -(def-std-html :i nil) -(def-std-html :iframe nil) -(def-std-html :ilayer nil) -(def-std-html :img :id) -(def-std-html :input nil) -(def-std-html :ins nil) -(def-std-html :isindex nil) - -(def-std-html :kbd nil) -(def-std-html :keygen nil) - -(def-std-html :label nil) -(def-std-html :layer nil) -(def-std-html :legend nil) -(def-std-html :li nil) -(def-std-html :link nil) -(def-std-html :listing nil) - -(def-std-html :map nil) -(def-std-html :marquee nil) -(def-std-html :menu nil) -(def-std-html :meta nil) -(def-std-html :multicol nil) - -(def-std-html :nobr nil) -(def-std-html :noembed nil) -(def-std-html :noframes nil) -(def-std-html :noscript nil) - -(def-std-html :object nil) -(def-std-html :ol nil) -(def-std-html :optgroup nil) -(def-std-html :option nil) - -(def-std-html :p nil) -(def-std-html :param nil) -(def-std-html :plaintext nil) -(def-std-html :pre nil) - -(def-std-html :q nil) - -(def-std-html :s nil) -(def-std-html :samp nil) -(def-std-html :script nil) -(def-std-html :select nil) -(def-std-html :server nil) -(def-std-html :small nil) -(def-std-html :spacer nil) -(def-std-html :span :id) -(def-std-html :strike nil) -(def-std-html :strong nil) -(def-std-html :style nil) -(def-std-html :sub nil) -(def-std-html :sup nil) - -(def-std-html :table :name) -(def-std-html :tbody nil) -(def-std-html :td nil) -(def-std-html :textarea nil) -(def-std-html :tfoot nil) -(def-std-html :th nil) -(def-std-html :thead nil) -(def-std-html :title nil) -(def-std-html :tr nil) -(def-std-html :tt nil) - -(def-std-html :u nil) -(def-std-html :ul nil) - -(def-std-html :var nil) - -(def-std-html :wbr nil) - -(def-std-html :xmp nil) Copied: branches/trunk-reorg/xhtmlgen (from rev 2181, trunk/bknr/src/xhtmlgen)

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

bknr-cvs October 2007