ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-16 19:57:39 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

utils: Add a 'delete-expression' procedure.

Browse source 
* guix/utils.scm: Fix copyright lines and order imports.
(edit-expression): Fix typo in doc.  Add a new 'include-trailing-newline?'
keyword argument.  Update doc.
(delete-expression): New procedure.
This commit is contained in:
Maxim Cournoyer 2022-04-26 00:11:26 -04:00
parent 5e6efdfeec
commit 5bc1ede862
No known key found for this signature in database
GPG key ID: 1260E46482E63562
1 changed files with 21 additions and 11 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

32
guix/utils.scm
View file

@ -8,12 +8,11 @@
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2018, 2020 Marius Bakke <marius@gnu.org> ;;; Copyright © 2018, 2020 Marius Bakke <marius@gnu.org>
;;; Copyright © 2020, 2021 Efraim Flashner <efraim@flashner.co.il> ;;; Copyright © 2020, 2021 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com> ;;; Copyright © 2020, 2021, 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2021 Simon Tournier <zimon.toutoune@gmail.com> ;;; Copyright © 2021 Simon Tournier <zimon.toutoune@gmail.com>
;;; Copyright © 2021 Chris Marusich <cmmarusich@gmail.com> ;;; Copyright © 2021 Chris Marusich <cmmarusich@gmail.com>
;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be> ;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
;;; Copyright © 2018 Steve Sprang <scs@stevesprang.com> ;;; Copyright © 2018 Steve Sprang <scs@stevesprang.com>
;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -38,7 +37,6 @@ (define-module (guix utils)
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
#:use-module (srfi srfi-39) #:use-module (srfi srfi-39)
#:use-module (srfi srfi-71) #:use-module (srfi srfi-71)
#:use-module (ice-9 ftw)
#:use-module (rnrs io ports) ;need 'port-position' etc. #:use-module (rnrs io ports) ;need 'port-position' etc.
#:use-module ((rnrs bytevectors) #:select (bytevector-u8-set!)) #:use-module ((rnrs bytevectors) #:select (bytevector-u8-set!))
#:use-module (guix memoization) #:use-module (guix memoization)
@ -49,10 +47,11 @@ (define-module (guix utils)
#:use-module ((guix combinators) #:select (fold2)) #:use-module ((guix combinators) #:select (fold2))
#:use-module (guix diagnostics) ;<location>, &error-location, etc. #:use-module (guix diagnostics) ;<location>, &error-location, etc.
#:use-module (ice-9 format) #:use-module (ice-9 format)
#:use-module (ice-9 regex) #:use-module (ice-9 ftw)
#:use-module (ice-9 match)
#:use-module (ice-9 format)
#:use-module ((ice-9 iconv) #:prefix iconv:) #:use-module ((ice-9 iconv) #:prefix iconv:)
#:use-module (ice-9 match)
#:use-module (ice-9 regex)
#:use-module (ice-9 rdelim)
#:use-module (ice-9 vlist) #:use-module (ice-9 vlist)
#:autoload (zlib) (make-zlib-input-port make-zlib-output-port) #:autoload (zlib) (make-zlib-input-port make-zlib-output-port)
#:use-module (system foreign) #:use-module (system foreign)
@ -133,6 +132,7 @@ (define-module (guix utils)
readlink* readlink*
go-to-location go-to-location
edit-expression edit-expression
delete-expression
filtered-port filtered-port
decompressed-port decompressed-port
@ -433,11 +433,13 @@ (define (move-source-location-map! source target line)
(hash-set! %source-location-map target-key (hash-set! %source-location-map target-key
`(,@target-stamp ,source-map))))))) `(,@target-stamp ,source-map)))))))
(define* (edit-expression source-properties proc #:key (encoding "UTF-8")) (define* (edit-expression source-properties proc #:key (encoding "UTF-8")
include-trailing-newline?)
"Edit the expression specified by SOURCE-PROPERTIES using PROC, which should "Edit the expression specified by SOURCE-PROPERTIES using PROC, which should
be a procedure that takes the original expression in string and returns a new be a procedure that takes the original expression in string and returns a new
one. ENCODING will be used to interpret all port I/O, it default to UTF-8. one. ENCODING will be used to interpret all port I/O, it defaults to UTF-8.
This procedure returns #t on success." This procedure returns #t on success. When INCLUDE-TRAILING-NEWLINE? is true,
the trailing line is included in the edited expression."
(define file (assq-ref source-properties 'filename)) (define file (assq-ref source-properties 'filename))
(define line (assq-ref source-properties 'line)) (define line (assq-ref source-properties 'line))
(define column (assq-ref source-properties 'column)) (define column (assq-ref source-properties 'column))
@ -446,10 +448,14 @@ (define column (assq-ref source-properties 'column))
(call-with-input-file file (call-with-input-file file
(lambda (in) (lambda (in)
(let* ( ;; The start byte position of the expression. (let* ( ;; The start byte position of the expression.
(start (begin (go-to-location in (+ 1 line) (+ 1 column)) (start (begin (go-to-location
in (+ 1 line) (+ 1 column))
(ftell in))) (ftell in)))
;; The end byte position of the expression. ;; The end byte position of the expression.
(end (begin (read in) (ftell in)))) (end (begin (read in)
(when include-trailing-newline?
(read-line in))
(ftell in))))
(seek in 0 SEEK_SET) ; read from the beginning of the file. (seek in 0 SEEK_SET) ; read from the beginning of the file.
(let* ((pre-bv (get-bytevector-n in start)) (let* ((pre-bv (get-bytevector-n in start))
;; The expression in string form. ;; The expression in string form.
@ -478,6 +484,10 @@ (define column (assq-ref source-properties 'column))
(move-source-location-map! (stat in) (stat file) (move-source-location-map! (stat in) (stat file)
(+ 1 line)))))))))) (+ 1 line))))))))))
(define (delete-expression source-properties)
"Delete the expression specified by SOURCE-PROPERTIES."
(edit-expression source-properties (const "") #:include-trailing-newline? #t))
;;; ;;;
;;; Keyword arguments. ;;; Keyword arguments.