[PATCH] gnu-maintenance: update-package-source: Only update the desired package.

[宋文武]

Fixes <http://bugs.gnu.org/22693>.
Suggested by Andy Wingo.

* guix/upstream.scm (update-package-source): Use a customized 'substitute'
to work within lines of the package's source.
---
 guix/upstream.scm | 81 +++++++++++++++++++++++++++++++++++++++++++++----------
 1 file changed, 67 insertions(+), 14 deletions(-)

diff --git a/guix/upstream.scm b/guix/upstream.scm
index cea23fe..f4bc09c 100644
--- a/guix/upstream.scm
+++ b/guix/upstream.scm
@@ -23,7 +23,11 @@
   #:use-module ((guix download)
                 #:select (download-to-store))
   #:use-module ((guix build utils)
-                #:select (substitute))
+                #:select (with-atomic-file-replacement))
+  #:use-module ((ice-9 rdelim)
+                #:select (read-line))
+  #:use-module ((rnrs io ports)
+                #:select (get-string-all))
   #:use-module (guix gnupg)
   #:use-module (guix packages)
   #:use-module (guix ui)
@@ -205,6 +209,37 @@ and 'interactive' (default)."
   "Modify the source file that defines PACKAGE to refer to VERSION,
 whose tarball has SHA256 HASH (a bytevector).  Return the new version string
 if an update was made, and #f otherwise."
+  (define (substitute+ file start end pattern+procs)
+    ;; Same as substitute, but within lines from START to END.
+    (let ((rx+proc  (map (match-lambda
+                        (((? regexp? pattern) . proc)
+                         (cons pattern proc))
+                        ((pattern . proc)
+                         (cons (make-regexp pattern regexp/extended)
+                               proc)))
+                       pattern+procs)))
+    (with-atomic-file-replacement file
+      (lambda (in out)
+        (while (< (port-line in) (- start 1))
+          (display (read-line in 'concat) out))
+
+        (let loop ((line (read-line in 'concat)))
+          (let ((line (fold (lambda (r+p line)
+                              (match r+p
+                                ((regexp . proc)
+                                 (match (list-matches regexp line)
+                                   ((and m+ (_ _ ...))
+                                    (proc line m+))
+                                   (_ line)))))
+                            line
+                            rx+proc)))
+            (display line out)
+            (if (< (port-line in) end)
+                (loop (read-line in 'concat))
+                (begin
+                  (display (get-string-all in) out)
+                  #t))))))))
+
   (define (new-line line matches replacement)
     ;; Iterate over MATCHES and return the modified line based on LINE.
     ;; Replace each match with REPLACEMENT.
@@ -222,24 +257,40 @@ if an update was made, and #f otherwise."
                       (substring line o (match:start m))
                       r))))))
 
-  (define (update-source file old-version version
+  (define (update-source file start end old-version version
                          old-hash hash)
-    ;; Update source file FILE, replacing occurrences OLD-VERSION by VERSION
-    ;; and occurrences of OLD-HASH by HASH (base32 representation thereof).
-
-    ;; TODO: Currently this is a bit of a sledgehammer: if VERSION occurs in
-    ;; different unrelated places, we may modify it more than needed, for
-    ;; instance.  We should try to make changes only within the sexp that
-    ;; corresponds to the definition of PACKAGE.
+    ;; Update source file FILE within lines from START to END,
+    ;; replacing occurrences OLD-VERSION by VERSION and occurrences
+    ;; of OLD-HASH by HASH (base32 representation thereof).
     (let ((old-hash (bytevector->nix-base32-string old-hash))
           (hash     (bytevector->nix-base32-string hash)))
-      (substitute file
-                  `((,(regexp-quote old-version)
-                     . ,(cut new-line <> <> version))
-                    (,(regexp-quote old-hash)
-                     . ,(cut new-line <> <> hash))))
+      (substitute+ file start end
+                   `((,(regexp-quote old-version)
+                      . ,(cut new-line <> <> version))
+                     (,(regexp-quote old-hash)
+                      . ,(cut new-line <> <> hash))))
       version))
 
+
+  (define (package-location-line-start package)
+    (location-line (package-location package)))
+
+  (define (package-location-line-end package)
+    (define (goto port line column)
+      (unless (and (= (port-column port)) (- column 1)
+                   (= (port-line port) (- line 1)))
+        (unless (eof-object? (read-char port))
+          (goto port line column))))
+
+    (match (package-location package)
+      (($ <location> file line column)
+       (call-with-input-file (search-path %load-path file)
+         (lambda (port)
+           (goto port line column)
+           (match (read port)
+             (('package _ ...)
+              (1+ (port-line port)))))))))
+
   (let ((name (package-name package))
         (loc  (package-field-location package 'version)))
     (if loc
@@ -249,6 +300,8 @@ if an update was made, and #f otherwise."
                                   (cut search-path %load-path <>))))
           (if file
               (update-source file
+                             (package-location-line-start package)
+                             (package-location-line-end package)
                              old-version version
                              old-hash hash)
               (begin
-- 
2.6.3