Commit 0364f783 authored by Dave Cooper's avatar Dave Cooper

ready for fresh dev install

parent cef7a134
(in-package :gdl-user)
(define-object robot-drawing (base-drawing)
:hidden-objects ((robot-assembly :type 'robot:assembly)
(text-block :type 'robot-text-block
......@@ -17,7 +17,7 @@
:objects
((text-view :type 'base-view
((text-view :type 'base-view
;;:left-margin 0
;;:front-margin 0
:border-box? t
......@@ -26,7 +26,7 @@
:width (half (the width))
:projection-vector (getf *standard-views* :top)
:center (translate (the center) :rear (half (the-child length))
:right (half (the-child width))))
:right (half (the-child width))))
(tri-view :type 'base-view
:border-box? t
......@@ -98,6 +98,7 @@
(tt:vspace 100)
(tt:paragraph () "Robot Data")
(let ((width (- (the width) (the margins))))
(tt:table (:col-widths (list (* 2/3 width) (* 1/3 width)))
(dolist (slot (list :robot-width :robot-length :body-angle :arm-angle-left :head-angle))
......
......@@ -16,7 +16,7 @@
;; 2. WHERE ARE WE?
(defvar *gdl-home* (file-truename (concat (file-name-directory (file-truename load-file-name)) "../")))
(defvar *gendl-home* (file-truename (concat (file-name-directory (file-truename load-file-name)) "../")))
;; 3. CONFGURGE EMACS
......@@ -39,7 +39,7 @@
;; 3.2. Set up color-theme and solarized color-themes
(add-to-list 'load-path (concat *gdl-home* "emacs/emacs-color-theme"))
(add-to-list 'load-path (concat *gendl-home* "emacs/emacs-color-theme"))
(require 'color-theme)
(color-theme-initialize)
(color-theme-sitaramv-solaris)
......@@ -100,8 +100,9 @@
;;
;; 4.1. Some synonyms
(defun gendl () (interactive) (with-temp-buffer (cd *gdl-home*) (slime)))
(defun gendl () (interactive) (with-temp-buffer (cd *gendl-home*) (slime)))
(defun gdl () (interactive) (gendl))
(defun glime () (interactive) (gendl))
(defun gdl-quit () (interactive) (slime-quit-lisp))
(defun gq () (interactive) (gdl-quit))
......@@ -117,13 +118,15 @@
(defun configure-slime ()
(setq lisp-invocation nil)
(setq path-to-quicklisp-helper nil)
(let ((config-file (concat *gdl-home* "configure.el")))
(when (file-exists-p config-file)
;; Loading this file sets lisp-invocation and path-to-quicklisp-helper
(load-file config-file))
(when lisp-invocation
(setq slime-lisp-implementations `((gendl ,lisp-invocation))))
(load-file path-to-quicklisp-helper)))
(let ((config-file (concat *gendl-home* "configure.el")))
(if (file-exists-p config-file)
(progn
;; Loading this file sets slime-lisp-implementations and path-to-quicklisp-helper
(load-file config-file)
(load-file path-to-quicklisp-slime-helper))
(error "Config File %s was not found.
Please create this file, which should set slime-lisp-implementations and path-to-quicklisp-slime-helper."))))
(configure-slime)
(require 'slime-autoloads)
......@@ -144,7 +147,7 @@
(defun load-gendl ()
(slime-repl)
(insert (format "(load \"%sload-gendl.lisp\")" *gdl-home*))
(insert (format "(load \"%sload-gendl.lisp\")" *gendl-home*))
(insert "(in-package gdl-user)")
(slime-repl-return)
(end-of-buffer))
......@@ -168,14 +171,11 @@
;; 4.4. Prior to SLIME
(defun prior-to-slime ()
(find-file (concat *gdl-home* "emacs/README.txt"))
(find-file (concat *gendl-home* "emacs/README.txt"))
(toggle-read-only)
(let ((frame-title "Genworks® Gendl™ Interactive Authoring Environment"))
(modify-frame-parameters nil
(list (cons 'name frame-title))))
(message "Please see the Startup section of this document for starting the Gendl environment.")
(when (file-exists-p "~/.emacs-gendl")
(load-file "~/.emacs-gendl"))
(modify-frame-parameters nil (list (cons 'name frame-title))))
(when (file-exists-p "~/.emacs-gendl") (load-file "~/.emacs-gendl"))
(setq inhibit-splash-screen t)
(cd "~/")
(set-frame-parameter nil 'fullscreen 'maximized))
......@@ -184,7 +184,7 @@
;; 5. MAKE IT HAPPEN
(prior-to-slime)
(slime)
(glime)
;; A. REFERENCES
......
1. Reference-chains entered into Slime REPL throw an "error in process
filter" e.g.:
1. Reference-chains (with "the" or "the-object") entered into Slime
REPL (or anywhere else outside of a define-object context) should
still provide an enriched-decoded-arglist in the mini-buffer, iff
the global gdl:self is bound (which it typically will be, if
someone is typing reference chains at Slime REPL).
GDL-USER>
;; Error: Odd length keyword list: (SWANK::%CURSOR-MARKER%)
;; Error: Odd length keyword list: (SWANK::%CURSOR-MARKER%)
;; Error: Odd length keyword list: (SWANK::%CURSOR-MARKER%)
; No value
GDL-USER> (the foo ...
In that case, the global gdl:self should be the starting class for
any reference chains.
This is fixed temporarily with an ignore-errors around body of
this-the-from-form in emacs/glime.lisp genworks' current
slime-devel branch. Ignore-errors should probably still be there
just to catch any unforeseen situations, but probably with a
multiple-value-bind to catch the error and handle it somehow or at
least print a warning message about it.
example:
GDL-USER> (make-self 'robot-drawing)
#<ROBOT-DRAWING #x302004739C4D>
GDL-USER> (the
Now the mini-buffer should show completions of "(the ..." based
on the fact that self is an instance of robot-drawing.
N.B. self is not declared special in Gendl currently. It probably
should be, but I am not sure what would be the ramifications of
doing this. Needs to be investigated (on my end). For now it
should be left as-is and not declared special with defparameter or
defvar.
2. Within the-child and the-object, glime was incorrectly picking up
the messages-in-this-form as well as the messages from the :type of
the current child object. This has been fixed for now by binding
*message-locators* to simply '(messages-from-classes) in
compute-enriched-decoded-arglist for the-object and the-child. I'm
not sure if this is the best way to go about this, because there is
another case where messages-in-this-form should not be included
(see (3) below).
2. the-child is not picking up the type of current child -- it still
appears to be working based off the enclosing define-object type.
3. In reference-chains after the first message, i.e.
3. When placing the "(" after "(the (" it does toggle to display
available GDL Functions, but it should also suppress display of
non-Function slots, and it does not appear to be doing this.
(the foo ...)
it is still picking up messages-in-this-form. At that point it
should only be picking up messages-from-classes for the class-of
(the foo) [if any].
4. Sequence (quantified) objects are still showing up for "(the ..."
and they should only show up for "(the (..." [i.e. they should
behave like Functions]
example:
(define-object frob ()
:objects ((baz :type 'box
:sequence (:size 10))))
;; compile above form. Now do
(make-self 'frob)
(the ...
4. slime-autodoc-use-multiline-p does not appear to be activated.
Typing "(the ..." should not include baz
5. Sequence (quantified) objects are not behaving like GDL Functions
for "(the (" as they should.
Typing "(the (..." _should_ include baz.
6. Reference-chains do not appear to pick up the inferred type of each
element along the chain, as theoretically should (at least
sometimes) be possible, using e.g. (the (slot-source ...)) and
pulling out the :type for messages which name :objects
or :hidden-objects.
7. Functions-in-this-form (which are not compiled into object yet) are
not being picked up.
8. a. "(the-object foo (evaluate ... " should work identically to
5. a. "(the-object foo (evaluate ... " should work identically to
"(the-object foo ..." except symbols should show up as keywords.
b. "(the-object foo ((evaluate ... " should work identically to
......
......@@ -432,11 +432,13 @@ each returning a list of proposed messages.")
(defmethod compute-enriched-decoded-arglist ((operator (eql 'gendl:the-object)) arguments)
(declare (ignorable arguments))
(or (embedded-the-arglist) (call-next-method)))
(let ((*message-locators* '(messages-from-classes)))
(or (embedded-the-arglist) (call-next-method))))
(defmethod compute-enriched-decoded-arglist ((operator (eql 'gendl:the-child)) arguments)
(declare (ignorable arguments))
(or (embedded-the-arglist) (call-next-method)))
(let ((*message-locators* '(messages-from-classes)))
(or (embedded-the-arglist) (call-next-method))))
(defvar *this-the*)
......@@ -446,6 +448,7 @@ each returning a list of proposed messages.")
;; 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
......@@ -463,11 +466,11 @@ each returning a list of proposed messages.")
;; 9.1. Analyse the current gendl:the form
(defstruct (this-the
(:constructor make-this-the (section slot-form the-form
&aux
(functionp (when (consp the-form)
(the-form-functionp (cdr the-form))))
(quantifiedp (quantified-objects-p section slot-form the-form)))))
(:constructor make-this-the (section slot-form the-form
&aux
(functionp (when (consp the-form)
(the-form-functionp (cdr the-form))))
(quantifiedp (quantified-objects-p section slot-form the-form)))))
section
slot-form
the-form
......@@ -571,18 +574,25 @@ gendl:the (etc) form under construction."
;; 9.3. Messages which we can deduce from mixin classes.
(defparameter *messages-to-suppress*
(list :aggregate :all-mixins :children-uncached :direct-mixins :documentation
:hidden? :leaves-uncached :message-documentation :message-list :mixins :name-for-display
:restore-all-defaults! :restore-tree! :root :root-path-local :root? :safe-children
:safe-hidden-children :slot-documentation :slot-source :slot-status :update! :visible-children
:write-snapshot))
(list
;; from vanilla-mixin*:
:aggregate :all-mixins :children-uncached :direct-mixins :documentation
:hidden? :leaves-uncached :message-documentation :message-list :mixins :name-for-display
:restore-all-defaults! :restore-tree! :root :root-path-local :root? :safe-children
:safe-hidden-children :slot-documentation :slot-source :slot-status :update! :visible-children
:write-snapshot
;; from base-object:
:image-file :local-bbox :local-box :local-center :local-center*
:local-orientation :obliqueness
))
(defparameter *messages-to-suppress-when-not-sequence-member*
(list :first? :index :last?))
(list :first? :index :last? :next :previous))
(defun messages-from-classes (form)
(defun messages-from-classes* (classes)
"Use message-list to find out what the messages might be."
(let* ((starting-classes (starting-classes form))
(let* ((starting-classes classes)
(mixins (remove-duplicates (append (mapcar 'class-name starting-classes)
(loop for class in starting-classes append
(gendl:the-object (gendl-class-prototype class) all-mixins)))
......@@ -592,6 +602,12 @@ gendl:the (etc) form under construction."
'string<)))))
(filter-sequence-messages messages)))
(defun messages-from-classes (form)
"Use message-list to find out what the messages might be."
(let ((starting-classes (starting-classes form)))
(messages-from-classes* starting-classes)))
(defun starting-classes (form)
(destructuring-bind (classname &optional mixins &rest keywords)
(cdr form)
......@@ -602,10 +618,10 @@ gendl:the (etc) form under construction."
;; It's a either a (the-child ...) class , or a redefinition
;; (which includes: clicking on an existing defintion).
(the-reference-chain this-class)
;; New definition. Hit the superclasses.
(loop for classname in mixins
for class = (safe-find-class classname)
when class collect class)))))
;; New definition. Hit the superclasses.
(loop for classname in mixins
for class = (safe-find-class classname)
when class collect class)))))
;; If we're in a the-child inside an :objects or :hidden-objects clause and can find
;; a class for the :type, return that.
......@@ -699,6 +715,7 @@ in one of the *internal-packages*), otherwise filter for non-nil message-remarks
collect message)))))
(defun filter-sequence-messages (messages)
(if (and (boundp '*this-the*)
(this-the-quantifiedp *this-the*))
messages
......
(in-package :common-lisp-user)
(let ((personal-boot-file "../gdl/tools/boot/load.lisp"))
(when (probe-file personal-boot-file) (load personal-boot-file)))
(funcall (find-symbol (string #:quickload) :ql) :gendl)
(gendl:start-gendl!)
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