Commit 952c8c7e authored by Dave Cooper's avatar Dave Cooper

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

parent dc0485d0
;;
;; 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 :tasty)
(defun initialize ())
\ No newline at end of file
;;
;; Copyright 2002-2011, 2012 Genworks International
;;
;; This source file is part of the General-purpose Declarative
;; Language project (GDL).
;;
;; 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 :tasty)
(glisp:set-features *these-features*)
\ No newline at end of file
;;
;; Copyright 2002-2011, 2012 Genworks International
;;
;; This source file is part of the General-purpose Declarative
;; Language project (GDL).
;;
;; 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 :yadd)
(defun initialize () (glisp:set-settings *settings*))
\ No newline at end of file
;;
;; Copyright 2002-2011, 2012 Genworks International
;;
;; This source file is part of the General-purpose Declarative
;; Language project (GDL).
;;
;; 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 :yadd)
(defparameter *these-features* (list :yadd))
(defparameter *settings* nil)
\ No newline at end of file
;;
;; Copyright 2002-2011, 2012 Genworks International
;;
;; This source file is part of the General-purpose Declarative
;; Language project (GDL).
;;
;; 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 :yadd)
(glisp:set-features *these-features*)
("package" "genworks" "presets" "parameters" "metaclasses" "utilities")
\ No newline at end of file
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)
(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)
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)
(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.")
;;
;; FLAG this belongs in :geom-base.
;;
(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 the system detects circular references
in messages. Defaults to NIL.")
(defvar *run-with-circular-reference-detection?* nil
"Boolean. This is a runtime switch. Determines whether the system 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 the system 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 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 the system 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 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 the system 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 base by itself, it requires the :gwl system as well.
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)
(in-package :base)
(glisp:set-default-float-format)
(glisp:set-defpackage-behavior)
;;
;; 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)
(defparameter *features-to-initialize* (list :base :glisp :geom-base :gwl
:gwl-graphics :tasty :yadd :robot :cl-lite))
(defun start-gendl! (&key (features *features-to-initialize*))
(dolist (feature features)
;;
;; This assumes feature name = package name of its initialize!
;; function. This is the case now. Let's hope we can keep it that
;; way.
;;
(let ((package feature))
(if (and (find-package package) (glisp:featurep feature))
(let ((function-sym (read-from-string (format nil "~a::initialize" package))))
(if (fboundp function-sym)
(let ((description (glisp:package-documentation package)))
(format t "~&Initializing ~a subsystem...~%" description)
(let ((anything-changed? (funcall function-sym)))
(format t "~&...Done~a~%"
(if anything-changed? "."
(format nil " (no new global settings).")))))
(format t "~&Note: Feature ~s appears to be loaded, but has no initialize! function.~%"
feature)))
(format t "~&Note: Feature ~s does not appear to be loaded at this time.~%" feature))))
(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/
"))
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)
(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, 2012 Genworks International
;;
;; This source file is part of the General-purpose Declarative
;; Language project (GDL).
;;
;; 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 :gendl)
(defparameter *these-features* (list :base))
(glisp:set-features *these-features*)
("package" "parameters")
\ 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 :cl-lite)
(defun initialize ())
\ No newline at end of file
;;
;; Copyright 2002, 2009 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/>.
;;
(in-package :gdl-user)
(gdl:define-package :cl-lite
(:documentation "Compile & Load Lite")
(:export #:cl-lite #:codebase-directory-node))
;;
;; Copyright 2002, 2009 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/>.
;;
(in-package :cl-lite)
(defparameter *these-features* (list :cl-lite))
;;
;; Copyright 2002-2011, 2012 Genworks International
;;
;; This source file is part of the General-purpose Declarative
;; Language project (GDL).
;;
;; 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 :cl-lite)
(glisp:set-features *these-features*)
\ 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 :robot)
(defun initialize ())
\ No newline at end of file
;;
;; Copyright 2002, 2009 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/>.
;;
(in-package :robot)
(defparameter *these-features* (list :robot))
(defparameter *settings* nil)