Commits

Anonymous committed fd03aee

empty

  • Participants
  • Parent commits fe447bd

Comments (0)

Files changed (3)

+2004-12-06  Zajcev Evgeny <zevlg@yandex.ru>
+
+	* extra/xwem-frametrans.el (Repository): initial import of frame
+		  transparency code.  Not yet fully functional however.
+
+	* dockapp/xwem-pager.el:
+	* dockapp/xwem-pager.el (requires): [fix] xwem-load, xlib-xshape
+		  added.
+
 2004-12-06  Zajcev Evgeny <zevlg@yandex.ru>
 
 	* *.el (Author): Fixes.

dockapp/xwem-pager.el

 
 ;;; Code:
 
+(require 'xwem-load)
+(require 'xlib-xshape)
 
-(defvar xwem-pager-xwin nil
-  "XWIN of xwem pager.")
-
-(defvar xwem-pager-background-active "grey30")
-(defvar xwem-pager-background-inactive "grey55")
-(defvar xwem-pager-border-shadow-active "grey55")
-(defvar xwem-pager-border-shadow-inactive "grey55")
-
+
 ;; veryvery simple pager / 2d viewport support
 ;; the code works, do the following:
 ;; 
 
 ;;; //////////////////////////////////////////////////////////////////////
 
+(defvar xwem-pager-xwin nil
+  "XWIN of xwem pager.")
+
+(defvar xwem-pager-background-active "grey30")
+(defvar xwem-pager-background-inactive "grey55")
+(defvar xwem-pager-border-shadow-active "grey55")
+(defvar xwem-pager-border-shadow-inactive "grey55")
+
 (defvar xwem-2dframes-dim '(4 . 4)
   "X*Y viewports")
 
+
+;;; Functions
 (defun xwem-2dframes-make-frames ()
   "Make the frames, call from XWEM-AFTER-INIT-HOOK!"
   (let ((num (1- (* (car xwem-2dframes-dim)

extra/xwem-frametrans.el

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