home *** CD-ROM | disk | FTP | other *** search
/ ftp.uv.es / 2014.11.ftp.uv.es.tar / ftp.uv.es / pub / unix / wais-8-b5.tar.Z / wais-8-b5.tar / wais-8-b5 / ui / lucid.lisp < prev    next >
Lisp/Scheme  |  1992-01-08  |  4KB  |  143 lines
  1. ;;This file is a Lucid lisp interface for the client functions of WAIS.
  2. ;; I have not used this heavily, so I can not say it is very robust.
  3. ;;
  4. ;; -brewster
  5.  
  6.  
  7. ;; top level functions:
  8. ;; wais-search
  9. ;; wais-retrieve
  10.  
  11. (in-package 'wais :use '(lisp))
  12.  
  13. (defvar *wais-stream* nil "The stream that talks to the wais process")
  14. (defvar *wais-temp-filename* nil "the temp filename of the file that will be used to store the question and results")
  15. (defvar *verbose* t "prints what it sends to the wais process")
  16. (defmacro comment (&rest ignore) (declare (ignore ignore)) :comment)
  17.  
  18. (defun wais-init (&optional directory)
  19.   "starts a wais process"
  20.   (if (null *wais-temp-filename*)
  21.       (setq *wais-temp-filename*
  22.     (format nil "/tmp/waisq-~d" (get-universal-time)))))
  23.  
  24. (comment (run-question '(:question :version  2
  25.         :seed-words "help"
  26.         :relevant-documents ()
  27.         :sources ((:source-id :filename "dj.src"))
  28.         :result-documents ())))
  29.  
  30. ;; waisq -f /tmp/waisq-2894216218 -g -s ~/wais-sources
  31. (defun run-question (question &optional
  32.                   (source-directory 
  33.                 (merge-pathnames 
  34.                   (USER-HOMEDIR-PATHNAME) "wais-sources")))
  35.   "runs a question and returns the filled in question structure"
  36.   (if (not *wais-temp-filename*)
  37.       (wais-init))
  38.   (with-open-file (stream *wais-temp-filename* :direction :output)
  39.     (let ((*print-pretty* nil) 
  40.       (*print-case* :downcase)
  41.       (*print-array* t)
  42.       (*print-length* nil))
  43.       (format stream "~s" question)))
  44.   ;;(foobar)
  45.   (lucid::run-unix-program "/proj/wais/latest/bin/waisq"
  46.                :arguments (list "-f" *wais-temp-filename* "-g"
  47.                         "-s" (namestring source-directory))
  48.                :wait t)
  49.   ;;(print *wais-temp-filename*)
  50.   (with-open-file (stream *wais-temp-filename* :direction :input)
  51.      (read stream)))
  52.  
  53. (defun wais-search (seed-words database
  54.                    &optional 
  55.                    (source-directory (merge-pathnames (USER-HOMEDIR-PATHNAME) "wais-sources"))
  56.                    (relevant-documents ()))
  57.   "runs a wais search and returns a list of document specifiers
  58.    or an error"
  59.   (check-type seed-words string)
  60.   (check-type database string)
  61.   (check-type source-directory (or pathname string))
  62.   (check-type relevant-documents (or null list))
  63.   (if (not *wais-temp-filename*)
  64.       (wais-init))
  65.   (if (not (search ".src" database))
  66.       (format t "~%There must be a .src extention to a database '~s'"
  67.           database))
  68.   
  69.   (second (member :result-documents 
  70.           (run-question 
  71.             `(:question :version 2
  72.                 :seed-words ,seed-words
  73.                 :relevant-documents ,relevant-documents
  74.                 :sources ((:source-id :filename ,database))
  75.                 :result-documents ())
  76.             source-directory))))
  77.  
  78. (defun wais-retrieve (document-id 
  79.               &optional 
  80.               (source-directory (merge-pathnames (USER-HOMEDIR-PATHNAME) "wais-sources")))
  81.   "retrieves a document or an error"
  82.   (with-open-file (stream *wais-temp-filename* :direction :output)
  83.     (let ((*print-pretty* t) (*print-array* t) (*print-case* :downcase))
  84.       (format stream "(:question :version
  85.            2
  86.            :seed-words
  87.            ()
  88.            :relevant-documents
  89.            ()
  90.            :sources
  91.            ()
  92.            :result-documents
  93.            (~a)
  94.        )~
  95.         " (write-to-string document-id))))
  96.   (let ((stream (lucid::run-unix-program 
  97.           "/proj/wais/latest/bin/waisq"
  98.           :arguments (list "-f" *wais-temp-filename* "-v"
  99.                    "1"
  100.                    "-s" (namestring source-directory))
  101.           :output :stream
  102.           :wait nil)))
  103.     (comment (loop for line = (read-line stream)
  104.            until (equal "done." line)
  105.            ;;do (print line)
  106.            ))
  107.     (with-output-to-string (stream)
  108.       (loop for line = (read-line stream nil :eof)
  109.         until (eq line :eof)
  110.         do (write-line line stream)))))
  111.  
  112. (defun try ()
  113.   "sample use of the wais functions"
  114.   (wais-init)
  115.   (let ((answers (wais-search "dad" "mail-sent.src")))
  116.     (if (null answers)
  117.     (error "no answers were returned")
  118.     (wais-retrieve (first answers)))))
  119.  
  120.  
  121.  
  122. (defun display-doc-ids (doc-ids)
  123.   (mapcan 'display-doc-id doc-ids))
  124.  
  125. (defun display-doc-id (doc-id)
  126.   (if (not (eq :document-id (car doc-id)))
  127.       (error "doc-id should start with :document-id.  ~s"
  128.          doc-id))
  129.   (let ((original-local-id
  130.      (any-to-string
  131.        (second (member :original-local-id
  132.                (second
  133.                  (member :doc-id 
  134.                      (second (member :document doc-id)))))))))
  135.     (format t "~%Headline: ~s
  136.   doc-id: ~s
  137.   score: ~d" (second (member :headline (second (member :document doc-id))))
  138.   original-local-id
  139.   (second (member :score doc-id))
  140.   )))
  141.  
  142.  
  143.