Commit 8ece2e00 authored by Dave Cooper's avatar Dave Cooper
Browse files

made snap-folder into a function.

parent 4909c79b
...@@ -351,6 +351,7 @@ If you are interested in this effort we would love to hear from you at open-sour ...@@ -351,6 +351,7 @@ If you are interested in this effort we would love to hear from you at open-sour
#:replace-regexp #:replace-regexp
#:room-report #:room-report
#:slot-definition-name #:slot-definition-name
#:snap-folder
#:socket-bytes-written #:socket-bytes-written
#:split-regexp #:split-regexp
#:with-heuristic-case-mode #:with-heuristic-case-mode
......
...@@ -27,29 +27,11 @@ ...@@ -27,29 +27,11 @@
(glisp:set-default-float-format) (glisp:set-default-float-format)
(glisp:set-defpackage-behavior) (glisp:set-defpackage-behavior)
(defparameter *packages-to-initialize* (list :gdl :geom-base :gwl))
(defparameter *init-functions* nil)
(defun register-init-function (function-symbol) (defun start-gendl! (&key packages *packages-to-initialize*)
(unless (symbolp function-symbol) (dolist (package packages)
(error "~&register-init-function only accepts a symbol which names a function (i.e. is fboundp).~%"))
(unless (fboundp function-symbol)
(warn "~&register-init-function was called with unbound function ~s.~%" function-symbol))
(format t "Registering ~s. Init functions now contain ~s.~%" function-symbol *init-functions*)
(setq *init-functions* (append *init-functions* (list function-symbol)))
*init-functions*)
;;
;; FLAG -- each initialize function should return nil or non-nil based
;; on its local anything-changed?. Consider collecting and reporting
;; those results here.
;;
(defun start-gendl! ()
(dolist (package (list :gdl :geom-base :gwl))
(when (find-package package) (when (find-package package)
(let ((function-sym (read-from-string (format nil "~a::initialize" package)))) (let ((function-sym (read-from-string (format nil "~a::initialize" package))))
(when (fboundp function-sym) (when (fboundp function-sym)
......
...@@ -21,12 +21,7 @@ ...@@ -21,12 +21,7 @@
(in-package :gwl) (in-package :gwl)
;; (defvar *snap-folder* (glisp:snap-folder))
;; FLAG -- Undocumented. This will change.
;;
(defvar *snap-folder*
(or (probe-file (merge-pathnames "snaps/" "sys:"))
(ensure-directories-exist (merge-pathnames "snaps/" (glisp:temporary-folder)))))
(defun restore-from-snap (iid) (defun restore-from-snap (iid)
(let ((new-self (let ((new-self
......
...@@ -251,6 +251,10 @@ the \"current\" error." ...@@ -251,6 +251,10 @@ the \"current\" error."
#+sbcl sb-mop:slot-definition-name #+sbcl sb-mop:slot-definition-name
#+ccl ccl:slot-definition-name slot-definition)) #+ccl ccl:slot-definition-name slot-definition))
(defun snap-folder ()
(or #+allegro (probe-file (merge-pathnames "snaps/" "sys:"))
(ensure-directories-exist (merge-pathnames "snaps/" (glisp:temporary-folder)))))
(defun socket-bytes-written (socket) (defun socket-bytes-written (socket)
#-allegro (declare (ignore socket)) #-allegro (declare (ignore socket))
#+allegro (excl::socket-bytes-written socket) #+allegro (excl::socket-bytes-written socket)
......
...@@ -47,7 +47,6 @@ ...@@ -47,7 +47,6 @@
(declare (ignore in-memory host login password)) (declare (ignore in-memory host login password))
(setq *geometry-kernel* (make-instance 'vanilla-geometry-kernel))) (setq *geometry-kernel* (make-instance 'vanilla-geometry-kernel)))
(unless *geometry-kernel* (make-geometry-kernel :vanilla))
(defmethod decomposed-curves ((geometry-kernel vanilla-geometry-kernel) native-curve) (defmethod decomposed-curves ((geometry-kernel vanilla-geometry-kernel) native-curve)
(declare (ignore native-curve)) (declare (ignore native-curve))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment