Commit 1f80d51d authored by Dave Cooper's avatar Dave Cooper

Geysr enhancements, bigfix with base-form-element

Added part type entry field in geysr.
Added email? slot to base-form-control to accomodate addition of email-form-control.
parent addf6a6f
......@@ -9,6 +9,18 @@
;;
;;
#|
ToDO:
1. Update welcome message to reflect empty object and refer to File->New.
2. Adjust spacing of tree for empty object to give enough room not to
obstruct File->New menu.
|#
(in-package :geysr)
(defvar *developing?* nil)
......@@ -63,13 +75,22 @@
(use-anyresize? (not (the design-mode?)))
(root-object-type (read-from-string "robot:assembly") :settable)
(root-object-type nil :settable)
(root-object-type-valid? (and (the root-object-type)
(typep (ignore-errors
(find-class
(ignore-errors
(read-safe-string (the root-object-type)))))
'gdl-class)))
(root-object (the root-object-object) :settable)
(root-object-object (make-object (the root-object-type)
:god-parents (list self)
:strings-for-display (format nil "~s" (the root-object-type))))
(root-object-object
(when (the root-object-type-valid?)
(make-object (the root-object-type)
:god-parents (list self)
:strings-for-display (format nil "~s" (the root-object-type)))))
(additional-header-content
(with-cl-who-string ()
......@@ -234,6 +255,17 @@
:functions
(
(set-new-geysr-object!
(object-type)
(let ((type (ignore-errors (read-safe-string object-type))))
;;
;; FLAG -- throw an error (which gets displayed) if an invalid
;; object type is entered.
;;
(when (and type (typep (find-class type) 'gdl-class))
(the viewport clear!)
(the (set-slot! :root-object-type type)))))
;;
;; FLAG -- change this to accept the actual single menu object in
;; question, then compute a list of it and its parents' ids up
......
......@@ -3,16 +3,16 @@
(define-object menu-node ()
:input-slots ((label "TBD")
(title (unless (the child-nodes) "This operation is not implemented yet..."))
(id (glisp:replace-regexp
(glisp:replace-regexp
(glisp:replace-regexp
(glisp:replace-regexp
(format nil "~s" (cons 'the (reverse (butlast (butlast (the root-path))))))
" " "__") "\\:" "") "\\(" "") "\\)" ""))
(onfocus nil)
(depth (if (or (not (the parent)) (not (typep (the parent) 'menu-node)))
0
(1+ (the parent depth)))))
(id (glisp:replace-regexp
(glisp:replace-regexp
(glisp:replace-regexp
(glisp:replace-regexp
(format nil "~s" (cons 'the (reverse (butlast (butlast (the root-path))))))
" " "__") "\\:" "") "\\(" "") "\\)" ""))
(onfocus nil)
(depth (if (or (not (the parent)) (not (typep (the parent) 'menu-node)))
0
(1+ (the parent depth)))))
:computed-slots ((child-nodes
......@@ -59,6 +59,12 @@
(htm ((:span :class "menu-right-icon")
((:i :class "fas fa-caret-right"))))))
(str (the-object child html))))
(str (the-object child html)))))))))
(str (the-object child html))))))))
:functions
((set-new-geysr-object!
(object-type)
(the menu-object geysr (set-new-geysr-object! object-type)))))
......@@ -78,6 +78,12 @@ setTimeout(hideMenus, 10);
document.addEventListener('click', hideMenus);
//document.querySelector('#menu').addEventListener('keypress', function (e) {
// if (e.key === 'Enter') {hideMenus();}})
document.addEventListener('keypress', function (e) {
if (e.key === 'Enter') {hideMenus();}})
function addVisible(event, level)
{
var obj = event.target;
......@@ -113,8 +119,6 @@ function addVisible(event, level)
(reset-root! () (funcall (the reset-root-func)))))
(define-object geysr-nav (menu-node)
:input-slots ((id "menu") menu-object (design-mode? nil) (local-assets? t))
......@@ -153,7 +157,33 @@ function addVisible(event, level)
:objects ((file-new-menu) (file-open-menu) (file-save-menu)))
(define-object file-new-menu (menu-node)
:computed-slots ((label "New")))
:computed-slots ((label "New"))
:objects ((file-new-typein)))
(define-object file-new-typein (menu-node sheet-section)
:computed-slots ((label (with-cl-who-string ()
(str (the file-new-typein-control form-control-string))))
(ajax-call (the (gdl-ajax-call
:function-key :set-new-geysr-object!
:form-controls (list (the file-new-typein-control))))))
:objects (;;
;; FLAG - implement a dropdown ("combo box") to pick from existing defs.
;;
(file-new-typein-control :type 'text-form-control
:onblur (the ajax-call)
:placeholder "package:type"
:default ""))
:functions
((set-new-geysr-object!
()
(the menu-object geysr (set-new-geysr-object! (the file-new-typein-control value))))))
(define-object file-open-menu (menu-node)
:computed-slots ((label "Open")))
......
......@@ -122,8 +122,11 @@ Converting to a string to avoid error."
(inner-html
(with-cl-who-string ()
((:ul :id "tree-root" :class "geysr-tree")
(str (the tree-node-view)))))
(if (the target-object)
(htm ((:ul :id "tree-root" :class "geysr-tree")
(str (the tree-node-view))))
(htm ((:span :class "geysr-tree")
"No Object Instantiated")))))
(tree-node-view
......
......@@ -269,7 +269,8 @@ x3draw();
hash)))))
(clear! ()
(the (clear-display-controls!)) (the (clear-view-object-roots!)) (the (clear-view-objects!)))
(the (clear-display-controls!)) (the (clear-view-object-roots!))
(the (clear-view-objects!)))
(clear-display-controls!
() (let ((hash (the display-controls-root-path-hash)))
......
......@@ -236,7 +236,9 @@ This must be specified by user code, or an error will result."
(string
(if (null (the index))
(make-keyword (the %name%))
(make-keyword (format nil "~a#~a" (the %name%) (the index))))) "-" " ")))
(make-keyword (format nil "~a#~a" (the %name%) (the index))))) "-" " ")))
(email? nil)
("Boolean. Regardless of :domain, if this is non-nil, nil values will be accepted. Defaults to t if (the default) is nil,
otherwise defaults to nil."
......
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