code:
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2015, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2016, 2017, 2019 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2016 Adonay "adfeno" Felipe Nogueira <https://libreplanet.org/wiki/User:Adfeno> <adfeno@openmailbox.org>
;;; Copyright © 2017 Thomas Danckaert <post@thomasdanckaert.be>
;;; Copyright © 2017, 2018, 2020 Marius Bakke <mbakke@fastmail.com>
;;; Copyright © 2018–2021 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2019 Rutger Helling <rhelling@mykolab.com>
;;; Copyright © 2020 Pierre Langlois <pierre.langlois@gmx.com>
;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (gnu packages samba)
  #:use-module (guix packages)
  #:use-module (guix download)
  #:use-module (guix git-download)
  #:use-module (guix build-system gnu)
  #:use-module (guix licenses)
  #:use-module (guix utils)
  #:use-module (gnu packages)
  #:use-module (gnu packages acl)
  #:use-module (gnu packages admin)
  #:use-module (gnu packages autotools)
  #:use-module (gnu packages backup)
  #:use-module (gnu packages base)
  #:use-module (gnu packages check)
  #:use-module (gnu packages crypto)
  #:use-module (gnu packages cups)
  #:use-module (gnu packages databases)
  #:use-module (gnu packages docbook)
  #:use-module (gnu packages glib)
  #:use-module (gnu packages gnome)
  #:use-module (gnu packages gnupg)
  #:use-module (gnu packages kerberos)
  #:use-module (gnu packages linux)
  #:use-module (gnu packages onc-rpc)
  #:use-module (gnu packages openldap)
  #:use-module (gnu packages perl)
  #:use-module (gnu packages pkg-config)
  #:use-module (gnu packages popt)
  #:use-module (gnu packages python)
  #:use-module (gnu packages readline)
  #:use-module (gnu packages time)
  #:use-module (gnu packages tls)
  #:use-module (gnu packages web)
  #:use-module (gnu packages xml))

