annotate implementations/midi-db/methods.lisp @ 314:937334f2bcd2

Add generic ID constructor to midi-db. Ignore-this: 91554466a43d64ee99fbf840985d7c6b darcs-hash:20100414185257-16a00-dcfa03eaa450cfdce842c64c3f49214c5c938181.gz
author j.forth <j.forth@gold.ac.uk>
date Wed, 14 Apr 2010 19:52:57 +0100
parents f99fd6a7bbfc
children 2138ea478adb
rev   line source
j@310 1 (cl:in-package #:amuse-midi-db)
j@310 2
j@314 3 ;;;=====================================================================
j@314 4 ;;; Specialized constructors
j@314 5 ;;;=====================================================================
j@314 6
j@314 7 (defmethod make-composition-identifier ((package (eql *package*))
j@314 8 composition-id)
j@314 9 (make-midi-db-composition-identifier composition-id))
j@314 10
j@314 11
j@314 12
j@314 13 ;;;=====================================================================
j@314 14 ;;; Specialized database-admin methods
j@314 15 ;;;=====================================================================
j@314 16
j@310 17 (defmethod list-collections ((package (eql *package*)) &key
j@310 18 compositions (stream *standard-output*))
j@310 19 "FIXME: better formatting."
j@310 20 (let ((collection-rows (%get-all-collection-headers)))
j@310 21 (flet ((print-separator (&optional (columns 77))
j@310 22 (format stream "~% ~A"
j@310 23 (make-sequence 'string columns :initial-element #\-))))
j@310 24 (loop for collection-row in collection-rows
j@310 25 do (destructuring-bind (collection-id collection-name description)
j@310 26 collection-row
j@310 27 (format stream "~%Collection-id: ~A~% Name: ~A~% Description: ~A~%"
j@310 28 collection-id collection-name description)
j@310 29 (when compositions
j@310 30 (list-compositions package
j@310 31 :collection-identifier
j@310 32 (make-midi-db-collection-identifier
j@310 33 collection-id))))
j@310 34 do (print-separator)))))
j@310 35
j@310 36 (defmethod list-compositions ((package (eql *package*)) &key
j@310 37 collection-identifier
j@310 38 (stream *standard-output*))
j@310 39 (let ((composition-headers
j@310 40 (if collection-identifier
j@310 41 (%get-all-collection-composition-headers
j@310 42 collection-identifier)
j@310 43 (%get-all-composition-headers))))
j@310 44 (loop for composition-header in composition-headers
j@310 45 do (destructuring-bind (collection-id filename timebase start
j@310 46 duration owner version
j@310 47 creation-timestamp
j@310 48 deletion-timestamp)
j@310 49 composition-header
j@310 50 (format stream "~%Collection-id: ~A filename: ~A timebase: ~A start: ~A duration: ~A owner: ~A version: ~A created: ~A deleted: ~A~%"
j@310 51 collection-id filename timebase start duration owner
j@310 52 version creation-timestamp deletion-timestamp)))))