Commit 0e7bd69e authored by Dave Cooper's avatar Dave Cooper

cleaned up several customer deployment issues

parent 0073c627
...@@ -40,11 +40,12 @@ ...@@ -40,11 +40,12 @@
(ignore-errors (funcall (read-from-string "asdf:system-source-directory") "base")) (ignore-errors (funcall (read-from-string "asdf:system-source-directory") "base"))
(if (typep error 'error) (if (typep error 'error)
(warn "~&ASDF is loaded, but :base is not registered. glisp:*genworks-source-home* remains unknown and set to nil.~%") (warn "~&ASDF is loaded, but :base is not registered. glisp:*genworks-source-home* remains unknown and set to nil.~%")
(setq *genworks-source-home* (when base-home
(make-pathname :name nil (setq *genworks-source-home*
:type nil (make-pathname :name nil
:directory (butlast (butlast (pathname-directory base-home))) :type nil
:defaults base-home))))))) :directory (butlast (butlast (pathname-directory base-home)))
:defaults base-home))))))))
(set-genworks-source-home-if-known) (set-genworks-source-home-if-known)
......
...@@ -70,7 +70,7 @@ given as keyword args to this function)." ...@@ -70,7 +70,7 @@ given as keyword args to this function)."
(remf args :show-redefinition-warnings? ) (remf args :show-redefinition-warnings? )
(with-compilation-unit () (with-compilation-unit ()
(let ((object (apply #'make-object 'codebase-directory-node :pathname pathname args))) (let ((object (apply #'make-object 'codebase-directory-node :pathname pathname args)))
(unless (the-object object dry-run?) (unless nil ;;(the-object object dry-run?)
(the-object object (compile-and-load :package-file-ht package-file-ht))) (the-object object (compile-and-load :package-file-ht package-file-ht)))
(when (the-object object create-asd-file?) (when (the-object object create-asd-file?)
(the-object object (write-asd-file)))))))) (the-object object (write-asd-file))))))))
......
...@@ -122,28 +122,29 @@ ...@@ -122,28 +122,29 @@
:output-functions :output-functions
((cad-output ((cad-output
() ()
(set-format-slot view self) (let ((*dxf-entity-id* (or *dxf-entity-id* 107)))
(let ((center (the center))(view-center (scalar*vector (the view-scale-total) (set-format-slot view self)
(keyed-transform*vector (the view-transform) (let ((center (the center))(view-center (scalar*vector (the view-scale-total)
(the view-center))))) (keyed-transform*vector (the view-transform)
(with-translated-state (:dxf center) (the view-center)))))
(with-format-slots (view) (with-translated-state (:dxf center)
(set-format-slot view nil) (with-format-slots (view)
(dolist (cache (list-elements (the annotation-caches))) (set-format-slot view nil)
(write-the-object cache object cad-output) (write-the-object cache lines-and-curves)) (dolist (cache (list-elements (the annotation-caches)))
(set-format-slot view view)) (write-the-object cache object cad-output) (write-the-object cache lines-and-curves))
(dolist (cache (list-elements (the object-caches))) (set-format-slot view view))
(dolist (cache (list-elements (the object-caches)))
(write-the-object cache object cad-output)) (write-the-object cache object cad-output))
;; ;;
;; FLAG - look into capturing this translate in the ;; FLAG - look into capturing this translate in the
;; vertex-array-2d-scaled in view-object-cache. so it will ;; vertex-array-2d-scaled in view-object-cache. so it will
;; become unecessary here. ;; become unecessary here.
;; ;;
(with-translated-state (:dxf (make-vector (- (get-x view-center)) (with-translated-state (:dxf (make-vector (- (get-x view-center))
(- (get-y view-center)))) (- (get-y view-center))))
(dolist (cache (list-elements (the object-caches))) (dolist (cache (list-elements (the object-caches)))
(write-the-object cache lines-and-curves)))))))) (write-the-object cache lines-and-curves)))))))))
;; ;;
......
...@@ -23,7 +23,7 @@ ...@@ -23,7 +23,7 @@
(defparameter *dxf-header* (defparameter *dxf-header-new*
" 0 " 0
SECTION SECTION
2 2
...@@ -2547,8 +2547,10 @@ ENTITIES ...@@ -2547,8 +2547,10 @@ ENTITIES
") ")
(defparameter *dxf-header* *dxf-header-new*)
(defparameter *dxf-footer*
(defparameter *dxf-footer-new*
" 0 " 0
ENDSEC ENDSEC
0 0
...@@ -3860,11 +3862,10 @@ EOF ...@@ -3860,11 +3862,10 @@ EOF
") ")
(defparameter *dxf-footer* *dxf-footer-new*)
(defparameter *dxf-header-pre-1592*
#+nil ;; original - currently in 1590
(defparameter *dxf-header*
" 0 " 0
SECTION SECTION
2 2
...@@ -3872,7 +3873,7 @@ HEADER ...@@ -3872,7 +3873,7 @@ HEADER
9 9
$ACADVER $ACADVER
1 1
AC1500 AC1009
9 9
$DWGCODEPAGE $DWGCODEPAGE
3 3
...@@ -4052,15 +4053,30 @@ ENTITIES ...@@ -4052,15 +4053,30 @@ ENTITIES
") ")
#+nil ;; original - currently in 1590
(defparameter *dxf-footer* (defparameter *dxf-footer-pre-1592*
" 0 " 0
ENDSEC ENDSEC
0 0
EOF EOF
") ")
(define-format dxf (2d-output)) (define-format dxf (2d-output))
(defun legacy-dxf ()
(setq *dxf-header* *dxf-header-pre-1592*
*dxf-footer* *dxf-footer-pre-1592*)
(format t "Switched to legacy DXF header and footer.~%"))
(defun new-dxf ()
(setq *dxf-header* *dxf-header-new*
*dxf-footer* *dxf-footer-new*)
(format t "Switched to new DXF header and footer.~%"))
...@@ -100,7 +100,7 @@ Perhaps a zombie process is holding port ~a?~%" port port)) ...@@ -100,7 +100,7 @@ Perhaps a zombie process is holding port ~a?~%" port port))
(ignore-errors (ignore-errors
(glisp:with-timeout (2 (error "AllegroServe port probe timed out on port ~a. (glisp:with-timeout (2 (error "AllegroServe port probe timed out on port ~a.
Perhaps a zombie process is holding port ~a?~%" port port)) Perhaps a zombie process is holding port ~a?~%" port port))
(net.aserve.client:do-http-request (format nil "http://localhost:~a" port)))) (net.aserve.client:do-http-request (format nil "http://127.0.0.1:~a" port))))
(declare (ignore result)) (declare (ignore result))
(when (typep error 'error) (when (typep error 'error)
port)) 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