(in-package :alp) ;; Fixes problem when an ALP file has arguments and its processed as usual ;; This patch supersedes 2002-06-17-default-arguments-patch. The previous ;; version only works with output from compiled functions. But when we ;; patch ALP pages they can be interpreted functions, and the output of ;; excl:arglist is different. (defun has-args (funct) (when (not (fboundp funct)) (error "No function is bounded to '~S'." funct)) (let ((f-args (excl:arglist funct))) (not (loop for expected-argname in '(&OPTIONAL ALP::OUTPUT-STREAM ALP::ALIST &REST REST) for given-arg in f-args for given-argname = (if (consp given-arg) (car given-arg) given-arg) always (eq expected-argname given-argname))))) (defun process (alp-name &optional (funct nil) (client-stream *output-stream*) (alist *query-alist*) &rest rest) "Process a request" ;; Prepare the page and then execute request (setq funct (prepare alp-name funct)) (if (has-args funct) (apply funct (alist-to-function-arguments funct *query-alist*)) (apply funct client-stream alist rest))) ;;; EOF (in-package :alp) ;; Automatically generated file - do not modify by hand! (defun alp::|expected-correspondence| (&optional (OUTPUT-STREAM cl:*standard-output*) (ALIST nil) &rest REST) (let ((cl:*standard-output* OUTPUT-STREAM) (alp::*query-alist* ALIST)) (write-line "") (write-line "") #| Query parameters: sessionid: User's login name action: Requested action on the page. One of answer-question, add-new, delete-selected, submit. root: The root concept relative that provides context question-type: The question type that must be passed through from ask-question.alp, back to ask-question.alp. target: The concept about which the user is asking, used as the structure mapping target. base: The concept to compare to, used as the structure mapping base. step: Describes what data should be displayed. Either 1 or 2. target-object: The skolem object representing the object from the concept (target) in the current correspondence. base-object: The skolem object representing the object from the base in the current correspondence. sk-target: The skolem for the concept (target). sk-base: The skolem object for the base. |# (write-string " ") (util::with-alist-values (sessionid action step root question-type target target-sk target-object base base-sk base-object confirmed concept message) ALIST (write-line " ") (write-line " Ask Question") (write-line " ") (write-line " ") (write-line " ") (write-line " ") (write-line " ") (write-line " ") (write-line " ") (write-line " ") (write-line "
") (write-line " ") (write-line "

Ask Question

") (write-line "
") (write-line " ") (write-string " ") (alp::include-with-args "secondary-toolbar-inc.alp") (write-line " ") (write-string " ") (alp::include-with-args "message-inc.alp" message) (write-line " ") (write-line "
") (write-string " ") (write-string " ") (write-string " ") (write-string " ") (write-string " ") (write-string " ") (write-string " ") (write-string " ") (write-string " ") (write-string " ") (write-line " ") (write-string " ") (when (equal step "1") (write-line " ") (write-line "

Comparing concept") (write-string " ") (alp::include-with-args "link-inc.alp" target-sk "examineConstant") (unless (or (empty-p root) (equal root concept)) (write-line " as") (write-string " ") (princ (alp::nil-filter (rkf::path2english (rkf::compute-lmap-path sessionid concept)) )) (write-string " ") ) (write-line " to") (write-string " ") (alp::include-with-args "link-inc.alp" base-sk "examineConstant") (write-line "

") (write-line "
") (write-line " ") (write-line "
") (write-line "

While computing similarities or contrasts between the two concepts, you may") (write-line " guide SHAKEN by pairing specific properties of the two concepts being considered.") (write-line " We call such pairings correspondences.

") (write-line "

For example, while comparing solar system with an atom, you could guide") (write-line " SHAKEN by pairing that Sun in the solar system with the nucleus in an atom. This") (write-line " correspondence between the Sun and a nucleus is given special consideration in") (write-line " the subsequent comparison.

") (write-line "

While it is not necessary to give this kind of guidance, the results SHAKEN") (write-line " produces can often be improved if it is provided.

") (write-line "
") (write-line "
") (write-line " ") (write-string " ") (cond (rkf::*expected-correspondences* (let ((i 0)) (loop for (cr-base . cr-target) in rkf::*expected-correspondences* do (write-string " ") (write-string " ") (princ (alp::nil-filter (rkf::frame2english cr-base :root base) )) (write-line " must correspond to") (write-string " ") (princ (alp::nil-filter (rkf::frame2english cr-target :root target) )) (write-line "
") (write-string " ") (incf i))) (write-line "

Click here to remove") (write-line " selected expected matches.

") (write-string " ") ) (t (write-line "

There are no user specified concept correspondences.

") (write-string " ") )) (write-line "

If you want to specify a new one, ") (write-line " click here.

") (write-line "

Otherwise, hit Continue to compare the two concepts.

") (write-string " ") ) (write-line " ") (write-string " ") (when (equal step "2") (cond ((or (empty-p target-object) (empty-p base-object) (empty-p confirmed)) (write-line "

Specify a new correspondence:

") (write-line "

You can specify a correspondence between the concepts related to") (write-string " ") (princ (alp::nil-filter target )) (write-string " and ") (princ (alp::nil-filter base )) (write-line ".

") (write-line " ") (write-string "

Concept related to ") (princ (alp::nil-filter target )) (write-line ":") (write-string " ") (write-string " ") (cond ((empty-p target-object) (write-line " ") (write-string " ") ) (t (let* ((target-object (okbc:coerce-to-frame target-object :kb rkf::*base-kb*)) (path (rkf::compute-lmap-path sessionid target-object)) (sentence-path (rkf::path2english path)) (sentence-instance (rkf::frame2english target-object))) (write-string " ") (princ (alp::nil-filter sentence-path )) (write-string " ") (when (not (string-equal sentence-path sentence-instance)) (write-string ": ") (princ (alp::nil-filter sentence-instance )) (write-string " ") )))) (write-line "

") (write-line " ") (write-string "

Concept related to ") (princ (alp::nil-filter base )) (write-line ":") (write-string " ") (write-string " ") (cond ((empty-p base-object) (write-line " ") (write-string " ") ) (t (let* ((base-object (okbc:coerce-to-frame base-object :kb rkf::*base-kb*)) (path (rkf::compute-lmap-path sessionid base-object)) (sentence-path (rkf::path2english path)) (sentence-instance (rkf::frame2english base-object))) (write-string " ") (princ (alp::nil-filter sentence-path )) (write-string " ") (when (not (string-equal sentence-path sentence-instance)) (write-string ": ") (princ (alp::nil-filter sentence-instance )) (write-string " ") )))) (when (and (empty-p confirmed) (not (empty-p base-object)) (not (empty-p target-object))) (write-line " ") (write-string " ") ) (write-line "

") (write-string " ") ) (t (write-line "

Correspondence Specified:

") (write-string "

") (princ (alp::nil-filter (rkf::individual-path-english sessionid base-object base) )) (write-line " must corresond to") (write-string " ") (princ (alp::nil-filter (rkf::individual-path-english sessionid target-object target) )) (write-line ".

") (write-string " ") (write-string " ") (write-string " ") ))) (write-line " ") (write-line "
") (write-line "

") (write-line " ") (write-string " ") (unless (or (equal step "1") (empty-p target-object) (empty-p base-object)) (unless (empty-p confirmed) (write-line " ") (write-string " ") ) (when (empty-p confirmed) (write-line " ") (write-string " ") )) (when (equal step "1") (write-line " ") (write-string " ") ) (write-line "

") (write-line "
") (write-line "
") (write-line " ") (write-string " ") (alp::include-with-args "copyright-inc.alp") (write-line " ") (write-string " ") ) (write-line "") ) ;; Closes the let nil) ;; Closes the defun ;;; -*- Syntax: Common-Lisp; Mode: LISP; Package: RKF; Base: 10 -*- ;;; $Id$ (in-package :rkf) (defun path-in-case (object root case) (when (and (atom object) (atom root)) (let* ((root (intern root :user)) (object (intern object :user)) (shaken::*root-instance* root)) (shaken::km-path-expr-for-instance object (make-lmap-from-case root case) nil)))) ;;; EOF