[sawfish: 9/13] Indent fix.
- From: Christopher Bratusek <chrisb src gnome org>
- To: commits-list gnome org
- Cc:
- Subject: [sawfish: 9/13] Indent fix.
- Date: Sat, 9 Oct 2010 13:38:53 +0000 (UTC)
commit 78216b96ea22f0551843594eec1355f25b30e536
Author: Teika kazura <teika lavabit com>
Date: Sat Oct 9 17:47:05 2010 +0900
Indent fix.
Let-loop and let-fluids are correctly indented, making them more readable.
lisp/sawfish/cfg/group.jl | 11 +-
lisp/sawfish/cfg/layouts/keymaps.jl | 39 +++--
lisp/sawfish/cfg/slot.jl | 45 +++---
lisp/sawfish/cfg/utils.jl | 13 +-
lisp/sawfish/cfg/widgets/command.jl | 6 +-
lisp/sawfish/cfg/widgets/match-window.jl | 38 ++--
lisp/sawfish/cfg/widgets/modifier-list.jl | 6 +-
lisp/sawfish/gtk/widget.jl | 38 ++--
lisp/sawfish/wm/commands.jl | 66 ++++----
lisp/sawfish/wm/custom.jl | 4 +-
lisp/sawfish/wm/ext/apps-menu.jl | 34 ++--
lisp/sawfish/wm/frames.jl | 34 ++--
lisp/sawfish/wm/menus.jl | 14 +-
lisp/sawfish/wm/misc.jl | 40 +++---
lisp/sawfish/wm/session/init.jl | 18 +-
lisp/sawfish/wm/stacking.jl | 264 ++++++++++++++--------------
lisp/sawfish/wm/state/transient.jl | 18 +-
lisp/sawfish/wm/state/wm-spec.jl | 112 ++++++------
lisp/sawfish/wm/tabs/tabgroup.jl | 32 ++--
lisp/sawfish/wm/user.jl | 14 +-
lisp/sawfish/wm/util/font.jl | 66 ++++----
lisp/sawfish/wm/util/keymap-diff.jl | 54 +++---
lisp/sawfish/wm/util/ping.jl | 18 +-
lisp/sawfish/wm/util/recolor-image.jl | 22 ++--
lisp/sawfish/wm/util/rects.jl | 14 +-
lisp/sawfish/wm/util/window-order.jl | 10 +-
lisp/sawfish/wm/util/workarea.jl | 24 ++--
lisp/sawfish/wm/windows.jl | 6 +-
28 files changed, 532 insertions(+), 528 deletions(-)
---
diff --git a/lisp/sawfish/cfg/group.jl b/lisp/sawfish/cfg/group.jl
index fcfcba6..a5f8978 100644
--- a/lisp/sawfish/cfg/group.jl
+++ b/lisp/sawfish/cfg/group.jl
@@ -253,8 +253,9 @@
;; return the union of lists X and Y, using `eq' for comparisons
(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))))))
+ (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))))))
diff --git a/lisp/sawfish/cfg/layouts/keymaps.jl b/lisp/sawfish/cfg/layouts/keymaps.jl
index 2822bd8..34ce6a9 100644
--- a/lisp/sawfish/cfg/layouts/keymaps.jl
+++ b/lisp/sawfish/cfg/layouts/keymaps.jl
@@ -55,25 +55,26 @@
(gtk-widget-relate-label omenu label-ptr)
(gtk-box-pack-start vbox hbox)
- (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))))
+ (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))))
(gtk-option-menu-set-menu omenu menu)
diff --git a/lisp/sawfish/cfg/slot.jl b/lisp/sawfish/cfg/slot.jl
index 0cc8691..15b75c1 100644
--- a/lisp/sawfish/cfg/slot.jl
+++ b/lisp/sawfish/cfg/slot.jl
@@ -122,31 +122,32 @@
;; 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))))))
+ (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))))))
;;; misc
diff --git a/lisp/sawfish/cfg/utils.jl b/lisp/sawfish/cfg/utils.jl
index a43fc7e..1a6f9e4 100644
--- a/lisp/sawfish/cfg/utils.jl
+++ b/lisp/sawfish/cfg/utils.jl
@@ -38,9 +38,10 @@
(_ name)))))
(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)))))))
+ (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)))))))
diff --git a/lisp/sawfish/cfg/widgets/command.jl b/lisp/sawfish/cfg/widgets/command.jl
index a9a147d..82b39b2 100644
--- a/lisp/sawfish/cfg/widgets/command.jl
+++ b/lisp/sawfish/cfg/widgets/command.jl
@@ -159,6 +159,6 @@
(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/match-window.jl b/lisp/sawfish/cfg/widgets/match-window.jl
index 0f9ddcc..cd3f614 100644
--- a/lisp/sawfish/cfg/widgets/match-window.jl
+++ b/lisp/sawfish/cfg/widgets/match-window.jl
@@ -95,19 +95,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)
@@ -166,12 +166,12 @@
(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)
diff --git a/lisp/sawfish/cfg/widgets/modifier-list.jl b/lisp/sawfish/cfg/widgets/modifier-list.jl
index bd6eeec..2ec27ba 100644
--- a/lisp/sawfish/cfg/widgets/modifier-list.jl
+++ b/lisp/sawfish/cfg/widgets/modifier-list.jl
@@ -48,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/gtk/widget.jl b/lisp/sawfish/gtk/widget.jl
index b85154a..d3e244b 100644
--- a/lisp/sawfish/gtk/widget.jl
+++ b/lisp/sawfish/gtk/widget.jl
@@ -145,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))
@@ -192,18 +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)
@@ -431,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)))
@@ -523,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/wm/commands.jl b/lisp/sawfish/wm/commands.jl
index 85ffef2..ec56d41 100644
--- a/lisp/sawfish/wm/commands.jl
+++ b/lisp/sawfish/wm/commands.jl
@@ -204,36 +204,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))))
@@ -340,9 +340,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."
diff --git a/lisp/sawfish/wm/custom.jl b/lisp/sawfish/wm/custom.jl
index 1182a01..e04994c 100644
--- a/lisp/sawfish/wm/custom.jl
+++ b/lisp/sawfish/wm/custom.jl
@@ -444,12 +444,12 @@ the user."
(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/ext/apps-menu.jl b/lisp/sawfish/wm/ext/apps-menu.jl
index 5dc7405..927419c 100644
--- a/lisp/sawfish/wm/ext/apps-menu.jl
+++ b/lisp/sawfish/wm/ext/apps-menu.jl
@@ -174,10 +174,10 @@ set this to non-nil.")
(define (find-lang-string)
(let loop ((lang-vars '("LC_ALL" "LC_MESSAGES" "LANG")))
- (and lang-vars
- (let ((mlang (getenv (car lang-vars))))
- (if mlang (simplify-mlang mlang 0)
- (loop (cdr lang-vars)))))))
+ (and lang-vars
+ (let ((mlang (getenv (car lang-vars))))
+ (if mlang (simplify-mlang mlang 0)
+ (loop (cdr lang-vars)))))))
;; The Master Category List
@@ -258,19 +258,19 @@ set this to non-nil.")
(define (determine-desktop-category line)
(let loop ((cat-list (string-split ";" line))
this-cat)
- (if (cdr cat-list)
- (progn
- (setq this-cat (car cat-list))
- (if (or
- (string= this-cat "GNOME")
- (string= this-cat "GTK")
- (string= this-cat "KDE")
- (string= this-cat "Qt")
- (string= this-cat "X-XFCE")
- (string= this-cat "Application"))
- (loop (cdr cat-list) nil)
- this-cat))
- (car cat-list))))
+ (if (cdr cat-list)
+ (progn
+ (setq this-cat (car cat-list))
+ (if (or
+ (string= this-cat "GNOME")
+ (string= this-cat "GTK")
+ (string= this-cat "KDE")
+ (string= this-cat "Qt")
+ (string= this-cat "X-XFCE")
+ (string= this-cat "Application"))
+ (loop (cdr cat-list) nil)
+ this-cat))
+ (car cat-list))))
;; Alphabetize the entries in the category menus
(define (alphabetize-entries saw-menu)
diff --git a/lisp/sawfish/wm/frames.jl b/lisp/sawfish/wm/frames.jl
index be4ff3e..fb0fa89 100644
--- a/lisp/sawfish/wm/frames.jl
+++ b/lisp/sawfish/wm/frames.jl
@@ -264,23 +264,23 @@ 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
diff --git a/lisp/sawfish/wm/menus.jl b/lisp/sawfish/wm/menus.jl
index a277229..8aba5cd 100644
--- a/lisp/sawfish/wm/menus.jl
+++ b/lisp/sawfish/wm/menus.jl
@@ -385,13 +385,13 @@ before killing it.")
(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)))))))
+ (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 129905b..aea9c24 100644
--- a/lisp/sawfish/wm/misc.jl
+++ b/lisp/sawfish/wm/misc.jl
@@ -48,15 +48,15 @@
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)
@@ -89,10 +89,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)
@@ -184,13 +184,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
diff --git a/lisp/sawfish/wm/session/init.jl b/lisp/sawfish/wm/session/init.jl
index 4d124ae..c594169 100644
--- a/lisp/sawfish/wm/session/init.jl
+++ b/lisp/sawfish/wm/session/init.jl
@@ -143,15 +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/stacking.jl b/lisp/sawfish/wm/stacking.jl
index a6a79b7..a8c09c8 100644
--- a/lisp/sawfish/wm/stacking.jl
+++ b/lisp/sawfish/wm/stacking.jl
@@ -90,22 +90,22 @@
(let ((w-depth (window-depth w)))
(setq parents (delete-if (lambda (x)
(> (window-depth x) w-depth)) parents))
- (setq children (delete-if (lambda (x)
- (< (window-depth x) w-depth)) children)))
+ (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))))))
- (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))))))))))
+ (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))))))
+ (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))))))))))
(define (stacking-constraint:transients-above-all w)
(let ((w-depth (window-depth w)))
@@ -115,27 +115,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
@@ -168,14 +168,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)',
@@ -186,9 +186,9 @@ the empty list."
nil
(let ((next (car cell)))
(rplaca cell (cdar cell))
- (rplacd next (cdr cell))
- (rplacd cell next)
- cell)))
+ (rplacd next (cdr cell))
+ (rplacd cell next)
+ cell)))
(define (stack-rotate-downwards cell)
"Given a cons cell containing two lists of windows `(ABOVE . BELOW)',
@@ -199,9 +199,9 @@ the empty list."
nil
(let ((next (cdr cell)))
(rplacd cell (cddr cell))
- (rplacd next (car cell))
- (rplaca cell next)
- cell)))
+ (rplacd next (car cell))
+ (rplaca cell next)
+ cell)))
(define (mapped-stacking-order)
(delete-if-not window-mapped-p (stacking-order)))
@@ -216,18 +216,18 @@ fully obscure WINDOW."
(define ws (nearest-workspace-with-window w current-workspace))
(let loop ((stack (stacking-order))
(obs nil))
- (if (null stack) ; Should not happen
- obs
- (let ((w2 (car stack)))
- (cond ((eq w2 w) obs)
- ((and (window-visible-p w2)
- (window-appears-in-workspace-p w2 ws))
- (case (apply rect-obscured
- (rectangles-from-windows (list w w2)))
- ((unobscured) (loop (cdr stack) obs))
- ((fully-obscured) t)
- (t (loop (cdr stack) (cons w2 obs))))) ; Partially
- (t (loop (cdr stack) obs)))))))
+ (if (null stack) ; Should not happen
+ obs
+ (let ((w2 (car stack)))
+ (cond ((eq w2 w) obs)
+ ((and (window-visible-p w2)
+ (window-appears-in-workspace-p w2 ws))
+ (case (apply rect-obscured
+ (rectangles-from-windows (list w w2)))
+ ((unobscured) (loop (cdr stack) obs))
+ ((fully-obscured) t)
+ (t (loop (cdr stack) (cons w2 obs))))) ; Partially
+ (t (loop (cdr stack) obs)))))))
(define (stacking-visibility window)
"Compute the visibility of WINDOW from the stacking order. This should
@@ -262,16 +262,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."
@@ -279,17 +279,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
@@ -298,18 +298,18 @@ BELOW as possible."
(stack (break-window-list
(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))))))
+ (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))))))
(define (stack-window-below below above)
"Change the stacking of window BELOW so that it is as closely below window
@@ -318,17 +318,17 @@ ABOVE as possible."
(stack (break-window-list
(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))))))
+ (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))))))
(define (restack-window w)
"Assuming that the current stacking order is in a consistent state
@@ -353,14 +353,14 @@ order they are stacked within the layer (top to bottom)."
"Set the stacking depth of window W to DEPTH."
(let ((old (window-depth w)))
(window-put w 'depth depth)
- (cond ((> old depth)
- ;; window's going downwards
- (raise-window w))
- ((< old depth)
- ;; window's going upwards
- (lower-window w)))
- (call-window-hook 'window-depth-change-hook w (list depth))
- (call-window-hook 'window-state-change-hook w (list '(stacking)))))
+ (cond ((> old depth)
+ ;; window's going downwards
+ (raise-window w))
+ ((< old depth)
+ ;; window's going upwards
+ (lower-window w)))
+ (call-window-hook 'window-depth-change-hook w (list depth))
+ (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
@@ -376,12 +376,12 @@ stacking order."
(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
@@ -433,20 +433,20 @@ lowest possible position. Otherwise raise it as far as 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)
@@ -455,28 +455,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/transient.jl b/lisp/sawfish/wm/state/transient.jl
index 3946e12..e1bb07a 100644
--- a/lisp/sawfish/wm/state/transient.jl
+++ b/lisp/sawfish/wm/state/transient.jl
@@ -73,15 +73,15 @@
"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 674cd9e..313f6b6 100644
--- a/lisp/sawfish/wm/state/wm-spec.jl
+++ b/lisp/sawfish/wm/state/wm-spec.jl
@@ -130,13 +130,13 @@
(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))
@@ -213,18 +213,18 @@
(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)
- (if (eq i current-workspace)
- (progn
- (aset view (* i 2) (* (car port) (screen-width)))
- (aset view (1+ (* i 2)) (* (cdr port)
- (screen-height))))
- (let ((vp-data (cdr (assoc i workspace-viewport-data))))
- (aset view (* i 2) (car vp-data))
- (aset view (1+ (* i 2)) (nth 1 vp-data))))
- (loop (1+ i))))))
+ (if (= i total-workspaces)
+ (set-x-property 'root '_NET_DESKTOP_VIEWPORT
+ view 'CARDINAL 32)
+ (if (eq i current-workspace)
+ (progn
+ (aset view (* i 2) (* (car port) (screen-width)))
+ (aset view (1+ (* i 2)) (* (cdr port)
+ (screen-height))))
+ (let ((vp-data (cdr (assoc i workspace-viewport-data))))
+ (aset view (* i 2) (car vp-data))
+ (aset view (1+ (* i 2)) (nth 1 vp-data))))
+ (loop (1+ i))))))
;; _NET_WORKAREA
(unless (equal last-workarea workarea)
@@ -246,9 +246,9 @@
(let ((area (calculate-workarea-from-struts
#:workspace (+ i (car limits)))))
(aset workarea (+ (* i 4) 0) (nth 0 area))
- (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)))))
+ (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
@@ -280,7 +280,7 @@
(call-state-fun w x 'get))
(setq state (cons x state))))
supported-states)
- (set-x-property w '_NET_WM_STATE (apply vector state) 'ATOM 32)))
+ (set-x-property w '_NET_WM_STATE (apply vector state) 'ATOM 32)))
;;; honouring the initially set window state hints
@@ -310,10 +310,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
@@ -500,27 +500,27 @@
(let ((mode (aref data 2)))
;; don't want grabs failing, sigh
(x-server-timestamp t t)
- (if (or (eq mode _NET_WM_MOVERESIZE_MOVE)
- (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)))))
- (resize-window-interactively w))))))
+ (if (or (eq mode _NET_WM_MOVERESIZE_MOVE)
+ (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)))))
+ (resize-window-interactively w))))))
((_NET_NUMBER_OF_DESKTOPS)
(set-number-of-workspaces (aref data 0)))
@@ -545,9 +545,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)
@@ -570,10 +570,10 @@
(eq atom1 '_NET_WM_STATE_MAXIMIZED_HORZ)))
(setq atom1 '_NET_WM_STATE_MAXIMIZED)
(setq atom2 nil))
- (when atom1
- (call-state-fun w atom1 mode))
- (when atom2
- (call-state-fun w atom2 mode)))))
+ (when atom1
+ (call-state-fun w atom1 mode))
+ (when atom2
+ (call-state-fun w atom2 mode)))))
((_NET_WM_DESKTOP)
(when (windowp w)
@@ -586,7 +586,7 @@
(send-window-to-workspace-from-first w desktop nil)))))
(t (setq handled nil)))
- handled))
+ handled))
;;; property changes
diff --git a/lisp/sawfish/wm/tabs/tabgroup.jl b/lisp/sawfish/wm/tabs/tabgroup.jl
index aab0dae..cf75a28 100644
--- a/lisp/sawfish/wm/tabs/tabgroup.jl
+++ b/lisp/sawfish/wm/tabs/tabgroup.jl
@@ -80,26 +80,26 @@
(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))
diff --git a/lisp/sawfish/wm/user.jl b/lisp/sawfish/wm/user.jl
index a4018d1..8407c91 100644
--- a/lisp/sawfish/wm/user.jl
+++ b/lisp/sawfish/wm/user.jl
@@ -136,13 +136,13 @@ Possible values are \"kde\", \"gnome\", \"xfce\", or \"none\".")
;; then the sawfish specific user configuration
(let loop ((rest rc-files))
- (when rest
- (if (file-exists-p (car rest))
- ;; Print stack trace on error during exeuction
- ;; of ~/.sawfish/rc
- (let ((%in-condition-case nil))
- (safe-load (car rest) t t t))
- (loop (cdr rest)))))))
+ (when rest
+ (if (file-exists-p (car rest))
+ ;; Print stack trace on error during exeuction
+ ;; of ~/.sawfish/rc
+ (let ((%in-condition-case nil))
+ (safe-load (car rest) t t t))
+ (loop (cdr rest)))))))
(error
(format (stderr-file) "error in local config--> %S\n" error-data))))
diff --git a/lisp/sawfish/wm/util/font.jl b/lisp/sawfish/wm/util/font.jl
index 5edb22a..6a09367 100644
--- a/lisp/sawfish/wm/util/font.jl
+++ b/lisp/sawfish/wm/util/font.jl
@@ -63,9 +63,9 @@
(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))))
@@ -107,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)))
@@ -203,23 +203,23 @@
(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))))))
+ (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
diff --git a/lisp/sawfish/wm/util/keymap-diff.jl b/lisp/sawfish/wm/util/keymap-diff.jl
index 15cbecf..00bcedf 100644
--- a/lisp/sawfish/wm/util/keymap-diff.jl
+++ b/lisp/sawfish/wm/util/keymap-diff.jl
@@ -40,33 +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)))
-
- ((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)))
-
- ((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 to list, so add it
- (loop from-rest (cdr to-rest)
- (cons (list '+ (car to-rest)) 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 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))
+
+ ((< (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))))))
(define (patch-keymap map diff)
"Returns a new copy of the keymap MAP, transformed following by the list
diff --git a/lisp/sawfish/wm/util/ping.jl b/lisp/sawfish/wm/util/ping.jl
index af25851..2bded3d 100644
--- a/lisp/sawfish/wm/util/ping.jl
+++ b/lisp/sawfish/wm/util/ping.jl
@@ -86,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/recolor-image.jl b/lisp/sawfish/wm/util/recolor-image.jl
index ed6b743..d04c455 100644
--- a/lisp/sawfish/wm/util/recolor-image.jl
+++ b/lisp/sawfish/wm/util/recolor-image.jl
@@ -75,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 89c1a60..aa70031 100644
--- a/lisp/sawfish/wm/util/rects.jl
+++ b/lisp/sawfish/wm/util/rects.jl
@@ -286,10 +286,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/window-order.jl b/lisp/sawfish/wm/util/window-order.jl
index 341d8d2..70d1a4d 100644
--- a/lisp/sawfish/wm/util/window-order.jl
+++ b/lisp/sawfish/wm/util/window-order.jl
@@ -87,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/workarea.jl b/lisp/sawfish/wm/util/workarea.jl
index 156f1af..71090bf 100644
--- a/lisp/sawfish/wm/util/workarea.jl
+++ b/lisp/sawfish/wm/util/workarea.jl
@@ -76,18 +76,18 @@
(- (cdr viewport)
(cdr cur-vp))))))
(let loop ((rest avoided))
- (cond ((null rest) (rect-within-head-p rect head))
- ((> (rect-2d-overlap
- (window-frame-dimensions (car rest))
- (let ((pos (window-position (car rest))))
- (if (window-get (car rest) 'sticky-viewport)
- (cons (+ (car pos) x-offset)
- (+ (cdr pos) y-offset))
- pos))
- rect)
- 0)
- nil)
- (t (loop (cdr rest)))))))
+ (cond ((null rest) (rect-within-head-p rect head))
+ ((> (rect-2d-overlap
+ (window-frame-dimensions (car rest))
+ (let ((pos (window-position (car rest))))
+ (if (window-get (car rest) 'sticky-viewport)
+ (cons (+ (car pos) x-offset)
+ (+ (cdr pos) y-offset))
+ pos))
+ rect)
+ 0)
+ nil)
+ (t (loop (cdr rest)))))))
(let* ((grid (grid-from-edges (car edges) (cdr edges)))
;; find all possible rectangles
diff --git a/lisp/sawfish/wm/windows.jl b/lisp/sawfish/wm/windows.jl
index 28d7120..0fb5c29 100644
--- a/lisp/sawfish/wm/windows.jl
+++ b/lisp/sawfish/wm/windows.jl
@@ -252,9 +252,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
[
Date Prev][
Date Next] [
Thread Prev][
Thread Next]
[
Thread Index]
[
Date Index]
[
Author Index]
