1. xemacs
  2. xwem

Commits

viteno  committed 7aa1714

Initial import of xlib sources

  • Participants
  • Branches default
  • Tags XWEM_0_1

Comments (0)

Files changed (105)

File ChangeLog

View file
  • Ignore whitespace
+2004-02-15  Zajcev Evgeny  <zevlg@yandex.ru>
+	
+	* XWEM: Many improvements, window configurations, keyboard macros,
+	etc.  I think we are ready for beta or even for pre-release.
+
+	* addons/xwem-register.el (new): Registers for XWEM added.
+
+	* addons/xwem-framei.el (new): Frame indicator added.
+
+	* xwem-sound.el (new): Sound support added.
+
+2004-01-23 Zajcev Evgeny <zevlg@yandex.ru>
+
+	* addons/xwem-osd.el (Bugs): Some bug fixes.
+
+	* addons/xwem-holer.el (interactive): More interactive support
+	added, now it is possible to create/move/resize/delete holers
+	interactively.
+
+	* addons/xwem-edmacro.el (xwem-edmacro-can-edit-unbinded): Now it
+	is possible to edit(create) even unbinded keyboard macros.
+
+	* xwem-keymacro.el (xwem-keymacro-show-macro): Added new
+	customizable variable.
+
+	* xwem-macros.el (xwem-cursor-shape-choice): Added new shapes. 
+
+	* xwem-misc.el (xwem-make-cursor): Moved here from xwem-macros.el.
+
+	* xwem-minibuffer.el (xwem-minibuffer-init): Work around
+	`menubar-visible-p' specifier problem.
+
+2004-01-21 Zajcev Evgeny <zevlg@yandex.ru>
+
+	* xwem-keyboard.el (xwem-kbd-process-after-lookup): Bug fix. check
+	for `xwem-kbd-reading-keyseq' added when lkm is nil.
+
+2004-01-21 Zajcev Evgeny <zevlg@yandex.ru>
+
+	* ChangeLog (Revision): ChangeLog in new XWEM layout created.
+	
+;; $Id$

File Makefile

View file
  • Ignore whitespace
