Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
gendl
gendl
Commits
b253aea6
Commit
b253aea6
authored
Jul 29, 2013
by
Dave Cooper
Browse files
Merge branch 'devo' of github.com:genworks/gendl into feature/svg-dd
parents
6d31b7d7
e71654bf
Changes
26
Hide whitespace changes
Inline
Side-by-side
apps/ta2/ta2.asd
View file @
b253aea6
...
...
@@ -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
"201307
06
"
:depends-on
(
:gwl-graphics
)
:version
"201307
24
"
:depends-on
(
:gwl-graphics
)
#+
asdf-encoding
:encoding
#+
asdf-encoding
:utf-8
:components
((
:file
"source/package"
)
(
:file
"source/parameters"
)
...
...
apps/tasty/tasty.asd
View file @
b253aea6
...
...
@@ -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
"201307
06
"
:depends-on
(
:tree
:gwl-graphics
)
:version
"201307
24
"
:depends-on
(
:tree
:gwl-graphics
)
#+
asdf-encoding
:encoding
#+
asdf-encoding
:utf-8
:components
((
:file
"source/package"
)
(
:file
"source/parameters"
)
...
...
apps/translators/translators.asd
View file @
b253aea6
...
...
@@ -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
"201307
06
"
:depends-on
(
:gwl
)
:version
"201307
24
"
:depends-on
(
:gwl
)
#+
asdf-encoding
:encoding
#+
asdf-encoding
:utf-8
:components
((
:file
"xml/source/package"
)
(
:file
"xml/source/genworks"
)
...
...
apps/tree/tree.asd
View file @
b253aea6
...
...
@@ -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
"201307
06
"
:depends-on
(
:gwl-graphics
)
:version
"201307
24
"
:depends-on
(
:gwl-graphics
)
#+
asdf-encoding
:encoding
#+
asdf-encoding
:utf-8
:components
((
:file
"source/package"
)
(
:file
"source/parameters"
)
...
...
apps/yadd/yadd.asd
View file @
b253aea6
...
...
@@ -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
"201307
06
"
:depends-on
(
:gwl-graphics
)
:version
"201307
24
"
:depends-on
(
:gwl-graphics
)
#+
asdf-encoding
:encoding
#+
asdf-encoding
:utf-8
:components
((
:file
"source/package"
)
(
:file
"source/genworks"
)
...
...
base/base.asd
View file @
b253aea6
...
...
@@ -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
"201307
06
"
:depends-on
nil
:serial
t
:version
"201307
24
"
:depends-on
nil
#+
asdf-encoding
:encoding
#+
asdf-encoding
:utf-8
:components
((
:file
"source/package"
)
(
:file
"source/genworks"
)
...
...
base/source/genworks.lisp
View file @
b253aea6
;;;; -*-
en
coding: utf-8
;
-*-
;;;; -*- coding: utf-8 -*-
;
;;
;; Copyright 2002-2011, 2012 Genworks International
;;
...
...
base/source/parameters.lisp
View file @
b253aea6
...
...
@@ -21,7 +21,7 @@
(
in-package
:gdl
)
(
defparameter
*gendl-version*
"158
3
"
)
(
defparameter
*gendl-version*
"158
4
"
)
(
eval-when
(
compile
load
eval
)
(
when
(
not
(
boundp
'*production-build?*
))
(
defvar
*production-build?*
nil
)))
...
...
base/zzinit/source/initialize.lisp
View file @
b253aea6
...
...
@@ -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
)
...
...
cl-lite/cl-lite.asd
View file @
b253aea6
...
...
@@ -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
"201307
06
"
:depends-on
(
:glisp
)
:serial
t
:version
"201307
24
"
:depends-on
(
:glisp
)
#+
asdf-encoding
:encoding
#+
asdf-encoding
:utf-8
:components
((
:file
"source/package"
)
(
:file
"source/parameters"
)
...
...
demos/bus/bus.asd
View file @
b253aea6
...
...
@@ -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
"201307
06
"
:depends-on
(
:gwl-graphics
)
:serial
t
:version
"201307
24
"
:depends-on
(
:gwl-graphics
)
#+
asdf-encoding
:encoding
#+
asdf-encoding
:utf-8
:components
((
:file
"source/package"
)
(
:file
"source/assembly"
)
...
...
demos/ledger/ledger.asd
View file @
b253aea6
...
...
@@ -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
"201307
06
"
:depends-on
(
:gwl
)
:serial
t
:version
"201307
24
"
:depends-on
(
:gwl
)
#+
asdf-encoding
:encoding
#+
asdf-encoding
:utf-8
:components
((
:file
"source/package"
)
(
:file
"source/assembly"
)
...
...
demos/robot/robot.asd
View file @
b253aea6
...
...
@@ -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
"201307
06
"
:depends-on
(
:gwl-graphics
)
:version
"201307
24
"
:depends-on
(
:gwl-graphics
)
#+
asdf-encoding
:encoding
#+
asdf-encoding
:utf-8
:components
((
:file
"source/package"
)
(
:file
"source/assembly"
)
...
...
demos/wire-world/wire-world.asd
View file @
b253aea6
...
...
@@ -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
"201307
06
"
:depends-on
(
:gwl-graphics
)
:version
"201307
24
"
:depends-on
(
:gwl-graphics
)
#+
asdf-encoding
:encoding
#+
asdf-encoding
:utf-8
:components
((
:file
"source/package"
)
(
:file
"source/assembly"
)))
documentation/training/g102-tud/examples/examples.asd
View file @
b253aea6
...
...
@@ -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
"201307
06
"
:depends-on
(
:surf
)
:version
"201307
24
"
:depends-on
(
:surf
)
#+
asdf-encoding
:encoding
#+
asdf-encoding
:utf-8
:components
((
:file
"source/ch2-examples"
)
(
:file
"source/ch3-examples"
)
...
...
emacs/gdl.el
View file @
b253aea6
...
...
@@ -30,7 +30,7 @@
(
defvar
*gendl-home*
(
file-truename
(
concat
(
file-name-directory
(
file-truename
load-file-name
))
"../"
)))
;; 3. CONFGURGE EMACS
;; 3. CONF
I
GURGE EMACS
;;
;; This section is not SLIME-specific.
;;
...
...
@@ -203,7 +203,7 @@
(
defun
prior-to-glime
()
(
find-file
(
concat
*gendl-home*
"emacs/README.txt"
))
(
toggle-read-only
)
(
let
((
frame-title
"Genworks® G
endl™
Interactive Authoring Environment"
))
(
let
((
frame-title
"Genworks® G
DL
Interactive Authoring Environment"
))
(
modify-frame-parameters
nil
(
list
(
cons
'name
frame-title
))))
(
setq
inhibit-splash-screen
t
)
(
cd
"~/"
))
...
...
emacs/glime.lisp
View file @
b253aea6
...
...
@@ -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.
...
...
geom-base/geom-base.asd
View file @
b253aea6
...
...
@@ -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
"201307
06
"
:depends-on
(
:glisp
)
:version
"201307
24
"
:depends-on
(
:glisp
)
#+
asdf-encoding
:encoding
#+
asdf-encoding
:utf-8
:components
((
:file
"prereqs/source/presets"
)
...
...
glisp/glisp.asd
View file @
b253aea6
...
...
@@ -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
"201307
06
"
:depends-on
:serial
t
:version
"201307
24
"
: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
...
...
gwl-graphics/gwl-graphics.asd
View file @
b253aea6
...
...
@@ -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
"201307
06
"
:depends-on
(
:geom-base
:gwl
)
:serial
t
:version
"201307
24
"
:depends-on
(
:geom-base
:gwl
)
#+
asdf-encoding
:encoding
#+
asdf-encoding
:utf-8
:components
((
:file
"gwl/source/application-mixin"
)
...
...
Prev
1
2
Next
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment