[sawfish: 2/6] Revert "removed old-window-menu"

[Christopher Bratusek <chrisb src gnome org>]

commit dd132bfa8cf234f299987fb5e73e704befa7a979
Author: Teika kazura <teika lavabit com>
Date:   Sat Sep 25 14:12:32 2010 +0900

    Revert "removed old-window-menu"
    
    This reverts commit cf79775eaacdadd8803a7f691e5101cd0a20f6b0.
    
    Conflicts:
    
    	ChangeLog
    	man/news.texi

 ChangeLog                              |    4 ++
 lisp/sawfish/wm/ext/old-window-menu.jl |   86 ++++++++++++++++++++++++++++++++
 2 files changed, 90 insertions(+), 0 deletions(-)
---
diff --git a/ChangeLog b/ChangeLog
index d744d7e..bb424cc 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,7 @@
+2010-09-25  Teika kazura <teika lavabit com>
+	* lisp/sawfish/wm/ext/old-window-menu.jl: Resurrected. It was
+	removed in commit cf79775e.
+
 2010-09-21  Christopher Bratusek <zanghar freenet de>
 	* lisp/sawfish/gtk/widgets/scheme-boolean.jl: fixed loading widget-dialog,
 	it's now in simple-dialog. Also change the behaviour a bit: Previously the
diff --git a/lisp/sawfish/wm/ext/old-window-menu.jl b/lisp/sawfish/wm/ext/old-window-menu.jl
new file mode 100644
index 0000000..8fdada3
--- /dev/null
+++ b/lisp/sawfish/wm/ext/old-window-menu.jl
@@ -0,0 +1,86 @@
+;; old-window-menu.jl
+
+;; 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.
+
+;; This is the "old" window menu. By default, beos-window-menu is used
+;; instead. But **DON'T** remove. There sure exist those who use it,
+;; according to a questionnaire.
+
+;; Usage: add (require 'sawfish.wm.ext.old-window-menu) in your rc file.
+
+(define-structure sawfish.wm.ext.old-window-menu
+
+    (export old-window-menu)
+
+    (open rep
+	  rep.util.utf8
+	  sawfish.wm.windows
+	  sawfish.wm.workspace
+	  sawfish.wm.misc
+	  sawfish.wm.menus
+	  sawfish.wm.util.display-window)
+
+  (define-structure-alias old-window-menu sawfish.wm.ext.old-window-menu)
+
+  (define (make-label w)
+    (let ((name (window-name w)))
+      (quote-menu-item (concat (and (window-get w 'iconified) ?\[)
+			       (if (> (utf8-string-length name) 20)
+				   (concat (utf8-substring name 0 20) "...")
+				 name)
+			       (and (window-get w 'iconified)  ?\])))))
+
+  (define (old-window-menu)
+    (let* ((limits (workspace-limits))
+	   (windows (managed-windows))
+	   menu)
+      (do ((i (car limits) (1+ i)))
+	  ((> i (cdr limits)))
+	(mapc (lambda (w)
+		(when (and (window-in-workspace-p w i)
+			   (window-mapped-p w)
+			   (not (window-get w 'window-list-skip))
+			   (or (not (window-get w 'ignored))
+			       (window-get w 'iconified)))
+		  (setq menu (cons (list (make-label w)
+					 (lambda ()
+					   (when (windowp w)
+					     (display-window w)))
+					 (cons 'check (eq (input-focus) w))
+					 '(group . old-window-menu))
+				   menu))))
+	      windows)
+	(unless (or (= i (cdr limits)) (null (car menu)))
+	  (setq menu (cons nil menu))))
+      ;; search for any iconified windows that aren't anywhere else in the menu
+      (let (extra)
+	(mapc (lambda (w)
+		(when (and (not (window-get w 'window-list-skip))
+			   (window-get w 'iconified)
+			   (window-get w 'sticky))
+		  (setq extra (cons (list (make-label w)
+					  `(display-window
+					    (get-window-by-id ,(window-id w))))
+				    extra))))
+	      windows)
+	(when extra
+	  (setq menu (if menu (nconc extra (list nil) menu) extra))))
+      (nreverse menu)))
+
+  (setq window-menu old-window-menu))