Hello, I have an updated version of apps-menu.jl which includes the entry filtering discussed a while back, which brings along with it more and better functionaliuty and configurability. Applications are now going to each of the categories mentioned in it's .desktop file, as requested by the freedesktop.org specifications. Top-Level categories, e.g. Gnome, KDE, GTK, Application, etc., are filtered out by default (included in the 'default and 'some filters (as most applications with these cateogories are included in other categories as well), but can be viewed by redefining the filters. Some other sub-categories were shifted around between the main categories, better reflecting the specifications and intended usage. The menu can also generate using only the sub-categories mentioned in the .desktop files by setting 'apps-menu-associate-categories to '(), which can be cluttered but interesting. Let me know what you all think. Cheers -- Matthew Love
Attachment:
apps-menu.jl
Description: apps-menu
3c3
< ;; (c) 2009 Matthew Love
---
> ;; (c) 2009 - 2011 Matthew Love
32d31
< ;; * Acquisition of the locale is wrong.
42c41,50
< update-apps-menu)
---
> update-apps-menu
> parse-fdo-file
> fdo-filter-record
> fdo-toplevel-filter
> fdo-nodisplay-filter
> fdo-hidden-filter
> fdo-onlyshowin-filter
> fdo-notshowin-filter
> fdo-default-filter
> fdo-some-filter)
53c61
<
---
>
56a65
>
65,69c74,85
< (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-toplevel-filter' `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")
>
78a95,136
> ;; The Master Category List
>
> (defvar desktop-cat-alist
> '(("Top-Level" . ("Application" "Applications" "GNOME" "KDE" "X-Xfce-Toplevel"
> "GTK" "Qt"))
> ("Desktop" . ("X-Desktop" "X-DesktopApplets" "X-DesktopCountry"))
> ("Office" . ("Office" "WordProcessor" "Presentation" "X-Document"
> "TextEditor" "SpreadSheet" "Calculator" "X-Calculate"
> "Chart" "FlowChart" "Finance" "Calendar" "ContactManagement"
> "X-Personal" "X-PersonalUtility" "Dictionary"))
> ("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"))
> ("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" "Simulation"))
> ("Development" . ("GUIDesigner" "IDE" "Profiling" "RevisionControl"
> "ProjectManagement" "Translation" "Java"
> "Development" "Documentation" "Editors"))
> ("Utility" . ("X-SystemMemory" "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" "Printing" "Monitor" "Security"))
> ("Settings" . ("Settings" "HardwareSettings" "PackageManager"
> "X-GNOME-PersonalSettings" "DesktopSettings"))
> ("Exiles" . ("Exile"))))
>
80c138
< (define local-menu)
---
>
83c141
< ;; fdo-desktop-file-parsing
---
> ;; fdo-file-parsing
85c143,144
< (define (desktop-skip-line-p instring)
---
> (define (fdo-skip-line-p instring)
> "Return `t' if `instring' should be skipped."
88c147
<
---
>
89a149
> "Check for the `[Desktop Entry]' line in `instream'"
94c154
< (when (desktop-skip-line-p line)
---
> (when (fdo-skip-line-p line)
96c156
<
---
>
97a158
> "Quickly check if `directory-file' is a `*.desktop' file."
103,107c164
<
< (define (desktop-group-p instring)
< (eq (aref instring 0) ?\[))
<
< ;; returns (key . value)
---
>
108a166,167
> "Split a `*.desktop' file line into it's key-value pair.
> Returns (key . value)"
115,116c174,175
< (define (get-desktop-group instring)
< (substring instring 1 (- (length instring) 2)))
---
> (define (fdo-group-p instring)
> (eq (aref instring 0) ?\[))
118,119c177,182
< ;; 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) ...)"
121c184
< (if (not (desktop-skip-line-p this-line))
---
> (if (not (fdo-skip-line-p this-line))
123,124c186,187
< (if (desktop-group-p this-line)
< (get-desktop-group this-line)
---
> (if (fdo-group-p this-line)
> (get-fdo-group this-line)
126,131c189,190
< (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)))
---
> (parse-fdo-file-line infile))
> (parse-fdo-file-line infile))))
133,135c192,202
< ;; generic functions
<
< (define (map-desk-files in-desk-files in-directory)
---
> (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."
137,140c204,212
< (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."
144,146c216,218
< (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))))
154,160d225
< ;; 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))
<
163,172c228,238
< ,(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)))
177,180c243,246
< (and lang-vars
< (let ((mlang (getenv (car lang-vars))))
< (if mlang (simplify-mlang mlang 0)
< (loop (cdr lang-vars)))))))
---
> (and lang-vars
> (let ((mlang (getenv (car lang-vars))))
> (if mlang (simplify-mlang mlang 0)
> (loop (cdr lang-vars)))))))
182,223c248
< ;; 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"
< "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"))))
---
> ;; Functions for categories
225,234c250,311
< ;; 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))))
---
> (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 '()))
> (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)))
236,273c313,318
< ;; 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))))
---
> ;; In fact, %% means "escaped %". Let's forget :/
> (define (trim-percent string)
> "Cut the string before % sign if present."
> (if (string-match "%" string)
> (substring string 0 (match-start))
> string))
275d319
< ;; Alphabetize the entries in the category menus
276a321
> "Alphabetize the entries in the category menus."
292,293c337,339
< (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'
296,297c342,350
< (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
299a353
> ;; Set the Name key if it does not exist
301,308c355,356
< (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")))))
310c358
<
---
>
312c360
< "If `fdo-list' doesn't have a Categories, Exec, or Name field
---
> "If `fdo-list' doesn't have a Categories, Exec, or Name field,
315c363,364
< (if (or (not (assoc "Categories" fdo-list))
---
> (if (or (and (not (assoc "Categories" fdo-list))
> (not (assoc "Category" fdo-list)))
323a373,393
> (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))))
>
326,331c396,404
< (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)))
> " &")))
336,377c409,528
< (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)))
---
> ;; 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 `fdo-associate-categories'."
> (when fdol
> (if apps-menu-associate-categories
> (associate-categories fdol)
> fdol)))
>
> (define (fdo-toplevel-filter fdol)
> "Return the desktop-file-list if the `Category' is of the
> Top-Level variety."
> (when fdol
> (if (not (equal "Top-Level" (cdr (assoc "Category" fdol))))
> fdol)))
>
> (define (fdo-default-filter fdol)
> "The default fdo-filter, combines the above."
> (fdo-toplevel-filter
> (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-toplevel-filter
> (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))))
379d529
< ;; generate a sawfish menu entry from a .desktop file
383,389c533,537
< (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)))))
395,400c543,551
< (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)
402,403c553,554
< (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<)))))
420c571
< )
---
> )
\ No newline at end of file