;;; xwem-tabbing.el --- Tabs in XWEM frames.

;; Copyright (C) 2003 by Free Software Foundation, Inc.

;; Author: Zajcev Evgeny <zevlg@yandex.ru>
;; Created: Sun Dec  7 18:35:15 MSK 2003
;; Keywords: xwem, xlib
;; X-CVS: $Id: xwem-tabbing.el,v 1.2 2004/05/05 22:43:06 lg Exp $

;; This file is part of XWEM.

;; XWEM is free software; you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; XWEM is distributed in the hope that it will be useful, but WITHOUT
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
;; License for more details.

;; You should have received a copy of the GNU General Public License
;; along with XEmacs; see the file COPYING.  If not, write to the Free
;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
;; 02111-1307, USA.

;;; Synched up with: Not in FSF

;;; Commentary:

;; Tab format may contain one of escape seqs:
;;   %n - Client's name (WM_NAME)
;;   %c - Client's class instance (WM_CLASS)
;;   %C - Client's class name (WM_CLASS)
;;   %i - Client's icon
;;   %u - Client's uptime
;;   %U - Cilent's Uptime
;;   %s - Client's size in pixels
;;   %S - Client's size in units
;;   %f - Client's Frame number
;;   %* - "*" when client marked and "-" when not.
;;   %# - "#" when client support WM_DELETE and "-" when not.

;;   %{ - starts emacs lisp
;;   %} - ends emacs lisp

;; Note that while running elisp within %{ and %} symbol `cl' refers
;; to client.

;; Also `X-use-queryfont' is highly recommended to be `t' if you are
;; using this file.

;;; Code:


(defconst xwem-tab-states
  '(xwem-face-tab-selected-active
    xwem-face-tab-selected-passive
    xwem-face-tab-nonselected-active 
    xwem-face-tab-nonselected-passive)
  "List of all tab items states. Actually face names.")

