Commit 200e10dc authored by Dave Cooper's avatar Dave Cooper
Browse files

generated asd files for surf and smlib using full pathnames - asd/ql load now works.

parent ac36d300
#!/bin/bash
cd `dirname "$0"`
os_platform=`uname`
export cl_platform=''
if [ "$os_platform" == "Linux" ]; then
cl_platform='Allegro'
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 --load devo.el $@
#/Applications/Emacs.app/Contents/MacOS/Emacs --no-splash --no-init-file -l devo.el $@
fi
#!/bin/bash
cd `dirname "$0"`
export os_platform=`uname`
export cl_platform=''
if [ "$os_platform" == "Linux" ]; then
cl_platform='Allegro'
emacs --no-splash --no-init-file -l devo.el $@
elif [ "$os_platform" == "Darwin" ]; then
cl_platform='LispWorks'
/Applications/Emacs.app/Contents/MacOS/Emacs --no-splash --no-init-file -l devo.el $@
fi
......@@ -2,25 +2,24 @@
(load (expand-file-name "../../common/quicklisp/slime-helper.el"))
(setq slime-lisp-implementations
'((acl82m-win-x86 ("../../common/acl82-win-x86/mlisp.exe"))
(acl82a-win-x86 ("../../common/acl82-win-x86/alisp.exe"))))
;;
;; FLAG -- learn how to add command line args to inferior-lisp-program
;; to load load.lisp for Genworks GDL automatically.
;;
;;(if (string= (getenv "cl_platform") "LispWorks")
;; (setq inferior-lisp-program "~/bin/lw-console")
;; (if (string= (getenv "cl_platform") "Allegro")
;; (setq inferior-lisp-program "/usr/local/acl/mlisp")
;; (if (file-exists-p "c:/program files (x86)/acl82/mlisp.exe")
;; (setq inferior-lisp-program "c:/program files (x86)/acl82/mlisp.exe")
;; (error "Don't know what CL executable to use"))))
(setq slime-lisp-implementations
(cond ((and (string= (getenv "cl_platform") "LispWorks")
(string= (getenv "os_platform") "Darwin"))
'((lw60-macosx-x86 ("../../common/lw60-macosx-x86/lw-console"))))
((and (string= (getenv "cl_platform") "Allegro")
(string= (getenv "os_platform") "Linux"))
'((acl82m-linux-x86 ("../../common/acl82-linux-x86/mlisp"))
(acl82a-linux-x86 ("../../common/acl82-linux-x86/alisp"))))
(t '((acl82m-win-x86 ("../../common/acl82-win-x86/mlisp.exe"))
(acl82a-win-x86 ("../../common/acl82-win-x86/alisp.exe"))))))
(defun gdl () (interactive) (slime ))
(setq gdl:*gdl-toplevel* "*slime-repl allegro*")
(setq gdl:*gdl-toplevel* (concat "*" "slime-repl " (symbol-name (first (first slime-lisp-implementations))) "*"))
(setq gdl:*inferior-lisp* "*inferior-lisp*")
(require 'slime-autoloads)
......
......@@ -150,7 +150,7 @@ o filter inspector slots to local slots
(viewport :type 'viewport
:pass-down (root-object color-selected)
:pass-down (root-object)
:line-thickness-selected (the menu-section line-thickness-selected)
:color (the menu-section color)
:inspected-object (the inspector node)
......@@ -166,14 +166,9 @@ o filter inspector slots to local slots
(inspector :type 'inspector
:pass-down (root-object)
:click-mode (the click-mode value)
:length (getf (the inspector-dimensions) :length)
:width (getf (the inspector-dimensions) :width)
:relative-font-size (the inspector-relative-font-size)
:display-controls-hash (the viewport display-controls-hash)
:tatu-root self
;;:respondent self
)
:tatu-root self)
(viewport-status-object :type 'status-object
:status-message (the viewport digitation-mode))
......@@ -394,8 +389,8 @@ The error was: ~a
)
((:div :class "outer-north ui-widget pane")
(str (the menu-section main-div))
)
((:div :onmouseover "InnerLayout.allowOverflow(this)")
(str (the menu-section main-div))))
((:div :class "outer-south ui-widget pane")
((:div :class "footer ui-widget-header")
......
File mode changed from 100755 to 100644
;;
;; 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/>.
;;
(in-package :gdl)
(defparameter *gdl-init-functions* nil)
(defun start-gdl (&key edition)
(mapc #'(lambda(function)
(funcall function :edition edition))
(reverse *gdl-init-functions*))
(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)))))
(pushnew #'load-gdl-init-files *gdl-init-functions*)
(defun startup-banner (&key edition)
(glisp:display-startup-banner edition
"
Copyright 2002-2011 Genworks International and Genworks BV
This is the General-purpose Declarative Language (GDL).
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/
"))
(pushnew #'startup-banner *gdl-init-functions*)
;;
;; FLAG -- do some of these at beginning of bootstrapping, others
;; defer until end of loading everything.
;;
(defun initialize-gdl (&key edition)
(declare (ignore edition))
(glisp:set-local-compiler-tweaks)
(glisp:set-defpackage-behavior)
(glisp:set-default-float-format)
(glisp:set-default-package)
(glisp:xref-off)
(glisp:set-window-titles))
(pushnew #'initialize-gdl *gdl-init-functions*)
;;
;; 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/>.
;;
(in-package :gdl)
(defparameter *gdl-init-functions* nil)
(defun start-gdl (&key edition)
(mapc #'(lambda(function)
(funcall function :edition edition))
(reverse *gdl-init-functions*))
(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)))))
(pushnew #'load-gdl-init-files *gdl-init-functions*)
(defun startup-banner (&key edition)
(glisp:display-startup-banner edition
"
Copyright 2002-2011 Genworks International and Genworks BV
This is the General-purpose Declarative Language (GDL).
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/
"))
(pushnew #'startup-banner *gdl-init-functions*)
;;
;; FLAG -- do some of these at beginning of bootstrapping, others
;; defer until end of loading everything.
;;
(defun initialize-gdl (&key edition)
(declare (ignore edition))
(glisp:set-local-compiler-tweaks)
(glisp:set-defpackage-behavior)
(glisp:set-default-float-format)
(glisp:set-default-package)
(glisp:xref-off)
(glisp:set-window-titles))
(pushnew #'initialize-gdl *gdl-init-functions*)
......@@ -37,7 +37,8 @@ supports a full range of output options such as page dimensions, view transforms
(let ((*stream* (if (or (stringp ,stream-or-file) (pathnamep ,stream-or-file))
(open ,stream-or-file :if-does-not-exist :create
:if-exists :supersede :direction :output
:external-format ,(or external-format :default))
;;:external-format ,(or external-format :default)
)
,stream-or-file))
(,flag t))
(unwind-protect
......
;;
;; 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/>.
;;
(in-package :gwl)
(defun publish-images ()
(with-all-servers (server)
(publish-directory
:prefix "/images/gwl/"
:server server
:destination (if (and (glisp:patches-dir)
(probe-file (merge-pathnames "static/gwl/images/" (glisp:patches-dir))))
(format nil "~a" (merge-pathnames "static/gwl/images/" (glisp:patches-dir)))
(format nil "~a" (merge-pathnames "gdl/gwl/static/gwl/images/"
glisp:*genworks-source-home*))))))
(defun publish-statics ()
(with-all-servers (server)
(publish-directory
:prefix "/static/"
:server server
:destination (if (and (glisp:patches-dir)
(probe-file (merge-pathnames "static/" (glisp:patches-dir))))
(format nil "~a" (merge-pathnames "static/" (glisp:patches-dir)))
(format nil "~a" (merge-pathnames "gdl/gwl/static/"
glisp:*genworks-source-home*))))))
(defun publish-style ()
(with-all-servers (server)
(publish-directory
:prefix "/style/"
:server server
:destination (if (and (glisp:patches-dir)
(probe-file (merge-pathnames "static/style/" (glisp:patches-dir))))
(format nil "~a" (merge-pathnames "static/style/" (glisp:patches-dir)))
(format nil "~a" (merge-pathnames "gdl/gwl/static/style/"
glisp:*genworks-source-home*))))))
(defvar *aserve-listeners* 25)
(defun client-test (port)
(multiple-value-bind (result error)
(ignore-errors
(net.aserve.client:do-http-request
(format nil "http://localhost:~a" port) :timeout 2))
(declare (ignore result))
(when (typep error 'error)
port)))
(defun start-gwl (&key (port 9000) (listeners *aserve-listeners*))
(net.aserve:shutdown)
(let ((port port))
(do ((error (client-test port) (client-test port)))
(error (format t "~&~%Starting AllegroServe on ~a...~%~%" port)
(net.aserve:start :port port :listeners listeners)
port)
(incf port))))
(defun initialize-gwl (&key edition) (declare (ignore edition))
;;(glisp:initialize-multiprocessing)
(publish-images)
(publish-statics)
(publish-style)
(glisp:load-html-parser)
(start-gwl))
(push #'initialize-gwl *gdl-init-functions*)
(format t "
Initializing GWL static directories --
NOTE this should be done as part of an official startup function...
")
(initialize-gwl)
;;
;; 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/>.
;;
(in-package :gwl)
(defun publish-images ()
(with-all-servers (server)
(publish-directory
:prefix "/images/gwl/"
:server server
:destination (if (and (glisp:patches-dir)
(probe-file (merge-pathnames "static/gwl/images/" (glisp:patches-dir))))
(format nil "~a" (merge-pathnames "static/gwl/images/" (glisp:patches-dir)))
(format nil "~a" (merge-pathnames "gdl/gwl/static/gwl/images/"
glisp:*genworks-source-home*))))))
(defun publish-statics ()
(with-all-servers (server)
(publish-directory
:prefix "/static/"
:server server
:destination (if (and (glisp:patches-dir)
(probe-file (merge-pathnames "static/" (glisp:patches-dir))))
(format nil "~a" (merge-pathnames "static/" (glisp:patches-dir)))
(format nil "~a" (merge-pathnames "gdl/gwl/static/"
glisp:*genworks-source-home*))))))
(defun publish-style ()
(with-all-servers (server)
(publish-directory
:prefix "/style/"
:server server
:destination (if (and (glisp:patches-dir)
(probe-file (merge-pathnames "static/style/" (glisp:patches-dir))))
(format nil "~a" (merge-pathnames "static/style/" (glisp:patches-dir)))
(format nil "~a" (merge-pathnames "gdl/gwl/static/style/"
glisp:*genworks-source-home*))))))
(defvar *aserve-listeners* 25)
(defun client-test (port)
(multiple-value-bind (result error)
(ignore-errors
(net.aserve.client:do-http-request
(format nil "http://localhost:~a" port) :timeout 2))
(declare (ignore result))
(when (typep error 'error)
port)))
(defun start-gwl (&key (port 9000) (listeners *aserve-listeners*))
(net.aserve:shutdown)
(let ((port port))
(do ((error (client-test port) (client-test port)))
(error (format t "~&~%Starting AllegroServe on ~a...~%~%" port)
(net.aserve:start :port port :listeners listeners)
port)
(incf port))))
(defun initialize-gwl (&key edition) (declare (ignore edition))
;;(glisp:initialize-multiprocessing)
(publish-images)
(publish-statics)
(publish-style)
(glisp:load-html-parser)
(start-gwl))
(push #'initialize-gwl *gdl-init-functions*)
(format t "
Initializing GWL static directories --
NOTE this should be done as part of an official startup function...
")
(initialize-gwl)
......@@ -74,6 +74,10 @@
;;
;; FLAG -- add this back when we are sure to be flushing to log file.
;;
#+nil
(defmethod net.aserve::log-request :after ((req http-request))
(let* ((ipaddr (socket:remote-host (request-socket req)))
(end-time (net.aserve::request-reply-date req))
......
......@@ -81,4 +81,6 @@
;;
;; Skeleton "vanilla" geometry kernel - nonfunctional without SMLib module.
;;
(load (merge-pathnames "surf/gdl-surf.asd" *load-truename*))
(asdf:defsystem #:gdl-surf :description
"Auto-generated asdf defsys from Genworks GDL cl-lite."
:author
"Genworks and Dave Cooper unless otherwise indicated"
:license "AGPL unless otherwise indicated" :serial t
:version "2011111400" :depends-on (:gdl-geom-base)
:components
((:file "source\\package")
(:file "source\\parameters")
(:file "source\\classes") (:file "source\\methods")
(:file "source\\curve") (:file "source\\surface")
(:file "source\\approximated-curve")
(:file "source\\approximated-subsurface")
(:file "source\\arc-curve")
(:file "source\\b-spline-curve")
(:file "source\\b-spline-surface")
(:file "source\\basic-surface")
(:file "source\\blended-solid")
(:file "source\\boolean")
(:file "source\\box-intersection ")
(:file "source\\box-solid")
(:file "source\\brep-reader") (:file "source\\brep")
(:file "source\\breps-display")
(:file "source\\compatible-curves")
(:file "source\\composed-curve")
(:file "source\\cone-solid")
(:file "source\\coons-surface")
(:file "source\\csets")
(:file "source\\decomposed-curves")
(:file "source\\dropped-curve")
(:file "source\\dual-blend-surface")
(:file "source\\edge-blend-surface")
(:file "source\\edge")
(:file "source\\elliptical-curve")
(:file "source\\extended-curve")
(:file "source\\extended-surface")
(:file "source\\extruded-solid")
(:file "source\\face") (:file "source\\facial-brep")
(:file "source\\filleted-curve")
(:file "source\\fitted-conic")
(:file "source\\fitted-curve")
(:file "source\\fitted-surface")
(:file "source\\formats")
(:file "source\\general-dual-blend-surface")
(:file "source\\general-sweep")
(:file "source\\geometry-kernel-object-mixin")
(:file "source\\global-filleted-polyline-curves")
(:file "source\\gordon-surface")
(:file "source\\grouped-items")
(:file "source\\iges-reader")
(:file "source\\iso-curve")
(:file "source\\joined-and-compatible-surfaces")
(:file "source\\linear-curve")
(:file "source\\lofted-surface")
(:file "source\\merged-brep")
(:file "source\\native-reader")
(:file "source\\normalized-curve")
(:file "source\\offset-solid")
(:file "source\\offset-surface")
(:file "source\\ordered-curves")
(:file "source\\planar-contour-surface")
(:file "source\\planar-offset-curve")
(:file "source\\planar-section-curve")
(:file "source\\planar-surface")
(:file "source\\poly-brep")
(:file "source\\projected-curve")
(:file "source\\rectangular-surface")
(:file "source\\region")
(:file "source\\reparameterized-curve")
(:file "source\\revolved-surface")
(:file