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
tutorials
Commits
2eed4923
Commit
2eed4923
authored
Jun 15, 2021
by
Dave Cooper
Browse files
Merge branch 'release/1596'
parents
53225681
9901e1bb
Changes
47
Expand all
Hide whitespace changes
Inline
Side-by-side
.gitignore
View file @
2eed4923
*.wx64fsl
*.*x64fsl
*.fasl
*~
#*#
\ No newline at end of file
#*#
system-index.txt
\ No newline at end of file
bench/source/patches.gdl
View file @
2eed4923
...
...
@@ -20,16 +20,22 @@
;; <http://www.gnu.org/licenses/>.
;;
;;
;; This file can be purged with latest build.
;;
;;
;; Below can be cleared with 1596
;;
(in-package :geom-base)
#+nil
(#+allegro
excl:without-package-locks
#-allegro progn
(in-package :geom-base)
(defun flush-center (ref-center datum p-plane u-plane &optional (u-datum u-plane))
(translate-along-vector ref-center u-datum
(distance-to-plane datum p-plane u-plane u-datum)))
...
...
@@ -44,13 +50,14 @@
;; All below can be cleared as of 1596
;;
;;(in-package :gdl)
#+nil
(#+allegro
excl:without-package-locks
#-allegro progn
(in-package :gdl)
(defun %unbind-dependent-slots% (object slot &key updating?)
(let ((current (gethash (list object slot) *unbound-slots*)))
...
...
@@ -88,14 +95,3 @@
(#+allegro
excl:without-package-locks
#-allegro progn
(in-package :gwl)
(define-object-amendment base-ajax-graphics-sheet ()
:input-slots
((viewport-js-text ""))))
geysr/defsystem-depends-on.isc
deleted
100644 → 0
View file @
53225681
;;
;; Copyright 2020 Genworks International
;;
;; This source file is part of the General-purpose Declarative
;; Language project (Gendl).
;;
;; This source file contains free software: you can redistribute it
;; and/or modify it under the terms of the GNU Affero General Public
;; License as published by the Free Software Foundation, either
;; version 3 of the License, or (at your option) any later version.
;;
;; This source file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; Affero General Public License for more details.
;;
;; You should have received a copy of the GNU Affero General Public
;; License along with this source file. If not, see
;; <http://www.gnu.org/licenses/>.
;;
":gendl-asdf"
\ No newline at end of file
geysr/depends-on.isc
deleted
100644 → 0
View file @
53225681
;;
;; Copyright 2020 Genworks International
;;
;; This source file is part of the General-purpose Declarative
;; Language project (Gendl).
;;
;; This source file contains free software: you can redistribute it
;; and/or modify it under the terms of the GNU Affero General Public
;; License as published by the Free Software Foundation, either
;; version 3 of the License, or (at your option) any later version.
;;
;; This source file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; Affero General Public License for more details.
;;
;; You should have received a copy of the GNU Affero General Public
;; License along with this source file. If not, see
;; <http://www.gnu.org/licenses/>.
;;
(:gwl-graphics)
\ No newline at end of file
geysr/gendl-asdf/gendl-asdf.asd
deleted
100644 → 0
View file @
53225681
;;;; -*- coding: utf-8 -*-
;;
;; Copyright 2020 Genworks International
;;
;; This source file is part of the General-purpose Declarative
;; Language project (Gendl).
;;
;; This source file contains free software: you can redistribute it
;; and/or modify it under the terms of the GNU Affero General Public
;; License as published by the Free Software Foundation, either
;; version 3 of the License, or (at your option) any later version.
;;
;; This source file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; Affero General Public License for more details.
;;
;; You should have received a copy of the GNU Affero General Public
;; License along with this source file. If not, see
;; <http://www.gnu.org/licenses/>.
;;
(
in-package
:cl-user
)
(
asdf:defsystem
#:gendl-asdf
:description
"asdf gendl artifacts loading"
:serial
t
:version
"20200720"
:depends-on
nil
:components
((
:file
"gendl-asdf"
)))
geysr/gendl-asdf/gendl-asdf.lisp
deleted
100644 → 0
View file @
53225681
;;;; -*- coding: utf-8 -*-
;;
;; Copyright 2020 Genworks International
;;
;; This source file is part of the General-purpose Declarative
;; Language project (Gendl).
;;
;; This source file contains free software: you can redistribute it
;; and/or modify it under the terms of the GNU Affero General Public
;; License as published by the Free Software Foundation, either
;; version 3 of the License, or (at your option) any later version.
;;
;; This source file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; Affero General Public License for more details.
;;
;; You should have received a copy of the GNU Affero General Public
;; License along with this source file. If not, see
;; <http://www.gnu.org/licenses/>.
;;
(
in-package
:cl-user
)
(
eval-when
(
:compile-toplevel
:load-toplevel
:execute
)
(
defparameter
*asdf-found?*
t
)
(
unless
(
find-package
:asdf
)
(
setq
*asdf-found?*
nil
)
(
defpackage
:asdf
(
:nicknames
:asdf/interface
asdf/lisp-action
))))
(
when
(
find-package
:asdf
)
(
defclass
asdf::gdl
(
asdf::cl-source-file
)
((
type
:initform
"gdl"
)))
(
defclass
asdf::gendl
(
asdf::cl-source-file
)
((
type
:initform
"gendl"
)))
(
defclass
asdf::lisp
(
asdf::cl-source-file
)
()))
(
eval-when
(
:compile-toplevel
:load-toplevel
:execute
)
(
unless
*asdf-found?*
(
delete-package
:asdf
)))
geysr/geysr.asd
deleted
100644 → 0
View file @
53225681
;;;; -*- coding: utf-8 -*-
;;
;; Copyright 2020 Genworks International
;;
;; This source file is part of the General-purpose Declarative
;; Language project (Gendl).
;;
;; This source file contains free software: you can redistribute it
;; and/or modify it under the terms of the GNU Affero General Public
;; License as published by the Free Software Foundation, either
;; version 3 of the License, or (at your option) any later version.
;;
;; This source file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; Affero General Public License for more details.
;;
;; You should have received a copy of the GNU Affero General Public
;; License along with this source file. If not, see
;; <http://www.gnu.org/licenses/>.
;;
(
asdf:defsystem
#:geysr
:description
"The Gendl® geysr Subsystem"
:author
"Genworks International"
:license
"Affero Gnu Public License (http://www.gnu.org/licenses/)"
:serial
t
:version
"20190912"
:depends-on
(
:gwl-graphics
)
#-
asdf-unicode
:defsystem-depends-on
#-
asdf-unicode
(
:asdf-encodings
:gendl-asdf
)
#+
asdf-unicode
:defsystem-depends-on
#+
asdf-unicode
(
:gendl-asdf
)
#+
asdf-encodings
:encoding
#+
asdf-encodings
:utf-8
:components
((
:gdl
"source/package"
)
(
:gdl
"source/parameters"
)
(
:gdl
"source/assembly"
)
(
:gdl
"source/initialize"
)
(
:gdl
"source/inspector"
)
(
:gdl
"source/menu-node"
)
(
:gdl
"source/menu"
)
(
:gdl
"source/tree"
)
(
:gdl
"source/user-inputs"
)
(
:gdl
"source/viewport"
)
(
:gdl
"source/zzinit"
)))
geysr/notes.txt
deleted
100644 → 0
View file @
53225681
;;
;; Copyright 2020 Genworks International
;;
;; This source file is part of the General-purpose Declarative
;; Language project (Gendl).
;;
;; This source file contains free software: you can redistribute it
;; and/or modify it under the terms of the GNU Affero General Public
;; License as published by the Free Software Foundation, either
;; version 3 of the License, or (at your option) any later version.
;;
;; This source file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; Affero General Public License for more details.
;;
;; You should have received a copy of the GNU Affero General Public
;; License along with this source file. If not, see
;; <http://www.gnu.org/licenses/>.
;;
- Add ability to visit definition in source code for a node from geysr and from emacs.
- Add inspector inserted directly in tree under a node.
geysr/source/assembly.gdl
deleted
100644 → 0
View file @
53225681
This diff is collapsed.
Click to expand it.
geysr/source/file-ordering.isc
deleted
100755 → 0
View file @
53225681
;;;; -*- coding: utf-8 -*-
;;
;; Copyright 2020 Genworks International
;;
;; This source file is part of the General-purpose Declarative
;; Language project (Gendl).
;;
;; This source file contains free software: you can redistribute it
;; and/or modify it under the terms of the GNU Affero General Public
;; License as published by the Free Software Foundation, either
;; version 3 of the License, or (at your option) any later version.
;;
;; This source file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; Affero General Public License for more details.
;;
;; You should have received a copy of the GNU Affero General Public
;; License along with this source file. If not, see
;; <http://www.gnu.org/licenses/>.
;;
("package" "parameters")
geysr/source/iframe.lisp
deleted
100644 → 0
View file @
53225681
;;;; -*- coding: utf-8 -*-
;;
;; Copyright 2020 Genworks International
;;
;; This source file is part of the General-purpose Declarative
;; Language project (Gendl).
;;
;; This source file contains free software: you can redistribute it
;; and/or modify it under the terms of the GNU Affero General Public
;; License as published by the Free Software Foundation, either
;; version 3 of the License, or (at your option) any later version.
;;
;; This source file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; Affero General Public License for more details.
;;
;; You should have received a copy of the GNU Affero General Public
;; License along with this source file. If not, see
;; <http://www.gnu.org/licenses/>.
;;
(
in-package
:geysr
)
(
define-object
iframe
(
sheet-section
)
:input-slots
(
url
)
:computed-slots
((
div-class
"gwl-iframe-section"
)
(
inner-html
(
with-cl-who-string
()
(
if
(
the
url
)
(
htm
((
:iframe
:id
"EmbeddedUI"
:title
"Embedded UI"
:height
"100%"
:width
"100%"
:seamless
:seamless
:src
(
the
url
))))
(
htm
(
:p
(
:h2
(
fmt
"Welcome to Geysr."
)))
(
:p
(
fmt
"Geysr is for inspecting Genworks GDL models
and user interfaces while you're developing them."
))
(
:p
(
fmt
"No object is currently selected and you're
in User Interface mode."
))
(
:p
(
fmt
"Select a node from the tree atleft
to display its User Interface, if one exists."
))))))))
geysr/source/initialize.gdl
deleted
100644 → 0
View file @
53225681
;;;; -*- coding: utf-8 -*-
;;
;; Copyright 2020 Genworks International
;;
;; This source file is part of the General-purpose Declarative
;; Language project (Gendl).
;;
;; This source file contains free software: you can redistribute it
;; and/or modify it under the terms of the GNU Affero General Public
;; License as published by the Free Software Foundation, either
;; version 3 of the License, or (at your option) any later version.
;;
;; This source file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; Affero General Public License for more details.
;;
;; You should have received a copy of the GNU Affero General Public
;; License along with this source file. If not, see
;; <http://www.gnu.org/licenses/>.
;;
(in-package :geysr)
(define-object geysr-try (assembly)
:computed-slots ((root-object-type (read-from-string "gdl-user::try"))))
(define-object geysr-bus (assembly)
:computed-slots ((root-object-type (read-from-string "bus::assembly"))))
(define-object geysr-house (assembly)
:computed-slots ((root-object-type (read-from-string "gdl-user::house"))))
(define-object geysr-missile (assembly)
:computed-slots ((root-object-type (read-from-string "missile::model"))))
(define-object geysr-robot (assembly)
:computed-slots ((root-object-type (read-from-string "robot:assembly"))))
(define-object geysr-cpacs (assembly)
:computed-slots ((root-object-type (read-from-string "xml-tree"))))
(define-object geysr-primi-plane (assembly)
:computed-slots ((root-object-type (read-from-string "primi-plane"))))
#+nil
(define-object geysr-tool-search (assembly)
:computed-slots ((root-object-type (read-from-string "gdl-user::tool-search"))))
(define-object geysr-spiral (assembly)
:computed-slots ((root-object-type (read-from-string "surf::spiral-curve-test"))))
(define-object geysr-bolt (assembly)
:computed-slots ((root-object-type (read-from-string "gdl-user::bolt-test"))))
(define-object geysr-glider (assembly)
:computed-slots ((root-object-type (read-from-string "wbl::glider"))))
(defun initialize ()
(let* ((directory (namestring
(or (probe-file (merge-pathnames "geysr/" (glisp:executable-homedir-pathname)))
(glisp:system-home :geysr)
(error "~&Geysr System Home not found, needed for its static/.~%"))))
(static (namestring (merge-pathnames "static/" directory))))
(with-all-servers (server)
(mapc #'(lambda(prefix file)
(publish-directory :prefix prefix :server server :destination file))
`("/geysr-static")
`(,static))
(publish-gwl-app "/glr" 'assembly)
(publish-gwl-app "/geysr" 'assembly)
(publish-gwl-app "/geysr-house" 'geysr-house)
(publish-gwl-app "/geysr-bus" 'geysr-bus)
(publish-gwl-app "/geysr-try" 'geysr-try)
(publish-gwl-app "/geysr-missile" 'geysr-missile)
(publish-gwl-app "/geysr-robot" 'geysr-robot)
(publish-gwl-app "/geysr-cpacs" 'geysr-cpacs)
(publish-gwl-app "/geysr-pp" 'geysr-primi-plane)
;;(publish-gwl-app "/geysr-ts" 'geysr-tool-search)
(publish-gwl-app "/geysr-spiral" 'geysr-spiral)
(publish-gwl-app "/geysr-bolt" 'geysr-bolt)
(publish-gwl-app "/geysr-glider" 'geysr-glider)
)))
;; (initialize)
geysr/source/inspector.gdl
deleted
100644 → 0
View file @
53225681
;;;; -*- coding: utf-8 -*-
;;
;; Copyright 2020 Genworks International
;;
;; This source file is part of the General-purpose Declarative
;; Language project (Gendl).
;;
;; This source file contains free software: you can redistribute it
;; and/or modify it under the terms of the GNU Affero General Public
;; License as published by the Free Software Foundation, either
;; version 3 of the License, or (at your option) any later version.
;;
;; This source file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; Affero General Public License for more details.
;;
;; You should have received a copy of the GNU Affero General Public
;; License along with this source file. If not, see
;; <http://www.gnu.org/licenses/>.
;;
(in-package :geysr)
(define-object inspector (sheet-section)
:input-slots
((node-root-path nil :settable)
onclick-function
(design-mode? nil)
root-object
tree-toplevel
geysr colors-default tree-type tree-node
display-controls-hash
click-mode
(relative-font-size "-1")
(node (when (the root-object) (the root-object (follow-root-path (the node-root-path)))))
(expand? (< (the depth) 1) :settable)
(depth 0)
)
:computed-slots
(
(show-settables? nil :settable)
(messages-local (set-difference (the node (message-list :message-type :local))
(append (the node (message-list :message-type :local
:category :methods))
(the node (message-list :message-type :local
:category :uncached-attributes)))))
(messages (safe-sort
(remove-if
#'(lambda (keyword)
(or (member keyword *internal-keywords*)
(and *suppress-$$-messages?*
(let ((string (string keyword)))
(and
(> (length string) 2) (string-equal (subseq string 0 2) "$$"))))
(and *suppress-%%-messages?*
(let ((string (string keyword)))
(and
(> (length string) 2)
(and (eql (aref string 0) #\%)
(or (eql (aref string 1) #\%)
(eql
(aref string (1- (length string)))
#\%))))))))
(set-difference (the :node (:message-list))
(append (the
:node
(:message-list :category :methods))
(the :node (:message-list
:category
:uncached-attributes)))))
#'string<))
(check-links nil :settable))
:hidden-objects
((values :type 'value-inspector
:depth (1+ (the depth))
:sequence (:size (length (the messages)))
:respondent (the respondent)
:message (nth (the-child index) (the messages))
:parent-node (the node)
:pass-down (design-mode?
geysr root-object
tree-toplevel colors-default
tree-type tree-node display-controls-hash
onclick-function
click-mode relative-font-size))
(settables-form :type 'settables-form
:pass-down (show-settables? node geysr design-mode?)))
:functions
(
(visit-definition-in-emacs
(definition)
(declare (ignore definition))
(error "Sorry! This is supposed to do 'lisp-find-definition' in emacs, but not working yet... Please send email to support@genworks.com"))
#+nil
(visit-definition-in-emacs
(definition)
(let ((emacs-lisp-command (format nil "(fi:lisp-find-definition ~s)" definition)))
(print-variables emacs-lisp-command)
#+allegro (lep::eval-in-emacs emacs-lisp-command)))
#+nil
(perform-action!
(object)
(the geysr (perform-action! object)))
(message-evaluate
(message)
;;
;; FLAG -- note we have to bash the view-toggle because no bashing
;; is actually happening when we evaluate the message, so the view
;; does not update by itself.
;;
;;(the toggle-view-toggle!)
(the (set-slot! :expand? t))
(with-error-handling () (the node (evaluate message)))
#+nil
(multiple-value-bind (value error) (ignore-errors (the node (evaluate message)))
(let* ((error? (and error (typep error 'error)))
(value (if error? (format nil "ERROR: ~a" error) value)))
(when error? (the node (set-slot! message value))))))
(set-object! (object) (the (set-slot! :node-root-path (the-object object root-path))))))
(define-lens (html-format inspector)()
:output-functions
((inner-html
()
(with-cl-who ()
(if (the node)
(write-the inspector-body)
(htm "No Object Instantiated"))))
(inspector-body
()
(with-cl-who ()
(:center
((:span :style "font-style: italic; font-weight: bold;")
(:p "Inspecting: "
(fmt "\"~a\"" (the node strings-for-display))
:br
"root-path: "
(esc (format nil "~s"
(cons 'the (reverse (butlast (the node-root-path))))))
(unless (butlast (the node-root-path))
(htm " [the root object]"))
:br
" type: " ((:span :style "color: blue; cursor: pointer;"
:onclick (unless (the design-mode?)
(the (gdl-ajax-call :function-key :visit-definition-in-emacs
:arguments (list (format nil "~s" (the node type)))))))
(esc (format nil "~s" (the node type)))))))
((:table :class "inspector-table" :border 1)
(:tr (:td "Settables") (:td (str (the settables-form control-view))))
(when (the settables-form show-settables?)
(htm (:tr ((:td :colspan 2)
(str (the settables-form inner-html))))))
(let ((count -1))
(dolist (value-inspector (list-elements (the values)))
(let ((message (the-object value-inspector message)))
(incf count)
(htm (:tr
((:td :class "i-t-m") (str (the-object value-inspector message)))
((:td :class "i-t-v")
;;
;; FLAG -- push everything to do with node into value-inspector
;;
(let ((slot-status (if (the expand?)
(the node (slot-status message)) :unbound)))
(case slot-status
(:unbound
(htm ((:span :class "i-t-v-click"
:onclick (unless (the design-mode?)
(the (gdl-ajax-call