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 14:13:34 -0600
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]
