;;; -*- Mode:LISP; Readtable:CL; Base:10 -*-
;;; Flavors and functions that implement 'display menus'
;;; Display menus work about the same as dynamic item list menus,
;;; except they are normally in a quiescent state 'displaying' the current
;;; value of the chosen item.

;;; When you click on them, they display all the possible settings and let you
;;; choose one.

;;; They, like slider windows, change the value of a global variable.

;;; NIC sep 85


(defvar cant-change '(("Can't change this" :no-select t))
  "Menu-list for items that are display-only, and can't be changed.
Set item-list pointer to this.  Setting item-list-pointer to nil, or to a
symbol that is unbound will also make it impossible to change the value.
It is probably preferable to set it to nil.")

(defvar boolean '(("True" :value t) ("False" :value nil))
  "Menu-list for boolean items.
Set item-list-pointer to this.")

(defvar undefined '(("No other values are currently defined" :no-select t))
  "Menu-list to use until you make up your mind.
Set item-list-pointer to this.")


(defflavor display-menu
	   (the-var item-list-pointer)
	   (tv:window)
  (:documentation
    "Display menus display the current value of a global value and allow you to change it.")
  :gettable-instance-variables
  :settable-instance-variables
  :inittable-instance-variables
  (:default-init-plist
    :the-var 'foo
    :item-list-pointer nil
    :width 50
    :height 20
    :save-bits t
    :borders nil
    :label nil
    :blinker-p nil
    :font-map '(fonts:tr12b)))


(defmethod (display-menu :after :change-of-size-or-margins) (&rest ignore)
  (send self :set-the-var the-var))

(defmethod (display-menu :before :pane-size) (&rest ignore)
  (send self :change-of-size-or-margins))

(defmethod (display-menu :item-list-pointer) ()			;This avoids idiotic errors if item-list
  (if (boundp item-list-pointer) item-list-pointer nil))	;pointer is unbound

(defmethod (display-menu :set-the-var) (var)
  (proclaim `(special ,var))
  (or (boundp var) (set var ""))
  (if var (progn
	    (setf the-var var)
	    (tv:sheet-force-access (self)
	      (send self :clear-screen)
	      (send self :string-out-centered (format nil "~a" (eval the-var)))))))


(defmethod (display-menu :update) ()
  (send self :clear-screen)
  (send self :string-out-centered (format nil "~a" (eval the-var))))


(defmethod (display-menu :before :handle-mouse) ()
  (send self :set-reverse-video-p t))

(defmethod (display-menu :after :handle-mouse) ()
  (send self :set-reverse-video-p nil))

(defmethod (display-menu :who-line-documentation-string) ()
  (format nil "The current value of ~a.  ~a" the-var 
	  (if (send self :item-list-pointer)
	      "Click left for a menu of other possible values."
	    "Display only.")))

(defmethod (display-menu :mouse-buttons) (mask x y)
  x
  y							;never use x or y 
  (if (= mask 1)					;1 means left-mouse and only left-mouse
      (process-run-function				;do this in a sub-process 'cause we 
	'(:name "display-menu function" :priority 20.)	;don't wanna muck the mouse process
	'display-func self)
    (let ((buttons (tv:mouse-button-encode mask)))	;otherwise check for double-click right
      (if (= buttons #\mouse-3-2)
	  (tv:mouse-call-system-menu)			;and bring up sysmenu
	(send self :mouse-click buttons x y)))))

(defun display-func (menu)
	 (let ((the-var (send menu :the-var))
	       (item-list-pointer (symeval (send menu :item-list-pointer)))
	       val real-p x y)
	   (multiple-value-setq (x y)
	     (tv:sheet-calculate-offsets menu nil))
	 (multiple-value-setq (val real-p)
	   (tv:menu-choose item-list-pointer nil
			   `(:point ,(+ (/ (send menu :width) 2) x)	;coors of the center of the menu
				    ,(+ (/ (send menu :height) 2) y))
			   nil
			   ))
	 (if real-p (progn (set the-var val)
			   (send menu :update)))))

(defun disp-win (var &aux &special tr)
  (setf tr '("first" "second" "third"))
  (let ((disp-win (make-instance 'display-menu)))
    (send disp-win :set-item-list-pointer 'tr)
    (send disp-win :set-the-var var)
    (tv:expose-window-near disp-win '(:mouse))
    ;;return the menu created
    disp-win))

(compile-flavor-methods display-menu)