Skip to content

Commit 900ebec

Browse files
coatlesscoatless
committed
Add functions, docs, and NAMESPACE
1 parent 86b5091 commit 900ebec

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

64 files changed

+2479
-0
lines changed

‎NAMESPACE

Lines changed: 31 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,31 @@
1+
# Generated by roxygen2: do not edit by hand
2+
3+
S3method(print,stamp_dir_results)
4+
S3method(print,stamp_file_info)
5+
S3method(print,stamp_language)
6+
S3method(print,stamp_preview)
7+
S3method(print,stamp_template)
8+
S3method(print,stamp_update_preview)
9+
export(backup_file)
10+
export(detect_language)
11+
export(has_header)
12+
export(is_file)
13+
export(language_get)
14+
export(language_register)
15+
export(languages)
16+
export(stamp)
17+
export(stamp_dir)
18+
export(stamp_file)
19+
export(stamp_template_content)
20+
export(stamp_template_create)
21+
export(stamp_template_default)
22+
export(stamp_template_describe)
23+
export(stamp_template_field)
24+
export(stamp_template_load)
25+
export(stamp_templates)
26+
export(stamp_update)
27+
export(stamp_update_helper_author_add)
28+
export(stamp_update_helper_copyright_extend)
29+
export(stamp_variables)
30+
export(stamp_variables_add)
31+
export(stamp_variables_list)

‎R/language-support.R

Lines changed: 102 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,102 @@
1+
#' Register a new language
2+
#'
3+
#' @param name Character. Language name.
4+
#' @param extensions Character vector. File extensions.
5+
#' @param comment_single Character. Single-line comment marker.
6+
#' @param comment_multi_start Character or NULL. Multi-line comment start.
7+
#' @param comment_multi_end Character or NULL. Multi-line comment end.
8+
#'
9+
#' @return stamp_language object, invisibly.
10+
#' @export
11+
language_register <- function(name, extensions, comment_single,
12+
comment_multi_start = NULL, comment_multi_end = NULL) {
13+
lang <- structure(
14+
list(
15+
name = name,
16+
extensions = extensions,
17+
comment_single = comment_single,
18+
comment_multi_start = comment_multi_start,
19+
comment_multi_end = comment_multi_end
20+
),
21+
class = "stamp_language"
22+
)
23+
24+
langs <- getOption("filestamp.languages", list())
25+
langs[[name]] <- lang
26+
options(filestamp.languages = langs)
27+
28+
invisible(lang)
29+
}
30+
31+
#' Get registered language
32+
#'
33+
#' @param name Character. Language name.
34+
#'
35+
#' @return stamp_language object.
36+
#' @export
37+
language_get <- function(name) {
38+
langs <- getOption("filestamp.languages", list())
39+
40+
if (!name %in% names(langs)) {
41+
cli::cli_abort("Language not found: {name}")
42+
}
43+
44+
langs[[name]]
45+
}
46+
47+
#' List all registered languages
48+
#'
49+
#' @return Named list of stamp_language objects.
50+
#' @export
51+
languages <- function() {
52+
getOption("filestamp.languages", list())
53+
}
54+
55+
#' Detect language based on file extension
56+
#'
57+
#' @param file Character. Path to file.
58+
#'
59+
#' @return stamp_language object.
60+
#' @export
61+
detect_language <- function(file) {
62+
ext <- tolower(tools::file_ext(file))
63+
64+
langs <- languages()
65+
66+
for (lang_name in names(langs)) {
67+
lang <- langs[[lang_name]]
68+
if (ext %in% lang$extensions) {
69+
return(lang)
70+
}
71+
}
72+
73+
# Default to plain text
74+
language_get("text")
75+
}
76+
77+
#' Format header according to language's comment style
78+
#'
79+
#' @param content Character. Header content.
80+
#' @param language stamp_language object. Language for comment formatting.
81+
#'
82+
#' @return Character. Formatted header.
83+
#' @keywords internal
84+
format_header <- function(content, language) {
85+
# Ensure content is properly split into lines
86+
lines <- unlist(strsplit(content, "\n"))
87+
88+
if (!is.null(language$comment_multi_start) && !is.null(language$comment_multi_end)) {
89+
# Use multi-line comments
90+
paste0(
91+
language$comment_multi_start, "\n",
92+
paste(lines, collapse = "\n"),
93+
"\n", language$comment_multi_end
94+
)
95+
} else {
96+
# Use single-line comments
97+
paste(
98+
paste0(language$comment_single, " ", lines),
99+
collapse = "\n"
100+
)
101+
}
102+
}

