(use-modules (alterator glob))

(define *system-profile-dir* "/etc/alterator/profile.d/")
(define *local-profile-dir* "profile.d/")

(define *system-menu-dir* (list "/usr/share/applications/" "/var/cache/applications"))
(define *local-menu-dir* "applications/")

(define (select-profile-dir)
  (if (fluid-ref use-local-files)
      *local-profile-dir*
      *system-profile-dir*))

;;TODO: added support for user menu files
(define (select-menu-dir)
  (if (fluid-ref use-local-files)
      *local-menu-dir*
      (find write-access? *system-menu-dir*)))

(define (autocreate)
  (string-append "auto"
                 (number->string (current-time))
                 ".acc"))

(define (list-profiles-from profile-dir)
  (let ((dir (opendir profile-dir)))
    (let loop ((item (readdir dir))
               (result '()))
      (cond
       ((eof-object? item) result)
       ((or (string=? item ".") (string=? item "..")) (loop (readdir dir) result))
       (else
        (loop
         (readdir dir)
         (append1 result
                  (append (list item)
                          (with-input-from-file
                              (string-append profile-dir item) (lambda() (read)))))))))))

(define (list-profiles)
  (let ((dirs (delq #f (list (and (fluid-ref use-local-files)
                                  (read-access? *local-profile-dir*)
				  *local-profile-dir*)
                             (and (read-access? *system-profile-dir*)
			          *system-profile-dir*)))))
    (concatenate (map list-profiles-from dirs))))
  

(define (read-profile file)
  (let ((system-path (string-append *system-profile-dir* file))
        (local-path (and (fluid-ref use-local-files)
                         (string-append *local-profile-dir* file))))
    (with-first-readable
     (list local-path system-path)
     (lambda(path)
       (with-input-from-file path
         (lambda() (let ((result (read)))
                     (and (not (eof-object? result)) result))))))))
  
(define (write-profile file data)
  (let ((dir  (select-profile-dir)))
    (or (read-access? dir) (mkdir dir))
    (with-output-to-file
        (string-append dir file)
      (lambda() (write data) (newline)  #f))
    (list 'name file)))

(define (write-menu file icon name)
  (let ((dir (select-menu-dir)))
    (or (read-access? dir) (mkdir dir))
    (with-output-to-file
        (string-append dir "alterator-" file ".desktop")
      (lambda()
        (format #t "[Desktop Entry]~%")
        (format #t "Encoding=UTF-8~%")
        (format #t "Type=Application~%")
        (format #t "Categories=Settings;X-ALT-Settings~%")
        (format #t "Exec=alterator-standalone ~A~%" file)
        (format #t "Icon=~A~%" icon)
        (format #t "Name=~A~%" name)
        (format #t "Terminal=false~%")))
        (or (fluid-ref use-local-files) (system "/usr/bin/update-menus -N"))))

(define (make-name objects)
  (let ((name (string-join (map sure-string objects) "_")))
    (if (string=? name "autocreate") (autocreate) name)))

(define (exclude-action args)
  (plist-fold (lambda(x y res)
                (if (eq? x 'action)
                    res
                    (cons* x y res)))
              '()
              args))
(object
 #f
 ((read self objects options) (read-profile (make-name objects)))
 ((write self objects options) (let ((name (make-name objects)))
                                 (write-profile (make-name objects) (exclude-action options))
                                 (write-menu (make-name objects)
                                             (cond-plistq 'acc-icon options "altlinux")
                                             (cond-plistq 'acc-caption options "configurator"))
                                 '() ))
 ((list self objects options) (list-profiles)))
