sawfish r4393 - in trunk: . lisp lisp/sawfish/wm lisp/sawfish/wm/tabs man
- From: chrisb svn gnome org
- To: svn-commits-list gnome org
- Subject: sawfish r4393 - in trunk: . lisp lisp/sawfish/wm lisp/sawfish/wm/tabs man
- Date: Tue, 3 Feb 2009 22:35:58 +0000 (UTC)
Author: chrisb
Date: Tue Feb 3 22:35:58 2009
New Revision: 4393
URL: http://svn.gnome.org/viewvc/sawfish?rev=4393&view=rev
Log:
- merge tabbing system
- remove --copy flag from intltoolize
Added:
trunk/lisp/sawfish/wm/tabs/
trunk/lisp/sawfish/wm/tabs/marks.jl
trunk/lisp/sawfish/wm/tabs/tab.jl
trunk/lisp/sawfish/wm/tabs/tabgroup.jl
Modified:
trunk/ChangeLog
trunk/autogen.sh
trunk/lisp/Makefile.in
trunk/lisp/sawfish/wm/autoload.jl
trunk/lisp/sawfish/wm/keymaps.jl
trunk/man/news.texi
Modified: trunk/autogen.sh
==============================================================================
--- trunk/autogen.sh (original)
+++ trunk/autogen.sh Tue Feb 3 22:35:58 2009
@@ -26,7 +26,7 @@
fi
fi
echo "Running intltoolize"
- intltoolize --force --copy || exit 1
+ intltoolize --force || exit 1
echo "Running aclocal $ACLOCAL_FLAGS"
aclocal -I m4 $ACLOCAL_FLAGS || exit 1
Modified: trunk/lisp/Makefile.in
==============================================================================
--- trunk/lisp/Makefile.in (original)
+++ trunk/lisp/Makefile.in Tue Feb 3 22:35:58 2009
@@ -43,7 +43,8 @@
sawfish/wm/placement \
sawfish/wm/animation sawfish/wm/theming \
sawfish/wm/state sawfish/wm/gnome sawfish/wm/util \
- sawfish/wm/commands sawfish/wm/session
+ sawfish/wm/commands sawfish/wm/session \
+ sawfish/wm/tabs
all : lisp
set -e; for d in $(SUBDIRS); do \
Modified: trunk/lisp/sawfish/wm/autoload.jl
==============================================================================
--- trunk/lisp/sawfish/wm/autoload.jl (original)
+++ trunk/lisp/sawfish/wm/autoload.jl Tue Feb 3 22:35:58 2009
@@ -127,6 +127,7 @@
(autoload-command 'cycle-class-backwards 'sawfish.wm.commands.x-cycle)
(autoload-command 'cycle-dock 'sawfish.wm.commands.x-cycle)
(autoload-command 'cycle-dock-backwards 'sawfish.wm.commands.x-cycle)
+(defgroup tabs (_"Tabs"))
(autoload-command (quote xterm) (quote sawfish.wm.commands.xterm))
(autoload-command (quote 3d-hack) (quote sawfish.wm.ext.3d-hack) #:class 'default)
(defgroup audio (_"Sound") :require sawfish.wm.ext.audio-events)
Modified: trunk/lisp/sawfish/wm/keymaps.jl
==============================================================================
--- trunk/lisp/sawfish/wm/keymaps.jl (original)
+++ trunk/lisp/sawfish/wm/keymaps.jl Tue Feb 3 22:35:58 2009
@@ -87,7 +87,9 @@
(defcustom global-keymap (bind-keys (make-keymap)
"W-Left" 'previous-workspace
"W-Right" 'next-workspace
- "W-Tab" 'cycle-windows)
+ "W-Tab" 'cycle-windows
+ "W-ISO_Left_Tab" 'tab-raise-left-window
+ "H-ISO_Left_Tab" 'tab-raise-right-window)
(_"Keymap containing bindings active anywhere.")
:group bindings
:type keymap
@@ -100,7 +102,8 @@
"W-Button3-Click1" 'raise-lower-window
"W-Button2-Click1" 'popup-window-menu
"W-Button1-Move" 'move-window-interactively
- "Button1-Click1" 'raise-and-pass-through-click)
+ "Button1-Click1" 'raise-and-pass-through-click
+ "H-g" 'add-to-group)
(_"Keymap containing bindings active when a client window is focused.")
:group bindings
:type keymap
@@ -174,6 +177,15 @@
:group bindings
:type keymap)
+ (defcustom tab-keymap (bind-keys (make-keymap)
+ "Button1-Move" 'move-window-interactively
+ "Button1-Off" 'raise-window
+ "Button2-Off" 'mygroup
+ "Button3-Off" 'raise-lower-window)
+ (_"Keymap containing bindings active when the pointer is on a tab")
+ :group bindings
+ :type keymap)
+
(defvar pointer-motion-threshold 2
"Distance in pixels pointer must move before generating motion events.")
Added: trunk/lisp/sawfish/wm/tabs/marks.jl
==============================================================================
--- (empty file)
+++ trunk/lisp/sawfish/wm/tabs/marks.jl Tue Feb 3 22:35:58 2009
@@ -0,0 +1,42 @@
+;; marks.jl - Provide a way to operate on multiple windows
+;;
+;; Author : Yann Hodique <Yann Hodique lifl fr>
+
+(define-structure sawfish.wm.tabs.marks
+
+ (export mark-window
+ unmark-window
+ unmark-all-windows
+ apply-on-marked-windows
+ marked-windows)
+
+ (open rep
+ rep.system
+ sawfish.wm.misc
+ sawfish.wm.custom
+ sawfish.wm.commands)
+
+ (define-structure-alias marks sawfish.wm.tabs.marks)
+
+ (defvar marked-windows-list nil)
+
+ (define (mark-window win)
+ (setq marked-windows-list (append marked-windows-list (list win))))
+
+ (define-command 'mark-window mark-window #:spec "%W")
+
+ (define (unmark-window win)
+ (setq marked-windows-list (remove win marked-windows-list)))
+
+ (define-command 'unmark-window unmark-window #:spec "%W")
+
+ (define (unmark-all-windows)
+ (setq marked-windows-list nil))
+
+ (define-command 'unmark-all-windows unmark-all-windows)
+
+ (define (apply-on-marked-windows func)
+ (mapcar func marked-windows-list))
+
+ (define (marked-windows)
+ (not (eq marked-windows-list nil))))
Added: trunk/lisp/sawfish/wm/tabs/tab.jl
==============================================================================
--- (empty file)
+++ trunk/lisp/sawfish/wm/tabs/tab.jl Tue Feb 3 22:35:58 2009
@@ -0,0 +1,150 @@
+;; tab.jl - Emulate fluxbox tabs system
+;;
+;; Author : Yann Hodique <Yann Hodique lifl fr>
+;;
+;; Heavily modified by Scott Scriven <sawfish toykeeper net>
+;;
+;; Modified by Nathan Froyd <froydnj gmail com>
+;;
+;; Intltoolized/Reworked by Christopher Bratusek <zanghar freenet de>
+;;
+;; Usage:
+;; Copy this file to somewhere in your sawfish load-path, for example
+;; "~/.sawfish/lisp". Then add (require 'tab) to your ~/.sawfishrc and restart
+;; sawfish or issue the (load "tab") from sawfish-client.
+;;
+;; Be sure to also put marks.jl and tabgroup.jl in the same location. The tab.jl
+;; file requires these.
+;;
+;; After loading "tab", be sure to do the same with "tab-keymap" . Feel free to
+;; customize the key bindings in that file.
+;;
+;; You will also need a tab-enabled theme, in order to see any visual difference.
+;; There should be such a theme included with this file.
+
+
+(define-structure sawfish.wm.tabs.tab
+
+ (export add-to-group )
+
+ (open rep
+ rep.system
+ sawfish.wm.misc
+ sawfish.wm.custom
+ sawfish.wm.commands
+ sawfish.wm.frames
+ sawfish.wm.tabs.tabgroup
+ sawfish.wm.tabs.marks
+ sawfish.wm.windows)
+
+ (define-structure-alias tab sawfish.wm.tabs.tab)
+
+ ;; TODO:
+ ;; - change other tab sizes when window resizes itself
+ ;; - make calculations work with tiny windows
+ ;; - hide some frame parts on leftmost and rightmost tabs
+ ;; - add a drag-n-drop way to group windows by tabs
+
+ ;;###autoload (defgroup tabs (_"Tabs"))
+
+ (defgroup tabs (_"Tabs"))
+
+ (defcustom tab-left-dec-width 11 (_"Width of tab's left-edge decoration")
+ :group tabs
+ :type number)
+
+ (defcustom tab-right-dec-width 11 (_"Width of tab's right-edge decoration")
+ :group tabs
+ :type number)
+
+ (defcustom tab-left-margin 16 (_"Width of tab area's left-edge decoration")
+ :group tabs
+ :type number)
+
+ (defcustom tab-right-margin 16 (_"Width of tab area's right-edge decoration")
+ :group tabs
+ :type number)
+
+ (define (get-tab-pos win)
+ (let* ((group (tab-find-window win))
+ (tabnum (tab-rank win (tab-group-window-list group))))
+ (tab-pos group tabnum win)))
+
+ (define (tab-pos group tabnum win)
+ "find the left and right pixel offsets of a tab"
+ (let* ((tabarea-width (+
+ ; get width of a window in this group
+ ;(car (window-dimensions (car (tab-group-window-list group))))
+ (car (window-dimensions win))
+ (- tab-left-margin)
+ (- tab-right-margin)))
+ (numtabs (length (tab-group-window-list group)))
+ (left (quotient (* tabnum tabarea-width) numtabs))
+ ; the right edge is not always "left + (window-width / numtabs)"
+ ; that would be inaccurate due to rounding errors
+ (right (quotient (* (+ tabnum 1) tabarea-width) numtabs))
+ (width (- right left)))
+ (list left right width)))
+
+ (define (tab-title-text-width win)
+ "width of the title text area is the tabwidth minus decorations"
+ (let* ((tabwidth (nth 2 (get-tab-pos win))))
+ (+ tabwidth
+ (- tab-left-dec-width)
+ (- tab-right-dec-width))))
+
+ (define (tab-left-edge win)
+ "Compute left edge of tab"
+ (let* ((left (nth 0 (get-tab-pos win))))
+ (+ left tab-left-margin)))
+
+ (define (tab-right-dec-pos win)
+ "Compute position of tab's right-edge decoration"
+ (let* ((right (nth 1 (get-tab-pos win))))
+ (+ right tab-left-margin (- tab-right-dec-width))))
+
+ (define (tab-title-left-edge win)
+ "Compute left edge of tab"
+ (+ (tab-left-edge win) tab-left-dec-width))
+
+ ;; new class : tab
+ (define-frame-class 'tab
+ `((cursor . left_ptr)
+ (x-justify . center)
+ (y-justify . center)
+ (left-edge . ,tab-title-left-edge)
+ (width . ,tab-title-text-width)))
+ (set-frame-part-value 'tab 'keymap 'title-keymap)
+
+ (define-frame-class 'tab-l
+ `((cursor . left_ptr)
+ (left-edge . ,tab-left-edge)) t)
+
+ (define-frame-class 'tab-r
+ `((cursor . left_ptr)
+ (left-edge . ,tab-right-dec-pos)) t)
+
+ (define (mygroup win)
+ (if (marked-windows)
+ (progn
+ (apply-on-marked-windows (lambda (w) (tab-group-window w win)))
+ (unmark-all-windows))
+ (mark-window win)))
+
+ (define-command 'add-to-group mygroup #:spec "%W"))
+
+ ;(require 'x-cycle)
+ ;(define-cycle-command-pair
+ ; 'cycle-tabgroup 'cycle-tabgroup-backwards
+ ; (lambda (w)
+ ; (delete-if-not window-in-cycle-p
+ ; (delete-if (lambda (win)
+ ; (and (not (eq win w))
+ ; (tab-same-group-p win w)))
+ ; (workspace-windows current-workspace))
+ ; )
+ ; )
+ ; #:spec "%W")
+
+ ;(require 'sawfish.wm.util.window-order)
+
Added: trunk/lisp/sawfish/wm/tabs/tabgroup.jl
==============================================================================
--- (empty file)
+++ trunk/lisp/sawfish/wm/tabs/tabgroup.jl Tue Feb 3 22:35:58 2009
@@ -0,0 +1,212 @@
+;; group.jl - Make windows
+;;
+;; Author : Yann Hodique <Yann Hodique lifl fr>
+;;
+;; Modified by Scott Scriven <sawfish toykeeper net>
+;; (mostly hook updates)
+
+(define-structure sawfish.wm.tabs.tabgroup
+
+ (export tab-release-window
+ tab-raise-left-window
+ tab-raise-right-window
+ tab-find-window
+ tab-rank
+ tab-group-window-list
+ tab-group-window)
+
+ (open rep
+ rep.system
+ rep.data.records
+ sawfish.wm.misc
+ sawfish.wm.custom
+ sawfish.wm.commands
+ sawfish.wm.windows
+ sawfish.wm.state.iconify
+ sawfish.wm.state.shading
+ sawfish.wm.stacking)
+
+ (define-structure-alias tabgroup sawfish.wm.tabs.tabgroup)
+
+ (defvar tab-groups nil)
+
+ (defvar tab-refresh-lock t)
+ (defvar tab-move-lock t)
+
+ (define-record-type :tab-group
+ (tab-build-group p d wl)
+ tab-group?
+ (p tab-group-position)
+ (d tab-group-dimensions)
+ (wl tab-group-window-list))
+
+ (define (tab-move-resize-frame-window-to win x y w h)
+ "move and resize according to *frame* dimensions"
+ (let* ((dim1 (window-dimensions win))
+ (dim2 (window-frame-dimensions win))
+ (dw (- (car dim2) (car dim1)))
+ (dh (- (cdr dim2) (cdr dim1))))
+ (move-resize-window-to win x y (- w dw) (- h dh))))
+
+ (define (tab-make-new-group win)
+ "Return a new group containing only win"
+ (let* ((pos (window-position win))
+ (dim (window-frame-dimensions win))
+ (group (tab-build-group pos dim (list win))))
+ (setq tab-groups (append tab-groups (cons group nil)))
+ group))
+
+ (define (tab-find-window win)
+ "Return a group containing win"
+ (let loop ((gr tab-groups))
+ (cond
+ ((null gr)
+ (tab-make-new-group win)
+ )
+ ((member win (tab-group-window-list (car gr)))
+ (car gr))
+ (t
+ (loop (cdr gr))))))
+
+ (define (tab-window-group-index win)
+ "Return the index of the group containing win"
+ (let loop ((index 0))
+ (cond
+ ((eq index (length tab-groups))
+ (tab-make-new-group win)
+ index)
+ ((member win (tab-group-window-list (nth index tab-groups)))
+ index)
+ (t
+ (loop (+ index 1))))))
+
+ (define (tab-rank elem list)
+ (if (eq elem (car list))
+ 0
+ (+ 1 (tab-rank elem (cdr list)))))
+
+ (define (tab-delete-window-from-group win index)
+ "Remove a window from a group at given index"
+ (let* ((old (nth index tab-groups))
+ (l (remove win (tab-group-window-list old))))
+ (if (null l)
+ (setq tab-groups (delete old tab-groups))
+ (rplaca (nthcdr index tab-groups)
+ (tab-build-group (tab-group-position old) (tab-group-dimensions old) l))
+ (tab-refresh-group (car l) 'frame))))
+
+ (define (tab-delete-window-from-tab-groups w)
+ "Find window's group and remove it"
+ (tab-delete-window-from-group w (tab-window-group-index w)))
+
+ (define (tab-put-window-in-group win index)
+ "Put window in group at given index"
+ (let* ((group (nth index tab-groups))
+ (dim (tab-group-dimensions group))
+ (pos (tab-group-position group)))
+ (rplaca (nthcdr index tab-groups)
+ (tab-build-group (tab-group-position group)
+ (tab-group-dimensions group)
+ (append (tab-group-window-list group) (list win))))
+ (tab-move-resize-frame-window-to win (car pos) (cdr pos) (car dim) (cdr dim))
+ (rebuild-frame win)))
+
+ (define (tab-refresh-group win prop)
+ "Refresh the entire group containing win according to prop
+ prop can be one of the symbols : frame, move, resize, shade, unshade"
+ (when tab-refresh-lock
+ (setq tab-refresh-lock nil)
+ (unwind-protect
+ (let* ((index (tab-window-group-index win))
+ (wins (tab-group-window-list (nth index tab-groups))))
+ (cond
+ ((eq prop 'frame)
+ (mapcar (lambda (w)
+ (rebuild-frame w)) wins))
+ ((or (eq prop 'move) (eq prop 'resize))
+ (let ((dim (window-frame-dimensions win))
+ (pos (window-position win)))
+ (mapcar (lambda (w)
+ (tab-move-resize-frame-window-to w (car pos) (cdr pos) (car dim) (cdr dim))
+ (rebuild-frame w)) wins)
+ (rplaca (nthcdr index tab-groups)
+ (tab-build-group pos dim wins))))
+ ((eq prop 'stick)
+ (mapcar (lambda (w)
+ (toggle-window-sticky w)) wins))
+ ((eq prop 'shade)
+ (mapcar (lambda (w)
+ (shade-window w)
+ (rebuild-frame w)) wins))
+ ((eq prop 'unshade)
+ (mapcar (lambda (w)
+ (unshade-window w)
+ (rebuild-frame w)) wins))))
+ (setq tab-refresh-lock t))))
+
+ ;; Entry points
+ (define (tab-group-window w win)
+ "Put active window in pointer-selected group"
+ (interactive)
+ (let* ((index (tab-window-group-index win))
+ (index2 (tab-window-group-index w)))
+ (tab-refresh-group win 'move) ;ugly hack, don't know why it's needed, but new groups are listed with pos (0,0)
+ (tab-put-window-in-group w index)
+ (tab-delete-window-from-group w index2)
+ (tab-refresh-group w 'move)))
+
+ (define (tab-release-window w)
+ "Release active window from its group"
+ (tab-delete-window-from-tab-groups w)
+ (tab-make-new-group w))
+
+ (define-command 'tab-release-window tab-release-window #:spec "%f")
+
+ (define (tab-group-offset win n)
+ "Return the window at position (pos+n) in window's group"
+ (let* ((gr (tab-group-window-list (tab-find-window win)))
+ (size (length gr))
+ (r (tab-rank win gr)))
+ (nth (modulo (+ r n) size) gr)))
+
+ (define (tab-same-group-p w1 w2)
+ "Predicate : true <=> w1 and w2 are grouped together"
+ (member w1 (tab-group-window-list (tab-find-window w2))))
+
+ (define (tab-raise-left-window)
+ "Raise left window in current group"
+ (let ((win (tab-group-offset (input-focus) -1)))
+ (raise-window win)
+ (set-input-focus win)))
+
+ (define-command 'tab-raise-left-window tab-raise-left-window)
+
+ (define (tab-raise-right-window)
+ "Raise right window in current group"
+ (let ((win (tab-group-offset (input-focus) 1)))
+ (raise-window win)
+ (set-input-focus win)))
+
+ (define-command 'tab-raise-right-window tab-raise-right-window)
+
+ (define (map-other-grouped-windows win func)
+ ""
+ (mapcar func
+ (delete-if
+ (lambda (w) (eq w win))
+ (tab-group-window-list (tab-find-window win)))) )
+
+ (unless batch-mode
+ (add-hook 'window-state-change-hook
+ (lambda (win args)
+ (if (= 'sticky args)
+ (tab-refresh-group win 'stick))))
+ (add-hook 'after-move-hook (lambda (win) (tab-refresh-group win 'move)))
+ (add-hook 'while-moving-hook (lambda (win) (tab-refresh-group win 'move)))
+ (add-hook 'after-resize-hook (lambda (win) (tab-refresh-group win 'resize)))
+ (add-hook 'while-resizing-hook (lambda (win) (tab-refresh-group win 'resize)))
+ (add-hook 'window-maximized-hook (lambda (win) (tab-refresh-group win 'resize)))
+ (add-hook 'window-unmaximized-hook (lambda (win) (tab-refresh-group win 'resize)))
+ (add-hook 'shade-window-hook (lambda (win) (tab-refresh-group win 'shade)))
+ (add-hook 'unshade-window-hook (lambda (win) (tab-refresh-group win 'unshade)))
+ (add-hook 'destroy-notify-hook tab-delete-window-from-tab-groups)))
Modified: trunk/man/news.texi
==============================================================================
--- trunk/man/news.texi (original)
+++ trunk/man/news.texi Tue Feb 3 22:35:58 2009
@@ -18,6 +18,8 @@
@item librep 0.17 -> 0.17.3
@item rep-gtk 0.18.3 -> 0.18.4
+
+ item intltool 0.40.0
@end itemize
@item Bugs fixed:
@@ -41,6 +43,8 @@
@item New features:
@itemize @minus
+ item Tabbed Windowing Support [Yann Hodique, Scott Scriven, Nathan Froyd, Christopher Bratusek]
+
@item Warp cursor to cycled windows, if warp-cursor is enabled [Christopher Bratusek]
@item Warp cursor to unmaximied windows, if warp-cursor is enabled [Fernando Carmona Varo]
[
Date Prev][
Date Next] [
Thread Prev][
Thread Next]
[
Thread Index]
[
Date Index]
[
Author Index]
