sawfish r4399 - in trunk: . lisp/sawfish/wm lisp/sawfish/wm/commands man
- From: chrisb svn gnome org
- To: svn-commits-list gnome org
- Subject: sawfish r4399 - in trunk: . lisp/sawfish/wm lisp/sawfish/wm/commands man
- Date: Thu, 5 Feb 2009 19:35:39 +0000 (UTC)
Author: chrisb
Date: Thu Feb 5 19:35:38 2009
New Revision: 4399
URL: http://svn.gnome.org/viewvc/sawfish?rev=4399&view=rev
Log:
* po/POTFILES.in: updated for shrink/yank file
* OPTIONS: updated
* man/news.texi: updated
* lisp/sawfish/wm/commands/shrink-yank.jl: Shrinking/Yanking Support [Timo Korvola]
* configure.in: bump minimum intltool version to 0.40.0
Added:
trunk/lisp/sawfish/wm/commands/shrink-yank.jl
Modified:
trunk/ChangeLog
trunk/OPTIONS
trunk/config.h.in
trunk/configure.in
trunk/lisp/sawfish/wm/autoload.jl
trunk/man/news.texi
Modified: trunk/OPTIONS
==============================================================================
--- trunk/OPTIONS (original)
+++ trunk/OPTIONS Thu Feb 5 19:35:38 2009
@@ -578,7 +578,6 @@
;;window is displayed. See the `display-message' function for more
;;details.")
-
;; tab options
;; (define-special-variable tab-left-dec-width 11
@@ -592,4 +591,12 @@
;; (define-special-variable tab-right-margin 16
-;; "Width of tab area's right-edge decoration"
+;; "Width of tab area's right-edge decoration")
+
+;; shrink-yank options
+
+;; (define-special-variable shrink-window-minimum-size 10
+;; "The minimum height or width to which a window may be shrunk.")
+
+;; (define-special-variable yank-window-minimum-visible 10
+;; "The minimum amount of window left visible, if yanked over the edge.")
Modified: trunk/config.h.in
==============================================================================
--- trunk/config.h.in (original)
+++ trunk/config.h.in Thu Feb 5 19:35:38 2009
@@ -21,9 +21,6 @@
*/
#undef HAVE_ALLOCA_H
-/* Define to 1 if you have the <dlfcn.h> header file. */
-#undef HAVE_DLFCN_H
-
/* Define to 1 if you don't have `vprintf' but do have `_doprnt.' */
#undef HAVE_DOPRNT
@@ -129,16 +126,12 @@
/* Define to 1 if you have the <X11/SM/SMlib.h> header file. */
#undef HAVE_X11_SM_SMLIB_H
-/* Define to 1 if you have the <X11/Xft/Xft.h> header file. */
+/* Have xft */
#undef HAVE_X11_XFT_XFT_H
/* libc malloc */
#undef LIBC_MALLOC
-/* Define to the sub-directory in which libtool stores uninstalled libraries.
- */
-#undef LT_OBJDIR
-
/* Need pixmap cache */
#undef NEED_PIXMAP_CACHE
Modified: trunk/configure.in
==============================================================================
--- trunk/configure.in (original)
+++ trunk/configure.in Thu Feb 5 19:35:38 2009
@@ -26,7 +26,7 @@
AM_PROG_LIBTOOL
-IT_PROG_INTLTOOL([0.35.0])
+IT_PROG_INTLTOOL([0.40.0])
dnl Release versioning info
version="1.5.0"
Modified: trunk/lisp/sawfish/wm/autoload.jl
==============================================================================
--- trunk/lisp/sawfish/wm/autoload.jl (original)
+++ trunk/lisp/sawfish/wm/autoload.jl Thu Feb 5 19:35:38 2009
@@ -127,7 +127,6 @@
(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)
Added: trunk/lisp/sawfish/wm/commands/shrink-yank.jl
==============================================================================
--- (empty file)
+++ trunk/lisp/sawfish/wm/commands/shrink-yank.jl Thu Feb 5 19:35:38 2009
@@ -0,0 +1,279 @@
+;;; $Id: shrink-yank.jl,v 1.10 2008/06/23 11:39:07 thk Exp $
+;;; shrink windows to fit or yank them free.
+;; Copyright 2000, 2001, 2003, 2005 by Timo Korvola <tkorvola iki fi>
+
+;;; Commentary:
+;; This package provides functions to shrink or yank a window in the
+;; four cardinal directions. Shrinking resizes the window by moving one
+;; of its edges and yanking moves the window to meet the following condition:
+;; - if the window was partially (or in case of yanking even entirely) outside
+;; the screen it will be entirely on the screen,
+;; - otherwise, if the window intersected with other windows it will intersect
+;; with one window less,
+;; - otherwise the window will not be moved or resized.
+;;
+;; If the window reaches its minimum size before this condition can be
+;; satisfied the window is resized to the minimum size instead. There
+;; is also a minimum size constraint `shrink-window-minimum', which
+;; applies to all windows. However, it is measured in pixels and
+;; windows may actually become smaller than the specified value due to
+;; size truncation.
+;;
+;; If the window would have to be yanked off the screen to satisfy the
+;; condition `yank-window-minimum-visible' pixels will be left visible instead.
+
+(define-structure sawfish.wm.commands.shrink-yank ()
+
+ (open rep
+ sawfish.wm.commands
+ sawfish.wm.commands.grow-pack
+ sawfish.wm.events
+ sawfish.wm.misc
+ sawfish.wm.state.maximize
+ sawfish.wm.state.iconify
+ sawfish.wm.util.rects
+ sawfish.wm.windows
+ sawfish.wm.workspace)
+
+ (define-structure-alias shrink-yank sawfish.wm.commands.shrink-yank)
+
+ (defgroup shrink-yank (_"Shrinking and Yanking of windows") :group misc)
+
+ (defcustom shrink-window-minimum-size 10
+ (_"The minimum height or width to which a window may be shrunk.")
+ :type number
+ :group (misc shrink-yank))
+
+ (defcustom yank-window-minimum-visible 10
+ (_"The minimum amount of window left visible, if yanked over the edge.")
+ :type number
+ :group (misc shrink-yank))
+
+;;; Commands:
+
+ (define (shrink-window-left window)
+ "Shrinks WINDOW by moving the right edge to the left until it intersects
+with one window less than before."
+ (shrink-window window 'left))
+
+ (define (shrink-window-right window)
+ "Shrinks WINDOW by moving the left edge to the right until it intersects
+with one window less than before."
+ (shrink-window window 'right))
+
+ (define (shrink-window-up window)
+ "Shrinks WINDOW by moving the lower edge upwards until it intersects
+with one window less than before."
+ (shrink-window window 'up))
+
+ (define (shrink-window-down window)
+ "Shrinks WINDOW by moving the upper edge downwards until it intersects
+with one window less than before."
+ (shrink-window window 'down))
+
+ (define (yank-window-left window)
+ "Yanks WINDOW to the left until it inserts with one window less than before."
+ (yank-window window 'left))
+
+ (define (yank-window-right window)
+ "Yanks WINDOW to the right until it inserts with one window less than before."
+ (yank-window window 'right))
+
+ (define (yank-window-up window)
+ "Yanks WINDOW upwards until it inserts with one window less than before."
+ (yank-window window 'up))
+
+ (define (yank-window-down window)
+ "Yanks WINDOW downwards until it inserts with one window less than before."
+ (yank-window window 'down))
+
+ ;;###autoload
+ (define-command 'shrink-window-left shrink-window-left #:spec "%W")
+ (define-command 'shrink-window-right shrink-window-right #:spec "%W")
+ (define-command 'shrink-window-up shrink-window-up #:spec "%W")
+ (define-command 'shrink-window-down shrink-window-down #:spec "%W")
+ (define-command 'yank-window-left yank-window-left #:spec "%W")
+ (define-command 'yank-window-right yank-window-right #:spec "%W")
+ (define-command 'yank-window-up yank-window-up #:spec "%W")
+ (define-command 'yank-window-down yank-window-down #:spec "%W")
+
+;;; Implementation:
+
+ (define (window-frame-rect window)
+ "Returns the rectangle (left top right bottom) describing the frame
+dimensions of WINDOW."
+ (let* ((wpos (window-position window))
+ (wdim (window-frame-dimensions window))
+ (wleft (car wpos))
+ (wtop (cdr wpos)))
+ (list wleft wtop (+ wleft (car wdim)) (+ wtop (cdr wdim)))))
+
+ ;; I can never remember these!
+ (define left car)
+ (define top cadr)
+ (define right caddr)
+ (define bottom cadddr)
+
+ (define (maybe-warp-pointer window old-rect direction maybe)
+ (define (scale x x0 x1 x0new x1new)
+ (round (/ (+ (* (- x x0) x1new)
+ (* (- x1 x) x0new))
+ (- x1 x0))))
+ (define (truncate-rect r)
+ (list (max (left r) 0)
+ (max (top r) 0)
+ (min (right r) (screen-width))
+ (min (bottom r) (screen-height))))
+ (case pack-warp-pointer
+ ((always) (warp-cursor-to-window window))
+ ((maybe)
+ (when maybe
+ (let* ((owr (truncate-rect old-rect))
+ (nwr (truncate-rect (window-frame-rect window)))
+ (ppos (query-pointer))
+ (xpos (car ppos))
+ (ypos (cdr ppos)))
+ (case direction
+ ((left right)
+ (setq xpos (scale xpos (left owr) (right owr)
+ (left nwr) (right nwr))))
+ ((up down)
+ (setq ypos (scale ypos (top owr) (bottom owr)
+ (top nwr) (bottom nwr)))))
+ (warp-cursor xpos ypos))))))
+
+ ;; Return the coordinate of the window intersection to shink or yank to.
+ ;; This will do for both shrinking and yanking although the
+ ;; requirements are slightly different: e.g., a window that
+ ;; completely surrounds the active window is irrelevant for shrinking.
+ (define (find-least-intersection window wr direction yank)
+ (let* ((isect-coord (if yank
+ (case direction
+ ((left up) 0)
+ ((right) (screen-width))
+ ((down) (screen-height)))
+ (case direction
+ ((left) (left wr))
+ ((up) (top wr))
+ ((right) (right wr))
+ ((down) (bottom wr)))))
+ (isect-check (case direction
+ ((left)
+ (lambda (xr)
+ (and (< isect-coord (left xr) (right wr))
+ (setq isect-coord (left xr)))))
+ ((up)
+ (lambda (xr)
+ (and (< isect-coord (top xr) (bottom wr))
+ (setq isect-coord (top xr)))))
+ ((right)
+ (lambda (xr)
+ (and (< (left wr) (right xr) isect-coord)
+ (setq isect-coord (right xr)))))
+ ((down)
+ (lambda (xr)
+ (and (< (top wr) (bottom xr) isect-coord)
+ (setq isect-coord (bottom xr))))))))
+ ;; If the window is partially (shrink or yank) or entirely (yank only)
+ ;; outside the screen return the screen edge.
+ (cond ((and (eq direction 'left)
+ (< isect-coord (screen-width) (right wr)))
+ (screen-width))
+ ((and (eq direction 'right) (< (left wr) 0 isect-coord))
+ 0)
+ ((and (eq direction 'up)
+ (< isect-coord (screen-height) (bottom wr)))
+ (screen-height))
+ ((and (eq direction 'down) (< (top wr) 0 isect-coord))
+ 0)
+ (t
+ (let ((win nil))
+ (mapc (lambda (x)
+ (and (not (eql x window))
+ (not (window-iconified-p x))
+ (window-appears-in-workspace-p x current-workspace)
+ (let ((xr (window-frame-rect x)))
+ (and (positivep (rect-2d-overlap* wr xr))
+ (isect-check xr)
+ (setq win x)))))
+ (managed-windows))
+ (and win isect-coord))))))
+
+ (define (shrink-window window direction)
+ "Shrinks WINDOW by moving the edge opposite to DIRECTION (left, right,
+up or down) towards DIRECTION until it intersects with one window less than
+before."
+ (let* ((wr (window-frame-rect window))
+ (isect-coord (find-least-intersection window wr direction nil))
+ (nleft (left wr))
+ (ntop (top wr))
+ (wdim (window-dimensions window))
+ (nwidth (car wdim))
+ (nheight (cdr wdim)))
+ (when (and isect-coord
+ (let ((max-shrinkage (- (case direction
+ ((left right) nwidth)
+ ((up down) nheight))
+ shrink-window-minimum-size)))
+ (when (positivep max-shrinkage)
+ (case direction
+ ((left) (setq nwidth (- nwidth
+ (min max-shrinkage
+ (- (right wr)
+ isect-coord)))))
+ ((up) (setq nheight (- nheight
+ (min max-shrinkage
+ (- (bottom wr)
+ isect-coord)))))
+ ((right) (setq nwidth (- nwidth
+ (min max-shrinkage
+ (- isect-coord
+ (left wr))))))
+ ((down) (setq nheight (- nheight
+ (min max-shrinkage
+ (- isect-coord
+ (top wr))))))))))
+ (let ((tem (cons nwidth nheight)))
+ (maximize-truncate-dims window tem)
+ (setq nwidth (car tem)
+ nheight (cdr tem)))
+ (case direction
+ ((right) (setq nleft (+ nleft (- (car wdim) nwidth))))
+ ((down) (setq ntop (+ ntop (- (cdr wdim) nheight)))))
+ (let ((pointerw (query-pointer-window)))
+ (move-resize-window-to window nleft ntop nwidth nheight)
+ (maybe-warp-pointer window wr direction (eql window pointerw))))))
+
+ (define (yank-window window direction)
+ "Moves WINDOW towards DIRECTION (left, right, up or down) until
+WINDOW intersects with one window less than before."
+ (let* ((wr (window-frame-rect window))
+ (isect-coord (find-least-intersection window wr direction t))
+ (nleft (left wr))
+ (ntop (top wr)))
+ (and isect-coord
+ (case direction
+ ((left) (let ((max-move (- (right wr)
+ yank-window-minimum-visible)))
+ (when (positivep max-move)
+ (setq nleft (- nleft
+ (min max-move
+ (- (right wr) isect-coord)))))))
+ ((up) (let ((max-move (- (bottom wr)
+ yank-window-minimum-visible)))
+ (when (positivep max-move)
+ (setq ntop (- ntop
+ (min max-move
+ (- (bottom wr) isect-coord)))))))
+ ((right) (let ((max-pos (- (screen-width)
+ yank-window-minimum-visible)))
+ (when (< (left wr) max-pos)
+ (setq nleft (min max-pos isect-coord)))))
+ ((down) (let ((max-pos (- (screen-height)
+ yank-window-minimum-visible)))
+ (when (< (top wr) max-pos)
+ (setq ntop (min max-pos isect-coord))))))
+ (let ((pointerw (query-pointer-window)))
+ (move-window-to window nleft ntop)
+ (maybe-warp-pointer window wr
+ direction (eql window pointerw)))))))
Modified: trunk/man/news.texi
==============================================================================
--- trunk/man/news.texi (original)
+++ trunk/man/news.texi Thu Feb 5 19:35:38 2009
@@ -50,6 +50,8 @@
@item Warp cursor to unmaximied windows, if warp-cursor is enabled [Fernando Carmona Varo]
@item 3 New Window-Animators: cross, elliptical and draft [Christopher Bratusek]
+
+ item Shrinking/Yanking Support [Timo Korvola]
@end itemize
@item Other changes:
@@ -92,9 +94,13 @@
@item Intltoolize Sawfish [Christopher Bratusek]
- item print usefull stuff at the end of configure [Christopher Bratusek]
+ item Print usefull stuff at the end of configure [Christopher Bratusek]
+
+ item Add distclean rule to all Makefiles [Christopher Bratusek]
+
+ item Add KEYBINDINGS file, containing a list of all default keybindings [Christopher Bratusek]
- item add distclean rule to all Makefiles [Christopher Bratusek]
+ item Updated OPTIONS for all new options [Christopher Bratusek]
@end itemize
@end itemize
[
Date Prev][
Date Next] [
Thread Prev][
Thread Next]
[
Thread Index]
[
Date Index]
[
Author Index]
