Re: [Patch] apps-menu

[Matthew Love <matth love gmail com>]

Christopher Roy Bratusek <zanghar freenet de> writes:

> perhaps there should be some tunable option like
>
> apps-menu-display-all
>
> t = ignore NoDisplay, Hidden, NotShowIn and OnlyShowIn
>
> maybe = ignore NoDisplay and Hidden, but respect NotShowIn and OnlyShowIn
>
> nil = respect NoDisplay, Hidden, NotShowIn and OnlyShowIn
>
> no?
>
> Chris
>

Along these same lines I was thinking we could have a tunable option like
'apps-menu-filter

which would have pre-defined filters 'default and 'maybe which would be
the same as 'nil and 'maybe above, respectively.

There would also be the option to make your own filter if you choose,
i.e.

(setq user-apps-menu-display-filter '(
      ('no-games ;; filter-name
        (var0 "Categories" "[Gg]ame") ;; (variable-name fdo-key regexp
      &optional t) -- the optional 't will filter out the record if the
      test is false, rather than the default of filtering out a record
      if the test it true.
	(var2 "NoDisplay" "[Tt]")
	(var3 "Hidden" "[Tt]"))
      ('xfce
        (var4 "OnlyShowIn" "xfce" t)
	(var5 "NoDisplay" "[Tt]")
	(var6 "Hidden" "[Tt]"))))

then

(setq apps-menu-filter 'no-games)

would use the filter 'no-games that was just defined.

This is the idea of the attached patch, let me know what you think.

diff --git a/lisp/sawfish/wm/ext/apps-menu.jl b/lisp/sawfish/wm/ext/apps-menu.jl
index 5dc7405..a7aea31 100644
--- a/lisp/sawfish/wm/ext/apps-menu.jl
+++ b/lisp/sawfish/wm/ext/apps-menu.jl
@@ -62,10 +62,23 @@ 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
+  (defvar apps-menu-filter 'default
     "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-default-display-filter 
+    '(
+      ('maybe 
+       (a "OnlyShowIn" desktop-environment t)
+       (b "NotShowIn" desktop-environment))
+      ('default
+       (c "OnlyShowIn" desktop-environment t)
+       (d "NotShowIn" desktop-environment)
+       (e "Hidden" "[Tt]")
+       (f "NoDisplay" "[Tt]"))))
+
+  (defvar user-apps-menu-display-filter '())
   
   (defvar desktop-directory '("/usr/share/applications")
     "List of directories to look for *.desktop files.")
@@ -333,49 +346,68 @@ exile it."
 	    (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)))
-
+  (define (filter-vars fv)
+    (when fv
+      (let ((this-var (caar fv))
+	    (this-key (cadar fv)))
+	(cons `(,this-var (assoc ,this-key fdo-list)) (filter-vars (cdr fv))))))
+  
+  (define (filter-list fv)
+    (when fv
+      (let ((this-filter (caar fv)))
+	(cons this-filter (filter-list (cdr fv))))))
+  
+  (define (var-list fv)
+    (when fv
+      (cons (pull-vars (cdar fv)) (var-list (cdr fv)))))
+    
+  (define (append-filters show-filters)
+    (when show-filters
+      (append (cdar show-filters) (append-filters (cdr show-filters)))))
+  
+  (define (pull-vars vl)
+    (when vl
+      (cons (caar vl)
+	    (pull-vars (cdr vl)))))
+  
+  (define (fdov->fdol fdov fdovs)
+    (when fdov
+      (cons
+       `(when (eq apps-menu-filter 
+		  ,(car fdov))
+	  ,(append '(progn) (fdovs->fdol (car fdovs))))
+       (fdov->fdol (cdr fdov) (cdr fdovs)))))
+  
+  (define (fdovs->fdol fdovs)
+    (when fdovs
+      (let ((this-value (car fdovs))
+	    (this-filter (append user-apps-menu-display-filter apps-menu-default-display-filter)))
+	(cons `(when ,this-value 
+		 ,(if (eq 't (cadddr (assoc this-value (append-filters this-filter))))
+		      `(if (not (string-match ,(caddr (assoc this-value (append-filters this-filter)))
+					      (string-downcase (cdr ,this-value))))
+			   (rplacd (assoc "apps-menu-display?" fdo-list)
+				   "false"))
+		    `(if (string-match ,(caddr (assoc this-value (append-filters this-filter)))
+				       (string-downcase (cdr ,this-value)))
+			 (rplacd (assoc "apps-menu-display?" fdo-list)
+				 "false"))))
+	      (fdovs->fdol (cdr fdovs))))))
+  
+  (define (fdof->fdol fdof)
+    (eval
+     `(when (desktop-file-p ,fdof)
+	(let ((fdo-list (fdo-check-exile (parse-desktop-file ,fdof))))
+	  (let
+	      ,(filter-vars (append-filters 
+			     (append user-apps-menu-display-filter apps-menu-default-display-filter)))
+	    (setq fdo-list (append fdo-list (cons (cons "apps-menu-display?" "true"))))
+	    ,(append '(progn) 
+		     (fdov->fdol (filter-list 
+				  (append user-apps-menu-display-filter apps-menu-default-display-filter)) 
+				 (var-list (append user-apps-menu-display-filter apps-menu-default-display-filter)))))
+	  fdo-list))))
+  
   ;; generate a sawfish menu entry from a .desktop file
   (define (generate-menu-entry fdo-list)
     "Generate a menu entry to run the program specified in the the
@@ -397,7 +429,7 @@ desktop file `desk-file'."
       (mapc (lambda (x)
 	      (setq local-menu
 		    (append local-menu
-			    (list (generate-menu-entry (desk-file->fdo-list x)))))) desk-files)
+			    (list (generate-menu-entry (fdof->fdol x)))))) desk-files)
       (if apps-menu-alphabetize
 	  (alphabetize-entries (fix-cats desktop-cat-alist))
 	(fix-cats desktop-cat-alist))))

-- 
mrl