annotate implementations/midi-db/methods.lisp @ 240:c454b4fc9aad

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