Commit 4c0b8f40 authored by Dave Cooper's avatar Dave Cooper

added generalized check for reserved words (i.e. non-inputs) in internal primitives

parent 6f979848
......@@ -140,11 +140,16 @@ and then compile this again.~%"))
(safe-sort (set-difference attempted-inputs accepted-inputs)
#'string-lessp :key #'string)))
;;
;; FLAG -- do we really need to do this here? We are already
;; checking for non-inputs, and the reserved words will all
;; be non-inputs.
;;
(reserved-word-warning-or-error part-type-symbol
(mapcar #'(lambda(symbol)
(glisp:intern symbol :gdl-acc))
attempted-inputs))
attempted-inputs) (list part-type-symbol))
(when unrecognized-inputs
(let* ((singular? (= (length unrecognized-inputs) 1))
......
This diff is collapsed.
......@@ -159,18 +159,44 @@
(setq current-remark-string nil on-message? nil))))))
(defparameter *reserved-word-protected-packages* (list (find-package :gdl)
(find-package :geom-base)
(find-package :surf)))
(defun reserved-word-warning-or-error (name messages)
(unless (and (atom name)
(or (member (symbol-package name) *reserved-word-protected-packages*)))
(let ((reserved-violations (intersection messages +reserved-words+)))
(defparameter *reserved-words-hash* (make-hash-table))
;;
;; FLAG -- consider a scheme for controlling the overriding of your
;; own mixins as well, perhaps allowing for a list of
;; overridable-slots.
;;
(defun reserved-words-for (mixins)
(apply #'append
(mapcar
#'(lambda(mixin)
(when (member (glisp:intern (package-name (symbol-package mixin)) :keyword) *packages-to-lock*)
(or (gethash mixin *reserved-words-hash*)
(setf (gethash mixin *reserved-words-hash*)
(mapcar
#'(lambda(word) (glisp:intern word :gdl-acc))
(set-difference
(the-object (make-object mixin) message-list)
(append
(the-object (make-object mixin) (message-list :category :required-input-slots))
(the-object (make-object mixin) (message-list :category :optional-input-slots))
(the-object (make-object mixin) (message-list :category :settable-optional-input-slots))
(the-object (make-object mixin) (message-list :category :defaulted-input-slots))
(the-object (make-object mixin) (message-list :category :settable-defaulted-input-slots)))))))))
mixins)))
(defun reserved-word-warning-or-error (name messages mixins)
(unless (and (atom name) (member (glisp:intern (package-name (symbol-package name)) :keyword) *packages-to-lock*))
(let* ((reserved-words (reserved-words-for mixins))
(reserved-violations (intersection messages reserved-words))
(length (length reserved-violations)))
(when reserved-violations
(let ((is-or-are (if (= (length reserved-violations) 1) "is" "are"))
(s-or-blank (if (= (length reserved-violations) 1) "" "s"))
(a-or-blank (if (= (length reserved-violations) 1) "a " "")))
(let ((is-or-are (if (= length 1) "is" "are"))
(s-or-blank (if (= length 1) "" "s"))
(a-or-blank (if (= length 1) "a " "")))
(funcall (if *error-on-reserved-words?*
#'error
......
......@@ -210,3 +210,6 @@ values are a color indicator for the default foreground and background of graphi
:tasty :robot :tree :yadd :surf :smlib :genworks-gdl))
(defvar *quicklisp-home* nil)
(defvar *packages-to-lock*
(list :gendl :geom-base :cl-lite :gwl :gwl-graphics :tasty :robot :tree :yadd :surf :smlib :genworks-gdl))
;;
;; Copyright 2002-2011 Genworks International and Genworks BV
;;
;; This source file is part of the General-purpose Declarative
;; Language project (GDL).
;;
;; 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/>.
;;
("tests")
;;;; -*- coding: utf-8 -*-
(asdf:defsystem #:gwl :description
"The Gendl™ Generative Web Language (GWL)" :author "John McCarthy"
:license "Affero Gnu Public License (http://www.gnu.org/licenses/)"
:serial t :version "20150122" :depends-on
(asdf:defsystem
#:gwl
:description
"The Gendl™ Generative Web Language (GWL)"
:author
"Dave Cooper"
:license
"Affero Gnu Public License (http://www.gnu.org/licenses/)"
:serial
t
:version
"20150317"
:depends-on
(:bordeaux-threads :glisp :aserve)
#-asdf-unicode :defsystem-depends-on #-asdf-unicode (:asdf-encodings)
#+asdf-encodings :encoding #+asdf-encodings :utf-8
:components
((:file "source/package") (:file "source/defparameters")
(:file "source/presets") (:file "source/base-html-sheet")
(:file "source/base-html-utils") (:file "source/macros")
((:file "source/package")
(:file "source/defparameters")
(:file "source/presets")
(:file "source/base-html-sheet")
(:file "source/base-html-utils")
(:file "source/macros")
(:file "source/ignore-errors-with-backtrace")
(:file "source/utilities") (:file "source/answer")
(:file "source/accessories") (:file "source/gdl-remote")
(:file "source/vanilla-remote") (:file "source/base64-utils")
(:file "source/cl-pdf-patches") (:file "source/color-palette")
(:file "source/crawler") (:file "source/log-utils")
(:file "source/new-urls") (:file "source/publish")
(:file "source/utilities")
(:file "source/answer")
(:file "source/accessories")
(:file "source/gdl-remote")
(:file "source/vanilla-remote")
(:file "source/base64-utils")
(:file "source/cl-pdf-patches")
(:file "source/color-palette")
(:file "source/crawler")
(:file "source/log-utils")
(:file "source/new-urls")
(:file "source/publish")
(:file "source/remote-object")
(:file "source/security-check-failed")
(:file "form-elements/source/grid-form-element")
(:file "form-elements/source/macros")
(:file "form-elements/source/primitives")
(:file "form-elements/source/short-test")
(:file "form-elements/source/test-seq")
(:file "form-elements/source/validation-tests")
(:file "ajax/source/parameters") (:file "ajax/source/ajax")
(:file "ajax/source/parameters")
(:file "ajax/source/ajax")
(:file "ajax/source/base-ajax-sheet")
(:file "ajax/source/skeleton-ui-element")
(:file "gwl-session/source/parameters")
......@@ -38,4 +54,5 @@
(:file "gwl-session/source/session-report")
(:file "js-libs/jquery/source/package")
(:file "js-libs/jquery/source/slider-form-control")
(:file "zzinit/source/initialize") (:file "zzinit/source/zzinit")))
(:file "zzinit/source/initialize")
(:file "zzinit/source/zzinit")))
......@@ -19,7 +19,7 @@
;; <http://www.gnu.org/licenses/>.
;;
(in-package :gwl-user)
(in-package :gwl)
(publish :path "/color-map"
......
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