Changeset 3680

Show
Ignore:
Timestamp:
07/29/08 14:56:24 (4 months ago)
Author:
ksprotte
Message:

add &allow-other-keys to initialize-persistent-instance for now

Files:

Legend:

Unmodified
Added
Removed
Modified
Copied
Moved

  • trunk/bknr/datastore/src/data/object.lisp

    r3677 r3680  
    245245                          :args (append (list object (if (symbolp class) class (class-name class))) args)))) 
    246246 
    247 (defgeneric initialize-persistent-instance (store-object &key) 
     247(defgeneric initialize-persistent-instance (store-object &key &allow-other-keys) 
    248248  (:documentation 
    249249   "Initializes the persistent aspects of a persistent object. This 

  • trunk/projects/bos/m2/poi.lisp

    r3679 r3680  
    88;;; POI-Anwendungsklassen und Konstruktoren 
    99 
    10 ;;; poi-image 
    11 (define-persistent-class poi-image (store-image) 
    12   ((poi :read) 
    13    (title :update :initform (make-string-hash-table)) 
    14    (subtitle :update :initform (make-string-hash-table)) 
    15    (description :update :initform (make-string-hash-table)))) 
     10;;; textual-attributes-mixin 
     11(define-persistent-class textual-attributes-mixin () 
     12  ((title :update :initform (make-string-hash-table) 
     13                  :documentation "Angezeigter Name") 
     14   (subtitle :update :initform (make-string-hash-table) 
     15                     :documentation "Unterschrift") 
     16   (description :update :initform (make-string-hash-table) 
     17                        :documentation "Beschreibungstext"))) 
    1618 
    17 (defmethod print-object ((object poi-image) stream) 
     19(deftransaction update-textual-attributes (obj language &key title subtitle description) 
     20  (when title 
     21    (setf (slot-string obj 'title language) title)) 
     22  (when subtitle 
     23    (setf (slot-string obj 'subtitle language) subtitle)) 
     24  (when description 
     25    (setf (slot-string obj 'description language) description))) 
     26 
     27;;; poi-medium 
     28(define-persistent-class poi-medium (textual-attributes-mixin) 
     29  ((poi :read))) 
     30 
     31(deftransaction make-poi-medium (class-name &key language title subtitle description poi initargs) 
     32  (assert (if (or title subtitle description) language t) nil 
     33          "language needs to be specified, if any of title, subtitle 
     34           or description is given") 
     35  (let ((medium (apply #'make-object class-name :poi poi initargs))) 
     36    (update-textual-attributes medium language 
     37                               :title title 
     38                               :subtitle subtitle 
     39                               :description description)     
     40    medium)) 
     41 
     42(defmethod initialize-persistent-instance :after ((poi-medium poi-medium) &key language title subtitle description poi) 
     43  (when (poi-medium-poi poi-medium) 
     44    (push poi-medium (poi-media (poi-medium-poi poi-medium))))) 
     45 
     46(defmethod print-object ((object poi-medium) stream) 
    1847  (print-unreadable-object (object stream :type t :identity nil) 
    1948    (format stream "~D" (store-object-id object)))) 
    2049 
    21 (deftransaction make-poi-image (language &key title subtitle description poi) 
    22   (let ((poi-image (make-object 'poi-image :poi poi))) 
    23     (setf (slot-string poi-image 'title language) title) 
    24     (setf (slot-string poi-image 'subtitle language) subtitle) 
    25     (setf (slot-string poi-image 'description language) description) 
    26     poi-image)) 
     50(defmethod destroy-object :before ((poi-medium poi-medium)) 
     51  (with-slots (poi) poi-medium 
     52    (when poi 
     53      (setf (poi-media poi) (remove poi-medium (poi-media poi)))))) 
    2754 
    28 (defmethod destroy-object :before ((poi-image poi-image)) 
    29   (with-slots (poi) poi-image 
    30     (when poi 
    31       (setf (poi-images poi) (remove poi-image (poi-images poi)))))) 
    32  
    33 (defmethod initialize-persistent-instance :after ((poi-image poi-image) &key) 
    34   (setf (poi-images (poi-image-poi poi-image)) (append (poi-images (poi-image-poi poi-image)) (list poi-image)))) 
    35  
    36 (deftransaction update-poi-image (poi-image language 
    37                                             &key title subtitle description) 
    38   (when title 
    39     (setf (slot-string poi-image 'title language) title)) 
    40   (when subtitle 
    41     (setf (slot-string poi-image 'subtitle language) subtitle)) 
    42   (when description 
    43     (setf (slot-string poi-image 'description language) description))) 
     55;;; poi-image 
     56(define-persistent-class poi-image (store-image poi-medium) 
     57  ()) 
    4458 
    4559;;; poi-movie 
    46 (define-persistent-class poi-movie () 
    47   ((poi :read) 
    48    (url :update :initform nil))) 
     60(define-persistent-class poi-movie (poi-medium) 
     61  ((url :update :initform nil))) 
    4962 
    5063;;; poi 
    51 (define-persistent-class poi () 
     64(define-persistent-class poi (textual-attributes-mixin) 
    5265  ((name :read :index-type string-unique-index 
    5366               :index-reader find-poi :index-values all-pois 
    5467               :documentation "Symbolischer Name") 
    55    (published :update :initform nil :documentation "Wenn dieses Flag NIL ist, wird der POI in den UIs nicht angezeigt") 
    56    (title :update :initform (make-string-hash-table) :documentation "Angezeigter Name") 
    57    (subtitle :update :initform (make-string-hash-table) :documentation "Unterschrift") 
    58    (description :update :initform (make-string-hash-table) :documentation "Beschreibungstext") 
     68   (published :update :initform nil :documentation "Wenn dieses Flag NIL ist, wird der POI in den UIs nicht angezeigt")    
    5969   (area :update :initform nil :documentation "Polygon mit den POI-Koordinaten") 
    6070   (icon :update :initform "palme" :documentation "Name des Icons")    
    61    (medias :update :initform nil))) 
    62  
    63 (defmethod poi-movies :before ((poi poi)) 
    64   "Lazily update the db schema. Method can be removed later." 
    65   (macrolet ((movie (tail) `(car ,tail))) 
    66     (mapl (lambda (tail) 
    67             (when (stringp (movie tail)) 
    68               (setf (movie tail) 
    69                     (make-object 'poi-movie :poi poi :url (movie tail))))) 
    70           (slot-value poi 'movies)))) 
     71   (media :update :initform nil))) 
    7172 
    7273(deftransaction make-poi (language name &key title description area) 
    …… 
    7778 
    7879(defmethod destroy-object :before ((poi poi)) 
    79   (mapc #'delete-object (poi-images poi))) 
     80  (mapc #'delete-object (poi-media poi))) 
    8081 
    8182(defmethod poi-complete ((poi poi) language) 
    8283  (and (every #'(lambda (slot-name) (slot-string poi slot-name language nil)) '(title subtitle description)) 
    83        (poi-area poi) 
    84        (poi-images poi) 
     84       (poi-area poi)        
     85       (<= 6 (count-if (lambda (medium) (typep medium 'poi-image)) (poi-media poi))) 
    8586       t)) 
    86  
    87 (defun update-poi (poi language &key title subtitle description area icon published (images :not-set) (movies :not-set)) 
    88   (with-transaction () 
    89     (setf (slot-value poi 'published) published) 
    90     (when title 
    91       (setf (slot-string poi 'title language) title)) 
    92     (when subtitle 
    93       (setf (slot-string poi 'subtitle language) subtitle)) 
    94     (when description 
    95       (setf (slot-string poi 'description language) description)) 
    96     (when area 
    97       (setf (poi-area poi) area)) 
    98     (when icon 
    99       (setf (poi-icon poi) icon)) 
    100     (when (listp images) 
    101       (setf (poi-images poi) images)) 
    102     (when (listp movies) 
    103       (setf (poi-movies poi) movies)))) 
    10487 
    10588(defmethod poi-center-x ((poi poi)) 

  • trunk/projects/bos/m2/slot-strings.lisp

    r3675 r3680  
    1818(defun set-slot-string (object slot-name language new-value) 
    1919  (unless (in-transaction-p) 
    20     (error "attempt to set string in multi-language string slot ~a of object ~a outside of transaction" slot-name object)) 
     20    (error "attempt to set string in multi-language string slot ~a of ~ 
     21            object ~a outside of transaction" slot-name object)) 
    2122  (setf (gethash language (slot-value object slot-name)) new-value)) 
    2223