(in-package :common-lisp-user)

;;; File: system-flags-acl.lsp
;;; John: Stirling: June 97.
;;;
;;; Provides the KPML system flag menus in PC-Windows native form from
;;; ACL-PC. Looks a bit better and can run concurrently with other
;;; Lisp processes....
 
(defvar *kpml-system-flags* nil)
 
;;; (Replaces version in ui-clim/substrate/kpml-system-flags.lisp)

(defun KPML::KPML-SYSTEM-FLAGS-MENU (&optional dummy)
  (declare (ignore dummy))
  (create-kpml-system-flag-menu))

;; Return the window, creating it the first time or when it's closed.
;; Use only this function if you need only one instance.
(defun create-kpml-system-flag-menu ()
   (if (windowp *kpml-system-flags*) *kpml-system-flags* 
      (setq *kpml-system-flags* (make-kpml-system-flags))))
 
;; Create an instance of the window.
;; Use this if you need more than one instance.
(defun make-kpml-system-flags (&key (parent *lisp-main-window*) 
                               (window-interior 
                                  (make-box 18 69 364 432))
                               (name "KPML system flags") 
                               (title "KPML system flags"))
  (let ((string-bracketting (not (string= kpml-i::*ol-bracketting* ""))))
    (setq *loaded-but-uncreated-windows* 
	  (delete 'kpml-system-flags *loaded-but-uncreated-windows*))
    (let (window-0 window-1 window-2 window-3 window-4)
      (setq window-0 
	    (open-dialog 
	     (list 
	      (make-dialog-item 
	       :widget 'single-item-list 
	       :name :single-item-list-1 
	       :title (delete #\Newline "Single Item List 1") 
	       :value kpml-i::*example-display-desired-mode*
	       :box (make-box 5 170 89 213) 
	       :tabstop t 
	       :groupstart t 
	       :key 'capitalize-object
	       :set-value-fn #'(lambda (widg new old)
				 (setf kpml-i::*example-display-desired-mode*
				       new))
	       :range kpml-i::*example-display-options*
	       :font (make-font-ex nil :arial 13 nil))
               (make-dialog-item 
                  :widget 'check-box 
                  :name :check-box-3 
                  :title 
                  (delete #\Newline 
                     "Restrict offered examples by language")
                  :value kpml::*restrict-example-running-by-language* 
		  :set-value-fn 
		  #'(lambda (widg new old)
		      (setf kpml::*restrict-example-running-by-language* new)
		      (values t nil))
                  :box (make-box 3 101 303 120) 
                  :tabstop nil 
                  :groupstart nil 
                  :font (make-font-ex nil :arial 13 '(:bold)) 
                  :tab-control nil)
               (make-dialog-item 
                  :widget 'static-text 
                  :name :static-text-4 
                  :title (delete #\Newline "Static Text 4") 
                  :value (delete #\Newline "Example menu shows...") 
                  :box (make-box 5 134 103 170) 
                  :tabstop nil 
                  :groupstart t 
                  :font (make-font-ex nil :arial 13 '(:bold)))
               (make-dialog-item 
                  :widget 'static-text 
                  :name :static-text-5 
                  :title (delete #\Newline "Static Text 4") 
                  :value 
                  (delete #\Newline "Example runner detail level...") 
                  :box (make-box 160 134 278 167) 
                  :tabstop nil 
                  :groupstart t 
                  :font (make-font-ex nil :arial 13 '(:bold)) 
                  :tab-control nil)
               (make-dialog-item 
                  :widget 'check-box 
                  :name :check-box-1 
                  :title 
                  (delete #\Newline 
                     "Display structure of generated examples")
                  :value kpml-i::*display-structures* 
		  :set-value-fn #'(lambda (widg new old)
				    (setf kpml-i::*display-structures* new)
				    (values t nil))
                  :box (make-box 3 9 303 28) 
                  :tabstop nil 
                  :groupstart nil 
                  :font (make-font-ex nil :arial 13 '(:bold)))
               (make-dialog-item 
                  :widget 'check-box 
                  :name :check-box-2 
                  :title 
                  (delete #\Newline 
                     "Display generated string constituency")
                  :value string-bracketting
		  :set-value-fn
		  #'(lambda (widg new old)
		      (setf string-bracketting new)
		      (if string-bracketting 
			  (setf kpml-i::*ol-bracketting* "(" 
				kpml-i::*or-bracketting* ")")
			(setf kpml-i::*ol-bracketting* "" 
			      kpml-i::*or-bracketting* ""))
		      (values t nil))
                  :box (make-box 3 31 303 50) 
                  :tabstop nil 
                  :groupstart nil 
                  :font (make-font-ex nil :arial 13 '(:bold)) 
                  :tab-control nil)
               (make-dialog-item 
                  :widget 'check-box 
                  :name :check-box-4 
                  :title 
                  (delete #\Newline 
                     "Acquire previously unknown lexical items")
                  :value kpml::*acquire-lexical-items-mode* 
                  :box (make-box 3 63 303 82) 
		  :set-value-fn #'(lambda (widg new old)
				    (setf kpml::*acquire-lexical-items-mode* new)
				    (values t nil))
                  :tabstop nil 
                  :groupstart nil 
                  :font (make-font-ex nil :arial 13 '(:bold)) 
                  :tab-control nil)
               (make-dialog-item 
                  :widget 'static-text 
                  :name :static-text-6 
                  :title (delete #\Newline "Static Text 4") 
                  :value (delete #\Newline "Activated pop-ups...") 
                  :box (make-box 3 265 132 284) 
                  :tabstop nil 
                  :groupstart t 
                  :font (make-font-ex nil :arial 13 '(:bold)) 
                  :tab-control nil)
               (make-dialog-item 
                  :widget 'multi-item-list 
                  :name :multi-item-list-3 
                  :title (delete #\Newline "Multi Item List 3") 
                  :value kpml::*pop-ups*
                  :box (make-box 160 265 288 342) 
		  :set-value-fn #'(lambda (widg new old)
				    (setf kpml::*pop-ups* new))
                  :tabstop t 
                  :groupstart t 
                  :key 'capitalize-object 
                  :range 'kpml::*possible-pop-ups*
                  :font (make-font-ex nil :arial 13 nil))
               (make-dialog-item 
                  :widget 'single-item-list 
                  :name :single-item-list-2 
                  :title (delete #\Newline "Single Item List 1") 
                  :value kpml::*example-running-detail-level*
                  :box (make-box 160 170 240 242) 
		  :set-value-fn #'(lambda (widg new old)
				    (setf kpml::*example-running-detail-level*
					  new)
				    (values t nil))
                  :tabstop t 
                  :groupstart t 
                  :key 'capitalize-object 
                  :range kpml::*example-running-options*
                  :font (make-font-ex nil :arial 13 nil) 
                  :tab-control nil))
            'dialog parent 
            :name name 
            :title title 
            :font (make-font :swiss :system 16 '(:bold)) 
            :window-state :shrunk 
            :window-border :frame 
            :left-attachment nil 
            :top-attachment nil 
            :right-attachment nil 
            :bottom-attachment nil 
            :user-movable t 
            :user-resizable t 
            :user-closable t 
            :user-shrinkable t 
            :user-scrollable nil 
            :overlapped nil 
            :background-color light-gray 
            :pop-up-p nil 
            :window-interior window-interior))
      (setf (window-editable-p window-0) nil)
      (setf (getf (stream-plist window-0) :path) "")
      (setf (getf (stream-plist window-0) :startup-state) nil)
      (setf (getf (stream-plist window-0) :top-level-p) T)
      (setf (help-string window-0) (delete #\Newline nil))
      (setf (getf (stream-plist window-0) :package) nil)
      nil
      (let* ((box (getf *window-exteriors* (object-name window-0))))
         (when box (reshape-window-exterior window-0 box)))
      (show-window window-0 nil)
      window-0)))
(unless (windowp *kpml-system-flags*) 
	(pushnew 'kpml-system-flags *loaded-but-uncreated-windows*))
