X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~mdw/git/clg/blobdiff_plain/5ab32e1f43fe47d27512c3827a2ed2d8049eedb6..c37e94700281519d2ca06ad29eecdaa54b24900c:/glib/gutils.lisp?ds=inline diff --git a/glib/gutils.lisp b/glib/gutils.lisp index f10c70b..86deed5 100644 --- a/glib/gutils.lisp +++ b/glib/gutils.lisp @@ -15,7 +15,7 @@ ;; License along with this library; if not, write to the Free Software ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -;; $Id: gutils.lisp,v 1.3 2000/10/05 17:18:28 espen Exp $ +;; $Id: gutils.lisp,v 1.5 2001/05/04 16:54:35 espen Exp $ (in-package "KERNEL") @@ -30,6 +30,21 @@ (defun type-expand-1 (form) (values (funcall def (if (consp form) form (list form))) t) (values form nil)))) +(in-package "PCL") + +(defmethod finalize-inheritance ((class std-class)) + (update-cpl class (compute-class-precedence-list class)) + (update-slots class (compute-slots class)) + (update-gfs-of-class class) + (update-inits class (compute-default-initargs class)) + (update-make-instance-function-table class) + (dolist (sub (class-direct-subclasses class)) + (update-class sub))) + +(defun update-class (class &optional finalizep) + (declare (ignore finalizep)) + (unless (class-has-a-forward-referenced-superclass-p class) + (finalize-inheritance class))) (in-package "GLIB") @@ -50,7 +65,7 @@ (defmacro with-gc-disabled (&body body) `(progn (let ((,gc-inhibit lisp::*gc-inhibit*)) (ext:gc-off) - (unwind-protect + (unwind-protect ,@body (unless ,gc-inhibit (ext:gc-on))))))) @@ -83,7 +98,7 @@ (defun make-pointer (address) (defun null-pointer-p (pointer) (zerop (sap-int pointer))) - + (defmacro when-bind ((var expr) &body body) `(let ((,var ,expr)) @@ -112,3 +127,34 @@ (defun funcallable (object) (fdefinition object) object)) + +(defun split-string (string delimiter) + (declare (simple-string string) (character delimiter)) + (check-type string string) + (check-type delimiter character) + (let ((pos (position delimiter string))) + (if (not pos) + (list string) + (cons + (subseq string 0 pos) + (split-string (subseq string (1+ pos)) delimiter))))) + +(defun split-string-if (string predicate) + (declare (simple-string string)) + (check-type string string) + (check-type predicate (or symbol function)) + (let ((pos (position-if predicate string :start 1))) + (if (not pos) + (list string) + (cons + (subseq string 0 pos) + (split-string-if (subseq string pos) predicate))))) + +(defun concatenate-strings (strings &optional delimiter) + (if (not (rest strings)) + (first strings) + (concatenate + 'string + (first strings) + (if delimiter (string delimiter) "") + (concatenate-strings (rest strings)))))