- bknr-cvs@common-lisp.net - mailman3.common-lisp.net

[bknr-cvs] ksprotte changed trunk/projects/bos/web/contract-tree.lisp
by BKNR Commits 15 Jul '08

15 Jul '08

Revision: 3440 Author: ksprotte URL: http://bknr.net/trac/changeset/3440 use contract-node-invalidate-timestamp for remove-contract U trunk/projects/bos/web/contract-tree.lisp Modified: trunk/projects/bos/web/contract-tree.lisp =================================================================== --- trunk/projects/bos/web/contract-tree.lisp 2008-07-15 10:03:24 UTC (rev 3439) +++ trunk/projects/bos/web/contract-tree.lisp 2008-07-15 10:07:07 UTC (rev 3440) @@ -9,8 +9,12 @@ (kml-req-count :initform 0 :accessor kml-req-count) (image-req-count :initform 0 :accessor image-req-count))) -(defun contract-node-set-timestamp-now (node) - (setf (timestamp node) (get-universal-time))) +(defun contract-node-invalidate-timestamp (node) + (let ((image (contract-node-find-corresponding-store-image node))) + (setf (timestamp node) + (if (and image (probe-file (blob-pathname image))) + (1+ (blob-timestamp image)) + (get-universal-time))))) (defun contract-node-timestamp-updater (contract) (lambda (node) (setf (timestamp node) @@ -102,7 +106,7 @@ (setf (placemark-contracts node) (delete contract (placemark-contracts node))) ;; mark intersecting children as dirty - (ensure-intersecting-children contract-tree geo-box #'contract-node-set-timestamp-now)))) + (ensure-intersecting-children contract-tree geo-box #'contract-node-invalidate-timestamp)))) (defun contract-tree-changed (contract-tree contract &key type) (case type

1 0

[bknr-cvs] ksprotte changed trunk/projects/bos/web/contract-tree.lisp
by BKNR Commits 15 Jul '08

15 Jul '08

Revision: 3439 Author: ksprotte URL: http://bknr.net/trac/changeset/3439 fixed contract-node timestamp behaviour the main problem was that (timestamp node) has to be computed by (max (timestamp node) (contract-date contract)) U trunk/projects/bos/web/contract-tree.lisp Modified: trunk/projects/bos/web/contract-tree.lisp =================================================================== --- trunk/projects/bos/web/contract-tree.lisp 2008-07-15 07:45:57 UTC (rev 3438) +++ trunk/projects/bos/web/contract-tree.lisp 2008-07-15 10:03:24 UTC (rev 3439) @@ -3,7 +3,7 @@ ;;; contract-node (defclass contract-node (node-extension) ((name :allocation :class :initform 'contract-node) - (timestamp :accessor timestamp) + (timestamp :accessor timestamp :initform 0) ; timestamp initially "very old" (placemark-contracts :initform nil :accessor placemark-contracts) (image :initform nil :accessor image) (kml-req-count :initform 0 :accessor kml-req-count) @@ -12,16 +12,22 @@ (defun contract-node-set-timestamp-now (node) (setf (timestamp node) (get-universal-time))) +(defun contract-node-timestamp-updater (contract) + (lambda (node) (setf (timestamp node) + (max (timestamp node) (contract-date contract))))) + (defun contract-node-find-corresponding-store-image (node) - (first (get-keyword-store-images (contract-node-keyword node)))) + (let ((store-images (get-keyword-store-images (contract-node-keyword node)))) + (when (< 1 (length store-images)) + (warn "~D store-images for ~S" (length store-images) node)) + (first store-images))) (defmethod initialize-instance :after ((node contract-node) &key args) (declare (ignore args)) (let ((image (contract-node-find-corresponding-store-image node))) - (if (and image (probe-file (blob-pathname image))) - (setf (image node) image - (timestamp node) (blob-timestamp image)) - (contract-node-set-timestamp-now node)))) + (when (and image (probe-file (blob-pathname image))) + (setf (image node) image + (timestamp node) (blob-timestamp image))))) (defvar *contract-tree* nil) (defparameter *contract-tree-images-size* 128) ; was 256 @@ -78,11 +84,13 @@ (defun insert-contract (contract-tree contract) (let ((geo-box (contract-geo-box contract)) (geo-center (contract-geo-center contract))) - (ensure-intersecting-children contract-tree geo-box #'contract-node-set-timestamp-now) - (let ((placemark-node (find-node-if (lambda (node) (contract-placemark-at-node-p node contract)) - contract-tree - :prune-test (lambda (node) - (not (geo-point-in-box-p (geo-box node) geo-center)))))) + (ensure-intersecting-children contract-tree geo-box + (contract-node-timestamp-updater contract)) + (let ((placemark-node (find-node-if + (lambda (node) (contract-placemark-at-node-p node contract)) + contract-tree + :prune-test (lambda (node) + (not (geo-point-in-box-p (geo-box node) geo-center)))))) (assert placemark-node) (push contract (placemark-contracts placemark-node))))) @@ -289,9 +297,9 @@ (dolist (contract (class-instances 'contract)) (when (contract-published-p contract) (insert-contract *contract-tree* contract))) - (format t "~&rendering contract-tree images if needed...") + (format t "~&rendering contract-tree images if needed...") (force-output) (map-nodes #'contract-node-update-image-if-needed *contract-tree*) - (format t "done.~%") + (format t "done.~%") (force-output) (geometry:register-rect-subscriber geometry:*rect-publisher* *contract-tree* (list 0 0 +width+ +width+) #'contract-tree-changed))

