(defextern |←XMenuCreate|(external string) external)
(defextern |←XMenuAddPane|(external external fix) fix)
(defextern |←XMenuAddSelection|(external fix t external fix) fix)
(defextern |←XMenuInsertPane|(external fix external fix) fix)
(defextern |←XMenuInsertSelection|(external fix fix t external fix) fix)
;(defextern |←XMenuFindPane|(external string) fix)
;(defextern |←XMenuFindSelection|(external fix string) fix)
(defextern |←XMenuChangePane|(external fix external) fix)
(defextern |←XMenuChangeSelection|(external fix fix t fix external fix) fix)
(defextern |←XMenuSetPane|(external fix fix) fix)
(defextern |←XMenuSetSelection|(external fix fix fix) fix)
(defextern |←XMenuDeletePane|(external fix) fix)
(defextern |←XMenuDeleteSelection|(external fix fix) fix)
;(defextern |←XMenuRecompute|(external) fix)
;(defextern |←XMenuEventHandler|(external) fix)
(defextern |←XMenuLocate|(external fix fix fix fix t t t t) fix)
;(defextern |←XMenuSetFreeze|(external fix) fix)
(defextern |←XMenuActivate|(external t t fix fix fix t) fix)
(defextern |←XMenuDestroy|(external) fix)

(setq #:sys-package:colon 'menu)

(defstruct :x
    def  ; liste de (string cstring et liste de (string cstring value))
    (selection 0)
    (pane 0))

(unless (boundp ':x:all-menus)
	(defvar :x:all-menus ()))

(de #:bitmap:x:create-menu (menu)
    (let ((newmenu (:x:make))
          (extend (|←XMenuCreate| (|←rootwindow|) "lelisp")))
         (:extend newmenu extend)
	 (newl :x:all-menus newmenu)
         newmenu))

(de :x:kill-menu (menu)
    (mapc (lambda (l)
                  (|←free| (caddr l))
                  (mapc (lambda (def)
                                (|←free| (caddr def)))
                        (cdddr l)))
          (:x:def menu))
    (setq :x:all-menus (delq menu :x:all-menus))
    (|←XMenuDestroy| (:extend menu)))

(defvar :x:pane 0)
(defvar :x:selection 0)
(defvar :x:result 0)

(defvar :x:x-menu)
(defvar :x:y-menu)
(defvar :x:w-menu)
(defvar :x:h-menu)

(de :x:activate-menu (menu x y)
    (setq :x:selection (:x:selection menu))
    (setq :x:pane (:x:pane menu))
    (|←XMenuLocate| (:extend menu)
                    :x:pane :x:selection
                    x y
                    ':x:x-menu
                    ':x:y-menu
                    ':x:w-menu
                    ':x:h-menu)
    (setq :x:x-menu (or (fixp :x:x-menu) (cdr (loc :x:x-menu))))
    (setq :x:y-menu (or (fixp :x:y-menu) (cdr (loc :x:y-menu))))
    (setq x
          (max (add1 (sub x :x:x-menu))
               (min x (add (sub (bitxmax) :x:w-menu)
                           (sub x :x:x-menu)))))
    (setq y
          (max (add1 (sub y :x:y-menu))
               (min y (add (sub (bitymax) :x:h-menu)
                           (sub y :x:y-menu)))))
    (cond ((eqn (|←XMenuActivate| (:extend menu)
                    ':x:pane ':x:selection 
                    x y
                    #$ffff ':x:result)
                1)
           (:x:selection menu -1)
           (:x:pane menu :x:pane)
           menu
           :x:result)
          (t
            (:x:selection menu -1)
            (:x:pane menu 0)
            ())))

(de :x:menu-insert-item-list (menu choix name active)
    (setq name (string name))
    (let ((cname (|←cstring| name (slen name))))
      (or (and (eqn 0 choix)
	       (neqn -1 (|←XMenuInsertPane| (:extend menu) 
					    choix cname active)))
	  (|←XMenuAddPane| (:extend menu) cname active))
      (:x:def menu (nconc (firstn choix (:x:def menu))
			  (ncons (list name active cname))
			  (nthcdr choix (:x:def menu))))))

(de :x:menu-insert-item (menu choix item name active value)
    (setq name (string name))
    (let ((cname (|←cstring| name (slen name))))
      (or (and (eqn 0 item)
	       (neqn -1 (|←XMenuInsertSelection| (:extend menu)
						 choix item value
						 cname active)))
	  (|←XMenuAddSelection| (:extend menu) choix value cname active))
      (let ((ilist (nth choix (:x:def menu))))
	(rplacd (cddr ilist)
		(nconc (firstn item (cdddr ilist))
		       (ncons (list name active cname value))
		       (nthcdr item (cdddr ilist)))))))

(de :x:menu-delete-item-list (menu choix)
    (|←XMenuDeletePane| (:extend menu) choix)
; il manque un FREE des chaines C
    (:x:def menu (nconc (firstn choix (:x:def menu))
                      (nthcdr (add1 choix) (:x:def menu)))))

(de :x:menu-delete-item (menu choix item)
    (|←XMenuDeleteSelection| (:extend menu) choix item)
    (let ((ilist (nth choix (:x:def menu))))
         (rplacd (cddr ilist)
                 (nconc (firstn item (cdddr ilist))
                        (nthcdr (add1 item) (cdddr ilist))))))

(de :x:menu-modify-item-list (menu choix name active)
    (when name
	  (setq name (string name))
	  (let ((cname (|←cstring| name (slen name))))
	    (|←XMenuChangePane| (:extend menu) choix cname)
	    (rplaca (nth choix (:x:def menu)) name)
	    (rplaca (cddr (nth choix (:x:def menu))) cname)))
    (when active
	  (|←XMenuSetPane| (:extend menu) choix active)
	  (rplaca (cdr (nth choix (:x:def menu))) active))) 

(de :x:menu-modify-item (menu choix item name active value)
    (let (cname)
      (when name
	    (setq name (string name))
	    (setq cname (|←cstring| name (slen name)))
	    (|←XMenuChangeSelection| 
	     (:extend menu) 
	     choix
	     item
	     value 
	     (if value 1 0)
	     cname
	     (if name 1 0)))
      (when (or name value)
	    (let ((itemdef (nth item (cdddr (nth choix (:x:def menu))))))
	      (when name (rplaca itemdef name))
	      (when name (rplaca (cddr itemdef) cname))
	      (when value (rplaca (cdddr itemdef) value))))
      (when active
	    (let ((itemdef (nth item (cdddr (nth choix (:x:def menu))))))
	      (rplaca (cdr itemdef) active)
	      (|←XMenuSetSelection| (:extend menu) choix item active)))))

(de :x:rebuild-menu (menu)
    (let ((def (:x:def menu)))
      (:x:def menu ())
      (:extend menu (|←XMenuCreate| (|←rootwindow|) "lelisp"))
      (mapc (lambda (ilist)
	      (menu-insert-item-list menu 0 (car ilist) (cadr ilist))
	      (mapc (lambda (item)
		      (menu-insert-item menu 0 0 (car item) (cadr item)
					(cadddr item)))
		    (reverse (cdddr ilist))))
	    (reverse def))))