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@huebner.org>" - :author "Manuel Odendahl <manuel@bl0rg.net>" - :version "0" - :maintainer "Manuel Odendahl <manuel@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@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)