1 0

[bknr-cvs] ksprotte changed trunk/projects/bos/web/contract-tree.lisp
by BKNR Commits 15 Jul '08

15 Jul '08

Revision: 3438 Author: ksprotte URL: http://bknr.net/trac/changeset/3438 contract-tree small refactoring U trunk/projects/bos/web/contract-tree.lisp Modified: trunk/projects/bos/web/contract-tree.lisp =================================================================== --- trunk/projects/bos/web/contract-tree.lisp 2008-07-14 18:10:10 UTC (rev 3437) +++ trunk/projects/bos/web/contract-tree.lisp 2008-07-15 07:45:57 UTC (rev 3438) @@ -9,6 +9,9 @@ (kml-req-count :initform 0 :accessor kml-req-count) (image-req-count :initform 0 :accessor image-req-count))) +(defun contract-node-set-timestamp-now (node) + (setf (timestamp node) (get-universal-time))) + (defun contract-node-find-corresponding-store-image (node) (first (get-keyword-store-images (contract-node-keyword node)))) @@ -18,7 +21,7 @@ (if (and image (probe-file (blob-pathname image))) (setf (image node) image (timestamp node) (blob-timestamp image)) - (setf (timestamp node) (get-universal-time))))) + (contract-node-set-timestamp-now node)))) (defvar *contract-tree* nil) (defparameter *contract-tree-images-size* 128) ; was 256 @@ -75,8 +78,7 @@ (defun insert-contract (contract-tree contract) (let ((geo-box (contract-geo-box contract)) (geo-center (contract-geo-center contract))) - (ensure-intersecting-children contract-tree geo-box - (lambda (node) (setf (timestamp node) (get-universal-time)))) + (ensure-intersecting-children contract-tree geo-box #'contract-node-set-timestamp-now) (let ((placemark-node (find-node-if (lambda (node) (contract-placemark-at-node-p node contract)) contract-tree :prune-test (lambda (node) @@ -92,8 +94,7 @@ (setf (placemark-contracts node) (delete contract (placemark-contracts node))) ;; mark intersecting children as dirty - (ensure-intersecting-children contract-tree geo-box - (lambda (node) (setf (timestamp node) (get-universal-time))))))) + (ensure-intersecting-children contract-tree geo-box #'contract-node-set-timestamp-now)))) (defun contract-tree-changed (contract-tree contract &key type) (case type @@ -232,7 +233,6 @@ (cl-gd:with-image (cl-gd:*default-image* image-size image-size t) (setf (cl-gd:save-alpha-p) t (cl-gd:alpha-blending-p) nil) - ;; (cl-gd:draw-rectangle* 0 0 127 127 :filled nil :color (cl-gd:find-color 255 0 0)) (let ((transparent (cl-gd:find-color 255 255 255 :alpha 127)) (subbox (make-geo-box 0d0 0d0 0d0 0d0))) (cl-gd:do-rows (y)

1 0

[bknr-cvs] ksprotte changed trunk/projects/bos/web/contract-tree.lisp
by BKNR Commits 14 Jul '08

14 Jul '08

