(in-package "KPML")

;;; File: punctuation.lisp
;;;
;;; Originally added: KPML-0.8
;;;                   March 1995, John Bateman.
;;;                   IPSI.
;;;
;;;----------------------------------------------------------------------
;;; Here we replace the Penman-style of setting punctuation for
;;; generated strings  by a definition macro that is also 
;;; aware of the possibility of mulitilingual divergences in 
;;; such punctuation.
;;;
;;; Old punctuation definitions will continue to work with KPML 0.8+,
;;; although they have the side-effect that any multilingual
;;; information is lost.  KPML resources Release 3 and above have the
;;; new punctuation definitions in place.
;;;
;;; Code here is modelled exactly on ml-default-orderings.lisp. Could
;;; maybe be parameterized one fine day.
;;;----------------------------------------------------------------------

;;; 4.0 pre-Self punctuation added
;;; 2.0 further extension allows
;;;     a punctuating method to be called on a particular unit that
;;;     has the appropriate grammatical function and/or selection
;;;     expression members. Typical methods will be: 
;;;         kpml-upcase
;;;         kpml-downcase
;;;         kpml-capitalize
;;;
;;;     These work by calling a function of the same name to provide
;;;     a modified word-order list entry...
#||

An example rule would be:

(define-post-self-punctuation :language :ENGLISH
  :punctuation-rules '((WORDS * " ") 
		       (INDIVIDUAL-NAME * upcase)
		       (INTERROGATIVE PROJECTED "?")
		       ...))

Realized by:

(defun UPCASE (x)
  (string-modifying-punctuation wol 'string-upcase))

||#

;;; ----------------------------------------------------------------------

(defmacro DEFINE-PRE-PUNCTUATION 
  (&key (language nil)(punctuation-rules nil))
  (if (and language punctuation-rules)
      `(merge-in-pre-punctuation ,language ,punctuation-rules)
    (warning "Ill-formed punctuation (pre-) definition!")))

(defmacro DEFINE-POST-PUNCTUATION 
  (&key (language nil)(punctuation-rules nil))
  (if (and language punctuation-rules)
      `(merge-in-post-punctuation ,language ,punctuation-rules)
    (warning "Ill-formed punctuation (post-) definition!")))

(defmacro DEFINE-POST-SELF-PUNCTUATION 
  (&key (language nil)(punctuation-rules nil))
  (if (and language punctuation-rules)
      `(merge-in-post-self-punctuation ,language ,punctuation-rules)
    (warning "Ill-formed punctuation (post-self) definition!")))

;; 4.0
(defmacro DEFINE-PRE-SELF-PUNCTUATION 
  (&key (language nil)(punctuation-rules nil))
  (if (and language punctuation-rules)
      `(merge-in-pre-self-punctuation ,language ,punctuation-rules)
    (warning "Ill-formed punctuation (pre-self) definition!")))

;;; The structure of the value of the global variables
;;; *PRE-PUNCTUATION*, *POST-PUNCTUATION* and *POST-SELF-PUNCTUATION*
;;; are now changed so that they consists of a cons. The car of the
;;; cons is the symbol :multilingual; this enables KPML to recognize
;;; whether it has a KPML-style punctuation definitions, or a
;;; Penman-style one. The cdr of the cons is a simple association list
;;; of pairs, where the first element of each pair denotes a language,
;;; and the second element is the old Penman-style list of punctuation
;;; rules. No multilingual conditionalization is allowed within
;;; elements. If at some time this seems useful, it can be put in.

(defun MERGE-IN-PRE-PUNCTUATION (lg punctuation)
  (setf *pre-punctuation*
	(merge-in-punctuation lg punctuation *pre-punctuation*)))

(defun MERGE-IN-POST-PUNCTUATION (lg punctuation)
  (setf *post-punctuation*
	(merge-in-punctuation lg punctuation *post-punctuation*)))

(defun MERGE-IN-POST-SELF-PUNCTUATION (lg punctuation)
  (setf *post-self-punctuation*
	(merge-in-punctuation lg punctuation *post-self-punctuation*)))

;; 4.0
(defun MERGE-IN-PRE-SELF-PUNCTUATION (lg punctuation)
  (setf *pre-self-punctuation*
	(merge-in-punctuation lg punctuation *pre-self-punctuation*)))

;;; ----------------------------------------------------------------------

(defun MERGE-IN-PUNCTUATION 
  (lg ml-punctuation-fragments punctuation-rules-list)
  (cond ((eq (car punctuation-rules-list) :multilingual)
	 (let ((modified-punctuation-lists nil)
	       (consumed nil))
	   (loop for lg-defaults in (cdr punctuation-rules-list)
		 do
		 (cond ((eq (car lg-defaults) lg)
			(push (list lg ml-punctuation-fragments)
			      modified-punctuation-lists)
			(warning "Pre/Post/Pre-self/Post-self Punctuation for language "
				 lg 
				 " being updated.")
			(setf consumed t))
		       (t
			(push lg-defaults modified-punctuation-lists))))
	   (unless consumed (push (list lg ml-punctuation-fragments)
				  modified-punctuation-lists))
	   (setf punctuation-rules-list 
		 (cons :multilingual
		       modified-punctuation-lists))))
	(t
	 (when punctuation-rules-list
	       (warning "Multilingual punctuation for language "
			lg " is being attempted although previously a non-multilingual set of punctation rules had been loaded; new definition wins, old
ones are lost."))
	 (setf punctuation-rules-list 
		 (cons :multilingual
		       (list (list lg ml-punctuation-fragments)))))))


;;;
;;; Function calls to replace previous monolingual references to
;;; the punctuation variables...
;;;

(defun ML-PRE-PUNCTUATION ()
  (if (eq (car *pre-punctuation*) :multilingual)
      (second (assoc curlan (cdr *pre-punctuation*)))
    *pre-punctuation*))

(defun ML-POST-PUNCTUATION ()
  (if (eq (car *POST-punctuation*) :multilingual)
      (second (assoc curlan (cdr *POST-punctuation*)))
    *POST-punctuation*))

(defun ML-POST-SELF-PUNCTUATION ()
  (if (eq (car *POST-SELF-punctuation*) :multilingual)
      (second (assoc curlan (cdr *POST-SELF-punctuation*)))
    *POST-SELF-punctuation*))

;;; 4.0: added on the model of the above
(defun ML-PRE-SELF-PUNCTUATION ()
  (if (eq (car *POST-SELF-punctuation*) :multilingual)
      (second (assoc curlan (cdr *pre-self-punctuation*)))
    *pre-SELF-punctuation*))


;;;
;;; Finally, provide for straightforward conversion to KPML form.
;;; Following function is called when KPML is called on to output
;;; some version of the punctuation-rules and there is no
;;; multilingual-conform loaded. Provides conversion. 
;;;

(defun MAKE-KPML-CONFORMING-PUNCTUATION-RULES ()
  (warning "Previously nonmultilingual punctuation rule sets are now being forcibly updated to be multilingually conform and defined for language: " curlan ".")
  (setf *pre-punctuation*
	`(:multilingual (,curlan ,*pre-punctuation*)))
  (setf *post-punctuation*
	`(:multilingual (,curlan ,*post-punctuation*)))
  (setf *post-self-punctuation*
	`(:multilingual (,curlan ,*post-self-punctuation*)))
  ;; 4.0 added, although they can't be any older resources using this
  ;;     feature as it is new. Added for general consistency
  ;;     of behaviour in any case...
  (setf *pre-self-punctuation*
	`(:multilingual (,curlan ,*pre-self-punctuation*))))