+# Makefile for xwem lisp code
+
+# This file is part of XEmacs.
+
+# XEmacs 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.
+
+# XEmacs 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.
+
+VERSION = 1.00
+AUTHOR_VERSION = 0.1
+MAINTAINER = Zajcev Evgeny
+PACKAGE = xwem
+PKG_TYPE = regular
+REQUIRES = xemacs-base xlib strokes edit-utils text-modes time slider
+CATEGORY = standard
+
+ELCS =  lisp/xwem-compat.elc lisp/xwem-clients.elc lisp/xwem-events.elc lisp/xwem-frame.elc \
+        lisp/xwem-faces.elc lisp/xwem-help.elc lisp/xwem-focus.elc lisp/xwem-keyboard.elc \
+        lisp/xwem-keymacro.elc lisp/xwem-keydefs.elc \
+        lisp/xwem-launcher.elc lisp/xwem-main.elc lisp/xwem-manage.elc lisp/xwem-minibuffer.elc \
+        lisp/xwem-misc.elc lisp/xwem-mouse.elc lisp/xwem-interactive.elc lisp/xwem-root.elc \
+        lisp/xwem-special.elc lisp/xwem-strokes.elc lisp/xwem-tray.elc lisp/xwem-win.elc \
+        lisp/xwem-icons.elc lisp/xwem-tabbing.elc lisp/xwem-sound.elc lisp/xwem-load.elc
+
+ELCS_1 = lisp/addons/xwem-edmacro.elc lisp/addons/xwem-clswi.elc lisp/addons/xwem-time.elc \
+        lisp/addons/xwem-osd.elc lisp/addons/xwem-holer.elc lisp/addons/xwem-framei.elc \
+        lisp/addons/xwem-register.elc lisp/addons/xwem-gamma.elc
+
+ELCS_1_DEST = $(PACKAGE)/addons
+ELCS_1_FILES = $(ELCS_1) $(ELCS_1:.elc=.el)
+
+DATA_FILES = $(wildcard icons/*.x[bp]m) logo.xpm
+DATA_DEST = $(PACKAGE)
+
+AUTOLOAD_PATH = lisp
+
+PRELOADS = -eval '(progn (push "./lisp" load-path) (push "./lisp/addons" load-path) (push (concat (package-name-to-directory "xlib") "/ext") load-path))' -l lisp/auto-autoloads.el
+
+include ../../XEmacs.rules

File TODO

View file
  • Ignore whitespace
+Thu Feb 19 09:16:05 MSK 2004:
+
+     - Focusing manage (according to ICCCM)! very needed. (mostly done)
+
+     - More ICCCM stuff to support, like WM_PROTOCOL, DELETE_WINDOW,
+       etc. (mostly done)
+     
+     - Write some documentation.
+
+     - Configuration file handling. (I think it is done).
+
+     - More hookenization.
+
+     - Session management. save-window-configuration,
+       set-window-configuration, save-frame-configuration,
+       set-frame-configuration, etc. (window configurations done)
+
+     - kbd macros. i.e. save keypress sequence and then play it with
+       XSendEvent. (Done, using xtest extension)
+
+     - Strokes:
+         * Support for dymanic strokes types. i.e. you can register
+           new types of strokes.
+
+         * Kanji strokes database
+
+     - CL switcher, something like `iswitchb' or `buqis'.(Done mostly)
+
+     - Programs launcher.(done)
+
+     - Summarize mode. i.e. make buffer with xwem information like
+       frames setup, clients online, etc.(Done `xwem-help')
+
+     - Multiple visible frames(partly done), frame should reguard his
+       properties changes on fly, i.e. resize x window, when frame-width
+       and such changes.
+
+     - Extensions support:
+          * Xinerama
+	  * Record (may be clones could be done with it?)
+	  * MiscKbd
+	  * XTrap (may be play with it to implement X window clones).
+
+     - Ubering. i.e. you can run other window manager in xwem frame.
+       Maybe implement using Xnest's -parent feature?
+
+# $Id$

File icons/README

View file
  • Ignore whitespace
+ CREATING NEW ICONS:
+
+   If you are going to add icon in this directory please check your
+   icon to correspond next xpm format:
+
+    Required:
+
+      * icon filename must begin with 'mini-' if size of icon < 32 in
+        both directions.
+
+      * icon filename must begin with 'miniWxH-'(where W and H is
+        width and height of icon), when one of size is great or equal
+        to 32, but less then 48.
+
+      * icon filename must have no beggining if it's on of its size is
+        greater or equal to 48.
+
+      * icon name(pointer variable name) must be the same as filename,
+        but substitute '-' and '.' with '_'.  For example if icon's
+        filename is "mini-apm.xpm" then variable name must be
+        "mini_apm_xpm".
+
+      * mini icons(W and H < 32) must have no more then 32 colors.
+
+      * 16x16 icons must have no more then 18 colors.
+
+      * After variable name icon must have comment:
+
+	      /* columns rows colors chars-per-pixel */
+
+	And after colors declation icon must have comment:
+
+	      /* pixels */
+
+      * Chars per pixel value must be 1.
+
+      * "};" must be on its own line at the end of file.
+
+      * ' ' must be used for None color.
+
+
+    Recommended, but not required:
+
+      * Use only 'c' in colors specification.
+
+      * Use 'None' instead of 'none' in colors specifications.
+
+      * Use '#' for black color.
+
+      * Use '.' for white color.
+
+      * Use 'r' for red color.
+
+      * Use 'g' for green color.
+
+      * use 'b' for blue color.

File icons/mini-acroread.xpm

View file
  • Ignore whitespace
Added
New image

File icons/mini-bitchx.xpm

View file
  • Ignore whitespace
Added
New image

File icons/mini-calc.xpm

View file
  • Ignore whitespace
Added
New image

File icons/mini-cd.xpm

View file
  • Ignore whitespace
Added
New image

File icons/mini-clock.xpm

View file
  • Ignore whitespace
Added
New image

File icons/mini-colors.xpm

View file
  • Ignore whitespace
Added
New image

File icons/mini-cross.xpm

View file
  • Ignore whitespace
Added
New image

File icons/mini-daemon.xpm

View file
  • Ignore whitespace
Added
New image

File icons/mini-diskete.xpm

View file
  • Ignore whitespace
Added
New image

File icons/mini-diskete2.xpm

View file
  • Ignore whitespace
Added
New image

File icons/mini-diskette.xpm

View file
  • Ignore whitespace
Added
New image

File icons/mini-display.xpm

View file
  • Ignore whitespace
Added
New image

File icons/mini-doc1.xpm

View file
  • Ignore whitespace
Added
New image

File icons/mini-ethereal.xpm

View file
  • Ignore whitespace
Added
New image

File icons/mini-font.xpm

View file
  • Ignore whitespace
Added
New image

File icons/mini-freedesk.xpm

View file
  • Ignore whitespace
Added
New image

File icons/mini-ftp.xpm

View file
  • Ignore whitespace
Added
New image

File icons/mini-gnus.xpm

View file
  • Ignore whitespace
Added
New image

File icons/mini-graph.xpm

View file
  • Ignore whitespace
Added
New image

File icons/mini-gv.xpm

View file
  • Ignore whitespace
Added
New image

File icons/mini-info.xpm

View file
  • Ignore whitespace
Added
New image

File icons/mini-keyboard.xpm

View file
  • Ignore whitespace
Added
New image

File icons/mini-lower.xpm

View file
  • Ignore whitespace
Added
New image

File icons/mini-measure.xpm

View file
  • Ignore whitespace
Added
New image

File icons/mini-mozilla.xpm

View file
  • Ignore whitespace
Added
New image

File icons/mini-mozilla1.xpm

View file
  • Ignore whitespace
Added
New image

File icons/mini-mozilla2.xpm

View file
  • Ignore whitespace
Added
New image

File icons/mini-mozilla3.xpm

View file
  • Ignore whitespace
Added
New image

File icons/mini-netscape.xpm

View file
  • Ignore whitespace
Added
New image

File icons/mini-netscape1.xpm

View file
  • Ignore whitespace
Added
New image

File icons/mini-netscape2.xpm

View file
  • Ignore whitespace
Added
New image

File icons/mini-pager.xpm

View file
  • Ignore whitespace
Added
New image

File icons/mini-penguin.xpm

View file
  • Ignore whitespace
Added
New image

File icons/mini-raise.xpm

View file
  • Ignore whitespace
Added
New image

File icons/mini-ray.xpm

View file
  • Ignore whitespace
Added
New image

File icons/mini-redhat.xpm

View file
  • Ignore whitespace
Added
New image

File icons/mini-sh1.xpm

View file
  • Ignore whitespace
Added
New image

File icons/mini-stroke.xpm

View file
  • Ignore whitespace
Added
New image

File icons/mini-term.xpm

View file
  • Ignore whitespace
Added
New image

File icons/mini-tex.xpm

View file
  • Ignore whitespace
Added
New image

File icons/mini-turn.xpm

View file
  • Ignore whitespace
Added
New image

File icons/mini-x.xpm

View file
  • Ignore whitespace
Added
New image

File icons/mini-x2.xpm

View file
  • Ignore whitespace
Added
New image

File icons/mini-xchat.xpm

View file
  • Ignore whitespace
Added
New image

File icons/mini-xchat1.xpm

View file
  • Ignore whitespace
Added
New image

File icons/mini-xdvi.xpm

View file
  • Ignore whitespace
Added
New image

File icons/mini-xemacs.xpm

View file
  • Ignore whitespace
Added
New image

File icons/mini-xemacs1.xpm

View file
  • Ignore whitespace
Added
New image

File icons/mini-xemacsC.xpm

View file
  • Ignore whitespace
Added
New image

File icons/mini-xemacsgnus.xpm

View file
  • Ignore whitespace
Added
New image

File icons/mini-xemacsinfo.xpm

View file
  • Ignore whitespace
Added
New image

File icons/mini-xemacspy.xpm

View file
  • Ignore whitespace
Added
New image

File icons/mini-xemacstex.xpm

View file
  • Ignore whitespace
Added
New image

File icons/mini-xfig.xpm

View file
  • Ignore whitespace
Added
New image

File icons/mini-xkeycaps.xpm

View file
  • Ignore whitespace
Added
New image

File icons/mini-xterm.xpm

View file
  • Ignore whitespace
Added
New image

File icons/mini-xterm1.xpm

View file
  • Ignore whitespace
Added
New image

File icons/mini-xv.xpm

View file
  • Ignore whitespace
Added
New image

File icons/mini-xv1.xpm

View file
  • Ignore whitespace
Added
New image

File icons/mini-xwem.xpm

View file
  • Ignore whitespace
Added
New image

File icons/mini-zoom.xpm

View file
  • Ignore whitespace
Added
New image

File icons/mini32x32-help.xpm

View file
  • Ignore whitespace
Added
New image

File lisp/addons/xwem-clswi.el

View file
  • Ignore whitespace
+;;; xwem-clswi.el --- Client switching package.
+
+;; Copyright (C) 2003 by Free Software Foundation, Inc.
+
+;; Author: Zajcev Evgeny <zevlg@yandex.ru>
+;; Keywords: xwem
+;; X-CVS: $Id$
+
+;; This file is NOT part of XEmacs.
+
+;; 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:
+
+;; To use this package add something like:
+;;
+;;     (autoload 'xwem-clswi-enable "xwem-clswi" "Enable client switching." t)
+;;     (add-hook 'xwem-load-hook 'xwem-clswi-enable)
+;;
+;; to your xwemrc.el.  It will install new bindings `H-]' for
+;; switching to next client and `H-[' for switching to previous
+;; client.
+
+;;; Code:
+
+(defgroup xwem-clswi nil
+  "Group to customize clients switcher."
+  :prefix "xwem-clswi-"
+  :group 'xwem)
+
+(defcustom xwem-clswi-beep-on-error nil
+  "*Non-nil mean beep on any error."
+  :type 'boolean
+  :group 'xwem-clswi)
+
+(defcustom xwem-clswi-show-info nil
+  "*Non-nil mean show info about client in xwem minibuffer after switch."
+  :type 'boolean
+  :group 'xwem-clswi)
+
+(defvar xwem-clswi-enabled nil 
+  "Non-nil means that xwem-clswi is enabled.
+Do not change this value directly, use `xwem-clswi-enable',
+`xwem-clswi-disable' or `xwem-clswi-toggle' instead.")
+
+
+(define-xwem-command xwem-clswi-enable ()
+  "Enables xwem-clswi."
+  (xwem-interactive)
+
+  (unless xwem-clswi-enabled
+    (if xwem-started
+	(progn
+	  (xwem-global-set-key (xwem-kbd "H-]") 'xwem-clswi-next)
+	  (xwem-global-set-key (xwem-kbd "H-[") 'xwem-clswi-prev))
+
+      (define-key xwem-global-map (xwem-kbd "H-]") 'xwem-clswi-next)
+      (define-key xwem-global-map (xwem-kbd "H-[") 'xwem-clswi-prev))
+
+    (setq xwem-clswi-enabled t)))
+
+(define-xwem-command xwem-clswi-disable ()
+  "Disables xwem-clswi, uninstalls default keybindings."
+  (xwem-interactive)
+
+  (when xwem-clswi-enabled
+    (if xwem-started
+	(progn
+	  (xwem-global-set-key (xwem-kbd "H-]") nil)
+	  (xwem-global-set-key (xwem-kbd "H-[") nil))
+
+      (define-key xwem-global-map (xwem-kbd "H-]") nil)
+      (define-key xwem-global-map (xwem-kbd "H-[") nil))
+
+    (setq xwem-clswi-enabled nil)))
+
+(define-xwem-command xwem-clswi-toggle ()
+  "Toggle xwem-clswi."
+  (xwem-interactive)
+
+  (if xwem-clswi-enabled
+      (xwem-clswi-enable)
+    (xwem-clswi-disable)
+  ))
+
+(define-xwem-command xwem-clswi-next (arg &optional win)
+  "Switch to ARG next client in WIN.
+If WIN is ommited then in selected window."
+  (xwem-interactive "p")
+
+  (let* ((swin (or win (xwem-win-selected)))
+	 (ccl (xwem-win-cl swin))	;currently selected client
+	 (cls (xwem-win-make-cl-list swin))
+	 cclinx num scl)
+    (if cls
+	(progn
+	  (setq cclinx (- (length cls) (length (memq ccl cls))))
+	  (setq num (% (+ cclinx arg) (length cls)))
+	  (setq scl (nth (if (natnump num) num (+ (length cls) num)) cls))
+
+	  (xwem-manda-fun-run (xwem-cl-manda scl) 'manage scl)
+
+	  (when xwem-clswi-show-info
+	    (xwem-client-info scl)))
+
+      (xwem-message (if xwem-clswi-beep-on-error 'warn 'warn-nobeep)
+		    "No clients to switch."))))
+
+(define-xwem-command xwem-clswi-prev (arg &optional win)
+  "Switch to ARG previous client in WIN.
+If WIN is ommited then in selected window."
+  (xwem-interactive "p")
+
+  (xwem-clswi-next (- arg) win))
+
+
+(provide 'xwem-clswi)
+
+;;; xwem-clswi.el ends here

File lisp/addons/xwem-edmacro.el

View file
  • Ignore whitespace
+;;; xwem-edmacro.el --- Keyboard macro editor for XWEM.
+
+;; Copyright (C) 2003 by Free Software Foundation, Inc.
+
+;; Author: Zajcev Evgeny <zevlg@yandex.ru>
+;; Created: Fri Dec 12 11:19:50 MSK 2003
+;; Keywords: xwem, xlib
+;; 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:
+
+;; Macro editing package.  Allow you to edit XWEM keyboard macros like
+;; `edmacro' allow you to edit Emacs keyboard macros.  Uses xwem
+;; special frame, so you can edit keyboard macro from any point.
+
+;; You might change `xwem-edmacro-can-edit-unbinded' to non-nil to
+;; allow edition of non-macro keys.
+
+;;; Code:
+
+
+(eval-and-compile
+  (require 'edmacro))
+
+(defgroup xwem-edmacro nil
+  "Group to customize `xwem-edmacro' addon."
+  :prefix "xwem-edmacro-"
+  :group 'xwem-keyboard)
+
+(defcustom xwem-edmacro-can-edit-unbinded t
+  "*Non-nil mean that `xwem-edmacro' allows edit unbinded keys."
+  :type 'boolean
+  :group 'xwem-edmacro)
+
+(defcustom xwem-edmacro-can-edit-nonmacro nil
+  "*Non-nil allow you to edit keys binded to non-macro commands.
+USE WITH CAUTION, if this variable is non-nil you can override any
+binding in `xwem-global-map'!"
+  :type 'boolean
+  :group 'xwem-edmacro)
+
+;; Variables
+(defvar xwem-edmacro-prefix-arg nil
+  "Value of prefix argument.
+Internal variable, do not modify.")
+
+(defvar xwem-edmacro-store-place nil
+  "Place where to store new keyboard macro after editing.
+Internal variable, do not use.")
+
+
+;; Functions
+(defun xwem-edmacro-store (mac)
+  "Store new keyboard macro MAC."
+  (setq mac (key-sequence-list-description mac))
+  (cond ((eq xwem-edmacro-store-place 'xwem-keymacro-last-kbd-macro)
+	 (setq xwem-keymacro-last-kbd-macro mac)
+	 (xwem-message 'info "New keymacro stored to `%S'" xwem-edmacro-store-place))
+
+	(t
+	 ;; redefine key in user macros map
+	 (define-key xwem-global-map xwem-edmacro-store-place mac)))
+
+  (setq xwem-edmacro-store-place nil)
+  )
+
+(define-xwem-command xwem-edmacro-edit-kbd-macro (xwem-keys &optional arg)
+  "Edit XWEM keyboard macro specified by XWEM-KEYS.
+With a prefix ARG, format the macro in a more concise way."
+  (xwem-interactive
+   (list
+    (xwem-read-key-sequence
+     (substitute-command-keys
+      (concat "Enter \\<xwem-global-map>\\[xwem-keymacro-play-last] "
+	      "or one of \\<xwem-global-map>\\[xwem-user-keymacros-prefix] XXX: ")))
+    (prefix-numeric-value xwem-prefix-arg)))
+
+  (xwem-kbd-stop-grabbing)
+
+  (let ((xwem-cmd (xwem-kbd-key-binding xwem-keys))
+	xwem-evs)
+
+    (setq xwem-evs (cond ((eq xwem-cmd 'xwem-keymacro-play-last)
+			  (setq xwem-edmacro-store-place 'xwem-keymacro-last-kbd-macro)
+			  xwem-keymacro-last-kbd-macro)
+
+			 ((vectorp xwem-cmd)
+			  (setq xwem-edmacro-store-place xwem-keys)
+			  xwem-cmd)
+
+			 ((and xwem-edmacro-can-edit-unbinded (null xwem-cmd))
+			  (setq xwem-edmacro-store-place xwem-keys)
+			  [])
+
+			 (xwem-edmacro-can-edit-nonmacro
+			  (setq xwem-edmacro-store-place xwem-keys)
+			  [])
+
+			 (t nil)))
+
+    (if (null xwem-evs)
+	(cond ((and (null xwem-edmacro-can-edit-unbinded) (null xwem-cmd))
+	       (xwem-message 'warn (concat "Dissalowed to edit unbinded key "
+					   (key-description xwem-keys)
+					   " by `xwem-edmacro-can-edit-unbinded'")))
+	      ((null xwem-edmacro-can-edit-nonmacro)
+	       (xwem-message 'warn (concat "Dissalowed to edit non-macro key "
+					   (key-description xwem-keys)
+					   " by `xwem-edmacro-can-edit-nonmacro'.")))
+	      (t (xwem-message 'warn "Invalid keyboard macro given.")))
+
+      ;; XXX
+      (when xwem-edmacro-store-place
+	(xwem-special-popup-frame (get-buffer-create "*Edit Macro*") t)
+
+	;; Add some info in *Edit Macro* buffer
+	(let ((edmacro-format-hook
+	       (lambda ()
+		 (save-excursion
+		   (re-search-backward "Macro:")
+		   (previous-line 1)
+		   (insert (format "\n;; Key: %s\n" (key-description xwem-keys)))
+		   (insert (format ";; Type: %s\n" (if xwem-cmd
+						       (if (vectorp xwem-cmd)
+							   "binded macro"
+							 "binded command")
+						     "unbinded")))
+		   (when (not (vectorp xwem-cmd))
+		     (insert (format ";; Cmd: %S\n" xwem-cmd)))))))
+
+	  (edit-kbd-macro xwem-evs arg 'xwem-special-revert-focus 'xwem-edmacro-store)))
+      )))
+
+
+(provide 'xwem-edmacro)
+
+;;; xwem-edmacro.el ends here

File lisp/addons/xwem-framei.el

View file
  • Ignore whitespace
+;;; xwem-framei.el --- Frame indicator.
+
+;; Copyright (C) 2004 by Free Software Foundation, Inc.
+
+;; Author: Zajcev Evgeny <zevlg@yandex.ru>
+;; Created: Tue Jan 27 08:01:43 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:
+
+;; When switching frames indicate frame number using xwem-osd.
+;;
+;; Add something like this to your xwemrc.el to start using frame
+;; indicator:
+;;
+;;   (autoload 'xwem-framei-init "xwem-framei")
+;;   (add-hook 'xwem-after-init-hook 'xwem-framei-init)
+;;
+
+;;; Code:
+
+(require 'xwem-osd)
+
+(defgroup xwem-framei nil
+  "*Group to customize xwem frame indicator."
+  :prefix "xwem-framei-"
+  :group 'xwem-frame)
+
+(defcustom xwem-framei-showtime 1
+  "Period of time in second while xwem framei is shown."
+  :type 'number
+  :group 'xwem-framei)
+
+(defcustom xwem-framei-xoffset 20
+  "*X Offset from top left frame corner in pixels, where to show framei."
+  :type 'number
+  :group 'xwem-framei)
+
+(defcustom xwem-framei-yoffset 20
+  "*Y Offset from top left frame corner in pixels, where to show framei."
+  :type 'number
+  :group 'xwem-framei)
+
+(defface xwem-framei-face
+  `((t (:foreground "green2" :size 128 :family "helvetica")))
+  "*Face used to draw frame number."
+  :group 'xwem-framei)
+
+
+;;; Internal variables
+(defvar xwem-framei-osd nil
+  "Osd")
+
+(defvar xwem-framei-itimer nil
+  "Hidder itimer.")
+
+(defun xwem-framei-hidder ()
+  (xwem-osd-hide xwem-framei-osd))
+
+
+;;; Functions
+(defun xwem-framei-handle-switch (ofr nfr)
+  "Handle frame switching."
+  (let ((frgeom (xwem-frame-xgeom nfr)))
+
+    (xwem-osd-move xwem-framei-osd (+ xwem-framei-xoffset (X-Geom-x frgeom))
+		   (+ xwem-framei-yoffset (X-Geom-y frgeom)))
+    (xwem-osd-text xwem-framei-osd (format "%d" (xwem-frame-num nfr)))
+    (xwem-osd-show xwem-framei-osd)
+
+    (delete-itimer xwem-framei-itimer)
+    (set-itimer-value xwem-framei-itimer xwem-framei-showtime)
+    (activate-itimer xwem-framei-itimer)
+    ))
+
+(defun xwem-framei-init (&optional xdpy)
+  "Initialize xwem frame indicator on display XDPY."
+  (unless xdpy
+    (setq xdpy (xwem-dpy)))
+
+  (let (xwem-osd-always-ontop)
+    (setq xwem-framei-osd (xwem-osd-create xdpy 0 0 400 200)))
+
+  (setq xwem-framei-itimer (list "xwem-framei-timer" xwem-framei-showtime
+				 nil 'xwem-framei-hidder nil nil nil
+				 (list 0 0 0)))
+
+  (xwem-osd-set-color xwem-framei-osd (face-foreground-name 'xwem-framei-face))
+  (xwem-osd-set-font xwem-framei-osd (face-font-name 'xwem-framei-face))
+  
+  (add-hook 'xwem-frame-switch-hook 'xwem-framei-handle-switch))
+
+
+(provide 'xwem-framei)
+
+;;; xwem-framei.el ends here

File lisp/addons/xwem-gamma.el

View file
  • Ignore whitespace
+;;; xwem-gamma.el --- XWEM addon used to adjust gamma.
+
+;; Copyright (C) 2004 by Free Software Foundation, Inc.
+
+;; Author: Zajcev Evgeny <zevlg@yandex.ru>
+;; Created: Tue Jan 20 13:10:28 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:
+
+;; `xwem-gamma' uses uses `xlib-vidmode' Xlib extension and
+;; `color-selector' package.
+
+;; To use it do something like:
+;;
+;;     (xwem-gamma-widget (xwem-dpy))
+
+;;; Code:
+
+(require 'xlib-vidmode)
+(require 'color-selector)
+
+(defface xwem-gamma-face
+  `((t (:foreground "#1a1a1a" :background "black")))
+  "Face used to adjust gamma.")
+
+(defvar xwem-gamma-display nil
+  "X Display.")
+
+(defvar xwem-gamma-screen 0
+  "Screen number.")
+
+
+;;; Functions
+(defun xwem-gamma-corector (selector)
+  "Using SELECTOR adjust gamma."
+  (let* ((k (/ 9.9 256))
+	 (clist (color-selector-get-color selector))
+	 (rg (+ 0.1 (* k (car clist))))
+	 (gg (+ 0.1 (* k (cadr clist))))
+	 (bg (+ 0.1 (* k (caddr clist)))))
+    (X-XF86VidModeSetGamma xwem-gamma-display rg gg bg xwem-gamma-screen)
+    (xwem-message 'nolog "New gamma: r=%f g=%f b=%f" rg gg bg)))
+
+(defun xwem-gamma-widget (xdpy &optional screen-num)
+  "Start correcting gama on display XDPY and screen SCREEN-NUM."
+  (setq xwem-gamma-display xdpy)
+  (setq xwem-gamma-screen (or (and (numberp screen-num) screen-num) 0))
+  (color-selector-make-selector 'xwem-gamma-face 'foreground
+				'xwem-gamma-corector))
+
+
+(provide 'xwem-gamma)
+
+;;; xwem-gamma.el ends here

File lisp/addons/xwem-holer.el

View file
  • Ignore whitespace
+;;; xwem-holer.el --- Making holes in xwem frames.
+
+;; Copyright (C) 2004 by Free Software Foundation, Inc.
+
+;; Author: Zajcev Evgeny <zevlg@yandex.ru>
+;; Created: Thu Jan 15 12:39:04 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:
+
+;; This XWEM addon allow you to create/manipulate holes in XWEM
+;; frames.
+;;
+;; Add something following to your ~/.xwem/xwemrc.el to start using
+;; holer:
+
+;;   (autoload 'xwem-holer-imove-or-create "xwem-holer"
+;;     "Interactively move or create holer." t)
+;;   (autoload 'xwem-holer-idestroy "xwem-holer"
+;;     "Interactively destroy holer." t)
+;;   (autoload 'xwem-holer-iresize "xwem-holer"
+;;     "Interactively resize holer." t)
+
+;;   (define-key xwem-global-map [(hyper ?x) ?h button1]
+;;     'xwem-holer-imove-or-create)
+;;   (define-key xwem-global-map [(hyper ?x) ?h button2]
+;;     'xwem-holer-idestroy)
+;;   (define-key xwem-global-map [(hyper ?x) ?h button3]
+;;     'xwem-holer-iresize)
+
+;;; BUGS:
+;;
+;; - You can create/manipulate holes only on selected frame.
+
+;;; Code:
+(require 'xlib-xshape)
+
+
+(defgroup xwem-holer nil
+  "Group to customize xwem holer."
+  :prefix "xwem-holer-"
+  :group 'xwem)
+
+(defcustom xwem-holer-outline-width 3
+  "Width of outliner."
+  :type 'number
+  :group 'xwem-holer)
+
+(defcustom xwem-holer-outline-color "blue2"
+  "*Color of holer outliner."
+  :type '(restricted-sexp :match-alternatives ('nil xwem-misc-colorspec-valid-p))
+  :group 'xwem-holer)
+
+(defcustom xwem-holer-move-cursor-shape 'X-XC-fleur
+  "*Shape of cursor when moving holer."
+  :type (xwem-cursor-shape-choice)
+  :group 'xwem-holer)
+
+(defcustom xwem-holer-move-cursor-foreground "#0000AA"
+  "*Cursor's foreground when moving holer."
+  :type '(restricted-sexp :match-alternatives ('nil xwem-misc-colorspec-valid-p))
+  :group 'xwem-holer)
+
+(defcustom xwem-holer-move-cursor-background "#000088"
+  "*Cursor's background when moving holer."
+  :type '(restricted-sexp :match-alternatives ('nil xwem-misc-colorspec-valid-p))
+  :group 'xwem-holer)
+
+(defcustom xwem-holer-resize-cursor-foreground "#0000AA"
+  "*Cursor's foreground when resizing holer."
+  :type '(restricted-sexp :match-alternatives ('nil xwem-misc-colorspec-valid-p))
+  :group 'xwem-holer)
+
+(defcustom xwem-holer-resize-cursor-background "#000088"
+  "*Cursor's background when resizing holer."
+  :type '(restricted-sexp :match-alternatives ('nil xwem-misc-colorspec-valid-p))
+  :group 'xwem-holer)
+
+(defcustom xwem-holer-min-pixels 10
+  "*Minimum pixels to change holer geometry.
+Set it higher value to speed up moving/resizing."
+  :type 'number
+  :group 'xwem-holer)
+
+
+;;; Define holer prefix map
+(xwem-define-prefix-command 'xwem-holer-prefix t)
+(defvar xwem-holer-map (symbol-function 'xwem-holer-prefix)
+  "Keymap for holer (\\<xwem-global-map>\\[xwem-holer-prefix]) commands.
+Bindings:
+\\{xwem-holer-map}")
+
+(define-key xwem-holer-map [button1] 'xwem-holer-imove-or-create)
+(define-key xwem-holer-map [button2] 'xwem-holer-idestroy)
+(define-key xwem-holer-map [button3] 'xwem-holer-iresize)
+(define-key xwem-holer-map (xwem-kbd "h") 'xwem-holer-ihide)
+(define-key xwem-holer-map (xwem-kbd "s") 'xwem-holer-ishow)
+
+
+(defvar xwem-holers-list nil "List of all holers.")
+
+(defstruct xwem-holer
+  frame
+  x y width height
+
+  click-xoff click-yoff			; offset within holer where click occured
+
+  outliner-win				;
+  xmask xmask-gc xmask-bgc
+
+  mode					; nil, 'move, 'resize-bl,
+					; 'resize-br, 'resize-tl or
+					; 'resize-tr, 'hidden
+
+  ;; cursors
+  move-cursor
+  resize-bl-cursor resize-br-cursor
+  resize-tl-cursor resize-tr-cursor
+  )
+
+(defmacro xwem-holer-xdpy (holer)
+  "Return HOLER's display."
+  `(X-Win-dpy (xwem-frame-xwin (xwem-holer-frame holer))))
+
+(defsubst xwem-holer-add (holer)
+  "Add HOLER to the `xwem-holers-list'."
+  (pushnew holer xwem-holers-list))
+
+(defsubst xwem-holer-del (holer)
+  "Remove HOLER from `xwem-holers-list'."
+  (setq xwem-holers-list (delete holer xwem-holers-list)))
+
+(defsubst xwem-holer-find-by-frame (frame)
+  "Find holer by FRAME.
+Return list of holers for FRAME."
+  (let (holers)
+    (mapc (lambda (h)
+            (when (eq (xwem-holer-frame h) frame)
+              (setq holers (cons h holers))))
+          xwem-holers-list)
+    holers))
+
+
+(defun xwem-holer-clear (holer)
+  "Clear HOLER's xmask."
+  (let* ((xgeom (xwem-frame-xgeom (xwem-holer-frame holer)))
+	 (width (X-Geom-width xgeom))
+	 (height (X-Geom-height xgeom)))
+    (XFillRectangle (xwem-holer-xdpy holer) (xwem-holer-xmask holer)
+		    (xwem-holer-xmask-gc holer) 0 0 width height)))
+
+(defun xwem-holer-create (frame x y width height)
+  "Create new holer for FRAME with geometry +X+Y+WIDTHxHEIGHT."
+
+  (let* ((holer (make-xwem-holer :frame frame :x x :y y :width width :height height))
+	 (xdpy (xwem-holer-xdpy holer))
+	 (xgeom (xwem-frame-xgeom frame)))
+    
+    (setf (xwem-holer-xmask holer)
+	  (XCreatePixmap xdpy
+			 (make-X-Pixmap :dpy xdpy :id (X-Dpy-get-id xdpy))
+			 (xwem-frame-xwin frame) 1
+			 (X-Geom-width xgeom) (X-Geom-height xgeom)))
+    (setf (xwem-holer-xmask-gc holer)
+	  (XCreateGC xdpy (xwem-holer-xmask holer)
+		     (make-X-Gc :dpy xdpy :id (X-Dpy-get-id xdpy)
+				:foreground 1.0
+				:background 0.0)))
+    (setf (xwem-holer-xmask-bgc holer)
+	  (XCreateGC xdpy (xwem-holer-xmask holer)
+		     (make-X-Gc :dpy xdpy :id (X-Dpy-get-id xdpy)
+				:foreground 0.0
+				:background 1.0)))
+
+    (xwem-holer-clear holer)
+
+    (XFillRectangle xdpy (xwem-holer-xmask holer) (xwem-holer-xmask-bgc holer)
+		    x y width height)
+    (X-XShapeMask xdpy (xwem-frame-xwin frame)
+		  X-XShape-Bounding X-XShapeSet 0 0 (xwem-holer-xmask holer))
+    
+    ;; Create cursors
+    (setf (xwem-holer-move-cursor holer)
+	  (xwem-make-cursor (eval xwem-holer-move-cursor-shape)
+			    xwem-holer-move-cursor-foreground
+			    xwem-holer-move-cursor-background))
+    (setf (xwem-holer-resize-bl-cursor holer)
+	  (xwem-make-cursor X-XC-bottom_left_corner
+			    xwem-holer-resize-cursor-foreground
+			    xwem-holer-resize-cursor-background))
+    (setf (xwem-holer-resize-br-cursor holer)
+	  (xwem-make-cursor X-XC-bottom_right_corner
+			    xwem-holer-resize-cursor-foreground
+			    xwem-holer-resize-cursor-background))
+    (setf (xwem-holer-resize-tl-cursor holer)
+	  (xwem-make-cursor X-XC-top_left_corner
+			    xwem-holer-resize-cursor-foreground
+			    xwem-holer-resize-cursor-background))
+    (setf (xwem-holer-resize-tr-cursor holer)
+	  (xwem-make-cursor X-XC-top_right_corner
+			    xwem-holer-resize-cursor-foreground
+			    xwem-holer-resize-cursor-background))
+
+    ;; Outline holer
+    (setf (xwem-holer-outliner-win holer)
+	  (XCreateWindow xdpy (xwem-frame-xwin frame)
+			 (- x xwem-holer-outline-width)
+			 (- y xwem-holer-outline-width)
+			 width height xwem-holer-outline-width
+			 nil nil nil (make-X-Attr :override-redirect t
+						  :border-pixel (XAllocNamedColor xdpy (XDefaultColormap xdpy)
+										  xwem-holer-outline-color (make-X-Color)))))
+    (X-Win-put-prop (xwem-holer-outliner-win holer) 'xwem-holer holer)
+    (XMapWindow xdpy (xwem-holer-outliner-win holer))
+
+    ;; Finally add to `xwem-holers-list'
+    (xwem-holer-add holer)
+
+    holer))
+
+(defun xwem-holer-move (holer x y)
+  "Move HOLER to X Y."
+  (let ((xdpy (xwem-holer-xdpy holer)))
+    (setf (xwem-holer-x holer) x)
+    (setf (xwem-holer-y holer) y)
+
+    (xwem-holer-clear holer)
+    (XFillRectangle xdpy (xwem-holer-xmask holer) (xwem-holer-xmask-bgc holer)
+		    (xwem-holer-x holer) (xwem-holer-y holer)
+		    (xwem-holer-width holer) (xwem-holer-height holer))
+    (X-XShapeMask xdpy (xwem-frame-xwin (xwem-holer-frame holer))
+		  X-XShape-Bounding X-XShapeSet 0 0 (xwem-holer-xmask holer))
+
+    (XMoveWindow xdpy (xwem-holer-outliner-win holer)
+		 (- x xwem-holer-outline-width)
+		 (- y xwem-holer-outline-width))))
+
+(defun xwem-holer-resize (holer width height)
+  "Resize HOLER to WIDTH HEIGHT."
+  )
+
+(defun xwem-holer-move-resize (holer x y width height)
+  "Move and resize HOLER to X Y WIDTH HEIGHT geometry."
+  (let ((xdpy (xwem-holer-xdpy holer)))
+    (setf (xwem-holer-x holer) x)
+    (setf (xwem-holer-y holer) y)
+    (setf (xwem-holer-width holer) width)
+    (setf (xwem-holer-height holer) height)
+
+    (xwem-holer-clear holer)
+    (XFillRectangle xdpy (xwem-holer-xmask holer) (xwem-holer-xmask-bgc holer)
+		    (xwem-holer-x holer) (xwem-holer-y holer)
+		    (xwem-holer-width holer) (xwem-holer-height holer))
+    (X-XShapeMask xdpy (xwem-frame-xwin (xwem-holer-frame holer))
+		  X-XShape-Bounding X-XShapeSet 0 0 (xwem-holer-xmask holer))
+
+    (XMoveResizeWindow xdpy (xwem-holer-outliner-win holer)
+		       (- x xwem-holer-outline-width)
+		       (- y xwem-holer-outline-width)
+		       (xwem-holer-width holer)
+		       (xwem-holer-height holer))))
+  
+
+(defun xwem-holer-destroy (holer)
+  "Destroy HOLER."
+  (let ((xdpy (xwem-holer-xdpy holer)))
+    (xwem-holer-del holer)              ; remove from `xwem-holers-list'
+
+    (X-XShapeMask xdpy (xwem-frame-xwin (xwem-holer-frame holer))
+		  X-XShape-Bounding X-XShapeSet 0 0 nil)
+    (XFreePixmap xdpy (xwem-holer-xmask holer))
+    (XFreeGC xdpy (xwem-holer-xmask-gc holer))
+    (XFreeGC xdpy (xwem-holer-xmask-bgc holer))
+
+    ;; Finally destroy outliner window
+    (X-Win-rem-prop (xwem-holer-outliner-win holer) 'xwem-holer)
+    (XDestroyWindow xdpy (xwem-holer-outliner-win holer))))
+
+;;; Subroutines using when resizing
+(defun xwem-holer-change-mode-to-opposite (holer &optional width-p)
+  "Change HOLER's resize mode to opposite when resizing."
+  (let ((ww '(resize-tr resize-br resize-tl resize-bl))
+	(hh '(resize-bl resize-tl resize-br resize-tr))
+	(c (member (xwem-holer-mode holer) '(resize-tl resize-bl resize-tr resize-br))))
+    (when c
+      (setf (xwem-holer-mode holer) (nth (- 4 (length c)) (if width-p ww hh))))))
+
+(defun xwem-holer-calculate-new-geom (hl frx fry)
+  "Return list '(x y width height) represented new geometry for holer HL."
+  (let ((mode (xwem-holer-mode hl))
+	x y w h)
+    (cond ((eq mode 'resize-tl)
+	   (setq x frx
+		 y fry
+		 w (+ (- (xwem-holer-x hl) x) (xwem-holer-width hl))
+		 h (+ (- (xwem-holer-y hl) y) (xwem-holer-height hl))))
+	  ((eq mode 'resize-bl)
+	   (setq x frx
+		 y (xwem-holer-y hl)	; didnt affected
+		 h (- fry (xwem-holer-y hl))
+		 w (+ (- (xwem-holer-x hl) x) (xwem-holer-width hl))))
+	  ((eq mode 'resize-tr)
+	   (setq x (xwem-holer-x hl)
+		 y fry
+		 w (- frx x)
+		 h (+ (- (xwem-holer-y hl) y) (xwem-holer-height hl))))
+	  ((eq mode 'resize-br)
+	   (setq x (xwem-holer-x hl)
+		 y (xwem-holer-y hl)
+		 w (- frx (xwem-holer-x hl))
+		 h (- fry (xwem-holer-y hl))))
+	  )
+    (list x y w h)))
+
+(defun xwem-holer-event-handler (xdpy win xev)
+  "Handle events come from root window."
+  (X-Event-CASE xev
+    (:X-MotionNotify
+     (let ((hl (X-Win-get-prop win 'xwem-holer))
+	   frxgeom frx fry)
+       (when (xwem-holer-p hl)
+	 (setq frxgeom (xwem-frame-xgeom (xwem-holer-frame hl)))
+	 (setq frx (- (X-Event-xmotion-root-x xev) (X-Geom-x frxgeom)))
+	 (setq fry (- (X-Event-xmotion-root-y xev) (X-Geom-y frxgeom)))
+	 (cond ((eq (xwem-holer-mode hl) 'move)
+		;; Translate root coordinates to frame coordinates.
+		;; Using XTranslateCoordinates will slow down.
+		(let ((x (- frx (xwem-holer-click-xoff hl)))
+		      (y (- fry (xwem-holer-click-yoff hl))))
+		  (when (or (>= (abs (- x (xwem-holer-x hl))) xwem-holer-min-pixels)
+			    (>= (abs (- y (xwem-holer-y hl))) xwem-holer-min-pixels))
+		    (xwem-holer-move hl x y))))
+
+	       ;; Interactively resize holer
+	       ((member (xwem-holer-mode hl) '(resize-bl resize-br resize-tl resize-tr))
+		;; Calculate new geometry
+		(let* ((ngeom (xwem-holer-calculate-new-geom hl frx fry))
+		       (x (nth 0 ngeom))
+		       (y (nth 1 ngeom))
+		       (w (nth 2 ngeom))
+		       (h (nth 3 ngeom)))
+
+		  ;; When width or height is less then zero check is
+		  ;; there need to change resize mode.
+		  (when (or (< w 0) (< h 0))
+		    (when (< w 0)
+		      (xwem-holer-change-mode-to-opposite hl t))
+		    (when (< h 0)
+		      (xwem-holer-change-mode-to-opposite hl))
+		    (setq ngeom (xwem-holer-calculate-new-geom hl frx fry)
+			  x (nth 0 ngeom)
+			  y (nth 1 ngeom)
+			  w (nth 2 ngeom)
+			  h (nth 3 ngeom)))
+
+		  (when (and x y (> w 0) (> h 0)
+			     (or (>= (abs (- w (xwem-holer-width hl)))
+				     xwem-holer-min-pixels)
+				 (>= (abs (- h (xwem-holer-height hl)))
+				     xwem-holer-min-pixels)))
+		    (xwem-holer-move-resize hl x y w h))
+		  ))
+	       ))))
+
+    (:X-ButtonRelease
+     (XUngrabPointer xdpy)
+     (X-Win-EventHandler-rem (X-Event-xmotion-event xev) 'xwem-holer-event-handler)
+     (let ((hl (X-Win-get-prop win 'xwem-holer)))
+       (when (xwem-holer-p hl)
+	 (setf (xwem-holer-mode hl) nil)))
+     )
+
+    (:X-Expose
+     (let ((hl (X-Win-get-prop win 'xwem-holer)))
+       (when (xwem-holer-p hl)
+	 (X-XShapeMask xdpy (xwem-frame-xwin (xwem-holer-frame hl))
+		       X-XShape-Bounding X-XShapeSet 0 0 (xwem-holer-xmask hl)))))
+    ))
+
+(defun xwem-holer-find-frame (xev)
+  "Using ButtonPress XEV find out xwem frame."
+  ;; XXX
+  (xwem-frame-selected))
+
+(defun xwem-holer-find-holer (xev)
+  "Using ButtonPress XEV find out holer under pointer."
+  (when (= (X-Event-type xev) X-ButtonPress)
+    (let* ((xdpy (X-Event-dpy xev))
+	   (frame (xwem-holer-find-frame xev))
+	   (xt (and (xwem-frame-p frame)
+		    (XTranslateCoordinates xdpy (XDefaultRootWindow xdpy)
+					   (xwem-frame-xwin frame)
+					   (X-Event-xbutton-root-x xev)
+					   (X-Event-xbutton-root-y xev))))
+	   (chw (nth 3 xt))
+	   (hl (and (X-Win-p chw) (X-Win-get-prop chw 'xwem-holer))))
+      (when (xwem-holer-p hl)
+	(let ((hlxt (XTranslateCoordinates
+		     xdpy (XDefaultRootWindow xdpy)
+		     (xwem-holer-outliner-win hl)
+		     (X-Event-xbutton-root-x xev) (X-Event-xbutton-root-y xev))))
+	  (setf (xwem-holer-click-xoff hl) (nth 4 hlxt))
+	  (setf (xwem-holer-click-yoff hl) (nth 5 hlxt))
+
+	  hl)))))
+	
+(define-xwem-command xwem-holer-imove ()
+  "Move holer."
+  (xwem-interactive "_")
+
+  (let* ((xev xwem-last-xevent)
+	 (hl (xwem-holer-find-holer xev)))
+    (when (xwem-holer-p hl)
+      (setf (xwem-holer-mode hl) 'move)
+      (XGrabPointer (X-Event-dpy xev)
+		    (xwem-holer-outliner-win hl)
+		    (truncate (Xmask-or XM-ButtonPress XM-ButtonRelease XM-ButtonMotion))
+		    (xwem-holer-move-cursor hl))
+      (X-Win-EventHandler-add-new (xwem-holer-outliner-win hl) 'xwem-holer-event-handler)
+      )))
+
+(define-xwem-command xwem-holer-imove-or-create ()
+  "Move already existing holer or create new."
+  (xwem-interactive "_")
+
+  (let* ((xev xwem-last-xevent)
+	 (hl (xwem-holer-find-holer xev)))
+    (if (xwem-holer-p hl)
+	(call-interactively 'xwem-holer-imove)
+
+      ;; Create new holer
+      (let ((frame (xwem-holer-find-frame xev))
+	    frxgeom frx fry)
+	
+	(when (xwem-frame-p frame)
+	  (setq frxgeom (xwem-frame-xgeom frame))
+	  (setq frx (- (X-Event-xmotion-root-x xev) (X-Geom-x frxgeom)))
+	  (setq fry (- (X-Event-xmotion-root-y xev) (X-Geom-y frxgeom)))
+
+	  (xwem-holer-create frame (- frx 1) (- fry 1) 1 1)
+	  ;; After this resizing should appear in 'resize-br mode
+	  (call-interactively 'xwem-holer-iresize))))))
+      
+(define-xwem-command xwem-holer-iresize ()
+  "Resize holer."
+  (xwem-interactive "_")
+
+  (let* ((xev xwem-last-xevent)
+	 (hl (xwem-holer-find-holer xev)))
+    (when (xwem-holer-p hl)
+      (let ((cx (xwem-holer-click-xoff hl))
+	    (cy (xwem-holer-click-yoff hl))
+	    (hw (/ (xwem-holer-width hl) 2)) ; half of width
+	    (hh (/ (xwem-holer-height hl) 2)) ; half of height
+	    cursor)
+	(cond ((and (> cx hw) (> cy hh))
+	       (setf (xwem-holer-mode hl) 'resize-br)
+	       (setq cursor (xwem-holer-resize-br-cursor hl)))
+
+	      ((> cx hw)
+	       (setf (xwem-holer-mode hl) 'resize-tr)
+	       (setq cursor (xwem-holer-resize-tr-cursor hl)))
+
+	      ((and (<= cx hw) (> cy hh))
+	       (setf (xwem-holer-mode hl) 'resize-bl)
+	       (setq cursor (xwem-holer-resize-bl-cursor hl)))
+
+	      ((<= cx hw)
+	       (setf (xwem-holer-mode hl) 'resize-tl)
+	       (setq cursor (xwem-holer-resize-tl-cursor hl))))
+
+	(XGrabPointer (X-Event-dpy xev)
+		      (xwem-holer-outliner-win hl)
+		      (truncate (Xmask-or XM-ButtonPress XM-ButtonRelease XM-ButtonMotion))
+		      cursor)
+	(X-Win-EventHandler-add-new (xwem-holer-outliner-win hl) 'xwem-holer-event-handler)
+	))))
+
+(define-xwem-command xwem-holer-idestroy ()
+  "Destroy holer."
+  (xwem-interactive)
+
+  (let* ((xev xwem-last-xevent)
+	 (hl (xwem-holer-find-holer xev)))
+    (when (xwem-holer-p hl)
+      (xwem-holer-destroy hl)
+
+      (xwem-message 'info "Holler at %dx%d destroyed."
+		    (X-Event-xbutton-root-x xev)
+		    (X-Event-xbutton-root-y xev)))))
+
+(define-xwem-command xwem-holer-ihide (frame)
+  "Hide all holers for FRAME.
+If FRAME is ommited - `xwem-frame-selected' assumed."
+  (xwem-interactive (list (xwem-frame-selected)))
+
+  (let* ((xwin (xwem-frame-xwin frame))
+         (xdpy (X-Win-dpy xwin)))
+
+    (mapc (lambda (h)
+            (XUnmapWindow xdpy (xwem-holer-outliner-win h)))
+          (xwem-holer-find-by-frame frame))
+
+    (X-XShapeMask xdpy xwin X-XShape-Bounding X-XShapeSet 0 0 nil)))
+
+(define-xwem-command xwem-holer-ishow (frame)
+  "Show all holers for FRAME.
+If FRAME is ommited - `xwem-frame-selected' assumed."
+  (xwem-interactive (list (xwem-frame-selected)))
+
+  (let* ((xwin (xwem-frame-xwin frame))
+         (xdpy (X-Win-dpy xwin)))
+
+    (mapc (lambda (h)
+            (XMapWindow xdpy (xwem-holer-outliner-win h))
+            (X-XShapeMask xdpy xwin
+                          X-XShape-Bounding X-XShapeSet 0 0 (xwem-holer-xmask h)))
+          (xwem-holer-find-by-frame frame))))
+
+
+(provide 'xwem-holer)
+
+;;; xwem-holer.el ends here

File lisp/addons/xwem-keytt.el

View file
  • Ignore whitespace
+;;; xwem-keytt.el --- Keypress translation table.
+
+;; Copyright (C) 2003 by Free Software Foundation, Inc.
+
+;; Author: Zajcev Evgeny <zevlg@yandex.ru>
+;; Created: Fri Dec 12 19:33:35 MSK 2003
+;; Keywords: xwem, xlib
+;; 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:
+
+;; 
+
+;;; Code:
+
+;; Translation table
+(defcustom xwem-key-tt-alist nil
+  "*Keypresses translation table.
+Alist in where keys is source keypress and value is destination keypress.
+Each keypresses is in form returned from `kbd'."
+  :type 'alist
+  :group 'xwem-keyboard)
+
+
+
+;; Functions
+(define-xwem-command xwem-key-tt-command ()
+  "Command to perform keypress translation."
+  (xwem-interactive)
+
+  (let* ((prk xwem-this-command-keys)
+	 (tte (assoc prk xwem-key-tt-alist)))
+    (if tte
+	(X-Dpy-send-excursion (xwem-dpy)
+	  (xwem-key-send-ekeys (cdr tte)))
+
+      (xwem-message 'warn "Can't find tt entry for: %S" prk))))
+
+(defun xwem-key-tt-init ()
+  "Initialize translation table.
+Translation table is alist with elements in form:
+  (issued-key . send-key)
+
+i.e. tt substitutes pressed key ISSUED-KEY with SEND-KEY actually it
+will looks like you press SEND-KEY."
+  (mapcar (lambda (el)
+	    (xwem-define-key (car el) 'xwem-key-tt-command))
+	  xwem-key-tt-alist))
+
+
+
+
+(provide 'xwem-keytt)
+
+;;; xwem-keytt.el ends here

File lisp/addons/xwem-osd.el

View file
  • Ignore whitespace
+;;; xwem-osd.el --- On Screen Display implementation for XWEM.
+
+;; Copyright (C) 2004 by Free Software Foundation, Inc.
+
+;; Author: Zajcev Evgeny <zevlg@yandex.ru>
+;; Created: Mon Jan 12 13:14:32 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:
+
+;; Support for on screen display in XWEM.  xwem-osd can display text,
+;; processing bar, other stuff using shaped window.  The main feature
+;; of this OSD implementation that it uses OSD instances to display
+;; stuff, so it does not need to handle expose events.
+
+;;; Code:
+
+(eval-when-compile
+  (require 'cl))
+
+(require 'xlib-xshape)
+
+(defconst xwem-osd-instance-types '(text line arc rect)
+  "List of valid types of osd instance.")
+
+
+(defstruct xwem-osd-instance
+  type					; instance type, see `xwem-osd-instance-types'
+  osd					; back reference to osd
+  (depth 0)				; depth
+
+  xwin xmask
+  color)				; instance background color
+
+(defmacro xwem-osd-instance-xdpy (osin)
+  "Return display of OSIN osd instance."
+  `(xwem-osd-xdpy (xwem-osd-instance-osd osin)))
+
+(defstruct xwem-osd
+  state					; 'destroyed, 'hided or 'shown
+  x y
+  width height
+
+  xdpy
+  xwin
+  xmask
+
+  gc					; GC used to draw
+  mask-gc				; GC used to draw mask
+
+  instances				; list of xwem-osd-instance structs sorted by depth
+
+  plist)				; User defined plist
+
+(defcustom xwem-osd-default-font "fixed"
+  "Default font for text drawed in osd.")
+
+(defcustom xwem-osd-default-color "black"
+  "Default color used to draw.")
+
+(defcustom xwem-osd-always-ontop t
+  "*Non-nil mean that OSD's winow will be always on top.")
+
+
+;;; Functions
+(defun xwem-osd-event-handler (xdpy xwin xev)
+  "On X display XDPY and window XWIN handle X Event XEV."
+  (let ((osd (xwem-osd-get-osd xwin)))
+    (when (xwem-osd-p osd)
+      (X-Event-CASE xev
+	(:X-DestroyNotify
+	 (xwem-osd-destroy osd t))
+	))))
+
+(defun xwem-osd-root-event-handler (xdpy xwin xev)
+  "Root window event handler for OSD."
+  (X-Event-CASE xev
+    (:X-ConfigureNotify
+     (let ((osd (xwem-osd-get-osd (X-Event-xconfigure-above-sibling xev))))
+       (when (xwem-osd-p osd)
+	 ;; OSD's window is above sibling for some other window, so it
+	 ;; is (osd's window) obscured and we need to pop it back.
+	 (xwem-osd-show osd)
+	 )))
+    ))
+
+;;; Instances operations
+(defun xwem-osd-instance-destroy (osin)
+  "Destroy osd instance OSIN."
+  (XDestroyWindow (xwem-osd-instance-xdpy osin) (xwem-osd-instance-xwin osin))
+  (XFreePixmap (xwem-osd-instance-xdpy osin) (xwem-osd-instance-xmask osin))
+  )
+
+(defun xwem-osd-add-instance (osd depth color)
+  "In OSD add osd instance with background COLOR.
+Return newly created osd instance."
+  (let ((xdpy (xwem-osd-xdpy osd))
+	(osin (make-xwem-osd-instance :osd osd :depth depth
+				      :color color)))
+    (setf (xwem-osd-instance-xwin osin)
+	  (XCreateWindow xdpy (xwem-osd-xwin osd)
+			 0 0 (xwem-osd-width osd) (xwem-osd-height osd)
+			 0 nil nil nil
+			 (make-X-Attr :override-redirect t
+				      :background-pixel (XAllocNamedColor xdpy (XDefaultColormap xdpy)
+									  color (make-X-Color)))))
+    (setf (xwem-osd-instance-xmask osin)
+	  (XCreatePixmap xdpy (make-X-Pixmap :dpy xdpy :id (X-Dpy-get-id xdpy))
+			 (xwem-osd-instance-xwin osin) 1
+			 (xwem-osd-width osd) (xwem-osd-height osd)))
+    (xwem-osd-instance-clear osin)
+
+    (push osin (xwem-osd-instances osd))
+    ;; TODO: - sort instances according to depth
+
+    osin))
+
+(defun xwem-osd-instance-clear (osin)
+  "Clear mask area of OSD instance."
+  (let ((osd (xwem-osd-instance-osd osin)))
+    (xwem-osd-mask-fgbg osd)
+    (XFillRectangle (xwem-osd-xdpy osd) (xwem-osd-instance-xmask osin) (xwem-osd-mask-gc osd)
+		    0 0 (xwem-osd-width osd) (xwem-osd-height osd))
+    (xwem-osd-mask-fgbg osd)))
+
+(defun xwem-osd-instance-show (osin)
+  "Show osd instance OSIN."
+  (XMapWindow (xwem-osd-instance-xdpy osin) (xwem-osd-instance-xwin osin)))
+
+(defun xwem-osd-instance-set-color (osin new-color)
+  "Set new color."
+  (let ((xdpy (xwem-osd-instance-xdpy osin)))
+    (setf (xwem-osd-instance-color osin) new-color)
+    (XSetWindowBackground xdpy (xwem-osd-instance-xwin osin)
+			  (XAllocNamedColor xdpy (XDefaultColormap xdpy)
+					    new-color (make-X-Color)))
+    (XClearArea xdpy (xwem-osd-instance-xwin osin)
+		0 0 (xwem-osd-width (xwem-osd-instance-osd osin))
+		(xwem-osd-height (xwem-osd-instance-osd osin)) nil)))
+
+;;; OSD functions
+(defun xwem-osd-create (xdpy x y width height &optional x-parent)
+  "On X display XDPY create new xwem osd context with +X+Y/WIDTHxHEIGHT geometry on X-PARENT."
+  (let ((osd (make-xwem-osd :xdpy xdpy :x x :y y :width width :height height)))
+    (setf (xwem-osd-xwin osd)
+	  (XCreateWindow xdpy (or x-parent (XDefaultRootWindow xdpy))
+			 x y width height 0 nil nil nil
+			 (make-X-Attr :override-redirect t
+				      :background-pixel (XBlackPixel xdpy)
+				      :event-mask (Xmask-or XM-StructureNotify))))
+    ;; Create gc
+    (setf (xwem-osd-gc osd)
+	  (XCreateGC xdpy (xwem-osd-xwin osd)
+		     (make-X-Gc :dpy xdpy :id (X-Dpy-get-id xdpy)
+				:foreground (XAllocNamedColor xdpy (XDefaultColormap xdpy)
+							      xwem-osd-default-color (make-X-Color))
+				:font (X-Font-get xdpy xwem-osd-default-font))))
+
+    (X-Win-put-prop (xwem-osd-xwin osd) 'osd-ctx osd)
+    (X-Win-EventHandler-add-new (xwem-osd-xwin osd) 'xwem-osd-event-handler)
+
+    (when xwem-osd-always-ontop
+      (X-Win-EventHandler-add-new (XDefaultRootWindow xdpy) 'xwem-osd-root-event-handler))
+
+    (xwem-osd-create-mask osd)
+    osd))
+
+(defun xwem-osd-get-osd (xwin)
+  "Get osd context associated with XWIN."
+  (and (X-Win-p xwin) (X-Win-get-prop xwin 'osd-ctx)))
+
+(defun xwem-osd-mask-fgbg (osd)
+  "Exchange foreground and background colors in OSD's mask gc."
+  (let* ((mgc (xwem-osd-mask-gc osd))