Revision: 3437 Author: ksprotte URL: http://bknr.net/trac/changeset/3437 improved the way contract-tree uses store-images for caching U trunk/projects/bos/web/contract-tree.lisp Modified: trunk/projects/bos/web/contract-tree.lisp =================================================================== --- trunk/projects/bos/web/contract-tree.lisp 2008-07-14 14:33:26 UTC (rev 3436) +++ trunk/projects/bos/web/contract-tree.lisp 2008-07-14 18:10:10 UTC (rev 3437) @@ -3,12 +3,23 @@ ;;; contract-node (defclass contract-node (node-extension) ((name :allocation :class :initform 'contract-node) - (timestamp :accessor timestamp :initform (get-universal-time)) + (timestamp :accessor timestamp) (placemark-contracts :initform nil :accessor placemark-contracts) (image :initform nil :accessor image) (kml-req-count :initform 0 :accessor kml-req-count) (image-req-count :initform 0 :accessor image-req-count))) +(defun contract-node-find-corresponding-store-image (node) + (first (get-keyword-store-images (contract-node-keyword node)))) + +(defmethod initialize-instance :after ((node contract-node) &key args) + (declare (ignore args)) + (let ((image (contract-node-find-corresponding-store-image node))) + (if (and image (probe-file (blob-pathname image))) + (setf (image node) image + (timestamp node) (blob-timestamp image)) + (setf (timestamp node) (get-universal-time))))) + (defvar *contract-tree* nil) (defparameter *contract-tree-images-size* 128) ; was 256 @@ -199,9 +210,18 @@ ;; contract-images are stored as store-images. The image slot of ;; contract-node points to the current store-image. -(defun contract-node-store-image-name (node) - (format nil "contract-node~{~D~}" (node-path node))) +(defun contract-node-keyword (node) + "Used to relate NODE to its store-image." + (intern (format nil "CONTRACT-NODE~{~D~}" (node-path node)) #.(find-package "KEYWORD"))) +(defun contract-node-store-image-name (node old-store-image) + "Used only as a placeholder for store-image-name that always +has to be unique." + (let ((next-internal-id (if old-store-image + (store-object-id old-store-image) + 0))) + (format nil "contract-node~{~d~}_~D" (node-path node) next-internal-id))) + (defun contract-node-update-image (node) (labels ((find-contract-color (contract) (destructuring-bind (r g b) @@ -226,15 +246,21 @@ (if (and contract (contract-paidp contract)) (find-contract-color contract) transparent)))))))) - (let* ((image-name (contract-node-store-image-name node)) - (old-store-image (store-image-with-name image-name))) - (when old-store-image (delete-object old-store-image)) - (setf (image node) - (make-store-image :name image-name - :type :png))))))) + (let* ((keyword (contract-node-keyword node)) + (old-store-image (contract-node-find-corresponding-store-image node)) + (new-store-image (make-store-image :name (contract-node-store-image-name node old-store-image) + :type :png + :keywords (list keyword)))) + ;; activate new-store-image + (setf (image node) new-store-image) + ;; delete the old one + (when old-store-image + (delete-file (blob-pathname old-store-image)) + (delete-object old-store-image))))))) (defun contract-node-update-image-if-needed (node) (when (or (null (image node)) + (not (probe-file (blob-pathname (image node)))) (> (timestamp node) (blob-timestamp (image node)))) (contract-node-update-image node))) @@ -263,10 +289,9 @@ (dolist (contract (class-instances 'contract)) (when (contract-published-p contract) (insert-contract *contract-tree* contract))) - (format t "~&rendering contract-tree images...") + (format t "~&rendering contract-tree images if needed...") (map-nodes #'contract-node-update-image-if-needed *contract-tree*) - (format t "done.~%") - (bknr.datastore::delete-orphaned-blob-files nil) + (format t "done.~%") (geometry:register-rect-subscriber geometry:*rect-publisher* *contract-tree* (list 0 0 +width+ +width+) #'contract-tree-changed))

1 0

[bknr-cvs] hans changed trunk/
by BKNR Commits 14 Jul '08

14 Jul '08

