[sawfish] General whitespace and formatting cleanup.
- From: Jeremy Hankins <jjhankins src gnome org>
- To: svn-commits-list gnome org
- Cc:
- Subject: [sawfish] General whitespace and formatting cleanup.
- Date: Tue, 29 Sep 2009 18:04:14 +0000 (UTC)
commit 28a420c0454cb61deba663ff43832837f7a81170
Author: Jeremy Hankins <nowan nowan org>
Date: Tue Sep 29 10:47:29 2009 -0500
General whitespace and formatting cleanup.
lisp/sawfish/cfg/apply.jl | 67 +-
lisp/sawfish/cfg/config.jl | 41 +-
lisp/sawfish/cfg/group.jl | 49 +-
lisp/sawfish/cfg/i18n.jl | 41 +-
lisp/sawfish/cfg/layout.jl | 47 +-
lisp/sawfish/cfg/layouts/keymaps.jl | 95 +-
lisp/sawfish/cfg/shell.jl | 46 +-
lisp/sawfish/cfg/slot.jl | 85 +-
lisp/sawfish/cfg/widgets/command.jl | 87 +-
lisp/sawfish/cfg/widgets/event.jl | 59 +-
lisp/sawfish/cfg/widgets/frame-style.jl | 61 +-
lisp/sawfish/cfg/widgets/gtk/icon.jl | 47 +-
lisp/sawfish/cfg/widgets/gtk/workspace-geometry.jl | 47 +-
lisp/sawfish/cfg/widgets/icon.jl | 47 +-
lisp/sawfish/cfg/widgets/keymap.jl | 55 +-
lisp/sawfish/cfg/widgets/match-window.jl | 122 +-
lisp/sawfish/cfg/widgets/modifier-list.jl | 61 +-
lisp/sawfish/cfg/widgets/workspace-geometry.jl | 47 +-
lisp/sawfish/cfg/wm.jl | 41 +-
lisp/sawfish/gtk/stock.jl | 53 +-
lisp/sawfish/gtk/widget-dialog.jl | 41 +-
lisp/sawfish/gtk/widget-test.jl | 53 +-
lisp/sawfish/gtk/widget.jl | 80 +-
lisp/sawfish/gtk/widgets/alist.jl | 53 +-
lisp/sawfish/gtk/widgets/color.jl | 71 +-
lisp/sawfish/gtk/widgets/file.jl | 49 +-
lisp/sawfish/gtk/widgets/list.jl | 140 +-
lisp/sawfish/gtk/widgets/pair.jl | 51 +-
lisp/sawfish/gtk/widgets/program.jl | 49 +-
lisp/sawfish/gtk/widgets/scheme-boolean.jl | 53 +-
lisp/sawfish/wm.jl | 45 +-
lisp/sawfish/wm/animation/outline.jl | 1 -
lisp/sawfish/wm/autoload.jl | 1 -
lisp/sawfish/wm/commands.jl | 109 +-
lisp/sawfish/wm/commands/cycle.jl | 1 -
lisp/sawfish/wm/commands/describe.jl | 7 +-
lisp/sawfish/wm/commands/groups.jl | 33 +-
lisp/sawfish/wm/commands/grow-pack.jl | 7 +-
lisp/sawfish/wm/commands/help.jl | 3 +-
lisp/sawfish/wm/commands/move-cursor.jl | 5 +-
lisp/sawfish/wm/commands/move-resize.jl | 90 +-
lisp/sawfish/wm/commands/raise-commands.jl | 21 +-
lisp/sawfish/wm/commands/shrink-yank.jl | 84 +-
lisp/sawfish/wm/commands/size-window.jl | 3 +-
lisp/sawfish/wm/commands/slide-window.jl | 3 +-
lisp/sawfish/wm/commands/user.jl | 58 +-
lisp/sawfish/wm/commands/viewport-extras.jl | 27 +-
lisp/sawfish/wm/commands/viewport-linear.jl | 1 -
lisp/sawfish/wm/commands/x-cycle.jl | 231 +-
lisp/sawfish/wm/cursors.jl | 41 +-
lisp/sawfish/wm/custom-defaults.jl | 4 +-
lisp/sawfish/wm/custom.jl | 73 +-
lisp/sawfish/wm/customize.jl | 5 +-
lisp/sawfish/wm/defaults.jl | 5 +-
lisp/sawfish/wm/ext/3d-hack.jl | 10 +-
lisp/sawfish/wm/ext/audio-events.jl | 5 +-
lisp/sawfish/wm/ext/auto-raise.jl | 15 +-
lisp/sawfish/wm/ext/beos-window-menu.jl | 83 +-
lisp/sawfish/wm/ext/edge-flip.jl | 1 -
lisp/sawfish/wm/ext/error-handler.jl | 1 -
lisp/sawfish/wm/ext/fdo-menu.jl | 223 +-
lisp/sawfish/wm/ext/hide-dialogs.jl | 61 +-
lisp/sawfish/wm/ext/infinite-desktop.jl | 217 +-
lisp/sawfish/wm/ext/match-window.jl | 313 +-
lisp/sawfish/wm/ext/old-window-menu.jl | 1 -
lisp/sawfish/wm/ext/shade-hover.jl | 20 +-
lisp/sawfish/wm/ext/tooltips.jl | 1 -
lisp/sawfish/wm/ext/window-history.jl | 8 +-
lisp/sawfish/wm/ext/workspace-grid.jl | 57 +-
lisp/sawfish/wm/extras.jl | 39 +-
lisp/sawfish/wm/focus.jl | 31 +-
lisp/sawfish/wm/frames.jl | 71 +-
lisp/sawfish/wm/gaol.jl | 87 +-
lisp/sawfish/wm/integration/gnome.jl | 19 +-
lisp/sawfish/wm/integration/kde.jl | 26 +-
lisp/sawfish/wm/keymaps.jl | 5 +-
lisp/sawfish/wm/menus.jl | 63 +-
lisp/sawfish/wm/misc.jl | 100 +-
lisp/sawfish/wm/placement.jl | 22 +-
lisp/sawfish/wm/placement/off-center.jl | 49 +-
lisp/sawfish/wm/placement/smart.jl | 23 +-
lisp/sawfish/wm/placement/stagger.jl | 18 +-
lisp/sawfish/wm/placement/top-left.jl | 49 +-
lisp/sawfish/wm/server.jl | 1 -
lisp/sawfish/wm/session/init.jl | 24 +-
lisp/sawfish/wm/session/load.jl | 3 +-
lisp/sawfish/wm/session/save.jl | 4 +-
lisp/sawfish/wm/stacking.jl | 202 +-
lisp/sawfish/wm/state/configure.jl | 3 +-
lisp/sawfish/wm/state/iconify.jl | 7 +-
lisp/sawfish/wm/state/ignored.jl | 24 +-
lisp/sawfish/wm/state/maximize.jl | 107 +-
lisp/sawfish/wm/state/mwm.jl | 13 +-
lisp/sawfish/wm/state/open-look.jl | 13 +-
lisp/sawfish/wm/state/shading.jl | 1 -
lisp/sawfish/wm/state/transient.jl | 24 +-
lisp/sawfish/wm/state/wm-spec.jl | 231 +-
lisp/sawfish/wm/swapper.jl | 59 +-
lisp/sawfish/wm/tabs/tab.jl | 124 +-
lisp/sawfish/wm/tabs/tabgroup.jl | 207 +-
lisp/sawfish/wm/theming/make-theme-preview.jl | 1 -
lisp/sawfish/wm/theming/make-theme.jl | 10 +-
lisp/sawfish/wm/user.jl | 55 +-
lisp/sawfish/wm/util/compat.jl | 48 +-
lisp/sawfish/wm/util/decode-events.jl | 23 +-
lisp/sawfish/wm/util/display-window.jl | 41 +-
lisp/sawfish/wm/util/display-wininfo.jl | 61 +-
lisp/sawfish/wm/util/edges.jl | 35 +-
lisp/sawfish/wm/util/font.jl | 127 +-
lisp/sawfish/wm/util/groups.jl | 15 +-
lisp/sawfish/wm/util/gtkrc.jl | 1 -
lisp/sawfish/wm/util/keymap-diff.jl | 107 +-
lisp/sawfish/wm/util/keymap.jl | 9 +-
lisp/sawfish/wm/util/marks.jl | 63 +-
lisp/sawfish/wm/util/nokogiri.jl | 55 +-
lisp/sawfish/wm/util/ping.jl | 63 +-
lisp/sawfish/wm/util/play-audio.jl | 1 -
lisp/sawfish/wm/util/prompt-extras.jl | 3 +-
lisp/sawfish/wm/util/prompt-wm.jl | 1 -
lisp/sawfish/wm/util/prompt.jl | 56 +-
lisp/sawfish/wm/util/recolor-image.jl | 67 +-
lisp/sawfish/wm/util/rects.jl | 33 +-
lisp/sawfish/wm/util/stacking.jl | 66 +-
lisp/sawfish/wm/util/window-order.jl | 11 +-
lisp/sawfish/wm/util/window-outline.jl | 14 +-
lisp/sawfish/wm/util/with-output.jl | 1 -
lisp/sawfish/wm/util/workarea.jl | 73 +-
lisp/sawfish/wm/viewport.jl | 157 +-
lisp/sawfish/wm/window-anim.jl | 1 -
lisp/sawfish/wm/windows.jl | 105 +-
lisp/sawfish/wm/workspace.jl | 39 +-
scripts/sawfish-client.jl | 91 +-
scripts/sawfish-menu.jl | 3 +-
themes/Crux/theme.jl | 82 +-
themes/Elberg-tabbed/theme.jl | 452 +-
themes/absolute-e/theme.jl | 3 +-
themes/brushed-metal/theme.jl | 1 -
themes/get-S-tabbed/theme.jl | 627 ++--
themes/gradient/theme.jl | 1 -
themes/gtk/theme.jl | 1 -
themes/microGUI/theme.jl | 292 +-
themes/mono/theme.jl | 1 -
themes/mxflat/theme.jl | 5258 +++++++++-----------
themes/simple/theme.jl | 39 +-
themes/smaker/theme.jl | 3 +-
145 files changed, 6535 insertions(+), 7022 deletions(-)
---
diff --git a/lisp/sawfish/cfg/apply.jl b/lisp/sawfish/cfg/apply.jl
index 0ac52a4..ee8e870 100644
--- a/lisp/sawfish/cfg/apply.jl
+++ b/lisp/sawfish/cfg/apply.jl
@@ -1,25 +1,22 @@
-#| nokogiri-apply.jl -- setting values in the wm
-
- $Id$
-
- Copyright (C) 2000 John Harper <john dcs warwick ac uk>
-
- This file is part of sawfish.
-
- sawfish 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.
-
- sawfish 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 sawfish; see the file COPYING. If not, write to
- the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-|#
+;; nokogiri-apply.jl -- setting values in the wm
+;;
+;; Copyright (C) 2000 John Harper <john dcs warwick ac uk>
+;;
+;; This file is part of sawfish.
+;;
+;; sawfish 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.
+;;
+;; sawfish 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 sawfish; see the file COPYING. If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
(define-structure sawfish.cfg.apply
@@ -96,19 +93,19 @@
;; avoid infinite regress..
(do-apply)
(let-fluids ((in-apply-changes t))
- (condition-case data
- (do-apply)
- (remote-sawfish
- ;; An error occurred while setting the values,
- ;; back them all out, then display the error message
- (revert-slots slots)
- (let ((label (gtk-label-new (format-error data))))
- (gtk-label-set-justify label 'left)
- (gtk-label-set-line-wrap label t)
- (gtk-widget-show label)
- (simple-dialog (_ "Sawfish Error") label nil
- (gtk-widget-get-toplevel
- (slot-gtk-widget (car slots)))))))))
+ (condition-case data
+ (do-apply)
+ (remote-sawfish
+ ;; An error occurred while setting the values,
+ ;; back them all out, then display the error message
+ (revert-slots slots)
+ (let ((label (gtk-label-new (format-error data))))
+ (gtk-label-set-justify label 'left)
+ (gtk-label-set-line-wrap label t)
+ (gtk-widget-show label)
+ (simple-dialog (_ "Sawfish Error") label nil
+ (gtk-widget-get-toplevel
+ (slot-gtk-widget (car slots)))))))))
(mapc (lambda (slot)
(mapc (lambda (h) (h)) (slot-change-handlers slot))) slots)))
diff --git a/lisp/sawfish/cfg/config.jl b/lisp/sawfish/cfg/config.jl
index eec68eb..78e61b5 100644
--- a/lisp/sawfish/cfg/config.jl
+++ b/lisp/sawfish/cfg/config.jl
@@ -1,25 +1,22 @@
-#| nokogiri-config.jl -- options that affect the configurator, not the wm
-
- $Id$
-
- Copyright (C) 2000 John Harper <john dcs warwick ac uk>
-
- This file is part of sawfish.
-
- sawfish 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.
-
- sawfish 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 sawfish; see the file COPYING. If not, write to
- the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-|#
+;; nokogiri-config.jl -- options that affect the configurator, not the wm
+;;
+;; Copyright (C) 2000 John Harper <john dcs warwick ac uk>
+;;
+;; This file is part of sawfish.
+;;
+;; sawfish 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.
+;;
+;; sawfish 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 sawfish; see the file COPYING. If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
(define-structure sawfish.cfg.config
diff --git a/lisp/sawfish/cfg/group.jl b/lisp/sawfish/cfg/group.jl
index 4d2bec3..fcfcba6 100644
--- a/lisp/sawfish/cfg/group.jl
+++ b/lisp/sawfish/cfg/group.jl
@@ -1,25 +1,22 @@
-#| nokogiri-group.jl -- group management
-
- $Id$
-
- Copyright (C) 2000 John Harper <john dcs warwick ac uk>
-
- This file is part of sawfish.
-
- sawfish 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.
-
- sawfish 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 sawfish; see the file COPYING. If not, write to
- the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-|#
+;; nokogiri-group.jl -- group management
+;;
+;; Copyright (C) 2000 John Harper <john dcs warwick ac uk>
+;;
+;; This file is part of sawfish.
+;;
+;; sawfish 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.
+;;
+;; sawfish 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 sawfish; see the file COPYING. If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
(define-structure sawfish.cfg.group
@@ -154,7 +151,7 @@
(when (and (eq group current-group)
(/= (length (group-slots group)) old-slots))
(select-group group #:force t)))))
-
+
;; Return the list of (unique) groups containing the list of SLOTS
(define (locate-groups slots)
(let ((out '()))
@@ -258,6 +255,6 @@
(define (unionq x y)
(let loop ((rest x)
(out '()))
- (cond ((null rest) (nreverse out))
- ((memq (car rest) y) (loop (cdr rest) (cons (car rest) out)))
- (t (loop (cdr rest) out))))))
+ (cond ((null rest) (nreverse out))
+ ((memq (car rest) y) (loop (cdr rest) (cons (car rest) out)))
+ (t (loop (cdr rest) out))))))
diff --git a/lisp/sawfish/cfg/i18n.jl b/lisp/sawfish/cfg/i18n.jl
index 2502c3b..55eded4 100644
--- a/lisp/sawfish/cfg/i18n.jl
+++ b/lisp/sawfish/cfg/i18n.jl
@@ -1,25 +1,22 @@
-#| nokogiri-i18n -- support for internationalization
-
- $Id$
-
- Copyright (C) 2000 John Harper <john dcs warwick ac uk>
-
- This file is part of sawfish.
-
- sawfish 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.
-
- sawfish 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 sawfish; see the file COPYING. If not, write to
- the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-|#
+;; nokogiri-i18n -- support for internationalization
+;;
+;; Copyright (C) 2000 John Harper <john dcs warwick ac uk>
+;;
+;; This file is part of sawfish.
+;;
+;; sawfish 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.
+;;
+;; sawfish 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 sawfish; see the file COPYING. If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
(define-structure sawfish.cfg.i18n
diff --git a/lisp/sawfish/cfg/layout.jl b/lisp/sawfish/cfg/layout.jl
index bea75cb..38f6423 100644
--- a/lisp/sawfish/cfg/layout.jl
+++ b/lisp/sawfish/cfg/layout.jl
@@ -1,25 +1,22 @@
-#| nokogiri-layout.jl -- arranging groups of slots
-
- $Id: layout.jl,v 1.9 2003/01/12 20:30:47 jsh Exp $
-
- Copyright (C) 2000 John Harper <john dcs warwick ac uk>
-
- This file is part of sawfish.
-
- sawfish 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.
-
- sawfish 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 sawfish; see the file COPYING. If not, write to
- the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-|#
+;; nokogiri-layout.jl -- arranging groups of slots
+;;
+;; Copyright (C) 2000 John Harper <john dcs warwick ac uk>
+;;
+;; This file is part of sawfish.
+;;
+;; sawfish 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.
+;;
+;; sawfish 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 sawfish; see the file COPYING. If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
(define-structure sawfish.cfg.layout
@@ -137,7 +134,7 @@
(gtk-box-pack-start hbox widget-ptr t t)
(gtk-box-pack-start hbox widget-ptr nil nil))
(when (< break (length doc))
- (setq tempstring (substring doc (+ break 2)))
+ (setq tempstring (substring doc (+ break 2)))
(if (> (length tempstring) 0)
(progn
(setq label-ptr (make-label tempstring))
@@ -146,7 +143,7 @@
(setq hbox (add-tooltip hbox))
(gtk-widget-show-all hbox)
hbox))))))
-
+
(define (remove-newlines string)
(let loop ((point 0)
(out '()))
@@ -154,7 +151,7 @@
(loop (match-end)
(list* #\space (substring string point (match-start)) out))
(apply concat (nreverse (cons (substring string point) out))))))
-
+
(define (make-label text)
(let ((label (gtk-label-new text)))
(gtk-label-set-justify label 'left)
diff --git a/lisp/sawfish/cfg/layouts/keymaps.jl b/lisp/sawfish/cfg/layouts/keymaps.jl
index f9f9b15..2822bd8 100644
--- a/lisp/sawfish/cfg/layouts/keymaps.jl
+++ b/lisp/sawfish/cfg/layouts/keymaps.jl
@@ -1,35 +1,34 @@
-#| nokogiri-layouts/keymaps.jl -- shell for binding group
-
- $Id: keymaps.jl,v 1.8 2003/01/12 20:30:49 jsh Exp $
-
- Copyright (C) 2000 John Harper <john dcs warwick ac uk>
-
- This file is part of sawfish.
-
- sawfish 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.
-
- sawfish 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 sawfish; see the file COPYING. If not, write to
- the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-|#
-
-(define-structure sawfish.cfg.layouts.keymaps ()
+;; nokogiri-layouts/keymaps.jl -- shell for binding group
+;;
+;; Copyright (C) 2000 John Harper <john dcs warwick ac uk>
+;;
+;; This file is part of sawfish.
+;;
+;; sawfish 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.
+;;
+;; sawfish 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 sawfish; see the file COPYING. If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+(define-structure sawfish.cfg.layouts.keymaps
+
+ (export )
(open rep
- gui.gtk-2.gtk
- rep.regexp
- sawfish.cfg.slot
- sawfish.cfg.wm
- sawfish.cfg.layout
- sawfish.gtk.widget)
+ gui.gtk-2.gtk
+ rep.regexp
+ sawfish.cfg.slot
+ sawfish.cfg.wm
+ sawfish.cfg.layout
+ sawfish.gtk.widget)
(define label-ptr nil)
@@ -50,7 +49,7 @@
(active (car keymap-slots)))
(when keymap-slots
- (setq label-ptr (gtk-label-new (_ "Context:")))
+ (setq label-ptr (gtk-label-new (_ "Context:")))
(gtk-box-pack-start hbox label-ptr)
(gtk-box-pack-start hbox omenu)
(gtk-widget-relate-label omenu label-ptr)
@@ -58,23 +57,23 @@
(let loop ((rest keymap-slots)
(last nil))
- (when rest
- (let* ((slot (car rest))
- (button (gtk-radio-menu-item-new-with-label-from-widget
- last (beautify-keymap-name (slot-name slot)))))
- (gtk-menu-shell-append menu button)
- (gtk-widget-show button)
- (g-signal-connect button "toggled"
- (lambda (w)
- (when (gtk-check-menu-item-active w)
- (when active
- (gtk-container-remove
- km-vbox (slot-gtk-widget active)))
- (setq active slot)
- (gtk-box-pack-start
- km-vbox (slot-gtk-widget active) t t))))
- (set-slot-layout slot (slot-gtk-widget slot))
- (loop (cdr rest) button))))
+ (when rest
+ (let* ((slot (car rest))
+ (button (gtk-radio-menu-item-new-with-label-from-widget
+ last (beautify-keymap-name (slot-name slot)))))
+ (gtk-menu-shell-append menu button)
+ (gtk-widget-show button)
+ (g-signal-connect button "toggled"
+ (lambda (w)
+ (when (gtk-check-menu-item-active w)
+ (when active
+ (gtk-container-remove
+ km-vbox (slot-gtk-widget active)))
+ (setq active slot)
+ (gtk-box-pack-start
+ km-vbox (slot-gtk-widget active) t t))))
+ (set-slot-layout slot (slot-gtk-widget slot))
+ (loop (cdr rest) button))))
(gtk-option-menu-set-menu omenu menu)
diff --git a/lisp/sawfish/cfg/shell.jl b/lisp/sawfish/cfg/shell.jl
index 842254e..842b3a5 100644
--- a/lisp/sawfish/cfg/shell.jl
+++ b/lisp/sawfish/cfg/shell.jl
@@ -1,25 +1,22 @@
-#| nokogiri-shell.jl -- shell displaying custom groups
-
- $Id: shell.jl,v 1.23 2003/01/12 20:30:47 jsh Exp $
-
- Copyright (C) 2000 John Harper <john dcs warwick ac uk>
-
- This file is part of sawfish.
-
- sawfish 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.
-
- sawfish 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 sawfish; see the file COPYING. If not, write to
- the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-|#
+;; nokogiri-shell.jl -- shell displaying custom groups
+;;
+;; Copyright (C) 2000 John Harper <john dcs warwick ac uk>
+;;
+;; This file is part of sawfish.
+;;
+;; sawfish 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.
+;;
+;; sawfish 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 sawfish; see the file COPYING. If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
(define-structure sawfish.cfg.shell
@@ -103,10 +100,11 @@
(setq revert-widget (stock-button 'revert))
(gtk-window-set-title main-window (_ "Sawfish Configurator"))
(gtk-widget-set-name main-window (_ "Sawfish Configurator"))
- (gtk-window-set-wmclass main-window "sawfish-configurator" "Sawfish-Configurator"))
+ (gtk-window-set-wmclass main-window "sawfish-configurator"
+ "Sawfish-Configurator"))
(g-signal-connect main-window "delete_event"
- (if (not socket-id) on-quit capplet-delete-event))
+ (if (not socket-id) on-quit capplet-delete-event))
(unless socket-id
(gtk-box-set-spacing hbox button-box-spacing)
diff --git a/lisp/sawfish/cfg/slot.jl b/lisp/sawfish/cfg/slot.jl
index ed00673..0cc8691 100644
--- a/lisp/sawfish/cfg/slot.jl
+++ b/lisp/sawfish/cfg/slot.jl
@@ -1,25 +1,22 @@
-#| nokogiri-slot.jl -- managing individual config items
-
- $Id: slot.jl,v 1.9 2003/01/12 20:30:47 jsh Exp $
-
- Copyright (C) 2000 John Harper <john dcs warwick ac uk>
-
- This file is part of sawfish.
-
- sawfish 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.
-
- sawfish 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 sawfish; see the file COPYING. If not, write to
- the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-|#
+;; nokogiri-slot.jl -- managing individual config items
+;;
+;; Copyright (C) 2000 John Harper <john dcs warwick ac uk>
+;;
+;; This file is part of sawfish.
+;;
+;; sawfish 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.
+;;
+;; sawfish 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 sawfish; see the file COPYING. If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
(define-structure sawfish.cfg.slot
@@ -47,11 +44,11 @@
(define-record-type :slot
(create-slot name old-value flags)
;; [no predicate]
- (name slot-name) ;name of config item
+ (name slot-name) ;name of config item
(widget slot-widget slot-widget-set) ;associated lisp widget
(layout slot-layout set-slot-layout) ;gtk widget if the slot is displayed
- (old-value slot-old-value) ;original value of slot's config
- (doc slot-doc slot-doc-set) ;doc string (unless shown in widget)
+ (old-value slot-old-value) ;original value of slot's config
+ (doc slot-doc slot-doc-set) ;doc string (unless shown in widget)
(flags slot-flags))
(define-record-discloser :slot
@@ -125,31 +122,31 @@
;; the nil spaces.
(define (merge slots extra)
(let loop ((rest slots))
- (if (null rest)
- slots
- (when (null (car rest))
- (rplaca rest (apply make-slot (car extra)))
- (setq extra (cdr extra)))
- (loop (cdr rest)))))
+ (if (null rest)
+ slots
+ (when (null (car rest))
+ (rplaca rest (apply make-slot (car extra)))
+ (setq extra (cdr extra)))
+ (loop (cdr rest)))))
;; find which slots still need to be loaded
(let ((slots (mapcar get-slot names)))
(let loop ((names-rest names)
(slots-rest slots)
(to-fetch '()))
- (if (null names-rest)
- (if to-fetch
- ;; load and merge the required slots
- (merge slots (wm-load-slots (nreverse to-fetch)))
- slots)
- (if (null (car slots-rest))
- ;; slot not loaded yet
- (loop (cdr names-rest)
- (cdr slots-rest)
- (cons (car names-rest) to-fetch))
- (loop (cdr names-rest)
- (cdr slots-rest)
- to-fetch))))))
+ (if (null names-rest)
+ (if to-fetch
+ ;; load and merge the required slots
+ (merge slots (wm-load-slots (nreverse to-fetch)))
+ slots)
+ (if (null (car slots-rest))
+ ;; slot not loaded yet
+ (loop (cdr names-rest)
+ (cdr slots-rest)
+ (cons (car names-rest) to-fetch))
+ (loop (cdr names-rest)
+ (cdr slots-rest)
+ to-fetch))))))
;;; misc
diff --git a/lisp/sawfish/cfg/widgets/command.jl b/lisp/sawfish/cfg/widgets/command.jl
index 10018ab..eafb440 100644
--- a/lisp/sawfish/cfg/widgets/command.jl
+++ b/lisp/sawfish/cfg/widgets/command.jl
@@ -1,33 +1,32 @@
-#| nokogiri-widgets/command.jl
-
- $Id$
-
- Copyright (C) 2000 John Harper <john dcs warwick ac uk>
-
- This file is part of sawfish.
-
- sawfish 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.
-
- sawfish 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 sawfish; see the file COPYING. If not, write to
- the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-|#
-
-(define-structure sawfish.cfg.widgets.command ()
+;; nokogiri-widgets/command.jl
+;;
+;; Copyright (C) 2000 John Harper <john dcs warwick ac uk>
+;;
+;; This file is part of sawfish.
+;;
+;; sawfish 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.
+;;
+;; sawfish 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 sawfish; see the file COPYING. If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+(define-structure sawfish.cfg.widgets.command
+
+ (export )
(open rep
- gui.gtk-2.gtk
- rep.regexp
- sawfish.gtk.widget
- sawfish.cfg.wm)
+ gui.gtk-2.gtk
+ rep.regexp
+ sawfish.gtk.widget
+ sawfish.cfg.wm)
(define all-commands)
@@ -47,7 +46,7 @@
(unless all-commands
(setq all-commands (wm-command-list)))
-
+
(let ((commands (filter-command-list))
(clist (gtk-clist-new-with-titles (list (_ "Command"))))
(text-view (gtk-text-view-new))
@@ -88,17 +87,17 @@
(gtk-clist-append clist (command-item c))) commands)
(g-signal-connect clist "select_row"
- (lambda (w row col)
- (declare (unused w col))
- (setq selection row)
- (update-params)
- (update-doc)
- (call-callback changed)))
+ (lambda (w row col)
+ (declare (unused w col))
+ (setq selection row)
+ (update-params)
+ (update-doc)
+ (call-callback changed)))
;; seems you have to `moveto' _after_ the widget is realized..
(g-signal-connect clist "map"
- (lambda ()
- (gtk-clist-moveto clist selection 0)))
+ (lambda ()
+ (gtk-clist-moveto clist selection 0)))
(gtk-text-view-set-wrap-mode text-view 'word)
(gtk-text-view-set-editable text-view nil)
@@ -171,13 +170,13 @@
(define (remove-newlines string)
(let loop ((point 0)
(out '()))
- (if (string-match "\n" string point)
- (loop (match-end)
- (list* #\space (substring string point (match-start)) out))
- (apply concat (nreverse (cons (substring string point) out))))))
+ (if (string-match "\n" string point)
+ (loop (match-end)
+ (list* #\space (substring string point (match-start)) out))
+ (apply concat (nreverse (cons (substring string point) out))))))
(define (command-index lst x)
(let loop ((i 0) (rest lst))
- (cond ((null rest) nil)
- ((eq (or (caar rest) (car rest)) x) i)
- (t (loop (1+ i) (cdr rest)))))))
+ (cond ((null rest) nil)
+ ((eq (or (caar rest) (car rest)) x) i)
+ (t (loop (1+ i) (cdr rest)))))))
diff --git a/lisp/sawfish/cfg/widgets/event.jl b/lisp/sawfish/cfg/widgets/event.jl
index 8464f84..c4ea8c4 100644
--- a/lisp/sawfish/cfg/widgets/event.jl
+++ b/lisp/sawfish/cfg/widgets/event.jl
@@ -1,33 +1,32 @@
-#| nokogiri-widgets/event.jl
-
- $Id$
-
- Copyright (C) 2000 John Harper <john dcs warwick ac uk>
-
- This file is part of sawfish.
-
- sawfish 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.
-
- sawfish 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 sawfish; see the file COPYING. If not, write to
- the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-|#
-
-(define-structure sawfish.cfg.widgets.event ()
+;; nokogiri-widgets/event.jl
+;;
+;; Copyright (C) 2000 John Harper <john dcs warwick ac uk>
+;;
+;; This file is part of sawfish.
+;;
+;; sawfish 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.
+;;
+;; sawfish 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 sawfish; see the file COPYING. If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+(define-structure sawfish.cfg.widgets.event
+
+ (export )
(open rep
- rep.regexp
- gui.gtk-2.gtk
- sawfish.gtk.widget
- sawfish.cfg.wm)
+ rep.regexp
+ gui.gtk-2.gtk
+ sawfish.gtk.widget
+ sawfish.cfg.wm)
(define (make-event-item changed)
@@ -41,8 +40,8 @@
(g-signal-connect entry "changed" (make-signal-callback changed))
(g-signal-connect grab "clicked"
- (lambda ()
- (gtk-entry-set-text entry (wm-grab-key))))
+ (lambda ()
+ (gtk-entry-set-text entry (wm-grab-key))))
(lambda (op)
(case op
diff --git a/lisp/sawfish/cfg/widgets/frame-style.jl b/lisp/sawfish/cfg/widgets/frame-style.jl
index d68bb09..32bcd94 100644
--- a/lisp/sawfish/cfg/widgets/frame-style.jl
+++ b/lisp/sawfish/cfg/widgets/frame-style.jl
@@ -1,42 +1,41 @@
-#| nokogiri-widgets/frame-style.jl -- theme chooser widget
-
- $Id: frame-style.jl,v 1.9 2003/01/12 20:30:49 jsh Exp $
-
- Copyright (C) 2000 John Harper <john dcs warwick ac uk>
-
- This file is part of sawfish.
-
- sawfish 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.
-
- sawfish 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 sawfish; see the file COPYING. If not, write to
- the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-|#
-
-(define-structure sawfish.cfg.widgets.frame-style ()
+;; nokogiri-widgets/frame-style.jl -- theme chooser widget
+;;
+;; Copyright (C) 2000 John Harper <john dcs warwick ac uk>
+;;
+;; This file is part of sawfish.
+;;
+;; sawfish 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.
+;;
+;; sawfish 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 sawfish; see the file COPYING. If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+(define-structure sawfish.cfg.widgets.frame-style
+
+ (export )
(open rep
- gui.gtk-2.gtk
- rep.regexp
- rep.io.files
- rep.io.timers
- sawfish.gtk.widget
- sawfish.cfg.i18n)
+ gui.gtk-2.gtk
+ rep.regexp
+ rep.io.files
+ rep.io.timers
+ sawfish.gtk.widget
+ sawfish.cfg.i18n)
(define (make-frame-style-item changed-callback doc options path)
(let ((vbox (gtk-vbox-new nil 0))
(hbox (gtk-hbox-new nil 0))
(combo (gtk-combo-new))
- (doc-label (gtk-label-new (_ doc)))
+ (doc-label (gtk-label-new (_ doc)))
(readme-text-view (gtk-text-view-new))
(readme-scroller (gtk-scrolled-window-new))
(value (car options))
diff --git a/lisp/sawfish/cfg/widgets/gtk/icon.jl b/lisp/sawfish/cfg/widgets/gtk/icon.jl
index ee8d00c..acfcaef 100644
--- a/lisp/sawfish/cfg/widgets/gtk/icon.jl
+++ b/lisp/sawfish/cfg/widgets/gtk/icon.jl
@@ -1,31 +1,30 @@
-#| nokogiri-widgets/icon.jl -- GNOME icon entry widget
-
- $Id$
-
- Originally written by Bruce Miller <docmad md prestige net>
-
- This file is part of sawfish.
-
- sawfish 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.
-
- sawfish 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 sawfish; see the file COPYING. If not, write to
- the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-|#
+;; nokogiri-widgets/icon.jl -- GNOME icon entry widget
+;;
+;; Originally written by Bruce Miller <docmad md prestige net>
+;;
+;; This file is part of sawfish.
+;;
+;; sawfish 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.
+;;
+;; sawfish 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 sawfish; see the file COPYING. If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
;; GNOME-less version of this widget
-(define-structure sawfish.cfg.widgets.icon ()
+(define-structure sawfish.cfg.widgets.icon
+
+ (export )
(open rep
- sawfish.gtk.widget)
+ sawfish.gtk.widget)
(define-widget-type 'icon (lambda (changed) (make-widget 'file changed))))
diff --git a/lisp/sawfish/cfg/widgets/gtk/workspace-geometry.jl b/lisp/sawfish/cfg/widgets/gtk/workspace-geometry.jl
index 25d8a05..5a7c28e 100644
--- a/lisp/sawfish/cfg/widgets/gtk/workspace-geometry.jl
+++ b/lisp/sawfish/cfg/widgets/gtk/workspace-geometry.jl
@@ -1,32 +1,31 @@
-#| nokogiri-widgets/workspace-geometry.jl
-
- $Id$
-
- Copyright (C) 2000 John Harper <john dcs warwick ac uk>
-
- This file is part of sawfish.
-
- sawfish 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.
-
- sawfish 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 sawfish; see the file COPYING. If not, write to
- the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-|#
+;; nokogiri-widgets/workspace-geometry.jl
+;;
+;; Copyright (C) 2000 John Harper <john dcs warwick ac uk>
+;;
+;; This file is part of sawfish.
+;;
+;; sawfish 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.
+;;
+;; sawfish 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 sawfish; see the file COPYING. If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
;; GNOME-less version of this widget
-(define-structure sawfish.cfg.widgets.workspace-geometry ()
+(define-structure sawfish.cfg.widgets.workspace-geometry
+
+ (export )
(open rep
- sawfish.gtk.widget)
+ sawfish.gtk.widget)
(define-widget-type 'workspace-geometry
(lambda (changed)
diff --git a/lisp/sawfish/cfg/widgets/icon.jl b/lisp/sawfish/cfg/widgets/icon.jl
index af6b08b..acfcaef 100644
--- a/lisp/sawfish/cfg/widgets/icon.jl
+++ b/lisp/sawfish/cfg/widgets/icon.jl
@@ -1,31 +1,30 @@
-#| nokogiri-widgets/icon.jl -- GNOME icon entry widget
-
- $Id: icon.jl,v 1.1 2000/09/01 20:03:29 john Exp $
-
- Originally written by Bruce Miller <docmad md prestige net>
-
- This file is part of sawfish.
-
- sawfish 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.
-
- sawfish 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 sawfish; see the file COPYING. If not, write to
- the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-|#
+;; nokogiri-widgets/icon.jl -- GNOME icon entry widget
+;;
+;; Originally written by Bruce Miller <docmad md prestige net>
+;;
+;; This file is part of sawfish.
+;;
+;; sawfish 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.
+;;
+;; sawfish 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 sawfish; see the file COPYING. If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
;; GNOME-less version of this widget
-(define-structure sawfish.cfg.widgets.icon ()
+(define-structure sawfish.cfg.widgets.icon
+
+ (export )
(open rep
- sawfish.gtk.widget)
+ sawfish.gtk.widget)
(define-widget-type 'icon (lambda (changed) (make-widget 'file changed))))
diff --git a/lisp/sawfish/cfg/widgets/keymap.jl b/lisp/sawfish/cfg/widgets/keymap.jl
index 6abee7f..5bdf471 100644
--- a/lisp/sawfish/cfg/widgets/keymap.jl
+++ b/lisp/sawfish/cfg/widgets/keymap.jl
@@ -1,33 +1,32 @@
-#| nokogiri-widgets/keymap.jl
-
- $Id$
-
- Copyright (C) 2000 John Harper <john dcs warwick ac uk>
-
- This file is part of sawfish.
-
- sawfish 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.
-
- sawfish 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 sawfish; see the file COPYING. If not, write to
- the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-|#
-
-(define-structure sawfish.cfg.widgets.keymap ()
+;; nokogiri-widgets/keymap.jl
+;;
+;; Copyright (C) 2000 John Harper <john dcs warwick ac uk>
+;;
+;; This file is part of sawfish.
+;;
+;; sawfish 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.
+;;
+;; sawfish 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 sawfish; see the file COPYING. If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+(define-structure sawfish.cfg.widgets.keymap
+
+ (export )
(open rep
- gui.gtk-2.gtk
- rep.regexp
- sawfish.gtk.stock
- sawfish.gtk.widget)
+ gui.gtk-2.gtk
+ rep.regexp
+ sawfish.gtk.stock
+ sawfish.gtk.widget)
;;; widget for representing keymaps
diff --git a/lisp/sawfish/cfg/widgets/match-window.jl b/lisp/sawfish/cfg/widgets/match-window.jl
index d4669aa..e9e0490 100644
--- a/lisp/sawfish/cfg/widgets/match-window.jl
+++ b/lisp/sawfish/cfg/widgets/match-window.jl
@@ -1,34 +1,33 @@
-#| nokogiri-widgets/match-window.jl -- match-window widget
-
- $Id: match-window.jl,v 1.11 2003/01/12 20:30:49 jsh Exp $
-
- Copyright (C) 2000 John Harper <john dcs warwick ac uk>
-
- This file is part of sawfish.
-
- sawfish 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.
-
- sawfish 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 sawfish; see the file COPYING. If not, write to
- the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-|#
-
-(define-structure sawfish.cfg.widgets.match-window ()
+;; nokogiri-widgets/match-window.jl -- match-window widget
+;;
+;; Copyright (C) 2000 John Harper <john dcs warwick ac uk>
+;;
+;; This file is part of sawfish.
+;;
+;; sawfish 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.
+;;
+;; sawfish 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 sawfish; see the file COPYING. If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+(define-structure sawfish.cfg.widgets.match-window
+
+ (export )
(open rep
- gui.gtk-2.gtk
- rep.regexp
- sawfish.gtk.widget
- sawfish.gtk.stock
- sawfish.cfg.wm)
+ gui.gtk-2.gtk
+ rep.regexp
+ sawfish.gtk.widget
+ sawfish.gtk.stock
+ sawfish.cfg.wm)
(defconst matcher-count 3)
@@ -56,16 +55,17 @@
(gtk-table-attach-defaults table button 0 1 i (1+ i))
(gtk-table-attach-defaults table combo 1 2 i (1+ i))
(gtk-table-attach-defaults table entry 2 3 i (1+ i))
- (g-signal-connect button "clicked"
- (lambda ()
- (let* ((string (gtk-entry-get-text (gtk-combo-entry combo)))
- (x-prop (and string (car (rassoc string
- l10n-x-properties)))))
- (when string
- (let ((prop (wm-grab-x-property (or x-prop (intern string)))))
- (gtk-entry-set-text entry (if (stringp prop)
- prop
- "")))))))
+ (g-signal-connect
+ button "clicked"
+ (lambda ()
+ (let* ((string (gtk-entry-get-text (gtk-combo-entry combo)))
+ (x-prop (and string (car (rassoc string
+ l10n-x-properties)))))
+ (when string
+ (let ((prop (wm-grab-x-property (or x-prop (intern string)))))
+ (gtk-entry-set-text entry (if (stringp prop)
+ prop
+ "")))))))
(setq widgets (nconc widgets (list (cons combo entry))))))
(gtk-container-add frame table)
(gtk-container-set-border-width table box-border)
@@ -94,19 +94,19 @@
(lambda ()
(let loop ((cells widgets)
(out '()))
- (if (null cells)
- (nreverse out)
- (let ((name (gtk-entry-get-text
- (gtk-combo-entry (caar cells))))
- (value (gtk-entry-get-text (cdar cells))))
- (if (or (string= name "") (string= value ""))
- (loop (cdr cells) out)
- (let ((prop (rassoc name l10n-x-properties)))
- (if prop
- (setq name (car prop))
- (setq name (intern name))))
- (loop (cdr cells)
- (cons (cons name value) out))))))))
+ (if (null cells)
+ (nreverse out)
+ (let ((name (gtk-entry-get-text
+ (gtk-combo-entry (caar cells))))
+ (value (gtk-entry-get-text (cdar cells))))
+ (if (or (string= name "") (string= value ""))
+ (loop (cdr cells) out)
+ (let ((prop (rassoc name l10n-x-properties)))
+ (if prop
+ (setq name (car prop))
+ (setq name (intern name))))
+ (loop (cdr cells)
+ (cons (cons name value) out))))))))
((validp) listp)))))
(define-widget-type 'match-window:matchers make-match-window:matchers)
@@ -165,20 +165,20 @@
(lambda ()
(let loop ((rest widgets)
(out '()))
- (if (null rest)
- (nreverse out)
- (let ((value (widget-ref (cdar rest))))
- (if value
- (loop (cdr rest) (cons (cons (caar rest) value) out))
- (loop (cdr rest) out)))))))))))
-
+ (if (null rest)
+ (nreverse out)
+ (let ((value (widget-ref (cdar rest))))
+ (if value
+ (loop (cdr rest) (cons (cons (caar rest) value) out))
+ (loop (cdr rest) out)))))))))))
+
(define-widget-type 'match-window:actions make-match-window:actions)
(define (make-left-label string)
(let ((hbox (gtk-hbox-new nil 0)))
(gtk-box-pack-start hbox (gtk-label-new string))
hbox))
-
+
;; also in sawfish-xgettext
(define (beautify-symbol-name symbol)
(cond ((stringp symbol) symbol)
@@ -192,7 +192,7 @@
(_ name)))))
;;; the main widget
-
+
;; (match-window ...)
(define (make-match-window-item changed-callback properties x-properties)
diff --git a/lisp/sawfish/cfg/widgets/modifier-list.jl b/lisp/sawfish/cfg/widgets/modifier-list.jl
index 6b58bc5..bd6eeec 100644
--- a/lisp/sawfish/cfg/widgets/modifier-list.jl
+++ b/lisp/sawfish/cfg/widgets/modifier-list.jl
@@ -1,33 +1,32 @@
-#| modifier-list.jl -- widget for a list of modifier keys
-
- $Id$
-
- Author: John Harper <john dcs warwick ac uk>
-
- Copyright (C) 2000 Eazel, Inc.
-
- This file is part of sawfish.
-
- sawfish 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.
-
- sawfish 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 sawfish; see the file COPYING. If not, write to
- the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-|#
-
-(define-structure sawfish.cfg.widgets.modifier-list ()
+;; modifier-list.jl -- widget for a list of modifier keys
+;;
+;; Author: John Harper <john dcs warwick ac uk>
+;;
+;; Copyright (C) 2000 Eazel, Inc.
+;;
+;; This file is part of sawfish.
+;;
+;; sawfish 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.
+;;
+;; sawfish 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 sawfish; see the file COPYING. If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+(define-structure sawfish.cfg.widgets.modifier-list
+
+ (export )
(open rep
- rep.regexp
- sawfish.gtk.widget)
+ rep.regexp
+ sawfish.gtk.widget)
;; XXX should read the non-null modifiers from the wm?
@@ -49,9 +48,9 @@
(and (listp x)
(not (null x))
(let loop ((rest x))
- (cond ((null rest) t)
- ((not (memq (car rest) modifiers)) nil)
- (t (loop (cdr rest)))))))
+ (cond ((null rest) t)
+ ((not (memq (car rest) modifiers)) nil)
+ (t (loop (cdr rest)))))))
(define (make-item changed-callback)
(let (base)
diff --git a/lisp/sawfish/cfg/widgets/workspace-geometry.jl b/lisp/sawfish/cfg/widgets/workspace-geometry.jl
index 2a522a8..5a7c28e 100644
--- a/lisp/sawfish/cfg/widgets/workspace-geometry.jl
+++ b/lisp/sawfish/cfg/widgets/workspace-geometry.jl
@@ -1,32 +1,31 @@
-#| nokogiri-widgets/workspace-geometry.jl
-
- $Id: workspace-geometry.jl,v 1.1 2000/09/01 20:03:29 john Exp $
-
- Copyright (C) 2000 John Harper <john dcs warwick ac uk>
-
- This file is part of sawfish.
-
- sawfish 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.
-
- sawfish 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 sawfish; see the file COPYING. If not, write to
- the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-|#
+;; nokogiri-widgets/workspace-geometry.jl
+;;
+;; Copyright (C) 2000 John Harper <john dcs warwick ac uk>
+;;
+;; This file is part of sawfish.
+;;
+;; sawfish 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.
+;;
+;; sawfish 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 sawfish; see the file COPYING. If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
;; GNOME-less version of this widget
-(define-structure sawfish.cfg.widgets.workspace-geometry ()
+(define-structure sawfish.cfg.widgets.workspace-geometry
+
+ (export )
(open rep
- sawfish.gtk.widget)
+ sawfish.gtk.widget)
(define-widget-type 'workspace-geometry
(lambda (changed)
diff --git a/lisp/sawfish/cfg/wm.jl b/lisp/sawfish/cfg/wm.jl
index 110ff59..93ffeba 100644
--- a/lisp/sawfish/cfg/wm.jl
+++ b/lisp/sawfish/cfg/wm.jl
@@ -1,25 +1,22 @@
-#| nokogiri-wm.jl -- WM communication
-
- $Id$
-
- Copyright (C) 2000 John Harper <john dcs warwick ac uk>
-
- This file is part of sawfish.
-
- sawfish 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.
-
- sawfish 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 sawfish; see the file COPYING. If not, write to
- the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-|#
+;; nokogiri-wm.jl -- WM communication
+;;
+;; Copyright (C) 2000 John Harper <john dcs warwick ac uk>
+;;
+;; This file is part of sawfish.
+;;
+;; sawfish 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.
+;;
+;; sawfish 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 sawfish; see the file COPYING. If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
(define-structure sawfish.cfg.wm
diff --git a/lisp/sawfish/gtk/stock.jl b/lisp/sawfish/gtk/stock.jl
index b59fc58..a7a44e3 100644
--- a/lisp/sawfish/gtk/stock.jl
+++ b/lisp/sawfish/gtk/stock.jl
@@ -1,36 +1,33 @@
-#| nokogiri-no-gnome.jl -- workaround lack of GNOME widgets -*- lisp -*-
-
- $Id: stock.jl.gtk,v 1.9 2003/01/12 20:30:43 jsh Exp $
-
- Copyright (C) 2000 John Harper <john dcs warwick ac uk>
-
- This file is part of sawfish.
-
- sawfish 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.
-
- sawfish 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 sawfish; see the file COPYING. If not, write to
- the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-|#
+;; nokogiri-no-gnome.jl -- workaround lack of GNOME widgets -*- lisp -*-
+;;
+;; Copyright (C) 2000 John Harper <john dcs warwick ac uk>
+;;
+;; This file is part of sawfish.
+;;
+;; sawfish 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.
+;;
+;; sawfish 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 sawfish; see the file COPYING. If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
(define-structure sawfish.gtk.stock
(export stock-button
- simple-dialog
- about-dialog
- make-url-widget)
+ simple-dialog
+ about-dialog
+ make-url-widget)
(open rep
- gui.gtk-2.gtk
- sawfish.gtk.widget)
+ gui.gtk-2.gtk
+ sawfish.gtk.widget)
;; same as in gnome now
(define (stock-button type)
@@ -59,7 +56,7 @@
(define (on-ok)
(ok-callback)
(gtk-widget-destroy window))
-
+
(gtk-window-set-title window title)
(gtk-window-set-wmclass window "ok_cancel_dialog" "Nokogiri")
(gtk-container-set-border-width window box-border)
diff --git a/lisp/sawfish/gtk/widget-dialog.jl b/lisp/sawfish/gtk/widget-dialog.jl
index 13f471f..d6c6b52 100644
--- a/lisp/sawfish/gtk/widget-dialog.jl
+++ b/lisp/sawfish/gtk/widget-dialog.jl
@@ -1,25 +1,22 @@
-#| nokogiri-widget-dialog.jl -- simple dialogs from widgets
-
- $Id$
-
- Copyright (C) 2000 John Harper <john dcs warwick ac uk>
-
- This file is part of sawfish.
-
- sawfish 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.
-
- sawfish 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 sawfish; see the file COPYING. If not, write to
- the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-|#
+;; nokogiri-widget-dialog.jl -- simple dialogs from widgets
+;;
+;; Copyright (C) 2000 John Harper <john dcs warwick ac uk>
+;;
+;; This file is part of sawfish.
+;;
+;; sawfish 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.
+;;
+;; sawfish 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 sawfish; see the file COPYING. If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
(define-structure sawfish.gtk.widget-dialog
diff --git a/lisp/sawfish/gtk/widget-test.jl b/lisp/sawfish/gtk/widget-test.jl
index cd05a75..a4ca49c 100644
--- a/lisp/sawfish/gtk/widget-test.jl
+++ b/lisp/sawfish/gtk/widget-test.jl
@@ -1,33 +1,30 @@
-#| nokogiri-widget-test.jl -- test harness for widgets
-
- $Id$
-
- Copyright (C) 2000 John Harper <john dcs warwick ac uk>
-
- This file is part of sawfish.
-
- sawfish 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.
-
- sawfish 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 sawfish; see the file COPYING. If not, write to
- the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-|#
+;; nokogiri-widget-test.jl -- test harness for widgets
+;;
+;; Copyright (C) 2000 John Harper <john dcs warwick ac uk>
+;;
+;; This file is part of sawfish.
+;;
+;; sawfish 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.
+;;
+;; sawfish 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 sawfish; see the file COPYING. If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
(define-structure sawfish.gtk.widget-test
- ;;;;; This is broken, it kills sawfish, test it: ;
- ;;;; sawfish-client ;;
- ;;; (require 'sawfish.gtk.widget-test) ;;;
- ;; (test-widget '(optional (choice one two three)) 'two) ;;;;
- ; now move the window -> X Window System error -> kill ;;;;;
+;;;;; This is broken, it kills sawfish, test it: ;;;;;
+;;;;; sawfish-client ;;;;;
+;;;;; (require 'sawfish.gtk.widget-test) ;;;;;
+;;;;; (test-widget '(optional (choice one two three)) 'two) ;;;;;
+;;;;; now move the window -> X Window System error -> kill ;;;;;
(export test-widget)
@@ -50,7 +47,7 @@
(let ((window (gtk-window-new 'toplevel)))
(gtk-container-add window (widget-gtk-widget widget))
(g-signal-connect window "delete_event"
- (lambda () (throw 'done t)))
+ (lambda () (throw 'done t)))
(gtk-widget-show-all window)
(unwind-protect
(catch 'done
diff --git a/lisp/sawfish/gtk/widget.jl b/lisp/sawfish/gtk/widget.jl
index 046d290..b85154a 100644
--- a/lisp/sawfish/gtk/widget.jl
+++ b/lisp/sawfish/gtk/widget.jl
@@ -1,25 +1,22 @@
-#| nokogiri-widget.jl -- high-level widget encapsulation
-
- $Id: widget.jl,v 1.21 2003/07/30 05:56:04 jsh Exp $
-
- Copyright (C) 2000 John Harper <john dcs warwick ac uk>
-
- This file is part of sawfish.
-
- sawfish 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.
-
- sawfish 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 sawfish; see the file COPYING. If not, write to
- the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-|#
+;; nokogiri-widget.jl -- high-level widget encapsulation
+;;
+;; Copyright (C) 2000 John Harper <john dcs warwick ac uk>
+;;
+;; This file is part of sawfish.
+;;
+;; sawfish 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.
+;;
+;; sawfish 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 sawfish; see the file COPYING. If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
(define-structure sawfish.gtk.widget
@@ -148,11 +145,11 @@
(define (widget-set item value)
(let-fluids ((callback-enabled nil))
- ((item 'set) value)))
+ ((item 'set) value)))
(define (widget-clear item)
(let-fluids ((callback-enabled nil))
- ((item 'clear))))
+ ((item 'clear))))
(define (widget-gtk-widget item) (item 'gtk-widget))
@@ -195,17 +192,18 @@
(value (or (caar options) (car options))))
(let loop ((rest options)
(last nil))
- (when rest
- (let ((button (gtk-radio-menu-item-new-with-label-from-widget
- last (_ (or (cadar rest) (symbol-name (car rest)))))))
- (gtk-menu-shell-append menu button)
- (gtk-widget-show button)
- (g-signal-connect button "toggled"
- (lambda (w)
- (when (gtk-check-menu-item-active w)
- (setq value (or (caar rest) (car rest)))
- (call-callback changed-callback))))
- (loop (cdr rest) button))))
+ (when rest
+ (let ((button (gtk-radio-menu-item-new-with-label-from-widget
+ last (_ (or (cadar rest)
+ (symbol-name (car rest)))))))
+ (gtk-menu-shell-append menu button)
+ (gtk-widget-show button)
+ (g-signal-connect button "toggled"
+ (lambda (w)
+ (when (gtk-check-menu-item-active w)
+ (setq value (or (caar rest) (car rest)))
+ (call-callback changed-callback))))
+ (loop (cdr rest) button))))
(gtk-option-menu-set-menu omenu menu)
(gtk-widget-show-all omenu)
(lambda (op)
@@ -353,7 +351,7 @@
(do ((i 0 (1+ i)))
((= i (length items)))
(g-signal-connect (nth i checks) "toggled" (lambda ()
- (toggle-fun i)))
+ (toggle-fun i)))
(gtk-box-pack-start box (nth i hboxes))
(gtk-box-pack-start (nth i hboxes) (nth i checks))
(gtk-box-pack-start (nth i hboxes) (widget-gtk-widget (nth i items))))
@@ -433,11 +431,11 @@
(define-widget-type 'h-and (lambda (#!rest args)
(let-fluids ((and-direction 'horizontal))
- (apply make-and-item args))))
+ (apply make-and-item args))))
(define-widget-type 'v-and (lambda (#!rest args)
(let-fluids ((and-direction 'vertical))
- (apply make-and-item args))))
+ (apply make-and-item args))))
(define (make-labelled-item changed-callback label item)
(let ((box (gtk-hbox-new nil box-spacing)))
@@ -525,6 +523,6 @@
(define (option-index lst x)
(let loop ((i 0) (rest lst))
- (cond ((null rest) nil)
- ((eq (or (caar rest) (car rest)) x) i)
- (t (loop (1+ i) (cdr rest)))))))
+ (cond ((null rest) nil)
+ ((eq (or (caar rest) (car rest)) x) i)
+ (t (loop (1+ i) (cdr rest)))))))
diff --git a/lisp/sawfish/gtk/widgets/alist.jl b/lisp/sawfish/gtk/widgets/alist.jl
index 4596f31..a67ad3e 100644
--- a/lisp/sawfish/gtk/widgets/alist.jl
+++ b/lisp/sawfish/gtk/widgets/alist.jl
@@ -1,32 +1,31 @@
-#| nokogiri-widgets/alist.jl -- alist widget
-
- $Id$
-
- Copyright (C) 2000 John Harper <john dcs warwick ac uk>
-
- This file is part of sawfish.
-
- sawfish 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.
-
- sawfish 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 sawfish; see the file COPYING. If not, write to
- the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-|#
-
-(define-structure sawfish.gtk.widgets.alist ()
+;; nokogiri-widgets/alist.jl -- alist widget
+;;
+;; Copyright (C) 2000 John Harper <john dcs warwick ac uk>
+;;
+;; This file is part of sawfish.
+;;
+;; sawfish 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.
+;;
+;; sawfish 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 sawfish; see the file COPYING. If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+(define-structure sawfish.gtk.widgets.alist
+
+ (export )
(open rep
- gui.gtk-2.gtk
- sawfish.gtk.widget
- sawfish.gtk.widget-dialog)
+ gui.gtk-2.gtk
+ sawfish.gtk.widget
+ sawfish.gtk.widget-dialog)
;; (alist (KEY-SPEC "KEY-TITLE") (VALUE-SPEC "VALUE-TITLE"))
diff --git a/lisp/sawfish/gtk/widgets/color.jl b/lisp/sawfish/gtk/widgets/color.jl
index 3194fd2..a6a4697 100644
--- a/lisp/sawfish/gtk/widgets/color.jl
+++ b/lisp/sawfish/gtk/widgets/color.jl
@@ -1,52 +1,55 @@
-#| nokogiri-widgets/color.jl -- color selector widget
-
- $Id$
-
- Copyright (C) 2000 John Harper <john dcs warwick ac uk>
-
- This file is part of sawfish.
-
- sawfish 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.
-
- sawfish 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 sawfish; see the file COPYING. If not, write to
- the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-|#
-
-(define-structure sawfish.gtk.widgets.color ()
+;; nokogiri-widgets/color.jl -- color selector widget
+;;
+;; Copyright (C) 2000 John Harper <john dcs warwick ac uk>
+;;
+;; This file is part of sawfish.
+;;
+;; sawfish 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.
+;;
+;; sawfish 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 sawfish; see the file COPYING. If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+(define-structure sawfish.gtk.widgets.color
+
+ (export )
(open rep
- gui.gtk-2.gtk
- rep.regexp
- sawfish.gtk.widget)
+ gui.gtk-2.gtk
+ rep.regexp
+ sawfish.gtk.widget)
(defconst default-color "#000000")
(define (make-color-item changed-callback)
(let* ((value default-color)
- (button (gtk-color-button-new-with-color (gdk-color-parse-interp value))))
+ (button (gtk-color-button-new-with-color
+ (gdk-color-parse-interp value))))
(g-signal-connect button "color-set"
- (lambda ()
- (let ((color (gtk-color-button-get-color-interp button)))
- (setq value color)
- (call-callback changed-callback))))
+ (lambda ()
+ (let ((color (gtk-color-button-get-color-interp
+ button)))
+ (setq value color)
+ (call-callback changed-callback))))
(gtk-widget-show button)
(lambda (op)
(case op
((set) (lambda (x)
(setq value x)
- (gtk-color-button-set-color button (gdk-color-parse-interp value))))
+ (gtk-color-button-set-color button (gdk-color-parse-interp
+ value))))
((clear) (lambda ()
(setq value default-color)
- (gtk-color-button-set-color button (gdk-color-parse-interp value))))
+ (gtk-color-button-set-color button (gdk-color-parse-interp
+ value))))
((ref) (lambda () value))
((gtk-widget) button)
((validp) (lambda (x)
diff --git a/lisp/sawfish/gtk/widgets/file.jl b/lisp/sawfish/gtk/widgets/file.jl
index ba8f89a..c4c5896 100644
--- a/lisp/sawfish/gtk/widgets/file.jl
+++ b/lisp/sawfish/gtk/widgets/file.jl
@@ -1,31 +1,30 @@
-#| nokogiri-widgets/file.jl -- file name widget
+;; nokogiri-widgets/file.jl -- file name widget
+;;
+;; Copyright (C) 2000 John Harper <john dcs warwick ac uk>
+;;
+;; This file is part of sawfish.
+;;
+;; sawfish 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.
+;;
+;; sawfish 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 sawfish; see the file COPYING. If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
- $Id$
+(define-structure sawfish.gtk.widgets.file
- Copyright (C) 2000 John Harper <john dcs warwick ac uk>
-
- This file is part of sawfish.
-
- sawfish 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.
-
- sawfish 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 sawfish; see the file COPYING. If not, write to
- the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-|#
-
-(define-structure sawfish.gtk.widgets.file ()
+ (export )
(open rep
- gui.gtk-2.gtk
- sawfish.gtk.widget)
+ gui.gtk-2.gtk
+ sawfish.gtk.widget)
(define (make-file-item changed-callback)
(let* ((box (gtk-hbox-new nil box-spacing))
@@ -52,7 +51,7 @@
(gtk-file-selection-cancel-button filesel) "clicked"
(lambda () (gtk-widget-destroy filesel)))
(g-signal-connect filesel "delete_event"
- (lambda () (gtk-widget-destroy filesel)))
+ (lambda () (gtk-widget-destroy filesel)))
(gtk-widget-show filesel)
(gtk-grab-add filesel))))
(gtk-widget-show box)
diff --git a/lisp/sawfish/gtk/widgets/list.jl b/lisp/sawfish/gtk/widgets/list.jl
index 264bffe..26df35d 100644
--- a/lisp/sawfish/gtk/widgets/list.jl
+++ b/lisp/sawfish/gtk/widgets/list.jl
@@ -1,32 +1,31 @@
-#| nokogiri-widgets/list.jl -- list widget
-
- $Id$
-
- Copyright (C) 2000 John Harper <john dcs warwick ac uk>
-
- This file is part of sawfish.
-
- sawfish 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.
-
- sawfish 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 sawfish; see the file COPYING. If not, write to
- the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-|#
-
-(define-structure sawfish.gtk.widgets.list ()
+;; nokogiri-widgets/list.jl -- list widget
+;;
+;; Copyright (C) 2000 John Harper <john dcs warwick ac uk>
+;;
+;; This file is part of sawfish.
+;;
+;; sawfish 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.
+;;
+;; sawfish 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 sawfish; see the file COPYING. If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+(define-structure sawfish.gtk.widgets.list
+
+ (export )
(open rep
- gui.gtk-2.gtk
- sawfish.gtk.widget
- sawfish.gtk.widget-dialog)
+ gui.gtk-2.gtk
+ sawfish.gtk.widget
+ sawfish.gtk.widget-dialog)
;; (list SPEC-OR-FUNCTION [TITLE])
@@ -72,18 +71,22 @@
(list (format nil "%s" x))))
(define (add-item)
- (let ((callback (lambda (new)
- (with-clist-frozen clist
- (if (not selection)
- (progn
- (setq value (append value (list new)))
- (gtk-clist-append clist (print-value new)))
- (setq value (copy-sequence value))
- (setq value (insert-after new value selection))
- (gtk-clist-insert
- clist (1+ selection) (print-value new))
- (gtk-clist-select-row clist (1+ selection) 0)))
- (call-callback changed-callback))))
+ (let ((callback
+ (lambda (new)
+ (with-clist-frozen clist
+ (if (not selection)
+ (progn
+ (setq value (append value (list new)))
+ (gtk-clist-append clist
+ (print-value new)))
+ (setq value (copy-sequence value))
+ (setq value (insert-after new value
+ selection))
+ (gtk-clist-insert
+ clist (1+ selection) (print-value new))
+ (gtk-clist-select-row clist
+ (1+ selection) 0)))
+ (call-callback changed-callback))))
(if (functionp spec)
((spec 'dialog) (_ "Add:") callback #:for (top-level))
(widget-dialog (_ "Add:") spec callback nil (top-level)))))
@@ -97,10 +100,10 @@
(rplacd (nthcdr (1- selection) value)
(nthcdr (1+ selection) value)))
(with-clist-frozen clist
- (gtk-clist-remove clist selection)
- (if (> (gtk-clist-rows clist) orig-sel)
- (gtk-clist-select-row clist orig-sel 0)
- (set-selection nil)))
+ (gtk-clist-remove clist selection)
+ (if (> (gtk-clist-rows clist) orig-sel)
+ (gtk-clist-select-row clist orig-sel 0)
+ (set-selection nil)))
(call-callback changed-callback))))
(define (edit-item)
@@ -108,14 +111,15 @@
(setq value (copy-sequence value))
(let* ((orig-sel selection)
(cell (nthcdr orig-sel value))
- (callback (lambda (new)
- (rplaca cell new)
- (with-clist-frozen clist
- (gtk-clist-remove clist orig-sel)
- (gtk-clist-insert
- clist orig-sel (print-value new))
- (gtk-clist-select-row clist orig-sel 0))
- (call-callback changed-callback))))
+ (callback
+ (lambda (new)
+ (rplaca cell new)
+ (with-clist-frozen clist
+ (gtk-clist-remove clist orig-sel)
+ (gtk-clist-insert
+ clist orig-sel (print-value new))
+ (gtk-clist-select-row clist orig-sel 0))
+ (call-callback changed-callback))))
(if (functionp spec)
((spec 'dialog) (_ "Edit:") callback
#:value (car cell) #:for (top-level))
@@ -130,26 +134,26 @@
(g-signal-connect delete "clicked" delete-item)
(g-signal-connect edit "clicked" edit-item)
(g-signal-connect clist "select_row"
- (lambda (w row col)
- (declare (unused w col))
- (set-selection row)))
+ (lambda (w row col)
+ (declare (unused w col))
+ (set-selection row)))
(g-signal-connect clist "unselect_row"
- (lambda (w row col)
- (declare (unused w col))
- (when (= row selection)
- (set-selection nil))))
+ (lambda (w row col)
+ (declare (unused w col))
+ (when (= row selection)
+ (set-selection nil))))
(g-signal-connect clist "button_press_event"
- (lambda (w ev)
- (declare (unused w))
- (when (eq (gdk-event-type ev) '2button-press)
- (edit-item))
- nil))
+ (lambda (w ev)
+ (declare (unused w))
+ (when (eq (gdk-event-type ev) '2button-press)
+ (edit-item))
+ nil))
(g-signal-connect clist "key_press_event"
- (lambda (w ev)
- (declare (unused w))
- (when (string= (gdk-event-string ev) "\r")
- (edit-item))
- nil))
+ (lambda (w ev)
+ (declare (unused w))
+ (when (string= (gdk-event-string ev) "\r")
+ (edit-item))
+ nil))
(gtk-clist-set-shadow-type clist 'none)
(gtk-clist-set-column-width clist 0 100)
diff --git a/lisp/sawfish/gtk/widgets/pair.jl b/lisp/sawfish/gtk/widgets/pair.jl
index 808cd81..f66e817 100644
--- a/lisp/sawfish/gtk/widgets/pair.jl
+++ b/lisp/sawfish/gtk/widgets/pair.jl
@@ -1,31 +1,30 @@
-#| nokogiri-widgets/pair.jl -- cons-cell widget
-
- $Id$
-
- Copyright (C) 2000 John Harper <john dcs warwick ac uk>
-
- This file is part of sawfish.
-
- sawfish 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.
-
- sawfish 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 sawfish; see the file COPYING. If not, write to
- the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-|#
-
-(define-structure sawfish.gtk.widgets.pair ()
+;; nokogiri-widgets/pair.jl -- cons-cell widget
+;;
+;; Copyright (C) 2000 John Harper <john dcs warwick ac uk>
+;;
+;; This file is part of sawfish.
+;;
+;; sawfish 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.
+;;
+;; sawfish 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 sawfish; see the file COPYING. If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+(define-structure sawfish.gtk.widgets.pair
+
+ (export )
(open rep
- gui.gtk-2.gtk
- sawfish.gtk.widget)
+ gui.gtk-2.gtk
+ sawfish.gtk.widget)
;; (pair CAR-SPEC CDR-SPEC)
diff --git a/lisp/sawfish/gtk/widgets/program.jl b/lisp/sawfish/gtk/widgets/program.jl
index eecf209..4affb1e 100644
--- a/lisp/sawfish/gtk/widgets/program.jl
+++ b/lisp/sawfish/gtk/widgets/program.jl
@@ -1,30 +1,29 @@
-#| nokogiri-widgets/program.jl --
-
- $Id$
-
- Copyright (C) 2000 John Harper <john dcs warwick ac uk>
-
- This file is part of sawfish.
-
- sawfish 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.
-
- sawfish 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 sawfish; see the file COPYING. If not, write to
- the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-|#
-
-(define-structure sawfish.gtk.widgets.program ()
+;; nokogiri-widgets/program.jl --
+;;
+;; Copyright (C) 2000 John Harper <john dcs warwick ac uk>
+;;
+;; This file is part of sawfish.
+;;
+;; sawfish 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.
+;;
+;; sawfish 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 sawfish; see the file COPYING. If not, write to the
+;; Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+(define-structure sawfish.gtk.widgets.program
+
+ (export )
(open rep
- sawfish.gtk.widget)
+ sawfish.gtk.widget)
(define (make-program-item changed-callback)
(make-widget 'file changed-callback))
diff --git a/lisp/sawfish/gtk/widgets/scheme-boolean.jl b/lisp/sawfish/gtk/widgets/scheme-boolean.jl
index abdbc7d..47da6bc 100644
--- a/lisp/sawfish/gtk/widgets/scheme-boolean.jl
+++ b/lisp/sawfish/gtk/widgets/scheme-boolean.jl
@@ -1,32 +1,31 @@
-#| nokogiri-widgets/scheme-boolean.jl --
-
- $Id$
-
- Copyright (C) 2002 John Harper <jsh unfactored org>
-
- This file is part of sawfish.
-
- sawfish 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.
-
- sawfish 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 sawfish; see the file COPYING. If not, write to
- the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-|#
-
-(define-structure sawfish.gtk.widgets.scheme-boolean ()
+;; nokogiri-widgets/scheme-boolean.jl --
+;;
+;; Copyright (C) 2002 John Harper <jsh unfactored org>
+;;
+;; This file is part of sawfish.
+;;
+;; sawfish 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.
+;;
+;; sawfish 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 sawfish; see the file COPYING. If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+(define-structure sawfish.gtk.widgets.scheme-boolean
+
+ (export )
(open rep
- gui.gtk-2.gtk
- sawfish.gtk.widget
- sawfish.gtk.widget-dialog)
+ gui.gtk-2.gtk
+ sawfish.gtk.widget
+ sawfish.gtk.widget-dialog)
(define (make-item changed-callback)
(let ((widget (gtk-toggle-button-new-with-label (_ "Yes"))))
diff --git a/lisp/sawfish/wm.jl b/lisp/sawfish/wm.jl
index b549a54..fb7c47b 100644
--- a/lisp/sawfish/wm.jl
+++ b/lisp/sawfish/wm.jl
@@ -1,25 +1,22 @@
-#| sawfish.wm bootstrap
-
- $Id: wm.jl,v 1.13 2002/05/07 03:35:59 jsh Exp $
-
- Copyright (C) 1999 John Harper <john dcs warwick ac uk>
-
- This file is part of sawfish.
-
- sawfish 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.
-
- sawfish 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 sawfish; see the file COPYING. If not, write to
- the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-|#
+;; sawfish.wm bootstrap
+;;
+;; Copyright (C) 1999 John Harper <john dcs warwick ac uk>
+;;
+;; This file is part of sawfish.
+;;
+;; sawfish 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.
+;;
+;; sawfish 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 sawfish; see the file COPYING. If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
(declare (in-module sawfish.wm))
@@ -150,8 +147,8 @@
(sawfish-load-all "sawfish/wm/autoload")
(sawfish-load-all (concat "os-" (symbol-name operating-system))))
- ;; do user-level initialization
- (load "sawfish/wm/user")
+;; do user-level initialization
+(load "sawfish/wm/user")
(let ((session-id (get-command-line-option "--sm-client-id" t))
(session-prefix (get-command-line-option "--sm-prefix" t)))
diff --git a/lisp/sawfish/wm/animation/outline.jl b/lisp/sawfish/wm/animation/outline.jl
index c47465e..604eeba 100644
--- a/lisp/sawfish/wm/animation/outline.jl
+++ b/lisp/sawfish/wm/animation/outline.jl
@@ -1,5 +1,4 @@
;; anim-outline.jl -- simple window animations
-;; $Id: outline.jl,v 1.8 2002/03/24 10:12:26 jsh Exp $
;; Copyright (C) 2000 John Harper <john dcs warwick ac uk>
diff --git a/lisp/sawfish/wm/autoload.jl b/lisp/sawfish/wm/autoload.jl
index dd5837c..55ffe59 100644
--- a/lisp/sawfish/wm/autoload.jl
+++ b/lisp/sawfish/wm/autoload.jl
@@ -1,5 +1,4 @@
;; autoload.jl -- Initialise auto-load functions
-;; $Id: autoload.jl,v 1.21 2002/08/18 21:30:05 jsh Exp $
;; Copyright (C) 1999 John Harper <john dcs warwick ac uk>
diff --git a/lisp/sawfish/wm/commands.jl b/lisp/sawfish/wm/commands.jl
index e2a4edd..4b450e1 100644
--- a/lisp/sawfish/wm/commands.jl
+++ b/lisp/sawfish/wm/commands.jl
@@ -1,25 +1,22 @@
-#| commands.jl -- managing the command database
-
- $Id$
-
- Copyright (C) 2000 John Harper <john dcs warwick ac uk>
-
- This file is part of sawfish.
-
- sawfish 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.
-
- sawfish 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 sawfish; see the file COPYING. If not, write to
- the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-|#
+;; commands.jl -- managing the command database
+;;
+;; Copyright (C) 2000 John Harper <john dcs warwick ac uk>
+;;
+;; This file is part of sawfish.
+;;
+;; sawfish 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.
+;;
+;; sawfish 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 sawfish; see the file COPYING. If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
(define-structure sawfish.wm.commands
@@ -200,34 +197,36 @@ command called NAME (optionally whose arguments have custom-type TYPE)."
(cond ((stringp spec)
(let loop ((args '())
(point 0))
- (cond ((>= point (length spec)) (nreverse args))
- ((eql (aref spec point) #\newline)
- (loop (cons nil args) (1+ point)))
- (t
- (let ((local nil)
- (code nil)
- (prompt nil))
- (if (eql (aref spec point) #\%)
- (progn
- (setq local t)
- (setq code (aref spec (1+ point)))
- (setq point (+ point 2)))
- (setq code (aref spec point))
- (setq point (1+ point)))
- (let ((end (if (string-match "(\n|$)" spec point)
- (match-start)
- (length spec))))
- (unless (= point end)
- (setq prompt (substring spec point end)))
- (setq point (1+ end)))
- (let (arg)
- (let-fluids ((arg-can-be-nil nil))
- (setq arg (if local
- (local-codes code prompt)
- (global-codes code prompt)))
- (when (and (not (fluid arg-can-be-nil)) (null arg))
- (error "Null argument to command: %s" name)))
- (loop (cons arg args) point)))))))
+ (cond ((>= point (length spec)) (nreverse args))
+ ((eql (aref spec point) #\newline)
+ (loop (cons nil args) (1+ point)))
+ (t
+ (let ((local nil)
+ (code nil)
+ (prompt nil))
+ (if (eql (aref spec point) #\%)
+ (progn
+ (setq local t)
+ (setq code (aref spec (1+ point)))
+ (setq point (+ point 2)))
+ (setq code (aref spec point))
+ (setq point (1+ point)))
+ (let ((end (if (string-match "(\n|$)" spec point)
+ (match-start)
+ (length spec))))
+ (unless (= point end)
+ (setq prompt (substring spec point end)))
+ (setq point (1+ end)))
+ (let (arg)
+ (let-fluids ((arg-can-be-nil nil))
+ (setq arg (if local
+ (local-codes code prompt)
+ (global-codes code prompt)))
+ (when (and (not (fluid arg-can-be-nil))
+ (null arg))
+ (error "Null argument to command: %s"
+ name)))
+ (loop (cons arg args) point)))))))
((functionp spec) (spec))
((consp spec) (user-eval spec))))
@@ -253,7 +252,7 @@ command called NAME (optionally whose arguments have custom-type TYPE)."
(prompt-for-workspace prompt))
(t (error "Unknown spec: %%%c" code))))
-
+
;; general rep codes
(define (global-codes code prompt)
(case code
@@ -334,9 +333,9 @@ command called NAME (optionally whose arguments have custom-type TYPE)."
((eq (car body) 'lambda)
;; search for interactive decl at head of body
(let loop ((rest (cddr body)))
- (cond ((stringp (car rest)) (loop (cdr rest)))
- ((eq (caar rest) 'interactive) (car rest))
- (t nil))))))))
+ (cond ((stringp (car rest)) (loop (cdr rest)))
+ ((eq (caar rest) 'interactive) (car rest))
+ (t nil))))))))
(define (command-documentation name)
"Return the documentation associated with the command called NAME."
@@ -386,4 +385,4 @@ command called NAME (optionally whose arguments have custom-type TYPE)."
(define (define-command-to-screen name fun #!rest keys)
(apply define-command name (lambda args (with-output-to-screen
- (apply fun args))) keys)))
+ (apply fun args))) keys)))
diff --git a/lisp/sawfish/wm/commands/cycle.jl b/lisp/sawfish/wm/commands/cycle.jl
index c3402f0..b993526 100644
--- a/lisp/sawfish/wm/commands/cycle.jl
+++ b/lisp/sawfish/wm/commands/cycle.jl
@@ -1,5 +1,4 @@
;; cycle.jl -- simple window cycling
-;; $Id: cycle.jl,v 1.5 2000/09/14 12:43:36 john Exp $
;; Copyright (C) 1999 John Harper <john dcs warwick ac uk>
diff --git a/lisp/sawfish/wm/commands/describe.jl b/lisp/sawfish/wm/commands/describe.jl
index a99e37c..3acb927 100644
--- a/lisp/sawfish/wm/commands/describe.jl
+++ b/lisp/sawfish/wm/commands/describe.jl
@@ -1,5 +1,4 @@
-;; describe.jl --
-;; $Id: describe.jl,v 1.11 2002/04/21 04:52:14 jsh Exp $
+;; describe.jl --
;; Copyright (C) 2000 John Harper <john dcs warwick ac uk>
@@ -41,7 +40,7 @@
(define-command 'describe-symbol describe-symbol
#:spec "SSymbol:" #:class 'advanced)
(define-command-to-screen 'describe-symbol-to-screen describe-symbol
- #:spec "SSymbol:" #:class 'advanced)
+ #:spec "SSymbol:" #:class 'advanced)
(define (apropos-output symbols)
(let ((separator (make-string 72 ?-)))
@@ -64,7 +63,7 @@
#:spec "sApropos functions:\nP" #:class 'advanced)
(define-command-to-screen 'apropos-function-to-screen apropos-function
#:spec "sApropos functions:\nP" #:class 'advanced)
-
+
(define (apropos-variable regexp)
(format standard-output "Apropos variable `%s':\n" regexp)
(apropos-output (apropos regexp boundp)))
diff --git a/lisp/sawfish/wm/commands/groups.jl b/lisp/sawfish/wm/commands/groups.jl
index ef1aad5..78c7bc9 100644
--- a/lisp/sawfish/wm/commands/groups.jl
+++ b/lisp/sawfish/wm/commands/groups.jl
@@ -1,5 +1,4 @@
;; groups.jl -- commands for manipulating window groups
-;; $Id: groups.jl,v 1.21 2002/04/21 22:25:12 jsh Exp $
;; Copyright (C) 1999 John Harper <john dcs warwick ac uk>
@@ -75,15 +74,21 @@
(define (uniconify-transient-group w)
(call-with-iconify-mode 'transients uniconify-window w))
- (define-command 'iconify-group iconify-group #:spec "%W")
- (define-command 'uniconify-group uniconify-group #:spec "%W")
- (define-command 'iconify-transient-group iconify-transient-group #:spec "%W")
- (define-command 'uniconify-transientgroup uniconify-transient-group #:spec "%W")
-
+ (define-command 'iconify-group
+ iconify-group #:spec "%W")
+ (define-command 'uniconify-group
+ uniconify-group #:spec "%W")
+ (define-command 'iconify-transient-group
+ iconify-transient-group #:spec "%W")
+ (define-command 'uniconify-transientgroup
+ uniconify-transient-group #:spec "%W")
+
;; sticky
- (define (make-group-sticky w) (map-window-group make-window-sticky w))
- (define (make-group-unsticky w) (map-window-group make-window-unsticky w))
+ (define (make-group-sticky w)
+ (map-window-group make-window-sticky w))
+ (define (make-group-unsticky w)
+ (map-window-group make-window-unsticky w))
(defun toggle-group-sticky (w)
(if (window-get w 'sticky)
@@ -145,10 +150,14 @@
move-group-to-current-viewport #:spec "%W" #:class 'viewport)
;;###autoload
- (define-command 'move-group-left move-group-left #:spec "%W" #:class 'viewport)
- (define-command 'move-group-right move-group-right #:spec "%W" #:class 'viewport)
- (define-command 'move-group-up move-group-up #:spec "%W" #:class 'viewport)
- (define-command 'move-group-down move-group-down #:spec "%W" #:class 'viewport)
+ (define-command 'move-group-left
+ move-group-left #:spec "%W" #:class 'viewport)
+ (define-command 'move-group-right
+ move-group-right #:spec "%W" #:class 'viewport)
+ (define-command 'move-group-up
+ move-group-up #:spec "%W" #:class 'viewport)
+ (define-command 'move-group-down
+ move-group-down #:spec "%W" #:class 'viewport)
;; stacking
diff --git a/lisp/sawfish/wm/commands/grow-pack.jl b/lisp/sawfish/wm/commands/grow-pack.jl
index b639f62..632bd47 100644
--- a/lisp/sawfish/wm/commands/grow-pack.jl
+++ b/lisp/sawfish/wm/commands/grow-pack.jl
@@ -1,5 +1,4 @@
;; grow-pack.jl -- window resize and movement
-;; $Id: grow-pack.jl,v 1.15 2002/09/27 06:20:42 jsh Exp $
;; Copyright (C) 2000, 01 Kai Grossjohann <Kai Grossjohann CS Uni-Dortmund DE>
@@ -81,7 +80,7 @@
:type boolean
:group gpsy)
- (defcustom shrink-window-minimum-size 10
+ (defcustom shrink-window-minimum-size 10
"The minimum height or width to which a window may be shrunk."
:type number
:group gpsy)
@@ -192,7 +191,7 @@ See `pack-window-up'."
(window-avoided-p x)
(eq grow-pack-bump-other-depth 'always))))
(or grow-pack-bump-obscured
- (not (eq (stacking-visibility x) 'fully-obscured)))
+ (not (eq (stacking-visibility x) 'fully-obscured)))
(or grow-pack-bump-ignored
(not (window-ignored-p x)))
(setq xa (window-position x)
@@ -226,7 +225,7 @@ See `pack-window-up'."
(window-put w 'unmaximized-geometry (list x y (car dim) (cdr dim))))
(window-put w
(if horizontal 'maximized-horizontally
- 'maximized-vertically)
+ 'maximized-vertically)
t))
(setq dim (cons (car new-dim) (cdr new-dim)))
(maximize-truncate-dims w new-dim (if horizontal 'horizontal 'vertical)
diff --git a/lisp/sawfish/wm/commands/help.jl b/lisp/sawfish/wm/commands/help.jl
index 871d1c0..9db4016 100644
--- a/lisp/sawfish/wm/commands/help.jl
+++ b/lisp/sawfish/wm/commands/help.jl
@@ -1,5 +1,4 @@
;; help.jl -- commands for the help menu
-;; $Id: help.jl,v 1.6 2003/01/12 20:35:09 jsh Exp $
;; Copyright (C) 2000 John Harper <john dcs warwick ac uk>
@@ -34,7 +33,7 @@
(define (help-call-info document node)
(xterm (format nil "info '%s' '%s'"
- document node)))
+ document node)))
(defvar help-display-info-function help-call-info)
diff --git a/lisp/sawfish/wm/commands/move-cursor.jl b/lisp/sawfish/wm/commands/move-cursor.jl
index 5949097..b3ba89b 100644
--- a/lisp/sawfish/wm/commands/move-cursor.jl
+++ b/lisp/sawfish/wm/commands/move-cursor.jl
@@ -1,5 +1,4 @@
;; move-cursor.jl -- commands to move the mouse pointer
-;; $Id: move-cursor.jl,v 1.4 2000/07/27 13:19:29 john Exp $
;; Copyright (C) 2000 John Harper <john dcs warwick ac uk>
@@ -53,8 +52,8 @@
:type (number 1))
(define (move-cursor right down)
- (let ((coords (query-pointer)))
- (warp-cursor (+ (car coords) right) (+ (cdr coords) down))))
+ (let ((coords (query-pointer)))
+ (warp-cursor (+ (car coords) right) (+ (cdr coords) down))))
(define (move-cursor-left)
"Move the cursor `move-cursor-increment' pixels to the left."
diff --git a/lisp/sawfish/wm/commands/move-resize.jl b/lisp/sawfish/wm/commands/move-resize.jl
index 9508fce..b6f555f 100644
--- a/lisp/sawfish/wm/commands/move-resize.jl
+++ b/lisp/sawfish/wm/commands/move-resize.jl
@@ -1,5 +1,4 @@
;; move-resize.jl -- interactive moving and resizing of windows
-;; $Id: move-resize.jl,v 1.91 2002/05/29 06:39:02 jsh Exp $
;; Copyright (C) 1999 John Harper <john dcs warwick ac uk>
@@ -77,16 +76,17 @@
:group move
:type boolean)
- (defcustom resize-edge-mode 'border-grab
- "How to choose window edges when resizing."
- :type (choice region border grab border-grab)
- :group move)
+ (defcustom resize-edge-mode 'border-grab
+ "How to choose window edges when resizing."
+ :type (choice region border grab border-grab)
+ :group move)
(defcustom move-snap-epsilon 12
"Distance in pixels before window edges align with each other."
:group move
:type (number 0 64)
- :tooltip "When moving a window, this option lets you align one of its edges with an edge of another window.")
+ :tooltip "When moving a window, this option lets you align one of \
+its edges with an edge of another window.")
(defvar move-snap-mode 'resistance
"How to snap together window edges, one of `magnetism', `resistance', or
@@ -99,20 +99,20 @@
"Only update window contents after it has stopped moving.")
(defvar move-resize-map (bind-keys (make-keymap)
- "Any-Off1" (lambda () (finished))
- "Any-Off2" (lambda () (finished))
- "Any-Off3" (lambda () (finished))
- "Any-Move" (lambda () (motion))
- "Any-ESC" (lambda () (cancel))
- "Any-RET" (lambda () (finished))
- "Up" 'move-cursor-up
- "Down" 'move-cursor-down
- "Left" 'move-cursor-left
- "Right" 'move-cursor-right
- "S-Up" 'move-cursor-up-fine
- "S-Down" 'move-cursor-down-fine
- "S-Left" 'move-cursor-left-fine
- "S-Right" 'move-cursor-right-fine))
+ "Any-Off1" (lambda () (finished))
+ "Any-Off2" (lambda () (finished))
+ "Any-Off3" (lambda () (finished))
+ "Any-Move" (lambda () (motion))
+ "Any-ESC" (lambda () (cancel))
+ "Any-RET" (lambda () (finished))
+ "Up" 'move-cursor-up
+ "Down" 'move-cursor-down
+ "Left" 'move-cursor-left
+ "Right" 'move-cursor-right
+ "S-Up" 'move-cursor-up-fine
+ "S-Down" 'move-cursor-down-fine
+ "S-Left" 'move-cursor-left-fine
+ "S-Right" 'move-cursor-right-fine))
(define fp-edges-alist '((top-border top)
(left-border left)
@@ -342,7 +342,8 @@
(setq move-resize-width
(constrain-dimension-to-hints
(+ move-resize-old-width
- (- move-resize-old-ptr-x ptr-x)) 'x move-resize-hints))
+ (- move-resize-old-ptr-x ptr-x))
+ 'x move-resize-hints))
(when (or min-aspect max-aspect)
(setq move-resize-height
(constrain-aspect-to-hints
@@ -518,12 +519,12 @@
(define (resize-by-factor win amount)
"Multiply win's dimensions by amount"
(let* (
- (orig-wid (car (window-dimensions win)))
- (orig-hgt (cdr (window-dimensions win)))
- (new-wid (inexact->exact (floor (* amount orig-wid))))
- (new-hgt (inexact->exact (floor (* amount orig-hgt)))))
- ; this expects integers ("800 600") and fails on floats ("800. 600.")
- (resize-window-with-hints* win new-wid new-hgt)))
+ (orig-wid (car (window-dimensions win)))
+ (orig-hgt (cdr (window-dimensions win)))
+ (new-wid (inexact->exact (floor (* amount orig-wid))))
+ (new-hgt (inexact->exact (floor (* amount orig-hgt)))))
+ ;; this expects integers ("800 600") and fails on floats ("800. 600.")
+ (resize-window-with-hints* win new-wid new-hgt)))
(define (double-window-size w)
(resize-by-factor w 2))
@@ -551,29 +552,40 @@
(do-move-resize w 'resize))
(define (move-selected-window)
- "Wait for the user to select a window, then interactively move that window."
+ "Wait for the user to select a window, then interactively move
+that window."
(let ((w (select-window)))
(when w
(move-window-interactively w))))
(define (resize-selected-window)
- "Wait for the user to select a window, then interactively resize that window."
+ "Wait for the user to select a window, then interactively resize
+that window."
(let ((w (select-window)))
(when w
(resize-window-interactively w))))
-;; Move Window To Center
+ ;; Move Window To Center
(define (move-window-center w)
(move-window-to w
- (round (/ (- (screen-width) (car (window-frame-dimensions w))) 2))
- (round (/ (- (screen-height) (cdr (window-frame-dimensions w))) 2))))
+ (round (/ (- (screen-width)
+ (car (window-frame-dimensions w))) 2))
+ (round (/ (- (screen-height)
+ (cdr (window-frame-dimensions w))) 2))))
;;###autoload
- (define-command 'move-window-center move-window-center #:spec "%W")
- (define-command 'move-window-interactively move-window-interactively #:spec "%W")
- (define-command 'resize-window-interactively resize-window-interactively #:spec "%W")
- (define-command 'move-selected-window move-selected-window)
- (define-command 'resize-selected-window resize-selected-window)
- (define-command 'double-window-size double-window-size #:spec "%W")
- (define-command 'halve-window-size halve-window-size #:spec "%W"))
+ (define-command 'move-window-center
+ move-window-center #:spec "%W")
+ (define-command 'move-window-interactively
+ move-window-interactively #:spec "%W")
+ (define-command 'resize-window-interactively
+ resize-window-interactively #:spec "%W")
+ (define-command 'move-selected-window
+ move-selected-window)
+ (define-command 'resize-selected-window
+ resize-selected-window)
+ (define-command 'double-window-size
+ double-window-size #:spec "%W")
+ (define-command 'halve-window-size
+ halve-window-size #:spec "%W"))
diff --git a/lisp/sawfish/wm/commands/raise-commands.jl b/lisp/sawfish/wm/commands/raise-commands.jl
index cb62d50..394334f 100644
--- a/lisp/sawfish/wm/commands/raise-commands.jl
+++ b/lisp/sawfish/wm/commands/raise-commands.jl
@@ -1,5 +1,4 @@
;; raise-commands.jl -- some commands for raising windows
-;; $Id: raise-commands.jl,v 1.11 2002/04/21 04:52:14 jsh Exp $
;; Copyright (C) 1999-2000 John Harper <john dcs warwick ac uk>
@@ -19,17 +18,19 @@
;; along with sawfish; see the file COPYING. If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-(define-structure sawfish.wm.commands.raise-commands ()
+(define-structure sawfish.wm.commands.raise-commands
+
+ (export )
(open rep
- sawfish.wm.windows
- sawfish.wm.events
- sawfish.wm.stacking
- sawfish.wm.util.stacking
- sawfish.wm.state.transient
- sawfish.wm.commands.groups
- sawfish.wm.commands
- sawfish.wm.focus)
+ sawfish.wm.windows
+ sawfish.wm.events
+ sawfish.wm.stacking
+ sawfish.wm.util.stacking
+ sawfish.wm.state.transient
+ sawfish.wm.commands.groups
+ sawfish.wm.commands
+ sawfish.wm.focus)
(define (replay-pointer w)
;; click-to-focus mode sets this to t when it calls a command
diff --git a/lisp/sawfish/wm/commands/shrink-yank.jl b/lisp/sawfish/wm/commands/shrink-yank.jl
index a4b255b..c6db7dd 100644
--- a/lisp/sawfish/wm/commands/shrink-yank.jl
+++ b/lisp/sawfish/wm/commands/shrink-yank.jl
@@ -1,4 +1,3 @@
-;;; $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>
@@ -22,67 +21,71 @@
;; 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 ()
+(define-structure sawfish.wm.commands.shrink-yank
- (export shrink-window-left
- shrink-window-right
- shrink-window-up
- shrink-window-down
- yank-window-left
- yank-window-right
- yank-window-up
- yank-window-down)
+ (export shrink-window-left
+ shrink-window-right
+ shrink-window-up
+ shrink-window-down
+ yank-window-left
+ yank-window-right
+ yank-window-up
+ yank-window-down)
- (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
- sawfish.wm.custom)
+ (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
+ sawfish.wm.custom)
(define-structure-alias shrink-yank sawfish.wm.commands.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."
+ "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."
+ "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."
+ "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."
+ "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."
+ "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."
+ "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."
+ "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."
+ "Yanks WINDOW downwards until it inserts with one window less than
+before."
(yank-window window 'down))
;;###autoload
@@ -140,10 +143,11 @@ dimensions of WINDOW."
(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
+ ;; 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.
+ ;; completely surrounds the active window is irrelevant for
+ ;; shrinking.
(define (find-least-intersection window wr direction yank)
(let* ((isect-coord (if yank
(case direction
@@ -172,8 +176,8 @@ dimensions of WINDOW."
(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.
+ ;; 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))
diff --git a/lisp/sawfish/wm/commands/size-window.jl b/lisp/sawfish/wm/commands/size-window.jl
index d10ae89..e026a2c 100644
--- a/lisp/sawfish/wm/commands/size-window.jl
+++ b/lisp/sawfish/wm/commands/size-window.jl
@@ -1,5 +1,4 @@
;; size-window -- resizing window iteratively (like `C-x ^' in emacs)
-;; $Id: size-window.jl,v 1.6 2002/04/21 03:39:33 jsh Exp $
;; Copyright (C) 2000 John Harper <john dcs warwick ac uk>
@@ -57,7 +56,7 @@ size of each row or column is taken from `size-window-def-increment.'"
(descale (lambda (x base inc)
(quotient (- x base) inc))))
- ;; use the configure-request handler (to handle gravity)
+ ;; use the configure-request handler (to handle gravity)
(call-window-hook
'configure-request-hook w
(list (list (cons 'dimensions
diff --git a/lisp/sawfish/wm/commands/slide-window.jl b/lisp/sawfish/wm/commands/slide-window.jl
index cfe8966..a33fb5b 100644
--- a/lisp/sawfish/wm/commands/slide-window.jl
+++ b/lisp/sawfish/wm/commands/slide-window.jl
@@ -1,5 +1,4 @@
;; slide-window.jl -- simple code to move a window via the keyboard
-;; $Id: slide-window.jl,v 1.8 2002/04/21 03:39:33 jsh Exp $
;; Copyright (C) 1999 John Harper <john dcs warwick ac uk>
@@ -76,7 +75,7 @@
(define-command 'slide-window-up slide-window-up #:spec "%W")
(define-command 'slide-window-down slide-window-down #:spec "%W")
-;; group commands
+ ;; group commands
(define (slide-group-left w)
"Move the window group `slide-window-increment' pixels to the left."
diff --git a/lisp/sawfish/wm/commands/user.jl b/lisp/sawfish/wm/commands/user.jl
index d104b16..94bc583 100644
--- a/lisp/sawfish/wm/commands/user.jl
+++ b/lisp/sawfish/wm/commands/user.jl
@@ -1,25 +1,22 @@
-#| user.jl -- command to launch an xterm/brower and more
-
- $Id: user.jl,v 1.7 2002/04/21 22:25:12 jsh Exp $
-
- Copyright (C) 2000 John Harper <john dcs warwick ac uk>
-
- This file is part of sawfish.
-
- sawfish 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.
-
- sawfish 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 sawfish; see the file COPYING. If not, write to
- the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-|#
+;; user.jl -- command to launch an xterm/brower and more
+;;
+;; Copyright (C) 2000 John Harper <john dcs warwick ac uk>
+;;
+;; This file is part of sawfish.
+;;
+;; sawfish 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.
+;;
+;; sawfish 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 sawfish; see the file COPYING. If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
(define-structure sawfish.wm.commands.user
@@ -73,8 +70,8 @@
;; XXX description
(define (some pred lst)
(cond ((null lst) nil)
- ((pred (car lst)) t)
- (t (some pred (cdr lst)))))
+ ((pred (car lst)) t)
+ (t (some pred (cdr lst)))))
;; display-message-with-timeout
;; like display-message, but it dissapears
@@ -88,8 +85,8 @@
;; return true, if program `cmd' is in PATH
(define (program-available cmd)
(some (lambda (dir)
- (file-exists-p (concat dir "/" cmd)))
- (string-split ":" (getenv "PATH"))))
+ (file-exists-p (concat dir "/" cmd)))
+ (string-split ":" (getenv "PATH"))))
(defcustom clipboard-preview-clip-length 60
"Maximum length of Clipboard Preview"
@@ -107,10 +104,11 @@
"Show the contents of the clipboard in a message window"
(let ((c (x-get-selection 'PRIMARY)))
(if (> (length c) 0)
- (if (< (length c) clipboard-preview-clip-length)
- (display-message-with-timeout c clipboard-preview-timeout)
- (display-message-with-timeout (format nil "%s ..."
- (substring c 0 clipboard-preview-clip-length)) clipboard-preview-timeout)))))
+ (if (< (length c) clipboard-preview-clip-length)
+ (display-message-with-timeout c clipboard-preview-timeout)
+ (display-message-with-timeout
+ (format nil "%s ..." (substring c 0 clipboard-preview-clip-length))
+ clipboard-preview-timeout)))))
;;###autoload
(define-command 'xterm xterm #:class 'default)
diff --git a/lisp/sawfish/wm/commands/viewport-extras.jl b/lisp/sawfish/wm/commands/viewport-extras.jl
index 8d97cc7..cdd67fb 100644
--- a/lisp/sawfish/wm/commands/viewport-extras.jl
+++ b/lisp/sawfish/wm/commands/viewport-extras.jl
@@ -1,15 +1,14 @@
-#| viewport-extras.jl -- extra viewport commands
+;; viewport-extras.jl -- extra viewport commands
+;;
+;; Contributed by: Dams Nadé <anvil amin unice fr>
- $Id$
+(define-structure sawfish.wm.commands.viewport-extras
- Contributed by: Dams Nadé <anvil amin unice fr>
-|#
-
-(define-structure sawfish.wm.commands.viewport-extras ()
+ (export )
(open rep
- sawfish.wm.viewport
- sawfish.wm.commands)
+ sawfish.wm.viewport
+ sawfish.wm.commands)
;; Returns (cons next-x next-y) from current screen-viewport
(define (next-coords)
@@ -59,7 +58,11 @@
(set-window-and-viewport w (car prevs) (cdr prevs))))
;;###autoload
- (define-command 'move-viewport-next move-viewport-next #:class 'viewport)
- (define-command 'move-viewport-previous move-viewport-previous #:class 'viewport)
- (define-command 'move-window-previous move-window-previous #:spec "%W" #:class 'viewport)
- (define-command 'move-window-next move-window-next #:spec "%W" #:class 'viewport))
+ (define-command 'move-viewport-next
+ move-viewport-next #:class 'viewport)
+ (define-command 'move-viewport-previous
+ move-viewport-previous #:class 'viewport)
+ (define-command 'move-window-previous
+ move-window-previous #:spec "%W" #:class 'viewport)
+ (define-command 'move-window-next
+ move-window-next #:spec "%W" #:class 'viewport))
diff --git a/lisp/sawfish/wm/commands/viewport-linear.jl b/lisp/sawfish/wm/commands/viewport-linear.jl
index 3d8646a..7b7c751 100644
--- a/lisp/sawfish/wm/commands/viewport-linear.jl
+++ b/lisp/sawfish/wm/commands/viewport-linear.jl
@@ -1,5 +1,4 @@
;; viewport-linear.jl -- linear address of viewports
-;; $Id: viewport-linear.jl,v 1.10 2002/04/21 22:25:12 jsh Exp $
;; Copyright (C) 1999 John Harper <john dcs warwick ac uk>
diff --git a/lisp/sawfish/wm/commands/x-cycle.jl b/lisp/sawfish/wm/commands/x-cycle.jl
index bc72ce3..71afc85 100644
--- a/lisp/sawfish/wm/commands/x-cycle.jl
+++ b/lisp/sawfish/wm/commands/x-cycle.jl
@@ -1,5 +1,4 @@
;; x-cycle.jl -- stack-based window cycling
-;; $Id: x-cycle.jl,v 1.68 2002/04/21 03:39:33 jsh Exp $
;; Copyright (C) 1999 John Harper <john dcs warwick ac uk>
@@ -97,7 +96,9 @@
;;; customization options
;;###autoload (defgroup cycle "Window Cycling" :group focus :require sawfish.wm.commands.x-cycle)
- (defgroup cycle "Window Cycling" :group focus :require sawfish.wm.commands.x-cycle)
+ (defgroup cycle "Window Cycling"
+ :group focus
+ :require sawfish.wm.commands.x-cycle)
(defcustom cycle-show-window-names t
"Display window names and icons while cycling through windows."
@@ -132,7 +133,7 @@
(defvar after-cycle-step-hook '()
"Window hook called after each step of window cycling.")
-;; variables
+ ;; variables
;; the current window
(define x-cycle-current (make-fluid))
@@ -154,9 +155,9 @@
(define (forwards lst elt count)
(let ((total (length lst))
(current (let loop ((rest lst) (i 0))
- (cond ((null rest) 0)
- ((eq (car rest) elt) i)
- (t (loop (cdr rest) (1+ i)))))))
+ (cond ((null rest) 0)
+ ((eq (car rest) elt) i)
+ (t (loop (cdr rest) (1+ i)))))))
(nth (mod (+ current count) total) lst)))
(define (cycle-display-message)
@@ -222,80 +223,80 @@
(x-cycle-windows windows)
(x-cycle-active t))
- (define (unmap-fun w)
- (when (eq w grab-win)
- (setq grab-win nil)
- (or (grab-keyboard nil nil t)
- (throw 'x-cycle-exit nil))
- (allow-events 'sync-keyboard)))
-
- (define (enter-fun space)
- (declare (unused space))
- (when grab-win
- (setq grab-win nil)
- (or (grab-keyboard nil nil t)
- (throw 'x-cycle-exit nil))
- (allow-events 'sync-keyboard)))
-
- (define (unbound-fun)
- (let* ((event (current-event))
- (ev (decode-event event)))
- (cond
- ((memq 'release (nth 1 ev)) ;; key released
- (when (and (modifier-keysym-p (nth 2 ev)) ; modifier released
- (eq 2 (length (nth 1 ev)))) ; 'release + 1 modifier
- (throw 'x-cycle-exit t)))
- ((not (modifier-keysym-p (nth 2 ev)))
- ;; real key pressed
- (let* ((override-keymap cycle-keymap)
- (command (lookup-event-binding event)))
- (unless command
- ;; search cycle-keymap then the usual ones
- (setq override-keymap nil)
- (setq command (lookup-event-binding event)))
- (if (memq command cycle-commands)
- ;; call without aborting cycle operation
- (progn
- (current-event-window (fluid x-cycle-current))
- (call-command command))
- (unless (setq tail-command command)
- ;; no wm binding, so forward the event to
- ;; the focused window (this is why we have
- ;; to grab the keyboard synchronously)
- (allow-events 'replay-keyboard))
- (throw 'x-cycle-exit nil)))))))
-
- (let* ((decoded (decode-event (current-event)))
+ (define (unmap-fun w)
+ (when (eq w grab-win)
+ (setq grab-win nil)
+ (or (grab-keyboard nil nil t)
+ (throw 'x-cycle-exit nil))
+ (allow-events 'sync-keyboard)))
+
+ (define (enter-fun space)
+ (declare (unused space))
+ (when grab-win
+ (setq grab-win nil)
+ (or (grab-keyboard nil nil t)
+ (throw 'x-cycle-exit nil))
+ (allow-events 'sync-keyboard)))
+
+ (define (unbound-fun)
+ (let* ((event (current-event))
+ (ev (decode-event event)))
+ (cond
+ ((memq 'release (nth 1 ev)) ; key released
+ (when (and (modifier-keysym-p (nth 2 ev)) ; modifier released
+ (eq 2 (length (nth 1 ev)))) ; 'release + 1 modifier
+ (throw 'x-cycle-exit t)))
+ ((not (modifier-keysym-p (nth 2 ev)))
+ ;; real key pressed
+ (let* ((override-keymap cycle-keymap)
+ (command (lookup-event-binding event)))
+ (unless command
+ ;; search cycle-keymap then the usual ones
+ (setq override-keymap nil)
+ (setq command (lookup-event-binding event)))
+ (if (memq command cycle-commands)
+ ;; call without aborting cycle operation
+ (progn
+ (current-event-window (fluid x-cycle-current))
+ (call-command command))
+ (unless (setq tail-command command)
+ ;; no wm binding, so forward the event to
+ ;; the focused window (this is why we have
+ ;; to grab the keyboard synchronously)
+ (allow-events 'replay-keyboard))
+ (throw 'x-cycle-exit nil)))))))
+
+ (let* ((decoded (decode-event (current-event)))
(eval-modifier-events t)
- (eval-key-release-events t)
- (override-keymap (make-keymap))
- (focus-dont-push t)
- (disable-auto-raise t)
- (tooltips-enabled nil)
- (unmap-notify-hook (cons unmap-fun unmap-notify-hook))
- (enter-workspace-hook (cons enter-fun enter-workspace-hook))
- (unbound-key-hook (list unbound-fun)))
+ (eval-key-release-events t)
+ (override-keymap (make-keymap))
+ (focus-dont-push t)
+ (disable-auto-raise t)
+ (tooltips-enabled nil)
+ (unmap-notify-hook (cons unmap-fun unmap-notify-hook))
+ (enter-workspace-hook (cons enter-fun enter-workspace-hook))
+ (unbound-key-hook (list unbound-fun)))
(unless (and (eq 'key (car decoded)) (nth 1 decoded))
(error "%s must be bound to a key event with modifiers."
- this-command))
-
- ;; grab synchronously, so that event replaying works
- (when (grab-keyboard grab-win nil t)
- (unwind-protect
- (progn
- (catch 'x-cycle-exit
- ;; do the first step
- (cycle-next windows step)
- (setq focus-ignore-pointer-events t)
- (recursive-edit))
- (when (fluid x-cycle-current)
- (display-window (fluid x-cycle-current))))
- (remove-message)
- (ungrab-keyboard)
- (make-timer (lambda ()
- (setq focus-ignore-pointer-events nil))
- 0 100)))))
+ this-command))
+
+ ;; grab synchronously, so that event replaying works
+ (when (grab-keyboard grab-win nil t)
+ (unwind-protect
+ (progn
+ (catch 'x-cycle-exit
+ ;; do the first step
+ (cycle-next windows step)
+ (setq focus-ignore-pointer-events t)
+ (recursive-edit))
+ (when (fluid x-cycle-current)
+ (display-window (fluid x-cycle-current))))
+ (remove-message)
+ (ungrab-keyboard)
+ (make-timer (lambda ()
+ (setq focus-ignore-pointer-events nil))
+ 0 100)))))
(when tail-command
;; make sure that the command operates on the newly-focused
@@ -338,57 +339,57 @@ Any extra arguments are passed to each call to define-command."
;;; commands
(define-cycle-command-pair
- 'cycle-windows 'cycle-windows-backwards
- (lambda () (filter-windows window-in-cycle-p)))
+ 'cycle-windows 'cycle-windows-backwards
+ (lambda () (filter-windows window-in-cycle-p)))
(define-cycle-command-pair
- 'cycle-group 'cycle-group-backwards
- (lambda (w)
- (delete-if-not window-in-cycle-p (windows-in-group w)))
- #:spec "%W")
+ 'cycle-group 'cycle-group-backwards
+ (lambda (w)
+ (delete-if-not window-in-cycle-p (windows-in-group w)))
+ #:spec "%W")
(define-cycle-command-pair
- 'cycle-among-groups 'cycle-among-groups-backwards
- (lambda ()
- "Only cycle the top members of each group."
- (delete-if-not window-in-cycle-p
- (mapcar (lambda (gid) (car (windows-by-group gid t)))
- (window-group-ids)))))
+ 'cycle-among-groups 'cycle-among-groups-backwards
+ (lambda ()
+ "Only cycle the top members of each group."
+ (delete-if-not window-in-cycle-p
+ (mapcar (lambda (gid) (car (windows-by-group gid t)))
+ (window-group-ids)))))
(define-cycle-command-pair
- 'cycle-prefix 'cycle-prefix-backwards
- (lambda (w)
- (when (string-match "^([^:]+)\\s*:" (window-name w))
- (let* ((prefix (expand-last-match "\\1"))
- (re (concat ?^ (quote-regexp prefix) "\\s*:")))
- (delete-if-not window-in-cycle-p
- (filter-windows
- (lambda (x)
- (string-match re (window-name x))))))))
- #:spec "%W")
+ 'cycle-prefix 'cycle-prefix-backwards
+ (lambda (w)
+ (when (string-match "^([^:]+)\\s*:" (window-name w))
+ (let* ((prefix (expand-last-match "\\1"))
+ (re (concat ?^ (quote-regexp prefix) "\\s*:")))
+ (delete-if-not window-in-cycle-p
+ (filter-windows
+ (lambda (x)
+ (string-match re (window-name x))))))))
+ #:spec "%W")
(define-cycle-command-pair
- 'cycle-class 'cycle-class-backwards
- (lambda (w)
- (let ((class (window-class w)))
- (delete-if-not window-in-cycle-p
- (filter-windows
- (lambda (x) (equal (window-class x) class))))))
- #:spec "%W")
+ 'cycle-class 'cycle-class-backwards
+ (lambda (w)
+ (let ((class (window-class w)))
+ (delete-if-not window-in-cycle-p
+ (filter-windows
+ (lambda (x) (equal (window-class x) class))))))
+ #:spec "%W")
(define-cycle-command-pair
- 'cycle-step 'cycle-step-backwards
- (lambda ()
- (if (fluid x-cycle-active)
- (fluid x-cycle-windows)
- (error "%s must be bound to a key event in the cycle keymap."
- this-command))))
+ 'cycle-step 'cycle-step-backwards
+ (lambda ()
+ (if (fluid x-cycle-active)
+ (fluid x-cycle-windows)
+ (error "%s must be bound to a key event in the cycle keymap."
+ this-command))))
(define-cycle-command-pair
- 'cycle-dock 'cycle-dock-backwards
- (lambda ()
- (delete-if-not (lambda (x) (window-in-cycle-p x #:ignore-cycle-skip t))
- (filter-windows dock-window-p)))))
+ 'cycle-dock 'cycle-dock-backwards
+ (lambda ()
+ (delete-if-not (lambda (x) (window-in-cycle-p x #:ignore-cycle-skip t))
+ (filter-windows dock-window-p)))))
#| autoload cookies:
diff --git a/lisp/sawfish/wm/cursors.jl b/lisp/sawfish/wm/cursors.jl
index d6ccf2b..244ef04 100644
--- a/lisp/sawfish/wm/cursors.jl
+++ b/lisp/sawfish/wm/cursors.jl
@@ -1,25 +1,22 @@
-#| sawfish.wm.cursors bootstrap
-
- $Id: cursors.jl,v 1.3 2000/07/27 13:19:29 john Exp $
-
- Copyright (C) 1999 John Harper <john dcs warwick ac uk>
-
- This file is part of sawfish.
-
- sawfish 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.
-
- sawfish 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 sawfish; see the file COPYING. If not, write to
- the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-|#
+;; sawfish.wm.cursors bootstrap
+;;
+;; Copyright (C) 1999 John Harper <john dcs warwick ac uk>
+;;
+;; This file is part of sawfish.
+;;
+;; sawfish 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.
+;;
+;; sawfish 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 sawfish; see the file COPYING. If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
(declare (in-module sawfish.wm.cursors))
diff --git a/lisp/sawfish/wm/custom-defaults.jl b/lisp/sawfish/wm/custom-defaults.jl
index 009d4e1..4a02f8b 100644
--- a/lisp/sawfish/wm/custom-defaults.jl
+++ b/lisp/sawfish/wm/custom-defaults.jl
@@ -1,5 +1,4 @@
;; custom-defaults.jl -- customize settings loaded if no user customization
-;; $Id: custom-defaults.jl,v 1.4 2002/04/20 20:59:15 jsh Exp $
;; Copyright (C) 2000 John Harper <john dcs warwick ac uk>
@@ -19,4 +18,5 @@
;; along with sawfish; see the file COPYING. If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-(custom-set-typed-variable (quote workspace-geometry) (quote (4 1 . 1)) (quote workspace-geometry))
+(custom-set-typed-variable (quote workspace-geometry) (quote (4 1 . 1))
+ (quote workspace-geometry))
diff --git a/lisp/sawfish/wm/custom.jl b/lisp/sawfish/wm/custom.jl
index 1beabd2..13e9b78 100644
--- a/lisp/sawfish/wm/custom.jl
+++ b/lisp/sawfish/wm/custom.jl
@@ -1,5 +1,4 @@
;; custom.jl -- Emacs-like ``customizing'' (but more simple)
-;; $Id: custom.jl,v 1.64 2002/11/03 10:53:59 jsh Exp $
;; Copyright (C) 1999 John Harper <john dcs warwick ac uk>
@@ -77,7 +76,7 @@
(define custom-quoted-keys
'(:group :require :type :options :range :depends :user-level
- :layout :widget-flags)
+ :layout :widget-flags)
"defcustom keys whose values are quoted by the macro expansion.")
(define custom-option-alist '((:group . custom-group)
@@ -99,7 +98,7 @@
(define custom-group-option-alist '((:layout . custom-group-layout)
(:require . custom-group-require)))
- ;; hash group names (lists of symbols) to alist of options
+ ;; hash group names (lists of symbols) to alist of options
(define custom-group-table (make-table equal-hash equal))
;;; defining custom variables and groups
@@ -207,9 +206,9 @@ Note that the value of the `:group' key is not evaluated."
(unless container
;; declare a command to customize this group
(define-command (intern (concat "customize:" (symbol-name group)))
- (lambda ()
- (require 'sawfish.wm.customize)
- (customize group))))))
+ (lambda ()
+ (require 'sawfish.wm.customize)
+ (customize group))))))
(define (custom-quote-keys keys)
(let ((out '()))
@@ -231,7 +230,7 @@ Note that the value of the `:group' key is not evaluated."
(define (custom-setter name)
(or (table-ref custom-setter-table name)
(error "No such custom setter: %s" name)))
-
+
(define (custom-set-property sym prop value)
"Set the custom key PROP for defcustom'd symbol SYM to value."
(let ((key (cdr (assq prop custom-option-alist))))
@@ -283,32 +282,32 @@ of choices."
(setq full-group (list full-group)))
(let loop ((group full-group)
(parent custom-groups))
- (if (null group)
- parent
- (loop (cdr group)
- (or (assq (car group) (cddr parent))
- (error "No such group: %S" full-group))))))
+ (if (null group)
+ parent
+ (loop (cdr group)
+ (or (assq (car group) (cddr parent))
+ (error "No such group: %S" full-group))))))
(define (custom-add-to-group cell full-group)
(when (and (symbolp full-group) (not (null full-group)))
(setq full-group (list full-group)))
(let loop ((group full-group)
(parent custom-groups))
- (if (null group)
- (unless (or (memq cell (cddr parent))
- (assq (car cell) (cddr parent)))
- ;; reached the bottom most group
- (rplacd (cdr parent) (nconc (cddr parent) (list cell))))
- ;; keep on recursing
- (loop (cdr group)
- (or (assq (car group) (cddr parent))
- (error "Unknown group %s" full-group)))
- (unless (cdr group)
- (rplacd (cdr custom-groups)
- (nconc (sort (filter consp (cddr custom-groups))
- (lambda (x y)
- (string-lessp (cadr x) (cadr y))))
- (filter atom (cddr custom-groups))))))))
+ (if (null group)
+ (unless (or (memq cell (cddr parent))
+ (assq (car cell) (cddr parent)))
+ ;; reached the bottom most group
+ (rplacd (cdr parent) (nconc (cddr parent) (list cell))))
+ ;; keep on recursing
+ (loop (cdr group)
+ (or (assq (car group) (cddr parent))
+ (error "Unknown group %s" full-group)))
+ (unless (cdr group)
+ (rplacd (cdr custom-groups)
+ (nconc (sort (filter consp (cddr custom-groups))
+ (lambda (x y)
+ (string-lessp (cadr x) (cadr y))))
+ (filter atom (cddr custom-groups))))))))
;;; setting values
@@ -334,7 +333,7 @@ of choices."
(set symbol old-value)
(makunbound symbol))
(raise-exception ex))))))
-
+
(define (custom-set-variable symbol value #!optional req)
;; XXX kludge for old custom files..
(when (eq value 'nil) (setq value nil))
@@ -356,7 +355,8 @@ of choices."
symbol))
(define (variable-customized-p symbol)
- "Returns `t' if the variable named SYMBOL has been customized by the user."
+ "Returns `t' if the variable named SYMBOL has been customized by
+the user."
(get symbol 'custom-user-value))
(define (variable-type symbol)
@@ -376,10 +376,10 @@ of choices."
(let ((fun (or (get symbol 'custom-set) 'custom-set-typed-variable))
(custom-value (custom-serialize value (variable-type symbol))))
`(,fun ',symbol ',custom-value
- ,@(and (eq fun 'custom-set-typed-variable)
- (list (list 'quote (variable-type symbol))))
- ,@(and (get symbol 'custom-require)
- (list (list 'quote (get symbol 'custom-require)))))))
+ ,@(and (eq fun 'custom-set-typed-variable)
+ (list (list 'quote (variable-type symbol))))
+ ,@(and (get symbol 'custom-require)
+ (list (list 'quote (get symbol 'custom-require)))))))
(define (custom-eval form)
(apply (custom-setter (car form))
@@ -391,7 +391,8 @@ of choices."
;;; serializing unreadable types
- ;; property name (symbol) to find type converters on during custom-convert
+ ;; property name (symbol) to find type converters on during
+ ;; custom-convert
(define custom-converter-property (make-fluid))
;; convert VALUE of TYPE to or from a printable object
@@ -438,12 +439,12 @@ of choices."
(define (custom-serialize value type)
"Convert VALUE of TYPE to a printable value."
(let-fluids ((custom-converter-property 'custom-serializer))
- (custom-convert value type)))
+ (custom-convert value type)))
(define (custom-deserialize value type)
"Convert VALUE of TYPE back from a printable value."
(let-fluids ((custom-converter-property 'custom-deserializer))
- (custom-convert value type)))
+ (custom-convert value type)))
(define (define-custom-serializer type fun)
(put type 'custom-serializer fun))
diff --git a/lisp/sawfish/wm/customize.jl b/lisp/sawfish/wm/customize.jl
index 0018280..39fd74d 100644
--- a/lisp/sawfish/wm/customize.jl
+++ b/lisp/sawfish/wm/customize.jl
@@ -1,5 +1,4 @@
;; customize.jl -- invocation of configurator GUI & customization file IO
-;; $Id: customize.jl,v 1.46 2000/11/29 00:54:47 jsh Exp $
;; Copyright (C) 1999 John Harper <john dcs warwick ac uk>
@@ -42,7 +41,7 @@
(defvar customize-redirect ">/dev/null 2>&1 </dev/null"
"Redirect the configurator's input & output.")
-
+
(define customize-user-forms nil)
(define customize-user-file-read nil)
(define customize-user-file-dirty nil)
@@ -97,7 +96,7 @@
(format file "\
;; sawfish user customization -- do not edit by hand!
;; sawfish version %s, written %s\n\n"
- sawfish-version (current-time-string))
+ sawfish-version (current-time-string))
(mapc (lambda (f)
(format file "%S\n" f)) customize-user-forms))
(close-file file))
diff --git a/lisp/sawfish/wm/defaults.jl b/lisp/sawfish/wm/defaults.jl
index 8668844..fdad7f7 100644
--- a/lisp/sawfish/wm/defaults.jl
+++ b/lisp/sawfish/wm/defaults.jl
@@ -1,5 +1,4 @@
;; sawfish-default.jl -- default user startup
-;; $Id: defaults.jl,v 1.20 2002/04/20 20:59:15 jsh Exp $
;; Copyright (C) 1999 John Harper <john dcs warwick ac uk>
@@ -32,13 +31,13 @@
;; extra GNOME integration module
(unless batch-mode
(if (getenv "GNOME_DESKTOP_SESSION_ID")
- (require 'sawfish.wm.integration.gnome)))
+ (require 'sawfish.wm.integration.gnome)))
;; if it looks like KDE is the desktop environment, then load the
;; extra KDE integration module
(unless batch-mode
(if (getenv "KDE_SESSION_VERSION")
- (require 'sawfish.wm.integration.kde)))
+ (require 'sawfish.wm.integration.kde)))
;; save errors to aid debugging
(require 'sawfish.wm.ext.error-handler)
diff --git a/lisp/sawfish/wm/ext/3d-hack.jl b/lisp/sawfish/wm/ext/3d-hack.jl
index 828e917..7b4a864 100644
--- a/lisp/sawfish/wm/ext/3d-hack.jl
+++ b/lisp/sawfish/wm/ext/3d-hack.jl
@@ -1,5 +1,4 @@
;; 3d-hack.jl -- too much spare time..
-;; $Id: 3d-hack.jl,v 1.10 2002/04/21 04:52:15 jsh Exp $
;; Copyright (C) 2000 John Harper <john dcs warwick ac uk>
@@ -115,9 +114,12 @@
(setq 3d-rot-speed [0.02 0.04 -0.1])))
(define (3d-make-cube)
- (let ((red-gc (x-create-gc 3d-window `((foreground . ,(get-color "red")))))
- (blue-gc (x-create-gc 3d-window `((foreground . ,(get-color "blue")))))
- (green-gc (x-create-gc 3d-window `((foreground . ,(get-color "green"))))))
+ (let ((red-gc (x-create-gc 3d-window
+ `((foreground . ,(get-color "red")))))
+ (blue-gc (x-create-gc 3d-window
+ `((foreground . ,(get-color "blue")))))
+ (green-gc (x-create-gc 3d-window
+ `((foreground . ,(get-color "green"))))))
(setq 3d-vertices [[-1 -1 1]
[1 -1 1]
[1 1 1]
diff --git a/lisp/sawfish/wm/ext/audio-events.jl b/lisp/sawfish/wm/ext/audio-events.jl
index 7cf1a7a..738df0b 100644
--- a/lisp/sawfish/wm/ext/audio-events.jl
+++ b/lisp/sawfish/wm/ext/audio-events.jl
@@ -1,5 +1,4 @@
;; audio-events.jl -- map wm actions to audio samples
-;; $Id: audio-events.jl,v 1.14 2002/04/21 03:39:34 jsh Exp $
;; Copyright (C) 2000 John Harper <john dcs warwick ac uk>
@@ -62,8 +61,8 @@
(unmapped . "unmap.wav")
(mapped-transient . "map-transient.wav")
(unmapped-transient . "unmap-transient.wav")
- ;(focused . "focused.wav")
- ;(unfocused . "unfocused.wav")
+ ;;(focused . "focused.wav")
+ ;;(unfocused . "unfocused.wav")
(switch-workspace . "switch-workspace.wav")
(move-viewport . "move-viewport.wav"))
nil
diff --git a/lisp/sawfish/wm/ext/auto-raise.jl b/lisp/sawfish/wm/ext/auto-raise.jl
index 604c9a9..7315ea0 100644
--- a/lisp/sawfish/wm/ext/auto-raise.jl
+++ b/lisp/sawfish/wm/ext/auto-raise.jl
@@ -1,5 +1,4 @@
;; auto-raise.jl -- auto-raise on focus
-;; $Id: auto-raise.jl,v 1.25 2002/04/21 22:25:13 jsh Exp $
;; Copyright (C) 1999 John Harper <john dcs warwick ac uk>
@@ -19,14 +18,16 @@
;; along with sawfish; see the file COPYING. If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-(define-structure sawfish.wm.ext.auto-raise ()
+(define-structure sawfish.wm.ext.auto-raise
+
+ (export )
(open rep
- rep.system
- rep.io.timers
- sawfish.wm.windows
- sawfish.wm.custom
- sawfish.wm.util.stacking)
+ rep.system
+ rep.io.timers
+ sawfish.wm.windows
+ sawfish.wm.custom
+ sawfish.wm.util.stacking)
(define-structure-alias auto-raise sawfish.wm.ext.auto-raise)
diff --git a/lisp/sawfish/wm/ext/beos-window-menu.jl b/lisp/sawfish/wm/ext/beos-window-menu.jl
index 1cd39f2..2dd2e28 100644
--- a/lisp/sawfish/wm/ext/beos-window-menu.jl
+++ b/lisp/sawfish/wm/ext/beos-window-menu.jl
@@ -1,7 +1,5 @@
;; beos-window-menu.jl -- hack to change window-menu to approximate BeOS
-;; $Id: beos-window-menu.jl,v 1.15 2003/08/14 06:55:35 jsh Exp $
-
;; Copyright (C) 2000 John Harper <john dcs warwick ac uk>
;; This file is part of sawfish.
@@ -85,11 +83,11 @@
(define (make-group-item id)
(let loop ((menu '())
(windows (windows-by-group id)))
- (if (null windows)
- (cons (group-name id) (nreverse menu))
- (if (window-suitable-p (car windows))
- (loop (cons (make-item (car windows)) menu) (cdr windows))
- (loop menu (cdr windows))))))
+ (if (null windows)
+ (cons (group-name id) (nreverse menu))
+ (if (window-suitable-p (car windows))
+ (loop (cons (make-item (car windows)) menu) (cdr windows))
+ (loop menu (cdr windows))))))
(define (cleanup-menu menu)
;; sort the group names..
@@ -97,49 +95,50 @@
(not (string-lessp (car x) (car y))))))
;; ..then merge any identically named sub-menus
(let loop ((rest menu))
- (when (cdr rest)
- (if (string= (caar rest) (caadr rest))
- (progn
- (rplacd (car rest) (nconc (cdar rest) (cdadr rest)))
- (rplacd rest (cddr rest))
- (loop rest))
- (loop (cdr rest)))))
+ (when (cdr rest)
+ (if (string= (caar rest) (caadr rest))
+ (progn
+ (rplacd (car rest) (nconc (cdar rest) (cdadr rest)))
+ (rplacd rest (cddr rest))
+ (loop rest))
+ (loop (cdr rest)))))
menu)
(define (make-menu)
(let-fluids ((windows-left (managed-windows)))
- (let loop-1 ((menu '())
- (groups (window-group-ids)))
- (if (null groups)
- (progn
- (setq menu (cleanup-menu menu))
- (let ((left (delete-if-not window-suitable-p
- (fluid windows-left))))
- (if left
- (let loop-2 ((menu (cons '() menu))
- (rest left))
- (if (null rest)
- menu
- (loop-2 (cons (make-item (car rest)) menu)
- (cdr rest))))
- menu)))
- (loop-1 (let ((item (make-group-item (car groups))))
- (if (cdr item)
- (cons item menu)
- menu))
- (cdr groups))))))
+ (let loop-1 ((menu '())
+ (groups (window-group-ids)))
+ (if (null groups)
+ (progn
+ (setq menu (cleanup-menu menu))
+ (let ((left (delete-if-not window-suitable-p
+ (fluid windows-left))))
+ (if left
+ (let loop-2 ((menu (cons '() menu))
+ (rest left))
+ (if (null rest)
+ menu
+ (loop-2 (cons (make-item (car rest))
+ menu)
+ (cdr rest))))
+ menu)))
+ (loop-1 (let ((item (make-group-item (car groups))))
+ (if (cdr item)
+ (cons item menu)
+ menu))
+ (cdr groups))))))
(define (simplify menu)
(let loop ((rest menu)
(out '()))
- (if (null rest)
- out
- (let ((next (cdr rest)))
- ;; reverse the pointers
- (rplacd rest out)
- (when (= (length (cdar rest)) 1)
- (rplaca rest (cadar rest)))
- (loop next rest)))))
+ (if (null rest)
+ out
+ (let ((next (cdr rest)))
+ ;; reverse the pointers
+ (rplacd rest out)
+ (when (= (length (cdar rest)) 1)
+ (rplaca rest (cadar rest)))
+ (loop next rest)))))
(define (beos-window-menu) (simplify (make-menu)))
diff --git a/lisp/sawfish/wm/ext/edge-flip.jl b/lisp/sawfish/wm/ext/edge-flip.jl
index cc07d4e..7b973cf 100644
--- a/lisp/sawfish/wm/ext/edge-flip.jl
+++ b/lisp/sawfish/wm/ext/edge-flip.jl
@@ -1,5 +1,4 @@
;; edge-flip.jl -- move viewports by pushing pointer against screen edges
-;; $Id: edge-flip.jl,v 1.31 2002/08/18 21:30:05 jsh Exp $
;; Copyright (C) 1999 John Harper <john dcs warwick ac uk>
diff --git a/lisp/sawfish/wm/ext/error-handler.jl b/lisp/sawfish/wm/ext/error-handler.jl
index 8eb249a..27e30b5 100644
--- a/lisp/sawfish/wm/ext/error-handler.jl
+++ b/lisp/sawfish/wm/ext/error-handler.jl
@@ -1,5 +1,4 @@
;; error-handler.jl -- replace the standard rep error handler
-;; $Id: error-handler.jl,v 1.7 2002/04/21 03:39:34 jsh Exp $
;; Copyright (C) 1999 John Harper <john dcs warwick ac uk>
diff --git a/lisp/sawfish/wm/ext/fdo-menu.jl b/lisp/sawfish/wm/ext/fdo-menu.jl
index 36f58e7..e80b7d5 100644
--- a/lisp/sawfish/wm/ext/fdo-menu.jl
+++ b/lisp/sawfish/wm/ext/fdo-menu.jl
@@ -1,4 +1,4 @@
-;-*-sawfish-*-
+;;-*-sawfish-*-
;; (fdo-menu.jl (v1.0.1) sawfish-wm-menu-generation librep)
;; (c) 2009 Matthew Love
@@ -29,7 +29,7 @@
(define-structure sawfish.wm.ext.fdo-menu
(export update-saw-menu)
-
+
(open rep
rep.io.files
rep.io.streams
@@ -47,7 +47,7 @@
(make-variable-special 'apps-menu)
;; fdo-desktop-file-parsing
-
+
(define (desktop-file-p directory-file)
(let ((this-file (open-file directory-file 'read)))
(string= (read-line this-file) "[Desktop Entry]\012")))
@@ -63,7 +63,7 @@
(define (get-key-break instring key)
(if instring
(let ((mlength (length instring)))
- (do ((mcount 0 (1+ mcount)))
+ (do ((mcount 0 (1+ mcount)))
((or (string= (substring instring mcount (+ mcount 1)) "\n")
(string= (substring instring mcount (+ mcount 1)) "\012")
(string= (substring instring mcount (+ mcount 1)) key)
@@ -92,7 +92,8 @@
(if (desktop-group-p this-line)
(get-desktop-group this-line)
(if (not (desktop-group-p this-line))
- (cons (get-desktop-key this-line) (get-desktop-value this-line))))
+ (cons (get-desktop-key this-line)
+ (get-desktop-value this-line))))
(parse-desktop-file-line infile))
(parse-desktop-file-line infile))))
@@ -101,17 +102,17 @@
(parse-desktop-file-line d-file)))
;; generic functions
-
+
(define (map-desk-files in-desk-files in-directory)
(if in-desk-files
(cons (expand-file-name (car in-desk-files) in-directory)
(map-desk-files (cdr in-desk-files) in-directory))))
-
+
(define (map-dir-files directories)
(if directories
(if (file-directory-p (car directories))
(let ((desk0 (directory-files (car directories))))
- (cons (map-desk-files desk0 (car directories))
+ (cons (map-desk-files desk0 (car directories))
(map-dir-files (cdr directories))))
(map-dir-files (cdr directories)))))
@@ -120,7 +121,7 @@
((atom input) (list input))
(t (append (flatten (car input))
(flatten (cdr input))))))
-
+
(define (trim-end string)
(cond
((string= (aref string (- (length string) 3)) 37)
@@ -156,8 +157,8 @@
(substring mlang 0 2)) "xx")))
(t "xx")))
- ;; Variables that can be set in .sawfish[/]rc
-
+ ;; Variables that can be set in .sawfish[/]rc
+
(if (not (boundp 'my-lang-string))
(defvar my-lang-string (find-lang-string)))
@@ -179,46 +180,62 @@
;; The Master Category List
(defvar menu-cat-alist
- '(("Desktop" . ("X-Desktop" "X-DesktopApplets" "X-DesktopCountry" \
- "DesktopSettings" "GNOME" "KDE" "X-GNOME-PersonalSettings" \
- "X-Xfce-Toplevel"))
- ("Personal" . ("X-Personal" "X-PersonalUtility" "Calendar" "ContactManagement"))
- ("Office" . ("Office" "WordProcessor" "Presentation" "X-Document" \
- "TextEditor" "SpreadSheet" "Calculator" "X-Calculate" \
- "Chart" "FlowChart" "Finance"))
- ("Internet" . ("Telephony" "Network" "Dialup" "VideoConference" \
- "RemoteAccess" "News" "HamRadio" "FileTransfer" \
- "X-Internet" "P2P" "Email" "WebBrowser" "IRCClient" "Chat" \
- "InstantMessaging" "Chat" "WebDevelopment"))
- ("Games" . ("Game" "ActionGame" "AdventureGame" "ArcadeGame" "BoardGame" "Emulator"\
- "BlocksGame" "CardGame" "KidsGame" "LogicGame" "RolePlaying" "Simulation"))
- ("Graphics" . ("RasterGraphics" "VectorGraphics" "X-GraphicUtility" \
- "2DGraphics" "3dGraphics" "3DGraphics" "Scanning" "OCR" "Photography" \
- "Viewer" "Publishing" "Art" "ImageProcessing"))
- ("Media" . ("AudioVideo" "Audio", "Video" "Midi" "Mixer" "Sequencer" "Tuner" \
- "TV" "AudioVideoEditing" "Player" "Recorder" "DiscBurning" "Music"))
- ("Science" . ("Science" "Astrology" "ArtificialIntelligence" "Astronomy" \
- "Biology" "Chemistry" "ComputerScience" "DataVisualization" \
- "Electricity" "Robotics" "Physics" "Math" "Education" "Geography"))
- ("Development" . ("GUIDesigner" "IDE" "Profiling" "RevisionControl" \
- "ProjectManagement" "Translation" "GTK" "Development" \
- "Qt" "Development" "Documentation"))
- ("Utility" . ("X-SystemMemory" "Security" "Utility" \
- "X-SetupEntry" "X-SetupUtility" "X-SystemMemory" \
- "TextTools" "TelephonyTools" "Accessibility" "Clock" \
- "ConsoleOnly"))
- ("Filesystem" . ("X-FileSystemFind" "X-FileSystemUtility" "Archiving" \
- "FileManager" "X-FileSystemMount" "Compression"))
- ("System" . ("X-SystemSchedule" "System" "X-SystemMemory" \
- "TerminalEmulator" "Dictionary" "Puppy" "Printing" "Monitor" "Security"))
- ("Settings" . ("Settings" "HardwareSettings" "PackageManager"))
+ '(("Desktop" . ("X-Desktop" "X-DesktopApplets"
+ "X-DesktopCountry" "DesktopSettings" "GNOME"
+ "KDE" "X-GNOME-PersonalSettings"
+ "X-Xfce-Toplevel"))
+ ("Personal" . ("X-Personal" "X-PersonalUtility" "Calendar"
+ "ContactManagement"))
+ ("Office" . ("Office" "WordProcessor" "Presentation"
+ "X-Document" "TextEditor" "SpreadSheet"
+ "Calculator" "X-Calculate" "Chart" "FlowChart"
+ "Finance"))
+ ("Internet" . ("Telephony" "Network" "Dialup"
+ "VideoConference" "RemoteAccess" "News"
+ "HamRadio" "FileTransfer" "X-Internet" "P2P"
+ "Email" "WebBrowser" "IRCClient" "Chat"
+ "InstantMessaging" "Chat" "WebDevelopment"))
+ ("Games" . ("Game" "ActionGame" "AdventureGame" "ArcadeGame"
+ "BoardGame" "Emulator" "BlocksGame" "CardGame"
+ "KidsGame" "LogicGame" "RolePlaying"
+ "Simulation"))
+ ("Graphics" . ("RasterGraphics" "VectorGraphics"
+ "X-GraphicUtility" "2DGraphics" "3dGraphics"
+ "3DGraphics" "Scanning" "OCR" "Photography"
+ "Viewer" "Publishing" "Art" "ImageProcessing"))
+ ("Media" . ("AudioVideo" "Audio", "Video" "Midi" "Mixer"
+ "Sequencer" "Tuner" "TV" "AudioVideoEditing"
+ "Player" "Recorder" "DiscBurning" "Music"))
+ ("Science" . ("Science" "Astrology" "ArtificialIntelligence"
+ "Astronomy" "Biology" "Chemistry"
+ "ComputerScience" "DataVisualization"
+ "Electricity" "Robotics" "Physics" "Math"
+ "Education" "Geography"))
+ ("Development" . ("GUIDesigner" "IDE" "Profiling"
+ "RevisionControl" "ProjectManagement"
+ "Translation" "GTK" "Development" "Qt"
+ "Development" "Documentation"))
+ ("Utility" . ("X-SystemMemory" "Security" "Utility"
+ "X-SetupEntry" "X-SetupUtility" "X-SystemMemory"
+ "TextTools" "TelephonyTools" "Accessibility"
+ "Clock" "ConsoleOnly"))
+ ("Filesystem" . ("X-FileSystemFind" "X-FileSystemUtility"
+ "Archiving" "FileManager"
+ "X-FileSystemMount" "Compression"))
+ ("System" . ("X-SystemSchedule" "System" "X-SystemMemory"
+ "TerminalEmulator" "Dictionary" "Puppy"
+ "Printing" "Monitor" "Security"))
+ ("Settings" . ("Settings" "HardwareSettings"
+ "PackageManager"))
("Exiles" . ("Exile"))))
;; Get the correct Name value based on language settings
(define (find-lang-in-desktop-file fdo-list)
(if (assoc (concat fdo-name-string my-lang-string "]") fdo-list)
(concat fdo-name-string my-lang-string "]")
- (if (assoc (concat fdo-name-string (substring my-lang-string 0 2) "]") fdo-list)
+ (if (assoc (concat fdo-name-string
+ (substring my-lang-string 0 2) "]")
+ fdo-list)
(concat fdo-name-string (substring my-lang-string 0 2) "]")
"Name")))
@@ -228,10 +245,12 @@
(let ((cat-val (car cat-list)))
(if (assoc cat-val loc-list)
(cons (cdr (assoc cat-val loc-list))
- (fix-sub-cats cat-list (remove (assoc cat-val loc-list) loc-list)))
+ (fix-sub-cats cat-list (remove (assoc cat-val loc-list)
+ loc-list)))
(fix-sub-cats (cdr cat-list) loc-list)))))
- ;; Associate values from the Master Category list with sub-categories from file
+ ;; Associate values from the Master Category list with
+ ;; sub-categories from file
(define (fix-cats cat-list)
(if cat-list
(let ((cat-val (car (car cat-list)))
@@ -240,13 +259,15 @@
(cons (cons cat-val c-list) (fix-cats (cdr cat-list)))
(fix-cats (cdr cat-list))))))
- ;; Convert a Categories key value from ; delineated records to a list
- (define (build-cat-list line)
+ ;; Convert a Categories key value from ; delineated records to a
+ ;; list
+ (define (build-cat-list line)
(if (> (length line) 1)
(let ((this-cat (prin1-to-string (read-from-string line))))
- (cons this-cat
+ (cons this-cat
(if (< (length this-cat) (length line))
- (build-cat-list (substring line (+ 1 (length this-cat)))))))))
+ (build-cat-list
+ (substring line (+ 1 (length this-cat)))))))))
;; Helper for (parse-desk-line)
;; Determine best category to use... :|
@@ -267,51 +288,82 @@
;; Alphabetize the entries in the category menus
(define (alphabetize-entries saw-menu)
(if saw-menu
- (cons (cons (car (car saw-menu))
- (sort (cdr (car saw-menu)) string<))
+ (cons (cons (car (car saw-menu))
+ (sort (cdr (car saw-menu)) string<))
(alphabetize-entries (cdr saw-menu)))))
(define (fdo-exile fdo-list)
- (setq fdo-list
- (append fdo-list (cons (cons "fdo-Comment" "This .desktop file was exiled, use with caution, file may be corrupt.\n"))))
- (if (assoc "NoDisplay" fdo-list)
- (rplacd (assoc "NoDisplay" fdo-list) "true\n")
- (setq fdo-list (append fdo-list (cons (cons "NoDisplay" "true\n")))))
- (if (not (assoc "Exec" fdo-list))
- (setq fdo-list (append fdo-list (cons (cons "Exec" "sawfish-client -c 'display-errors'\n")))))
- (if (and (not (assoc "Name" fdo-list))
- (not (assoc (concat fdo-name-string my-lang-string "]") fdo-list)))
- (setq fdo-list (append fdo-list (cons (cons "Name" "Unknown\n")))))
- (if (assoc "Categories" fdo-list)
- (rplacd (assoc "Categories" fdo-list) "Exile\n")
- (setq fdo-list (append fdo-list (cons (cons "Categories" "Exile\n")))))
- fdo-list)
+ "Exile `fdo-list' -- i.e., mark it as an invalid or garbled
+.desktop file."
+ (let ((exile-comment
+ (cons "fdo-Comment" "This .desktop file was exiled, use \
+with caution, file may be corrupt.\n"))
+ (exile-cmd
+ (cons "Exec" "sawfish-client -c 'display-errors'\n")))
+ (setq fdo-list
+ (append fdo-list (list exile-comment)))
+ (if (assoc "NoDisplay" fdo-list)
+ (rplacd (assoc "NoDisplay" fdo-list) "true\n")
+ (setq fdo-list (append fdo-list (cons (cons "NoDisplay"
+ "true\n")))))
+ (when (not (assoc "Exec" fdo-list))
+ (setq fdo-list (append fdo-list (list exile-cmd))))
+ (when (and (not (assoc "Name" fdo-list))
+ (not (assoc (concat fdo-name-string my-lang-string "]")
+ fdo-list)))
+ (setq fdo-list (append fdo-list (cons (cons "Name"
+ "Unknown\n")))))
+ (if (assoc "Categories" fdo-list)
+ (rplacd (assoc "Categories" fdo-list) "Exile\n")
+ (setq fdo-list (append fdo-list (cons (cons "Categories"
+ "Exile\n")))))
+ fdo-list))
(define (fdo-check-exile fdo-list)
- (if fdo-list
- (if (or (not (assoc "Categories" fdo-list))
- (not (assoc "Exec" fdo-list))
- (and (not (assoc "Name" fdo-list))
- (not (assoc (concat fdo-name-string my-lang-string "]") fdo-list))))
- (fdo-exile fdo-list)
- fdo-list)))
+ "If `fdo-list' doesn't have a Categories, Exec, or Name field
+exile it."
+ (when fdo-list
+ (if (or (not (assoc "Categories" fdo-list))
+ (not (assoc "Exec" fdo-list))
+ (and (not (assoc "Name" fdo-list))
+ (not (assoc (concat fdo-name-string
+ my-lang-string "]")
+ fdo-list))))
+ (fdo-exile fdo-list)
+ fdo-list)))
;; generate a saw-fish menu entry from a .desktop file
(define (generate-menu-entry desk-file)
+ "Generate a menu entry to run the program specified in the the
+.desktop file `desk-file'."
(if (and (not (file-directory-p desk-file))
(desktop-file-p desk-file))
(let ((fdo-list (fdo-check-exile (parse-desktop-file desk-file))))
(if ignore-no-display
(if (assoc "NoDisplay" fdo-list)
(rplacd (assoc "NoDisplay" fdo-list) "false\n")
- (setq fdo-list (append fdo-list (cons (cons "NoDisplay" "false\n"))))))
+ (setq fdo-list (append fdo-list (list (cons "NoDisplay"
+ "false\n"))))))
(if (not (string= (cdr (assoc "NoDisplay" fdo-list)) "true\n"))
- (cons (parse-cat-list (build-cat-list (trim-end (cdr (assoc "Categories" fdo-list)))))
- (cons (trim-end (cdr (assoc (find-lang-in-desktop-file fdo-list) fdo-list)))
- (if (string= (cdr (assoc "Terminal" fdo-list)) "true\012")
- (cons (list
- 'system (concat my-term-string (trim-end (cdr (assoc "Exec" fdo-list))) " &")))
- (cons (list 'system (concat (trim-end (cdr (assoc "Exec" fdo-list))) " &"))))))))))
+ (cons (parse-cat-list
+ (build-cat-list
+ (trim-end (cdr (assoc "Categories" fdo-list)))))
+ (cons (trim-end
+ (cdr (assoc (find-lang-in-desktop-file fdo-list)
+ fdo-list)))
+ (if (string= (cdr (assoc "Terminal" fdo-list))
+ "true\012")
+ (cons (list
+ 'system
+ (concat my-term-string
+ (trim-end
+ (cdr (assoc "Exec" fdo-list)))
+ " &")))
+ (cons (list
+ 'system
+ (concat (trim-end
+ (cdr (assoc "Exec" fdo-list)))
+ " &"))))))))))
;; Update the menu
(define (update-saw-menu)
@@ -321,12 +373,15 @@
(setq my-lang-string "xx"))
(let ((desk-files (flatten (map-dir-files desktop-directory))))
(mapc (lambda (x)
- (setq *fdo-local-menu* (append *fdo-local-menu* (list (generate-menu-entry x))))) desk-files)
+ (setq *fdo-local-menu*
+ (append *fdo-local-menu*
+ (list (generate-menu-entry x))))) desk-files)
(if want-alphabetize
(setq apps-menu (alphabetize-entries (fix-cats menu-cat-alist)))
(setq apps-menu (fix-cats menu-cat-alist))))))
(define-command 'update-saw-menu update-saw-menu)
-))
- ;; END-FILE
+
+ ))
+;; END-FILE
diff --git a/lisp/sawfish/wm/ext/hide-dialogs.jl b/lisp/sawfish/wm/ext/hide-dialogs.jl
index b65822a..ccb8048 100644
--- a/lisp/sawfish/wm/ext/hide-dialogs.jl
+++ b/lisp/sawfish/wm/ext/hide-dialogs.jl
@@ -1,27 +1,24 @@
-#| hide-dialogs.jl -- only show dialog windows for the focused group
-
- $Id: hide-dialogs.jl,v 1.2 2002/04/21 22:25:13 jsh Exp $
-
- Copyright (C) 2001 Eazel, Inc.
-
- This file is part of sawfish.
-
- sawfish 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.
-
- sawfish 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 sawfish; see the file COPYING. If not, write to
- the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-
- Authors: John Harper <jsh eazel com>
-|#
+;; hide-dialogs.jl -- only show dialog windows for the focused group
+;;
+;; Copyright (C) 2001 Eazel, Inc.
+;;
+;; This file is part of sawfish.
+;;
+;; sawfish 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.
+;;
+;; sawfish 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 sawfish; see the file COPYING. If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;;
+;; Authors: John Harper <jsh eazel com>
;; Commentary:
@@ -30,15 +27,17 @@
;; The idea is to minimize dialog windows for all groups but the group
;; containing the currently focused windows.
-(define-structure sawfish.wm.ext.hide-dialogs ()
+(define-structure sawfish.wm.ext.hide-dialogs
+
+ (define )
(open rep
- rep.system
- rep.io.timers
- sawfish.wm.util.groups
- sawfish.wm.state.iconify
- sawfish.wm.state.transient
- sawfish.wm.windows)
+ rep.system
+ rep.io.timers
+ sawfish.wm.util.groups
+ sawfish.wm.state.iconify
+ sawfish.wm.state.transient
+ sawfish.wm.windows)
(define (dialogs-in-group w)
(filter window-transient-p (windows-in-group w)))
diff --git a/lisp/sawfish/wm/ext/infinite-desktop.jl b/lisp/sawfish/wm/ext/infinite-desktop.jl
index 549a557..3dc9f97 100644
--- a/lisp/sawfish/wm/ext/infinite-desktop.jl
+++ b/lisp/sawfish/wm/ext/infinite-desktop.jl
@@ -1,5 +1,4 @@
;; infinite-desktop.jl -- make the virtual desktop bigger than the physical
-;; $Id: infinite-desktop.jl,v 1.33 2008/02/05 06:48:02 chrisb Exp $
;; Copyright (C) 2008 David T. McWherter <udmcwher mcs drexel edu>
@@ -21,111 +20,111 @@
(define-structure sawfish.wm.ext.infinite-desktop
- (export )
-
- (open rep
- rep.system
- sawfish.wm.misc
- sawfish.wm.custom
- sawfish.wm.commands.move-cursor
- sawfish.wm.viewport
- sawfish.wm.util.prompt
- sawfish.wm.util.flippers
- sawfish.wm.ext.edge-flip)
-
- (define-structure-alias infinite-desktop sawfish.wm.ext.infinite-desktop)
-
-;;
-;; Remove our hooks if they're already installed -
-;; allows us to be imported multiple times safely.
-;;
-
-(define (infinite-desktop.remove a l)
- (cond ((not l) nil)
- ((eq a (car l)) (infinite-desktop.remove a (cdr l)))
- (t (cons (car l) (infinite-desktop.remove a (cdr l))))))
-
-(defgroup infinite-desktop "Infinite Desktop"
- :group workspace)
-
-(defcustom infinite-desktop-p 1
- "Simulate an infinite desktop (Conflicts edge-flipping)."
- :group (workspace infinite-desktop)
- :after-set (lambda () (infinite-desktop.infinite-desktop))
- :type boolean)
-
-(defcustom infinite-desktop.move-distance 64
- "Amount to move the workspace."
- :group (workspace infinite-desktop)
- :type number
- :range (1 . nil))
-
-(defcustom infinite-desktop.move-cursor-distance 32
- "Amount to move the cursor after moving the workspace."
- :group (workspace infinite-desktop)
- :type number
- :range (1 . nil))
-
-(defcustom infinite-desktop.stop-at-workspace-borders nil
- "Stop scrolling at workspace borders (Fixes warp-to-window bugs)."
- :group (workspace infinite-desktop)
- :type boolean )
-
-(define (infinite-desktop.move-right)
- (let ((dist infinite-desktop.move-distance)
- (cdist infinite-desktop.move-cursor-distance)
- (maxx (* (screen-width) (1- (car viewport-dimensions)))))
- (if
- (and infinite-desktop.stop-at-workspace-borders
- (> (+ dist viewport-x-offset) maxx))
- (setq dist (- maxx viewport-x-offset)))
- (set-viewport (+ viewport-x-offset dist) viewport-y-offset)
- (move-cursor (- (min dist cdist)) 0)))
-
-(define (infinite-desktop.move-left)
- (let ((dist (- infinite-desktop.move-distance))
- (cdist (- infinite-desktop.move-cursor-distance))
- (minx 0))
- (if
- (and infinite-desktop.stop-at-workspace-borders
- (< (+ viewport-x-offset dist) minx))
- (setq dist (- minx viewport-x-offset)))
- (set-viewport (+ viewport-x-offset dist) viewport-y-offset)
- (move-cursor (- (max dist cdist)) 0)))
-
-(define (infinite-desktop.move-top)
- (let ((dist (- infinite-desktop.move-distance))
- (cdist (- infinite-desktop.move-cursor-distance))
- (miny 0))
- (if
- (and infinite-desktop.stop-at-workspace-borders
- (< (+ viewport-y-offset dist) miny))
- (setq dist (- miny viewport-y-offset)))
- (set-viewport viewport-x-offset (+ viewport-y-offset dist))
- (move-cursor 0 (- (max dist cdist)))))
-
-(define (infinite-desktop.move-bottom)
- (let ((dist infinite-desktop.move-distance)
- (cdist infinite-desktop.move-cursor-distance)
- (maxy (* (screen-height) (1- (cdr viewport-dimensions)))))
- (if
- (and infinite-desktop.stop-at-workspace-borders
- (> (+ dist viewport-y-offset) maxy))
- (setq dist (- maxy viewport-y-offset)))
- (set-viewport viewport-x-offset (+ viewport-y-offset dist))
- (move-cursor 0 (- (min dist cdist)))))
-
-(define (infinite-desktop.enter-flipper-hook w)
- (if infinite-desktop-p
- (cond ((eq w 'right) (infinite-desktop.move-right))
- ((eq w 'left) (infinite-desktop.move-left))
- ((eq w 'bottom) (infinite-desktop.move-bottom))
- ((eq w 'top) (infinite-desktop.move-top))
- (t (display-message "move-unknown")))))
-
-(define (infinite-desktop.infinite-desktop)
- (if infinite-desktop-p
- (enable-flippers)))
-
-(unless batch-mode
- (add-hook 'enter-flipper-hook infinite-desktop.enter-flipper-hook)))
+ (export )
+
+ (open rep
+ rep.system
+ sawfish.wm.misc
+ sawfish.wm.custom
+ sawfish.wm.commands.move-cursor
+ sawfish.wm.viewport
+ sawfish.wm.util.prompt
+ sawfish.wm.util.flippers
+ sawfish.wm.ext.edge-flip)
+
+ (define-structure-alias infinite-desktop sawfish.wm.ext.infinite-desktop)
+
+ ;;
+ ;; Remove our hooks if they're already installed -
+ ;; allows us to be imported multiple times safely.
+ ;;
+
+ (define (infinite-desktop.remove a l)
+ (cond ((not l) nil)
+ ((eq a (car l)) (infinite-desktop.remove a (cdr l)))
+ (t (cons (car l) (infinite-desktop.remove a (cdr l))))))
+
+ (defgroup infinite-desktop "Infinite Desktop"
+ :group workspace)
+
+ (defcustom infinite-desktop-p 1
+ "Simulate an infinite desktop (Conflicts edge-flipping)."
+ :group (workspace infinite-desktop)
+ :after-set (lambda () (infinite-desktop.infinite-desktop))
+ :type boolean)
+
+ (defcustom infinite-desktop.move-distance 64
+ "Amount to move the workspace."
+ :group (workspace infinite-desktop)
+ :type number
+ :range (1 . nil))
+
+ (defcustom infinite-desktop.move-cursor-distance 32
+ "Amount to move the cursor after moving the workspace."
+ :group (workspace infinite-desktop)
+ :type number
+ :range (1 . nil))
+
+ (defcustom infinite-desktop.stop-at-workspace-borders nil
+ "Stop scrolling at workspace borders (Fixes warp-to-window bugs)."
+ :group (workspace infinite-desktop)
+ :type boolean )
+
+ (define (infinite-desktop.move-right)
+ (let ((dist infinite-desktop.move-distance)
+ (cdist infinite-desktop.move-cursor-distance)
+ (maxx (* (screen-width) (1- (car viewport-dimensions)))))
+ (if
+ (and infinite-desktop.stop-at-workspace-borders
+ (> (+ dist viewport-x-offset) maxx))
+ (setq dist (- maxx viewport-x-offset)))
+ (set-viewport (+ viewport-x-offset dist) viewport-y-offset)
+ (move-cursor (- (min dist cdist)) 0)))
+
+ (define (infinite-desktop.move-left)
+ (let ((dist (- infinite-desktop.move-distance))
+ (cdist (- infinite-desktop.move-cursor-distance))
+ (minx 0))
+ (if
+ (and infinite-desktop.stop-at-workspace-borders
+ (< (+ viewport-x-offset dist) minx))
+ (setq dist (- minx viewport-x-offset)))
+ (set-viewport (+ viewport-x-offset dist) viewport-y-offset)
+ (move-cursor (- (max dist cdist)) 0)))
+
+ (define (infinite-desktop.move-top)
+ (let ((dist (- infinite-desktop.move-distance))
+ (cdist (- infinite-desktop.move-cursor-distance))
+ (miny 0))
+ (if
+ (and infinite-desktop.stop-at-workspace-borders
+ (< (+ viewport-y-offset dist) miny))
+ (setq dist (- miny viewport-y-offset)))
+ (set-viewport viewport-x-offset (+ viewport-y-offset dist))
+ (move-cursor 0 (- (max dist cdist)))))
+
+ (define (infinite-desktop.move-bottom)
+ (let ((dist infinite-desktop.move-distance)
+ (cdist infinite-desktop.move-cursor-distance)
+ (maxy (* (screen-height) (1- (cdr viewport-dimensions)))))
+ (if
+ (and infinite-desktop.stop-at-workspace-borders
+ (> (+ dist viewport-y-offset) maxy))
+ (setq dist (- maxy viewport-y-offset)))
+ (set-viewport viewport-x-offset (+ viewport-y-offset dist))
+ (move-cursor 0 (- (min dist cdist)))))
+
+ (define (infinite-desktop.enter-flipper-hook w)
+ (if infinite-desktop-p
+ (cond ((eq w 'right) (infinite-desktop.move-right))
+ ((eq w 'left) (infinite-desktop.move-left))
+ ((eq w 'bottom) (infinite-desktop.move-bottom))
+ ((eq w 'top) (infinite-desktop.move-top))
+ (t (display-message "move-unknown")))))
+
+ (define (infinite-desktop.infinite-desktop)
+ (if infinite-desktop-p
+ (enable-flippers)))
+
+ (unless batch-mode
+ (add-hook 'enter-flipper-hook infinite-desktop.enter-flipper-hook)))
diff --git a/lisp/sawfish/wm/ext/match-window.jl b/lisp/sawfish/wm/ext/match-window.jl
index e3ded4a..917d1a3 100644
--- a/lisp/sawfish/wm/ext/match-window.jl
+++ b/lisp/sawfish/wm/ext/match-window.jl
@@ -1,5 +1,4 @@
;; match-window.jl -- match windows to properties
-;; $Id: match-window.jl,v 1.52 2003/02/20 04:56:05 jsh Exp $
;; Copyright (C) 1999 John Harper <john dcs warwick ac uk>
@@ -61,63 +60,69 @@
;;; configuration and customize stuff
(i18n-defvar match-window-x-properties
- '((WM_NAME . "Name")
- (WM_CLASS . "Class")
- (WM_ICON_NAME . "Icon Name")
- (WM_WINDOW_ROLE . "Role")
- (WM_CLIENT_MACHINE . "Host")
- (WM_COMMAND . "Command")
- (WM_LOCALE_NAME . "Locale")))
-
- (i18n-defvar match-window-properties
- `((placement ,(_ "Placement")
- (ignore-program-position boolean)
- (place-mode ,(lambda () `(choice ,@placement-modes)))
- (position (or
- (pair (number -65536 65536 0) (number -65536 65536 0))
- (choice center east north north-east north-west south south-east south-west west)))
- (dimensions (pair (number 1) (number 1)))
- (workspace (number 1))
- (viewport (pair (number 1) (number 1)))
- (depth (number -16 16 0))
- (placement-weight (number 0))
- (fixed-position boolean)
- (maximized (choice all vertical horizontal))
- (new-workspace boolean)
- (new-viewport boolean))
- (focus ,(_ "Focus")
- (raise-on-focus boolean)
- (focus-when-mapped boolean)
- (never-focus boolean)
- (focus-click-through boolean)
- (focus-mode ,(lambda () `(choice ,@focus-modes))))
- (appearance ,(_ "Appearance")
- (frame-type ,(lambda () `(choice ,@(mapcar car match-window-types))))
- (frame-style ,(lambda () `(symbol ,@(find-all-frame-styles t)))))
- (state ,(_ "State")
- (avoid boolean)
- (ignored boolean)
- (iconified boolean)
- (shaded boolean)
- (sticky boolean)
- (sticky-viewport boolean)
- (group ,(lambda ()
- `(symbol ,@(delete-if-not symbolp (window-group-ids)))))
- (ungrouped boolean)
- (cycle-skip boolean)
- (window-list-skip boolean)
- (task-list-skip boolean)
- (never-iconify boolean)
- (never-maximize boolean)
- (fullscreen boolean)
- (fullscreen-xinerama boolean))
- (other ,(_ "Other")
- (unique-name boolean)
- (auto-gravity boolean)
- (shade-hover boolean)
- (transients-above (choice all parents none))
- (ignore-stacking-requests boolean)
- (window-name string))))
+ '((WM_NAME . "Name")
+ (WM_CLASS . "Class")
+ (WM_ICON_NAME . "Icon Name")
+ (WM_WINDOW_ROLE . "Role")
+ (WM_CLIENT_MACHINE . "Host")
+ (WM_COMMAND . "Command")
+ (WM_LOCALE_NAME . "Locale")))
+
+ (i18n-defvar
+ match-window-properties
+ `((placement ,(_ "Placement")
+ (ignore-program-position boolean)
+ (place-mode ,(lambda () `(choice ,@placement-modes)))
+ (position (or
+ (pair (number -65536 65536 0)
+ (number -65536 65536 0))
+ (choice center east north north-east
+ north-west south south-east
+ south-west west)))
+ (dimensions (pair (number 1) (number 1)))
+ (workspace (number 1))
+ (viewport (pair (number 1) (number 1)))
+ (depth (number -16 16 0))
+ (placement-weight (number 0))
+ (fixed-position boolean)
+ (maximized (choice all vertical horizontal))
+ (new-workspace boolean)
+ (new-viewport boolean))
+ (focus ,(_ "Focus")
+ (raise-on-focus boolean)
+ (focus-when-mapped boolean)
+ (never-focus boolean)
+ (focus-click-through boolean)
+ (focus-mode ,(lambda () `(choice ,@focus-modes))))
+ (appearance ,(_ "Appearance")
+ (frame-type ,(lambda ()
+ `(choice ,@(mapcar car match-window-types))))
+ (frame-style ,(lambda ()
+ `(symbol ,@(find-all-frame-styles t)))))
+ (state ,(_ "State")
+ (avoid boolean)
+ (ignored boolean)
+ (iconified boolean)
+ (shaded boolean)
+ (sticky boolean)
+ (sticky-viewport boolean)
+ (group ,(lambda ()
+ `(symbol ,@(delete-if-not symbolp (window-group-ids)))))
+ (ungrouped boolean)
+ (cycle-skip boolean)
+ (window-list-skip boolean)
+ (task-list-skip boolean)
+ (never-iconify boolean)
+ (never-maximize boolean)
+ (fullscreen boolean)
+ (fullscreen-xinerama boolean))
+ (other ,(_ "Other")
+ (unique-name boolean)
+ (auto-gravity boolean)
+ (shade-hover boolean)
+ (transients-above (choice all parents none))
+ (ignore-stacking-requests boolean)
+ (window-name string))))
;; alist of (PROPERTY . FEATURE) mapping properties to the lisp
;; libraries implementing them
@@ -324,113 +329,113 @@
;;; custom property formatters and setters
(define-match-window-formatter 'WM_CLASS
- (lambda (vec)
- (format nil "%s/%s" (and (> (length vec) 1) (aref vec 1)) (aref vec 0))))
+ (lambda (vec)
+ (format nil "%s/%s" (and (> (length vec) 1) (aref vec 1)) (aref vec 0))))
(define-match-window-formatter 'WM_COMMAND
- (lambda (vec)
- (let ((i 0)
- parts)
- (while (< i (length vec))
- (when parts
- (setq parts (cons ? parts)))
- (setq parts (cons (aref vec i) parts))
- (setq i (1+ i)))
- (apply concat (nreverse parts)))))
+ (lambda (vec)
+ (let ((i 0)
+ parts)
+ (while (< i (length vec))
+ (when parts
+ (setq parts (cons ? parts)))
+ (setq parts (cons (aref vec i) parts))
+ (setq i (1+ i)))
+ (apply concat (nreverse parts)))))
(define-match-window-setter 'workspace
- (lambda (w prop value)
- (declare (unused prop))
- (unless (or (window-get w 'placed) (window-workspaces w))
- ;; translate from 1.. to 0..
- (set-window-workspaces w (list (1- value))))))
+ (lambda (w prop value)
+ (declare (unused prop))
+ (unless (or (window-get w 'placed) (window-workspaces w))
+ ;; translate from 1.. to 0..
+ (set-window-workspaces w (list (1- value))))))
(define-match-window-setter 'position
- (lambda (w prop value)
- (declare (unused prop))
- (let* ((size (window-frame-dimensions w))
- (x (if (symbolp value)
- (cond ((memq value '(east south-east north-east))
- (- (screen-width) (car size)))
- ((memq value '(north center south))
- (- (quotient (screen-width) 2)
- (quotient (car size) 2)))
- (t 0))
- (car value)))
- (y (if (symbolp value)
- (cond ((memq value '(south south-east south-west))
- (- (screen-height) (cdr size)))
- ((memq value '(east center west))
- (- (quotient (screen-height) 2)
- (quotient (cdr size) 2)))
- (t 0))
- (cdr value)))
- (gravity (cond ((symbolp value)
- value)
- ((and (< x 0) (< y 0))
- 'south-east)
- ((< x 0)
- 'north-east)
- ((< y 0)
- 'south-west)
- (t nil))))
- (when gravity
- (window-put w 'gravity gravity))
- (when (< x 0)
+ (lambda (w prop value)
+ (declare (unused prop))
+ (let* ((size (window-frame-dimensions w))
+ (x (if (symbolp value)
+ (cond ((memq value '(east south-east north-east))
+ (- (screen-width) (car size)))
+ ((memq value '(north center south))
+ (- (quotient (screen-width) 2)
+ (quotient (car size) 2)))
+ (t 0))
+ (car value)))
+ (y (if (symbolp value)
+ (cond ((memq value '(south south-east south-west))
+ (- (screen-height) (cdr size)))
+ ((memq value '(east center west))
+ (- (quotient (screen-height) 2)
+ (quotient (cdr size) 2)))
+ (t 0))
+ (cdr value)))
+ (gravity (cond ((symbolp value)
+ value)
+ ((and (< x 0) (< y 0))
+ 'south-east)
+ ((< x 0)
+ 'north-east)
+ ((< y 0)
+ 'south-west)
+ (t nil))))
+ (when gravity
+ (window-put w 'gravity gravity))
+ (when (< x 0)
(setq x (+ (- (screen-width) (car size)) x)))
- (when (< y 0)
+ (when (< y 0)
(setq y (+ (- (screen-height) (cdr size)) y)))
- (move-window-to w x y))))
+ (move-window-to w x y))))
(define-match-window-setter 'dimensions
- (lambda (w prop value)
- (declare (unused prop))
- (resize-window-with-hints w (car value) (cdr value))))
+ (lambda (w prop value)
+ (declare (unused prop))
+ (resize-window-with-hints w (car value) (cdr value))))
(define-match-window-setter 'viewport
- (lambda (w prop value)
- (declare (unused prop))
- (unless (window-get w 'placed)
- (set-screen-viewport (1- (car value)) (1- (cdr value)))
- (set-window-viewport w (1- (car value)) (1- (cdr value))))))
+ (lambda (w prop value)
+ (declare (unused prop))
+ (unless (window-get w 'placed)
+ (set-screen-viewport (1- (car value)) (1- (cdr value)))
+ (set-window-viewport w (1- (car value)) (1- (cdr value))))))
(define-match-window-setter 'frame-type
- (lambda (w prop value)
- (declare (unused prop))
- (set-window-type w (or (cdr (assq value match-window-types)) value))))
+ (lambda (w prop value)
+ (declare (unused prop))
+ (set-window-type w (or (cdr (assq value match-window-types)) value))))
(define-match-window-setter 'ungrouped
- (lambda (w prop value)
- (declare (unused prop))
- (when value
- (add-window-to-new-group w))))
+ (lambda (w prop value)
+ (declare (unused prop))
+ (when value
+ (add-window-to-new-group w))))
(define-match-window-setter 'unique-name
(lambda (w prop value)
- (declare (unused prop))
+ (declare (unused prop))
(when value
(uniquify-window-name w))))
(define-match-window-setter 'focus-mode
- (lambda (w prop value)
- (declare (unused prop))
- (set-focus-mode w value)))
+ (lambda (w prop value)
+ (declare (unused prop))
+ (set-focus-mode w value)))
(define-match-window-setter 'fullscreen
- (lambda (w prop value)
- (declare (unused prop))
- (when value
- (window-put w 'queued-fullscreen-maximize t))))
+ (lambda (w prop value)
+ (declare (unused prop))
+ (when value
+ (window-put w 'queued-fullscreen-maximize t))))
(define-match-window-setter 'new-workspace
- (lambda (w prop value)
- (declare (unused prop))
- (when value
- (unless (window-get w 'placed)
- (let ((space (car (workspace-limits))))
- (while (not (workspace-empty-p space))
- (setq space (1+ space)))
- (set-window-workspaces w (list space)))))))
+ (lambda (w prop value)
+ (declare (unused prop))
+ (when value
+ (unless (window-get w 'placed)
+ (let ((space (car (workspace-limits))))
+ (while (not (workspace-empty-p space))
+ (setq space (1+ space)))
+ (set-window-workspaces w (list space)))))))
(define-match-window-setter 'new-viewport
(lambda (w prop value)
@@ -462,10 +467,10 @@
(set-window-viewport w col row))))))
(define-match-window-setter 'fullscreen-xinerama
- (lambda (w prop value)
- (declare (unused prop))
- (when value
- (window-put w 'queued-fullxinerama-maximize t))))
+ (lambda (w prop value)
+ (declare (unused prop))
+ (when value
+ (window-put w 'queued-fullxinerama-maximize t))))
(define-match-window-setter 'window-name
(lambda (w prop value)
@@ -474,23 +479,24 @@
(rename-window-func w value))))
(define-match-window-setter 'maximized
- (lambda (w prop value)
- (declare (unused prop))
- (when (memq value '(all vertical))
- (window-put w 'queued-vertical-maximize t))
- (when (memq value '(all horizontal))
- (window-put w 'queued-horizontal-maximize t))))
+ (lambda (w prop value)
+ (declare (unused prop))
+ (when (memq value '(all vertical))
+ (window-put w 'queued-vertical-maximize t))
+ (when (memq value '(all horizontal))
+ (window-put w 'queued-horizontal-maximize t))))
(define-match-window-setter 'keymap-trans
(lambda (w prop value)
- (declare (unused prop))
+ (declare (unused prop))
(let ((keymap (or (window-get w 'keymap)
(window-put w 'keymap (copy-sequence window-keymap)))))
(mapcar
(lambda (pair) ; pair of from and to keys
- (bind-keys keymap (car pair)
- (lambda () (interactive)
- (synthesize-event (lookup-event (cadr pair)) (current-event-window))))) value))))
+ (bind-keys keymap (car pair)
+ (lambda () (interactive)
+ (synthesize-event (lookup-event (cadr pair))
+ (current-event-window))))) value))))
(define (rename-window-func window new-name)
(set-x-text-property window 'WM_NAME (vector new-name))
@@ -499,7 +505,8 @@
(set-x-text-property window '_NET_WM_ICON_NAME (vector new-name)))
(define (rename-window-interactive w)
- (let ((new-name (prompt-for-string "Enter new window title:" (window-name w))))
+ (let ((new-name (prompt-for-string "Enter new window title:"
+ (window-name w))))
(rename-window-func w new-name)))
(define-command 'rename-window rename-window-interactive #:spec "%W"))
diff --git a/lisp/sawfish/wm/ext/old-window-menu.jl b/lisp/sawfish/wm/ext/old-window-menu.jl
index 76b1da1..a738fcf 100644
--- a/lisp/sawfish/wm/ext/old-window-menu.jl
+++ b/lisp/sawfish/wm/ext/old-window-menu.jl
@@ -1,5 +1,4 @@
;; old-window-menu.jl
-;; $Id: old-window-menu.jl,v 1.8 2000/10/09 13:13:41 john Exp $
;; Copyright (C) 1999 John Harper <john dcs warwick ac uk>
diff --git a/lisp/sawfish/wm/ext/shade-hover.jl b/lisp/sawfish/wm/ext/shade-hover.jl
index 49fd95a..586f47f 100644
--- a/lisp/sawfish/wm/ext/shade-hover.jl
+++ b/lisp/sawfish/wm/ext/shade-hover.jl
@@ -1,5 +1,4 @@
;; shade-hover.jl -- temporarily unshade windows while hovered over
-;; $Id: shade-hover.jl,v 1.20 2002/04/21 22:25:13 jsh Exp $
;; Copyright (C) 2000 John Harper <john dcs warwick ac uk>
@@ -19,15 +18,17 @@
;; along with sawfish; see the file COPYING. If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-(define-structure sawfish.wm.ext.shade-hover ()
+(define-structure sawfish.wm.ext.shade-hover
+
+ (export )
(open rep
- rep.system
- rep.io.timers
- sawfish.wm.windows
- sawfish.wm.custom
- sawfish.wm.events
- sawfish.wm.state.shading)
+ rep.system
+ rep.io.timers
+ sawfish.wm.windows
+ sawfish.wm.custom
+ sawfish.wm.events
+ sawfish.wm.state.shading)
(define-structure-alias shade-hover sawfish.wm.ext.shade-hover)
@@ -37,7 +38,8 @@
(defcustom shade-hover-mode nil
"Enable shade-hover mode."
- :tooltip "(Temporarily unshades windows while the mouse pointer is over them.)"
+ :tooltip "(Temporarily unshades windows while the mouse pointer is \
+over them.)"
:group (focus shade-hover)
:type boolean
:require sawfish.wm.ext.shade-hover)
diff --git a/lisp/sawfish/wm/ext/tooltips.jl b/lisp/sawfish/wm/ext/tooltips.jl
index 45a71b0..085b3fb 100644
--- a/lisp/sawfish/wm/ext/tooltips.jl
+++ b/lisp/sawfish/wm/ext/tooltips.jl
@@ -1,5 +1,4 @@
;; tooltips.jl -- display frame-part keymap descriptions
-;; $Id: tooltips.jl,v 1.33 2004/01/06 06:48:02 jsh Exp $
;; Copyright (C) 1999 John Harper <john dcs warwick ac uk>
diff --git a/lisp/sawfish/wm/ext/window-history.jl b/lisp/sawfish/wm/ext/window-history.jl
index 5c71684..893eac4 100644
--- a/lisp/sawfish/wm/ext/window-history.jl
+++ b/lisp/sawfish/wm/ext/window-history.jl
@@ -1,5 +1,4 @@
;; window-history.jl -- store state across window instances
-;; $Id: window-history.jl,v 1.34 2003/02/04 05:43:19 jsh Exp $
;; Copyright (C) 2000 John Harper <john dcs warwick ac uk>
@@ -73,8 +72,9 @@
;; list of states in window-state-change-hook that should be tracked
(defvar window-history-states '(sticky ignored never-focus type maximized
- frame-style cycle-skip window-list-skip))
-
+ frame-style cycle-skip
+ window-list-skip))
+
;; property matched on
(defvar window-history-key-property '(WM_CLASS WM_WINDOW_ROLE))
@@ -254,7 +254,7 @@
;; handle the `position' attribute specially
(let ((position (cdr (assq 'position alist))))
(when position
- ;; we don't want to place two windows of the same class
+ ;; we don't want to place two windows of the same class
;; at the same position, that's just pointless
(when (or (window-get w 'placed)
(catch 'out
diff --git a/lisp/sawfish/wm/ext/workspace-grid.jl b/lisp/sawfish/wm/ext/workspace-grid.jl
index 4f29533..818669e 100644
--- a/lisp/sawfish/wm/ext/workspace-grid.jl
+++ b/lisp/sawfish/wm/ext/workspace-grid.jl
@@ -1,31 +1,28 @@
-#| workspace-grid.jl -- Workspace Grid
-
- $Id$
-
- This file is part of sawfish.
-
- sawfish 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.
-
- sawfish 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 sawfish; see the file COPYING. If not, write to
- the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-
- Author: Michael Toomim <toomim cs berkeley edu>
-|#
+;; workspace-grid.jl -- Workspace Grid
+;;
+;; This file is part of sawfish.
+;;
+;; sawfish 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.
+;;
+;; sawfish 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 sawfish; see the file COPYING. If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;;
+;; Author: Michael Toomim <toomim cs berkeley edu>
;; Commentary:
;; Provides a virtual desktop "grid" abstraction, using workspaces. In
;; effect, this emulates viewports with workspaces
-
+
;; Gets desktop layout information from the _NET_DESKTOP_LAYOUT root
;; property according to a proposed ICWWM EWMH spec. Accounts for bugs
;; in gnome2's implementation.
@@ -99,19 +96,19 @@ number of rows your workspaces are arranged in")
(safe-send-to-workspace
window
(get-workspace-down current-workspace 1)))
-
+
(define (send-to-workspace-up window)
"Send window to the workspace above the current workspace"
(safe-send-to-workspace
window
(get-workspace-up current-workspace 1)))
-
+
(define (send-to-workspace-left window)
"Send window to the workspace left of the current workspace"
(safe-send-to-workspace
window
(get-workspace-left current-workspace 1)))
-
+
(define (send-to-workspace-right window)
"Send window to the workspace right of the current workspace"
(safe-send-to-workspace
@@ -123,7 +120,7 @@ number of rows your workspaces are arranged in")
(define-command 'send-to-workspace-up send-to-workspace-up #:spec "%W")
(define-command 'send-to-workspace-left send-to-workspace-left #:spec "%W")
(define-command 'send-to-workspace-right send-to-workspace-right #:spec "%W")
-
+
;;; Public Procedures
;; The workspace-switcher makes a desktop grid by splitting a sequence of
@@ -157,7 +154,7 @@ pager, or nil of none exists."
(cdr coords))
(cons (car coords)
(+ distance (cdr coords)))))))
-
+
(define (get-workspace-right workspace distance)
"Returns the workspace `distance' squares right of `workspace' in
the pager, or nil of none exists."
@@ -207,7 +204,7 @@ the pager, or nil of none exists."
;; x is always sideways
;; y is always vertical
;; x or y are optional (can be zero)
-
+
;; Bugs in gnome2: x and y are switched, orientation is always
;; horizontal
(if (not layout-property)
@@ -215,7 +212,7 @@ the pager, or nil of none exists."
(let ((cols (aref (caddr layout-property) 1))
(rows (aref (caddr layout-property) 2)))
-
+
;; Since we're translating (x,y) to (cols,rows), swap if values
;; are for a vertical pager,
(when (= (aref (caddr layout-property) 0) 1)
diff --git a/lisp/sawfish/wm/extras.jl b/lisp/sawfish/wm/extras.jl
index 1ac81d3..df7b733 100644
--- a/lisp/sawfish/wm/extras.jl
+++ b/lisp/sawfish/wm/extras.jl
@@ -1,5 +1,4 @@
;; extras.jl -- handle extra functions
-;; $Id: extras.jl,v 1.93 2003/10/21 16:17:59 jsh Exp $
;; Copyright (C) 1999 John Harper <john dcs warwick ac uk>
@@ -24,22 +23,22 @@
;; magic comment to get an alias installed
;; (define-structure-alias sawfish-extras sawfish.wm.extras)
- (defcustom use-custom-font-color '()
- "Use custom font colors for frames"
- :type boolean
- :group appearance
- :after-set (lambda () (update-frame-font-color)))
-
- (defcustom frame-font-active-color "black"
- "Font color for active frames"
- :type color
- :group appearance
- :depends use-custom-font-color
- :after-set (lambda () (update-frame-font-color)))
-
- (defcustom frame-font-inactive-color "black"
- "Font color for inactive frames"
- :type color
- :group appearance
- :depends use-custom-font-color
- :after-set (lambda () (update-frame-font-color)))
+(defcustom use-custom-font-color '()
+ "Use custom font colors for frames"
+ :type boolean
+ :group appearance
+ :after-set (lambda () (update-frame-font-color)))
+
+(defcustom frame-font-active-color "black"
+ "Font color for active frames"
+ :type color
+ :group appearance
+ :depends use-custom-font-color
+ :after-set (lambda () (update-frame-font-color)))
+
+(defcustom frame-font-inactive-color "black"
+ "Font color for inactive frames"
+ :type color
+ :group appearance
+ :depends use-custom-font-color
+ :after-set (lambda () (update-frame-font-color)))
diff --git a/lisp/sawfish/wm/focus.jl b/lisp/sawfish/wm/focus.jl
index c2cacb1..5c6bf03 100644
--- a/lisp/sawfish/wm/focus.jl
+++ b/lisp/sawfish/wm/focus.jl
@@ -1,5 +1,4 @@
;; focus.jl -- implement standard focus behaviour
-;; $Id: focus.jl,v 1.50 2002/04/21 03:39:31 jsh Exp $
;; Copyright (C) 1999 John Harper <john dcs warwick ac uk>
@@ -68,8 +67,8 @@
:group focus)
(define focus-within-click-event (make-fluid nil)
- "When true, the current command is being called from within a
-click-to-focus button press event.")
+ "When true, the current command is being called from within
+a click-to-focus button press event.")
;;; general utilities
@@ -224,7 +223,7 @@ EVENT-NAME)', where EVENT-NAME may be one of the following symbols:
(let ((command (lookup-event-binding event)))
(if command
(let-fluids ((focus-within-click-event t))
- (call-command command))
+ (call-command command))
(require 'sawfish.wm.util.decode-events)
(when (and (or focus-click-through
(window-get w 'focus-click-through)
@@ -235,16 +234,16 @@ EVENT-NAME)', where EVENT-NAME may be one of the following symbols:
;; need to keep the grab for the events that would follow
(allow-events 'replay-pointer)
(forget-button-press)))))
- (unless (eq (input-focus) w)
- (focus-push-map w click-to-focus-map))))
+ (unless (eq (input-focus) w)
+ (focus-push-map w click-to-focus-map))))
(defvar click-to-focus-map
(bind-keys (make-keymap)
- ;; apparently buttons 4 & 5 are usually bound to the
- ;; wheel on some mice
- "Any-Button1-Click1" focus-click
- "Any-Button2-Click1" focus-click
- "Any-Button3-Click1" focus-click))
+ ;; apparently buttons 4 & 5 are usually bound to the
+ ;; wheel on some mice
+ "Any-Button1-Click1" focus-click
+ "Any-Button2-Click1" focus-click
+ "Any-Button3-Click1" focus-click))
(define-focus-mode 'click
(lambda (w action)
@@ -317,7 +316,7 @@ EVENT-NAME)', where EVENT-NAME may be one of the following symbols:
(sm-add-saved-properties 'never-focus 'focus-mode)
-;; bug prevention
+;;; bug prevention
;; XXX Pavel reported this bug (windows becoming unfocusable in
;; XXX click-to-focus mode). I can't see why it happens, hence this
@@ -332,10 +331,10 @@ EVENT-NAME)', where EVENT-NAME may be one of the following symbols:
(not (window-really-wants-input-p w))
(eq (window-get w 'keymap)
click-to-focus-map))
-; (format standard-error
-; "Window lost focus keymap: %s, %s\n"
-; (window-name w) (window-get w 'keymap))
-; (beep) (beep)
+ ;;(format standard-error
+ ;; "Window lost focus keymap: %s, %s\n"
+ ;; (window-name w) (window-get w 'keymap))
+ ;;(beep) (beep)
(focus-push-map w click-to-focus-map))))))
(add-hook 'idle-hook scan-windows-for-bugs))
diff --git a/lisp/sawfish/wm/frames.jl b/lisp/sawfish/wm/frames.jl
index 9c65c2e..98b4596 100644
--- a/lisp/sawfish/wm/frames.jl
+++ b/lisp/sawfish/wm/frames.jl
@@ -1,5 +1,4 @@
;; frames.jl -- handle window framing
-;; $Id: frames.jl,v 1.93 2003/10/21 16:17:59 jsh Exp $
;; Copyright (C) 1999 John Harper <john dcs warwick ac uk>
@@ -156,9 +155,9 @@ that overrides settings set elsewhere.")
(utility . default)
(shaded-utility . shaded-transient)
(toolbar . unframed)
-;; (shaded-toolbar . shaded-utility)
+ ;; (shaded-toolbar . shaded-utility)
(menu . unframed)
-;; (shaded-menu . shaded-utility)
+ ;; (shaded-menu . shaded-utility)
(splash . unframed))
"Frame type fallbacks.")
@@ -167,10 +166,17 @@ that overrides settings set elsewhere.")
(define (update-frame-font-color)
(if use-custom-font-color
(mapc (lambda (fc)
- (set-frame-part-value fc 'foreground (list frame-font-inactive-color frame-font-active-color) 't)) (list 'title 'tab))
+ (set-frame-part-value fc 'foreground
+ (list frame-font-inactive-color
+ frame-font-active-color)
+ 't))
+ (list 'title 'tab))
(mapc (lambda (fc)
- (rplacd (assoc 'foreground (assoc fc override-frame-part-classes)) nil)
- (rplaca (assoc 'foreground (assoc fc override-frame-part-classes)) nil)) (list 'title 'tab)))
+ (rplacd (assoc 'foreground
+ (assoc fc override-frame-part-classes)) nil)
+ (rplaca (assoc 'foreground
+ (assoc fc override-frame-part-classes)) nil))
+ (list 'title 'tab)))
(mapc (lambda (x) (rebuild-frame x)) (managed-windows)))
(defvar theme-update-interval 60
@@ -193,7 +199,7 @@ that overrides settings set elsewhere.")
"List of directories from which themes may be loaded.")
(define frame-styles nil
- "List of (NAME . FUNCTION) defining all loaded frame styles.")
+ "List of (NAME . FUNCTION) defining all loaded frame styles.")
;; List of (NAME FILENAME MODTIME) mapping loaded frame styles to the
;; files they were loaded from; used to check if the theme needs reloading
@@ -203,14 +209,17 @@ that overrides settings set elsewhere.")
(define editable-frame-styles nil)
(define frame-type-mappers '()
- "List of functions that map (WINDOW FRAME-TYPE) -> FRAME-TYPE. Used when
-deciding which frame type to ask a theme to generate.")
+ "List of functions that map (WINDOW FRAME-TYPE) ->
+FRAME-TYPE. Used when deciding which frame type to ask a theme to
+generate.")
;; list of (REGEXP DIR-EXPAND NAME-EXPAND)
(defvar theme-suffix-regexps
- '(("^(.*)/(.*)\\.tar(\\.gz|\\.Z|\\.bz2|\\.xz|\\.lzma|)$" "\\0#tar/\\2" "\\2")))
+ '(("^(.*)/(.*)\\.tar(\\.gz|\\.Z|\\.bz2|\\.xz|\\.lzma|)$"
+ "\\0#tar/\\2" "\\2")))
- (defvar theme-suffixes '("" ".tar" ".tar.gz" ".tar.Z" ".tar.bz2" ".tar.xz" ".tar.lzma"))
+ (defvar theme-suffixes '("" ".tar" ".tar.gz" ".tar.Z" ".tar.bz2"
+ ".tar.xz" ".tar.lzma"))
(defvar themes-are-gaolled t
"When non-nil themes are assumed to be malicious.")
@@ -239,21 +248,23 @@ deciding which frame type to ask a theme to generate.")
;; 1. map window type to actual frame type
(let loop-1 ((rest frame-type-mappers)
(type (window-type w)))
- (if (null rest)
- ;; found the final frame type, so,
- ;; 2. find the closest type that the style implements to this
- (let loop-2 ((type type)
- (seen (list type)))
- (cond ((eq type 'unframed) nil-frame)
- ((style w type))
- (t (let ((next (or (cdr (assq type frame-type-fallback-alist))
- 'unframed)))
- (if (memq next seen)
- ;; been here before..
- nil-frame
- (loop-2 next (cons next seen)))))))
- ;; else, apply this transformation and keep looping
- (loop-1 (cdr rest) ((car rest) w type)))))
+ (if (null rest)
+ ;; found the final frame type, so,
+ ;; 2. find the closest type that the style implements to this
+ (let loop-2 ((type type)
+ (seen (list type)))
+ (cond ((eq type 'unframed) nil-frame)
+ ((style w type))
+ (t (let ((next (or
+ (cdr (assq type
+ frame-type-fallback-alist))
+ 'unframed)))
+ (if (memq next seen)
+ ;; been here before..
+ nil-frame
+ (loop-2 next (cons next seen)))))))
+ ;; else, apply this transformation and keep looping
+ (loop-1 (cdr rest) ((car rest) w type)))))
;;; managing frame styles
@@ -493,7 +504,7 @@ deciding which frame type to ask a theme to generate.")
(gaol-load (expand-file-name "theme.jl" dir) gaol)
(define-gaol-structure (intern (concat "themes."
(symbol-name name)))
- gaol))
+ gaol))
(load (expand-file-name "theme" dir) nil t))))))
(define (find-all-frame-styles #!optional sorted)
@@ -641,9 +652,9 @@ deciding which frame type to ask a theme to generate.")
(define-frame-class x `((cursor . ,(cursor-for-frame-part x))
(keymap . border-keymap))))
'(top-border bottom-border
- left-border right-border
- top-left-corner top-right-corner
- bottom-left-corner bottom-right-corner))
+ left-border right-border
+ top-left-corner top-right-corner
+ bottom-left-corner bottom-right-corner))
(gaol-add add-frame-style reframe-window rebuild-frames-with-style
reframe-windows-with-style reframe-all-windows window-type
diff --git a/lisp/sawfish/wm/gaol.jl b/lisp/sawfish/wm/gaol.jl
index 9f0e95b..731ed98 100644
--- a/lisp/sawfish/wm/gaol.jl
+++ b/lisp/sawfish/wm/gaol.jl
@@ -1,25 +1,22 @@
-#| gaol.jl -- protected environment for themes
-
- $Id: gaol.jl,v 1.35 2002/11/03 04:23:45 jsh Exp $
-
- Copyright (C) 1999, 2000 John Harper <john dcs warwick ac uk>
-
- This file is part of sawfish.
-
- sawfish 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.
-
- sawfish 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 sawfish; see the file COPYING. If not, write to
- the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-|#
+;; gaol.jl -- protected environment for themes
+;;
+;; Copyright (C) 1999, 2000 John Harper <john dcs warwick ac uk>
+;;
+;; This file is part of sawfish.
+;;
+;; sawfish 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.
+;;
+;; sawfish 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 sawfish; see the file COPYING. If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
(define-structure sawfish.wm.gaol
@@ -43,20 +40,21 @@
;; safe functions in the core module
(define safe-functions
- '(get-color-rgb get-color color-name color-rgb colorp get-cursor
- cursorp get-font get-font-typed font-type-exists-p font-name
- fontp font-type text-width font-height font-ascent font-descent
- screen-width screen-height get-x-property get-x-text-property
+ '(get-color-rgb get-color color-name color-rgb colorp
+ get-cursor cursorp get-font get-font-typed
+ font-type-exists-p font-name fontp font-type text-width
+ font-height font-ascent font-descent screen-width
+ screen-height get-x-property get-x-text-property
list-x-properties x-atom x-atom-name make-image
make-image-from-x-drawable copy-image
flip-image-horizontally flip-image-vertically
- flip-image-diagonally image-get
- image-put imagep image-dimensions image-border set-image-border
+ flip-image-diagonally image-get image-put imagep
+ image-dimensions image-border set-image-border
image-shape-color set-image-shape-color image-modifier
set-image-modifier make-sized-image bevel-image clear-image
tile-image scale-image composite-images crop-image
- make-keymap bind-keys unbind-keys keymapp eventp
- image-ref image-set image-map image-fill color-rgb-8 uniquify-list))
+ make-keymap bind-keys unbind-keys keymapp eventp image-ref
+ image-set image-map image-fill color-rgb-8 uniquify-list))
(define safe-specials
'(default-foreground display-name canonical-display-name
@@ -105,15 +103,20 @@
;; a plugin, so easier to do this here..
(call-after-load "sawfish.wm.util.x"
- (lambda ()
- (require 'sawfish.wm.util.x)
- (mapc (lambda (x) (gaol-define x (symbol-value x)))
- '(x-create-gc x-change-gc x-destroy-gc x-gc-p
- x-create-pixmap x-create-bitmap x-change-window-attributes
- x-window-p x-destroy-drawable x-drawable-p
- x-pixmap-p x-bitmap-p x-drawable-id x-drawable-width
- x-drawable-height x-window-id x-window-back-buffer
- x-window-swap-buffers x-clear-window x-draw-string
- x-draw-line x-draw-rectangle x-fill-rectangle
- x-draw-arc x-fill-arc x-fill-polygon x-copy-area
- x-draw-image x-grab-image-from-drawable x-gc-set-dashes)))))
+ (lambda ()
+ (require 'sawfish.wm.util.x)
+ (mapc (lambda (x) (gaol-define x (symbol-value x)))
+ '(x-create-gc x-change-gc x-destroy-gc x-gc-p
+ x-create-pixmap x-create-bitmap
+ x-change-window-attributes x-window-p
+ x-destroy-drawable x-drawable-p
+ x-pixmap-p x-bitmap-p x-drawable-id
+ x-drawable-width x-drawable-height
+ x-window-id x-window-back-buffer
+ x-window-swap-buffers x-clear-window
+ x-draw-string x-draw-line
+ x-draw-rectangle x-fill-rectangle
+ x-draw-arc x-fill-arc x-fill-polygon
+ x-copy-area x-draw-image
+ x-grab-image-from-drawable
+ x-gc-set-dashes)))))
diff --git a/lisp/sawfish/wm/integration/gnome.jl b/lisp/sawfish/wm/integration/gnome.jl
index 55eaa0d..606e557 100644
--- a/lisp/sawfish/wm/integration/gnome.jl
+++ b/lisp/sawfish/wm/integration/gnome.jl
@@ -1,5 +1,4 @@
;; gnome-int.jl -- more GNOME integration
-;; $Id: integration.jl,v 1.20 2003/08/14 06:55:36 jsh Exp $
;; Copyright (C) 2000 John Harper <john dcs warwick ac uk>
@@ -19,13 +18,15 @@
;; along with sawfish; see the file COPYING. If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-(define-structure sawfish.wm.integration.gnome ()
+(define-structure sawfish.wm.integration.gnome
+
+ (export )
(open rep
- sawfish.wm.menus
- sawfish.wm.custom
- sawfish.wm.commands
- sawfish.wm.commands.user)
+ sawfish.wm.menus
+ sawfish.wm.custom
+ sawfish.wm.commands
+ sawfish.wm.commands.user)
(define-structure-alias gnome-int sawfish.wm.integration.gnome)
@@ -49,5 +50,7 @@
(let ((menu (assoc (_ "Sessi_on") root-menu)))
(when menu
(nconc menu `(()
- (,(_ "_Logout from GNOME") (system "gnome-session-save --logout-dialog &"))
- (,(_ "_Shutdown from GNOME") (system "gnome-session-save --shutdown-dialog &")))))))
+ (,(_ "_Logout from GNOME")
+ (system "gnome-session-save --logout-dialog &"))
+ (,(_ "_Shutdown from GNOME")
+ (system "gnome-session-save --shutdown-dialog &")))))))
diff --git a/lisp/sawfish/wm/integration/kde.jl b/lisp/sawfish/wm/integration/kde.jl
index 54dc1bd..1af6bb6 100644
--- a/lisp/sawfish/wm/integration/kde.jl
+++ b/lisp/sawfish/wm/integration/kde.jl
@@ -1,5 +1,4 @@
;; kde-int.jl -- more KDE integration
-;; $Id: integration.jl,v 1.20 2003/08/14 06:55:36 jsh Exp $
;; Copyright (C) 2000 John Harper <john dcs warwick ac uk>
@@ -19,13 +18,15 @@
;; along with sawfish; see the file COPYING. If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-(define-structure sawfish.wm.integration.kde ()
+(define-structure sawfish.wm.integration.kde
+
+ (export )
(open rep
- sawfish.wm.menus
- sawfish.wm.custom
- sawfish.wm.commands
- sawfish.wm.commands.user)
+ sawfish.wm.menus
+ sawfish.wm.custom
+ sawfish.wm.commands
+ sawfish.wm.commands.user)
(define-structure-alias kde-int sawfish.wm.integration.kde)
@@ -43,12 +44,15 @@
(nconc menu `(()
(,(_ "_KDE Help") (system "khelpcenter &"))
(,(_ "KDE Website") (browser "http://www.kde.org";))))))
- ;(,(_ "About KDE") (system "false &"))))))
;; add kde-logout menu item
- (let ((menu (assoc (_ "Sessi_on") root-menu)))
+ (let ((menu (assoc (_ "Sessi_on") root-menu))
+ (kde-logout-cmd "qdbus org.kde.ksmserver /KSMServer org.kde.KSMServerInterface.logout"))
(when menu
(nconc menu `(()
- (,(_ "_Logout from KDE") (system "qdbus org.kde.ksmserver /KSMServer org.kde.KSMServerInterface.logout 1 0 -1 &"))
- (,(_ "_Reboot from KDE") (system "qdbus org.kde.ksmserver /KSMServer org.kde.KSMServerInterface.logout 1 1 -1 &"))
- (,(_ "_Shutdown from KDE") (system "qdbus org.kde.ksmserver /KSMServer org.kde.KSMServerInterface.logout 1 2 -1 &")))))))
+ (,(_ "_Logout from KDE")
+ (system ,(concat kde-logout-cmd " 1 0 -1 &")))
+ (,(_ "_Reboot from KDE")
+ (system ,(concat kde-logout-cmd " 1 1 -1 &")))
+ (,(_ "_Shutdown from KDE")
+ (system ,(concat kde-logout-cmd " 1 2 -1 &"))))))))
diff --git a/lisp/sawfish/wm/keymaps.jl b/lisp/sawfish/wm/keymaps.jl
index 25e761b..1b1c0f7 100644
--- a/lisp/sawfish/wm/keymaps.jl
+++ b/lisp/sawfish/wm/keymaps.jl
@@ -1,5 +1,4 @@
;; keymaps.jl -- the default keymaps
-;; $Id: keymaps.jl,v 1.55 2003/01/12 20:30:50 jsh Exp $
;; Copyright (C) 1999 John Harper <john dcs warwick ac uk>
@@ -101,7 +100,7 @@
"W-Button2-Click1" 'popup-window-menu
"W-Button1-Move" 'move-window-interactively
"Button1-Click1" 'raise-and-pass-through-click
- "W-ISO_Left_Tab" 'tab-raise-left-window
+ "W-ISO_Left_Tab" 'tab-raise-left-window
"H-ISO_Left_Tab" 'tab-raise-right-window)
"Keymap containing bindings active when a client window is focused."
:group bindings
@@ -196,7 +195,7 @@ of a window. (Only mouse-bindings are evaluated in this map.)"
(define (keymap-add-window w)
(unless (window-get w 'keymap)
(window-put w 'keymap window-keymap)))
-
+
(add-hook 'add-window-hook keymap-add-window)
;; custom support for modifiers
diff --git a/lisp/sawfish/wm/menus.jl b/lisp/sawfish/wm/menus.jl
index 21d4a0d..ae145e0 100644
--- a/lisp/sawfish/wm/menus.jl
+++ b/lisp/sawfish/wm/menus.jl
@@ -1,5 +1,4 @@
;; menus.jl -- popup menus
-;; $Id: menus.jl,v 1.76 2005/02/07 00:12:18 jsh Exp $
;; Copyright (C) 1999 John Harper <john dcs warwick ac uk>
@@ -109,24 +108,24 @@ before killing it.")
(,(_ "Ne_xt workspace") copy-to-next-workspace))
(,(_ "_Grow & Pack")
(,(_ "Grow left") grow-window-left)
- (,(_ "Grow right") grow-window-right)
- (,(_ "Grow up") grow-window-up)
- (,(_ "Grow down") grow-window-down)
- ()
- (,(_ "Pack left") pack-window-left)
- (,(_ "Pack right") pack-window-right)
- (,(_ "Pack up") pack-window-up)
- (,(_ "Pack down") pack-window-down))
+ (,(_ "Grow right") grow-window-right)
+ (,(_ "Grow up") grow-window-up)
+ (,(_ "Grow down") grow-window-down)
+ ()
+ (,(_ "Pack left") pack-window-left)
+ (,(_ "Pack right") pack-window-right)
+ (,(_ "Pack up") pack-window-up)
+ (,(_ "Pack down") pack-window-down))
(,(_ "Shrink & _Yank")
(,(_ "Shrink left") shrink-window-left)
- (,(_ "Shrink right") shrink-window-right)
- (,(_ "Shrink up") shrink-window-up)
- (,(_ "Shrink down") shrink-window-down)
- ()
- (,(_ "Yank left") yank-window-left)
- (,(_ "Yank right") yank-window-right)
- (,(_ "Yank up") yank-window-up)
- (,(_ "Yank down") yank-window-down))
+ (,(_ "Shrink right") shrink-window-right)
+ (,(_ "Shrink up") shrink-window-up)
+ (,(_ "Shrink down") shrink-window-down)
+ ()
+ (,(_ "Yank left") yank-window-left)
+ (,(_ "Yank right") yank-window-right)
+ (,(_ "Yank up") yank-window-up)
+ (,(_ "Yank down") yank-window-down))
(,(_ "Stac_king")
(,(_ "_Raise") raise-window)
(,(_ "_Lower") lower-window)
@@ -165,7 +164,7 @@ before killing it.")
(,(_ "Kill Window") (system "xkill &"))))
(defvar apps-menu)
-
+
(define (menu-start-process)
(when menu-timer
(delete-timer menu-timer)
@@ -269,7 +268,7 @@ before killing it.")
(require 'sawfish.wm.util.keymap)
(make-memoizing-where-is
(list global-keymap window-keymap)))))
- (inner cell)))
+ (inner cell)))
(define (menu-dispatch result)
(let ((orig-win menu-active))
@@ -333,15 +332,15 @@ before killing it.")
;; avoid large numbers of system calls :-[
(format nil "%S" (mapcar menu-preprocessor spec))
(x-server-timestamp) offset))
- (error
- ;; prevents spurious errors with subsequent menus
- (setq menu-active nil)
- (apply signal error-data))))))
+ (error
+ ;; prevents spurious errors with subsequent menus
+ (setq menu-active nil)
+ (apply signal error-data))))))
(define (popup-window-menu w)
"Display the menu listing all window operations."
(let-fluids ((menu-args (list w)))
- (popup-menu window-ops-menu)))
+ (popup-menu window-ops-menu)))
(define (popup-root-menu)
"Display the main menu."
@@ -361,14 +360,14 @@ before killing it.")
(define (add-window-menu-toggle label command #!optional predicate)
(let ((item (list* label command
(and predicate (list (cons 'check predicate))))))
- (let loop ((rest window-ops-toggle-menu))
- (cond
- ((null rest)
- (setq window-ops-toggle-menu (nconc window-ops-toggle-menu
- (list item))))
- ((eq (cadar rest) command)
- (rplaca rest item))
- (t (loop (cdr rest)))))))
+ (let loop ((rest window-ops-toggle-menu))
+ (cond
+ ((null rest)
+ (setq window-ops-toggle-menu (nconc window-ops-toggle-menu
+ (list item))))
+ ((eq (cadar rest) command)
+ (rplaca rest item))
+ (t (loop (cdr rest)))))))
;;; customize menu
diff --git a/lisp/sawfish/wm/misc.jl b/lisp/sawfish/wm/misc.jl
index a6718db..e247438 100644
--- a/lisp/sawfish/wm/misc.jl
+++ b/lisp/sawfish/wm/misc.jl
@@ -1,25 +1,22 @@
-#| sawfish.wm.misc bootstrap
-
- $Id: misc.jl,v 1.12 2002/10/04 06:33:23 jsh Exp $
-
- Copyright (C) 1999 John Harper <john dcs warwick ac uk>
-
- This file is part of sawfish.
-
- sawfish 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.
-
- sawfish 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 sawfish; see the file COPYING. If not, write to
- the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-|#
+;; sawfish.wm.misc bootstrap
+;;
+;; Copyright (C) 1999 John Harper <john dcs warwick ac uk>
+;;
+;; This file is part of sawfish.
+;;
+;; sawfish 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.
+;;
+;; sawfish 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 sawfish; see the file COPYING. If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
(declare (in-module sawfish.wm.misc))
@@ -45,20 +42,20 @@
server is currently grabbed, ungrab it first, restoring the original grab
status after the call to THUNK returns."
(let loop ((counter 0))
- (if (server-grabbed-p)
- (progn
- (ungrab-server)
- (loop (1+ counter)))
- (unwind-protect
- (thunk)
- (do ((i 0 (1+ i)))
- ((= i counter))
- (grab-server))))))
+ (if (server-grabbed-p)
+ (progn
+ (ungrab-server)
+ (loop (1+ counter)))
+ (unwind-protect
+ (thunk)
+ (do ((i 0 (1+ i)))
+ ((= i counter))
+ (grab-server))))))
(define grab-counter 0)
(define (call-with-keyboard-grabbed thunk)
-"Call the zero-parameter function THUNK with the keyboard grabbed. If unable
+ "Call the zero-parameter function THUNK with the keyboard grabbed. If unable
to grab the keyboard then THUNK won't be called."
(when (grab-keyboard)
(unwind-protect
@@ -86,10 +83,10 @@ to grab the keyboard then THUNK won't be called."
"Search for a file called FILENAME in any of the directories named by the
list of strings DIRS."
(let loop ((rest dirs))
- (cond ((null rest) nil)
- ((file-exists-p (expand-file-name filename (car rest)))
- (expand-file-name filename (car rest)))
- (t (loop (cdr rest))))))
+ (cond ((null rest) nil)
+ ((file-exists-p (expand-file-name filename (car rest)))
+ (expand-file-name filename (car rest)))
+ (t (loop (cdr rest))))))
(define (clamp x lower upper)
(cond ((< x lower) lower)
@@ -181,13 +178,13 @@ vector of strings representing the contents of the property."
(let loop ((start 0)
(point 0)
(out '()))
- (cond ((= point (length string))
- (apply vector (nreverse (cons (substring
- string start point) out))))
- ((= (aref string point) 0)
- (loop (1+ point) (1+ point)
- (cons (substring string start point) out)))
- (t (loop start (1+ point) out))))))))
+ (cond ((= point (length string))
+ (apply vector (nreverse (cons (substring
+ string start point) out))))
+ ((= (aref string point) 0)
+ (loop (1+ point) (1+ point)
+ (cons (substring string start point) out)))
+ (t (loop start (1+ point) out))))))))
(define (set-x-text-property w prop seq #!optional (encoding 'STRING))
"Set the X property named PROP on window W to the text property obtained
@@ -196,11 +193,12 @@ by concatenating the sequence of strings SEQ."
;; exports
-(export-bindings '(with-server-grabbed call-with-server-ungrabbed
- call-with-keyboard-grabbed call-with-error-handler
- make-directory-recursively locate-file
- clamp clamp* uniquify-list screen-dimensions
- pointer-head current-head current-head-dimensions
- current-head-offset load-module eval-in
- user-eval user-require quote-menu-item
- get-x-text-property set-x-text-property))
+(export-bindings
+ '(with-server-grabbed call-with-server-ungrabbed
+ call-with-keyboard-grabbed call-with-error-handler
+ make-directory-recursively locate-file
+ clamp clamp* uniquify-list screen-dimensions
+ pointer-head current-head current-head-dimensions
+ current-head-offset load-module eval-in
+ user-eval user-require quote-menu-item
+ get-x-text-property set-x-text-property))
diff --git a/lisp/sawfish/wm/placement.jl b/lisp/sawfish/wm/placement.jl
index 271756e..a7f4ac4 100644
--- a/lisp/sawfish/wm/placement.jl
+++ b/lisp/sawfish/wm/placement.jl
@@ -1,5 +1,4 @@
;; place-window.jl -- decide where to initially place a window
-;; $Id: placement.jl,v 1.55 2003/01/12 20:48:36 jsh Exp $
;; Copyright (C) 1999 John Harper <john dcs warwick ac uk>
@@ -188,7 +187,8 @@ this mode. The single argument is the window to be placed."
(let ((dims (window-frame-dimensions w))
(pdims (window-frame-dimensions parent))
(coords (window-position parent))
- (screen (calculate-workarea #:window w #:head (current-head parent))))
+ (screen (calculate-workarea #:window w
+ #:head (current-head parent))))
(rplaca coords (clamp* (+ (car coords)
(quotient (- (car pdims) (car dims)) 2))
(car dims) (nth 0 screen) (nth 2 screen)))
@@ -207,9 +207,15 @@ this mode. The single argument is the window to be placed."
(cdr dims) (nth 1 screen) (nth 3 screen)))
(move-window-to w (car coords) (cdr coords))))
- (define-placement-mode 'randomly place-window-randomly #:for-normal t #:for-dialogs t)
- (define-placement-mode 'interactively place-window-interactively #:for-normal t #:for-dialogs t)
- (define-placement-mode 'centered place-window-centered #:for-normal t #:for-dialogs t)
- (define-placement-mode 'centered-on-parent place-window-centered-on-parent #:for-normal t #:for-dialogs t)
- (define-placement-mode 'under-pointer place-window-under-pointer #:for-normal t #:for-dialogs t)
- (define-placement-mode 'none nop #:for-normal t #:for-dialogs t))
+ (define-placement-mode 'randomly place-window-randomly
+ #:for-normal t #:for-dialogs t)
+ (define-placement-mode 'interactively place-window-interactively
+ #:for-normal t #:for-dialogs t)
+ (define-placement-mode 'centered place-window-centered
+ #:for-normal t #:for-dialogs t)
+ (define-placement-mode 'centered-on-parent place-window-centered-on-parent
+ #:for-normal t #:for-dialogs t)
+ (define-placement-mode 'under-pointer place-window-under-pointer
+ #:for-normal t #:for-dialogs t)
+ (define-placement-mode 'none nop
+ #:for-normal t #:for-dialogs t))
diff --git a/lisp/sawfish/wm/placement/off-center.jl b/lisp/sawfish/wm/placement/off-center.jl
index 4679c00..877d82e 100644
--- a/lisp/sawfish/wm/placement/off-center.jl
+++ b/lisp/sawfish/wm/placement/off-center.jl
@@ -1,27 +1,24 @@
-#| off-center.jl -- place windows around the centre of the screen
-
- Copyright (C) 2000 Eazel, Inc.
-
- This file is part of sawfish.
-
- sawfish 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.
-
- sawfish 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 sawfish; see the file COPYING. If not, write to
- the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-
- $Id: off-center.jl,v 1.3 2002/04/24 06:57:02 jsh Exp $
-
- Authors: John Harper <jsh eazel com>
-|#
+;; off-center.jl -- place windows around the centre of the screen
+;;
+;; Copyright (C) 2000 Eazel, Inc.
+;;
+;; This file is part of sawfish.
+;;
+;; sawfish 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.
+;;
+;; sawfish 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 sawfish; see the file COPYING. If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;;
+;; Authors: John Harper <jsh eazel com>
;; Commentary:
@@ -33,7 +30,9 @@
;; created one after the other, so that the user is sure to see (at
;; least part of) both windows
-(define-structure sawfish.wm.placement.off-center ()
+(define-structure sawfish.wm.placement.off-center
+
+ (export )
(open rep
sawfish.wm.misc
diff --git a/lisp/sawfish/wm/placement/smart.jl b/lisp/sawfish/wm/placement/smart.jl
index 6199c5e..ed6ad2f 100644
--- a/lisp/sawfish/wm/placement/smart.jl
+++ b/lisp/sawfish/wm/placement/smart.jl
@@ -1,5 +1,4 @@
;; smart-placement.jl -- ``intelligent'' window placement
-;; $Id: smart.jl,v 1.50 2002/07/01 03:07:18 jsh Exp $
;; Copyright (C) 1999 John Harper <john dcs warwick ac uk>
@@ -21,7 +20,7 @@
;; Commentary:
-;; This implements two different algorithms: first-fit and best-fit.
+;; This implements two different algorithms: first-fit and best-fit.
;; Both use the same inner core -- they scan for the position to place
;; the window where it overlaps the smallest area with other windows
@@ -66,7 +65,8 @@
(defvar sp-normal-windows-weight 1)
(defvar sp-padding 0
- "Try to leave at least this many pixels between window edges in first/best-fit.")
+ "Try to leave at least this many pixels between window edges in
+first/best-fit.")
;; the maximum number of points to keep in each grid dimension
(defvar sp-max-points 10)
@@ -117,7 +117,7 @@
points))
(setq total (1+ total)))))
points))
-
+
;; returns the list of windows to compare with when overlapping, by
;; default windows with their `ignored' property set are dropped
(define (sp-get-windows w #!optional pred)
@@ -302,8 +302,8 @@ the proposed placement to the center of the screen."
(defvar sp-cost-components (list (cons sp-cost:overlap 7/8)
(cons sp-cost:center-locality 1/8))
- "Alist defining smart placement cost functions and their associated weights
-(multipliers).")
+ "Alist defining smart placement cost functions and their
+associated weights (multipliers).")
;; This is the crux of the problem -- this function must assign a value
;; to placing a window of DIMS at POINT. GRID defines the grid from which
@@ -355,7 +355,8 @@ the proposed placement to the center of the screen."
;;; entry-points
- (define (sp-do-placement w fit-fun #!optional fall-back-fun #!key window-filter)
+ (define (sp-do-placement w fit-fun #!optional fall-back-fun
+ #!key window-filter)
(if (and sp-max-queued-events (> (x-events-queued) sp-max-queued-events))
;; fitted placement can cause event tailbacks when there's
;; lots of windows being opened with lots of windows already
@@ -410,12 +411,14 @@ the proposed placement to the center of the screen."
(define (place-window-first-fit-or-interactive w)
(sp-do-placement w sp-fit-or-nil (placement-mode 'interactively)))
-
+
;;; init
;;###autoload
(define-placement-mode 'first-fit place-window-first-fit #:for-normal t)
(define-placement-mode 'best-fit place-window-best-fit #:for-normal t)
- (define-placement-mode 'best-fit-group place-window-best-fit-group #:for-normal t)
- (define-placement-mode 'first-fit-or-interactive place-window-first-fit-or-interactive #:for-normal t))
+ (define-placement-mode 'best-fit-group
+ place-window-best-fit-group #:for-normal t)
+ (define-placement-mode 'first-fit-or-interactive
+ place-window-first-fit-or-interactive #:for-normal t))
diff --git a/lisp/sawfish/wm/placement/stagger.jl b/lisp/sawfish/wm/placement/stagger.jl
index 7eb7a09..9c43d46 100644
--- a/lisp/sawfish/wm/placement/stagger.jl
+++ b/lisp/sawfish/wm/placement/stagger.jl
@@ -1,7 +1,5 @@
;; stagger-placement.jl -- for jwz
-;; $Id: stagger.jl,v 1.3 2002/05/27 05:18:56 jsh Exp $
-
;; Copyright (C) 2000 John Harper <john dcs warwick ac uk>
;; This file is part of sawfish.
@@ -20,15 +18,17 @@
;; along with sawfish; see the file COPYING. If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-(define-structure sawfish.wm.placement.stagger ()
+(define-structure sawfish.wm.placement.stagger
+
+ (export )
(open rep
- sawfish.wm.windows
- sawfish.wm.misc
- sawfish.wm.events
- sawfish.wm.placement
- sawfish.wm.custom
- sawfish.wm.util.workarea)
+ sawfish.wm.windows
+ sawfish.wm.misc
+ sawfish.wm.events
+ sawfish.wm.placement
+ sawfish.wm.custom
+ sawfish.wm.util.workarea)
(defcustom stagger-placement-step 32
"Distance between successive placements in `stagger' placement mode."
diff --git a/lisp/sawfish/wm/placement/top-left.jl b/lisp/sawfish/wm/placement/top-left.jl
index 11ae0a3..deb1d17 100644
--- a/lisp/sawfish/wm/placement/top-left.jl
+++ b/lisp/sawfish/wm/placement/top-left.jl
@@ -1,27 +1,24 @@
-#| top-left.jl -- place windows on the diagonal from the top-left corner
-
- Copyright (C) 2000 Eazel, Inc.
-
- This file is part of sawfish.
-
- sawfish 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.
-
- sawfish 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 sawfish; see the file COPYING. If not, write to
- the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-
- $Id: top-left.jl,v 1.6 2002/04/24 06:57:03 jsh Exp $
-
- Authors: John Harper <jsh eazel com>
-|#
+;; top-left.jl -- place windows on the diagonal from the top-left corner
+;;
+;; Copyright (C) 2000 Eazel, Inc.
+;;
+;; This file is part of sawfish.
+;;
+;; sawfish 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.
+;;
+;; sawfish 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 sawfish; see the file COPYING. If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;;
+;; Authors: John Harper <jsh eazel com>
;; Commentary:
@@ -41,7 +38,9 @@
;; (note, for `screen' above, I actually mean the work-area, i.e. the
;; area not reserved for special windows, e.g. the panel)
-(define-structure sawfish.wm.placement.top-left ()
+(define-structure sawfish.wm.placement.top-left
+
+ (export )
(open rep
sawfish.wm.windows
diff --git a/lisp/sawfish/wm/server.jl b/lisp/sawfish/wm/server.jl
index bb49692..f6c9aa7 100644
--- a/lisp/sawfish/wm/server.jl
+++ b/lisp/sawfish/wm/server.jl
@@ -1,5 +1,4 @@
;; server.jl -- execute forms on demand
-;; $Id: server.jl,v 1.13 2000/09/11 07:44:42 john Exp $
;; Copyright (C) 1999 John Harper <john dcs warwick ac uk>
diff --git a/lisp/sawfish/wm/session/init.jl b/lisp/sawfish/wm/session/init.jl
index 0f42f0e..4d124ae 100644
--- a/lisp/sawfish/wm/session/init.jl
+++ b/lisp/sawfish/wm/session/init.jl
@@ -1,5 +1,4 @@
;; sm-init.jl -- session manager code loaded on startup
-;; $Id: init.jl,v 1.21 2003/08/15 08:09:30 jsh Exp $
;; Copyright (C) 1999 John Harper <john dcs warwick ac uk>
@@ -38,10 +37,10 @@
sawfish.wm.session.util)
(define sm-client-id nil
- "A string identifying the current session.")
+ "A string identifying the current session.")
(define sm-prefix nil
- "A string used to uniquify the session file.")
+ "A string used to uniquify the session file.")
;; this is before both the panel and gmc..?
(defconst sm-gsm-priority 30)
@@ -113,7 +112,7 @@ that feature off, allowing some broken clients to be session managed.")
(define (make-unique-prefix) (number->string (current-utime) 36))
-;; callback
+ ;; callback
(define (sm-save-yourself)
(require 'sawfish.wm.session.save)
@@ -144,14 +143,15 @@ that feature off, allowing some broken clients to be session managed.")
(define (remove-sm-options)
;; remove any sm options from saved-command-line-args
(let loop ((args saved-command-line-args))
- (when (cdr args)
- (if (string-match "^(--sm-client-id|-clientId|--sm-prefix)" (cadr args))
- (progn
- (if (string-match "=" (cadr args))
- (rplacd args (cddr args))
- (rplacd args (cdddr args)))
- (loop args))
- (loop (cdr args))))))
+ (when (cdr args)
+ (if (string-match "^(--sm-client-id|-clientId|--sm-prefix)"
+ (cadr args))
+ (progn
+ (if (string-match "=" (cadr args))
+ (rplacd args (cddr args))
+ (rplacd args (cdddr args)))
+ (loop args))
+ (loop (cdr args))))))
(define (set-discard-command)
(sm-set-property
diff --git a/lisp/sawfish/wm/session/load.jl b/lisp/sawfish/wm/session/load.jl
index 433f737..041491d 100644
--- a/lisp/sawfish/wm/session/load.jl
+++ b/lisp/sawfish/wm/session/load.jl
@@ -1,5 +1,4 @@
;; sm-load.jl -- session manager code to reload a saved session
-;; $Id: load.jl,v 1.12 2002/11/04 03:35:39 jsh Exp $
;; Copyright (C) 1999 John Harper <john dcs warwick ac uk>
@@ -98,7 +97,7 @@
;; no WM_WINDOW_ROLE, so try matching WM_CLASS
(when (and class (cdr (assq 'class alist))
(not (string= class (cdr (assq 'class alist)))))
- (throw 'out nil))
+ (throw 'out nil))
;; no WM_CLASS, so try matching WM_NAME
(when (and name (cdr (assq 'name alist))
(not (string= name (cdr (assq 'name alist)))))
diff --git a/lisp/sawfish/wm/session/save.jl b/lisp/sawfish/wm/session/save.jl
index 0050dc0..166dcc1 100644
--- a/lisp/sawfish/wm/session/save.jl
+++ b/lisp/sawfish/wm/session/save.jl
@@ -1,5 +1,4 @@
;; sm-save.jl -- session manager code to save the current session
-;; $Id: save.jl,v 1.10 2001/01/29 01:34:37 jsh Exp $
;; Copyright (C) 1999 John Harper <john dcs warwick ac uk>
@@ -74,6 +73,7 @@
sawfish-version (current-time-string))
(map-windows (lambda (w)
(and (not (desktop-window-p w))
- (sm-print-alist file (sm-get-window-state w)))))
+ (sm-print-alist file
+ (sm-get-window-state w)))))
t)
(close-file file))))))
diff --git a/lisp/sawfish/wm/stacking.jl b/lisp/sawfish/wm/stacking.jl
index 015ffe7..50dc4fe 100644
--- a/lisp/sawfish/wm/stacking.jl
+++ b/lisp/sawfish/wm/stacking.jl
@@ -1,5 +1,4 @@
;; stacking.jl -- window stacking
-;; $Id: stacking.jl,v 1.59 2002/10/18 06:46:16 jsh Exp $
;; Copyright (C) 1999 John Harper <john dcs warwick ac uk>
@@ -48,7 +47,7 @@
sawfish.wm.custom
sawfish.wm.session.init
sawfish.wm.workspace
- sawfish.wm.state.transient
+ sawfish.wm.state.transient
sawfish.wm.util.rects)
;; Each window will have a `depth' property--an integer, zero
@@ -95,20 +94,20 @@
(> (window-depth x) w-depth)) parents))
(setq children (delete-if (lambda (x)
(< (window-depth x) w-depth)) children)))
-
+
(lambda (above below)
(and (or (null parents)
;; All parents must be below W
(let loop ((rest parents))
- (cond ((null rest) t)
- ((memq (car rest) above) nil)
- (t (loop (cdr rest))))))
+ (cond ((null rest) t)
+ ((memq (car rest) above) nil)
+ (t (loop (cdr rest))))))
(or (null children)
;; All children must be above W
(let loop ((rest children))
- (cond ((null rest) t)
- ((memq (car rest) below) nil)
- (t (loop (cdr rest))))))))))
+ (cond ((null rest) t)
+ ((memq (car rest) below) nil)
+ (t (loop (cdr rest))))))))))
(define (stacking-constraint:transients-above-all w)
(let ((w-depth (window-depth w)))
@@ -118,27 +117,27 @@
(lambda (above below)
(declare (unused below))
(let loop ((rest above))
- (cond ((null rest) t)
- ((and (not (window-transient-p (car rest)))
- (<= (window-depth (car rest)) w-depth)) nil)
- (t (loop (cdr rest))))))
+ (cond ((null rest) t)
+ ((and (not (window-transient-p (car rest)))
+ (<= (window-depth (car rest)) w-depth)) nil)
+ (t (loop (cdr rest))))))
;; ensure no transients below W, unless they're depth < W
(lambda (above below)
(declare (unused above))
(let loop ((rest below))
- (cond ((null rest) t)
- ((and (window-transient-p (car rest))
- (>= (window-depth (car rest)) w-depth)) nil)
- (t (loop (cdr rest)))))))))
+ (cond ((null rest) t)
+ ((and (window-transient-p (car rest))
+ (>= (window-depth (car rest)) w-depth)) nil)
+ (t (loop (cdr rest)))))))))
(define (combine-constraints constraints)
"Combine the list of secondary constraint functions into a single
function (using logical `and' combinator)."
(lambda (above below)
(let loop ((rest constraints))
- (cond ((null rest) t)
- ((not ((car rest) above below)) nil)
- (t (loop (cdr rest)))))))
+ (cond ((null rest) t)
+ ((not ((car rest) above below)) nil)
+ (t (loop (cdr rest)))))))
(defvar basic-stacking-constraints (list stacking-constraint:layer)
"List of stacking constraint functions to adhere to (excluding transient
@@ -171,14 +170,14 @@ reverse order), and the list of windows occurring in LST after PIVOT.
LST is destructively modified by this procedure."
(let loop ((rest lst)
(before '()))
- (cond ((null rest)
- (cons before rest))
- ((eq (car rest) pivot)
- (cons before (cdr rest)))
- (t
- (let ((next (cdr rest)))
- (rplacd rest before)
- (loop next rest))))))
+ (cond ((null rest)
+ (cons before rest))
+ ((eq (car rest) pivot)
+ (cons before (cdr rest)))
+ (t
+ (let ((next (cdr rest)))
+ (rplacd rest before)
+ (loop next rest))))))
(define (stack-rotate-upwards cell)
"Given a cons cell containing two lists of windows `(ABOVE . BELOW)',
@@ -265,16 +264,16 @@ distinction, window-obscured should be faster."
(let ((constraint (make-constraint w))
(stack (cons '() (delq w (stacking-order)))))
(let loop ()
- (cond ((constraint (car stack) (cdr stack))
- (if (car stack)
- (x-lower-window w (car (car stack)))
- (x-raise-window w (car (cdr stack)))))
- ((null (cdr stack))
- ;; no position
- nil)
- (t
- (stack-rotate-downwards stack)
- (loop))))))
+ (cond ((constraint (car stack) (cdr stack))
+ (if (car stack)
+ (x-lower-window w (car (car stack)))
+ (x-raise-window w (car (cdr stack)))))
+ ((null (cdr stack))
+ ;; no position
+ nil)
+ (t
+ (stack-rotate-downwards stack)
+ (loop))))))
(define (lower-window w)
"Lower the window to its lowest allowed position in the stacking order."
@@ -282,17 +281,17 @@ distinction, window-obscured should be faster."
(stack (cons (nreverse (delq w (stacking-order))) '())))
;; work upwards from bottom
(let loop ()
- (cond ((constraint (car stack) (cdr stack))
- ;; found the lowest position
- (if (cdr stack)
- (x-raise-window w (car (cdr stack)))
- (x-lower-window w (car (car stack)))))
- ((null (car stack))
- ;; no possible position..
- nil)
- (t
- (stack-rotate-upwards stack)
- (loop))))))
+ (cond ((constraint (car stack) (cdr stack))
+ ;; found the lowest position
+ (if (cdr stack)
+ (x-raise-window w (car (cdr stack)))
+ (x-lower-window w (car (car stack)))))
+ ((null (car stack))
+ ;; no possible position..
+ nil)
+ (t
+ (stack-rotate-upwards stack)
+ (loop))))))
(define (stack-window-above above below)
"Change the stacking of window ABOVE so that it is as closely above window
@@ -302,17 +301,17 @@ BELOW as possible."
(delq above (stacking-order)) below)))
(rplacd stack (cons below (cdr stack)))
(let loop ()
- (cond ((constraint (car stack) (cdr stack))
- ;; found a suitable position
- (if (car stack)
- (x-lower-window above (car (car stack)))
- (x-raise-window above (car (cdr stack)))))
- ((null (car stack))
- ;; reached the top
- nil)
- (t
- (stack-rotate-upwards stack)
- (loop))))))
+ (cond ((constraint (car stack) (cdr stack))
+ ;; found a suitable position
+ (if (car stack)
+ (x-lower-window above (car (car stack)))
+ (x-raise-window above (car (cdr stack)))))
+ ((null (car stack))
+ ;; reached the top
+ nil)
+ (t
+ (stack-rotate-upwards stack)
+ (loop))))))
(define (stack-window-below below above)
"Change the stacking of window BELOW so that it is as closely below window
@@ -322,16 +321,16 @@ ABOVE as possible."
(delq below (stacking-order)) above)))
(rplaca stack (cons above (car stack)))
(let loop ()
- (cond ((constraint (car stack) (cdr stack))
- (if (cdr stack)
- (x-raise-window below (car (cdr stack)))
- (x-lower-window below (car (car stack)))))
- ((null (cdr stack))
- ;; reached the bottom
- nil)
- (t
- (stack-rotate-downwards stack)
- (loop))))))
+ (cond ((constraint (car stack) (cdr stack))
+ (if (cdr stack)
+ (x-raise-window below (car (cdr stack)))
+ (x-lower-window below (car (car stack)))))
+ ((null (cdr stack))
+ ;; reached the bottom
+ nil)
+ (t
+ (stack-rotate-downwards stack)
+ (loop))))))
(define (restack-window w)
"Assuming that the current stacking order is in a consistent state
@@ -366,7 +365,8 @@ order they are stacked within the layer (top to bottom)."
(call-window-hook 'window-state-change-hook w (list '(stacking)))))
(define (window-on-top-p w)
- "Return t if window W is as high as it can legally go in the stacking order."
+ "Return t if window W is as high as it can legally go in the
+stacking order."
(let* ((constraint (make-constraint w))
(order (delete-if-not
;; XXX doesn't handle viewports..
@@ -378,12 +378,12 @@ order they are stacked within the layer (top to bottom)."
(old-posn (- (length order) (length (memq w order))))
(stack (cons '() (delq w order))))
(let loop ()
- (if (or (constraint (car stack) (cdr stack))
- (null (cdr stack)))
- ;; found highest position
- (= (length (car stack)) old-posn)
- (stack-rotate-downwards stack)
- (loop)))))
+ (if (or (constraint (car stack) (cdr stack))
+ (null (cdr stack)))
+ ;; found highest position
+ (= (length (car stack)) old-posn)
+ (stack-rotate-downwards stack)
+ (loop)))))
(define (raise-lower-window w)
"If the window is at its highest possible position, then lower it to its
@@ -429,26 +429,26 @@ lowest possible position. Otherwise raise it as far as allowed."
;; must be a valid stacking configuration (highest-to-lowest). Do
;; the restacking in such a way that no part of any window in
;; ORDER is exposed during the restacking that is not exposed
- ;; afterwards.
+ ;; afterwards.
(define (highest-window order)
- ;; find the first window in ORDER that is allowed
+ ;; find the first window in ORDER that is allowed
;; to be above all other windows in ORDER...
(let loop ((rest order))
- (cond ((null rest) nil)
- (((make-constraint (car rest)) '() (remq (car rest) order))
- (car rest))
- (t (loop (cdr rest))))))
+ (cond ((null rest) nil)
+ (((make-constraint (car rest)) '() (remq (car rest) order))
+ (car rest))
+ (t (loop (cdr rest))))))
;; Cons up the new order (in reverse), by picking the most-raisable
;; each time until no windows are left, then commit that ordering
(let loop ((rest (cons w (remq w order)))
(out '()))
- (if (null rest)
- (apply-group-order (nreverse out) raise-window stack-window-below)
- (let ((highest (or (highest-window rest)
- (error "Stacking constraint failed"))))
- (loop (delq highest rest) (cons highest out))))))
+ (if (null rest)
+ (apply-group-order (nreverse out) raise-window stack-window-below)
+ (let ((highest (or (highest-window rest)
+ (error "Stacking constraint failed"))))
+ (loop (delq highest rest) (cons highest out))))))
(define (lower-windows w order)
@@ -457,28 +457,28 @@ lowest possible position. Otherwise raise it as far as allowed."
;; windows in ORDER
(let ((reversed (reverse order)))
(let loop ((rest reversed))
- (cond ((null rest) nil)
- (((make-constraint (car rest))
- (remq (car rest) reversed) '()) (car rest))
- (t (loop (cdr rest)))))))
+ (cond ((null rest) nil)
+ (((make-constraint (car rest))
+ (remq (car rest) reversed) '()) (car rest))
+ (t (loop (cdr rest)))))))
(let loop ((rest (nconc (remq w order) (list w)))
(out '()))
- (if (null rest)
- (apply-group-order (nreverse out) lower-window stack-window-above)
- (let ((lowest (or (lowest-window rest)
- (error "Stacking constraint failed"))))
- (loop (delq lowest rest) (cons lowest out))))))
+ (if (null rest)
+ (apply-group-order (nreverse out) lower-window stack-window-above)
+ (let ((lowest (or (lowest-window rest)
+ (error "Stacking constraint failed"))))
+ (loop (delq lowest rest) (cons lowest out))))))
(define (raise-lower-windows w order)
(if (or (not (window-obscured w))
(and (window-on-top-p (car order))
;; look for the group as a block.. this is a heuristic
(let loop ((rest (memq (car order) (stacking-order))))
- (cond ((null rest) nil)
- ((eq (car rest) w) t)
- ((memq (car rest) order) (loop (cdr rest)))
- (t nil)))))
+ (cond ((null rest) nil)
+ ((eq (car rest) w) t)
+ ((memq (car rest) order) (loop (cdr rest)))
+ (t nil)))))
(lower-windows w order)
(raise-windows w order)))
diff --git a/lisp/sawfish/wm/state/configure.jl b/lisp/sawfish/wm/state/configure.jl
index ac16d63..9243164 100644
--- a/lisp/sawfish/wm/state/configure.jl
+++ b/lisp/sawfish/wm/state/configure.jl
@@ -1,5 +1,4 @@
;; configure.jl -- default configure-request handler
-;; $Id: configure.jl,v 1.25 2002/09/29 22:11:33 jsh Exp $
;; Copyright (C) 2000 John Harper <john dcs warwick ac uk>
@@ -73,7 +72,7 @@
((windows-intersect-p w (car wins)) t)
(t (iter (cdr below) (cdr wins)))))))
(iter below-w sorted-wlist)))
-
+
(defun configure-request-handler (w alist)
(let ((coords (window-position w))
(dims (window-dimensions w))
diff --git a/lisp/sawfish/wm/state/iconify.jl b/lisp/sawfish/wm/state/iconify.jl
index 2541ea9..69278fb 100644
--- a/lisp/sawfish/wm/state/iconify.jl
+++ b/lisp/sawfish/wm/state/iconify.jl
@@ -1,5 +1,4 @@
;; iconify.jl -- handling window state
-;; $Id: iconify.jl,v 1.33 2002/04/21 22:25:15 jsh Exp $
;; Copyright (C) 1999 John Harper <john dcs warwick ac uk>
@@ -52,7 +51,7 @@
sawfish.wm.commands.groups
sawfish.wm.state.transient
sawfish.wm.menus)
-
+
;; Commentary:
;; Iconification (but without icons)
@@ -207,13 +206,13 @@
(make-window-sticky/workspace w #:no-hooks t)
(make-window-sticky/viewport w #:no-hooks t)
(emit-sticky-hook w)))
-
+
(define (make-window-unsticky w)
(when (window-sticky-p w)
(make-window-unsticky/workspace w #:no-hooks t)
(make-window-unsticky/viewport w #:no-hooks t)
(emit-sticky-hook w)))
-
+
(define (toggle-window-sticky w)
"Toggle the `stickiness' of the window--whether or not it is a member of
all workspaces."
diff --git a/lisp/sawfish/wm/state/ignored.jl b/lisp/sawfish/wm/state/ignored.jl
index 78a26d7..7df0bab 100644
--- a/lisp/sawfish/wm/state/ignored.jl
+++ b/lisp/sawfish/wm/state/ignored.jl
@@ -1,5 +1,4 @@
;; ignore-window.jl -- controlling the ignored property
-;; $Id: ignored.jl,v 1.13 2003/02/20 07:29:10 jsh Exp $
;; Copyright (C) 1999 John Harper <john dcs warwick ac uk>
@@ -88,13 +87,20 @@
(window-put w 'task-list-skip (not (window-get w 'task-list-skip)))
(call-window-hook 'window-state-change-hook w (list '(task-list-skip))))
- (define-command 'make-window-ignored make-window-ignored #:spec "%W")
- (define-command 'make-window-not-ignored make-window-not-ignored #:spec "%W")
- (define-command 'toggle-window-ignored toggle-window-ignored #:spec "%W")
- (define-command 'toggle-window-never-focus toggle-window-never-focus #:spec "%W")
- (define-command 'toggle-window-cycle-skip toggle-window-cycle-skip #:spec "%W")
- (define-command 'toggle-window-list-skip toggle-window-list-skip #:spec "%W")
- (define-command 'toggle-task-list-skip toggle-task-list-skip #:spec "%W")
+ (define-command 'make-window-ignored
+ make-window-ignored #:spec "%W")
+ (define-command 'make-window-not-ignored
+ make-window-not-ignored #:spec "%W")
+ (define-command 'toggle-window-ignored
+ toggle-window-ignored #:spec "%W")
+ (define-command 'toggle-window-never-focus
+ toggle-window-never-focus #:spec "%W")
+ (define-command 'toggle-window-cycle-skip
+ toggle-window-cycle-skip #:spec "%W")
+ (define-command 'toggle-window-list-skip
+ toggle-window-list-skip #:spec "%W")
+ (define-command 'toggle-task-list-skip
+ toggle-task-list-skip #:spec "%W")
(add-window-menu-toggle (_ "_Ignored") 'toggle-window-ignored
window-ignored-p)
@@ -105,5 +111,5 @@
(add-window-menu-toggle (_ "In _window list") 'toggle-window-list-skip
(lambda (w) (not (window-get w 'window-list-skip))))
(add-window-menu-toggle (_ "In _task list") 'toggle-task-list-skip
- (lambda (w) (not (window-get w 'task-list-skip)))))
+ (lambda (w) (not (window-get w 'task-list-skip)))))
diff --git a/lisp/sawfish/wm/state/maximize.jl b/lisp/sawfish/wm/state/maximize.jl
index 0695ade..2c89973 100644
--- a/lisp/sawfish/wm/state/maximize.jl
+++ b/lisp/sawfish/wm/state/maximize.jl
@@ -1,5 +1,4 @@
;; maximize.jl -- window maximization
-;; $Id: maximize.jl,v 1.67 2002/09/23 07:33:17 jsh Exp $
;; Copyright (C) 1999 John Harper <john dcs warwick ac uk>
@@ -74,7 +73,8 @@
(define-structure-alias maximize sawfish.wm.state.maximize)
(defvar maximize-always-expands nil
- "Maximizing a window in one dimension must increase the size of that dimension.")
+ "Maximizing a window in one dimension must increase the size of
+that dimension.")
(defvar maximize-raises t
"Raise windows when they are maximized.")
@@ -89,7 +89,7 @@
"Lock position and size while windows are maximized."
:type boolean
:group min-max)
-
+
;; called when a window is maximized, args (W #!optional DIRECTION)
(defvar window-maximized-hook nil)
@@ -295,7 +295,7 @@
(y-inc (or (cdr (assq 'height-inc hints)) 1))
(x-max (cdr (assq 'max-width hints)))
(y-max (cdr (assq 'max-height hints)))
-
+
(trunc (lambda (x inc base #!optional maximum)
(min (+ base (max 0 (- (- x base) (mod (- x base) inc))))
(or maximum 65535)))))
@@ -329,7 +329,7 @@
((top-border bottom-border) (not v-maximized))
((left-border right-border) (not h-maximized))
((top-left-corner top-right-corner
- bottom-left-corner bottom-right-corner title)
+ bottom-left-corner bottom-right-corner title)
(not (and h-maximized v-maximized)))))))
;;; commands
@@ -391,18 +391,19 @@
(car dims) (cdr dims)))))
(define (unmaximize-window w #!optional direction)
- "Restore the dimensions of the window to its original, unmaximized, state."
+ "Restore the dimensions of the window to its original,
+unmaximized, state."
(unmaximize-window-1 w direction
- (lambda ()
- (when (memq direction '(() fullscreen horizontal))
- (window-put w 'maximized-horizontally nil))
- (when (memq direction '(() fullscreen vertical))
- (window-put w 'maximized-vertically nil))
- (window-put w 'maximized-fullscreen nil)
- (when (and (not (window-maximized-vertically-p w))
- (not (window-maximized-horizontally-p w))
- (not (window-maximized-fullscreen-p w)))
- (discard-unmaximized-geometry w))))
+ (lambda ()
+ (when (memq direction '(() fullscreen horizontal))
+ (window-put w 'maximized-horizontally nil))
+ (when (memq direction '(() fullscreen vertical))
+ (window-put w 'maximized-vertically nil))
+ (window-put w 'maximized-fullscreen nil)
+ (when (and (not (window-maximized-vertically-p w))
+ (not (window-maximized-horizontally-p w))
+ (not (window-maximized-fullscreen-p w)))
+ (discard-unmaximized-geometry w))))
(warp-pointer-if-necessary w)
(call-window-hook 'window-unmaximized-hook w (list direction))
(call-window-hook 'window-state-change-hook w (list '(maximized))))
@@ -436,13 +437,20 @@ unmaximized."
(maximize-window w 'horizontal)))
;;###autoload
- (define-command 'maximize-window maximize-window #:spec "%W")
- (define-command 'unmaximize-window unmaximize-window #:spec "%W")
- (define-command 'maximize-window-vertically maximize-window-vertically #:spec "%W")
- (define-command 'maximize-window-horizontally maximize-window-horizontally #:spec "%W")
- (define-command 'maximize-window-toggle maximize-window-toggle #:spec "%W")
- (define-command 'maximize-window-horizontally-toggle maximize-window-horizontally-toggle #:spec "%W")
- (define-command 'maximize-window-vertically-toggle maximize-window-vertically-toggle #:spec "%W")
+ (define-command 'maximize-window
+ maximize-window #:spec "%W")
+ (define-command 'unmaximize-window
+ unmaximize-window #:spec "%W")
+ (define-command 'maximize-window-vertically
+ maximize-window-vertically #:spec "%W")
+ (define-command 'maximize-window-horizontally
+ maximize-window-horizontally #:spec "%W")
+ (define-command 'maximize-window-toggle
+ maximize-window-toggle #:spec "%W")
+ (define-command 'maximize-window-horizontally-toggle
+ maximize-window-horizontally-toggle #:spec "%W")
+ (define-command 'maximize-window-vertically-toggle
+ maximize-window-vertically-toggle #:spec "%W")
;;; fill commands
@@ -490,22 +498,31 @@ unmaximized."
(maximize-window w))
;;###autoload
- (define-command 'maximize-fill-window maximize-fill-window #:spec "%W")
- (define-command 'maximize-fill-window-vertically maximize-fill-window-vertically #:spec "%W")
- (define-command 'maximize-fill-window-horizontally maximize-fill-window-horizontally #:spec "%W")
- (define-command 'maximize-fill-window-toggle maximize-fill-window-toggle #:spec "%W")
- (define-command 'maximize-fill-window-horizontally-toggle maximize-fill-window-horizontally-toggle #:spec "%W")
- (define-command 'maximize-fill-window-vertically-toggle maximize-fill-window-vertically-toggle #:spec "%W")
- (define-command 'maximize-unframe maximize-unframe #:spec "%W")
- (define-command 'maximize-reframe maximize-reframe #:spec "%W")
-
-;; fullscreen commands
+ (define-command 'maximize-fill-window
+ maximize-fill-window #:spec "%W")
+ (define-command 'maximize-fill-window-vertically
+ maximize-fill-window-vertically #:spec "%W")
+ (define-command 'maximize-fill-window-horizontally
+ maximize-fill-window-horizontally #:spec "%W")
+ (define-command 'maximize-fill-window-toggle
+ maximize-fill-window-toggle #:spec "%W")
+ (define-command 'maximize-fill-window-horizontally-toggle
+ maximize-fill-window-horizontally-toggle #:spec "%W")
+ (define-command 'maximize-fill-window-vertically-toggle
+ maximize-fill-window-vertically-toggle #:spec "%W")
+ (define-command 'maximize-unframe
+ maximize-unframe #:spec "%W")
+ (define-command 'maximize-reframe
+ maximize-reframe #:spec "%W")
+
+ ;; fullscreen commands
(define (maximize-window-fullscreen w state)
"Fullscreen maximize the window."
(cond ((and state (not (window-maximized-fullscreen-p w)))
(when (window-maximizable-p w)
- (let ((head-offset (current-head-offset w)) (head-dims (current-head-dimensions w)))
+ (let ((head-offset (current-head-offset w))
+ (head-dims (current-head-dimensions w)))
(save-unmaximized-geometry w)
(window-put w 'unmaximized-type (window-type w))
(push-window-type w 'unframed 'sawfish.wm.state.maximize)
@@ -524,7 +541,8 @@ unmaximized."
(unmaximize-window w 'fullscreen))))
(define (maximize-window-fullscreen-toggle w)
- "Toggle the state of the window between fullscreen maximized and unmaximized."
+ "Toggle the state of the window between fullscreen maximized and
+unmaximized."
(maximize-window-fullscreen w (not (window-maximized-fullscreen-p w))))
(define-command 'maximize-window-fullscreen
@@ -540,7 +558,9 @@ unmaximized."
(save-unmaximized-geometry w)
(window-put w 'unmaximized-type (window-type w))
(push-window-type w 'unframed 'sawfish.wm.state.maximize)
- (move-resize-window-to w 0 0 (car screen-dims) (cdr screen-dims))
+ (move-resize-window-to w 0 0
+ (car screen-dims)
+ (cdr screen-dims))
(raise-window* w)
(window-put w 'maximized-fullscreen t)
(window-put w 'maximized-vertically t)
@@ -554,7 +574,8 @@ unmaximized."
(unmaximize-window w 'fullscreen))))
(define (maximize-window-fullxinerama-toggle w)
- "Toggle the state of the window between fullscreen maximized across all Xinerama and unmaximized."
+ "Toggle the state of the window between fullscreen maximized
+across all Xinerama and unmaximized."
(maximize-window-fullxinerama w (not (window-maximized-fullscreen-p w))))
(define-command 'maximize-window-fullxinerama
@@ -578,12 +599,12 @@ unmaximized."
(window-put w 'queued-fullscreen-maximize nil))
(when fullxinerama
(window-put w 'queued-fullxinerama-maximize nil))
- (cond
- (full
- (maximize-window-fullscreen w t))
- (fullxinerama
- (maximize-window-fullxinerama w t))
- (t
+ (cond
+ (full
+ (maximize-window-fullscreen w t))
+ (fullxinerama
+ (maximize-window-fullxinerama w t))
+ (t
(maximize-window w (cond ((and vert horiz) nil)
(vert 'vertical)
(horiz 'horizontal))))))))
diff --git a/lisp/sawfish/wm/state/mwm.jl b/lisp/sawfish/wm/state/mwm.jl
index 8944a76..d6121c4 100644
--- a/lisp/sawfish/wm/state/mwm.jl
+++ b/lisp/sawfish/wm/state/mwm.jl
@@ -1,5 +1,4 @@
;; mwm.jl -- handle some of the Motif hints
-;; $Id: mwm.jl,v 1.8 2000/11/16 23:05:30 jsh Exp $
;; Copyright (C) 1999 John Harper <john dcs warwick ac uk>
@@ -36,13 +35,15 @@
;; For the moment I'll just have to mash the window hints into the four
;; available window types: default, shaped, transient, shaped-transient
-(define-structure sawfish.wm.state.mwm ()
+(define-structure sawfish.wm.state.mwm
+
+ (export )
(open rep
- rep.system
- sawfish.wm.windows
- sawfish.wm.misc
- sawfish.wm.frames)
+ rep.system
+ sawfish.wm.windows
+ sawfish.wm.misc
+ sawfish.wm.frames)
;;; Hint definitions
diff --git a/lisp/sawfish/wm/state/open-look.jl b/lisp/sawfish/wm/state/open-look.jl
index fc0fafd..4a59a56 100644
--- a/lisp/sawfish/wm/state/open-look.jl
+++ b/lisp/sawfish/wm/state/open-look.jl
@@ -1,5 +1,4 @@
;; open-look.jl -- handle some ol hints
-;; $Id: open-look.jl,v 1.7 2000/09/08 15:14:01 john Exp $
;; Copyright (C) 1999 John Harper <john dcs warwick ac uk>
@@ -24,13 +23,15 @@
;; This suffers from the same limitations as the Motif hints. See
;; mwm.jl for more details
-(define-structure sawfish.wm.state.open-look ()
+(define-structure sawfish.wm.state.open-look
+
+ (export )
(open rep
- rep.system
- sawfish.wm.windows
- sawfish.wm.misc
- sawfish.wm.frames)
+ rep.system
+ sawfish.wm.windows
+ sawfish.wm.misc
+ sawfish.wm.frames)
(define (ol-add-window w)
(let* ((type (window-type w))
diff --git a/lisp/sawfish/wm/state/shading.jl b/lisp/sawfish/wm/state/shading.jl
index 6f71365..9053e6a 100644
--- a/lisp/sawfish/wm/state/shading.jl
+++ b/lisp/sawfish/wm/state/shading.jl
@@ -1,5 +1,4 @@
;; shading.jl -- window ``shading''
-;; $Id: shading.jl,v 1.24 2003/10/21 16:17:59 jsh Exp $
;; Copyright (C) 1999 John Harper <john dcs warwick ac uk>
diff --git a/lisp/sawfish/wm/state/transient.jl b/lisp/sawfish/wm/state/transient.jl
index d308d4e..3946e12 100644
--- a/lisp/sawfish/wm/state/transient.jl
+++ b/lisp/sawfish/wm/state/transient.jl
@@ -1,5 +1,4 @@
;; transient.jl -- support transient windows
-;; $Id: transient.jl,v 1.63 2002/04/27 19:31:25 jsh Exp $
;; Copyright (C) 1999 John Harper <john dcs warwick ac uk>
@@ -37,7 +36,7 @@
sawfish.wm.events
sawfish.wm.custom
sawfish.wm.commands
- sawfish.wm.focus
+ sawfish.wm.focus
sawfish.wm.windows
sawfish.wm.stacking
sawfish.wm.viewport
@@ -71,17 +70,18 @@
(eql (window-group-id x) (window-group-id y)))))))
(define (indirect-transient-of-p x y #!key allow-root)
- "Return t if window X is (directly, or indirectly) a transient for window Y."
+ "Return t if window X is (directly, or indirectly) a transient for
+window Y."
(let loop ((x x))
- (or (transient-of-p x y #:allow-root allow-root)
- (let ((x-for (window-transient-p x)))
- (and x-for
- ;; Some KDE windows set WM_TRANSIENT_FOR to their own id!
- (not (eql x-for (window-id x)))
- (let ((x-for-w (get-window-by-id x-for)))
- (if x-for-w
- (loop x-for-w)
- nil)))))))
+ (or (transient-of-p x y #:allow-root allow-root)
+ (let ((x-for (window-transient-p x)))
+ (and x-for
+ ;; Some KDE windows set WM_TRANSIENT_FOR to their own id!
+ (not (eql x-for (window-id x)))
+ (let ((x-for-w (get-window-by-id x-for)))
+ (if x-for-w
+ (loop x-for-w)
+ nil)))))))
(define (transient-parents w #!optional indirectly)
"Return the list of windows that window W is a transient for."
diff --git a/lisp/sawfish/wm/state/wm-spec.jl b/lisp/sawfish/wm/state/wm-spec.jl
index 50b9776..3ed1853 100644
--- a/lisp/sawfish/wm/state/wm-spec.jl
+++ b/lisp/sawfish/wm/state/wm-spec.jl
@@ -1,7 +1,5 @@
;; wm-spec.jl -- implement the new (GNOME/KDE) wm hints spec
-;; $Id: wm-spec.jl,v 1.49 2005/07/01 16:04:50 jsh Exp $
-
;; Copyright (C) 1999, 2000 John Harper <john dcs warwick ac uk>
;; This file is part of sawfish.
@@ -124,7 +122,7 @@
_NET_WM_WINDOW_TYPE_UTILITY
_NET_WM_WINDOW_TYPE_SPLASH
_NET_WM_USER_TIME])
-
+
(defvar wm-spec-below-depth -2)
(defvar wm-spec-above-depth +2)
@@ -136,18 +134,18 @@
(define (set-prop lst prop)
(let loop ((rest lst)
(collected '()))
- (cond ((null rest)
- (set-x-property 'root prop
- (apply vector (nreverse collected))
- 'WINDOW 32))
- ((window-mapped-p (car rest))
- (loop (cdr rest) (cons (window-id (car rest)) collected)))
- (t (loop (cdr rest) collected)))))
+ (cond ((null rest)
+ (set-x-property 'root prop
+ (apply vector (nreverse collected))
+ 'WINDOW 32))
+ ((window-mapped-p (car rest))
+ (loop (cdr rest) (cons (window-id (car rest)) collected)))
+ (t (loop (cdr rest) collected)))))
(unless only-stacking-list
(set-prop (managed-windows) '_NET_CLIENT_LIST))
(set-prop (nreverse (stacking-order)) '_NET_CLIENT_LIST_STACKING))
-;; setting the desktop / viewport hints
+ ;; setting the desktop / viewport hints
(define last-workspace nil)
(define last-workspace-count 0)
@@ -210,12 +208,12 @@
(unless (equal last-area port)
(let ((view (make-vector (* total-workspaces 2))))
(let loop ((i 0))
- (if (= i total-workspaces)
- (set-x-property 'root '_NET_DESKTOP_VIEWPORT
- view 'CARDINAL 32)
- (aset view (* i 2) (* (car port) (screen-width)))
- (aset view (1+ (* i 2)) (* (cdr port) (screen-height)))
- (loop (1+ i))))))
+ (if (= i total-workspaces)
+ (set-x-property 'root '_NET_DESKTOP_VIEWPORT
+ view 'CARDINAL 32)
+ (aset view (* i 2) (* (car port) (screen-width)))
+ (aset view (1+ (* i 2)) (* (cdr port) (screen-height)))
+ (loop (1+ i))))))
;; _NET_WORKAREA
(unless (equal last-workarea workarea)
@@ -240,7 +238,7 @@
(aset workarea (+ (* i 4) 1) (nth 1 area))
(aset workarea (+ (* i 4) 2) (- (nth 2 area) (nth 0 area)))
(aset workarea (+ (* i 4) 3) (- (nth 3 area) (nth 1 area)))))
-
+
;; apparently some pagers don't like it if we place windows
;; on (temporarily) non-existent workspaces
(when (< last-workspace-count total-workspaces)
@@ -284,7 +282,7 @@
(when (and strut (eq (nth 0 strut) 'CARDINAL))
(let ((data (nth 2 strut)))
(define-window-strut w (aref data 0) (aref data 2)
- (aref data 1) (aref data 3))))))
+ (aref data 1) (aref data 3))))))
(define (honour-client-state w)
(let ((space (get-x-property w '_NET_WM_DESKTOP)))
@@ -301,10 +299,10 @@
;; _NET_WM_WINDOW_TYPE is a vector of atoms, the first atom
;; about which we know something is the type we'll use
(let loop ((i 0))
- (cond ((= i (length type)))
- ((get (aref type i) 'wm-spec-type)
- ((get (aref type i) 'wm-spec-type) w))
- (t (loop (1+ i)))))))
+ (cond ((= i (length type)))
+ ((get (aref type i) 'wm-spec-type)
+ ((get (aref type i) 'wm-spec-type) w))
+ (t (loop (1+ i)))))))
(let ((state (get-x-property w '_NET_WM_STATE)))
(when state
@@ -318,9 +316,9 @@
(let ((geom (get-x-property w '_NET_WM_ICON_GEOMETRY)))
(when geom
(update-icon-geometry w (nth 2 geom))))
- (when (equal (get-x-property w '_NET_WM_USER_TIME)
- '(CARDINAL 32 #(0)))
- (window-put w 'inhibit-focus-when-mapped t)))
+ (when (equal (get-x-property w '_NET_WM_USER_TIME)
+ '(CARDINAL 32 #(0)))
+ (window-put w 'inhibit-focus-when-mapped t)))
;;; helper functions
@@ -345,48 +343,48 @@
(fun w mode))))
(define-wm-spec-window-type '_NET_WM_WINDOW_TYPE_DESKTOP
- (lambda (w)
- (mark-window-as-desktop w)))
+ (lambda (w)
+ (mark-window-as-desktop w)))
(define-wm-spec-window-type '_NET_WM_WINDOW_TYPE_DOCK
- (lambda (w)
- (mark-window-as-dock w)))
+ (lambda (w)
+ (mark-window-as-dock w)))
(define-wm-spec-window-type '_NET_WM_WINDOW_TYPE_DIALOG
- (lambda (w)
- (mark-window-as-transient w)))
+ (lambda (w)
+ (mark-window-as-transient w)))
(define-wm-spec-window-type '_NET_WM_WINDOW_TYPE_UTILITY
- (lambda (w)
- (require 'sawfish.wm.frames)
- (set-window-type w 'utility)))
+ (lambda (w)
+ (require 'sawfish.wm.frames)
+ (set-window-type w 'utility)))
(define-wm-spec-window-type '_NET_WM_WINDOW_TYPE_TOOLBAR
- (lambda (w)
- (require 'sawfish.wm.frames)
- (set-window-type w 'toolbar)))
+ (lambda (w)
+ (require 'sawfish.wm.frames)
+ (set-window-type w 'toolbar)))
(define-wm-spec-window-type '_NET_WM_WINDOW_TYPE_MENU
- (lambda (w)
- (require 'sawfish.wm.frames)
- (set-window-type w 'menu)))
+ (lambda (w)
+ (require 'sawfish.wm.frames)
+ (set-window-type w 'menu)))
(define-wm-spec-window-type '_NET_WM_WINDOW_TYPE_SPLASH
- (lambda (w)
- (require 'sawfish.wm.frames)
- (set-window-type w 'splash)
- (window-put w 'place-mode 'centered)))
+ (lambda (w)
+ (require 'sawfish.wm.frames)
+ (set-window-type w 'splash)
+ (window-put w 'place-mode 'centered)))
(define-wm-spec-window-state '_NET_WM_STATE_STICKY
- (lambda (w mode)
- (case mode
- ((init) (window-put w 'sticky-viewport t))
- ((remove) (make-window-unsticky/viewport w))
- ((add) (make-window-sticky/viewport w))
- ((toggle) (if (window-sticky-p/viewport w)
- (make-window-unsticky/viewport w)
- (make-window-sticky/viewport w)))
- ((get) (window-sticky-p/viewport w)))))
+ (lambda (w mode)
+ (case mode
+ ((init) (window-put w 'sticky-viewport t))
+ ((remove) (make-window-unsticky/viewport w))
+ ((add) (make-window-sticky/viewport w))
+ ((toggle) (if (window-sticky-p/viewport w)
+ (make-window-unsticky/viewport w)
+ (make-window-sticky/viewport w)))
+ ((get) (window-sticky-p/viewport w)))))
(define (wm-spec-maximize-handler direction)
(lambda (w mode)
@@ -407,49 +405,49 @@
(t (window-maximized-p w))))))))
(define-wm-spec-window-state '_NET_WM_STATE_MAXIMIZED_VERT
- (wm-spec-maximize-handler 'vertical))
+ (wm-spec-maximize-handler 'vertical))
(define-wm-spec-window-state '_NET_WM_STATE_MAXIMIZED_HORZ
- (wm-spec-maximize-handler 'horizontal))
+ (wm-spec-maximize-handler 'horizontal))
(define-wm-spec-window-state '_NET_WM_STATE_MAXIMIZED
- (wm-spec-maximize-handler nil)
- #:pseudo t)
+ (wm-spec-maximize-handler nil)
+ #:pseudo t)
(define-wm-spec-window-state '_NET_WM_STATE_SHADED
- (lambda (w mode)
- (require 'sawfish.wm.state.shading)
- (case mode
- ((init) (window-put w 'shaded t))
- ((add) (shade-window w))
- ((remove) (unshade-window w))
- ((toggle) (toggle-window-shaded w))
- ((get) (window-get w 'shaded)))))
+ (lambda (w mode)
+ (require 'sawfish.wm.state.shading)
+ (case mode
+ ((init) (window-put w 'shaded t))
+ ((add) (shade-window w))
+ ((remove) (unshade-window w))
+ ((toggle) (toggle-window-shaded w))
+ ((get) (window-get w 'shaded)))))
(define-wm-spec-window-state '_NET_WM_STATE_SKIP_PAGER
- (lambda (w mode)
- (case mode
- ((init add) (window-put w 'window-list-skip t))
- ((remove) (window-put w 'window-list-skip nil))
- ((toggle) (window-put w 'window-list-skip
- (not (window-get w 'window-list-skip))))
- ((get) (window-get w 'window-list-skip)))))
+ (lambda (w mode)
+ (case mode
+ ((init add) (window-put w 'window-list-skip t))
+ ((remove) (window-put w 'window-list-skip nil))
+ ((toggle) (window-put w 'window-list-skip
+ (not (window-get w 'window-list-skip))))
+ ((get) (window-get w 'window-list-skip)))))
(define-wm-spec-window-state '_NET_WM_STATE_SKIP_TASKBAR
- (lambda (w mode)
- (case mode
- ((init add) (window-put w 'task-list-skip t))
- ((remove) (window-put w 'task-list-skip nil))
- ((toggle) (window-put w 'task-list-skip
- (not (window-get w 'task-list-skip))))
- ((get) (window-get w 'task-list-skip)))))
+ (lambda (w mode)
+ (case mode
+ ((init add) (window-put w 'task-list-skip t))
+ ((remove) (window-put w 'task-list-skip nil))
+ ((toggle) (window-put w 'task-list-skip
+ (not (window-get w 'task-list-skip))))
+ ((get) (window-get w 'task-list-skip)))))
(define-wm-spec-window-state '_NET_WM_STATE_FULLSCREEN
- (lambda (w mode)
- (require 'sawfish.wm.state.maximize)
- (case mode
- ((init) (window-put w 'queued-fullscreen-maximize t))
- ((add remove) (maximize-window-fullscreen w (eq mode 'add)))
- ((toggle) (maximize-window-fullscreen-toggle w))
- ((get) (window-maximized-fullscreen-p w)))))
+ (lambda (w mode)
+ (require 'sawfish.wm.state.maximize)
+ (case mode
+ ((init) (window-put w 'queued-fullscreen-maximize t))
+ ((add remove) (maximize-window-fullscreen w (eq mode 'add)))
+ ((toggle) (maximize-window-fullscreen-toggle w))
+ ((get) (window-maximized-fullscreen-p w)))))
(define (above-below-handler depth w mode)
(require 'sawfish.wm.stacking)
@@ -464,12 +462,12 @@
(= (window-depth w) depth))))
(define-wm-spec-window-state '_NET_WM_STATE_BELOW
- (lambda (w mode)
- (above-below-handler wm-spec-below-depth w mode)))
+ (lambda (w mode)
+ (above-below-handler wm-spec-below-depth w mode)))
(define-wm-spec-window-state '_NET_WM_STATE_ABOVE
- (lambda (w mode)
- (above-below-handler wm-spec-above-depth w mode)))
+ (lambda (w mode)
+ (above-below-handler wm-spec-above-depth w mode)))
;;; client messages
@@ -495,14 +493,22 @@
(eq mode _NET_WM_MOVERESIZE_MOVE_KEYBOARD))
(move-window-interactively w)
(let ((move-resize-moving-edges
- (cond ((eq mode _NET_WM_MOVERESIZE_SIZE_TOPLEFT) '(top left))
- ((eq mode _NET_WM_MOVERESIZE_SIZE_TOP) '(top))
- ((eq mode _NET_WM_MOVERESIZE_SIZE_TOPRIGHT) '(top right))
- ((eq mode _NET_WM_MOVERESIZE_SIZE_BOTTOMLEFT) '(bottom left))
- ((eq mode _NET_WM_MOVERESIZE_SIZE_BOTTOM) '(bottom))
- ((eq mode _NET_WM_MOVERESIZE_SIZE_BOTTOMRIGHT) '(bottom right))
- ((eq mode _NET_WM_MOVERESIZE_SIZE_LEFT) '(left))
- ((eq mode _NET_WM_MOVERESIZE_SIZE_RIGHT) '(right)))))
+ (cond ((eq mode _NET_WM_MOVERESIZE_SIZE_TOPLEFT)
+ '(top left))
+ ((eq mode _NET_WM_MOVERESIZE_SIZE_TOP)
+ '(top))
+ ((eq mode _NET_WM_MOVERESIZE_SIZE_TOPRIGHT)
+ '(top right))
+ ((eq mode _NET_WM_MOVERESIZE_SIZE_BOTTOMLEFT)
+ '(bottom left))
+ ((eq mode _NET_WM_MOVERESIZE_SIZE_BOTTOM)
+ '(bottom))
+ ((eq mode _NET_WM_MOVERESIZE_SIZE_BOTTOMRIGHT)
+ '(bottom right))
+ ((eq mode _NET_WM_MOVERESIZE_SIZE_LEFT)
+ '(left))
+ ((eq mode _NET_WM_MOVERESIZE_SIZE_RIGHT)
+ '(right)))))
(resize-window-interactively w))))))
((_NET_NUMBER_OF_DESKTOPS)
@@ -515,8 +521,8 @@
(set-viewport (aref data 0) (aref data 1)))
((_NET_CURRENT_DESKTOP)
- ; KDE spews _NET_CURRENT_DESKTOP( -1) messages so often that it
- ; is best to just ignore out of bounds errors silently.
+ ;; KDE spews _NET_CURRENT_DESKTOP( -1) messages so often that it
+ ;; is best to just ignore out of bounds errors silently.
(let ((ws (workspace-id-from-logical (aref data 0)))
(limits (workspace-limits)))
(if (<= (car limits) ws (cdr limits))
@@ -528,9 +534,9 @@
(setq data (aref data 0))
(let loop ((i 0)
(out '()))
- (if (= i (length data))
- (setq workspace-names (nreverse out))
- (loop (1+ i) (cons (aref data i) out)))))
+ (if (= i (length data))
+ (setq workspace-names (nreverse out))
+ (loop (1+ i) (cons (aref data i) out)))))
((_NET_ACTIVE_WINDOW)
(require 'sawfish.wm.util.display-window)
@@ -539,9 +545,12 @@
((_NET_WM_STATE)
(when (windowp w)
- (let ((mode (cond ((eql (aref data 0) _NET_WM_STATE_REMOVE) 'remove)
- ((eql (aref data 0) _NET_WM_STATE_ADD) 'add)
- ((eql (aref data 0) _NET_WM_STATE_TOGGLE) 'toggle)))
+ (let ((mode (cond ((eql (aref data 0) _NET_WM_STATE_REMOVE)
+ 'remove)
+ ((eql (aref data 0) _NET_WM_STATE_ADD)
+ 'add)
+ ((eql (aref data 0) _NET_WM_STATE_TOGGLE)
+ 'toggle)))
(atom1 (x-atom-name (aref data 1)))
(atom2 (x-atom-name (aref data 2))))
(when (or (and (eq atom1 '_NET_WM_STATE_MAXIMIZED_VERT)
@@ -623,9 +632,9 @@
(add-hook 'workarea-changed-hook update-workspace-hints)
(add-hook 'configure-notify-hook update-on-configure-notify)
- ; Better not expose work in progress. map-notify-hook gets
- ; called after this anyway.
- ;(add-hook 'add-window-hook update-client-list-hints)
+ ;; Better not expose work in progress. map-notify-hook gets
+ ;; called after this anyway.
+ ;;(add-hook 'add-window-hook update-client-list-hints)
(add-hook 'destroy-notify-hook update-client-list-hints)
(add-hook 'map-notify-hook update-client-list-hints)
(add-hook 'unmap-notify-hook update-client-list-hints)
@@ -634,7 +643,7 @@
(add-hook 'before-add-window-hook honour-client-state)
(add-hook 'add-window-hook update-client-state)
(call-after-state-changed '(sticky shaded maximized stacking
- window-list-skip task-list-skip)
+ window-list-skip task-list-skip)
update-client-state)
(call-after-state-changed 'sticky update-window-workspace-hints)
diff --git a/lisp/sawfish/wm/swapper.jl b/lisp/sawfish/wm/swapper.jl
index 859102a..018578e 100644
--- a/lisp/sawfish/wm/swapper.jl
+++ b/lisp/sawfish/wm/swapper.jl
@@ -1,35 +1,34 @@
-#| workspace-swapper.jl -- swapping window attributes per-workspace
+;; workspace-swapper.jl -- swapping window attributes per-workspace
+;;
+;; Copyright (C) 2000 John Harper <john dcs warwick ac uk>
+;;
+;; This file is part of sawfish.
+;;
+;; sawfish 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.
+;;
+;; sawfish 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 sawfish; see the file COPYING. If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
- $Id: swapper.jl,v 1.6 2001/01/05 04:12:38 jsh Exp $
+(define-structure sawfish.wm.swapper
- Copyright (C) 2000 John Harper <john dcs warwick ac uk>
-
- This file is part of sawfish.
-
- sawfish 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.
-
- sawfish 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 sawfish; see the file COPYING. If not, write to
- the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-|#
-
-(define-structure sawfish.wm.swapper ()
+ (export )
(open rep
- rep.system
- sawfish.wm.windows
- sawfish.wm.misc
- sawfish.wm.workspace
- sawfish.wm.viewport
- sawfish.wm.frames)
+ rep.system
+ sawfish.wm.windows
+ sawfish.wm.misc
+ sawfish.wm.workspace
+ sawfish.wm.viewport
+ sawfish.wm.frames)
;;; default swappers
diff --git a/lisp/sawfish/wm/tabs/tab.jl b/lisp/sawfish/wm/tabs/tab.jl
index 255a093..0fd60a0 100644
--- a/lisp/sawfish/wm/tabs/tab.jl
+++ b/lisp/sawfish/wm/tabs/tab.jl
@@ -1,42 +1,39 @@
-#| tab.jl - emulate fluxbox tab system
-
- $Id: tab.jl 4424 2009-02-18 21:38:42+0100 chrisb $
-
- Copyright (C) Yann Hodique <Yann Hodique lifl fr>
-
- This file is an official accepted contribution into sawfish.
-
- This script 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.
-
- sawfish 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 sawfish; see the file COPYING. If not, write to
- the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-|#
+;; tab.jl - emulate fluxbox tab system
+;;
+;; Copyright (C) Yann Hodique <Yann Hodique lifl fr>
+;;
+;; This file is an official accepted contribution into sawfish.
+;;
+;; This script 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.
+;;
+;; sawfish 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 sawfish; see the file COPYING. If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
(define-structure sawfish.wm.tabs.tab
- (export tab-add-to-group)
+ (export tab-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.util.marks
- sawfish.wm.windows
- sawfish.wm.stacking)
+ (open rep
+ rep.system
+ sawfish.wm.misc
+ sawfish.wm.custom
+ sawfish.wm.commands
+ sawfish.wm.frames
+ sawfish.wm.tabs.tabgroup
+ sawfish.wm.util.marks
+ sawfish.wm.windows
+ sawfish.wm.stacking)
- (define-structure-alias tab sawfish.wm.tabs.tab)
+ (define-structure-alias tab sawfish.wm.tabs.tab)
;; TODO:
;; - change other tab sizes when window resizes itself
@@ -78,25 +75,26 @@
(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)))
+ ;; 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))))
+ (- tab-left-dec-width)
+ (- tab-right-dec-width))))
(define (tab-left-edge win)
"Compute left edge of tab"
@@ -143,21 +141,21 @@
(define (raise-tabs-on-hover-setter)
(if (eq tab-raise-on-hover 't)
- (add-hook 'enter-frame-part-hook raise-tabs-on-hover-action)
+ (add-hook 'enter-frame-part-hook raise-tabs-on-hover-action)
(remove-hook 'enter-frame-part-hook raise-tabs-on-hover-action))))
- ;(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)
+;;(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)
diff --git a/lisp/sawfish/wm/tabs/tabgroup.jl b/lisp/sawfish/wm/tabs/tabgroup.jl
index 7e85531..d6c48d6 100644
--- a/lisp/sawfish/wm/tabs/tabgroup.jl
+++ b/lisp/sawfish/wm/tabs/tabgroup.jl
@@ -1,48 +1,45 @@
-#| tabgroup.jl - emulate fluxbox tab system
-
- $Id: tabgroup.jl 4424 2009-02-18 21:38:42+0100 chrisb $
-
- Copyright (C) Yann Hodique <Yann Hodique lifl fr>
-
- This file is an official accepted contribution into sawfish.
-
- This script 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 22, or (at your option)
- any later version.
-
- sawfish 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 sawfish; see the file COPYING. If not, write to
- the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-|#
+;; tabgroup.jl - emulate fluxbox tab system
+;;
+;; Copyright (C) Yann Hodique <Yann Hodique lifl fr>
+;;
+;; This file is an official accepted contribution into sawfish.
+;;
+;; This script 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 22, or (at your option)
+;; any later version.
+;;
+;; sawfish 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 sawfish; see the file COPYING. If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
(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)
+ (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)
@@ -59,56 +56,57 @@
(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))))
+ (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))))
+ (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))))))
+ (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))))))
+ (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
+ 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))))
+ (l (remove win (tab-group-window-list old))))
(if (null l)
- (setq tab-groups (delete old tab-groups))
+ (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-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)
@@ -118,13 +116,15 @@
(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)))
+ (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))
+ (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)
@@ -133,9 +133,9 @@
(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
+ (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))
@@ -143,7 +143,9 @@
(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))
+ (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))))
@@ -158,7 +160,7 @@
(mapcar (lambda (w)
(unshade-window w)
(rebuild-frame w)) wins))))
- (setq tab-refresh-lock t))))
+ (setq tab-refresh-lock t))))
;; Entry points
(define (tab-group-window w win)
@@ -166,7 +168,9 @@
(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)
+ ;; ugly hack, don't know why it's needed, but new groups are
+ ;; listed with pos (0,0):
+ (tab-refresh-group win 'move)
(tab-put-window-in-group w index)
(tab-delete-window-from-group w index2)
(tab-refresh-group w 'move)))
@@ -174,15 +178,15 @@
(define (tab-release-window w)
"Release active window from its group"
(tab-delete-window-from-tab-groups w)
- (tab-make-new-group 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)))
+ (size (length gr))
+ (r (tab-rank win gr)))
(nth (modulo (+ r n) size) gr)))
(define (tab-same-group-p w1 w2)
@@ -208,21 +212,30 @@
(define (map-other-grouped-windows win func)
""
(mapcar func
- (delete-if
- (lambda (w) (eq w win))
- (tab-group-window-list (tab-find-window win)))) )
+ (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)))
+ (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)))
diff --git a/lisp/sawfish/wm/theming/make-theme-preview.jl b/lisp/sawfish/wm/theming/make-theme-preview.jl
index 34576af..4fe21f7 100644
--- a/lisp/sawfish/wm/theming/make-theme-preview.jl
+++ b/lisp/sawfish/wm/theming/make-theme-preview.jl
@@ -1,5 +1,4 @@
;; make-theme-preview.jl -- previewing for theme builder
-;; $Id: make-theme-preview.jl,v 1.8 2000/10/31 07:12:04 jsh Exp $
;; Copyright (C) 2000 John Harper <john dcs warwick ac uk>
diff --git a/lisp/sawfish/wm/theming/make-theme.jl b/lisp/sawfish/wm/theming/make-theme.jl
index 87b846e..459886b 100644
--- a/lisp/sawfish/wm/theming/make-theme.jl
+++ b/lisp/sawfish/wm/theming/make-theme.jl
@@ -1,5 +1,4 @@
;; make-theme.jl -- support for theme builder
-;; $Id: make-theme.jl,v 1.8 2000/11/27 18:17:21 jsh Exp $
;; Copyright (C) 2000 John Harper <john dcs warwick ac uk>
@@ -34,7 +33,7 @@
(define (make-frames patterns-alist frame-alist)
(let ((image-cache '()))
-
+
(define (make-image-possibly-from-cache file)
(or (cdr (assoc file image-cache))
(let ((img (gaol-eval `(make-image ',file))))
@@ -49,7 +48,8 @@
(setq value (get-color value)))
((and (consp value) (stringp (car value)))
(let
- ((img (make-image-possibly-from-cache (car value))))
+ ((img (make-image-possibly-from-cache
+ (car value))))
(when img
(mapc (lambda (attr)
(cond
@@ -66,7 +66,7 @@
(cons (car cell)
(make-pattern (cdr cell))))
patterns-alist)))
-
+
(define (make-frame-part def)
(mapcar (lambda (cell)
(cons (car cell)
@@ -89,7 +89,7 @@
(mapcar (lambda (cell)
(cons (car cell) (mapcar make-frame-part (cdr cell))))
frame-alist))))
-
+
(define (make-theme patterns-alist frame-alist mapping-alist)
(let ((real-frames (make-frames patterns-alist frame-alist)))
(lambda (w type)
diff --git a/lisp/sawfish/wm/user.jl b/lisp/sawfish/wm/user.jl
index 7250e34..40a5644 100644
--- a/lisp/sawfish/wm/user.jl
+++ b/lisp/sawfish/wm/user.jl
@@ -1,25 +1,22 @@
-#| user.jl -- do user-local initialization
-
- $Id: user.jl,v 1.16 2001/02/14 00:03:21 jsh Exp $
-
- Copyright (C) 2000 John Harper <john dcs warwick ac uk>
-
- This file is part of sawfish.
-
- sawfish 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.
-
- sawfish 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 sawfish; see the file COPYING. If not, write to
- the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-|#
+;; user.jl -- do user-local initialization
+;;
+;; Copyright (C) 2000 John Harper <john dcs warwick ac uk>
+;;
+;; This file is part of sawfish.
+;;
+;; sawfish 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.
+;;
+;; sawfish 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 sawfish; see the file COPYING. If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
;; Commentary:
@@ -35,7 +32,9 @@
;; The downside is that it's harder for user extensions to redefine
;; existing code, IMHO this may also be a good thing..
-(define-structure user ()
+(define-structure user
+
+ (export )
((open rep
rep.regexp
@@ -108,10 +107,10 @@
;; then the sawfish specific user configuration
(let loop ((rest rc-files))
- (when rest
- (if (rc-file-exists-p (car rest))
- (safe-load (car rest) t t t)
- (loop (cdr rest))))))))
+ (when rest
+ (if (rc-file-exists-p (car rest))
+ (safe-load (car rest) t t t)
+ (loop (cdr rest))))))))
(error
(format (stderr-file) "error in local config--> %S\n" error-data))))
@@ -122,7 +121,7 @@
;; apply customized font-colors
(require 'sawfish.wm.extras)
(if use-custom-font-color
- (update-frame-font-color))
+ (update-frame-font-color))
;; use a default theme if none given
(unless (or batch-mode default-frame-style)
diff --git a/lisp/sawfish/wm/util/compat.jl b/lisp/sawfish/wm/util/compat.jl
index 1410ee0..a190cbe 100644
--- a/lisp/sawfish/wm/util/compat.jl
+++ b/lisp/sawfish/wm/util/compat.jl
@@ -1,5 +1,4 @@
;; compat.jl -- aliases for obsolete functions
-;; $Id: compat.jl,v 1.18 2002/04/21 23:11:40 jsh Exp $
;; Copyright (C) 1999 John Harper <john dcs warwick ac uk>
@@ -96,30 +95,29 @@
(mapc (lambda (x)
(put x 'custom-obsolete t))
- '(viewport-columns viewport-rows
- preallocated-workspaces iconify-whole-group
- uniconify-whole-group always-update-frames
- edge-flip-warp-pointer frame-type-fallbacks
- warp-to-window-x-offset warp-to-window-y-offset
- uniquify-name-format transients-get-focus decorate-transients
- raise-windows-on-uniconify uniconify-to-current-workspace
- uniconify-to-current-viewport iconify-ignored
- focus-windows-on-uniconify
- transients-are-group-members raise-selected-windows
- warp-to-selected-windows menus-include-shortcuts
- configure-auto-gravity configure-ignore-stacking-requests
- beos-window-menu-simplifies customize-show-symbols
- move-snap-mode move-snap-ignored-windows
- move-resize-inhibit-configure move-snap-edges
- raise-windows-when-unshaded persistent-group-ids
- delete-workspaces-when-empty transients-on-parents-workspace
- audio-for-ignored-windows
- size-window-def-increment slide-window-increment
- default-bevel-percent sp-padding nokogiri-user-level
- nokogiri-buttons workspace-boundary-mode
- workspace-send-boundary-mode lock-first-workspace
- ignore-window-input-hint workspace-geometry
- pointer-motion-threshold ignore-program-positions))
+ '(viewport-columns viewport-rows preallocated-workspaces
+ iconify-whole-group uniconify-whole-group
+ always-update-frames edge-flip-warp-pointer
+ frame-type-fallbacks warp-to-window-x-offset
+ warp-to-window-y-offset uniquify-name-format
+ transients-get-focus decorate-transients
+ raise-windows-on-uniconify uniconify-to-current-workspace
+ uniconify-to-current-viewport iconify-ignored
+ focus-windows-on-uniconify transients-are-group-members
+ raise-selected-windows warp-to-selected-windows
+ menus-include-shortcuts configure-auto-gravity
+ configure-ignore-stacking-requests
+ beos-window-menu-simplifies customize-show-symbols
+ move-snap-mode move-snap-ignored-windows
+ move-resize-inhibit-configure move-snap-edges
+ raise-windows-when-unshaded persistent-group-ids
+ delete-workspaces-when-empty transients-on-parents-workspace
+ audio-for-ignored-windows size-window-def-increment
+ slide-window-increment default-bevel-percent sp-padding
+ nokogiri-user-level nokogiri-buttons workspace-boundary-mode
+ workspace-send-boundary-mode lock-first-workspace
+ ignore-window-input-hint workspace-geometry
+ pointer-motion-threshold ignore-program-positions))
;;; obsolete custom setters
diff --git a/lisp/sawfish/wm/util/decode-events.jl b/lisp/sawfish/wm/util/decode-events.jl
index b026924..9be8922 100644
--- a/lisp/sawfish/wm/util/decode-events.jl
+++ b/lisp/sawfish/wm/util/decode-events.jl
@@ -1,5 +1,4 @@
;; decode-events.jl -- symbolic event manipulation
-;; $Id: decode-events.jl,v 1.12 2001/05/04 07:41:33 jsh Exp $
;; Copyright (C) 2000 John Harper <john dcs warwick ac uk>
@@ -83,8 +82,9 @@
event))
(define (decode-event event)
- "Return a symbol description of the low-level event structure EVENT (a cons
-cell). The symbolic description has the form `(TYPE MODIFIER-LIST ACTION)'."
+ "Return a symbol description of the low-level event structure
+EVENT (a cons cell). The symbolic description has the form `(TYPE
+MODIFIER-LIST ACTION)'."
(let* ((code (car event))
(mods (cdr event)))
@@ -99,8 +99,9 @@ cell). The symbolic description has the form `(TYPE MODIFIER-LIST ACTION)'."
(t (error "Unknown event type")))))
(define (encode-event event)
- "Return the low-level event structure (cons cell) representing the symbolic
-event description EVENT, a list `(TYPE MODIFIER-LIST ACTION)'."
+ "Return the low-level event structure (cons cell) representing the
+symbolic event description EVENT, a list `(TYPE MODIFIER-LIST
+ACTION)'."
(let* ((code 0)
(mods (encode-modifier (cadr event))))
@@ -152,9 +153,9 @@ representing the X11 keysyms that may generate the modifier."
(define (member-event ev lst)
(let loop ((rest lst))
- (cond ((null rest) nil)
- ((event-match ev (car rest)) rest)
- (t (loop (cdr rest))))))
+ (cond ((null rest) nil)
+ ((event-match ev (car rest)) rest)
+ (t (loop (cdr rest))))))
(define (should-grab-button-event-p event keymap)
(let* ((decoded (decode-event event))
@@ -163,6 +164,6 @@ representing the X11 keysyms that may generate the modifier."
(list (car decoded) (cadr decoded) action)))
'(click-2 click-3 move off-1 off-2 off-3))))
(let loop ((rest (cdr keymap)))
- (cond ((null rest) nil)
- ((member-event (cdar rest) variants) t)
- (t (loop (cdr rest))))))))
+ (cond ((null rest) nil)
+ ((member-event (cdar rest) variants) t)
+ (t (loop (cdr rest))))))))
diff --git a/lisp/sawfish/wm/util/display-window.jl b/lisp/sawfish/wm/util/display-window.jl
index c39c8bc..7aed6b6 100644
--- a/lisp/sawfish/wm/util/display-window.jl
+++ b/lisp/sawfish/wm/util/display-window.jl
@@ -1,25 +1,22 @@
-#| display-window.jl -- activating windows
-
- $Id: display-window.jl,v 1.9 2002/06/18 04:22:22 jsh Exp $
-
- Copyright (C) 2000 John Harper <john dcs warwick ac uk>
-
- This file is part of sawfish.
-
- sawfish 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.
-
- sawfish 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 sawfish; see the file COPYING. If not, write to
- the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-|#
+;; display-window.jl -- activating windows
+;;
+;; Copyright (C) 2000 John Harper <john dcs warwick ac uk>
+;;
+;; This file is part of sawfish.
+;;
+;; sawfish 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.
+;;
+;; sawfish 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 sawfish; see the file COPYING. If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
(define-structure sawfish.wm.util.display-window
diff --git a/lisp/sawfish/wm/util/display-wininfo.jl b/lisp/sawfish/wm/util/display-wininfo.jl
index 4ba69d3..6a31915 100644
--- a/lisp/sawfish/wm/util/display-wininfo.jl
+++ b/lisp/sawfish/wm/util/display-wininfo.jl
@@ -1,23 +1,22 @@
-#| display-wininfo.jl -- shows info about focused window
-
- Copyright (C) 2000 Unai Uribarri <unaiur telecable es>
-
- This file is part of sawfish.
-
- sawfish 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.
-
- sawfish 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 sawfish; see the file COPYING. If not, write to
- the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-|#
+;; display-wininfo.jl -- shows info about focused window
+;;
+;; Copyright (C) 2000 Unai Uribarri <unaiur telecable es>
+;;
+;; This file is part of sawfish.
+;;
+;; sawfish 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.
+;;
+;; sawfish 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 sawfish; see the file COPYING. If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
(define-structure sawfish.wm.util.display-wininfo
@@ -33,8 +32,7 @@
sawfish.wm.misc
sawfish.wm.util.x
sawfish.wm.windows
- sawfish.wm.workspace
- )
+ sawfish.wm.workspace)
;;; variables
@@ -83,18 +81,15 @@
;; Returns a list of strings describing window W in some way
(define (window-info w)
(list (concat (and (window-get w 'iconified) ?[)
- (window-name w)
- (and (window-get w 'iconified) ?])
- ; potentially include the workspace where the window is
+ (window-name w)
+ (and (window-get w 'iconified) ?])
+ ;; potentially include the workspace where the window is
(if (and
display-wininfo-show-workspace
(not (window-in-workspace-p w current-workspace)))
- (concat " <" (number->string (car (window-workspaces w))) ">")
- ""
- )
- )
- )
- )
+ (concat " <" (number->string
+ (car (window-workspaces w))) ">")
+ ""))))
;;; entry point
@@ -110,7 +105,7 @@ icon (if available). With a null W any displayed information is removed."
(when info-window
(x-destroy-window info-window)
(setq info-window nil))
-
+
(when w
(let* ((text (make-text-item (window-info w) default-font))
(icon (let ((i (window-icon-image w)))
@@ -134,7 +129,7 @@ icon (if available). With a null W any displayed information is removed."
(cons x-margin
(quotient (- (x-drawable-height xw)
(cdr icon-dims)) 2))))
-
+
;; draw lines of text one at a time
(let ((gc (x-create-gc xw
`((foreground . ,(get-color "black"))
diff --git a/lisp/sawfish/wm/util/edges.jl b/lisp/sawfish/wm/util/edges.jl
index 59fcbd1..d76a048 100644
--- a/lisp/sawfish/wm/util/edges.jl
+++ b/lisp/sawfish/wm/util/edges.jl
@@ -1,5 +1,4 @@
;; edges.jl -- Identify all window edges
-;; $Id: edges.jl,v 1.23 2000/08/29 18:16:35 john Exp $
;; Copyright (C) 1999 John Harper <john dcs warwick ac uk>
@@ -56,22 +55,22 @@ The returned lists may contain duplicates, and are unsorted."
(not (window-get w 'ignored)))
(not (memq w windows-to-ignore))
(or (not (listp windows)) (memq w windows)))
- (let ((dims (window-frame-dimensions w))
- (coords (window-position w)))
- (setq x-edges (cons (list (car coords) (cdr coords)
- (+ (cdr coords) (cdr dims)) t)
- (cons (list (+ (car coords) (car dims))
- (cdr coords)
- (+ (cdr coords) (cdr dims))
- nil)
- x-edges)))
- (setq y-edges (cons (list (cdr coords) (car coords)
- (+ (car coords) (car dims)) t)
- (cons (list (+ (cdr coords) (cdr dims))
- (car coords)
- (+ (car coords) (car dims))
- nil)
- y-edges)))))))
+ (let ((dims (window-frame-dimensions w))
+ (coords (window-position w)))
+ (setq x-edges (cons (list (car coords) (cdr coords)
+ (+ (cdr coords) (cdr dims)) t)
+ (cons (list (+ (car coords) (car dims))
+ (cdr coords)
+ (+ (cdr coords) (cdr dims))
+ nil)
+ x-edges)))
+ (setq y-edges (cons (list (cdr coords) (car coords)
+ (+ (car coords) (car dims)) t)
+ (cons (list (+ (cdr coords) (cdr dims))
+ (car coords)
+ (+ (car coords) (car dims))
+ nil)
+ y-edges)))))))
(when include-screen
(setq x-edges (list* (list 0 0 (screen-height) nil)
@@ -104,7 +103,7 @@ The returned lists may contain duplicates, and are unsorted."
(+ (car offset) (car dims)) t)
y-edges))))
include-heads))
-
+
(cons x-edges y-edges)))
(define (grid-from-edges x-edges y-edges)
diff --git a/lisp/sawfish/wm/util/font.jl b/lisp/sawfish/wm/util/font.jl
index d7b319e..5edb22a 100644
--- a/lisp/sawfish/wm/util/font.jl
+++ b/lisp/sawfish/wm/util/font.jl
@@ -1,27 +1,24 @@
-#| font.jl -- some font-related functions
-
- $Id: font.jl,v 1.4 2003/08/14 06:55:36 jsh Exp $
-
- Author: John Harper <jsh unfactored org>
-
- Copyright (C) 2002 John Harper
-
- This file is part of sawfish.
-
- sawfish 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.
-
- sawfish 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 sawfish; see the file COPYING. If not, write to
- the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-|#
+;; font.jl -- some font-related functions
+;;
+;; Author: John Harper <jsh unfactored org>
+;;
+;; Copyright (C) 2002 John Harper
+;;
+;; This file is part of sawfish.
+;;
+;; sawfish 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.
+;;
+;; sawfish 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 sawfish; see the file COPYING. If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
(define-structure sawfish.wm.util.font
@@ -66,14 +63,14 @@
(define (assoc-case x map)
(let loop ((rest map))
- (cond ((null rest) nil)
- ((string-equal x (caar rest)) (car rest))
- (t (loop (cdr rest))))))
+ (cond ((null rest) nil)
+ ((string-equal x (caar rest)) (car rest))
+ (t (loop (cdr rest))))))
(define (face-style face style)
(cdr (assoc-case style (face-styles face))))
-;; Xft naming scheme
+ ;; Xft naming scheme
(define xft-abbrev-map
'(("light" "weight" . "light")
@@ -110,19 +107,19 @@
;; extract styles
(let loop ((rest (cdr fields))
(styles '()))
- (if (null rest)
- (make-face family size (nreverse styles))
- (cond ((string-match "\\s*=\\s*" (car rest))
- (loop (cdr rest)
- (cons (cons (substring (car rest) 0 (match-start))
- (substring (car rest) (match-end)))
- styles)))
- ((assoc-case (car rest) xft-abbrev-map)
- (loop (cdr rest)
- (cons (cdr (assoc-case (car rest)
- xft-abbrev-map)) styles)))
- ;; drop unknown single words..
- (t (loop (cdr rest) styles)))))))
+ (if (null rest)
+ (make-face family size (nreverse styles))
+ (cond ((string-match "\\s*=\\s*" (car rest))
+ (loop (cdr rest)
+ (cons (cons (substring (car rest) 0 (match-start))
+ (substring (car rest) (match-end)))
+ styles)))
+ ((assoc-case (car rest) xft-abbrev-map)
+ (loop (cdr rest)
+ (cons (cdr (assoc-case (car rest)
+ xft-abbrev-map)) styles)))
+ ;; drop unknown single words..
+ (t (loop (cdr rest) styles)))))))
(define (face->xft-description face)
(let ((families (string-replace "-" "\\-" (face-families face)))
@@ -139,13 +136,13 @@
(format nil "%s=%s" (car x) (cdr x)))
(t (car x)))) styles)) #\:)))
-;; Pango naming scheme
+ ;; Pango naming scheme
(define pango-style-map
'(("Oblique" "slant" . "oblique")
("Italic" "slant" . "italic")
("Small-Caps" "style" . "smallcaps") ;FIXME?
-#|
+ #|
("Ultra-Condensed" . ?) ;FIXME
("Extra-Condensed" . ?)
("Condensed" . ?)
@@ -154,7 +151,7 @@
("Expanded" . ?)
("Extra-Expanded" . ?)
("Ultra-Expanded" . ?)
-|#
+ |#
("Ultra-Light" "weight" . "ultralight") ;FIXME?
("Light" "weight" . "light")
("Medium" "weight" . "medium")
@@ -189,7 +186,8 @@
(car fields) pango-style-map)) styles))
(setq fields (cdr fields)))
- ;; whatever's left is the family name, except of that comma found in name
+ ;; whatever's left is the family name, except of that comma
+ ;; found in name
(if force-family
(setq family force-family)
(setq family (mapconcat identity (nreverse fields) #\space)))
@@ -200,29 +198,30 @@
(catch 'found
(mapc (lambda (x) (if (string-match regexp (car x) 0 case-fold)
(throw 'found x)))
- alist)))
+ alist)))
(define (face->pango-description face)
(let loop ((rest (face-styles face))
(out '()))
- (if (null rest)
- (let* ((family (face-families face))
- (regexp (concat "^" (last (string-split "\\s+" family)))))
- (when (and (not (string-equal family ""))
- (assoc-grep regexp pango-style-map t))
- (setq family (concat family ",")))
- (mapconcat identity
- (nconc (list family)
- (nreverse out)
- (and (face-size face)
- (list (format nil "%d" (face-size face)))))
- #\space))
- (let ((tem (rassoc (car rest) pango-style-map)))
- (if tem
- (loop (cdr rest) (cons (car tem) out))
- (loop (cdr rest) out))))))
-
-;; XLFD naming scheme
+ (if (null rest)
+ (let* ((family (face-families face))
+ (regexp (concat "^" (last (string-split "\\s+" family)))))
+ (when (and (not (string-equal family ""))
+ (assoc-grep regexp pango-style-map t))
+ (setq family (concat family ",")))
+ (mapconcat identity
+ (nconc (list family)
+ (nreverse out)
+ (and (face-size face)
+ (list
+ (format nil "%d" (face-size face)))))
+ #\space))
+ (let ((tem (rassoc (car rest) pango-style-map)))
+ (if tem
+ (loop (cdr rest) (cons (car tem) out))
+ (loop (cdr rest) out))))))
+
+ ;; XLFD naming scheme
(define xlfd-style-names
'((5 . "width")
diff --git a/lisp/sawfish/wm/util/groups.jl b/lisp/sawfish/wm/util/groups.jl
index 970cf92..bb686ea 100644
--- a/lisp/sawfish/wm/util/groups.jl
+++ b/lisp/sawfish/wm/util/groups.jl
@@ -1,5 +1,4 @@
;; group-funs.jl -- ever-present window-group support
-;; $Id: groups.jl,v 1.31 2002/04/20 20:59:20 jsh Exp $
;; Copyright (C) 1999 John Harper <john dcs warwick ac uk>
@@ -79,9 +78,9 @@
(window-id w))))
(define (windows-by-group group-id #!optional by-depth)
- "Return the list of windows in the group with id GROUP-ID. If BY-DEPTH is
-non-nil, then return the windows in order of stacking, from topmost to
-bottommost."
+ "Return the list of windows in the group with id GROUP-ID. If
+BY-DEPTH is non-nil, then return the windows in order of stacking,
+from topmost to bottommost."
(delete-if-not (lambda (x)
(eq (window-actual-group-id x) group-id))
(if by-depth (stacking-order) (managed-windows))))
@@ -91,8 +90,8 @@ bottommost."
(windows-by-group (window-actual-group-id w) by-depth))
(define (map-window-group fun w)
- "Map the single argument function FUN over all windows in the same group as
-window W."
+ "Map the single argument function FUN over all windows in the same
+group as window W."
(mapc fun (windows-in-group w)))
(define (map-other-window-groups fun w)
@@ -118,8 +117,8 @@ group as window W."
(window-put w 'group group-id))
(define (add-window-to-new-group w)
- "Add window W to a new group (i.e. has W as its sole member); returns the
-id of the new group."
+ "Add window W to a new group (i.e. has W as its sole member); returns
+the id of the new group."
(let ((ids (window-group-ids))
(i -1))
(while (memq i ids)
diff --git a/lisp/sawfish/wm/util/gtkrc.jl b/lisp/sawfish/wm/util/gtkrc.jl
index 22376f2..2c4a777 100644
--- a/lisp/sawfish/wm/util/gtkrc.jl
+++ b/lisp/sawfish/wm/util/gtkrc.jl
@@ -1,5 +1,4 @@
;; gtkrc.jl -- code to read current gtkrc settings
-;; $Id: gtkrc.jl,v 1.16 2001/01/15 18:57:23 jsh Exp $
;; Copyright (C) 1999 John Harper <john dcs warwick ac uk>
diff --git a/lisp/sawfish/wm/util/keymap-diff.jl b/lisp/sawfish/wm/util/keymap-diff.jl
index 269acea..15cbecf 100644
--- a/lisp/sawfish/wm/util/keymap-diff.jl
+++ b/lisp/sawfish/wm/util/keymap-diff.jl
@@ -1,27 +1,24 @@
-#| keymap-diff.jl -- functions for diffing and patching keymaps
-
- $Id$
-
- Copyright (C) 2001 Eazel, Inc.
-
- This file is part of sawfish.
-
- sawfish 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.
-
- sawfish 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 sawfish; see the file COPYING. If not, write to
- the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-
- Authors: John Harper <jsh eazel com>
-|#
+;; keymap-diff.jl -- functions for diffing and patching keymaps
+;;
+;; Copyright (C) 2001 Eazel, Inc.
+;;
+;; This file is part of sawfish.
+;;
+;; sawfish 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.
+;;
+;; sawfish 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 sawfish; see the file COPYING. If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;;
+;; Authors: John Harper <jsh eazel com>
(define-structure sawfish.wm.util.keymap-diff
@@ -43,31 +40,33 @@ FROM-MAP to the keymap TO-MAP."
(to-rest (cdr (sort-keymap to-map)))
(diff '()))
- (cond ((and (null from-rest) (null to-rest))
- ;; both lists ended
- (cons 'keymap-diff (nreverse diff)))
+ (cond ((and (null from-rest) (null to-rest))
+ ;; both lists ended
+ (cons 'keymap-diff (nreverse diff)))
- ((null from-rest)
- ;; from ended, so need to add rest of to
- (loop '() (cdr to-rest) (cons (list '+ (car to-rest)) diff)))
+ ((null from-rest)
+ ;; from ended, so need to add rest of to
+ (loop '() (cdr to-rest) (cons (list '+ (car to-rest)) diff)))
- ((null to-rest)
- ;; to ended, so need to subtract rest of from
- (loop (cdr from-rest) '() (cons (list '- (car from-rest)) diff)))
+ ((null to-rest)
+ ;; to ended, so need to subtract rest of from
+ (loop (cdr from-rest)
+ '()
+ (cons (list '- (car from-rest)) diff)))
- ((equal (car from-rest) (car to-rest))
- ;; both equal, keep going
- (loop (cdr from-rest) (cdr to-rest) diff))
+ ((equal (car from-rest) (car to-rest))
+ ;; both equal, keep going
+ (loop (cdr from-rest) (cdr to-rest) diff))
- ((< (car from-rest) (car to-rest))
- ;; extra item in from list, so subtract it
- (loop (cdr from-rest) to-rest
- (cons (list '- (car from-rest)) diff)))
+ ((< (car from-rest) (car to-rest))
+ ;; extra item in from list, so subtract it
+ (loop (cdr from-rest) to-rest
+ (cons (list '- (car from-rest)) diff)))
- ((> (car from-rest) (car to-rest))
- ;; extra item in to list, so add it
- (loop from-rest (cdr to-rest)
- (cons (list '+ (car to-rest)) diff))))))
+ ((> (car from-rest) (car to-rest))
+ ;; extra item in to list, so add it
+ (loop from-rest (cdr to-rest)
+ (cons (list '+ (car to-rest)) diff))))))
(define (patch-keymap map diff)
"Returns a new copy of the keymap MAP, transformed following by the list
@@ -79,16 +78,16 @@ DIFF, which should have been created by the `diff-keymaps' function."
(let loop ((rest (cdr diff))
(new-map (copy-sequence (cdr map))))
- (cond ((null rest)
- ;; end of the script, return the new map
- (cons 'keymap new-map))
+ (cond ((null rest)
+ ;; end of the script, return the new map
+ (cons 'keymap new-map))
- ((eq (caar rest) '-)
- ;; something to remove
- (loop (cdr rest) (delete (cadar rest) new-map)))
+ ((eq (caar rest) '-)
+ ;; something to remove
+ (loop (cdr rest) (delete (cadar rest) new-map)))
- ((eq (caar rest) '+)
- ;; something to add
- (loop (cdr rest) (cons (cadar rest) new-map)))
+ ((eq (caar rest) '+)
+ ;; something to add
+ (loop (cdr rest) (cons (cadar rest) new-map)))
- (t (error "Malformed item in diff script: %s" (car rest)))))))
+ (t (error "Malformed item in diff script: %s" (car rest)))))))
diff --git a/lisp/sawfish/wm/util/keymap.jl b/lisp/sawfish/wm/util/keymap.jl
index 2ab3c0d..34bf2ac 100644
--- a/lisp/sawfish/wm/util/keymap.jl
+++ b/lisp/sawfish/wm/util/keymap.jl
@@ -1,5 +1,4 @@
;; keymap.jl -- some keymap utilities, mostly copied from jade
-;; $Id: keymap.jl,v 1.18 2000/12/19 23:49:54 jsh Exp $
;; Copyright (C) 1999 John Harper <john dcs warwick ac uk>
@@ -54,7 +53,7 @@ cons cell (COMMAND . EVENT)."
(when (keymapp keymap)
(setq keymap (list keymap)))
(let ((keymap-list keymap)
- (done-list nil))
+ (done-list nil))
(while keymap-list
(let
((keymap (car keymap-list)))
@@ -99,7 +98,7 @@ for the bindings to be installed if and when it is."
`(if (featurep ',feature)
(bind-keys ,keymap ,@bindings)
(eval-after-load ,(symbol-name feature)
- '(bind-keys ,keymap ,@bindings))))
+ '(bind-keys ,keymap ,@bindings))))
;;; Search for a named command in the current keymap configuration
@@ -108,7 +107,9 @@ for the bindings to be installed if and when it is."
(let ((where-is-results '()))
(map-keymap (lambda (k)
(when (eq (car k) command)
- (setq where-is-results (cons (event-name (substitute-wm-modifier (cdr k))) where-is-results))))
+ (setq where-is-results
+ (cons (event-name (substitute-wm-modifier (cdr k)))
+ where-is-results))))
(or keymap global-keymap))
where-is-results))
diff --git a/lisp/sawfish/wm/util/marks.jl b/lisp/sawfish/wm/util/marks.jl
index 250c794..f8a7f5a 100644
--- a/lisp/sawfish/wm/util/marks.jl
+++ b/lisp/sawfish/wm/util/marks.jl
@@ -1,39 +1,36 @@
-#| marks.jl -- provide a way to operate on multiple windows
-
- $Id$
-
- Copyright (C) Yann Hodique <Yann Hodique lifl fr>
-
- This file is an official accepted contribution into sawfish.
-
- This script 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.
-
- sawfish 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 sawfish; see the file COPYING. If not, write to
- the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-|#
+;; marks.jl -- provide a way to operate on multiple windows
+;;
+;; Copyright (C) Yann Hodique <Yann Hodique lifl fr>
+;;
+;; This file is an official accepted contribution into sawfish.
+;;
+;; This script 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.
+;;
+;; sawfish 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 sawfish; see the file COPYING. If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
(define-structure sawfish.wm.util.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)
+ (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.util.marks)
diff --git a/lisp/sawfish/wm/util/nokogiri.jl b/lisp/sawfish/wm/util/nokogiri.jl
index 07fc751..9ada0de 100644
--- a/lisp/sawfish/wm/util/nokogiri.jl
+++ b/lisp/sawfish/wm/util/nokogiri.jl
@@ -1,25 +1,22 @@
-#| nokogiri-sawfish.jl -- code to load into window manager
-
- $Id: nokogiri.jl,v 1.20 2002/04/21 04:52:17 jsh Exp $
-
- Copyright (C) 2000 John Harper <john dcs warwick ac uk>
-
- This file is part of sawfish.
-
- sawfish 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.
-
- sawfish 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 sawfish; see the file COPYING. If not, write to
- the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-|#
+;; nokogiri-sawfish.jl -- code to load into window manager
+;;
+;; Copyright (C) 2000 John Harper <john dcs warwick ac uk>
+;;
+;; This file is part of sawfish.
+;;
+;; sawfish 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.
+;;
+;; sawfish 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 sawfish; see the file COPYING. If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
(define-structure sawfish.wm.util.nokogiri
@@ -60,10 +57,10 @@
(setq doc (_ doc))
(when customize-show-symbols
(setq doc (format nil "%s\n[%s]" doc (symbol-name symbol)))))
-
+
(when (and (symbolp type) (get type 'custom-widget))
(setq type ((get type 'custom-widget) type)))
-
+
;; backwards compatibility
(case type
((symbol)
@@ -76,7 +73,7 @@
(setq type 'file))
((program-name)
(setq type 'program)))
-
+
(nconc (list #:name symbol
#:type type
#:value value)
@@ -126,7 +123,7 @@
(mapc (lambda (x) (put x 'deprecated-command t))
'(apropos-function apropos-variable beep call-command
- copy-file delete-directory delete-file describe-key
- describe-symbol focus-click garbage-collect load
- make-directory nop rename-file set step system
- trace untrace recursive-edit)))
+ copy-file delete-directory delete-file describe-key
+ describe-symbol focus-click garbage-collect load
+ make-directory nop rename-file set step system
+ trace untrace recursive-edit)))
diff --git a/lisp/sawfish/wm/util/ping.jl b/lisp/sawfish/wm/util/ping.jl
index a046270..af25851 100644
--- a/lisp/sawfish/wm/util/ping.jl
+++ b/lisp/sawfish/wm/util/ping.jl
@@ -1,27 +1,24 @@
-#| ping.jl -- implement the _NET_WM_PING protocol
-
- $Id$
-
- Author: John Harper <jsh eazel com>
-
- Copyright (C) 2000 Eazel, Inc.
-
- This file is part of sawfish.
-
- sawfish 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.
-
- sawfish 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 sawfish; see the file COPYING. If not, write to
- the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-|#
+;; ping.jl -- implement the _NET_WM_PING protocol
+;;
+;; Author: John Harper <jsh eazel com>
+;;
+;; Copyright (C) 2000 Eazel, Inc.
+;;
+;; This file is part of sawfish.
+;;
+;; sawfish 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.
+;;
+;; sawfish 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 sawfish; see the file COPYING. If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
(define-structure sawfish.wm.util.ping
@@ -89,17 +86,17 @@ milliseconds (defaults to 1 second), false otherwise."
;; a returning ping (pong?)
(let ((id (aref data 1)))
(let loop ((rest pings-in-transit))
- (cond ((null loop)
- (format
- standard-error "Received stray _NET_WM_PING: %s\n" data))
+ (cond ((null loop)
+ (format
+ standard-error "Received stray _NET_WM_PING: %s\n" data))
- ((eql (ping-id (car rest)) id)
- ;; found our ping
- (let ((this (car rest)))
- (setq pings-in-transit (delq this pings-in-transit))
- ((ping-callback this) t)))
+ ((eql (ping-id (car rest)) id)
+ ;; found our ping
+ (let ((this (car rest)))
+ (setq pings-in-transit (delq this pings-in-transit))
+ ((ping-callback this) t)))
- (t (loop (cdr rest))))))
+ (t (loop (cdr rest))))))
t))
(add-hook 'client-message-hook client-message-handler))
diff --git a/lisp/sawfish/wm/util/play-audio.jl b/lisp/sawfish/wm/util/play-audio.jl
index c5d2850..34561b3 100644
--- a/lisp/sawfish/wm/util/play-audio.jl
+++ b/lisp/sawfish/wm/util/play-audio.jl
@@ -1,5 +1,4 @@
;; play-audio.jl -- functions for playing sound samples
-;; $Id: play-audio.jl,v 1.8 2002/04/21 03:39:41 jsh Exp $
;; Copyright (C) 2000 John Harper <john dcs warwick ac uk>
diff --git a/lisp/sawfish/wm/util/prompt-extras.jl b/lisp/sawfish/wm/util/prompt-extras.jl
index 88c519d..1d1fe05 100644
--- a/lisp/sawfish/wm/util/prompt-extras.jl
+++ b/lisp/sawfish/wm/util/prompt-extras.jl
@@ -1,5 +1,4 @@
;; prompt-extras.jl -- more esoteric prompt variants
-;; $Id: prompt-extras.jl,v 1.7 2000/09/08 15:14:02 john Exp $
;; Copyright (C) 2000 John Harper <john dcs warwick ac uk>
@@ -138,6 +137,6 @@ Unless DONT-VALIDATE is t, only a member of PROMPT-LIST will be returned."
(define (pwd-prompt title)
(let ((prompt-display-fun (lambda (string)
- (make-string (length string) ?*)))
+ (make-string (length string) ?*)))
(prompt-history nil))
(prompt-for-string title)))
diff --git a/lisp/sawfish/wm/util/prompt-wm.jl b/lisp/sawfish/wm/util/prompt-wm.jl
index 45067d1..7d9e746 100644
--- a/lisp/sawfish/wm/util/prompt-wm.jl
+++ b/lisp/sawfish/wm/util/prompt-wm.jl
@@ -1,5 +1,4 @@
;; prompt-wm.jl -- prompt variants for windows/workspaces
-;; $Id: prompt-wm.jl,v 1.6 2000/09/11 07:44:42 john Exp $
;; Contributed by Dave Pearson <davep davep org>
diff --git a/lisp/sawfish/wm/util/prompt.jl b/lisp/sawfish/wm/util/prompt.jl
index 23d2e86..96906f5 100644
--- a/lisp/sawfish/wm/util/prompt.jl
+++ b/lisp/sawfish/wm/util/prompt.jl
@@ -1,9 +1,8 @@
;; prompt.jl -- read line from user
-;; Time-stamp: <Fri Sep 18 12:09:45 CDT 2009>
;;
;; Copyright (C) 2008 Sergey I. Sharybin <sharybin nm ru>
;; Copyright (C) 2000 Topi Paavola <tjp iki fi>
-;;
+;;
;; This file 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)
@@ -87,8 +86,8 @@
of a word when moving.")
(defvar prompt-file-exclude '"\\.(o|jlc|x)$|~$|^#.*#$|^\\.\\.?$"
- "A regexp, if it matches the file being considered for completion, the file
-is rejected.")
+ "A regexp, if it matches the file being considered for completion,
+the file is rejected.")
(defvar prompt-list nil
"List of possible entries for prompt-from-list.")
@@ -128,8 +127,8 @@ displayed. See the `display-message' function for more details.")
prompt-display-fun (lambda (#!rest) nil)))
-;; From merlin
-;; But maybe better if we'd include this util?
+ ;; From merlin
+ ;; But maybe better if we'd include this util?
;; string/font -> font
(define (prompt-fontify font)
@@ -142,7 +141,7 @@ displayed. See the `display-message' function for more details.")
;; assq with default
(define (prompt-assqd key alist default)
(if (assq key alist)
- (assq key alist)
+ (assq key alist)
(cons key default)))
(defun prompt-exit ()
@@ -218,7 +217,7 @@ displayed. See the `display-message' function for more details.")
(and (>= new-pos 0) (<= new-pos (length prompt-result))
(setq prompt-position new-pos)
(prompt-update-display))))
-
+
(defun prompt-forward-word ()
"Move to next non-word character."
(setq prompt-position (1+ prompt-position))
@@ -306,25 +305,28 @@ displayed. See the `display-message' function for more details.")
(defun prompt-update-display ()
(let ((result (if prompt-display-fun
(prompt-display-fun prompt-result)
- prompt-result))
- (completions (prompt-format-completions)))
- (let
- (
- (fg (prompt-colorify (cdr (prompt-assqd 'foreground prompt-attr (car prompt-color)))))
- (bg (prompt-colorify (cdr (prompt-assqd 'background prompt-attr (cdr prompt-color)))))
- (font (prompt-fontify (cdr (prompt-assqd 'font prompt-attr prompt-font))))
- )
- (display-message
+ prompt-result))
+ (completions (prompt-format-completions)))
+ (let
+ ((fg (prompt-colorify
+ (cdr (prompt-assqd 'foreground prompt-attr
+ (car prompt-color)))))
+ (bg (prompt-colorify
+ (cdr (prompt-assqd 'background prompt-attr
+ (cdr prompt-color)))))
+ (font (prompt-fontify
+ (cdr (prompt-assqd 'font prompt-attr prompt-font)))))
+ (display-message
(concat completions
- (when completions "\n\n")
- prompt-prompt
- (substring result 0 prompt-position)
- ?| (substring result prompt-position))
- `((position . ,prompt-window-position)
- (foreground . ,fg)
- (background . ,bg)
- (font . , font)
- )))))
+ (when completions "\n\n")
+ prompt-prompt
+ (substring result 0 prompt-position)
+ ?| (substring result prompt-position))
+ `((position . ,prompt-window-position)
+ (foreground . ,fg)
+ (background . ,bg)
+ (font . , font)
+ )))))
;; Insert all unbound keys to result.
(defun prompt-unbound-callback ()
@@ -364,7 +366,7 @@ displayed. See the `display-message' function for more details.")
(display-message nil)))))
(defun prompt-for-symbol (#!optional title predicate validator)
- (let ((prompt-completion-fun
+ (let ((prompt-completion-fun
(lambda (x)
(mapcar symbol-name
(apropos (concat ?^ (quote-regexp x)) predicate))))
diff --git a/lisp/sawfish/wm/util/recolor-image.jl b/lisp/sawfish/wm/util/recolor-image.jl
index e72e4d9..ed6b743 100644
--- a/lisp/sawfish/wm/util/recolor-image.jl
+++ b/lisp/sawfish/wm/util/recolor-image.jl
@@ -1,27 +1,24 @@
-#| recolor-image.jl -- simple code for recolouring images
-
- $Id$
-
- Copyright (C) 2001 Eazel, Inc.
-
- This file is part of sawfish.
-
- sawfish 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.
-
- sawfish 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 sawfish; see the file COPYING. If not, write to
- the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-
- Authors: John Harper <jsh eazel com>
-|#
+;; recolor-image.jl -- simple code for recolouring images
+;;
+;; Copyright (C) 2001 Eazel, Inc.
+;;
+;; This file is part of sawfish.
+;;
+;; sawfish 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.
+;;
+;; sawfish 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 sawfish; see the file COPYING. If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;;
+;; Authors: John Harper <jsh eazel com>
;; this module is marked as being fully-safe, so don't add any
;; dangerous functions!
@@ -78,17 +75,17 @@
(red-rest red-luts)
(green-rest green-luts)
(blue-rest blue-luts))
- (when rest
- (let ((index (nth (car rest) pixel)))
- (if (not (zerop index))
- (list (aref (car red-rest) index)
- (aref (car green-rest) index)
- (aref (car blue-rest) index)
- (nth alpha-channel pixel))
- (loop (cdr rest)
- (cdr red-rest)
- (cdr green-rest)
- (cdr blue-rest))))))))
+ (when rest
+ (let ((index (nth (car rest) pixel)))
+ (if (not (zerop index))
+ (list (aref (car red-rest) index)
+ (aref (car green-rest) index)
+ (aref (car blue-rest) index)
+ (nth alpha-channel pixel))
+ (loop (cdr rest)
+ (cdr red-rest)
+ (cdr green-rest)
+ (cdr blue-rest))))))))
image))))
(define (make-image-recolorer color #!key
diff --git a/lisp/sawfish/wm/util/rects.jl b/lisp/sawfish/wm/util/rects.jl
index ed8af59..3ec8777 100644
--- a/lisp/sawfish/wm/util/rects.jl
+++ b/lisp/sawfish/wm/util/rects.jl
@@ -1,5 +1,4 @@
;; rects.jl -- rectangle manipulation
-;; $Id: rects.jl,v 1.15 2002/04/24 06:57:05 jsh Exp $
;; Copyright (C) 1999 John Harper <john dcs warwick ac uk>
@@ -117,7 +116,7 @@ result is prepended to it."
result)))
;; Completely covered.
(t result))))
-
+
(define (rectangles-from-grid x-points y-points #!optional pred)
"The two lists of integers X-POINTS and Y-POINTS define a rectangular
grid. Return the complete list of rectangles formed by the
@@ -181,14 +180,14 @@ a cons cell `(X-POINTS . Y-POINTS)' defining the grid they represent.
If WITH-ROOT is non-nil, then add the root window boundaries to the
grid."
- (let ((x-edges (nconc (mapcar car rects)
- (mapcar (lambda (x) (nth 2 x)) rects)))
- (y-edges (nconc (mapcar (lambda (x) (nth 1 x)) rects)
- (mapcar (lambda (x) (nth 3 x)) rects))))
- (when with-root
- (setq x-edges (cons 0 (nconc x-edges (list (screen-width)))))
- (setq y-edges (cons 0 (nconc y-edges (list (screen-height))))))
- (cons (uniquify-list x-edges) (uniquify-list y-edges))))
+ (let ((x-edges (nconc (mapcar car rects)
+ (mapcar (lambda (x) (nth 2 x)) rects)))
+ (y-edges (nconc (mapcar (lambda (x) (nth 1 x)) rects)
+ (mapcar (lambda (x) (nth 3 x)) rects))))
+ (when with-root
+ (setq x-edges (cons 0 (nconc x-edges (list (screen-width)))))
+ (setq y-edges (cons 0 (nconc y-edges (list (screen-height))))))
+ (cons (uniquify-list x-edges) (uniquify-list y-edges))))
(define (rectangle-area rect)
"Given a rectangle RECT, return its area."
@@ -283,10 +282,10 @@ DIMS and POINT, and the list of rectangles RECTS when placed at POINT."
"Return the number of screen heads that rectangle RECT appears on."
(let loop ((head 0)
(count 0))
- (if (= head (head-count))
- count
- (loop (1+ head)
- (if (> (rect-2d-overlap (head-dimensions head)
- (head-offset head) rect) 0)
- (1+ count)
- count))))))
+ (if (= head (head-count))
+ count
+ (loop (1+ head)
+ (if (> (rect-2d-overlap (head-dimensions head)
+ (head-offset head) rect) 0)
+ (1+ count)
+ count))))))
diff --git a/lisp/sawfish/wm/util/stacking.jl b/lisp/sawfish/wm/util/stacking.jl
index df3583f..6a56e97 100644
--- a/lisp/sawfish/wm/util/stacking.jl
+++ b/lisp/sawfish/wm/util/stacking.jl
@@ -1,27 +1,24 @@
-#| stacking.jl -- customizable stacking functions
-
- $Id: stacking.jl,v 1.5 2002/04/20 20:59:20 jsh Exp $
-
- Copyright (C) 2000 Eazel, Inc
-
- Author: John Harper <jsh eazel com>
-
- This file is part of sawfish.
-
- sawfish 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.
-
- sawfish 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 sawfish; see the file COPYING. If not, write to
- the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-|#
+;; stacking.jl -- customizable stacking functions
+;;
+;; Copyright (C) 2000 Eazel, Inc
+;;
+;; Author: John Harper <jsh eazel com>
+;;
+;; This file is part of sawfish.
+;;
+;; sawfish 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.
+;;
+;; sawfish 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 sawfish; see the file COPYING. If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
(define-structure sawfish.wm.util.stacking
@@ -47,22 +44,25 @@
:group (misc stacking))
(define (raise-window* w)
- "Raise the window to its highest allowed position in the stacking order."
+ "Raise the window to its highest allowed position in the stacking
+order."
(case user-raise-type
((transients) (raise-window-and-transients w))
((group) (raise-group w))
(t (raise-window w))))
(define (lower-window* w)
- "Lower the window to its lowest allowed position in the stacking order."
+ "Lower the window to its lowest allowed position in the stacking
+order."
(case user-raise-type
((transients) (lower-window-and-transients w))
((group) (lower-group w))
(t (lower-window w))))
(define (raise-lower-window* w)
- "If the window is at its highest possible position, then lower it to its
-lowest possible position. Otherwise raise it as far as allowed."
+ "If the window is at its highest possible position, then lower it
+to its lowest possible position. Otherwise raise it as far as
+allowed."
(case user-raise-type
((transients) (raise-lower-window-and-transients w))
((group) (raise-lower-group w))
@@ -75,8 +75,9 @@ lowest possible position. Otherwise raise it as far as allowed."
;;; application-assisted stacking functions
(define (maybe-raise-window w)
- "If window W supports the _SAWFISH_WM_RAISE_WINDOW protocol, ask it whether
-it wants to raise itself or not. Else, raise the window unconditionally."
+ "If window W supports the _SAWFISH_WM_RAISE_WINDOW protocol, ask
+it whether it wants to raise itself or not. Else, raise the window
+unconditionally."
;; this only works symmetrically because the configure handler
;; uses raise-window*
@@ -90,8 +91,9 @@ it wants to raise itself or not. Else, raise the window unconditionally."
(raise-window* w)))
(define (maybe-lower-window w)
- "If window W supports the _SAWFISH_WM_LOWER_WINDOW protocol, ask it whether
-it wants to lower itself or not. Else, lower the window unconditionally."
+ "If window W supports the _SAWFISH_WM_LOWER_WINDOW protocol, ask
+it whether it wants to lower itself or not. Else, lower the window
+unconditionally."
;; this only works symmetrically because the configure handler
;; uses lower-window*
diff --git a/lisp/sawfish/wm/util/window-order.jl b/lisp/sawfish/wm/util/window-order.jl
index 5de4459..341d8d2 100644
--- a/lisp/sawfish/wm/util/window-order.jl
+++ b/lisp/sawfish/wm/util/window-order.jl
@@ -1,5 +1,4 @@
;; window-order.jl -- keep track of recently accessed windows
-;; $Id: window-order.jl,v 1.21 2002/04/23 07:43:52 jsh Exp $
;; Copyright (C) 1999 John Harper <john dcs warwick ac uk>
@@ -88,11 +87,11 @@
WINDOWS argument is given it should be a list of windows, in this case the
function will restrict its search to the elements of this list."
(let loop ((rest (window-order current-workspace nil)))
- (cond ((null rest) nil)
- ((or (window-get (car rest) 'never-focus)
- (and (listp windows) (not (memq (car rest) windows))))
- (loop (cdr rest)))
- (t (car rest)))))
+ (cond ((null rest) nil)
+ ((or (window-get (car rest) 'never-focus)
+ (and (listp windows) (not (memq (car rest) windows))))
+ (loop (cdr rest)))
+ (t (car rest)))))
(define (window-order-focus-most-recent)
(set-input-focus (window-order-most-recent)))
diff --git a/lisp/sawfish/wm/util/window-outline.jl b/lisp/sawfish/wm/util/window-outline.jl
index 652048e..8962bac 100644
--- a/lisp/sawfish/wm/util/window-outline.jl
+++ b/lisp/sawfish/wm/util/window-outline.jl
@@ -1,5 +1,4 @@
;; window-outline.jl -- drawing window `rubber-band' outlines
-;; $Id: window-outline.jl,v 1.5 2000/07/28 21:51:54 john Exp $
;; Copyright (C) 2000 John Harper <john dcs warwick ac uk>
@@ -44,8 +43,8 @@
;;; entry points
(define (draw-window-outline mode x y width height)
- "Draw an outline of a window of dimensions (WIDTH, HEIGHT) at position
-(X, Y) relative to the root window.
+ "Draw an outline of a window of dimensions (WIDTH, HEIGHT) at
+position (X, Y) relative to the root window.
MODE is a symbol defining the type of outline drawn, currently it may
only be `box' for a 3x3 grid.
@@ -59,11 +58,10 @@ grabbed until the outline is erased."
(fun x y width height))))
(defun erase-window-outline (mode x y width height)
- "Erase a previously drawn outline of a window of dimensions (WIDTH, HEIGHT)
-at position (X, Y) relative to the root window. See `draw-window-outline'.
-
-MODE is a symbol defining the type of outline drawn, currently it may
-only be `box' for a 3x3 grid."
+ "Erase a previously drawn outline of a window of dimensions (WIDTH,
+HEIGHT) at position (X, Y) relative to the root window. See
+`draw-window-outline'. MODE is a symbol defining the type of outline
+drawn, currently it may only be `box' for a 3x3 grid."
(draw-window-outline mode x y width height))
diff --git a/lisp/sawfish/wm/util/with-output.jl b/lisp/sawfish/wm/util/with-output.jl
index 874259d..2bdafd5 100644
--- a/lisp/sawfish/wm/util/with-output.jl
+++ b/lisp/sawfish/wm/util/with-output.jl
@@ -1,5 +1,4 @@
;; with-output.jl -- call a command/function redirecting stdout
-;; $Id: with-output.jl,v 1.7 2000/09/11 07:44:42 john Exp $
;; Copyright (C) 2000 John Harper <john dcs warwick ac uk>
diff --git a/lisp/sawfish/wm/util/workarea.jl b/lisp/sawfish/wm/util/workarea.jl
index 4aedf31..b1a15c9 100644
--- a/lisp/sawfish/wm/util/workarea.jl
+++ b/lisp/sawfish/wm/util/workarea.jl
@@ -1,27 +1,24 @@
-#| workarea.jl -- calculating the usable region of a head
-
- $Id$
-
- Author: John Harper <jsh unfactored org>
-
- Copyright (C) 2002 John Harper
-
- This file is part of sawfish.
-
- sawfish 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.
-
- sawfish 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 sawfish; see the file COPYING. If not, write to
- the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-|#
+;; workarea.jl -- calculating the usable region of a head
+;;
+;; Author: John Harper <jsh unfactored org>
+;;
+;; Copyright (C) 2002 John Harper
+;;
+;; This file is part of sawfish.
+;;
+;; sawfish 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.
+;;
+;; sawfish 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 sawfish; see the file COPYING. If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
(define-structure sawfish.wm.util.workarea
@@ -69,15 +66,15 @@
;; or span multiple heads, or be on a different head
;; to that requested
(let loop ((rest avoided))
- (cond ((null rest) t)
- ((or (> (rect-2d-overlap
- (window-frame-dimensions (car rest))
- (window-position (car rest))
- rect) 0)
- (/= (rectangle-heads rect) 1)
- (and head (/= head (find-head (car rect) (cadr rect)))))
- nil)
- (t (loop (cdr rest))))))
+ (cond ((null rest) t)
+ ((or (> (rect-2d-overlap
+ (window-frame-dimensions (car rest))
+ (window-position (car rest))
+ rect) 0)
+ (/= (rectangle-heads rect) 1)
+ (and head (/= head (find-head (car rect) (cadr rect)))))
+ nil)
+ (t (loop (cdr rest))))))
(let* ((grid (grid-from-edges (car edges) (cdr edges)))
;; find all possible rectangles
@@ -95,10 +92,10 @@
max-rect)))
(define (calculate-workarea #!key window head)
- "Return the rectangle representing the largest rectangle on the screen that
-doesn't overlap any avoided windows, or nil. If HEAD is true, then an
-empty workarea will be replaced with the area of HEAD, not the current
-head (of WINDOW)."
+ "Return the rectangle representing the largest rectangle on the
+screen that doesn't overlap any avoided windows, or nil. If HEAD is
+true, then an empty workarea will be replaced with the area of HEAD,
+not the current head (of WINDOW)."
(unless head
(setq head (current-head window)))
(let* ((avoided (avoided-windows window))
@@ -110,7 +107,7 @@ head (of WINDOW)."
;; Find the rectangle covering the current head
(head-rect (rectangle-from-coords (head-offset head)
(head-dimensions head)))
- ;; Find the largest rectangle
+ ;; Find the largest rectangle
(rect (or (largest-rectangle-from-edges
edges #:avoided avoided #:head head) head-rect)))
;; Shrink that to the union of all struts
diff --git a/lisp/sawfish/wm/viewport.jl b/lisp/sawfish/wm/viewport.jl
index 5cfb152..c9f8297 100644
--- a/lisp/sawfish/wm/viewport.jl
+++ b/lisp/sawfish/wm/viewport.jl
@@ -1,5 +1,4 @@
;; viewport.jl -- virtual desktops
-;; $Id: viewport.jl,v 1.46 2002/04/23 03:44:18 jsh Exp $
;; Copyright (C) 1999 John Harper <john dcs warwick ac uk>
@@ -133,7 +132,8 @@ The scrolling makes a number of increments equal to `scroll-viewport-steps'."
(ystep (quotient (- y viewport-y-offset) scroll-viewport-steps))
(step-count (if (= xstep ystep 0) 0 scroll-viewport-steps)))
(while (> step-count 1)
- (warp-viewport (+ viewport-x-offset xstep) (+ viewport-y-offset ystep))
+ (warp-viewport (+ viewport-x-offset xstep)
+ (+ viewport-y-offset ystep))
(setq step-count (1- step-count)))))
(warp-viewport x y)
(call-hook 'viewport-moved-hook))
@@ -152,58 +152,57 @@ well as any windows in the current workspace."
(lambda (w)
(window-in-workspace-p w current-workspace)))))
(if windows
- (let*
- ((width (screen-width))
- (height (screen-height))
- (points
- (nconc
- (mapcar (lambda (w)
- (let ((pos (window-position w))
- (dims (window-frame-dimensions w)))
- (list (car pos)
- (cdr pos)
- (+ (car pos) (car dims))
- (+ (cdr pos) (cdr dims)))))
- windows)
- ;; Include the current screen:
- `((0 0 ,(1- width) ,(1- height)))))
- ;; The min/max values calculated below are relative to
- ;; the old logical 0,0 point of the virtual desktop:
- (old-x-origin (- viewport-x-offset))
- (old-y-origin (- viewport-y-offset))
- (x-min (- (apply min (mapcar car points)) old-x-origin))
- (y-min (- (apply min (mapcar (lambda (e) (nth 1 e)) points))
- old-y-origin))
- (x-max (- (apply max (mapcar (lambda (e) (nth 2 e)) points))
- old-x-origin))
- (y-max (- (apply max (mapcar (lambda (e) (nth 3 e)) points))
- old-y-origin))
- ;; high-* values are the number of rows/columns above
- ;; the old origin, low-* values the number below the
- ;; old origin.
- (high-rows (+ (quotient y-max height)
- (if (> (mod y-max height) 0)
- 1
- 0)))
- (low-rows (+ (- (quotient y-min height))
- (if (and (< y-min 0)
- (> (mod y-min height) 0))
- 1
- 0)))
- (rows (+ low-rows high-rows))
- (high-cols (+ (quotient x-max width)
- (if (> (mod x-max width) 0)
- 1
- 0)))
- (low-cols (+ (- (quotient x-min width))
- (if (and (< x-min 0)
- (> (mod x-min width) 0))
- 1
- 0)))
- (cols (+ low-cols high-cols)))
+ (let* ((width (screen-width))
+ (height (screen-height))
+ (points
+ (nconc
+ (mapcar (lambda (w)
+ (let ((pos (window-position w))
+ (dims (window-frame-dimensions w)))
+ (list (car pos)
+ (cdr pos)
+ (+ (car pos) (car dims))
+ (+ (cdr pos) (cdr dims)))))
+ windows)
+ ;; Include the current screen:
+ `((0 0 ,(1- width) ,(1- height)))))
+ ;; The min/max values calculated below are relative to
+ ;; the old logical 0,0 point of the virtual desktop:
+ (old-x-origin (- viewport-x-offset))
+ (old-y-origin (- viewport-y-offset))
+ (x-min (- (apply min (mapcar car points)) old-x-origin))
+ (y-min (- (apply min (mapcar (lambda (e) (nth 1 e)) points))
+ old-y-origin))
+ (x-max (- (apply max (mapcar (lambda (e) (nth 2 e)) points))
+ old-x-origin))
+ (y-max (- (apply max (mapcar (lambda (e) (nth 3 e)) points))
+ old-y-origin))
+ ;; high-* values are the number of rows/columns above
+ ;; the old origin, low-* values the number below the
+ ;; old origin.
+ (high-rows (+ (quotient y-max height)
+ (if (> (mod y-max height) 0)
+ 1
+ 0)))
+ (low-rows (+ (- (quotient y-min height))
+ (if (and (< y-min 0)
+ (> (mod y-min height) 0))
+ 1
+ 0)))
+ (rows (+ low-rows high-rows))
+ (high-cols (+ (quotient x-max width)
+ (if (> (mod x-max width) 0)
+ 1
+ 0)))
+ (low-cols (+ (- (quotient x-min width))
+ (if (and (< x-min 0)
+ (> (mod x-min width) 0))
+ 1
+ 0)))
+ (cols (+ low-cols high-cols)))
(setq
- viewport-y-offset (- (- old-y-origin (* low-rows height)))
- viewport-x-offset (- (- old-x-origin (* low-cols width)))
+ viewport-y-offset (- (- old-y-origin (* low-rows height)))
+ viewport-x-offset (- (- old-x-origin (* low-cols width)))
viewport-dimensions (cons
(max cols
(car viewport-minimum-dimensions))
@@ -249,9 +248,9 @@ viewport is within `viewport-dimensions'."
;; Do maybe-y-offset and maybe-x-offset fit within
;; current viewport-dimensions?
(if (and (<= maybe-y-offset
- (* (1- (car viewport-dimensions)) (screen-height)))
+ (* (1- (car viewport-dimensions)) (screen-height)))
(<= maybe-x-offset
- (* (1- (cdr viewport-dimensions)) (screen-width))))
+ (* (1- (cdr viewport-dimensions)) (screen-width))))
(setq viewport-y-offset maybe-y-offset
viewport-x-offset maybe-x-offset)
(setq viewport-y-offset 0
@@ -264,7 +263,7 @@ viewport is within `viewport-dimensions'."
viewport-enter-workspace-handler)
-;; screen sized viewport handling
+;;; screen sized viewport handling
(define (screen-viewport)
(cons (quotient viewport-x-offset (screen-width))
@@ -387,7 +386,7 @@ viewport is within `viewport-dimensions'."
(set-screen-viewport (min (car port) (1- (car viewport-dimensions)))
(min (cdr port) (1- (cdr viewport-dimensions))))
(map-windows (lambda (w)
- (when (and (window-outside-workspace-p w)
+ (when (and (window-outside-workspace-p w)
(window-appears-in-workspace-p
w current-workspace))
(move-window-to-current-viewport w))))
@@ -396,8 +395,10 @@ viewport is within `viewport-dimensions'."
(define (viewport-minimum-size-changed)
(if (eq viewport-boundary-mode 'dynamic)
(viewport-dynamic-resize)
- (when (or (< (car viewport-dimensions) (car viewport-minimum-dimensions))
- (< (cdr viewport-dimensions) (cdr viewport-minimum-dimensions)))
+ (when (or (< (car viewport-dimensions)
+ (car viewport-minimum-dimensions))
+ (< (cdr viewport-dimensions)
+ (cdr viewport-minimum-dimensions)))
(setq viewport-dimensions
(cons (max (car viewport-dimensions)
(car viewport-minimum-dimensions))
@@ -440,7 +441,7 @@ viewport is within `viewport-dimensions'."
(>= (car pos) right)
(>= (cdr pos) bottom)))))))))
-;; commands
+;;; commands
(define (activate-viewport x y)
"Select the specified viewport."
@@ -509,29 +510,41 @@ viewport is within `viewport-dimensions'."
(window-put window 'sticky-viewport nil))))
(define (move-window-left w)
- "Move the window to the viewport on the left, and switch to that viewport."
+ "Move the window to the viewport on the left, and switch to that
+viewport."
(move-window-to-viewport-and-move-viewport w -1 0))
(define (move-window-right w)
- "Move the window to the viewport on the right, and switch to that viewport."
+ "Move the window to the viewport on the right, and switch to that
+viewport."
(move-window-to-viewport-and-move-viewport w 1 0))
(define (move-window-down w)
- "Move the window to the viewport below, and switch to that viewport."
+ "Move the window to the viewport below, and switch to that
+viewport."
(move-window-to-viewport-and-move-viewport w 0 1))
(define (move-window-up w)
- "Move the window to the viewport above, and switch to that viewport."
+ "Move the window to the viewport above, and switch to that
+viewport."
(move-window-to-viewport-and-move-viewport w 0 -1))
- (define-command 'move-viewport-right move-viewport-right #:class 'default)
- (define-command 'move-viewport-left move-viewport-left #:class 'default)
- (define-command 'move-viewport-up move-viewport-up #:class 'default)
- (define-command 'move-viewport-down move-viewport-down #:class 'default)
- (define-command 'move-window-right move-window-right #:spec "%W" #:class 'default)
- (define-command 'move-window-left move-window-left #:spec "%W" #:class 'default)
- (define-command 'move-window-up move-window-up #:spec "%W" #:class 'default)
- (define-command 'move-window-down move-window-down #:spec "%W" #:class 'default)
+ (define-command 'move-viewport-right move-viewport-right
+ #:class 'default)
+ (define-command 'move-viewport-left move-viewport-left
+ #:class 'default)
+ (define-command 'move-viewport-up move-viewport-up
+ #:class 'default)
+ (define-command 'move-viewport-down move-viewport-down
+ #:class 'default)
+ (define-command 'move-window-right move-window-right #:spec "%W"
+ #:class 'default)
+ (define-command 'move-window-left move-window-left #:spec "%W"
+ #:class 'default)
+ (define-command 'move-window-up move-window-up #:spec "%W"
+ #:class 'default)
+ (define-command 'move-window-down move-window-down #:spec "%W"
+ #:class 'default)
;;; session management, config
diff --git a/lisp/sawfish/wm/window-anim.jl b/lisp/sawfish/wm/window-anim.jl
index ae931d5..c478b7b 100644
--- a/lisp/sawfish/wm/window-anim.jl
+++ b/lisp/sawfish/wm/window-anim.jl
@@ -1,5 +1,4 @@
;; window-anim.jl -- visual feedback for window actions
-;; $Id: window-anim.jl,v 1.6 2002/04/21 04:52:13 jsh Exp $
;; Copyright (C) 2000 John Harper <john dcs warwick ac uk>
diff --git a/lisp/sawfish/wm/windows.jl b/lisp/sawfish/wm/windows.jl
index 84e9d84..4aa3480 100644
--- a/lisp/sawfish/wm/windows.jl
+++ b/lisp/sawfish/wm/windows.jl
@@ -1,25 +1,22 @@
-#| windows.jl -- miscellaneous window mgmt functions
-
- $Id: windows.jl,v 1.32 2003/03/27 06:30:30 jsh Exp $
-
- Copyright (C) 2000 John Harper <john dcs warwick ac uk>
-
- This file is part of sawfish.
-
- sawfish 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.
-
- sawfish 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 sawfish; see the file COPYING. If not, write to
- the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-|#
+;; windows.jl -- miscellaneous window mgmt functions
+;;
+;; Copyright (C) 2000 John Harper <john dcs warwick ac uk>
+;;
+;; This file is part of sawfish.
+;;
+;; sawfish 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.
+;;
+;; sawfish 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 sawfish; see the file COPYING. If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
(define-structure sawfish.wm.windows
@@ -105,8 +102,8 @@
(defvar dock-window-properties
'(window-list-skip cycle-skip fixed-position focus-click-through
- avoid no-history never-iconify never-maximize sticky
- sticky-viewport placed)
+ avoid no-history never-iconify never-maximize sticky
+ sticky-viewport placed)
"List of properties set (to true) on windows marked as docks.")
(defvar desktop-window-properties
@@ -235,9 +232,9 @@ supported by client window W."
(data (and prop (eq (car prop) 'ATOM) (nth 2 prop))))
(when data
(let loop ((i 0))
- (cond ((= i (length data)) nil)
- ((eq (aref data i) atom) t)
- (t (loop (1+ i))))))))
+ (cond ((= i (length data)) nil)
+ ((eq (aref data i) atom) t)
+ (t (loop (1+ i))))))))
;;; warping
@@ -255,14 +252,18 @@ specified by the user."
(setq x
(if (< (car warp-to-window-offset) 0)
(car warp-to-window-offset)
- (quotient (* (car dims) (car warp-to-window-offset)) 100))))
+ (quotient (* (car dims)
+ (car warp-to-window-offset)) 100))))
(unless y
(setq y (if (< (cdr warp-to-window-offset) 0)
(cdr warp-to-window-offset)
- (quotient (* (cdr dims) (cdr warp-to-window-offset)) 100))))
+ (quotient (* (cdr dims)
+ (cdr warp-to-window-offset)) 100))))
(warp-cursor
- (max 0 (min (1- (screen-width)) (+ x (car coords) (- (car foff)))))
- (max 0 (min (1- (screen-height)) (+ y (cdr coords) (- (cdr foff)))))))))
+ (max 0 (min (1- (screen-width))
+ (+ x (car coords) (- (car foff)))))
+ (max 0 (min (1- (screen-height))
+ (+ y (cdr coords) (- (cdr foff)))))))))
(define (activate-window w)
(require 'sawfish.wm.focus)
@@ -300,11 +301,11 @@ specified by the user."
(clamp old-b (floor (/ a max-ratio)) (floor (/ a min-ratio))))))
(define (resize-window-with-hints w cols rows #!optional hints)
- "Resize window W to COLS x ROWS, using the window's size hints to define
-the row and column size, and the minimum possible size.
+ "Resize window W to COLS x ROWS, using the window's size hints to
+define the row and column size, and the minimum possible size.
-If HINTS is non-nil, then it is the size hints structure to use. Otherwise
-(window-size-hints W) is used."
+If HINTS is non-nil, then it is the size hints structure to
+use. Otherwise (window-size-hints W) is used."
(unless hints
(setq hints (window-size-hints w)))
(let ((x-base (or (cdr (or (assq 'base-width hints)
@@ -318,13 +319,13 @@ If HINTS is non-nil, then it is the size hints structure to use. Otherwise
(constrain-dimension-to-hints (+ y-base (* y-inc rows)) 'y hints))))
(define (resize-window-with-hints* w width height #!optional hints)
- "Resize window W to WIDTH x HEIGHT, with WIDTH and HEIGHT defined in
-terms of pixels. The window's size hints structure defines the minimum
-and maximum dimensions of the window, within which WIDTH and HEIGHT are
-constrained.
+ "Resize window W to WIDTH x HEIGHT, with WIDTH and HEIGHT defined
+in terms of pixels. The window's size hints structure defines the
+minimum and maximum dimensions of the window, within which WIDTH and
+HEIGHT are constrained.
-If HINTS is non-nil, then it is the size hints structure to use. Otherwise
-(window-size-hints W) is used."
+If HINTS is non-nil, then it is the size hints structure to
+use. Otherwise (window-size-hints W) is used."
(unless hints
(setq hints (window-size-hints w)))
(resize-window-to w (constrain-dimension-to-hints width 'x hints)
@@ -422,12 +423,13 @@ string `uniquify-name-format' to generate unique names."
(define-command 'uniquify-window-name uniquify-window-name #:spec "%W")
-;; selecting a single window
+;;; selecting a single window
(define select-window-map
(bind-keys (make-keymap)
- "Any-Click1" (lambda ()
- (throw 'select-window (query-pointer-window)))))
+ "Any-Click1" (lambda ()
+ (throw 'select-window
+ (query-pointer-window)))))
(defvar select-window-cursor-shape 'crosshair)
@@ -477,9 +479,9 @@ this substitution occurs. Those themes should really be fixed."
(cons (cond ((listp prop) prop)
((eq prop 'WM_NAME)
(format standard-error
-"(call-after-property-changed 'WM_NAME ...) should probably be
-(call-after-property-changed '(WM_NAME _NET_WM_NAME) ...);
-use '(WM_NAME) if you really want only WM_NAME\n")
+" (call-after-property-changed 'WM_NAME ...) should probably be
+ (call-after-property-changed '(WM_NAME _NET_WM_NAME) ...);
+Use '(WM_NAME) if you really want only WM_NAME\n")
'(WM_NAME _NET_WM_NAME))
(t (list prop)))
fun)
@@ -506,14 +508,13 @@ STATES has been changed. STATES may also be a single symbol."
'window-state-change-hook
(lambda (w states)
(mapc (lambda (cell)
- (let
- ((relevant (filter (lambda (state)
- (memq state (car cell))) states)))
+ (let ((relevant (filter (lambda (state)
+ (memq state (car cell))) states)))
(when relevant
((cdr cell) w relevant))))
- state-changes)))
+ state-changes)))
-;; gaollable functions
+ ;;; gaollable functions
(gaol-add window-really-wants-input-p window-class window-avoided-p
call-after-property-changed call-after-state-changed
diff --git a/lisp/sawfish/wm/workspace.jl b/lisp/sawfish/wm/workspace.jl
index 97e1fde..7604b1a 100644
--- a/lisp/sawfish/wm/workspace.jl
+++ b/lisp/sawfish/wm/workspace.jl
@@ -1,5 +1,4 @@
;; workspace.jl -- similar to virtual desktops
-;; $Id: workspace.jl,v 1.162 2003/04/03 02:50:12 jsh Exp $
;; Copyright (C) 1999 John Harper <john dcs warwick ac uk>
@@ -127,7 +126,8 @@
:group workspace)
(defcustom workspace-send-boundary-mode 'stop
- "How to act when passing the first or last workspace, while moving a window"
+ "How to act when passing the first or last workspace, while moving
+a window"
:type (choice stop wrap-around keep-going)
:group workspace)
@@ -412,9 +412,11 @@
(setq index current-workspace))
(when (> current-workspace index)
(setq current-workspace (1- current-workspace)))
- (when (and first-interesting-workspace (> first-interesting-workspace index))
+ (when (and first-interesting-workspace
+ (> first-interesting-workspace index))
(setq first-interesting-workspace (1- first-interesting-workspace)))
- (when (and last-interesting-workspace (> last-interesting-workspace index))
+ (when (and last-interesting-workspace
+ (> last-interesting-workspace index))
(setq last-interesting-workspace (1- last-interesting-workspace)))
(map-windows
(lambda (w)
@@ -453,7 +455,7 @@
((= space index)
(+ space count))
((>= space (+ index count))
- (1+ space))
+ (1+ space))
(t space))) w)))
(cond ((= current-workspace index)
(setq current-workspace (+ current-workspace count)))
@@ -477,7 +479,8 @@
(define (move-window-to-workspace w old new #!optional was-focused)
(or (window-in-workspace-p w old)
(error
- "move-window-to-workspace--window isn't in original workspace: %s, %s" w old))
+ "move-window-to-workspace--window isn't in original workspace: %s, %s"
+ w old))
(unless (= old new)
(cond ((window-in-workspace-p w new)
;; just remove from the source workspace
@@ -503,7 +506,8 @@
(define (copy-window-to-workspace w old new #!optional was-focused)
(or (window-in-workspace-p w old)
(error
- "copy-window-to-workspace--window isn't in original workspace: %s, %s" w old))
+ "copy-window-to-workspace--window isn't in original workspace: %s, %s"
+ w old))
(unless (= old new)
(unless (window-in-workspace-p w new)
(window-add-to-workspace w new))
@@ -566,7 +570,8 @@
(call-hook 'workspace-state-change-hook))))
(define (select-workspace space #!optional dont-focus inner-thunk)
- (select-workspace* space #:dont-focus dont-focus #:inner-thunk inner-thunk))
+ (select-workspace* space #:dont-focus dont-focus
+ #:inner-thunk inner-thunk))
;; return a list of all windows on workspace index SPACE
(define (workspace-windows
@@ -739,7 +744,8 @@
w orig-space (1+ (cdr limits)) was-focused)))))
(define (prepend-workspace-and-send w #!optional select)
- "Create a new workspace at the start of the list, and move the window to it."
+ "Create a new workspace at the start of the list, and move the
+window to it."
(let ((limits (workspace-limits))
(was-focused (eq (input-focus) w))
(orig-space (if (window-in-workspace-p w current-workspace)
@@ -880,7 +886,7 @@ last instance remaining, then delete the actual window."
(define-command 'show-desktop show-desktop)
(define-command 'hide-desktop hide-desktop)
-;; some commands for moving directly to a workspace
+;;; some commands for moving directly to a workspace
(define (activate-workspace n)
"Select the N'th workspace."
@@ -970,17 +976,18 @@ last instance remaining, then delete the actual window."
;; display WS name on switch
(define (display-workspace-name)
(display-message-with-timeout
- (format nil "Now on Workspace: %s"
- (or (nth current-workspace workspace-names)
- (format nil (_ "Workspace %d") (1+ current-workspace))))
- display-ws-name-timeout))
+ (format nil "Now on Workspace: %s"
+ (or (nth current-workspace workspace-names)
+ (format nil (_ "Workspace %d") (1+ current-workspace))))
+ display-ws-name-timeout))
(define (display-ws-name-setter)
(if (eq display-ws-name-on-switch 't)
- (add-hook 'enter-workspace-hook display-workspace-name)
+ (add-hook 'enter-workspace-hook display-workspace-name)
(remove-hook 'enter-workspace-hook display-workspace-name)))
- (define-command 'display-workspace-name display-workspace-name #:class 'default)
+ (define-command 'display-workspace-name display-workspace-name
+ #:class 'default)
;;; Initialisation
diff --git a/scripts/sawfish-client.jl b/scripts/sawfish-client.jl
index 9a10caa..4b03cab 100644
--- a/scripts/sawfish-client.jl
+++ b/scripts/sawfish-client.jl
@@ -2,28 +2,27 @@
exec rep "$0" "$@"
!#
-#| sawfish-client.jl -- window manager remote client
-
- $Id$
-
- Copyright (C) 2000 John Harper <john dcs warwick ac uk>
-
- This file is part of sawmill.
-
- sawmill 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.
-
- sawmill 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 sawmill; see the file COPYING. If not, write to
- the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-|#
+;; sawfish-client.jl -- window manager remote client
+;;
+;; $Id$
+;;
+;; Copyright (C) 2000 John Harper <john dcs warwick ac uk>
+;;
+;; This file is part of sawmill.
+;;
+;; sawmill 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.
+;;
+;; sawmill 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 sawmill; see the file COPYING. If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
(require 'sawfish.client)
@@ -35,22 +34,22 @@ usage: sawfish-client OPTIONS...
where OPTIONS are any of:
- --display X Connect to the window manager on display X
- -q Be quiet (perform commands asynchronously)
- -f FUNCTION Call Lisp function FUNCTION on the server
- -c COMMAND Call the interactive Lisp function COMMAND
- -r FEATURE Require the module called FEATURE
- -e FORM Evaluate Lisp form FORM on the server
- - Read lines of input until EOF, evaluating each
- one as it is read
- -- Read forms from standard input until EOF, evaluating
- the whole lot in one go (inside a progn)\n"))
+ --display X Connect to the window manager on display X
+ -q Be quiet (perform commands asynchronously)
+ -f FUNCTION Call Lisp function FUNCTION on the server
+ -c COMMAND Call the interactive Lisp function COMMAND
+ -r FEATURE Require the module called FEATURE
+ -e FORM Evaluate Lisp form FORM on the server
+ - Read lines of input until EOF, evaluating each
+ one as it is read
+ -- Read forms from standard input until EOF, evaluating
+ the whole lot in one go (inside a progn)\n"))
(define (exit n) (throw 'quit n))
(define (main)
(let ((dpy (or (get-command-line-option "-display" t)
- (get-command-line-option "--display" t))))
+ (get-command-line-option "--display" t))))
(when dpy
(sawfish-client-display dpy)))
@@ -62,28 +61,28 @@ where OPTIONS are any of:
(define (do-eval form)
(if quiet
- (sawfish-client-eval-async form)
- (write standard-output (sawfish-client-eval form t))
- (write standard-output #\newline)))
-
+ (sawfish-client-eval-async form)
+ (write standard-output (sawfish-client-eval form t))
+ (write standard-output #\newline)))
+
(let loop ((args (or command-line-args '("-"))))
(cond ((null args))
- ((string= (car args) "-q")
- (setq quiet t)
- (loop (cdr args)))
+ ((string= (car args) "-q")
+ (setq quiet t)
+ (loop (cdr args)))
- ((string= (car args) "-d") (loop (cdr args)))
+ ((string= (car args) "-d") (loop (cdr args)))
- ((and (string= (car args) "-f") (cdr args))
- (do-eval `(,(read-from-string (cadr args))))
- (loop (cddr args)))
+ ((and (string= (car args) "-f") (cdr args))
+ (do-eval `(,(read-from-string (cadr args))))
+ (loop (cddr args)))
((and (string= (car args) "-c") (cdr args))
(do-eval `(call-command ',(read-from-string (cadr args))))
(loop (cddr args)))
- ((and (string= (car args) "-r") (cdr args))
+ ((and (string= (car args) "-r") (cdr args))
(do-eval `(require ',(read-from-string (cadr args))))
(loop (cddr args)))
@@ -143,7 +142,7 @@ sawfish comes with ABSOLUTELY NO WARRANTY; for details see the file COPYING\n"
"Try `sawfish-client --help' for more information.\n")
(exit 1))))
(exit 0)))
-
+
(define (rl-completion-generator w)
(sawfish-client-eval
`(repl-completions ',(fluid current-repl) ',w)))
diff --git a/scripts/sawfish-menu.jl b/scripts/sawfish-menu.jl
index 11c757f..582d83d 100644
--- a/scripts/sawfish-menu.jl
+++ b/scripts/sawfish-menu.jl
@@ -3,7 +3,6 @@ exec rep "$0" "$@"
!#
;; sawmill-menu -- subprocess to handle menus
-;; $Id: sawfish-menu.jl,v 1.8 2003/04/03 02:23:33 jsh Exp $
;; Copyright (C) 1999 John Harper <john dcs warwick ac uk>
@@ -101,7 +100,7 @@ exec rep "$0" "$@"
(define (popup-menu spec #!optional timestamp position)
(let ((menu (let-fluids ((group-table (make-group-table)))
- (create-menu spec))))
+ (create-menu spec))))
(g-signal-connect menu "deactivate" gtk-main-quit)
(setq menu-selected nil)
(gtk-menu-popup-interp menu nil nil 0 (or timestamp 0) position)
diff --git a/themes/Crux/theme.jl b/themes/Crux/theme.jl
index c4edafc..b8cb7c9 100644
--- a/themes/Crux/theme.jl
+++ b/themes/Crux/theme.jl
@@ -1,25 +1,22 @@
-#| theme.jl for Arlo's new theme design
-
- Copyright (C) 2001 Eazel, Inc.
-
- This program 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 of the
- License, or (at your option) any later version.
-
- This program 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 this program; if not, write to the Free Software
- Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-
- $Id: theme.jl,v 1.8 2002/03/29 04:00:23 jsh Exp $
-
- Authors: John Harper <jsh eazel com>
-|#
+;; theme.jl for Arlo's new theme design
+;;
+;; Copyright (C) 2001 Eazel, Inc.
+;;
+;; This program 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 of the
+;; License, or (at your option) any later version.
+;;
+;; This program 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 this program; if not, write to the Free Software
+;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+;;
+;; Authors: John Harper <jsh eazel com>
(require 'rep.data.tables) ;need hash tables for icon cache
(require 'sawfish.wm.util.recolor-image)
@@ -40,22 +37,25 @@
:group (appearance Crux)
:after-set (lambda () (rebuild-all)))
-(defvar Crux:button-themes '((default
- ((close-button) . (iconify-button maximize-button shade-button)))
- (platinum
- ((close-button) . (maximize-button shade-button)))
- (macos-x
- ((close-button maximize-button iconify-button)))
- (windows
- ((menu-button) . (iconify-button maximize-button close-button))
- ((menu-button)))
- (next
- ((iconify-button) . (close-button))
- ((iconify-button) . (close-button)))
- (complete
- ((close-button) . (shade-button iconify-button maximize-button menu-button)))
- (complete-inverse
- ((menu-button maximize-button iconify-button shade-button) . (close-button)))))
+(defvar Crux:button-themes
+ '((default
+ ((close-button) . (iconify-button maximize-button shade-button)))
+ (platinum
+ ((close-button) . (maximize-button shade-button)))
+ (macos-x
+ ((close-button maximize-button iconify-button)))
+ (windows
+ ((menu-button) . (iconify-button maximize-button close-button))
+ ((menu-button)))
+ (next
+ ((iconify-button) . (close-button))
+ ((iconify-button) . (close-button)))
+ (complete
+ ((close-button) . (shade-button iconify-button maximize-button
+ menu-button)))
+ (complete-inverse
+ ((menu-button maximize-button iconify-button shade-button) .
+ (close-button)))))
(defcustom Crux:button-theme 'default
"Display title buttons to mimic: \\w"
@@ -146,8 +146,10 @@
;; 32*x6
(define bottom-left-border
- (list (set-image-border (make-image "inactive:bottom-left-border.png") 0 30 0 0)
- (set-image-border (make-image "active:bottom-left-border.png") 0 30 0 0)))
+ (list (set-image-border
+ (make-image "inactive:bottom-left-border.png") 0 30 0 0)
+ (set-image-border
+ (make-image "active:bottom-left-border.png") 0 30 0 0)))
;; 16*x6
(define bottom-right-border
diff --git a/themes/Elberg-tabbed/theme.jl b/themes/Elberg-tabbed/theme.jl
index 36025ca..e9ea3b5 100644
--- a/themes/Elberg-tabbed/theme.jl
+++ b/themes/Elberg-tabbed/theme.jl
@@ -1,12 +1,12 @@
-; This USED to be the theme.jl from the microGUI theme by
-; Ryan Lovett, Ben FrantzDale, and John Harper. Big props to them, and
-; here's to hoping someone will write a decent HOWTO for sawfish-themer
-; because I really, _really_ suck at scheme coding.
+;; This USED to be the theme.jl from the microGUI theme by
+;; Ryan Lovett, Ben FrantzDale, and John Harper. Big props to them, and
+;; here's to hoping someone will write a decent HOWTO for sawfish-themer
+;; because I really, _really_ suck at scheme coding.
-; This theme is GPL, unless Ryan, Ben, or John have a problem with that.
-; I just got tired of there not being many non-hideous themes for Sawfish.
+;; This theme is GPL, unless Ryan, Ben, or John have a problem with that.
+;; I just got tired of there not being many non-hideous themes for Sawfish.
-; Modified to add tabbed windowing support by Scott Scriven.
+;; Modified to add tabbed windowing support by Scott Scriven.
(let*
;; Update window title pixel length
@@ -15,7 +15,7 @@
(let
((w-width (car (window-dimensions w))))
(max 0 (min (- w-width 100) (text-width (window-name w)))))))
-
+
;; 6x19 - upper left corner
(upper-left-images (list (make-image "i-ul.png")
(make-image "a-ul.png")))
@@ -42,7 +42,7 @@
;; 3x19 - upper grey background
(top-grey-images (list (make-image "i-t0.png")
- (make-image "a-t0.png")))
+ (make-image "a-t0.png")))
;; 17x16 - iconify icon
(iconify-images (list (make-image "i-ti.png")
@@ -141,41 +141,41 @@
(class . menu-button))
;; top curves
- ;((background . ,top-lefthollow-images)
- ; (top-edge . -19)
- ; ;(left-edge . 16)
- ; (left-edge . 0)
- ; (class . title))
+ ;;((background . ,top-lefthollow-images)
+ ;; (top-edge . -19)
+ ;; ;(left-edge . 16)
+ ;; (left-edge . 0)
+ ;; (class . title))
;; top green
- ;((background . ,top-hollow-images)
- ; (foreground . ,text-colors)
- ; (text . ,window-name)
- ; (x-justify . 4)
- ; (y-justify . center)
- ; (top-edge . -19)
- ; ;(left-edge . 27)
- ; (left-edge . 11)
- ; (width . ,(lambda (w) (+ (title-width w) 13)))
- ; ;(right-edge . 27)
- ; (class . title))
+ ;;((background . ,top-hollow-images)
+ ;; (foreground . ,text-colors)
+ ;; (text . ,window-name)
+ ;; (x-justify . 4)
+ ;; (y-justify . center)
+ ;; (top-edge . -19)
+ ;; ;(left-edge . 27)
+ ;; (left-edge . 11)
+ ;; (width . ,(lambda (w) (+ (title-width w) 13)))
+ ;; ;(right-edge . 27)
+ ;; (class . title))
;; top curves
- ;((background . ,top-righthollow-images)
- ; ;(left-edge . ,(lambda (w) (+ (title-width w) 37)))
- ; (left-edge . ,(lambda (w) (+ (title-width w) 21)))
- ; ;(right-edge . 16)
- ; (top-edge . -19)
- ; (class . title))
+ ;;((background . ,top-righthollow-images)
+ ;; ;(left-edge . ,(lambda (w) (+ (title-width w) 37)))
+ ;; (left-edge . ,(lambda (w) (+ (title-width w) 21)))
+ ;; ;(right-edge . 16)
+ ;; (top-edge . -19)
+ ;; (class . title))
;; top grey
- ;((background . ,top-grey-images)
- ; ;(left-edge . ,(lambda (w) (+ (title-width w) 48)))
- ; (left-edge . ,(lambda (w) (+ (title-width w) 32)))
- ; (top-edge . -19)
- ; ;(right-edge . 48)
- ; (right-edge . 16)
- ; (class . title))
+ ;;((background . ,top-grey-images)
+ ;; ;(left-edge . ,(lambda (w) (+ (title-width w) 48)))
+ ;; (left-edge . ,(lambda (w) (+ (title-width w) 32)))
+ ;; (top-edge . -19)
+ ;; ;(right-edge . 48)
+ ;; (right-edge . 16)
+ ;; (class . title))
;; left border
((background . ,left-side-images)
@@ -217,16 +217,16 @@
(class . bottom-right-corner))
;; iconify button
- ;((background . ,iconify-images)
- ; (right-edge . 32)
- ; (top-edge . -19)
- ; (class . iconify-button))
+ ;((background . ,iconify-images)
+ ; (right-edge . 32)
+ ; (top-edge . -19)
+ ; (class . iconify-button))
;; maximize button
- ;((background . ,maximize-images)
- ; (right-edge . 16)
- ; (top-edge . -19)
- ; (class . maximize-button))
+ ;((background . ,maximize-images)
+ ; (right-edge . 16)
+ ; (top-edge . -19)
+ ; (class . maximize-button))
;; delete button
((background . ,close-images)
@@ -244,11 +244,11 @@
(background . ,top-hollow-images)
(foreground . ,text-colors)
(top-edge . -19)
- ;(left-edge . 0)
+ ;(left-edge . 0)
(height . 19)
(text . ,window-name)
- ;(x-justify . 4)
- ;(y-justify . center)
+ ;(x-justify . 4)
+ ;(y-justify . center)
(class . tab))
;; tab right curve
@@ -259,181 +259,181 @@
))
- (shaped-frame `(((background . ,upper-left-shaped-images)
- (left-edge . -6)
- (top-edge . -19)
- (height . 19)
- (class . top-left-corner))
-
- ;; menu button
- ((background . ,menu-images)
- (top-edge . -19)
- (left-edge . 0)
- (class . menu-button))
-
- ;; top curves
- ;((background . ,top-lefthollow-images)
- ;(top-edge . -19)
- ;(left-edge . 16)
- ;(class . title))
-
- ;; Title text area
- ;((background . ,top-hollow-images)
- ;(foreground . ,text-colors)
- ;(text . ,window-name)
- ;(x-justify . 4)
- ;(y-justify . center)
- ;(top-edge . -19)
- ;(left-edge . 27)
- ;(width . ,(lambda (w) (+ (title-width w) 13)))
- ;(class . title))
-
- ;; top curves
- ;((background . ,top-righthollow-images)
- ;(left-edge . ,(lambda (w) (+ (title-width w) 37)))
- ;(top-edge . -19)
- ;(class . title))
-
- ;; top grey
- ;((background . ,top-grey-images)
- ;(left-edge . ,(lambda (w) (+ (title-width w) 48)))
- ;(top-edge . -19)
- ;(right-edge . 48)
- ;(class . title))
-
- ;; top-right corner
- ((background . ,upper-right-shaped-images)
- (right-edge . -6)
- (top-edge . -19)
- (height . 19)
- (class . top-right-corner))
-
- ;; iconify button
- ;((background . ,iconify-images)
- ;(right-edge . 32)
- ;(top-edge . -19)
- ;(class . iconify-button))
-
- ;; maximize button
- ;((background . ,maximize-images)
- ;(right-edge . 16)
- ;(top-edge . -19)
- ;(class . maximize-button))
-
- ;; delete button
- ((background . ,close-images)
- (right-edge . 0)
- (top-edge . -19)
- (class . close-button))
-
- ;; tab left curve
- ((background . ,top-lefthollow-images)
- (top-edge . -19)
- (class . tab-l))
-
- ;; tab
- (
- (background . ,top-hollow-images)
- (foreground . ,text-colors)
- (top-edge . -19)
- ;(left-edge . 0)
- (height . 19)
- (text . ,window-name)
- ;(x-justify . 4)
- ;(y-justify . center)
- (class . tab))
-
- ;; tab right curve
- ((background . ,top-righthollow-images)
- (top-edge . -19)
- (class . tab-r))
-
- ))
-
-
- (transient-frame `(((background . ,t-upper-left-images)
- (left-edge . -4)
- (top-edge . -4)
- (class . top-left-corner))
-
- ;;top-right corner
- ((background . ,t-upper-right-images)
- (right-edge . -17)
- (top-edge . -4)
- (class . top-right-corner))
-
- ;;title border
- ((background . ,t-upper-side-images)
- (left-edge . -1)
- (right-edge . -1)
- (top-edge . -4)
- (class . top-border))
-
- ;; left border
- ((background . ,t-left-images)
- (left-edge . -4)
- (top-edge . -1)
- (bottom-edge . -1)
- (class . left-border))
-
- ;; right border
- ((background . ,t-right-images)
- (right-edge . -17)
- (top-edge . -1)
- (bottom-edge . -1)
- (class . title))
-
- ;; bottom border
- ((background . ,t-bottom-side-images)
- (left-edge . -1)
- (right-edge . -1)
- (bottom-edge . -4)
- (class . bottom-border))
-
- ;; bottom-left corner
- ((background . ,t-bottom-left-images)
- (left-edge . -4)
- (bottom-edge . -4)
- (class . bottom-left-corner))
-
- ;; bottom-right corner
- ((background . ,t-bottom-right-images)
- (right-edge . -17)
- (bottom-edge . -4)
- (class . bottom-right-corner))
-
- ;; delete button
- ((background . ,t-close-images)
- (right-edge . -17)
- (top-edge . 1)
- (class . close-button))
-
- ))
-
- (shaped-transient-frame `(((background . ,t-upper-right-shaped-images)
- (right-edge . -17)
- (top-edge . -4)
- (class . top-right-corner))
-
- ;; right border
- ((background . ,t-right-images)
- (right-edge . -17)
- (top-edge . -1)
- (bottom-edge . -1)
- (class . title))
-
- ;; bottom-right corner
- ((background . ,t-bottom-right-shaped-images)
- (right-edge . -17)
- (bottom-edge . -4)
- (class . bottom-right-corner))
-
- ;; delete button
- ((background . ,t-close-images)
- (right-edge . -17)
- (top-edge . 1)
- (class . close-button)))))
-
+ (shaped-frame `(((background . ,upper-left-shaped-images)
+ (left-edge . -6)
+ (top-edge . -19)
+ (height . 19)
+ (class . top-left-corner))
+
+ ;; menu button
+ ((background . ,menu-images)
+ (top-edge . -19)
+ (left-edge . 0)
+ (class . menu-button))
+
+ ;; top curves
+ ;((background . ,top-lefthollow-images)
+ ;(top-edge . -19)
+ ;(left-edge . 16)
+ ;(class . title))
+
+ ;; Title text area
+ ;((background . ,top-hollow-images)
+ ;(foreground . ,text-colors)
+ ;(text . ,window-name)
+ ;(x-justify . 4)
+ ;(y-justify . center)
+ ;(top-edge . -19)
+ ;(left-edge . 27)
+ ;(width . ,(lambda (w) (+ (title-width w) 13)))
+ ;(class . title))
+
+ ;; top curves
+ ;((background . ,top-righthollow-images)
+ ;(left-edge . ,(lambda (w) (+ (title-width w) 37)))
+ ;(top-edge . -19)
+ ;(class . title))
+
+ ;; top grey
+ ;((background . ,top-grey-images)
+ ;(left-edge . ,(lambda (w) (+ (title-width w) 48)))
+ ;(top-edge . -19)
+ ;(right-edge . 48)
+ ;(class . title))
+
+ ;; top-right corner
+ ((background . ,upper-right-shaped-images)
+ (right-edge . -6)
+ (top-edge . -19)
+ (height . 19)
+ (class . top-right-corner))
+
+ ;; iconify button
+ ;((background . ,iconify-images)
+ ;(right-edge . 32)
+ ;(top-edge . -19)
+ ;(class . iconify-button))
+
+ ;; maximize button
+ ;((background . ,maximize-images)
+ ;(right-edge . 16)
+ ;(top-edge . -19)
+ ;(class . maximize-button))
+
+ ;; delete button
+ ((background . ,close-images)
+ (right-edge . 0)
+ (top-edge . -19)
+ (class . close-button))
+
+ ;; tab left curve
+ ((background . ,top-lefthollow-images)
+ (top-edge . -19)
+ (class . tab-l))
+
+ ;; tab
+ (
+ (background . ,top-hollow-images)
+ (foreground . ,text-colors)
+ (top-edge . -19)
+ ;(left-edge . 0)
+ (height . 19)
+ (text . ,window-name)
+ ;(x-justify . 4)
+ ;(y-justify . center)
+ (class . tab))
+
+ ;; tab right curve
+ ((background . ,top-righthollow-images)
+ (top-edge . -19)
+ (class . tab-r))
+
+ ))
+
+
+ (transient-frame `(((background . ,t-upper-left-images)
+ (left-edge . -4)
+ (top-edge . -4)
+ (class . top-left-corner))
+
+ ;;top-right corner
+ ((background . ,t-upper-right-images)
+ (right-edge . -17)
+ (top-edge . -4)
+ (class . top-right-corner))
+
+ ;;title border
+ ((background . ,t-upper-side-images)
+ (left-edge . -1)
+ (right-edge . -1)
+ (top-edge . -4)
+ (class . top-border))
+
+ ;; left border
+ ((background . ,t-left-images)
+ (left-edge . -4)
+ (top-edge . -1)
+ (bottom-edge . -1)
+ (class . left-border))
+
+ ;; right border
+ ((background . ,t-right-images)
+ (right-edge . -17)
+ (top-edge . -1)
+ (bottom-edge . -1)
+ (class . title))
+
+ ;; bottom border
+ ((background . ,t-bottom-side-images)
+ (left-edge . -1)
+ (right-edge . -1)
+ (bottom-edge . -4)
+ (class . bottom-border))
+
+ ;; bottom-left corner
+ ((background . ,t-bottom-left-images)
+ (left-edge . -4)
+ (bottom-edge . -4)
+ (class . bottom-left-corner))
+
+ ;; bottom-right corner
+ ((background . ,t-bottom-right-images)
+ (right-edge . -17)
+ (bottom-edge . -4)
+ (class . bottom-right-corner))
+
+ ;; delete button
+ ((background . ,t-close-images)
+ (right-edge . -17)
+ (top-edge . 1)
+ (class . close-button))
+
+ ))
+
+ (shaped-transient-frame `(((background . ,t-upper-right-shaped-images)
+ (right-edge . -17)
+ (top-edge . -4)
+ (class . top-right-corner))
+
+ ;; right border
+ ((background . ,t-right-images)
+ (right-edge . -17)
+ (top-edge . -1)
+ (bottom-edge . -1)
+ (class . title))
+
+ ;; bottom-right corner
+ ((background . ,t-bottom-right-shaped-images)
+ (right-edge . -17)
+ (bottom-edge . -4)
+ (class . bottom-right-corner))
+
+ ;; delete button
+ ((background . ,t-close-images)
+ (right-edge . -17)
+ (top-edge . 1)
+ (class . close-button)))))
+
(add-frame-style 'Elberg-tabbed
(lambda (w type)
(case type
@@ -443,5 +443,5 @@
((shaped-transient) shaped-transient-frame))))
(call-after-property-changed
- '(WM_NAME _NET_WM_NAME) (lambda (w prop state)
- (reframe-window w))))
+ '(WM_NAME _NET_WM_NAME) (lambda (w prop state)
+ (reframe-window w))))
diff --git a/themes/absolute-e/theme.jl b/themes/absolute-e/theme.jl
index fcdb5f6..08010c9 100644
--- a/themes/absolute-e/theme.jl
+++ b/themes/absolute-e/theme.jl
@@ -1,5 +1,4 @@
;; absolute-e/theme.jl
-;; $Id: theme.jl,v 1.11 2000/05/15 16:37:52 john Exp $
;; Copyright (C) 1999 John Harper <john dcs warwick ac uk>
@@ -46,7 +45,7 @@
(let
((w-width (car (window-dimensions w))))
(- (min (max (/ w-width 2) 100) w-width) 16))))
-
+
;; 100x16
(bar-images (mapcar (lambda (i)
(set-image-border i 4 4 4 4))
diff --git a/themes/brushed-metal/theme.jl b/themes/brushed-metal/theme.jl
index 79eced0..2ffc926 100644
--- a/themes/brushed-metal/theme.jl
+++ b/themes/brushed-metal/theme.jl
@@ -1,5 +1,4 @@
;; brushed-metal/theme.jl
-;; $Id: theme.jl,v 1.12 2000/10/09 15:42:30 john Exp $
;; Copyright (C) 1999 John Harper <john dcs warwick ac uk>
diff --git a/themes/get-S-tabbed/theme.jl b/themes/get-S-tabbed/theme.jl
index 3657995..5d4f8db 100644
--- a/themes/get-S-tabbed/theme.jl
+++ b/themes/get-S-tabbed/theme.jl
@@ -1,323 +1,320 @@
-; get-S-tabbed/theme.jl
+;; get-S-tabbed/theme.jl
;; Based off of my arctic Enlightenment theme....
(let*
- (
- ;(font (get-font "-*-lucida-medium-r-normal-*-*-100-*-*-p-*-iso8859-1"))
- ;(font (get-font "Sans 9"))
- (font default-font)
- (font-colors (list "grey50" "white"))
-
- (title-images (list (make-image "title-bar-inactive.png")
- (make-image "title-bar-active.png")))
-
- (title-left-images (list (set-image-border
- (make-image "title-left-inactive.png") 10 10 0 0)
- (set-image-border
- (make-image "title-left-active.png") 10 10 0 0)))
-
- (title-left-f-images (list (set-image-border
- (make-image "title-left-inactive-f.png") 10 10 3 1)
- (set-image-border
- (make-image "title-left-active-f.png") 10 10 3 1)))
-
- (title-left-l-images (list (make-image "title-left-inactive-l.png")
- (make-image "title-left-active-l.png")))
-
- (title-left-m-images (list (set-image-border
- (make-image "title-left-inactive-m.png") 10 10 0 0)
- (set-image-border
- (make-image "title-left-active-m.png") 10 10 0 0)))
-
- (title-left-r-images (list (make-image "title-left-inactive-r.png")
- (make-image "title-left-active-r.png")))
-
- (iconify-images (list (make-image "iconify-normal.png")
- nil nil
- (make-image "iconify-clicked.png")))
-
- (maximize-images (list (make-image "maximize-normal.png")
- nil nil
- (make-image "maximize-clicked.png")))
-
- (menu-images (list (make-image "menu-normal.png")
- nil nil
- (make-image "menu-clicked.png")))
-
- (close-images (list (make-image "close-normal.png")
- nil nil
- (make-image "close-clicked.png")))
-
- (title-right (set-image-border(make-image "title-right.png")10 10 10 10))
- (title-right-l (set-image-border(make-image "title-right-l.png") 3 0 10 10))
- (title-right-r (set-image-border(make-image "title-right-r.png") 0 3 10 10))
- (border-top (make-image "border_top.png"))
- (border-bottom (make-image "border_bottom.png"))
- (border-right (make-image "border_right.png"))
- (border-left (make-image "border_left.png"))
-
- (corner-tl (make-image "corner_top_left.png"))
- (corner-tr (make-image "corner_top_right.png"))
- (corner-tl-2 (make-image "corner_top_left_2.png"))
- (corner-tr-2 (make-image "corner_top_right_2.png"))
- (corner-bl (make-image "corner_bottom_left.png"))
- (corner-br (make-image "corner_bottom_right.png"))
- (corner-bl-2 (make-image "corner_bottom_left_2.png"))
- (corner-br-2 (make-image "corner_bottom_right_2.png"))
-
- (shaped-frame `(
-
- ((background . ,title-left-images)
- (foreground . ,font-colors)
- (font . ,font)
- (text . ,window-name)
- (x-justify . center)
- (y-justify . center)
- (top-edge . -16)
- (left-edge . 15)
- (right-edge . 40)
- (class . title))
-
- ))
-
- (shaped-transient-frame `(
-
- ((background . ,title-images)
- (foreground . ,font-colors)
- (font . ,font)
- (text . ,window-name)
- (x-justify . center)
- (y-justify . center)
- (top-edge . -12)
- (left-edge . 0)
- (right-edge . 0)
- (class . title))
-
- ((background . ,menu-images)
- (top-edge . -12)
- (left-edge . 1)
- (class . menu-button))
-
- ((background . ,iconify-images)
- (top-edge . -12)
- (right-edge . 26)
- (class . iconify-button))
-
- ((background . ,maximize-images)
- (top-edge . -12)
- (right-edge . 13)
- (class . maximize-button))
-
- ((background . ,close-images)
- (top-edge . -12)
- (right-edge . 1)
- (class . close-button))
-
- ((background . ,border-left)
- (top-edge . -12)
- ;;(bottom-edge . 0)
- (left-edge . -2)
- (class . left-border))
-
- ((background . ,border-right)
- (top-edge . -12)
- ;;(bottom-edge . 0)
- (right-edge . -2)
- (class . right-border))
-
- ((background . ,border-top)
- (top-edge . -14)
- (right-edge . 0)
- (left-edge . 0)
- (class . top-border))
-
- ((background . ,border-bottom)
- (top-edge . 0)
- (right-edge . 0)
- (left-edge . 0)
- (class . bottom-border))
-
- ((background . ,corner-tl)
- (top-edge . -14)
- (left-edge . -2)
- (class . top-left-corner))
-
- ((background . ,corner-tr)
- (top-edge . -14)
- (right-edge . -2)
- (class . top-right-corner))
-
- ((background . ,corner-bl-2)
- (top-edge . 0)
- (left-edge . -2)
- (class . bottom-left-corner))
-
- ((background . ,corner-br-2)
- (top-edge . 0)
- (right-edge . -2)
- (class . bottom-right-corner))
-
-
-
-))
-
- (transient-frame `(
-
- ((background . ,border-left)
- (top-edge . -2)
- (bottom-edge . 0)
- (left-edge . -2)
- (class . left-border))
-
- ((background . ,border-right)
- (top-edge . -2)
- (bottom-edge . 0)
- (right-edge . -2)
- (class . right-border))
-
- ((background . ,border-top)
- (top-edge . -2)
- (right-edge . 0)
- (left-edge . 0)
- (class . title))
-
- ((background . ,border-bottom)
- (bottom-edge . -2)
- (right-edge . 0)
- (left-edge . 0)
- (class . bottom-border))
-
- ((background . ,corner-tl-2)
- (top-edge . -2)
- (left-edge . -2)
- (class . top-left-corner))
-
- ((background . ,corner-tr-2)
- (top-edge . -2)
- (right-edge . -2)
- (class . top-right-corner))
-
- ((background . ,corner-bl)
- (bottom-edge . -2)
- (left-edge . -2)
- (class . bottom-left-corner))
-
- ((background . ,corner-br)
- (bottom-edge . -2)
- (right-edge . -2)
- (class . bottom-right-corner))
- ))
-
- (frame `(
- ; TODO: re-add this part
- ;((background . ,title-right)
- ; (top-edge . -14)
- ; (left-edge . -3)
- ; (right-edge . -3)
- ; (class . title))
-
- ;; left part of title background
- ((background . ,title-right-l)
- (top-edge . -14)
- (left-edge . -3)
- (width . 18)
- (class . title))
-
- ;; right part of title background
- ((background . ,title-right-r)
- (top-edge . -14)
- (width . 42)
- (right-edge . -3)
- (class . title))
-
- ;; tab
- ;((background . ,title-left-f-images)
- ((background . ,title-left-m-images)
- (foreground . ,font-colors)
- (font . ,font)
- (text . ,window-name)
- (x-justify . center)
- (y-justify . center)
- (top-edge . -16)
- ;(left-edge . 15)
- ;(right-edge . 40)
- (class . tab))
-
- ;; tab
- ((background . ,title-left-l-images)
- (top-edge . -16)
- (class . tab-l))
-
- ;; tab
- ((background . ,title-left-r-images)
- (top-edge . -16)
- (class . tab-r))
-
- ((background . ,menu-images)
- (top-edge . -12)
- (left-edge . 1)
- (class . menu-button))
-
- ((background . ,iconify-images)
- (top-edge . -12)
- (right-edge . 26)
- (class . iconify-button))
-
- ((background . ,maximize-images)
- (top-edge . -12)
- (right-edge . 13)
- (class . maximize-button))
-
- ((background . ,close-images)
- (top-edge . -12)
- (right-edge . 1)
- (class . close-button))
-
- ((background . ,border-left)
- (top-edge . 0)
- (bottom-edge . 0)
- (left-edge . -2)
- (class . left-border))
-
- ((background . ,border-right)
- (top-edge . 0)
- (bottom-edge . 0)
- (right-edge . -2)
- (class . right-border))
-
- ((background . ,border-bottom)
- (bottom-edge . 0)
- (right-edge . 0)
- (left-edge . 0)
- (class . bottom-border))
-
- ((background . ,corner-bl)
- (bottom-edge . 0)
- (left-edge . -2)
- (class . bottom-left-corner))
-
- ((background . ,corner-br)
- (bottom-edge . 0)
- (right-edge . -2)
- (class . bottom-right-corner))
-
- ))
-
- )
+ (
+ ;;(font (get-font "-*-lucida-medium-r-normal-*-*-100-*-*-p-*-iso8859-1"))
+ ;;(font (get-font "Sans 9"))
+ (font default-font)
+ (font-colors (list "grey50" "white"))
+
+ (title-images
+ (list (make-image "title-bar-inactive.png")
+ (make-image "title-bar-active.png")))
+
+ (title-left-images
+ (list (set-image-border
+ (make-image "title-left-inactive.png") 10 10 0 0)
+ (set-image-border
+ (make-image "title-left-active.png") 10 10 0 0)))
+
+ (title-left-f-images
+ (list (set-image-border
+ (make-image "title-left-inactive-f.png") 10 10 3 1)
+ (set-image-border
+ (make-image "title-left-active-f.png") 10 10 3 1)))
+
+ (title-left-l-images
+ (list (make-image "title-left-inactive-l.png")
+ (make-image "title-left-active-l.png")))
+
+ (title-left-m-images
+ (list (set-image-border
+ (make-image "title-left-inactive-m.png") 10 10 0 0)
+ (set-image-border
+ (make-image "title-left-active-m.png") 10 10 0 0)))
+
+ (title-left-r-images
+ (list (make-image "title-left-inactive-r.png")
+ (make-image "title-left-active-r.png")))
+
+ (iconify-images
+ (list (make-image "iconify-normal.png")
+ nil nil
+ (make-image "iconify-clicked.png")))
+
+ (maximize-images
+ (list (make-image "maximize-normal.png")
+ nil nil
+ (make-image "maximize-clicked.png")))
+
+ (menu-images
+ (list (make-image "menu-normal.png")
+ nil nil
+ (make-image "menu-clicked.png")))
+
+ (close-images
+ (list (make-image "close-normal.png")
+ nil nil
+ (make-image "close-clicked.png")))
+
+ (title-right
+ (set-image-border(make-image "title-right.png")10 10 10 10))
+ (title-right-l
+ (set-image-border(make-image "title-right-l.png") 3 0 10 10))
+ (title-right-r
+ (set-image-border(make-image "title-right-r.png") 0 3 10 10))
+ (border-top (make-image "border_top.png"))
+ (border-bottom (make-image "border_bottom.png"))
+ (border-right (make-image "border_right.png"))
+ (border-left (make-image "border_left.png"))
+
+ (corner-tl (make-image "corner_top_left.png"))
+ (corner-tr (make-image "corner_top_right.png"))
+ (corner-tl-2 (make-image "corner_top_left_2.png"))
+ (corner-tr-2 (make-image "corner_top_right_2.png"))
+ (corner-bl (make-image "corner_bottom_left.png"))
+ (corner-br (make-image "corner_bottom_right.png"))
+ (corner-bl-2 (make-image "corner_bottom_left_2.png"))
+ (corner-br-2 (make-image "corner_bottom_right_2.png"))
+
+ (shaped-frame `(((background . ,title-left-images)
+ (foreground . ,font-colors)
+ (font . ,font)
+ (text . ,window-name)
+ (x-justify . center)
+ (y-justify . center)
+ (top-edge . -16)
+ (left-edge . 15)
+ (right-edge . 40)
+ (class . title))))
+
+ (shaped-transient-frame `(((background . ,title-images)
+ (foreground . ,font-colors)
+ (font . ,font)
+ (text . ,window-name)
+ (x-justify . center)
+ (y-justify . center)
+ (top-edge . -12)
+ (left-edge . 0)
+ (right-edge . 0)
+ (class . title))
+
+ ((background . ,menu-images)
+ (top-edge . -12)
+ (left-edge . 1)
+ (class . menu-button))
+
+ ((background . ,iconify-images)
+ (top-edge . -12)
+ (right-edge . 26)
+ (class . iconify-button))
+
+ ((background . ,maximize-images)
+ (top-edge . -12)
+ (right-edge . 13)
+ (class . maximize-button))
+
+ ((background . ,close-images)
+ (top-edge . -12)
+ (right-edge . 1)
+ (class . close-button))
+
+ ((background . ,border-left)
+ (top-edge . -12)
+ ;;(bottom-edge . 0)
+ (left-edge . -2)
+ (class . left-border))
+
+ ((background . ,border-right)
+ (top-edge . -12)
+ ;;(bottom-edge . 0)
+ (right-edge . -2)
+ (class . right-border))
+
+ ((background . ,border-top)
+ (top-edge . -14)
+ (right-edge . 0)
+ (left-edge . 0)
+ (class . top-border))
+
+ ((background . ,border-bottom)
+ (top-edge . 0)
+ (right-edge . 0)
+ (left-edge . 0)
+ (class . bottom-border))
+
+ ((background . ,corner-tl)
+ (top-edge . -14)
+ (left-edge . -2)
+ (class . top-left-corner))
+
+ ((background . ,corner-tr)
+ (top-edge . -14)
+ (right-edge . -2)
+ (class . top-right-corner))
+
+ ((background . ,corner-bl-2)
+ (top-edge . 0)
+ (left-edge . -2)
+ (class . bottom-left-corner))
+
+ ((background . ,corner-br-2)
+ (top-edge . 0)
+ (right-edge . -2)
+ (class . bottom-right-corner))))
+
+ (transient-frame `(((background . ,border-left)
+ (top-edge . -2)
+ (bottom-edge . 0)
+ (left-edge . -2)
+ (class . left-border))
+
+ ((background . ,border-right)
+ (top-edge . -2)
+ (bottom-edge . 0)
+ (right-edge . -2)
+ (class . right-border))
+
+ ((background . ,border-top)
+ (top-edge . -2)
+ (right-edge . 0)
+ (left-edge . 0)
+ (class . title))
+
+ ((background . ,border-bottom)
+ (bottom-edge . -2)
+ (right-edge . 0)
+ (left-edge . 0)
+ (class . bottom-border))
+
+ ((background . ,corner-tl-2)
+ (top-edge . -2)
+ (left-edge . -2)
+ (class . top-left-corner))
+
+ ((background . ,corner-tr-2)
+ (top-edge . -2)
+ (right-edge . -2)
+ (class . top-right-corner))
+
+ ((background . ,corner-bl)
+ (bottom-edge . -2)
+ (left-edge . -2)
+ (class . bottom-left-corner))
+
+ ((background . ,corner-br)
+ (bottom-edge . -2)
+ (right-edge . -2)
+ (class . bottom-right-corner))))
+
+ (frame `(
+ ;; TODO: re-add this part
+ ;;((background . ,title-right)
+ ;; (top-edge . -14)
+ ;; (left-edge . -3)
+ ;; (right-edge . -3)
+ ;; (class . title))
+
+ ;; left part of title background
+ ((background . ,title-right-l)
+ (top-edge . -14)
+ (left-edge . -3)
+ (width . 18)
+ (class . title))
+
+ ;; right part of title background
+ ((background . ,title-right-r)
+ (top-edge . -14)
+ (width . 42)
+ (right-edge . -3)
+ (class . title))
+
+ ;; tab
+ ;;((background . ,title-left-f-images)
+ ((background . ,title-left-m-images)
+ (foreground . ,font-colors)
+ (font . ,font)
+ (text . ,window-name)
+ (x-justify . center)
+ (y-justify . center)
+ (top-edge . -16)
+ ;;(left-edge . 15)
+ ;;(right-edge . 40)
+ (class . tab))
+
+ ;; tab
+ ((background . ,title-left-l-images)
+ (top-edge . -16)
+ (class . tab-l))
+
+ ;; tab
+ ((background . ,title-left-r-images)
+ (top-edge . -16)
+ (class . tab-r))
+
+ ((background . ,menu-images)
+ (top-edge . -12)
+ (left-edge . 1)
+ (class . menu-button))
+
+ ((background . ,iconify-images)
+ (top-edge . -12)
+ (right-edge . 26)
+ (class . iconify-button))
+
+ ((background . ,maximize-images)
+ (top-edge . -12)
+ (right-edge . 13)
+ (class . maximize-button))
+
+ ((background . ,close-images)
+ (top-edge . -12)
+ (right-edge . 1)
+ (class . close-button))
+
+ ((background . ,border-left)
+ (top-edge . 0)
+ (bottom-edge . 0)
+ (left-edge . -2)
+ (class . left-border))
+
+ ((background . ,border-right)
+ (top-edge . 0)
+ (bottom-edge . 0)
+ (right-edge . -2)
+ (class . right-border))
+
+ ((background . ,border-bottom)
+ (bottom-edge . 0)
+ (right-edge . 0)
+ (left-edge . 0)
+ (class . bottom-border))
+
+ ((background . ,corner-bl)
+ (bottom-edge . 0)
+ (left-edge . -2)
+ (class . bottom-left-corner))
+
+ ((background . ,corner-br)
+ (bottom-edge . 0)
+ (right-edge . -2)
+ (class . bottom-right-corner)))))
+
(add-frame-style 'get-S-tabbed
- (lambda (w type)
- (case type
- ((default) frame)
- ((transient) transient-frame)
- ((shaped) shaped-frame)
- ((shaped-transient) shaped-transient-frame))))
-
- ; TODO: figure out how to store this info in this file correctly
- ;(custom-set-typed-variable'tab-left-dec-width '5 'number)
- ;(custom-set-typed-variable'tab-right-dec-width '5 'number)
- ;(custom-set-typed-variable'tab-left-margin '14 'number)
- ;(custom-set-typed-variable'tab-right-margin '38 'number)
+ (lambda (w type)
+ (case type
+ ((default) frame)
+ ((transient) transient-frame)
+ ((shaped) shaped-frame)
+ ((shaped-transient) shaped-transient-frame))))
+
+ ;; TODO: figure out how to store this info in this file correctly
+ ;;(custom-set-typed-variable'tab-left-dec-width '5 'number)
+ ;;(custom-set-typed-variable'tab-right-dec-width '5 'number)
+ ;;(custom-set-typed-variable'tab-left-margin '14 'number)
+ ;;(custom-set-typed-variable'tab-right-margin '38 'number)
)
diff --git a/themes/gradient/theme.jl b/themes/gradient/theme.jl
index 7100037..bbf955f 100644
--- a/themes/gradient/theme.jl
+++ b/themes/gradient/theme.jl
@@ -1,5 +1,4 @@
;; gradient/theme.jl
-;; $Id: theme.jl,v 1.22 2000/08/14 14:23:08 john Exp $
;; Copyright (C) 1999 John Harper <john dcs warwick ac uk>
diff --git a/themes/gtk/theme.jl b/themes/gtk/theme.jl
index 8291e60..a451f2d 100644
--- a/themes/gtk/theme.jl
+++ b/themes/gtk/theme.jl
@@ -1,5 +1,4 @@
;; gtk/theme.jl
-;; $Id: theme.jl,v 1.22 2001/01/12 03:51:49 jsh Exp $
;; Copyright (C) 1999 John Harper <john dcs warwick ac uk>
diff --git a/themes/microGUI/theme.jl b/themes/microGUI/theme.jl
index c37b0e3..31d3cb3 100644
--- a/themes/microGUI/theme.jl
+++ b/themes/microGUI/theme.jl
@@ -1,4 +1,4 @@
-; microGUI/theme.jl
+;; microGUI/theme.jl
;; Copyright (C) 1999 Ryan Lovett <ryan ocf berkeley edu>
@@ -17,7 +17,7 @@
(let
((w-width (car (window-dimensions w))))
(max 0 (min (- w-width 100) (text-width (window-name w)))))))
-
+
;; 2x6
(bottom-images (make-image "bottom.png"))
@@ -200,148 +200,148 @@
(top-edge . -19)
(class . close-button))))
- (shaped-frame `(((background . ,top-left-shaped-images)
- (left-edge . -6)
- (top-edge . -19)
- (height . 19)
- (class . top-left-corner))
-
- ;; top blue
- ((background . ,top-blue-images)
- (foreground . ,text-colors)
- (text . ,window-name)
- (x-justify . 4)
- (y-justify . center)
- (top-edge . -19)
- (left-edge . 19)
- (width . ,(lambda (w) (+ (title-width w) 13)))
- (class . title))
-
- ;; menu button
- ((background . ,menu-images)
- (top-edge . -19)
- (left-edge . 0)
- (class . menu-button))
-
- ;; top curves
- ((background . ,top-curves-images)
- (left-edge . ,(lambda (w) (+ (title-width w) 32)))
- (top-edge . -19)
- (class . title))
-
- ;; top grey
- ((background . ,top-grey-images)
- (top-edge . -19)
- (left-edge . ,(lambda (w) (+ (title-width w) 44)))
- (right-edge . 52)
- (class . title))
-
- ;; top-right corner
- ((background . ,top-right-shaped-images)
- (right-edge . -6)
- (top-edge . -19)
- (height . 19)
- (class . top-right-corner))
-
- ;; iconify button
- ((background . ,iconify-images)
- (right-edge . 35)
- (top-edge . -19)
- (class . iconify-button))
-
- ;; maximize button
- ((background . ,maximize-images)
- (right-edge . 18)
- (top-edge . -19)
- (class . maximize-button))
-
- ;; delete button
- ((background . ,close-images)
- (right-edge . 1)
- (top-edge . -19)
- (class . close-button))))
-
- (transient-frame `(((background . ,t-top-left-images)
- (left-edge . -5)
- (top-edge . -5)
- (class . top-left-corner))
-
- ;;top-right corner
- ((background . ,t-top-right-images)
- (right-edge . -18)
- (top-edge . -5)
- (class . top-right-corner))
-
- ;;title border
- ((background . ,t-top-images)
- (left-edge . -1)
- (right-edge . -1)
- (top-edge . -5)
- (class . top-border))
-
- ;; left border
- ((background . ,t-left-images)
- (left-edge . -5)
- (top-edge . -1)
- (bottom-edge . -1)
- (class . left-border))
-
- ;; right border
- ((background . ,t-right-images)
- (right-edge . -18)
- (top-edge . -1)
- (bottom-edge . -1)
- (class . title))
-
- ;; bottom border
- ((background . ,t-bottom-images)
- (left-edge . -1)
- (right-edge . -1)
- (bottom-edge . -5)
- (class . bottom-border))
-
- ;; bottom-left corner
- ((background . ,t-bottom-left-images)
- (left-edge . -5)
- (bottom-edge . -5)
- (class . bottom-left-corner))
-
- ;; bottom-right corner
- ((background . ,t-bottom-right-images)
- (right-edge . -18)
- (bottom-edge . -5)
- (class . bottom-right-corner))
-
- ;; delete button
- ((background . ,t-close-images)
- (right-edge . -18)
- (top-edge . 1)
- (class . close-button))))
-
- (shaped-transient-frame `(((background . ,t-top-right-images)
- (right-edge . -18)
- (top-edge . -5)
- (class . top-right-corner))
-
- ;; right border
- ((background . ,t-right-images)
- (right-edge . -18)
- (top-edge . -1)
- (bottom-edge . -1)
- (class . title))
-
- ;; bottom-right corner
- ((background . ,t-bottom-right-images)
- (right-edge . -18)
- (bottom-edge . -5)
- (class . bottom-right-corner))
-
- ;; delete button
- ((background . ,t-close-images)
- (right-edge . -18)
- (top-edge . 1)
- (class . close-button)))))
-
+ (shaped-frame `(((background . ,top-left-shaped-images)
+ (left-edge . -6)
+ (top-edge . -19)
+ (height . 19)
+ (class . top-left-corner))
+
+ ;; top blue
+ ((background . ,top-blue-images)
+ (foreground . ,text-colors)
+ (text . ,window-name)
+ (x-justify . 4)
+ (y-justify . center)
+ (top-edge . -19)
+ (left-edge . 19)
+ (width . ,(lambda (w) (+ (title-width w) 13)))
+ (class . title))
+
+ ;; menu button
+ ((background . ,menu-images)
+ (top-edge . -19)
+ (left-edge . 0)
+ (class . menu-button))
+
+ ;; top curves
+ ((background . ,top-curves-images)
+ (left-edge . ,(lambda (w) (+ (title-width w) 32)))
+ (top-edge . -19)
+ (class . title))
+
+ ;; top grey
+ ((background . ,top-grey-images)
+ (top-edge . -19)
+ (left-edge . ,(lambda (w) (+ (title-width w) 44)))
+ (right-edge . 52)
+ (class . title))
+
+ ;; top-right corner
+ ((background . ,top-right-shaped-images)
+ (right-edge . -6)
+ (top-edge . -19)
+ (height . 19)
+ (class . top-right-corner))
+
+ ;; iconify button
+ ((background . ,iconify-images)
+ (right-edge . 35)
+ (top-edge . -19)
+ (class . iconify-button))
+
+ ;; maximize button
+ ((background . ,maximize-images)
+ (right-edge . 18)
+ (top-edge . -19)
+ (class . maximize-button))
+
+ ;; delete button
+ ((background . ,close-images)
+ (right-edge . 1)
+ (top-edge . -19)
+ (class . close-button))))
+
+ (transient-frame `(((background . ,t-top-left-images)
+ (left-edge . -5)
+ (top-edge . -5)
+ (class . top-left-corner))
+
+ ;;top-right corner
+ ((background . ,t-top-right-images)
+ (right-edge . -18)
+ (top-edge . -5)
+ (class . top-right-corner))
+
+ ;;title border
+ ((background . ,t-top-images)
+ (left-edge . -1)
+ (right-edge . -1)
+ (top-edge . -5)
+ (class . top-border))
+
+ ;; left border
+ ((background . ,t-left-images)
+ (left-edge . -5)
+ (top-edge . -1)
+ (bottom-edge . -1)
+ (class . left-border))
+
+ ;; right border
+ ((background . ,t-right-images)
+ (right-edge . -18)
+ (top-edge . -1)
+ (bottom-edge . -1)
+ (class . title))
+
+ ;; bottom border
+ ((background . ,t-bottom-images)
+ (left-edge . -1)
+ (right-edge . -1)
+ (bottom-edge . -5)
+ (class . bottom-border))
+
+ ;; bottom-left corner
+ ((background . ,t-bottom-left-images)
+ (left-edge . -5)
+ (bottom-edge . -5)
+ (class . bottom-left-corner))
+
+ ;; bottom-right corner
+ ((background . ,t-bottom-right-images)
+ (right-edge . -18)
+ (bottom-edge . -5)
+ (class . bottom-right-corner))
+
+ ;; delete button
+ ((background . ,t-close-images)
+ (right-edge . -18)
+ (top-edge . 1)
+ (class . close-button))))
+
+ (shaped-transient-frame `(((background . ,t-top-right-images)
+ (right-edge . -18)
+ (top-edge . -5)
+ (class . top-right-corner))
+
+ ;; right border
+ ((background . ,t-right-images)
+ (right-edge . -18)
+ (top-edge . -1)
+ (bottom-edge . -1)
+ (class . title))
+
+ ;; bottom-right corner
+ ((background . ,t-bottom-right-images)
+ (right-edge . -18)
+ (bottom-edge . -5)
+ (class . bottom-right-corner))
+
+ ;; delete button
+ ((background . ,t-close-images)
+ (right-edge . -18)
+ (top-edge . 1)
+ (class . close-button)))))
+
(add-frame-style 'microGUI
(lambda (w type)
(case type
@@ -351,5 +351,5 @@
((shaped-transient) shaped-transient-frame))))
(call-after-property-changed
- '(WM_NAME _NET_WM_NAME) (lambda (w prop state)
- (reframe-window w))))
+ '(WM_NAME _NET_WM_NAME) (lambda (w prop state)
+ (reframe-window w))))
diff --git a/themes/mono/theme.jl b/themes/mono/theme.jl
index 8a81f7c..40c8403 100644
--- a/themes/mono/theme.jl
+++ b/themes/mono/theme.jl
@@ -1,5 +1,4 @@
;; mono/theme.jl
-;; $Id: theme.jl,v 1.10 2001/02/11 01:33:56 jsh Exp $
;; Copyright (C) 1999 John Harper <john dcs warwick ac uk>
diff --git a/themes/mxflat/theme.jl b/themes/mxflat/theme.jl
index e363081..7b9adb3 100644
--- a/themes/mxflat/theme.jl
+++ b/themes/mxflat/theme.jl
@@ -1,2827 +1,2389 @@
-; mxflat/mxflat.jl
-;;; START
-
-#| theme.jl for mxflat (v0.7.3) sawfish theme
-
- Copyright (C) 2002 mx & ta
-
- This program 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 of the
- License, or (at your option) any later version.
-
- This program 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 this program; if not, write to the Free Software
- Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-
- authors: mx (email) & ta (dev null gmx net)
-|#
+;; mxflat/mxflat.jl
+;;
+;; theme.jl for mxflat (v0.7.3) sawfish theme
+;;
+;; Copyright (C) 2002 mx & ta
+;;
+;; This program 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 of the
+;; License, or (at your option) any later version.
+;;
+;; This program 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 this program; if not, write to the Free Software
+;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+;;
+;; authors: mx (email) & ta (dev null gmx net)
(require 'gradient)
-; need hash tables for icon cache
+;; need hash tables for icon cache
(require 'rep.data.tables)
(require 'rep.io.timers)
(require 'sawfish.wm.util.recolor-image)
-; required when gaoling is turned off (for debugging)
-;(require 'rep.mmsystem)
-;(require 'sawfish.wm.custom)
-;(require 'sawfish.wm.colors)
-;(require 'sawfish.wm.images)
-;(require 'sawfish.wm.fonts)
+;; required when gaoling is turned off (for debugging)
+;;(require 'rep.mmsystem)
+;;(require 'sawfish.wm.custom)
+;;(require 'sawfish.wm.colors)
+;;(require 'sawfish.wm.images)
+;;(require 'sawfish.wm.fonts)
-; ---------
+;; ---------
;;; REDRAWING
-; ---------
+;; ---------
-;
+;;
;; redrawing:internal vars
-;
+;;
-; we need to define theme here
-; so we can reach them from our defcustom clauses
+;; we need to define theme here
+;; so we can reach them from our defcustom clauses
-; cache for window icons
+;; cache for window icons
(defvar icon-cache (make-weak-table eq-hash eq))
-; holds the shadow side for the current selected option
-(defvar shadow-side ())
+;; holds the shadow side for the current selected option
+(defvar shadow-side nil)
-; for now empty, see below
+;; for now empty, see below
(define (recolor-all))
-;
+;;
;; redrawing:functions
-;
+;;
(define (get-symbol #!rest strings)
- (intern (mapconcat identity strings ""))
-)
+ (intern (mapconcat identity strings "")))
+
(define (check-symbol #!rest strings)
- (let
- (
- (name (intern (mapconcat identity strings "")))
- )
- (if (boundp name)
- (symbol-value name)
- nil
- )
- )
-)
+ (let ((name (intern (mapconcat identity strings ""))))
+ (if (boundp name)
+ (symbol-value name)
+ nil)))
(define (refresh-one-frame w)
- (if (eq (window-get w 'current-frame-style) 'mxflat)
- (refresh-window w)
- )
-)
+ (if (eq (window-get w 'current-frame-style) 'mxflat)
+ (refresh-window w)))
(define (refresh-all-frames)
- (map-windows refresh-window)
-)
+ (map-windows refresh-window))
(define (rebuild-all-frames)
- (rebuild-frames-with-style 'mxflat)
-)
+ (rebuild-frames-with-style 'mxflat))
-; same as rebuild but this also deletes the icon cache
+;; same as rebuild but this also deletes the icon cache
(define (recreate-all-frames)
- (reframe-windows-with-style 'mxflat)
-)
+ (reframe-windows-with-style 'mxflat))
-; after the light source direction is updated we have to destroy the cache
-; with the correct shadow sides, it will be recreated on next access
+;; after the light source direction is updated we have to destroy the cache
+;; with the correct shadow sides, it will be recreated on next access
(define (after-set-shadow-light-source)
- (setq shadow-side ())
- (recreate-all-frames)
-)
+ (setq shadow-side nil)
+ (recreate-all-frames))
(define update-interval nil)
-(define update-timer
- (make-timer (lambda ()
- (refresh-all-frames)
- (if update-interval
- (set-timer update-timer update-interval)
- )
- ))
-)
+(define update-timer
+ (make-timer (lambda ()
+ (refresh-all-frames)
+ (if update-interval
+ (set-timer update-timer update-interval)))))
(define (after-set-title-periodic-update)
- (if (check-symbol "mxflat:title-periodic-update")
- (set-timer update-timer update-interval)
- (delete-timer update-timer)
- )
-)
+ (if (check-symbol "mxflat:title-periodic-update")
+ (set-timer update-timer update-interval)
+ (delete-timer update-timer)))
(define (after-set-title-update-interval)
- (setq update-interval (check-symbol "mxflat:title-update-interval"))
- (after-set-title-periodic-update)
-)
+ (setq update-interval (check-symbol "mxflat:title-update-interval"))
+ (after-set-title-periodic-update))
(define (recreate-all-frames-clear-cache)
- ; reset icon cache
- (setq icon-cache (make-weak-table eq-hash eq))
- (recreate-all-frames)
-)
+ ;; reset icon cache
+ (setq icon-cache (make-weak-table eq-hash eq))
+ (recreate-all-frames))
(define (recreate-all-frames-recolor-all)
- (recolor-all)
- (recreate-all-frames)
-)
+ (recolor-all)
+ (recreate-all-frames))
-; -------------
+;; -------------
;;; CONFIGURATION
-; -------------
+;; -------------
-;
+;;
;; configuration:keymaps
-;
+;;
-; we need to define our default keymaps here,
-; so we can reach them from our defcustom clauses
+;; we need to define our default keymaps here,
+;; so we can reach them from our defcustom clauses
(defvar sticky-button-keymap
- (bind-keys (make-keymap)
- "Button1-Off" 'toggle-window-sticky
- )
-)
+ (bind-keys (make-keymap)
+ "Button1-Off" 'toggle-window-sticky))
+
(defvar previous-button-keymap
- (bind-keys (make-keymap)
- "Button6-Click" 'pack-window-left
- "Button3-Off" '(command-sequence `((send-to-workspace ,(1+ (car (workspace-limits))))
- (activate-workspace ,(1+ (car (workspace-limits))))))
- "Button2-Click" 'popup-workspace-list
- "Button1-Off" 'send-to-previous-workspace
- )
-)
+ (bind-keys (make-keymap)
+ "Button6-Click" 'pack-window-left
+ "Button3-Off" '(command-sequence
+ `((send-to-workspace
+ ,(1+ (car (workspace-limits))))
+ (activate-workspace
+ ,(1+ (car (workspace-limits))))))
+ "Button2-Click" 'popup-workspace-list
+ "Button1-Off" 'send-to-previous-workspace))
+
(defvar next-button-keymap
- (bind-keys (make-keymap)
- "Button6-Click" 'pack-window-right
- "Button3-Off" '(command-sequence `((send-to-workspace ,(1+ (cdr (workspace-limits))))
- (activate-workspace ,(1+ (cdr (workspace-limits))))))
- "Button2-Click" 'popup-workspace-list
- "Button1-Off" 'send-to-next-workspace
- )
-)
+ (bind-keys (make-keymap)
+ "Button6-Click" 'pack-window-right
+ "Button3-Off" '(command-sequence
+ `((send-to-workspace
+ ,(1+ (cdr (workspace-limits))))
+ (activate-workspace
+ ,(1+ (cdr (workspace-limits))))))
+ "Button2-Click" 'popup-workspace-list
+ "Button1-Off" 'send-to-next-workspace))
(defvar configure-button-keymap
- (bind-keys (make-keymap)
- "Button1-Off" 'customize
- "Button3-Off" '(call-command
- (lambda ()
- (if mxflat:custom-title
- (setq mxflat:custom-title nil)
- (setq mxflat:custom-title t)
- )
- ;(reframe-windows-with-style 'mxflat)
- (map-windows refresh-window)
- ))
- )
-)
+ (bind-keys (make-keymap)
+ "Button1-Off" 'customize
+ "Button3-Off" '(call-command
+ (lambda ()
+ (if mxflat:custom-title
+ (setq mxflat:custom-title nil)
+ (setq mxflat:custom-title t))
+ ;;(reframe-windows-with-style 'mxflat)
+ (map-windows refresh-window)))))
+
(defvar always-on-top-button-keymap
- (bind-keys (make-keymap)
- "Button1-Off" '(call-command
- (lambda ()
- (if (> (window-get (current-event-window) 'depth) 0)
- (window-put (current-event-window) 'depth 0)
- (window-put (current-event-window) 'depth mxflat:always-on-top-depth)
- )
- (reframe-window (current-event-window))
- ))
- )
-)
+ (bind-keys (make-keymap)
+ "Button1-Off" '(call-command
+ (lambda ()
+ (if (> (window-get (current-event-window)
+ 'depth)
+ 0)
+ (window-put (current-event-window)
+ 'depth 0)
+ (window-put (current-event-window)
+ 'depth
+ mxflat:always-on-top-depth))
+ (reframe-window (current-event-window))))))
+
(defvar lock-button-keymap
- (bind-keys (make-keymap)
- "Button1-Off" '(call-command
- (lambda ()
- (if (window-get (current-event-window) 'fixed-position)
- (window-put (current-event-window) 'fixed-position nil)
- (window-put (current-event-window) 'fixed-position t)
- )
- (reframe-window (current-event-window))
- ))
- )
-)
-
-
-;
+ (bind-keys (make-keymap)
+ "Button1-Off" '(call-command
+ (lambda ()
+ (if (window-get (current-event-window)
+ 'fixed-position)
+ (window-put (current-event-window)
+ 'fixed-position nil)
+ (window-put (current-event-window)
+ 'fixed-position t))
+ (reframe-window (current-event-window))))))
+
+
+;;
;; configuration:groups
-;
+;;
-; there are just too many options
-; so we put them into several groups/tabs
+;; there are just too many options
+;; so we put them into several groups/tabs
(defgroup mxflat:group
- "mxflat"
- :group appearance
-)
+ "mxflat"
+ :group appearance)
+
(defgroup mxflat:title-group
- "title"
- :group (appearance mxflat:group)
-)
+ "title"
+ :group (appearance mxflat:group))
+
(defgroup mxflat:title-basic-group
- "basic"
- :group (appearance mxflat:group mxflat:title-group)
-)
+ "basic"
+ :group (appearance mxflat:group mxflat:title-group))
+
(defgroup mxflat:title-gradient-group
- "gradient"
- :group (appearance mxflat:group mxflat:title-group)
-)
+ "gradient"
+ :group (appearance mxflat:group mxflat:title-group))
+
(defgroup mxflat:title-colors-group
- "colors"
- :group (appearance mxflat:group mxflat:title-group)
-)
+ "colors"
+ :group (appearance mxflat:group mxflat:title-group))
+
(defgroup mxflat:buttons-group
- "buttons"
- :group (appearance mxflat:group)
-)
+ "buttons"
+ :group (appearance mxflat:group))
+
(defgroup mxflat:buttons-basic-group
- "basic"
- :group (appearance mxflat:group mxflat:buttons-group)
-)
+ "basic"
+ :group (appearance mxflat:group mxflat:buttons-group))
+
(defgroup mxflat:buttons-positions1-group
- "positions 1"
- :group (appearance mxflat:group mxflat:buttons-group)
-)
+ "positions 1"
+ :group (appearance mxflat:group mxflat:buttons-group))
+
(defgroup mxflat:buttons-positions2-group
- "positions 2"
- :group (appearance mxflat:group mxflat:buttons-group)
-)
+ "positions 2"
+ :group (appearance mxflat:group mxflat:buttons-group))
+
(defgroup mxflat:buttons-keymaps1-group
- "keymaps 1"
- :group (appearance mxflat:group mxflat:buttons-group)
-)
+ "keymaps 1"
+ :group (appearance mxflat:group mxflat:buttons-group))
+
(defgroup mxflat:buttons-keymaps2-group
- "keymaps 2"
- :group (appearance mxflat:group mxflat:buttons-group)
-)
+ "keymaps 2"
+ :group (appearance mxflat:group mxflat:buttons-group))
+
(defgroup mxflat:button-colors-group
- "colors"
- :group (appearance mxflat:group mxflat:buttons-group)
-)
+ "colors"
+ :group (appearance mxflat:group mxflat:buttons-group))
+
(defgroup mxflat:border-group
- "borders"
- :group (appearance mxflat:group)
-)
+ "borders"
+ :group (appearance mxflat:group))
+
(defgroup mxflat:border1-group
- "basic"
- :group (appearance mxflat:group mxflat:border-group)
-)
+ "basic"
+ :group (appearance mxflat:group mxflat:border-group))
+
(defgroup mxflat:border-extended-group
- "extended"
- :group (appearance mxflat:group mxflat:border-group)
-)
+ "extended"
+ :group (appearance mxflat:group mxflat:border-group))
+
(defgroup mxflat:border-colors-group
- "colors"
- :group (appearance mxflat:group mxflat:border-group)
-)
+ "colors"
+ :group (appearance mxflat:group mxflat:border-group))
+
-;
+;;
;; configuration:title-basic
-;
+;;
(defcustom mxflat:decoration-mode
- 'normal
- "decoration mode"
- :tooltip "set the mode 'when to draw a titlebar and window buttons'. the decoration mode 'all' means that all windows, even transients/dialogs, will get a titlebar and buttons. none means no window will get any :-). usually transients only have a contents-border. this option is for reimplementing a sawfish feature that is gone in the latest version."
- :group (appearance mxflat:group mxflat:title-group mxflat:title-basic-group)
- :type symbol
- :options (normal all none)
- :after-set recreate-all-frames
-)
+ 'normal
+ "decoration mode"
+ :tooltip "Set the mode 'when to draw a titlebar and window \
+buttons'. The decoration mode 'all' means that all windows, even \
+transients/dialogs, will get a titlebar and buttons. None means no \
+window will get any :-). Usually transients only have a \
+contents-border. This option is for reimplementing a sawfish feature \
+that is gone in the latest version."
+ :group (appearance mxflat:group mxflat:title-group mxflat:title-basic-group)
+ :type symbol
+ :options (normal all none)
+ :after-set recreate-all-frames)
(defcustom mxflat:title-height
- 16
- "titlebar height (9 - 1000 pixel)"
- :group (appearance mxflat:group mxflat:title-group mxflat:title-basic-group)
- :type (number 9 1000)
- :after-set rebuild-all-frames
-)
+ 16
+ "titlebar height (9 - 1000 pixel)"
+ :group (appearance mxflat:group mxflat:title-group mxflat:title-basic-group)
+ :type (number 9 1000)
+ :after-set rebuild-all-frames)
(defcustom mxflat:custom-title
- nil
- "customize title string"
- :tooltip "see the tooltip for the 'title string' option below for more information. (NOTE: i hope the redrawing problems with this option are solved. if not, write an email please!)"
- :group (appearance mxflat:group mxflat:title-group mxflat:title-basic-group)
- :type boolean
- :after-set refresh-all-frames
-)
+ nil
+ "customize title string"
+ :tooltip "See the tooltip for the 'title string' option below for \
+more information. (NOTE: I hope the redrawing problems with this \
+option are solved. If not, write an email please!)"
+ :group (appearance mxflat:group mxflat:title-group mxflat:title-basic-group)
+ :type boolean
+ :after-set refresh-all-frames)
(defcustom mxflat:title-string
- "$fullname |$widthx$height-($x-pos,$y-pos)@$current-ws/$last-ws-$(DISPLAY)"
- "title string"
- :tooltip "the string you insert here will be your new title string. variables always start with a dollar-sign $ and are replaced with their actual values. to get the value of an environment variable use $(variable), eg $(DISPLAY). to get the value of an rep/sawfish function use $[fuction], eg $[current-time-string]. the following vars are built-in: $name, $fullname, $width, $width-content, $height, $height-content, $depth, $x-pos, $y-pos, $current-ws and $last-ws. (NOTE: i hope the redrawing problems with this option are solved. if not, write an email please!"
- :group (appearance mxflat:group mxflat:title-group mxflat:title-basic-group)
- :type string
- :depends mxflat:custom-title
- :after-set refresh-all-frames
-)
+ "$fullname |$widthx$height-($x-pos,$y-pos)@$current-ws/$last-ws-$(DISPLAY)"
+ "title string"
+ :tooltip "The string you insert here will be your new title \
+string. Variables always start with a dollar-sign ($) and are \
+replaced with their actual values. To get the value of an environment \
+variable use $(variable), eg $(DISPLAY). To get the value of an \
+rep/sawfish function use $[fuction], eg $[current-time-string]. The \
+following vars are built-in: $name, $fullname, $width, $width-content, \
+$height, $height-content, $depth, $x-pos, $y-pos, $current-ws and \
+$last-ws. (NOTE: I hope the redrawing problems with this option are \
+solved. If not, write an email please!"
+ :group (appearance mxflat:group mxflat:title-group mxflat:title-basic-group)
+ :type string
+ :depends mxflat:custom-title
+ :after-set refresh-all-frames)
(defcustom mxflat:title-periodic-update
- nil
- "update title string periodically"
- :tooltip "this is useful if your title string changes without user interaction (eg because it displays the current time or something like that)."
- :group (appearance mxflat:group mxflat:title-group mxflat:title-basic-group)
- :type boolean
- :depends mxflat:custom-title
- :after-set after-set-title-periodic-update
-)
+ nil
+ "update title string periodically"
+ :tooltip "This is useful if your title string changes without user \
+interaction (eg because it displays the current time or something like \
+that)."
+ :group (appearance mxflat:group mxflat:title-group mxflat:title-basic-group)
+ :type boolean
+ :depends mxflat:custom-title
+ :after-set after-set-title-periodic-update)
(defcustom mxflat:title-update-interval
- 1000
- "title string update interval (1 - 1000000 s)"
- :tooltip "this is useful if your title string changes without user interaction (eg because it displays the current time or something like that)."
- :group (appearance mxflat:group mxflat:title-group mxflat:title-basic-group)
- :type (number 1 1000000)
- :depends mxflat:custom-title
- :after-set after-set-title-update-interval
-)
+ 1000
+ "title string update interval (1 - 1000000 s)"
+ :tooltip "This is useful if your title string changes without user \
+interaction (e.g., because it displays the current time or something \
+like that)."
+ :group (appearance mxflat:group mxflat:title-group mxflat:title-basic-group)
+ :type (number 1 1000000)
+ :depends mxflat:custom-title
+ :after-set after-set-title-update-interval)
(defcustom mxflat:title-font
- default-font
- "title string font"
- :tooltip "you should really choose a better font. verdana bold 8 pt looks nice."
- :group (appearance mxflat:group mxflat:title-group mxflat:title-basic-group)
- :type font
- :after-set rebuild-all-frames
-)
+ default-font
+ "title string font"
+ :tooltip "You should really choose a better font. Verdana bold 8 \
+pt looks nice."
+ :group (appearance mxflat:group mxflat:title-group mxflat:title-basic-group)
+ :type font
+ :after-set rebuild-all-frames)
(defcustom mxflat:customize-title-position
- nil
- "customize title position"
- :tooltip "by default the title string is centered horizontally and vertically."
- :group (appearance mxflat:group mxflat:title-group mxflat:title-basic-group)
- :type boolean
- :after-set rebuild-all-frames
-)
+ nil
+ "customize title position"
+ :tooltip "By default the title string is centered horizontally and \
+vertically."
+ :group (appearance mxflat:group mxflat:title-group mxflat:title-basic-group)
+ :type boolean
+ :after-set rebuild-all-frames)
(defcustom mxflat:title-x-justify
- 'center
- "title string horizontal alignment"
- :tooltip "'real-center' means to take the whole titlebar into account while centering the string. when selecting 'center' only the distance between the buttons is taken into account."
- :group (appearance mxflat:group mxflat:title-group mxflat:title-basic-group)
- :type symbol
- :depends mxflat:customize-title-position
- :options (left center real-center right)
- :after-set rebuild-all-frames
-)
+ 'center
+ "title string horizontal alignment"
+ :tooltip "'real-center' means to take the whole titlebar into \
+account while centering the string. when selecting 'center' only the \
+distance between the buttons is taken into account."
+ :group (appearance mxflat:group mxflat:title-group mxflat:title-basic-group)
+ :type symbol
+ :depends mxflat:customize-title-position
+ :options (left center real-center right)
+ :after-set rebuild-all-frames)
(defcustom mxflat:title-x-adjustment
- 0
- "title string horizontal align adjustment (-10000 - 10000 pixel)"
- :tooltip "the horizontal position of the title string can only be adjusted if the horizontal alignment is not 'center'. the range also depends on the setting of the option above. it the title string is already aligned left, you cannot adjust it to be even further left because there are button in the way."
- :group (appearance mxflat:group mxflat:title-group mxflat:title-basic-group)
- :type (number -10000 10000)
- :depends mxflat:customize-title-position
- :after-set rebuild-all-frames
-)
+ 0
+ "title string horizontal align adjustment (-10000 - 10000 pixel)"
+ :tooltip "The horizontal position of the title string can only be \
+adjusted if the horizontal alignment is not 'center'. The range also \
+depends on the setting of the option above. It the title string is \
+already aligned left, you cannot adjust it to be even further left \
+because there are button in the way."
+ :group (appearance mxflat:group mxflat:title-group mxflat:title-basic-group)
+ :type (number -10000 10000)
+ :depends mxflat:customize-title-position
+ :after-set rebuild-all-frames)
(defcustom mxflat:title-y-justify
- 'center
- "title string vertical alignment"
- :group (appearance mxflat:group mxflat:title-group mxflat:title-basic-group)
- :type symbol
- :depends mxflat:customize-title-position
- :options (top center bottom)
- :after-set rebuild-all-frames
-)
+ 'center
+ "title string vertical alignment"
+ :group (appearance mxflat:group mxflat:title-group mxflat:title-basic-group)
+ :type symbol
+ :depends mxflat:customize-title-position
+ :options (top center bottom)
+ :after-set rebuild-all-frames)
(defcustom mxflat:title-y-adjustment
- 0
- "title string vertical align adjustment (-10000 - 10000 pixel)"
- :group (appearance mxflat:group mxflat:title-group mxflat:title-basic-group)
- :type (number -10000 10000)
- :depends mxflat:customize-title-position
- :after-set rebuild-all-frames
-)
-
-;
+ 0
+ "title string vertical align adjustment (-10000 - 10000 pixel)"
+ :group (appearance mxflat:group mxflat:title-group mxflat:title-basic-group)
+ :type (number -10000 10000)
+ :depends mxflat:customize-title-position
+ :after-set rebuild-all-frames)
+
+;;
;; configuration:title-gradient
-;
+;;
(defcustom mxflat:title-gradient
- nil
- "gradient titlebar background (experimental)"
- :tooltip "when activating the gradient background the normal titlebar background colors will be ignored. besides the button background colors will be ignored. (NOTE: this can be very cpu intensive if you set the quality to a low value, ie high quality.)"
- :group (appearance mxflat:group mxflat:title-group mxflat:title-gradient-group)
- :type boolean
- :after-set recreate-all-frames
-)
+ nil
+ "gradient titlebar background (experimental)"
+ :tooltip "When activating the gradient background the normal \
+titlebar background colors will be ignored. Besides the button \
+background colors will be ignored. (NOTE: This can be very cpu \
+intensive if you set the quality to a low value, i.e., high quality.)"
+ :group (appearance mxflat:group mxflat:title-group
+ mxflat:title-gradient-group)
+ :type boolean
+ :after-set recreate-all-frames)
(defcustom mxflat:gradient-direction
- 'horizontal
- "gradient mode"
- :tooltip "with gradient mode vertical or diagonal only the first or last (reversed) 2 colors in the list are used."
- :group (appearance mxflat:group mxflat:title-group mxflat:title-gradient-group)
- :options (none horizontal vertical diagonal)
- :depends mxflat:title-gradient
- :type symbol
- :after-set recreate-all-frames
-)
+ 'horizontal
+ "gradient mode"
+ :tooltip "With gradient mode vertical or diagonal only the first \
+or last (reversed) 2 colors in the list are used."
+ :group (appearance mxflat:group mxflat:title-group
+ mxflat:title-gradient-group)
+ :options (none horizontal vertical diagonal)
+ :depends mxflat:title-gradient
+ :type symbol
+ :after-set recreate-all-frames
+ )
(defcustom mxflat:gradient-scale
- 3
- "gradient quality (1 best - 20 worst)"
- :tooltip "the value here is the factor the calculated gradient image will be scaled down. this increases speed but decreases quality."
- :group (appearance mxflat:group mxflat:title-group mxflat:title-gradient-group)
- :depends mxflat:title-gradient
- :type (number 1 20)
- :after-set recreate-all-frames
-)
+ 3
+ "gradient quality (1 best - 20 worst)"
+ :tooltip "The value here is the factor the calculated gradient image \
+will be scaled down. This increases speed but decreases quality."
+ :group (appearance mxflat:group mxflat:title-group
+ mxflat:title-gradient-group)
+ :depends mxflat:title-gradient
+ :type (number 1 20)
+ :after-set recreate-all-frames)
(defcustom mxflat:titlebar-gradient-color-mode
- 'rainbow
- "gradient color mode"
- :tooltip "the custom mode will respect the colors set in the list below."
- :group (appearance mxflat:group mxflat:title-group mxflat:title-gradient-group)
- :options (rainbow jamaica rgb custom)
- :depends mxflat:title-gradient
- :type symbol
- :after-set recreate-all-frames
-)
+ 'rainbow
+ "gradient color mode"
+ :tooltip "the custom mode will respect the colors set in the list below."
+ :group (appearance mxflat:group mxflat:title-group
+ mxflat:title-gradient-group)
+ :options (rainbow jamaica rgb custom)
+ :depends mxflat:title-gradient
+ :type symbol
+ :after-set recreate-all-frames)
(defcustom mxflat:titlebar-gradient-bgcolors
- nil
- nil
- :tooltip "with gradient mode vertical or diagonal only the first or last (reversed) 2 colors in the list are used. besides the gradient color mode must be set to custom to activate this list."
- :group (appearance mxflat:group mxflat:title-group mxflat:title-gradient-group)
- :widget-flags (expand-horizontally)
- :depends mxflat:title-gradient
- :type* `(list color "titlebar background colors")
- :after-set recreate-all-frames
-)
+ nil
+ nil
+ :tooltip "With gradient mode vertical or diagonal only the first or \
+last (reversed) 2 colors in the list are used. Besides the gradient \
+color mode must be set to custom to activate this list."
+ :group (appearance mxflat:group mxflat:title-group
+ mxflat:title-gradient-group)
+ :widget-flags (expand-horizontally)
+ :depends mxflat:title-gradient
+ :type* `(list color "titlebar background colors")
+ :after-set recreate-all-frames)
(defcustom mxflat:titlebar-gradient-bgcolors-reverse
- nil
- "reverse colors"
- :group (appearance mxflat:group mxflat:title-group mxflat:title-gradient-group)
- :depends mxflat:title-gradient
- :type boolean
- :after-set recreate-all-frames
-)
+ nil
+ "reverse colors"
+ :group (appearance mxflat:group mxflat:title-group
+ mxflat:title-gradient-group)
+ :depends mxflat:title-gradient
+ :type boolean
+ :after-set recreate-all-frames)
(defcustom mxflat:color-hue
- 0
- "unfocused/highlighted titlebar colors hue (0 - 360)"
- :tooltip "this value changes the hue of a color, by moving (0 - 360) degress around the color cycle...180 for example inverts the color"
- :group (appearance mxflat:group mxflat:title-group mxflat:title-gradient-group)
- :depends mxflat:title-gradient
- :type (number 0 360)
- :after-set recreate-all-frames
-)
+ 0
+ "unfocused/highlighted titlebar colors hue (0 - 360)"
+ :tooltip "This value changes the hue of a color, by moving (0 - 360) \
+degress around the color cycle...180 for example inverts the color"
+ :group (appearance mxflat:group mxflat:title-group
+ mxflat:title-gradient-group)
+ :depends mxflat:title-gradient
+ :type (number 0 360)
+ :after-set recreate-all-frames)
(defcustom mxflat:color-saturation
- 50
- "unfocused/highlighted titlebar colors saturation (0 - 100% of the focused color)"
- :tooltip "the saturation of a color is a measurement of the color intensity"
- :group (appearance mxflat:group mxflat:title-group mxflat:title-gradient-group)
- :depends mxflat:title-gradient
- :type (number 0 100)
- :after-set recreate-all-frames
-)
+ 50
+ "unfocused/highlighted titlebar colors saturation (0 - 100% of the \
+focused color)"
+ :tooltip "The saturation of a color is a measurement of the color \
+intensity"
+ :group (appearance mxflat:group mxflat:title-group
+ mxflat:title-gradient-group)
+ :depends mxflat:title-gradient
+ :type (number 0 100)
+ :after-set recreate-all-frames)
(defcustom mxflat:color-brightness
- 90
- "unfocused/highlighted titlebar colors brightness (0 - 100% of the focused color)"
- :group (appearance mxflat:group mxflat:title-group mxflat:title-gradient-group)
- :depends mxflat:title-gradient
- :type (number 0 100)
- :after-set recreate-all-frames
-)
-
-;
+ 90
+ "unfocused/highlighted titlebar colors brightness (0 - 100% of the \
+focused color)"
+ :group (appearance mxflat:group mxflat:title-group
+ mxflat:title-gradient-group)
+ :depends mxflat:title-gradient
+ :type (number 0 100)
+ :after-set recreate-all-frames)
+
+;;
;; configuration:title-colors
-;
+;;
(defcustom mxflat:titlebar-bgcolor-focused
- (get-color "#fffbde")
- " focused titlebar color"
- :tooltip "this is one of the 4 base colors. you can set these 4 colors and keep the extended colors deactivated. all other color options of the theme will then depend on these 4 colors."
- :group (appearance mxflat:group mxflat:title-group mxflat:title-colors-group)
- :type color
- :after-set recreate-all-frames
-)
+ (get-color "#fffbde")
+ " focused titlebar color"
+ :tooltip "This is one of the 4 base colors. You can set these 4 \
+colors and keep the extended colors deactivated. All other color \
+options of the theme will then depend on these 4 colors."
+ :group (appearance mxflat:group mxflat:title-group
+ mxflat:title-colors-group)
+ :type color
+ :after-set recreate-all-frames)
(defcustom mxflat:titlebar-bgcolor-unfocused
- (get-color "#cedfef")
- "unfocused titlebar color"
- :tooltip "this is one of the 4 base colors. you can set these 4 colors and keep the extended colors deactivated. all other color options of the theme will then depend on these 4 colors."
- :group (appearance mxflat:group mxflat:title-group mxflat:title-colors-group)
- :type color
- :after-set recreate-all-frames
-)
+ (get-color "#cedfef")
+ "unfocused titlebar color"
+ :tooltip "This is one of the 4 base colors. You can set these 4 \
+colors and keep the extended colors deactivated. All other color \
+options of the theme will then depend on these 4 colors."
+ :group (appearance mxflat:group mxflat:title-group
+ mxflat:title-colors-group)
+ :type color
+ :after-set recreate-all-frames)
(defcustom mxflat:text-color-focused
- (get-color "#000000")
- " focused title string color"
- :tooltip "this is one of the 4 base colors. you can set these 4 colors and keep the extended colors deactivated. all other color options of the theme will then depend on these 4 colors."
- :group (appearance mxflat:group mxflat:title-group mxflat:title-colors-group)
- :type color
- :after-set recreate-all-frames-recolor-all
-)
+ (get-color "#000000")
+ " focused title string color"
+ :tooltip "This is one of the 4 base colors. You can set these 4 \
+colors and keep the extended colors deactivated. All other color \
+options of the theme will then depend on these 4 colors."
+ :group (appearance mxflat:group mxflat:title-group
+ mxflat:title-colors-group)
+ :type color
+ :after-set recreate-all-frames-recolor-all)
(defcustom mxflat:text-color-unfocused
- (get-color "#838383")
- "unfocused title string color"
- :tooltip "this is one of the 4 base colors. you can set these 4 colors and keep the extended colors deactivated. all other color options of the theme will then depend on these 4 colors."
- :group (appearance mxflat:group mxflat:title-group mxflat:title-colors-group)
- :type color
- :after-set recreate-all-frames-recolor-all
-)
+ (get-color "#838383")
+ "unfocused title string color"
+ :tooltip "This is one of the 4 base colors. You can set these 4 \
+colors and keep the extended colors deactivated. All other color \
+options of the theme will then depend on these 4 colors."
+ :group (appearance mxflat:group mxflat:title-group
+ mxflat:title-colors-group)
+ :type color
+ :after-set recreate-all-frames-recolor-all)
(defcustom mxflat:customize-extended-text-colors
- nil
- "customize extended title string colors"
- :tooltip "you can customize additional colors of the title string. if you deactivate this, these colors will be set to the focused title string color."
- :group (appearance mxflat:group mxflat:title-group mxflat:title-colors-group)
- :type boolean
- :after-set recreate-all-frames
-)
+ nil
+ "customize extended title string colors"
+ :tooltip "You can customize additional colors of the title string. \
+If you deactivate this, these colors will be set to the focused title \
+string color."
+ :group (appearance mxflat:group mxflat:title-group
+ mxflat:title-colors-group)
+ :type boolean
+ :after-set recreate-all-frames)
(defcustom mxflat:text-color-highlighted
- (get-color "#000000")
- " focused highlighted title string color"
- :group (appearance mxflat:group mxflat:title-group mxflat:title-colors-group)
- :type color
- :depends mxflat:customize-extended-text-colors
- :after-set recreate-all-frames
-)
+ (get-color "#000000")
+ " focused highlighted title string color"
+ :group (appearance mxflat:group mxflat:title-group
+ mxflat:title-colors-group)
+ :type color
+ :depends mxflat:customize-extended-text-colors
+ :after-set recreate-all-frames)
(defcustom mxflat:text-color-inactive-highlighted
- (get-color "#000000")
- "unfocused highlighted title string color"
- :group (appearance mxflat:group mxflat:title-group mxflat:title-colors-group)
- :type color
- :depends mxflat:customize-extended-text-colors
- :after-set recreate-all-frames
-)
+ (get-color "#000000")
+ "unfocused highlighted title string color"
+ :group (appearance mxflat:group mxflat:title-group
+ mxflat:title-colors-group)
+ :type color
+ :depends mxflat:customize-extended-text-colors
+ :after-set recreate-all-frames)
(defcustom mxflat:text-color-clicked
- (get-color "#000000")
- " focused clicked title string color"
- :group (appearance mxflat:group mxflat:title-group mxflat:title-colors-group)
- :type color
- :depends mxflat:customize-extended-text-colors
- :after-set recreate-all-frames
-)
+ (get-color "#000000")
+ " focused clicked title string color"
+ :group (appearance mxflat:group mxflat:title-group
+ mxflat:title-colors-group)
+ :type color
+ :depends mxflat:customize-extended-text-colors
+ :after-set recreate-all-frames)
(defcustom mxflat:text-color-inactive-clicked
- (get-color "#000000")
- "unfocused clicked title string color"
- :group (appearance mxflat:group mxflat:title-group mxflat:title-colors-group)
- :type color
- :depends mxflat:customize-extended-text-colors
- :after-set recreate-all-frames
-)
+ (get-color "#000000")
+ "unfocused clicked title string color"
+ :group (appearance mxflat:group mxflat:title-group
+ mxflat:title-colors-group)
+ :type color
+ :depends mxflat:customize-extended-text-colors
+ :after-set recreate-all-frames)
;; configuration:buttons-basic
-;
+;;
(defcustom mxflat:button-icon-set
- 'default-9
- "button icon set (experimental)"
- :tooltip "the number at the end is the width/height of the button icons in the icon set. (NOTE: YOU NEED TO RESTART SAWFISH AFTER CHANGING THE BUTTON ICON SET!)"
- :group (appearance mxflat:group mxflat:buttons-group mxflat:buttons-basic-group)
- :options (default-9 default-12 square-6 square-9 square-12 square-15 square-18 ball-9 ball-12)
- :type symbol
- :after-set recreate-all-frames-clear-cache
-)
+ 'default-9
+ "button icon set (experimental)"
+ :tooltip "The number at the end is the width/height of the button \
+icons in the icon set. (NOTE: YOU NEED TO RESTART SAWFISH AFTER \
+CHANGING THE BUTTON ICON SET!)"
+ :group (appearance mxflat:group mxflat:buttons-group
+ mxflat:buttons-basic-group)
+ :options (default-9 default-12 square-6 square-9 square-12
+ square-15 square-18 ball-9 ball-12)
+ :type symbol
+ :after-set recreate-all-frames-clear-cache)
(defcustom mxflat:customize-button-size
- nil
- "customize button size"
- :tooltip "by default the button size follows the size of the titlebar, but by activating this you can set it to something different."
- :group (appearance mxflat:group mxflat:buttons-group mxflat:buttons-basic-group)
- :type boolean
- :after-set rebuild-all-frames
-)
+ nil
+ "customize button size"
+ :tooltip "By default the button size follows the size of the \
+titlebar, but by activating this you can set it to something \
+different."
+ :group (appearance mxflat:group mxflat:buttons-group
+ mxflat:buttons-basic-group)
+ :type boolean
+ :after-set rebuild-all-frames)
(defcustom mxflat:button-size
- 14
- "buttons size (1 - 1000 pixel)"
- :tooltip "a buttons size that is bigger than your current titlebar height is ignored."
- :group (appearance mxflat:group mxflat:buttons-group mxflat:buttons-basic-group)
- :depends mxflat:customize-button-size
- :type (number 1 1000)
- :after-set rebuild-all-frames
-)
+ 14
+ "buttons size (1 - 1000 pixel)"
+ :tooltip "A buttons size that is bigger than your current titlebar \
+height is ignored."
+ :group (appearance mxflat:group mxflat:buttons-group
+ mxflat:buttons-basic-group)
+ :depends mxflat:customize-button-size
+ :type (number 1 1000)
+ :after-set rebuild-all-frames)
(defcustom mxflat:button-y-alignment
- 'center
- "button vertical alignment"
- :tooltip "if a button is smaller than the titlebar you might want to set its vertical alignment."
- :group (appearance mxflat:group mxflat:buttons-group mxflat:buttons-basic-group)
- :depends mxflat:customize-button-size
- :options (top center bottom)
- :type symbol
- :after-set rebuild-all-frames
-)
+ 'center
+ "button vertical alignment"
+ :tooltip "If a button is smaller than the titlebar you might want to \
+set its vertical alignment."
+ :group (appearance mxflat:group mxflat:buttons-group
+ mxflat:buttons-basic-group)
+ :depends mxflat:customize-button-size
+ :options (top center bottom)
+ :type symbol
+ :after-set rebuild-all-frames)
(defcustom mxflat:scale-buttons
- nil
- "scale button icons (experimental)"
- :tooltip "in case you don't like the default size of 9 pixel you might activate button-scaling. YOU NEED TO RESTART SAWFISH AFTER CHANGING THE BUTTON SCALE!"
- :group (appearance mxflat:group mxflat:buttons-group mxflat:buttons-basic-group)
- :type boolean
- :after-set recreate-all-frames-clear-cache
-)
+ nil
+ "scale button icons (experimental)"
+ :tooltip "In case you don't like the default size of 9 pixel you \
+might activate button-scaling. YOU NEED TO RESTART SAWFISH AFTER \
+CHANGING THE BUTTON SCALE!"
+ :group (appearance mxflat:group mxflat:buttons-group
+ mxflat:buttons-basic-group)
+ :type boolean
+ :after-set recreate-all-frames-clear-cache)
(defcustom mxflat:button-scale
- 9
- "button icon scale; changes here need a restart of sawfish (0 - 1000 pixel)"
- :tooltip "in case you don't like the default size of 9 pixel you might activate button-scaling. (NOTE: YOU NEED TO RESTART SAWFISH AFTER CHANGING THE BUTTON SCALE!)"
- :group (appearance mxflat:group mxflat:buttons-group mxflat:buttons-basic-group)
- :depends mxflat:scale-buttons
- :type (number 0 1000)
- :after-set recreate-all-frames-clear-cache
-)
+ 9
+ "button icon scale; changes here need a restart of sawfish (0 - 1000 \
+pixel)"
+ :tooltip "in case you don't like the default size of 9 pixel you \
+might activate button-scaling. (NOTE: YOU NEED TO RESTART SAWFISH \
+AFTER CHANGING THE BUTTON SCALE!)"
+ :group (appearance mxflat:group mxflat:buttons-group
+ mxflat:buttons-basic-group)
+ :depends mxflat:scale-buttons
+ :type (number 0 1000)
+ :after-set recreate-all-frames-clear-cache)
(defcustom mxflat:menu-button-icon
- nil
- "display window icon on menu button"
- :tooltip "many people like having the window-icon displayed on the menu-button. this icon is defined by the application itself and is also shown in your pager and task-list."
- :group (appearance mxflat:group mxflat:buttons-group mxflat:buttons-basic-group)
- :type boolean
- :after-set recreate-all-frames
-)
+ nil
+ "display window icon on menu button"
+ :tooltip "Many people like having the window-icon displayed on the \
+menu-button. This icon is defined by the application itself and is \
+also shown in your pager and task-list."
+ :group (appearance mxflat:group mxflat:buttons-group
+ mxflat:buttons-basic-group)
+ :type boolean
+ :after-set recreate-all-frames)
(defcustom mxflat:menu-button-scale
- 12
- "menu icon scale (0 - 1000 pixel)"
- :group (appearance mxflat:group mxflat:buttons-group mxflat:buttons-basic-group)
- :depends mxflat:menu-button-icon
- :type (number 0 1000)
- :after-set recreate-all-frames-clear-cache
-)
-
-;
+ 12
+ "menu icon scale (0 - 1000 pixel)"
+ :group (appearance mxflat:group mxflat:buttons-group
+ mxflat:buttons-basic-group)
+ :depends mxflat:menu-button-icon
+ :type (number 0 1000)
+ :after-set recreate-all-frames-clear-cache)
+
+;;
;; configuration:buttons-position1
-;
+;;
(defcustom mxflat:button-distance
- 3
- "button distance (0 - 1000 pixel)"
- :group (appearance mxflat:group mxflat:buttons-group mxflat:buttons-positions1-group)
- :type (number 0 1000)
- :after-set rebuild-all-frames
-)
+ 3
+ "button distance (0 - 1000 pixel)"
+ :group (appearance mxflat:group mxflat:buttons-group
+ mxflat:buttons-positions1-group)
+ :type (number 0 1000)
+ :after-set rebuild-all-frames)
(defcustom mxflat:button-left-offset
- 1
- "buttons left offset (0 - 1000 pixel)"
- :group (appearance mxflat:group mxflat:buttons-group mxflat:buttons-positions1-group)
- :type (number 0 1000)
- :after-set rebuild-all-frames
-)
+ 1
+ "buttons left offset (0 - 1000 pixel)"
+ :group (appearance mxflat:group mxflat:buttons-group
+ mxflat:buttons-positions1-group)
+ :type (number 0 1000)
+ :after-set rebuild-all-frames)
(defcustom mxflat:button-right-offset
- 1
- "buttons right offset (0 - 1000 pixel)"
- :group (appearance mxflat:group mxflat:buttons-group mxflat:buttons-positions1-group)
- :type (number 0 1000)
- :after-set rebuild-all-frames
-)
+ 1
+ "buttons right offset (0 - 1000 pixel)"
+ :group (appearance mxflat:group mxflat:buttons-group
+ mxflat:buttons-positions1-group)
+ :type (number 0 1000)
+ :after-set rebuild-all-frames)
(defcustom mxflat:customize-buttons
- nil
- "customize button position (-1 -2 -3 .. title string .. +3 +2 +1)"
- :tooltip "enabling this will allow you to set the positon of each button in the titlebar manually. a negative/positiv value means the button will be drawn on left/right side of the titlebar."
- :group (appearance mxflat:group mxflat:buttons-group mxflat:buttons-positions1-group)
- :type boolean
- :after-set recreate-all-frames
-)
+ nil
+ "customize button position (-1 -2 -3 .. title string .. +3 +2 +1)"
+ :tooltip "Enabling this will allow you to set the positon of each \
+button in the titlebar manually. A negative/positiv value means the \
+button will be drawn on left/right side of the titlebar."
+ :group (appearance mxflat:group mxflat:buttons-group
+ mxflat:buttons-positions1-group)
+ :type boolean
+ :after-set recreate-all-frames)
(defcustom mxflat:button-position-model
- 'title-height
- "button position model"
- :tooltip "'titel-height' means calculate position as multiple of title height. when selecting 'pixel' you can adjust the button position pixelwise, but keep in mind that several buttons might slide on top of each other. 'none' means no buttons at all."
- :group (appearance mxflat:group mxflat:buttons-group mxflat:buttons-positions1-group)
- :options (title-height pixel none)
- :depends mxflat:customize-buttons
- :type symbol
- :after-set rebuild-all-frames
-)
-
-;
+ 'title-height
+ "button position model"
+ :tooltip "'title-height' means calculate position as multiple of \
+title height. when selecting 'pixel' you can adjust the button \
+position pixelwise, but keep in mind that several buttons might \
+slide on top of each other. 'none' means no buttons at all."
+ :group (appearance mxflat:group mxflat:buttons-group
+ mxflat:buttons-positions1-group)
+ :options (title-height pixel none)
+ :depends mxflat:customize-buttons
+ :type symbol
+ :after-set rebuild-all-frames)
+
+;;
;; configuration:buttons-position2
-;
+;;
(defcustom mxflat:menu-button-position
- -1
- "menu button position"
- :group (appearance mxflat:group mxflat:buttons-group mxflat:buttons-positions2-group)
- :depends mxflat:customize-buttons
- :type (number -10000 10000)
- :after-set rebuild-all-frames
-)
+ -1
+ "menu button position"
+ :group (appearance mxflat:group mxflat:buttons-group
+ mxflat:buttons-positions2-group)
+ :depends mxflat:customize-buttons
+ :type (number -10000 10000)
+ :after-set rebuild-all-frames)
(defcustom mxflat:shade-button-position
- -2
- "shade button position"
- :group (appearance mxflat:group mxflat:buttons-group mxflat:buttons-positions2-group)
- :depends mxflat:customize-buttons
- :type (number -10000 10000)
- :after-set rebuild-all-frames
-)
+ -2
+ "shade button position"
+ :group (appearance mxflat:group mxflat:buttons-group
+ mxflat:buttons-positions2-group)
+ :depends mxflat:customize-buttons
+ :type (number -10000 10000)
+ :after-set rebuild-all-frames)
(defcustom mxflat:iconify-button-position
- +3
- "iconify button position"
- :group (appearance mxflat:group mxflat:buttons-group mxflat:buttons-positions2-group)
- :depends mxflat:customize-buttons
- :type (number -10000 10000)
- :after-set rebuild-all-frames
-)
+ +3
+ "iconify button position"
+ :group (appearance mxflat:group mxflat:buttons-group
+ mxflat:buttons-positions2-group)
+ :depends mxflat:customize-buttons
+ :type (number -10000 10000)
+ :after-set rebuild-all-frames)
(defcustom mxflat:maximize-button-position
- +2
- "maximize button position"
- :group (appearance mxflat:group mxflat:buttons-group mxflat:buttons-positions2-group)
- :depends mxflat:customize-buttons
- :type (number -10000 10000)
- :after-set rebuild-all-frames
-)
+ +2
+ "maximize button position"
+ :group (appearance mxflat:group mxflat:buttons-group
+ mxflat:buttons-positions2-group)
+ :depends mxflat:customize-buttons
+ :type (number -10000 10000)
+ :after-set rebuild-all-frames)
(defcustom mxflat:close-button-position
- +1
- "close button position"
- :group (appearance mxflat:group mxflat:buttons-group mxflat:buttons-positions2-group)
- :depends mxflat:customize-buttons
- :type (number -10000 10000)
- :after-set rebuild-all-frames
-)
+ +1
+ "close button position"
+ :group (appearance mxflat:group mxflat:buttons-group
+ mxflat:buttons-positions2-group)
+ :depends mxflat:customize-buttons
+ :type (number -10000 10000)
+ :after-set rebuild-all-frames)
(defcustom mxflat:sticky-button-position
- -3
- "sticky button position"
- :group (appearance mxflat:group mxflat:buttons-group mxflat:buttons-positions2-group)
- :depends mxflat:customize-buttons
- :type (number -10000 10000)
- :after-set rebuild-all-frames
-)
+ -3
+ "sticky button position"
+ :group (appearance mxflat:group mxflat:buttons-group
+ mxflat:buttons-positions2-group)
+ :depends mxflat:customize-buttons
+ :type (number -10000 10000)
+ :after-set rebuild-all-frames)
(defcustom mxflat:previous-button-position
- -5
- "previous workspace button position"
- :group (appearance mxflat:group mxflat:buttons-group mxflat:buttons-positions2-group)
- :depends mxflat:customize-buttons
- :type (number -10000 10000)
- :after-set rebuild-all-frames
-)
+ -5
+ "previous workspace button position"
+ :group (appearance mxflat:group mxflat:buttons-group
+ mxflat:buttons-positions2-group)
+ :depends mxflat:customize-buttons
+ :type (number -10000 10000)
+ :after-set rebuild-all-frames)
(defcustom mxflat:next-button-position
- -6
- "next workspace button position"
- :group (appearance mxflat:group mxflat:buttons-group mxflat:buttons-positions2-group)
- :depends mxflat:customize-buttons
- :type (number -10000 10000)
- :after-set rebuild-all-frames
-)
+ -6
+ "next workspace button position"
+ :group (appearance mxflat:group mxflat:buttons-group
+ mxflat:buttons-positions2-group)
+ :depends mxflat:customize-buttons
+ :type (number -10000 10000)
+ :after-set rebuild-all-frames)
(defcustom mxflat:configure-button-position
- 0
- "configure button position"
- :group (appearance mxflat:group mxflat:buttons-group mxflat:buttons-positions2-group)
- :depends mxflat:customize-buttons
- :type (number -10000 10000)
- :after-set rebuild-all-frames
-)
+ 0
+ "configure button position"
+ :group (appearance mxflat:group mxflat:buttons-group
+ mxflat:buttons-positions2-group)
+ :depends mxflat:customize-buttons
+ :type (number -10000 10000)
+ :after-set rebuild-all-frames)
(defcustom mxflat:info-button-position
- 0
- "info button position"
- :group (appearance mxflat:group mxflat:buttons-group mxflat:buttons-positions2-group)
- :depends mxflat:customize-buttons
- :type (number -10000 10000)
- :after-set rebuild-all-frames
-)
+ 0
+ "info button position"
+ :group (appearance mxflat:group mxflat:buttons-group
+ mxflat:buttons-positions2-group)
+ :depends mxflat:customize-buttons
+ :type (number -10000 10000)
+ :after-set rebuild-all-frames)
(defcustom mxflat:always-on-top-button-position
- 0
- "always-on-top button position"
- :group (appearance mxflat:group mxflat:buttons-group mxflat:buttons-positions2-group)
- :depends mxflat:customize-buttons
- :type (number -10000 10000)
- :after-set rebuild-all-frames
-)
+ 0
+ "always-on-top button position"
+ :group (appearance mxflat:group mxflat:buttons-group
+ mxflat:buttons-positions2-group)
+ :depends mxflat:customize-buttons
+ :type (number -10000 10000)
+ :after-set rebuild-all-frames)
(defcustom mxflat:lock-button-position
- 0
- "lock button position"
- :group (appearance mxflat:group mxflat:buttons-group mxflat:buttons-positions2-group)
- :depends mxflat:customize-buttons
- :type (number -10000 10000)
- :after-set rebuild-all-frames
-)
-
-;
+ 0
+ "lock button position"
+ :group (appearance mxflat:group mxflat:buttons-group
+ mxflat:buttons-positions2-group)
+ :depends mxflat:customize-buttons
+ :type (number -10000 10000)
+ :after-set rebuild-all-frames)
+
+;;
;; configuration:buttons-keymaps1
-;
+;;
(defcustom mxflat:customize-sticky-keymap
- nil
- "customize sticky button keymap"
- :tooltip "by default a button will work as it's name suggests. button1: toggle sticky state of window"
- :group (appearance mxflat:group mxflat:buttons-group mxflat:buttons-keymaps1-group)
- :type boolean
- :after-set recreate-all-frames
-)
+ nil
+ "customize sticky button keymap"
+ :tooltip "By default a button will work as it's name suggests.
+Button1: toggle sticky state of window"
+ :group (appearance mxflat:group mxflat:buttons-group
+ mxflat:buttons-keymaps1-group)
+ :type boolean
+ :after-set recreate-all-frames)
(defcustom mxflat:sticky-button-keymap
- nil
- nil
- :group (appearance mxflat:group mxflat:buttons-group mxflat:buttons-keymaps1-group)
- :widget-flags (expand-horizontally)
- :depends mxflat:customize-sticky-keymap
- :type keymap
-)
+ nil
+ nil
+ :group (appearance mxflat:group mxflat:buttons-group
+ mxflat:buttons-keymaps1-group)
+ :widget-flags (expand-horizontally)
+ :depends mxflat:customize-sticky-keymap
+ :type keymap)
(defcustom mxflat:customize-previous-keymap
- nil
- "customize previous button keymap"
- :tooltip "by default a button will work as it's name suggests. button1: send window to previous workspace - button2 workspace-list - button3 send window to first workspace - button6 pack window left"
- :group (appearance mxflat:group mxflat:buttons-group mxflat:buttons-keymaps1-group)
- :type boolean
- :after-set recreate-all-frames
-)
+ nil
+ "customize previous button keymap"
+ :tooltip "By default a button will work as it's name suggests. \
+Button1: send window to previous workspace - button2 workspace-list \
+- button3 send window to first workspace - button6 pack window left"
+ :group (appearance mxflat:group mxflat:buttons-group
+ mxflat:buttons-keymaps1-group)
+ :type boolean
+ :after-set recreate-all-frames)
(defcustom mxflat:previous-button-keymap
- nil
- nil
- :group (appearance mxflat:group mxflat:buttons-group mxflat:buttons-keymaps1-group)
- :widget-flags (expand-horizontally)
- :depends mxflat:customize-previous-keymap
- :type keymap
-)
+ nil
+ nil
+ :group (appearance mxflat:group mxflat:buttons-group
+ mxflat:buttons-keymaps1-group)
+ :widget-flags (expand-horizontally)
+ :depends mxflat:customize-previous-keymap
+ :type keymap)
(defcustom mxflat:customize-next-keymap
- nil
- "customize next button keymap"
- :tooltip "by default a button will work as it's name suggests. button1: send window to next workspace - button2 workspace-list - button3 send window to last workspace - button6 pack window right"
- :group (appearance mxflat:group mxflat:buttons-group mxflat:buttons-keymaps1-group)
- :type boolean
- :after-set recreate-all-frames
-)
+ nil
+ "customize next button keymap"
+ :tooltip "By default a button will work as it's name suggests. \
+Button1: send window to next workspace - button2 workspace-list - \
+button3 send window to last workspace - button6 pack window right"
+ :group (appearance mxflat:group mxflat:buttons-group
+ mxflat:buttons-keymaps1-group)
+ :type boolean
+ :after-set recreate-all-frames)
(defcustom mxflat:next-button-keymap
- nil
- nil
- :tooltip "button1: send window to next workspace - button2 workspace-list - button3 send window to last workspace - button6 pack window right"
- :group (appearance mxflat:group mxflat:buttons-group mxflat:buttons-keymaps1-group)
- :widget-flags (expand-horizontally)
- :depends mxflat:customize-next-keymap
- :type keymap
-)
-
-;
+ nil
+ nil
+ :tooltip "button1: send window to next workspace - button2 \
+workspace-list - button3 send window to last workspace - button6 \
+pack window right"
+ :group (appearance mxflat:group mxflat:buttons-group
+ mxflat:buttons-keymaps1-group)
+ :widget-flags (expand-horizontally)
+ :depends mxflat:customize-next-keymap
+ :type keymap)
+
+;;
;; configuration:buttons-keymaps2
-;
+;;
(defcustom mxflat:customize-configure-keymap
- nil
- "customize configure button keymap"
- :tooltip "by default a button will work as it's name suggests. button1: start sawfish-config - button3: toggle custom title string"
- :group (appearance mxflat:group mxflat:buttons-group mxflat:buttons-keymaps2-group)
- :type boolean
- :after-set recreate-all-frames
-)
+ nil
+ "customize configure button keymap"
+ :tooltip "By default a button will work as it's name suggests. \
+Button1: start sawfish-config - button3: toggle custom title string"
+ :group (appearance mxflat:group mxflat:buttons-group
+ mxflat:buttons-keymaps2-group)
+ :type boolean
+ :after-set recreate-all-frames)
(defcustom mxflat:configure-button-keymap
- nil
- nil
- :tooltip "button1: start sawfish-config - button3: toggle custom title string"
- :group (appearance mxflat:group mxflat:buttons-group mxflat:buttons-keymaps2-group)
- :widget-flags (expand-horizontally)
- :depends mxflat:customize-configure-keymap
- :type keymap
-)
+ nil
+ nil
+ :tooltip "Button1: start sawfish-config - button3: toggle custom \
+title string"
+ :group (appearance mxflat:group mxflat:buttons-group
+ mxflat:buttons-keymaps2-group)
+ :widget-flags (expand-horizontally)
+ :depends mxflat:customize-configure-keymap
+ :type keymap)
(defcustom mxflat:customize-info-keymap
- nil
- "customize info button keymap"
- :tooltip "by default a button will work as it's name suggests. button1: window list - button3 window snooper (not included by default)"
- :group (appearance mxflat:group mxflat:buttons-group mxflat:buttons-keymaps2-group)
- :type boolean
- :after-set recreate-all-frames
-)
+ nil
+ "customize info button keymap"
+ :tooltip "By default a button will work as it's name suggests. \
+Button1: window list - button3 window snooper (not included by \
+default)"
+ :group (appearance mxflat:group mxflat:buttons-group
+ mxflat:buttons-keymaps2-group)
+ :type boolean
+ :after-set recreate-all-frames)
(defcustom mxflat:info-button-keymap
- nil
- nil
- :group (appearance mxflat:group mxflat:buttons-group mxflat:buttons-keymaps2-group)
- :widget-flags (expand-horizontally)
- :depends mxflat:customize-info-keymap
- :type keymap
-)
+ nil
+ nil
+ :group (appearance mxflat:group mxflat:buttons-group
+ mxflat:buttons-keymaps2-group)
+ :widget-flags (expand-horizontally)
+ :depends mxflat:customize-info-keymap
+ :type keymap)
(defcustom mxflat:always-on-top-depth
- 1
- "always on top depth (-1000 - 1000)"
- :tooltip "a window will have this depth after you have pressed the always-on-top button. 0 is the normal window level. every positive value means above other windows, a negative value means below. keept it at a positive value in order to have the always-on-top button do it's job."
- :group (appearance mxflat:group mxflat:buttons-group mxflat:buttons-keymaps2-group)
- :type (number -1000 1000)
- :after-set rebuild-all-frames
-)
+ 1
+ "always on top depth (-1000 - 1000)"
+ :tooltip "A window will have this depth after you have pressed the \
+always-on-top button. 0 is the normal window level. Every positive \
+value means above other windows, a negative value means below. Keep \
+it at a positive value in order to have the always-on-top button do \
+it's job."
+ :group (appearance mxflat:group mxflat:buttons-group
+ mxflat:buttons-keymaps2-group)
+ :type (number -1000 1000)
+ :after-set rebuild-all-frames)
(defcustom mxflat:customize-always-on-top-keymap
- nil
- "customize always-on-top button keymap"
- :tooltip "by default a button will work as it's name suggests. button1: sets window depth to the adjusted value"
- :group (appearance mxflat:group mxflat:buttons-group mxflat:buttons-keymaps2-group)
- :type boolean
- :after-set recreate-all-frames
-)
+ nil
+ "customize always-on-top button keymap"
+ :tooltip "By default a button will work as it's name suggests. \
+Button1: sets window depth to the adjusted value."
+ :group (appearance mxflat:group mxflat:buttons-group
+ mxflat:buttons-keymaps2-group)
+ :type boolean
+ :after-set recreate-all-frames)
(defcustom mxflat:always-on-top-button-keymap
- nil
- nil
- :group (appearance mxflat:group mxflat:buttons-group mxflat:buttons-keymaps2-group)
- :depends mxflat:customize-always-on-top-keymap
- :widget-flags (expand-horizontally)
- :type keymap
-)
+ nil
+ nil
+ :group (appearance mxflat:group mxflat:buttons-group
+ mxflat:buttons-keymaps2-group)
+ :depends mxflat:customize-always-on-top-keymap
+ :widget-flags (expand-horizontally)
+ :type keymap)
(defcustom mxflat:customize-lock-keymap
- nil
- "customize look button keymap"
- :tooltip "by default a button will work as it's name suggests. button1: lock window position"
- :group (appearance mxflat:group mxflat:buttons-group mxflat:buttons-keymaps2-group)
- :type boolean
- :after-set recreate-all-frames
-)
+ nil
+ "customize look button keymap"
+ :tooltip "By default a button will work as it's name suggests. \
+Button1: lock window position"
+ :group (appearance mxflat:group mxflat:buttons-group
+ mxflat:buttons-keymaps2-group)
+ :type boolean
+ :after-set recreate-all-frames)
(defcustom mxflat:lock-button-keymap
- nil
- nil
- :group (appearance mxflat:group mxflat:buttons-group mxflat:buttons-keymaps2-group)
- :depends mxflat:customize-lock-keymap
- :widget-flags (expand-horizontally)
- :type keymap
-)
-
-;
+ nil
+ nil
+ :group (appearance mxflat:group mxflat:buttons-group
+ mxflat:buttons-keymaps2-group)
+ :depends mxflat:customize-lock-keymap
+ :widget-flags (expand-horizontally)
+ :type keymap)
+
+;;
;; configuration:button-colors
-;
+;;
(defcustom mxflat:custom-button-colors
- nil
- "customize button-colors"
- :tooltip "when you active this you will be able to set custom button colors. by default the button colors depend on the titlebar colors."
- :group (appearance mxflat:group mxflat:buttons-group mxflat:button-colors-group)
- :type boolean
- :after-set recreate-all-frames-recolor-all
-)
+ nil
+ "customize button-colors"
+ :tooltip "When you active this you will be able to set custom \
+button colors. By default the button colors depend on the titlebar \
+colors."
+ :group (appearance mxflat:group mxflat:buttons-group
+ mxflat:button-colors-group)
+ :type boolean
+ :after-set recreate-all-frames-recolor-all)
(defcustom mxflat:button-bgcolor-focused
- (get-color "#fffbde")
- " focused button background color"
- :group (appearance mxflat:group mxflat:buttons-group mxflat:button-colors-group)
- :depends mxflat:custom-button-colors
- :type color
- :after-set recreate-all-frames
-)
+ (get-color "#fffbde")
+ " focused button background color"
+ :group (appearance mxflat:group mxflat:buttons-group
+ mxflat:button-colors-group)
+ :depends mxflat:custom-button-colors
+ :type color
+ :after-set recreate-all-frames)
(defcustom mxflat:button-bgcolor-unfocused
- (get-color "#cedfef")
- "unfocused button background color"
- :group (appearance mxflat:group mxflat:buttons-group mxflat:button-colors-group)
- :depends mxflat:custom-button-colors
- :type color
- :after-set recreate-all-frames
-)
+ (get-color "#cedfef")
+ "unfocused button background color"
+ :group (appearance mxflat:group mxflat:buttons-group
+ mxflat:button-colors-group)
+ :depends mxflat:custom-button-colors
+ :type color
+ :after-set recreate-all-frames)
(defcustom mxflat:button-bgcolor-highlighted
- (get-color "#def3ff")
- " focused highlighted button background color"
- :group (appearance mxflat:group mxflat:buttons-group mxflat:button-colors-group)
- :depends mxflat:custom-button-colors
- :type color
- :after-set recreate-all-frames
-)
+ (get-color "#def3ff")
+ " focused highlighted button background color"
+ :group (appearance mxflat:group mxflat:buttons-group
+ mxflat:button-colors-group)
+ :depends mxflat:custom-button-colors
+ :type color
+ :after-set recreate-all-frames)
(defcustom mxflat:button-bgcolor-inactive-highlighted
- (get-color "#fffbde")
- "unfocused highlighted button background color"
- :group (appearance mxflat:group mxflat:buttons-group mxflat:button-colors-group)
- :depends mxflat:custom-button-colors
- :type color
- :after-set recreate-all-frames
-)
+ (get-color "#fffbde")
+ "unfocused highlighted button background color"
+ :group (appearance mxflat:group mxflat:buttons-group
+ mxflat:button-colors-group)
+ :depends mxflat:custom-button-colors
+ :type color
+ :after-set recreate-all-frames)
(defcustom mxflat:button-bgcolor-clicked
- (get-color "#cecece")
- " focused clicked button background color"
- :group (appearance mxflat:group mxflat:buttons-group mxflat:button-colors-group)
- :depends mxflat:custom-button-colors
- :type color
- :after-set recreate-all-frames
-)
+ (get-color "#cecece")
+ " focused clicked button background color"
+ :group (appearance mxflat:group mxflat:buttons-group
+ mxflat:button-colors-group)
+ :depends mxflat:custom-button-colors
+ :type color
+ :after-set recreate-all-frames)
(defcustom mxflat:button-bgcolor-inactive-clicked
- (get-color "#cecece")
- "unfocused clicked button background color"
- :group (appearance mxflat:group mxflat:buttons-group mxflat:button-colors-group)
- :depends mxflat:custom-button-colors
- :type color
- :after-set recreate-all-frames
-)
+ (get-color "#cecece")
+ "unfocused clicked button background color"
+ :group (appearance mxflat:group mxflat:buttons-group
+ mxflat:button-colors-group)
+ :depends mxflat:custom-button-colors
+ :type color
+ :after-set recreate-all-frames)
(defcustom mxflat:button-fgcolor-focused
- (get-color "#000000")
- " focused button foreground color"
- :group (appearance mxflat:group mxflat:buttons-group mxflat:button-colors-group)
- :depends mxflat:custom-button-colors
- :type color
- :after-set recreate-all-frames-recolor-all
-)
+ (get-color "#000000")
+ " focused button foreground color"
+ :group (appearance mxflat:group mxflat:buttons-group
+ mxflat:button-colors-group)
+ :depends mxflat:custom-button-colors
+ :type color
+ :after-set recreate-all-frames-recolor-all)
(defcustom mxflat:button-fgcolor-inactive
- (get-color "#838383")
- "unfocused button foreground color"
- :group (appearance mxflat:group mxflat:buttons-group mxflat:button-colors-group)
- :depends mxflat:custom-button-colors
- :type color
- :after-set recreate-all-frames-recolor-all
-)
+ (get-color "#838383")
+ "unfocused button foreground color"
+ :group (appearance mxflat:group mxflat:buttons-group
+ mxflat:button-colors-group)
+ :depends mxflat:custom-button-colors
+ :type color
+ :after-set recreate-all-frames-recolor-all)
(defcustom mxflat:button-fgcolor-highlighted
- (get-color "#000000")
- " focused highlighted button foreground color"
- :group (appearance mxflat:group mxflat:buttons-group mxflat:button-colors-group)
- :depends mxflat:custom-button-colors
- :type color
- :after-set recreate-all-frames-recolor-all
-)
+ (get-color "#000000")
+ " focused highlighted button foreground color"
+ :group (appearance mxflat:group mxflat:buttons-group
+ mxflat:button-colors-group)
+ :depends mxflat:custom-button-colors
+ :type color
+ :after-set recreate-all-frames-recolor-all)
(defcustom mxflat:button-fgcolor-clicked
- (get-color "#000000")
- " focused clicked button foreground color"
- :group (appearance mxflat:group mxflat:buttons-group mxflat:button-colors-group)
- :depends mxflat:custom-button-colors
- :type color
- :after-set recreate-all-frames-recolor-all
-)
-
-;
+ (get-color "#000000")
+ " focused clicked button foreground color"
+ :group (appearance mxflat:group mxflat:buttons-group
+ mxflat:button-colors-group)
+ :depends mxflat:custom-button-colors
+ :type color
+ :after-set recreate-all-frames-recolor-all)
+
+;;
;; configuration:border-basic
-;
+;;
(defcustom mxflat:border-width-unmaximized
- 1
- "border width (0 - 1000 pixel)"
- :tooltip "set the width border around the window."
- :group (appearance mxflat:group mxflat:border-group mxflat:border1-group)
- :type (number 0 1000)
- :after-set rebuild-all-frames
-)
+ 1
+ "border width (0 - 1000 pixel)"
+ :tooltip "set the width border around the window."
+ :group (appearance mxflat:group mxflat:border-group mxflat:border1-group)
+ :type (number 0 1000)
+ :after-set rebuild-all-frames)
(defcustom mxflat:border-width-maximized
- 1
- "border width for maximized windows (0 - 1000 pixel)"
- :tooltip "when you like having a big border around your windows you might have noticed that sawfish still draws that big border when the window is maximized. if you don't want that, set the border width for maximized windows smaller than the border width for unmaximized windows. (NOTE: this feature is still buggy as sawfish does not resize the windows correctly yet, so the best might be to set it to the normal border width.)"
- :group (appearance mxflat:group mxflat:border-group mxflat:border1-group)
- :type (number 0 1000)
- :after-set rebuild-all-frames
-)
+ 1
+ "border width for maximized windows (0 - 1000 pixel)"
+ :tooltip "When you like having a big border around your windows you \
+might have noticed that sawfish still draws that big border when the \
+window is maximized. If you don't want that, set the border width for \
+maximized windows smaller than the border width for unmaximized \
+windows. (NOTE: this feature is still buggy as sawfish does not \
+resize the windows correctly yet, so the best might be to set it to \
+the normal border width.)"
+ :group (appearance mxflat:group mxflat:border-group mxflat:border1-group)
+ :type (number 0 1000)
+ :after-set rebuild-all-frames)
(defcustom mxflat:custom-border-focused
- nil
- "customize border for focused windows (experimental)"
- :tooltip "(NOTE: this works but it is VERY cpu intensive and might slow down your computer noticably. so turn it on at your own risk.)"
- :group (appearance mxflat:group mxflat:border-group mxflat:border1-group)
- :type boolean
- :after-set rebuild-all-frames
-)
+ nil
+ "customize border for focused windows (experimental)"
+ :tooltip "(NOTE: this works but it is VERY cpu intensive and might \
+slow down your computer noticably. So turn it on at your own risk.)"
+ :group (appearance mxflat:group mxflat:border-group mxflat:border1-group)
+ :type boolean
+ :after-set rebuild-all-frames)
(defcustom mxflat:border-width-focused
- 1
- "border width for focused windows (0 - 1000 pixel)"
- :tooltip "(NOTE: this works but it is VERY cpu intensive and might slow down your computer noticably. so turn it on at your own risk.)"
- :group (appearance mxflat:group mxflat:border-group mxflat:border1-group)
- :type (number 0 1000)
- :depends mxflat:custom-border-focused
- :after-set rebuild-all-frames
-)
+ 1
+ "border width for focused windows (0 - 1000 pixel)"
+ :tooltip "(NOTE: this works but it is VERY cpu intensive and might \
+slow down your computer noticably. So turn it on at your own risk.)"
+ :group (appearance mxflat:group mxflat:border-group mxflat:border1-group)
+ :type (number 0 1000)
+ :depends mxflat:custom-border-focused
+ :after-set rebuild-all-frames)
(defcustom mxflat:border-width-titlebar-contents
- 1
- "title-contents border width (0 - 1000 pixel)"
- :tooltip "sets the widths of the line between titlebar and contents window"
- :group (appearance mxflat:group mxflat:border-group mxflat:border1-group)
- :type (number 0 1000)
- :after-set rebuild-all-frames
-)
+ 1
+ "title-contents border width (0 - 1000 pixel)"
+ :tooltip "Sets the widths of the line between titlebar and contents \
+window"
+ :group (appearance mxflat:group mxflat:border-group mxflat:border1-group)
+ :type (number 0 1000)
+ :after-set rebuild-all-frames)
(defcustom mxflat:border-offset
- -1
- "border offset (-1000 - 1000 pixel)"
- :tooltip "adjust the point where the border actually starts. many gtk2 apps draw a small black border around their contents window and this is just ugly when sawfish draws another border around the window. with a border offset of -1 the sawfish window border will overlay the gtk2 border exactly."
- :group (appearance mxflat:group mxflat:border-group mxflat:border1-group)
- :type (number -1000 1000)
- :after-set rebuild-all-frames
-)
+ -1
+ "border offset (-1000 - 1000 pixel)"
+ :tooltip "Adjust the point where the border actually starts. Many \
+gtk2 apps draw a small black border around their contents window and \
+this is just ugly when sawfish draws another border around the window. \
+With a border offset of -1 the sawfish window border will overlay the \
+gtk2 border exactly."
+ :group (appearance mxflat:group mxflat:border-group mxflat:border1-group)
+ :type (number -1000 1000)
+ :after-set rebuild-all-frames)
(defcustom mxflat:keep-borders-when-shaded
- nil
- "keep window borders and corners at their place when shading a window"
- :tooltip "when shading a window borders and corners will stay where they were and not merge with the titlebar."
- :group (appearance mxflat:group mxflat:border-group mxflat:border1-group)
- :type boolean
- :after-set recreate-all-frames
-)
-
-;
+ nil
+ "keep window borders and corners at their place when shading a window"
+ :tooltip "When shading a window borders and corners will stay where \
+they were and not merge with the titlebar."
+ :group (appearance mxflat:group mxflat:border-group mxflat:border1-group)
+ :type boolean
+ :after-set recreate-all-frames)
+
+;;
;; configuration:border-extended
-;
+;;
(defcustom mxflat:show-corners
- t
- "show window corners"
- :tooltip " the corners are used to resize a window in two directions at the same time. usually the width and length of window corners are determined by the border width but you can adjust them below."
- :group (appearance mxflat:group mxflat:border-group mxflat:border-extended-group)
- :type boolean
- :after-set recreate-all-frames
-)
+ t
+ "show window corners"
+ :tooltip "The corners are used to resize a window in two directions \
+at the same time. Usually the width and length of window corners are \
+determined by the border width but you can adjust them below."
+ :group (appearance mxflat:group mxflat:border-group
+ mxflat:border-extended-group)
+ :type boolean
+ :after-set recreate-all-frames)
(defcustom mxflat:corner-length-adjustment
- 20
- "corners length adjustement (-1 - 100 pixel)"
- :tooltip "increasing the corner length will grow the window corners along the window border (i.e. make them longer). with a border width of 1 pixel it is hard to grab the 1 pixel corner to be able to resize the window in two directions; thus, make it bigger."
- :group (appearance mxflat:group mxflat:border-group mxflat:border-extended-group)
- :type (number -1 100)
- :depends mxflat:show-corners
- :after-set rebuild-all-frames
-)
+ 20
+ "corners length adjustement (-1 - 100 pixel)"
+ :tooltip "Increasing the corner length will grow the window corners \
+along the window border (i.e. make them longer). With a border width \
+of 1 pixel it is hard to grab the 1 pixel corner to be able to resize \
+the window in two directions; thus, make it bigger."
+ :group (appearance mxflat:group mxflat:border-group
+ mxflat:border-extended-group)
+ :type (number -1 100)
+ :depends mxflat:show-corners
+ :after-set rebuild-all-frames)
(defcustom mxflat:corner-direction
- 'outside
- "corner direction"
- :"inside or outside the window border"
- :group (appearance mxflat:group mxflat:border-group mxflat:border-extended-group)
- :type symbol
- :options (outside inside)
- :depends mxflat:show-corners
- :after-set recreate-all-frames
-)
+ 'outside
+ "corner direction"
+ :"inside or outside the window border"
+ :group (appearance mxflat:group mxflat:border-group
+ mxflat:border-extended-group)
+ :type symbol
+ :options (outside inside)
+ :depends mxflat:show-corners
+ :after-set recreate-all-frames)
(defcustom mxflat:corner-width-adjustment
- 1
- "corners width adjustement (0 - 100 pixel)"
- :tooltip "this option makes the window corners broader. with a border width of 1 pixel it is hard to grab this 1 pixel corner to be able to resize the window in two directions; thus, make it bigger."
- :group (appearance mxflat:group mxflat:border-group mxflat:border-extended-group)
- :type (number 0 100)
- :depends mxflat:show-corners
- :after-set rebuild-all-frames
-)
+ 1
+ "corners width adjustement (0 - 100 pixel)"
+ :tooltip "This option makes the window corners broader. with a \
+border width of 1 pixel it is hard to grab this 1 pixel corner to be \
+able to resize the window in two directions; thus, make it bigger."
+ :group (appearance mxflat:group mxflat:border-group
+ mxflat:border-extended-group)
+ :type (number 0 100)
+ :depends mxflat:show-corners
+ :after-set rebuild-all-frames)
(defcustom mxflat:corner-width-adjustment-maximized
- 0
- "corners width adjustement for maximized windows (0 - 100 pixel)"
- :group (appearance mxflat:group mxflat:border-group mxflat:border-extended-group)
- :type (number 0 100)
- :depends mxflat:show-corners
- :after-set rebuild-all-frames
-)
+ 0
+ "corners width adjustement for maximized windows (0 - 100 pixel)"
+ :group (appearance mxflat:group mxflat:border-group
+ mxflat:border-extended-group)
+ :type (number 0 100)
+ :depends mxflat:show-corners
+ :after-set rebuild-all-frames)
(defcustom mxflat:fake-shadow
- nil
- "fake shadow (experimental)"
- :tooltip "draw a small additional border around your windows emulating a solid shadow effect. use the options below to adjust its width and direction. (NOTE: this is VERY cpu intensive and might slow down your computer noticably. so turn it on at your own risk.)"
- :group (appearance mxflat:group mxflat:border-group mxflat:border-extended-group)
- :type boolean
- :after-set recreate-all-frames
-)
+ nil
+ "fake shadow (experimental)"
+ :tooltip "Draw a small additional border around your windows \
+emulating a solid shadow effect. Use the options below to adjust its \
+width and direction. (NOTE: this is VERY cpu intensive and might slow \
+down your computer noticably. So turn it on at your own risk.)"
+ :group (appearance mxflat:group mxflat:border-group
+ mxflat:border-extended-group)
+ :type boolean
+ :after-set recreate-all-frames)
(defcustom mxflat:fake-shadow-focused-only
- nil
- "fake shadow only on focused windows"
- :group (appearance mxflat:group mxflat:border-group mxflat:border-extended-group)
- :type boolean
- :depends mxflat:fake-shadow
- :after-set recreate-all-frames
-)
+ nil
+ "fake shadow only on focused windows"
+ :group (appearance mxflat:group mxflat:border-group
+ mxflat:border-extended-group)
+ :type boolean
+ :depends mxflat:fake-shadow
+ :after-set recreate-all-frames)
(defcustom mxflat:shadow-light-source
- 'north-west
- "fake shadow light source"
- :tooltip "set the direction of the fake shadow. usually only 2 or 3 borders of your window have a fake shadow. this depends on where the light comes from."
- :group (appearance mxflat:group mxflat:border-group mxflat:border-extended-group)
- :type symbol
- :options (north east south west north-east north-west south-east south-west)
- :depends mxflat:fake-shadow
- :after-set after-set-shadow-light-source
-)
+ 'north-west
+ "fake shadow light source"
+ :tooltip "Set the direction of the fake shadow. Usually only 2 or 3 \
+borders of your window have a fake shadow. This depends on where the \
+light comes from."
+ :group (appearance mxflat:group mxflat:border-group
+ mxflat:border-extended-group)
+ :type symbol
+ :options (north east south west north-east north-west
+ south-east south-west)
+ :depends mxflat:fake-shadow
+ :after-set after-set-shadow-light-source)
(defcustom mxflat:shadow-light-distance
- 3
- "fake shadow light distance (0 - 100)"
- :tooltip "this option has only an effect on the north, east, south and west light sources. the further away the light source is, the smaller will the two 'side' shadows be."
- :group (appearance mxflat:group mxflat:border-group mxflat:border-extended-group)
- :type (number 1 100)
- :depends mxflat:fake-shadow
- :after-set rebuild-all-frames
-)
+ 3
+ "fake shadow light distance (0 - 100)"
+ :tooltip "This option has only an effect on the north, east, south \
+and west light sources. The further away the light source is, the \
+smaller will the two 'side' shadows be."
+ :group (appearance mxflat:group mxflat:border-group
+ mxflat:border-extended-group)
+ :type (number 1 100)
+ :depends mxflat:fake-shadow
+ :after-set rebuild-all-frames)
(defcustom mxflat:shadow-width
- 4
- "fake shadow width (0 - 100 pixel)"
- :group (appearance mxflat:group mxflat:border-group mxflat:border-extended-group)
- :type (number 0 100)
- :depends mxflat:fake-shadow
- :after-set rebuild-all-frames
-)
+ 4
+ "fake shadow width (0 - 100 pixel)"
+ :group (appearance mxflat:group mxflat:border-group
+ mxflat:border-extended-group)
+ :type (number 0 100)
+ :depends mxflat:fake-shadow
+ :after-set rebuild-all-frames)
(defcustom mxflat:shadow-color
- (get-color "#838383")
- "shadow color"
- :group (appearance mxflat:group mxflat:border-group mxflat:border-extended-group)
- :type color
- :depends mxflat:fake-shadow
- :after-set rebuild-all-frames
-)
-
-;
+ (get-color "#838383")
+ "shadow color"
+ :group (appearance mxflat:group mxflat:border-group
+ mxflat:border-extended-group)
+ :type color
+ :depends mxflat:fake-shadow
+ :after-set rebuild-all-frames)
+
+;;
;; configuration:border-colors
-;
+;;
(defcustom mxflat:customize-border-colors
- nil
- "customize border colors"
- :tooltip "you can customize your border colors here. if you deactivate this, these colors will be set to the focused title string color."
- :group (appearance mxflat:group mxflat:border-group mxflat:border-colors-group)
- :type boolean
- :after-set rebuild-all-frames
-)
+ nil
+ "customize border colors"
+ :tooltip "You can customize your border colors here. If you \
+deactivate this, these colors will be set to the focused title \
+string color."
+ :group (appearance mxflat:group mxflat:border-group
+ mxflat:border-colors-group)
+ :type boolean
+ :after-set rebuild-all-frames)
(defcustom mxflat:border-color-focused
- (get-color "#000000")
- " focused border color"
- :group (appearance mxflat:group mxflat:border-group mxflat:border-colors-group)
- :type color
- :depends mxflat:customize-border-colors
- :after-set rebuild-all-frames
-)
+ (get-color "#000000")
+ " focused border color"
+ :group (appearance mxflat:group mxflat:border-group
+ mxflat:border-colors-group)
+ :type color
+ :depends mxflat:customize-border-colors
+ :after-set rebuild-all-frames)
(defcustom mxflat:border-color-unfocused
- (get-color "#000000")
- "unfocused border color"
- :group (appearance mxflat:group mxflat:border-group mxflat:border-colors-group)
- :type color
- :depends mxflat:customize-border-colors
- :after-set rebuild-all-frames
-)
+ (get-color "#000000")
+ "unfocused border color"
+ :group (appearance mxflat:group mxflat:border-group
+ mxflat:border-colors-group)
+ :type color
+ :depends mxflat:customize-border-colors
+ :after-set rebuild-all-frames)
(defcustom mxflat:border-color-highlighted
- (get-color "#000000")
- " focused highlighted border color"
- :group (appearance mxflat:group mxflat:border-group mxflat:border-colors-group)
- :type color
- :depends mxflat:customize-border-colors
- :after-set rebuild-all-frames
-)
+ (get-color "#000000")
+ " focused highlighted border color"
+ :group (appearance mxflat:group mxflat:border-group
+ mxflat:border-colors-group)
+ :type color
+ :depends mxflat:customize-border-colors
+ :after-set rebuild-all-frames)
(defcustom mxflat:border-color-inactive-highlighted
- (get-color "#000000")
- "unfocused highlighted border color"
- :group (appearance mxflat:group mxflat:border-group mxflat:border-colors-group)
- :type color
- :depends mxflat:customize-border-colors
- :after-set rebuild-all-frames
-)
+ (get-color "#000000")
+ "unfocused highlighted border color"
+ :group (appearance mxflat:group mxflat:border-group
+ mxflat:border-colors-group)
+ :type color
+ :depends mxflat:customize-border-colors
+ :after-set rebuild-all-frames)
(defcustom mxflat:border-color-clicked
- (get-color "#000000")
- " focused clicked border color"
- :group (appearance mxflat:group mxflat:border-group mxflat:border-colors-group)
- :type color
- :depends mxflat:customize-border-colors
- :after-set rebuild-all-frames
-)
+ (get-color "#000000")
+ " focused clicked border color"
+ :group (appearance mxflat:group mxflat:border-group
+ mxflat:border-colors-group)
+ :type color
+ :depends mxflat:customize-border-colors
+ :after-set rebuild-all-frames)
(defcustom mxflat:border-color-inactive-clicked
- (get-color "#000000")
- "unfocused clicked border color"
- :group (appearance mxflat:group mxflat:border-group mxflat:border-colors-group)
- :type color
- :depends mxflat:customize-border-colors
- :after-set rebuild-all-frames
-)
-
-; ----
+ (get-color "#000000")
+ "unfocused clicked border color"
+ :group (appearance mxflat:group mxflat:border-group
+ mxflat:border-colors-group)
+ :type color
+ :depends mxflat:customize-border-colors
+ :after-set rebuild-all-frames)
+
+;; ----
;;; MISC
-; ----
+;; ----
(define (get-last-workspace)
- (aref
- (nth 2 (get-x-property 'root '_NET_NUMBER_OF_DESKTOPS))
- 0
- )
-)
+ (aref (nth 2 (get-x-property 'root '_NET_NUMBER_OF_DESKTOPS))
+ 0))
(define (get-first-workspace) 1)
(defmacro window-in-workspace-p (w space)
- `(memq ,space (window-get ,w 'workspaces))
-)
+ `(memq ,space (window-get ,w 'workspaces)))
(define (window-maximized-p w)
- (window-get w 'unmaximized-geometry)
-)
+ (window-get w 'unmaximized-geometry))
(define (window-maximized-horizontally-p w)
- (window-get w 'maximized-horizontally)
-)
+ (window-get w 'maximized-horizontally))
(define (window-maximized-vertically-p w)
- (window-get w 'maximized-vertically)
-)
+ (window-get w 'maximized-vertically))
-; constant accuracy factor since
-; we ???are not allowed to use floats in themes???
-; / seems to be gaoled
+;; constant accuracy factor since we ???are not allowed to use floats
+;; in themes???
+;; / seems to be gaoled
(defvar afactor 10000000000000)
(defvar afactor360 (* 360 afactor))
-;
+;;
;; misc:color manipulation
-;
+;;
-; returns a list containing hue saturation and value of color
+;; returns a list containing hue saturation and value of color
(define (rgb2hsv color)
- (let*
- (
- ; get rgb ints for the color
- (rgbchannels (color-rgb color))
-
- ; get red, green and blue ints from rgbchannels
- (red (nth 0 rgbchannels))
- (green (nth 1 rgbchannels))
- (blue (nth 2 rgbchannels))
-
- ; channnel with the biggest int value
- (value (apply max (list red green blue)))
- ; delta
- (max-min (- value (apply min (list red green blue))))
-
- ; saturation: 1 - min / max = (max - min) / max = delta / max
- ; saturation * afactor - acutally the saturation
- ; is a float between 0 and 1 but as it seems
- ; we cannot use them in themes
- (saturation
- (if (= max-min 0)
- 0
- (/
- (* max-min afactor)
- value
- )
- )
- )
- ; value between 0 and 360 degree * afactor
- ; 0 = red, 120 = green, 240 = blue
- (hue
- (if (= max-min 0)
- 0
- (/
- (*
- 60
- afactor
- (cond
- (
- (= value red)
- (- green blue)
- )
- (
- (= value green)
- (+ (* 2 max-min) (- blue red))
- )
- (
- ; (= value blue)
- t
- (+ (* 4 max-min) (- red green))
- )
- )
- )
- max-min
- )
- )
- )
- )
- (list (if (< hue 0) (+ hue afactor360) hue) saturation value)
- )
-)
-
-; translates a rgb-color from the ints of the list, which contains hue, saturation and value
+ (let* (
+ ;; get rgb ints for the color
+ (rgbchannels (color-rgb color))
+
+ ;; get red, green and blue ints from rgbchannels
+ (red (nth 0 rgbchannels))
+ (green (nth 1 rgbchannels))
+ (blue (nth 2 rgbchannels))
+
+ ;; channnel with the biggest int value
+ (value (apply max (list red green blue)))
+ ;; delta
+ (max-min (- value (apply min (list red green blue))))
+
+ ;; saturation: 1 - min / max = (max - min) / max = delta / max
+ ;; saturation * afactor - acutally the saturation
+ ;; is a float between 0 and 1 but as it seems
+ ;; we cannot use them in themes
+ (saturation
+ (if (= max-min 0)
+ 0
+ (/ (* max-min afactor) value)))
+ ;; value between 0 and 360 degree * afactor
+ ;; 0 = red, 120 = green, 240 = blue
+ (hue (if (= max-min 0)
+ 0
+ (/ (* 60 afactor (cond ((= value red)
+ (- green blue))
+ ((= value green)
+ (+ (* 2 max-min) (- blue red)))
+ (t ; (= value blue)
+ (+ (* 4 max-min) (- red green)))))
+ max-min))))
+ (list (if (< hue 0) (+ hue afactor360) hue) saturation value)))
+
+;; translates a rgb-color from the ints of the list, which contains
+;; hue, saturation and value
(define (hsv2rgb hsv)
- (let*
- (
- (hue (nth 0 hsv))
- (saturation (nth 1 hsv))
- (value (nth 2 hsv))
-
- )
-
- ; value zero -> color black
- (cond
- ((= value 0)
- (get-color-rgb 0 0 0)
- )
- ((= saturation 0)
-
- ; in this case the color is grey and
- ; thus its rgb value is:
- (get-color-rgb value value value)
- )
- (t
- ; else we need to do some calculations -
- ; the hue and saturation are aleady
- ; multiplied with afactor
- (let*
- (
- ; we need it often, so we define
- ; it once here
- (afactor2 (* afactor afactor))
- ; kind of an 'compensation delta'
- (f
- (if
- (or
- (= hue 0)
- (= hue afactor360)
- )
- 0
- (/ (mod hue (* 60 afactor)) 60)
- )
- )
-
- ; p is the lowest color int
- (p
- (/
- (* value
- (- afactor saturation)
- )
- afactor
- )
- )
- ; tt is a medium color int
- (q
- (/
- (*
- value
- (-
- afactor2
- (* saturation f)
- )
- )
- afactor2
- )
- )
- ; tt is a medium color int
- (tt
- (/
- (*
- value
- (-
- afactor2
- (*
- saturation
- (- afactor f)
- )
- )
- )
- afactor2
- )
- )
-
- ; area on the color circle (0 .. 5)
- (circle-part
- (if (>= hue afactor360)
- 0
- (/
- (/ hue afactor)
- 60
- )
- )
- )
- )
- ; arrange the right vars for the current
- ; color circle part
- (case circle-part
- ((0) (get-color-rgb value tt p))
- ((1) (get-color-rgb q value p))
- ((2) (get-color-rgb p value tt))
- ((3) (get-color-rgb p q value))
- ((4) (get-color-rgb tt p value))
- ((5) (get-color-rgb value p p))
- )
- )
- )
- )
- )
-)
-
-; adjusts the hue, brightness and saturation of color
+ (let* ((hue (nth 0 hsv))
+ (saturation (nth 1 hsv))
+ (value (nth 2 hsv)))
+
+ ;; value zero -> color black
+ (cond ((= value 0)
+ (get-color-rgb 0 0 0))
+ ((= saturation 0)
+
+ ;; in this case the color is grey and
+ ;; thus its rgb value is:
+ (get-color-rgb value value value))
+ (t
+ ;; else we need to do some calculations -
+ ;; the hue and saturation are aleady
+ ;; multiplied with afactor
+ (let* (;; we need it often, so we define
+ ;; it once here
+ (afactor2 (* afactor afactor))
+
+ ;; kind of an 'compensation delta'
+ (f (if (or (= hue 0)
+ (= hue afactor360))
+ 0
+ (/ (mod hue (* 60 afactor)) 60)))
+
+ ;; p is the lowest color int
+ (p (/ (* value
+ (- afactor saturation))
+ afactor))
+
+ ;; tt is a medium color int
+ (q (/ (* value
+ (- afactor2 (* saturation f)))
+ afactor2))
+
+ ;; tt is a medium color int
+ (tt (/ (* value
+ (- afactor2
+ (* saturation (- afactor f))))
+ afactor2))
+
+ ;; area on the color circle (0 .. 5)
+ (circle-part
+ (if (>= hue afactor360)
+ 0
+ (/ (/ hue afactor)
+ 60))))
+ ;; arrange the right vars for the current
+ ;; color circle part
+ (case circle-part
+ ((0) (get-color-rgb value tt p))
+ ((1) (get-color-rgb q value p))
+ ((2) (get-color-rgb p value tt))
+ ((3) (get-color-rgb p q value))
+ ((4) (get-color-rgb tt p value))
+ ((5) (get-color-rgb value p p))))))))
+
+;; adjusts the hue, brightness and saturation of color
(define (adjust-color color)
- (let*
- (
- ; hue saturation value list
- (hsv (rgb2hsv color))
- ; add used configured adjustment to
- ; the hue of the color
- (a-hue
- (+
- (nth 0 hsv)
- (* mxflat:color-hue afactor)
- )
- )
- ; adjust saturation with
- ; user configured factor
- (a-saturation
- (/
- (*
- (nth 1 hsv)
- mxflat:color-saturation
- )
- 100
- )
- )
- ; adjust value/brightness with
- ; user configured factor
- (a-value
- (/
- (*
- (nth 2 hsv)
- mxflat:color-brightness
- )
- 100
- )
- )
- )
- (hsv2rgb
- (list
- ; adjust the hue if necessary
- ; (ie it is >360 degree)
- (if (> a-hue afactor360)
- (- a-hue afactor360)
- a-hue
- )
- a-saturation
- a-value
- )
- )
- )
-)
-
-;
+ (let* (;; hue saturation value list
+ (hsv (rgb2hsv color))
+ ;; add used configured adjustment to
+ ;; the hue of the color
+ (a-hue (+ (nth 0 hsv)
+ (* mxflat:color-hue afactor)))
+ ;; adjust saturation with
+ ;; user configured factor
+ (a-saturation (/ (* (nth 1 hsv)
+ mxflat:color-saturation)
+ 100))
+ ;; adjust value/brightness with
+ ;; user configured factor
+ (a-value (/ (* (nth 2 hsv)
+ mxflat:color-brightness)
+ 100)))
+ (hsv2rgb (list
+ ;; adjust the hue if necessary
+ ;; (ie it is >360 degree)
+ (if (> a-hue afactor360)
+ (- a-hue afactor360)
+ a-hue)
+ a-saturation
+ a-value))))
+
+;;
;; misc:hook-ins
-;
+;;
-; when the window title or some other wm_hints attribute changes, redraw the window
+;; when the window title or some other wm_hints attribute changes,
+;; redraw the window
(call-after-property-changed (list 'WM_NAME)
- (lambda (w)
- (if (eq mxflat:title-x-justify 'real-center)
- (rebuild-frame w)
- (refresh-one-frame w)
- )
- )
-)
-
-; when we set a window sticky we have to redraw it,
-; the sticky button has changed
-(call-after-state-changed '(sticky) reframe-window)
-
-; when the window is sent to another workspace
-; redraw it to update the buttons and titlebar if necessary
+ (lambda (w)
+ (if (eq mxflat:title-x-justify 'real-center)
+ (rebuild-frame w)
+ (refresh-one-frame w))))
+
+;; when we set a window sticky we have to redraw it, the sticky button
+;; has changed
+(call-after-state-changed '(sticky) reframe-window)
+
+;; when the window is sent to another workspace redraw it to update
+;; the buttons and titlebar if necessary
(add-hook 'remove-from-workspace-hook
- (lambda (w)
- (reframe-window w)
- )
-)
+ (lambda (w)
+ (reframe-window w)))
-; not necessary anymore?
-;(add-hook 'after-resize-hook refresh-one-frame)
+;; not necessary anymore?
+;;(add-hook 'after-resize-hook refresh-one-frame)
(add-hook 'focus-in-hook
- (lambda (w)
- ; if 'custom borders for focused windows' -> redraw
- (if (or
- mxflat:custom-border-focused
- (and
- mxflat:fake-shadow
- mxflat:fake-shadow-focused-only
- )
- )
- (reframe-window w)
- )
- )
-)
+ (lambda (w)
+ ;; if 'custom borders for focused windows' -> redraw
+ (if (or mxflat:custom-border-focused
+ (and mxflat:fake-shadow
+ mxflat:fake-shadow-focused-only))
+ (reframe-window w))))
(add-hook 'focus-out-hook
- (lambda (w)
- ; if 'custom borders for focused windows' -> redraw
- (if (or
- mxflat:custom-border-focused
- (and
- mxflat:fake-shadow
- mxflat:fake-shadow-focused-only
- )
- )
- (reframe-window w)
- )
- )
-)
-
-;
+ (lambda (w)
+ ;; if 'custom borders for focused windows' -> redraw
+ (if (or mxflat:custom-border-focused
+ (and mxflat:fake-shadow
+ mxflat:fake-shadow-focused-only))
+ (reframe-window w))))
+
+;;
;; misc:functions
-;
+;;
(define (get-border-offset)
- ; we use the negative value to make the defcustom option
- ; work more like one would expect, ie a positive value
- ; means the border will have a bigger distance to the
- ; contents window
- (- mxflat:border-offset)
-)
+ ;; we use the negative value to make the defcustom option work more
+ ;; like one would expect, ie a positive value means the border will
+ ;; have a bigger distance to the contents window
+ (- mxflat:border-offset))
(define (get-button-size)
- (if
- (and
- mxflat:customize-button-size
- (< mxflat:button-size mxflat:title-height)
- )
- mxflat:button-size
- mxflat:title-height
- )
-)
-
-; -----------
+ (if (and mxflat:customize-button-size
+ (< mxflat:button-size mxflat:title-height))
+ mxflat:button-size
+ mxflat:title-height))
+
+;; -----------
;;; FAKE SHADOW
-; -----------
+;; -----------
-; this list defines which window sides have shadows
-; for which direction
+;; this list defines which window sides have shadows for which
+;; direction
(defvar shadow-sides
- `(
- (north . (bottom left right))
- (east . (top bottom left))
- (west . (top bottom right))
- (south . (top left right))
- (north-east . (bottom left))
- (north-west . (bottom right))
- (south-west . (top right))
- (south-east . (top left))
- )
-)
-
-; selects the right shadow-side from the shadow-sides list
+ `((north . (bottom left right))
+ (east . (top bottom left))
+ (west . (top bottom right))
+ (south . (top left right))
+ (north-east . (bottom left))
+ (north-west . (bottom right))
+ (south-west . (top right))
+ (south-east . (top left))))
+
+;; selects the right shadow-side from the shadow-sides list
(define (get-shadow-side)
- (mapc
- (lambda (ss)
- (if (eq (car ss) mxflat:shadow-light-source)
- (setq shadow-side (cdr ss))
- )
- )
- shadow-sides
- )
-)
+ (mapc (lambda (ss)
+ (if (eq (car ss) mxflat:shadow-light-source)
+ (setq shadow-side (cdr ss))))
+ shadow-sides))
(define (get-shadow-color) mxflat:shadow-color)
(define (get-shadow-width w side)
- (if (member side shadow-side)
- (get-neg-border-width w side)
- mxflat:shadow-width
- )
-)
+ (if (member side shadow-side)
+ (get-neg-border-width w side)
+ mxflat:shadow-width))
(define (get-shadow-offset w side)
- ; the shadow is only not visible on all window edges
- (if (not (window-maximized-p w))
- (if
- (or
- (and
- (eq mxflat:shadow-light-source 'north)
- (not (eq side 'bottom))
- )
- (and
- (eq mxflat:shadow-light-source 'south)
- (not (eq side 'top))
- )
- (and
- (eq mxflat:shadow-light-source 'east)
- (not (eq side 'left))
- )
- (and
- (eq mxflat:shadow-light-source 'west)
- (not (eq side 'right))
- )
- )
- (/ mxflat:shadow-width mxflat:shadow-light-distance)
- (if (member side shadow-side)
- mxflat:shadow-width
- 0
- )
- )
- 0
- )
-)
-
-; --------
+ ;; the shadow is only not visible on all window edges
+ (if (not (window-maximized-p w))
+ (if (or (and (eq mxflat:shadow-light-source 'north)
+ (not (eq side 'bottom)))
+ (and (eq mxflat:shadow-light-source 'south)
+ (not (eq side 'top)))
+ (and (eq mxflat:shadow-light-source 'east)
+ (not (eq side 'left)))
+ (and (eq mxflat:shadow-light-source 'west)
+ (not (eq side 'right))))
+ (/ mxflat:shadow-width mxflat:shadow-light-distance)
+ (if (member side shadow-side)
+ mxflat:shadow-width
+ 0))
+ 0))
+
+;; --------
;;; TITLEBAR
-; --------
+;; --------
-;
+;;
;; titlebar:colors
-;
+;;
(define (get-text-colors)
- (if mxflat:customize-extended-text-colors
- `(
- (inactive . ,mxflat:text-color-unfocused)
- (focused . ,mxflat:text-color-focused)
- (highlighted . ,mxflat:text-color-highlighted)
- (inactive-highlighted . ,mxflat:text-color-inactive-highlighted)
- (clicked . ,mxflat:text-color-clicked)
- (inactive-clicked . ,mxflat:text-color-inactive-clicked)
- )
- `(
- (inactive . ,mxflat:text-color-unfocused)
- (focused . ,mxflat:text-color-focused)
- (highlighted . ,mxflat:text-color-focused)
- (inactive-highlighted . ,mxflat:text-color-focused)
- (clicked . ,mxflat:text-color-focused)
- (inactive-clicked . ,mxflat:text-color-focused)
- )
- )
-)
+ (if mxflat:customize-extended-text-colors
+ `((inactive . ,mxflat:text-color-unfocused)
+ (focused . ,mxflat:text-color-focused)
+ (highlighted . ,mxflat:text-color-highlighted)
+ (inactive-highlighted . ,mxflat:text-color-inactive-highlighted)
+ (clicked . ,mxflat:text-color-clicked)
+ (inactive-clicked . ,mxflat:text-color-inactive-clicked))
+
+ `((inactive . ,mxflat:text-color-unfocused)
+ (focused . ,mxflat:text-color-focused)
+ (highlighted . ,mxflat:text-color-focused)
+ (inactive-highlighted . ,mxflat:text-color-focused)
+ (clicked . ,mxflat:text-color-focused)
+ (inactive-clicked . ,mxflat:text-color-focused))))
(define (titlebar-gradient-colors-helper)
- (case mxflat:titlebar-gradient-color-mode
- ((custom)
- (if (> (length mxflat:titlebar-gradient-bgcolors) 0)
- mxflat:titlebar-gradient-bgcolors
- (list (get-color "#ffffffffffff"))
- )
- )
- ((rainbow)
- (list
- (get-color "#ffff0000153b")
- (get-color "#ffff9b700000")
- (get-color "#fffff92d0000")
- (get-color "#3661ffff0000")
- (get-color "#00004c0dffff")
- (get-color "#b7ad0000ffff")
- )
- )
- ((jamaica)
- (list
- (get-color "#7899f1340000")
- (get-color "#ffffffff0000")
- (get-color "#ffff37030000")
- )
- )
- ((rgb)
- (list
- (get-color "#ffff00000000")
- (get-color "#0000ffff0000")
- (get-color "#00000000ffff")
- )
- )
- )
-)
-
+ (case mxflat:titlebar-gradient-color-mode
+ ((custom)
+ (if (> (length mxflat:titlebar-gradient-bgcolors) 0)
+ mxflat:titlebar-gradient-bgcolors
+ (list (get-color "#ffffffffffff"))))
+ ((rainbow)
+ (list (get-color "#ffff0000153b")
+ (get-color "#ffff9b700000")
+ (get-color "#fffff92d0000")
+ (get-color "#3661ffff0000")
+ (get-color "#00004c0dffff")
+ (get-color "#b7ad0000ffff")))
+ ((jamaica)
+ (list (get-color "#7899f1340000")
+ (get-color "#ffffffff0000")
+ (get-color "#ffff37030000")))
+ ((rgb)
+ (list (get-color "#ffff00000000")
+ (get-color "#0000ffff0000")
+ (get-color "#00000000ffff")))))
+
(define (titlebar-gradient-colors)
- (if mxflat:titlebar-gradient-bgcolors-reverse
- (reverse (titlebar-gradient-colors-helper))
- (titlebar-gradient-colors-helper)
- )
-)
-
-; changes the brightness and saturation for the
-; titlebar gradient color with index i
+ (if mxflat:titlebar-gradient-bgcolors-reverse
+ (reverse (titlebar-gradient-colors-helper))
+ (titlebar-gradient-colors-helper)))
+
+;; changes the brightness and saturation for the titlebar gradient
+;; color with index i
(define (adjust-titlebar-bgcolor i)
- ; get rgb ints for the color with index i
- (adjust-color (nth i (titlebar-gradient-colors)))
-)
+ ;; get rgb ints for the color with index i
+ (adjust-color (nth i (titlebar-gradient-colors))))
(define (get-titlebar-bgcolors #!optional side)
- (cond
- ((and mxflat:title-gradient side)
- (let*
- (
- (index
- (if (eq side 'right)
- (1- (length (titlebar-gradient-colors)))
- 0
- )
- )
- )
- `(
- (inactive . ,(adjust-titlebar-bgcolor index))
- (focused . ,(nth index (titlebar-gradient-colors)))
- )
- )
- )
- (t
- `(
- (inactive . ,mxflat:titlebar-bgcolor-unfocused)
- (focused . ,mxflat:titlebar-bgcolor-focused)
- )
- )
- )
-)
-
-;
+ (cond ((and mxflat:title-gradient side)
+ (let* ((index
+ (if (eq side 'right)
+ (1- (length (titlebar-gradient-colors)))
+ 0)))
+ `((inactive . ,(adjust-titlebar-bgcolor index))
+ (focused . ,(nth index (titlebar-gradient-colors))))))
+ (t
+ `((inactive . ,mxflat:titlebar-bgcolor-unfocused)
+ (focused . ,mxflat:titlebar-bgcolor-focused)))))
+
+;;
;; titlebar:bg rendering
-;
+;;
(define (num-titlebar-parts)
- (if
- (or
- (= (length (titlebar-gradient-colors)) 1)
- (eq mxflat:gradient-direction 'none)
- )
- (length (titlebar-gradient-colors))
- (1- (length (titlebar-gradient-colors)))
- )
-)
-
-; render frame-part background
-; this function takes the background img and uses
-; many single 2-color gradients to fill it
+ (if (or (= (length (titlebar-gradient-colors)) 1)
+ (eq mxflat:gradient-direction 'none))
+ (length (titlebar-gradient-colors))
+ (1- (length (titlebar-gradient-colors)))))
+
+;; render frame-part background
+;; this function takes the background img and uses many single 2-color
+;; gradients to fill it
(define (render-bg img state)
- (let*
- (
- ; width and height of the titlebar part we have to fill
- (width (car (image-dimensions img)))
- (height (cdr (image-dimensions img)))
-
- ; 2-color gradient width
- (part-width (/ width (num-titlebar-parts)))
- (rest-width (modulo width (num-titlebar-parts)))
-
- ; the offset in the img that we've already reached
- ; with our 2-color gradients
- (offset 0)
-
- ; get the width of the 2-color gradient with index i
- (titlebar-parts-width-helper (lambda (i)
- (if (= i (1- (num-titlebar-parts)))
- (+ part-width rest-width)
- part-width
- )
- ))
-
- ; check the 2-color gradient width if it is > 0
- (titlebar-parts-width (lambda (i)
- (let
- (
- (val (titlebar-parts-width-helper i))
- )
- (if (< val 1)
- 1
- val
- )
- )
- ))
-
- ; 2-color gradient image
- (img2 ())
- )
-
- (case mxflat:gradient-direction
- ((horizontal none)
- (do
- ((i 0 (1+ i)))
- ((= i (num-titlebar-parts)))
-
- ; create the 2-color gradient image and fill
- ; it with a background color
- (setq img2
- (make-sized-image
- (titlebar-parts-width i)
- height
- (if state
- (nth i (titlebar-gradient-colors))
- (adjust-titlebar-bgcolor i)
- )
- )
- )
-
- ; fill the img2 with the 2-color gradient
- ; in necessary
- (if (not (eq mxflat:gradient-direction 'none))
- (apply
- draw-horizontal-gradient
- img2
- (if state
- (list
- (nth i (titlebar-gradient-colors))
- (if (or
- (= (length (titlebar-gradient-colors)) 1)
- (eq mxflat:gradient-direction 'none)
- )
- (nth i (titlebar-gradient-colors))
- (nth (1+ i) (titlebar-gradient-colors))
- )
- )
- (list
- (adjust-titlebar-bgcolor i)
- (if (or
- (= (length (titlebar-gradient-colors)) 1)
- (eq mxflat:gradient-direction 'none)
- )
- (adjust-titlebar-bgcolor i)
- (adjust-titlebar-bgcolor (1+ i))
- )
- )
- )
- )
- )
-
- ; paste the current 2-color gradient into
- ; the titlebar background image
- (composite-images img img2 offset 0)
- (setq offset (+ offset (titlebar-parts-width i)))
- )
- )
- ((vertical diagonal)
- (apply
- (if (eq mxflat:gradient-direction 'vertical)
- draw-vertical-gradient
- draw-diagonal-gradient
- )
- img
- (if state
- (list
- (nth 0 (titlebar-gradient-colors))
- (if (= (length (titlebar-gradient-colors)) 1)
- (nth 0 (titlebar-gradient-colors))
- (nth 1 (titlebar-gradient-colors))
- )
- )
- (list
- (adjust-titlebar-bgcolor 0)
- (if (= (length (titlebar-gradient-colors)) 1)
- (adjust-titlebar-bgcolor 0)
- (adjust-titlebar-bgcolor 1)
- )
- )
- )
- )
- )
- )
- img
- )
-)
-
-;
+ (let* (;; width and height of the titlebar part we have to fill
+ (width (car (image-dimensions img)))
+ (height (cdr (image-dimensions img)))
+
+ ;; 2-color gradient width
+ (part-width (/ width (num-titlebar-parts)))
+ (rest-width (modulo width (num-titlebar-parts)))
+
+ ;; the offset in the img that we've already reached
+ ;; with our 2-color gradients
+ (offset 0)
+
+ ;; get the width of the 2-color gradient with index i
+ (titlebar-parts-width-helper (lambda (i)
+ (if (= i (1- (num-titlebar-parts)))
+ (+ part-width rest-width)
+ part-width)))
+
+ ;; check the 2-color gradient width if it is > 0
+ (titlebar-parts-width (lambda (i)
+ (let ((val (titlebar-parts-width-helper i)))
+ (if (< val 1)
+ 1
+ val))))
+
+ ;; 2-color gradient image
+ (img2 nil))
+
+ (case mxflat:gradient-direction
+ ((horizontal none)
+ (do ((i 0 (1+ i)))
+ ((= i (num-titlebar-parts)))
+
+ ;; create the 2-color gradient image and fill it with a
+ ;; background color
+ (setq img2 (make-sized-image (titlebar-parts-width i)
+ height
+ (if state
+ (nth i (titlebar-gradient-colors))
+ (adjust-titlebar-bgcolor i))))
+
+ ;; fill the img2 with the 2-color gradient if necessary
+ (if (not (eq mxflat:gradient-direction 'none))
+ (apply draw-horizontal-gradient
+ img2
+ (if state
+ (list (nth i (titlebar-gradient-colors))
+ (if (or
+ (= (length (titlebar-gradient-colors)) 1)
+ (eq mxflat:gradient-direction 'none))
+ (nth i (titlebar-gradient-colors))
+ (nth (1+ i) (titlebar-gradient-colors))))
+ (list (adjust-titlebar-bgcolor i)
+ (if (or
+ (= (length (titlebar-gradient-colors)) 1)
+ (eq mxflat:gradient-direction 'none))
+ (adjust-titlebar-bgcolor i)
+ (adjust-titlebar-bgcolor (1+ i)))))))
+
+ ;; paste the current 2-color gradient into the titlebar
+ ;; background image
+ (composite-images img img2 offset 0)
+ (setq offset (+ offset (titlebar-parts-width i)))))
+
+ ((vertical diagonal)
+ (apply
+ (if (eq mxflat:gradient-direction 'vertical)
+ draw-vertical-gradient
+ draw-diagonal-gradient)
+ img
+ (if state
+ (list (nth 0 (titlebar-gradient-colors))
+ (if (= (length (titlebar-gradient-colors)) 1)
+ (nth 0 (titlebar-gradient-colors))
+ (nth 1 (titlebar-gradient-colors))))
+ (list (adjust-titlebar-bgcolor 0)
+ (if (= (length (titlebar-gradient-colors)) 1)
+ (adjust-titlebar-bgcolor 0)
+ (adjust-titlebar-bgcolor 1)))))))
+ img))
+
+;;
;; titlebar:string
-;
+;;
(define (get-title-font) mxflat:title-font)
-; replace vars in the title string with their actual values
-; and return the new title string
+;; replace vars in the title string with their actual values and
+;; return the new title string
(define (get-title-string w)
- (if mxflat:custom-title
- (let*
- (
- (title mxflat:title-string)
- (update-title (lambda (match-str replace-str)
- (while (string-match match-str title)
- (setq title
- (concat
- (expand-last-match "\\1")
- (if (numberp replace-str)
- (number->string replace-str)
- replace-str
- )
- (expand-last-match "\\3")
- )
- )
- )
- ))
- )
- ; some built-in vars
- (update-title "(.*)(\\$name)(.*)" (window-name w))
- (update-title "(.*)(\\$fullname)(.*)" (window-full-name w))
- (update-title "(.*)(\\$width)(.*)" (car (window-frame-dimensions w)))
- (update-title "(.*)(\\$height)(.*)" (cdr (window-frame-dimensions w)))
- (update-title "(.*)(\\$width-content)(.*)" (car (window-dimensions w)))
- (update-title "(.*)(\\$height-content)(.*)" (cdr (window-dimensions w)))
- (update-title "(.*)(\\$x-pos)(.*)" (car (window-position w)))
- (update-title "(.*)(\\$y-pos)(.*)" (cdr (window-position w)))
- (update-title "(.*)(\\$id)(.*)" (window-id w))
- (update-title "(.*)(\\$depth)(.*)" (window-get w 'depth))
- (update-title "(.*)(\\$gid)(.*)" (window-group-id w))
- (update-title "(.*)(\\$last-ws)(.*)" (get-last-workspace))
- (update-title "(.*)(\\$current-ws)(.*)"
- (let
- (
- (workspaces (window-get w 'workspaces))
- )
- (if workspaces
- (1+ (nth 0 workspaces))
- "*"
- )
- )
- )
- ; replace environment vars
- (while (string-match "(.*)\\$\\((.+?)\\)(.*)" title)
- (let
- (
- (part1 (expand-last-match "\\1"))
- (part2 (expand-last-match "\\3"))
- (envvar (getenv (expand-last-match "\\2")))
- )
- (if (not envvar)
- (setq envvar (concat "$?(" (expand-last-match "\\2") ")"))
- )
- (setq title (concat part1 envvar part2))
- )
- )
- ; replace rep functions
- ; XXX: no arguments to the functions possible yet,
- ; does someone need this?
- (while (string-match "(.*)\\$\\[(.+?)\\](.*)" title)
- (let
- (
- (part1 (expand-last-match "\\1"))
- (part2 (expand-last-match "\\3"))
- (symb (intern (expand-last-match "\\2")))
- (func ())
- (value (concat "$?[" (expand-last-match "\\2") "]"))
- )
- (if (boundp symb)
- (setq func (symbol-value symb))
- )
- (if (functionp func)
- (setq value (funcall func))
- )
- (setq title (concat part1 value part2))
- )
- )
- title
- )
- (window-name w)
- )
-)
-
-;
+ (if mxflat:custom-title
+ (let* ((title mxflat:title-string)
+ (update-title (lambda (match-str replace-str)
+ (while (string-match match-str title)
+ (setq title
+ (concat
+ (expand-last-match "\\1")
+ (if (numberp replace-str)
+ (number->string replace-str)
+ replace-str)
+ (expand-last-match "\\3")))))))
+ ;; some built-in vars
+ (update-title "(.*)(\\$name)(.*)"
+ (window-name w))
+ (update-title "(.*)(\\$fullname)(.*)"
+ (window-full-name w))
+ (update-title "(.*)(\\$width)(.*)"
+ (car (window-frame-dimensions w)))
+ (update-title "(.*)(\\$height)(.*)"
+ (cdr (window-frame-dimensions w)))
+ (update-title "(.*)(\\$width-content)(.*)"
+ (car (window-dimensions w)))
+ (update-title "(.*)(\\$height-content)(.*)"
+ (cdr (window-dimensions w)))
+ (update-title "(.*)(\\$x-pos)(.*)"
+ (car (window-position w)))
+ (update-title "(.*)(\\$y-pos)(.*)"
+ (cdr (window-position w)))
+ (update-title "(.*)(\\$id)(.*)"
+ (window-id w))
+ (update-title "(.*)(\\$depth)(.*)"
+ (window-get w 'depth))
+ (update-title "(.*)(\\$gid)(.*)"
+ (window-group-id w))
+ (update-title "(.*)(\\$last-ws)(.*)"
+ (get-last-workspace))
+ (update-title "(.*)(\\$current-ws)(.*)"
+ (let ((workspaces (window-get w 'workspaces)))
+ (if workspaces
+ (1+ (nth 0 workspaces))
+ "*")))
+ ;; replace environment vars
+ (while (string-match "(.*)\\$\\((.+?)\\)(.*)" title)
+ (let ((part1 (expand-last-match "\\1"))
+ (part2 (expand-last-match "\\3"))
+ (envvar (getenv (expand-last-match "\\2"))))
+ (if (not envvar)
+ (setq envvar (concat "$?(" (expand-last-match "\\2") ")")))
+ (setq title (concat part1 envvar part2))))
+ ;; replace rep functions
+ ;; XXX: no arguments to the functions possible yet, does
+ ;; someone need this?
+ (while (string-match "(.*)\\$\\[(.+?)\\](.*)" title)
+ (let ((part1 (expand-last-match "\\1"))
+ (part2 (expand-last-match "\\3"))
+ (symb (intern (expand-last-match "\\2")))
+ (func nil)
+ (value (concat "$?[" (expand-last-match "\\2") "]")))
+ (if (boundp symb)
+ (setq func (symbol-value symb)))
+ (if (functionp func)
+ (setq value (funcall func)))
+ (setq title (concat part1 value part2))))
+ title)
+ (window-name w)))
+
+;;
;; titlebar:position
-;
+;;
-; calculate the leftmost x position of an object on the titlebar
-; this function is also used for button positions on the titlebar
+;; calculate the leftmost x position of an object on the titlebar
+;; this function is also used for button positions on the titlebar
(define (calculate-position pos)
- (if
- (and
- mxflat:customize-buttons
- (eq mxflat:button-position-model 'pixel)
- )
- ; if the button-position-model is pixel we dont
- ; need to calculate anything but just return the
- ; argument value
- pos
- ; actually calculate the positon
- (*
- (1- pos)
- (+
- (get-button-size)
- mxflat:button-distance
- )
- )
- )
-)
+ (if (and mxflat:customize-buttons
+ (eq mxflat:button-position-model 'pixel))
+ ;; if the button-position-model is pixel we dont
+ ;; need to calculate anything but just return the
+ ;; argument value
+ pos
+ ;; actually calculate the positon
+ (* (1- pos)
+ (+ (get-button-size)
+ mxflat:button-distance))))
(define (get-title-height)
- (+
- mxflat:title-height
- mxflat:border-width-titlebar-contents
- )
-)
-
-; not really the neg value since we add the border offset
-; but thats the easiest place for doing so
+ (+ mxflat:title-height
+ mxflat:border-width-titlebar-contents))
+
+;; not really the neg value since we add the border offset
+;; but thats the easiest place for doing so
(define (get-neg-title-height)
- (-
- (get-border-offset)
- (get-title-height)
- )
-)
+ (- (get-border-offset)
+ (get-title-height)))
(define (get-titlebar-height w)
- (+
- (get-title-height)
- (get-border-width w 'top)
- )
-)
-
-; not really the neg value since we add the border offset
-; but thats the easiest place for doing so
+ (+ (get-title-height)
+ (get-border-width w 'top)))
+
+;; not really the neg value since we add the border offset
+;; but thats the easiest place for doing so
(define (get-neg-titlebar-height w)
- (-
- (get-border-offset)
- (get-titlebar-height w)
- )
-)
+ (- (get-border-offset)
+ (get-titlebar-height w)))
- ; get the 1+ position of the leftmost or rightmost button
+;; get the 1+ position of the leftmost or rightmost button
(define (get-last-button-position left-right)
- (let
- ((pos
- (if mxflat:customize-buttons
- (abs (apply
- (if (eq left-right 'left)
- min
- max
- )
- (list mxflat:menu-button-position mxflat:shade-button-position
- mxflat:sticky-button-position mxflat:previous-button-position
- mxflat:next-button-position mxflat:configure-button-position
- mxflat:info-button-position mxflat:iconify-button-position
- mxflat:maximize-button-position mxflat:close-button-position
- mxflat:always-on-top-button-position mxflat:lock-button-position
- )
- ))
- (if (eq left-right 'left)
- 3
- 2
- )
- )
- ))
- (if
- (or
- (eq mxflat:button-position-model 'title-height)
- (not mxflat:customize-buttons)
- )
- (calculate-position (1+ pos))
- (if (eq mxflat:button-position-model 'pixel)
- (+
- pos
- mxflat:title-height
- )
- 1
- )
- )
- )
-)
-
-; by default the title is vertically centered and pixelwise
-; adjusted through mxflat:title-y-adjustment
+ (let ((pos
+ (if mxflat:customize-buttons
+ (abs (apply
+ (if (eq left-right 'left)
+ min
+ max)
+ (list mxflat:menu-button-position
+ mxflat:shade-button-position
+ mxflat:sticky-button-position
+ mxflat:previous-button-position
+ mxflat:next-button-position
+ mxflat:configure-button-position
+ mxflat:info-button-position
+ mxflat:iconify-button-position
+ mxflat:maximize-button-position
+ mxflat:close-button-position
+ mxflat:always-on-top-button-position
+ mxflat:lock-button-position)))
+ (if (eq left-right 'left)
+ 3
+ 2))))
+ (if (or (eq mxflat:button-position-model 'title-height)
+ (not mxflat:customize-buttons))
+ (calculate-position (1+ pos))
+ (if (eq mxflat:button-position-model 'pixel)
+ (+ pos
+ mxflat:title-height)1))))
+
+;; by default the title is vertically centered and pixelwise
+;; adjusted through mxflat:title-y-adjustment
(define (get-title-y-alignment)
- (if mxflat:customize-title-position
- (case mxflat:title-y-justify
- ((top)
- ; sanity check on the value
- ; else the title string would not be visible
- (if (> mxflat:title-y-adjustment 0)
- mxflat:title-y-adjustment
- 0
- )
- )
-
- ; we have to calculate it manually to be able to take
- ; the y align adjustment into account
- ((center)
- (+
- mxflat:title-y-adjustment
- (/
- (-
- mxflat:title-height
- (font-height mxflat:title-font)
- )
- 2
- )
- )
- )
- ; bottom
- (t
- ; sanity check on the value
- ; else the title string would not be visible
- (if (< mxflat:title-y-adjustment 0)
- mxflat:title-y-adjustment
- -1
- )
- )
- )
- 'center
- )
-)
+ (if mxflat:customize-title-position
+ (case mxflat:title-y-justify
+ ((top)
+ ;; sanity check on the value
+ ;; else the title string would not be visible
+ (if (> mxflat:title-y-adjustment 0)
+ mxflat:title-y-adjustment
+ 0))
+
+ ;; we have to calculate it manually to be able to take
+ ;; the y align adjustment into account
+ ((center)
+ (+ mxflat:title-y-adjustment
+ (/ (- mxflat:title-height
+ (font-height mxflat:title-font))
+ 2)))
+
+ ;; bottom
+ (t
+ ;; sanity check on the value
+ ;; else the title string would not be visible
+ (if (< mxflat:title-y-adjustment 0)
+ mxflat:title-y-adjustment
+ -1)))
+ 'center))
(define (get-title-x-alignment w)
- (if mxflat:customize-title-position
- (case mxflat:title-x-justify
- ((left)
- ; sanity check on the value
- ; else the title string would not be visible
- (if (< mxflat:title-x-adjustment 0)
- 0
- mxflat:title-x-adjustment
- )
- )
- ((center)
- 'center
- )
- ((right)
- ; sanity check on the value
- ; else the title string would not be visible
- (if (> mxflat:title-x-adjustment -1)
- -1
- mxflat:title-x-adjustment
- )
- )
- ; 'real-center' means to take the whole titlebar into account
- ; while centering the title string
- ((real-center)
- (let
- (
- (real-title-offset
- (/
- (-
- (car (window-dimensions w))
- (text-width (get-title-string w) (get-title-font))
- )
- 2
- )
- )
- (title-offset
- (-
- (get-last-button-position 'left)
- mxflat:title-x-adjustment
- )
- )
- )
- (if (> title-offset real-title-offset)
- 0
- (- real-title-offset title-offset)
- )
- )
- )
- )
- 'center
- )
-)
+ (if mxflat:customize-title-position
+ (case mxflat:title-x-justify
+ ((left)
+ ;; sanity check on the value
+ ;; else the title string would not be visible
+ (if (< mxflat:title-x-adjustment 0)
+ 0
+ mxflat:title-x-adjustment))
+ ((center)
+ 'center)
+ ((right)
+ ;; sanity check on the value
+ ;; else the title string would not be visible
+ (if (> mxflat:title-x-adjustment -1)
+ -1
+ mxflat:title-x-adjustment))
+ ;; 'real-center' means to take the whole titlebar into account
+ ;; while centering the title string
+ ((real-center)
+ (let ((real-title-offset
+ (/ (- (car (window-dimensions w))
+ (text-width (get-title-string w) (get-title-font)))
+ 2))
+ (title-offset
+ (- (get-last-button-position 'left)
+ mxflat:title-x-adjustment)))
+ (if (> title-offset real-title-offset)
+ 0
+ (- real-title-offset title-offset)))))
+ 'center))
(define (left-buttons-end-offset)
- (get-last-button-position 'left)
-)
+ (get-last-button-position 'left))
+
(define (right-buttons-end-offset)
- (get-last-button-position 'right)
-)
+ (get-last-button-position 'right))
-;
+;;
;; titlebar:creation
-;
+;;
(define (titlebar-center backgroun backgroundd)
- `(
- (
- (class . title)
- (,backgroun . ,backgroundd)
- (render-scale . ,mxflat:gradient-scale)
- (foreground . ,get-text-colors)
- (font . ,get-title-font)
- (text . ,get-title-string)
- (x-justify . ,get-title-x-alignment)
- (y-justify . ,get-title-y-alignment)
- (left-edge .
- ,(lambda ()
- (+
- (left-buttons-end-offset)
- (get-border-offset)
- )
- )
- )
- (right-edge .
- ,(lambda ()
- (+
- (right-buttons-end-offset)
- (get-border-offset)
- )
- )
- )
- (top-edge . ,get-neg-title-height)
- (height . ,(lambda () mxflat:title-height))
- )
- )
-)
+ `(((class . title)
+ (,backgroun . ,backgroundd)
+ (render-scale . ,mxflat:gradient-scale)
+ (foreground . ,get-text-colors)
+ (font . ,get-title-font)
+ (text . ,get-title-string)
+ (x-justify . ,get-title-x-alignment)
+ (y-justify . ,get-title-y-alignment)
+ (left-edge . ,(lambda ()
+ (+ (left-buttons-end-offset)
+ (get-border-offset))))
+ (right-edge . ,(lambda ()
+ (+ (right-buttons-end-offset)
+ (get-border-offset))))
+ (top-edge . ,get-neg-title-height)
+ (height . ,(lambda () mxflat:title-height)))))
(define (titlebar-left-right backgroun backgroundd edg1 edgee1 edg2 edgee2)
- `(
- ; left part of the titlebar
- (
- (class . title)
- (,backgroun . ,backgroundd)
- (render-scale . ,mxflat:gradient-scale)
- (,edg1 . ,edgee1)
- (,edg2 . ,edgee2)
- (top-edge . ,get-neg-title-height)
- (height . ,(lambda () mxflat:title-height))
- )
- )
-)
+ ;; left part of the titlebar
+ `(((class . title)
+ (,backgroun . ,backgroundd)
+ (render-scale . ,mxflat:gradient-scale)
+ (,edg1 . ,edgee1)
+ (,edg2 . ,edgee2)
+ (top-edge . ,get-neg-title-height)
+ (height . ,(lambda () mxflat:title-height)))))
(define (titlebar)
- (append
- (if
- (and
- (or
- (eq mxflat:gradient-direction 'vertical)
- (eq mxflat:gradient-direction 'diagonal)
- )
- mxflat:title-gradient
- )
- (append
- (titlebar-left-right
- 'renderer render-bg
- 'left-edge get-border-offset
- 'width left-buttons-end-offset
- )
- (titlebar-left-right
- 'renderer render-bg
- 'width right-buttons-end-offset
- 'right-edge get-border-offset
- )
- )
- (append
- (titlebar-left-right
- 'background (lambda () (get-titlebar-bgcolors 'left))
- 'left-edge get-border-offset
- 'width left-buttons-end-offset
- )
- (titlebar-left-right
- 'background (lambda () (get-titlebar-bgcolors 'right))
- 'width right-buttons-end-offset
- 'right-edge get-border-offset
- )
- )
- )
- (if mxflat:title-gradient
- (titlebar-center 'renderer render-bg)
- (titlebar-center 'background get-titlebar-bgcolors)
- )
- )
-)
-
-; -------
+ (append
+ (if (and (or (eq mxflat:gradient-direction 'vertical)
+ (eq mxflat:gradient-direction 'diagonal))
+ mxflat:title-gradient)
+ (append
+ (titlebar-left-right
+ 'renderer render-bg
+ 'left-edge get-border-offset
+ 'width left-buttons-end-offset)
+ (titlebar-left-right
+ 'renderer render-bg
+ 'width right-buttons-end-offset
+ 'right-edge get-border-offset))
+ (append
+ (titlebar-left-right
+ 'background (lambda () (get-titlebar-bgcolors 'left))
+ 'left-edge get-border-offset
+ 'width left-buttons-end-offset)
+ (titlebar-left-right
+ 'background (lambda () (get-titlebar-bgcolors 'right))
+ 'width right-buttons-end-offset
+ 'right-edge get-border-offset)))
+ (if mxflat:title-gradient
+ (titlebar-center 'renderer render-bg)
+ (titlebar-center 'background get-titlebar-bgcolors))))
+
+;; -------
;;; BORDERS
-; -------
+;; -------
-;
+;;
;; borders:colors
-;
+;;
(define (get-border-color)
- (if mxflat:customize-border-colors
- `(
- (inactive . ,mxflat:border-color-unfocused)
- (focused . ,mxflat:border-color-focused)
- (highlighted . ,mxflat:border-color-highlighted)
- (inactive-highlighted . ,mxflat:border-color-inactive-highlighted)
- (clicked . ,mxflat:border-color-clicked)
- (inactive-clicked . ,mxflat:border-color-inactive-clicked)
- )
- `(
- (inactive . ,mxflat:text-color-unfocused)
- (focused . ,mxflat:text-color-focused)
- )
- )
-)
+ (if mxflat:customize-border-colors
+ `((inactive . ,mxflat:border-color-unfocused)
+ (focused . ,mxflat:border-color-focused)
+ (highlighted . ,mxflat:border-color-highlighted)
+ (inactive-highlighted . ,mxflat:border-color-inactive-highlighted)
+ (clicked . ,mxflat:border-color-clicked)
+ (inactive-clicked . ,mxflat:border-color-inactive-clicked))
+ `((inactive . ,mxflat:text-color-unfocused)
+ (focused . ,mxflat:text-color-focused))))
(define (get-border-color-titlebar-contents)
- (if mxflat:customize-border-colors
- `(
- (inactive . ,mxflat:border-color-unfocused)
- (focused . ,mxflat:border-color-focused)
- )
- `(
- (inactive . ,mxflat:text-color-unfocused)
- (focused . ,mxflat:text-color-focused)
- )
- )
-)
-
-;
+ (if mxflat:customize-border-colors
+ `((inactive . ,mxflat:border-color-unfocused)
+ (focused . ,mxflat:border-color-focused))
+ `((inactive . ,mxflat:text-color-unfocused)
+ (focused . ,mxflat:text-color-focused))))
+
+;;
;; borders:width
-;
+;;
(define (get-border-width w #!optional side)
- (cond
- (
- (or
- (and
- (window-maximized-vertically-p w)
- (or
- (eq side 'top)
- (eq side 'bottom)
- )
- )
- (and
- (window-maximized-horizontally-p w)
- (or
- (eq side 'left)
- (eq side 'right)
- )
- )
- )
- mxflat:border-width-maximized
- )
- (
- (and
- mxflat:custom-border-focused
- (eq w (input-focus))
- )
- mxflat:border-width-focused
- )
- (
- t
- mxflat:border-width-unmaximized
- )
- )
-)
+ (cond ((or (and (window-maximized-vertically-p w)
+ (or (eq side 'top)
+ (eq side 'bottom)))
+ (and (window-maximized-horizontally-p w)
+ (or (eq side 'left)
+ (eq side 'right))))
+ mxflat:border-width-maximized)
+ ((and mxflat:custom-border-focused
+ (eq w (input-focus)))
+ mxflat:border-width-focused)
+ (t
+ mxflat:border-width-unmaximized)))
(define (get-neg-border-width w #!optional side)
- (-
- (get-border-offset)
- (get-border-width w side)
- )
-)
+ (- (get-border-offset)
+ (get-border-width w side)))
-;
+;;
;; borders:creation
-;
-
-(define (create-border-frame-parts color offset widthh #!optional mode border-list)
- (let*
- (
- (get-pos (lambda (w side)
- (-
- (offset w side)
- (widthh w side)
- )
- ))
- ; bottom edge of the frame
- (bottom-edgee1 'bottom-edge)
- (bottom-edgee2 'bottom-edge)
- (bottom-edg1 (lambda (w) (offset w 'bottom)))
- (bottom-edg2 (lambda (w) (get-pos w 'bottom)))
- (top-edg1 (lambda (w)
- (-
- (offset w 'top)
- (get-title-height)
- )
- ))
- (top-edg2 (lambda (w)
- (-
- (offset w 'top)
- (+
- (get-title-height)
- (widthh w 'top)
- )
- )
- ))
- (left-edg (lambda (w) (get-pos w 'left)))
- (right-edg (lambda (w) (get-pos w 'right)))
- (right-borderr (if border-list 'shadow 'right-border))
- (left-borderr (if border-list 'shadow 'left-border))
- (top-borderr (if border-list 'shadow 'top-border))
- (bottom-borderr (if border-list 'shadow 'bottom-border))
- )
- (case mode
- ('transient
- (setq top-edg1 (lambda (w) (offset w 'top)))
- (setq top-edg2 (lambda (w) (get-pos w 'top)))
- )
- ('shaded
- (setq bottom-edgee2 'top-edge)
- (setq bottom-edg2 (lambda (w) (- (offset w 'bottom) mxflat:border-width-titlebar-contents)))
- ; when the window is shaded we rather define the borders by
- ; top-edge and height instead of using top- and bottom-edge
- (setq bottom-edgee1 'height)
- (setq bottom-edg1 (lambda (w) (get-titlebar-height w)))
- )
- )
- (append
- ; draw the right border
- (if
- (or
- (not border-list)
- (member 'right border-list)
- )
- `((
- (class . ,right-borderr)
- (background . ,color)
- (width . ,(lambda (w) (widthh w 'right)))
- (right-edge . ,right-edg)
- (top-edge . ,top-edg1)
- (,bottom-edgee1 . ,bottom-edg1)
- ))
- )
-
- ; draw the left border
- (if
- (or
- (not border-list)
- (member 'left border-list)
- )
- `((
- (class . ,left-borderr)
- (background . ,color)
- (width . ,(lambda (w) (widthh w 'left)))
- (left-edge . ,left-edg)
- (top-edge . ,top-edg1)
- (,bottom-edgee1 . ,bottom-edg1)
- ))
- )
-
- ; draw the top border of the title frame
- (if
- (or
- (not border-list)
- (member 'top border-list)
- )
- `((
- (class . ,top-borderr)
- (background . ,color)
- (height . ,(lambda (w) (widthh w 'top)))
- (left-edge . ,left-edg)
- (right-edge . ,right-edg)
- (top-edge . ,top-edg2)
- ))
- )
-
- ; draw the bottom border
- (if
- (or
- (not border-list)
- (member 'bottom border-list)
- )
- `((
- (class . ,bottom-borderr)
- (background . ,color)
- (height . ,(lambda (w) (widthh w 'bottom)))
- (left-edge . ,left-edg)
- (right-edge . ,right-edg)
- (,bottom-edgee2 . ,bottom-edg2)
- ))
- )
- )
- )
-)
-
-; this function appends the window border (frame) and its shadow
+;;
+
+(define (create-border-frame-parts color offset widthh
+ #!optional mode border-list)
+ (let* ((get-pos (lambda (w side)
+ (- (offset w side)
+ (widthh w side))))
+ ;; bottom edge of the frame
+ (bottom-edgee1 'bottom-edge)
+ (bottom-edgee2 'bottom-edge)
+ (bottom-edg1 (lambda (w)
+ (offset w 'bottom)))
+ (bottom-edg2 (lambda (w)
+ (get-pos w 'bottom)))
+ (top-edg1 (lambda (w)
+ (- (offset w 'top)
+ (get-title-height))))
+ (top-edg2 (lambda (w)
+ (- (offset w 'top)
+ (+ (get-title-height)
+ (widthh w 'top)))))
+ (left-edg (lambda (w)
+ (get-pos w 'left)))
+ (right-edg (lambda (w)
+ (get-pos w 'right)))
+ (right-borderr (if border-list
+ 'shadow
+ 'right-border))
+ (left-borderr (if border-list
+ 'shadow
+ 'left-border))
+ (top-borderr (if border-list
+ 'shadow
+ 'top-border))
+ (bottom-borderr (if border-list
+ 'shadow
+ 'bottom-border)))
+ (case mode
+ ('transient
+ (setq top-edg1 (lambda (w) (offset w 'top)))
+ (setq top-edg2 (lambda (w) (get-pos w 'top))))
+ ('shaded
+ (setq bottom-edgee2 'top-edge)
+ (setq bottom-edg2 (lambda (w)
+ (- (offset w 'bottom)
+ mxflat:border-width-titlebar-contents)))
+ ;; when the window is shaded we rather define the borders by
+ ;; top-edge and height nstead of using top- and bottom-edge
+ (setq bottom-edgee1 'height)
+ (setq bottom-edg1 (lambda (w)
+ (get-titlebar-height w)))))
+ (append
+ ;; draw the right border
+ (if (or (not border-list)
+ (member 'right border-list))
+ `(((class . ,right-borderr)
+ (background . ,color)
+ (width . ,(lambda (w) (widthh w 'right)))
+ (right-edge . ,right-edg)
+ (top-edge . ,top-edg1)
+ (,bottom-edgee1 . ,bottom-edg1))))
+
+ ;; draw the left border
+ (if (or (not border-list)
+ (member 'left border-list))
+ `(((class . ,left-borderr)
+ (background . ,color)
+ (width . ,(lambda (w) (widthh w 'left)))
+ (left-edge . ,left-edg)
+ (top-edge . ,top-edg1)
+ (,bottom-edgee1 . ,bottom-edg1))))
+
+ ;; draw the top border of the title frame
+ (if (or (not border-list)
+ (member 'top border-list))
+ `(((class . ,top-borderr)
+ (background . ,color)
+ (height . ,(lambda (w) (widthh w 'top)))
+ (left-edge . ,left-edg)
+ (right-edge . ,right-edg)
+ (top-edge . ,top-edg2))))
+
+ ;; draw the bottom border
+ (if (or (not border-list)
+ (member 'bottom border-list))
+ `(((class . ,bottom-borderr)
+ (background . ,color)
+ (height . ,(lambda (w) (widthh w 'bottom)))
+ (left-edge . ,left-edg)
+ (right-edge . ,right-edg)
+ (,bottom-edgee2 . ,bottom-edg2)))))))
+
+;; this function appends the window border (frame) and its shadow
(define (create-borders w #!optional mode)
- (if (= (length shadow-side) 0)
- (get-shadow-side)
- )
- (append
- ; create normal window border
- (create-border-frame-parts
- get-border-color
- get-border-offset
- get-border-width
- mode
- )
- ; create fake shadow if necessary
- (if
- (and
- mxflat:fake-shadow
- (or
- (not mxflat:fake-shadow-focused-only)
- (eq w (input-focus))
- )
- )
- (create-border-frame-parts
- get-shadow-color
- get-shadow-width
- get-shadow-offset
- mode
- shadow-side
- )
- )
- )
-)
-
-; create the (small) line between titlebar and contents window
+ (when (= (length shadow-side) 0)
+ (get-shadow-side))
+ (append
+ ;; create normal window border
+ (create-border-frame-parts get-border-color
+ get-border-offset
+ get-border-width
+ mode)
+ ;; create fake shadow if necessary
+ (when (and mxflat:fake-shadow
+ (or (not mxflat:fake-shadow-focused-only)
+ (eq w (input-focus))))
+ (create-border-frame-parts get-shadow-color
+ get-shadow-width
+ get-shadow-offset
+ mode
+ shadow-side))))
+
+;; create the (small) line between titlebar and contents window
(define (create-titlebar-contents-border)
- `(
- (
- (class . middle-border)
- (background . ,get-border-color-titlebar-contents)
- (height . ,(lambda () mxflat:border-width-titlebar-contents))
- (top-edge . ,(lambda ()
- (-
- (get-border-offset)
- mxflat:border-width-titlebar-contents
- )
- ))
- (left-edge . ,get-border-offset)
- (right-edge . ,get-border-offset)
- )
- )
-)
-
-; return a top border (for shaded-transient)
+ `(((class . middle-border)
+ (background . ,get-border-color-titlebar-contents)
+ (height . ,(lambda ()
+ mxflat:border-width-titlebar-contents))
+ (top-edge . ,(lambda ()
+ (- (get-border-offset)
+ mxflat:border-width-titlebar-contents)))
+ (left-edge . ,get-border-offset)
+ (right-edge . ,get-border-offset))))
+
+;; return a top border (for shaded-transient)
(define (create-top-border)
- `(
- (
- (class . top-border)
- (background . ,get-border-color)
- (height . ,(lambda (w) (get-border-width w 'top)))
- (top-edge . ,(lambda (w) (get-neg-border-width w 'top)))
- (left-edge . 0)
- (right-edge . 0)
- )
- )
-)
-
-; -------
+ `(((class . top-border)
+ (background . ,get-border-color)
+ (height . ,(lambda (w) (get-border-width w 'top)))
+ (top-edge . ,(lambda (w) (get-neg-border-width w 'top)))
+ (left-edge . 0)
+ (right-edge . 0))))
+
+;; -------
;;; BUTTONS
-; -------
+;; -------
-; create, scale and cache an image
+;; create, scale and cache an image
(define (get-image img)
- (or
- (table-ref icon-cache img)
- (let
- (
- (image
- (if mxflat:scale-buttons
- (scale-image
- (make-image img)
- mxflat:button-scale mxflat:button-scale
- )
- (make-image img)
- )
- )
- )
- (table-set icon-cache img image)
- image
- )
- )
-)
-
-;
+ (or (table-ref icon-cache img)
+ (let ((image
+ (if mxflat:scale-buttons
+ (scale-image (make-image img) mxflat:button-scale
+ mxflat:button-scale)
+ (make-image img))))
+ (table-set icon-cache img image)
+ image)))
+
+;;
;; buttons:colors
-;
+;;
(define (get-button-bgcolor #!optional edge)
- (cond
- (mxflat:title-gradient
- (let*
- (
- (index
- (if (eq edge 'right-edge)
- (1- (length (titlebar-gradient-colors)))
- 0
- )
- )
- )
- `(
- (inactive . ,(adjust-titlebar-bgcolor index))
- (focused . ,(nth index (titlebar-gradient-colors)))
- (highlighted . ,(adjust-titlebar-bgcolor index))
- (inactive-highlighted . ,(nth index (titlebar-gradient-colors)))
- (clicked . ,(adjust-titlebar-bgcolor index))
- (inactive-clicked . ,(nth index (titlebar-gradient-colors)))
- )
- )
- )
- (mxflat:custom-button-colors
- `(
- (inactive . ,mxflat:button-bgcolor-unfocused)
- (focused . ,mxflat:button-bgcolor-focused)
- (highlighted . ,mxflat:button-bgcolor-highlighted)
- (inactive-highlighted . ,mxflat:button-bgcolor-inactive-highlighted)
- (clicked . ,mxflat:button-bgcolor-clicked)
- (inactive-clicked . ,mxflat:button-bgcolor-inactive-clicked)
- )
- )
- (t
- `(
- (inactive . ,mxflat:titlebar-bgcolor-unfocused)
- (focused . ,mxflat:titlebar-bgcolor-focused)
- (highlighted . ,mxflat:titlebar-bgcolor-unfocused)
- (inactive-highlighted . ,mxflat:titlebar-bgcolor-focused)
- (clicked . ,mxflat:text-color-unfocused)
- (inactive-clicked . ,mxflat:text-color-unfocused)
- )
- )
- )
-)
-
-
-;
+ (cond (mxflat:title-gradient
+ (let* ((index
+ (if (eq edge 'right-edge)
+ (1- (length (titlebar-gradient-colors)))
+ 0)))
+ `((inactive . ,(adjust-titlebar-bgcolor index))
+ (focused . ,(nth index (titlebar-gradient-colors)))
+ (highlighted . ,(adjust-titlebar-bgcolor index))
+ (inactive-highlighted . ,(nth index (titlebar-gradient-colors)))
+ (clicked . ,(adjust-titlebar-bgcolor index))
+ (inactive-clicked . ,(nth index
+ (titlebar-gradient-colors))))))
+ (mxflat:custom-button-colors
+ `((inactive . ,mxflat:button-bgcolor-unfocused)
+ (focused . ,mxflat:button-bgcolor-focused)
+ (highlighted . ,mxflat:button-bgcolor-highlighted)
+ (inactive-highlighted . ,mxflat:button-bgcolor-inactive-highlighted)
+ (clicked . ,mxflat:button-bgcolor-clicked)
+ (inactive-clicked . ,mxflat:button-bgcolor-inactive-clicked)))
+ (t
+ `((inactive . ,mxflat:titlebar-bgcolor-unfocused)
+ (focused . ,mxflat:titlebar-bgcolor-focused)
+ (highlighted . ,mxflat:titlebar-bgcolor-unfocused)
+ (inactive-highlighted . ,mxflat:titlebar-bgcolor-focused)
+ (clicked . ,mxflat:text-color-unfocused)
+ (inactive-clicked . ,mxflat:text-color-unfocused)))))
+
+
+;;
;; buttons:icons
-;
+;;
-; return a list of 4 different image objects
-; as needed for the button fg images/icons
+;; return a list of 4 different image objects as needed for the button
+;; fg images/icons
(define (get-images img)
- (let
- (
- (image (get-image (concat "button-icons/" (symbol-name mxflat:button-icon-set) "/" img)))
- )
- (list
- image
- (copy-image image)
- (copy-image image)
- (copy-image image)
- )
- )
-)
+ (let ((image (get-image (concat "button-icons/"
+ (symbol-name mxflat:button-icon-set)
+ "/"
+ img))))
+ (list image
+ (copy-image image)
+ (copy-image image)
+ (copy-image image))))
(defvar get-menu-button1 (get-images "button-menu.png"))
(define (get-menu-button w)
- (if mxflat:menu-button-icon
- (or
- (table-ref icon-cache w)
- (or
- (let
- (
- (icon (window-icon-image w))
- )
- (when icon
- (let
- (
- (scaled
- (scale-image icon mxflat:menu-button-scale
- mxflat:menu-button-scale)
- )
- )
- (table-set icon-cache w scaled)
- scaled
- )
- )
- )
- get-menu-button1
- )
- )
- get-menu-button1
- )
-)
+ (if mxflat:menu-button-icon
+ (or (table-ref icon-cache w)
+ (or (let ((icon (window-icon-image w)))
+ (when icon
+ (let ((scaled
+ (scale-image icon mxflat:menu-button-scale
+ mxflat:menu-button-scale)))
+ (table-set icon-cache w scaled)
+ scaled)))
+ get-menu-button1))
+ get-menu-button1))
(defvar get-shade-button1 (get-images "button-shade1.png"))
(defvar get-shade-button2 (get-images "button-shade2.png"))
(define (get-shade-button w)
- (if (window-get w 'shaded)
- get-shade-button2
- get-shade-button1
- )
-)
+ (if (window-get w 'shaded)
+ get-shade-button2
+ get-shade-button1))
(defvar get-sticky-button1 (get-images "button-sticky1.png"))
(defvar get-sticky-button2 (get-images "button-sticky2.png"))
(define (get-sticky-button w)
- (if (window-get w 'sticky)
- get-sticky-button2
- get-sticky-button1
- )
-)
+ (if (window-get w 'sticky)
+ get-sticky-button2
+ get-sticky-button1))
(defvar get-iconify-button (get-images "button-minimize.png"))
(defvar get-maximize-button1 (get-images "button-maximize1.png"))
(defvar get-maximize-button2 (get-images "button-maximize2.png"))
(define (get-maximize-button w)
- (if (window-maximized-p w)
- get-maximize-button2
- get-maximize-button1
- )
-)
+ (if (window-maximized-p w)
+ get-maximize-button2
+ get-maximize-button1))
(defvar get-close-button (get-images "button-close.png"))
(defvar get-previous-button1 (get-images "button-previous1.png"))
(defvar get-previous-button2 (get-images "button-previous2.png"))
(define (get-previous-button w)
- (if
- (or
- (window-in-workspace-p w (- (get-first-workspace) 1))
- (window-get w 'sticky)
- )
- get-previous-button2
- get-previous-button1
- )
-)
+ (if (or (window-in-workspace-p w (- (get-first-workspace) 1))
+ (window-get w 'sticky))
+ get-previous-button2
+ get-previous-button1))
(defvar get-next-button1 (get-images "button-next1.png"))
(defvar get-next-button2 (get-images "button-next2.png"))
(define (get-next-button w)
- (if
- (or
- (window-in-workspace-p w (- (get-last-workspace) 1))
- (window-get w 'sticky)
- )
- get-next-button2
- get-next-button1
- )
-)
+ (if (or (window-in-workspace-p w (- (get-last-workspace) 1))
+ (window-get w 'sticky))
+ get-next-button2
+ get-next-button1))
(defvar get-configure-button (get-images "button-configure.png"))
@@ -2830,562 +2392,448 @@
(defvar get-always-on-top-button1 (get-images "button-a1.png"))
(defvar get-always-on-top-button2 (get-images "button-a2.png"))
(define (get-always-on-top-button w)
- (if (> (window-get w 'depth) 0)
- get-always-on-top-button2
- get-always-on-top-button1
- )
-)
+ (if (> (window-get w 'depth) 0)
+ get-always-on-top-button2
+ get-always-on-top-button1))
(defvar get-lock-button1 (get-images "button-lock1.png"))
(defvar get-lock-button2 (get-images "button-lock2.png"))
(define (get-lock-button w)
- (if (window-get w 'fixed-position)
- get-lock-button2
- get-lock-button1
- )
-)
+ (if (window-get w 'fixed-position)
+ get-lock-button2
+ get-lock-button1))
-;
+;;
;; buttons:fg recolor
-;
-
-; this function is stolen from the crux sawfish theme
-; (the theme is included in the original sawfish package)
-(setq recolor-all (lambda ()
- (let*
- (
- (recolorer (lambda (color1 color2)
- (make-image-recolorer
- (if mxflat:custom-button-colors
- color1
- color2
- )
- #:zero-channel blue-channel
- #:index-channel red-channel
- )
- ))
-
- ; unfocused
- (recolorer1
- (recolorer
- mxflat:button-fgcolor-inactive
- mxflat:text-color-unfocused
- )
- )
- ; focused
- (recolorer2
- (recolorer
- mxflat:button-fgcolor-focused
- mxflat:text-color-focused
- )
- )
- ; highlighted
- (recolorer3
- (recolorer
- mxflat:button-fgcolor-highlighted
- mxflat:text-color-unfocused
- )
- )
- ; clicked
- (recolorer4
- (recolorer
- mxflat:button-fgcolor-clicked
- mxflat:text-color-focused
- )
- )
- )
- (mapc
- (lambda (x)
- (apply recolorer1 x)
- (apply recolorer2 (cdr x))
- (if (> (length x) 2)
- (apply recolorer3 (nthcdr 2 x))
- )
- (if (> (length x) 3)
- (apply recolorer4 (nthcdr 3 x))
- )
- )
- ; list of all button fg icon lists that we have to recolor
- (list get-menu-button1 get-shade-button1 get-shade-button2
- get-sticky-button1 get-sticky-button2 get-iconify-button
- get-maximize-button1 get-maximize-button2 get-close-button
- get-previous-button1 get-previous-button2 get-next-button1
- get-next-button2 get-configure-button get-info-button
- get-always-on-top-button1 get-always-on-top-button2
- get-lock-button1 get-lock-button2
- )
- )
- )
-))
-
-;
+;;
+
+;; this function is stolen from the crux sawfish theme (the theme is
+;; included in the original sawfish package)
+(setq recolor-all
+ (lambda ()
+ (let* ((recolorer (lambda (color1 color2)
+ (make-image-recolorer
+ (if mxflat:custom-button-colors
+ color1
+ color2)
+ #:zero-channel blue-channel
+ #:index-channel red-channel)))
+
+ ;; unfocused
+ (recolorer1 (recolorer
+ mxflat:button-fgcolor-inactive
+ mxflat:text-color-unfocused))
+ ;; focused
+ (recolorer2 (recolorer
+ mxflat:button-fgcolor-focused
+ mxflat:text-color-focused))
+ ;; highlighted
+ (recolorer3 (recolorer
+ mxflat:button-fgcolor-highlighted
+ mxflat:text-color-unfocused))
+ ;; clicked
+ (recolorer4 (recolorer
+ mxflat:button-fgcolor-clicked
+ mxflat:text-color-focused)))
+ (mapc (lambda (x)
+ (apply recolorer1 x)
+ (apply recolorer2 (cdr x))
+ (if (> (length x) 2)
+ (apply recolorer3 (nthcdr 2 x)))
+ (if (> (length x) 3)
+ (apply recolorer4 (nthcdr 3 x))))
+
+ ;; list of all button fg icon lists that we have to recolor
+ (list get-menu-button1 get-shade-button1
+ get-shade-button2 get-sticky-button1
+ get-sticky-button2 get-iconify-button
+ get-maximize-button1 get-maximize-button2
+ get-close-button get-previous-button1
+ get-previous-button2 get-next-button1
+ get-next-button2 get-configure-button
+ get-info-button get-always-on-top-button1
+ get-always-on-top-button2 get-lock-button1
+ get-lock-button2)))))
+
+;;
;; buttons:define classes
-;
-
-; missing button frame part classes
-; all other classes are defined by sawfish by default -
-; it are always 2 classes, one with the default key binding
-; and one with the custom (user defined) one
-(define-frame-class 'configure-button-custom '((keymap . mxflat:configure-button-keymap)))
-(define-frame-class 'configure-button '((keymap . configure-button-keymap)))
-(define-frame-class 'info-button-custom '((keymap . mxflat:info-button-keymap)))
-(define-frame-class 'info-button '((keymap . info-button-keymap)))
-(define-frame-class 'next-button-custom '((keymap . mxflat:next-button-keymap)))
-(define-frame-class 'next-button '((keymap . next-button-keymap)))
-(define-frame-class 'previous-button-custom '((keymap . mxflat:previous-button-keymap)))
-(define-frame-class 'previous-button '((keymap . previous-button-keymap)))
-(define-frame-class 'sticky-button-custom '((keymap . mxflat:sticky-button-keymap)))
-(define-frame-class 'sticky-button '((keymap . sticky-button-keymap)))
-(define-frame-class 'always-on-top-button-custom '((keymap . mxflat:always-on-top-button-keymap)))
-(define-frame-class 'always-on-top-button '((keymap . always-on-top-button-keymap)))
-(define-frame-class 'lock-button-custom '((keymap . mxflat:lock-button-keymap)))
-(define-frame-class 'lock-button '((keymap . lock-button-keymap)))
-
-;
+;;
+
+;; missing button frame part classes
+;; all other classes are defined by sawfish by default - it are always
+;; 2 classes, one with the default key binding and one with the custom
+;; (user defined) one
+
+(define-frame-class 'configure-button-custom
+ '((keymap . mxflat:configure-button-keymap)))
+
+(define-frame-class 'configure-button
+ '((keymap . configure-button-keymap)))
+
+(define-frame-class 'info-button-custom
+ '((keymap . mxflat:info-button-keymap)))
+
+(define-frame-class 'info-button
+ '((keymap . info-button-keymap)))
+
+(define-frame-class 'next-button-custom
+ '((keymap . mxflat:next-button-keymap)))
+
+(define-frame-class 'next-button
+ '((keymap . next-button-keymap)))
+
+(define-frame-class 'previous-button-custom
+ '((keymap . mxflat:previous-button-keymap)))
+
+(define-frame-class 'previous-button
+ '((keymap . previous-button-keymap)))
+
+(define-frame-class 'sticky-button-custom
+ '((keymap . mxflat:sticky-button-keymap)))
+
+(define-frame-class 'sticky-button
+ '((keymap . sticky-button-keymap)))
+
+(define-frame-class 'always-on-top-button-custom
+ '((keymap . mxflat:always-on-top-button-keymap)))
+
+(define-frame-class 'always-on-top-button
+ '((keymap . always-on-top-button-keymap)))
+
+(define-frame-class 'lock-button-custom
+ '((keymap . mxflat:lock-button-keymap)))
+
+(define-frame-class 'lock-button
+ '((keymap . lock-button-keymap)))
+
+;;
;; buttons:creation
-;
-
-; this function actually creates a button frame part and returns it
-(define (create-button-frame-part classs fg edge x-pos y-pos backgroun backgroundd)
- ; button frame part definition
- `(
- (class . ,classs)
- (,backgroun . ,backgroundd)
- (render-scale . ,mxflat:gradient-scale)
- (foreground . ,fg)
- (x-justify . center)
- (y-justify . center)
- (,edge . ,x-pos)
- (top-edge . ,y-pos)
- (height . ,get-button-size)
- (width . ,get-button-size)
- )
-)
-
-; gather all necessary arguments and then call create-button-frame-part
-; to actually create the button
+;;
+
+;; this function actually creates a button frame part and returns it
+(define (create-button-frame-part classs fg edge x-pos y-pos backgroun
+ backgroundd)
+ ;; button frame part definition
+ `((class . ,classs)
+ (,backgroun . ,backgroundd)
+ (render-scale . ,mxflat:gradient-scale)
+ (foreground . ,fg)
+ (x-justify . center)
+ (y-justify . center)
+ (,edge . ,x-pos)
+ (top-edge . ,y-pos)
+ (height . ,get-button-size)
+ (width . ,get-button-size)))
+
+;; gather all necessary arguments and then call create-button-frame-part
+;; to actually create the button
(define (create-button button-type #!optional x-pos-default)
- (let
- (
- ; raw position, creatue-button-frame-part does some more
- ; calculations on it
- (x-pos-raw
- (if mxflat:customize-buttons
- (check-symbol "mxflat:" button-type "-button-position")
- (if x-pos-default x-pos-default 0)
- )
- )
- )
-
- ; position = 0 means the button is not displayed
- ; so we can save some time be not doing all these evaluations
- (if (not (= x-pos-raw 0))
- (let*
- (
- ; if the position parameter (x-pos-raw) for the current button is
- ; positive it starts on the right side
- (edge (if (> x-pos-raw 0) 'right-edge 'left-edge))
-
- ; default button background mode (ie static color)
- (backgroun 'background)
- (backgroundd (get-button-bgcolor edge))
-
- ; button x offset from the left/right titlebar edge
- (x-pos (lambda ()
- (+
- (-
- (calculate-position (abs x-pos-raw))
- mxflat:border-offset
- )
- (if (> x-pos-raw 0)
- mxflat:button-right-offset
- mxflat:button-left-offset
- )
- )
- ))
-
- ; different top positions for different mxflat:button-y-alignment
- ; but only in case mxflat:customize-button-size is true
- ; because in the other case the buttons height and width is equal
- ; to the titlebar height
- (y-pos (lambda ()
- (if mxflat:customize-button-size
- (case mxflat:button-y-alignment
- ((top)
- (get-neg-title-height)
- )
- ((bottom)
- (+
- (get-neg-title-height)
- (-
- mxflat:title-height
- (get-button-size)
- )
- )
- )
- ; this is the center case
- (t
- (+
- (get-neg-title-height)
- (/
- (-
- mxflat:title-height
- (get-button-size)
- )
- 2
- )
- )
- )
- )
- ; in case the size is the default we start on top
- ; of the titlebar
- (get-neg-title-height)
- )
- ))
- )
-
- ; in case of a gradient titlebar bg
- ; change the button bg to rendering
- (cond
- (
- (and
- mxflat:title-gradient
- (or
- (eq mxflat:gradient-direction 'vertical)
- (eq mxflat:gradient-direction 'diagonal)
- )
- )
- (setq backgroun 'renderer)
- (setq backgroundd render-bg)
- )
- )
-
- (create-button-frame-part
- ; decide which frame part (and indirectly which keymap) to use
- (if (check-symbol "mxflat:customize-" button-type "-keymap")
- (get-symbol button-type "-button-custom")
- (get-symbol button-type "-button")
- )
- ; button fg images/icons
- (check-symbol "get-" button-type "-button")
- edge
- x-pos
- y-pos
- backgroun
- backgroundd
- )
- )
- )
- )
-)
-
-; create a list of button frame parts and return it
+ (let ((x-pos-raw
+ ;; raw position, creatue-button-frame-part does some more
+ ;; calculations on it
+ (if mxflat:customize-buttons
+ (check-symbol "mxflat:" button-type "-button-position")
+ (if x-pos-default x-pos-default 0))))
+
+ ;; position = 0 means the button is not displayed so we can save
+ ;; some time be not doing all these evaluations
+ (if (not (= x-pos-raw 0))
+ (let* (;; if the position parameter (x-pos-raw) for the
+ ;; current button is positive it starts on the right
+ ;; side
+ (edge (if (> x-pos-raw 0) 'right-edge 'left-edge))
+
+ ;; default button background mode (ie static color)
+ (backgroun 'background)
+ (backgroundd (get-button-bgcolor edge))
+
+ ;; button x offset from the left/right titlebar edge
+ (x-pos (lambda ()
+ (+ (- (calculate-position (abs x-pos-raw))
+ mxflat:border-offset)
+ (if (> x-pos-raw 0)
+ mxflat:button-right-offset
+ mxflat:button-left-offset))))
+
+ ;; different top positions for different
+ ;; mxflat:button-y-alignment but only in case
+ ;; mxflat:customize-button-size is true because in the
+ ;; other case the buttons height and width is equal to
+ ;; the titlebar height
+ (y-pos (lambda ()
+ (if mxflat:customize-button-size
+ (case mxflat:button-y-alignment
+ ((top)
+ (get-neg-title-height))
+ ((bottom)
+ (+ (get-neg-title-height)
+ (- mxflat:title-height
+ (get-button-size))))
+ (t ; this is the center case
+ (+ (get-neg-title-height)
+ (/ (- mxflat:title-height
+ (get-button-size))
+ 2))))
+ ;; in case the size is the default we start
+ ;; on top of the titlebar
+ (get-neg-title-height)))))
+
+ ;; in case of a gradient titlebar bg change the button bg to
+ ;; rendering
+ (cond ((and mxflat:title-gradient
+ (or (eq mxflat:gradient-direction 'vertical)
+ (eq mxflat:gradient-direction 'diagonal)))
+ (setq backgroun 'renderer)
+ (setq backgroundd render-bg)))
+
+ (create-button-frame-part
+ ;; decide which frame part (and indirectly which keymap) to
+ ;; use
+ (if (check-symbol "mxflat:customize-" button-type "-keymap")
+ (get-symbol button-type "-button-custom")
+ (get-symbol button-type "-button"))
+ ;; button fg images/icons
+ (check-symbol "get-" button-type "-button")
+ edge
+ x-pos
+ y-pos
+ backgroun
+ backgroundd)))))
+
+;; create a list of button frame parts and return it
(define (create-buttons)
- ; create a list of all custom buttons if the button
- ; position model is not none (none means no buttons)
- (if (not (eq mxflat:button-position-model 'none))
- (list
- (create-button "menu" -1)
- (create-button "shade" -2)
- (create-button "iconify" +3)
- (create-button "maximize" +2)
- (create-button "close" +1)
- (create-button "sticky")
- (create-button "next")
- (create-button "previous")
- (create-button "configure")
- (create-button "info")
- (create-button "always-on-top")
- (create-button "lock")
- )
- )
-)
-
-; -------
+ ;; create a list of all custom buttons if the button
+ ;; position model is not none (none means no buttons)
+ (if (not (eq mxflat:button-position-model 'none))
+ (list
+ (create-button "menu" -1)
+ (create-button "shade" -2)
+ (create-button "iconify" +3)
+ (create-button "maximize" +2)
+ (create-button "close" +1)
+ (create-button "sticky")
+ (create-button "next")
+ (create-button "previous")
+ (create-button "configure")
+ (create-button "info")
+ (create-button "always-on-top")
+ (create-button "lock"))))
+
+;; -------
;;; CORNERS
-; -------
+;; -------
-;
+;;
;; corners:size
-;
+;;
(define (get-corner-width-adjustment w #!optional side)
- (if
- (or
- (and
- (window-maximized-vertically-p w)
- (or
- (eq side 'top)
- (eq side 'bottom)
- )
- )
- (and
- (window-maximized-horizontally-p w)
- (or
- (eq side 'left)
- (eq side 'right)
- )
- )
- )
- mxflat:corner-width-adjustment-maximized
- mxflat:corner-width-adjustment
- )
-)
+ (if (or (and (window-maximized-vertically-p w)
+ (or (eq side 'top)
+ (eq side 'bottom)))
+ (and (window-maximized-horizontally-p w)
+ (or (eq side 'left)
+ (eq side 'right))))
+ mxflat:corner-width-adjustment-maximized
+ mxflat:corner-width-adjustment))
(define (get-corner-width w #!optional frame-type side)
- (if
- (and
- (eq frame-type 'shaded)
- (> (get-corner-width-adjustment w side) (/ (get-title-height) 2))
- (eq mxflat:corner-direction 'inside)
- )
- (/ (1+ (get-title-height)) 2)
- (+
- (get-corner-width-adjustment w side)
- (get-border-width w side)
- )
- )
-)
+ (if (and (eq frame-type 'shaded)
+ (> (get-corner-width-adjustment w side)
+ (/ (get-title-height) 2))
+ (eq mxflat:corner-direction 'inside))
+ (/ (1+ (get-title-height)) 2)
+ (+ (get-corner-width-adjustment w side)
+ (get-border-width w side))))
(define (get-corner-length w #!optional frame-type)
- (if (= mxflat:corner-length-adjustment -1)
- 0
- (+
- (+
- (if (and
- (eq frame-type 'shaded)
- (> mxflat:corner-length-adjustment (/ (get-title-height) 2))
- )
- (/ (1+ (get-title-height)) 2)
- mxflat:corner-length-adjustment
- )
- (get-border-width w 'top)
- )
- (if (eq mxflat:corner-direction 'inside)
- 0
- (get-corner-width-adjustment w)
- )
- )
- )
-)
-
-;
+ (if (= mxflat:corner-length-adjustment -1)
+ 0
+ (+ (+ (if (and (eq frame-type 'shaded)
+ (> mxflat:corner-length-adjustment
+ (/ (get-title-height) 2)))
+ (/ (1+ (get-title-height)) 2)
+ mxflat:corner-length-adjustment)
+ (get-border-width w 'top))
+ (if (eq mxflat:corner-direction 'inside)
+ 0
+ (get-corner-width-adjustment w)))))
+
+;;
;; corners:position
-;
+;;
-; get top or bottom position
+;; get top or bottom position
(define (get-corner-1-pos w side part #!optional frame-type)
- (-
- (if (eq side 'bottom)
- (if (eq frame-type 'shaded)
- (+
- (if (eq part 'b)
- (+
- (- (get-corner-length w frame-type))
- (get-corner-width w frame-type side)
- )
- 0
- )
- (-
- (get-border-offset)
- mxflat:border-width-titlebar-contents
- )
- )
- (get-neg-border-width w side)
- )
- (if (eq frame-type 'transient)
- (get-neg-border-width w 'top)
- (get-neg-titlebar-height w)
- )
- )
- (if
- (and
- (eq frame-type 'shaded)
- (eq side 'bottom)
- )
- (if (eq mxflat:corner-direction 'inside)
- (get-corner-width-adjustment w side)
- 0
- )
- (if (eq mxflat:corner-direction 'inside)
- 0
- (get-corner-width-adjustment w side)
- )
- )
- )
-)
-
-; get left or right position
+ (- (if (eq side 'bottom)
+ (if (eq frame-type 'shaded)
+ (+ (if (eq part 'b)
+ (+ (- (get-corner-length w frame-type))
+ (get-corner-width w frame-type side))
+ 0)
+ (- (get-border-offset)
+ mxflat:border-width-titlebar-contents))
+ (get-neg-border-width w side))
+ (if (eq frame-type 'transient)
+ (get-neg-border-width w 'top)
+ (get-neg-titlebar-height w)))
+ (if (and (eq frame-type 'shaded)
+ (eq side 'bottom))
+ (if (eq mxflat:corner-direction 'inside)
+ (get-corner-width-adjustment w side)
+ 0)
+ (if (eq mxflat:corner-direction 'inside)
+ 0
+ (get-corner-width-adjustment w side)))))
+
+;; get left or right position
(define (get-corner-2-pos w side)
- (-
- (get-neg-border-width w side)
- (if (eq mxflat:corner-direction 'inside)
- 0
- (get-corner-width-adjustment w side)
- )
- )
-)
-
-;
+ (- (get-neg-border-width w side)
+ (if (eq mxflat:corner-direction 'inside)
+ 0
+ (get-corner-width-adjustment w side))))
+
+;;
;; corners:creation
-;
+;;
-; create the two corner lists a real corner consists of
+;; create the two corner lists a real corner consists of
(define (create-corner classs edgee1 side1 edgee2 side2 frame-type)
- `(
- (
- (class . ,classs)
- (background . ,get-border-color)
- (width . ,get-corner-length)
- (height . ,(lambda (w) (get-corner-width w frame-type side1)))
- (,edgee1 . ,(lambda (w) (get-corner-1-pos w side1 'a frame-type)))
- (,edgee2 . ,(lambda (w) (get-corner-2-pos w side2)))
- )
- (
- (class . ,classs)
- (background . ,get-border-color)
- (width . ,(lambda (w) (get-corner-width w frame-type side2)))
- (height . ,(lambda (w) (get-corner-length w frame-type)))
- (,edgee1 . ,(lambda (w) (get-corner-1-pos w side1 'b frame-type)))
- (,edgee2 . ,(lambda (w) (get-corner-2-pos w side2)))
- )
- )
-)
-; this function actually creates the 4 window corners and returns them
+ `(((class . ,classs)
+ (background . ,get-border-color)
+ (width . ,get-corner-length)
+ (height . ,(lambda (w) (get-corner-width w frame-type side1)))
+ (,edgee1 . ,(lambda (w) (get-corner-1-pos w side1 'a frame-type)))
+ (,edgee2 . ,(lambda (w) (get-corner-2-pos w side2))))
+ ((class . ,classs)
+ (background . ,get-border-color)
+ (width . ,(lambda (w) (get-corner-width w frame-type side2)))
+ (height . ,(lambda (w) (get-corner-length w frame-type)))
+ (,edgee1 . ,(lambda (w) (get-corner-1-pos w side1 'b frame-type)))
+ (,edgee2 . ,(lambda (w) (get-corner-2-pos w side2))))))
+
+;; this function actually creates the 4 window corners and returns
+;; them
(define (create-corners #!optional frame-type)
- (if mxflat:show-corners
- (let
- (
- (edgee1 'top-edge)
- (edgee2 'bottom-edge)
- )
- (if (eq frame-type 'shaded)
- (setq edgee2 'top-edge)
- )
- (append
- (create-corner 'top-left-corner edgee1 'top 'left-edge 'left frame-type)
- (create-corner 'top-right-corner edgee1 'top 'right-edge 'right frame-type)
- (create-corner 'bottom-left-corner edgee2 'bottom 'left-edge 'left frame-type)
- (create-corner 'bottom-right-corner edgee2 'bottom 'right-edge 'right frame-type)
- )
- )
- )
-)
-
-; --------------
+ (if mxflat:show-corners
+ (let ((edgee1 'top-edge)
+ (edgee2 'bottom-edge))
+ (if (eq frame-type 'shaded)
+ (setq edgee2 'top-edge))
+ (append
+ (create-corner 'top-left-corner edgee1 'top 'left-edge
+ 'left frame-type)
+ (create-corner 'top-right-corner edgee1 'top 'right-edge
+ 'right frame-type)
+ (create-corner 'bottom-left-corner edgee2 'bottom 'left-edge
+ 'left frame-type)
+ (create-corner 'bottom-right-corner edgee2 'bottom 'right-edge
+ 'right frame-type)))))
+
+;; --------------
;;; REGISTER THEME
-; --------------
-
-#|
-
-that is from the manual (http://sawmill.sourceforge.net/prog-manual.html)
-
-Frame Types
-
-default
- The normal frame type. Includes all decorations, both borders and the title bar.
- transient
- The frame for a transient window. This usually does not include a title bar,
- but does have all four borders.
-shaped
- Shaped windows are normally decorated with only a title-bar, since their boundary
- is not rectangular it makes no sense to surround them with a rectangular border.
-shaped-transient
- A combination of the shaped and transient types, normally just a very small title
- border with no text.
-shaded
- A shaded window (normally just the title bar).
-shaded-transient
- A shaded transient window.
-unframed
- No frame at all, just the client window itself. The predefined nil-frame variable
- contains a null frame that may be used for this frame type.
-
-"Normal" 'default
-"Title-only" 'shaped
-"Border-only" 'transient
-"Top-border" 'shaped-transient
-"None" 'unframed
-
-|#
-
-; return the window frame and decorations
+;; --------------
+;;
+;; that is from the manual
+;; (http://sawmill.sourceforge.net/prog-manual.html)
+;;
+;; Frame Types
+;;
+;; * default
+;; The normal frame type. Includes all decorations, both borders and
+;; the title bar.
+;;
+;; * transient
+;; The frame for a transient window. This usually does not include a
+;; title bar, but does have all four borders.
+;;
+;; * shaped
+;; Shaped windows are normally decorated with only a title-bar, since
+;; their boundary is not rectangular it makes no sense to surround
+;; them with a rectangular border.
+;;
+;; * shaped-transient
+;; A combination of the shaped and transient types, normally just a
+;; very small title border with no text.
+;;
+;; * shaded
+;; A shaded window (normally just the title bar).
+;;
+;; * shaded-transient
+;; A shaded transient window.
+;;
+;; * unframed
+;; No frame at all, just the client window itself. The predefined
+;; nil-frame variable contains a null frame that may be used for this
+;; frame type.
+;;
+;; "Normal" 'default
+;; "Title-only" 'shaped
+;; "Border-only" 'transient
+;; "Top-border" 'shaped-transient
+;; "None" 'unframed
+;;
+
+;; return the window frame and decorations
(define (get-frame w frame-type)
- (let*
- (
- ; window with all decorations
- (defaul (lambda ()
- (append (titlebar) (create-titlebar-contents-border)
- (create-borders w) (create-buttons) (create-corners))
- ))
-
- ; window with contents frame only
- (transien (lambda ()
- (append (create-borders w 'transient) (create-corners 'transient))
- ))
-
- (titleba (lambda (#!optional mode)
- (if mode
- (titlebar)
- (append (titlebar) (create-buttons))
- )
- ))
-
- ; window that is shaded
- (shade (lambda (#!optional titlebar-mode)
- (if mxflat:keep-borders-when-shaded
- (append (titleba titlebar-mode) (create-titlebar-contents-border)
- (create-borders w) (create-corners))
- (append (titleba titlebar-mode)
- (create-borders w 'shaded) (create-corners 'shaded))
- )
- ))
-
- (check (lambda (mode)
- (cond
- ((eq mxflat:decoration-mode 'none)
- (transien)
- )
- ((eq mxflat:decoration-mode 'all)
- (defaul)
- )
- (t
- (mode)
- )
- )
- ))
- )
-
- (case frame-type
- ((default)
- (check defaul)
- )
- ((transient)
- (check transien)
- )
- ((shaped shaded)
- (if (eq mxflat:decoration-mode 'none)
- (shade 'no-buttons)
- (shade)
- )
- )
- ((shaded-transient)
- (if (eq mxflat:decoration-mode 'all)
- (shade)
- (shade 'no-buttons)
- )
- )
- ((shaped-transient)
- (create-top-border)
- )
- )
- )
-)
-
-; setup initial colors
+ (let* (;; window with all decorations
+ (defaul (lambda ()
+ (append (titlebar)
+ (create-titlebar-contents-border)
+ (create-borders w)
+ (create-buttons)
+ (create-corners))))
+
+ ;; window with contents frame only
+ (transien (lambda ()
+ (append (create-borders w 'transient)
+ (create-corners 'transient))))
+
+ (titleba (lambda (#!optional mode)
+ (if mode
+ (titlebar)
+ (append (titlebar) (create-buttons)))))
+
+ ;; window that is shaded
+ (shade (lambda (#!optional titlebar-mode)
+ (if mxflat:keep-borders-when-shaded
+ (append (titleba titlebar-mode)
+ (create-titlebar-contents-border)
+ (create-borders w)
+ (create-corners))
+ (append (titleba titlebar-mode)
+ (create-borders w 'shaded)
+ (create-corners 'shaded)))))
+
+ (check (lambda (mode)
+ (cond
+ ((eq mxflat:decoration-mode 'none)
+ (transien))
+ ((eq mxflat:decoration-mode 'all)
+ (defaul))
+ (t
+ (mode))))))
+
+ (case frame-type
+ ((default)
+ (check defaul))
+ ((transient)
+ (check transien))
+ ((shaped shaded)
+ (if (eq mxflat:decoration-mode 'none)
+ (shade 'no-buttons)
+ (shade)))
+ ((shaded-transient)
+ (if (eq mxflat:decoration-mode 'all)
+ (shade)
+ (shade 'no-buttons)))
+ ((shaped-transient)
+ (create-top-border)))))
+
+;; setup initial colors
(recolor-all)
(after-set-title-update-interval)
-; register theme with sawfish
+;; register theme with sawfish
(add-frame-style 'mxflat get-frame)
;;; END
diff --git a/themes/simple/theme.jl b/themes/simple/theme.jl
index bbd5291..619731a 100644
--- a/themes/simple/theme.jl
+++ b/themes/simple/theme.jl
@@ -1,5 +1,4 @@
;; simple/theme.jl
-;; $Id: theme.jl,v 1.16 2000/08/14 14:23:08 john Exp $
;; Copyright (C) 1999 John Harper <john dcs warwick ac uk>
@@ -59,45 +58,45 @@
(top-edge . -21)
(height . 21)
(class . title))
-
+
((background . "black")
(left-edge . 0)
(right-edge . 0)
(top-edge . -22)
(height . 1))
-
+
((background . "black")
(left-edge . -1)
(width . 1)
(top-edge . -22)
(bottom-edge . -5))
-
+
((background . "black")
(right-edge . -1)
(width . 1)
(top-edge . -22)
(bottom-edge . -5)
(class . right-border))
-
+
((background . ,frame-colors)
(left-edge . 0)
(right-edge . 0)
(bottom-edge . -4)
(height . 4)
(class . bottom-border))
-
+
((background . "black")
(left-edge . 0)
(right-edge . 0)
(bottom-edge . -5)
(height . 1))
-
+
((background . ,minimize)
(left-edge . 4)
(top-edge . -18)
(class . iconify-button)
(removable . t))
-
+
((background . ,close)
(right-edge . 4)
(top-edge . -18)
@@ -114,7 +113,7 @@
(top-edge . -21)
(height . 21)
(class . title))
-
+
((background . "black")
(left-edge . 0)
(right-edge . 0)
@@ -126,14 +125,14 @@
(width . 1)
(top-edge . -22)
(height . 23))
-
+
((background . "black")
(right-edge . -1)
(width . 1)
(top-edge . -22)
(height . 23)
(class . right-border))
-
+
((background . "black")
(left-edge . 0)
(right-edge . 0)
@@ -145,7 +144,7 @@
(top-edge . -18)
(class . iconify-button)
(removable . t))
-
+
((background . ,close)
(right-edge . 4)
(top-edge . -18)
@@ -158,19 +157,19 @@
(top-edge . -4)
(height . 4)
(class . title))
-
+
((background . "black")
(left-edge . 0)
(right-edge . 0)
(top-edge . -5)
(height . 1))
-
+
((background . "black")
(left-edge . -1)
(width . 1)
(top-edge . -5)
(bottom-edge . -5))
-
+
((background . "black")
(right-edge . -1)
(width . 1)
@@ -184,7 +183,7 @@
(bottom-edge . -4)
(height . 4)
(class . bottom-border))
-
+
((background . "black")
(left-edge . 0)
(right-edge . 0)
@@ -197,26 +196,26 @@
(top-edge . -5)
(height . 4)
(class . title))
-
+
((background . "black")
(left-edge . 0)
(right-edge . 0)
(top-edge . -6)
(height . 1))
-
+
((background . "black")
(left-edge . -1)
(width . 1)
(top-edge . -6)
(height . 6))
-
+
((background . "black")
(right-edge . -1)
(width . 1)
(top-edge . -6)
(height . 6)
(class . right-border))
-
+
((background . "black")
(left-edge . 0)
(right-edge . 0)
diff --git a/themes/smaker/theme.jl b/themes/smaker/theme.jl
index c6116d4..47fe801 100644
--- a/themes/smaker/theme.jl
+++ b/themes/smaker/theme.jl
@@ -1,5 +1,4 @@
;; smaker/theme.jl -- somewhat windowmaker like theme, heavily customizable
-;; $Id: theme.jl,v 1.11 2000/06/28 15:53:06 john Exp $
;; Copyright (C) 1999 John Harper <john dcs warwick ac uk>
@@ -90,7 +89,7 @@
(make-image i)
(error))
(make-image (concat install-dir i)))))
-
+
(rebuild (lambda ()
(rebuild-frames-with-style 'smaker)))
[
Date Prev][
Date Next] [
Thread Prev][
Thread Next]
[
Thread Index]
[
Date Index]
[
Author Index]
