Re: [Patch] apps-menu filtering
- From: Matthew Love <matth love gmail com>
- To: sawfish-list gnome org
- Subject: Re: [Patch] apps-menu filtering
- Date: Sun, 12 Sep 2010 09:51:09 -0600
Matthew Love <matth love gmail com> writes:
> Christopher Roy Bratusek <zanghar freenet de> writes:
>
>> Sadly no.
>>
>> I've attached an tarball with all my .desktop files.
>>
>> Chris
>>
>
> Thanks, I think I found the problem. The new associate-categories would
> return nil if the the categories described in the desktop files did not
> associate, which led to a string-match error down the road (in a
> string-split call), the categories are now double-checked after being
> associated and will go to Exile if there is not a value in the desktop
> entry. Should work fine now in that respect.
>
> Cheers
Ok, I think this is a better patch for it, instead of double-checking
the results of associate-categories, it now will return the original
categories instead of nil, so it wont be exiled, it will just show up in
the menu under the category it has mentioned. This can of course be
filtered to go into any category one wishes.
diff --git a/lisp/sawfish/wm/ext/apps-menu.jl b/lisp/sawfish/wm/ext/apps-menu.jl
index 5dc7405..1df001b 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-setq 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,83 @@ 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) ";")))
+ (when cat-string
+ (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 +336,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 +372,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 +561,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]
