Re: [Patch] apps-menu filtering

[Matthew Love <matth love gmail com>]

Jeremy Hankins <nowan nowan org> writes:

> Matthew <matth love gmail com> writes:
>> On 8/31/2010 2:30 PM, Jeremy Hankins wrote:
>
>>> I was hoping to be able to play with the categories, but this doesn't
>>> work:
>>>
>>> (setq apps-menu-filter
>>>        (lambda (ent)
>>>          (when ent
>>>            (let ((cat (cdr (assoc "Categories" ent))))
>>>              (if (string-match "Utility" cat)
>>>                  (rplacd (assoc "Categories" ent) "utility")))
>>>            ent)))
>>>
>>> Rather than renaming the "Utility" category, this seems to dump
>>> everything in the "Utility" category into limbo -- i.e., those items no
>>> longer show up in the menu.  Looking closer at apps-menu.jl you're
>>> apparently doing some complicated stuff with categories, so this is
>>> probably the wrong way to go about changing a category name.  But
>>> dropping the entries is probably not the right thing to do.
>>
>> Ah, I misunderstood what you were requesting.  This will not change
>> the category name as it is shown in the apps-menu, but change the
>> category of given .desktop entries, I'll see what i can do to make the
>> category functions more accessible and easier to manipulate.
>
> It's not a big deal that I be able to rename categories -- though it'd
> be handy for me since I use the keyboard to navigate them.  But there
> should probably be a check for renamed categories (e.g., to exile them)
> or a big warning in the docs.
>
>>> In addition to moving emacs to the "System" category I noticed that
>>> "File Browser" (i.e., nautilus-browser) shows up there as well.  Without
>>> the above snippet it doesn't show up at all -- confirmed by searching
>>> the contents of apps-menu.  I don't know why -- there's no "Emacs" in
>>> the desktop file for nautilus-browser at all.  If I have a chance over
>>> the next few days I'll see if I can trouble-shoot more on this one.
>>
>> This likely occured because when you set apps-menu-filter it no longer
>> would filter out things like OnlyShowIn, which is probably why
>> nautilus-browser showed up all of a sudden when you set the
>> apps-menu-filter.
>
> Ah, of course.  That works much better.  ;)
>
>> to use the default filters along with your in a lambda, do something like:
>>
>> (setq apps-menu-filter
>>        (lambda (ent)
>>          (when ent
>>            (let ((name (cdr (assoc "Name" ent))))
>>              (if (string-match "Emacs" name)
>>                  (rplacd (assoc "Categories" ent) "System")))
>>            (fdo-hidden-filter (fdo-nodisplay-filter
>> (fdo-onlyshowin-filter (fdo-notshowin-filter ent)))))))
>>
>> Perhaps there is a better way to go about using the default filters
>> when one defines their own...
>
> Here's how I'd do it, just to avoid doing an extra string-match on
> entries that aren't going to be shown anyway:
>
> (setq apps-menu-filter
>       (lambda (ent)
>         (let ((ent (fdo-hidden-filter
>                     (fdo-nodisplay-filter
>                      (fdo-onlyshowin-filter
>                       (fdo-notshowin-filter ent))))))
>           (when ent
>             (if (string-match "Emacs" (cdr (assoc "Name" ent)))
>                 (rplacd (assoc "Categories" ent) "System")))
>           ent)))
>
> It might be nice if there were an fdo-std-filter or something that did
> all four filters, just for ease-of-use and readability.  That would
> eliminate three lines from the above, and would mean that if we change
> the standard filters user code could automatically get the benefit of
> the changes.
>
>>> I have to admit, I don't really understand what all is going on with the
>>> categories.  Desktop entries list several categories, not just one.
>>> `determine-desktop-category' seems to arbitrarily choose only one -- if
>>> there's no reason to choose one rather than another why not use them
>>> all?  It seems reasonable for, e.g., emacs to show up under both
>>> development and office.  Then the fix-cats and fix-sub-cats are (if I
>>> understand them right, and I'm not sure I do) consolidating the category
>>> structure according to desktop-cat-alist.  Is that right?
>>
>> Yes, that is basically right.  The choosing of categories is that it
>> will basically choose the first category it finds that is not
>> something like 'Application or 'KDE.  So it could definitely do this
>> better, and one of updates i'd like to make, per Chris' suggestion, is
>> to add support for sub-menus, which would then be more suited to take
>> advantage of the multiple categories in each entry.  And it would be
>> nice to be able to simply re-name menu-categories as well....
>
> Ah.  The category reorg could be done as a filter, I'd imagine.  Not
> sure if that's a good idea, though.
>
>> It could also easily use all the categories specified, making multiple
>> entries per application, if this is something people would like it
>> should be pretty easy to change things in this way.
>
> That would make sense to me, anyway.  Otherwise we find ourselves having
> to decide which of the categories the app provides is the "proper"
> category.

Ok, see attached patch (diff to current git).  
The way categories are sorted has changed.  There is a new variable
'apps-menu-associate-categories, which can be set to nil, which will use
the categories directly from the desktop file in the menu, which means 
one could change the categories as they like through filters.  

By default, the categories are associated with the 'master category list',
so one could still change the location of entries throughout those with
filters as well, though now it accepts multiple categories, and will
distribute the entry between all associated categories.

The default filters are combined in the filter 'fdo-default-filter
now so adding it in for users should be simpler now.  I was thinking as
well that perhaps it would be nice to do the default filters the way the
categories filter is now, by controlling them with a seperate variable
that can be turned on or off by setting it to 't or 'nil, so that users
wouldn't have to include them specifically in their filter functions.

I will add info to docs as well if this patch seems ok to everyone.

diff --git a/lisp/sawfish/wm/ext/apps-menu.jl b/lisp/sawfish/wm/ext/apps-menu.jl
index 5dc7405..51f3cf1 100644
--- a/lisp/sawfish/wm/ext/apps-menu.jl
+++ b/lisp/sawfish/wm/ext/apps-menu.jl
@@ -29,7 +29,6 @@
 ;; 'fdo' in some names stands for "freedesktop.org".
 
 ;;; Todo:
-;;  * Acquisition of the locale is wrong.
 
 ;;; Notes: we don't handle non-utf8 encoding.
 
@@ -39,7 +38,16 @@
 
     (export generate-apps-menu
 	    init-apps-menu
-	    update-apps-menu)
+	    update-apps-menu
+	    parse-desktop-file
+	    ;; filtering
+	    fdo-filter-record
+	    fdo-nodisplay-filter
+	    fdo-hidden-filter
+	    fdo-onlyshowin-filter
+	    fdo-notshowin-filter
+	    fdo-default-filter
+	    fdo-some-filter)
 
     (open rep
 	  rep.io.files
@@ -62,11 +70,17 @@ and *.desktop files. If you set `apps-menu', then it won't happen anyway.")
     "Your own applications menu entries. It is followed by auto generated
 applications menu.")
 
