Commit 93ddf8fe authored by Dave Cooper's avatar Dave Cooper
Browse files

took out gdl-ajax auto-restore, will put on an experimental branch until stable.

parent 9931beae
......@@ -34,6 +34,9 @@
#-(or allegro lispworks sbcl ccl)
(warn "~&Please implement concatenate-fasls for the currently running lisp.~%")
;;
;; FLAG -- OBSOLETED by asdf/bundle:fasl-op and asdf/bundle:monolithic-fasl-op
;;
(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.~%")
......@@ -80,14 +83,14 @@
(make-pathname :name :wild :type :wild :version :wild))
#+nil
(defun copy-directory (from-dir to-dir &rest args)
(declare (ignore args))
#+allegro (excl:copy-directory from-dir to-dir)
#+lispworks (cl-copy-directory to-dir from-dir)
#+clozure (ccl::recursive-copy-directory from-dir to-dir )
#-(or allegro lispworks clozure)
(error "~&copy-directory needed for ~a. Consider cl-fad.~%" (lisp-implementation-type)))
(error "~&copy-directory needed for ~a. Does uiop/filesystem have one yet?~%" (lisp-implementation-type)))
#+nil
......@@ -231,14 +234,10 @@ and \"..\" entries."
(t -1))))
;;
;; FLAG -- figure out how to use uiop:run-program to hide the popup console window.
;;
(defun run-gs (command)
"Shell out a ghostscript command and handle errors."
(let ((result
#+(and mswindows allegro) (excl:run-shell-command command :show-window :hide)
#-(and mswindows allegro) (run-program command)))
(run-program command)))
(unless (zerop result) (error "Ghostscript threw error"))))
(defun run-program (command &key output ignore-error-status force-shell
......
......@@ -21,39 +21,7 @@
(in-package :gwl)
(defvar *snap-folder* (glisp:snap-folder))
(defun restore-from-snap (iid)
(let ((new-self
(let ((snap-file
(merge-pathnames
(make-pathname :name (format nil "~a" iid)
:type "snap") *snap-folder*)))
(when (probe-file snap-file)
(with-error-handling ()
(read-snapshot :filename snap-file
:keys-to-ignore (list :time-last-touched
:time-instantiated
:expires-at)))))))
(when new-self
(setf (gethash (make-keyword (the-object new-self instance-id)) *instance-hash-table*)
(list new-self nil))
(when (typep new-self 'session-control-mixin) (the-object new-self set-expires-at))
(the-object new-self set-instantiation-time!)
(the-object new-self set-time-last-touched!)
;;(evaluate-relevant-slots new-self)
(format t "~%~%*************** Session ~a Restarted! ***************~%~%" (the-object new-self instance-id))
(the-object new-self tree-manager restore-design-state!))
;;
;; FLAG for testing only.
;; return error object instead of just throwing an error here.
;;
(unless new-self (error "Restoring of session ~a was not possible.~%" iid))
new-self))
......@@ -82,14 +50,6 @@
(iid (getf plist :|iid|))
(self (first (gethash (make-keyword iid) gwl:*instance-hash-table*)))
;;
;; Restore from snapshot if exists.
;;
(self (or self (restore-from-snap iid)))
;;
;; FLAG If not exists, we don't handle that yet.
;;
(plist (decode-from-ajax plist self))
(bashee (getf plist :|bashee|))
(respondent (progn (when *debug?* (print-variables plist))
......@@ -132,20 +92,11 @@
(when (and respondent (the-object respondent root)
(the-object respondent root (set-remote-host! req))))
(quick-save self)
(respond-with-new-html-sections req ent respondent))))
(publish :path "/gdlAjax" :function 'gdlAjax)
(defun quick-save (self &key (snap-folder *snap-folder*))
(let ((snap-file
(merge-pathnames
(make-pathname :name (format nil "~a" (the instance-id))
:type "snap") snap-folder)))
(the (write-snapshot :filename snap-file))))
(defun wrap-cdata (string)
(string-append "<![CDATA[" string "]]>"))
......
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