(in-package "KPML-I")

;;; File: extra-development-commands.lisp

;;; ----------------------------------------------------------------------
;;; Commands available in command interactor...
;;; User levels added (2.1)
;;; ----------------------------------------------------------------------

;;; Additional operations on systems
;;; (2.1 proper names used)

(define-kpml-resource-development-command 
  (com-PRINT-SYSTEM-RDC :name "Show the system")	      
  ((system 'system :gesture :select))
  (clim:raise-frame *resource-inspector-frame*)
  (kpml::describe-system system))

#+(and :kpml-level>= :kpml-l2)
(define-kpml-resource-development-command (com-DISABLE-SYSTEM-RDC :name "Disable system")
    ((system 'system :gesture :select))
  (kpml::disable-system system))

#+(and :kpml-level>= :kpml-l2)
(define-kpml-resource-development-command (com-ENABLE-SYSTEM-RDC :name "Enable system")
    ((system 'system :gesture :select))
  (kpml::enable-system system))

#+(and :kpml-level>= :kpml-l2)
(define-kpml-resource-development-command (com-TRACE-SYSTEM-RDC :name "Trace system")
    ((system 'system :gesture :select))
  (pushnew system kpml::*traced-systems*))

#+(and :kpml-level>= :kpml-l2)
(define-kpml-resource-development-command (com-UNTRACE-SYSTEM-RDC :name "Untrace system")
  ((system 'system :gesture :select))
  (setf kpml::*traced-systems* (remove system kpml::*traced-systems*)))


;;;
;;; Additional commands on inquiries...
;;;

#+(and :kpml-level>= :kpml-l2)
(define-kpml-resource-development-command (com-PAUSE-ON-INQUIRY :name t)
  ((inquiry 'inquiry :gesture :select))
  (pushnew inquiry kpml::*inquiries-to-pause-upon*))

#+(and :kpml-level>= :kpml-l2)
(define-kpml-resource-development-command (com-STOP-PAUSING-ON-INQUIRY :name t)
  ((inquiry 'inquiry :gesture :select))
  (setf kpml::*inquiries-to-pause-upon*
	(remove inquiry kpml::*inquiries-to-pause-upon*)))

;;; --------------------------------------------------------------------
;;; Operations on example names...

(define-kpml-resource-development-command (com-SAY-EXAMPLE :name t :menu nil)
  ((example-name 'example-name :gesture :select))
  #-acl3.0
  (setf *say-process*
	(cpc:make-process #'(lambda () (run-say-top-level example-name))
			  :name "say"))
  #+acl3.0
  (run-say-top-level example-name)
  )

#+(and :kpml-level>= :kpml-l2)
(define-kpml-resource-development-command 
  (com-RENAME-EXAMPLE :name t :menu nil)
  ((example-name 'example-name :gesture :select))
  (example-renamer example-name))

;;; ----------------------------------------------------------------------
;;; Following extra commands for examples copy those from inspection.lisp
;;; directly...
;;; 2.0 similarly updated...

(define-kpml-resource-development-command 
    (com-GRAPH-EXAMPLE-3 :name "Graph example structure" :menu nil)
    ((example-name 'example-name :gesture :select))
  (let* ((stream (clim:get-frame-pane *resource-development-frame* 'inspector))
	 (struct (kpml::fetch-example-info example-name 'kpml::structure)))
    (if struct
	(loop for s in (if (consp struct) struct
			 (list struct))
	    do (graph-example-structure s))
      (format stream "~%No stored structure for example: ~A" example-name))))

#+(and :kpml-level>= :kpml-l2)
(define-kpml-resource-development-command 
    (com-DISPLAY-STRING-OF-EXAMPLE-3 
     :name "Display generated string" :menu nil)
    ((example-name 'example-name :gesture :select))
  (let* ((stream (clim:get-frame-pane *resource-inspector-frame* 'inspector))
	 (str-2  
	  (clim:get-frame-pane *resource-development-frame* 'inspector))
	 (struct    (kpml::fetch-example-info example-name 'kpml::structure)))
    (if struct
	(progn
	  (format str-2 "~%Generated strings for example: ~A" example-name)
	  (loop for s in (if (consp struct) struct (list struct)) do 
		(kpml-i-terpri str-2)
		(mouseable-sentence-display s str-2))
	  (kpml-i-terpri str-2))
      (format stream "~%No stored structure for example: ~A" example-name))))



