Re: [Patch] apps-menu filtering



Christopher Roy Bratusek <zanghar freenet de> writes:

>> >
>> > from my .xsession-errors (ignore the line-numbers)
>> >
>> > 9468 Lisp backtrace:
>> > 9469 #12  string-match ...
>> > 9470 #11  string-split ...
>> > 9471 #10  split-desktop-entry ...
>> > 9472 #9   fdo-menu-entry ...
>> > 9473 #8   generate-apps-menu ...
>> > 9474 #7   update-apps-menu ...
>> > 9475 #6   run-byte-code ...
>> > 9476 #4   make-structure (() #<closure 19de8d8 @ user> #<closure 19de900 @ user> user)
>> > 9477 #2   load ...
>> > 9478 #1   run-byte-code ...
>> > 9479  
>> > 9480 error--> (bad-arg #<subr string-match> () 2)
>> >
>> > :/ Am I missing something?
>> >
>> > Using plain apps-menus without anything set or filtered.
>> >
>> > Chris
>> >
>> 
>> 
>> Hm, not that I know of, it seems to work fine here.  Just to make sure
>> you have the latest, here is the full apps-menu.jl, in case something
>> went funky with the patch. (it is also possible i sent a bad patch last
>> time, I was getting that error just before the last edits, so perhaps I
>> didn't save properly before making the patch.).
>> 
>
> There's a small diff between both, but it's still hapenning.
>
>

Ok, I think this patch should solve that.  I think the problem was a
'Categories entry that only had a single ';'.  This should fix it if
that was the case.
Patch to current git.

diff --git a/lisp/sawfish/wm/ext/apps-menu.jl b/lisp/sawfish/wm/ext/apps-menu.jl
index 5dc7405..9a23195 100644
--- a/lisp/sawfish/wm/ext/apps-menu.jl
+++ b/lisp/sawfish/wm/ext/apps-menu.jl
@@ -1,6 +1,6 @@
 ;; apps-menu.jl -- generate applications menu from *.desktop files
 
-;; (c) 2009 Matthew Love
+;; (c) 2009, 2010 Matthew Love
 
 ;; This file is part of sawfish.
 
@@ -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,15 @@
 
     (export generate-apps-menu
 	    init-apps-menu
-	    update-apps-menu)
+	    update-apps-menu
+	    parse-fdo-file
+	    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
@@ -50,10 +57,11 @@
 	  sawfish.wm.menus
 	  sawfish.wm.commands
 	  sawfish.wm.commands.launcher)
-
+  
   (define-structure-alias apps-menu sawfish.wm.ext.apps-menu)
 
   ;; User Options
+
   (defvar apps-menu-autogen t
     "If non-nil, `apps-menu' is automatically generated from `user-apps-menu'
 and *.desktop files. If you set `apps-menu', then it won't happen anyway.")
@@ -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.")
 
@@ -76,74 +90,131 @@ set this to non-nil.")
   (defvar apps-menu-lang nil
     "Language for applications menu, in string. Default is set from locale.")
 
+  ;; The Master Category List
+
+  (defvar desktop-cat-alist
+    '(("Desktop" . ("X-Desktop" "X-DesktopApplets" "X-DesktopCountry"
+		    "DesktopSettings" "GNOME" "KDE"
+		    "X-GNOME-PersonalSettings" "X-Xfce-Toplevel"))
+      ("Personal" . ("X-Personal" "X-PersonalUtility" "Calendar"
+		     "ContactManagement"))
+      ("Office" . ("Office" "WordProcessor" "Presentation" "X-Document"
+		   "TextEditor" "SpreadSheet" "Calculator" "X-Calculate"
+		   "Chart" "FlowChart" "Finance"))
+      ("Internet" . ("Telephony" "Network" "Dialup" "VideoConference"
+		     "RemoteAccess" "News" "HamRadio" "FileTransfer"
+		     "X-Internet" "P2P" "Email" "WebBrowser" "IRCClient"
+		     "Chat" "InstantMessaging" "Chat" "WebDevelopment"))
+      ("Games" . ("Game" "ActionGame" "AdventureGame" "ArcadeGame"
+		  "BoardGame" "Emulator" "BlocksGame" "CardGame" "KidsGame"
+		  "LogicGame" "RolePlaying" "Simulation"))
+      ("Graphics" . ("RasterGraphics" "VectorGraphics" "X-GraphicUtility"
+		     "2DGraphics" "3dGraphics" "3DGraphics" "Scanning"
+		     "OCR" "Photography" "Viewer" "Publishing" "Art"
+		     "ImageProcessing"))
+      ("Media" . ("AudioVideo" "Audio", "Video" "Midi" "Mixer" "Sequencer"
+		  "Tuner" "TV" "AudioVideoEditing" "Player" "Recorder"
+		  "DiscBurning" "Music"))
+      ("Science" . ("Science" "Astrology" "ArtificialIntelligence"
+		    "Astronomy" "Biology" "Chemistry" "ComputerScience"
+		    "DataVisualization" "Electricity" "Robotics" "Physics"
+		    "Math" "Education" "Geography"))
+      ("Development" . ("GUIDesigner" "IDE" "Profiling" "RevisionControl"
+			"ProjectManagement" "Translation" "GTK" "Java"
+			"Development" "Qt" "Documentation" "Editors"))
+      ("Utility" . ("X-SystemMemory" "Security" "Utility" "X-SetupEntry"
+		    "X-SetupUtility" "X-SystemMemory" "TextTools"
+		    "TelephonyTools" "Accessibility" "Clock" "ConsoleOnly"))
+      ("Filesystem" . ("X-FileSystemFind" "X-FileSystemUtility" "Archiving"
+		       "FileManager" "X-FileSystemMount" "Compression"))
+      ("System" . ("X-SystemSchedule" "System" "X-SystemMemory"
+		   "TerminalEmulator" "Dictionary" "Puppy" "Printing"
+		   "Monitor" "Security"))
+      ("Settings" . ("Settings" "HardwareSettings" "PackageManager"))
+      ("Other" . ("Application" "Applications"))
+      ("Exiles" . ("Exile"))))
+
   (define this-line nil)
-  (define local-menu)
   (define name-string "Name[")
 
-  ;; fdo-desktop-file-parsing
+  ;; fdo-file-parsing
 
-  (define (desktop-skip-line-p instring)
+  (define (fdo-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)
+	  (when (fdo-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)))
+  (define (fdo-group-p instring)
+    (eq (aref instring 0) ?\[))  
 
-  ;; Returns (group1 (key1 . value1) ... group2 (keyA . valueA) ...)
-  (define (parse-desktop-file-line infile)
+  (define (get-fdo-group instring)
+    (substring instring 1 (- (length instring) 2)))
+  
+  (define (parse-fdo-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))
+      (if (not (fdo-skip-line-p this-line))
 	  (cons
-	   (if (desktop-group-p this-line)
-	       (get-desktop-group this-line)
+	   (if (fdo-group-p this-line)
+	       (get-fdo-group this-line)
 	     (get-key-value-pair this-line))
-	   (parse-desktop-file-line infile))
-	(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-fdo-file-line infile))
+	(parse-fdo-file-line infile))))
+
+  (define (parse-fdo-file infile)
+    "Parse a `*.desktop' file and return an alist."
+    (when (desktop-file-p infile)
+      (let ((d-file (open-file infile 'read)))
+	(parse-fdo-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 +222,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)
@@ -179,101 +244,82 @@ set this to non-nil.")
 		(if mlang (simplify-mlang mlang 0)
 		  (loop (cdr lang-vars)))))))
 
-  ;; The Master Category List
+  ;; Functions for categories
 
-  (defvar desktop-cat-alist
-    '(("Desktop" . ("X-Desktop" "X-DesktopApplets" "X-DesktopCountry"
-		    "DesktopSettings" "GNOME" "KDE"
-		    "X-GNOME-PersonalSettings" "X-Xfce-Toplevel"))
-      ("Personal" . ("X-Personal" "X-PersonalUtility" "Calendar"
-		     "ContactManagement"))
-      ("Office" . ("Office" "WordProcessor" "Presentation" "X-Document"
-		   "TextEditor" "SpreadSheet" "Calculator" "X-Calculate"
-		   "Chart" "FlowChart" "Finance"))
-      ("Internet" . ("Telephony" "Network" "Dialup" "VideoConference"
-		     "RemoteAccess" "News" "HamRadio" "FileTransfer"
-		     "X-Internet" "P2P" "Email" "WebBrowser" "IRCClient"
-		     "Chat" "InstantMessaging" "Chat" "WebDevelopment"))
-      ("Games" . ("Game" "ActionGame" "AdventureGame" "ArcadeGame"
-		  "BoardGame" "Emulator" "BlocksGame" "CardGame" "KidsGame"
-		  "LogicGame" "RolePlaying" "Simulation"))
-      ("Graphics" . ("RasterGraphics" "VectorGraphics" "X-GraphicUtility"
-		     "2DGraphics" "3dGraphics" "3DGraphics" "Scanning"
-		     "OCR" "Photography" "Viewer" "Publishing" "Art"
-		     "ImageProcessing"))
-      ("Media" . ("AudioVideo" "Audio", "Video" "Midi" "Mixer" "Sequencer"
-		  "Tuner" "TV" "AudioVideoEditing" "Player" "Recorder"
-		  "DiscBurning" "Music"))
-      ("Science" . ("Science" "Astrology" "ArtificialIntelligence"
-		    "Astronomy" "Biology" "Chemistry" "ComputerScience"
-		    "DataVisualization" "Electricity" "Robotics" "Physics"
-		    "Math" "Education" "Geography"))
-      ("Development" . ("GUIDesigner" "IDE" "Profiling" "RevisionControl"
-			"ProjectManagement" "Translation" "GTK"
-			"Development" "Qt" "Documentation" "Editors"))
-      ("Utility" . ("X-SystemMemory" "Security" "Utility" "X-SetupEntry"
-		    "X-SetupUtility" "X-SystemMemory" "TextTools"
-		    "TelephonyTools" "Accessibility" "Clock" "ConsoleOnly"))
-      ("Filesystem" . ("X-FileSystemFind" "X-FileSystemUtility" "Archiving"
-		       "FileManager" "X-FileSystemMount" "Compression"))
-      ("System" . ("X-SystemSchedule" "System" "X-SystemMemory"
-		   "TerminalEmulator" "Dictionary" "Puppy" "Printing"
-		   "Monitor" "Security"))
-      ("Settings" . ("Settings" "HardwareSettings" "PackageManager"))
-      ("Exiles" . ("Exile"))))
+  (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, `desktop-cat-alist'.  Returns a modified desktop-file entry."
+    (when fdol
+      (let* ((these-categories 
+	     (delete "" (string-split ";" (cdr (assoc "Categories" fdol)))))
+	    (category-list '()))
+	(if (null these-categories)
+	    (setq these-categories '("Exile")))
+	(let loop ((this-category these-categories))
+	     (if (null this-category)
+		 (let ((cat-string (merge-list (remove-duplicates category-list) ";")))
+		   (rplacd (assoc "Categories" fdol)
+			   cat-string)
+		   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 (remove-duplicates (grab-category input x))))))
+	      cat-list)
+	out-menu)))
 
-  ;; 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))))
+  ;; 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))
 
-  ;; 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 (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)) 
@@ -289,30 +335,34 @@ desktop file."
 with caution, file may be corrupt.\n"))
 	  (exile-cmd
 	   (cons "Exec" "sawfish-client -c 'display-errors'\n")))
-      (setq fdo-list
-	    (append fdo-list (list exile-comment)))
+      ;; Set the fdo-Comment key, mentioning the exile.
+      (setq fdo-list (append fdo-list (list exile-comment)))
+      ;; Set the NoDisplay key to 'true'
       (if (assoc "NoDisplay" fdo-list)
 	  (rplacd (assoc "NoDisplay" fdo-list) "true")
-	(setq fdo-list (append fdo-list (cons (cons "NoDisplay"
-						    "true")))))
+	(setq fdo-list (append fdo-list (cons (cons "NoDisplay" "true")))))
+      ;; Set the Categories & Category keys to 'Exile'
+      (if (assoc "Categories" fdo-list)
+	  (rplacd (assoc "Categories" fdo-list) "Exile")
+	(setq fdo-list (append fdo-list (cons (cons "Categories" "Exile")))))
+      (if (assoc "Category" fdo-list)
+	  (rplacd (assoc "Category" fdo-list) "Exile")
+	(setq fdo-list (append fdo-list (cons (cons "Category" "Exile")))))
+      ;; Set the Exec key if it does not exist
       (when (not (assoc "Exec" fdo-list))
 	(setq fdo-list (append fdo-list (list exile-cmd))))
+      ;; Set the Name key if it does not exist
       (when (and (not (assoc "Name" fdo-list))
-		 (not (assoc (concat name-string apps-menu-lang "]")
-			     fdo-list)))
-	(setq fdo-list (append fdo-list (cons (cons "Name"
-						    "Unknown")))))
-      (if (assoc "Categories" fdo-list)
-	  (rplacd (assoc "Categories" fdo-list) "Exile")
-	(setq fdo-list (append fdo-list (cons (cons "Categories"
-						    "Exile")))))
+		 (not (assoc (concat name-string apps-menu-lang "]") fdo-list)))
+	(setq fdo-list (append fdo-list (cons (cons "Name" "Unknown")))))
       fdo-list))
-
+	    
   (define (fdo-check-exile fdo-list)
-    "If `fdo-list' doesn't have a Categories, Exec, or Name field
+    "If `fdo-list' doesn't have a Categories, Exec, or Name field,
 exile it."
     (when fdo-list
-      (if (or (not (assoc "Categories" fdo-list))
+      (if (or (and (not (assoc "Categories" fdo-list))
+		   (not (assoc "Category" fdo-list)))
 	      (not (assoc "Exec" fdo-list))
 	      (and (not (assoc "Name" fdo-list))
 		   (not (assoc (concat name-string
@@ -321,86 +371,179 @@ exile it."
 	  (fdo-exile fdo-list)
 	fdo-list)))
 
+  (define (fdo-double-check-category fdo-list)
+    "Make sure the Category key is present and correctly asigned."
+    (when fdo-list
+      (if (assoc "Category" fdo-list)
+	  (if (or (not (stringp (cdr (assoc "Category" fdo-list))))
+		  (equal "" (cdr (assoc "Category" fdo-list))))
+	      (rplacd (assoc "Category" fdo-list) "Exile"))
+	(append fdo-list (cons (cons "Category" "Exile")))))
+      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)
+    "If `apps-menu-associate-categories' is true, filter the
+desktop-entry through `apps-menu-associate-categories'."
+    (when fdol
+      (if apps-menu-associate-categories
+	  (associate-categories fdol)
+	fdol)))
+
+  (define (fdo-default-filter fdol)
+    "The default fdo-filter, combines the above."
+    (fdo-hidden-filter
+     (fdo-notshowin-filter
+      (fdo-onlyshowin-filter
+       (fdo-nodisplay-filter fdol)))))
+
+  (define (fdo-some-filter fdol)
+    "The 'some fdo-filter, will only respect
+the NotShowIn and OnlyShowIn keys."
+    (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."
+    (if (not display-test) fdol
+      (condition-case nil
+	  (let loop ((fdo-entry fdol))
+	       (when (consp fdo-entry)
+		 (cons
+		  ;; Check if entry is valid
+		  (fdo-double-check-category
+		   (fdo-check-exile
+		    ((cond 
+		      ;; default filter is chosen
+		      ((equal display-test 'default)
+		       fdo-default-filter)
+		      ;; some flter is chosen
+		      ((equal display-test 'some)
+		       fdo-some-filter)
+		      ;; user filter is chosen
+		      ((closurep display-test)
+		       display-test)
+		      (t `progn))
+		     (car fdo-entry))))
+		  (loop (cdr fdo-entry)))))
+	(error fdol))))
+
+  (define (split-desktop-entry fdol)
+    "Split a desktop entry into several entries, each containing one
+of the categories of the original."
+    (when fdol
+      (let ((new-fdol fdol))
+	(let loop ((categories
+		    (delete "" (string-split ";" (cdr (assoc "Categories" fdol))))))
+	     (when categories
+	       (append (list 
+			(append new-fdol (list (cons "Category" (car categories)))))
+		       (loop (cdr categories))))))))
+
+  ;; Sawfish-menu generation
+
+  (define (fdo-menu-entry fdol)
+    "Return menu-entry list from a fdo-list."
+    ;; Generate the menu-entry list
+    (generate-menu-entry
+      ;; Filter entry by pre-made or user function
+     (delete nil
+	     (fdo-filter-record
+	      ;; Split the desktop-entry by category
+	      (split-desktop-entry
+	       ;; Rename 'Categories' key based on category-list
+	       (fdo-associate-categories-filter
+		;; Check if entry is valid
+		(fdo-check-exile fdol)))
+	      apps-menu-filter))))
+
   (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 (car fdo-list)
+      (cons (list (cdr (assoc "Category" (car fdo-list)))
+		    (determine-desktop-name (car fdo-list))
+		    (determine-desktop-exec (car fdo-list)))
+	      (generate-menu-entry (cdr fdo-list)))))
 
   (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
+		       (fdo-menu-entry
+			(parse-fdo-file x)))))
+       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 +560,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


[Date Prev][Date Next]   [Thread Prev][Thread Next]   [Thread Index] [Date Index] [Author Index]