Change naming convention around.

[sod] / src / pset-impl.lisp

diff --git a/src/pset-impl.lisp b/src/pset-impl.lisp
new file mode 100644 (file)
index 0000000..e498deb
--- /dev/null
+++ b/src/pset-impl.lisp
@@ -0,0 +1,83 @@
+;;; -*-lisp-*-
+;;;
+;;; Implementation for property sets
+;;;
+;;; (c) 2009 Straylight/Edgeware
+;;;
+
+;;;----- Licensing notice ---------------------------------------------------
+;;;
+;;; This file is part of the Sensble Object Design, an object system for C.
+;;;
+;;; SOD is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; SOD 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 General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with SOD; if not, write to the Free Software Foundation,
+;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+(cl:in-package #:sod)
+
+;;;--------------------------------------------------------------------------
+;;; Property representation.
+
+(defmethod file-location ((prop property))
+  (file-location (p-location prop)))
+
+;;; Keywords.
+
+(defmethod coerce-property-value
+    ((value symbol) (type (eql :symbol)) (wanted (eql :keyword)))
+  value)
+
+(defmethod coerce-property-value
+    ((value string) (type (eql :id)) (wanted (eql :keyword)))
+  (string-to-symbol value :package :keyword))
+
+(defmethod coerce-property-value
+    ((value string) (type (eql :string)) (wanted (eql :keyword)))
+  (string-to-symbol value :package :keyword :swap-hyphen nil))
+
+;;; Symbols.
+
+(defmethod coerce-property-value
+    ((value string) (type (eql :id)) (wanted (eql :symbol)))
+  (string-to-symbol value))
+
+(defmethod coerce-property-value
+    ((value string) (type (eql :string)) (wanted (eql :symbol)))
+  (string-to-symbol value :swap-hyphen nil))
+
+;;; Identifiers.
+
+(defmethod coerce-property-value
+    ((value string) (type (eql :string)) (wanted (eql :id)))
+  value)
+
+(defmethod coerce-property-value
+    ((value symbol) (type (eql :symbol)) (wanted (eql :id)))
+  (frob-identifier (symbol-name value)))
+
+;;;--------------------------------------------------------------------------
+;;; Property sets.
+
+(defmethod print-object ((pset pset) stream)
+  (print-unreadable-object (pset stream :type t)
+    (pprint-logical-block (stream nil)
+      (let ((firstp t))
+       (pset-map (lambda (prop)
+                   (cond (firstp (setf firstp nil))
+                         (t (write-char #\space stream)
+                            (pprint-newline :linear stream)))
+                   (format stream "~:@<~S ~@_~S ~@_~S~:>"
+                           (p-name prop) (p-type prop) (p-value prop)))
+                 pset)))))
+
+;;;----- That's all, folks --------------------------------------------------