(defgroup xwem-tab nil
  "Group to customize tabs."
  :prefix "xwem-tab-"
  :prefix "xwem-face-"
  :group 'xwem)

;;;###autoload
(defcustom xwem-tab-default-format " %i %*%# %n"
  "*Default format for tab item."
  :type 'string
  :group 'xwem-tab)

(defcustom xwem-tab-formats-alist
  '(([".*" ".*" ".*"] . "%i %n"))
  "Alist of formats for tab items."
  :type '(repeat (cons (sexp :tag "Name/Class spec")
                       (sexp :tag "Tab format")))
  :group 'xwem-tab)

(defcustom xwem-tab-delim-interval 2
  "*Number of clients to group, will draw largeer delimeter."
  :type 'number
  :group 'xwem-tab)

(defcustom xwem-tab-empty-name "<empty>"
  "What to show when there no client."
  :type 'string
  :group 'xwem-tab)

(defcustom xwem-tab-show-cl-info-on-click t
  "*Non-nil mean show client info when `xwem-tabber-switch-cl' called."
  :type 'boolean
  :group 'xwem-tab)

(defface xwem-face-tab-selected-active
  `((t (:foreground "white" :background "green4" :bold t)))
  "*Face used to draw active tab item in selected frame.."
  :group 'xwem-tab
  :group 'xwem-faces)

(defface xwem-face-tab-selected-passive
  `((t (:foreground "black" :background "gray60")))
  "*Face used to draw passive tab item in selected frame."
  :group 'xwem-tab
  :group 'xwem-faces)

(defface xwem-face-tab-nonselected-active
  `((t (:foreground "gray80" :background "DarkGreen" :bold t)))
  "*Face used to draw active tab item in non-selected frame."
  :group 'xwem-tab
  :group 'xwem-faces)

(defface xwem-face-tab-nonselected-passive
  `((t (:foreground "black" :background "gray40")))
  "*Face used to draw passibe tab item in non-selected frame."
  :group 'xwem-tab
  :group 'xwem-faces)

(defvar xwem-tabber-map
  (let ((map (make-sparse-keymap)))
    (define-key map [button1] 'xwem-tabber-switch-cl)
    (define-key map [button3] 'xwem-tabber-popup-cl-menu)
    map)
  "Keymap used when accessing `xwem-tabber'.")

(defvar xwem-tabber-click-titem nil
  "Will be binded to tab item when tabber clicked.")
(defvar xwem-tabber-click-frame nil
  "Will be binded to frame when tabber clicked.")
(defvar xwem-tabber-click-cl nil
  "Will be binded to cl when tabber clicked.")


;;; Structures
;;;###autoload
(defstruct xwem-tab-item
  type					; type of tab one of 'header, 'tailer, 'normal etc
;  tabber				; xwem-tabber
  state
  rect					; X-Rect
  (delim-width 0)			; Width of delimiter

  cl					; xwem-cl
  format)				; Tab item format

;;;###autoload
(defstruct xwem-tabber
  frame					; xwem-frame, our parent
  xwin					; X-Win
  xpreparer				; X-Pixmap to prepare tab items
  xgeom
  
  state					; Global state of all tab items in tab-items field
  empty-tabi                            ; empty tab item
  header-tabis				; Header tab items
  tailer-tabis				; Tailing tab items

  tab-items				; list of xwem-tab-item
  plist                                 ; props list
  )


;;; Internal variables
(defvar xwem-tabi-sa-gc nil "Internal variable, do not modify.")
(defvar xwem-tabi-sp-gc nil "Internal variable, do not modify.")
(defvar xwem-tabi-na-gc nil "Internal variable, do not modify.")
(defvar xwem-tabi-np-gc nil "Internal variable, do not modify.")

;; Additional GC's
(defvar xwem-tabber-gc1 nil "Additional GC number 1.")
(defvar xwem-tabber-gc2 nil "Additional GC number 2.")
(defvar xwem-tabber-gc3 nil "Additional GC number 3.")
(defvar xwem-tabber-gc4 nil "Additional GC number 4.")
(defvar xwem-tabber-gc5 nil "Additional GC number 5.")
(defvar xwem-tabber-gc6 nil "Additional GC number 6.")
(defvar xwem-tabber-gc7 nil "Additional GC number 7.")
(defvar xwem-tabber-gc8 nil "Additional GC number 8.")
(defvar xwem-tabber-gc9 nil "Additional GC number 9.")


;;; Functions

(defsubst xwem-tabber-put-prop (tabber prop val)
  (setf (xwem-tabber-plist tabber) (plist-put (xwem-tabber-plist tabber) prop val)))
(put 'xwem-tabber-put-prop 'lisp-indent-function 2)

(defsubst xwem-tabber-get-prop (tabber prop)
  (plist-get (xwem-tabber-plist tabber) prop))

;;;###autoload
(defun xwem-init-tabber ()
  "Initialize tabbing."
  (xwem-message 'info "Initializing tabbing ...")

  ;; Frame hooks
  (add-hook 'xwem-frame-resize-hook 'xwem-tabber-on-frame-resize)
  (add-hook 'xwem-frame-redraw-hook 'xwem-tabber-on-frame-redraw)
  (add-hook 'xwem-frame-creation-hook 'xwem-tabber-on-frame-creation)

  ;; Window hooks
  (add-hook 'xwem-win-switch-hook 'xwem-tabber-on-win-switch)
  (add-hook 'xwem-win-clients-change-hook 'xwem-tabber-on-win-change)

  ;; Client hooks
  (add-hook 'xwem-cl-create-hook 'xwem-tabber-on-cl-creation)
  (add-hook 'xwem-cl-destroy-hook 'xwem-tabber-on-cl-destroy)

  (add-hook 'xwem-cl-state-change-hook 'xwem-tabber-on-cl-change)
;  (add-hook 'xwem-cl-manage-hook 'xwem-tabber-on-cl-change)
;  (add-hook 'xwem-cl-demanage-hook 'xwem-tabber-on-cl-change)
  (add-hook 'xwem-cl-wmname-change-hooks 'xwem-tabber-on-cl-change)
  (add-hook 'xwem-cl-mark-hook 'xwem-tabber-on-cl-change)
  )

;;;###autoload(autoload 'xwem-tabber-switch-cl "xwem-tabber" "" t)
(define-xwem-command xwem-tabber-switch-cl ()
  "Switch to client which tab item was clicked."
  (xwem-interactive)

  (when (xwem-cl-alive-p xwem-tabber-click-cl)
    (xwem-manda-manage xwem-tabber-click-cl (xwem-cl-win xwem-tabber-click-cl))

    (when xwem-tab-show-cl-info-on-click
      (xwem-client-info xwem-tabber-click-cl))
    ))

;;;###autoload(autoload 'xwem-tabber-popup-cl-menu "xwem-tabber" "" t)
(define-xwem-command xwem-tabber-popup-cl-menu ()
  "Popup clients menu."
  (xwem-interactive)

  (when (xwem-cl-alive-p xwem-tabber-click-cl)
    (xwem-popup-menu (xwem-gen-cl-menu xwem-tabber-click-cl))
    ))

(defun xwem-tabber-event-handler (xdpy xwin xev)
  "On display XDPY and window XWIN handle event XEV."
  (let ((tabber (X-Win-get-prop xwin 'xwem-tabber)))
    (when (xwem-tabber-p tabber)
      (X-Event-CASE xev
	(:X-Expose
	 (when (eq (xwem-frame-state (xwem-tabber-frame tabber)) 'mapped)
	   (xwem-tabber-draw tabber))
	 )

	(:X-DestroyNotify
	 (X-invalidate-cl-struct tabber))

        ((:X-ButtonPress :X-ButtonRelease)
         ;; Handle button press/release event
         (let* ((x (X-Event-xbutton-event-x xev))
                (y (X-Event-xbutton-event-y xev))
                (xwem-tabber-click-frame (xwem-tabber-frame tabber))
                (xwem-tabber-click-titem
                 (xwem-tabber-item-at (xwem-frame-selwin xwem-tabber-click-frame) x y tabber))
                (xwem-tabber-click-cl (and (xwem-tab-item-p xwem-tabber-click-titem)
                                           (xwem-tab-item-cl xwem-tabber-click-titem)))
                (xwem-keyboard-echo-keystrokes nil) ; XXX
                (xwem-override-global-map xwem-tabber-map))

           (xwem-kbd-handle-keybutton xev)))
        ))))

;;;###autoload
(defun xwem-tabber-create (frame geom initial-state)
  "Create new tabber for FRAME with GEOM and INITIAL-STATE."
  (let ((xft (make-xwem-tabber :frame frame
			       :xgeom geom
			       :state initial-state))
	(xdpy (xwem-dpy))
	w preparer)
    (setq w (XCreateWindow xdpy
			   (xwem-frame-xwin frame)
			   (X-Geom-x geom) (X-Geom-y geom)
			   (X-Geom-width geom) (X-Geom-height geom)
			   (X-Geom-border-width geom)
			   nil nil nil;X-InputOutput nil
			   (make-X-Attr :background-pixel (XWhitePixel (xwem-dpy))
                                        :backing-store X-WhenMapped
                                        )))
    (setf (xwem-tabber-xwin xft) w)
    (X-Win-put-prop w 'xwem-tabber xft)

    (XSelectInput xdpy w (Xmask-or XM-Exposure XM-StructureNotify XM-ButtonPress XM-ButtonRelease XM-ButtonMotion))
    (X-Win-EventHandler-add w 'xwem-tabber-event-handler 0
                            (list X-Expose X-DestroyNotify X-ButtonPress X-ButtonRelease X-MotionNotify))

    (setq preparer (XCreatePixmap xdpy (make-X-Pixmap :dpy xdpy :id (X-Dpy-get-id xdpy))
				  w (XDefaultDepth xdpy) (X-Geom-width geom) (X-Geom-height geom)))

    (setf (xwem-tabber-xpreparer xft) preparer)

    (XMapWindow (X-Win-dpy w) w)
    xft))

(defun xwem-tabber-add-tab-item (tabber tab-item)
  "Into TABBER tab items list add TAB-ITEM."
  (pushnew tab-item (xwem-tabber-tab-items tabber)))

(defun xwem-tabber-item-at (win x y &optional tabber)
  "Return tab item at X Y in tabber."
  (let ((cls (xwem-win-make-cl-list win))
        ti)
    (while (and cls (not ti))
      (let* ((tit (xwem-cl-get-prop (car cls) 'xwem-tab-item))
             (xg (and (xwem-tab-item-p tit) (xwem-tab-item-rect tit))))
        (when (and xg
                   (<= (X-Rect-x xg) x)
                   (>= (+ (X-Rect-x xg) (X-Rect-width xg)) x)
                   (<= (X-Rect-y xg) y)
                   (>= (+ (X-Rect-y xg) (X-Rect-height xg)) y))
          (setq ti tit)))
      (setq cls (cdr cls)))
    (or ti (and (xwem-tabber-p tabber) (xwem-tabber-empty-tabi tabber)))))

(defun xwem-tabber-headers-width (xft)
  "Return width of XFT's headers."
  (apply (lambda (els)
	   (if els (apply '+ els) 0))
	 (mapcar (lambda (ti)
		   (X-Rect-width (xwem-tab-item-rect ti)))
		 (xwem-tabber-header-tabis xft))))

(defun xwem-tabber-tailers-width (xft)
  "Return width of XFT's tailers."
  (apply (lambda (els)
	   (if els (apply '+ els) 0))
	 (mapcar (lambda (ti)
		   (X-Rect-width (xwem-tab-item-rect ti)))
		 (xwem-tabber-tailer-tabis xft))))

;;;###autoload  
(defun xwem-tabber-regeom-window (win &optional draw-p)
  (let ((tabber (xwem-frame-get-prop (xwem-win-frame win) 'xwem-tabber)))
    (when (xwem-tabber-p tabber)
      (xwem-tabber-regeom tabber win draw-p))))

;;;###autoload
(defun xwem-tabber-regeom (tabber window &optional draw-p)
  "Adjust tabs geometries in TABBER."
  ;; TODO:
  ;;   - Take into account large delimeters
  (let* ((frame (xwem-tabber-frame tabber))
	 (hw 0);(xwem-tabber-headers-width tabber))
	 (tw 0);(xwem-tabber-tailers-width tabber))
	 (twidth (- (xwem-frame-width frame) hw tw))
	 (off hw)
	 (cls (xwem-win-make-cl-list (or window (xwem-frame-selwin (xwem-tabber-frame tabber)))))
	 (clsn (length cls))		; number of clients
	 (dw 2)				; XXX delimeter width
	 (ldw 4)			; XXX large delimeter width
	 dwc ldwc                       ; dws counter and ldws counter
         tiw twrem tabi rect)

    (when cls
      (setq ldwc (/ clsn xwem-tab-delim-interval))
      (setq dwc (- clsn ldwc 1))
      (setq tiw (/ (- twidth (* dw dwc) (* ldw ldwc)) clsn)) ; tab item width
      (setq twrem (% (- twidth (* dw dwc) (* ldw ldwc)) clsn)) ; reminder

      (while cls
	(setq tabi (xwem-cl-get-prop (car cls) 'xwem-tab-item))
	(setq rect (xwem-tab-item-rect tabi))
	(setf (X-Rect-x rect) off)
	(setf (X-Rect-width rect) (+ tiw (if (cdr cls) 0 twrem)))

	;; XXX
	(setf (X-Rect-height rect) (X-Geom-height (xwem-tabber-xgeom tabber)))

	(if (zerop (% (length cls) xwem-tab-delim-interval))
	    (progn
	      (setf (xwem-tab-item-delim-width tabi) ldw)
	      (setq off (+ off tiw ldw)))
	
	  (setf (xwem-tab-item-delim-width tabi) dw)
	  (setq off (+ off tiw dw)))

	(setq cls (cdr cls))))

    (when draw-p
      (xwem-tabber-draw tabber))
    ))

;;;###autoload
(defsubst xwem-tabber-safe-regeom (tabber &optional draw-p)
  "Saf variant of `xwem-tabber-regeom'."
  (and (xwem-tabber-p tabber)
       (xwem-tabber-regeom tabber nil draw-p)))

(defun xwem-tabber-draw-empty (tabber)
  "Draw empty."
  (let* ((frame (xwem-tabber-frame tabber))
	 (selected-p (xwem-frame-selected-p frame))
	 (xgeom (xwem-tabber-xgeom tabber)))

    ;; Create fake CL and tabi
    (setf (xwem-tabber-empty-tabi tabber)
          (make-xwem-tab-item :rect (make-X-Rect :x (X-Geom-x xgeom)
                                                 :y (X-Geom-y xgeom)
                                                 :width (X-Geom-width xgeom)
                                                 :height(X-Geom-height xgeom))
                              :state (if selected-p
                                         'xwem-face-tab-selected-active
                                       'xwem-face-tab-nonselected-active)
                              :format xwem-tab-empty-name))

    (xwem-tab-item-draw-format-1 (xwem-tabber-empty-tabi tabber) tabber)))

;;;###autoload
(defun xwem-tabber-draw (tabber)
  "Draw tabber."
  (let* ((cls (xwem-win-make-cl-list (xwem-frame-selwin (xwem-tabber-frame tabber))))
	 (tabis (mapcar (lambda (cl) (xwem-cl-get-prop cl 'xwem-tab-item)) cls));(xwem-tabber-tab-items tabber))
	 tab-item)

    (if (not tabis)
	(xwem-tabber-draw-empty tabber)

      (X-invalidate-cl-struct (xwem-tabber-empty-tabi tabber)) ; make sure here no empty tabitem
      (while tabis
	(setq tab-item (car tabis))
	(xwem-tab-item-draw-format tab-item)
      
	(setq tabis (cdr tabis))
	))))

(defun xwem-tab-item-get-fill-gc (tabi &optional tabber)
  "Return GC associated with TABI."
  ;; TODO: write me
  (xwem-face-get-gc (xwem-tab-item-state tabi)))

(defun xwem-tab-item-get-draw-gc (tabi &optional tabber)
  "Return GC to draw TABI's text."
  (xwem-face-get-gc (xwem-tab-item-state tabi)))


;;; Drawers
;;;###autoload
(defun xwem-tab-item-draw-format (tabi)
  (when (and (xwem-cl-p (xwem-tab-item-cl tabi))
	     (xwem-frame-p (xwem-cl-frame (xwem-tab-item-cl tabi))))
    (xwem-tab-item-draw-format-1 tabi)))

(defun xwem-tab-item-draw-format-1 (tabi &optional tabber)
  "Draw TABI's format string."
  (let* ((rect (xwem-tab-item-rect tabi))
	 (tabxwin (xwem-tabber-xwin (or tabber (xwem-tab-item-tabber tabi))))
	 (xprep (xwem-tabber-xpreparer (or tabber (xwem-tab-item-tabber tabi))))
	 (cl (xwem-tab-item-cl tabi))
	 (fmt (xwem-tab-item-format tabi))
	 (xoff (X-Rect-x rect))
	 (yoff (X-Rect-y rect))
	 fill-gc currgc fi item fmt-index
	 sfg)
 
    ;; Update tabi's state
    (when (xwem-cl-p cl)
      (let ((frame (xwem-cl-frame cl)))
	(when (xwem-frame-p frame)
	  (if (xwem-frame-selected-p frame)
	      (setf (xwem-tab-item-state tabi)
		    (if (xwem-win-cl-current-p cl)
			'xwem-face-tab-selected-active
		      'xwem-face-tab-selected-passive))

	    ;; XXX
	    (setf (xwem-tab-item-state tabi)
		  (if (xwem-win-cl-current-p cl)
		      'xwem-face-tab-nonselected-active
		    'xwem-face-tab-nonselected-passive))))))

    (setq fill-gc (xwem-tab-item-get-fill-gc tabi tabber))
    (setq currgc (xwem-tab-item-get-draw-gc tabi tabber))

    (setq sfg (X-Gc-foreground fill-gc))
    (unwind-protect
	(progn
	  (setf (X-Gc-foreground fill-gc) (X-Gc-background fill-gc))
	  (XChangeGC (xwem-dpy) fill-gc)

	  (XFillRectangles (xwem-dpy) xprep fill-gc (list rect)))

      (setf (X-Gc-foreground fill-gc) sfg)
      (XChangeGC (xwem-dpy) fill-gc))

    (XSetClipRectangles (xwem-dpy) fill-gc 0 0 (list rect))
    (XSetClipRectangles (xwem-dpy) currgc 0 0 (list rect))

    ;; In case there no cl attached, skip format field
    (unless (xwem-cl-p cl)
      (setq fmt xwem-tab-empty-name))

    (setq fmt-index 0)
    (while (and (< xoff (+ (X-Rect-x rect) (X-Rect-width rect)))
		(< fmt-index (length fmt)))
      (setq fi (aref fmt fmt-index))

      (incf fmt-index)
      (if (eq fi ?%)
	  (progn
	    (setq fi (aref fmt fmt-index))
	    (setq item (cond ((= fi ?n) (xwem-hints-wm-name (xwem-cl-hints cl)))
			     ((= fi ?c) (car (xwem-hints-wm-class (xwem-cl-hints cl))))
			     ((= fi ?C) (cadr (xwem-hints-wm-class (xwem-cl-hints cl))))
			     ((= fi ?i) (xwem-icons-cl-icon cl))
			     ((= fi ?s) (xwem-cl-get-psize cl))
			     ((= fi ?S) (xwem-cl-get-usize cl))
			     ((= fi ?u) (xwem-cl-get-uptime cl))
			     ((= fi ?U) (xwem-cl-get-uptime cl))
			     ((= fi ?f) (int-to-string (xwem-frame-num (xwem-cl-frame cl))))
			     ((= fi ?*) (if (xwem-cl-marked-p cl) "*" "-"))
			     ((= fi ?#) (if (XWMProtocol-set-p (xwem-dpy)
					     (xwem-hints-wm-protocols (xwem-cl-hints cl))
					     "WM_DELETE_WINDOW")
					    "#" "-"))
			     ((= fi ?%) "%")

			     ;; Emacs lisp
			     ((= fi ?{)
			      (let ((substr (substring fmt (1+ fmt-index)))
				    elstr)
				(unless (string-match "\\(\\([^%]\\|%[^}]\\)*\\)%}" substr)
				  (signal 'search-failed fmt "%}"))
				
				;; extract lisp code and update fmt indexer
				(setq elstr (match-string 1 substr))
				(incf fmt-index (match-end 0))

				;; Now time to run emacs lisp.
				
				;; NOTE:
				;;
				;;  - Due to dynamic scoping, emacs
				;;    lisp code that is in ELSTR can
				;;    access any locally bounded
				;;    variable for example `cl'.
				;;
				;; - It should return string, cons
				;;   cell(image) or nil.
				(eval (read elstr))))
				
			     ;; Ditig is number of aditional GC
			     ((and (> (Xforcenum fi) 47) (< (Xforcenum fi) 57))
			      (let* ((n (string-to-int (char-to-string fi)))
				     (gc (if (= n 0)
					     (xwem-tab-item-get-draw-gc tabi)
					   (eval (intern-soft (concat "xwem-tabber-gc" (int-to-string n)))))))
				(when (X-Gc-p gc)
				  (setq currgc gc)
				  (XSetClipRectangles (xwem-dpy) currgc 0 0 (list rect))))
			      'skip)

			     (t (error "Unknown token in tabi format"))))
	    ;; size fix
	    (when (and (consp item)
		       (numberp (car item))
		       (numberp (cdr item)))
	      (setq item (concat (int-to-string (car item))
				 "x"
				 (int-to-string (cdr item)))))
	    (incf fmt-index))

	;; Not %
	(setq item (char-to-string fi))
	(while (and (< fmt-index (length fmt))
		    (not (= (aref fmt fmt-index) ?%)))
	  (setq item (concat item (char-to-string (aref fmt fmt-index))))
	  (incf fmt-index)))

      (cond ((stringp item)
	     ;; Draw text
	     (let* ((font (X-Gc-font currgc))
		    (ta (X-Text-ascent (xwem-dpy) font item))
		    (td (X-Text-descent (xwem-dpy) font item))
		    (hei (X-Rect-height rect))
		    (ty (+ yoff (/ (- hei (+ ta td)) 2) ta)))

	       (XDrawString (xwem-dpy) xprep currgc xoff ty item)
	       (setq xoff (+ xoff (X-Text-width (xwem-dpy) (X-Gc-font currgc) item)))
	       ))

	    ((and (consp item)
		  (X-Pixmap-p (car item))
		  (X-Pixmap-p (cdr item)))
	     ;; Draw icon
	     (let* ((ximg (X-Pixmap-get-prop (car item) 'ximg))
		    (ty (/ (- (X-Rect-height rect) (X-Image-height ximg)) 2)))
;		   (ximg-mask (X-Pixmap-get-prop (cdr item) 'ximg)))
	       (unwind-protect
		   (progn
		     (setf (X-Gc-clip-mask currgc) (cdr item))
		     (setf (X-Gc-clip-x-origin currgc) xoff)
		     (setf (X-Gc-clip-y-origin currgc) (+ yoff ty))
		     (XChangeGC (xwem-dpy) currgc)

		     (XCopyArea (xwem-dpy) (car item) xprep currgc 0 0
				(X-Image-width ximg) (X-Image-height ximg)
				xoff (+ yoff ty))
                     )

		 (setf (X-Gc-clip-mask currgc) X-None)
		 (setf (X-Gc-clip-x-origin currgc) 0)
		 (setf (X-Gc-clip-y-origin currgc) 0)
		 (XChangeGC (xwem-dpy) currgc)
		 (XSetClipRectangles (xwem-dpy) currgc 0 0 (list rect)))

	       (setq xoff (+ xoff (X-Image-width ximg)))))

	    ((or (null item)
		 (eq item 'skip)) nil)

	    (t (error "Unknown Item" item)))
      )

    (when (> xoff (+ (X-Rect-x rect) (X-Rect-width rect)))
      (setq xoff (+ (X-Rect-x rect) (X-Rect-width rect))))
    
    (X-Dpy-send-excursion (xwem-dpy)
      (setq sfg (X-Gc-foreground fill-gc))
      (unwind-protect
	  (progn
	    (setf (X-Gc-foreground fill-gc) (X-Gc-background fill-gc))
	    (XChangeGC (xwem-dpy) fill-gc)

	    (XFillRectangles (xwem-dpy) tabxwin fill-gc (list rect)))

	(setf (X-Gc-foreground fill-gc) sfg)
	(XChangeGC (xwem-dpy) fill-gc))

      (XSetClipRectangles (xwem-dpy) fill-gc 0 0 (list rect))
      (XSetClipRectangles (xwem-dpy) currgc 0 0 (list rect))

      (XCopyArea (xwem-dpy) xprep tabxwin currgc
		 (X-Rect-x rect) (X-Rect-y rect) (X-Rect-width rect) (X-Rect-height rect)
		 (+ (X-Rect-x rect)
		    (/ (- (+ (X-Rect-x rect) (X-Rect-width rect)) xoff) 2))
		 (X-Rect-y rect))

      ;; Draw a delimeter
      (when (not (zerop (xwem-tab-item-delim-width tabi)))
	(cond ((= (xwem-tab-item-delim-width tabi) 2)
	       (XDrawLine (xwem-dpy) tabxwin
			  (xwem-face-get-gc 'xwem-face-black)
			  (+ (X-Rect-x rect) (X-Rect-width rect)) (X-Rect-y rect)
			  (+ (X-Rect-x rect) (X-Rect-width rect)) (X-Rect-height rect))
	       (XDrawLine (xwem-dpy) tabxwin
			  (xwem-face-get-gc 'xwem-face-white)
			  (+ (+ (X-Rect-x rect) (X-Rect-width rect)) 1) (X-Rect-y rect)
			  (+ (+ (X-Rect-x rect) (X-Rect-width rect)) 1) (X-Rect-height rect)))
	      ((= (xwem-tab-item-delim-width tabi) 4)
               ;; XXX
	       (XDrawLine (xwem-dpy) tabxwin
			  (xwem-face-get-gc 'xwem-face-black)
			  (+ (X-Rect-x rect) (X-Rect-width rect)) (X-Rect-y rect)
			  (+ (X-Rect-x rect) (X-Rect-width rect)) (X-Rect-height rect))
	       (XDrawLine (xwem-dpy) tabxwin
			  (xwem-face-get-gc 'xwem-face-darkgray)
			  (+ (+ (X-Rect-x rect) (X-Rect-width rect)) 1) (X-Rect-y rect)
			  (+ (+ (X-Rect-x rect) (X-Rect-width rect)) 1) (X-Rect-height rect))
	       (XDrawLine (xwem-dpy) tabxwin
			  (xwem-face-get-gc 'xwem-face-white)
			  (+ (+ (X-Rect-x rect) (X-Rect-width rect)) 2) (X-Rect-y rect)
			  (+ (+ (X-Rect-x rect) (X-Rect-width rect)) 2) (X-Rect-height rect))
	       (XDrawLine (xwem-dpy) tabxwin
			  (xwem-face-get-gc 'xwem-face-lightgray)
			  (+ (+ (X-Rect-x rect) (X-Rect-width rect)) 3) (X-Rect-y rect)
			  (+ (+ (X-Rect-x rect) (X-Rect-width rect)) 3) (X-Rect-height rect)))))
      )
    ))

;;;###autoload
(defsubst xwem-client-get-tab-item (cl)
  "Get tab item associated with CL."
  (xwem-cl-get-prop cl 'tab-item))

;;;###autoload
(defsubst xwem-client-set-tab-item (tabi cl)
  "Associate tab item TABI with client CL."
  (xwem-cl-put-prop cl 'tab-item tabi))

(defun xwem-tabber-resize (tabber width height)
  "Resize TABBER to WIDTH, HEIGHT."
  (let* ((xgeom (xwem-tabber-xgeom tabber))
         (owidth (X-Geom-width xgeom))
         (oheight (X-Geom-height xgeom)))
    (setf (X-Geom-width xgeom) width)
    (setf (X-Geom-height xgeom) height)
    (XResizeWindow (xwem-dpy) (xwem-tabber-xwin tabber) width height)

    (when (or (> width owidth) (> height oheight))
      ;; Recreate xpreparer
      (XFreePixmap (xwem-dpy) (xwem-tabber-xpreparer tabber))
      (setf (xwem-tabber-xpreparer tabber)
            (XCreatePixmap (xwem-dpy) (make-X-Pixmap :dpy (xwem-dpy) :id (X-Dpy-get-id (xwem-dpy)))
                           (xwem-tabber-xwin tabber) (XDefaultDepth (xwem-dpy)) (X-Geom-width xgeom) (X-Geom-height xgeom))))
    ))

;;; Frame Hooks
(defun xwem-tabber-on-frame-redraw (frame)
  "To be used in `xwem-frame-redraw-hook'."
  (let ((tabber (xwem-frame-get-prop frame 'xwem-tabber)))
    (when (xwem-tabber-p tabber)
      (xwem-tabber-draw tabber))))

(defun xwem-tabber-on-frame-resize (frame)
  "FRAME just resized, apply changes to tabber, if any."
  (let ((tabber (xwem-frame-get-prop frame 'xwem-tabber)))
    (when (xwem-tabber-p tabber)
      (xwem-tabber-resize tabber (xwem-frame-width frame)
                          (xwem-frame-get-prop frame 'title-height))
      (xwem-win-map (lambda (win)
                      (xwem-tabber-regeom tabber win (xwem-win-selected-p win)))
                    (xwem-frame-selwin frame))
      )))

(defun xwem-tabber-on-frame-creation (frame)
  "FRAME just created."
  (xwem-frame-put-prop frame 'xwem-tabber
     (xwem-tabber-create frame (make-X-Geom :x 0 :y 0 :width (xwem-frame-width frame)
                                            :height (xwem-frame-get-prop frame 'title-height))
                         'unknown)))

(defun xwem-tabber-on-win-switch (owin nwin)
  "Window switch occured OWIN -> NWIN."
  (when (not (eq owin nwin))
    (xwem-tabber-check-and-regeom nwin)))

(defun xwem-tabber-on-win-change (win)
  "WIN's clients list changed."
  (xwem-tabber-check-and-regeom win))

(defun xwem-tabber-on-cl-creation (cl)
  "CL just created."
  ;; Make tab item for CL
  (xwem-cl-put-prop cl 'xwem-tab-item
    (make-xwem-tab-item :type 'client
                        :state 'unmapped :rect (make-X-Rect :y 0 :x 0 :width 0 :height 0)
                        :cl cl :format xwem-tab-default-format)))

(defun xwem-tabber-on-cl-destroy (cl)
  "CL is about to be destroyed."
  (let ((tab-item (xwem-cl-get-prop cl 'xwem-tab-item))
        (win (xwem-cl-win cl)))
    (when (xwem-tab-item-p tab-item)
      (xwem-cl-put-prop cl 'xwem-tab-item nil)
      (X-invalidate-cl-struct tab-item))

    (xwem-tabber-check-and-regeom win)
    ))

(defun xwem-tabber-check-and-regeom (win &optional force)
  "Check is regeometry needed of CL's tabber.
Return non-nil if regeom occured."
  (let* ((frame (and (xwem-win-p win) (xwem-win-frame win)))
         (tabber (and (xwem-frame-p frame) (xwem-frame-get-prop frame 'xwem-tabber)))
         (cls (xwem-win-make-cl-list win)))
    (when (xwem-tabber-p tabber)
      (unless (and (not force)
                   (equal (xwem-tabber-get-prop tabber 'last-units) cls)
                   (eq (xwem-tabber-get-prop tabber 'last-win) win))
        (xwem-tabber-put-prop tabber 'last-units cls)
        (xwem-tabber-put-prop tabber 'last-win win)
        (xwem-tabber-regeom tabber win (xwem-win-selected-p win))
        t))))

(defun xwem-tabber-on-cl-change (cl &rest args)
  "CL just changed its component."
  (let ((tab-item (xwem-cl-get-prop cl 'xwem-tab-item))
        (win (xwem-cl-win cl)))
    (when (xwem-tab-item-p tab-item)
      (when (and (not (xwem-tabber-check-and-regeom win))
                 (xwem-win-selected-p win))
        (xwem-tab-item-draw-format-1 tab-item)))))

;;; Test:
;(xwem-init-tabber)
;(setq tb (xwem-tabber-create (car xwem-frames-list) (make-X-Geom :x 0 :y 0 :width 600 :height 20)
;			     'normal))
;(setq ti (make-xwem-tab-item :type 'test :tabber tb
;			     :state 'tab-selected-active
;			     :rect (make-X-Rect :x 10 :y 0 :width 500 :height 20)
;			     :cl (xwem-cl-selected)
;			     :format "test %n test1"))
;(setf (xwem-tab-item-format ti) "Test %i test1")
;(setf (xwem-tab-item-state ti) 'nonselected-passive)
;(xwem-tab-item-draw-format ti)

;(XClearArea (xwem-dpy) (xwem-tabber-xwin tb) 0 0 600 20 nil)
;(XDestroyWindow (xwem-dpy) (xwem-tabber-xwin tb))


(provide 'xwem-tabbing)

;;; xwem-tabbing.el ends here
