~ruther/guix-local

9a9d64eaf97609d05b52deacdbd3dfb171a29048 — Tobias Geerinckx-Rice 8 years ago ea5d238
gnu: lout: Update phase style.

* gnu/packages/lout.scm (lout)[arguments]: Write phases in-line, use
MODIFY-PHASES syntax, INVOKE, and WITH-DIRECTORY-EXCURSION, and end
phases with #t.  Re-indent the result.
1 files changed, 69 insertions(+), 78 deletions(-)

M gnu/packages/lout.scm
M gnu/packages/lout.scm => gnu/packages/lout.scm +69 -78
@@ 1,5 1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2018 Tobias Geerinckx-Rice <me@tobias.gr>
;;;
;;; This file is part of GNU Guix.
;;;


@@ 24,91 25,81 @@
  #:use-module (gnu packages ghostscript))

(define-public lout
  ;; This one is a bit tricky, because it doesn't follow the GNU Build System
  ;; rules.  Instead, it has a makefile that has to be patched to set the
  ;; prefix, etc., and it has no makefile rules to build its doc.
  (let ((configure-phase
         '(lambda* (#:key outputs #:allow-other-keys)
            (let ((out (assoc-ref outputs "out"))
                  (doc (assoc-ref outputs "doc")))
              (substitute* "makefile"
                (("^PREFIX[[:blank:]]*=.*$")
                 (string-append "PREFIX = " out "\n"))
                (("^LOUTLIBDIR[[:blank:]]*=.*$")
                 (string-append "LOUTLIBDIR = " out "/lib/lout\n"))
                (("^LOUTDOCDIR[[:blank:]]*=.*$")
                 (string-append "LOUTDOCDIR = " doc "/share/doc/lout\n"))
                (("^MANDIR[[:blank:]]*=.*$")
                 (string-append "MANDIR = " out "/man\n")))
              (mkdir out)
              (mkdir (string-append out "/bin"))
              (mkdir (string-append out "/lib"))
              (mkdir (string-append out "/man"))
              (mkdir-p (string-append doc "/share/doc/lout")))))
        (install-man-phase
         '(lambda* (#:key outputs #:allow-other-keys)
            (zero? (system* "make" "installman"))))
        (doc-phase
         '(lambda* (#:key outputs #:allow-other-keys)
            (define out
              (assoc-ref outputs "doc"))

            (setenv "PATH"
                    (string-append (assoc-ref outputs "out")
                                   "/bin:" (getenv "PATH")))
            (chdir "doc")
            (every (lambda (doc)
                     (format #t "doc: building `~a'...~%" doc)
                     (with-directory-excursion doc
                       (let ((file (string-append out "/share/doc/lout/"
                                                  doc ".ps")))
                         (and (or (file-exists? "outfile.ps")
                                  (zero? (system* "lout" "-r4" "-o"
                                                  "outfile.ps" "all")))
                              (begin
                                (copy-file "outfile.ps" file)
                                #t)
                              (zero? (system* "ps2pdf"
                                              "-dPDFSETTINGS=/prepress"
                                              "-sPAPERSIZE=a4"
                                              file
                                              (string-append out "/share/doc/lout/"
                                                             doc ".pdf")))))))
                   '("design" "expert" "slides" "user")))))
   (package
  (package
    (name "lout")
    (version "3.40")
    (source (origin
             (method url-fetch)
             (uri (string-append "mirror://savannah/lout/lout-"
                                 version ".tar.gz"))
             (sha256
              (base32
               "1gb8vb1wl7ikn269dd1c7ihqhkyrwk19jwx5kd0rdvbk6g7g25ix"))))
    (build-system gnu-build-system)               ; actually, just a makefile
              (method url-fetch)
              (uri (string-append "mirror://savannah/lout/lout-"
                                  version ".tar.gz"))
              (sha256
               (base32
                "1gb8vb1wl7ikn269dd1c7ihqhkyrwk19jwx5kd0rdvbk6g7g25ix"))))
    (build-system gnu-build-system)     ; actually, just a makefile
    (outputs '("out" "doc"))
    (native-inputs
     `(("ghostscript" ,ghostscript)))
    (arguments `(#:modules ((guix build utils)
                            (guix build gnu-build-system)
                            (srfi srfi-1))        ; we need SRFI-1
                 #:tests? #f                      ; no "check" target

                 ;; Customize the build phases.
                 #:phases (alist-replace
                           'configure ,configure-phase

                           (alist-cons-after
                            'install 'install-man-pages
                            ,install-man-phase

                            (alist-cons-after
                             'install 'install-doc
                             ,doc-phase
                             %standard-phases)))))
    (arguments
     `(#:modules ((guix build utils)
                  (guix build gnu-build-system)
                  (srfi srfi-1))        ; we need SRFI-1
       #:tests? #f                      ; no "check" target
       #:phases
       (modify-phases %standard-phases
         ;; This package is a bit tricky, because it doesn't follow the GNU
         ;; Build System rules.  Instead, it has a makefile that has to be
         ;; patched to set the prefix, etc., and it has no makefile rules to
         ;; build its documentation.
         (replace 'configure
           (lambda* (#:key outputs #:allow-other-keys)
             (let ((out (assoc-ref outputs "out"))
                   (doc (assoc-ref outputs "doc")))
               (substitute* "makefile"
                 (("^PREFIX[[:blank:]]*=.*$")
                  (string-append "PREFIX = " out "\n"))
                 (("^LOUTLIBDIR[[:blank:]]*=.*$")
                  (string-append "LOUTLIBDIR = " out "/lib/lout\n"))
                 (("^LOUTDOCDIR[[:blank:]]*=.*$")
                  (string-append "LOUTDOCDIR = " doc "/share/doc/lout\n"))
                 (("^MANDIR[[:blank:]]*=.*$")
                  (string-append "MANDIR = " out "/man\n")))
               (mkdir out)
               (mkdir (string-append out "/bin"))
               (mkdir (string-append out "/lib"))
               (mkdir (string-append out "/man"))
               (mkdir-p (string-append doc "/share/doc/lout"))
               #t)))
         (add-after 'install 'install-man-pages
           (lambda* (#:key outputs #:allow-other-keys)
             (invoke "make" "installman")
             #t))
         (add-after 'install 'install-doc
           (lambda* (#:key outputs #:allow-other-keys)
             (let ((out (assoc-ref outputs "doc")))
               (setenv "PATH"
                       (string-append (assoc-ref outputs "out")
                                      "/bin:" (getenv "PATH")))
               (with-directory-excursion "doc"
                 (every (lambda (doc)
                          (format #t "doc: building `~a'...~%" doc)
                          (with-directory-excursion doc
                            (let ((file (string-append out "/share/doc/lout/"
                                                       doc ".ps")))
                              (unless (file-exists? "outfile.ps")
                                (invoke "lout" "-r4" "-o"
                                        "outfile.ps" "all"))
                              (copy-file "outfile.ps" file)
                              (invoke "ps2pdf"
                                      "-dPDFSETTINGS=/prepress"
                                      "-sPAPERSIZE=a4"
                                      file
                                      (string-append out "/share/doc/lout/"
                                                     doc ".pdf")))))
                        '("design" "expert" "slides" "user")))
               #t))))))
    (synopsis "Document layout system")
    (description
"The Lout document formatting system reads a high-level description of
     "The Lout document formatting system reads a high-level description of
a document similar in style to LaTeX and produces a PostScript or plain text
output file.



@@ 124,4 115,4 @@ TeX macros because Lout is a high-level, purely functional language, the
outcome of an eight-year research project that went back to the
beginning.")
    (license gpl3+)
    (home-page "https://savannah.nongnu.org/projects/lout/"))))
    (home-page "https://savannah.nongnu.org/projects/lout/")))