gnu: Add scmutils.

* gnu/packages/scheme.scm (scmutils): New variable.
This commit is contained in:
Federico Beffa 2015-08-13 18:58:01 +02:00
parent 212d563d26
commit c093f9f63a
1 changed files with 177 additions and 0 deletions

View File

@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015 Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.com>
;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch>
;;;
;;; This file is part of GNU Guix.
;;;
@ -486,3 +487,179 @@ 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)))
;; FIXME: This function is temporarily in the engineering module and not
;; exported. It will be moved to an utility module for general use. Once
;; this is done, we should remove this definition.
(define broken-tarball-fetch
(@@ (gnu packages engineering) broken-tarball-fetch))
(define-public scmutils
(let ()
(define (system-suffix)
(cond
((string-prefix? "x86_64" (or (%current-target-system)
(%current-system)))
"x86-64")
(else "i386")))
(package
(name "scmutils")
(version "20140302")
(source
(origin
(method broken-tarball-fetch)
(modules '((guix build utils)))
(snippet
;; Remove binary code
'(delete-file-recursively "scmutils/mit-scheme"))
(file-name (string-append name "-" version ".tar.gz"))
(uri (string-append "http://groups.csail.mit.edu/mac/users/gjs/6946"
"/scmutils-tarballs/" name "-" version
"-x86-64-gnu-linux.tar.gz"))
(sha256
(base32 "10cnbm7nh78m5mrl1di85s29gny81jb1am9zd9f9yx725xb6dnfg"))))
(build-system gnu-build-system)
(inputs
`(("mit-scheme" ,mit-scheme)
("emacs" ,emacs-no-x)))
(arguments
`(#:tests? #f ;; no tests-suite
#:modules ((guix build gnu-build-system)
(guix build utils)
(guix build emacs-utils))
#:imported-modules (,@%gnu-build-system-modules
(guix build emacs-utils))
#:phases
(modify-phases %standard-phases
(replace 'configure
;; No standard build procedure is used. We set the correct
;; runtime path in the custom build system.
(lambda* (#:key outputs #:allow-other-keys)
(let ((out (assoc-ref outputs "out")))
;; Required to find .bci files at runtime.
(with-directory-excursion "scmutils"
(rename-file "src" "scmutils"))
(substitute* "scmutils/scmutils/load.scm"
(("/usr/local/scmutils/")
(string-append out "/lib/mit-scheme-"
,(system-suffix) "/")))
#t)))
(replace 'build
;; Compile the code and build a band.
(lambda* (#:key outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(make-img (string-append
"echo '(load \"load\") "
"(disk-save \"edwin-mechanics.com\")'"
"| mit-scheme")))
(with-directory-excursion "scmutils/scmutils"
(and (zero? (system "mit-scheme < compile.scm"))
(zero? (system make-img)))))))
(add-before 'install 'fix-directory-names
;; Correct directory names in the startup script.
(lambda* (#:key inputs outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(scm-root (assoc-ref inputs "mit-scheme")))
(substitute* "bin/mechanics"
(("ROOT=\"\\$\\{SCMUTILS_ROOT:-/.*\\}\"")
(string-append
"ROOT=\"${SCMUTILS_ROOT:-" scm-root "}\"\n"
"LIB=\"${ROOT}/lib/mit-scheme-"
,(system-suffix) ":"
out "/lib/mit-scheme-" ,(system-suffix) "\""))
(("EDWIN_INFO_DIRECTORY=.*\n") "")
(("SCHEME=.*\n")
(string-append "SCHEME=\"${ROOT}/bin/scheme "
"--library ${LIB}\"\n"))
(("export EDWIN_INFO_DIRECTORY") ""))
#t)))
(add-before 'install 'emacs-tags
;; Generate Emacs's tags for easy reference to source
;; code.
(lambda* (#:key inputs outputs #:allow-other-keys)
(with-directory-excursion "scmutils/scmutils"
(zero? (apply system* "etags"
(find-files "." "\\.scm"))))))
(replace 'install
;; Copy files to the store.
(lambda* (#:key outputs #:allow-other-keys)
(define* (copy-files-to-directory files dir
#:optional (delete? #f))
(for-each (lambda (f)
(copy-file f (string-append dir "/" f))
(when delete? (delete-file f)))
files))
(let* ((out (assoc-ref outputs "out"))
(bin (string-append out "/bin"))
(doc (string-append out "/share/doc/"
,name "-" ,version))
(lib (string-append out "/lib/mit-scheme-"
,(system-suffix)
"/scmutils")))
(for-each mkdir-p (list lib doc bin))
(with-directory-excursion "scmutils/scmutils"
(copy-files-to-directory '("COPYING" "LICENSE")
doc #t)
(for-each delete-file (find-files "." "\\.bin"))
(copy-files-to-directory '("edwin-mechanics.com")
(string-append lib "/..") #t)
(copy-recursively "." lib))
(with-directory-excursion "bin"
(copy-files-to-directory (find-files ".") bin))
(with-directory-excursion "scmutils/manual"
(copy-files-to-directory (find-files ".") doc))
#t)))
(add-after 'install 'emacs-helpers
;; Add convenience Emacs commands to easily load the
;; Scmutils band in an MIT-Scheme buffer inside of Emacs
;; and to easily load code tags.
(lambda* (#:key inputs outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(mit-root (assoc-ref inputs "mit-scheme"))
(emacs-lisp-dir
(string-append out "/share/emacs/site-lisp"
"/guix.d/" ,name "-" ,version))
(el-file (string-append emacs-lisp-dir
"/scmutils.el"))
(lib-relative-path
(string-append "/lib/mit-scheme-"
,(system-suffix))))
(mkdir-p emacs-lisp-dir)
(call-with-output-file el-file
(lambda (p)
(format p
";;;###autoload
(defun scmutils-load ()
(interactive)
(require 'xscheme)
(let ((mit-root \"~a\")
(scmutils \"~a\"))
(run-scheme
(concat mit-root \"/bin/scheme --library \"
mit-root \"~a:\" scmutils \"~a\"
\" --band edwin-mechanics.com\"
\" --emacs\"))))
;;;###autoload
(defun scmutils-load-tags ()
(interactive)
(let ((scmutils \"~a\"))
(visit-tags-table (concat scmutils \"/TAGS\"))))
"
mit-root out
lib-relative-path
lib-relative-path
(string-append out lib-relative-path
"/scmutils"))))
(emacs-byte-compile-directory (dirname el-file))
#t))))))
(home-page
"http://groups.csail.mit.edu/mac/users/gjs/6946/linux-install.htm")
(synopsis "Scmutils library for MIT Scheme")
(description "The Scmutils system is an integrated library of
procedures, embedded in the programming language Scheme, and intended to
support teaching and research in mathematical physics and electrical
engineering.")
(license gpl2+))))