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")))
(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/gdl2xml")
(:file "xml/source/xml2gdl"))) (:file "xml/source/xml2gdl")))
(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")
......
(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
(let ((new-value (if (functionp new-value-or-func)
(funcall new-value-or-func) new-value-or-func)))
(unless (equalp (symbol-value symbol) new-value) (unless (equalp (symbol-value symbol) new-value)
(setf (symbol-value symbol) new-value)
(setq anything-changed? t) (setq anything-changed? t)
(format t "Setting ~s from default value ~s to non-default value.~%" (format t "~&Set ~s from default value ~s to non-default value ~s.~%"
symbol default) symbol default new-value))))) anything-changed?))
(setf (symbol-value symbol) 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 ;;
;; This has to be able to be a string in case it has e.g. #-allegro
;; conditionals in it.
;;
(asdf-depends-on (let ((sexpr (glisp:sexpr-from-file
(merge-pathnames (make-pathname :name "depends-on" (merge-pathnames (make-pathname :name "depends-on"
:type "isc") :type "isc")
(the ppathname)))) (the ppathname)))))
(when (probe-file depends-on-file) (if (stringp sexpr)
(with-open-file (in depends-on-file) (format nil "%%remove%%~a%%remove%%" sexpr) sexpr)))
(read in)))))
(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"
...@@ -295,15 +298,33 @@ Defaults to nil (i.e. we assume we are loading into a clean system and need all ...@@ -295,15 +298,33 @@ Defaults to nil (i.e. we assume we are loading into a clean system and need all
((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))
#-(or allegro lispworks sbcl ccl) (error "~&Please implement concatenate-fasls for the currently running lisp.~%")
#+(or allegro sbcl)
;;
;; Provided by Franz:
;;
;; copy the contents of all files to the file named dest.
;; append .fasl to the filenames
(let ((buffer (make-array 4096 :element-type