(in-package "KPML")

;;; File: object-descriptions.lisp
;;;

;;;;--------------------------------------------------------
;;;;            KPML-PACKAGE SPECIFIC DISPLAY FNS
;;;;--------------------------------------------------------

;;; 0.9:
;;; The following functions arrange for the mouse-sensitive
;;; display of linguistic objects in the inspector frame.
;;; As of KPML 0.9, the previous functions are completely
;;; replaced with code using the new KPML (0.8) generic
;;; systemic display function. The old functionality was
;;; to simply send an internal definition form (i.e., a
;;; lisp expression), the name, and the stream (usually the inspector
;;; pane) back to kpml-i::pen-pprint-for-clim. Sending
;;; a definition to the sensitizer is now inside the presentation
;;; handler function supplied as argument to the generic
;;; display function. This makes all the checking for multilingual
;;; modes, etc. in 0.8 redundent, since this is already integrated
;;; in the generic display functions.

;;; These functions occasionally give further information concerning
;;; their arguments, and so have more of the flavor of the Lisp
;;; display function than of the straight print-Object Penman-style
;;; functions. This is done using the old pen-pprint-for-clim
;;; function as before: so this needs to be kept in mind with
;;; any update/replacement of this function.

;;; 0.9: the functions of ml-compatibility-pretty-printing (0.8)
;;; *are no longer used*.
;;; The old pretty printing functions (window-interface/pretty-printing.lisp, 
;;; etc.) are no longer used. The generic pretty printing provided in 
;;; KPML (generic-systemic-display.lisp) is now folded in directly,
;;; making the old Penman display functions redundent: these older
;;; functions are therefore *no longer included* in KPML releases.

;;; The question remains to what extent the displaying process can
;;; can be speeded up...

;;; Added goody, when *pop-ups* set we get extra pop up windows with
;;; definitions...