(define-public cifs-utils
  (package
    (name "cifs-utils")
    (version "6.13")
    (source
     (origin
       (method url-fetch)
       (uri (string-append "https://download.samba.org/pub/linux-cifs/"
                           "cifs-utils/cifs-utils-" version ".tar.bz2"))
       (sha256 (base32
                "0mnhcc4ayj2vn2azhk45fnal1hibsv0q2c4ihkxcrjhkhrn7in23"))))
    (build-system gnu-build-system)
    (native-inputs
     `(("autoconf" ,autoconf)
       ("automake" ,automake)
       ("pkg-config" ,pkg-config)))
    (inputs
     `(("keytuils" ,keyutils)
       ("linux-pam" ,linux-pam)
       ("libcap-ng" ,libcap-ng)
       ("mit-krb5" ,mit-krb5)
       ("samba" ,samba)
       ("talloc" ,talloc)))
    (arguments
     `(#:phases
       (modify-phases %standard-phases
         (add-before 'configure 'set-root-sbin
           (lambda* (#:key outputs #:allow-other-keys)
             ;; Don't try to install into "/sbin".
             (setenv "ROOTSBINDIR"
                     (string-append (assoc-ref outputs "out") "/sbin"))
             #t))
         (add-before 'install 'create-man8dir
           ;; Create a directory that isn't created since version 6.10.
           (lambda* (#:key outputs #:allow-other-keys)
             (let ((out (assoc-ref outputs "out")))
               (mkdir-p (string-append out "/share/man/man8"))
               #t))))))
    (synopsis "User-space utilities for Linux CIFS (Samba) mounts")
    (description "@code{cifs-utils} is a set of user-space utilities for
mounting and managing @dfn{Common Internet File System} (CIFS) shares using
the Linux kernel CIFS client.")
    (home-page "https://wiki.samba.org/index.php/LinuxCIFS_utils")
    ;; cifs-utils is licensed as GPL3 or later, but 3 files contain LGPL code.
    (license gpl3+)))

(define-public iniparser
  (package
    (name "iniparser")
    (version "4.1")
    (source (origin
             (method git-fetch)
             (uri (git-reference
                    (url "https://github.com/ndevilla/iniparser")
                    (commit (string-append "v" version))))
             (file-name (git-file-name name version))
             (sha256
              (base32
               "0dhab6pad6wh816lr7r3jb6z273njlgw2vpw8kcfnmi7ijaqhnr5"))))
    (build-system gnu-build-system)
    (arguments
     `(#:make-flags
       (list ,(string-append "CC=" (cc-for-target)))
       #:phases
       (modify-phases %standard-phases
         (replace 'configure
           (lambda* (#:key outputs #:allow-other-keys)
             (substitute* '("Makefile" "test/Makefile")
               (("/usr/lib")
                (string-append (assoc-ref outputs "out") "/lib")))
             #t))
         (replace 'build
           (lambda* (#:key make-flags #:allow-other-keys)
             (apply invoke "make" "libiniparser.so.1"
                    make-flags)))
         (replace 'install
           (lambda* (#:key outputs #:allow-other-keys)
             (let* ((out  (assoc-ref outputs "out"))
                    (lib  (string-append out "/lib"))
                    (inc  (string-append out "/include"))
                    (doc  (string-append out "/share/doc/" ,name))
                    (html (string-append doc "/html")))
               (define (install dir)
                 (lambda (file)
                   (install-file file dir)))
               (for-each (install lib)
                         (find-files "." "^lib.*\\.so"))
               (with-directory-excursion lib
                 (symlink "libiniparser.so.1" "libiniparser.so"))
               (for-each (install inc)
                         (find-files "src" "\\.h$"))
               (for-each (install html)
                         (find-files "html" ".*"))
               (for-each (install doc)
                         '("AUTHORS" "INSTALL" "LICENSE" "README.md"))
               #t))))))
    (home-page "https://github.com/ndevilla/iniparser")
    (synopsis "Simple @file{.ini} configuration file parsing library")
    (description
     "The iniParser C library reads and writes Windows-style @file{.ini}
configuration files.  These are simple text files with a basic structure
composed of sections, properties, and values.  While not expressive, they
are easy to read, write, and modify.

The library is small, thread safe, and written in portable ANSI C with no
external dependencies.")
    (license x11)))

(define-public samba
  (package
    (name "samba")
    (version "4.13.4")
    (source
     (origin
       (method url-fetch)
       (uri (string-append "https://download.samba.org/pub/samba/stable/"
                           "samba-" version ".tar.gz"))
       (sha256
        (base32 "0y2wc7njhyhg055krp878xfv9c3wbhrhzn02d5ich30hyxilrcx1"))
       (patches (search-patches "samba-fix-fcntl-hint-detection.patch"))
       (modules '((guix build utils)))
       (snippet
        '(begin
           ;; XXX: Some bundled libraries (e.g, popt, cmocka) are used from
           ;; the system, but their bundled sources must be kept as they
           ;; include the WAF scripts used for detecting them.
           (delete-file-recursively "third_party/pyiso8601")
           #t))))
    (build-system gnu-build-system)
    (arguments
     `(#:make-flags '("TEST_OPTIONS=--quick") ;some tests are very long
       #:phases
       (modify-phases %standard-phases
         (add-before 'configure 'setup-docbook-stylesheets
           (lambda* (#:key inputs #:allow-other-keys)
             ;; Append Samba's own DTDs to XML_CATALOG_FILES
             ;; (c.f. docs-xml/build/README).
             (copy-file "docs-xml/build/catalog.xml.in"
                        "docs-xml/build/catalog.xml")
             (substitute* "docs-xml/build/catalog.xml"
               (("/@abs_top_srcdir@")
                (string-append (getcwd) "/docs-xml")))
             ;; Honor XML_CATALOG_FILES.
             (substitute* "buildtools/wafsamba/wafsamba.py"
               (("XML_CATALOG_FILES=\"\\$\\{SAMBA_CATALOGS\\}" all)
                (string-append all " $XML_CATALOG_FILES")))
             #t))
         (replace 'configure
           ;; Samba uses a custom configuration script that runs WAF.
           (lambda* (#:key outputs #:allow-other-keys)
             (let* ((out    (assoc-ref outputs "out"))
                    (libdir (string-append out "/lib")))
               (invoke "./configure"
                       "--enable-selftest"
                       "--enable-fhs"
                       (string-append "--prefix=" out)
                       "--sysconfdir=/etc"
                       "--localstatedir=/var"
                       ;; Install public and private libraries into
                       ;; a single directory to avoid RPATH issues.
                       (string-append "--libdir=" libdir)
                       (string-append "--with-privatelibdir=" libdir)))))
         (add-before 'install 'disable-etc,var-samba-directories-setup
           (lambda _
             (substitute* "dynconfig/wscript"
               (("bld\\.INSTALL_DIR.*") ""))
             #t)))
       ;; FIXME: The test suite seemingly hangs after failing to provision the
       ;; test environment.
       #:tests? #f))
    (inputs
     `(("acl" ,acl)
       ("cmocka" ,cmocka)
       ("cups" ,cups)
       ("gamin" ,gamin)
       ("dbus" ,dbus)
       ("gpgme" ,gpgme)
       ("gnutls" ,gnutls)
       ("heimdal" ,heimdal)
       ("jansson" ,jansson)
       ("libarchive" ,libarchive)
       ("libtirpc" ,libtirpc)
       ("linux-pam" ,linux-pam)
       ("lmdb" ,lmdb)
       ("openldap" ,openldap)
       ("perl" ,perl)
       ("python" ,python)
       ("popt" ,popt)
       ("readline" ,readline)
       ("tdb" ,tdb)))
    (propagated-inputs
     ;; In Requires or Requires.private of pkg-config files.
     `(("ldb" ,ldb)
       ("talloc" ,talloc)
       ("tevent" ,tevent)))
    (native-inputs
     `(("perl-parse-yapp" ,perl-parse-yapp)
       ("pkg-config" ,pkg-config)
       ("python-iso8601" ,python-iso8601)
       ("rpcsvc-proto" ,rpcsvc-proto)   ; for 'rpcgen'
       ;; For generating man pages.
       ("docbook-xml" ,docbook-xml-4.2)
       ("docbook-xsl" ,docbook-xsl)
       ("xsltproc" ,libxslt)
       ("libxml2" ,libxml2)))           ;for XML_CATALOG_FILES
    (home-page "https://www.samba.org/")
    (synopsis
     "The standard Windows interoperability suite of programs for GNU and Unix")
    (description
     "Since 1992, Samba has provided secure, stable and fast file and print
services for all clients using the SMB/CIFS protocol, such as all versions of
DOS and Windows, OS/2, GNU/Linux and many others.

Samba is an important component to seamlessly integrate Linux/Unix Servers and
Desktops into Active Directory environments using the winbind daemon.")
    (license gpl3+)))

(define-public talloc
  (package
    (name "talloc")
    (version "2.3.2")
    (source (origin
              (method url-fetch)
              (uri (string-append "https://www.samba.org/ftp/talloc/talloc-"
                                  version ".tar.gz"))
              (sha256
               (base32
                "1mvv57srpzcc1qh6vjjyjhgpdlcw4bmmsxfz4j8pfk9qkvwkx817"))))
    (build-system gnu-build-system)
    (arguments
     '(#:phases
       (modify-phases %standard-phases
         (replace 'configure
           (lambda* (#:key outputs #:allow-other-keys)
             ;; talloc uses a custom configuration script that runs a Python
             ;; script called 'waf', and doesn't tolerate unknown options.
             (setenv "CONFIG_SHELL" (which "sh"))
             (let ((out (assoc-ref outputs "out")))
               (invoke "./configure"
                       (string-append "--prefix=" out))))))))
    (native-inputs
     `(("which" ,which)))
    (inputs
     `(("python" ,python)))
    (home-page "https://talloc.samba.org")
    (synopsis "Hierarchical, reference counted memory pool system")
    (description
     "Talloc is a hierarchical, reference counted memory pool system with
destructors.  It is the core memory allocator used in Samba.")
    (license gpl3+))) ;; The bundled "replace" library uses LGPL3.

(define-public talloc/static
  (package
    (inherit talloc)
    (name "talloc-static")
    (synopsis
     "Hierarchical, reference counted memory pool system (static library)")
    (arguments
     (substitute-keyword-arguments (package-arguments talloc)
       ((#:phases phases)
        ;; Since Waf, the build system talloc uses, apparently does not
        ;; support building static libraries from a ./configure flag, roll our
        ;; own build process.  No need to be ashamed, we're not the only ones
        ;; doing that:
        ;; <https://github.com/proot-me/proot-static-build/blob/master/GNUmakefile>.
        ;; :-)
        `(modify-phases ,phases
           (replace 'build
             (lambda _
               (invoke "gcc" "-c" "-Ibin/default" "-I" "lib/replace"
                       "-I." "-Wall" "-g" "-D__STDC_WANT_LIB_EXT1__=1"
                       "talloc.c")
               (invoke "ar" "rc" "libtalloc.a" "talloc.o")))
           (replace 'install
             (lambda* (#:key outputs #:allow-other-keys)
               (let* ((out     (assoc-ref outputs "out"))
                      (lib     (string-append out "/lib"))
                      (include (string-append out "/include")))
                 (mkdir-p lib)
                 (install-file "libtalloc.a" lib)
                 (install-file "talloc.h" include)
                 #t)))
           (delete 'check)))))))            ;XXX: tests rely on Python modules

(define-public tevent
  (package
    (name "tevent")
    (version "0.10.2")
    (source (origin
              (method url-fetch)
              (uri (string-append "https://www.samba.org/ftp/tevent/tevent-"
                                  version ".tar.gz"))
              (sha256
               (base32
                "15k6i8ad5lpxfjsjyq9h64zlyws8d3cm0vwdnaw8z1xjwli7hhpq"))))
    (build-system gnu-build-system)
    (arguments
     '(#:phases
       (modify-phases %standard-phases
         (replace 'configure
           ;; tevent uses a custom configuration script that runs waf.
           (lambda* (#:key outputs #:allow-other-keys)
             (let ((out (assoc-ref outputs "out")))
               (invoke "./configure"
                       (string-append "--prefix=" out)
                       "--bundled-libraries=NONE")))))))
    (native-inputs
     `(("pkg-config" ,pkg-config)
       ("python" ,python)
       ("which" ,which)))
    (propagated-inputs
     `(("talloc" ,talloc))) ; required by tevent.pc
    (synopsis "Event system library")
    (home-page "https://tevent.samba.org/")
    (description
     "Tevent is an event system based on the talloc memory management library.
It is the core event system used in Samba.  The low level tevent has support for
many event types, including timers, signals, and the classic file descriptor events.")
    (license lgpl3+)))

(define-public ldb
  (package
    (name "ldb")
    (version "1.5.6")
    (source (origin
              (method url-fetch)
              (uri (string-append "https://www.samba.org/ftp/ldb/ldb-"
                                  version ".tar.gz"))
              (sha256
               (base32
                "0nwpkqidsna4yz3vhjzzadm4hpviwnyk80yml8ay82gi1d6lg0pz"))
              (modules '((guix build utils)))
              (snippet
               '(begin
                  (for-each (lambda (file)
                              ;; Delete everything except the build tools.
                              (unless (or (string-prefix? "third_party/waf" file)
                                          (string-suffix? "wscript" file))
                                (delete-file file)))
                            (find-files "third_party"))
                  #t))))
    (build-system gnu-build-system)
    (arguments
     '(;; LMDB is only supported on 64-bit systems, yet the test suite
       ;; requires it.
       #:tests? (assoc-ref %build-inputs "lmdb")
       #:phases
       (modify-phases %standard-phases
         (replace 'configure
           ;; ldb use a custom configuration script that runs waf.
           (lambda* (#:key outputs #:allow-other-keys)
             (let ((out (assoc-ref outputs "out")))
               (invoke "./configure"
                       (string-append "--prefix=" out)
                       (string-append "--with-modulesdir=" out
                                      "/lib/ldb/modules")
                       "--bundled-libraries=NONE")))))))
    (native-inputs
     `(("cmocka" ,cmocka)
       ("pkg-config" ,pkg-config)
       ("python" ,python)
       ("which" ,which)))
    (propagated-inputs
     ;; ldb.pc refers to all these.
     `(("talloc" ,talloc)
       ("tdb" ,tdb)))
    (inputs
     `(,@(if (target-64bit?)
             `(("lmdb" ,lmdb))
             '())
       ("popt" ,popt)
       ("tevent" ,tevent)))
    (synopsis "LDAP-like embedded database")
    (home-page "https://ldb.samba.org/")
    (description
     "Ldb is a LDAP-like embedded database built on top of TDB.  What ldb does
is provide a fast database with an LDAP-like API designed to be used within an
application.  In some ways it can be seen as a intermediate solution between
key-value pair databases and a real LDAP database.")
    (license lgpl3+)))

(define-public ppp
  (package
    (name "ppp")
    (version "2.4.9")
    (source (origin
              (method git-fetch)
              (uri (git-reference
                    (url "https://github.com/paulusmack/ppp")
                    (commit version)))
              (file-name (git-file-name name version))
              (sha256
               (base32
                "1bhhksdclsnkw54a517ndrw55q5zljjbh9pcqz1z4a2z2flxpsgk"))))
    (build-system gnu-build-system)
    (arguments
     '(#:tests? #f                    ; no check target
       #:make-flags '("CC=gcc")
       #:phases
       (modify-phases %standard-phases
         (add-before 'configure 'patch-Makefile
           (lambda* (#:key inputs #:allow-other-keys)
             (let ((libc    (assoc-ref inputs "libc"))
                   (openssl (assoc-ref inputs "openssl"))
                   (libpcap (assoc-ref inputs "libpcap")))
               (substitute* "pppd/Makefile.linux"
                 (("/usr/include/crypt\\.h")
                  (string-append libc "/include/crypt.h"))
                 (("/usr/include/openssl")
                  (string-append openssl "/include/openssl"))
                 (("/usr/include/pcap-bpf.h")
                  (string-append libpcap "/include/pcap-bpf.h")))
               #t))))))
    (inputs
     `(("libpcap" ,libpcap)
       ("openssl" ,(@ (gnu packages tls) openssl))))
    (synopsis "Implementation of the Point-to-Point Protocol")
    (home-page "https://ppp.samba.org/")
    (description
     "The Point-to-Point Protocol (PPP) provides a standard way to establish
a network connection over a serial link.  At present, this package supports IP
and IPV6 and the protocols layered above them, such as TCP and UDP.")
    ;; pppd, pppstats and pppdump are under BSD-style notices.
    ;; some of the pppd plugins are GPL'd.
    ;; chat is public domain.
    (license (list bsd-3 bsd-4 gpl2+ public-domain))))


code:
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 Sou Bunnbu <iyzsong@gmail.com>
;;; Copyright © 2018 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2019 Benjamin Slade <slade@jnanam.net>
;;; Copyright © 2019 Arun Isaac <arunisaac@systemreboot.net>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (gnu packages sawfish)
  #:use-module ((guix licenses) #:select (gpl2+))
  #:use-module (guix packages)
  #:use-module (guix download)
  #:use-module (guix build-system gnu)
  #:use-module (gnu packages)
  #:use-module (gnu packages autotools)
  #:use-module (gnu packages dbm)
  #:use-module (gnu packages gettext)
  #:use-module (gnu packages gtk)
  #:use-module (gnu packages libffi)
  #:use-module (gnu packages multiprecision)
  #:use-module (gnu packages pkg-config)
  #:use-module (gnu packages readline)
  #:use-module (gnu packages texinfo)
  #:use-module (gnu packages base)
  #:use-module (gnu packages xorg))

(define-public librep
  (package
    (name "librep")
    (version "0.92.7")
    (source (origin
              (method url-fetch)
              (uri (string-append "http://download.tuxfamily.org/librep/"
                                  "librep_" version ".tar.xz"))
              (sha256
               (base32
                "1bmcjl1x1rdh514q9z3hzyjmjmwwwkziipjpjsl301bwmiwrd8a8"))))
    (build-system gnu-build-system)
    (native-inputs
     `(("makeinfo"   ,texinfo)
       ("pkg-config" ,pkg-config)

       ("autoconf" ,autoconf)
       ("automake" ,automake)
       ("libtool"  ,libtool)))
    (inputs
     `(("gdbm"     ,gdbm)
       ("gmp"      ,gmp)
       ("libffi"   ,libffi)
       ("readline" ,readline)))
    (native-search-paths
     (list (search-path-specification
            (variable "REP_DL_LOAD_PATH")
            (files '("lib/rep")))))
    (home-page "https://sawfish.fandom.com/wiki/Librep")
    (synopsis "Lisp system for sawfish")
    (description
     "Librep is a dialect of Lisp, designed to be used both as an extension
language for applications and as a general purpose programming language.  It
was originally written to be mostly-compatible with Emacs Lisp, but has
subsequently diverged markedly.  Its aim is to combine the best features of
Scheme and Common Lisp and provide an environment that is comfortable for
implementing both small and large scale systems.")
    (license gpl2+)))

(define-public rep-gtk
  (package
    (name "rep-gtk")
    (version "0.90.8.3")
    (source (origin
              (method url-fetch)
              (uri (string-append "https://download.tuxfamily.org/librep/"
                                  name "/" name "_" version ".tar.xz"))
              (sha256
               (base32
                "0hgkkywm8zczir3lqr727bn7ybgg71x9cwj1av8fykkr8pdpard9"))
              (modules '((guix build utils)))
              (snippet
               '(begin
                  (substitute* "Makefile.in"
                    (("installdir=\\$\\(repexecdir\\)")
                     ;; Install libraries for librep to $out/lib/rep.
                     "installdir=$(libdir)/rep"))
                  #t))))
    (build-system gnu-build-system)
    (arguments
     `(#:tests? #f ; no tests
       #:phases
       (modify-phases %standard-phases
         (add-before 'bootstrap 'remove-autogen
           (lambda _
             ;; Remove autogen.sh so that the bootstrap phase can run
             ;; autoreconf.
             (delete-file "autogen.sh")
             #t)))))
    (native-inputs
     `(("autoconf" ,autoconf)
       ("automake" ,automake)
       ("libtool" ,libtool)
       ("pkg-config" ,pkg-config)))
    (propagated-inputs
     ;; required by rep-gtk.pc.
     `(("gtk+"   ,gtk+-2)
       ("librep" ,librep)))
    (home-page "https://sawfish.fandom.com/wiki/Rep-GTK")
    (synopsis "GTK+ binding for librep")
    (description
     "Rep-GTK is a GTK+ (and GLib, GDK) binding to the librep, and one of the
backend of Sawfish.")
    (license gpl2+)))

(define-public sawfish
  (package
    (name "sawfish")
    (version "1.12.0")
    (source (origin
              (method url-fetch)
              (uri (string-append "https://download.tuxfamily.org/sawfish/"
                                  name "_" version ".tar.xz"))
              (sha256
               (base32
                "1z7awzgw8d15aw17kpbj460pcxq8l2rhkaxk47w7yg9qrmg0xja4"))
              (modules '((guix build utils)))
              (snippet
               '(begin
                  (substitute* "Makedefs.in"
                    (("/bin/sh") "@SHELL@")
                    (("REP_DL_LOAD_PATH=")
                     ;; To find rep-gtk when building sawfish.
                     "REP_DL_LOAD_PATH=$(REP_DL_LOAD_PATH):"))
                  (substitute* "src/Makefile.in"
                    ;; Install libraries for librep to $out/lib/rep.
                    (("\\$\\(repexecdir\\)") "$(libdir)/rep"))
                  #t))))
    (build-system gnu-build-system)
    (arguments
     '(#:tests? #f ; no tests
       #:phases
       (modify-phases %standard-phases
         (add-before 'configure 'patch-exec-rep
           (lambda _
             (substitute* '("lisp/sawfish/cfg/main.jl.in"
                            "scripts/sawfish-about.jl.in"
                            "scripts/sawfish-client.jl"
                            "scripts/sawfish-menu.jl")
               (("exec rep") (string-append "exec " (which "rep"))))
             #t))
         (add-after 'install 'wrap-scripts
           ;; Wrap scripts with REP_DL_LOAD_PATH for finding rep-gtk
           ;; and sawfish.client.
           (lambda* (#:key outputs #:allow-other-keys)
             (define (wrap-script script)
               (let ((out (assoc-ref outputs "out")))
                 (wrap-program (string-append out script)
                   `("REP_DL_LOAD_PATH" =
                     ,(list (getenv "REP_DL_LOAD_PATH")
                            (string-append out "/lib/rep"))))))
             (for-each wrap-script
                       (list "/bin/sawfish-about"
                             "/bin/sawfish-client"
                             "/bin/sawfish-config"
                             "/lib/sawfish/sawfish-menu"))
             #t)))))
    (native-inputs
     `(("gettext"     ,gettext-minimal)
       ("makeinfo"    ,texinfo)
       ("pkg-config"  ,pkg-config)
       ("which"       ,which)))
    (inputs
     `(("libsm"       ,libsm)
       ("libxft"      ,libxft)
       ("libxinerama" ,libxinerama)
       ("libxrandr"   ,libxrandr)
       ("libxtst"     ,libxtst)
       ("rep-gtk"     ,rep-gtk)))
    (home-page "https://sawfish.tuxfamily.org")
    (synopsis "Configurable window manager")
    (description
     "Sawfish is an extensible window manager using a Lisp-based scripting
language.  Its policy is very minimal compared to most window managers.  Its aim
is simply to manage windows in the most flexible and attractive manner possible.
All high-level WM functions are implemented in Lisp for future extensibility or
redefinition.")
    (license gpl2+)))

repo_name: maximed/guix

license: mit


code:
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 John Darrington <jmd@gnu.org>
;;; Copyright © 2015 Andy Wingo <wingo@igalia.com>
;;; Copyright © 2016 Andy Patterson <ajpatter@uwaterloo.ca>
;;; Copyright © 2017, 2019, 2020 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2018 Efraim Flashner <efraim@flashner.co.il>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (gnu packages scanner)
  #:use-module (gnu packages)
  #:use-module (gnu packages autotools)
  #:use-module (gnu packages freedesktop)
  #:use-module (gnu packages gettext)
  #:use-module (gnu packages ghostscript)
  #:use-module (gnu packages gtk)
  #:use-module (gnu packages image)
  #:use-module (gnu packages libusb)
  #:use-module (gnu packages pkg-config)
  #:use-module (gnu packages python)
  #:use-module (gnu packages xml)
  #:use-module (guix build-system gnu)
  #:use-module (guix download)
  #:use-module (guix git-download)
  #:use-module ((guix licenses)
                #:prefix license:)
  #:use-module (guix packages)
  #:use-module (guix utils))

(define-public sane-backends-minimal
  (package
    (name "sane-backends-minimal")
    (version "1.0.32")
    (source (origin
             (method git-fetch)
             (uri (git-reference
                   (url "https://gitlab.com/sane-project/backends")
                   (commit version)))
             (file-name (git-file-name name version))
             (sha256
              (base32 "13jlqdp7n7z2n78v6idl3ri5idk7ddk9j8wrmh73lba8l9y8xnsi"))
             (modules '((guix build utils)))
             (snippet
              ;; Generated HTML files and udev rules normally embed a
              ;; timestamp.  Work around that to build things reproducibly.
              '(begin
                 (substitute* "tools/sane-desc.c"
                   (("asctime \\(localtime \\(&current_time\\)\\)")
                    "\"1970-01-01\""))))))
    (build-system gnu-build-system)
    (native-inputs
     `(("autoconf" ,autoconf)
       ("autoconf-archive" ,autoconf-archive)
       ("automake" ,automake)
       ("gettext" ,gettext-minimal)
       ("libtool" ,libtool)
       ("pkg-config" ,pkg-config)
       ;; For scripts/pixma_gen_options.py.
       ("python" ,python-wrapper)))
    (inputs
     `(("libusb" ,libusb)))
    (arguments
     `(#:phases
       (modify-phases %standard-phases
         (add-before 'bootstrap 'zap-unnecessary-git-dependency
           (lambda _
             ;; This runs before default patch-shebangs phase.
             (substitute* "tools/git-version-gen"
               (("/bin/sh") (which "sh")))
             (with-output-to-file ".tarball-version"
               (lambda _ (format #t ,version)))))
         (add-before 'configure 'disable-backends
           (lambda _
             (setenv "BACKENDS" " ")

             ;; Disable tests that may require back ends to be built.
             (substitute* "testsuite/Makefile.in"
               ((" backend ") " "))))
         (add-before 'configure 'disable-failing-tests
           (lambda _
             ;; Disable unmaintained tests that that fail with errors resembling:
             ;;
             ;; < # by sane-desc 3.5 from sane-backends 1.0.24git on Jul 31 2013
             ;; ---
             ;; > # by sane-desc 3.5 from sane-backends 1.0.27 on 1970-01-01#
             ;; FAIL: sane-desc -m usermap -s ./data
             (for-each
              (lambda (pattern)
                (substitute* "testsuite/tools/Makefile.in"
                  (((string-append " " pattern " ")) " ")))
              (list "usermap" "db" "udev" "udev\\+acl" "udev\\+hwdb" "hwdb"))

             ;; Disable tests that try to connect to actual USB hardware & fail
             ;; with the following error when no USB access is allowed at all:
             ;;
             ;; sanei_usb_test: sanei_usb_test.c:849: main: Assertion
             ;; `test_init (1)' failed.
             (substitute* "testsuite/sanei/Makefile.in"
               (("sanei_usb_test\\$\\(EXEEXT\\) ") ""))))
         (add-before 'build 'build-pixma_sane_options.c
           ;; "No rule to make target '../backend/pixma/pixma_sane_options.c',
           ;; needed by 'sane-backends.pot-update'."
           (lambda _
             (invoke "make" "-C" "backend" "pixma/pixma_sane_options.c")))
         (add-after 'install 'install-udev-rules
           (lambda* (#:key outputs #:allow-other-keys)
             (let ((out (assoc-ref outputs "out")))
               (mkdir-p (string-append out "/lib/udev/rules.d"))
               (copy-file "tools/udev/libsane.rules"
                          (string-append out
                                         "/lib/udev/rules.d/"
                                         "60-libsane.rules")))))
         (add-after 'install 'make-reproducible
           ;; XXX Work around an old bug <https://issues.guix.gnu.org/26247>.
           ;; Then work around "Throw to key `decoding-error' ..." by using sed.
           (lambda* (#:key outputs #:allow-other-keys)
             (let* ((out (assoc-ref outputs "out"))
                    (locale (string-append out "/share/locale")))
               (with-directory-excursion locale
                 (for-each (lambda (file)
                             (invoke "sed" "-i" "/^PO-Revision-Date:/d" file))
                           (list "en@boldquot/LC_MESSAGES/sane-backends.mo"
                                 "en@quot/LC_MESSAGES/sane-backends.mo")))))))))
    (home-page "http://www.sane-project.org")
    (synopsis
     "Raster image scanner library and drivers, without scanner support")
    (description "SANE stands for \"Scanner Access Now Easy\" and is an API
proving access to any raster image scanner hardware (flatbed scanner,
hand-held scanner, video- and still-cameras, frame-grabbers, etc.).  The
package contains the library, but no drivers.")
    (license license:gpl2+))) ; plus linking exception

;; This variant links in the hpaio backend provided by hplip, which adds
;; support for HP scanners whose backends are not maintained by the SANE
;; project, and builds all of those backends.
(define-public sane-backends
  (package/inherit sane-backends-minimal
    (name "sane-backends")
    (inputs
     `(("hplip" ,(@ (gnu packages cups) hplip-minimal))
       ("libjpeg" ,libjpeg-turbo)       ; for pixma/epsonds/other back ends
       ("libpng" ,libpng)               ; support ‘scanimage --format=png’
       ("libxml2" ,libxml2)             ; for pixma back end
       ,@(package-inputs sane-backends-minimal)))
    (arguments
     (substitute-keyword-arguments (package-arguments sane-backends-minimal)
       ((#:phases phases)
        `(modify-phases ,phases
           (delete 'disable-backends)
           (add-after 'disable-failing-tests 'disable-failing-backend-tests
             (lambda _
               ;; Disable test that fails on i686:
               ;;   <https://bugs.gnu.org/39449>
               (substitute* "testsuite/backend/genesys/Makefile.in"
                 ((" genesys_unit_tests\\$\\(EXEEXT\\)") ""))
               #t))
           (add-after 'unpack 'add-backends
             (lambda _
               (substitute* "backend/dll.conf.in"
                 (("hp5590" all) (format #f "~a~%~a" all "hpaio")))
               #t))
           (add-after 'install 'install-hpaio
             (lambda* (#:key inputs outputs #:allow-other-keys)
               (define hplip (string-append (assoc-ref inputs "hplip")
                                            "/lib/sane"))
               (define out (string-append (assoc-ref outputs "out")
                                          "/lib/sane"))
               (for-each
                (lambda (file)
                  (symlink file (string-append out "/" (basename file))))
                (find-files hplip))
               #t))))))
    (synopsis
     "Raster image scanner library and drivers, with scanner support")
    (description "SANE stands for \"Scanner Access Now Easy\" and is an API
proving access to any raster image scanner hardware (flatbed scanner,
hand-held scanner, video- and still-cameras, frame-grabbers, etc.).  The
package contains the library and drivers.")))

(define-public xsane
  (package
    (name "xsane")
    (version "0.999")
    (source
     (origin
       (method git-fetch)
       (uri (git-reference
             (url "https://gitlab.com/sane-project/frontend/xsane.git")
             (commit version)))
       (file-name (git-file-name name version))
       (sha256
        (base32 "08zvxj7i1s88ckrsqldmsrikc3g62a6p3s3i5b5x4krcfpi3vs50"))
       ;; Apply some important-looking fixes.  There are many more unreleased
       ;; commits upstream.  A 1.0 release is planned.
       (patches (search-patches "xsane-fix-memory-leak.patch"
                                "xsane-fix-pdf-floats.patch"
                                "xsane-fix-snprintf-buffer-length.patch"
                                "xsane-support-ipv6.patch"
                                "xsane-tighten-default-umask.patch"))
       (modules '((guix build utils)))
       (snippet
        '(begin
           ;; Remove ancient bundled lprng code under a non-free licence.  See
           ;; <https://trisquel.info/en/issues/10713>, which solves the problem
           ;; by replacing it with a newer (free) copy.  We let the build fall
           ;; back to the system version instead, which appears to work fine.
           (delete-file "lib/snprintf.c")
           (substitute* "lib/Makefile.in"
             (("snprintf\\.o ") ""))
           #t))))
    (build-system gnu-build-system)
    (arguments
     `(#:make-flags
       (list (string-append "xsanedocdir=" (assoc-ref %outputs "out")
                            "/share/doc/" ,name "-" ,version))
       #:tests? #f                                ; no test suite
       #:phases
       (modify-phases %standard-phases
         (add-after 'unpack 'patch-invalid-dereference
           ;; Fix the following compilation error with libpng:
           ;;   xsane-save.c: In function ‘xsane_save_png’:
           ;;   xsane-save.c:4913:21: error: dereferencing pointer to
           ;;   incomplete type ‘png_struct {aka struct png_struct_def}’
           ;;       if (setjmp(png_ptr->jmpbuf))
           ;;                         ^
           (lambda _
             (substitute* "src/xsane-save.c"
               (("png_ptr->jmpbuf") "png_jmpbuf(png_ptr)"))
             #t))
         (add-after 'unpack 'use-sane-help-browser
           (lambda _
             (substitute* "src/xsane.h"
               (("netscape") (which "xdg-open")))
             #t))
         (add-after 'install 'delete-empty-/sbin
           (lambda* (#:key outputs #:allow-other-keys)
             (let ((out (assoc-ref outputs "out")))
               (rmdir (string-append out "/sbin"))
               #t))))))
    (native-inputs
     `(("pkg-config" ,pkg-config)))
    (inputs
     `(("gtk+" ,gtk+-2)
       ("lcms" ,lcms)
       ("libjpeg" ,libjpeg-turbo)
       ("libtiff" ,libtiff)
       ("sane-backends" ,sane-backends)

       ;; To open the manual from the Help menu.
       ("xdg-utils" ,xdg-utils)))
    (home-page "https://gitlab.com/sane-project/frontend/xsane")
    (synopsis "Featureful graphical interface for document and image scanners")
    (description
     "XSane is a graphical interface for controlling a scanner and acquiring
images from it.  You can photocopy multi-page documents and save, fax, print,
or e-mail your scanned images.  It is highly configurable and exposes all
device settings, letting you fine-tune the final result.  It can also be used
as a GIMP plugin to acquire images directly from a scanner.

XSane talks to scanners through the @acronym{SANE, Scanner Access Now Easy}
back-end library, which supports almost all existing scanners.")
    (license license:gpl2+)))


code:
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015, 2016, 2018, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015 Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.com>
;;; Copyright © 2015, 2016 Federico Beffa <beffa@fbengineering.ch>
;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2016, 2017, 2020 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2016, 2017 Nikita <nikita@n0.is>
;;; Copyright © 2017 John Darrington <jmd@gnu.org>
;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org>
;;; Copyright © 2017, 2018, 2019, 2020 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2018 Adam Massmann <massmannak@gmail.com>
;;; Copyright © 2018 Gabriel Hondet <gabrielhondet@gmail.com>
;;; Copyright © 2020 Pierre Neidhardt <mail@ambrevar.xyz>
;;; Copyright © 2020 Brett Gilio <brettg@gnu.org>
;;; Copyright © 2020 Edouard Klein <edk@beaver-labs.com>
;;; Copyright © 2021 Philip McGrath <philip@philipmcgrath.com>
;;; Copyright © 2021 Guillaume Le Vaillant <glv@posteo.net>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (gnu packages scheme)
  #:use-module (gnu packages)
  #:use-module ((guix licenses)
                #:select (gpl2+ lgpl2.0+ lgpl2.1 lgpl2.1+ lgpl3+ asl2.0 bsd-3
                          cc-by-sa4.0 non-copyleft expat))
  #:use-module (guix packages)
  #:use-module (guix download)
  #:use-module (guix git-download)
  #:use-module (guix utils)
  #:use-module (guix build-system gnu)
  #:use-module (guix build-system trivial)
  #:use-module (gnu packages autotools)
  #:use-module (gnu packages bdw-gc)
  #:use-module (gnu packages bash)
  #:use-module (gnu packages compression)
  #:use-module (gnu packages databases)
  #:use-module (gnu packages libevent)
  #:use-module (gnu packages libunistring)
  #:use-module (gnu packages m4)
  #:use-module (gnu packages multiprecision)
  #:use-module (gnu packages ncurses)
  #:use-module (gnu packages pcre)
  #:use-module (gnu packages emacs)
  #:use-module (gnu packages ghostscript)
  #:use-module (gnu packages netpbm)
  #:use-module (gnu packages texinfo)
  #:use-module (gnu packages tex)
  #:use-module (gnu packages base)
  #:use-module (gnu packages compression)
  #:use-module (gnu packages pkg-config)
  #:use-module (gnu packages avahi)
  #:use-module (gnu packages libphidget)
  #:use-module (gnu packages gcc)
  #:use-module (gnu packages glib)
  #:use-module (gnu packages gtk)
  #:use-module (gnu packages libffi)
  #:use-module (gnu packages fontutils)
  #:use-module (gnu packages image)
  #:use-module (gnu packages xorg)
  #:use-module (gnu packages sqlite)
  #:use-module (gnu packages tls)
  #:use-module (gnu packages gl)
  #:use-module (gnu packages libedit)
  #:use-module (gnu packages linux)
  #:use-module (srfi srfi-1)
  #:use-module (ice-9 match))

(define (mit-scheme-source-directory system version)
  (string-append "mit-scheme-"
                 (if (or (string-prefix? "x86_64" system)
                         (string-prefix? "i686" system))
                     ""
                     "c-")
                 version))

(define-public mit-scheme
  (package
    (name "mit-scheme")
    (version "10.1.3")
    (source #f)                                   ; see below
    (outputs '("out" "doc"))
    (build-system gnu-build-system)
    (arguments
     `(#:modules ((guix build gnu-build-system)
                  (guix build utils)
                  (srfi srfi-1))
       #:phases
       (modify-phases %standard-phases
         (replace 'unpack
           (lambda* (#:key inputs #:allow-other-keys)
             (invoke "tar" "xzvf"
                     (assoc-ref inputs "source"))
             (chdir ,(mit-scheme-source-directory (%current-system)
                                                  version))
             ;; Delete these dangling symlinks since they break
             ;; `patch-shebangs'.
             (for-each delete-file
                       (find-files "src/compiler" "^make\\."))
             (chdir "src")
             #t))
         (add-after 'unpack 'patch-/bin/sh
           (lambda _
             (setenv "CONFIG_SHELL" (which "sh"))
             (substitute* '("../tests/ffi/autogen.sh"
                            "../tests/ffi/autobuild.sh"
                            "../tests/ffi/test-ffi.sh"
                            "../tests/runtime/test-process.scm"
                            "runtime/unxprm.scm")
               (("/bin/sh") (which "sh"))
               (("\\./autogen\\.sh")
                (string-append (which "sh") " autogen.sh"))
               (("\\./configure")
                (string-append (which "sh") " configure")))
             #t))
         ;; FIXME: the texlive-union insists on regenerating fonts.  It stores
         ;; them in HOME, so it needs to be writeable.
         (add-before 'build 'set-HOME
           (lambda _ (setenv "HOME" "/tmp") #t))
         (replace 'build
           (lambda* (#:key system outputs #:allow-other-keys)
             (let ((out (assoc-ref outputs "out")))
               (if (or (string-prefix? "x86_64" system)
                       (string-prefix? "i686" system))
                   (invoke "make" "compile-microcode")
                   (invoke "./etc/make-liarc.sh"
                           (string-append "--prefix=" out)))
               #t)))
         (add-after 'configure 'configure-doc
           (lambda* (#:key outputs inputs #:allow-other-keys)
             (with-directory-excursion "../doc"
               (let* ((out (assoc-ref outputs "out"))
                      (bash (assoc-ref inputs "bash"))
                      (bin/sh (string-append bash "/bin/sh")))
                 (invoke bin/sh "./configure"
                         (string-append "--prefix=" out)
                         (string-append "SHELL=" bin/sh))
                 #t))))
         (add-after 'build 'build-doc
           (lambda* _
             (with-directory-excursion "../doc"
               (invoke "make"))
             #t))
         (add-after 'install 'install-doc
           (lambda* (#:key outputs #:allow-other-keys)
             (let* ((out (assoc-ref outputs "out"))
                    (doc (assoc-ref outputs "doc"))
                    (old-doc-dir (string-append out "/share/doc"))
                    (new-doc/mit-scheme-dir
                     (string-append doc "/share/doc/" ,name "-" ,version)))
               (with-directory-excursion "../doc"
                 (for-each (lambda (target)
                             (invoke "make" target))
                           '("install-info-gz" "install-man"
                             "install-html" "install-pdf")))
               (mkdir-p new-doc/mit-scheme-dir)
               (copy-recursively
                (string-append old-doc-dir "/" ,name)
                new-doc/mit-scheme-dir)
               (delete-file-recursively old-doc-dir)
               #t))))))
    (native-inputs
     `(;; Autoconf, Automake, and Libtool are necessary for the FFI tests.
       ("autoconf" ,autoconf)
       ("automake" ,automake)
       ("libtool" ,libtool)
       ("texlive" ,(texlive-union (list texlive-tex-texinfo)))
       ("texinfo" ,texinfo)
       ("m4" ,m4)))
    (inputs
     `(("libx11" ,libx11)

       ("source"

        ;; MIT/GNU Scheme is not bootstrappable, so it's recommended to
        ;; compile from the architecture-specific tarballs, which contain
        ;; pre-built binaries.  It leads to more efficient code than when
        ;; building the tarball that contains generated C code instead of
        ;; those binaries.
        ,(origin
          (method url-fetch)
          (uri (string-append "mirror://gnu/mit-scheme/stable.pkg/"
                              version "/mit-scheme-"
                              (match (%current-system)
                                ("x86_64-linux"
                                 (string-append version "-x86-64"))
                                ("i686-linux"
                                 (string-append version "-i386"))
                                (_
                                 (string-append "c-" version)))
                              ".tar.gz"))
          (sha256
           (match (%current-system)
             ("x86_64-linux"
              (base32
               "03m7cc035w3avs91j2pcz9f15ssgvgp3rm045d1vbydqrkzfyw8k"))
             ("i686-linux"
              (base32
               "05sjyz90xxfnmi87qv8x0yx0fcallnzl1dciygdafp317pn489is"))
             (_
              (base32
               "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"))))))))

    ;; Fails to build on MIPS, see <http://bugs.gnu.org/18221>.
    ;; Also, the portable C version of MIT/GNU Scheme did not work in time for
    ;; release in version 10.1.
    (supported-systems '("x86_64-linux" "i686-linux"))

    (home-page "https://www.gnu.org/software/mit-scheme/")
    (synopsis "A Scheme implementation with integrated editor and debugger")
    (description
     "GNU/MIT Scheme is an implementation of the Scheme programming
language.  It provides an interpreter, a compiler and a debugger.  It also
features an integrated Emacs-like editor and a large runtime library.")
    (license gpl2+)
    (properties '((ftp-directory . "/gnu/mit-scheme/stable.pkg")))))

(define-public bigloo
  ;; Upstream modifies source tarballs in place, making significant changes
  ;; long after the initial publication: <https://bugs.gnu.org/33525>.
  (let ((upstream-version "4.3g"))
    (package
      (name "bigloo")
      (version "4.3g")
      (source (origin
                (method url-fetch)
                (uri (string-append "ftp://ftp-sop.inria.fr/indes/fp/Bigloo/bigloo"
                                    upstream-version ".tar.gz"))
                (sha256
                 (base32
                  "07305c134v7s1nz44igwsyqpb9qqia5zyng1q2qj60sskw3nbd67"))
                ;; Remove bundled libraries.
                (modules '((guix build utils)))
                (snippet
                 '(begin
                    (for-each delete-file-recursively
                              '("gc" "gmp" "libuv" "libunistring" "pcre"))
                    #t))))
      (build-system gnu-build-system)
      (arguments
       `(#:test-target "test"
         #:phases
         (modify-phases %standard-phases
           (add-after 'unpack 'fix-gmp-detection
             (lambda _
               (substitute* "configure"
                 (("gmpversion=`\\$autoconf gmp --lib=\\$gmplib`")
                  "gmpversion=`\\$autoconf gmp --lib=\"\\$gmplib\"`"))))
           (replace 'configure
             (lambda* (#:key inputs outputs #:allow-other-keys)

               (substitute* "configure"
                 (("^shell=.*$")
                  (string-append "shell=" (which "bash") "\n"))
                 (("`date`") "0"))
               (substitute* "autoconf/runtest.in"
                 ((", @DATE@") ""))
               (substitute* "autoconf/osversion"
                 (("^version.*$") "version=\"\"\n"))
               (substitute* "comptime/Makefile"
                 (("\\$\\(LDCOMPLIBS\\)")
                  "$(LDCOMPLIBS) $(LDFLAGS)"))

               ;; The `configure' script doesn't understand options
               ;; of those of Autoconf.
               (let ((out (assoc-ref outputs "out")))
                 (invoke "./configure"
                         (string-append "--prefix=" out)
                                                  ; use system libraries
                         "--customgc=no"
                         "--enable-gmp"
                         "--customgmp=no"
                         "--customunistring=no"
                         "--customlibuv=no"
                         (string-append"--mv=" (which "mv"))
                         (string-append "--rm=" (which "rm"))
                         "--cflags=-fPIC"
                         (string-append "--ldflags=-Wl,-rpath="
                                        (assoc-ref outputs "out")
                                        "/lib/bigloo/" ,upstream-version)
                         (string-append "--lispdir=" out
                                        "/share/emacs/site-lisp")
                         "--sharedbde=yes"
                         "--sharedcompiler=yes"
                         "--disable-patch"))))
           (add-after 'install 'install-emacs-modes
             (lambda* (#:key outputs #:allow-other-keys)
               (let* ((out (assoc-ref outputs "out"))
                      (dir (string-append out "/share/emacs/site-lisp")))
                 (invoke "make" "-C" "bmacs" "all" "install"
                         (string-append "EMACSBRAND=emacs25")
                         (string-append "EMACSDIR=" dir))))))))
      (inputs
       `(("emacs" ,emacs)                     ;UDE needs the X version of Emacs
         ("libgc" ,libgc)
         ("libunistring" ,libunistring)
         ("libuv" ,libuv)
         ("openssl" ,openssl)
         ("sqlite" ,sqlite)

         ;; Optional APIs for which Bigloo has bindings.
         ("avahi" ,avahi)
         ("libphidget" ,libphidget)
         ("pcre" ,pcre)))
      (native-inputs
       `(("pkg-config" ,pkg-config)))
      (propagated-inputs
       `(("gmp" ,gmp)))                            ; bigloo.h refers to gmp.h
      (home-page "https://www-sop.inria.fr/indes/fp/Bigloo/")
      (synopsis "Efficient Scheme compiler")
      (description
       "Bigloo is a Scheme implementation devoted to one goal: enabling Scheme
based programming style where C(++) is usually required.  Bigloo attempts to
make Scheme practical by offering features usually presented by traditional
programming languages but not offered by Scheme and functional programming.
Bigloo compiles Scheme modules.  It delivers small and fast stand alone binary
executables.  Bigloo enables full connections between Scheme and C programs
and between Scheme and Java programs.")
      (license gpl2+))))

(define-public hop
  (package
    (name "hop")
    (version "3.2.0-pre1")
    (source (origin
             (method url-fetch)
             (uri (string-append "ftp://ftp-sop.inria.fr/indes/fp/Hop/hop-"
                                 version ".tar.gz"))
             (sha256
              (base32
               "0jf418d0s9imv98s6qrpjxr1mdaxr37knh5qyfl5y4a9cc41mlg5"))))
    (build-system gnu-build-system)
    (arguments
     `(#:test-target "test"
       #:make-flags '("BIGLOO=bigloo")
       #:parallel-build? #f
       #:phases
       (modify-phases %standard-phases
         (replace 'configure
           (lambda* (#:key inputs outputs #:allow-other-keys)
             (let ((out (assoc-ref outputs "out")))
               (substitute* '("tools/Makefile"
                              "test/hopjs/TEST.in")
                 (("/bin/rm") (which "rm")))
               (invoke "./configure"
                       (string-append "--prefix=" out)
                       "--hostcc=gcc"
                       (string-append "--blflags="
                                      ;; user flags completely override useful
                                      ;; default flags, so repeat them here.
                                      "-copt \\$(CPICFLAGS) "
                                      "-L \\$(BUILDLIBDIR) "
                                      "-ldopt -Wl,-rpath," out "/lib"))))))))
    (inputs `(("avahi" ,avahi)
              ("bigloo" ,bigloo)
              ("libgc" ,libgc)
              ("libunistring" ,libunistring)
              ("libuv" ,libuv)
              ("pcre" ,pcre)
              ("sqlite" ,sqlite)
              ("which" ,which)))
    (home-page "http://hop.inria.fr/")
    (synopsis "Multi-tier programming language for the Web 2.0")
    (description
     "HOP is a multi-tier programming language for the Web 2.0 and the
so-called diffuse Web.  It is designed for programming interactive web
applications in many fields such as multimedia (web galleries, music players,
...), ubiquitous and house automation (SmartPhones, personal appliance),
mashups, office (web agendas, mail clients, ...), etc.")
    (license gpl2+)))

(define-public scheme48
  (package
    (name "scheme48")
    (version "1.9.2")
    (source (origin
             (method url-fetch)
             (uri (string-append "http://s48.org/" version
                                 "/scheme48-" version ".tgz"))
             (sha256
              (base32
               "1x4xfm3lyz2piqcw1h01vbs1iq89zq7wrsfjgh3fxnlm1slj2jcw"))
             (patches (search-patches "scheme48-tests.patch"))))
    (build-system gnu-build-system)
    (home-page "http://s48.org/")
    (synopsis "Scheme implementation using a bytecode interpreter")
    (description
     "Scheme 48 is an implementation of Scheme based on a byte-code
interpreter and is designed to be used as a testbed for experiments in
implementation techniques and as an expository tool.")

    ;; Most files are BSD-3; see COPYING for the few exceptions.
    (license bsd-3)))

(define-public gambit-c
  (package
    (name "gambit-c")
    (version "4.9.3")
    (source
     (origin
       (method url-fetch)
       (uri (string-append
             "http://www.iro.umontreal.ca/~gambit/download/gambit/v"
             (version-major+minor version) "/source/gambit-v"
             (string-map (lambda (c) (if (char=? c #\.) #\_ c)) version)
             ".tgz"))
       (sha256
        (base32 "1p6172vhcrlpjgia6hsks1w4fl8rdyjf9xjh14wxfkv7dnx8a5hk"))))
    (build-system gnu-build-system)
    (arguments
     '(#:configure-flags
       ;; According to the ./configure script, this makes the build slower and
       ;; use >= 1 GB memory, but makes Gambit much faster.
       '("--enable-single-host")))
    (home-page "http://dynamo.iro.umontreal.ca/wiki/index.php/Main_Page")
    (synopsis "Efficient Scheme interpreter and compiler")
    (description
     "Gambit consists of two main programs: gsi, the Gambit Scheme
interpreter, and gsc, the Gambit Scheme compiler.  The interpreter contains
the complete execution and debugging environment.  The compiler is the
interpreter extended with the capability of generating executable files.  The
compiler can produce standalone executables or compiled modules which can be
loaded at run time.  Interpreted code and compiled code can be freely
mixed.")
    ;; Dual license.
    (license (list lgpl2.1+ asl2.0))))

(define-public chibi-scheme
  (package
    (name "chibi-scheme")
    (version "0.9")
    (home-page "https://github.com/ashinn/chibi-scheme")
    (source
     (origin
       (method git-fetch)
       (uri (git-reference (url home-page) (commit version)))
       (file-name (git-file-name name version))
       (sha256
        (base32
         "1lnap41gl9vg82h557f4rlr69jgmd2gh0iqs6cxm77d39kv1scb8"))))
    (build-system gnu-build-system)
    (arguments
     `(#:phases (modify-phases %standard-phases
                  (delete 'configure)
                  (add-before 'build 'set-cc
                    (lambda _
                      (setenv "CC" "gcc"))))
       #:make-flags (let ((out (assoc-ref %outputs "out")))
                      (list (string-append "PREFIX=" out)
                            (string-append "LDFLAGS=-Wl,-rpath=" out "/lib")))
       #:test-target "test"))
    (synopsis "Small embeddable Scheme implementation")
    (description
     "Chibi-Scheme is a very small library with no external dependencies
intended for use as an extension and scripting language in C programs.  In
addition to support for lightweight VM-based threads, each VM itself runs in
an isolated heap allowing multiple VMs to run simultaneously in different OS
threads.")
    (license bsd-3)))

(define-public sicp
  (let ((commit "225c172f9b859902a64a3c5dd5e1f9ac1a7382de"))
    (package
      (name "sicp")
      (version (string-append "20170703-1." (string-take commit 7)))
      (source (origin
                (method git-fetch)
                (uri (git-reference
                      (url "https://github.com/sarabander/sicp")
                      (commit commit)))
                (sha256
                 (base32
                  "0bhdrdc1mgdjdsg4jksq9z6x129f3346jbf3zir2a0dfmsj6m10n"))
                (file-name (string-append name "-" version "-checkout"))))
      (build-system trivial-build-system)
      (native-inputs `(("gzip" ,gzip)
                       ("source" ,source)
                       ("texinfo" ,texinfo)))
      (arguments
       `(#:modules ((guix build utils))
         #:builder
         (begin
           (use-modules (guix build utils)
                        (srfi srfi-26))
           (let ((gzip (assoc-ref %build-inputs "gzip"))
                 (source (assoc-ref %build-inputs "source"))
                 (texinfo (assoc-ref %build-inputs "texinfo"))
                 (html-dir (string-append %output "/share/doc/" ,name "/html"))
                 (info-dir (string-append %output "/share/info")))
             (copy-recursively (string-append source "/html") html-dir)
             (setenv "PATH" (string-append gzip "/bin"
                                           ":" texinfo "/bin"))
             (mkdir-p info-dir)
             (invoke "makeinfo" "--output"
                     (string-append info-dir "/sicp.info")
                     (string-append source "/sicp-pocket.texi"))
             (for-each (cut invoke "gzip" "-9n" <>)
                       (find-files info-dir))
             #t))))
      (home-page "https://sarabander.github.io/sicp")
      (synopsis "Structure and Interpretation of Computer Programs")
      (description "Structure and Interpretation of Computer Programs (SICP) is
a textbook aiming to teach the principles of computer programming.

Using Scheme, a dialect of the Lisp programming language, the book explains
core computer science concepts such as abstraction in programming,
metalinguistic abstraction, recursion, interpreters, and modular programming.")
      (license cc-by-sa4.0))))

(define-public scheme48-rx
  (let* ((commit "dd9037f6f9ea01019390614f6b126b7dd293798d")
         (revision "2"))
    (package
      (name "scheme48-rx")
      (version (string-append "0.0.0-" revision "." (string-take commit 7)))
      (source
       (origin
         (method git-fetch)
         (uri (git-reference
               (url "https://github.com/scheme/rx")
               (commit commit)))
         (sha256
          (base32
           "1bvriavxw5kf2izjbil3999vr983vkk2xplfpinafr86m40b2cci"))
         (file-name (string-append name "-" version "-checkout"))))
      (build-system trivial-build-system)
      (arguments
       `(#:modules ((guix build utils))
         #:builder
         (begin
           (use-modules (guix build utils))
           (let ((share (string-append %output
                                       "/share/scheme48-"
                                       ,(package-version scheme48)
                                       "/rx")))
             (chdir (assoc-ref %build-inputs "source"))
             (mkdir-p share)
             (copy-recursively "." share)
             #t))))
      (native-inputs
       `(("source" ,source)
         ("scheme48" ,scheme48)))
      (home-page "https://github.com/scheme/rx/")
      (synopsis "SRE String pattern-matching library for scheme48")
      (description
       "String pattern-matching library for scheme48 based on the SRE
regular-expression notation.")
      (license bsd-3))))

(define-public slib
  (package
    (name "slib")
    (version "3b5")
    (source (origin
             (method url-fetch)
             (uri (string-append "http://groups.csail.mit.edu/mac/ftpdir/scm/slib-"
                                 version ".zip"))
             (sha256
              (base32
               "0q0p2d53p8qw2592yknzgy2y1p5a9k7ppjx0cfrbvk6242c4mdpq"))))
    (build-system gnu-build-system)
    (arguments
     `(#:tests? #f ; There is no check target.
       #:phases
       (modify-phases %standard-phases
         (add-after 'install 'remove-bin-share
                    (lambda* (#:key inputs outputs #:allow-other-keys)
                      (delete-file-recursively
                       (string-append (assoc-ref outputs "out") "/bin"))
                      #t))
         (replace 'configure
                  (lambda* (#:key inputs outputs #:allow-other-keys)
                    (invoke "./configure"
                            (string-append "--prefix="
                                           (assoc-ref outputs "out"))))))))
    (native-inputs `(("unzip" ,unzip)
                     ("texinfo" ,texinfo)))
    (home-page "https://people.csail.mit.edu/jaffer/SLIB.html")
    (synopsis "Compatibility and utility library for Scheme")
    (description "SLIB is a portable Scheme library providing compatibility and
utility functions for all standard Scheme implementations.")
    (license (non-copyleft
              "http://people.csail.mit.edu/jaffer/SLIB_COPYING.txt"
              "Or see COPYING in the distribution."))))

(define-public scm
  (package
    (name "scm")
    (version "5f3")
    (source (origin
              (method url-fetch)
              (uri (string-append
                    "http://groups.csail.mit.edu/mac/ftpdir/scm/scm-"
                    version ".zip"))
              (sha256
               (base32
                "1jxxlhmgal26mpcl97kz37djkn97rfy9h5pvw0hah6f3f6w49j97"))))
    (build-system gnu-build-system)
    (arguments
     `(#:phases
       (modify-phases %standard-phases
         (replace 'configure
                  (lambda* (#:key inputs outputs #:allow-other-keys)
                    (invoke "./configure"
                            (string-append "--prefix="
                                           (assoc-ref outputs "out")))))
         (add-before 'build 'pre-build
                     (lambda* (#:key inputs #:allow-other-keys)
                       (substitute* "Makefile"
                         (("ginstall-info") "install-info"))
                       #t))
         (replace 'build
                  (lambda* (#:key inputs outputs #:allow-other-keys)
                    (setenv "SCHEME_LIBRARY_PATH"
                            (string-append (assoc-ref inputs "slib")
                                           "/lib/slib/"))
                    (invoke "make" "scmlit" "CC=gcc")
                    (invoke "make" "all")))
         (add-after 'install 'post-install
                    (lambda* (#:key inputs outputs #:allow-other-keys)
                      (let* ((out         (assoc-ref outputs "out"))
                             (req (string-append out "/lib/scm/require.scm")))
                        (delete-file req)
                        (format (open req (logior O_WRONLY O_CREAT))
                                "(define (library-vicinity) ~s)\n"
                                (string-append (assoc-ref inputs "slib")
                                               "/lib/slib/"))

                        ;; We must generate the slibcat file.
                        (invoke (string-append out "/bin/scm")
                                "-br" "new-catalog")))))))
    (inputs `(("slib" ,slib)))
    (native-inputs `(("unzip" ,unzip)
                     ("texinfo" ,texinfo)))
    (home-page "https://people.csail.mit.edu/jaffer/SCM")
    (synopsis "Scheme implementation conforming to R5RS and IEEE P1178")
    (description "GNU SCM is an implementation of Scheme.  This
implementation includes Hobbit, a Scheme-to-C compiler, which can
generate C files whose binaries can be dynamically or statically
linked with a SCM executable.")
    (license lgpl3+)))

(define-public tinyscheme
  (package
    (name "tinyscheme")
    (version "1.42")
    (source (origin
              (method url-fetch)
              (uri (string-append "mirror://sourceforge/" name "/" name "/"
                                  name "-" version "/" name "-" version ".zip"))
              (sha256
               (base32
                "0rik3qnxqd8wjlazx8rw996pfzkjjg60v6hcbpcqzi7rgml8q4n8"))))
    (build-system gnu-build-system)
    (native-inputs
     `(("unzip" ,unzip)))
    (arguments
     `(#:phases
       (modify-phases %standard-phases
         (replace 'unpack
           (lambda* (#:key source #:allow-other-keys)
             (invoke "unzip" source)
             (chdir (string-append ,name "-" ,version))
             #t))
         (add-after 'unpack 'set-scm-directory
           ;; Hard-code ‘our’ init.scm instead of looking in the current
           ;; working directory, so invoking ‘scheme’ just works.
           (lambda* (#:key outputs #:allow-other-keys)
             (let* ((out (assoc-ref outputs "out"))
                    (scm (string-append out "/share/" ,name)))
               (substitute* "scheme.c"
                 (("init.scm" all)
                  (string-append scm "/" all)))
               #t)))
         (delete 'configure)            ; no configure script
         (replace 'install
           ;; There's no ‘install’ target.  Install files manually.
           (lambda* (#:key outputs #:allow-other-keys)
             (let* ((out     (assoc-ref outputs "out"))
                    (bin     (string-append out "/bin"))
                    (doc     (string-append out "/share/doc/"
                                            ,name "-" ,version))
                    (include (string-append out "/include"))
                    (lib     (string-append out "/lib"))
                    (scm     (string-append out "/share/" ,name)))
               (install-file "scheme" bin)
               (install-file "Manual.txt" doc)
               (install-file "scheme.h" include)
               (install-file "libtinyscheme.so" lib)
               (install-file "init.scm" scm)
               #t))))
       #:tests? #f))                    ; no tests
    (home-page "http://tinyscheme.sourceforge.net/")
    (synopsis "Light-weight interpreter for the Scheme programming language")
    (description
     "TinyScheme is a light-weight Scheme interpreter that implements as large a
subset of R5RS as was possible without getting very large and complicated.

It's meant to be used as an embedded scripting interpreter for other programs.
As such, it does not offer an Integrated Development Environment (@dfn{IDE}) or
extensive toolkits, although it does sport a small (and optional) top-level
loop.

As an embedded interpreter, it allows multiple interpreter states to coexist in
the same program, without any interference between them.  Foreign functions in C
can be added and values can be defined in the Scheme environment.  Being quite a
small program, it is easy to comprehend, get to grips with, and use.")
    (license bsd-3)))                   ; there are no licence headers

(define-public stalin
  (let ((commit "ed1c9e339c352b7a6fee40bb2a47607c3466f0be"))
    ;; FIXME: The Stalin "source" contains C code generated by itself:
    ;; 'stalin-AMD64.c', etc.
    (package
      (name "stalin")
      (version "0.11")
      (source (origin
                ;; Use Pearlmutter's upstream branch with AMD64 patches
                ;; applied. Saves us from including those 20M! patches
                ;; in Guix. For more info, see:
                ;; <ftp.ecn.purdue.edu/qobi/stalin-0.11-amd64-patches.tgz>
                (method git-fetch)
                (uri (git-reference
                      (url "https://github.com/barak/stalin")
                      (commit commit)))
                (file-name (string-append name "-" version "-checkout"))
                (sha256
                 (base32
                  "15a5gxj9v7jqlgkg0543gdflw0rbrir7fj5zgifnb33m074wiyhn"))
                (modules '((guix build utils)))
                (snippet
                 ;; remove gc libs from build, we have them as input
                 '(begin
                    (delete-file "gc6.8.tar.gz")
                    (delete-file-recursively "benchmarks")
                    (substitute* "build"
                      ((".*gc6.8.*") "")
                      (("  cd \\.\\.") "")
                      ((".*B include/libgc.a") "")
                      ((".*make.*") ""))
                    #t))))
      (build-system gnu-build-system)
      (arguments
       `(#:make-flags (list "ARCH_OPTS=-freg-struct-return")
         #:phases
         (modify-phases %standard-phases
           (replace 'configure
             (lambda* (#:key outputs #:allow-other-keys)
               (let* ((out (assoc-ref outputs "out"))
                      (include-out (string-append out "/include")))
                 (invoke "./build")
                 (for-each (lambda (fname)
                             (install-file fname include-out))
                           (find-files "include"))
                 (substitute* "makefile"
                   (("\\./include") include-out))
                 (substitute* "post-make"
                   (("`pwd`") out))
                 #t)))
           (delete 'check)
           (replace 'install
             (lambda* (#:key outputs #:allow-other-keys)
               (let ((out (assoc-ref outputs "out")))
                 (install-file "stalin.1"
                               (string-append out "/share/man/man1"))
                 (install-file "stalin"
                               (string-append out "/bin"))
                 #t))))))
      (inputs
       `(("libx11" ,libx11)))
      (propagated-inputs
       `(("libgc" ,libgc)))
      (supported-systems '("x86_64-linux"))
      (home-page "https://engineering.purdue.edu/~qobi/papers/fdlcc.pdf")
      (synopsis "Brutally efficient Scheme compiler")
      (description
       "Stalin is an aggressively optimizing whole-program compiler
for Scheme that does polyvariant interprocedural flow analysis,
flow-directed interprocedural escape analysis, flow-directed
lightweight CPS conversion, flow-directed lightweight closure
conversion, flow-directed interprocedural lifetime analysis, automatic
in-lining, unboxing, and flow-directed program-specific and
program-point-specific low-level representation selection and code
generation.")
      (license gpl2+))))

(define-public femtolisp
  (let ((commit "ec7601076a976f845bc05ad6bd3ed5b8cde58a97")
        (revision "2"))
    (package
      (name "femtolisp")
      (version (string-append "0.0.0-" revision "." (string-take commit 7)))
      (source (origin
                (method git-fetch)
                (uri (git-reference
                      (url "https://github.com/JeffBezanson/femtolisp")
                      (commit commit)))
                (file-name (string-append name "-" version "-checkout"))
                (sha256
                 (base32
                  "1fcyiqlqn27nd4wxi27km8mhmlzpzzsxzpwsl1bxbmhraq468njw"))))
      ;; See "utils.h" for supported systems. Upstream bug:
      ;; https://github.com/JeffBezanson/femtolisp/issues/25
      (supported-systems
       (fold delete %supported-systems
             '("armhf-linux" "mips64el-linux" "aarch64-linux")))
      (build-system gnu-build-system)
      (arguments
       `(#:make-flags '("CC=gcc" "release")
         #:test-target "test"
         #:phases
         (modify-phases %standard-phases
           (delete 'bootstrap)
           (delete 'configure) ; No configure script
           (replace 'install ; Makefile has no 'install phase
            (lambda* (#:key outputs #:allow-other-keys)
              (let* ((out (assoc-ref outputs "out"))
                     (bin (string-append out "/bin")))
                (install-file "flisp" bin)
                #t)))
           ;; The flisp binary is now available, run bootstrap to
           ;; generate flisp.boot and afterwards runs make test.
           (add-after 'install 'bootstrap-gen-and-test
             (lambda* (#:key outputs #:allow-other-keys)
              (let* ((out (assoc-ref outputs "out"))
                     (bin (string-append out "/bin")))
                (invoke "./bootstrap.sh")
                (install-file "flisp.boot" bin)
                #t))))))
      (synopsis "Scheme-like lisp implementation")
      (description
       "@code{femtolisp} is a scheme-like lisp implementation with a
simple, elegant Scheme dialect.  It is a lisp-1 with lexical scope.
The core is 12 builtin special forms and 33 builtin functions.")
      (home-page "https://github.com/JeffBezanson/femtolisp")
      (license bsd-3))))

(define-public gauche
  (package
    (name "gauche")
    (version "0.9.10")
    (home-page "https://practical-scheme.net/gauche/index.html")
    (source
     (origin
       (method url-fetch)
       (uri (string-append
             "mirror://sourceforge/gauche/Gauche/Gauche-"
             version ".tgz"))
       (sha256
        (base32 "0ci57ak5cp3lkmfy3nh50hifh8nbg58hh6r18asq0rn5mqfxyf8g"))
       (modules '((guix build utils)))
       (snippet '(begin
                   ;; Remove libatomic-ops.
                   (delete-file-recursively "gc/libatomic_ops")
                   #t))))
    (build-system gnu-build-system)
    (inputs
     `(("libatomic-ops" ,libatomic-ops)
       ("slib" ,slib)
       ("zlib" ,zlib)))
    (native-inputs
     `(("texinfo" ,texinfo)
       ("openssl" ,openssl)            ; needed for tests
       ("pkg-config" ,pkg-config)))    ; needed to find external libatomic-ops
    (arguments
     `(#:configure-flags
       (list (string-append "--with-slib="
                            (assoc-ref %build-inputs "slib")
                            "/lib/slib"))
       #:phases
       (modify-phases %standard-phases
         (add-after 'unpack 'patch-/bin/sh
           ;; Needed only for tests.
           (lambda _
             (substitute* '("test/www.scm"
                            "ext/tls/test.scm"
                            "lib/gauche/package/util.scm"
                            "libsrc/gauche/process.scm")
               (("/bin/sh") (which "sh")))
             #t))
         (add-after 'build 'build-doc
           (lambda _
             (with-directory-excursion "doc"
               (invoke "make" "info"))
             #t))
         (add-before 'check 'patch-network-tests
           ;; Remove net checks.
           (lambda _
             (delete-file "ext/net/test.scm")
             (invoke "touch" "ext/net/test.scm")
             #t))
         (add-after 'install 'install-docs
           (lambda _
             (with-directory-excursion "doc"
               (invoke "make" "install"))
             #t)))))
    (synopsis "Scheme scripting engine")
    (description "Gauche is a R7RS Scheme scripting engine aiming at being a
handy tool that helps programmers and system administrators to write small to
large scripts quickly.  Quick startup, built-in system interface, native
multilingual support are some of the goals.  Gauche comes with a package
manager/installer @code{gauche-package} which can download, compile, install
and list gauche extension packages.")
    (license bsd-3)))

(define-public gerbil
  (package
    (name "gerbil")
    (version "0.16")
    (source
     (origin
       (method git-fetch)
       (uri (git-reference
             (url "https://github.com/vyzo/gerbil")
             (commit (string-append "v" version))))
       (file-name (git-file-name name version))
       (sha256
        (base32 "0vng0kxpnwsg8jbjdpyn4sdww36jz7zfpfbzayg9sdpz6bjxjy0f"))))
    (arguments
     `(#:phases
       (modify-phases %standard-phases
         (delete 'bootstrap)
         (add-before 'configure 'chdir
           (lambda _
             (chdir "src")
             #t))
         (replace 'configure
           (lambda* (#:key outputs inputs #:allow-other-keys)
             (invoke "chmod" "755" "-R" ".")
             ;; Otherwise fails when editing an r--r--r-- file.
             (invoke "gsi-script" "configure"
                     "--prefix" (assoc-ref outputs "out")
                     "--with-gambit" (assoc-ref inputs "gambit-c"))))
         (add-before 'patch-generated-file-shebangs 'fix-gxi-shebangs
           (lambda _
             ;; Some .ss files refer to gxi using /usr/bin/env gxi
             ;; and 'patch-generated-file-shebangs can't fix that
             ;; because gxi has not been compiled yet.
             ;; We know where gxi is going to end up so we
             ;; Doctor Who our fix here before the problem
             ;; happens towards the end of the build.sh script.
             (let ((abs-srcdir (getcwd)))
               (for-each
                (lambda (f)
                   (substitute* f
                     (("#!/usr/bin/env gxi")
                      (string-append "#!" abs-srcdir "/../bin/gxi"))))
                 '("./gerbil/gxc"
                   "./lang/build.ss"
                   "./misc/http-perf/build.ss"
                   "./misc/rpc-perf/build.ss"
                   "./misc/scripts/docsnarf.ss"
                   "./misc/scripts/docstub.ss"
                   "./misc/scripts/docsyms.ss"
                   "./r7rs-large/build.ss"
                   "./release.ss"
                   "./std/build.ss"
                   "./std/run-tests.ss"
                   "./std/web/fastcgi-test.ss"
                   "./std/web/rack-test.ss"
                   "./tools/build.ss"
                   "./tutorial/httpd/build.ss"
                   "./tutorial/kvstore/build.ss"
                   "./tutorial/lang/build.ss"
                   "./tutorial/proxy/build-static.ss"
                   "./tutorial/proxy/build.ss")))
             #t))
         (replace
          'build
          (lambda*
           (#:key inputs #:allow-other-keys)
           (setenv "HOME" (getcwd))
             (invoke
              ;; The build script needs a tty or it'll crash on an ioctl
              ;; trying to find the width of the terminal it's running on.
              ;; Calling in script prevents that.
              "script"
              "-qefc"
              "./build.sh")))
         (delete 'check)
         (replace 'install
           (lambda* (#:key outputs #:allow-other-keys)
             (let* ((out (assoc-ref outputs "out"))
                    (bin (string-append out "/bin"))
                    (lib (string-append out "/lib")))
               (mkdir-p bin)
               (mkdir-p lib)
               (copy-recursively "../bin" bin)
               (copy-recursively "../lib" lib)))))))
    (native-inputs
     `(("coreutils" ,coreutils)
       ("util-linux" ,util-linux)))
    (propagated-inputs
     `(("gambit-c" ,gambit-c)
       ("zlib" ,zlib)
       ("openssl" ,openssl)
       ("sqlite" ,sqlite)))
    (build-system gnu-build-system)
    (synopsis "Meta-dialect of Scheme with post-modern features")
    (description "Gerbil is an opinionated dialect of Scheme designed for Systems
Programming, with a state of the art macro and module system on top of the Gambit
runtime.  The macro system is based on quote-syntax, and provides the full meta-syntactic
tower with a native implementation of syntax-case.  It also provides a full-blown module
system, similar to PLT Scheme's (sorry, Racket) modules.  The main difference from Racket
is that Gerbil modules are single instantiation, supporting high performance ahead of
time compilation and compiled macros.")
    (home-page "https://cons.io")
    (license `(,lgpl2.1 ,asl2.0))))


code:
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013 Cyril Roelandt <tipecaml@gmail.com>
;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2015, 2017 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2016, 2017, 2019, 2020, 2021 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2016 Alex Griffin <a@ajgrf.com>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2017, 2018, 2019, 2020 Tobias Geerinckx-Rice <me@tobias.gr>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (gnu packages screen)
  #:use-module (guix licenses)
  #:use-module (guix packages)
  #:use-module (guix download)
  #:use-module (guix git-download)
  #:use-module (guix build-system gnu)
  #:use-module (gnu packages)
  #:use-module (gnu packages hurd)
  #:use-module (gnu packages ncurses)
  #:use-module (gnu packages perl)
  #:use-module (gnu packages python)
  #:use-module (gnu packages slang)
  #:use-module (gnu packages texinfo))

(define-public screen
  (package
    (name "screen")
    (version "4.8.0")
    (source (origin
             (method url-fetch)
             (uri (string-append "mirror://gnu/screen/screen-"
                                 version ".tar.gz"))
             (patches (search-patches "screen-hurd-path-max.patch"
                                      "screen-CVE-2021-26937.patch"))
             (sha256
              (base32 "18ascpjzsy70h6hk7wpg8zmzjwgdyrdr7c6z4pg5z4l9hhyv24bf"))))
    (build-system gnu-build-system)
    (native-inputs
     `(("makeinfo" ,texinfo)))
    (inputs
     `(("ncurses" ,ncurses)
       ("perl" ,perl)))
    (arguments
     `(#:configure-flags
       ;; By default, screen supports 16 colors, but we want 256 when
       ;; ~/.screenrc contains 'term xterm-256color'.
       '("--enable-colors256")))
    (home-page "https://www.gnu.org/software/screen/")
    (synopsis "Full-screen window manager providing multiple terminals")
    (description
     "GNU Screen is a terminal window manager that multiplexes a single
terminal between several processes.  The virtual terminals each provide
features such as a scroll-back buffer and a copy-and-paste mechanism.  Screen
then manages the different virtual terminals, allowing you to easily switch
between them, to detach them from the current session, or even splitting the
view to show two terminals at once.")
    (license gpl2+)))

(define-public dtach
  (package
    (name "dtach")
    (version "0.9")
    (source (origin
              (method url-fetch)
              (uri (string-append "mirror://sourceforge/" name "/" name "/"
                                  version "/" name "-" version ".tar.gz"))
              (sha256
               (base32
                "1wwj2hlngi8qn2pisvhyfxxs8gyqjlgrrv5lz91w8ly54dlzvs9j"))))
    (build-system gnu-build-system)
    (arguments
     ;; No install target.
     '(#:phases
       (modify-phases %standard-phases
         (replace 'install
           (lambda* (#:key outputs #:allow-other-keys)
             (let ((out (assoc-ref outputs "out")))
               (install-file "dtach" (string-append out "/bin"))
               (install-file "dtach.1" (string-append out "/share/man/man1"))
               #t))))
       ;; No check target.
       #:tests? #f))
    (home-page "http://dtach.sourceforge.net/")
    (synopsis "Emulates the detach feature of screen")
    (description
     "dtach is a tiny program that emulates the detach feature of screen,
allowing you to run a program in an environment that is protected from the
controlling terminal and attach to it later.")
    (license gpl2+)))

(define-public byobu
  (package
    (name "byobu")
    (version "5.133")
    (source
     (origin
       (method url-fetch)
       (uri (string-append "https://launchpad.net/byobu/trunk/"
                           version "/+download/byobu_"
                           version ".orig.tar.gz"))
       (sha256
        (base32 "0qvmmdnvwqbgbhn5c8asmrmjhclcl029py2d2zvmd7h5ij7s93jd"))
       (patches (search-patches "byobu-writable-status.patch"))))
    (build-system gnu-build-system)
    (inputs
     `(("python" ,python-wrapper)       ; for config and session GUIs
       ("python-newt" ,newt "python")))
    (arguments
     `(#:phases
       (modify-phases %standard-phases
         (add-before
          'configure 'provide-locale
          (lambda* (#:key inputs #:allow-other-keys)
            (let ((libc (assoc-ref inputs "libc"))) ; implicit input
              (substitute* "usr/bin/byobu.in"
                (("locale") (string-append libc "/bin/locale")))
              #t)))
         (add-after
          'install 'wrap-python-scripts
          (lambda* (#:key inputs outputs #:allow-other-keys)
            (let* ((python (string-append (assoc-ref inputs "python")
                                          "/bin/python"))
                   (out    (assoc-ref outputs "out"))
                   (config (string-append out "/bin/byobu-config"))
                   (select (string-append out "/bin/byobu-select-session")))
              (wrap-program config
                `("BYOBU_PYTHON" = (,python))
                `("PYTHONPATH" ":" prefix (,(getenv "PYTHONPATH"))))
              (wrap-program select
                `("BYOBU_PYTHON" = (,python)))
              #t))))))
    (home-page "https://byobu.org/")
    (synopsis "Text-based window manager and terminal multiplexer")
    (description
     "Byobu is a Japanese term for decorative, multi-panel screens that serve
as folding room dividers.  The Byobu software includes an enhanced profile,
configuration utilities, and system status notifications for the GNU Screen
window manager as well as the Tmux terminal multiplexer.")
    (license gpl3+)))

(define-public reptyr
  (package
    (name "reptyr")
    (version "0.7.0")
    (source
     (origin
       (method git-fetch)
       (uri (git-reference
             (url "https://github.com/nelhage/reptyr")
             (commit (string-append "reptyr-" version))))
       (file-name (git-file-name name version))
       (sha256
        (base32 "1hnijfz1ab34j2h2cxc3f43rmbclyihgn9x9wxa7jqqgb2xm71hj"))))
    (build-system gnu-build-system)
    (arguments
     '(#:tests? #f                      ; no tests
       #:make-flags
       (list "CC=gcc"
             (string-append "PREFIX=" (assoc-ref %outputs "out"))
             (string-append "BASHCOMPDIR=" (assoc-ref %outputs "out")
                            "/etc/bash_completion.d"))
       #:phases
       (modify-phases %standard-phases
         (delete 'configure))))         ; no configure script
    (home-page "https://github.com/nelhage/reptyr")
    (synopsis "Tool for reparenting a running program to a new terminal")
    (description
     "reptyr is a utility for taking an existing running program and attaching
it to a new terminal.  Started a long-running process over @code{ssh}, but have
to leave and don't want to interrupt it?  Just start a @code{screen}, use
reptyr to grab it, and then kill the @code{ssh} session and head on home.")
    ;; Reptyr currently does not support mips.
    (supported-systems (delete "mips64el-linux" %supported-systems))
    (license expat)))


code:
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015, 2018 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2017, 2018, 2021 Nicolas Goaziou <mail@nicolasgoaziou.fr>
;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
;;; Copyright © 2019 Marius Bakke <mbakke@fastmail.com>
;;; Copyright © 2020, 2021 Tobias Geerinckx-Rice <me@tobias.gr>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (gnu packages scribus)
  #:use-module (guix packages)
  #:use-module (guix download)
  #:use-module (guix utils)
  #:use-module ((guix licenses) #:prefix license:)
  #:use-module (guix build-system cmake)
  #:use-module (gnu packages)
  #:use-module (gnu packages boost)
  #:use-module (gnu packages compression)
  #:use-module (gnu packages cups)
  #:use-module (gnu packages fontutils)
  #:use-module (gnu packages ghostscript)
  #:use-module (gnu packages gtk)
  #:use-module (gnu packages icu4c)
  #:use-module (gnu packages image)
  #:use-module (gnu packages imagemagick)
  #:use-module (gnu packages libreoffice)
  #:use-module (gnu packages linux)
  #:use-module (gnu packages pdf)
  #:use-module (gnu packages pkg-config)
  #:use-module (gnu packages python)
  #:use-module (gnu packages qt)
  #:use-module (gnu packages tls)
  #:use-module (gnu packages xml))

(define-public scribus
  (package
    (name "scribus")
    (version "1.5.7")
    (source
     (origin
       (method url-fetch)
       (uri (string-append "mirror://sourceforge/scribus/scribus-devel/"
                           version "/scribus-" version ".tar.xz"))
       (sha256
        (base32 "1kpq4vc95hj3w8l205kh0pmdlisi4v1gilz0sf8n39y7ryr1d0ri"))))
    (build-system cmake-build-system)
    (arguments
     `(#:tests? #f                      ;no test target
       #:configure-flags
       '("-DWANT_GRAPHICSMAGICK=1")))
    (inputs
     `(("boost" ,boost)
       ("cairo" ,cairo)
       ("cups" ,cups)
       ("fontconfig" ,fontconfig)
       ("freetype" ,freetype)
       ("graphicsmagick" ,graphicsmagick)
       ("harfbuzz" ,harfbuzz)
       ("hunspell" ,hunspell)
       ("icu4c" ,icu4c)
       ("lcms" ,lcms)
       ("libcdr" ,libcdr)
       ("libfreehand" ,libfreehand)
       ("libjpeg" ,libjpeg-turbo)
       ("libmspub" ,libmspub)
       ("libpagemaker" ,libpagemaker)
       ("librevenge" ,librevenge)
       ("libtiff" ,libtiff)
       ("libvisio" ,libvisio)
       ("libxml2" ,libxml2)
       ("libzmf" ,libzmf)
       ("openssl" ,openssl)
       ("podofo" ,podofo)
       ("poppler" ,poppler)
       ("python" ,python)               ; need Python library
       ("qtbase" ,qtbase-5)
       ("qtdeclarative" ,qtdeclarative)
       ("zlib" ,zlib)))
    (native-inputs
     `(("pkg-config" ,pkg-config)
       ("qttools" ,qttools)
       ("util-linux" ,util-linux)))
    (home-page "https://www.scribus.net")
    (synopsis "Desktop publishing and page layout program")
    (description
     "Scribus is a @dfn{desktop publishing} (DTP) application and can
be used for many tasks; from brochure design to newspapers, magazines,
newsletters and posters to technical documentation.  Scribus supports
professional DTP features, such as CMYK color and a color management
system to soft proof images for high quality color printing, flexible
PDF creation options, Encapsulated PostScript import/export and
creation of four color separations, import of EPS/PS and SVG as native
vector graphics, Unicode text including right to left scripts such as
Arabic and Hebrew via FreeType.")
    (license license:gpl2+)))


code:
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
;;; Copyright © 2018, 2020, 2021 Tobias Geerinckx-Rice <me@tobias.gr>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (gnu packages scsi)
  #:use-module ((guix licenses)
                #:select (gpl2+ bsd-2 bsd-3))
  #:use-module (guix packages)
  #:use-module (guix download)
  #:use-module (guix build-system gnu))

(define-public sg3-utils
  (package
    (name "sg3-utils")
    (version "1.46")
    (source (origin
              (method url-fetch)
              (uri (string-append "http://sg.danny.cz/sg/p/sg3_utils-"
                                  version ".tar.xz"))
              (sha256
               (base32
                "185rlxppnsmi6q7garfhglmw31gji2ff24xg2yjk3klk1fqnihjr"))))
    (build-system gnu-build-system)
    (home-page "http://sg.danny.cz/sg/sg3_utils.html")
    (synopsis "SCSI device utilities")
    (description
     "sg3-utils is a collection of utilities for devices that use the Small
Computer System Interface (@dfn{SCSI}) command set.  It includes utilities to
read data from, write data to, control, modify, and query the state of SCSI
devices.

For example, this package provides command-line tools to:
@itemize
@item copy data based on @code{dd} syntax and semantics (called @command{sg_dd},
@command{sgp_dd}, and @command{sgm_dd})
@item check @code{INQUIRY} data and @code{VPD pages} (@command{sg_inq})
@item check mode and log pages (@command{sginfo}, @command{sg_modes}, and
@command{sg_logs})
@item spin up and down disks (@command{sg_start})
@item do self-tests (@code{sg_senddiag})
@item parse sense data (@code{sg_decode_sense})
@item and perform various other functions.
@end itemize

In addition, this package includes a library, called libsgutils, which can be
used in C and C++ programs to interact with SCSI devices.")
    ;; See README: "All utilities and libraries have either a "2 clause" BSD
    ;;   license or are "GPL-2ed". [...] That BSD license was updated from the
    ;;   "3 clause" to the newer "2 clause" version on 20180119. To save space
    ;;   various source code files refer to a file called "BSD_LICENSE" [...]."
    ;; Some files (like sg_compare_and_write.c) retain their 3-clause headers!
    (license (list gpl2+ bsd-2 bsd-3))))