Commit a47e86aa authored by Dave Cooper's avatar Dave Cooper

building the manual

parent 87685b18
;;;; -*- coding: utf-8 -*-
(asdf:defsystem #:dom :description
"The Gendl\" dom Subsystem" :author "John McCarthy" :license
"The Gendl\" dom Subsystem" :author "Dave Cooper" :license
"Affero Gnu Public License (http://www.gnu.org/licenses/)" :serial t
:version "20150330" :depends-on (:cl-who :yadd)
:version "20151206" :depends-on (:cl-who :yadd)
#-asdf-unicode :defsystem-depends-on #-asdf-unicode (:asdf-encodings)
#+asdf-encodings :encoding #+asdf-encodings :utf-8
:components
......
......@@ -2,9 +2,9 @@
(asdf:defsystem #:ta2 :description
"The Gendl\" (legacy) Testing and Tracking Utility, version 2 (using Ajax but pre-gdlAjax, and no JQuery or CSS)"
:author "John McCarthy" :license
:author "Dave Cooper" :license
"Affero Gnu Public License (http://www.gnu.org/licenses/)" :serial t
:version "20150330" :depends-on (:gwl-graphics)
:version "20151206" :depends-on (:gwl-graphics)
#-asdf-unicode :defsystem-depends-on #-asdf-unicode (:asdf-encodings)
#+asdf-encodings :encoding #+asdf-encodings :utf-8
:components
......
......@@ -2,9 +2,9 @@
(asdf:defsystem #:tasty :description
"The Gendl\" Web-based Development Environment (tasty)" :author
"John McCarthy" :license
"Dave Cooper" :license
"Affero Gnu Public License (http://www.gnu.org/licenses/)" :serial t
:version "20150330" :depends-on (:tree :gwl-graphics)
:version "20151206" :depends-on (:tree :gwl-graphics)
#-asdf-unicode :defsystem-depends-on #-asdf-unicode (:asdf-encodings)
#+asdf-encodings :encoding #+asdf-encodings :utf-8
:components
......
......@@ -2,9 +2,9 @@
(asdf:defsystem #:translators :description
"The Gendl\" Translators to/from XML and potentially other high-level KBE and Knowledge formats"
:author "John McCarthy" :license
:author "Dave Cooper" :license
"Affero Gnu Public License (http://www.gnu.org/licenses/)" :serial t
:version "20150330" :depends-on (:gwl)
:version "20151206" :depends-on (:gwl)
#-asdf-unicode :defsystem-depends-on #-asdf-unicode (:asdf-encodings)
#+asdf-encodings :encoding #+asdf-encodings :utf-8
:components
......
......@@ -2,9 +2,9 @@
(asdf:defsystem #:tree :description
"The Gendl\" Tree component used by Tasty and potentially as a UI component on its own"
:author "John McCarthy" :license
:author "Dave Cooper" :license
"Affero Gnu Public License (http://www.gnu.org/licenses/)" :serial t
:version "20150330" :depends-on (:gwl-graphics)
:version "20151206" :depends-on (:gwl-graphics)
#-asdf-unicode :defsystem-depends-on #-asdf-unicode (:asdf-encodings)
#+asdf-encodings :encoding #+asdf-encodings :utf-8
:components
......
......@@ -2,9 +2,9 @@
(asdf:defsystem #:yadd :description
"The Gendl\" Yet Another Definition Documenter (yadd)" :author
"John McCarthy" :license
"Dave Cooper" :license
"Affero Gnu Public License (http://www.gnu.org/licenses/)" :serial t
:version "20150330" :depends-on
:version "20151206" :depends-on
(:gwl-graphics #-allegro :cl-html-parse)
#-asdf-unicode :defsystem-depends-on #-asdf-unicode (:asdf-encodings)
#+asdf-encodings :encoding #+asdf-encodings :utf-8
......
;;;; -*- coding: utf-8 -*-
(asdf:defsystem #:base :description
"The Gendl\" Base Core Kernel Engine" :author "John McCarthy"
:license "Affero Gnu Public License (http://www.gnu.org/licenses/)"
:serial t :version "20150330" :depends-on (:bordeaux-threads)
"The Gendl\" Base Core Kernel Engine" :author "Dave Cooper" :license
"Affero Gnu Public License (http://www.gnu.org/licenses/)" :serial t
:version "20151206" :depends-on (:bordeaux-threads)
#-asdf-unicode :defsystem-depends-on #-asdf-unicode (:asdf-encodings)
#+asdf-encodings :encoding #+asdf-encodings :utf-8
:components
......@@ -28,10 +28,5 @@
(:file "rest/source/base-rule-object") (:file "rest/source/bodies")
(:file "rest/source/ignore-errors-with-backtrace")
(:file "rest/source/init") (:file "rest/source/make-part")
(:file "rest/source/sequence")
(:file "zzinit/source/initialize")
(:file "zzinit/source/zzinit")
))
(:file "rest/source/sequence") (:file "zzinit/source/initialize")
(:file "zzinit/source/zzinit")))
......@@ -709,38 +709,69 @@ an iso-8601 date, optionally with time, e.g. 2012-07-08 or 2012-07-08T13:33 or 2
(defun read-snapshot (&key (filename "/tmp/snap.gdl") object keep-bashed-values? make-object-args
keys-to-ignore
(keys-to-ignore-default (list :query-plist :view-toggle :cookies-received)))
(defun read-snapshot (&key (filename "/tmp/snap.gdl")
string stream
object keep-bashed-values? make-object-args
keys-to-ignore
(keys-to-ignore-default (list :query-plist :view-toggle :cookies-received)))
"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
<tt>object</tt> is given, the object should be compatible in type to that specified in the
snapshot file, and this existing object will be modified to contain the set slot values and
toplevel inputs as specified in the snapshot file.
:&key ((filename \"/tmp/snap.gdl\") \"String or pathname. File to be read.\"
"GDL Instance. Reads the snapshot data from stream, from the string,
or from 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 <tt>object</tt> is given,
the object should be compatible in type to that specified in the
snapshot file, and this existing object will be modified to contain
the set slot values and toplevel inputs as specified in the snapshot
file.
:&key ((filename \"/tmp/snap.gdl\") \"String or pathname. File to be read. If either string or stream is specified, this will not be used.\"
(string nil) \"String of data. The actual snapshot contents, stored in a string. If stream is specified, this will not be used.\"
(stream nil) \"Stream open for input. A stream from which the snapshot data can be read.\"
(keep-bashed-values? nil) \"Boolean. Indicates whether to keep the currently bashed values in object before reading snap values into it.\"
(object nil) \"GDL object. Existing object to be modified with restored values.\")"
(let ((keys-to-ignore (append keys-to-ignore keys-to-ignore-default)))
(with-open-file (in filename)
(let ((package-form (read in)))
(when (or (null package-form) (not (find-package (second package-form))))
(error "Invalid package specification at beginning of ~a.~%" filename))
(let* ((*package* (find-package (second package-form))) (root-form (read in)))
(when (or (null root-form)
(not (eql (class-of (find-class (first root-form))) (find-class 'gdl-class))))
(error "Invalid object type specifier as first element of second form in ~a.~%" root-form))
(cond (stream (read-snapshot-from-stream stream :object object :keep-bashed-values? keep-bashed-values?
:make-object-args make-object-args :keys-to-ignore keys-to-ignore))
(string (with-input-from-string (in string)
(read-snapshot-from-stream in :object object :keep-bashed-values? keep-bashed-values?
:make-object-args make-object-args :keys-to-ignore keys-to-ignore)))
(filename (with-open-file (in filename)
(read-snapshot-from-stream in :object object :keep-bashed-values? keep-bashed-values?
:make-object-args make-object-args :keys-to-ignore keys-to-ignore))))))
(defun read-snapshot-from-stream (in &key object keep-bashed-values? make-object-args keys-to-ignore)
(let (forms)
(do ((form (read in nil nil) (read in nil nil)))
((null form) forms)
(push form forms))
(setq forms (nreverse forms))
(let ((package-form (first forms)))
(when (or (null package-form) (not (find-package (second package-form))))
(error "Invalid package specification at beginning of snapshot data.~%"))
(let* ((*package* (find-package (second package-form)))
(root-form (second forms)))
(when (or (null root-form)
(not (atom (first root-form)))
(not (eql (class-of (find-class (first root-form))) (find-class 'gdl-class))))
(warn "Invalid root-form: ~a.~%" root-form)
(setq root-form (first (remove-if-not #'(lambda(form) (atom (first form))) (rest forms))))
(setq forms (cons package-form
(cons root-form
(remove root-form (rest forms) :test #'equalp)))))
(let* ((object (cond ((and object keep-bashed-values?) object)
(object (the-object object restore-tree!) object)
(t (progn
(apply #'make-object (first root-form) make-object-args))))))
(let ((self object) (value-plist (rest root-form)))
......@@ -749,33 +780,27 @@ toplevel inputs as specified in the snapshot file.
(when self (the-object self (set-slot! key (eval expression) :re-sort? nil)))))
(plist-keys value-plist) (plist-values value-plist)))
(let (forms)
(do ((form (read in nil nil) (read in nil nil)))
((null form) forms)
(push form forms))
(setq forms (nreverse forms))
(let* ((forms (double-length-sort forms))
(let* ((forms (double-length-sort forms))
(primaries (remove-if-not #'(lambda(item) (or (getf (rest item) :%primary?%)
(getf (rest item) :element-index-list))) forms))
(non-primaries (remove-if #'(lambda(item) (or (getf (rest item) :%primary?%)
(getf (rest item) :element-index-list))) forms))
(forms (append primaries non-primaries)))
(primaries (remove-if-not #'(lambda(item) (or (getf (rest item) :%primary?%)
(getf (rest item) :element-index-list))) forms))
(non-primaries (remove-if #'(lambda(item) (or (getf (rest item) :%primary?%)
(getf (rest item) :element-index-list))) forms))
(forms (append primaries non-primaries)))
(dolist (form forms)
(dolist (form forms)
(let ((root-path (first form)) (value-plist (rest form)))
(let ((self
(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)
(the-object self (set-slot! key (eval `(let ((self ,self)) ,expression)) :re-sort? nil))))
(plist-keys value-plist) (plist-values value-plist))))))))
object))))))
(let ((root-path (first form)) (value-plist (rest form)))
(let ((self
(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)
(the-object self (set-slot! key (eval `(let ((self ,self)) ,expression)) :re-sort? nil))))
(plist-keys value-plist) (plist-values value-plist)))))))
object)))))
;;
......
;;;; -*- coding: utf-8 -*-
(asdf:defsystem #:cl-lite :description
"The Gendl\" Compile-and-Load Lite Utility" :author "John McCarthy"
"The Gendl\" Compile-and-Load Lite Utility" :author "Dave Cooper"
:license "Affero Gnu Public License (http://www.gnu.org/licenses/)"
:serial t :version "20150330" :depends-on (:glisp)
:serial t :version "20151206" :depends-on (:glisp)
#-asdf-unicode :defsystem-depends-on #-asdf-unicode (:asdf-encodings)
#+asdf-encodings :encoding #+asdf-encodings :utf-8
:components
......
;;;; -*- coding: utf-8 -*-
(asdf:defsystem #:bus :description
"The Gendl\" Wireframe School Bus Demo" :author "John McCarthy"
"The Gendl\" Wireframe School Bus Demo" :author "Dave Cooper"
:license "Affero Gnu Public License (http://www.gnu.org/licenses/)"
:serial t :version "20150330" :depends-on nil
:serial t :version "20151206" :depends-on nil
#-asdf-unicode :defsystem-depends-on #-asdf-unicode (:asdf-encodings)
#+asdf-encodings :encoding #+asdf-encodings :utf-8
:components
......
;;;; -*- coding: utf-8 -*-
(asdf:defsystem #:ledger :description
"The Gendl\" Ledger Bookkeeping Demo" :author "John McCarthy"
:license "Affero Gnu Public License (http://www.gnu.org/licenses/)"
:serial t :version "20150330" :depends-on
(#-gwl :gwl)
"The Gendl\" Ledger Bookkeeping Demo" :author "Dave Cooper" :license
"Affero Gnu Public License (http://www.gnu.org/licenses/)" :serial t
:version "20151206" :depends-on (#-gwl :gwl)
#-asdf-unicode :defsystem-depends-on #-asdf-unicode (:asdf-encodings)
#+asdf-encodings :encoding #+asdf-encodings :utf-8
:components
......
......@@ -2,9 +2,9 @@
(asdf:defsystem #:robot :description
"The Gendl\" Simplified Android Robot example " :author
"John McCarthy" :license
"Dave Cooper" :license
"Affero Gnu Public License (http://www.gnu.org/licenses/)" :serial t
:version "20150330" :depends-on nil
:version "20151206" :depends-on nil
#-asdf-unicode :defsystem-depends-on #-asdf-unicode (:asdf-encodings)
#+asdf-encodings :encoding #+asdf-encodings :utf-8
:components
......
......@@ -2,9 +2,9 @@
(asdf:defsystem #:wire-world :description
"The Gendl\" Wire-World demo and test-case for wireframe tessellation and X3D output"
:author "John McCarthy" :license
:author "Dave Cooper" :license
"Affero Gnu Public License (http://www.gnu.org/licenses/)" :serial t
:version "20150330" :depends-on
:version "20151206" :depends-on
(#-gwl-graphics :gwl-graphics)
#-asdf-unicode :defsystem-depends-on #-asdf-unicode (:asdf-encodings)
#+asdf-encodings :encoding #+asdf-encodings :utf-8
......
;;;; -*- coding: utf-8 -*-
(asdf:defsystem #:examples :description
"The Gendl\" examples Subsystem" :author "John McCarthy" :license
"The Gendl\" examples Subsystem" :author "Dave Cooper" :license
"Affero Gnu Public License (http://www.gnu.org/licenses/)" :serial t
:version "20150330" :depends-on (:gwl-graphics :surf)
:version "20151206" :depends-on (:gwl-graphics :surf)
#-asdf-unicode :defsystem-depends-on #-asdf-unicode (:asdf-encodings)
#+asdf-encodings :encoding #+asdf-encodings :utf-8
:components
......
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
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