Commit b5bb39c4 authored by Dave Cooper's avatar Dave Cooper
Browse files

updated build utilities

parent 8d5ca8d5
......@@ -39,7 +39,8 @@
glisp:*genworks-source-home*)
:demo (getf args :demo-days)
;;:init-file-names (getf args :init-file-names)
:init-file-names (getf args :init-file-names)
:pre-load-form (getf args :pre-load-form)
:post-load-form (getf args :post-load-form)
:restart-init-function (getf args :restart-init-function)
:purify t
......
......@@ -11,28 +11,29 @@
Defaults to \"gdl-base.\""
application-name "gdl-base")
("Keyword symbol. Should be one of <tt>:runtime</tt>, <tt>:development</tt>, or <tt>:enterprise</tt>.
("Keyword symbol. Should be one of <tt>:runtime</tt>, <tt>:development</tt>,
or <tt>:enterprise</tt>.
Indicates which level of application should be made. Defaults to :development."
application-class :development)
("Pathname. Indicates the directory to be created or overwritten for producing the distribution.
Defaults to a directory called <tt>(the application-name)</tt> in the user temporary directory,
returned by <tt>(glisp:temporary-folder)</tt>."
("Pathname. Indicates the directory to be created or overwritten for producing
the distribution.
Defaults to a directory called <tt>(the application-name)</tt> in the user
temporary directory, returned by <tt>(glisp:temporary-folder)</tt>."
destination-directory
(merge-pathnames (make-pathname :directory (list :relative (the application-name)))
(glisp:temporary-folder) ))
;;
;; FLAG -- leave this to nil for now while we are working on the basic build.
;;
(pre-load-form `(progn (load ,(merge-pathnames "load.lisp"
glisp:*genworks-source-home*))
(setf (symbol-value (read-from-string
"glisp:*genworks-source-home*")) nil)
(setf (symbol-value (read-from-string
"asdf:*central-registry*")) nil)))
(post-load-form nil)
#+nil
(post-load-form `(progn (load ,(merge-pathnames "load.lisp" glisp:*genworks-source-home*))
(setf (symbol-value (read-from-string "glisp:*genworks-source-home*")) nil)
(setf (symbol-value (read-from-string "asdf:*central-registry*")) nil)))
;;
;; FLAG -- leave this to nil for now while we are working on the basic build.
;;
......@@ -55,14 +56,27 @@ returned by <tt>(glisp:temporary-folder)</tt>."
(glisp:make-gdl-app :application-name (the application-name)
:destination-directory (the destination-directory)
:modules (the modules)
:post-load-form (the post-load-form)
:pre-load-form (the pre-load-form)
:post-load-form (the post-load-form)
:application-class (the application-class)
:demo-days (the demo-days)
;;
;; FLAG -- leave this to nil for now while we are working on the basic build.
;; FLAG -- leave this to nil for now while we are working
;; on the basic build.
;;
;;:init-file-names (the init-file-names)
;;:restart-init-function '(lambda() (gdl:start-gdl :edition :open-source))
:init-file-names (the init-file-names)
;;
;;:restart-init-function '(lambda()
;; (gdl:start-gdl :edition :open-source))
;;
))))
(defun make-gdl-site ()
(gdl-build:make-gdl-app :post-load-form '(progn
(load "~/genworks-1581-pre-git/gdl/dist/src/demos/site/gdl-site.asd")
(asdf:load-system :gdl-site)
(load "~/genworks-1580/gdl/apps/downloads/gdl-downloads.asd")
(asdf:load-system :gdl-downloads))
:demo-days nil))
\ No newline at end of file
(in-package :gdl-user)
(gdl:define-package :gdl-build (:export #:make-gdl-app))
(gdl:define-package :gdl-build (:export #:make-gdl-app #:make-gdl-site))
......@@ -11,7 +11,8 @@ if [ "$os_platform" == "Linux" ]; then
emacs --no-splash --no-init-file -l devo.el $@
elif [ "$os_platform" == "Darwin" ]; then
cl_platform='LispWorks'
/Applications/Aquamacs.app/Contents/MacOS/Aquamacs --no-splash --no-init-file -l devo.el $@
/Applications/Aquamacs.app/Contents/MacOS/Aquamacs --no-splash --no-init-file --load devo.el $@
#/Applications/Emacs.app/Contents/MacOS/Emacs --no-splash --no-init-file -l devo.el $@
fi
(load (expand-file-name "~/quicklisp/slime-helper.el"))
;;(load (expand-file-name "~/quicklisp/slime-helper.el"))
;;
;; FLAG -- learn how to add command line args to inferior-lisp-program
......@@ -65,7 +64,16 @@
;; ignore errors when setting colors in case of running in console
;; terminal (there's probably a better way to test for this).
(ignore-errors (gdl:set-colors))
;;(ignore-errors (gdl:set-colors))
(gdl:set-colors)
(defun gdl:set-font ()
(interactive)
(ignore-errors (set-frame-font "-bitstream-Courier 10 Pitch-normal-normal-normal-*-*-*-*-*-m-0-iso10646-1")))
(gdl:set-font)
(show-paren-mode t)
(require 'cl)
......
......@@ -627,7 +627,6 @@ Common Lisp universal time integer, e.g. 2007-11-30 or
(apply #'make-object (the-object object type) make-object-args))
(defun read-snapshot (&key (filename "/tmp/snap.gdl") object keep-bashed-values? make-object-args keys-to-ignore)
"GDL Instance. Reads the snapshot file indicated by filename. If no optional keyword <tt>object</tt>
argument is given, a new GDL instance based on the data in the snapshot file is returned. If an
......@@ -649,7 +648,6 @@ toplevel inputs as specified in the snapshot file.
)
(error "Invalid object type specifier as first element of second form in ~a.~%"))
(let ((object (cond ((and object keep-bashed-values?) object)
(object (the-object object restore-tree!) object)
(t (progn
......@@ -661,25 +659,35 @@ toplevel inputs as specified in the snapshot file.
(when self (the-object self (set-slot! key (eval expression))))))
(plist-keys value-plist) (plist-values value-plist)))
(do ((form (read in nil nil) (read in nil nil))) ((null form))
(let ((forms-ht (make-hash-table)))
(do ((form (read in nil nil) (read in nil nil)))
((null form))
(push form (gethash (length (first form)) forms-ht)))
(let* ((forms (list-hash forms-ht))
(forms (mapcar #'list (plist-keys forms) (plist-values forms)))
(forms (plist-values (alist2plist (sort forms #'< :key #'first))))
(forms (mapcar #'(lambda(group)
(let ((primaries (remove-if-not #'(lambda(item) (or (getf (rest item) :%primary?%)
(getf (rest item) :element-index-list))) group))
(non-primaries (remove-if #'(lambda(item) (or (getf (rest item) :%primary?%)
(getf (rest item) :element-index-list))) group)))
(append primaries non-primaries))) forms))
(forms (apply #'append forms)))
(dolist (form forms)
(let ((root-path (first form)) (value-plist (rest form)))
(let ((self
(let ((root-path (first form)) (value-plist (rest form)))
(let ((self
(with-error-handling (:timeout nil)
(the-object object (follow-root-path root-path)))
))
(with-error-handling (:timeout nil)
(the-object object (follow-root-path root-path)))))
(when self
(mapc #'(lambda(key expression)
(unless (member key keys-to-ignore)
(when self
(the-object self (set-slot! key (eval expression))))))
(plist-keys value-plist) (plist-values value-plist))))))
;; (restore-ui-object *ui-server* object)
(when self
(mapc #'(lambda(key expression)
(unless (member key keys-to-ignore)
(when self
(the-object self (set-slot! key (eval expression))))))
(plist-keys value-plist) (plist-values value-plist))))))))
object)))))
......
......@@ -16,6 +16,7 @@
#:remote-host
#:replace-regexp
#:socket-bytes-written
#:split-regexp
#:with-timeout-sym
)))
......@@ -94,6 +95,9 @@ please find implementation for the currently running lisp.~%")
0))
(defun split-regexp (regexp string)
(cl-ppcre:split regexp string))
(defun with-timeout-sym ()
"Returns the appropriate symbol for with-timeout, for substitution within macros."
#+allegro 'sys:with-timeout
......
......@@ -60,7 +60,7 @@
(multiple-value-bind (result error)
(ignore-errors
(net.aserve.client:do-http-request
(format nil "http://localhost:~a" port)))
(format nil "http://localhost:~a" port) :timeout 2))
(declare (ignore result))
(when (typep error 'error)
port)))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment