├── .ert-runner ├── .gitignore ├── .travis.yml ├── Cask ├── Makefile ├── browse-at-remote.el ├── readme.rst └── test ├── api-basic-test.el └── run-tests /.ert-runner: -------------------------------------------------------------------------------- 1 | -l test/run-tests -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /elpa 2 | /.cask 3 | *.elc 4 | *~ -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | dist: xenial 2 | language: emacs-lisp 3 | addons: 4 | apt: 5 | update: true 6 | 7 | jobs: 8 | allow_failures: 9 | - env: EVM_EMACS=emacs-git-snapshot-travis-linux-xenial 10 | include: 11 | - stage: build 12 | env: 13 | - EVM_EMACS=emacs-24.5-travis 14 | script: &build 15 | - rm -rf $HOME/.evm 16 | - travis_retry eval $"git clone https://github.com/rejeep/evm.git $HOME/.evm ; sleep 10" 17 | - export PATH=$HOME/.evm/bin:$HOME/.cask/bin:$PATH 18 | - evm config path /tmp 19 | - travis_retry eval $"evm install $EVM_EMACS --use --skip ; sleep 10" 20 | - emacs --version 21 | - travis_retry eval $"curl -fsSL https://raw.githubusercontent.com/cask/cask/master/go | python ; sleep 10" 22 | - travis_retry eval $"cask install ; sleep 10" 23 | - cask build 24 | - stage: build 25 | env: 26 | - EVM_EMACS=emacs-25.3-travis 27 | script: *build 28 | - stage: build 29 | env: 30 | - EVM_EMACS=emacs-26.3-travis-linux-xenial 31 | script: *build 32 | - stage: build 33 | env: 34 | - EVM_EMACS=emacs-git-snapshot-travis-linux-xenial 35 | script: *build 36 | -------------------------------------------------------------------------------- /Cask: -------------------------------------------------------------------------------- 1 | (source gnu) 2 | (source melpa) 3 | 4 | (package-file "browse-at-remote.el") 5 | 6 | (development 7 | (depends-on "ert-runner") 8 | (depends-on "f") 9 | (depends-on "s") 10 | (depends-on "vc") 11 | ) 12 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | EMACS ?= emacs 2 | CASK ?= cask 3 | 4 | .PHONY: test compile install clean 5 | 6 | install: 7 | ${CASK} install 8 | 9 | test: clean 10 | ${CASK} exec ert-runner 11 | 12 | compile: 13 | ${CASK} build 14 | 15 | clean: 16 | rm -f browse-at-remote.elc 17 | -------------------------------------------------------------------------------- /browse-at-remote.el: -------------------------------------------------------------------------------- 1 | ;;; browse-at-remote.el --- Open github/gitlab/bitbucket/stash/gist/phab/sourcehut page from Emacs -*- lexical-binding:t -*- 2 | 3 | ;; Copyright © 2015-2023 4 | ;; 5 | ;; Author: Rustem Muslimov 6 | ;; Version: 0.15.0 7 | ;; Keywords: github, gitlab, bitbucket, gist, stash, phabricator, sourcehut, pagure 8 | ;; Homepage: https://github.com/rmuslimov/browse-at-remote 9 | ;; Package-Requires: ((f "0.20.0") (s "1.9.0") (cl-lib "0.5")) 10 | 11 | ;; This program is free software: you can redistribute it and/or modify 12 | ;; it under the terms of the GNU General Public License as published by 13 | ;; the Free Software Foundation, either version 3 of the License, or 14 | ;; (at your option) any later version. 15 | 16 | ;; This program is distributed in the hope that it will be useful, 17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19 | ;; GNU General Public License for more details. 20 | 21 | ;; You should have received a copy of the GNU General Public License 22 | ;; along with this program. If not, see . 23 | 24 | ;; This file is not part of GNU Emacs. 25 | 26 | ;;; Commentary: 27 | 28 | ;; Easily open target page on github/gitlab (or bitbucket) from Emacs. 29 | ;; by calling `browse-at-remote` function. Support dired buffers and opens 30 | ;; them in tree mode at destination. 31 | 32 | ;;; Code: 33 | 34 | (require 'f) 35 | (require 's) 36 | (require 'dash) 37 | (require 'cl-lib) 38 | (require 'vc-git) 39 | (require 'url-parse) 40 | 41 | (defgroup browse-at-remote nil 42 | "Open target on github/gitlab/bitbucket/stash/etc." 43 | :prefix "browse-at-remote-" 44 | :group 'applications) 45 | 46 | (defvar browse-at-remote--customize-remote-types 47 | '(list 48 | (plist :key-type (choice (const :tag "Host" :host) 49 | (const :tag "Type" :type) 50 | (const :tag "Actual host" :actual-host)) 51 | :value-type (choice string 52 | (choice (const :tag "GitHub" "github") 53 | (const :tag "GitLab" "gitlab") 54 | (const :tag "Bitbucket" "bitbucket") 55 | (const :tag "Stash/Bitbucket Server" "stash") 56 | (const :tag "git.savannah.gnu.org" "gnu") 57 | (const :tag "Azure DevOps" "ado") 58 | (const :tag "Phabricator" "phabricator") 59 | (const :tag "gist.github.com" "gist") 60 | (const :tag "sourcehut" "sourcehut") 61 | (const :tag "pagure" "pagure") 62 | (const :tag "Gitiles" "gitiles"))))) 63 | "Customize types for remotes") 64 | 65 | (defcustom browse-at-remote-remote-type-regexps 66 | '((:host "^github\\.com$" :type "github") 67 | (:host "^bitbucket\\.org$" :type "bitbucket") 68 | (:host "^gitlab\\.com$" :type "gitlab") 69 | (:host "^git\\.savannah\\.gnu\\.org$" :type "gnu") 70 | (:host "^gist\\.github\\.com$" :type "gist") 71 | (:host "^git\\.sr\\.ht$" :type "sourcehut") 72 | (:host "^.*\\.visualstudio\\.com$" :type "ado") 73 | (:host "^pagure\\.io$" :type "pagure") 74 | (:host "^.*\\.fedoraproject\\.org$" :type "pagure") 75 | (:host "^.*\\.googlesource\\.com$" :type "gitiles") 76 | (:host "^gitlab\\.gnome\\.org$" :type "gitlab")) 77 | "Plist of host regular expressions to remote types. 78 | When property `:actual-host' is non-nil, the remote host will be 79 | resolved to `:actual-host'." 80 | :type browse-at-remote--customize-remote-types 81 | :group 'browse-at-remote) 82 | 83 | (defcustom browse-at-remote-preferred-remote-name 84 | "origin" 85 | "The preferred remote name 86 | Remotes ares sorted alphabetically, which might return the wrong remote pointing to a different url. 87 | When nil or not found use the first remote." 88 | :type 'string 89 | :group 'browse-at-remote) 90 | 91 | (defcustom browse-at-remote-prefer-symbolic t 92 | "Whether to prefer symbolic references when linking. 93 | 94 | When t, uses the branch name, if available. This generates easier to 95 | read URLs, but for long-lived links, the content of the linked file 96 | may change, producing link root. 97 | 98 | When nil, uses the commit hash. The contents will never change." 99 | :type 'boolean 100 | :group 'browse-at-remote) 101 | 102 | (defcustom browse-at-remote-add-line-number-if-no-region-selected t 103 | "Always add line number even if region is not selected in buffer. 104 | When is option is t, bar-browse adds line number to URL even if region was not selected. 105 | 106 | By default is true." 107 | :type 'boolean 108 | :group 'browse-at-remote) 109 | 110 | (defcustom browse-at-remote-use-http nil 111 | "List of hosts where the URL protocol should be http." 112 | :type '(repeat string)) 113 | 114 | (defun browse-at-remote--get-url-from-remote (remote-url) 115 | "Return a plist describing REMOTE-URL." 116 | ;; If the protocol isn't specified, git treats it as an SSH URL. 117 | (unless (s-contains-p "://" remote-url) 118 | (setq remote-url (concat "ssh://" remote-url))) 119 | (let* ((parsed (url-generic-parse-url remote-url)) 120 | (host (url-host parsed)) 121 | (unresolved-host nil) 122 | (port (url-port-if-non-default parsed)) 123 | (web-proto 124 | (if (equal (url-type parsed) "http") "http" "https")) 125 | (filename (url-filename parsed))) 126 | ;; SSH URLs can contain colons in the host part, e.g. ssh://example.com:foo. 127 | (when (s-contains-p ":" host) 128 | (let ((parts (s-split ":" host))) 129 | (setq host (cl-first parts)) 130 | (when (member host browse-at-remote-use-http) 131 | (setq web-proto "http")) 132 | (setq filename (concat "/" (cl-second parts) filename)))) 133 | ;; when protocol is not http(s) port must always be stripped 134 | (unless (member (url-type parsed) '("http" "https")) 135 | (setq port nil)) 136 | ;; Drop .git at the end of `remote-url'. 137 | (setq filename (s-chop-suffix ".git" filename)) 138 | ;; Preserve the port. 139 | (setq unresolved-host host 140 | host (browse-at-remote--resolve-host host)) 141 | (when port 142 | (setq host (format "%s:%d" host port) 143 | unresolved-host (format "%s:%d" unresolved-host port))) 144 | `(:host ,host 145 | :unresolved-host ,unresolved-host 146 | :url ,(format "%s://%s%s" web-proto host filename)))) 147 | 148 | (defun browse-at-remote--remote-ref (&optional filename) 149 | "Return (REMOTE-URL . REF) which contains FILENAME. 150 | Returns nil if no appropriate remote or ref can be found." 151 | (let ((local-branch (browse-at-remote--get-local-branch)) 152 | (revision (if (and (fboundp 'vc-git--symbolic-ref) 153 | browse-at-remote-prefer-symbolic) 154 | (vc-git--symbolic-ref (or filename ".")) 155 | (vc-git-working-revision (or filename ".")))) 156 | remote-branch 157 | remote-name) 158 | ;; If we're on a branch, try to find a corresponding remote 159 | ;; branch. 160 | (if local-branch 161 | (let ((remote-and-branch (browse-at-remote--get-remote-branch local-branch))) 162 | (setq remote-name (car remote-and-branch)) 163 | (setq remote-branch (cdr remote-and-branch))) 164 | ;; Otherwise, we have a detached head. Choose a remote 165 | ;; arbitrarily. 166 | (setq remote-name (browse-at-remote--get-preferred-remote))) 167 | 168 | (when remote-name 169 | (cons 170 | (browse-at-remote--get-remote-url remote-name) 171 | (if (and browse-at-remote-prefer-symbolic remote-branch) 172 | ;; If the user has requested an URL with a branch name, and we 173 | ;; have a remote branch, use that. 174 | remote-branch 175 | ;; Otherwise, just use the commit hash. 176 | revision))))) 177 | 178 | (defun browse-at-remote--get-local-branch () 179 | "Return the name of the current local branch name. 180 | If HEAD is detached, return nil." 181 | ;; Based on http://stackoverflow.com/a/1593487/509706 182 | (with-temp-buffer 183 | (let ((exit-code (vc-git--call t "symbolic-ref" "HEAD"))) 184 | (when (zerop exit-code) 185 | (s-chop-prefix "refs/heads/" (s-trim (buffer-string))))))) 186 | 187 | (defun browse-at-remote--get-remote-branch (local-branch) 188 | "If LOCAL-BRANCH is tracking a remote branch, return 189 | \(REMOTE-NAME . REMOTE-BRANCH-NAME). Returns nil otherwise." 190 | (let ((remote-and-branch 191 | ;; Try pushRemote first 192 | (let ((push-remote (vc-git--run-command-string 193 | nil "config" 194 | (format "branch.%s.pushRemote" local-branch)))) 195 | (if push-remote 196 | (format "%s/%s" (s-trim push-remote) local-branch) 197 | 198 | ;; If there's no pushRemote, fall back to upstream 199 | (vc-git--run-command-string 200 | nil "rev-parse" 201 | "--symbolic-full-name" 202 | "--abbrev-ref" 203 | (format "%s@{upstream}" local-branch)) 204 | )))) 205 | ;; `remote-and-branch' should be of the form "origin/master" 206 | (if (and remote-and-branch 207 | (s-contains? "/" remote-and-branch)) 208 | ;; Split into two-item list, then convert to a pair. 209 | (apply #'cons 210 | (s-split-up-to "/" (s-trim remote-and-branch) 1)) 211 | (cons (browse-at-remote--get-preferred-remote) local-branch)))) 212 | 213 | (defun browse-at-remote--get-remote-url (remote) 214 | "Get URL of REMOTE from current repo." 215 | (with-temp-buffer 216 | (vc-git--call t "ls-remote" "--get-url" remote) 217 | (s-replace "\n" "" (buffer-string)))) 218 | 219 | (defun browse-at-remote--get-remotes () 220 | "Get a list of known remotes." 221 | (with-temp-buffer 222 | (vc-git--call t "remote") 223 | (let ((remotes (s-trim (buffer-string)))) 224 | (unless (string= remotes "") 225 | (s-lines remotes))))) 226 | 227 | (defun browse-at-remote--get-preferred-remote () 228 | "Return either the preferred remote matching the name of browse-at-remote-preferred-remote-name. 229 | If nil return the first remote in the list." 230 | (let ((remotes (browse-at-remote--get-remotes))) 231 | (if (and 232 | remotes 233 | browse-at-remote-preferred-remote-name 234 | (-contains? remotes browse-at-remote-preferred-remote-name)) 235 | browse-at-remote-preferred-remote-name 236 | (car remotes)))) 237 | 238 | (defun browse-at-remote--get-remote-type-from-config () 239 | "Get remote type from current repo." 240 | (browse-at-remote--get-from-config "browseAtRemote.type")) 241 | 242 | (defun browse-at-remote--get-remote-actual-host-from-config () 243 | "Get remote actual host from current repo." 244 | (browse-at-remote--get-from-config "browseAtRemote.actualHost")) 245 | 246 | (defun browse-at-remote--get-from-config (key) 247 | (with-temp-buffer 248 | (vc-git--call t "config" "--get" key) 249 | (s-trim (buffer-string)))) 250 | 251 | (defun browse-at-remote--get-remote-type (host) 252 | (let ((type-from-config (browse-at-remote--get-remote-type-from-config))) 253 | (or (if (s-present? type-from-config) 254 | type-from-config 255 | (cl-loop for plist in browse-at-remote-remote-type-regexps 256 | when (string-match-p (plist-get plist :host) host) 257 | return (plist-get plist :type))) 258 | (error (format "Sorry, not sure what to do with host `%s' (consider adding it to `browse-at-remote-remote-type-regexps')" 259 | host))))) 260 | 261 | (defun browse-at-remote--resolve-host (host) 262 | "Translate HOST to the actual host. 263 | Returns HOST if the property `:actual-host' can't be found in its 264 | related remote in `browse-at-remote-remote-type-regexps'." 265 | (let ((actual-host-from-config (browse-at-remote--get-remote-actual-host-from-config))) 266 | (or (if (s-present? actual-host-from-config) 267 | actual-host-from-config 268 | (cl-loop for plist in browse-at-remote-remote-type-regexps 269 | when (and (plist-get plist :actual-host) 270 | (string-match-p (map-elt plist :host) host)) 271 | return (plist-get plist :actual-host))) 272 | host))) 273 | 274 | (defun browse-at-remote--get-formatter (formatter-type remote-type) 275 | "Get formatter function for given FORMATTER-TYPE (region-url or commit-url) and REMOTE-TYPE (github or bitbucket)" 276 | (let ((formatter (intern (format "browse-at-remote--format-%s-as-%s" formatter-type remote-type)))) 277 | (if (fboundp formatter) 278 | formatter nil))) 279 | 280 | (defun browse-at-remote-gnu-format-url (repo-url) 281 | "Get a gnu formatted URL." 282 | (let* ((parts (split-string repo-url "/" t)) 283 | (domain (butlast parts)) 284 | (project (car (last parts)))) 285 | (string-join 286 | (append domain (list "cgit" project)) "/"))) 287 | 288 | (defun browse-at-remote--format-region-url-as-gnu (repo-url location filename &optional linestart lineend) 289 | "URL formatter for gnu." 290 | (let ((repo-url (browse-at-remote-gnu-format-url repo-url))) 291 | (cond 292 | (linestart (format "%s.git/tree/%s?h=%s#n%d" repo-url filename location linestart)) 293 | (t (format "%s.git/tree/%s?h=%s" repo-url filename location))))) 294 | 295 | (defun browse-at-remote--format-commit-url-as-gnu (repo-url commithash) 296 | "Commit URL formatted for gnu" 297 | (format "%s.git/commit/?id=%s" (browse-at-remote-gnu-format-url repo-url) commithash)) 298 | 299 | (defun browse-at-remote--format-region-url-as-github (repo-url location filename &optional linestart lineend) 300 | "URL formatted for github." 301 | (cond 302 | ((and linestart lineend) 303 | (format "%s/blob/%s/%s#L%d-L%d" repo-url location filename linestart lineend)) 304 | (linestart (format "%s/blob/%s/%s#L%d" repo-url location filename linestart)) 305 | (t (format "%s/tree/%s/%s" repo-url location filename)))) 306 | 307 | (defun browse-at-remote--format-commit-url-as-github (repo-url commithash) 308 | "Commit URL formatted for github" 309 | (format "%s/commit/%s" repo-url commithash)) 310 | 311 | (defun browse-at-remote-ado-format-url (repo-url) 312 | "Get an ado formatted URL." 313 | (let* ((s (split-string repo-url "/"))) 314 | ;; [protocol]//[organization].visualstudio.com/[project]/_git/[repository] 315 | (format "%s//%s/%s/_git/%s" 316 | (nth 0 s) 317 | (replace-regexp-in-string "^vs-ssh" (nth 4 s) (nth 2 s)) 318 | (nth 5 s) 319 | (nth 6 s)))) 320 | 321 | (defun browse-at-remote--format-region-url-as-ado (repo-url location filename &optional linestart lineend) 322 | "URL formatted for ado" 323 | (let* ( 324 | ;; NOTE: I'm not sure what's the meaning of the "GB" 325 | ;; prefix. My guess is that it stands for a "Git Branch". 326 | (base-url (format "%s?version=%s%s&path=/%s" 327 | (browse-at-remote-ado-format-url repo-url) 328 | "GB" 329 | location 330 | filename))) 331 | (cond 332 | ((and linestart lineend) 333 | (format "%s&line=%d&lineEnd=%d&lineStartColumn=1&lineEndColumn=1" base-url linestart (+ 1 lineend))) 334 | (linestart (format "%s&line=%d&lineStartColumn=1&lineEndColumn=1" base-url linestart)) 335 | (t base-url)))) 336 | 337 | (defun browse-at-remote--format-commit-url-as-ado (repo-url commithash) 338 | "Commit URL formatted for ado" 339 | ;; They does not seem to have anything like permalinks from github. 340 | (error "The ado version of the commit-url is not implemented")) 341 | 342 | (defun browse-at-remote--format-region-url-as-bitbucket (repo-url location filename &optional linestart lineend) 343 | "URL formatted for bitbucket" 344 | (cond 345 | ((and linestart lineend) 346 | (format "%s/src/%s/%s#cl-%d:%d" repo-url location filename linestart lineend)) 347 | (linestart (format "%s/src/%s/%s#cl-%d" repo-url location filename linestart)) 348 | (t (format "%s/src/%s/%s" repo-url location filename)))) 349 | 350 | (defun browse-at-remote--format-commit-url-as-bitbucket (repo-url commithash) 351 | "Commit URL formatted for bitbucket" 352 | (format "%s/commits/%s" repo-url commithash)) 353 | 354 | (defun browse-at-remote--format-region-url-as-gist (repo-url location filename &optional linestart lineend) 355 | "URL formatted for gist." 356 | (concat 357 | (format "%s#file-%s" repo-url 358 | (replace-regexp-in-string "[^a-z0-9_]+" "-" filename)) 359 | (cond 360 | ((and linestart lineend) (format "-L%d-L%d" linestart lineend)) 361 | (linestart (format "-L%d" linestart)) 362 | (t "")))) 363 | 364 | (defun browse-at-remote--format-commit-url-as-gist (repo-url commithash) 365 | "Commit URL formatted for gist" 366 | (cond 367 | ((equal commithash "master") 368 | repo-url) 369 | (t 370 | (format "%s/%s" repo-url commithash)))) 371 | 372 | (defun browse-at-remote--fix-repo-url-stash (repo-url) 373 | "Inserts 'projects' and 'repos' in #repo-url" 374 | (let* ((reversed-url (reverse (split-string repo-url "/"))) 375 | (project (car reversed-url)) 376 | (repo (nth 1 reversed-url))) 377 | (string-join (reverse (append (list project "repos" repo "projects") (nthcdr 2 reversed-url))) "/"))) 378 | 379 | (defun browse-at-remote--format-region-url-as-stash (repo-url location filename &optional linestart lineend) 380 | "URL formatted for stash" 381 | (let* ((branch (cond 382 | ((string= location "master") "") 383 | (t (string-join (list "?at=" location))))) 384 | (lines (cond 385 | (lineend (format "#%d-%d" linestart lineend)) 386 | (linestart (format "#%d" linestart)) 387 | (t "")))) 388 | (format "%s/browse/%s%s%s" (browse-at-remote--fix-repo-url-stash repo-url) filename branch lines))) 389 | 390 | (defun browse-at-remote--format-commit-url-as-stash (repo-url commithash) 391 | "Commit URL formatted for stash" 392 | (format "%s/commits/%s" (browse-at-remote--fix-repo-url-stash repo-url) commithash)) 393 | 394 | (defun browse-at-remote--format-region-url-as-phabricator (repo-url location filename &optional linestart lineend) 395 | "URL formatted for Phabricator" 396 | (let* ((lines (cond 397 | (lineend (format "\$%d-%d" linestart lineend)) 398 | (linestart (format "\$%d" linestart)) 399 | (t "")))) 400 | (format "%s/browse/%s/%s%s" repo-url location filename lines))) 401 | 402 | (defun browse-at-remote--format-commit-url-as-phabricator (repo-url commithash) 403 | "Commit URL formatted for Phabricator" 404 | (message repo-url) 405 | (format "%s/%s%s" (replace-regexp-in-string "\/source/.*" "" repo-url) (read-string "Please input the callsign for this repository:") commithash)) 406 | 407 | (defun browse-at-remote--format-region-url-as-gitlab (repo-url location filename &optional linestart lineend) 408 | "URL formatted for gitlab. 409 | The only difference from github is format of region: L1-2 instead of L1-L2" 410 | (cond 411 | ((and linestart lineend) 412 | (format "%s/blob/%s/%s#L%d-%d" repo-url location filename linestart lineend)) 413 | (linestart (format "%s/blob/%s/%s#L%d" repo-url location filename linestart)) 414 | (t (format "%s/tree/%s/%s" repo-url location filename)))) 415 | 416 | (defun browse-at-remote--format-region-url-as-sourcehut (repo-url location filename &optional linestart lineend) 417 | "URL formatted for sourcehut." 418 | (cond 419 | ((and linestart lineend) 420 | (format "%s/tree/%s/%s#L%d-%d" repo-url location filename linestart lineend)) 421 | (linestart (format "%s/tree/%s/%s#L%d" repo-url location filename linestart)) 422 | (t (format "%s/tree/%s/%s" repo-url location filename)))) 423 | 424 | (defun browse-at-remote--format-commit-url-as-gitlab (repo-url commithash) 425 | "Commit URL formatted for gitlab. 426 | Currently the same as for github." 427 | (format "%s/commit/%s" repo-url commithash)) 428 | 429 | (defun browse-at-remote--format-commit-url-as-sourcehut (repo-url commithash) 430 | "Commit URL formatted for sourcehut." 431 | (format "%s/commit/%s" repo-url commithash)) 432 | 433 | (defun browse-at-remote--format-region-url-as-pagure (repo-url location filename &optional linestart lineend) 434 | (let* ((repo-url (s-replace "/forks/" "/fork/" repo-url)) 435 | (markup_ext (list ".rst" ".mk" ".md" ".markdown")) 436 | (markup? (seq-contains (mapcar (lambda (x) (string-suffix-p x filename)) markup_ext) t)) 437 | (filename (cond (markup? (concat filename "?text=True")) 438 | (t filename)))) 439 | (cond 440 | ((and linestart lineend) 441 | (format "%s/blob/%s/f/%s#_%d-%d" repo-url location filename linestart lineend)) 442 | (linestart (format "%s/blob/%s/f/%s#_%d" repo-url location filename linestart)) 443 | (t (format "%s/blob/%s/f/%s" repo-url location filename))))) 444 | 445 | (defun browse-at-remote--format-commit-url-as-pagure (repo-url commithash) 446 | "Commit URL formatted for github" 447 | (format "%s/c/%s" repo-url commithash)) 448 | 449 | (defun browse-at-remote--gerrit-url-cleanup (repo-url) 450 | "Remove -review from REPO-URL, so we end up at gitiles instead of gerrit" 451 | (replace-regexp-in-string 452 | "^\\(https?://\\)\\([A-Za-z0-9-]+\\)-review\\(\\.googlesource\\.com/\\)" 453 | "\\1\\2\\3" 454 | repo-url)) 455 | 456 | (defun browse-at-remote--format-region-url-as-gitiles (repo-url location filename &optional linestart lineend) 457 | "Region URL formatted for Gitiles." 458 | (format "%s/+/%s/%s%s" 459 | (browse-at-remote--gerrit-url-cleanup repo-url) 460 | location 461 | filename 462 | ;; No support for multiline region in gitiles. Just give 463 | ;; the first line. 464 | (if linestart 465 | (format "#%d" linestart) 466 | ""))) 467 | 468 | (defun browse-at-remote--format-commit-url-as-gitiles (repo-url commithash) 469 | "Commit URL formatted for Gitiles." 470 | (format "%s/+/%s^!/" 471 | (browse-at-remote--gerrit-url-cleanup repo-url) 472 | commithash)) 473 | 474 | (defun browse-at-remote--commit-url (commithash) 475 | "Return the URL to browse COMMITHASH." 476 | (let* ((remote (car (browse-at-remote--remote-ref))) 477 | (target-repo (browse-at-remote--get-url-from-remote remote)) 478 | (repo-url (plist-get target-repo :url)) 479 | (remote-type (browse-at-remote--get-remote-type (plist-get target-repo :unresolved-host))) 480 | (clear-commithash (s-chop-prefixes '("^") commithash)) 481 | (url-formatter (browse-at-remote--get-formatter 'commit-url remote-type))) 482 | (unless url-formatter 483 | (error (format "Origin repo parsing failed: %s" repo-url))) 484 | (funcall url-formatter repo-url clear-commithash))) 485 | 486 | (defun browse-at-remote--file-url (filename &optional start end) 487 | "Return the URL to browse FILENAME from lines START to END. " 488 | (let* ((remote-ref (browse-at-remote--remote-ref filename)) 489 | (remote (car remote-ref)) 490 | (ref (cdr remote-ref)) 491 | (relname (f-relative filename (f-expand (vc-git-root filename)))) 492 | (target-repo (browse-at-remote--get-url-from-remote remote)) 493 | (remote-type (browse-at-remote--get-remote-type (plist-get target-repo :unresolved-host))) 494 | (repo-url (plist-get target-repo :url)) 495 | (url-formatter (browse-at-remote--get-formatter 'region-url remote-type)) 496 | (start-line (when start (line-number-at-pos start))) 497 | (end-line (when end (line-number-at-pos end)))) 498 | (unless url-formatter 499 | (error (format "Origin repo parsing failed: %s" repo-url))) 500 | 501 | (funcall url-formatter repo-url ref relname 502 | (if start-line start-line) 503 | (if (and end-line (not (equal start-line end-line))) end-line)))) 504 | 505 | (defun browse-at-remote-get-url () 506 | "Main method, returns URL to browse." 507 | 508 | (cond 509 | ;; dired-mode 510 | ((eq major-mode 'dired-mode) 511 | (browse-at-remote--file-url (dired-current-directory))) 512 | 513 | ;; magit-status-mode 514 | ((eq major-mode 'magit-status-mode) 515 | (browse-at-remote--file-url default-directory)) 516 | 517 | ;; magit-log-mode 518 | ((or (eq major-mode 'magit-log-mode) (eq major-mode 'vc-annotate-mode)) 519 | (browse-at-remote--commit-url 520 | (save-excursion 521 | (save-restriction 522 | (widen) 523 | (goto-char (line-beginning-position)) 524 | (search-forward " ") 525 | (buffer-substring-no-properties (line-beginning-position) (- (point) 1)))))) 526 | 527 | ;; magit-commit-mode and magit-revision-mode 528 | ((or (eq major-mode 'magit-commit-mode) (eq major-mode 'magit-revision-mode)) 529 | (save-excursion 530 | ;; Search for the SHA1 on the first line. 531 | (goto-char (point-min)) 532 | (let* ((first-line 533 | (buffer-substring-no-properties (line-beginning-position) (line-end-position))) 534 | (commithash (cl-loop for word in (s-split " " first-line) 535 | when (eq 40 (length word)) 536 | return word))) 537 | (browse-at-remote--commit-url commithash)))) 538 | 539 | ;; log-view-mode 540 | ((derived-mode-p 'log-view-mode) 541 | (browse-at-remote--commit-url (cadr (log-view-current-entry)))) 542 | 543 | ;; We're inside of file-attached buffer with active region 544 | ((and buffer-file-name (use-region-p)) 545 | (let ((point-begin (min (region-beginning) (region-end))) 546 | (point-end (max (region-beginning) (region-end)))) 547 | (browse-at-remote--file-url 548 | buffer-file-name point-begin 549 | (if (eq (char-before point-end) ?\n) (- point-end 1) point-end)))) 550 | 551 | ;; We're inside of file-attached buffer without region 552 | (buffer-file-name 553 | (let ((line (when browse-at-remote-add-line-number-if-no-region-selected (point)))) 554 | (browse-at-remote--file-url (buffer-file-name) line))) 555 | 556 | (t (error "Sorry, I'm not sure what to do with this.")))) 557 | 558 | ;;;###autoload 559 | (defun browse-at-remote () 560 | "Browse the current file with `browse-url'." 561 | (interactive) 562 | (browse-url (browse-at-remote-get-url))) 563 | 564 | ;;;###autoload 565 | (defun browse-at-remote-kill () 566 | "Add the URL of the current file to the kill ring. 567 | 568 | Works like `browse-at-remote', but puts the address in the 569 | kill ring instead of opening it with `browse-url'." 570 | (interactive) 571 | (kill-new (browse-at-remote-get-url))) 572 | 573 | ;;;###autoload 574 | (defalias 'bar-browse 'browse-at-remote 575 | "Browse the current file with `browse-url'.") 576 | 577 | ;;;###autoload 578 | (defalias 'bar-to-clipboard 'browse-at-remote-kill 579 | "Add the URL of the current file to the kill ring. 580 | 581 | Works like `browse-at-remote', but puts the address in the 582 | kill ring instead of opening it with `browse-url'.") 583 | 584 | (provide 'browse-at-remote) 585 | 586 | ;;; browse-at-remote.el ends here 587 | -------------------------------------------------------------------------------- /readme.rst: -------------------------------------------------------------------------------- 1 | .. image:: http://melpa.org/packages/browse-at-remote-badge.svg 2 | :target: http://melpa.org/#/browse-at-remote 3 | 4 | .. image:: https://travis-ci.org/rmuslimov/browse-at-remote.svg?branch=master 5 | :target: https://travis-ci.org/rmuslimov/browse-at-remote 6 | 7 | browse-at-remote.el 8 | =================== 9 | 10 | This package is easiest way to open particular link on *github*/*gitlab*/*bitbucket*/*stash*/*git.savannah.gnu.org*/*sourcehut* from Emacs. It supports various kind of emacs buffer, like: 11 | 12 | - file buffer 13 | - dired buffer 14 | - magit-mode buffers representing code 15 | - vc-annotate mode (use get there by pressing ``C-x v g`` by default) 16 | 17 | Installation: 18 | ------------- 19 | 20 | Add ``browse-at-remote`` to your Cask file::: 21 | 22 | (depends-on "browse-at-remote") 23 | 24 | Manual 25 | ****** 26 | 27 | Simply add this package to your emacs path, and add to ``.emacs``,:: 28 | 29 | (require 'browse-at-remote) 30 | 31 | Active keybindings for ``browse-at-remote`` function::: 32 | 33 | (global-set-key (kbd "C-c g g") 'browse-at-remote) 34 | 35 | GNU Guix 36 | ******** 37 | 38 | Run ``guix install emacs-browse-at-remote`` then load ``browse-at-remote`` from your Emacs init. 39 | 40 | Customization 41 | ------------- 42 | 43 | Remote types 44 | ************ 45 | 46 | By default `browse-at-remote` knows how to work with popular remote types (github/gitlab..). Knowledge how to work with certain remote-type comes from mapping `browse-at-remote-remote-type-domains`. It defines that `github.com` should be treat in github manner, `bitbucket.org` in bitbucket manner and so on. 47 | In your development you may have some specific git-url, and `browse-at-remote` will before confuse which remote-type map to your domain. 48 | 49 | Two solution available: 50 | 51 | 1. In that case you can to customize that. (`M-x customize ... browse-at-remote-remote-type-domains`). For now our package supports next remote-types: 52 | 53 | 54 | - bitbucket.com 55 | - gitlab.com 56 | - github.com 57 | - Stash 58 | - git.savannah.gnu.org 59 | - gist.github.com 60 | - Phabricator 61 | - git.sr.ht 62 | - pagure.io 63 | - vs-ssh.visualstudio.com 64 | 65 | 66 | 2. Set specific remote-type directly in git repo. For example, if your repository is hosted on GitHub enterprise, you should add following setting to its config:: 67 | 68 | git config --add browseAtRemote.type "github" 69 | 70 | or for private Stash repository use command:: 71 | 72 | git config --add browseAtRemote.type "stash" 73 | 74 | Excluding line number if no region is selected 75 | ********************************************** 76 | 77 | By default `browse-at-remote` add line number when region is not selected in file attached buffer. If you don't like that and what to see no line information URL, it's possible to disable that by adding::: 78 | 79 | (setq browse-at-remote-add-line-number-if-no-region-selected nil) 80 | 81 | Or setting via UI with `M-x customize`. 82 | 83 | Customize how the host is resolved 84 | ********************************** 85 | 86 | There are cases where you might need to resolve a remote host to a particular value. For example, one common strategy to manage multiple SSH keys is to add an entry to `~/.ssh.config`:: 87 | 88 | Host mycompany.github.com 89 | HostName github.com 90 | User git 91 | IdentityFile ~/.ssh/id_rsa_mycompany 92 | 93 | For such cases, you can use the `:actual-host` property:: 94 | 95 | (add-to-list 'browse-at-remote-remote-type-regexps 96 | `(:host ,(rx bol "mycompany.github.com" eol) 97 | :type "github" 98 | :actual-host "github.com")) 99 | 100 | You can also directly configure the repository:: 101 | 102 | git config --add browseAtRemote.actualHost "github.com" 103 | 104 | Adding new remote type 105 | ---------------------- 106 | 107 | You can add your own remote if you need - PRs are welcome! Please see good examples here: gnu-savannah-remote_, or stash-remote_. 108 | 109 | 110 | Usage: 111 | ------ 112 | 113 | 1. Call function from emacs buffer:: 114 | 115 | M-x browse-at-remote 116 | 117 | or:: 118 | 119 | M-x bar-browse 120 | 121 | .. image:: http://i.imgur.com/rmAky8e.png 122 | 123 | or just call ``C-c g g`` if you've already added binding before. You can use 124 | this command in dired buffers too. 125 | 126 | 2. Target page at github/bitbucket will be opened using your default browser: 127 | 128 | 129 | .. image:: http://i.imgur.com/wBW9Gov.png 130 | alt: screenshot of page at github 131 | 132 | or same here is folder view at bitbucket: 133 | 134 | .. image:: http://i.imgur.com/XuzLhcR.png 135 | alt: screenshot page tree at bibucket 136 | 137 | 3. Opening github commit's page at *magit-commit-mode*, *magit-log-mode*: 138 | 139 | .. image:: http://i.imgur.com/NzlIHYr.png 140 | alt: screenshot of *magit-log-mode* 141 | 142 | 4. Open last commit which added target line: 143 | 144 | .. image:: http://i.imgur.com/lpmOAz2.png 145 | alt: screen of *vc-annotate-mode* 146 | 147 | - Press `C-x v g` to call standard vc-annotate 148 | - Call `browse-at-remote` on target line 149 | 150 | 151 | Contributors: 152 | ------------- 153 | 154 | - `@rmuslimov`_ 155 | - `@env0der`_ 156 | - `@ben`_ 157 | - `@duff`_ 158 | - `@Wilfred`_ 159 | - `@yauhen-l`_ 160 | - `@ieure`_ 161 | - `@wigust`_ 162 | - `@CyberShadow`_ 163 | - `@kuba-orlik`_ 164 | - `@jwhitbeck`_ 165 | - `@microamp`_ 166 | - `@FrostyX`_ 167 | - `@legendary-mich`_ 168 | - `@ilmotta`_ 169 | 170 | Changelog: 171 | -------- 172 | 173 | 0.15.0 174 | ****** 175 | Added new feature allowing customize how hosts are resolved by @ilmotta. 176 | 177 | 178 | 0.14.0 179 | ****** 180 | New remote type added **Pagure** by `@FrostyX`_. 181 | New configuration option `browse-at-remote-add-line-number-if-no-region-selected` allowing add or not line number when target page open and region initially is not selected. 182 | 183 | 0.13.0 184 | ****** 185 | New remote type added **Sourcehut** by `@microamp`_. 186 | 187 | 0.12.0 188 | ****** 189 | New remote type added **Phabricator** by `@kuba-orlik`_. 190 | 191 | 0.11.0 192 | ****** 193 | New remote type added **gist.github.com** by `@CyberShadow`_. 194 | 195 | 0.10.0 196 | ****** 197 | New remote type added **git.savannah.gnu.org** by `@wigust`_. 198 | 199 | 0.9.0 200 | ***** 201 | Minor fixes, added Stash (bitbucket support) by `@yauhen-l`_. 202 | 203 | 0.8.0 204 | ***** 205 | Drop clojure-style function namings. Add abbrev methods like `bar-browse` and `bar-to-clipoboard` (where `bar` is browse-at-remote abbrev.) 206 | 207 | 0.7.0 208 | ***** 209 | Major refactorings by `@ieure`_. Main function renamed to `browse-at-remote/browse`. (renamed in 0.8.0 to `bar-browse`) 210 | 211 | 0.6.0 212 | ***** 213 | Added support of Gitlab by `@env0der`_. Thanks! 214 | 215 | 0.5.0 216 | ***** 217 | Added support of Github Enterprice. Special thanks for `@env0der`_ for this feature. 218 | 219 | 0.4.0 220 | ***** 221 | Function `browse-at-remote/to-clipboard` were added (renamed in 0.8.0 to `bar-to-clibpoard`) 222 | 223 | TODO: 224 | ----- 225 | 226 | - Add mercurial support 227 | 228 | 229 | .. _`@rmuslimov`: https://github.com/rmuslimov 230 | .. _`@env0der`: https://github.com/env0der 231 | .. _`@Wilfred`: https://github.com/Wilfred 232 | .. _`@ben`: https://github.com/ben 233 | .. _`@duff`: https://github.com/duff 234 | .. _`@ieure`: https://github.com/ieure 235 | .. _`@yauhen-l`: https://github.com/yauhen-l 236 | .. _`@wigust`: https://github.com/wigust 237 | .. _`@CyberShadow`: https://github.com/CyberShadow 238 | .. _`@kuba-orlik`: https://github.com/kuba-orlik 239 | .. _`@jwhitbeck`: https://github.com/jwhitbeck 240 | .. _`@microamp`: https://github.com/microamp 241 | .. _`@FrostyX`: https://github.com/FrostyX 242 | .. _`@legendary-mich`: https://github.com/legendary-mich 243 | .. _stash-remote: https://github.com/rmuslimov/browse-at-remote/pull/34/files 244 | .. _gnu-savannah-remote: https://github.com/rmuslimov/browse-at-remote/pull/46/files 245 | -------------------------------------------------------------------------------- /test/api-basic-test.el: -------------------------------------------------------------------------------- 1 | ;;; -*- lexical-binding: t -*- 2 | 3 | (require 'browse-at-remote) 4 | 5 | (add-to-list 'browse-at-remote-remote-type-regexps 6 | `(:host ,(rx bol "acme.io" eol) 7 | :type "github" 8 | :actual-host "github.com")) 9 | 10 | (ert-deftest get-git-repo-url-test () 11 | "Generate github repo url from various kind of origin" 12 | (should (equal (browse-at-remote--get-url-from-remote "ssh://git@bitbucket.org:peta/project.git") 13 | '(:host "bitbucket.org" :unresolved-host "bitbucket.org" :url "https://bitbucket.org/peta/project"))) 14 | (should (equal (browse-at-remote--get-url-from-remote "ssh://git@acme.io:peta/project.git") 15 | '(:host "github.com" :unresolved-host "acme.io" :url "https://github.com/peta/project"))) 16 | (should (equal (browse-at-remote--get-url-from-remote "git@github.com:getgoing/airborne.git") 17 | '(:host "github.com" :unresolved-host "github.com" :url "https://github.com/getgoing/airborne"))) 18 | (should (equal (browse-at-remote--get-url-from-remote "git@github.com:env0der/dotemacs.git") 19 | '(:host "github.com" :unresolved-host "github.com" :url "https://github.com/env0der/dotemacs"))) 20 | (should (equal (browse-at-remote--get-url-from-remote "git@bitbucket.org:some/bome.git") 21 | '(:host "bitbucket.org" :unresolved-host "bitbucket.org" :url "https://bitbucket.org/some/bome"))) 22 | (should (equal (browse-at-remote--get-url-from-remote "git@github.com:someplace_with_underscores/with_underscores.el.git") 23 | '(:host "github.com" :unresolved-host "github.com" :url "https://github.com/someplace_with_underscores/with_underscores.el"))) 24 | (should (equal (browse-at-remote--get-url-from-remote "git@github.com:someplace/with-dash.el.git") 25 | '(:host "github.com" :unresolved-host "github.com" :url "https://github.com/someplace/with-dash.el"))) 26 | (should (equal (browse-at-remote--get-url-from-remote "git@github.com:someplace/wi2th-dash.el.git") 27 | '(:host "github.com" :unresolved-host "github.com" :url "https://github.com/someplace/wi2th-dash.el"))) 28 | (should (equal (browse-at-remote--get-url-from-remote "git@acme.io:someplace/wi2th-dash.el.git") 29 | '(:host "github.com" :unresolved-host "acme.io" :url "https://github.com/someplace/wi2th-dash.el"))) 30 | (should (equal (browse-at-remote--get-url-from-remote "ssh://git.example.com:8080/someplace/wi2th-dash.el") 31 | '(:host "git.example.com" :unresolved-host "git.example.com" :url "https://git.example.com/someplace/wi2th-dash.el"))) 32 | (should (equal (browse-at-remote--get-url-from-remote "ssh://user@git.example.com:8080/someplace/wi2th-dash.el") 33 | '(:host "git.example.com" :unresolved-host "git.example.com" :url "https://git.example.com/someplace/wi2th-dash.el"))) 34 | (should (equal (browse-at-remote--get-url-from-remote "git+ssh://git.example.com:8080/someplace/wi2th-dash.el") 35 | '(:host "git.example.com" :unresolved-host "git.example.com" :url "https://git.example.com/someplace/wi2th-dash.el"))) 36 | (should (equal (browse-at-remote--get-url-from-remote "git@gitlab.com:someplace/double-nested/wi2th-dash.el.git") 37 | '(:host "gitlab.com" :unresolved-host "gitlab.com" :url "https://gitlab.com/someplace/double-nested/wi2th-dash.el")))) 38 | 39 | (ert-deftest get-https-repo-url-test () 40 | "Test origins having https in the beginning" 41 | (should (equal (browse-at-remote--get-url-from-remote "https://rmuslimov@bitbucket.org/some/bome.git") 42 | '(:host "bitbucket.org" :unresolved-host "bitbucket.org" :url "https://bitbucket.org/some/bome"))) 43 | (should (equal (browse-at-remote--get-url-from-remote "https://github.com/syl20bnr/spacemacs") 44 | '(:host "github.com" :unresolved-host "github.com" :url "https://github.com/syl20bnr/spacemacs"))) 45 | (should (equal (browse-at-remote--get-url-from-remote "https://github.com/rejeep/prodigy.el.git") 46 | '(:host "github.com" :unresolved-host "github.com" :url "https://github.com/rejeep/prodigy.el"))) 47 | (should (equal (browse-at-remote--get-url-from-remote "https://github.com/rejeep/pro-digy.el.git") 48 | '(:host "github.com" :unresolved-host "github.com" :url "https://github.com/rejeep/pro-digy.el"))) 49 | (should (equal (browse-at-remote--get-url-from-remote "https://github.com/with_underscores/pro-digy_underscores.el.git") 50 | '(:host "github.com" :unresolved-host "github.com" :url "https://github.com/with_underscores/pro-digy_underscores.el"))) 51 | (should (equal (browse-at-remote--get-url-from-remote "https://github.com/rmuslimov/browse-at-remote.git") 52 | '(:host "github.com" :unresolved-host "github.com" :url "https://github.com/rmuslimov/browse-at-remote"))) 53 | (should (equal (browse-at-remote--get-url-from-remote "https://gitlab.com/someplace/double-nested/wi2th-dash.el.git") 54 | '(:host "gitlab.com" :unresolved-host "gitlab.com" :url "https://gitlab.com/someplace/double-nested/wi2th-dash.el"))) 55 | (should (equal (browse-at-remote--get-url-from-remote "https://acme.io:8000/someplace/wi2th-dash.el.git") 56 | '(:host "github.com:8000" :unresolved-host "acme.io:8000" :url "https://github.com:8000/someplace/wi2th-dash.el"))) 57 | (should (equal (browse-at-remote--get-url-from-remote "http://git.example.com:8000/someplace/wi2th-dash.el.git") 58 | '(:host "git.example.com:8000" :unresolved-host "git.example.com:8000" :url "http://git.example.com:8000/someplace/wi2th-dash.el"))) 59 | (should (equal (browse-at-remote--get-url-from-remote "https://git.example.com:8000/someplace/wi2th-dash.el.git") 60 | '(:host "git.example.com:8000" :unresolved-host "git.example.com:8000" :url "https://git.example.com:8000/someplace/wi2th-dash.el")))) 61 | 62 | (ert-deftest get-https-repo-url-without-ending () 63 | (should (equal (browse-at-remote--get-url-from-remote "https://github.com/rmuslimov/browse-at-remote") 64 | '(:host "github.com" :unresolved-host "github.com" :url "https://github.com/rmuslimov/browse-at-remote"))) 65 | (should (equal (browse-at-remote--get-url-from-remote "https://github.com/rmus2limov/brows2e-at-remote") 66 | '(:host "github.com" :unresolved-host "github.com" :url "https://github.com/rmus2limov/brows2e-at-remote"))) 67 | (should (equal (browse-at-remote--get-url-from-remote "git@github.com:someplace/without-ending") 68 | '(:host "github.com" :unresolved-host "github.com" :url "https://github.com/someplace/without-ending")))) 69 | 70 | (ert-deftest get-repo-url-pagure () 71 | (let ((repo-url "https://pagure.io/copr/copr") 72 | (location "master") 73 | (filename "frontend/coprs_frontend/manage.py")) 74 | (should (equal (browse-at-remote--format-region-url-as-pagure repo-url location filename) 75 | "https://pagure.io/copr/copr/blob/master/f/frontend/coprs_frontend/manage.py")) 76 | (should (equal (browse-at-remote--format-region-url-as-pagure repo-url location filename 12) 77 | "https://pagure.io/copr/copr/blob/master/f/frontend/coprs_frontend/manage.py#_12")) 78 | (should (equal (browse-at-remote--format-region-url-as-pagure repo-url location filename 12 14) 79 | "https://pagure.io/copr/copr/blob/master/f/frontend/coprs_frontend/manage.py#_12-14")) 80 | (should (equal (browse-at-remote--format-region-url-as-pagure repo-url location "README.md" 12 14) 81 | "https://pagure.io/copr/copr/blob/master/f/README.md?text=True#_12-14")) 82 | (should (equal (browse-at-remote--format-region-url-as-pagure "https://pagure.io/forks/frostyx/copr/copr" location filename) 83 | "https://pagure.io/fork/frostyx/copr/copr/blob/master/f/frontend/coprs_frontend/manage.py")))) 84 | 85 | (ert-deftest get-repo-url-ado () 86 | ;; GreatBanana - organization 87 | ;; Forest - project 88 | ;; Gorillas - repository 89 | (let ((repo-url "https://vs-ssh.visualstudio.com/v3/GreatBanana/Forest/Gorillas") 90 | (location "master") 91 | (filename "kind/silverback.el")) 92 | (should (equal (browse-at-remote--format-region-url-as-ado repo-url location filename) 93 | "https://GreatBanana.visualstudio.com/Forest/_git/Gorillas?version=GBmaster&path=/kind/silverback.el")) 94 | (should (equal (browse-at-remote--format-region-url-as-ado repo-url location filename 12) 95 | "https://GreatBanana.visualstudio.com/Forest/_git/Gorillas?version=GBmaster&path=/kind/silverback.el&line=12&lineStartColumn=1&lineEndColumn=1")) 96 | (should (equal (browse-at-remote--format-region-url-as-ado repo-url location filename 12 14) 97 | "https://GreatBanana.visualstudio.com/Forest/_git/Gorillas?version=GBmaster&path=/kind/silverback.el&line=12&lineEnd=15&lineStartColumn=1&lineEndColumn=1")))) 98 | 99 | (ert-deftest format-region-url-gitiles () 100 | (let ((repo-url "https://chromium-review.googlesource.com/chromiumos/platform/ec") 101 | (location "main") 102 | (filename "common/printf.c")) 103 | (should (equal (browse-at-remote--format-region-url-as-gitiles repo-url location filename) 104 | "https://chromium.googlesource.com/chromiumos/platform/ec/+/main/common/printf.c")) 105 | (should (equal (browse-at-remote--format-region-url-as-gitiles repo-url location filename 102) 106 | "https://chromium.googlesource.com/chromiumos/platform/ec/+/main/common/printf.c#102")) 107 | (should (equal (browse-at-remote--format-region-url-as-gitiles repo-url location filename 102 110) 108 | "https://chromium.googlesource.com/chromiumos/platform/ec/+/main/common/printf.c#102")))) 109 | 110 | (ert-deftest format-commit-url-gitiles () 111 | (let ((repo-url "https://chromium-review.googlesource.com/chromiumos/platform/ec") 112 | (commit "bf9979b91599ffc76018d60e780d19fa8d266ac0")) 113 | (should (equal (browse-at-remote--format-commit-url-as-gitiles repo-url commit) 114 | "https://chromium.googlesource.com/chromiumos/platform/ec/+/bf9979b91599ffc76018d60e780d19fa8d266ac0^!/")))) 115 | -------------------------------------------------------------------------------- /test/run-tests: -------------------------------------------------------------------------------- 1 | (let ((current-directory (file-name-directory load-file-name))) 2 | (setq browse-at-remote-test-path (expand-file-name "." current-directory)) 3 | (setq browse-at-remote-root-path (expand-file-name ".." current-directory))) 4 | 5 | (add-to-list 'load-path browse-at-remote-root-path) 6 | (add-to-list 'load-path browse-at-remote-test-path) 7 | --------------------------------------------------------------------------------