File: repr_help_files_with_topic.r

package info (click to toggle)
r-cran-repr 1.1.7-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 356 kB
  • sloc: sh: 10; makefile: 2
file content (81 lines) | stat: -rw-r--r-- 2,470 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
# override utils:::print.help_files_with_topic

#' Representations of help
#' 
#' @param obj  Help topic to create a representation for
#' @param ...  ignored
#' 
#' @name repr_*.help_files_with_topic
NULL

fetch_rd_db <- utils::getFromNamespace('fetchRdDB', 'tools')

# copy of utils:::.getHelpFile, necessary because CRAN doesn’t like us using :::
get_help_file <- function(file) {
	path <- dirname(file)
	dirpath <- dirname(path)
	if (!file.exists(dirpath))
		stop(sprintf('invalid %s argument', sQuote('file')))
	pkgname <- basename(dirpath)
	rd_db <- file.path(path, pkgname)
	if (!file.exists(paste(rd_db, 'rdx', sep = '.')))
		stop(sprintf('package %s exists but was not installed under R >= 2.10.0 so help cannot be accessed', sQuote(pkgname)))
	fetch_rd_db(rd_db, basename(file))
}

#' @importFrom utils capture.output
#' @importFrom tools Rd2HTML
repr_help_files_with_topic_generic <- function(obj, Rd2_) {
	topic <- attr(obj, 'topic')
	#type <- attr(obj, 'type') #should we make this html by setting some option?
	#tried_all_packages <- attr(obj, 'tried_all_packages')
	#TODO: handle tried_all_packages
	
	paths <- as.character(obj)
	
	if (length(paths) == 0) {
		return(paste(gettextf('No documentation for %s in specified packages and libraries:', sQuote(topic)),
		             gettextf('you could try %s', sQuote(paste0('??', topic))), sep = '\n'))
	}
	
	#TODO: handle multiple
	file <- paths[[1]]
	
	pkgname <- basename(dirname(dirname(file)))
	
	rd <- get_help_file(file)
	
	output <- capture.output(Rd2_(rd, package = pkgname, outputEncoding = 'UTF-8'))
	
	if (identical(Rd2_, Rd2HTML)) {
		head.end.idx <- which(startsWith(output, '</head><body>'))
		body.end.idx <- which(endsWith(output, '</body></html>'))
		rm.idx <- c(seq_len(head.end.idx), body.end.idx)
		
		output <- output[-rm.idx]
	}
	
	#TODO: replace all the Rd-specific envs in latex
	
	paste(output, collapse = '\n')
}

#' @name repr_*.help_files_with_topic
#' @importFrom tools Rd2txt
#' @export
repr_text.help_files_with_topic <- function(obj, ...)
	repr_help_files_with_topic_generic(obj, Rd2txt)

#' @name repr_*.help_files_with_topic
#' @importFrom tools Rd2HTML
#' @export
repr_html.help_files_with_topic <- function(obj, ...)
	repr_help_files_with_topic_generic(obj, Rd2HTML)

#TODO: markdown

#' @name repr_*.help_files_with_topic
#' @importFrom tools Rd2latex
#' @export
repr_latex.help_files_with_topic <- function(obj, ...)
	repr_help_files_with_topic_generic(obj, Rd2latex)