From 22267b7d0ab06744f7552eeef481871f2840316a Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Fri, 31 Aug 2007 18:04:31 +0000 Subject: [PATCH] r11859: Canonicalize whitespace --- package.lisp | 6 +- pubmed-src.lisp | 304 ++++++++++++++++++++++++------------------------ 2 files changed, 155 insertions(+), 155 deletions(-) diff --git a/package.lisp b/package.lisp index ad4114f..b7bfe49 100644 --- a/package.lisp +++ b/package.lisp @@ -12,7 +12,7 @@ ;;;; This file, part of cl-pubmed, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; ;;;; cl-pubmed users are granted the rights to distribute and use this software -;;;; as governed by the terms of the GNU Lesser General Public License +;;;; as governed by the terms of the GNU Lesser General Public License ;;;; (http://www.gnu.org/licenses/lgpl.html) ;;;; ************************************************************************* @@ -27,7 +27,7 @@ #:pubmed-query-error #:pubmed-server-error #:pubmed-condition-response - + ;; Query functions #:pm-query #:pm-fetch-ids @@ -40,7 +40,7 @@ #:pm-article #:pm-article-set - ;; pm-article-set accessors + ;; pm-article-set accessors #:articles #:articles-query #:articles-total diff --git a/pubmed-src.lisp b/pubmed-src.lisp index 18c83c4..ad18ca9 100644 --- a/pubmed-src.lisp +++ b/pubmed-src.lisp @@ -12,7 +12,7 @@ ;;;; This file, part of cl-pubmed, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; ;;;; cl-pubmed users are granted the rights to distribute and use this software -;;;; as governed by the terms of the GNU Lesser General Public License +;;;; as governed by the terms of the GNU Lesser General Public License ;;;; (http://www.gnu.org/licenses/lgpl.html) ;;;; ************************************************************************* @@ -28,25 +28,25 @@ (define-condition pubmed-condition () ()) - + (define-condition pubmed-server-error (error pubmed-condition) ((response :initarg :response - :initform nil - :reader pubmed-condition-response)) + :initform nil + :reader pubmed-condition-response)) (:report (lambda (c stream) - (format stream "A PubMed server error occurred.") - (awhen (pubmed-condition-response c) - (format stream " The server response was:~&~S" it))))) + (format stream "A PubMed server error occurred.") + (awhen (pubmed-condition-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-condition-response)) + :initform nil + :reader pubmed-condition-response)) (:report (lambda (c stream) - (format stream "A PubMed server error occurred.") - (awhen (pubmed-condition-response c) - (format stream " The server response was:~&~S" it))))) - + (format stream "A PubMed server error occurred.") + (awhen (pubmed-condition-response c) + (format stream " The server response was:~&~S" it))))) + ;;; Article-Set and Article Classes (defclass pm-article-set () @@ -57,7 +57,7 @@ (start :type fixnum :initarg :start :accessor articles-start)) (:documentation "Pubmed Article Set Class") (:default-initargs :total 0 :start 0 :count 0 - :query nil :articles nil)) + :query nil :articles nil)) (defclass pm-article () ( @@ -76,16 +76,16 @@ (defmethod print-object ((obj pm-article-set) (s stream)) (print-unreadable-object (obj s :type t :identity t) - (format s "~d total articles, ~d articles starting at #~d" - (articles-total obj) - (articles-count obj) - (articles-start obj) - ))) + (format s "~d total articles, ~d articles starting at #~d" + (articles-total obj) + (articles-count obj) + (articles-start obj) + ))) (defmethod print-object ((obj pm-article) (s stream)) (print-unreadable-object (obj s :type t :identity t) (format s "pmid:~d, title:~S" (article-pmid obj) - (article-title obj)))) + (article-title obj)))) (defun article-equal-p (a b) (check-type a pm-article) @@ -96,64 +96,64 @@ "Return a string of publication data for an article" (let ((ref "")) (awhen (article-date art) - (string-append ref (format nil "~a; " it))) + (string-append ref (format nil "~a; " it))) (awhen (article-volume art) - (string-append ref it)) + (string-append ref it)) (awhen (article-issue art) - (string-append ref (format nil "(~a)" it))) + (string-append ref (format nil "(~a)" it))) (awhen (article-pages art) - (string-append ref (format nil ":~a" it))) + (string-append ref (format nil ":~a" it))) ref)) (defmethod print-article-set ((artset pm-article-set) - &key (os *standard-output*) (format :text) - (complete nil) (print-link nil)) + &key (os *standard-output*) (format :text) + (complete nil) (print-link nil)) "Display an article set to specified stream in specified format" (dotimes (i (articles-count artset) artset) (if (nth i (articles artset)) - (print-article (nth i (articles artset)) :os os :format format - :complete complete :print-link print-link) + (print-article (nth i (articles artset)) :os os :format format + :complete complete :print-link print-link) (princ "NULL Article" os)))) (defmethod print-article ((art pm-article) &key (os *standard-output*) - (format :text) (complete nil) (print-link nil)) + (format :text) (complete nil) (print-link nil)) "Display an article" (ecase format (:text - (format os "~a~%~a~%~a~a ~a~%~a~%" - (article-title art) - (list-to-delimited-string (article-authors art) ", ") - (aif (article-affiliation art) - (format nil "~a~%" it) "") - (article-journal art) (article-ref art) - (aif (article-abstract art) - (if complete - it - "Abstract available") - "No abstract available") - (when complete - (format os "~a~%" (article-mesh-headings art))))) + (format os "~a~%~a~%~a~a ~a~%~a~%" + (article-title art) + (list-to-delimited-string (article-authors art) ", ") + (aif (article-affiliation art) + (format nil "~a~%" it) "") + (article-journal art) (article-ref art) + (aif (article-abstract art) + (if complete + it + "Abstract available") + "No abstract available") + (when complete + (format os "~a~%" (article-mesh-headings art))))) (:html (let ((has-link (or (article-abstract art) (article-mesh-headings art)))) - (when (and print-link has-link) - (format os "" (funcall print-link - (article-pmid art)))) - (format os "
~a
~%" - (article-title art)) - (when (and print-link has-link) - (format os "")) - (format os "
~a
~%" - (list-to-delimited-string (article-authors art) ", ")) - (format os "
~a ~a
~%" - (article-journal art) (article-ref art)) - (when (and complete (article-abstract art)) - (format os "
~a
~%" - (article-abstract art))) - (when (and complete (article-mesh-headings art)) - (format os "
Mesh Headings:
") - (dolist (mh (article-mesh-headings art)) - (format os "
~a
~%" mh))) - (format os "

~%")))) + (when (and print-link has-link) + (format os "" (funcall print-link + (article-pmid art)))) + (format os "

~a
~%" + (article-title art)) + (when (and print-link has-link) + (format os "")) + (format os "
~a
~%" + (list-to-delimited-string (article-authors art) ", ")) + (format os "
~a ~a
~%" + (article-journal art) (article-ref art)) + (when (and complete (article-abstract art)) + (format os "
~a
~%" + (article-abstract art))) + (when (and complete (article-mesh-headings art)) + (format os "
Mesh Headings:
") + (dolist (mh (article-mesh-headings art)) + (format os "
~a
~%" mh))) + (format os "

~%")))) art) @@ -161,18 +161,18 @@ (defun pm-query (searchstr &key maximum start) "Performs PubMed query and fetch and returns article-set structure" - (multiple-value-bind - (results status) - (pubmed-search-xml searchstr :maximum maximum :start start) + (multiple-value-bind + (results status) + (pubmed-search-xml searchstr :maximum maximum :start start) (when (xml-tag-contents "Count" status) - (let ((as (make-instance 'pm-article-set))) - (setf - (articles-total as) (parse-integer (xml-tag-contents "Count" status)) - (articles-query as) searchstr - (articles-start as) (parse-integer (xml-tag-contents "DispStart" status)) - (articles-count as) (parse-integer (xml-tag-contents "DispMax" status)) - (articles as) (extract-article-set results)) - as)))) + (let ((as (make-instance 'pm-article-set))) + (setf + (articles-total as) (parse-integer (xml-tag-contents "Count" status)) + (articles-query as) searchstr + (articles-start as) (parse-integer (xml-tag-contents "DispStart" status)) + (articles-count as) (parse-integer (xml-tag-contents "DispMax" status)) + (articles as) (extract-article-set results)) + as)))) (defun pm-fetch-ids (pmids) "Fetchs list of Pubmed ID's and returns pm-article-set class" @@ -180,30 +180,30 @@ (let ((results (pubmed-fetch-pmids-xml pmids))) (unless (xml-tag-contents "Error" results) (let ((as (make-instance 'pm-article-set))) - (setf - (articles-total as) (length pmids) - (articles-query as) (list-to-delimited-string pmids #\,) - (articles-start as) 0 - (articles-count as) (length pmids) - (articles as) (extract-article-set results)) - as)))) + (setf + (articles-total as) (length pmids) + (articles-query as) (list-to-delimited-string pmids #\,) + (articles-start as) 0 + (articles-count as) (length pmids) + (articles as) (extract-article-set results)) + as)))) #+ignore (defun pubmed-search-tree (searchstr &key maximum start) - "Performs a pubmed search and returns two values: + "Performs a pubmed search and returns two values: tree of PubMed search results and tree of PubMed search status" (multiple-value-bind (xml-search-results xml-search-status) (pubmed-search-xml searchstr :maximum maximum :start start) (if xml-search-results - (values (parse-xml-no-ws xml-search-results) - (parse-xml-no-ws xml-search-status)) + (values (parse-xml-no-ws xml-search-results) + (parse-xml-no-ws xml-search-status)) (values nil (parse-xml-no-ws xml-search-status))))) (defun pubmed-search-xml (searchstr &key maximum start) - "Performs a Pubmed search and returns two values: + "Performs a Pubmed search and returns two values: XML string of PubMed search results and XML search status" - (multiple-value-bind + (multiple-value-bind (pmids search-status) (pubmed-query-xml searchstr :maximum maximum :start start) (values (pubmed-fetch-pmids-xml pmids) search-status))) @@ -233,111 +233,111 @@ XML string of PubMed search results and XML search status" (net.aserve.client:do-http-request (format nil "http://~a~a" +pubmed-host+ +pubmed-fetch-url+) :method :get - :query + :query `(("db" . "PubMed") ("report" . "xml") ("mode" . "text") - ("id" . ,(list-to-delimited-string pmids #\,))) + ("id" . ,(list-to-delimited-string pmids #\,))) :proxy *proxy-host*))) ;;; XML Extraction Routines (defun extract-article-set (results) "Extract article set from PubMed XML string, return results in pm-article-set class" - (multiple-value-bind (as-start as-end as-next) + (multiple-value-bind (as-start as-end as-next) (positions-xml-tag-contents "PubmedArticleSet" results) (declare (ignore as-end as-next)) (when as-start (let ((done nil) - (articles '()) - (pos as-start)) - (until done - (multiple-value-bind - (a-start a-end a-next) - (positions-xml-tag-contents "PubmedArticle" results pos) - (if a-start - (progn - (push (extract-article results a-start a-end) articles) - (setq pos a-next) - ) - (setq done t)))) - (nreverse articles))))) + (articles '()) + (pos as-start)) + (until done + (multiple-value-bind + (a-start a-end a-next) + (positions-xml-tag-contents "PubmedArticle" results pos) + (if a-start + (progn + (push (extract-article results a-start a-end) articles) + (setq pos a-next) + ) + (setq done t)))) + (nreverse articles))))) (defun extract-article (xmlstr a-start a-end) "Extract article contents from PubMed XML string and return results in pm-article class" (let ((article (make-instance 'pm-article))) - (setf - (article-pmid article) (parse-integer (xml-tag-contents "PMID" xmlstr a-start a-end)) - (article-title article) (xml-tag-contents "ArticleTitle" xmlstr a-start a-end) - (article-journal article) (xml-tag-contents "MedlineTA" xmlstr a-start a-end) - (article-pages article) (xml-tag-contents "MedlinePgn" xmlstr a-start a-end) - (article-affiliation article) (xml-tag-contents "Affiliation" xmlstr a-start a-end) - (article-abstract article) (xml-tag-contents "AbstractText" xmlstr a-start a-end)) + (setf + (article-pmid article) (parse-integer (xml-tag-contents "PMID" xmlstr a-start a-end)) + (article-title article) (xml-tag-contents "ArticleTitle" xmlstr a-start a-end) + (article-journal article) (xml-tag-contents "MedlineTA" xmlstr a-start a-end) + (article-pages article) (xml-tag-contents "MedlinePgn" xmlstr a-start a-end) + (article-affiliation article) (xml-tag-contents "Affiliation" xmlstr a-start a-end) + (article-abstract article) (xml-tag-contents "AbstractText" xmlstr a-start a-end)) (multiple-value-bind (ji-start ji-end ji-next) - (positions-xml-tag-contents "JournalIssue" xmlstr a-start a-end) + (positions-xml-tag-contents "JournalIssue" xmlstr a-start a-end) (declare (ignore ji-next)) (setf - (article-volume article) (xml-tag-contents "Volume" xmlstr ji-start ji-end) - (article-issue article) (xml-tag-contents "Issue" xmlstr ji-start ji-end)) + (article-volume article) (xml-tag-contents "Volume" xmlstr ji-start ji-end) + (article-issue article) (xml-tag-contents "Issue" xmlstr ji-start ji-end)) (aif (xml-tag-contents "MedlineDate" xmlstr ji-start ji-end) - (setf (article-date article) it) - (setf (article-date article) - (concatenate 'string (xml-tag-contents "Year" xmlstr ji-start ji-end) - (aif (xml-tag-contents "Month" xmlstr ji-start ji-end) - (format nil " ~a" it) - ""))))) - + (setf (article-date article) it) + (setf (article-date article) + (concatenate 'string (xml-tag-contents "Year" xmlstr ji-start ji-end) + (aif (xml-tag-contents "Month" xmlstr ji-start ji-end) + (format nil " ~a" it) + ""))))) + (multiple-value-bind (al-start al-end al-next) - (positions-xml-tag-contents "AuthorList" xmlstr a-start a-end) + (positions-xml-tag-contents "AuthorList" xmlstr a-start a-end) (declare (ignore al-next)) (setf (article-authors article) - (when al-start - (let ((done nil) - (authors '()) - (pos al-start)) - (until done - (multiple-value-bind - (au-start au-end au-next) - (positions-xml-tag-contents "Author" xmlstr pos al-end) - (if au-start - (progn - (push (extract-author xmlstr au-start au-end) authors) - (setq pos au-next)) - (setq done t)))) - (nreverse authors))))) + (when al-start + (let ((done nil) + (authors '()) + (pos al-start)) + (until done + (multiple-value-bind + (au-start au-end au-next) + (positions-xml-tag-contents "Author" xmlstr pos al-end) + (if au-start + (progn + (push (extract-author xmlstr au-start au-end) authors) + (setq pos au-next)) + (setq done t)))) + (nreverse authors))))) (multiple-value-bind (mhl-start mhl-end mhl-next) - (positions-xml-tag-contents "MeshHeadingList" xmlstr a-start a-end) + (positions-xml-tag-contents "MeshHeadingList" xmlstr a-start a-end) (declare (ignore mhl-next)) (setf (article-mesh-headings article) - (when mhl-start - (let ((done nil) - (mesh-headings '()) - (pos mhl-start)) - (until done - (multiple-value-bind - (mh-start mh-end mh-next) - (positions-xml-tag-contents "MeshHeading" xmlstr pos mhl-end) - (if mh-start - (progn - (push (extract-mesh-heading xmlstr mh-start mh-end) mesh-headings) - (setq pos mh-next) - ) - (setq done t)))) - (nreverse mesh-headings))))) + (when mhl-start + (let ((done nil) + (mesh-headings '()) + (pos mhl-start)) + (until done + (multiple-value-bind + (mh-start mh-end mh-next) + (positions-xml-tag-contents "MeshHeading" xmlstr pos mhl-end) + (if mh-start + (progn + (push (extract-mesh-heading xmlstr mh-start mh-end) mesh-headings) + (setq pos mh-next) + ) + (setq done t)))) + (nreverse mesh-headings))))) article)) (defun extract-author (xmlstr start end) "Extract author name from XML string" (let ((last-name (xml-tag-contents "LastName" xmlstr start end)) - (initials (xml-tag-contents "Initials" xmlstr start end))) + (initials (xml-tag-contents "Initials" xmlstr start end))) (concatenate 'string last-name " " initials))) (defun extract-mesh-heading (xmlstr start end) "Extract and format mesh headings from XML string" (let ((desc (xml-tag-contents "DescriptorName" xmlstr start end)) - (sh (xml-tag-contents "SubHeading" xmlstr start end))) + (sh (xml-tag-contents "SubHeading" xmlstr start end))) (if sh - (format nil "~a(~a)" desc sh) + (format nil "~a(~a)" desc sh) desc))) (defun extract-pmid-list (results) @@ -349,7 +349,7 @@ XML string of PubMed search results and XML search status" (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