cells-cvs May 2008

cells-cvs@common-lisp.net

2 participants
14 discussions

[cells-cvs] CVS cells
by fgoenninger 24 May '08

24 May '08

Update of /project/cells/cvsroot/cells In directory clnet:/tmp/cvs-serv5681 Modified Files: fm-utilities.lisp Log Message: Added: CVS header info. --- /project/cells/cvsroot/cells/fm-utilities.lisp 2008/05/24 19:20:42 1.19 +++ /project/cells/cvsroot/cells/fm-utilities.lisp 2008/05/24 19:24:05 1.20 @@ -14,6 +14,7 @@ See the Lisp Lesser GNU Public License for more details. +$Header: /project/cells/cvsroot/cells/fm-utilities.lisp,v 1.20 2008/05/24 19:24:05 fgoenninger Exp $ |# (in-package :cells) @@ -723,5 +724,3 @@ (when (and self (fm-parent self)) (c-assert (member self (kids (fm-parent self)))) (position self (kids (fm-parent self))))) - -

1 0

[cells-cvs] CVS cells
by fgoenninger 24 May '08

24 May '08

Update of /project/cells/cvsroot/cells In directory clnet:/tmp/cvs-serv4521 Modified Files: fm-utilities.lisp Log Message: Changed: exporting all API symbols of fm-utilities. --- /project/cells/cvsroot/cells/fm-utilities.lisp 2008/04/11 09:19:31 1.18 +++ /project/cells/cvsroot/cells/fm-utilities.lisp 2008/05/24 19:20:42 1.19 @@ -18,14 +18,105 @@ (in-package :cells) -(defparameter *fmdbg* nil) +(eval-when (:compile-toplevel :load-toplevel :execute) + (export + '(;; Family member creation + make-part + mk-part + mk-part-spec + upper + ^u + container + container-typed + + ;; Family member finding + fm-descendant-typed + fm-ascendant-typed + fm-kid-named + fm-descendant-named + fm-ascendant-named + fm-ascendant-some + fm-ascendant-if + fm-descendant-if + fm-descendant-common + fm-collect-if + fm-collect-some + fm-value-dictionary + fm-max + fm-traverse + fm-traverse-bf + fm-ordered-p + sub-nodes + fm-ps-parent + with-like-fm-parts + do-like-fm-parts + true-that + fm-do-up + fm-gather + fm-find-all + fm-find-next + fm-find-next-within + fm-find-prior + fm-find-prior-within + fm-find-last-if + fm-prior-sib + fm-next-sib-if + fm-next-sib + ^fm-next-sib + fm-find-if + + ;; Family ordering + fm-kid-add + fm-kid-insert-last + fm-kid-insert-first + fm-kid-insert + fm-kid-remove + fm-quiesce-all + fm-kid-replace + + ;; Family high-order ops + fm-min-kid + fm-max-kid + fm-other + fmv + fm-otherx + fm-other-v + fm-otherv? + fm-other? + fm-other! + fm^ + fm? + fm! + fm!v + fm-other?! + fm-collect + fm-map + fm-mapc + fm-pos + fm-count-named + fm-top + fm-first-above + fm-nearest-if + fm-includes + fm-ancestor-p + fm-kid-containing + fm-ascendant-p + fm-find-one + fm-find-kid + fm-kid-typed + + ;; Other family stuff + make-name + name-root + name-subscript + kid-no + + ;; Debug flags + *fmdbg* + + ))) -(eval-when (compile eval load) - (export '(make-part mk-part fm-other fm-other? fm-traverse fm-descendant-typed - do-like-fm-parts - container-typed *fmdbg* fm-other-v fm! fm!v fm^ fm^v fm-find-one fm-kid-named - fm-prior-sib fm-ascendant-p fm-ordered-p - fm-value-dictionary fm-otherv?))) +(defparameter *fmdbg* nil) (defun make-part (partname part-class &rest initargs) ;;(trc "make-part > name class" partname partclass) @@ -42,11 +133,10 @@ (defmethod make-part-spec ((part model)) part) + (defmacro upper (self &optional (type t)) `(container-typed ,self ',type)) -(export! u^ fm-descendant-if) - (defmacro u^ (type) `(upper self ,type)) @@ -115,8 +205,6 @@ :with-dependency dependently) (nreverse collection))) -(export! fm-collect-some) - (defun fm-collect-some (tree test &optional skip-top dependently) (let (collection) (fm-traverse tree (lambda (node) @@ -173,7 +261,6 @@ (without-c-dependency (tv)))))) (values)) -(export! fm-traverse-bf) (defun fm-traverse-bf (family applied-fn &optional (cq (make-fifo-queue))) (when family (flet ((process-node (fm) @@ -260,8 +347,6 @@ ;; should be modified to go through 'gather', which should be the real fm-find-all ;; -(export! fm-do-up fm-find-next fm-find-prior) - (defun fm-do-up (self &optional (fn 'identity)) (when self (funcall fn self) @@ -454,8 +539,6 @@ :global-search t :test ,test)) -(export! fmv) - (defmacro fmv (name) `(value (fm-other ,name))) @@ -548,7 +631,6 @@ :must-find nil :global-search ,global-search))) ;--------------------------------------------------------------- -(export! fm-top) (defun fm-top (fm &optional (test #'true-that) &aux (fm-parent (fm-parent fm))) (cond ((null fm-parent) fm) ((not (funcall test fm-parent)) fm)

1 0

[cells-cvs] CVS triple-cells
by fgoenninger 22 May '08

22 May '08

Update of /project/cells/cvsroot/triple-cells In directory clnet:/tmp/cvs-serv13487 Modified Files: hello-world.lisp Log Message: Changed: Creating a triple store does not accept :if-does-not-exist any more (AllegroGraph Version 3). --- /project/cells/cvsroot/triple-cells/hello-world.lisp 2008/02/23 01:22:11 1.4 +++ /project/cells/cvsroot/triple-cells/hello-world.lisp 2008/05/22 13:23:11 1.5 @@ -92,8 +92,7 @@ (defun 3c-test-reopen () (close-triple-store) (open-triple-store "hello-world" - :directory (project-path) - :if-does-not-exist :error) + :directory (project-path)) (when (3c-integrity-managed?) (break "1")) (time (let ((dell (3c-find-id "dell"))

1 0

[cells-cvs] CVS triple-cells
by fgoenninger 22 May '08

22 May '08

Update of /project/cells/cvsroot/triple-cells In directory clnet:/tmp/cvs-serv13236 Added Files: triple-cells.asd Log Message: Added: ASDF system definition file for TRIPLE-CELLS. --- /project/cells/cvsroot/triple-cells/triple-cells.asd 2008/05/22 13:22:18 NONE +++ /project/cells/cvsroot/triple-cells/triple-cells.asd 2008/05/22 13:22:18 1.1 (asdf:defsystem #:triple-cells :name "triple-cells" :author "Kenny Tilton" :version "1.0" :licence "" :depends-on (#:cells) :serial t :components ((:file "defpackage") (:file "ag-utilities") (:file "3c-integrity") (:file "core") (:file "api") (:file "dataflow") (:file "observer") (:file "hello-world") (:file "read-me")))

1 0

[cells-cvs] CVS cells/utils-kt
by phildebrandt 21 May '08

21 May '08

Update of /project/cells/cvsroot/cells/utils-kt In directory clnet:/tmp/cvs-serv13158/utils-kt Added Files: .cvsignore Log Message: added a cvsignore in utils-kt --- /project/cells/cvsroot/cells/utils-kt/.cvsignore 2008/05/21 10:48:07 NONE +++ /project/cells/cvsroot/cells/utils-kt/.cvsignore 2008/05/21 10:48:07 1.1 core.fasl datetime.fasl debug.fasl defpackage.fasl detritus.fasl flow-control.fasl split-sequence.fasl strings.fasl

1 0

[cells-cvs] CVS cells
by phildebrandt 21 May '08

21 May '08

Update of /project/cells/cvsroot/cells In directory clnet:/tmp/cvs-serv13069 Modified Files: .cvsignore Log Message: changed cvsignore --- /project/cells/cvsroot/cells/.cvsignore 2008/02/11 14:48:09 1.1 +++ /project/cells/cvsroot/cells/.cvsignore 2008/05/21 10:47:41 1.2 @@ -1 +1,2 @@ cells.fasl cell-types.fasl constructors.fasl defmodel.fasl defpackage.fasl family.fasl family-values.fasl fm-utilities.fasl initialize.fasl integrity.fasl link.fasl md-slot-value.fasl md-utilities.fasl model-object.fasl propagate.fasl slot-utilities.fasl synapse.fasl synapse-types.fasl test-propagation.fasl trc-eko.fasl +cells-store.fasl

1 0

[cells-cvs] CVS cells
by phildebrandt 21 May '08

21 May '08

Update of /project/cells/cvsroot/cells In directory clnet:/tmp/cvs-serv12895 Modified Files: defmodel.lisp Log Message: added an eval-now! in defmodel to suppress SBCL warnings --- /project/cells/cvsroot/cells/defmodel.lisp 2008/04/23 03:20:09 1.20 +++ /project/cells/cvsroot/cells/defmodel.lisp 2008/05/21 10:46:52 1.21 @@ -54,73 +54,74 @@ ; ------- defclass --------------- (^slot-value ,model ',',slotname) ; - (prog1 - (defclass ,class ,(or directsupers '(model-object)) ;; now we can def the class - ,(mapcar (lambda (s) - (list* (car s) - (let ((ias (cdr s))) - (remf ias :persistable) - (remf ias :ps) - ;; We handle accessor below - (when (getf ias :cell t) - (remf ias :reader) - (remf ias :writer) - (remf ias :accessor)) - (remf ias :cell) - (remf ias :owning) - (remf ias :unchanged-if) - ias))) (mapcar #'copy-list slotspecs)) - (:documentation - ,@(or (cdr (find :documentation options :key #'car)) - '("chya"))) - (:default-initargs ;; nil ok and needed: acl oddity in re not clearing d-i's sans this - ,@(cdr (find :default-initargs options :key #'car))) - (:metaclass ,(or (cadr (find :metaclass options :key #'car)) - 'standard-class))) + (eval-now! ;; suppress style warning in SBCL + (prog1 + (defclass ,class ,(or directsupers '(model-object)) ;; now we can def the class + ,(mapcar (lambda (s) + (list* (car s) + (let ((ias (cdr s))) + (remf ias :persistable) + (remf ias :ps) + ;; We handle accessor below + (when (getf ias :cell t) + (remf ias :reader) + (remf ias :writer) + (remf ias :accessor)) + (remf ias :cell) + (remf ias :owning) + (remf ias :unchanged-if) + ias))) (mapcar #'copy-list slotspecs)) + (:documentation + ,@(or (cdr (find :documentation options :key #'car)) + '("chya"))) + (:default-initargs ;; nil ok and needed: acl oddity in re not clearing d-i's sans this + ,@(cdr (find :default-initargs options :key #'car))) + (:metaclass ,(or (cadr (find :metaclass options :key #'car)) + 'standard-class))) - (defmethod shared-initialize :after ((self ,class) slot-names &rest iargs &key) - (declare (ignore slot-names iargs)) - ,(when (and directsupers (not (member 'model-object directsupers))) - `(unless (typep self 'model-object) - (error "If no superclass of ~a inherits directly + (defmethod shared-initialize :after ((self ,class) slot-names &rest iargs &key) + (declare (ignore slot-names iargs)) + ,(when (and directsupers (not (member 'model-object directsupers))) + `(unless (typep self 'model-object) + (error "If no superclass of ~a inherits directly or indirectly from model-object, model-object must be included as a direct super-class in the defmodel form for ~a" ',class ',class)))) - ; - ; slot accessors once class is defined... - ; - ,@(mapcar (lambda (slotspec) - (destructuring-bind - (slotname &rest slotargs - &key (cell t) owning unchanged-if (accessor slotname) reader writer type - &allow-other-keys) - slotspec + ; + ; slot accessors once class is defined... + ; + ,@(mapcar (lambda (slotspec) + (destructuring-bind + (slotname &rest slotargs + &key (cell t) owning unchanged-if (accessor slotname) reader writer type + &allow-other-keys) + slotspec - (declare (ignorable slotargs)) - (when cell - (let* ((reader-fn (or reader accessor)) - (writer-fn (or writer accessor)) - ) - `(eval-when (#-sbcl :compile-toplevel :load-toplevel :execute) ; ph -- prevent sbcl warning - (setf (md-slot-cell-type ',class ',slotname) ,cell) - ,(when owning - `(setf (md-slot-owning-direct? ',class ',slotname) ,owning)) - ,(when reader-fn - `(defmethod ,reader-fn ((self ,class)) - (md-slot-value self ',slotname))) + (declare (ignorable slotargs)) + (when cell + (let* ((reader-fn (or reader accessor)) + (writer-fn (or writer accessor)) + ) + `(eval-when (#-sbcl :compile-toplevel :load-toplevel :execute) ; ph -- prevent sbcl warning + (setf (md-slot-cell-type ',class ',slotname) ,cell) + ,(when owning + `(setf (md-slot-owning-direct? ',class ',slotname) ,owning)) + ,(when reader-fn + `(defmethod ,reader-fn ((self ,class)) + (md-slot-value self ',slotname))) - ,(when writer-fn - `(defmethod (setf ,writer-fn) (new-value (self ,class)) - (setf (md-slot-value self ',slotname) - ,(if type - `(coerce new-value ',type) - 'new-value)))) + ,(when writer-fn + `(defmethod (setf ,writer-fn) (new-value (self ,class)) + (setf (md-slot-value self ',slotname) + ,(if type + `(coerce new-value ',type) + 'new-value)))) - ,(when unchanged-if - `(def-c-unchanged-test (,class ,slotname) ,unchanged-if)) - ) - )) - )) - slotspecs)))) + ,(when unchanged-if + `(def-c-unchanged-test (,class ,slotname) ,unchanged-if)) + ) + )) + )) + slotspecs))))) (defun defmd-canonicalize-slot (slotname &key

1 0

[cells-cvs] CVS cells-gtk3/cells-gtk
by phildebrandt 19 May '08

19 May '08

Update of /project/cells/cvsroot/cells-gtk3/cells-gtk In directory clnet:/tmp/cvs-serv30171/cells-gtk Modified Files: gtk-app.lisp Log Message: Ingo's non-threading patch. --- /project/cells/cvsroot/cells-gtk3/cells-gtk/gtk-app.lisp 2008/05/19 10:18:32 1.6 +++ /project/cells/cvsroot/cells-gtk3/cells-gtk/gtk-app.lisp 2008/05/19 10:26:06 1.7 @@ -157,10 +157,12 @@ (when close-all-windows (gtk-main-quit)) (when #+libcellsgtk (= 0 (gtk-adds-g-thread-supported)) ; init only once - #-libcellsgtk threading-initialized + #-libcellsgtk (not threading-initialized) (with-trcs - (g-thread-init +c-null+) ; init threading - (gdk-threads-init) + #+cells-gtk-threads + (progn + (g-thread-init +c-null+) ; init threading + (gdk-threads-init)) (assert (gtk-init-check +c-null+ +c-null+)) (gtk-init +c-null+ +c-null+) #+cells-gtk-opengl (gl-init)

1 0

[cells-cvs] CVS cells-gtk3/cells-gtk
by phildebrandt 19 May '08

19 May '08

Update of /project/cells/cvsroot/cells-gtk3/cells-gtk In directory clnet:/tmp/cvs-serv27464/cells-gtk Modified Files: cairo-drawing-area.lisp gtk-app.lisp widgets.lisp Log Message: With Ingo's utf-8 patch for clisp and cells-store support --- /project/cells/cvsroot/cells-gtk3/cells-gtk/cairo-drawing-area.lisp 2008/04/20 13:05:02 1.3 +++ /project/cells/cvsroot/cells-gtk3/cells-gtk/cairo-drawing-area.lisp 2008/05/19 10:18:32 1.4 @@ -509,7 +509,7 @@ (with-accessors ((mouse mouse-pos)) (widget self) (and (2d:point-in-box-p mouse (^p1) (^p2) :tol (^line-width)) (if (not (^filled)) - (not (2d:point-in-box-p mouse (^p1) (^p2) :tol (^line-width))) + (2d:point-in-box-p mouse (^p1) (^p2) :tol (^line-width)) t)))))) :no-redraw (mouse-over-p))) @@ -646,6 +646,8 @@ (^arrow-length)))))))) (defmodify arrow-line (arrow-angle arrow-length)) +(def-mk-primitive arrow-line (self initargs)) + ;;;; ----------------------------------------------------------- ;;;; event handlers ;;;; ----------------------------------------------------------- @@ -666,7 +668,7 @@ (setf (button-down-position self) pos) (case button (1 - (trc "button down on" (hover self)) + (trc nil "button down on" (hover self)) (bif (prim (hover self)) ;; prim --> select/toggle (with-slot-accessors (selection) self @@ -674,7 +676,7 @@ (if (contains-any '(:shift :control) state) ;; toggle if ctrl/shift (progn - (trc "CTRL/SHIFT -- toggeling" prim) + (trc nil "CTRL/SHIFT -- toggeling" prim) (if (selected-p prim) (setf selection (delete prim selection)) (push prim selection))) @@ -684,7 +686,7 @@ ;(deb "selection: ~a" selection))) ;; no prim --> draw a select box (progn - (trc "START SELECT-BOX") + (trc nil "START SELECT-BOX") (unless (contains-any '(:shift :control) state) (setf (selection self) nil)) (setf (select-box self) (mk-primitive self @@ -698,10 +700,10 @@ :fill-alpha .1)) (trc nil "select box is" (select-box self))))) (t (bwhen (box (select-box self)) - (trc "CANCEL SELECT-BOX") + (trc nil "CANCEL SELECT-BOX") (setf box (remove-primitive box))) (when (dragging self) - (trc "CANCEL DRAG") + (trc nil "CANCEL DRAG") (dolist (prim (selection self)) (setf (dragged-p prim) nil)) (setf (dragging self) nil @@ -714,7 +716,7 @@ (cond ((dragging self) ;; this is the button release after a dragging event - (trc "FINISH DRAGGING") + (trc nil "FINISH DRAGGING") (with-slot-accessors (dragging on-dragged drag-offset drag-start selection) self (dolist (prim selection) ;; call on-dragged [widget] [button] [primitive] [start-pos] [end-pos] @@ -730,15 +732,15 @@ drag-start nil drag-offset nil))) ((select-box self) - (trc "FINISH SELECT-BOX") + (trc nil "FINISH SELECT-BOX") (with-slot-accessors (selection prims button-down-position select-box) self (dolist (prim prims) - (trc "checking" prim) + (trc nil "checking" prim) (and (selectable prim) (2d:point-in-box-p (c-o-g prim) button-down-position pos) (push prim selection) - (trc "--> selected " prim))) - (trc "selection is now" selection) + (trc nil "--> selected " prim))) + (trc nil "selection is now" selection) (setf select-box (remove-primitive select-box)))) (t (with-slot-accessors (selection hover) self (unless (contains-any '(:shift :control) state) @@ -760,7 +762,7 @@ ((bwhen (start-pos (button-down-position self)) (and (not (select-box self)) (> (2d:polar-radius (2d:v- start-pos pos)) (drag-threshold self)))) - (trc "START DRAGGING") + (trc nil "START DRAGGING") ;; initiate dragging (with-slot-accessors (drag-offset drag-start selection dragging) self (setf drag-offset (make-hash-table) --- /project/cells/cvsroot/cells-gtk3/cells-gtk/gtk-app.lisp 2008/04/20 13:05:02 1.5 +++ /project/cells/cvsroot/cells-gtk3/cells-gtk/gtk-app.lisp 2008/05/19 10:18:32 1.6 @@ -253,11 +253,14 @@ (gtk-main)) ;; clean-up forms -- application windows are taken down by gtk-quit-add callbacks + (trc "cells-gtk clean-up code") (loop for i below (gtk-main-level) + do (trc " gtk-main-quit") do (gtk-main-quit)) ;; Next is a work-around for a problem with gtk and lispwork-created .exe files #+(and Lispworks win32)(loop for i from 1 to 30 do (gtk-main-quit)) (loop while (gtk-events-pending) + do (trc " gtk-main-iteration-do") do (gtk-main-iteration-do nil)))) ;;; --- /project/cells/cvsroot/cells-gtk3/cells-gtk/widgets.lisp 2008/04/20 13:05:02 1.4 +++ /project/cells/cvsroot/cells-gtk3/cells-gtk/widgets.lisp 2008/05/19 10:18:34 1.5 @@ -77,13 +77,13 @@ (defun gtk-object-forget (gtk-id gtk-object) (when (and gtk-id gtk-object) - (trc " forgetting id/obj" gtk-id gtk-object) + (trc nil " forgetting id/obj" gtk-id gtk-object) (let ((ptr (cffi:pointer-address gtk-id))) (assert *gtk-objects*) (remhash ptr *gtk-objects*) #+unnecessary (mapc (lambda (k) (gtk-object-forget (slot-value k 'id) k)) (slot-value gtk-object '.kids))) ; unnecessary, ph - (trc " done" gtk-id gtk-object))) + (trc nil " done" gtk-id gtk-object))) (defun gtk-object-find (gtk-id &optional must-find-p &aux (hash-id (cffi:pointer-address gtk-id))) (when *gtk-objects* @@ -340,11 +340,11 @@ #+libcellsgtk (cffi:defcallback reshape-widget-handler :int ((widget :pointer) (event :pointer) (data :pointer)) (declare (ignore data event)) - (trc "reshape" widget) + (trc nil "reshape" widget) (bwhen (self (gtk-object-find widget)) (let ((new-width (gtk-adds-widget-width widget)) (new-height (gtk-adds-widget-height widget))) - (trc "reshape widget to new size" self widget new-width new-height) + (trc nil "reshape widget to new size" self widget new-width new-height) (with-integrity (:change :adjust-widget-size) (setf (allocated-width self) new-width (allocated-height self) new-height)))) @@ -380,22 +380,22 @@ (gtk-widget-hide (id self)))) (defmethod not-to-be :around ((self gtk-object)) - (trc "gtk-object not-to-be :around" (md-name self) self) - (trc " store-remove") + (trc nil "gtk-object not-to-be :around" (md-name self) self) + (trc nil " store-remove") (when (eql (store-lookup (md-name self) *widgets*) self) (store-remove (md-name self) *widgets*)) - (trc " object-forget") + (trc nil " object-forget") (gtk-object-forget (id self) self) - (trc " call-next-method") + (trc nil " call-next-method") (call-next-method) - (trc " widget-destroy") + (trc nil " widget-destroy") (when *gtk-debug* - (trc "WIDGET DESTROY" (slot-value self '.md-name) (type-of self) self) + (trc nil "WIDGET DESTROY" (slot-value self '.md-name) (type-of self) self) (force-output)) (gtk-widget-destroy (slot-value self 'id)) - (trc " done")) + (trc nil " done")) (defun assert-bin (container)

1 0

[cells-cvs] CVS cells-gtk3/gtk-ffi
by phildebrandt 19 May '08

19 May '08

Update of /project/cells/cvsroot/cells-gtk3/gtk-ffi In directory clnet:/tmp/cvs-serv27464/gtk-ffi Modified Files: gtk-ffi-impl.lisp Log Message: With Ingo's utf-8 patch for clisp and cells-store support --- /project/cells/cvsroot/cells-gtk3/gtk-ffi/gtk-ffi-impl.lisp 2008/04/13 10:59:23 1.1 +++ /project/cells/cvsroot/cells-gtk3/gtk-ffi/gtk-ffi-impl.lisp 2008/05/19 10:18:35 1.2 @@ -6,6 +6,7 @@ Currently supported -- sbcl: utf-8 string handling + -- clisp: utf-8 string handling (thanks to Ingo Bormuth) |# @@ -16,21 +17,24 @@ ;;; UTF-8 string handling ;;; -(defun utf-8-to-lisp (str) +(defun lisp-to-utf-8 (str) + #-(or clisp sbcl) (return-from lisp-to-utf-8 str) (when str - #+sbcl (let ((s (sb-ext:string-to-octets str :external-format :utf-8))) - (sb-ext:octets-to-string - (coerce (loop for i from 0 below (length s) - for b = (aref s i) - collect b - if (= b 195) do (incf i 2)) ; ph: gtk gives us 4 bytes per char -- no idea why. - '(vector (unsigned-byte 8))) - :external-format :utf-8)) - #-(or sbcl) str)) + #+clisp (ext:convert-string-to-bytes str charset:utf-8) + #+sbcl (sb-ext:string-to-octets str :external-format :utf-8))) -(defun lisp-to-utf-8 (str) +(defun utf-8-to-lisp (str) + #-(or clisp sbcl) (return-from utf-8-to-lisp str) (when str - #+sbcl (sb-ext:string-to-octets str :external-format :utf-8) - #-(or sbcl) str)) + (let* ((nat (lisp-to-utf-8 str)) + (oct (coerce (loop for i from 0 below (length nat) + for b = (aref nat i) + collect b + ;; ph: gtk gives us 4 bytes per char ; why ? + if (= b 195) do (incf i 2)) + '(vector (unsigned-byte 8))))) + #+clisp (ext:convert-string-from-bytes oct charset:utf-8) + #+sbcl (sb-ext:octets-to-string oct :external-format :utf-8)))) +

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

2003

cells-cvs May 2008