Federico Beffa
parent
212d563d26
commit
c093f9f63a
|
|
@ -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+))))
|
||||
|
|
|
|||
Loading…
Reference in New Issue