Re: Script for creating Application Menu

[matthew <matth love gmail com>]

matthew <matth love gmail com> writes:

> Christopher Roy Bratusek <zanghar freenet de> writes:
>
>> Am Sonntag, den 16.08.2009, 20:18 +0200 schrieb Christopher Roy
>> Bratusek:
>>> Am Sonntag, den 16.08.2009, 20:09 +0200 schrieb Christopher Roy
>>> Bratusek:
>>> > Am Sonntag, den 16.08.2009, 10:18 -0600 schrieb matthew:
>>> > > Hi.
>>> > > I made a librep menu generator for .desktop files in a
>>> > > /usr/share/applications directory, it is attached. 
>>> > > Let me know if it works for any of you.
>>> > > 
>>> > > Put it in a load path and add the following into your .sawfishrc:
>>> > > 
>>> > > (require 'mk-saw-menu)
>>> > > (write-saw-menu)
>>> > > (require 'saw-menu)
>>> > > (setq apps-menu saw-apps-menu)
>>> > > 
>>> > > You can make it an executable script by uncommenting the last line in the
>>> > > mk-saw-menu.jl, i.e. (write-saw-menu) and adding the following to the
>>> > > begining and chmoding the file to +x:
>>> > > 
>>> > > #! /bin/sh
>>> > > exec rep --batch "$0" "$@"
>>> > > !#
>>> > > 
>>> > > Cheers
>>> > > 
>>> > 
>>> > Hi Matthew,
>>> > 
>>> > you're script is great and works like a charm.
>>> > 
>>> > I also did a few small changes:
>>> > 
>>> > - Added Settings Category (Otherwise System contains too many entries
>>> > and becomes too huge to be usefull (at least on my box))
>>> > - Re-orderd the Categories (System + Settings at the end for example)
>>> > - Bumped version to 0.5.2 (just for fun)
>>> > 
>>> > Two thoughts:
>>> > 
>>> > Also I personally don't see the point for having both Network and
>>> > Internet Submenus. And there should be an option for ignoring NoDisplay
>>> > Setting if Categories=GNOME* , as GNOME hides several stuff by default
>>> > from the menu (say: nautilus, bug-buddy, evince, eog, file-roller and
>>> > more -- Ugly, I know)
>>> > 
>>> > If there are no complaints about it, I would integrate this into sawfish
>>> > (as sawfish.wm.ext.fdo-menu) and then let the user choose wether to use
>>> > the apps-menu (the updated version I've posted to the ML yesterday) or
>>> > this new menu. But I guess It's o.k.
>>> > 
>>> > Updated script + Praising Screenshot (with mk-saw-menu + revamped
>>> > rootmenu (see my yesterdays post)) attached.
>>> > 
>>> > Thanks a lot for your efforts,
>>> > Chris
>>> > ________________________________________________________________________
>>> > Sawfish rules!
>>> 
>>> ... it does not check for duplicated entries, eg Synaptic twice in the
>>> menu, but this is just a minor glitch, not a show-stopper :)
>>> 
>>> Thanks,
>>> Chris
>>> 
>>
>> Ah and it should sort entries alphabetically (I promise this was the
>> last one :p)
>>
>> Thanks,
>> Chris
>>
>> _______________________________________________________________________
>> Sawfish rules!
>
> Thanks for the feedback and contributions.
>
> I have always felt the same way about Network and Internet menus, it may
> be good to merge them perhaps.
>
> I added two new variables at the begining, 
>
> ignore-no-display
> want-alphebetize
>
> Set these as 't to use; 
> - ignore-no-display will, intuitively, ignore the
> no-display entries in .desktop files, it is not tied to GNOME* entries,
> but that can be changed in the future.  
> - want-alphebetize, when set to 't, will alphebetize the resulting
> entries inside the individual categories.
> The alphebetize-entries function just does a simple (sort) using
> 'string<, which doesn't ignore case, so capital letters will come
> before lower-case ones, for some reason the 'string-lessp predicate
> doesn't want to work for me...
>
> ignore-no-display is defaulted to '() - false in this file,
> while want-alphebetize is defaulted to 't
>
> bumped to 0.5.3 :)
>
> Thanks again,

Made some updates, and a bug fix for the alph*a*betize function, which,
other than being spelled wrong, cut off the "Settings" menu.

I also added a function that parses out the non-regular files from the
.desktop file list, so it wont read ~ and # files anymore.

Also, began to add a function in (parse-cat-list) to do specific things
for specific categories, etc.

Cheers

-- 
Mattew Love

;-*-sawfish-*-
;; (mk-saw-menu.jl (v0.5.4)--- sawfish wm menu generation -- librep)

;; This file is not a 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)
;; in your .sawfishrc file add:
;; (setq my-term-string "xterm -e ") ;; change xterm -e to your appropriate \
;; string (should have a space at the end), you can leave this out if you use \
;; xterm, as that is the default.
;; (require 'mk-saw-menu)
;; (write-saw-menu)
;; (require 'saw-menu)
;; (setq apps-menu saw-apps-menu)
;; Doing the above will update the menu each time sawfish is started

;;; TODO:

;; adhere to the desktop entry file specifications.
;; http://standards.freedesktop.org/desktop-entry-spec/latest/
;; add support for field codes: http://standards.freedesktop.org/desktop-entry-spec/latest/ar01s06.html

;;; Code:

; remove non-regular files from the directory-files list
(defun parse-directory-files (dir-files)
  (if dir-files
      (let ((this-file (car dir-files)))
	(if (file-regular-p this-file)
	    (cons this-file (parse-directory-files (cdr dir-files)))))))

; set some defaults
(setq default-directory "/usr/share/applications"
      desk-files (parse-directory-files (directory-files default-directory))
      my-name ()
      my-disp ()
      my-term ()
      my-exec ()
      ignore-no-display '()
      want-alphabetize 't)

(if (not (boundp 'my-term-string))
    (setq my-term-string "xterm -e "))

(setq menu-cat-alist
      '(("Desktop" .  ("X-Desktop" "X-DesktopApplets" "X-DesktopCountry" \
		       "DesktopSettings" "GNOME" "KDE"))
	("Personal" . ("X-Personal" "X-PersonalUtility" "Calendar" "ContactManagement"))
	("Office" . ("Office" "WordProcessor" "Presentation" "X-Document" \
		     "TextEditor" "SpreadSheet" "Calculator" "X-Calculate" \
		     "Chart" "FlowChart" "Finance"))
	("Network" . ("Telephony" "Network" "Dialup" "VideoConference" \
		      "RemoteAccess" "News" "HamRadio" "FileTransfer"))
	("Internet" . ("X-Internet" "P2P" "Email" "WebBrowser" "IRCClient" "Chat" \
		       "InstantMessaging" "Chat" "WebDevelopment"))
	("Games" . ("Game" "ActionGame" "AdventureGame" "ArcadeGame" "BoardGame" \
		    "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" "X-Xfce-Toplevel"))))

(defun parse-desktop-file (desktop-file)
  (if (and (file-exists-p desktop-file) (not (file-directory-p desktop-file)))
	(let ((new-file (open-file desktop-file '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-name (cons (list 'system (concat my-term-string my-exec)) nil))))
	    (setq my-disp ())))))

(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)))))

(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))))))

(defun create-menu (line)
  (cond
   ((parse-desk-line line "Categories=")
    (setq my-cat (parse-desk-line line "Categories=")))
   ((parse-desk-line line "Name=")
    (setq my-name (parse-desk-line line "Name=")))
   ((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=")))))

(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))))))))

(defun parse-cat-list (cat-list)
  ; determine best category to use... :|
  (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 "X-XFCE")
	     (string= this-cat "Qt")
	     (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)))

(defun parse-desk-line (line desk-value)
  (let ((line-len (length line)))
    (cond
     ; this section is for the exec string
     ((and (> line-len 5) (string= desk-value (substring line 0 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))))))

(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)))))

(defun write-saw-menu ()
  (setq *loc-menu* '())
  (mapc (lambda (x)
	  (setq *loc-menu* (append *loc-menu* (list (parse-desktop-file x))))) desk-files)
  (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))
  (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)