Revision: 3436 Author: hans URL: http://bknr.net/trac/changeset/3436 Some small cmucl fixes. U trunk/bknr/datastore/src/utils/acl-mp-compat.lisp U trunk/bknr/modules/mail/smtp-server.lisp U trunk/thirdparty/closure-common/closure-common.asd U trunk/thirdparty/slime/swank-cmucl.lisp Modified: trunk/bknr/datastore/src/utils/acl-mp-compat.lisp =================================================================== --- trunk/bknr/datastore/src/utils/acl-mp-compat.lisp 2008-07-14 14:18:51 UTC (rev 3435) +++ trunk/bknr/datastore/src/utils/acl-mp-compat.lisp 2008-07-14 14:33:26 UTC (rev 3436) @@ -8,8 +8,10 @@ (mp:make-process-lock :name name) #+sbcl (sb-thread:make-mutex :name name) - #+cmu + #+(and cmu x86) (mp:make-lock name) + #+(and cmu (not x86)) + (declare (ignore name)) #+openmcl (ccl:make-lock name) #+lispworks Modified: trunk/bknr/modules/mail/smtp-server.lisp =================================================================== --- trunk/bknr/modules/mail/smtp-server.lisp 2008-07-14 14:18:51 UTC (rev 3435) +++ trunk/bknr/modules/mail/smtp-server.lisp 2008-07-14 14:33:26 UTC (rev 3436) @@ -87,14 +87,10 @@ (defun handle-smtp-client (client-socket) (handle-session (make-instance 'smtp-client :socket client-socket))) -#+cmu (defun smtp-server (&key (port 2525)) - (let ((server-socket (socket:make-socket :connect :passive :local-port port :reuse-address t))) - (unwind-protect - (loop - (let* ((client-socket (socket:accept-connection server-socket))) - (unwind-protect - (handle-smtp-client client-socket) - (close client-socket)))) - (format t ";; smtp server finished, closing~%") - (close server-socket)))) + (usocket:with-socket-listener (server-socket :local-port port :reuse-address t) + (loop + (let* ((client-socket (usocket:socket-accept server-socket))) + (unwind-protect + (handle-smtp-client client-socket) + (close client-socket)))))) Modified: trunk/thirdparty/closure-common/closure-common.asd =================================================================== --- trunk/thirdparty/closure-common/closure-common.asd 2008-07-14 14:18:51 UTC (rev 3435) +++ trunk/thirdparty/closure-common/closure-common.asd 2008-07-14 14:33:26 UTC (rev 3436) @@ -26,7 +26,7 @@ #+rune-is-character (error "conflicting unicode configuration. Please recompile.") (pushnew :rune-is-integer *features*)) - ((code-char 70000) + ((ignore-errors (code-char 70000)) (when (test #xD800) (format t " WARNING: Lisp implementation doesn't use UTF-16, ~ but accepts surrogate code points.~%")) Modified: trunk/thirdparty/slime/swank-cmucl.lisp =================================================================== --- trunk/thirdparty/slime/swank-cmucl.lisp 2008-07-14 14:18:51 UTC (rev 3435) +++ trunk/thirdparty/slime/swank-cmucl.lisp 2008-07-14 14:33:26 UTC (rev 3436) @@ -74,7 +74,7 @@ ;;; `:SPAWN' are reasonable alternatives. (defimplementation preferred-communication-style () - :sigio) + :fd-handler) #-(or darwin mips) (defimplementation create-socket (host port)

1 0

[bknr-cvs] hans changed trunk/thirdparty/hunchentoot/set-timeouts.lisp
by BKNR Commits 14 Jul '08

14 Jul '08

Revision: 3435 Author: hans URL: http://bknr.net/trac/changeset/3435 Add SET-TIMEOUTS implementation for CMUCL U trunk/thirdparty/hunchentoot/set-timeouts.lisp Modified: trunk/thirdparty/hunchentoot/set-timeouts.lisp =================================================================== --- trunk/thirdparty/hunchentoot/set-timeouts.lisp 2008-07-14 12:59:06 UTC (rev 3434) +++ trunk/thirdparty/hunchentoot/set-timeouts.lisp 2008-07-14 14:18:51 UTC (rev 3435) @@ -63,6 +63,9 @@ #+:sbcl (setf (sb-impl::fd-stream-timeout (usocket:socket-stream usocket)) (coerce read-timeout 'single-float)) - #-(or :clisp :allegro :openmcl :sbcl :lispworks) + #+:cmu + (setf (lisp::fd-stream-timeout (usocket:socket-stream usocket)) + (coerce read-timeout 'integer)) + #-(or :clisp :allegro :openmcl :sbcl :lispworks :cmu) (not-implemented 'set-timeouts))

1 0

[bknr-cvs] hans changed trunk/thirdparty/slime/
by BKNR Commits 14 Jul '08

14 Jul '08

Revision: 3434 Author: hans URL: http://bknr.net/trac/changeset/3434 update slime for cmucl-20 support U trunk/thirdparty/slime/CVS/Entries U trunk/thirdparty/slime/contrib/CVS/Entries U trunk/thirdparty/slime/doc/CVS/Entries Modified: trunk/thirdparty/slime/CVS/Entries =================================================================== --- trunk/thirdparty/slime/CVS/Entries 2008-07-14 12:00:51 UTC (rev 3433) +++ trunk/thirdparty/slime/CVS/Entries 2008-07-14 12:59:06 UTC (rev 3434) @@ -2,34 +2,34 @@ D/doc//// /swank-loader.lisp/1.85/Result of merge// /swank-openmcl.lisp/1.125/Mon May 12 18:52:05 2008// -/.cvsignore/1.5/Mon Jun 30 06:11:05 2008// -/ChangeLog/1.1367/Wed Jul 9 05:10:01 2008// -/HACKING/1.9/Mon Jun 30 06:11:05 2008// -/NEWS/1.9/Mon Jun 30 06:11:05 2008// -/PROBLEMS/1.8/Mon Jun 30 06:11:05 2008// -/README/1.14/Mon Jun 30 06:11:05 2008// -/hyperspec.el/1.11/Mon Jun 30 06:11:05 2008// -/metering.lisp/1.4/Mon Jun 30 06:11:05 2008// -/mkdist.sh/1.7/Mon Jun 30 06:11:05 2008// -/nregex.lisp/1.4/Mon Jun 30 06:11:05 2008// -/sbcl-pprint-patch.lisp/1.1/Mon Jun 30 06:11:05 2008// -/slime-autoloads.el/1.5/Mon Jun 30 06:11:05 2008// -/slime.el/1.944/Wed Jul 9 05:10:01 2008// -/swank-abcl.lisp/1.49/Mon Jun 30 06:11:05 2008// -/swank-allegro.lisp/1.103/Wed Jul 9 05:10:01 2008// /swank-backend.lisp/1.133/Result of merge// -/swank-clisp.lisp/1.69/Mon Jun 30 06:11:05 2008// /swank-cmucl.lisp/1.181/Result of merge// -/swank-corman.lisp/1.16/Mon Jun 30 06:11:05 2008// -/swank-ecl.lisp/1.23/Mon Jun 30 06:11:05 2008// -/swank-gray.lisp/1.10/Mon Jun 30 06:11:05 2008// -/swank-lispworks.lisp/1.100/Wed Jul 9 05:10:01 2008// -/swank-sbcl.lisp/1.198/Wed Jul 9 05:10:01 2008// -/swank-scl.lisp/1.19/Mon Jun 30 06:11:05 2008// -/swank-source-file-cache.lisp/1.9/Mon Jun 30 06:11:05 2008// -/swank-source-path-parser.lisp/1.20/Mon Jun 30 06:11:05 2008// -/swank.asd/1.9/Mon Jun 30 06:11:05 2008// /swank.lisp/1.546/Result of merge// -/test-all.sh/1.2/Mon Jun 30 06:11:05 2008// -/test.sh/1.10/Mon Jun 30 06:11:05 2008// -/xref.lisp/1.2/Mon Jun 30 06:11:05 2008// +/.cvsignore/1.5/Thu Jul 10 09:46:55 2008// +/ChangeLog/1.1367/Thu Jul 10 09:46:55 2008// +/HACKING/1.9/Thu Jul 10 09:46:55 2008// +/NEWS/1.9/Thu Jul 10 09:46:55 2008// +/PROBLEMS/1.8/Thu Jul 10 09:46:55 2008// +/README/1.14/Thu Jul 10 09:46:55 2008// +/hyperspec.el/1.11/Thu Jul 10 09:46:55 2008// +/metering.lisp/1.4/Thu Jul 10 09:46:55 2008// +/mkdist.sh/1.7/Thu Jul 10 09:46:55 2008// +/nregex.lisp/1.4/Thu Jul 10 09:46:55 2008// +/sbcl-pprint-patch.lisp/1.1/Thu Jul 10 09:46:55 2008// +/slime-autoloads.el/1.5/Thu Jul 10 09:46:55 2008// +/slime.el/1.944/Thu Jul 10 09:46:55 2008// +/swank-abcl.lisp/1.49/Thu Jul 10 09:46:55 2008// +/swank-allegro.lisp/1.103/Thu Jul 10 09:46:55 2008// +/swank-clisp.lisp/1.69/Thu Jul 10 09:46:55 2008// +/swank-corman.lisp/1.16/Thu Jul 10 09:46:55 2008// +/swank-ecl.lisp/1.23/Thu Jul 10 09:46:55 2008// +/swank-gray.lisp/1.10/Thu Jul 10 09:46:55 2008// +/swank-lispworks.lisp/1.100/Thu Jul 10 09:46:55 2008// +/swank-sbcl.lisp/1.198/Thu Jul 10 09:46:55 2008// +/swank-scl.lisp/1.19/Thu Jul 10 09:46:55 2008// +/swank-source-file-cache.lisp/1.9/Thu Jul 10 09:46:55 2008// +/swank-source-path-parser.lisp/1.20/Thu Jul 10 09:46:55 2008// +/swank.asd/1.9/Thu Jul 10 09:46:55 2008// +/test-all.sh/1.2/Thu Jul 10 09:46:55 2008// +/test.sh/1.10/Thu Jul 10 09:46:55 2008// +/xref.lisp/1.2/Thu Jul 10 09:46:55 2008// Modified: trunk/thirdparty/slime/contrib/CVS/Entries =================================================================== --- trunk/thirdparty/slime/contrib/CVS/Entries 2008-07-14 12:00:51 UTC (rev 3433) +++ trunk/thirdparty/slime/contrib/CVS/Entries 2008-07-14 12:59:06 UTC (rev 3434) @@ -1,38 +1,38 @@ -/ChangeLog/1.107/Wed Jul 9 05:10:01 2008// -/README/1.3/Mon Jun 30 06:11:05 2008// -/bridge.el/1.1/Mon Jun 30 06:11:05 2008// -/inferior-slime.el/1.2/Mon Jun 30 06:11:05 2008// -/slime-asdf.el/1.3/Mon Jun 30 06:11:05 2008// -/slime-autodoc.el/1.8/Mon Jun 30 06:11:05 2008// -/slime-banner.el/1.4/Mon Jun 30 06:11:05 2008// -/slime-c-p-c.el/1.9/Mon Jun 30 06:11:05 2008// -/slime-editing-commands.el/1.6/Mon Jun 30 06:11:05 2008// -/slime-fancy-inspector.el/1.3/Mon Jun 30 06:11:05 2008// -/slime-fancy.el/1.5/Mon Jun 30 06:11:05 2008// -/slime-fuzzy.el/1.7/Mon Jun 30 06:11:05 2008// -/slime-highlight-edits.el/1.3/Mon Jun 30 06:11:05 2008// -/slime-indentation.el/1.2/Mon Jun 30 06:11:05 2008// -/slime-motd.el/1.1/Mon Jun 30 06:11:05 2008// -/slime-parse.el/1.11/Wed Jul 9 05:10:02 2008// -/slime-presentation-streams.el/1.2/Mon Jun 30 06:11:05 2008// -/slime-presentations.el/1.15/Mon Jun 30 06:11:05 2008// -/slime-references.el/1.4/Mon Jun 30 06:11:05 2008// -/slime-scheme.el/1.1/Mon Jun 30 06:11:05 2008// -/slime-scratch.el/1.4/Mon Jun 30 06:11:05 2008// -/slime-tramp.el/1.3/Mon Jun 30 06:11:05 2008// -/slime-typeout-frame.el/1.6/Mon Jun 30 06:11:05 2008// -/slime-xref-browser.el/1.2/Mon Jun 30 06:11:05 2008// -/swank-arglists.lisp/1.21/Mon Jun 30 06:11:05 2008// -/swank-asdf.lisp/1.3/Wed Jul 9 05:10:02 2008// -/swank-c-p-c.lisp/1.2/Mon Jun 30 06:11:05 2008// -/swank-fancy-inspector.lisp/1.15/Mon Jun 30 06:11:05 2008// -/swank-fuzzy.lisp/1.8/Mon Jun 30 06:11:05 2008// -/swank-goo.goo/1.1/Mon Jun 30 06:11:05 2008// -/swank-indentation.lisp/1.1/Mon Jun 30 06:11:05 2008// -/swank-kawa.scm/1.7/Mon Jun 30 06:11:05 2008// -/swank-listener-hooks.lisp/1.1/Mon Jun 30 06:11:05 2008// -/swank-mit-scheme.scm/1.3/Mon Jun 30 06:11:05 2008// -/swank-motd.lisp/1.1/Mon Jun 30 06:11:05 2008// -/swank-presentation-streams.lisp/1.5/Mon Jun 30 06:11:05 2008// -/swank-presentations.lisp/1.5/Mon Jun 30 06:11:05 2008// +/ChangeLog/1.107/Thu Jul 10 09:46:55 2008// +/README/1.3/Thu Jul 10 09:46:55 2008// +/bridge.el/1.1/Thu Jul 10 09:46:55 2008// +/inferior-slime.el/1.2/Thu Jul 10 09:46:55 2008// +/slime-asdf.el/1.3/Thu Jul 10 09:46:55 2008// +/slime-autodoc.el/1.8/Thu Jul 10 09:46:55 2008// +/slime-banner.el/1.4/Thu Jul 10 09:46:55 2008// +/slime-c-p-c.el/1.9/Thu Jul 10 09:46:55 2008// +/slime-editing-commands.el/1.6/Thu Jul 10 09:46:55 2008// +/slime-fancy-inspector.el/1.3/Thu Jul 10 09:46:55 2008// +/slime-fancy.el/1.5/Thu Jul 10 09:46:55 2008// +/slime-fuzzy.el/1.7/Thu Jul 10 09:46:55 2008// +/slime-highlight-edits.el/1.3/Thu Jul 10 09:46:55 2008// +/slime-indentation.el/1.2/Thu Jul 10 09:46:55 2008// +/slime-motd.el/1.1/Thu Jul 10 09:46:55 2008// +/slime-parse.el/1.11/Thu Jul 10 09:46:55 2008// +/slime-presentation-streams.el/1.2/Thu Jul 10 09:46:55 2008// +/slime-presentations.el/1.15/Thu Jul 10 09:46:55 2008// +/slime-references.el/1.4/Thu Jul 10 09:46:55 2008// +/slime-scheme.el/1.1/Thu Jul 10 09:46:55 2008// +/slime-scratch.el/1.4/Thu Jul 10 09:46:55 2008// +/slime-tramp.el/1.3/Thu Jul 10 09:46:55 2008// +/slime-typeout-frame.el/1.6/Thu Jul 10 09:46:55 2008// +/slime-xref-browser.el/1.2/Thu Jul 10 09:46:55 2008// +/swank-arglists.lisp/1.21/Thu Jul 10 09:46:55 2008// +/swank-asdf.lisp/1.3/Thu Jul 10 09:46:55 2008// +/swank-c-p-c.lisp/1.2/Thu Jul 10 09:46:55 2008// +/swank-fancy-inspector.lisp/1.15/Thu Jul 10 09:46:55 2008// +/swank-fuzzy.lisp/1.8/Thu Jul 10 09:46:55 2008// +/swank-goo.goo/1.1/Thu Jul 10 09:46:55 2008// +/swank-indentation.lisp/1.1/Thu Jul 10 09:46:55 2008// +/swank-kawa.scm/1.7/Thu Jul 10 09:46:55 2008// +/swank-listener-hooks.lisp/1.1/Thu Jul 10 09:46:55 2008// +/swank-mit-scheme.scm/1.3/Thu Jul 10 09:46:55 2008// +/swank-motd.lisp/1.1/Thu Jul 10 09:46:55 2008// +/swank-presentation-streams.lisp/1.5/Thu Jul 10 09:46:55 2008// +/swank-presentations.lisp/1.5/Thu Jul 10 09:46:55 2008// D Modified: trunk/thirdparty/slime/doc/CVS/Entries =================================================================== --- trunk/thirdparty/slime/doc/CVS/Entries 2008-07-14 12:00:51 UTC (rev 3433) +++ trunk/thirdparty/slime/doc/CVS/Entries 2008-07-14 12:59:06 UTC (rev 3434) @@ -1,9 +1,9 @@ -/.cvsignore/1.1/Mon Jun 30 06:11:01 2008// -/Makefile/1.12/Mon Jun 30 06:11:01 2008// -/slime-refcard.pdf/1.1/Mon Jun 30 06:11:01 2008// -/slime-refcard.tex/1.1/Mon Jun 30 06:11:01 2008// -/slime-small.eps/1.1/Mon Jun 30 06:11:01 2008// -/slime-small.pdf/1.1/Mon Jun 30 06:11:01 2008// -/slime.texi/1.64/Mon Jun 30 06:11:01 2008// -/texinfo-tabulate.awk/1.2/Mon Jun 30 06:11:01 2008// +/.cvsignore/1.1/Thu Jul 10 09:46:48 2008// +/Makefile/1.12/Thu Jul 10 09:46:48 2008// +/slime-refcard.pdf/1.1/Thu Jul 10 09:46:48 2008// +/slime-refcard.tex/1.1/Thu Jul 10 09:46:48 2008// +/slime-small.eps/1.1/Thu Jul 10 09:46:48 2008// +/slime-small.pdf/1.1/Thu Jul 10 09:46:48 2008// +/slime.texi/1.64/Thu Jul 10 09:46:48 2008// +/texinfo-tabulate.awk/1.2/Thu Jul 10 09:46:48 2008// D

1 0

[bknr-cvs] ksprotte changed trunk/projects/bos/web/contract-tree.lisp
by BKNR Commits 14 Jul '08

14 Jul '08

Revision: 3433 Author: ksprotte URL: http://bknr.net/trac/changeset/3433 contract-tree-image-handler uses :max-age 600 U trunk/projects/bos/web/contract-tree.lisp Modified: trunk/projects/bos/web/contract-tree.lisp =================================================================== --- trunk/projects/bos/web/contract-tree.lisp 2008-07-14 11:06:52 UTC (rev 3432) +++ trunk/projects/bos/web/contract-tree.lisp 2008-07-14 12:00:51 UTC (rev 3433) @@ -242,14 +242,16 @@ (defclass contract-tree-image-handler (page-handler) ()) -(defmethod handle ((handler contract-tree-image-handler)) +(defmethod handle ((handler contract-tree-image-handler)) (with-query-params (path) (let* ((path (parse-path path)) - (node (find-node-with-path *contract-tree* path)) - (image (image node))) + (node (find-node-with-path *contract-tree* path)) + (image (image node))) (hunchentoot:handle-if-modified-since (blob-timestamp image)) (with-store-image* (image) - (emit-image-to-browser cl-gd:*default-image* :png :date (blob-timestamp image)))))) + (emit-image-to-browser cl-gd:*default-image* :png + :date (blob-timestamp image) + :max-age 600))))) ;;; make-contract-tree-from-m2 (defun make-contract-tree-from-m2 ()

