Commit 03eff33b authored by Dave Cooper's avatar Dave Cooper
Browse files

Re-arranged the system dependencies, added ability to use lambda function for...

Re-arranged the system dependencies, added ability to use lambda function for new-value of global settings.
parent 83911586
(defsystem #:ta2 :description (asdf:defsystem #:ta2 :description
"Auto-generated asdf defsys from Genworks GenDL cl-lite. Please avoid hand-editing." "Auto-generated asdf defsys from Genworks GenDL cl-lite. Please avoid hand-editing."
:author "Dave Cooper and Genworks International" :license :author "Dave Cooper and Genworks International" :license
"Gnu Affero General Public License (please see http://www.gnu.org/licenses/)" "Gnu Affero General Public License (please see http://www.gnu.org/licenses/)"
:serial t :version "20130315" :depends-on (:gwl-graphics) :serial t :version "20130316" :depends-on (:gwl-graphics)
:components :components
((:file "source/package") (:file "source/parameters") ((:file "source/package") (:file "source/parameters")
(:file "source/javascript") (:file "source/javascript") (:file "source/action-object")
(:file "source/action-object") (:file "source/ajax") (:file "source/ajax") (:file "source/assembly")
(:file "source/assembly") (:file "source/click-mode") (:file "source/click-mode") (:file "source/inspector")
(:file "source/inspector") (:file "source/object-tree") (:file "source/object-tree") (:file "source/part-type-form")
(:file "source/part-type-form") (:file "source/publish") (:file "source/publish") (:file "source/viewport")))
(:file "source/viewport")))
\ No newline at end of file
(defsystem #:tasty :description (asdf:defsystem #:tasty :description
"Auto-generated asdf defsys from Genworks GenDL cl-lite. Please avoid hand-editing." "Auto-generated asdf defsys from Genworks GenDL cl-lite. Please avoid hand-editing."
:author "Dave Cooper and Genworks International" :license :author "Dave Cooper and Genworks International" :license
"Gnu Affero General Public License (please see http://www.gnu.org/licenses/)" "Gnu Affero General Public License (please see http://www.gnu.org/licenses/)"
:serial t :version "20130315" :depends-on :serial t :version "20130316" :depends-on (:tree :gwl-graphics)
(:tree :gwl-graphics) :components :components
((:file "source/package") (:file "source/parameters") ((:file "source/package") (:file "source/parameters")
(:file "source/assembly") (:file "source/inspector") (:file "source/assembly") (:file "source/inspector")
(:file "source/menu") (:file "source/new-inspector") (:file "source/menu") (:file "source/new-inspector")
(:file "source/newer-inspector") (:file "source/newer-inspector") (:file "source/part-type-form")
(:file "source/part-type-form") (:file "source/publish") (:file "source/publish") (:file "source/status-object")
(:file "source/status-object") (:file "source/test-part") (:file "source/test-part") (:file "source/test-part2")
(:file "source/test-part2") (:file "source/two-viewports") (:file "source/viewport")))
(:file "source/two-viewports") (:file "source/viewport")))
\ No newline at end of file
(defsystem #:translators :description (asdf:defsystem #:translators :description
"Auto-generated asdf defsys from Genworks GenDL cl-lite. Please avoid hand-editing." "Auto-generated asdf defsys from Genworks GenDL cl-lite. Please avoid hand-editing."
:author "Dave Cooper and Genworks International" :license :author "Dave Cooper and Genworks International" :license
"Gnu Affero General Public License (please see http://www.gnu.org/licenses/)" "Gnu Affero General Public License (please see http://www.gnu.org/licenses/)"
:serial t :version "20130315" :depends-on nil :components :serial t :version "20130316" :depends-on nil :components
((:file "xml/source/package") ((:file "xml/source/package") (:file "xml/source/genworks")
(:file "xml/source/genworks") (:file "xml/source/definition-tree") (:file "xml/source/gdl2xml")
(:file "xml/source/definition-tree") (:file "xml/source/xml2gdl")))
(:file "xml/source/gdl2xml")
(:file "xml/source/xml2gdl")))
\ No newline at end of file
(defsystem #:tree :description (asdf:defsystem #:tree :description
"Auto-generated asdf defsys from Genworks GenDL cl-lite. Please avoid hand-editing." "Auto-generated asdf defsys from Genworks GenDL cl-lite. Please avoid hand-editing."
:author "Dave Cooper and Genworks International" :license :author "Dave Cooper and Genworks International" :license
"Gnu Affero General Public License (please see http://www.gnu.org/licenses/)" "Gnu Affero General Public License (please see http://www.gnu.org/licenses/)"
:serial t :version "20130315" :depends-on (:gwl-graphics) :serial t :version "20130316" :depends-on (:gwl-graphics)
:components :components
((:file "source/package") (:file "source/parameters") ((:file "source/package") (:file "source/parameters")
(:file "source/ajax") (:file "source/assembly") (:file "source/ajax") (:file "source/assembly")
(:file "source/newertree"))) (:file "source/newertree")))
\ No newline at end of file
(defsystem #:yadd :description (asdf:defsystem #:yadd :description
"Auto-generated asdf defsys from Genworks GenDL cl-lite. Please avoid hand-editing." "Auto-generated asdf defsys from Genworks GenDL cl-lite. Please avoid hand-editing."
:author "Dave Cooper and Genworks International" :license :author "Dave Cooper and Genworks International" :license
"Gnu Affero General Public License (please see http://www.gnu.org/licenses/)" "Gnu Affero General Public License (please see http://www.gnu.org/licenses/)"
:serial t :version "20130315" :depends-on (:gwl-graphics) :serial t :version "20130316" :depends-on (:gwl-graphics)
:components :components
((:file "source/package") (:file "source/genworks") ((:file "source/package") (:file "source/genworks")
(:file "source/mixins") (:file "source/mixins")
(:file "source/define-object-documentation") (:file "source/define-object-documentation")
(:file "source/assembly") (:file "source/ass") (:file "source/assembly") (:file "source/ass")
(:file "source/format-documentation") (:file "source/format-documentation")
(:file "source/function-documentation") (:file "source/function-documentation") (:file "source/publish")
(:file "source/publish") (:file "source/test-part") (:file "source/test-part") (:file "source/variable-documentation")))
(:file "source/variable-documentation")))
\ No newline at end of file
...@@ -292,19 +292,21 @@ ...@@ -292,19 +292,21 @@
(defun set-settings (settings) (defun set-settings (settings)
(let (anything-changed?) (let (anything-changed?)
(dolist (setting settings) (dolist (setting settings)
(destructuring-bind (symbol default new-value) setting (destructuring-bind (symbol default new-value-or-func) setting
(unless (equalp (symbol-value symbol) new-value) (let ((new-value (if (functionp new-value-or-func)
(setq anything-changed? t) (funcall new-value-or-func) new-value-or-func)))
(format t "Setting ~s from default value ~s to non-default value.~%" (unless (equalp (symbol-value symbol) new-value)
symbol default) (setf (symbol-value symbol) new-value)
(setf (symbol-value symbol) new-value)))) anything-changed?)) (setq anything-changed? t)
(format t "~&Set ~s from default value ~s to non-default value ~s.~%"
symbol default new-value))))) anything-changed?))
(defun set-features (features) (defun set-features (features)
(let (anything-changed?) (let (anything-changed?)
(dolist (feature features) (dolist (feature features)
(dolist (feature (make-versioned-features feature)) (dolist (feature (make-versioned-features feature))
(unless (or (null feature) (glisp:featurep feature)) (unless (or (null feature) (glisp:featurep feature))
(format t "Pushing ~s onto *features* list.~%" feature) (format t "~&Pushing ~s onto *features* list.~%" feature)
(push feature *features*) (push feature *features*)
(setq anything-changed? t)))) anything-changed?)) (setq anything-changed? t)))) anything-changed?))
......
...@@ -200,7 +200,6 @@ If you are interested in this effort we would love to hear from you at open-sour ...@@ -200,7 +200,6 @@ If you are interested in this effort we would love to hear from you at open-sour
#:remove-plist-key #:remove-plist-key
#:remove-plist-entry #:remove-plist-entry
#:remove-plist-keys #:remove-plist-keys
#:replace-regexp*
#:replace-substring #:replace-substring
#:restore-ui-object #:restore-ui-object
#:retitle-emacs #:retitle-emacs
...@@ -303,6 +302,7 @@ If you are interested in this effort we would love to hear from you at open-sour ...@@ -303,6 +302,7 @@ If you are interested in this effort we would love to hear from you at open-sour
#:set-features #:set-features
#:set-settings #:set-settings
#:set-window-titles #:set-window-titles
#:sexpr-from-file
#:source-pathname #:source-pathname
#:system-home #:system-home
#:set-genworks-source-home-if-known #:set-genworks-source-home-if-known
...@@ -314,9 +314,6 @@ If you are interested in this effort we would love to hear from you at open-sour ...@@ -314,9 +314,6 @@ If you are interested in this effort we would love to hear from you at open-sour
#:xref-off #:xref-off
#:xref-on #:xref-on
;;
;; Implemented in gdl/cl-lite/source/genworks.lisp.
;;
#:*fasl-extension* #:*fasl-extension*
#:concatenate-fasls #:concatenate-fasls
#:directory-list #:directory-list
...@@ -324,18 +321,13 @@ If you are interested in this effort we would love to hear from you at open-sour ...@@ -324,18 +321,13 @@ If you are interested in this effort we would love to hear from you at open-sour
#:temporary-folder #:temporary-folder
#:temporary-file #:temporary-file
;;
;; Implemented in gdl/geom-base/prereqs/source/genworks.lisp
;;
#:find-gs-path #:find-gs-path
#:get-pid #:get-pid
#:run-gs #:run-gs
#:set-gs-path #:set-gs-path
#:run-program #:run-program
#:run-shell-command #:run-shell-command
;;
;; Implemented in gdl/gwl/source/genworks.lisp
;;
#:*enable-utf8?* #:*enable-utf8?*
#:*base64-encode-func* #:*base64-encode-func*
#:*base64-decode-func* #:*base64-decode-func*
...@@ -358,17 +350,13 @@ If you are interested in this effort we would love to hear from you at open-sour ...@@ -358,17 +350,13 @@ If you are interested in this effort we would love to hear from you at open-sour
#:with-timeout-sym #:with-timeout-sym
#:with-timeout #:with-timeout
;;
;; Implemented in regression/utils/source/genworks.lisp
;;
#:close-old-areas #:close-old-areas
#:open-old-areas #:open-old-areas
#:get-mem-info #:get-mem-info
#:gc-scavenge #:gc-scavenge
;;
;; Implemented in build/source/genworks.lisp
;;
#:copy-directory #:copy-directory
#:copy-file #:copy-file
#:delete-directory-and-files #:delete-directory-and-files
...@@ -378,17 +366,12 @@ If you are interested in this effort we would love to hear from you at open-sour ...@@ -378,17 +366,12 @@ If you are interested in this effort we would love to hear from you at open-sour
#:make-gendl-app #:make-gendl-app
#:next-datestamp #:next-datestamp
;;
;; Implemented in gdl/apps/yadd/source/genworks.lisp
;;
#:autoloaded-packages #:autoloaded-packages
#:package-documentation #:package-documentation
#:function-documentation #:function-documentation
#:variable-documentation #:variable-documentation
;;
;; Implemented in gdl/apps/translators/xml/source/genworks.lisp
;;
#:parse-xml #:parse-xml
)) ))
...@@ -804,6 +787,7 @@ If you are interested in this effort we would love to hear from you at open-sour ...@@ -804,6 +787,7 @@ If you are interested in this effort we would love to hear from you at open-sour
#:*break-on-set-self?* #:*break-on-set-self?*
#:*jump-to-toplevel-on-set-self?* #:*jump-to-toplevel-on-set-self?*
#:*process-cookies?* #:*process-cookies?*
#:*static-home*
#:encode-root-path #:encode-root-path
#:base-html-sheet #:base-html-sheet
#:skeleton-ui-element #:skeleton-ui-element
......
...@@ -30,7 +30,7 @@ ...@@ -30,7 +30,7 @@
(defparameter *packages-to-initialize* (list :gdl :geom-base :gwl)) (defparameter *packages-to-initialize* (list :gdl :geom-base :gwl))
(defun start-gendl! (&key packages *packages-to-initialize*) w(defun start-gendl! (&key (packages *packages-to-initialize*))
(dolist (package packages) (dolist (package packages)
(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))))
......
(defsystem #:cl-lite :description (asdf:defsystem #:cl-lite :description
"Auto-generated asdf defsys from Genworks GenDL cl-lite. Please avoid hand-editing." "Auto-generated asdf defsys from Genworks GenDL cl-lite. Please avoid hand-editing."
:author "Dave Cooper and Genworks International" :license :author "Dave Cooper and Genworks International" :license
"Gnu Affero General Public License (please see http://www.gnu.org/licenses/)" "Gnu Affero General Public License (please see http://www.gnu.org/licenses/)"
:serial t :version "20130315" :depends-on (:base :cl-fad) :serial t :version "20130316" :depends-on (:glisp) :components
:components ((:file "source/cl-lite")))
((:file "source/genworks") (:file "source/cl-lite")))
...@@ -94,11 +94,10 @@ given as keyword args to this function)." ...@@ -94,11 +94,10 @@ given as keyword args to this function)."
(base-device (pathname-device (base-device (pathname-device
(translate-logical-pathname pathname-host))) (translate-logical-pathname pathname-host)))
(config-spec (with-open-file (in (make-pathname :directory (append base-dir (list "configs")) (config-spec (glisp:sexpr-from-file (make-pathname :directory (append base-dir (list "configs"))
:device base-device :device base-device
:name config-name :name config-name
:type "config")) :type "config")))
(read in)))
(bin-files (bin-files
(apply #'append (apply #'append
(mapcar #'cl-lite (mapcar #'cl-lite
...@@ -160,7 +159,7 @@ given as keyword args to this function)." ...@@ -160,7 +159,7 @@ given as keyword args to this function)."
(list (the pathname) (user-homedir-pathname))))) (list (the pathname) (user-homedir-pathname)))))
(dolist (file files-to-check) (dolist (file files-to-check)
(when (probe-file file) (when (probe-file file)
(return (with-open-file (in file) (read in)))))))) (return (glisp:sexpr-from-file file)))))))
:input-slots :input-slots
( (
...@@ -275,13 +274,17 @@ Defaults to nil (i.e. we assume we are loading into a clean system and need all ...@@ -275,13 +274,17 @@ Defaults to nil (i.e. we assume we are loading into a clean system and need all
(error "Could not create ~a in ~a.~%Directory does not exist.~%" (error "Could not create ~a in ~a.~%Directory does not exist.~%"
asd-file-name (the pathname))))) asd-file-name (the pathname)))))
(asdf-depends-on (let ((depends-on-file ;;
(merge-pathnames (make-pathname :name "depends-on" ;; This has to be able to be a string in case it has e.g. #-allegro
:type "isc") ;; conditionals in it.
(the ppathname)))) ;;
(when (probe-file depends-on-file) (asdf-depends-on (let ((sexpr (glisp:sexpr-from-file
(with-open-file (in depends-on-file) (merge-pathnames (make-pathname :name "depends-on"
(read in))))) :type "isc")
(the ppathname)))))
(if (stringp sexpr)
(format nil "%%remove%%~a%%remove%%" sexpr) sexpr)))
(additional-asd-code (let ((asd-code-file (additional-asd-code (let ((asd-code-file
(merge-pathnames (make-pathname :name "additional-asd-code" (merge-pathnames (make-pathname :name "additional-asd-code"
...@@ -294,16 +297,34 @@ Defaults to nil (i.e. we assume we are loading into a clean system and need all ...@@ -294,16 +297,34 @@ Defaults to nil (i.e. we assume we are loading into a clean system and need all
(do ((form (read in nil nil) (read in nil nil))) (do ((form (read in nil nil) (read in nil nil)))
((null form) (nreverse result)) ((null form) (nreverse result))
(push form result)))))))) (push form result))))))))
(asdf-system-list ;;
;; sanitize any strings for the depends-on
;;
(asdf-system-lines (let ((temp-file (glisp:temporary-file)))
(with-open-file (out temp-file :direction :output
:if-exists :supersede
:if-does-not-exist :create)
(pprint (the %asdf-system-list) out))
(with-open-file (in temp-file)
(let (result)
(do ((line (read-line in nil) (read-line in nil)))
((null line) (nreverse result))
(push (glisp:replace-regexp
(glisp:replace-regexp line "%%remove%%\"" "")
"\"%%remove%%" "") result))))))
(%asdf-system-list
(let ((binaries (the compile-and-load))) (let ((binaries (the compile-and-load)))
(append `(,(read-from-string "asdf:defsystem") ,(read-from-string (format nil "#:~a" (pathname-name (the asd-file)))) (append `("%%remove%%asdf:defsystem%%remove%%"
,(read-from-string (format nil "#:~a" (pathname-name (the asd-file))))
:description ,(the description) :description ,(the description)
:author ,(the author) :author ,(the author)
:license ,(the license) :license ,(the license)
:serial t :serial t
:version ,(the version) :version ,(the version)
:depends-on ,(the asdf-depends-on) :depends-on ,(the asdf-depends-on)
;; ;;
;; FLAG -- maybe can get rid of binaries and need to call (the compile-and-load) ;; FLAG -- maybe can get rid of binaries and need to call (the compile-and-load)
;; ;;
...@@ -374,9 +395,12 @@ Defaults to nil (i.e. we assume we are loading into a clean system and need all ...@@ -374,9 +395,12 @@ Defaults to nil (i.e. we assume we are loading into a clean system and need all
:if-exists :supersede :if-exists :supersede
:if-does-not-exist :create) :if-does-not-exist :create)
(let ((*print-right-margin* 70) (let ((*print-right-margin* 70)
(*print-case* :downcase) (*print-case* :downcase))
(*package* (find-package :asdf)))
(pprint (the asdf-system-list) out) (dolist (line (the asdf-system-lines))
(write-string line out)
(format out "~%"))
(when (the additional-asd-code) (when (the additional-asd-code)
(format out "~%~%") (format out "~%~%")
(pprint (the additional-asd-code) out)))) (pprint (the additional-asd-code) out))))
...@@ -473,14 +497,11 @@ Defaults to nil (i.e. we assume we are loading into a clean system and need all ...@@ -473,14 +497,11 @@ Defaults to nil (i.e. we assume we are loading into a clean system and need all
source-files-to-ignore) source-files-to-ignore)
:computed-slots :computed-slots
((ordering-bias (let ((ordering-info-file ((ordering-bias (glisp:sexpr-from-file (make-pathname
(make-pathname :directory (pathname-directory (the :pathname))
:directory (pathname-directory (the :pathname)) :device (the :device)
:device (the :device) :name "file-ordering"
:name "file-ordering" :type "isc")))
:type "isc")))
(when (probe-file ordering-info-file)
(with-open-file (in ordering-info-file) (read in)))))
;; ;;
;; FLAG -- read this info once in the parent directory object, not here for each file! ;; FLAG -- read this info once in the parent directory object, not here for each file!
...@@ -488,14 +509,12 @@ Defaults to nil (i.e. we assume we are loading into a clean system and need all ...@@ -488,14 +509,12 @@ Defaults to nil (i.e. we assume we are loading into a clean system and need all
;; FLAG -- convert to use read-isc-file function ;; FLAG -- convert to use read-isc-file function
;; ;;
;; ;;
(ignore-list (let ((ignore-list-file (ignore-list (glisp:sexpr-from-file (make-pathname
(make-pathname :directory (pathname-directory (the :pathname))
:directory (pathname-directory (the :pathname)) :device (the :device)
:device (the :device) :name "ignore-list"
:name "ignore-list" :type "isc")))
:type "isc")))
(when (probe-file ignore-list-file)
(with-open-file (in ignore-list-file) (read in)))))
(relevant-files (let (key) (relevant-files (let (key)
(mapcar #'(lambda (thing) (mapcar #'(lambda (thing)
(if (not (listp thing)) (if (not (listp thing))
...@@ -595,22 +614,20 @@ Defaults to nil (i.e. we assume we are loading into a clean system and need all ...@@ -595,22 +614,20 @@ Defaults to nil (i.e. we assume we are loading into a clean system and need all
;; ;;
;; FLAG -- convert to use read-isc-file function. ;; FLAG -- convert to use read-isc-file function.
;; ;;
(ordering-bias (let ((ordering-info-file (ordering-bias (glisp:sexpr-from-file
(make-pathname (make-pathname
:directory (pathname-directory (the :pathname)) :directory (pathname-directory (the :pathname))
:device (the :device) :device (the :device)
:name "system-ordering" :name "system-ordering"
:type "isc"))) :type "isc")))
(when (probe-file ordering-info-file)
(with-open-file (in ordering-info-file) (read in))))) (ignore-list (glisp:sexpr-from-file
(ignore-list (let ((ignore-list-file (make-pathname
(make-pathname :directory (pathname-directory (the :pathname))
:directory (pathname-directory (the :pathname)) :device (the :device)
:device (the :device) :name "ignore-list"
:name "ignore-list" :type "isc")))
:type "isc")))
(when (probe-file ignore-list-file)
(with-open-file (in ignore-list-file) (read in)))))
(subdir-pathnames-unordered (sort (subdir-pathnames-unordered (sort
(set-difference (set-difference
(mapcar #'pathname-directory (mapcar #'pathname-directory
......
;;
;; Copyright 2002-2011 Genworks International and Genworks BV
;;
;; 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/>.
;;
("genworks")
;;
;; 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 :com.genworks.lisp)
(defparameter *fasl-extension*
#+allegro excl:*fasl-default-type*
#+lispworks compiler:*fasl-extension-string*
#+sbcl sb-fasl:*fasl-file-type*
#+ccl (namestring ccl:*.fasl-pathname*)
#+abcl "abcl"
#+clisp "fas"
#-(or allegro lispworks sbcl ccl abcl clisp) (error "Need fasl extension string for the currently running lisp.~%"))
#-(or allegro lispworks sbcl ccl)
(warn "~&Please implement concatenate-fasls for the currently running lisp.~%")
(defun concatenate-fasls (files dest)
#-(or allegro lispworks sbcl ccl) (declare (ignore files dest))