;;; -*- Mode:LISP; Package:REPORTER; Lowercase:MIXED; Base:10; Fonts:MEDFNB; Readtable:ZL -*-

;;; REPORTER.LISP

;;; Bug/Problem/Note reporter.

(defvar *highest-report-number* 0)

(defconst *report-directory* "SW:REPORTS;")
(defconst *all-reports* "SW:REPORTS;*.*#>")
(defvar   true-report-directory *report-directory*)
(defconst high-prop :latest-report-number)

;; Ensure reporter directory exists.
(eval-when (eval load)
  (setq true-report-directory 
	(fs:translated-pathname *report-directory*))
  (fs:create-directory true-report-directory)
  )
  
;; Text prefixes:
(defconst *prefix*		";;; ")
(defconst *time-prefix*		";;; At ")
(defconst *author-prefix*	";;; By " )

;; Hacks to get unique report number/name. Need to inspect
;; the report directory to determine.

(defun reports() (directory *all-reports*))

(defun get-name(report) (send report :name))

(defun get-number(report)
  (or (get report high-prop) 0))

(defun set-number(report number)
  (setf (get report high-prop) number))

(defsetf get-number set-number)

(defun report-names()
  (remove-duplicates
    (mapcar #'get-name (reports))))

(defun set-highest-report-number(&optional highest
				 &aux names)
  "Brute force way to set highest report number."
  (setf (get true-report-directory high-prop)
	(or
	  highest
	  (highest-of (reports))
	  0)))

(defun highest-of(&optional (reports (reports)))
    (apply #'max
	   (mapcar #'get-number reports)))

	

(defmacro latest-report-number()
  `(or (get true-report-directory high-prop) 0))
       
(defun find-highest-report-number
       (&optional report-number)
  (1+ (or report-number *highest-report-number* )))


(defun lock-highest-report-number()
  (setq *highest-report-number*
	(find-highest-report-number)))

(defun new-report-name-string()
"Get high report # and convert into /"report-00x/" form"
  (let( (report-number (lock-highest-report-number)) )
     (format nil "REPORT-~3,48d" report-number)))

(defun id-ify(thing)
  (intern
    (string-upcase
      (string thing))))


;;; Here comes the report flavor definition

(defflavor REPORT
	   (
	    (name (new-report-name-string))
	    (author (string-upcase user-id))
	    (description "")
	    logfile output
	    )
	   nil
  (:inittable-instance-variables name author logfile)
  (:gettable-instance-variables name author logfile)
  (:settable-instance-variables name author)
  )

;;; How to nicely make a report object

(defun report(&optional text &key author name edit)
  (let ( (report (make-instance 'report
				:author author)))

    (if name (send report :set-name name))
    (if text (send report :report-string text))
    (if edit (send report :edit))
    (describe report))
  )

(defmethod (report :coerce-name) ()
  (let( (old-name name))
    (setq name
	  (typecase name
	    (symbol (string-upcase name))
	    (string (string-upcase name))
	    (t nil)))
    (unless name
      (setq name
	    (cerror t nil nil
		    "~s is not a valid report name -- /
    Press <resume> and enter a string or symbol."
		    old-name user-id))
      (send self :coerce-name))
    )
  (send self :name)
  )

(defmethod (report :coerce-author) ()
  (let( (old-author author))
    (setq author
	  (typecase author
	    (null (id-ify user-id))
	    ((or symbol string) (id-ify author))
	    (t nil)))
    (unless author
      (setq author
	    (cerror t nil nil
		    "~s is not a valid author id -- /
    Press <resume> and enter a string, symbol, /
    or NIL for current user-id ~s."
		    old-author user-id))
      (send self :coerce-author))
    )
  (send self :author)
  )

(defmethod (report :coerce-logfile) ()
  (setq logfile
	(fs:merge-pathname-defaults 
	  name *report-directory*
	  "TEXT"))
  )

(defmacro with-logfile(&body body)
  `(with-open-file
     (logfile-stream logfile
	:direction :output
	:if-exists :append)
     
     . ,body))

(defmethod (report :new-logfile) ()
;; Create logfile, must be new
  (with-open-file
    (s logfile
       :direction :output 
       :if-exists :error))
;; Write header info
    (send self :report-string name)
    (send self :report-current-time)
    (send self :report-string author *author-prefix* )
    )

(defmethod (report :report-string) (string &optional (prefix *prefix*))
  "Write a string, with optional prefix, into the log."
  (with-logfile
    (format logfile-stream "~a~a~%" prefix string)))

(defmethod (report :report-current-time) (&optional (prefix *time-prefix*))
  "Write the current time, with settable prefix, into the log."
  (send self :report-string
	(time:print-universal-time(get-universal-time) nil)
	prefix))

(defmethod (report :edit) ()
  (ed logfile)
  (format t "~&Edited report ~s in ~s.~%" name logfile))

(defmethod (report :view) ()
  (viewf logfile)
  (format t "~&Viewed report ~s in ~s.~%" name logfile))

;;; Daemonic stuff

(defmethod (report :after :init) (&rest ignore)
  (send self :coerce-name)
  (send self :coerce-author)
  (send self :coerce-logfile)
  (send self :new-logfile)
  )

(defmethod (report :after :set-author) (&rest ignore)
  (send self :coerce-author))

(defmethod (report :after :set-name) (&rest ignore)
  (send self :coerce-name)
 )

;(defmethod (report :before :set-logfile) (new-logfile)
;  (yes-or-no-p
;	  "Sure you want to change log-file name for ~s~% from ~s~% to ~s?"
;	  name log-file new-logfile))