;;; File: munge-string.lisp
;;; Susan Williams, September, 1995 at Waterloo
;;; Last saved in emacs: Time-stamp: <97/01/20 16:16:20 jlitchfi>

;;; This file contains a patch to correct the punctuation from the
;;; output of kpml.  It unfortunately does not correct the problem
;;; produced by conjuctions that produces such output as "a disk, sk,
;;; and a head, ad, and something else."


(in-package :penman)

;;; recursive removal of extra spaces, added by jlitchfi 20/01/97
(defun re-space (output)
  (let (result)
    (setq result (string-substitute " " "  " output))
    (cond ((eq output result)
	   result)
	  (t
	   (re-space result)))))
		 
(defun re-punctuate (result)
  (cond ((char= (char result 0) #\")
	 (setf (char result 2) (char-upcase (char result 2))))
	(t (setf (char result 0) (char-upcase (char result 0)))))
  (setq result (nospaces-near-quotes result))

  ;; remove excess spacing.
  (setq result (re-space result)) ;; added by jlitchfi 20/01/97
  ;; (setq result (string-substitute " " "  " result))
  
;;; Add a change to account for parentheses (added by WW, July 17/95)
  (setq result (string-substitute "(" "( " result))
  (setq result (string-substitute ")" " )" result))
  
;;; the following can safely be done within constituents... 
  (setq result (string-substitute "/" " / " result))	; spaces out in dates.
  (setq result (string-substitute "," ",," result))
  (setq result (string-substitute "." ",." result))
  (setq result (string-substitute "." ".," result))	; this is a hack to deal with the
  (setq result (string-substitute "?" "?." result))	; occasional multiple punctuation
  (setq result (string-substitute "!" "!." result))	; that occurs due to embedding.

  (setq result (string-substitute "," " ," result))
  (setq result (string-substitute "." ". " result))
  (setq result (string-substitute "." " ." result))
  (setq result (string-substitute "'" " '" result))
  (setq result (string-substitute "?" " ?" result))
  (setq result (string-substitute "?" "? " result))
  (remove-spaces-between-numerals-and-compass-points result))	;destructive replacement


(defun SAY-PLAN (plan print-results &optional (morphology NIL))
  "Convert the list-structured plan into term-graph structures, set global parameters,
   and invoke Express."
  (let ((generation-results nil))
    (unless (say-entry-control) (return-from say-plan nil))
    (reset-defaults-if-necessary)
    (setq *plan-graphs* nil)
    (setq *consumed-terms* nil)
    (setf (example-rootnode (gethash plan penexamples)) 
	  (setq *plan* 
		(make-plan-term-graph (fetch-example-info 
				       plan 'logicalform))))
    (setf (example-verbalizationgraph (gethash plan penexamples)) *plan-graphs*)
    (setq *speaker* (discourse-context-speaker 
		     (example-discoursecontext 
		      (gethash plan penexamples))))
    (setq *hearer* (discourse-context-hearer 
		    (example-discoursecontext 
		     (gethash plan penexamples))))
    (setq *speakingtime* (discourse-context-speaking-time 
			  (example-discoursecontext 
			   (gethash plan penexamples))))
    (setq *speakingplace* (discourse-context-realm-of-speech 
			   (example-discoursecontext 
			    (gethash plan penexamples))))
    (setf generation-results (Express plan print-results morphology))
    (setf first-string (car (first generation-results)))
;;; following can be replaced by setf when the defsetf is in place before
;;; entering this code!
;;;  (setf (fetch-example-info plan 'generatedform)
;;;	(generated-string nil))
    (replace-example-info plan 'generatedform first-string)
    (when store-to-environment-flag 
	  (replace-example-info plan 'structure *mouseable-sentences*))
    (values 
     (re-punctuate first-string)	; Added the re-punctuate, (WW Sept 8, 1995)
     generation-results))
  )