gnu/packages/guile-wm.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
   3 ;;; Copyright © 2016 Alex ter Weele <alex.ter.weele@gmail.com>
   4 ;;; Copyright © 2017, 2019 Ricardo Wurmus <rekado@elephly.net>
   5 ;;; Copyright © 2017 Nikita <nikita@n0.is>
   6 ;;; Copyright © 2019 Pierre-Moana Levesque <pierre.moana.levesque@gmail.com>
   7 ;;;
   8 ;;; This file is part of GNU Guix.
   9 ;;;
  10 ;;; GNU Guix is free software; you can redistribute it and/or modify it
  11 ;;; under the terms of the GNU General Public License as published by
  12 ;;; the Free Software Foundation; either version 3 of the License, or (at
  13 ;;; your option) any later version.
  14 ;;;
  15 ;;; GNU Guix is distributed in the hope that it will be useful, but
  16 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;;; GNU General Public License for more details.
  19 ;;;
  20 ;;; You should have received a copy of the GNU General Public License
  21 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  22
  23 (define-module (gnu packages guile-wm)
  24   #:use-module (guix licenses)
  25   #:use-module (gnu packages)
  26   #:use-module (gnu packages xorg)
  27   #:use-module (gnu packages guile)
  28   #:use-module (gnu packages pkg-config)
  29   #:use-module (gnu packages texinfo)
  30   #:use-module (guix packages)
  31   #:use-module (guix download)
  32   #:use-module (guix git-download)
  33   #:use-module (guix build-system gnu))
  34
  35 (define-public guile-xcb
  36   (let ((commit "db7d5a393cc37a56f66541b3f33938b40c6f35b3")
  37         (revision "1"))
  38     (package
  39       (name "guile-xcb")
  40       (version (git-version "1.3" revision commit))
  41       (source (origin
  42                 (method git-fetch)
  43                 (uri (git-reference
  44                       (url "https://github.com/mwitmer/guile-xcb")
  45                       (commit commit)))
  46                 (file-name (git-file-name name version))
  47                 (sha256
  48                  (base32
  49                   "16w4vgzbmnwih4bgfn8rw85ryfvzhc6hyly6bic9sd7hhc82rcnd"))))
  50       (build-system gnu-build-system)
  51       (arguments '(;; Parallel builds fail.
  52                    #:parallel-build? #f
  53                    #:configure-flags (list (string-append
  54                                             "--with-guile-site-dir="
  55                                             (assoc-ref %outputs "out")
  56                                             "/share/guile/site/2.2")
  57                                            (string-append
  58                                             "--with-guile-site-ccache-dir="
  59                                             (assoc-ref %outputs "out")
  60                                             "/lib/guile/2.2/site-ccache"))))
  61       (native-inputs `(("guile" ,guile-2.2)
  62                        ("pkg-config" ,pkg-config)
  63                        ("texinfo" ,texinfo)))
  64       (inputs `(("guile" ,guile-2.2)
  65                 ("xcb" ,xcb-proto)))
  66       (home-page "https://github.com/mwitmer/guile-xcb")
  67       (synopsis "XCB bindings for Guile")
  68       (description
  69        "Guile-XCB implements the XCB protocol and provides all the tools
  70 necessary to write X client code in Guile Scheme without any external
  71 dependencies.")
  72       (license gpl3+))))
  73
  74 (define-public guile-wm
  75   (let ((commit "f3c7b3be719f425ffb87265d34855a73366351be")
  76         (revision "1"))
  77     (package
  78       (name "guile-wm")
  79       (version (git-version "1.0" revision commit))
  80       (synopsis "X11 window manager toolkit in Scheme")
  81       (source (origin
  82                 (method git-fetch)
  83                 (uri (git-reference
  84                       (url "https://github.com/mwitmer/guile-wm")
  85                       (commit commit)))
  86                 (file-name (git-file-name name version))
  87                 (sha256
  88                  (base32
  89                   "086dijnpl5dpglf70d6f9sizyakr313y7blpdjrmbi687j1x3qcl"))))
  90       (build-system gnu-build-system)
  91       (arguments
  92        `(#:modules ((guix build gnu-build-system)
  93                     (guix build utils)
  94                     (ice-9 rdelim)
  95                     (ice-9 popen))
  96          ;; The '.scm' files go to $(datadir), so set that to the
  97          ;; standard value.
  98          #:configure-flags (list (string-append "--datadir="
  99                                                 (assoc-ref %outputs "out")
 100                                                 "/share/guile/site/2.2"))
 101          #:phases
 102          (modify-phases %standard-phases
 103            (add-before 'configure 'set-module-directory
 104              (lambda* (#:key outputs #:allow-other-keys)
 105                ;; Install .scm files to $out/share/guile/site/2.2.
 106                (let ((out (assoc-ref outputs "out"))
 107                      (effective (read-line
 108                                  (open-pipe* OPEN_READ
 109                                              "guile" "-c"
 110                                              "(display (effective-version))"))))
 111                  (substitute* "module/Makefile.in"
 112                    (("^wmdir = .*$")
 113                     (string-append "wmdir = " out
 114                                    "/share/guile/site/"
 115                                    effective "\n"))))
 116                #t))
 117            (add-after 'install 'set-load-path
 118              (lambda* (#:key inputs outputs #:allow-other-keys)
 119                ;; Put Guile-XCB's and Guile-WM's modules in the
 120                ;; search path of PROG.
 121                (let* ((out       (assoc-ref outputs "out"))
 122                       (effective (read-line
 123                                   (open-pipe* OPEN_READ
 124                                               "guile" "-c"
 125                                               "(display (effective-version))")))
 126                       (prog      (string-append out "/bin/guile-wm"))
 127                       (mods      (string-append out "/share/guile/site/" effective))
 128                       (gos       (string-append out "/lib/guile/" effective "/site-ccache"))
 129                       (xcb       (assoc-ref inputs "guile-xcb")))
 130                  (wrap-program prog
 131                    `("GUILE_AUTO_COMPILE" ":" = ("0"))
 132                    `("GUILE_LOAD_PATH" ":" prefix
 133                      (,mods ,(string-append xcb "/share/guile/site/" effective)))
 134                    `("GUILE_LOAD_COMPILED_PATH" ":" prefix
 135                      (,gos ,(string-append xcb "/lib/guile/"
 136                                            effective "/site-ccache")))))
 137                #t))
 138            (add-after 'install 'install-go-files
 139              (lambda* (#:key outputs inputs #:allow-other-keys)
 140                (let* ((out (assoc-ref outputs "out"))
 141                       (effective (read-line
 142                                   (open-pipe* OPEN_READ
 143                                               "guile" "-c"
 144                                               "(display (effective-version))")))
 145                       (module-dir (string-append out "/share/guile/site/"
 146                                                  effective))
 147                       (object-dir (string-append out "/lib/guile/" effective
 148                                                  "/site-ccache"))
 149                       (prefix     (string-length module-dir)))
 150                  (setenv "GUILE_AUTO_COMPILE" "0")
 151                  ;; compile to the destination
 152                  (for-each (lambda (file)
 153                              (let* ((base (string-drop (string-drop-right file 4)
 154                                                        prefix))
 155                                     (go   (string-append object-dir base ".go")))
 156                                (invoke "guild" "compile" "-L" module-dir
 157                                        file "-o" go)))
 158                            (find-files module-dir "\\.scm$"))
 159                  #t)))
 160            (add-after 'install 'install-xsession
 161              (lambda* (#:key outputs #:allow-other-keys)
 162                ;; add a .desktop file to xsessions
 163                (let ((xsessions (string-append
 164                                  %output "/share/xsessions")))
 165                  (mkdir-p xsessions)
 166                  (call-with-output-file (string-append
 167                                          xsessions "/guile-wm.desktop")
 168                    (lambda (port)
 169                      (format port
 170                              "[Desktop Entry]~@
 171                                     Name=~a~@
 172                                     Comment=~a~@
 173                                     Exec=~a/bin/guile-wm~@
 174                                     Type=Application~%"
 175                              ,name ,synopsis %output))))
 176                #t)))))
 177       (native-inputs `(("guile" ,guile-2.2)
 178                        ("guile-xcb" ,guile-xcb)
 179                        ("pkg-config" ,pkg-config)
 180                        ("texinfo" ,texinfo)))
 181       (inputs `(("guile" ,guile-2.2)
 182                 ("guile-xcb" ,guile-xcb)))
 183       (home-page "https://github.com/mwitmer/guile-wm/releases")
 184       (description
 185        "Guile-WM is a simple window manager that's completely customizable—you
 186 have total control of what it does by choosing which modules to include.
 187 Included with it are a few modules that provide basic TinyWM-like window
 188 management, some window record-keeping, multi-monitor support, and emacs-like
 189 keymaps and minibuffer.  At this point, it's just enough to get you started.")
 190       (license gpl3+))))