Commit dc0485d0 authored by Dave Cooper's avatar Dave Cooper

Canonicalized pushing of *features* and per-feature initialize! function.

parent 5ce3e6f1
......@@ -3,7 +3,7 @@
"Auto-generated asdf defsys from Genworks GenDL cl-lite. Please avoid hand-editing."
:author "Dave Cooper and Genworks International" :license
"Gnu Affero General Public License (please see http://www.gnu.org/licenses/)"
:serial t :version "20130316" :depends-on (:gwl-graphics)
:serial t :version "20130317" :depends-on (:gwl-graphics)
:components
((:file "source/package") (:file "source/parameters")
(:file "source/javascript") (:file "source/action-object")
......
......@@ -29,3 +29,7 @@
(defparameter *tasty-developing?* nil)
(defparameter *use-bsplines-for-vrml?* nil)
(defparameter *these-features* (list :tasty))
(defparameter *settings* nil)
\ No newline at end of file
......@@ -3,12 +3,13 @@
"Auto-generated asdf defsys from Genworks GenDL cl-lite. Please avoid hand-editing."
:author "Dave Cooper and Genworks International" :license
"Gnu Affero General Public License (please see http://www.gnu.org/licenses/)"
:serial t :version "20130316" :depends-on (:tree :gwl-graphics)
:serial t :version "20130317" :depends-on (:tree :gwl-graphics)
:components
((:file "source/package") (:file "source/parameters")
(:file "source/assembly") (:file "source/inspector")
(:file "source/menu") (:file "source/new-inspector")
(:file "source/newer-inspector") (:file "source/part-type-form")
(:file "source/publish") (:file "source/status-object")
(:file "source/test-part") (:file "source/test-part2")
(:file "source/two-viewports") (:file "source/viewport")))
(:file "source/assembly") (:file "source/initialize")
(:file "source/inspector") (:file "source/menu")
(:file "source/new-inspector") (:file "source/newer-inspector")
(:file "source/part-type-form") (:file "source/publish")
(:file "source/status-object") (:file "source/test-part")
(:file "source/test-part2") (:file "source/two-viewports")
(:file "source/viewport") (:file "source/zzinit")))
......@@ -3,7 +3,7 @@
"Auto-generated asdf defsys from Genworks GenDL cl-lite. Please avoid hand-editing."
:author "Dave Cooper and Genworks International" :license
"Gnu Affero General Public License (please see http://www.gnu.org/licenses/)"
:serial t :version "20130316" :depends-on nil :components
:serial t :version "20130317" :depends-on nil :components
((:file "xml/source/package") (:file "xml/source/genworks")
(:file "xml/source/definition-tree") (:file "xml/source/gdl2xml")
(:file "xml/source/xml2gdl")))
......@@ -3,7 +3,7 @@
"Auto-generated asdf defsys from Genworks GenDL cl-lite. Please avoid hand-editing."
:author "Dave Cooper and Genworks International" :license
"Gnu Affero General Public License (please see http://www.gnu.org/licenses/)"
:serial t :version "20130316" :depends-on (:gwl-graphics)
:serial t :version "20130317" :depends-on (:gwl-graphics)
:components
((:file "source/package") (:file "source/parameters")
(:file "source/ajax") (:file "source/assembly")
......
......@@ -3,12 +3,14 @@
"Auto-generated asdf defsys from Genworks GenDL cl-lite. Please avoid hand-editing."
:author "Dave Cooper and Genworks International" :license
"Gnu Affero General Public License (please see http://www.gnu.org/licenses/)"
:serial t :version "20130316" :depends-on (:gwl-graphics)
:serial t :version "20130317" :depends-on (:gwl-graphics)
:components
((:file "source/package") (:file "source/genworks")
(:file "source/mixins")
(:file "source/define-object-documentation")
(:file "source/assembly") (:file "source/ass")
(:file "source/format-documentation")
(:file "source/function-documentation") (:file "source/publish")
(:file "source/test-part") (:file "source/variable-documentation")))
(:file "source/function-documentation") (:file "source/initialize")
(:file "source/parameters") (:file "source/publish")
(:file "source/test-part") (:file "source/variable-documentation")
(:file "source/zzinit")))
(asdf:defsystem #:base :description
"Base GenDL Kernel Supplying define-object, define-format, define-view macros and Associated Referencing Operators and KBE Runtime Engine."
"Base Gendl Subsystem supplying define-object, define-format, define-view macros and Associated Referencing Operators and KBE Runtime Engine."
:author
"Dave Cooper and Genworks International"
:license "Gnu Affero General Public License (please see http://www.gnu.org/licenses/)" :serial t
:version "2013031400"
:components
((:file "common/package")
(:file "common/genworks")
(:file "common/start-gendl")
(:file "prereqs/source/parameters")
(:file "prereqs/source/metaclasses")
(:file "prereqs/source/utilities")
((:file "source/package")
(:file "source/genworks")
(:file "source/presets")
(:file "source/parameters")
(:file "source/metaclasses")
(:file "source/start")
(:file "source/utilities")
(:file "expanders/source/inputs")
(:file "expanders/source/computed-slots")
(:file "expanders/source/functions")
......@@ -33,4 +34,6 @@
(:file "rest/source/make-part")
(:file "rest/source/null-part")
(:file "rest/source/sequence")
(:file "rest/source/zzinit")))
(:file "zzinit/source/initialize")
(:file "zzinit/source/zzinit")))
This diff is collapsed.
This diff is collapsed.
;;
;; Copyright 2002-2011 Genworks International
;;
;; This source file is part of the General-purpose Declarative
;; Language project (GDL).
;;
;; This source file contains free software: you can redistribute it
;; and/or modify it under the terms of the GNU Affero General Public
;; License as published by the Free Software Foundation, either
;; version 3 of the License, or (at your option) any later version.
;;
;; This source file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; Affero General Public License for more details.
;;
;; You should have received a copy of the GNU Affero General Public
;; License along with this source file. If not, see
;; <http://www.gnu.org/licenses/>.
;;
(in-package :gdl)
;;
;; FLAG GLOBALS catalog these settings which affect compiling.
;;
(glisp:set-default-float-format)
(glisp:set-defpackage-behavior)
(defparameter *packages-to-initialize* (list :gdl :geom-base :gwl))
w(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)
(let ((description (glisp:package-documentation package)))
(format t "~&Initializing ~a (~a) subsystem...~%~%" description package)
(let ((anything-changed? (funcall function-sym)))
(format t "~&...Generative ~a (~a) subsystem initializaton is complete.~a~%~%"
description package (if anything-changed? ""
(format nil "~% (no new global settings).")))))))))
(startup-banner) (load-gdl-init-files) (values))
(defun load-gdl-init-files (&key edition)
(declare (ignore edition))
(let* ((user-homedir (user-homedir-pathname))
(current-directory (glisp:current-directory))
(homedir-init-file (or (probe-file (merge-pathnames ".gdlinit.cl" user-homedir))
(probe-file (merge-pathnames "gdlinit.cl" user-homedir))))
(current-init-file (when (not (equalp user-homedir current-directory))
(or (probe-file (merge-pathnames ".gdlinit.cl" current-directory))
(probe-file (merge-pathnames "gdlinit.cl" current-directory))))))
(let* ((command-args (glisp:basic-command-line-arguments))
(homedir-init? (and (not (member "-q" command-args :test #'string-equal))
(not (member "-qq" command-args :test #'string-equal))))
(current-dir-init? (not (member "-qq" command-args :test #'string-equal))))
(when (and current-dir-init? current-init-file) (load current-init-file))
(when (and homedir-init? homedir-init-file) (load homedir-init-file)))))
(defun startup-banner (&key edition)
(glisp:display-startup-banner edition
"
Copyright 2013 Genworks International
Welcome to Gendl(TM).
This program contains free software: you can redistribute it
and/or modify it under the terms of the GNU Affero General Public
License as published by the Free Software Foundation, either
version 3 of the License, or (at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Affero General Public License for more details.
You should have received a copy of the GNU Affero General Public
License along with the source code for this program. If not, see:
http://www.gnu.org/licenses/
"))
;;
;; FLAG -- do some of these at beginning of bootstrapping, others
;; defer until end of loading everything.
;;
(defun initialize ()
(declare (ignore edition))
(setq glisp:*gdl-program-home* (glisp:executable-homedir-pathname))
(setq glisp:*gdl-home* (make-pathname :name nil
:type nil
:directory (butlast (pathname-directory glisp:*gdl-program-home*))
:defaults glisp:*gdl-program-home*))
(glisp:set-genworks-source-home-if-known)
(glisp:set-default-float-format)
(glisp:set-defpackage-behavior)
(glisp:set-default-package)
(glisp:xref-off)
(glisp:set-window-titles))
;;
;; Copyright 2002-2011 Genworks International and Genworks BV
;;
;; This source file is part of the General-purpose Declarative
;; Language project (GDL).
;;
;; This source file contains free software: you can redistribute it
;; and/or modify it under the terms of the GNU Affero General Public
;; License as published by the Free Software Foundation, either
;; version 3 of the License, or (at your option) any later version.
;;
;; This source file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; Affero General Public License for more details.
;;
;; You should have received a copy of the GNU Affero General Public
;; License along with this source file. If not, see
;; <http://www.gnu.org/licenses/>.
;;
("compiler" "lift" "tests")
;;
;; Copyright 2002-2011 Genworks International
;;
;; This source file is part of the General-purpose Declarative
;; Language project (GDL).
;;
;; This source file contains free software: you can redistribute it
;; and/or modify it under the terms of the GNU Affero General Public
;; License as published by the Free Software Foundation, either
;; version 3 of the License, or (at your option) any later version.
;;
;; This source file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; Affero General Public License for more details.
;;
;; You should have received a copy of the GNU Affero General Public
;; License along with this source file. If not, see
;; <http://www.gnu.org/licenses/>.
;;
(in-package :common-lisp-user)
(load (merge-pathnames #p"common/setup.lisp" *load-truename*))
(funcall (read-from-string "gdl:cl"))
;;
;; Copyright 2002-2011 Genworks International and Genworks BV
;;
;; This source file is part of the General-purpose Declarative
;; Language project (GDL).
;;
;; This source file contains free software: you can redistribute it
;; and/or modify it under the terms of the GNU Affero General Public
;; License as published by the Free Software Foundation, either
;; version 3 of the License, or (at your option) any later version.
;;
;; This source file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; Affero General Public License for more details.
;;
;; You should have received a copy of the GNU Affero General Public
;; License along with this source file. If not, see
;; <http://www.gnu.org/licenses/>.
;;
("parameters" "metaclasses")
;;
;; Copyright 2002-2011 Genworks International
;;
;; This source file is part of the General-purpose Declarative
;; Language project (GDL).
;;
;; This source file contains free software: you can redistribute it
;; and/or modify it under the terms of the GNU Affero General Public
;; License as published by the Free Software Foundation, either
;; version 3 of the License, or (at your option) any later version.
;;
;; This source file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; Affero General Public License for more details.
;;
;; You should have received a copy of the GNU Affero General Public
;; License along with this source file. If not, see
;; <http://www.gnu.org/licenses/>.
;;
(in-package :gdl)
(defclass gdl-class (standard-class)
((messages :accessor messages :initform nil)
(gdl-documentation :accessor gdl-documentation :initform nil)
(required-input-slots :accessor required-input-slots :initform nil)
(optional-input-slots :accessor optional-input-slots :initform nil)
(defaulted-input-slots :accessor defaulted-input-slots :initform nil)
(computed-slots :accessor computed-slots :initform nil)
(query-slots :accessor query-slots :initform nil)
(settable-computed-slots :accessor settable-computed-slots :initform nil)
(uncached-computed-slots :accessor uncached-computed-slots :initform nil)
(settable-optional-input-slots :accessor settable-optional-input-slots :initform nil)
(settable-defaulted-input-slots :accessor settable-defaulted-input-slots :initform nil)
(functions :accessor functions :initform nil)
(methods :accessor methods :initform nil)
(cached-functions :accessor cached-functions :initform nil)
(cached-methods :accessor cached-methods :initform nil)
(objects :accessor objects :initform nil)
(quantified-objects :accessor quantified-objects :initform nil)
(hidden-objects :accessor hidden-objects :initform nil)
(quantified-hidden-objects :accessor quantified-hidden-objects :initform nil)
(trickle-down-slots :accessor trickle-down-slots :initform nil)
(settable-slots :accessor settable-slots :initform nil)
(message-documentation :accessor message-documentation :initform nil)
(message-source :accessor message-source :initform nil)
(message-source-copy :accessor message-source-copy :initform nil)
(message-source-changed :accessor message-source-changed :initform nil)
(format-functions :accessor format-functions :initform nil)
(child-inputs :accessor child-inputs :initform nil)
))
(defclass gdl-format-class (standard-class)
((gdl-documentation :accessor gdl-documentation :initform nil)
(format-functions :accessor format-functions :initform nil)
(output-functions :accessor output-functions :initform (make-hash-table))
(view-documentation :accessor view-documentation :initform (make-hash-table))))
(defclass gdl-skin-class (standard-class) ())
(defmethod glisp:validate-superclass ((class gdl-class) (superclass standard-class)) t)
(defmethod glisp:validate-superclass ((class gdl-format-class) (superclass standard-class)) t)
(defmethod glisp:validate-superclass ((class gdl-skin-class) (superclass standard-class)) t)
;;
;; Copyright 2002-2011 Genworks International
;;
;; This source file is part of the General-purpose Declarative
;; Language project (GDL).
;;
;; This source file contains free software: you can redistribute it
;; and/or modify it under the terms of the GNU Affero General Public
;; License as published by the Free Software Foundation, either
;; version 3 of the License, or (at your option) any later version.
;;
;; This source file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; Affero General Public License for more details.
;;
;; You should have received a copy of the GNU Affero General Public
;; License along with this source file. If not, see
;; <http://www.gnu.org/licenses/>.
;;
(in-package :gdl)
(eval-when (compile load eval)
(when (not (boundp '*production-build?*)) (defvar *production-build?* nil)))
(defparameter *compiling-changes* nil)
(defparameter *load-source-code-database?* nil ;;(not *production-build?*)
"Boolean. Determines whether pre-compiled source code
information will be loaded from compiled files. Defaults to T.")
(defparameter *curve-chords* 50 "Integer. The number of chords to use per Bezier curve when rendering curves as a sequence of straight chords (e.g. in VRML).")
(defparameter *load-documentation-database?* nil ;;t ;;(not *production-build?*)
"Boolean. Determines whether pre-compiled documentation strings
information will be loaded from compiled files. Defaults to T.")
(defparameter *compile-source-code-database?* nil ;;(not *production-build?*)
"Boolean. Determines whether source code information
information will be compiled into compiled files. Defaults to T.")
(defparameter *compile-documentation-database?* nil ;;t ;;(not *production-build?*)
"Boolean. Determines whether documentation strings
information will be compiled into compiled files. Defaults to T.")
(defparameter *retain-object-identity-on-type-change?* t)
(defparameter *dummy-version* (list 0))
(defparameter *notify-cons* nil)
(defparameter *root-checking-enabled?* t
"Boolean. Determines whether dependency-tracking carries over between objects which
do not share a common root. Default is T which means dependency-tracking does <b>not</b>
carry over (the checking prevents it).")
(defparameter *till-now* nil)
(defvar *compile-circular-reference-detection?* nil
"Boolean. This is a compile-time switch. Determines whether GDL detects circular references
in messages. Defaults to NIL.")
(defvar *run-with-circular-reference-detection?* nil
"Boolean. This is a runtime switch. Determines whether GDL detects circular references
in messages. Defaults to NIL.")
;;(defvar *compile-circular-reference-detection?* t)
;;(defvar *run-with-circular-reference-detection?* t)
(defvar *compile-dependency-tracking?* t
"Boolean. This is a compile-time switch. Determines whether GDL keeps track of object and message
dependencies at runtime, thereby enabling the modification of messages and subsequent proper
demand-driven recomputation of other messages in the object hierarchy. This switch must
be set at the beginning of a GDL session before comiling all code; switching it in the middle
of a session (especially from NIL to T) will have unpredictable effects and very likely will
result in incorrect operation. Defaults to T.")
(defvar *run-with-dependency-tracking?* t
"Boolean. This is a runtime switch. Determines whether GDL keeps track of object and message
dependencies at runtime, thereby enabling the modification of messages and subsequent proper
demand-driven recomputation of other messages in the object hierarchy. This switch must
be set at the beginning of a GDL session; switching it in the middle of a session (especially
from NIL to T) will have unpredictable effects and very likely will result in incorrect
operation. Defaults to T.")
(defvar *undeclared-parameters-enabled?* nil ;;t
"Boolean. This is a compile-time switch. Determines whether GDL will handle inputs passed
to child parts through :parameters plists, where the input is not declared in any other
part as either an input-slot or computed-slot. If you leave this as NIL when compiling
your application you may see an improvement in runtime performance of up to 10% as
compared to applications compiled with it set to T. Defaults to NIL.")
(defparameter *debug?* nil)
(defparameter *debug-object* nil)
(defparameter *report-gdl-redefinitions?* t)
(defparameter *allowed-part-documentation-keywords*
(list :author :purpose :description :examples :example))
(defparameter *message-categories*
(list :required-input-slots :optional-input-slots :settable-optional-input-slots
:defaulted-input-slots :settable-defaulted-input-slots :computed-slots :settable-computed-slots
:uncached-computed-slots
:objects :quantified-objects :hidden-objects :quantified-hidden-objects :functions
:query-slots))
(defparameter *stream* nil)
(defparameter *colors-default* (list :foreground :black :background :white)
"Plist. Should contain keys of at least <tt>:foreground</tt> and <tt>:background</tt>, whose
values are a color indicator for the default foreground and background of graphics viewports. The
default is <tt>:black</tt> for foreground, and <tt>:white</tt> for background.")
(defparameter *%format%* nil)
(defvar args-arg (gensym))
(defvar parent-arg (gensym))
(defvar part-arg (gensym))
(defvar val-arg (gensym))
(defvar self-arg (gensym))
(defparameter *error-on-not-handled?* t)
(glisp:define-constant +reserved-words+
(mapcar #'(lambda(symbol)
(glisp:intern symbol :gdl-acc))
'(aggregate
children
;;documentation
first
first?
follow-root-path
hidden-children
index
last
last?
leaf?
message-list
mixins
next
parent
parent-tree
previous
restore-slot-default!
root
root-path
root?
set-slot!
set-slots!
slot-documentation
type
update!
color-decimal
edge-center
face-center
face-normal-vector
local-center
obliqueness
vertex)))
(defparameter *error-on-reserved-words?* t)
(defparameter *compile-for-dgdl?* nil "Boolean. Determines whether
global methods are defined during compilation to allow calling any
message on a gdl remote-object. This functionality is not available
in the core GDL kernel and depends on additional web/networking
modules. Defaults to nil.")
#+nil
(defparameter *compile-for-dgdl?* t "Boolean. Determines whether
global methods are defined during compilation to allow calling any
message on a gdl remote-object. This functionality is not available
in the core GDL kernel and depends on additional web/networking
modules. Defaults to t.")
(defparameter *gs-path* nil)
(defparameter *new-features* (list :gendl))
\ No newline at end of file
This diff is collapsed.
(in-package :gendl)
(glisp:set-features *new-features*)
......@@ -19,4 +19,4 @@
;; <http://www.gnu.org/licenses/>.
;;
("prereqs" "expanders" "macros" "writers" "rest" "compiler" "geometry" "drawing" "text" "peruser")
("source" "expanders" "macros")
(in-package :gdl-user)
(defparameter *global-number* 10)
(defparameter *global-number-lock* (mp:make-process-lock :name "global-number-lock"))
(defun set-global-number (&key (value 20) (n nil))
(mp:with-process-lock (*global-number-lock*)
(setq *global-number* value)
(unless (= *global-number* value)
(error "*global-number* got reset out from under us! Should be ~a and it is now ~a~a~%"
value *global-number*
(if n (format nil " and n is ~a." n) "")))))
(defun start-threads (&key (times 1000000))
(mp:process-run-function "num-20" #'(lambda()(dotimes (n times)
(when (zerop (mod n 10000))
(format t "In 20-setter, n is: ~a~%" n))
(set-global-number :value 20 :n n))))
(mp:process-run-function "num-42" #'(lambda()(dotimes (n times)
(when (zerop (mod n 10000))
(format t "In 42-setter, n is: ~a~%" n))
(set-global-number :value 42 :n n)))))
\ No newline at end of file
;;
;; Copyright 2002-2011 Genworks International
;;
;; This source file is part of the General-purpose Declarative
;; Language project (GDL).
;;
;; This source file contains free software: you can redistribute it
;; and/or modify it under the terms of the GNU Affero General Public
;; License as published by the Free Software Foundation, either
;; version 3 of the License, or (at your option) any later version.
;;
;; This source file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; Affero General Public License for more details.
;;
;; You should have received a copy of the GNU Affero General Public
;; License along with this source file. If not, see
;; <http://www.gnu.org/licenses/>.
;;
(in-package :gdl-base-tests)
(define-object a ()
:input-slots ((inp-a "hey") inp-b)
:trickle-down-slots (desc-1 desc-2)
:computed-slots
((desc-1 (format nil "descendant ~a" (the inp-a)))
(desc-2 (format nil "descendant-2 ~a" (the inp-b))))
:objects
((part-1 :type 'b
:input-1 1
:input-2 2)
(part-2 :type 'b
:input-1 (the part-1 input-2)
:input-2 (the part-1 input-1))
(part-3 :type 'b
:input-1 (the part-2 input-1)
:input-2 (the part-2 input-2))))
(define-object b ()
:input-slots
((desc-2 "local value of desc-2" :defaulting)
(desc-1 "local value desc-1")
input-1 input-2 )
:computed-slots
((strings-for-display "B")))
(define-object c (a)
:objects
((part-1 :type 'b
:input-1 10)))
(in-package :gdl-user)
(define-object base-object-tree ()
:input-slots ((depth 0) (max-depth 6) (branch-factor 5))
:computed-slots ((depth*index (* (or (the index) 0) (the depth)))
(leaf-results (mapsend (the leaves) :depth*index)))
:functions ((write-results
(&key (output-path (merge-pathnames "leaf-results.dat" (glisp:temporary-folder))))
(with-format (base-format output-path)
(write-env (:a (the leaf-results))))
output-path))
:objects ((kids :type 'base-object-tree
:sequence (:size (if (<= (the depth) (the max-depth))
(the branch-factor) 0))
:depth (1+ (the depth))
:pass-down (max-depth branch-factor))))
(define-object base-object-tree-noseq ()
:input-slots ((depth 0) (max-depth 6) (branch-factor 5))
:computed-slots ((depth*index (* (or (the index) 0) (the depth)))
(leaf-results (mapsend (the leaves) :depth*index)))
:functions ((write-results
(&key (output-path (merge-pathnames "leaf-results.dat" (glisp:temporary-folder))))
(with-format (base-format output-path)
(</