labwc.scm (2959B)

      1 (define-module (mt services labwc)
      2   #:use-module (gnu home services)
      3   #:use-module (guix gexp)
      4   #:use-module (guix records)
      5   #:export (home-labwc-configuration
      6             home-labwc-configuration?
      7             home-labwc-service-type))
      8 
      9 ;; TODO: Themerc generation
     10 
     11 (define-record-type* <home-labwc-configuration>
     12   home-labwc-configuration
     13   make-home-labwc-configuration
     14   home-labwc-configuration?
     15   ;; Labwc rc configurations in SXML
     16   (rc home-labwc-configuration-rc
     17       (default '()))
     18   ;; Labwc menu configurations in SXML
     19   (menu home-labwc-configuration-menu
     20         (default '()))
     21   ;; Either a list of strings containing commands or a file-like object
     22   (autostart home-labwc-configuration-autostart
     23              (default '()))
     24   ;; Packages that will be used specifically by labwc to create the environment
     25   (packages home-labwc-configuration-packages
     26             (default '())))
     27 
     28 (define (make-labwc-rc-file config)
     29   (computed-file
     30    "rc.xml"
     31    #~(begin
     32        (use-modules (sxml simple))
     33        (call-with-output-file #$output
     34          (lambda (port)
     35            (sxml->xml
     36             '(*TOP*
     37               (labwc_config
     38                #$@config))
     39             port))))))
     40 
     41 (define (make-labwc-menu-file config)
     42   (computed-file
     43    "menu.xml"
     44    #~(begin
     45        (use-modules (sxml simple))
     46        (call-with-output-file #$output
     47          (lambda (port)
     48            (sxml->xml
     49             '(*TOP*
     50               (openbox_menu
     51                #$@config))
     52             port))))))
     53 
     54 (define (make-labwc-autostart-file commands)
     55   (computed-file
     56    "autostart"
     57    #~(begin
     58        (call-with-output-file #$output
     59          (lambda (port)
     60            (for-each
     61              (lambda (command)
     62                (display command port)
     63                (display ">/dev/null 2>&1 &" port)
     64                (newline port))
     65              (list #$@commands)))))))
     66 
     67 (define (labwc-configuration-files cfg)
     68   `(("labwc/rc.xml" ,(make-labwc-rc-file
     69                       (home-labwc-configuration-rc cfg)))
     70     ("labwc/menu.xml" ,(make-labwc-menu-file
     71                         (home-labwc-configuration-menu cfg)))
     72     ;; Use the provided autostart if it is a file-like object
     73     ;; Othwerwise, generate one from the given list
     74     ("labwc/autostart" ,(let ((autostart (home-labwc-configuration-autostart cfg)))
     75                              (if (file-like? autostart)
     76                                autostart
     77                                (make-labwc-autostart-file autostart))))))
     78 
     79 (define (labwc-profile cfg)
     80   (home-labwc-configuration-packages cfg))
     81 
     82 ;; TODO: Support simple autostart via list
     83 
     84 (define home-labwc-service-type
     85   (service-type
     86    (name 'home-labwc)
     87    (extensions
     88     (list (service-extension home-xdg-configuration-files-service-type
     89                              labwc-configuration-files)
     90           (service-extension home-profile-service-type
     91                              labwc-profile)))
     92    (description
     93     "Setup configuration for labwc")))
     94