‎R/printers.R

Lines changed: 158 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,158 @@
1+
#' Print method for templates
2+
#'
3+
#' @param x stamp_template object.
4+
#' @param ... Additional arguments.
5+
#'
6+
#' @return The stamp_template object, invisibly.
7+
#' @export
8+
#' @method print stamp_template
9+
print.stamp_template <- function(x, ...) {
10+
cli::cli_h1("Template: {x$name}")
11+
12+
cli::cli_h2("Fields:")
13+
for (field_name in names(x$fields)) {
14+
field <- x$fields[[field_name]]
15+
default <- if (is.null(field$default)) "<none>" else field$default
16+
required <- if (field$required) "Required" else "Optional"
17+
cli::cli_li("{field_name}: {default} ({required})")
18+
}
19+
20+
cli::cli_h2("Content:")
21+
cli::cli_code(x$content)
22+
23+
invisible(x)
24+
}
25+
26+
#' Print method for stamp preview
27+
#'
28+
#' @param x stamp_preview object.
29+
#' @param ... Additional arguments.
30+
#'
31+
#' @return The stamp_preview object, invisibly.
32+
#' @export
33+
#' @method print stamp_preview
34+
print.stamp_preview <- function(x, ...) {
35+
cli::cli_h1("Preview for: {x$file}")
36+
37+
cli::cli_h2("Header to be inserted:")
38+
cli::cli_code(x$header)
39+
40+
cli::cli_h2("Insertion point:")
41+
if (x$insert_position == 0) {
42+
cli::cli_text("Beginning of file")
43+
} else if (x$insert_position == 1) {
44+
cli::cli_text("After shebang")
45+
} else {
46+
cli::cli_text("Line {x$insert_position}")
47+
}
48+
49+
cli::cli_h2("File properties:")
50+
cli::cli_li("Encoding: {x$encoding}")
51+
cli::cli_li("Line ending: {if (x$line_ending == '\n') 'LF' else if (x$line_ending == '\r') 'CR' else 'CRLF'}")
52+
cli::cli_li("Read-only: {if (x$read_only) 'Yes' else 'No'}")
53+
54+
invisible(x)
55+
}
56+
57+
#' Print method for language
58+
#'
59+
#' @param x stamp_language object.
60+
#' @param ... Additional arguments.
61+
#'
62+
#' @return The stamp_language object, invisibly.
63+
#' @export
64+
#' @method print stamp_language
65+
print.stamp_language <- function(x, ...) {
66+
cli::cli_h1("Language: {x$name}")
67+
68+
cli::cli_h2("File extensions:")
69+
extensions <- paste(x$extensions, collapse = ", ")
70+
cli::cli_text(extensions)
71+
72+
cli::cli_h2("Comment style:")
73+
cli::cli_li("Single line: {x$comment_single}")
74+
75+
if (!is.null(x$comment_multi_start) && !is.null(x$comment_multi_end)) {
76+
cli::cli_li("Multi-line start: {x$comment_multi_start}")
77+
cli::cli_li("Multi-line end: {x$comment_multi_end}")
78+
}
79+
80+
invisible(x)
81+
}
82+
83+
#' Print method for directory results
84+
#'
85+
#' @param x stamp_dir_results object.
86+
#' @param ... Additional arguments.
87+
#'
88+
#' @return The stamp_dir_results object, invisibly.
89+
#' @export
90+
#' @method print stamp_dir_results
91+
print.stamp_dir_results <- function(x, ...) {
92+
cli::cli_h1("Directory Stamping Results: {x$dir}")
93+
94+
cli::cli_h2("Action: {x$action}")
95+
96+
success_count <- sum(sapply(x$results, function(r) r$status == "success"))
97+
error_count <- sum(sapply(x$results, function(r) r$status == "error"))
98+
99+
cli::cli_alert_success("{success_count} files successfully processed")
100+
101+
if (error_count > 0) {
102+
cli::cli_alert_danger("{error_count} files had errors")
103+
104+
cli::cli_h2("Errors:")
105+
for (result in x$results) {
106+
if (result$status == "error") {
107+
cli::cli_li("{result$file}: {result$message}")
108+
}
109+
}
110+
}
111+
112+
invisible(x)
113+
}
114+
115+
#' Print method for file info
116+
#'
117+
#' @param x stamp_file_info object.
118+
#' @param ... Additional arguments.
119+
#'
120+
#' @return The stamp_file_info object, invisibly.
121+
#' @export
122+
#' @method print stamp_file_info
123+
print.stamp_file_info <- function(x, ...) {
124+
cli::cli_h1("File Information: {x$path}")
125+
126+
cli::cli_li("Encoding: {x$encoding}")
127+
cli::cli_li("Line ending: {if (x$line_ending == '\n') 'LF' else if (x$line_ending == '\r') 'CR' else 'CRLF'}")
128+
cli::cli_li("Read-only: {if (x$read_only) 'Yes' else 'No'}")
129+
130+
invisible(x)
131+
}
132+
133+
#' Print method for update preview
134+
#'
135+
#' @param x stamp_update_preview object.
136+
#' @param ... Additional arguments.
137+
#'
138+
#' @return The stamp_update_preview object, invisibly.
139+
#' @export
140+
#' @method print stamp_update_preview
141+
print.stamp_update_preview <- function(x, ...) {
142+
cli::cli_h1("Update Preview for: {x$file}")
143+
144+
cli::cli_h2("Updated fields:")
145+
for (field_name in names(x$fields)) {
146+
cli::cli_li("{field_name}: {x$fields[[field_name]]}")
147+
}
148+
149+
cli::cli_h2("Header location:")
150+
cli::cli_text("Lines {x$range[1]} to {x$range[2]}")
151+
152+
cli::cli_h2("File properties:")
153+
cli::cli_li("Encoding: {x$encoding}")
154+
cli::cli_li("Line ending: {if (x$line_ending == '\n') 'LF' else if (x$line_ending == '\r') 'CR' else 'CRLF'}")
155+
cli::cli_li("Read-only: {if (x$read_only) 'Yes' else 'No'}")
156+
157+
invisible(x)
158+
}

‎R/stamp-dir.R

Lines changed: 55 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,55 @@
1+
#' Stamp all files in a directory with a header
2+
#'
3+
#' @param dir Character. Path to directory to stamp.
4+
#' @param template Character or stamp_template object. Template to use for stamping.
5+
#' @param action Character. Action to perform: "modify", "dryrun", or "backup".
6+
#' @param pattern Character. File pattern to match (passed to list.files).
7+
#' @param recursive Logical. Whether to search recursively.
8+
#' @param ... Additional arguments passed to stamp_file.
9+
#'
10+
#' @return stamp_dir_results object.
11+
#' @export
12+
stamp_dir <- function(dir, template = NULL, action = "modify", pattern = NULL,
13+
recursive = FALSE, ...) {
14+
ensure_directory_exists(dir)
15+
ensure_valid_action(action)
16+
17+
files <- header_find_files(dir, pattern, recursive)
18+
19+
cli::cli_alert_info("Stamping {length(files)} files in {dir}")
20+
21+
results <- lapply(files, function(file) {
22+
tryCatch({
23+
stamp_file(file, template, action, ...)
24+
list(file = file, status = "success")
25+
}, error = function(e) {
26+
list(file = file, status = "error", message = conditionMessage(e))
27+
})
28+
})
29+
30+
# Return result object with class for pretty printing
31+
structure(
32+
list(results = results, dir = dir, action = action),
33+
class = "stamp_dir_results"
34+
)
35+
}
36+
37+
#' Find files in a directory
38+
#'
39+
#' @param dir Character. Directory to search.
40+
#' @param pattern Character. File pattern to match (passed to list.files).
41+
#' @param recursive Logical. Whether to search recursively.
42+
#'
43+
#' @return Character vector of file paths.
44+
#' @keywords internal
45+
header_find_files <- function(dir, pattern = NULL, recursive = FALSE) {
46+
files <- list.files(
47+
path = dir,
48+
pattern = pattern,
49+
recursive = recursive,
50+
full.names = TRUE
51+
)
52+
53+
# Filter directories
54+
files[!file.info(files)$isdir]
55+
}

0 commit comments

Comments
 (0)