Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Update web-server, new version of hunchentoot. Separate

out log-warn and log-error.  Change packaging to asdf2.
Change andes-path
  • Loading branch information...
commit c3c376d583bf72b732db32825a9e667982ee54c8 1 parent a1a292e
@bvds authored
View
40 Base/log-condition.cl
@@ -0,0 +1,40 @@
+;; Author(s):
+;; Brett van de Sande, March 2012
+;;; Copyright 2012 by Kurt Vanlehn and Brett van de Sande
+;;; This file is part of the Andes Intelligent Tutor Stystem.
+;;;
+;;; The Andes Intelligent Tutor System is free software: you can redistribute
+;;; it and/or modify it under the terms of the GNU Lesser General Public
+;;; License as published by the Free Software Foundation, either version 3
+;;; of the License, or (at your option) any later version.
+;;;
+;;; The Andes Solver is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU Lesser General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Lesser General Public License
+;;; along with the Andes Intelligent Tutor System. If not, see
+;;; <http:;;;www.gnu.org/licenses/>.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; ctl-c ctl-k compiles entire file
+
+;; The :text field is supposed to be plain text (rather than html).
+
+(in-package :cl-user)
+
+(defpackage :log-condition
+ (:use :cl)
+ (:export :log-error :log-warn :log-tag))
+
+(in-package :log-condition)
+
+(define-condition log-error (error)
+ ((tag :initarg :tag :reader log-tag)
+ (text :initarg :text :reader text))
+ (:report (lambda (c s) (write-string (text c) s))))
+
+(define-condition log-warn (warning)
+ ((tag :initarg :tag :reader log-tag)
+ (text :initarg :text :reader text))
+ (:report (lambda (c s) (write-string (text c) s))))
View
30 Base/web-server.cl
@@ -21,7 +21,7 @@
(in-package :cl-user)
(defpackage :webserver
- (:use :cl :hunchentoot :json)
+ (:use :cl :hunchentoot :json :log-condition)
(:export :defun-method :start-json-rpc-services :stop-json-rpc-services
:*stdout* :print-sessions :*env* :close-idle-sessions :*debug*
:*turn-timeout* :*time*
@@ -62,7 +62,7 @@
;; One could easily extend this to multiple web servers or multiple
;; services, but we don't need that now.
(when *server* (error "server already started"))
- (setf *dispatch-table* (list #'default-dispatcher))
+ (setf *dispatch-table* (list))
(dolist (service services)
(let ((logger (cadr (member :log-function (cdr service)))))
(push (create-prefix-dispatcher
@@ -82,15 +82,24 @@
;; Error handlers
(setf *http-error-handler* 'json-rpc-error-message)
- ;; Log any errors in Hunchentoot or not otherwise handled.
- ;; In particular, log any errors or warning using log-function
(when server-log-path (setf *MESSAGE-LOG-PATHNAME* server-log-path))
;; Test for multi-threading
(unless hunchentoot::*supports-threads-p*
(warn "Hunchentoot running without thread support, performance may be seriously degraded."))
- (setf *server* (start (make-instance 'acceptor :port port))))
+ (setf *server* (start
+ (make-instance
+ 'easy-acceptor
+ :port port
+ ;; access already logged by Apache
+ :ACCESS-LOG-DESTINATION nil
+ ;; Log any errors in Hunchentoot or
+ ;; not otherwise handled.
+ ;; In particular, log any errors or
+ ;; warning using log-function
+ :message-log-destination server-log-path
+ ))))
(defun json-rpc-error-message (err)
(format nil "{\"jsonrpc\": \"2.0\", \"error\": {\"code\": ~A, \"message\": \"Hunchentoot error: ~A\"}, \"id\": null}"
@@ -362,17 +371,6 @@
`(((:action . "show-hint")
(:text . ,(format nil "An error occurred:<br>~%~A~%" condition)))))
-;; The :text field is supposed to be plain text (rather than html).
-(define-condition log-error (error)
- ((tag :initarg :tag :reader log-tag)
- (text :initarg :text :reader text))
- (:report (lambda (c s) (write-string (text c) s))))
-
-(define-condition log-warn (warning)
- ((tag :initarg :tag :reader log-tag)
- (text :initarg :text :reader text))
- (:report (lambda (c s) (write-string (text c) s))))
-
(defun log-err (condition)
"Log after an error or warning has occurred."
(let ((result '((:log . "server") (:action . "log"))))
View
18 Help/Entry-API.cl
@@ -421,14 +421,14 @@
(open-review-window-html
(or (exptype-short-name qexp)
(progn
- (warn 'webserver:log-warn
+ (warn 'log-condition:log-warn
:tag (list 'exptype-no-short-name (exptype-type qexp))
:text "ExpType missing short-name.")
(string-downcase (string (exptype-type qexp)))))
"quantities.html"
:section (string (exptype-type qexp))
:title "Quantities" :value (exptype-type qexp)))
- (t (warn 'webserver:log-warn
+ (t (warn 'log-condition:log-warn
:tag (list 'exptype-non-quantity (exptype-type qexp))
:text "Exptype is not a quantity.")
(string-downcase (string (exptype-type qexp))))))
@@ -619,7 +619,7 @@
"Pull the quantity phrase out of a definition: should match variablename.js"
(when (> (length symbol) 0) ;variablename.js returns empty string on no match
(if (not (search symbol text :test test))
- (warn 'webserver:log-warn
+ (warn 'log-condition:log-warn
:tag (list 'symbol-definition-mismatch symbol text)
:text "Symbol does not match definition.")
;; Find first occurence of symbol in text and take rest of text.
@@ -1501,7 +1501,7 @@
;; StudentEntry-ErrInterp should have been set before
;; calling this function, perhaps by a call to (diagnose entry).
;; Otherwise, this means that the grading has not been done.
- (warn 'webserver:log-warn
+ (warn 'log-condition:log-warn
:tag (list 'undiagnosed-entry (StudentEntry-prop entry))
:text "Undiagnosed error for studententry."))
(diagnose entry))
@@ -1637,19 +1637,19 @@
:key #'enode-entries)))
(cond
((null sysent)
- (error 'webserver:log-error
+ (error 'log-condition:log-error
:tag (list 'done-button-without-systementry id)
:text "No SystemEntry for button"))
((null PSM)
- (error 'webserver:log-error
+ (error 'log-condition:log-error
:tag (list 'done-button-without-enode id)
:text "No problem step found for button"))
;; If this is not a non-quant psm then we also need to throw an error
;; asserting that fact.
((not (enode-has-mark? PSM 'non-quant))
- (error 'webserver:log-error
+ (error 'log-condition:log-error
:tag (list 'bad-mark-for-button-enode psm id)
:text "Unmarked enode matching non-quant IDNum"))
@@ -1737,7 +1737,7 @@
(setf (turn-id rem) (StudentEntry-id entry))
rem))
- (t (warn 'webserver:log-warn
+ (t (warn 'log-condition:log-warn
:tag (list 'make-tutor-response-bad-arg state spontaneous)
:text "unsupported state"))))
@@ -1751,7 +1751,7 @@
(make-incorrect-reply entry (ErrorInterp-remediation
(StudentEntry-ErrInterp entry)))
(progn
- (warn 'webserver:log-warn
+ (warn 'log-condition:log-warn
:tag (list 'reply-missing-rem error-tag
(when (StudentEntry-ErrInterp entry) t)
(studentEntry-prop entry))
View
4 Help/IEA.cl
@@ -158,7 +158,7 @@
;; Often occurs when rerunning logs through help
;; server and hint sequence has changed.
;; Bug #1947
- (warn 'webserver:log-warn
+ (warn 'log-condition:log-warn
:tag (list 'iea-check-response response)
:text "iea-check-response expecting cons")
(return-from iea-check-response))
@@ -266,7 +266,7 @@
(cond ((eql Response 'yes)
(iea-prompt-alt-axes-yes Equation Bindings NewAxis))
((eql Response 'no) (iea-prompt-alt-axes-no))
- (t (warn 'webserver:log-warn
+ (t (warn 'log-condition:log-warn
:tag (list 'iea-alternate-axes-prompt
response)
:text "invalid response"))))
View
16 Help/Interface.cl
@@ -134,12 +134,14 @@
(answer-only-dispatcher Command Arguments)
(apply command Arguments)))
(Str (cond ((turn-p Result) (return-turn time Result))
- ((listp Result) result)
- (t (warn "Invalid result format ~A" result)))))
-
+ ((every #'alistp result) result)
+ (t (warn 'log-condition:log-warn
+ :tag (list 'invalid-turn-result-format result)
+ :text "Invalid result format.")))))
+
;; Having nil violates the API
(when (and (turn-p result) (member nil (turn-result result)))
- (warn 'webserver:log-warn
+ (warn 'log-condition:log-warn
:tag (list 'result-contains-nil command (turn-result result))
:text "nil in solution-step reply"))
@@ -163,12 +165,12 @@
(score-hint-request (turn-assoc result)
*help-last-entries*))
- ;; Irrespective of the entry we need to inform the workbench of
+ ;; Irrespective of the entry, we need to inform the workbench of
;; the current total score if it has changed since last sent
(let ((current-score (calculate-score)))
(cond
((null current-score)
- (warn 'webserver:log-warn :tag (list 'null-grading-score)
+ (warn 'log-condition:log-warn :tag (list 'null-grading-score)
:text "null grading score"))
((or (null *last-score*)
(> (abs (- current-score *last-score*)) 0.01))
@@ -279,7 +281,7 @@
;; been logged. Bug #1935
(when (and (notany #'student-log-line result)
(not **checking-entries**))
- (warn 'webserver:log-warn
+ (warn 'log-condition:log-warn
:tag (list 'incorrect-missing-interp id)
:text "Red turn without logging interp."))
(push `((:action . "modify-object") (:id . ,id)
View
18 Help/NextStepHelp.cl
@@ -1037,7 +1037,7 @@
((nsh-start-principle-free?) (nsh-start-principle-free))
;; At this point we know that an error has occured so we
;; need to signal that to the system for later use.
- (t (warn 'webserver:log-warn
+ (t (warn 'log-condition:log-warn
:tag (list 'nsh-prompt-start-invalid (problem-name *cp*)
*nsh-problem-type*)
:text "Invalid problem setup supplied."))))
@@ -1572,7 +1572,7 @@
(unless (stringp response)
(unless (eql response 'explain-more)
- (warn 'webserver:log-warn
+ (warn 'log-condition:log-warn
:tag (list 'nsh-check-sought-resp response)
:text "unexpected value"))
(return-from nsh-check-sought-resp
@@ -1651,7 +1651,7 @@
;; Find matching qnode.
(let ((q (match-exp->qnode prop (problem-graph *cp*))))
(unless q
- (warn 'webserver:log-warn
+ (warn 'log-condition:log-warn
:tag (list 'unique-prop-response-no-qnode prop)
:text "no qnode match"))
(nsh-ask-first-principle (random-positive-feedback) q)))))
@@ -1690,7 +1690,7 @@
(qexp (lookup-expression-struct sought)))
(if (exptype-p qexp)
(quantity-html-link qexp)
- (progn (warn 'webserver:log-warn
+ (progn (warn 'log-condition:log-warn
:tag (list 'return-answer-quantity-short-english sought)
:text "no ontology match")
(def-np sought)))))
@@ -1704,7 +1704,7 @@
(solution-quantities
(delete-if #'(lambda (p)
(unless (exptype-p p)
- (warn 'webserver:log-warn
+ (warn 'log-condition:log-warn
:tag (list 'nsh-sought-resp-ambiguous p)
:text "No ontology match")
t))
@@ -1994,7 +1994,7 @@
;;; now, review/principles.json must be generated by hand from KB.
(defun nsh-cfp-principle-null (value Sought past)
"Account for an unknown psm name or bad object."
- (warn 'webserver:log-warn
+ (warn 'log-condition:log-warn
:tag (list 'nsh-invalid-principle value)
:text "invalid response from picking principle")
(nsh-wrong-fp-resp
@@ -2294,7 +2294,7 @@
(nsh-cfp-choose-best-fp
(nsh-cfp-collect-valid-fps Choices Sought)
Sought Past))
- (t (warn 'webserver:log-warn
+ (t (warn 'log-condition:log-warn
:tag (list 'nsh-cfp-prompt-change-axis
response)
:text "bad response")
@@ -2392,7 +2392,7 @@
((eql Response 'principle)
(nsh-wrong-fp-resp "" Sought Past
:case 'cbf-invalid-no))
- (t (warn 'webserver:log-warn
+ (t (warn 'log-condition:log-warn
:tag (list 'nsh-cbf-invalid response)
:text "bad response"))))
:Assoc '((nsh . cbf-invalid))))
@@ -2471,7 +2471,7 @@
;; the appropriate axes.
(nsh-cbf-invalid-axis Best Solutions Principles
Sought Past))
- (t (warn 'webserver:log-warn
+ (t (warn 'log-condition:log-warn
:tag (list 'nsh-cbf-invalid-different Response)
:text "invalid response"))))
:Assoc `((nsh cbf-invalid-different ,New ,Prompt))))
View
2  Help/SolutionGraph.cl
@@ -368,7 +368,7 @@
"Given a help entry prop generate the system entry for it and return."
;; include helpful message for this error:
(when (not (get-operator-by-tag (csdo-op Do)))
- (error 'webserver:log-error
+ (error 'log-condition:log-error
:tag (list 'operator-not-in-problem-file (csdo-op Do))
:text (strcat "Operator not found in current KB. "
View
2  Help/State.cl
@@ -119,7 +119,7 @@
;; Raising an error, rather than a warning, keeps subsequent
;; code in open-problem from being executed and sends a
;; message to the student.
- (error 'webserver:log-error :tag 'problem-load-failed
+ (error 'log-condition:log-error :tag 'problem-load-failed
:text (strcat "Unable to load problem " (string name)
". Please try another problem." ))))
View
8 Help/database.cl
@@ -221,7 +221,7 @@ list of characters and replacement strings."
(format nil "REPLACE INTO PROBLEM_ATTEMPT (clientID,userName,userproblem,userSection~:[~;,extra~]) values ('~a','~a','~A','~A'~@[,'~A'~])"
extra client-id student problem section extra))
(when (> (get-affected-rows *connection*) 1)
- (warn 'webserver:log-warn
+ (warn 'log-condition:log-warn
:tag (list 'duplicate-client-id
client-id student
problem section extra)
@@ -236,7 +236,7 @@ list of characters and replacement strings."
"Intercept any errors, turning them into warnings, then return."
;; If there are json errors, we want to log them and then soldier on.
`(handler-case (progn ,@forms)
- (error (c) (warn 'webserver:log-warn
+ (error (c) (warn 'log-condition:log-warn
:tag (list 'database-error (type-of c)
;; The objects are generally strings and the
;; most errors occur for very long strings.
@@ -449,7 +449,7 @@ list of characters and replacement strings."
(truncate-client-id client-id)))))
(if (and (consp result) (consp (car result)))
(car (car result))
- (warn 'webserver:log-warn
+ (warn 'log-condition:log-warn
:tag (list 'get-start-tID result
*old-client-id*
webserver:*log-id*
@@ -562,7 +562,7 @@ otherwise, use latest step tID. No-store means add to cache only."
;; The correct way for setting up section defaults is by using nil for student.
(when (and (stringp student)
(equal (string-right-trim match:*whitespace* student) ""))
- (error 'webserver:log-error :tag 'empty-student-string
+ (error 'log-condition:log-error :tag 'empty-student-string
:text "Null string sent for student"))
;; Save in cache, by either updating or pushing
View
4 Help/fade.cl
@@ -29,7 +29,7 @@
(setf *fades*
(loop for fade in (problem-fade problem)
unless (car fade) do
- (warn 'webserver:log-warn
+ (warn 'log-condition:log-warn
:tag (list 'fade-null-prop fade)
:text "Fade with null prop on load.")
else collect
@@ -43,7 +43,7 @@
(match-exp->qnode (second (car fade))
(problem-graph *cp*))
(car fade))
- (warn 'webserver:log-warn
+ (warn 'log-condition:log-warn
:tag (list 'invalid-fade-proposition (car fade))
:text "No systementry or bgnode match for fade."))
;; Evaluate the hints.
View
6 Help/grade.cl
@@ -139,7 +139,7 @@
;; Should be extend to allowed & preferred, Bug #972
(unless (or T (eql (null (graded-optional graded))
(null (SystemEntry-optional sysent))))
- (warn 'webserver:log-warn
+ (warn 'log-condition:log-warn
:tag (list 'SystemEntry-optional (SystemEntry-prop sysent))
:text (format nil "Two methods of finding optionality don't match. ~A ~A ~A" (systemEntry-prop sysent) (graded-optional graded) (SystemEntry-optional sysent))))
;; For now, just put in dummy value
@@ -186,12 +186,12 @@
"Calculate contribution of individual SystemEntry to score."
(let* ((graded (SystemEntry-graded sysent))
(weight (graded-weight graded)))
- (unless weight (warn 'webserver:log-warn
+ (unless weight (warn 'log-condition:log-warn
:tag (list 'graded-weight-missing (SystemEntry-prop sysent))
:text "Entry missing grading weight.")
(return-from grade-sysentry))
(unless (graded-possibilities graded)
- (warn 'webserver:log-warn
+ (warn 'log-condition:log-warn
:tag (list 'graded-possibilities-missing (SystemEntry-prop sysent))
:text "Entry missing grading possibilities.")
(return-from grade-sysentry))
View
4 Help/interpret-equation.cl
@@ -45,7 +45,7 @@
(cond
((null interps)
(setf (StudentEntry-CInterp se) nil)
- (warn 'webserver:log-warn
+ (warn 'log-condition:log-warn
:tag (list 'interpret-equation-none
(StudentEntry-ParsedEqn se))
:text "Can't find interpretations.")
@@ -74,7 +74,7 @@
(setf (StudentEntry-State se) +nogood+)
(setf result (chain-explain-more +nogood-help+)))
(t
- (warn 'webserver:log-warn :tag (list 'interpret-equation-missing
+ (warn 'log-condition:log-warn :tag (list 'interpret-equation-missing
(StudentEntry-ParsedEqn se))
:text "No interpretation.")
(setf (StudentEntry-CInterp se) shortest)
View
12 Help/parse-andes.cl
@@ -474,7 +474,7 @@
;; This log-warn was used to find errors that are
;; not properly handled:
(when (and nil (te-error-tag te))
- (warn 'webserver:log-warn
+ (warn 'log-condition:log-warn
:tag (list 'choose-ambiguous-bad-turn (te-error-tag te))
:text "choose-ambiguous-bad: unknown error treated as wrong"))
(setf wrong (append wrong (list te))))))
@@ -573,7 +573,7 @@
(handler-case
(do-contains-strings answer)
(warn (c) (declare (ignore c))
- (warn 'webserver:log-warn
+ (warn 'log-condition:log-warn
:tag (list 'contains-strings answer)
:text "Invalid contains-string object."))))
@@ -630,7 +630,7 @@
(inaccurate
;; not currently used because What's wrong checks for
;; inaccuracy but only after checking for other error classes
- (warn 'webserver:log-warn
+ (warn 'log-condition:log-warn
:tag 'parse-handler-inaccurate
:text "inaccurate in parse-handler")
(diagnose se)
@@ -1140,11 +1140,11 @@ follow-up question and put it in the student entry's err interp field."
(setf (SystemEntry-entered sysent) nil))
;; Grading for result.
(update-grade-status (list sysent) (StudentEntry-state entry)))
- (warn 'webserver:log-warn :text "No matching systementry for box"
+ (warn 'log-condition:log-warn :text "No matching systementry for box"
:tag (list 'box-no-systementry (StudentEntry-prop entry)))))
(unless (turn-p result-turn)
- (warn 'webserver:log-warn :text "No reply turn for answer"
+ (warn 'log-condition:log-warn :text "No reply turn for answer"
:tag (list 'box-no-reply (StudentEntry-prop entry)))
(return-from check-answer
(make-tutor-response
@@ -1527,7 +1527,7 @@ follow-up question and put it in the student entry's err interp field."
(handler-case
(do-subst-canonical-vars Exp)
(warn (c) (declare (ignore c))
- (warn 'webserver:log-warn
+ (warn 'log-condition:log-warn
:tag (list 'subst-canonical-vars Exp)
:text "Invalid subst-canonical-vars object."))))
View
12 Help/sessions.cl
@@ -379,7 +379,7 @@
(when (or (null donners) (cdr donners))
;; Student can't successfully solve the problem if
;; this is broken.
- (error 'webserver:log-error
+ (error 'log-condition:log-error
:tag (list 'setup-button-match label
(mapcar #'SystemEntry-prop donners))
:text "Bad SystemEntry match for button."))
@@ -410,7 +410,7 @@
(width (second g)) (height (third g)))
(unless (and height width)
(setf height 100 width 100) ;give some value so we can muddle through.
- (warn 'webserver:log-warn
+ (warn 'log-condition:log-warn
:tag (list 'graphic-dimensions-missing (first g))
:text "Graphic dimensions not included."))
(push `((:action . "new-object") (:id . "graphic")
@@ -645,7 +645,7 @@
;; helper function to handle errors from old sessions
;; Turns errors into log-warn.
(defun old-errors-into-warnings (c method params)
- (warn 'webserver:log-warn
+ (warn 'log-condition:log-warn
:tag (list 'old-session-error method params
(type-of c) (webserver:get-any-log-tag c))
:text (format nil "Error from rerunning old sessions: ~A" c)))
@@ -751,12 +751,12 @@
(sleep 2))
(when (and old-entry (equal action "new-object"))
- (warn 'webserver:log-warn :tag (list 'create-existing-object id)
+ (warn 'log-condition:log-warn :tag (list 'create-existing-object id)
:text "Object already exists, updating old object."))
(when (and (not old-entry) (or (equal action "modify-object")
(equal action "delete-object")))
- (warn 'webserver:log-warn :tag (list 'modify-non-existant-object id)
+ (warn 'log-condition:log-warn :tag (list 'modify-non-existant-object id)
:text "Object does not exist, creating new object."))
(when (and type old-entry
@@ -1003,7 +1003,7 @@
(cdr (assoc "LONCAPA_correct_answer"
input :test #'equal))))
- ;; This will go into the general Hunchentoot log
+ ;; This error will go into the general Hunchentoot log
;; along with a backtrace. Bug #1907
(unless (cdr (assoc "LONCAPA_correct_answer" input
:test #'equal))
View
8 HelpStructs/TutorTurn.cl
@@ -180,7 +180,7 @@
((stringp R)
(string-responder R :explain-more t))
- (T (warn 'webserver:log-warn
+ (T (warn 'log-condition:log-warn
:tag (list 'invalid-turn-responder R)
:text "invalid responder"))))
:Assoc (alist-warn Assoc)))
@@ -349,11 +349,11 @@
((eq (car Hint) 'Function)
(unless (and *backwards-hints-hook*
(funcall *backwards-hints-hook*))
- (warn 'webserver:log-warn
+ (warn 'log-condition:log-warn
:tag (list 'hints-after-function rest)
:text "Hints in sequence after function inaccessible."))
(make-function-hseq (cdr Hint) Prefix))
- (t (Error 'webserver:log-error :tag 'problem-load-failed
+ (t (Error 'log-condition:log-error :tag 'problem-load-failed
:tag (list 'unrecognized-hint-type 'next hint)
:text "Unrecognized hint type supplied."))))
@@ -372,7 +372,7 @@
((eq (car Hint) 'Minilesson) (make-minil-end-hseq (cadr Hint) Assoc))
((eq (car Hint) 'Eval) (make-eval-hseq (cadr Hint)))
((eq (car Hint) 'function) (make-function-hseq (cdr Hint) Prefix))
- (t (Error 'webserver:log-error
+ (t (Error 'log-condition:log-error
:tag (list 'unrecognized-hint-type 'end hint)
:text "Unrecognized hint type supplied."))))
View
16 andes-help.asd
@@ -4,19 +4,10 @@
(defpackage :help-asd (:use :cl :asdf))
(in-package :help-asd)
-;;;; Load the source file, without compiling
-;;;; asdf:load-op reloads all files, whether they have been
-;;;; changed or not.
-
-(defclass no-compile-file (cl-source-file) ())
-(defmethod perform ((o compile-op) (s no-compile-file)) nil)
-(defmethod output-files ((o compile-op) (s no-compile-file))
- (list (component-pathname s)))
-
-
(defsystem :andes-help
:name "Andes help"
:description "Andes physics tutor system: helpsystem"
+ :default-component-class cl-source-file.cl ;use *.cl as default extension
:depends-on (problems web-server)
:components (
(:module "Base"
@@ -128,8 +119,3 @@
; (:file "StackTests")
))
))
-
-;;; make source file extension "cl" See asdf manual
-
-(defmethod source-file-type ((c cl-source-file)
- (s (eql (find-system :andes-help)))) "cl")
View
7 andes-path.cl
@@ -2,9 +2,4 @@
;;;; Set the default path for finding Andes2 files
;;;; (This should eventually not be needed)
-(defparameter *andes-path*
- (make-pathname :host (pathname-host *load-pathname*)
- :device (pathname-device *load-pathname*)
- :directory (pathname-directory *load-pathname*)
- :name nil
- :type nil))
+(defparameter *andes-path* (asdf:system-source-directory 'andes))
View
30 andes.asd
@@ -10,24 +10,11 @@
(defpackage :andes-asd (:use :cl :asdf))
(in-package :andes-asd)
-;;;; Load the source file, without compiling
-;;;; asdf:load-op reloads all files, whether they have been
-;;;; changed or not.
-
-(defclass no-compile-file (cl-source-file) ())
-(defmethod perform ((o compile-op) (s no-compile-file)) nil)
-(defmethod output-files ((o compile-op) (s no-compile-file))
- (list (component-pathname s)))
-
-;;;
-;;; Add directory of problem files to
-;;;
-
-
(defsystem :andes
:name "Andes"
:description "Andes physics tutor system"
:depends-on (cl-json) ;KB/principles.cl
+ :default-component-class cl-source-file.cl ;use *.cl as default
:components (
;;; this should eventually be removed
(:file "andes-path")
@@ -37,6 +24,7 @@
(:file "auxiliary")
(:file "hash")
(:file "match")
+ (:file "log-condition")
(:file "Utility")))
(:module "Algebra"
:components ((:file "solver")))
@@ -45,6 +33,8 @@
:components ((:file "PsmGraph")
(:file "StudentEntry")
(:file "hint-symbols")
+ ;;for make-hint-seq in KB/errors.cl
+ (:file "TutorTurn")
(:file "SystemEntry"
:depends-on ("PsmGraph"))
))
@@ -78,12 +68,11 @@
;;; :description "Knowledge Base"
;; Also depends on nlg
:depends-on ("Knowledge" "Base")
- :default-component-class no-compile-file
:serial t ;real dependancies would be better
:components (
;; treat these as normal lisp files
- (:cl-source-file "Physics-Funcs")
- (:cl-source-file "makeprob")
+ (:file "Physics-Funcs")
+ (:file "makeprob")
;; must be before any ontology
(:file "reset-KB")
@@ -91,7 +80,7 @@
(:file "quantities")
(:file "constants")
;; lots of outside dependencies:
- (:cl-source-file "errors")
+ (:file "errors")
;; TELL and NLG not defined
(:file "Ontology" )
(:file "circuit-ontology")
@@ -124,8 +113,3 @@
(:file "print-solutions")
(:file "SolutionSets")))
))
-
-;;; make lisp source file extension "cl" See asdf manual
-
-(defmethod source-file-type ((c cl-source-file) (s (eql (find-system :andes))))
- "cl")
View
6 lon-capa.asd
@@ -18,12 +18,8 @@
:name "LON-CAPA"
:description "Creat LON-CAPA courses"
:depends-on (problems)
+ :default-component-class cl-source-file.cl ;make *.cl default extension
:components (
(:module "lon-capa"
:components ((:file "assignments")
(:file "sets")))))
-
-;;; make source file extension "cl" See asdf manual
-
-(defmethod source-file-type ((c cl-source-file)
- (s (eql (find-system :lon-capa)))) "cl")
View
19 web-server.asd
@@ -8,28 +8,17 @@
(defpackage :web-server-asd (:use :cl :asdf))
(in-package :web-server-asd)
-;;;; Load the source file, without compiling
-;;;; asdf:load-op reloads all files, whether they have been
-;;;; changed or not.
-
-(defclass no-compile-file (cl-source-file) ())
-(defmethod perform ((o compile-op) (s no-compile-file)) nil)
-(defmethod output-files ((o compile-op) (s no-compile-file))
- (list (component-pathname s)))
-
;; Match instructions in the INSTALL file: don't do ssl when
;; loading huncentoot.
(push :hunchentoot-no-ssl *features*) ;we have apache to do this
+(setf SB-IMPL::*DEFAULT-EXTERNAL-FORMAT* :utf-8) ;for rfc2388.asd
(defsystem :web-server
:name "Web Server"
:description "Web Server"
:depends-on (hunchentoot cl-json)
+ :default-component-class cl-source-file.cl ;make *.cl default extension
:components (
(:module "Base"
- :components ((:file "web-server")))))
-
-;;; make lisp source file extension "cl" See asdf manual
-
-(defmethod source-file-type ((c cl-source-file)
- (s (eql (find-system :web-server)))) "cl")
+ :components ((:file "log-condition")
+ (:file "web-server")))))
Please sign in to comment.
Something went wrong with that request. Please try again.