[bknr-cvs] r2183 - in branches/trunk-reorg: . bknr/src bknr-web bknr-web/src bknr-web/src/xhtmlgen
bknr at bknr.net
bknr at bknr.net
Thu Oct 4 15:45:02 UTC 2007
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 at huebner.org>"
- :author "Manuel Odendahl <manuel at bl0rg.net>"
- :version "0"
- :maintainer "Manuel Odendahl <manuel at 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 at 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))))
- , at 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)
More information about the Bknr-cvs
mailing list