Source

xwem / lisp / xwem-frametrans.el

Full commit
;;; xwem-frametrans.el --- Transparency frames support.

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

;; Author: Zajcev Evgeny <zevlg@yandex.ru>
;; Created: Thu Dec  2 10:35:14 MSK 2004
;; Keywords: xwem
;; X-CVS: $Id$

;; 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:

;; Not yet fully functional.  To start using it do:
;; 
;;   (add-hook 'xwem-frame-creation-hook 'xwem-ft-mask-init)
;; 
;; It will apply masking to every newly created frame.
;; 
;; For masking on already exsting frame, do something like:
;; 
;;   H-: (xwem-ft-mask-init (xwem-frame-selected))

;;; Code:


(require 'xwem-load)
(require 'xlib-xshape)

(defstruct xwem-frame-ft
  frame
  mask
  gc
  bgc
  saved-height
  saved-width

  plist)

(defmacro xwem-frame-ft-get-prop (xff prop)
  `(plist-get (xwem-frame-ft-plist ,xff) ,prop))
(defmacro xwem-frame-ft-rem-prop (xff prop)
  `(setf (xwem-frame-ft-plist ,xff)
         (plist-remprop (xwem-frame-ft-plist ,xff) ,prop)))
(defmacro xwem-frame-ft-set-prop (xff prop val)
  `(if ,val
       (setf (xwem-frame-ft-plist ,xff)
             (plist-put (xwem-frame-ft-plist ,xff) ,prop ,val))
     (xwem-frame-ft-rem-prop ,xff ,prop)))


;;; Functions
(define-xwem-deffered xwem-ft-fill-mask (frame)
  "Fill the FRAME with mask."
  (let* ((xff (and (xwem-frame-p frame)
                   (xwem-frame-get-prop frame 'xwem-frame-ft)))
         (mask (and xff (xwem-frame-ft-mask xff)))
         (xgc (and xff (xwem-frame-ft-gc xff)))
         (xmgc (and xff (xwem-frame-ft-bgc xff)))
         (plist (and xff (xwem-frame-ft-plist xff))))
    (when (and (X-Pixmap-p mask)
               (X-Gc-p xgc)
               (X-Gc-p xmgc))
      (XFillRectangle (xwem-dpy) mask xgc 0 0
                      (xwem-frame-width frame) (xwem-frame-height frame))
      (xwem-win-map (lambda (w)
                      (XFillRectangle (xwem-dpy) mask xmgc
                                      (+ (xwem-win-x w)
                                         (xwem-win-border-width w))
                                      (+ (xwem-win-y w)
                                         (xwem-win-border-width w))
                                      (- (xwem-win-width w)
                                         (xwem-win-border-width w)
                                         (xwem-win-border-width w))
                                      (- (xwem-win-height w)
                                         (xwem-win-border-width w)
                                         (xwem-win-border-width w)))
                      (let ((cl (xwem-win-cl w))
                            clg)
                        (when (and (xwem-cl-p cl) (xwem-cl-active-p cl))
                          (setq clg (xwem-cl-xgeom cl))
                          (XFillRectangle (xwem-dpy) mask xgc
                                          (X-Geom-x clg)
                                          (X-Geom-y clg)
                                          (X-Geom-width-with-borders clg)
                                          (X-Geom-height-with-borders clg)))))
                    (xwem-frame-selwin frame))
      (X-XShapeMask (xwem-dpy) (xwem-frame-xwin frame)
                    X-XShape-Bounding X-XShapeSet 0 0 mask))))

(defun xwem-ft-mask-init (frame &optional ft-properties)
  "Initialize transparency mask for FRAME."
  (let* ((xpx (XCreatePixmap (xwem-dpy) (make-X-Pixmap :dpy (xwem-dpy) :id (X-Dpy-get-id (xwem-dpy)))
                             (xwem-frame-xwin frame) 1
                             (xwem-frame-width frame) (xwem-frame-height frame)))
         (gc xwem-misc-mask-fgc)
         (bgc xwem-misc-mask-bgc))
;         (gc (XCreateGC (xwem-dpy) xpx
;                        (make-X-Gc :dpy (xwem-dpy) :id (X-Dpy-get-id (xwem-dpy))
;                                   :foreground 1.0
;                                   :background 0.0)))
;         (bgc (XCreateGC (xwem-dpy) xpx
;                         (make-X-Gc :dpy (xwem-dpy) :id (X-Dpy-get-id (xwem-dpy))
;                                    :foreground 0.0
;                                    :background 1.0))))

    (XFillRectangle (xwem-dpy) xpx gc 0 0
                    (xwem-frame-width frame)
                    (xwem-frame-height frame))
    (xwem-frame-put-prop frame 'xwem-frame-ft
      (make-xwem-frame-ft :frame frame
                          :mask xpx
                          :gc gc
                          :bgc bgc
                          :saved-height (xwem-frame-height frame)
                          :saved-width (xwem-frame-width frame)
                          :plist ft-properties))

    (xwem-ft-fill-mask frame)))

(define-xwem-deffered xwem-ft-mask-resize (frame)
  "Resize FRAME's transparency mask."
  (let ((xff (and (xwem-frame-p frame)
                  (xwem-frame-get-prop frame 'xwem-frame-ft))))
    (when xff
      (when (or (not (xwem-frame-ft-saved-height xff))
                (not (xwem-frame-ft-saved-width xff))
                (> (xwem-frame-width frame)
                   (xwem-frame-ft-saved-width xff))
                (> (xwem-frame-height frame)
                   (xwem-frame-ft-saved-height xff)))
        ;; Recreate pixmap
        (XFreePixmap (xwem-dpy) (xwem-frame-ft-mask xff))

        (setf (xwem-frame-ft-mask xff)
              (XCreatePixmap (xwem-dpy) (make-X-Pixmap :dpy (xwem-dpy)
                                                       :id (X-Dpy-get-id (xwem-dpy)))
                             (xwem-frame-xwin frame) 1
                             (xwem-frame-width frame) (xwem-frame-height frame)))
        (setf (xwem-frame-ft-saved-width xff) (xwem-frame-width frame))
        (setf (xwem-frame-ft-saved-height xff) (xwem-frame-height frame))
        ))))

(defun xwem-ft-mask-deinit (frame)
  "Denitialize transparency mask for FRAME."
  (let ((xpx (xwem-frame-ft-mask frame))
        (xgc (xwem-frame-ft-gc frame))
        (xmgc (xwem-frame-ft-bgc frame)))
    (setf (xwem-frame-ft-mask frame) nil)
    (setf (xwem-frame-ft-gc frame) nil)
    (setf (xwem-frame-ft-bgc frame) nil)

    (XFreeGC (xwem-dpy) xgc)
    (XFreeGC (xwem-dpy) xmgc)
    (XFreePixmap (xwem-dpy) xpx)

    (X-XShapeMask (xwem-dpy) (xwem-frame-xwin frame)
                  X-XShape-Bounding X-XShapeSet 0 0 nil)))


(provide 'xwem-frametrans)

;; On-load actions:
(add-hook 'xwem-frame-resize-hook 'xwem-ft-mask-resize)
(add-hook 'xwem-frame-redraw-hook 'xwem-ft-fill-mask)

;;; xwem-frametrans.el ends here