Tweaks for .R_top_srcdir_from_Rd().

git-svn-id: https://svn.r-project.org/R/trunk@89012 00db46b3-68df-0310-9c12-caf00c1e9a41

Author: hornik

src/library/tools/R/admin.R

@@ -871,12 +871,14 @@ function(dir, outDir, encoding = "unknown")
     }
     pathsFile <- file.path(manOutDir, "paths.rds")
     ## Avoid (costly) rebuilding if not needed.
-    ## 'make Rdobjects' now takes 13s compared to 0.5s if remaking skips the below.
-    ## This tests if the Rd DB from a previous 'make' can be fully kept or needs
-    ## updating, but ignores that a dynamic help page may need reprocessing even
-    ## without modifying the source Rd file. With the advent of \bibshow, many
-    ## help pages have become dynamic and always rebuilding these is tedious ...
-    ## So for now only do a full rebuild when the system macros were touched.
+    ## 'make Rdobjects' now takes 13s compared to 0.5s if remaking skips
+    ## the below.  This tests if the Rd DB from a previous 'make' can be
+    ## fully kept or needs updating, but ignores that a dynamic help
+    ## page may need reprocessing even without modifying the source Rd
+    ## file. With the advent of \bibshow, many help pages have become
+    ## dynamic and always rebuilding these is tedious ... 
+    ## So for now only do a full rebuild when the system macros were
+    ## touched. 
     system_file <- file.path(R.home("share"), "Rd", "macros", "system.Rd")
     if (!file.exists(db_file) || # first build, including from .install_packages
         file_test("-nt", system_file, db_file)) {
@@ -891,9 +893,13 @@ function(dir, outDir, encoding = "unknown")
         db <- .build_Rd_db(dir, manfiles, db_file = db_file,
                            encoding = encoding, built_file = built_file)
         nm <- as.character(names(db)) # Might be NULL
-        saveRDS(structure(nm,
-                          first = nchar(file.path(mandir)) + 2L),
-                pathsFile)
+        at <- c(list(first = nchar(file.path(mandir)) + 2L),
+                if(basename(dir) == "tools") {
+                    ## We could use 3 dirname() calls, but perhaps more
+                    ## easily:
+                    list(top = substr(dir, 1L, nchar(dir) - 18L))
+                })
+        saveRDS(`attributes<-`(nm, at), pathsFile)
         names(db) <- sub("\\.[Rr]d$", "", basename(nm))
         makeLazyLoadDB(db, file.path(manOutDir, packageName))
     }

src/library/tools/R/utils.R

@@ -627,12 +627,8 @@ function(year)
 
 .R_top_srcdir_from_Rd <-
 function() {
-    filebase <-
-        file_path_sans_ext(system.file("help", "tools.rdb",
-                                       package = "tools"))
-    path <- attr(fetchRdDB(filebase, "QC"), "Rdfile")
-    ## We could use 5 dirname() calls, but perhaps more easily:
-    substr(path, 1L, nchar(path) - 28L)
+    attr(readRDS(system.file("help", "paths.rds", package = "tools")),
+         "top")
 }
 
 ## Unfortunately,