;;;; -*- Mode: LISP; Syntax: Common-Lisp; Base: 10 -*-
;;;; ---------------------------------------------------------------------------
;;;; File name: fire-knowledge-html.lsp
;;;; System:
;;;; Author: Shawn Nicholson
;;;; Created: October 2, 2001 15:43:18
;;;; Purpose:
;;;; ---------------------------------------------------------------------------
;;;; Modified: Tuesday, October 2, 2001 at 16:52:31 by Nicholson
;;;; ---------------------------------------------------------------------------
(in-package :fire-kb-browser)
(defmethod display-page-header (concept (kb-b fire-kb-browser-info))
(net.html.generator:html
(:center (:h1 "FIRE Knowledge Base Browser")
(:h5 "FIRE Knowledge Base: "
(:princ (fire:name (kb kb-b)))
" PATH: "
(:princ (fire:path (kb kb-b)))))
(:hr)
(display-search-bar concept kb-b)
(:hr)))
(defmethod display-page-footer (concept (kb-b fire-kb-browser-info))
(net.html.generator:html
(:hr)
(:cite "Qualitative Reasoning Group"
(:br)
"Northwestern University")))
(defmethod display-search-bar (concept (kb-b fire-kb-browser-info))
(net.html.generator:html
((:form :action "concept-search") "Search for Concept: "
((:input :type "text" :name "concept-search"))
((:input :type "submit" :name "search-type" :value "Complete"))
((:input :type "submit" :name "search-type" :value "Go")))
))
(defmethod generate-redirection-page ((kb-b fire-kb-browser-info) concept)
(net.html.generator:html
(:head (print-redirection kb-b concept 5))
(:body "Click " (print-concept-url kb-b concept) " if you are not automatically redirected in 5 seconds (or are just tired of waiting)")))
(defmethod generate-no-concept-page ((kb-b fire-kb-browser-info) concept)
(net.html.generator:html
(:body (:br)
(:h3 "No concept " (:princ concept) " in the knowledge base.
Please use your Back button to return."))))
(defmethod print-completions-list (lst (kb-b fire-kb-browser-info))
(dolist (completion lst)
(let ((type (concept-type completion kb-b)))
(when type
(net.html.generator:html
(:ul (:dl (print-concept-url kb-b completion)
" (" (:princ type) ")")))))))
(defmethod generate-completion-page ((kb-b fire-kb-browser-info) concept)
(let ((completions-lst (dbex:symbol-complete concept)))
(net.html.generator:html
(:body (:h2 "Completions for: " (:princ concept))
"Please select which completion you wish to view:"
(if completions-lst
(print-completions-list completions-lst kb-b)
(net.html.generator:html
(:br)
"No completions for " (:princ concept)
" Please use your browser's Back button to return."))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Documentation String Printing
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun whitespace? (char &key (special-chars nil))
(let ((whitespace-chars (list #\space #\newline #\linefeed #\tab)))
(or (member char whitespace-chars)
(member char special-chars))))
(defun read-concept (s)
(let ((punctuation-chars (list #\. #\! #\) #\; #\,)))
(intern
(with-output-to-string (out)
(do ((c (peek-char nil s nil 'done) (peek-char nil s nil 'done)))
((or (eq c 'done)
(member c punctuation-chars)
(whitespace? c))
:done)
(write-char (read-char s) out))))))
(defmethod add-links ((kb-b fire-kb-browser-info)
elem)
elem)
(defmethod add-links ((kb-b fire-kb-browser-info)
(str string))
(with-output-to-string (out)
(with-input-from-string (s str)
(do ((c (read-char s nil 'done) (read-char s nil 'done))
(nc (peek-char nil s nil 'done) (peek-char nil s nil 'done)))
((or (eq c 'done)
(eq nc 'done)))
(if (and (eq c #\#)
(eq nc #\$))
(let ((concept (progn (read-char s nil 'nil)
(read-concept s))))
(format out " #$~A"
(generate-concept-link kb-b concept)
concept))
(write-char c out))))))
(defmethod fire::get-documentation ((pred t) (kb fire::knowledge-base))
(first (fire:retrieve (fire::make-comment-statement pred '?x)
:kb kb :coverage :ground :number 1
:response '?x)))
(defmethod print-doc-string ((kb-b fire-kb-browser-info)
concept)
(let ((doc-string (add-links kb-b
(fire:get-documentation concept
(kb kb-b)))))
(net.html.generator:html
(:h4 (print-concept-url kb-b 'data::comment)
": "
(:princ doc-string)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ISA information printing
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defmethod print-isas ((kb-b fire-kb-browser-info)
concept)
(let ((isa-lst (fire:retrieve-isas concept :kb (kb kb-b))))
(net.html.generator:html
(:h4 (print-concept-url kb-b 'data::isa :label 'isas)
": "
(dolist (isa isa-lst)
(print-concept-url kb-b isa)
(format net.html.generator:*html-stream* " "))))))
(defmethod print-result-isas ((kb-b fire-kb-browser-info) concept)
(let ((isa-lst (fire:retrieve (list 'data::resultIsa concept '?col)
:response '?col)))
(net.html.generator:html
(:h4 (print-concept-url kb-b 'data::resultIsa)
": "
(dolist (isa isa-lst)
(print-concept-url kb-b isa)
(format net.html.generator:*html-stream* " "))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; GENLS information printing
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defmethod print-genls ((kb-b fire-kb-browser-info)
concept)
(let ((genls-lst (fire:immediate-genls concept :kb (kb kb-b))))
(net.html.generator:html
(:h4 (print-concept-url kb-b 'data::genls)
": "
(dolist (genl genls-lst)
(print-concept-url kb-b genl)
(format net.html.generator:*html-stream* " "))))))
(defmethod print-genl-preds ((kb-b fire-kb-browser-info) concept)
(let ((genls-lst (fire::genlPreds concept)))
(net.html.generator:html
(:h4 (print-concept-url kb-b 'data::genlPreds)
": "
(dolist (genl genls-lst)
(print-concept-url kb-b genl)
(format net.html.generator:*html-stream* " "))))))
(defmethod print-result-genls ((kb-b fire-kb-browser-info) concept)
(let ((genls-lst (fire:retrieve (list 'data::resultGenl concept '?col)
:response '?col)))
(net.html.generator:html
(:h4 (print-concept-url kb-b 'data::resultGenl)
": "
(dolist (genl genls-lst)
(print-concept-url kb-b genl)
(format net.html.generator:*html-stream* " "))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defmethod print-arity ((kb-b fire-kb-browser-info) concept)
(let ((arity (fire:arity concept :kb (kb kb-b))))
(net.html.generator:html
(:h4 (print-concept-url kb-b 'data::arity) ": "
(:princ arity)))
arity))
(defmethod print-argNisa ((kb-b fire-kb-browser-info) concept n)
(net.html.generator:html
(:h4 (print-concept-url kb-b (intern (format nil "arg~AIsa" n) 'data)) ": "
(print-concept-url kb-b (fire::retrieve-argn-isa concept n (kb kb-b))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Printing of special concepts
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defmethod print-concept-data ((kb-b fire-kb-browser-info)
type concept)
(net.html.generator:html
(:body "Currently no data for concept in the knowledge base. "
(:princ type))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Printing of COLLECTION concepts
(defmethod print-concept-data ((kb-b fire-kb-browser-info)
(type (eql :collection))
concept)
(net.html.generator:html
(print-isas kb-b concept)
(print-genls kb-b concept)
(print-doc-string kb-b concept)
))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Printing of Relationship concepts
(defmethod print-concept-data ((kb-b fire-kb-browser-info)
(type (eql :relation))
concept)
(net.html.generator:html
(print-isas kb-b concept)
(print-genl-preds kb-b concept)
(let ((ar (print-arity kb-b concept)))
(dotimes (i ar)
(print-argNisa kb-b concept (+ i 1))))
(print-doc-string kb-b concept)
))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Printing of Function concepts
(defmethod print-concept-data ((kb-b fire-kb-browser-info)
(type (eql :function))
concept)
(net.html.generator:html
(print-isas kb-b concept)
(print-result-isas kb-b concept)
(print-result-genls kb-b concept)
(let ((ar (print-arity kb-b concept)))
(dotimes (i ar)
(print-argNisa kb-b concept (+ i 1))))
(print-doc-string kb-b concept)
))
(defmethod add-links ((kb-b fire-kb-browser-info)
(lst list))
(let ((pretty-references-list (with-output-to-string (out)
(pprint lst out)))
(spec-chars (list #\( #\?)))
(with-output-to-string (out)
(with-input-from-string (s pretty-references-list)
(do ((c (read-char s nil 'done) (read-char s nil 'done))
(nc (peek-char nil s nil 'done) (peek-char nil s nil 'done)))
((eq c 'done))
;; (format t "CHAR: ~A NC: ~A~%" c nc)
(cond ((or (and (whitespace? c)
(not (or (member nc spec-chars)
(whitespace? nc))))
(and (eq c #\()
(not (member nc spec-chars))))
(write-char c out)
(let ((concept (read-concept s)))
(format out "~A"
(generate-concept-link kb-b concept)
concept)))
(t
(write-char c out))))))))
(defmethod print-all-references ((kb-b fire-kb-browser-info) concept)
(let ((refs (fire:retrieve-references concept :kb (kb kb-b))))
(format net.html.generator:*html-stream* "~A
~%"
(add-links kb-b refs))))
(defmethod display-all-references (concept (kb-b fire-kb-browser-info) references?)
(cond ((not references?)
(format net.html.generator:*html-stream*
"