cl-who-devel August 2007

cl-who-devel@common-lisp.net

7 participants
5 discussions

[cl-who-devel] Re: (Str ... in attributes
by yazicivo＠ttnet.net.tr 28 Aug '07

28 Aug '07

> I have an incorrect output when using (str.... as the value of an attribute. > (Or is that not allowed?) You shouldn't be using STR/FMT/ESC for attribute values. See CL-WHO documentation related with the syntax. Regards.

2 1

[cl-who-devel] (Str ... in attributes
by helmut＠cybernetic-systems.de 26 Aug '07

26 Aug '07

Some problems with (str ... Version: $Header: /usr/local/cvsrep/cl-who/cl-who.asd,v 1.16 2007/05/28 18:31:31 edi Exp $ I have an incorrect output when using (str.... as the value of an attribute. (Or is that not allowed?) Helmut Example: CL-USER> (cl-who:with-html-output (*standard-output*) (:input :onmouseover (cl-who:str "style.border=\"thin solid black\";"))) Result NotSoOK:> <inputstyle.border="thin solid black"; onmouseover='style.border="thin solid black";' /> CL-USER> (cl-who:with-html-output (*standard-output*) (:input :onmouseover "style.border=\"thin solid black\";")) Result OK:> <input onmouseover='style.border="thin solid black";' /> Same with a variable: CL-USER> (let ((ot "style.border=\"thin solid black\";")) (cl-who:with-html-output (*standard-output*) (:input :onmouseover (cl-who:str ot)))) Result NotOK:> <inputstyle.border="thin solid black"; onmouseover='style.border="thin solid black";' /> CL-USER> (let ((ot "style.border=\"thin solid black\";")) (cl-who:with-html-output (*standard-output*) (:input :onmouseover ot))) Result OK:> <input onmouseover='style.border="thin solid black";' />

1 0

[cl-who-devel] case sensitivity
by Osei Poku 24 Aug '07

24 Aug '07

I am evaluating cl-who for the capability of generating svg documents. One issue I have encountered is the viewBox attribute of a top-level svg tag which appears to be case sensitive. so for example: (with-html-output (*standard-output* nil :indent t) (:svg :width "500" :height "400" :viewBox "0 0 1000 800" (:rect :x "1" :y "1" :width "600" :height "500" :fill "none" :stroke-width "4" :stroke "red")) nil) gives: <svg width='500' height='400' viewbox='0 0 1000 800'> <rect x='1' y='1' width='600' height='500' fill='none' stroke-width='4' stroke='red'/> </svg> which outputs a rectangle with some of the edges outside the viewable area instead of inside the viewable area. Ideally the point of viewbox is to scale all the coordinates used within the svg tag such that they fit in the specified width and height of the svg tag. Is there a clean way (other than special casing that tag) to create the case sensitive attribute? I am not sure why it is case-sensitive but the following viewers seem to recognize the camelCase version and not the all lowercase version. opera inkscape sketsa SVG graphics editor xara xtreme Thanks, -- Osei Poku

3 4

[cl-who-devel] Fwd: *downcase-tags-p* for attributes, setting *downcase-tags-p* for compile-time
by Dave Cooper 24 Aug '07

24 Aug '07

Hi, Has anyone else found it necessary to conditionalize the downcasing of attribute names, like what is currently done with regular tags? For example in the following bit of X3D: (with-html-output (*stream* nil :indent t) (:Shape (:Appearance (:Material :diffuseColor "0 1 0") ... ))) the diffuseColor attribute name needs to have its case preserved. Second question: the *downcase-tags-p* has to be set to nil at compile time. This is probably more of a general Lisp question and not so specific to cl-who, but what is the preferred way of setting a variable like this to a non-default value for the duration of compiling a file, similar to what one would do with a special variable at runtime with (let ((*downcase-tags-p* nil)) ...) or (let (*downcase-tags-p*) ...) ? I am hoping to find something less error-prone (and thread-unsafe) than this: ;; beginning of the file (eval-when (compile load eval) (setq *downcase-tags-p* nil)) ;; ... ;; end of the file (eval-when (compile load eval) (setq *downcase-tags-p* t)) ;; Thanks, -dave -- Dave Cooper, Head of Product Development, Genworks International dave(a)genworks.com, dave.genworks.com(skype) USA: 248-327-3253(o), 1-800-731-9220(toll-free) UK: +44 (0) 191 645 1699

2 1

[cl-who-devel] Heap corruption?
by John Thingstad 04 Aug '07

04 Aug '07

Below is a selection of code I have written and the output it generates. The part that function generates a nested list of lists for a tree control. My system runs under Huchentoot. I use Lispworks under Windows. The output looks good. I can run it approx 10 times in a row. Then something fails. Among the errors are: 1. MySQL: 2006 - connection lost 2. MySQL: "select * from blog-header where (id = 199)" selector just be one row 3. The browser dons't update at all. When I go back other pages show incorrect data. I have isolated it to navigate-blog, navigate-year and navigate-month functions. I tried completly rewiting it (this is the second version), but get the same problem. Any idea what is happening here? (defun remove-prefix (uri prefix) "Returns the prefix from an uri in search of a blog name. Big assumtion: Blog names consists only of latin characters." (let ((scanstring (concatenate 'string prefix "([A-Za-z]+)"))) (multiple-value-bind (dummy matchvector) (scan-to-strings scanstring uri) (declare (ignore dummy)) (if matchvector (svref matchvector 0) "")))) (defconstant *month-abbrev* (list "jan" "feb" "mar" "apr" "may" "jun" "jul" "aug" "sep" "oct" "nov" "dec")) (defun get-month-string (month) (nth (decf month) *month-abbrev*)) (defun extract-year (date-string) (parse-integer (subseq date-string 0 4))) (defun extract-month (date-string) (parse-integer (subseq date-string 5 7))) ;; Result format: ((year (month (date title url) ...) ...) ...) (defun make-navigate-list (item-list name) (let (last-year last-month year-list month-list result-list) (iter (for item in (reverse item-list)) (let* ((date-string (getf item :pub_time)) (year (extract-year date-string)) (month (extract-month date-string))) (when (or (not last-year) (< year last-year)) (setf last-year year) (setf last-month nil) (when month-list (push (reverse month-list) year-list)) (setf month-list nil) (when year-list (push (reverse year-list) result-list)) (setf year-list (list (format nil "~D" year)))) (when (or (not last-month) (< month last-month)) (setf last-month month) (when month-list (push (reverse month-list) year-list)) (setf month-list (list (get-month-string month)))) (push (list (subseq (getf item :pub_time) 0 10) (or (getf item :title) "") (format nil "~A?id=~D" name (getf item :id))) month-list))) (when month-list (push (reverse month-list) year-list)) (when year-list (push (reverse year-list) result-list)) (reverse result-list))) (defun navigate-month (month-list) (with-html-output-to-string (*standard-output* nil :prologue nil :indent t) (:li (:a :href (format nil "/~A/" (first month-list)) (fmt "~A" (first month-list))) (:ul (iter (for item in (rest month-list)) (htm (:li (:a :href (third item) (fmt "~A ~A" (first item) (second item)))))))))) (defun navigate-year (year-list) (with-html-output-to-string (*standard-output* nil :prologue nil :indent t) (:li (:a :href (format nil "/~A/" (first year-list)) (fmt "~A" (first year-list))) (iter (for month-list in (rest year-list)) (htm (:ul (fmt "~A" (navigate-month month-list)))))))) (defun navigate-blog (items name) (let ((navigate-list (make-navigate-list items name))) (with-html-output-to-string (*standard-output* nil :prologue nil :indent t) (:div :id "bloglist" (:ul :id "navigation" :class "foldertree" (iter (for year-list in navigate-list) (fmt "~A" (navigate-year year-list)))))))) (defun present-blog (blog) (let* ((item-id (or (and (get-parameter "id") (parse-integer (get-parameter "id"))) (latest-blog-item-id (getf blog :name)))) (item (get-blog-item item-id))) (with-html-output-to-string (*standard-output* nil :prologue t :indent t) (:html :xmlns "http://www.w3.org/1999/xhtml" (:head (:title (fmt "~A - ~A" (escape-string (getf blog :title)) (escape-string (getf item :title)))) (:link :href *blog-css-file* :rel "stylesheet" :type "text/css") (:link :href *tree-css-file* :rel "stylesheet" :type "text/css" :media "screen, projection") (:script :type "text/javascript" :src *tree-js-file* "")) (:body (:div :id "left-column" (:a :href *blog-homepage* "Blog home") (fmt "~A" (navigate-blog (get-items (getf blog :id)) (script-name)))) (:div :id "wrapper" (:div :id "header" (:h1 (escape-string (fmt "~A" (escape-string (getf blog :title)))))) (:div :id "main" (if item (htm (:h3 (fmt "~A" (escape-string (getf item :title)))) (:h4 (fmt "~A" (escape-string (getf item :pub_time)))) (:p (fmt "~A" (or (getf item :contents) "")))) (htm (:p (:em "This blog is empty!"))))))))))) (defun no-blog () (with-html-output-to-string (*standard-output* nil :prologue t :indent t) (:html :xmlns "http://www.w3.org/1999/xhtml" (:head (:title "Error") (:link :href *blog-css-file* :rel "stylesheet" :type "text/css")) (:body (:div :id "left-column" (:a :href *blog-homepage* "Blog home")) (:div :id "wrapper" (:div :id "header" (:h1 :class "middle" "Error!")) (:div :id "main" (:h2 :class "middle" "No such page") (:p :class "middle" "The blog that you requested does not exist!"))))))) (defun blog-page () (no-cache) (let ((blog (get-blog (remove-prefix (script-name) *blog-prefix*)))) (if blog (present-blog blog) (no-blog)))) ;;----------------------------------------------------------------------------------------------------------- Which generatates something like the following <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"> <html xmlns='http://www.w3.org/1999/xhtml'> <head> <title>Many Items blog - Tomorrow </title> <link href='/static-files/stylesheet.css' rel='stylesheet' type='text/css' /> <link href='/static-files/foldertree.css' rel='stylesheet' type='text/css' media='screen, projection' /> <script type='text/javascript' src='/static-files/treeMenu.js'> </script> </head> <body> <div id='left-column'> <a href='/blogs.html'> Blog home </a> <div id='bloglist'> <ul id='navigation' class='foldertree'> <li> <a href='/2007/'>2007 </a> <ul> <li> <a href='/jul/'>jul </a> <ul> <li> <a href='/blogs/many?id=204'>2007-07-18 Tomorrow </a> </li> <li> <a href='/blogs/many?id=202'>2007-07-18 Tomorrow </a> </li> <li> <a href='/blogs/many?id=200'>2007-07-18 Tomorrow </a> </li> <li> <a href='/blogs/many?id=199'>2007-07-17 Today </a> </li> <li> <a href='/blogs/many?id=201'>2007-07-17 Today </a> </li> <li> <a href='/blogs/many?id=203'>2007-07-17 Today </a> </li> <li> <a href='/blogs/many?id=193'>2007-07-17 First item </a> </li> </ul> </li> </ul> <ul> <li> <a href='/jun/'>jun </a> <ul> <li> <a href='/blogs/many?id=198'>2007-06-12 Hollydays </a> </li> <li> <a href='/blogs/many?id=194'>2007-06-11 Second item </a> </li> </ul> </li> </ul> <ul> <li> <a href='/mar/'>mar </a> <ul> <li> <a href='/blogs/many?id=197'>2007-03-15 Easter </a> </li> </ul> </li> </ul> </li> <li> <a href='/2006/'>2006 </a> <ul> <li> <a href='/dec/'>dec </a> <ul> <li> <a href='/blogs/many?id=195'>2006-12-24 Christmas </a> </li> </ul> </li> </ul> <ul> <li> <a href='/mar/'>mar </a> <ul> <li> <a href='/blogs/many?id=196'>2006-03-14 Easter </a> </li> </ul> </li> </ul> </li> </ul> </div> </div> <div id='wrapper'> <div id='header'> <h1>Many Items blog </h1> </div> <div id='main'> <h3>Tomorrow </h3> <h4>2007-07-18 00:00:00 </h4> <p> </p> </div> </div> </body> </html>

1 1

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

cl-who-devel August 2007