(in-package "KPML")

;;; File: description-declarations.lisp
;;; KPML-3.2
;;; May 2000, John Bateman.
;;; Bremen.
;;;
;;; Patched at 3.2.68 in order to include descriptions of example
;;; sets.

;;;----------------------------------------------------------------------
;;; Individual languages can declare language descriptions for
;;; use in automatic web documentation creation. Usual declaration
;;; setup. Dependencies: 
;;;   * extension to kpml-eval-form to recognise this
;;;   * extension to kpml-resource-management to write them out when
;;;     saving
;;; ----------------------------------------------------------------------

 ;; ----------------------------------------------------------------------
 ;; To be added: 
 ;;        The language description macro should have a :version field
 ;;        added to it which can be picked up here and displayed
 ;;        appropriately. This should be added into KPML 3.2+. 
 ;;        As a default one could take the write date of the properties
 ;;        file. You get this with (file-write-date file-name). This
 ;;        must then be decoded with (decode-universal-time xxx). 
 ;;        time-stamp in utilities can then be extended to take
 ;;        the time as optional arg so that the time can be written
 ;;        out easily. When the resources are saved one could also
 ;;        create some version or re-versioning numbers to indicate
 ;;        that something has been done.
 ;; ----------------------------------------------------------------------

(defvar *language-description-profiles* nil)

(defmacro DEFINE-LANGUAGE-DESCRIPTION
  ((&key (language nil)(style :html)) &rest description)
  (if (and language description)
      `(let ((lg (intern (string ',language) :keyword)))
         (setf *language-description-profiles*
               (merge-in-description-declaration 
                lg ,style ',description 
		*language-description-profiles*)))
    (warning "Ill-formed language description declaration!")))

(defun MERGE-IN-DESCRIPTION-DECLARATION (lg style descriptions profiles)
  (let ((modified-profiles nil)
	(consumed nil))
    (loop for lg-defaults in profiles
	  do
	  (cond ((eq (first lg-defaults) lg)
		 (push (list lg style descriptions) modified-profiles)
		 (warning "Description profile for language " lg 
			  " being updated.")
		 (setf consumed t))
		(t
		 (push lg-defaults modified-profiles))))
    (unless consumed (push (list lg style descriptions) modified-profiles))
    modified-profiles))

 ;; ----------------------------------------------------------------------
 ;; 3.2.23 add language description to the SPL reports...
 ;;        so provide a function to do that...
 ;; 4.0    returns T if a language description was
 ;;        presented, else NIL.
 ;; ----------------------------------------------------------------------

(defun PRESENT-LANGUAGE-DESCRIPTION (stream lg)
  (let ((presented? nil))
    (loop for lg-defaults in *language-description-profiles*
	  when (eq (first lg-defaults) lg)
	  do
	  (setf presented? T)
	  (case 
	   (second lg-defaults)
	   (:html 
	    ;; the following, with a fancy paragraph, is just to
	    ;; remind me to follow Jiri's proposal of allowing
	    ;; proper style sheets to be used too at some stage...
	    ;; Now that there is an as-html macro, which defines
	    ;; header info in any case, it is trivial to add into
	    ;; this an appropriate collection of style definitions.
	    ;; This should be done. The style can be set in a 
	    ;; global string and can also point to a file name.
	    (when (third lg-defaults)
	      (format 
	       stream 
	       "<P style=\"border: 2px solid blue; padding: 0.5em; margin: 2em; width: 80%\"><B>Resource Description: </B><BR>~A</P>"
	       (third lg-defaults))))
	   (otherwise
	    (format stream "~%~10T~A" 
		    (third lg-defaults)))))
    presented?))

 ;; ----------------------------------------------------------------------
 ;; 3.2.68
 ;; and the same for example sets...
 ;;
 ;; An example set description can be placed at the beginning of
 ;; of an examples set file. It should then be picked up and used
 ;; when making reports. This needs to be added into the kpml-eval
 ;; list so that it can be picked up, and also to the write-example-set
 ;; functions in maintenance. May as well do this for KPML 3.2+ rather
 ;; than change the macro definitions as a patch. 
 ;; ----------------------------------------------------------------------

 ;;
 ;; could spread the following around a bit too, in all those places
 ;; that currently do a separate decoding of universal time...
 ;; argument must be an uncoded universal time or is ommited.

(defun TIME-TO-STRING (&optional (time nil))
  (multiple-value-bind (second minute hour date month year) 
		       (if time 
			   (decode-universal-time time)
			 (get-decoded-time))
		       (format nil "~a-~a-~a ~2,'0d:~2,'0d:~2,'0d" 
			       date month year hour minute second)))

 ;; ----------------------------------------------------------------------
 ;; format of the following is ( ... (lg exset-name style version text) ... )
 ;;
(defvar *language-exset-profiles* nil)
 ;; ----------------------------------------------------------------------


(defmacro DEFINE-EXSET-DESCRIPTION
  ((&key (language nil)(name nil)(style :html)(version nil)) &rest description)
  (unless version (setf version (time-to-string 
				 (file-write-date cl-user::*LOAD-TRUENAME*))))
  (if (and language description name)
      `(let ((lg (intern (string ',language) :keyword)))
         (setf *language-exset-profiles*
               (merge-in-exset-description-declaration 
                lg ',name ,style ',version ',description 
		*language-exset-profiles*)))
    (warning "Ill-formed excercise set description declaration!")))

(defun MERGE-IN-EXSET-DESCRIPTION-DECLARATION 
  (lg name style version descriptions profiles)
  (let ((modified-profiles nil)
	(consumed nil)
	(new-element (list lg name style version descriptions)))
    (loop for (pr-lang pr-name pr-style pr-version text) in profiles
	  do
	  (cond ((and (eq pr-lang lg)
		      (eq pr-name name))
		 (push new-element modified-profiles)
		 (warning "Description profile for exercise set " 
			  name " for language " lg 
			  " being updated.")
		 (setf consumed t))
		(t
		 (push (list pr-lang pr-name pr-style pr-version text)
		       modified-profiles))))
    (unless consumed (push new-element modified-profiles))
    modified-profiles))

(defun PRESENT-EXAMPLE-SET-DESCRIPTION (stream lg exset-name)
  (let ((presented? nil))
    (loop for lg-defaults in *language-exset-profiles*
	  when (and (eq (first lg-defaults) lg)
		    (eq (second lg-defaults) exset-name))
	  do
	  (setf presented? T)
	  (case (third lg-defaults)
		(:html 
		 ;; same reminder to use proper style sheets here too...
		 (when (fifth lg-defaults)
		   (format stream "<P style=\"border: 2px solid blue; padding: 0.5em; margin: 2em; width: 80%\"><B>Example Set Description (Version: ~A): </B><BR>~A</P>"
			   (fourth lg-defaults)
			   (fifth lg-defaults))))
		(otherwise
		 (format stream "~%~10T(~A) ~A" 
			 (fourth lg-defaults)
			 (fifth lg-defaults)
			 ))))
    presented?))

