;;; Susan's patches for Penman
;;; This file contains:
;;;     a fix for capitals after quotes
;;;     a patch to produce proper infinitives
;;; Last saved in emacs: Time-stamp: <95/07/17 12:11:19 williams>

(in-package :penman)


;;;-------------------------------------------------------------------------
;;; Fix the problem of no capitals after quotes at start of sentence. -- WW
;;;-------------------------------------------------------------------------


(DEFUN Generated-string (&optional (print-results t))
  "Either prints the generated string(s) or returns the last generated string,
    depending if return-string-only is NIL or T"

  (let ((result nil))
    (dolist (one-ordering final-orderings)
	    (cond ((null (cdr one-ordering))
		   (setq result ">>>NULL ORDERING<<<"))
		  (t
		   (SETQ result (unify-string (cdr one-ordering)))
		   
;;; the following cross structural boundaries...
;;; maybe can be improved on since now we have the structure available...
		   (setq result (string-substitute "," " & *[*" result))
					; it is necessary to take account of
		   (setq result (string-substitute ""  "*[* " result))
					; structure in order to replace
		   (setq result (string-substitute "and" "&" result))
					; and's by commas in lists appropriately.
		   
;;; the following is global and only done once...
;;;	     (setf (char result 0) (char-upcase (char result 0)))	; capitalize first word.


;;; Slightly changed to account for quotes at start of sentence (WW, Feb7/95)	     
		   (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))

;;; 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))    ; remove excess spacing.
		   (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.
		   (remove-spaces-between-numerals-and-compass-points result)))	;destructive replacement    
	    
	    (when print-results
		  (printwindow :display-pane " ")
		  (printwindow :display-pane (indent-and-fill "Generated string:  "))
		  (printwindow :display-pane (indent-and-fill result))))
    (if print-results
	(values )
      (values result)
      )))

;;; Added Mar 17-95 (WW)
;;; Gets rid of space after initial quote and before final quote in string.
(defun nospaces-near-quotes (s)
  (let ((first (position #\" s :test #'char=)))
    (if first
	(let* ((second (position #\" s :test #'char= :start (1+ first)))
	       (s-prime (concatenate 'string
				     (subseq s 0 (1- second))
				     (subseq s second (length s)))))
	  (concatenate 'string
		       (subseq s-prime 0 (1+ first))
		       (subseq s-prime (+ 2 first) (length s-prime))))
      s)))


;;; This came from Richard Whitney during our visit to ISI, April, 1995.
;;; It allows us to have proper infinitives such as "I help you to decide."
(defun Projector-Time-ID-Code (projected)
  "Return the time of the projecting process."
  (or (fetch-feature 'reference-time-id (term-graph-parent (symbol-value projected)))
#-KPML      (term-graph-id (inquiry-operator-activedefault
		      (gethash 'reference-time-id quiry-operators)))
#+KPML      (term-graph-id (second (inquiry-operator-activedefault
		      (gethash 'reference-time-id quiry-operators))))))