1 0

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

14 Jul '08

Revision: 3432 Author: ksprotte URL: http://bknr.net/trac/changeset/3432 bos start hunchentoot with :persistent-connections-p nil squid frontend does not seem to have a way to reuse the connection to the hunchentoot backend. U trunk/projects/bos/web/startup.lisp Modified: trunk/projects/bos/web/startup.lisp =================================================================== --- trunk/projects/bos/web/startup.lisp 2008-07-14 09:46:45 UTC (rev 3431) +++ trunk/projects/bos/web/startup.lisp 2008-07-14 11:06:52 UTC (rev 3432) @@ -46,7 +46,8 @@ (hunchentoot:stop-server *webserver*)) (setf *hunchentoot-default-external-format* (flex:make-external-format :utf-8 :eol-style :lf) hunchentoot:*rewrite-for-session-urls* nil) - (setq *webserver* (hunchentoot:start-server :port *port* #+not-yet :threaded #+not-yet (not debug))) + (setq *webserver* (hunchentoot:start-server :port *port* #+not-yet :threaded #+not-yet (not debug) + :persistent-connections-p nil)) (if start-frontend (start-frontend :host host :backend-port port :port frontend-port) (warn "frontend not started - to achieve this specify :start-frontend t"))

1 0

[bknr-cvs] ksprotte changed trunk/projects/bos/web/contract-tree.lisp
by BKNR Commits 14 Jul '08

