From 5c19cc5fb71169f984415761ab18c97249c0a5bc Mon Sep 17 00:00:00 2001
From: Krzysztof Drewniak <address@hidden>
Date: Fri, 6 May 2011 17:31:46 -0500
Subject: [PATCH 1/2] Added a contrib module that creates an "Applications" menu, and a Debian menu-method file to generate such entries
 Menu entry syntax:
 (:section "Foo/Bar" :title "Baz" :command "launch-foo")
 The menu-methods script should be copied to /etc/menu-methods and the file paths changed to reflect your setup.

---
 contrib/app-menu.lisp |   50 +++++++++++++++++++++++++++++++++++++++++++++++++
 debian/menu-method    |   21 ++++++++++++++++++++
 2 files changed, 71 insertions(+), 0 deletions(-)
 create mode 100644 contrib/app-menu.lisp
 create mode 100755 debian/menu-method

diff --git a/contrib/app-menu.lisp b/contrib/app-menu.lisp
new file mode 100644
index 0000000..d393d29
--- /dev/null
+++ b/contrib/app-menu.lisp
@@ -0,0 +1,50 @@
+(in-package :stumpwm)
+
+(export '(add-menu-item show-menu load-menu-file))
+
+(defvar *app-menu*  (make-hash-table :test #'equal) "Where the menu structure is held")
+
+(defun load-menu-file (file-name)
+  (with-open-file (file file-name)
+    (when (char= #\# (peek-char nil file)) (read-line file)) ;;Hack arund the "autogenerated file" comment
+    (loop for i = (read file nil nil nil)
+       while i collect (apply #'add-menu-item i))))
+
+(defun add-menu-item (&key section title command (strip 0))
+  ;; Please note: A section starting with a "/" needs a strip argument one higher than really needed
+  (let ((subpart nil)
+        (sections (nthcdr strip (cl-ppcre:split "/" section)))) ; strip off the tops of entries (if needed)
+    (let ((test (gethash (first sections) *app-menu*)))
+      (if test (setf subpart test)
+          (setf subpart
+                (setf (gethash (first sections) *app-menu*) (make-hash-table :test #'equal)))))
+    (pop sections)
+    (loop while sections do
+         (let ((test (gethash (first sections) subpart)))
+           (if test (setf subpart test)
+               (setf subpart
+                     (setf (gethash (first sections) subpart) (make-hash-table :test #'equal)))))
+         (pop sections))
+    (setf (gethash title subpart) command)))
+
+(defgeneric hash->alist (hash))
+
+(defmethod hash->alist (hash) hash)
+
+(defmethod hash->alist ((hash hash-table))
+  (loop for v being the hash-values in hash using (hash-key k) collect (cons (hash->alist k) (hash->alist v))))
+
+(defcommand show-menu () 
+  ()
+  (let* ((menu (hash->alist *app-menu*))
+         (current menu)
+         (parent nil))
+    (loop
+         (let ((choice (select-from-menu (current-screen) (append current (list (cons "Up a level" (first parent)))))))
+               (if (and choice (cdr choice)) ;;Can't "Go up from" the top level
+                   (progn
+                     (push current parent)
+                     (when (eql (cdr choice) (second parent)) (pop parent) (pop parent))
+                     (setf current (cdr choice))
+                     (when (stringp current) (run-shell-command current) (return)))
+                   (return))))))
diff --git a/debian/menu-method b/debian/menu-method
new file mode 100755
index 0000000..b2c7920
--- /dev/null
+++ b/debian/menu-method
@@ -0,0 +1,21 @@
+#!/usr/bin/install-menu
+#
+# Generates a stumpwm menu file
+# BE CERTAIN to chenge the pathnames as appropriate BEFORE using
+compat="menu-1"
+outputencoding="LOCALE"
+
+!include menu.h
+
+genmenu="stump.menu"
+rcfile="stump.menu"
+rootprefix="/home/krzys/src/stumpwm/"
+userprefix="src/stumpwm/contrib/"
+
+supported
+    x11=   "(:section \"" parent($section) "\" :title \"" title() "\" :command \"" esc($command, "\"")  "\" :strip 2)\n"
+    text=  "(:section \"" parent($section) "\" :title \""  title() "\" :command \"" esc(term(), "\"") "\" :strip 2)\n"
+endsupported
+
+startmenu= ""
+endmenu= ""
-- 
1.7.1