#!/usr/bin/clisp -q -ansi -norc

(defun subdirs (dir)
  (mapcar #'pathname-directory
          (directory (make-pathname :directory (append dir '("*")) :type "directory"))))

(defun entries (dir)
  (directory (make-pathname :directory dir :type "desktop")))

(defstruct entry name comment command terminalp type)

(defun parse-entry (p)
  (let ((e (make-entry)))
    (with-open-file (stream p :direction :input)
      (let ((*print-case* :upcase))
        (loop as l = (read-line stream nil nil nil)
          while l do
          (unless (eq (elt l 0) #\[)
            (let* ((pos (position #\= l))
                   (key (intern (string-upcase (subseq l 0 pos))))
                   (value (subseq l (1+ pos))))
              (case key
                (name (setf (entry-name e) value))
                (comment (setf (entry-comment e) value))
                (exec (setf (entry-command e) value))
                (terminal (setf (entry-terminalp e) (string= (string-downcase value) "true")))
                (type (setf (entry-type e) (intern (string-upcase value))))))))))
    (and (eq (entry-type e) 'application) (list e))))

(defconstant +me+ "rp-deb-gnome-menu")

(defconstant +default-root+ '(:absolute "var" "lib" "gnome" "Debian"))

(defconstant +menu-root+
  (or (and (first *args*) (read-from-string (first *args*)))
      +default-root+))

(defconstant +subdirs+
  (subdirs +menu-root+))

(defconstant +entries+
  (mapcan #'parse-entry (entries +menu-root+)))

(run-program "ratmenu"
             :input nil
             :output nil
             :arguments
             `("-style" "dreary" "-align" "center"
               ,@(loop for d in +subdirs+
                   append (list (format nil "{~A}" (car (last d)))
                                (format nil "~A '~S'" +me+ d)))
               ,@(loop for e in +entries+
                   append (list (cond
                                 ((null (entry-comment e))
                                  (format nil "~A" (entry-name e)))
                                 ((string= (string-downcase (entry-name e))
                                           (string-downcase (entry-comment e)))
                                  (format nil "~A" (entry-name e)))
                                 (t
                                  (format nil "~A" (entry-comment e))))
                                (if (entry-terminalp e)
                                    (format nil "gnome-terminal -e ~S" (entry-command e))
                                  (entry-command e))))
               ,@(let ((ldroot (length +default-root+)))
                   (loop as r = (butlast +menu-root+) then (butlast r)
                     while (>= (length r) ldroot)
                     append (list (format nil "<- {~A} ->" (car (last r)))
                                  (format nil "~A '~S'" +me+ r))))))

;;; Local Variables:
;;; mode: lisp
;;; outline-regexp: ";;\\*\\**"
;;; eval:(outline-minor-mode 1)
;;; End: