> v0.5.8: > > - added support for Name[LC]= [with fallback to Name=], the desired > language can be set in your .sawfishrc, using the desired string code > without the '[' and ']', with (setq my-lang-string "xx") > > Not sure about the alphabatizing, as string-lessp with sort doesn't seem > to work a new testing method would have be to written for it, otherwise, it > would be possible to just capatilize each of the entries, though some > applications prefer to have thier lower-case letters... > > Cheers, v0.5.8.1: - added README for my-lang-string - dropped two TODO items Well do you think you can manage to write that new function? Otherwise capitalizing the first letters is, o.k., as it's much more intelligent to have AMule at the beginning of the list, than having aMule at the end. This is the last thing to be done before merging into sawfish, the others (Comment= as Tooltip or displaying Icons in my are not on my agenda yet, as they require work on the menu itself and there's more important stuff to do, eg broken translations in interactive-mode and such) Cheers, Chris _______________________________________________________________________ Sawfish rules!
;-*-sawfish-*- ;; (mk-saw-menu.jl (v0.5.8.1) --- sawfish wm menu generation -- librep) ;; (c) 2009 Matthew Love ;; Christopher Bratusek ;; This file will be part of Sawfish ;;; Description: ;; ;; Create a sawfish wm menu from .desktop files ;; in your /usr/share/applications folder. #| Usage: Make sure the mk-saw-menu.jl is in your load path (i.e. ~/.sawfish/lisp), then in your .sawfish[/]rc file add: ;; Optional Part, config bits, defaults listed below ;; can be savely skipped, if you're fine with the defaults ;; change xterm -e to your appropriate string (must have ;; a space at the end) (setq my-term-string "xterm -e ") ;; what locale for localized strings to use, if available ;; eg.: set to de to read Dokumentbetrachter instead of Documentviewer (setq my-lang-string '()) ;; if your .desktop files are located somewhere else than ;; /usr/share/applications, then change the desktop-directory (setq desktop-directory "/usr/share/applications")) ;; some entries are hidden from the menu, especially GNOME Apps ;; like eog, nautilus or evince & Co, if you want to have them ;; added to your menu, then replace '() by 't in the following (setq ignore-no-display '()) ;; if you don't want your menus to be sorted alphabetically ;; then replace 't by '() in the following (setq want-alphabetize 't) ;; Necessary part, can't be skipped ;; load our script (require 'mk-saw-menu) ;; generate the menu (write-saw-menu) ;; load our menu (require 'saw-menu) ;; set our menu as default (setq apps-menu saw-apps-menu) |# ;;; TODO: ;; adhere to the desktop entry file specifications. ;; <a href="http://standards.freedesktop.org/desktop-entry-spec/latest/"; target="_blank">http://standards.freedesktop.org/desktop-entry-spec/latest/</a> ;; add support for field codes: <a href="http://standards.freedesktop.org/desktop-entry-spec/latest/ar01s06.html"; target="_blank">http://standards.freedesktop.org/desktop-entry-spec/latest/ar01s06.html</a> ;; add support for Comment=/Comment[lang]= ;; add support for Icon= ;;; Code: ;; Some defaults (setq my-name () ;my-comm () ;my-icon () my-disp () my-term () my-exec ()) ;; Variables that can be set in .sawfish[/]rc (if (not (boundp 'desktop-directory)) (setq desktop-directory "/usr/share/applications")) (setq desk-files (directory-files desktop-directory)) (if (not (boundp 'my-lang-string)) (setq my-lang-string '())) (if (not (boundp 'ignore-no-display)) (setq ignore-no-display '())) (if (not (boundp 'want-alphabetize)) (setq want-alphabetize 't)) (if (not (boundp 'my-term-string)) (setq my-term-string "xterm -e ")) ;; The Master Category List (setq menu-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" "Development" "Documentation")) ("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")))) ;; Some file-verifiers (defun desktop-file-p (directory-file) (let ((this-file (open-file directory-file 'read))) (let ((this-line (read-line this-file))) (if (string= (substring this-line 0 15) "[Desktop Entry]") 't '())))) (defun backup-file-p (input-file-name) (if (or (string= "~" (substring input-file-name (- (length input-file-name) 1))) (string= "#" (substring input-file-name 0 1))) 't '())) ;; Parse a .desktop file into a list suitable for a menu ;; ex. (parse-desktop-file "emacs.desktop") ==> ("Development" "Emacs Text Editor" (system "emacs &")) (defun parse-desktop-file (desktop-file) (let ((desktop-file-name (expand-file-name desktop-file desktop-directory))) desktop-file-name (if (and (file-exists-p desktop-file-name) (not (file-directory-p desktop-file-name))) ;(not (backup-file-p desktop-file-name)) ;(file-regular-p desktop-file-name)) (let ((new-file (open-file desktop-file-name 'read))) (while (setq file-line (read-line new-file)) (create-menu file-line)) (if ignore-no-display (setq my-disp '())) (if (not (string= my-disp "true")) (if (not (string= (string-downcase my-term) "true")) (cons my-cat (cons my-name (cons (list 'system my-exec) nil))) ;(cons my-cat (cons my-icon (cons my-name (cons my-comm (cons (list 'system my-exec) nil))))) (cons my-cat (cons my-name (cons (list 'system (concat my-term-string my-exec)) nil)))) ;(cons my-cat (cons my-icon (cons my-name (cons my-comm (cons (list 'system (concat my-term-string my-exec)) nil)))))) (setq my-disp ())))))) (if my-lang-string (setq name-string "Name[") (setq name-string "Name=")) ;; begining of parsing for (parse-desktop-file), feed a .desktop file line into this. ;; (create-menu "Name=Emacs ") ==> "Emacs" ;; (create-menu "Categories=Development;TextEditor;") ==> "Development" (defun create-menu (line) (cond ((parse-desk-line line "Categories=") (setq my-cat (parse-desk-line line "Categories="))) ((parse-desk-line line name-string) (setq my-name (parse-desk-line line name-string))) ;((parse-desk-line line "Comment=") ; (setq my-comm (parse-desk-line line "Comment="))) ;((parse-desk-line line "Icon=") ; (setq my-icon (parse-desk-line line "Icon="))) ((parse-desk-line line "Exec=") (setq my-exec (concat (parse-desk-line line "Exec=") " &"))) ((parse-desk-line line "Terminal=") (setq my-term (parse-desk-line line "Terminal="))) ((parse-desk-line line "NoDisplay=") (setq my-disp (parse-desk-line line "NoDisplay="))))) ;; Helper function for (create-menu), which will parse the string input there. ;; Will only give an output for specified lines (i.e. category, name, etc.) (defun parse-desk-line (line desk-value) (let ((line-len (length line))) (cond ; this section is for the multi-lingual name string ((and (> line-len 5) (string= desk-value (substring line 0 5)) (string= my-lang-string (substring line 5 7))) (substring line (+ 4 (length my-lang-string) 3) (- line-len 1))) ; this section is for the exec and default name strings ((and (> line-len 5) (string= (substring desk-value 0 4) (substring line 0 4)) (string= (substring line 4 5) "=")) (if (string= (aref line (- line-len 3)) 37) (substring line 5 (- line-len 4)) (substring line 5 (- line-len 1)))) ; this section is for the category string ((and (> line-len 10) (string= desk-value (substring line 0 11))) (let ((cat-string (parse-cat-list (build-cat-list (substring line 11))))) cat-string)) ; this section is for the terminal string ((and (> line-len 8) (string= desk-value (substring line 0 9))) (substring line 9 (- line-len 1))) ; this section is for the nodisplay string ((and (> line-len 9) (string= desk-value (substring line 0 10))) (substring line 10 (- line-len 1)))))) ;; Helper for (parse-desk-line) - specifically, for categories. (defun build-cat-list (line) ; line must be excluding the \ ; categories= part -> (substring line 11) (if (> (length line) 1) (let ((line-len (length line)) (this-cat (prin1-to-string (read-from-string line)))) (cons this-cat (build-cat-list (substring line (+ 1 (length this-cat)))))))) ;; Helper for (parse-desk-line) ;; Determine best category to use... :| (defun parse-cat-list (cat-list) (if (cdr cat-list) (let ((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")) (parse-cat-list (cdr cat-list)) ; to do specific things for the above entries (uncomment below, \ ; and comment out the above (parse-cat-list (cdr cat-list)): ;(let ((dm-specific this-cat)) ; (if (or (string= dm-specific "Application") ; (string= dm-specific "Qt") ; (string= dm-specific "GTK")) ; (parse-cat-list (cdr cat-list)) ;"Settings")) this-cat)) (car cat-list))) ;; Second Part of process, after (parse-desktop-file) has run \ ; through and generated the *loc-menu*. ;; Will run through the Category alist and assign menu values accordingly, and \ ; will output the base of the menu, to \ ; be fed into (build-saw-menu) (defun fix-cats (cat-list) (if cat-list (let ((cat-val (car (car cat-list))) (c-list (fix-sub-cats (car cat-list) *loc-menu*))) (if (car c-list) (cons (cons cat-val c-list) (fix-cats (cdr cat-list))) (fix-cats (cdr cat-list)))))) ;; Helper function for (fix-cats) (defun fix-sub-cats (cat-list loc-list) (if 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))))) ;; Format the menu for sawfish (defun build-saw-menu (entry) `(defvar saw-apps-menu ',entry)) ;; Alphabetize the entries in the category menus (defun alphabetize-entries (saw-menu) (if saw-menu (cons (cons (car (car saw-menu)) (sort (cdr (car saw-menu)) string<)) (alphabetize-entries (cdr saw-menu))))) ;; Write the sawfish menu to file (defun write-saw-menu () (setq *loc-menu* '()) ; generate a list (*loc-menu*) from a (parse-desktop-file) call on all the .desktop files (mapc (lambda (x) (setq *loc-menu* (append *loc-menu* (list (parse-desktop-file x))))) desk-files) ; check if ~/.sawfish/lisp exists, and if not, create it (if (not (file-exists-p "~/.sawfish/lisp")) (if (file-exists-p "~/.sawfish") (make-directory "~/.sawfish/lisp") (lambda () (make-directory "~/.sawfish") (make-directory "~/.sawfish/lisp")))) (setq menu-file (open-file "~/.sawfish/lisp/saw-menu.jl" 'write)) ; generate the sawfish compatible menu file from the *loc-menu* list (if want-alphabetize (prin1 (build-saw-menu (alphabetize-entries (fix-cats menu-cat-alist))) menu-file) (prin1 (build-saw-menu (fix-cats menu-cat-alist)) menu-file)) (close-file menu-file)) ;(write-saw-menu)
Attachment:
signature.asc
Description: Dies ist ein digital signierter Nachrichtenteil