14 Jul '08

Revision: 3431 Author: ksprotte URL: http://bknr.net/trac/changeset/3431 fixed CONTRACT-TREE-IMAGE-HANDLER U trunk/projects/bos/web/contract-tree.lisp Modified: trunk/projects/bos/web/contract-tree.lisp =================================================================== --- trunk/projects/bos/web/contract-tree.lisp 2008-07-14 09:43:17 UTC (rev 3430) +++ trunk/projects/bos/web/contract-tree.lisp 2008-07-14 09:46:45 UTC (rev 3431) @@ -229,8 +229,9 @@ (let* ((image-name (contract-node-store-image-name node)) (old-store-image (store-image-with-name image-name))) (when old-store-image (delete-object old-store-image)) - (make-store-image :name image-name - :type :png)))))) + (setf (image node) + (make-store-image :name image-name + :type :png))))))) (defun contract-node-update-image-if-needed (node) (when (or (null (image node)) @@ -245,10 +246,10 @@ (with-query-params (path) (let* ((path (parse-path path)) (node (find-node-with-path *contract-tree* path)) - (image (image node))) - (hunchentoot:handle-if-modified-since (timestamp image)) + (image (image node))) + (hunchentoot:handle-if-modified-since (blob-timestamp image)) (with-store-image* (image) - (emit-image-to-browser cl-gd:*default-image* :png :date (timestamp image)))))) + (emit-image-to-browser cl-gd:*default-image* :png :date (blob-timestamp image)))))) ;;; make-contract-tree-from-m2 (defun make-contract-tree-from-m2 ()

1 0