gnu: hyperrogue: Update to 9.4n. - guix - Wojtek's customized Guix

diff options

author	Kei Kebreau <kei@openmailbox.org>	2017-07-12 10:50:32 -0400
committer	Kei Kebreau <kei@openmailbox.org>	2017-07-12 10:51:19 -0400
commit	5149ff1b5f0c6c1e66a0702f14a1010fc6feb105 (patch)
tree	12823247c8425bb37654bb300e32f75a41a39ca0 /tests/elpa.scm
parent	911a53a53f4898c386cbb7347daf928fae592fa3 (diff)
download	guix-5149ff1b5f0c6c1e66a0702f14a1010fc6feb105.tar.gz guix-5149ff1b5f0c6c1e66a0702f14a1010fc6feb105.zip

gnu: hyperrogue: Update to 9.4n.

* gnu/packages/games.scm (hyperrogue): Update to 9.4n.

Diffstat (limited to 'tests/elpa.scm')

0 files changed, 0 insertions, 0 deletions

efine (surrounding-sexp port target-line-no) "Return the top-level S-expression surrounding the change at line number TARGET-LINE-NO in PORT." (let* ((line-numbers+offsets (lines+offsets-with-opening-parens port)) (closest-offset (or (and=> (list-index (match-lambda ((line-number . offset) (< line-number target-line-no))) line-numbers+offsets) 2017-04-17gnu: Fix typos in descriptions....Tobias Geerinckx-Rice 2017-04-08gnu: octave: Build with gl2ps support....Arun Isaac 2017-04-07gnu: flann: Move .mex file to a separate "octave" output....Ludovic Courtès 2017-04-06gnu: armadillo: Change license to ASL 2.0....Ricardo Wurmus 2017-04-06gnu: Remove armadillo-for-rcpparmadillo....Ricardo Wurmus 2017-04-06gnu: armadillo: Update to 7.800.2....Ricardo Wurmus 2017-04-06gnu: r-pracma: Update to 2.0.4....Ricardo Wurmus 2017-03-30Merge branch 'master' into core-updates...Marius Bakke ))) (cond ((eof-object? line) (values (reverse lines) type)) ((or (string-prefix? "@@ " line) (string-prefix? "diff --git" line)) (unget-string port line) (values (reverse lines) type)) (else (loop (cons line lines) (or type (cond ((string-prefix? "+(define" line) 'addition) ((string-prefix? "-(define" line) 'removal) (else #false))))))))) (define info (let loop ((acc '()) (file-name #f)) (let ((line (read-line port))) (cond ((eof-object? line) acc) ((string-prefix? "--- " line) (match (string-split line #\space) ((_ file-name) (loop acc file-name)))) ((string-prefix? "@@ " line) (match (string-split line #\space) ((_ old-start new-start . _) (let-values (((diff-lines type) (read-hunk))) (loop (cons (make-hunk file-name (extract-line-number old-start) (extract-line-number new-start) (cons (string-append line "\n") diff-lines) type) acc) file-name))))) (else (loop acc file-name)))))) (close-pipe port) info)) (define (lines-to-first-change hunk) "Return the number of diff lines until the first change." (1- (count (lambda (line) ((negate char-set-contains?) (char-set #\+ #\-) (string-ref line 0))) (hunk-diff-lines hunk)))) (define %original-file-cache (make-hash-table)) (define (read-original-file file-name) "Return the contents of FILE-NAME prior to any changes." (let* ((port (open-pipe* OPEN_READ "git" "cat-file" "-p" (string-append "HEAD:" file-name))) (contents (get-string-all port))) (close-pipe port) contents)) (define (read-original-file* file-name) "Caching variant of READ-ORIGINAL-FILE." (or (hashv-ref %original-file-cache file-name) (let ((value (read-original-file file-name))) (hashv-set! %original-file-cache file-name value) value))) (define (old-sexp hunk) "Using the diff information in HUNK return the unmodified S-expression corresponding to the top-level definition containing the staged changes." ;; TODO: We can't seek with a pipe port... (call-with-input-string (read-original-file* (hunk-file-name hunk)) (lambda (port) (surrounding-sexp port (+ (lines-to-first-change hunk) (hunk-old-line-number hunk)))))) (define (new-sexp hunk) "Using the diff information in HUNK return the modified S-expression corresponding to the top-level definition containing the staged changes." (call-with-input-file (hunk-file-name hunk) (lambda (port) (surrounding-sexp port (+ (lines-to-first-change hunk) (hunk-new-line-number hunk)))))) (define* (change-commit-message file-name old new #:optional (port (current-output-port))) "Print ChangeLog commit message for changes between OLD and NEW." (define (get-values expr field) (match ((xpath:node-or (xpath:sxpath `(*any* *any* package ,field quasiquote *)) ;; For let binding (xpath:sxpath `(*any* *any* (*any*) package ,field quasiquote *))) (cons '*TOP* expr)) (() ;; New-style plain lists (match ((xpath:node-or (xpath:sxpath `(*any* *any* package ,field list *)) ;; For let binding (xpath:sxpath `(*any* *any* (*any*) package ,field list *))) (cons '*TOP* expr)) ((inner) inner) (_ '()))) ;; Old-style labelled inputs ((first . rest) (map cadadr first)))) (define (listify items) (match items ((one) one) ((one two) (string-append one " and " two)) ((one two . more) (string-append (string-join (drop-right items 1) ", ") ", and " (first (take-right items 1)))))) (define variable-name (second old)) (define version (and=> ((xpath:node-or (xpath:sxpath '(*any* *any* package version *any*)) ;; For let binding (xpath:sxpath '(*any* *any* (*any*) package version *any*))) (cons '*TOP* new)) first)) (format port "gnu: ~a: Update to ~a.~%~%* ~a (~a): Update to ~a.~%" variable-name version file-name variable-name version) (for-each (lambda (field) (let ((old-values (get-values old field)) (new-values (get-values new field))) (or (equal? old-values new-values) (let ((removed (lset-difference equal? old-values new-values)) (added (lset-difference equal? new-values old-values))) (format port "[~a]: ~a~%" field (break-string (match (list (map symbol->string removed) (map symbol->string added)) ((() added) (format #f "Add ~a." (listify added))) ((removed ()) (format #f "Remove ~a." (listify removed))) ((removed added) (format #f "Remove ~a; add ~a." (listify removed) (listify added)))))))))) '(inputs propagated-inputs native-inputs))) (define* (add-commit-message file-name variable-name #:optional (port (current-output-port))) "Print ChangeLog commit message for a change to FILE-NAME adding a definition." (format port "gnu: Add ~a.~%~%* ~a (~a): New variable.~%" variable-name file-name variable-name)) (define* (remove-commit-message file-name variable-name #:optional (port (current-output-port))) "Print ChangeLog commit message for a change to FILE-NAME removing a definition." (format port "gnu: Remove ~a.~%~%* ~a (~a): Delete variable.~%" variable-name file-name variable-name)) (define* (custom-commit-message file-name variable-name message changelog #:optional (port (current-output-port))) "Print custom commit message for a change to VARIABLE-NAME in FILE-NAME, using MESSAGE as the commit message and CHANGELOG as the body of the ChangeLog entry. If CHANGELOG is #f, the commit message is reused. If CHANGELOG already contains ': ', no colon is inserted between the location and body of the ChangeLog entry." (define (trim msg) (string-trim-right (string-trim-both msg) (char-set #\.))) (define (changelog-has-location? changelog) (->bool (string-match "^[[:graph:]]+:[[:blank:]]" changelog))) (let* ((message (trim message)) (changelog (if changelog (trim changelog) message)) (message/f (format #f "gnu: ~a: ~a." variable-name message)) (changelog/f (if (changelog-has-location? changelog) (format #f "* ~a (~a)~a." file-name variable-name changelog) (format #f "* ~a (~a): ~a." file-name variable-name changelog)))) (format port "~a~%~%~a~%" (break-string-with-newlines message/f 72) (break-string-with-newlines changelog/f 72)))) (define (add-copyright-line line) "Add the copyright line on LINE to the previous commit." (let ((author (match:substring (string-match "^\\+;;; Copyright ©[^[:alpha:]]+(.*)$" line) 1))) (format (current-output-port) "Amend and add copyright line for ~a~%" author) (system* "git" "commit" "--amend" "--no-edit"))) (define (group-hunks-by-sexp hunks) "Return a list of pairs associating all hunks with the S-expression they are modifying." (fold (lambda (sexp hunk acc) (match acc (((previous-sexp . hunks) . rest) (if (equal? sexp previous-sexp) (cons (cons previous-sexp (cons hunk hunks)) rest) (cons (cons sexp (list hunk)) acc))) (_ (cons (cons sexp (list hunk)) acc)))) '() (map new-sexp hunks) hunks)) (define (new+old+hunks hunks) (map (match-lambda ((new . hunks) (cons* new (old-sexp (first hunks)) hunks))) (group-hunks-by-sexp hunks))) (define %delay 1000) (define (main . args) (define* (change-commit-message* file-name old new #:rest rest) (let ((changelog #f)) (match args ((or (message changelog) (message)) (apply custom-commit-message file-name (second old) message changelog rest)) (_ (apply change-commit-message file-name old new rest))))) (read-disable 'positions) (match (diff-info) (() (display "Nothing to be done.\n" (current-error-port))) (hunks (let-values (((definitions changes) (partition hunk-type hunks))) ;; Additions/removals. (for-each (lambda (hunk) (and-let* ((define-line (find (cut string-match "(\\+|-)\\(define" <>) (hunk-diff-lines hunk))) (variable-name (and=> (string-tokenize define-line) second)) (commit-message-proc (match (hunk-type hunk) ('addition add-commit-message) ('removal remove-commit-message)))) (commit-message-proc (hunk-file-name hunk) variable-name) (let ((port (open-pipe* OPEN_WRITE "git" "apply" "--cached" "--unidiff-zero"))) (hunk->patch hunk port) (unless (eqv? 0 (status:exit-val (close-pipe port))) (error "Cannot apply"))) (let ((port (open-pipe* OPEN_WRITE "git" "commit" "-F" "-"))) (commit-message-proc (hunk-file-name hunk) variable-name port) (usleep %delay) (unless (eqv? 0 (status:exit-val (close-pipe port))) (error "Cannot commit")))) (usleep %delay)) definitions) ;; Changes. (for-each (match-lambda ((new old . hunks) (for-each (lambda (hunk) (let ((port (open-pipe* OPEN_WRITE "git" "apply" "--cached" "--unidiff-zero"))) (hunk->patch hunk port) (unless (eqv? 0 (status:exit-val (close-pipe port))) (error "Cannot apply"))) (usleep %delay)) hunks) (define copyright-line (any (lambda (line) (and=> (string-prefix? "+;;; Copyright ©" line) (const line))) (hunk-diff-lines (first hunks)))) (cond (copyright-line (add-copyright-line copyright-line)) (else (let ((port (open-pipe* OPEN_WRITE "git" "commit" "-F" "-"))) (change-commit-message* (hunk-file-name (first hunks)) old new) (change-commit-message* (hunk-file-name (first hunks)) old new port) (usleep %delay) (unless (eqv? 0 (status:exit-val (close-pipe port))) (error "Cannot commit"))))))) (new+old+hunks (match definitions ('() changes) ;reuse (_ ;; XXX: we recompute the hunks here because previous ;; insertions lead to offsets. (let-values (((definitions changes) (partition hunk-type (diff-info)))) changes))))))))) (apply main (cdr (command-line)))


context:
space:
mode: