Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
gendl
gendl
Commits
8ece2e00
Commit
8ece2e00
authored
Mar 16, 2013
by
Dave Cooper
Browse files
made snap-folder into a function.
parent
4909c79b
Changes
5
Hide whitespace changes
Inline
Side-by-side
base/common/package.lisp
View file @
8ece2e00
...
...
@@ -351,6 +351,7 @@ If you are interested in this effort we would love to hear from you at open-sour
#:replace-regexp
#:room-report
#:slot-definition-name
#:snap-folder
#:socket-bytes-written
#:split-regexp
#:with-heuristic-case-mode
...
...
base/common/start-gendl.lisp
View file @
8ece2e00
...
...
@@ -27,29 +27,11 @@
(
glisp:set-default-float-format
)
(
glisp:set-defpackage-behavior
)
(
defparameter
*packages-to-initialize*
(
list
:gdl
:geom-base
:gwl
))
(
defparameter
*init-functions*
nil
)
(
defun
register-init-function
(
function-symbol
)
(
unless
(
symbolp
function-symbol
)
(
error
"~®ister-init-function only accepts a symbol which names a function (i.e. is fboundp).~%"
))
(
unless
(
fboundp
function-symbol
)
(
warn
"~®ister-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
))
(
defun
start-gendl!
(
&key
packages
*packages-to-initialize*
)
(
dolist
(
package
packages
)
(
when
(
find-package
package
)
(
let
((
function-sym
(
read-from-string
(
format
nil
"~a::initialize"
package
))))
(
when
(
fboundp
function-sym
)
...
...
gwl/ajax/source/ajax.lisp
View file @
8ece2e00
...
...
@@ -21,12 +21,7 @@
(
in-package
:gwl
)
;;
;; FLAG -- Undocumented. This will change.
;;
(
defvar
*snap-folder*
(
or
(
probe-file
(
merge-pathnames
"snaps/"
"sys:"
))
(
ensure-directories-exist
(
merge-pathnames
"snaps/"
(
glisp:temporary-folder
)))))
(
defvar
*snap-folder*
(
glisp:snap-folder
))
(
defun
restore-from-snap
(
iid
)
(
let
((
new-self
...
...
gwl/source/genworks.lisp
View file @
8ece2e00
...
...
@@ -251,6 +251,10 @@ the \"current\" error."
#+
sbcl
sb-mop:slot-definition-name
#+
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
)
#-
allegro
(
declare
(
ignore
socket
))
#+
allegro
(
excl::socket-bytes-written
socket
)
...
...
surf/source/methods.lisp
View file @
8ece2e00
...
...
@@ -47,7 +47,6 @@
(
declare
(
ignore
in-memory
host
login
password
))
(
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
)
(
declare
(
ignore
native-curve
))
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment