(in-package "KPML-I")

;;; File: options-selection.lisp
;;; New. John, Feb99

;;; Added to KPML as 2.0.58

;;; ----------------------------------------------------------------------
;;; Makes it clearer what the options are and why you may choose them.
;;; Assumes that the options are always going to be more experimental
;;; or to do with particular problems that arise on particular configurations
;;; and so are not worth really documenting in depth. Minidocumentation
;;; is therefore provided in the selection dialogue.
;;;
;;; Replaces KPML-I::SET-KPML-GLOBAL-OPTIONS from interface-root.lisp.
;;; ----------------------------------------------------------------------

(defvar *kpml-options*
    '(

;;; This variable holds the documentation and usage details thus:
;;;   (:name variable "short-description" "long-description" values)
;;; values is either left out, in which case it is equivalent to (nil T)
;;; or it provides values that are mapped from (nil T).

      #-lispworks
      (:graphical-selective kpml::*realize-selectively-mode* 
       "Graphical selective realization activated."
       "This option makes selective realization proceed graphically,
        presenting after each cycle through the grammar the structure
        built so far. The user may select from this structure the further
        nodes to be generated. Selective realization is activated from
        the Generation Modes menu." (:serial :graphical))
      (:gof *graphical-focusing-ops* "Graph object focusing activated." 
       "This option allows the linguistic objects to be operated on to
        be selected graphically. This is only relevant for the focusing
        on linguistic objects commands.")
      (:gfs *global-font-switching* "Global font switching."
       "UNIX: when set, this option means that all the fonts will change when a
        language variety with a specific font is used, and not just those
        in selected windows. Only sensible under Unix, since the Windows
        font treatment makes this unnecessary anyway.")
      (:careful-graphing *careful-graphing*
       "Careful network graphing activated."
       "This option makes the system network graphs be drawn more carefully.
        The graphs are generally better, but there still may be occasional
        problems when refreshing the graphs (for example, as is done after
        altering a system in the system editor). Can be activated for
        particular cases where the network has to look nice.

        Only recommended for simple monolingual graphs at present.

        If graphing breaks when in careful mode then return to the default
        graphing mode and send a bug report. If some connecting lines fail
        to get drawn, or are drawn in the wrong place, generally doing
        a regraph (click anywhere on blank space in the graph) will get them
        to come back.")
      (:careful-rs-editor kpml::*CAUTIOUS-RS-DIALOG-BOX-MODE*
       "Cautious realization statement editor on."
       "Under some Lisps and some Windows and some installations, the
        realization statement dialog box breaks. If you have this behaviour,
        try this extra cautious version. Alternatively, just check it
        out to compare.")))

;;; ----------------------------------------------------------------------
;;; Basic frame definition...
;;; ----------------------------------------------------------------------

(clim:define-application-frame KPML-OPTIONS-FRAME ()
  ( (current-option :initform nil) 
    (options :initform nil)
    )
  (:menu-bar T)
  (:top-level (clim:default-frame-top-level))
  (:command-table 
   (kpml-options-commands
    :menu
    (
     #-acl3.0 ("Quit" :command com-quit-options)
     ("Next" :command com-select-next-option)
     ("Select" :command com-select-option)
     ("Deselect" :command com-deselect-option))
    ))
  (:panes 
   (state        :application
		 :incremental-redisplay T
		 :display-after-commands T
		 :end-of-line-action :allow
		 :end-of-page-action :allow
		 :initial-cursor-visibility :inactive
		 :display-function 'option-state-displayer
		 :text-style *sans-serif--bold--10*
		 :scroll-bars :vertical)
   (description  :application
		 :incremental-redisplay T
		 :display-after-commands T
		 :end-of-line-action :allow
		 :end-of-page-action :allow
		 :initial-cursor-visibility :inactive
		 :display-function 'option-description-displayer
		 :text-style *sans-serif--bold--10*
		 :scroll-bars :vertical)
   (mouse-doc   :pointer-documentation
		:foreground  mouse-doc-fg
		:background  mouse-doc-bg))
  (:layouts (first 
	     (clim:vertically
		 ()
	       (#+lispworks 1/3 #-lispworks 100 state)
	       (:fill description)
	       (2/32 mouse-doc)))))


;;; ----------------------------------------------------------------------
;;; Display methods... ultra simple...
;;; ----------------------------------------------------------------------

(defmethod OPTION-DESCRIPTION-DISPLAYER
    ((frame kpml-options-frame) stream)
  (with-slots (current-option) frame
    (let ((option (assoc current-option *kpml-options*)))
      (format stream "~A" (fourth option))
      (clim:with-text-style
	  (stream *sans-serif--roman--9*)
	(if (boundp (second option))
	    (format stream 
		    "~2%Variable for inclusion in configuration file: `~S'"
		    (second option))
	  (format stream "~2%(not yet available)"))))))

(defmethod OPTION-STATE-DISPLAYER
    ((frame kpml-options-frame) stream)
  (with-slots (current-option) frame
    (clim:updating-output 
	(stream :cache-value (list current-option *kpml-options*))
      (clim:formatting-table (stream)
	(loop for o in *kpml-options*
	    as id = (first o)
	    as short = (third o)
	    as var = (second o)
	    when (boundp var)
	    do 
	      (clim:formatting-row (stream)
		(clim:formatting-cell (stream)
		  (clim:updating-output 
		      (stream :cache-value (equal current-option id))
		    (if (equal id current-option)
			(format stream "** ~A **" short)
		      (format stream   "    ~A " short))))
		(clim:formatting-cell (stream)
		  (clim:updating-output 
		      (stream :cache-value (symbol-value var))
		    (format stream "~A"  (symbol-value var))))))))))


;;; ----------------------------------------------------------------------
;;; Commands...
;;; ----------------------------------------------------------------------

#-acl3.0
(define-kpml-options-frame-command
    (com-QUIT-OPTIONS :name "Quit" :menu T)
    ()
  (close-a-window clim:*application-frame*)
  )

(define-kpml-options-frame-command
    (com-SELECT-NEXT-OPTION :name "Next option" :menu T)
    ()
  (with-slots (current-option) clim:*application-frame*
    (let* ((posn (position current-option kpml-i::*kpml-options* :key #'first))
	   (options-length (length kpml-i::*kpml-options*)))
      (setf posn (1+ posn))
      (when (>= posn options-length)
	(setf posn 0))
      (setf current-option
	(first (nth posn kpml-i::*kpml-options*)))
      (clim:redisplay-frame-pane 
       clim:*application-frame* 'description :force-p t)
      (clim:redisplay-frame-pane 
       clim:*application-frame* 'state :force-p nil))))


(define-kpml-options-frame-command
    (com-SELECT-OPTION :name "Select" :menu T)
    ()
  (with-slots (current-option) clim:*application-frame*
    (let* ((option (assoc current-option *kpml-options*))
	   (values (fifth option))
	   (range (if values values '(nil t)))
	   (id (second option)))
      (set id (second range))
      (clim:redisplay-frame-pane 
       clim:*application-frame* 'state :force-p nil))))

(define-kpml-options-frame-command
    (com-DESELECT-OPTION :name "Deselect" :menu T)
    ()
  (with-slots (current-option) clim:*application-frame*
    (let* ((option (assoc current-option *kpml-options*))
	   (values (fifth option))
	   (range (if values values '(nil t)))
	   (id (second option)))
      (set id (first range))
      (clim:redisplay-frame-pane 
       clim:*application-frame* 'state :force-p nil))))

;;; ----------------------------------------------------------------------
;;; startup...
;;; ----------------------------------------------------------------------

(defvar *options-frame* nil)

(defun SET-KPML-GLOBAL-OPTIONS ()
  (startup-kpml-options-frame))

(defun STARTUP-KPML-OPTIONS-FRAME (&optional (reset nil))
  #-acl3.0(when (and reset *options-frame*)
		(close-a-window *options-frame*)
		(setf *options-frame* nil))
  (let* ((frame (setf *options-frame*
		  (clim:make-application-frame
		   'kpml-options-frame
		   :pretty-name "Options (KPML)"
		   :left 100 :top 20
		   :width #-acl3.0 500 #+acl3.0 800 :height 400)))
         (dummy (setf (slot-value frame 'current-option) 
		  (first (first kpml-i::*kpml-options*))))
	 (process
	  (process-run-function "KPML-OPTIONS" 
				 #'run-packaged-frame
				 frame (find-package "KPML"))))
    (declare (ignore dummy))
    #-acl3.0(push (cons frame process) *frame-process-alist*)
    T))

