1#
2# SessionUserCommands.R
3#
4# Copyright (C) 2021 by RStudio, PBC
5#
6# Unless you have received this program directly from RStudio pursuant
7# to the terms of a commercial license agreement with RStudio, then
8# this program is licensed to you under the terms of version 3 of the
9# GNU Affero General Public License. This program is distributed WITHOUT
10# ANY EXPRESS OR IMPLIED WARRANTY, INCLUDING THOSE OF NON-INFRINGEMENT,
11# MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE. Please refer to the
12# AGPL (http://www.gnu.org/licenses/agpl-3.0.txt) for more details.
13#
14#
15
16assign(".rs.userCommands", new.env(parent = emptyenv()), envir = .rs.toolsEnv())
17
18.rs.addFunction("isValidShortcut", function(shortcut)
19{
20   if (!is.character(shortcut))
21      return(FALSE)
22
23   # TODO
24   TRUE
25})
26
27.rs.addFunction("normalizeKeyboardShortcut", function(shortcut)
28{
29   # A shortcut may be a vector of 'strings', each to be pressed
30   # in sequence to trigger the shortcut. Normalize each set and
31   # then paste together.
32   normalized <- lapply(shortcut, function(shortcut) {
33
34      # Ensure lower case
35      shortcut <- tolower(shortcut)
36
37      # Normalize aliases
38      aliases <- list(
39         "ctrl" = "control",
40         "cmd" = c("meta", "command", "win", "super")
41      )
42
43      for (i in seq_along(aliases))
44      {
45         destination <- names(aliases)[[i]]
46         potentials <- aliases[[i]]
47         for (item in potentials)
48         {
49            bounded <- paste("\\b", item, "\\b", sep = "")
50            shortcut <- gsub(bounded, destination, shortcut, perl = TRUE)
51         }
52      }
53
54      # Normalize modifier key names
55      for (modifier in c("ctrl", "alt", "cmd", "shift"))
56      {
57         reFrom <- paste(modifier, "\\s*[-+]\\s*", sep = "")
58         reTo <- paste(modifier, "-", sep = "")
59         shortcut <- gsub(reFrom, reTo, shortcut, perl = TRUE)
60      }
61
62      shortcut
63
64   })
65
66   paste(normalized, collapse = " ")
67
68})
69
70.rs.addFunction("registerUserCommand", function(name, shortcuts, fn, overwrite = TRUE)
71{
72   if (length(name) != 1 || !is.character(name))
73      stop("'name' should be a length-one character vector")
74
75   if (!overwrite && exists(name, envir = .rs.userCommands)) {
76      stop("'", name, "' is already bound to a command; use 'overwrite = TRUE'",
77           "to overwrite with the new command definition.")
78   }
79
80   shortcuts <- unlist(lapply(shortcuts, .rs.normalizeKeyboardShortcut))
81   .rs.userCommands[[name]] <- fn
82   .Call("rs_registerUserCommand", .rs.scalar(name), shortcuts)
83
84   TRUE
85})
86
87.rs.addFunction("loadUserCommands", function(keybindingPath)
88{
89   env <- new.env(parent = globalenv())
90   env$registerUserCommand <- .rs.registerUserCommand
91
92   # load user commands from pre-1.3 RStudio folder if present, then from the configured user
93   # command folder
94   paths <- c("~/.R/keybindings", keybindingPath)
95   for (path in paths)
96   {
97      files <- list.files(file.path(path, "R"), full.names = TRUE)
98      lapply(files, function(file)
99      {
100         source(file, local = env)
101      })
102   }
103})
104