Re: [Patch] apps-menu filtering
- From: Matthew Love <matth love gmail com>
- To: sawfish-list gnome org
- Subject: Re: [Patch] apps-menu filtering
- Date: Sat, 11 Sep 2010 08:28:47 -0600
Christopher Roy Bratusek <zanghar freenet de> writes:
> Am Sat, 11 Sep 2010 10:12:56 +0900 (JST)
> schrieb Teika Kazura <teika lavabit com>:
>
>> Gents, feature freeze is planned c. on the 16th, so if this new hack
>> on apps-menu is going to be a bit of challenge, remember that it may
>> not be shipped in 1.7.0. Of course you can freely continue the
>> development, but please be clear in which release you like it to be.
>
> correct.
>
>> (I know Chris is alive, but don't ask me when he'll be back.)
>
> I'm already here. Doing some tests and other stuff currently.
>
> There are some things from PG (Proposed Goals) I would like to see in before FF (Feature
> Freeze). I'll take some time working on them...
>
>> Now Matthew, what's the meaning of the new option
>> `apps-menu-associate-categories'? I tried 'nil', but I don't notice
>> any change. (I have scarcely been following your discussion.)
>>
>> After it's almost settled, I'll ask some more question on filtering.
>
> I also didn't follow the discussion lately. Either way I'll test it and read the mails.
> I guess we'll win the award for the most flexible fdo-menu implementation.
>
> Regards,
> Chris
>
>> Thanks a lot,
>> Teika (Teika kazura)
>
Ok, Sounds good :)
The attached patch should be all but final, unless some of you find
bugs :) (and I will add some docs for it). Let me explain the changes a bit.
The user has more control now as to how the categories get assigned as
well as how the categories will be viewed in the final menu. This is
through the new filtering functionality.
The menu entry gets generated in the following order now:
parse-file -> check-exile -> associate-entries (can be skipped by setting
'apps-menu-associate-categories to nil) -> split-entry (based on
category) -> filter-entry (using default or user defined filter or none) ->
generate-menu-entry.
If 'apps-menu-associate-categories is set to nil (it is 't by default)
then none of the entries will be associated with the master category
list, which would result in the final menu being populated with the
various random categories as defined in the .desktop entries.
Honoring items such as 'NoDisplay' 'Hidden' 'OnlyShowIn' etc. are now
set up as 'filters'. The filter(s) used can be defined using
'apps-menu-filter which defaults to 'default. This can be set to a
pre-defined filter, a combination or pre-defined filters or a
user-function that takes as input a desktop entry list and returns
either a modified list or '(). This way users can do what ever they
want to an entry before it is transformed into a menu-entry, including
changing the category (which will change the category which will display
in the apps-menu).
The default filters include:
'fdo-nodisplay-filter
'fdo-hidden-filter
'fdo-onlyshowin-filter
'fdo-notshowin-filter
'fdo-default-filter or 'default (uses all of the above)
'fdo-some-filter or 'some (uses onlyshowin and notshowin)
Another recent change is that now the menu will be populated by all the
named categories from a .desktop entry, for example, the emacs entry
will now show up (when associated) in "Development" and "Office" or
(when un-associated) in "Development" and "TextEditor", rather
than just taking the first category found and using that.
Let me know if you have any questions/suggestions/etc.
Some examples:
To filter out all 'Games' entries:
(define (games-filter fdol)
(when fdol
(if (not (equal "Games" (cdr (assoc "Category" fdol))))
fdol)))
Change all entries in the 'Other' category to 'Exile' category:
(define (other-filter fdol)
(when fdol
(if (equal "Other" (cdr (assoc "Category" fdol)))
(rplacd (assoc "Category" fdol) "Exile"))
fdol))
Filter out all 'Exile' entries:
(define (exile-filter fdol)
(when fdol
(if (not (equal "Exile" (cdr (assoc "Category" fdol))))
fdol)))
Use all the above filters while generating the apps-menu (and include
the default-filter):
(setq apps-menu-filter (lambda (ent)
(exile-filter
(other-filter
(games-filter
(fdo-default-filter ent))))))
diff --git a/lisp/sawfish/wm/ext/apps-menu.jl b/lisp/sawfish/wm/ext/apps-menu.jl
index 5dc7405..b04cb41 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,80 @@ 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 '()))
+ (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 (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 +333,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 +369,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 +558,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]