(defun DESCRIBE-SYSTEM (system)
  (let ((*tty-right-margin* (inspection-char-width)))
    (if (member :systems *pop-ups*) ;; 1.1
	(kpml-i::create-a-system-editing-graph system)
      (systemic-display system :object-type :system
			      :stream :interface
			      :presentation-handler 
			      #'kpml-mouse-sensitive-pp))))

;;; 2.1 may now be restriced to the generation information for a given constituent...
;;;     following variable is bound special when we pop up a selection expression
;;;     from the structure grapher...
(defvar *node-origin* nil)

(defun DESCRIBE-CHOOSER (chooser &key (for-constituent *node-origin*))
  (let ((*tty-right-margin* (inspection-char-width)))
    (setf for-constituent (if (slot-exists-p clim:*application-frame* 'kpml-i::origin)
                              (slot-value clim:*application-frame* 'kpml-i::origin)
                            for-constituent))
    (if (member :choosers *pop-ups*)
	(case *ml-display-mode*
	  (:monolingual (kpml-i::create-a-chooser-graph chooser for-constituent))
	  (:contrastive 
	   (dolist (curlan (if *languages-in-focus* *languages-in-focus*
			     all_languages))
	     (kpml-i::create-a-chooser-graph chooser for-constituent)))
	  (otherwise
	   (systemic-display chooser :object-type :chooser
			     :stream :interface
			     :presentation-handler 
			     #'kpml-mouse-sensitive-pp)))
      (systemic-display chooser :object-type :chooser
			     :stream :interface
			     :presentation-handler 
			     #'kpml-mouse-sensitive-pp))))

(defun DESCRIBE-INQUIRY (inquiry)
  (let ((stream
	 (clim:get-frame-pane kpml-i::*resource-inspector-frame* 
			      'kpml-i::inspector))
	(*tty-right-margin* (inspection-char-width)))

    (setf inquiry (find-symbol (string inquiry) "KPML"))
    (if (who-can-inquire inquiry)
	(progn
	  (format stream "~%Inquiry ~A is used in choosers:" inquiry)
	  (kpml-i::pen-pprint-for-clim 
	   (who-can-inquire inquiry) nil stream))
      (format stream 
	      "~%Inquiry ~A is NOT USED in the currently loaded grammar!"
	      inquiry))
    
    (if (gethash inquiry quiry-operators)
	(systemic-display inquiry :object-type :inquiry
			  :stream :interface
			  :presentation-handler 
			  #'kpml-mouse-sensitive-pp)
      (format stream "~%Inquiry ~A has NOT BEEN DEFINED." inquiry))))

(defun DESCRIBE-FEATURE (feature)
  (let ((stream
	 (clim:get-frame-pane 
	  kpml-i::*resource-inspector-frame* 'kpml-i::inspector)))

    (if (eq *ml-display-mode* :monolingual)
	(describe-feature-for-language curlan feature stream)
      (dolist (lg (if *languages-in-focus* *languages-in-focus*
			 all_languages))
	(format stream "~2%Language: ~A " (string lg))
	(describe-feature-for-language lg feature stream)))))

(defun DESCRIBE-FEATURE-FOR-LANGUAGE (curlan feature stream)
  (kpml-i::pen-pprint-for-clim
     (format nil "~%Systems with ~a as input:" feature)
     ':string 
     stream)
    (kpml-i::pen-pprint-for-clim (who-has-as-input feature) 
				 ':systems stream)
    (kpml-i::pen-pprint-for-clim
     (format nil "~%Systems with ~a as output:" feature)
     ':string 
     stream)
    (kpml-i::pen-pprint-for-clim (who-has-as-output feature) 
				 ':systems stream))

(defun DESCRIBE-LEX-ITEM (term)
  (let ((*tty-right-margin* (inspection-char-width)))
    (systemic-display term :object-type :lexeme
		      :stream :interface
		      :presentation-handler 
		      #'kpml-mouse-sensitive-pp)))



;;; No generic function for the following!  Is this what is meant?
;;; Note, that there *is* code for example displaying...
;;; 2.1 type checks added for robustness...

(defun DESCRIBE-SPL-TERM (term)
  (let ((stream
	 (clim:get-frame-pane 
	  kpml-i::*resource-inspector-frame* 'kpml-i::inspector)))
    (unless (eq *ml-display-mode* :monolingual)
	    (message "Multilingual display modes for SPL not present!"))
    (when (numberp term)
      (format stream "~%This term is simply the number: ~A" term)
      (return-from describe-spl-term nil))
    (kpml-i-terpri stream)
    (clim:with-text-style (stream kpml-i::*fix--bold--10*)
      (if (and (symbolp term)
               (boundp term))
          (cond ((and (term-graph-p (symbol-value term))
		      (eq (term-graph-type (symbol-value term)) 'um-set))
	         (kpml-i::pen-pprint-for-clim 
	          (term-graph-symbol (symbol-value term)) nil stream))
	        (t
	         (kpml-i::pen-pprint-for-clim (symbol-value term) term stream)))
        (format stream "~%Unbound symbol: ~A" term)))))


;;; ----------------------------------------------------------------------
;;; Genericized KB inspection...

;;; 4.0 following function was a bit clumsy with respect to
;;;     whether it was getting concepts or names of concepts;
;;;     this was somehow getting through with Loom3. Cleaned
;;;     up and made properly typed here.
;;;
;;;     kb-generate-source-definition : concept -> definition
;;;     kb-getnamedconcept : name -> concept
;;;

(defun DESCRIBE-CONCEPT-OR-RELATION (kr type)
  (let ((stream
	 (clim:get-frame-pane 
	  kpml-i::*resource-inspector-frame* 'kpml-i::inspector))
	(def (kb-generate-source-definition
	      (if (symbolp kr)
		  (kb-getnamedconcept kr)
		kr))))
    (declare (ignore type))
    (if def
	(print def stream)
      (format stream "~%No definition for ~A printable." kr))))



;;; ----------------------------------------------------------------------
;;; Support functions for the above...

(defun INSPECTION-CHAR-WIDTH ()
  (floor
   (/
    (clim:bounding-rectangle-width 
     (clim:window-viewport 
      (clim:get-frame-pane 
       kpml-i::*resource-inspector-frame* 'kpml-i::inspector)))
    7.0)))

(defun KPML-MOUSE-SENSITIVE-PP (object-as-string object-type)
  (let ((output-stream (clim:get-frame-pane 
			kpml-i::*resource-inspector-frame* 
			'kpml-i::inspector)))
    (if *displaying-patched-object*
	(clim:with-text-face (output-stream :italic)
	  (kpml-mouse-sensitive-pp-intern 
	   output-stream object-as-string object-type))
      (kpml-mouse-sensitive-pp-intern 
       output-stream object-as-string object-type))))


(defun KPML-MOUSE-SENSITIVE-PP-INTERN 
    (output-stream object-as-string object-type)
;;   (declare (optimize (speed 3)(safety 0)))
    (cond ((eq object-type :string)
	   (clim:with-output-as-presentation
	    (output-stream object-as-string 'string)
	    (format output-stream "~%~a " object-as-string)))
	  (t
	   (with-input-from-string
	    (ss object-as-string)
	    (kpml-i-terpri output-stream)
	    (loop for input = (read-line ss nil nil)
		  then (read-line ss nil nil)
		  while input do
		  (progn
		    (kpml-i-terpri output-stream)
		    (case object-type
			  ((kpml::term-graph kpml::example)
			   (kpml-i::read-and-print-spl-line input 
								output-stream))
			  (otherwise
			   (kpml-i::read-and-print-pen-line 
			    input output-stream)))))))))


