Commit 03ce3779 authored by Dave Cooper's avatar Dave Cooper
Browse files

Merge branch 'release/v1584'

parents e974d21a e158ba5d
......@@ -4,7 +4,7 @@
"The Gendl™ (legacy) Testing and Tracking Utility, version 2 (using Ajax but pre-gdlAjax, and no JQuery or CSS)"
:author "John McCarthy" :license
"Affero Gnu Public License (http://www.gnu.org/licenses/)" :serial t
:version "20130706" :depends-on (:gwl-graphics)
:version "20130723" :depends-on (:gwl-graphics)
#+asdf-encoding :encoding #+asdf-encoding :utf-8
:components
((:file "source/package") (:file "source/parameters")
......
......@@ -4,7 +4,7 @@
"The Gendl™ Web-based Development Environment (tasty)" :author
"John McCarthy" :license
"Affero Gnu Public License (http://www.gnu.org/licenses/)" :serial t
:version "20130706" :depends-on (:tree :gwl-graphics)
:version "20130723" :depends-on (:tree :gwl-graphics)
#+asdf-encoding :encoding #+asdf-encoding :utf-8
:components
((:file "source/package") (:file "source/parameters")
......
......@@ -4,7 +4,7 @@
"The Gendl™ Translators to/from XML and potentially other high-level KBE and Knowledge formats"
:author "John McCarthy" :license
"Affero Gnu Public License (http://www.gnu.org/licenses/)" :serial t
:version "20130706" :depends-on (:gwl)
:version "20130723" :depends-on (:gwl)
#+asdf-encoding :encoding #+asdf-encoding :utf-8
:components
((:file "xml/source/package") (:file "xml/source/genworks")
......
......@@ -4,7 +4,7 @@
"The Gendl™ Tree component used by Tasty and potentially as a UI component on its own"
:author "John McCarthy" :license
"Affero Gnu Public License (http://www.gnu.org/licenses/)" :serial t
:version "20130706" :depends-on (:gwl-graphics)
:version "20130723" :depends-on (:gwl-graphics)
#+asdf-encoding :encoding #+asdf-encoding :utf-8
:components
((:file "source/package") (:file "source/parameters")
......
......@@ -4,7 +4,7 @@
"The Gendl™ Yet Another Definition Documenter (yadd)" :author
"John McCarthy" :license
"Affero Gnu Public License (http://www.gnu.org/licenses/)" :serial t
:version "20130706" :depends-on (:gwl-graphics)
:version "20130723" :depends-on (:gwl-graphics)
#+asdf-encoding :encoding #+asdf-encoding :utf-8
:components
((:file "source/package") (:file "source/genworks")
......
......@@ -3,7 +3,7 @@
(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 "20130706" :depends-on nil
:serial t :version "20130723" :depends-on nil
#+asdf-encoding :encoding #+asdf-encoding :utf-8
:components
((:file "source/package") (:file "source/genworks")
......
;;;; -*- encoding: utf-8; -*-
;;;; -*- coding: utf-8 -*-;
;;
;; Copyright 2002-2011, 2012 Genworks International
;;
......
......@@ -21,7 +21,7 @@
(in-package :gdl)
(defparameter *gendl-version* "1583")
(defparameter *gendl-version* "1584")
(eval-when (compile load eval)
(when (not (boundp '*production-build?*)) (defvar *production-build?* nil)))
......
......@@ -30,6 +30,7 @@
:type nil
:directory (butlast (pathname-directory glisp:*gdl-program-home*))
:defaults glisp:*gdl-program-home*))
(pushnew (make-keyword (format nil "gendl-~a" *gendl-version*)) *features*)
(glisp:set-genworks-source-home-if-known)
(glisp:set-default-float-format)
(glisp:set-defpackage-behavior)
......
......@@ -3,7 +3,7 @@
(asdf:defsystem #:cl-lite :description
"The Gendl™ Compile-and-Load Lite Utility" :author "John McCarthy"
:license "Affero Gnu Public License (http://www.gnu.org/licenses/)"
:serial t :version "20130706" :depends-on (:glisp)
:serial t :version "20130723" :depends-on (:glisp)
#+asdf-encoding :encoding #+asdf-encoding :utf-8
:components
((:file "source/package") (:file "source/parameters")
......
......@@ -3,7 +3,7 @@
(asdf:defsystem #:bus :description
"The Gendl™ Wireframe School Bus Demo" :author "John McCarthy"
:license "Affero Gnu Public License (http://www.gnu.org/licenses/)"
:serial t :version "20130706" :depends-on (:gwl-graphics)
:serial t :version "20130723" :depends-on (:gwl-graphics)
#+asdf-encoding :encoding #+asdf-encoding :utf-8
:components
((:file "source/package") (:file "source/assembly")
......
......@@ -3,7 +3,7 @@
(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 "20130706" :depends-on (:gwl)
:serial t :version "20130723" :depends-on (:gwl)
#+asdf-encoding :encoding #+asdf-encoding :utf-8
:components
((:file "source/package") (:file "source/assembly")
......
......@@ -4,7 +4,7 @@
"The Gendl™ Simplified Android Robot example " :author
"John McCarthy" :license
"Affero Gnu Public License (http://www.gnu.org/licenses/)" :serial t
:version "20130706" :depends-on (:gwl-graphics)
:version "20130723" :depends-on (:gwl-graphics)
#+asdf-encoding :encoding #+asdf-encoding :utf-8
:components
((:file "source/package") (:file "source/assembly")
......
......@@ -4,6 +4,6 @@
"The Gendl™ Wire-World demo and test-case for wireframe tessellation and X3D output"
:author "John McCarthy" :license
"Affero Gnu Public License (http://www.gnu.org/licenses/)" :serial t
:version "20130706" :depends-on (:gwl-graphics)
:version "20130723" :depends-on (:gwl-graphics)
#+asdf-encoding :encoding #+asdf-encoding :utf-8
:components ((:file "source/package") (:file "source/assembly")))
......@@ -3,7 +3,7 @@
(asdf:defsystem #:examples :description
"The Gendl™ examples Subsystem" :author "John McCarthy" :license
"Affero Gnu Public License (http://www.gnu.org/licenses/)" :serial t
:version "20130706" :depends-on (:surf)
:version "20130723" :depends-on (:surf)
#+asdf-encoding :encoding #+asdf-encoding :utf-8
:components
((:file "source/ch2-examples") (:file "source/ch3-examples")
......
......@@ -203,7 +203,7 @@
(defun prior-to-glime ()
(find-file (concat *gendl-home* "emacs/README.txt"))
(toggle-read-only)
(let ((frame-title "Genworks® Gendl™ Interactive Authoring Environment"))
(let ((frame-title "Genworks® GDL Interactive Authoring Environment"))
(modify-frame-parameters nil (list (cons 'name frame-title))))
(setq inhibit-splash-screen t)
(cd "~/"))
......
......@@ -245,30 +245,30 @@
(multiple-value-bind (decoded-arglist determining-args any-enrichment)
(call-next-method)
(destructuring-bind (&optional name mixins &rest spec-pairs)
arguments
arguments
(declare (ignore name mixins))
;; Has the user got as far as the keyword list yet?
(when spec-pairs
;; Which keyword are they working on?
(multiple-value-bind (key values)
(active-keyword spec-pairs)
(when key
(when-let (this-keyword-arg (find key (arglist.keyword-args decoded-arglist)
:key 'keyword-arg.keyword))
;; Mangle the arglist structure: only show the keyword we're working on.
(let ((local-arglist (copy-arglist decoded-arglist)))
(setf (arglist.keyword-args local-arglist) (list this-keyword-arg)
(arglist.rest local-arglist) nil
(arglist.allow-other-keys-p local-arglist) t
;; Disable highlighting.
*autodoc-highlighting* nil)
(return-from compute-enriched-decoded-arglist
;; If we can, make the init-slots for this keyword appear to be
;; its default initargs. Behold! That makes them look just right.
(values (augment-gendl-define-object (keyword-arg.keyword this-keyword-arg)
local-arglist
values)
determining-args t))))))))
;; Which keyword are they working on?
(multiple-value-bind (key values)
(active-keyword spec-pairs)
(when key
(when-let (this-keyword-arg (find key (arglist.keyword-args decoded-arglist)
:key 'keyword-arg.keyword))
;; Mangle the arglist structure: only show the keyword we're working on.
(let ((local-arglist (copy-arglist decoded-arglist)))
(setf (arglist.keyword-args local-arglist) (list this-keyword-arg)
(arglist.rest local-arglist) nil
(arglist.allow-other-keys-p local-arglist) t
;; Disable highlighting.
*autodoc-highlighting* nil)
(return-from compute-enriched-decoded-arglist
;; If we can, make the init-slots for this keyword appear to be
;; its default initargs. Behold! That makes them look just right.
(values (augment-gendl-define-object (keyword-arg.keyword this-keyword-arg)
local-arglist
values)
determining-args t))))))))
;; &allow-other-keys and &rest don't contribute anything here.
(setf (arglist.rest decoded-arglist) nil
(arglist.allow-other-keys-p decoded-arglist) nil)
......@@ -443,25 +443,30 @@ each returning a list of proposed messages.")
(defvar *this-the*)
;;
;; FLAG -- DJC added this ignore-errors
;;
(defun embedded-the-arglist ()
(let* ((whole-form *form-with-arglist*)
(*this-the* (or (this-the-from-form whole-form)
;; The gend:the form isn't embedded inside a define-object. Bail out.
(return-from embedded-the-arglist
nil))))
(ignore-errors
(let* ((whole-form *form-with-arglist*)
(*this-the* (or (this-the-from-form whole-form)
;; The gend:the form isn't embedded inside a define-object. Bail out.
(return-from embedded-the-arglist
nil))))
(when-let (messages (when (and (consp whole-form)
(eq (car whole-form) 'gendl:define-object))
(remove-duplicates (loop for locator in *message-locators* append
(funcall locator whole-form))
:from-end t)))
(values (make-arglist :key-p t
:keyword-args (loop for message in messages collect
(make-keyword-arg message message nil))
:provided-args nil
:allow-other-keys-p t
:rest 'reference-chain)
nil t))))
(when-let (messages (when (and (consp whole-form)
(eq (car whole-form) 'gendl:define-object))
(remove-duplicates (loop for locator in *message-locators* append
(funcall locator whole-form))
:from-end t)))
(values (make-arglist :key-p t
:keyword-args (loop for message in messages collect
(make-keyword-arg message message nil))
:provided-args nil
:allow-other-keys-p t
:rest 'reference-chain)
nil t)))))
;; 9.1. Analyse the current gendl:the form
......@@ -507,6 +512,7 @@ each returning a list of proposed messages.")
;; Try repeating the name of this function, many times, fast, and in a darkened room.
(defun this-the-from-form (form)
;; A bit like messages-in-this-form below, best done as a separate cycle.
(when (eq (car form) 'gendl:define-object)
......@@ -523,22 +529,22 @@ each returning a list of proposed messages.")
do
(when-let (form-with-cursor-marker (form-with-cursor-marker item))
(return-from this-the-from-form
(make-this-the section-name item form-with-cursor-marker))))))))
(make-this-the section-name item form-with-cursor-marker))))))))
(defun form-with-cursor-marker (form)
;; Return, if any, the innermost (the ...) form containing the
;; cursor-marker.
(loop for thing in form
do
(cond ((eq thing '%cursor-marker%) (return form))
((consp thing)
(when-let (inner-form (form-with-cursor-marker thing))
(if (and (consp inner-form)
(case (car inner-form)
((gendl:the gendl:the-child gendl:the-object) t)))
(return inner-form)
(return thing)))))))
do
(cond ((eq thing '%cursor-marker%) (return form))
((consp thing)
(when-let (inner-form (form-with-cursor-marker thing))
(if (and (consp inner-form)
(case (car inner-form)
((gendl:the gendl:the-child gendl:the-object) t)))
(return inner-form)
(return thing)))))))
;; 9.2. Messages which we can deduce from the current form.
......
......@@ -3,7 +3,7 @@
(asdf:defsystem #:geom-base :description
"The Gendl™ Wireframe Geometry" :author "John McCarthy" :license
"Affero Gnu Public License (http://www.gnu.org/licenses/)" :serial t
:version "20130706" :depends-on (:glisp)
:version "20130723" :depends-on (:glisp)
#+asdf-encoding :encoding #+asdf-encoding :utf-8
:components
((:file "prereqs/source/presets")
......
......@@ -3,7 +3,7 @@
(asdf:defsystem #:glisp :description
"The Gendl™ Common Lisp Portability" :author "John McCarthy"
:license "Affero Gnu Public License (http://www.gnu.org/licenses/)"
:serial t :version "20130706" :depends-on
:serial t :version "20130723" :depends-on
(:base :uiop :cl-typesetting :cl-ppcre :cl-who #-allegro :cl-base64 #-allegro :babel #-allegro :acl-compat)
#+asdf-encoding :encoding #+asdf-encoding :utf-8
:components
......
......@@ -3,7 +3,7 @@
(asdf:defsystem #:gwl-graphics :description
"The Gendl™ GWL embedded graphics support" :author "John McCarthy"
:license "Affero Gnu Public License (http://www.gnu.org/licenses/)"
:serial t :version "20130706" :depends-on (:geom-base :gwl)
:serial t :version "20130723" :depends-on (:geom-base :gwl)
#+asdf-encoding :encoding #+asdf-encoding :utf-8
:components
((:file "gwl/source/application-mixin")
......
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