Commit af4db9c0 authored by unknown's avatar unknown
Browse files

If specialised treatment can't produce any messages, fall back on the's arglist.

parent 93ea639b
...@@ -390,7 +390,7 @@ doesn't matter. For others it does. So we'll make an object and cache it." ...@@ -390,7 +390,7 @@ doesn't matter. For others it does. So we'll make an object and cache it."
;; 9. HELP ON MESSAGES FOR GENDL:THE AND FRIENDS ;; 9. HELP ON MESSAGES FOR GENDL:THE AND FRIENDS
;; We're only looking at the top of the reference-chain. See ;; We're only looking at the top of the reference-chain. See
;; http://paste.lisp.org/display/137274 ;; http://paste.lisp.org/display/137274
;; Note that (the (slot-source :bar)) gives you info about the ;; Note that (the (slot-source :bar)) gives you info about the
;; specified :type of bar. "You also have to establish the fact that ;; specified :type of bar. "You also have to establish the fact that
;; bar is indeed a GDL object and not some leaf-level value as with a ;; bar is indeed a GDL object and not some leaf-level value as with a
...@@ -423,19 +423,20 @@ each returning a list of proposed messages.") ...@@ -423,19 +423,20 @@ each returning a list of proposed messages.")
(remove-duplicates (loop for locator in *message-locators* append (remove-duplicates (loop for locator in *message-locators* append
(funcall locator whole-form)) (funcall locator whole-form))
:from-end t)))) :from-end t))))
(values (make-arglist :key-p t (when messages
:keyword-args (loop for message in messages collect (values (make-arglist :key-p t
(make-keyword-arg message message nil)) :keyword-args (loop for message in messages collect
:provided-args nil (make-keyword-arg message message nil))
:allow-other-keys-p t :provided-args nil
:rest 'reference-chain) :allow-other-keys-p t
nil t))) :rest 'reference-chain)
nil t))))
;; 9.1. Analyse the current gendl:the form ;; 9.1. Analyse the current gendl:the form
(defstruct (this-the (defstruct (this-the
(:constructor make-this-the (section slot-form the-form (:constructor make-this-the (section slot-form the-form
&aux &aux
(functionp (and (consp the-form) (functionp (and (consp the-form)
;; Selects "(the (..." ;; Selects "(the (..."
(consp (second the-form)))) (consp (second the-form))))
...@@ -455,7 +456,7 @@ each returning a list of proposed messages.") ...@@ -455,7 +456,7 @@ each returning a list of proposed messages.")
(case operator (case operator
((gendl:the-child) ((gendl:the-child)
;; It's a the-child inside an :object or :hidden-object. ;; It's a the-child inside an :object or :hidden-object.
;; Look graciously for a :sequence key. ;; Look graciously for a :sequence key.
(loop for key in (cdr slot-form) by 'cddr (loop for key in (cdr slot-form) by 'cddr
thereis (eq key :sequence))))))) thereis (eq key :sequence)))))))
......
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