-  (defvar apps-menu-show-all nil
-    "Some entries are hidden from the menu, especially GNOME Apps like
-eog, nautilus or evince. If you want to have them added to your menu,
-set this to non-nil.")
-  
+  (defvar apps-menu-filter 'default
+    "The filter to use while generating the `apps-menu'. The default filters
+include `fdo-nodisplay-filter' `fdo-hidden-filter' `fdo-onlyshowin-filter'
+and `fdo-notshowin-filter'.  Can also be set with 'default or 'some, both
+of which are combinations of the default filters, 'default uses them all
+and 'some only uses `fdo-notshowin-filter' and `fdo-onlyshowin-filter'.
+This can be set to 'nil or '() to perform no filtering on the `apps-menu'.")
+
+  (defvar apps-menu-associate-categories t
+    "Associate desktop entry categories with the category-master-list")
+
   (defvar desktop-directory '("/usr/share/applications")
     "List of directories to look for *.desktop files.")
 
@@ -77,46 +91,50 @@ set this to non-nil.")
     "Language for applications menu, in string. Default is set from locale.")
 
   (define this-line nil)
-  (define local-menu)
   (define name-string "Name[")
 
   ;; fdo-desktop-file-parsing
 
   (define (desktop-skip-line-p instring)
+    "Return `t' if `instring' should be skipped."
     (or (eq (aref instring 0) ?#)
 	(eq (aref instring 0) ?\n)))
-
+  
   (define (check-if-desktop-stream instream)
+    "Check for the `[Desktop Entry]' line in `instream'"
     (let ((line (read-line instream)))
       (when line
 	(if (string= line "[Desktop Entry]\n")
 	    't
 	  (when (desktop-skip-line-p line)
 	    (check-if-desktop-stream instream))))))
-
+  
   (define (desktop-file-p directory-file)
+    "Quickly check if `directory-file' is a `*.desktop' file."
     (condition-case nil
 	(let ((this-file (open-file directory-file 'read)))
 	  (check-if-desktop-stream this-file))
       ;; unreadable -> return nil
       (file-error)))
-
+  
   (define (desktop-group-p instring)
     (eq (aref instring 0) ?\[))
-
-  ;; returns (key . value)
+  
   (define (get-key-value-pair instring)
+    "Split a `*.desktop' file line into it's key-value pair.
+Returns (key . value)"
     ;; Sorry, \\s doesn't work. Why??
     (if (string-match "^([^ \t=]+)[ \t]*=[ \t]*([^\n]+)" instring)
 	(cons (expand-last-match "\\1") (expand-last-match "\\2"))
       ;; Ususally, it doesn't reach here.
       (cons "" "")))
-
+  
   (define (get-desktop-group instring)
     (substring instring 1 (- (length instring) 2)))
-
-  ;; Returns (group1 (key1 . value1) ... group2 (keyA . valueA) ...)
+  
   (define (parse-desktop-file-line infile)
+    "Parse a `*.desktop' file line.
+Returns (group1 (key1 . value1) ... group2 (keyA . valueA) ...)"
     (when (setq this-line (read-line infile))
       (if (not (desktop-skip-line-p this-line))
 	  (cons
@@ -127,23 +145,32 @@ set this to non-nil.")
 	(parse-desktop-file-line infile))))
 
   (define (parse-desktop-file infile)
-    (let ((d-file (open-file infile 'read)))
-      (parse-desktop-file-line d-file)))
-
-  ;; generic functions
-
-  (define (map-desk-files in-desk-files in-directory)
+    "Parse a `*.desktop' file and return an alist."
+    (when (desktop-file-p infile)
+      (let ((d-file (open-file infile 'read)))
+	(parse-desktop-file-line d-file))))
+  
+  ;; desktop-file mapping
+  
+  (define (map-desk-files in-desk-files in-directory #!optional (extension "."))
+    "Given a list of filenames and a directory, will expand those
+filenames to include the full path."
     (when 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 (string-match extension (car in-desk-files))
+	  (cons (expand-file-name (car in-desk-files) in-directory)
+		(map-desk-files (cdr in-desk-files) in-directory extension))
+	(map-desk-files (cdr in-desk-files) in-directory extension))))
+  
+  (define (map-dir-files directories #!optional (extension "."))
+    "Given a list of directory paths, will return a list of
+files in those direcories with their full pathnames.  Optionally
+`extension' may be set to show only files that match the regexp."
     (when directories
       (if (file-directory-p (car directories))
 	  (let ((desk0 (directory-files (car directories))))
-	    (cons (map-desk-files desk0 (car directories))
-		  (map-dir-files (cdr directories))))
-	(map-dir-files (cdr directories)))))
+	    (cons (map-desk-files desk0 (car directories) extension)
+		  (map-dir-files (cdr directories) extension)))
+	(map-dir-files (cdr directories) extension))))
 
   (define (flatten input)
     (cond ((null input) nil)
@@ -151,25 +178,19 @@ set this to non-nil.")
 	  (t (append (flatten (car input))
 		     (flatten (cdr input))))))
 
-  ;; Cut the string before % sign if present.
-  ;; In fact, %% means "escaped %". Let's forget :/
-  (define (trim-percent string)
-    (if (string-match "%" string)
-	(substring string 0 (match-start))
-      string))
-
   (defmacro simplify-mlang (mlang mlevel)
     `(and
-      ,(if (or (= 0 mlevel) (not mlevel))
-	   `(or (string-looking-at "([a-z]*)(_?)([A-Z]*?)(@)([A-Z]*[a-z]*)?" ,mlang)
-		(string-looking-at "([a-z]*)(_..)|([a-z]*)?" ,mlang)
-		(string-looking-at "([a-z]*)?" ,mlang))
-	 (if (= 1 mlevel)
-	     `(string-looking-at "([a-z]*)(_?)([A-Z]*?)(@)([A-Z]*[a-z]*)?" ,mlang)
-	   (if (= 2 mlevel)
-	       `(string-looking-at "([a-z]*)(_..)|([a-z]*)?" ,mlang)
-	     (if (= 3 mlevel)
-		 `(string-looking-at "([a-z]*)?" ,mlang)))))
+      ,(cond 
+	((or (= 0 mlevel) (not mlevel))
+	 `(or (string-looking-at "([a-z]*)(_?)([A-Z]*?)(@)([A-Z]*[a-z]*)?" ,mlang)
+	      (string-looking-at "([a-z]*)(_..)|([a-z]*)?" ,mlang)
+	      (string-looking-at "([a-z]*)?" ,mlang)))
+	((= 1 mlevel)
+	 `(string-looking-at "([a-z]*)(_?)([A-Z]*?)(@)([A-Z]*[a-z]*)?" ,mlang))
+	((= 2 mlevel)
+	 `(string-looking-at "([a-z]*)(_..)|([a-z]*)?" ,mlang))
+	((= 3 mlevel)
+	 `(string-looking-at "([a-z]*)?" ,mlang)))
       (expand-last-match "\&")))
 
   (define (find-lang-string)
@@ -222,58 +243,80 @@ set this to non-nil.")
       ("Settings" . ("Settings" "HardwareSettings" "PackageManager"))
       ("Exiles" . ("Exile"))))
 
-  ;; Get the correct Name entry based on language settings
-  (define (determine-desktop-name fdo-list)
-    (or (when apps-menu-lang
-	  (let ((mlang-1 (concat name-string (simplify-mlang apps-menu-lang 1) "]"))
-		(mlang-2 (concat name-string (simplify-mlang apps-menu-lang 2) "]"))
-		(mlang-3 (concat name-string (simplify-mlang apps-menu-lang 3) "]")))
-	    (or (cdr (assoc mlang-1 fdo-list))
-		(cdr (assoc mlang-2 fdo-list))
-		(cdr (assoc mlang-3 fdo-list)))))
-	(cdr (assoc "Name" fdo-list))))
-
   ;; Functions for categories
-  (define (fix-sub-cats cat-list loc-list)
-    (when cat-list
-      (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 (cdr cat-list) loc-list)))))
-
-  ;; Associate values from the Master Category list with sub-categories
-  ;; from file
-  (define (fix-cats cat-list)
-    (when cat-list
-      (let ((cat-val (car (car cat-list)))
-	    (c-list (fix-sub-cats (car cat-list) local-menu)))
-	(if (car c-list)
-	    (cons (cons cat-val c-list) (fix-cats (cdr cat-list)))
-	  (fix-cats (cdr cat-list))))))
-
-  ;; Determine the best :| category to use. This will further be
-  ;; converted with fix-cats.
-  (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))))
-
-  ;; Alphabetize the entries in the category menus
+
+  (define (remove-duplicates input)
+    "Remove duplicate entries from `input'"
+    (do ((a '() (if (member (car input) a) a (cons (car input) a)))
+	 (input input (cdr input)))
+	((null input) (reverse a))))
+
+  (define (merge-list input delimiter)
+    "Merge a cons list `input' into a string separated by `delimiter'"
+    (when input
+      (concat (car input) delimiter 
+	      (merge-list (cdr input) delimiter))))
+
+  (define (associate-categories fdol)
+    "Associate the `Categories' value(s) with the category 
+master list.  Returns a modified desktop-file entry."
+    (when fdol
+      (let ((these-categories 
+	     (string-split ";" (cdr (assoc "Categories" fdol))))
+	    (category-list '()))
+	(let loop ((this-category these-categories))
+	     (if (null this-category)
+		 (progn (rplacd (assoc "Categories" fdol)
+				(merge-list (remove-duplicates category-list) ";"))
+			fdol)
+	       (progn (mapc (lambda (ent)
+			      (if (member (car this-category) ent)
+				  (setq category-list 
+					(append category-list (list (car ent))))))
+			    desktop-cat-alist)
+		      (loop (cdr this-category))))))))
+
+  (define (grab-category input cat)
+    "Remove duplicate categories from a generated apps-menu list by 
+category name."
+    (when input
+      (let ((cat-list '()))
+	(setq cat-list (append cat-list (list cat)))
+	(let loop ((this-line input))
+	     (if (not this-line) cat-list
+	       (progn (if (string= (caar this-line) cat)
+			  (setq cat-list (append cat-list (list (cdr (car this-line))))))
+		      (loop (cdr this-line))))))))
+
+
+  (define (make-category-list input)
+    "Return a list of the categories to be used in the menu."
+    (when input
+      (cons (caar input)
+	    (make-category-list (cdr input)))))
+  
+  (define (consolodate-menu input)
+    "Reduce the menu down so that each menu entry is inside a 
+single category."
+    (when input
+      (let ((cat-list (remove-duplicates (make-category-list input)))
+	    (out-menu nil))
+	(mapc (lambda (x)
+		(setq out-menu 
+		      (append out-menu
+			      (list (grab-category input x)))))
+	      cat-list)
+	out-menu)))
+
+  ;; In fact, %% means "escaped %". Let's forget :/
+  (define (trim-percent string)
+    "Cut the string begore % sign if present."
+    (if (string-match "%" string)
+	(substring string 0 (match-start))
+      string))
+
   (define (alphabetize-entries saw-menu)
+    "Alphabetize the entries in the category menus."
     (if saw-menu
 	(cons (cons (car (car saw-menu))
 		    (sort (cdr (car saw-menu)) 
@@ -321,86 +364,144 @@ exile it."
 	  (fdo-exile fdo-list)
 	fdo-list)))
 
+  (define (determine-desktop-name fdo-list)
+    "Get the correct Name[*] entry based on language settings."
+    (or (when apps-menu-lang
+	  (let ((mlang-1 (concat name-string (simplify-mlang apps-menu-lang 1) "]"))
+		(mlang-2 (concat name-string (simplify-mlang apps-menu-lang 2) "]"))
+		(mlang-3 (concat name-string (simplify-mlang apps-menu-lang 3) "]")))
+	    (or (cdr (assoc mlang-1 fdo-list))
+		(cdr (assoc mlang-2 fdo-list))
+		(cdr (assoc mlang-3 fdo-list)))))
+	(cdr (assoc "Name" fdo-list))))
+
   (define (determine-desktop-exec fdo-list)
     "Determine the correct `(system exec)' function from the given fdo alist"
-    (if (string= (cdr (assoc "Terminal" fdo-list))
-		 "true")
-	(list 'system
-	      (concat xterm-program " -e "
-		      (trim-percent (cdr (assoc "Exec" fdo-list)))
-		      " &"))
+    (if (assoc "Terminal" fdo-list)
+	(if (string-match "[Tt]" (cdr (assoc "Terminal" fdo-list)))
+	    (list 'system
+		  (concat xterm-program " -e "
+			  (trim-percent (cdr (assoc "Exec" fdo-list)))
+			  " &"))
+	  (list 'system
+		(concat (trim-percent (cdr (assoc "Exec" fdo-list)))
+			" &")))
       (list 'system
 	    (concat (trim-percent (cdr (assoc "Exec" fdo-list)))
 		    " &"))))
 
-  (define (desk-file->fdo-list desk-file)
-    (when (desktop-file-p desk-file)
-       (let ((fdo-list (fdo-check-exile (parse-desktop-file desk-file))))
-	 (let ((a (assoc "NoDisplay" fdo-list))
-	       (b (assoc "OnlyShowIn" fdo-list))
-	       (c (assoc "NotShowIn" fdo-list))
-	       (d (assoc "Hidden" fdo-list)))
-	   ;; 't
-	   (setq fdo-list (append fdo-list (cons (cons "apps-menu-display?" "true"))))
-	   ;; 'maybe
-	   (when (eq apps-menu-show-all 'maybe)
-	     (when b
-	       (if (string-match (concat (quote-regexp desktop-environment) "*")
-				 (string-downcase (cdr b)))
-		   (rplacd (assoc "apps-menu-display?" fdo-list) "true")
-		 (rplacd (assoc "apps-menu-display?" fdo-list) "false")))
-	     (when c
-	       (if (string-match (concat (quote-regexp desktop-environment) "*")
-				 (string-downcase (cdr c)))
-		   (rplacd (assoc "apps-menu-display?" fdo-list) "false")
-		 (rplacd (assoc "apps-menu-display?" fdo-list) "true"))))
-	   ;; 'nil
-	   (when (or (eq apps-menu-show-all 'nil) (not apps-menu-show-all))
-	     (when a
-	       (if (string-match "[Ff]" (cdr a))
-		   (rplacd (assoc "apps-menu-display?" fdo-list) "true")
-		 (rplacd (assoc "apps-menu-display?" fdo-list) "false")))
-	     (when d
-	       (if (string-match "[Ff]" (cdr d))
-		   (rplacd (assoc "apps-menu-display?" fdo-list) "true")
-		 (rplacd (assoc "apps-menu-display?" fdo-list) "false")))
-	     (when b
-	       (if (string-match (concat (quote-regexp desktop-environment) "*")
-				 (string-downcase (cdr b)))
-		   (rplacd (assoc "apps-menu-display?" fdo-list) "true")
-		 (rplacd (assoc "apps-menu-display?" fdo-list) "false")))
-	     (when c
-	       (if (string-match (concat (quote-regexp desktop-environment) "*")
-				 (string-downcase (cdr c)))
-		   (rplacd (assoc "apps-menu-display?" fdo-list) "false")
-		 (rplacd (assoc "apps-menu-display?" fdo-list) "true")))))
-	   fdo-list)))
-
-  ;; generate a sawfish menu entry from a .desktop file
+  ;; Apps-Menu Filtering
+
+  (define (fdo-nodisplay-filter fdol)
+    "Return the desktop-file-list if NoDisplay is False, or if NoDisplay is
+not present in the desktop-file-list"
+    (if (assoc "NoDisplay" fdol)
+	(if (string-match "[Ff]" (cdr (assoc "NoDisplay" fdol)))
+	    fdol)
+      fdol))
+  
+  (define (fdo-hidden-filter fdol)
+    "Return the desktop-file-list if Hidden is False, or if Hidden is
+not present in the desktop-file-list"
+    (if (assoc "Hidden" fdol)
+	(if (string-match "[Ff]" (string-downcase (cdr (assoc "OnlyShowIn" fdol))))
+	    fdol)
+      fdol))
+
+  (define (fdo-onlyshowin-filter fdol)
+    "Return the desktop-file-list if OnlyShowIn matches `desktop-environment', 
+or if OnlyShowIn is not present in the desktop-file-list"
+    (if (assoc "OnlyShowIn" fdol)
+	(if (string-match desktop-environment (string-downcase (cdr (assoc "OnlyShowIn" fdol))))
+	    fdol)
+      fdol))
+
+  (define (fdo-notshowin-filter fdol)
+    "Return the desktop-file-list if NotShowIn does not match `desktop-environment', 
+or if NotShowIn is not present in the desktop-file-list"
+    (if (assoc "NotShowIn" fdol)
+	(if (not (string-match desktop-environment (string-downcase (cdr (assoc "NotShowIn" fdol)))))
+	    fdol)
+      fdol))
+
+  (define (fdo-associate-categories-filter fdol)
+    (when fdol
+      (if apps-menu-associate-categories
+	  (associate-categories fdol)
+	fdol)))
+
+  (define (fdo-default-filter fdol)
+    (fdo-hidden-filter
+     (fdo-notshowin-filter
+      (fdo-onlyshowin-filter
+       (fdo-nodisplay-filter fdol)))))
+
+  (define (fdo-some-filter fdol)
+    (fdo-notshowin-filter
+     (fdo-onlyshowin-filter fdol)))
+
+  (define (fdo-filter-record fdol display-test)
+    "Return the result of `display-test' which can be a pre-set filter,
+such as `default' or `some' or it can be a pre-defined function of
+your choosing, which should either return the desktop-file-list or '(). 
+If `display-test' is not defined, will return the input desktop-file-list."
+    (cond 
+     ;; default filter is chosen
+     ((eq display-test 'default)
+      (fdo-default-filter fdol))
+     ;; some flter is chosen
+     ((eq display-test 'some)
+      (fdo-some-filter fdol))
+     ;; user filter is chosen
+     ((functionp display-test)
+      (condition-case nil
+	  (display-test fdol)
+	(error fdol)))
+     ((not display-test)
+      fdol)
+     (t
+      fdol)))
+
+  ;; Sawfish-menu generation
+
   (define (generate-menu-entry fdo-list)
     "Generate a menu entry to run the program specified in the the
 desktop file `desk-file'."
-    (when (and fdo-list
-	       (string= (cdr (assoc "apps-menu-display?" fdo-list)) "true"))
-      (list
-       (determine-desktop-category
-	(cdr (assoc "Categories" fdo-list)))
-       (determine-desktop-name fdo-list)
-       (determine-desktop-exec fdo-list))))
+    (when fdo-list
+      (let ((this-entry '())
+	    (this-exec (determine-desktop-exec fdo-list))
+	    (this-name (determine-desktop-name fdo-list))
+	    (these-categories (string-split ";" (cdr (assoc "Categories" fdo-list)))))
+	(let loop ((this-category these-categories))
+	     (if (not (cdr this-category)) this-entry
+	       (progn (setq this-entry 
+			    (append this-entry 
+				    (list (list (car this-category)
+						this-name
+						this-exec))))
+		      (loop (cdr this-category))))))))
+
 
   (define (generate-apps-menu)
     "Returns the list of applications menu which can be used for `apps-menu'."
     (unless apps-menu-lang
       (setq apps-menu-lang (find-lang-string)))
-    (setq local-menu nil)
-    (let ((desk-files (flatten (map-dir-files desktop-directory))))
-      (mapc (lambda (x)
-	      (setq local-menu
-		    (append local-menu
-			    (list (generate-menu-entry (desk-file->fdo-list x)))))) desk-files)
+    (let ((desk-files (flatten (map-dir-files desktop-directory ".desktop")))
+	  (local-menu nil))
+      (mapc 
+       (lambda (x)
+	 (setq local-menu
+	       (append local-menu
+		       (generate-menu-entry
+			(fdo-associate-categories-filter
+			 (fdo-filter-record
+			  (fdo-check-exile 
+			   (parse-desktop-file x))
+			  apps-menu-filter))))))
+       desk-files)
       (if apps-menu-alphabetize
-	  (alphabetize-entries (fix-cats desktop-cat-alist))
-	(fix-cats desktop-cat-alist))))
+	  (alphabetize-entries (consolodate-menu (sort (delete nil local-menu) string<)))
+	(consolodate-menu (sort (delete nil local-menu) string<)))))
 
   (define (init-apps-menu)
     "If `apps-menu' is nil, then call `update-apps-menu'. This function
@@ -417,4 +518,4 @@ append the auto generated one."
       (setq apps-menu user-apps-menu)))
 
   (define-command 'update-apps-menu update-apps-menu)
-  )
+  )
\ No newline at end of file

-- 
mrl