new file mode 100644

@@ -0,0 +1,33 @@

+Simple command line utility to query the Index Thomisticus hosted on Corpus Thomisticum

+and display the results.

+

+# Installation:

+

+To install from source:

+

+- Get sbcl: [http://www.sbcl.org](http://www.sbcl.org)

+- Get quicklisp: [https://www.quicklisp.org/beta/](https://www.quicklisp.org/beta/)

+- Get buildapp: `sbcl --eval '(ql:quickload :buildapp)' --eval '(buildapp:build-buildapp)' --exit`

+- Build this project: `./buildapp  --load ~/quicklisp/setup.lisp --eval '(push (truename #p".")

+  asdf:*central-registry*)' --load-system `basename $PWD` --entry indexthomisticus-client::main --output

+  it-lookup --compress-core`

+

+# Usage:

+

+```

+./it-lookup '=ordo' '=dicit'

+```

+

+This form displays the results for the query '=ordo =dicit' and prompts for further commands or queries.

+Note that, if you use any of the search operators supported by corpus thomisticum, you probably should 

+quote the query: i.e. not `./it-lookup =ordo =dicit` but either `./it-lookup '=ordo' '=dicit'` or

+`./it-lookup '=ordo =dicit'`

+

+```

+./it-lookup

+```

+

+This just prompts for commands or queries.

+

+When at the `Query?` prompt, `next` will bring up the next page of results. `prev` brings up the previous

+page of results. `quit` exits. and anything else is submitted as a query to Corpus Thomisticum.

new file mode 100644

@@ -0,0 +1,15 @@

+;;;; indexthomisticus-client.asd

+

+(asdf:defsystem #:indexthomisticus-client

+  :description "Describe indexthomisticus-client here"

+  :author "Your Name <your.name@example.com>"

+  :license "Specify license here"

+  :depends-on (:alexandria

+                :serapeum

+                :fwoar.lisputils

+                :drakma

+                :lquery)

+  :serial t

+  :components ((:file "package")

+               (:file "indexthomisticus-client")))

+

new file mode 100644

@@ -0,0 +1,102 @@

+;;;; indexthomisticus-client.lisp

+

+(in-package #:indexthomisticus-client)

+

+;;; "indexthomisticus-client" goes here. Hacks and glory await!

+

+(defparameter *post-url*  "http://www.corpusthomisticum.org/it/index.age")

+

+(defparameter *cookie-jar* (make-instance 'drakma:cookie-jar))

+

+(defun run-query (query &optional (page 1))

+  (drakma:http-request *post-url*

+                       :method :POST

+                       :parameters `(("text" . ,query)

+                                     ("Form.option.concordances" . "concordances")

+                                     ("results.currentPage" . ,(prin1-to-string page)))

+                       :cookie-jar *cookie-jar*))

+

+(defclass it-case ()

+  ((reference :initarg :reference :accessor case-reference)

+   (text :initarg :text :accessor case-text)))

+

+(defmethod initialize-instance :after ((object it-case) &key)

+  (with-slots (reference text) object

+    (when (arrayp reference)

+      (setf reference (elt reference 0)))

+    (when (plump:element-p reference)

+      (setf reference (plump-dom:text reference)))

+    (setf text (subseq text (+ (search reference text) (length reference))))

+    (setf reference (string-right-trim '(#\space) reference))

+    ))

+

+(defmacro make-constructor (class &rest initargs)

+  (let ((initarg-syms (mapcar #'(lambda (x) x (gensym)) initargs)))

+    `(defun ,(intern (concatenate 'string (string 'make-) (string class))) ,initarg-syms

+       (make-instance ',class ,@(loop for initarg in initargs

+                                     for sym in initarg-syms

+                                     nconc (list initarg sym))))))

+

+(make-constructor it-case :reference :text)

+

+(defun parse-results (query-result)

+  (lquery:$ (initialize query-result) "p[title]" (:combine ".ref" (text)) (map-apply #'make-it-case)))

+

+(defun format-result (parsed-result &optional (stream t))

+  (with-slots (reference text) parsed-result

+    (pprint-logical-block (stream nil)

+      (princ reference stream)

+      (pprint-indent :block 4 stream)

+      (pprint-newline :mandatory stream)

+      (pprint-logical-block (stream (split-sequence #\space text))

+        (loop

+              (princ (pprint-pop) stream)

+              (pprint-exit-if-list-exhausted)

+              (princ #\space stream)

+              (pprint-newline :fill stream))))))

+

+(defun format-results (parsed-results &optional (stream t))

+  (fresh-line stream)

+  (loop :for parsed-results :across parsed-results

+        :do (format-result parsed-results stream)

+        :do (terpri stream)))

+

+(defmacro compose-funcs ((&rest funcs) &rest args)

+  `(funcall (compose ,@funcs) ,@args))

+

+(defun main (args)

+  (handler-case

+    (let ((current-page 1)

+          current-query)

+      (flet ((next-page () (incf current-page))

+             (prev-page ()

+               (when (> current-page 0)

+                 (decf current-page)))

+             (get-results (current-query current-page)

+               (compose-funcs (#'format-results #'parse-results #'run-query)

+                              current-query current-page)))

+

+        (format *terminal-io* "~&Index Thomisticus Query Utility v0.1~%")

+

+        (when (cadr args)

+          (setf current-query (string-join (cdr args) #\space))

+          (format *terminal-io* "~&Query: ~a~%" current-query)

+          (get-results current-query current-page))

+        (loop

+          (format *terminal-io* "~&Query? ")

+          (finish-output *terminal-io*)

+          (let ((action (read-line *terminal-io*)))

+            (string-case action

+              ("quit" (return-from main))

+              ("prev"

+               (prev-page)

+               (format *terminal-io* "~&Query: ~a, Page: ~3d~%" current-query current-page)

+               (get-results current-query current-page))      

+              ("next"

+               (next-page)

+               (format *terminal-io* "~&Query: ~a, Page: ~3d~%" current-query current-page)

+               (get-results current-query current-page))      

+              (t (setf current-query action)

+                 (get-results current-query current-page)))))))

+    (end-of-file (c) (declare (ignore c)))

+    (sb-sys:interactive-interrupt (c) (declare (ignore c)))))

new file mode 100755

Binary files /dev/null and b/it-lookup.lx differ

new file mode 100644

@@ -0,0 +1,5 @@

+;;;; package.lisp

+

+(defpackage #:indexthomisticus-client

+  (:use #:cl #:alexandria #:serapeum #:fwoar.lisputils))

+