From 8f8c17ab7068ef5991595d678d9d2cc767a8b5bf Mon Sep 17 00:00:00 2001
From: "Kevin M. Rosenberg" <kevin@rosenberg.net>
Date: Thu, 31 Oct 2002 21:38:17 +0000
Subject: [PATCH] r3264: *** empty log message ***

---
 pubmed.lisp | 23 ++++++++++++++++++-----
 1 file changed, 18 insertions(+), 5 deletions(-)

diff --git a/pubmed.lisp b/pubmed.lisp
index eb3c930..3def005 100644
--- a/pubmed.lisp
+++ b/pubmed.lisp
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Jun 2001
 ;;;;
-;;;; $Id: pubmed.lisp,v 1.5 2002/10/31 21:07:04 kevin Exp $
+;;;; $Id: pubmed.lisp,v 1.6 2002/10/31 21:37:56 kevin Exp $
 ;;;;
 ;;;; This file, part of cl-pubmed, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -26,6 +26,7 @@
 
    ;; Conditions
    #:pubmed-condition
+   #:pubmed-query-error
    #:pubmed-server-error
    
    ;; Query functions
@@ -81,6 +82,15 @@
 	     (format stream "A PubMed server error occurred.")
 	     (awhen (pubmed-server-error-response c)
 		    (format stream " The server response was:~&~S" it)))))
+
+(define-condition pubmed-query-error (error pubmed-condition)
+  ((response :initarg :response
+	     :initform nil
+	     :reader pubmed-query-error-response))
+  (:report (lambda (c stream)
+	     (format stream "A PubMed server error occurred.")
+	     (awhen (pubmed-server-query-response c)
+		    (format stream " The server response was:~&~S" it)))))
   
 ;;; Article-Set and Article Classes
 
@@ -371,11 +381,14 @@ XML string of PubMed search results and XML search status"
 
 (defun extract-pmid-list (results)
   "Returns list of PubMed ID's from XML result string"
-  (if (or (search "<ERROR>" results)
-	  (search "<H1>Server Error</H1>" results))
-      (error 'pubmed-server-error :response results)
+  (cond
+   ((search "<ERROR>" results)
+    (error 'pubmed-query-error :response results))
+   ((search "<H1>Server Error</H1>" results)
+    (error 'pubmed-server-error :response results))
+   (t
     (awhen (xml-tag-contents "Id" results)
-	   (delimited-string-to-list it #\space))))
+	   (delimited-string-to-list it #\space)))))
 
 
 
-- 
2.34.1