diff options
author | Ludovic Courtès <ludo@gnu.org> | 2015-09-09 09:17:31 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2015-10-10 22:46:14 +0200 |
commit | be1c2c54d9f918f50f71c6d32a72d4498c07504c (patch) | |
tree | 642d087516b3ae7c2ffad6444e25b410712c92be /gnu/services/xorg.scm | |
parent | ce8a6dfc43265787c23fb93d3877fbcacb0451e4 (diff) | |
download | patches-be1c2c54d9f918f50f71c6d32a72d4498c07504c.tar patches-be1c2c54d9f918f50f71c6d32a72d4498c07504c.tar.gz |
system: Make service procedures non-monadic.
* gnu/services/avahi.scm (configuration-file): Use 'plain-file' instead
of 'text-file'.
(avahi-service): Turn into a regular procedure that returns a <service>.
* gnu/services/base.scm (root-file-system-service, file-system-service,
user-unmount-service, user-processes-service, host-name-service,
console-keymap-service, console-font-service, mingetty-service,
nscd.conf-file, nscd-service): Likewise.
(%default-syslog.conf): New variable.
(syslog-service): Use it. Turn into a regular procedure.
(guix-service, udev-rules-union, kvm-udev-rule, udev-service,
device-mapping-service, swap-service): Likewise.
* gnu/services/databases.scm (%default-postgres-hba,
%default-postgres-ident): Use 'plain-file' instead of 'text-file'.
(%default-postgres-config): Use 'mixed-text-file' instead of
'text-file*'.
(postgresql-service): Use 'program-file' instead of 'gexp->script'.
Turn into a regular procedure.
* gnu/services/desktop.scm (dbus-configuration-directory): Use
'computed-file' instead of 'gexp->derivation'.
(upower-configuration-file, geoclue-configuration-file,
elogind-configuration-file): Use 'plain-file' instead of 'text-file'.
(dbus-service, upower-service, colord-service, geoclue-service,
polkit-service, elogind-service): Turn into regular procedures.
(%desktop-services): Remove use of 'mlet' when iterating on
%BASE-SERVICES.
* gnu/services/lirc.scm (lirc-service): Turn into a regular procedure.
* gnu/services/networking.scm (static-networking-service,
dhcp-client-service, ntp-service, tor-service, bitlbee-service,
wicd-service): Likewise.
* gnu/services/ssh.scm (lsh-service): Likewise.
* gnu/services/web.scm (nginx-service): Likewise.
* gnu/services/xorg.scm (xorg-configuration-file): Use 'mixed-text-file'
instead of 'text-file*'.
(xorg-start-command, slim-service): Turn into regular procedures.
(xinitrc): Use 'program-file' instead of 'gexp->script'.
* gnu/system/install.scm (cow-store-service,
configuration-template-service): Turn into regular procedures.
* gnu/system.scm (other-file-system-services, device-mapping-services,
swap-services, essential-services, operating-system-services,
user-shells, operating-system-accounts): Remove now unnecessary
'mlet' and turn into regular procedures.
(operating-system-etc-directory, operating-system-activation-script,
operating-system-boot-script): Adjust accordingly.
* doc/guix.texi (Base Services, Networking Services, X Window, Desktop
Services, Database Services, Web Services, Various Services, Name
Service Switch): Adjust accordingly.
Diffstat (limited to 'gnu/services/xorg.scm')
-rw-r--r-- | gnu/services/xorg.scm | 129 |
1 files changed, 59 insertions, 70 deletions
diff --git a/gnu/services/xorg.scm b/gnu/services/xorg.scm index 9ee88170e4..9c96aab2b8 100644 --- a/gnu/services/xorg.scm +++ b/gnu/services/xorg.scm @@ -31,7 +31,6 @@ #:use-module (gnu packages bash) #:use-module (guix gexp) #:use-module (guix store) - #:use-module (guix monads) #:use-module (guix derivations) #:use-module (guix records) #:use-module (srfi srfi-1) @@ -63,8 +62,8 @@ appropriate screen resolution; otherwise, it must be a list of resolutions---e.g., @code{((1024 768) (640 480))}. Last, @var{extra-config} is a list of strings or objects appended to the -@code{text-file*} argument list. It is used to pass extra text to be added -verbatim to the configuration file." +@code{mixed-text-file} argument list. It is used to pass extra text to be +added verbatim to the configuration file." (define (device-section driver) (string-append " Section \"Device\" @@ -87,7 +86,7 @@ Section \"Screen\" EndSubSection EndSection")) - (apply text-file* "xserver.conf" " + (apply mixed-text-file "xserver.conf" " Section \"Files\" FontPath \"" font-adobe75dpi "/share/fonts/X11/75dpi\" ModulePath \"" xf86-video-vesa "/lib/xorg/modules/drivers\" @@ -128,7 +127,7 @@ EndSection (define* (xorg-start-command #:key (guile (canonical-package guile-2.0)) - configuration-file + (configuration-file (xorg-configuration-file)) (xorg-server xorg-server)) "Return a derivation that builds a @var{guile} script to start the X server from @var{xorg-server}. @var{configuration-file} is the server configuration @@ -136,27 +135,24 @@ file or a derivation that builds it; when omitted, the result of @code{xorg-configuration-file} is used. Usually the X server is started by a login manager." - (mlet %store-monad ((config (if configuration-file - (return configuration-file) - (xorg-configuration-file)))) - (define script - ;; Write a small wrapper around the X server. - #~(begin - (setenv "XORG_DRI_DRIVER_PATH" (string-append #$mesa "/lib/dri")) - (setenv "XKB_BINDIR" (string-append #$xkbcomp "/bin")) - - (apply execl (string-append #$xorg-server "/bin/X") - (string-append #$xorg-server "/bin/X") ;argv[0] - "-logverbose" "-verbose" - "-xkbdir" (string-append #$xkeyboard-config "/share/X11/xkb") - "-config" #$config - "-nolisten" "tcp" "-terminate" - - ;; Note: SLiM and other display managers add the - ;; '-auth' flag by themselves. - (cdr (command-line))))) - - (gexp->script "start-xorg" script))) + (define exp + ;; Write a small wrapper around the X server. + #~(begin + (setenv "XORG_DRI_DRIVER_PATH" (string-append #$mesa "/lib/dri")) + (setenv "XKB_BINDIR" (string-append #$xkbcomp "/bin")) + + (apply execl (string-append #$xorg-server "/bin/X") + (string-append #$xorg-server "/bin/X") ;argv[0] + "-logverbose" "-verbose" + "-xkbdir" (string-append #$xkeyboard-config "/share/X11/xkb") + "-config" #$configuration-file + "-nolisten" "tcp" "-terminate" + + ;; Note: SLiM and other display managers add the + ;; '-auth' flag by themselves. + (cdr (command-line))))) + + (program-file "start-xorg" exp)) (define* (xinitrc #:key (guile (canonical-package guile-2.0)) @@ -200,7 +196,7 @@ which should be passed to this script as the first argument. If not, the (exec-from-login-shell xsession-file session) ;; Otherwise, start the specified session. (exec-from-login-shell session))))) - (gexp->script "xinitrc" builder)) + (program-file "xinitrc" builder)) ;;; @@ -224,7 +220,7 @@ which should be passed to this script as the first argument. If not, the (xauth xauth) (dmd dmd) (bash bash) (auto-login-session #~(string-append #$windowmaker "/bin/wmaker")) - startx) + (startx (xorg-start-command))) "Return a service that spawns the SLiM graphical login manager, which in turn starts the X display server with @var{startx}, a command as returned by @code{xorg-start-command}. @@ -251,13 +247,9 @@ If @var{theme} is @code{#f}, the use the default log-in theme; otherwise theme to use. In that case, @var{theme-name} specifies the name of the theme." - (define (slim.cfg) - (mlet %store-monad ((startx (if startx - (return startx) - (xorg-start-command))) - (xinitrc (xinitrc #:fallback-session - auto-login-session))) - (text-file* "slim.cfg" " + (define slim.cfg + (let ((xinitrc (xinitrc #:fallback-session auto-login-session))) + (mixed-text-file "slim.cfg" " default_path /run/current-system/profile/bin default_xserver " startx " xserver_arguments :0 vt7 @@ -271,40 +263,37 @@ sessiondir /run/current-system/profile/share/xsessions session_msg session (F1 to change): halt_cmd " dmd "/sbin/halt -reboot_cmd " dmd "/sbin/reboot -" -(if auto-login? - (string-append "auto_login yes\ndefault_user " default-user "\n") - "") -(if theme-name - (string-append "current_theme " theme-name "\n") - "")))) - - (mlet %store-monad ((slim.cfg (slim.cfg))) - (return - (service - (documentation "Xorg display server") - (provision '(xorg-server)) - (requirement '(user-processes host-name udev)) - (start - #~(lambda () - ;; A stale lock file can prevent SLiM from starting, so remove it - ;; to be on the safe side. - (false-if-exception (delete-file "/var/run/slim.lock")) - - (fork+exec-command - (list (string-append #$slim "/bin/slim") "-nodaemon") - #:environment-variables - (list (string-append "SLIM_CFGFILE=" #$slim.cfg) - #$@(if theme - (list #~(string-append "SLIM_THEMESDIR=" #$theme)) - #~()))))) - (stop #~(make-kill-destructor)) - (respawn? #t) - (pam-services - ;; Tell PAM about 'slim'. - (list (unix-pam-service - "slim" - #:allow-empty-passwords? allow-empty-passwords?))))))) +reboot_cmd " dmd "/sbin/reboot\n" + (if auto-login? + (string-append "auto_login yes\ndefault_user " default-user "\n") + "") + (if theme-name + (string-append "current_theme " theme-name "\n") + "")))) + + (service + (documentation "Xorg display server") + (provision '(xorg-server)) + (requirement '(user-processes host-name udev)) + (start + #~(lambda () + ;; A stale lock file can prevent SLiM from starting, so remove it + ;; to be on the safe side. + (false-if-exception (delete-file "/var/run/slim.lock")) + + (fork+exec-command + (list (string-append #$slim "/bin/slim") "-nodaemon") + #:environment-variables + (list (string-append "SLIM_CFGFILE=" #$slim.cfg) + #$@(if theme + (list #~(string-append "SLIM_THEMESDIR=" #$theme)) + #~()))))) + (stop #~(make-kill-destructor)) + (respawn? #t) + (pam-services + ;; Tell PAM about 'slim'. + (list (unix-pam-service + "slim" + #:allow-empty-passwords? allow-empty-passwords?))))) ;;; xorg.scm ends here |