|
|
@@ -184,6 +184,19 @@
|
|
|
(integer track)
|
|
|
(string (parse-integer track :junk-allowed t))))))
|
|
|
|
|
|
+(defun slot< (a b)
|
|
|
+ (declare #.*standard-optimize-settings*
|
|
|
+ (type simple-string a b))
|
|
|
+ (when (xor (emptyp a) (emptyp b))
|
|
|
+ (return-from slot< (when (emptyp b) 0)))
|
|
|
+ (let ((aa (alpha-char-p (elt a 0)))
|
|
|
+ (ba (alpha-char-p (elt b 0))))
|
|
|
+ (cond
|
|
|
+ ((and aa ba) (string< a b))
|
|
|
+ (aa 0)
|
|
|
+ (ba)
|
|
|
+ (t (string< a b)))))
|
|
|
+
|
|
|
(defparameter +album-type-order+ '("album" "lp" "ep" "single" "compilation" "live" "soundtrack"
|
|
|
"spokenword" "remix" "mixed" "dj-mix" "mixtape" "broadcast")
|
|
|
"Half-arbitrary album type order")
|
|
|
@@ -192,24 +205,28 @@
|
|
|
(declare #.*standard-optimize-settings*)
|
|
|
(dolist (slot slots 0)
|
|
|
(let ((slot-a (slot-value a slot))
|
|
|
- (slot-b (slot-value b slot)))
|
|
|
- (when (xor (null slot-a) (null slot-b))
|
|
|
- (return-from info<> (if (null slot-b) 1 -1)))
|
|
|
- (case slot
|
|
|
- (type
|
|
|
- (setf slot-a (or (position slot-a (the list +album-type-order+) :test 'string-equal) 0)
|
|
|
- slot-b (or (position slot-b (the list +album-type-order+) :test 'string-equal) 0)))
|
|
|
- (no
|
|
|
- (setf slot-a (clear-track-no slot-a)
|
|
|
- slot-b (clear-track-no slot-b))))
|
|
|
- (unless (or (and (null slot-a) (null slot-b))
|
|
|
- (case slot
|
|
|
- ((type year no) (= (the fixnum slot-a) (the fixnum slot-b)))
|
|
|
- (t (string-equal slot-a slot-b))))
|
|
|
- (return-from info<> (case slot
|
|
|
- ((type year no) (- (the fixnum slot-a) (the fixnum slot-b)))
|
|
|
- (t (if (string< slot-a slot-b) -1 1)))))))))
|
|
|
-(defparameter +album<>+ (gen-comparator '(artist type original-date year album)))
|
|
|
+ (slot-b (slot-value b slot)))
|
|
|
+ (when (xor (null slot-a) (null slot-b))
|
|
|
+ (return-from info<> (if (null slot-b) -1 1)))
|
|
|
+ (unless (and (null slot-a) (null slot-b))
|
|
|
+ (case slot
|
|
|
+ (type
|
|
|
+ (let ((cmp (if (slot< slot-a slot-b) -1 1)))
|
|
|
+ (setf slot-a (or (position slot-a (the list +album-type-order+) :test 'string-equal)
|
|
|
+ (+ 100 cmp))
|
|
|
+ slot-b (or (position slot-b (the list +album-type-order+) :test 'string-equal)
|
|
|
+ (- 100 cmp)))))
|
|
|
+ (no
|
|
|
+ (setf slot-a (clear-track-no slot-a)
|
|
|
+ slot-b (clear-track-no slot-b))))
|
|
|
+ (unless (case slot
|
|
|
+ ((type year no) (= (the fixnum slot-a) (the fixnum slot-b)))
|
|
|
+ (t (string-equal slot-a slot-b)))
|
|
|
+ (return-from info<> (case slot
|
|
|
+ ((type year no) (- (the fixnum slot-a) (the fixnum slot-b)))
|
|
|
+ (t (if (slot< slot-a slot-b) -1 1))))))))))
|
|
|
+
|
|
|
+(defparameter +album<>+ (gen-comparator '(artist type year album)))
|
|
|
(defun album< (a b)
|
|
|
(declare #.*standard-optimize-settings*
|
|
|
(type function +album<>+))
|
|
|
@@ -231,16 +248,6 @@
|
|
|
(< (the fixnum (funcall +track<>+ a b)) 0)
|
|
|
albs)))
|
|
|
|
|
|
-(defun slot< (a b)
|
|
|
- (declare #.*standard-optimize-settings*
|
|
|
- (type simple-string a b))
|
|
|
- (let ((aa (alpha-char-p (elt a 0)))
|
|
|
- (ba (alpha-char-p (elt b 0))))
|
|
|
- (cond
|
|
|
- ((and aa ba) (string< a b))
|
|
|
- (aa 0)
|
|
|
- (ba)
|
|
|
- (t (string< a b)))))
|
|
|
|
|
|
(defun match-filter (data category filter)
|
|
|
(declare #.*standard-optimize-settings*)
|