├── .github ├── no-response.yml └── workflows │ └── test.yml ├── .gitignore ├── Makefile ├── README.md ├── git-link-test.el ├── git-link-transient.el └── git-link.el /.github/no-response.yml: -------------------------------------------------------------------------------- 1 | # Configuration for probot-no-response - https://github.com/probot/no-response 2 | 3 | daysUntilClose: 7 4 | responseRequiredLabel: more info 5 | closeComment: > 6 | Closing due to lack of feedback. Feel free to reopen with additional info. 7 | -------------------------------------------------------------------------------- /.github/workflows/test.yml: -------------------------------------------------------------------------------- 1 | name: CI 2 | 3 | on: [push, pull_request] 4 | 5 | jobs: 6 | test: 7 | runs-on: ${{ matrix.os }} 8 | strategy: 9 | matrix: 10 | os: [ubuntu-latest] 11 | emacs-version: 12 | - 24.3 13 | - 24.4 14 | - 24.5 15 | - 25.3 16 | - 26.3 17 | - 27.2 18 | - 28.2 19 | - 29.4 20 | - snapshot 21 | 22 | steps: 23 | - uses: actions/checkout@v2 24 | 25 | - uses: purcell/setup-emacs@master 26 | with: 27 | version: ${{ matrix.emacs-version }} 28 | 29 | - name: Run tests 30 | run: make test 31 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | 2 | # Created by https://www.gitignore.io/api/emacs,elisp 3 | 4 | ### Elisp ### 5 | # Compiled 6 | *.elc 7 | 8 | # Packaging 9 | .cask 10 | 11 | # Backup files 12 | *~ 13 | 14 | # Undo-tree save-files 15 | *.~undo-tree 16 | 17 | ### Emacs ### 18 | # -*- mode: gitignore; -*- 19 | \#*\# 20 | /.emacs.desktop 21 | /.emacs.desktop.lock 22 | auto-save-list 23 | tramp 24 | .\#* 25 | 26 | # Org-mode 27 | .org-id-locations 28 | *_archive 29 | 30 | # flymake-mode 31 | *_flymake.* 32 | 33 | # eshell files 34 | /eshell/history 35 | /eshell/lastdir 36 | 37 | # elpa packages 38 | /elpa/ 39 | 40 | # reftex files 41 | *.rel 42 | 43 | # AUCTeX auto folder 44 | /auto/ 45 | 46 | # cask packages 47 | .cask/ 48 | dist/ 49 | 50 | # Flycheck 51 | flycheck_*.el 52 | 53 | # server auth directory 54 | /server/ 55 | 56 | # projectiles files 57 | .projectile 58 | projectile-bookmarks.eld 59 | 60 | # directory configuration 61 | .dir-locals.el 62 | 63 | # saveplace 64 | places 65 | 66 | # url cache 67 | url/cache/ 68 | 69 | # cedet 70 | ede-projects.el 71 | 72 | # smex 73 | smex-items 74 | 75 | # company-statistics 76 | company-statistics-cache.el 77 | 78 | # anaconda-mode 79 | anaconda-mode/ 80 | 81 | 82 | # End of https://www.gitignore.io/api/emacs,elisp 83 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | .PHONEY: all build test clean 2 | 3 | emacs ?= emacs 4 | 5 | all: test 6 | 7 | build: clean 8 | "$(emacs)" -Q --batch -L . -f batch-byte-compile git-link.el 9 | 10 | test: build 11 | "$(emacs)" -Q --batch -L . -l ert -l git-link-test.el -f ert-run-tests-batch-and-exit 12 | 13 | clean: 14 | rm -f git-link.elc 15 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # git-link 2 | 3 | [![MELPA](http://melpa.org/packages/git-link-badge.svg)](http://melpa.org/#/git-link) 4 | [![Build Status](https://github.com/sshaw/git-link/workflows/CI/badge.svg)](https://github.com/sshaw/git-link/actions) 5 | 6 | Interactive Emacs functions that create URLs for files and commits in GitHub/Bitbucket/GitLab/... repositories. 7 | 8 | `git-link` returns the URL for the current buffer's file location at the current line number or active region. 9 | 10 | `git-link-commit` returns the URL for the commit at point. 11 | 12 | `git-link-homepage` returns the URL for the repository's homepage. 13 | 14 | URLs are added to the kill ring. 15 | 16 | ## Usage 17 | 18 | Functions can be called interactively (`M-x git-link`) or via a key binding of your choice. For example: 19 | ```el 20 | (global-set-key (kbd "C-c g l") 'git-link) 21 | ``` 22 | 23 | With a single prefix argument prompt for the remote's name. Defaults to `"origin"`. 24 | 25 | With a double prefix argument invert the value of `git-link-use-commit`. 26 | 27 | With a prefix argument of `-`, generate a link without line numbers. 28 | 29 | Works with Dired, Magit, VC revisions, and Tramp too. 30 | 31 | ### Settings 32 | 33 | Global setting are elisp variables. They can be set directly or via `M-x customize`. 34 | 35 | Local settings are managed via the repository's git configuration. They can be set via: 36 | 37 | ``` 38 | git config --local --add setting value 39 | ``` 40 | 41 | Local settings have precedence over global settings. 42 | 43 | #### Global 44 | 45 | ##### `git-link-default-remote` 46 | 47 | Name of the remote to link to, defaults to `nil`. 48 | 49 | ##### `git-link-default-branch` 50 | 51 | Name of the remote branch to link to, defaults to the current branch. 52 | 53 | ##### `git-link-open-in-browser` 54 | 55 | If `t` also open the link via `browse-url`. To use an alternate function set to 56 | that function's symbol. Defaults to `nil`. 57 | 58 | ##### `git-link-use-commit` 59 | 60 | If non-`nil` use the latest commit's hash in the link instead of the branch name, defaults to `nil`. 61 | 62 | ##### `git-link-use-single-line-number` 63 | 64 | If `nil` line numbers are only added when the selection contains more than 1 line, defaults to `t`. 65 | 66 | Note that `git-link` will exclude line numbers when invoked with the `-` prefix argument. 67 | 68 | ##### `git-link-add-to-kill-ring` 69 | 70 | If `t` the link will be added to the kill-ring, defaults to `t` 71 | 72 | ##### `git-link-consider-ssh-config` 73 | 74 | If `t` consider ssh configuration file for resolving the remote's hostname. If there's a match (using `ssh -G`), 75 | the link will be generated to the matching host instead of the remote's host. Defaults to `nil`. 76 | 77 | #### Local 78 | 79 | ##### `git-link.remote` 80 | 81 | Name of the remote to link to. 82 | 83 | ##### `git-link.branch` 84 | 85 | Name of the remote branch to link to. 86 | 87 | ### Supported Services 88 | 89 | * [Azure DevOps](https://azure.microsoft.com/en-us/services/devops/) 90 | * [AWS CodeCommit](https://aws.amazon.com/codecommit/) 91 | * [Bitbucket](http://bitbucket.com) 92 | * [Codeberg](https://codeberg.org/) 93 | * [cgit](https://wiki.archlinux.org/title/Cgit) 94 | * [GitHub](http://github.com) 95 | * [GitLab](https://gitlab.com) 96 | * [Gitea](https://about.gitea.com/) 97 | * [Gitorious](http://gitorious.org) 98 | * [GoogleSource](https://googlesource.com) 99 | * [Savannah](https://git.savannah.gnu.org/cgit) 100 | * [Sourcegraph](https://sourcegraph.com) 101 | * [sourcehut](https://sourcehut.org) 102 | 103 | ### Git Timemachine 104 | 105 | If [`git-timemachine-mode`](https://codeberg.org/pidu/git-timemachine) 106 | is active `git-link` generates a URL for the version of the file being 107 | visited. 108 | 109 | ### cgit and Gitea 110 | 111 | git-link comes with functions for linking to repositories hosted by these services but, because they're self-hosted there is no default URL to match. 112 | To make git-link work with these you must configure your URLs to use the appropriate matching function. 113 | 114 | #### cgit 115 | 116 | ```el 117 | (eval-after-load 'git-link 118 | '(progn 119 | (add-to-list 'git-link-remote-alist 120 | '("your-cgit\\.example\\.com" git-link-cgit)) 121 | (add-to-list 'git-link-commit-remote-alist 122 | '("your-cgit\\.domain\\.tld" git-link-commit-cgit)))) 123 | ``` 124 | 125 | #### Gitea 126 | 127 | ```el 128 | (eval-after-load 'git-link 129 | '(progn 130 | (add-to-list 'git-link-remote-alist 131 | '("your-gitea\\.example\\.com" git-link-gitea)) 132 | (add-to-list 'git-link-commit-remote-alist 133 | '("your-gitea\\.domain\\.tld" git-link-commit-gitea)))) 134 | ``` 135 | 136 | ### Sourcegraph 137 | 138 | To link to files on a Sourcegraph server add a git remote pointing to the repository's Sourcegraph page: 139 | ``` 140 | git remote add sourcegraph https://sourcegraph.com/github.com/sshaw/copy-as-format 141 | ``` 142 | 143 | Links can be generated by [specifying `sourcegraph` as your remote](#usage) when calling the desired link function or 144 | by [setting `sourcegraph` as the default remote](#settings). 145 | 146 | **Note** that the remote can be named anything but its URL's host must match what's in the associated link function's alist. 147 | This defaults to `"sourcegraph"` but can be changed. See [Building Links and Adding Services](#building-links-and-adding-services). 148 | 149 | URLs with ports or an http scheme will not work. It's a trivial fix so if it's a problem for you please open an issue. 150 | 151 | ### [Emacs Transient](https://www.gnu.org/software/emacs/manual/html_mono/transient.html) Support 152 | 153 | An optional Transient interface (magit-like menu) is provided via `git-link-transient.el`. To enable you need to have 154 | `transient` installed as a dependency. 155 | 156 | To enable `(require 'git-link-transient)` and call `git-link-dispatch` to show the menu. 157 | 158 | 159 | ### Building Links and Adding Services 160 | 161 | `git-link-remote-alist` is an alist containing `(REGEXP FUNCTION)` 162 | elements. The FUNCTION creates URLs for file on remote host names that 163 | match the REGEXP. To add (or modify) how URLs are created for a given 164 | host, add appropriate elements to this list. 165 | 166 | As an example, one of the default elements in this alist is 167 | `("gitlab" git-link-gitlab)`. So the `git-link-gitlab` function 168 | will be used to create URLs to files in remotes that match the 169 | *regexp* `"gitlab"`. That would cover common Gitlab host URLs like 170 | *"gitlab.com"*, *"gitlab.example.com"* and *"gitlab.example.org"*. 171 | 172 | `git-link-commit-remote-alist` is also an alist containing `(REGEXP 173 | FUNCTION)` elements. Here, the FUNCTION creates URLs to the commit 174 | pages, for remote hosts matching REGEXP. 175 | 176 | If you use a self-hosted version of one of the supported services, but 177 | your remote URL does match with the defaults, you can configure these 178 | link function alists. For example, for a GitHub Enterprise instance 179 | at `gh.example.com`, you could add the following to your `.emacs` 180 | file: 181 | 182 | ```el 183 | (eval-after-load 'git-link 184 | '(progn 185 | (add-to-list 'git-link-remote-alist 186 | '("gh\\.example\\.com" git-link-github)) 187 | (add-to-list 'git-link-commit-remote-alist 188 | '("gh\\.example\\.com" git-link-commit-github)))) 189 | ``` 190 | 191 | The `git-link` signature is: 192 | 193 | `HOSTNAME DIRNAME FILENAME BRANCH COMMIT START END` 194 | 195 | * `HOSTNAME` hostname of the remote 196 | * `DIRNAME` directory portion of the remote 197 | * `FILENAME` source file, relative to `DIRNAME` 198 | * `BRANCH` active branch, may be `nil` if the repo's in "detached HEAD" state 199 | * `COMMIT` SHA of the latest commit 200 | * `START` starting line number 201 | * `END` ending line number, `nil` unless region is active 202 | 203 | The `git-link-commit` signature is: 204 | 205 | `HOSTNAME DIRNAME COMMIT` 206 | 207 | * `HOSTNAME` hostname of the remote 208 | * `DIRNAME` directory portion of the remote 209 | * `COMMIT` SHA of the commit 210 | 211 | ### See Also 212 | 213 | * [copy-as-format](https://github.com/sshaw/copy-as-format) 214 | * [output-as-format](https://github.com/sshaw/output-as-format) 215 | 216 | ### TODO 217 | 218 | * More tests! 219 | * Consolidate `git-link-*-alist`s 220 | * `git-link-grep` 221 | -------------------------------------------------------------------------------- /git-link-test.el: -------------------------------------------------------------------------------- 1 | ;; Tests for git-link 2 | 3 | (require 'ert) 4 | (require 'git-link) 5 | 6 | (ert-deftest git-link--parse-remote-test () 7 | (should (equal '("foo" "") 8 | (git-link--parse-remote "foo"))) 9 | 10 | (should (equal '("github.com" "") 11 | (git-link--parse-remote "https://github.com"))) 12 | 13 | (should (equal '("github.com" "/") 14 | (git-link--parse-remote "https://github.com/"))) 15 | 16 | (should (equal '("github.com" "sshaw_/selfie_formatter") 17 | (git-link--parse-remote "git@github.com:sshaw_/selfie_formatter.git"))) 18 | 19 | (should (equal '("github.com" "ruby/ruby") 20 | (git-link--parse-remote "https://github.com/ruby/ruby.git"))) 21 | 22 | (should (equal '("github.com" "sshaw/copy-as-format") 23 | (git-link--parse-remote "https://github.com:9999/sshaw/copy-as-format.git"))) 24 | 25 | (should (equal '("github.com" "ScreenStaring/Some-Thing") 26 | (git-link--parse-remote "git@github.com:ScreenStaring/Some-Thing.git"))) 27 | 28 | (should (equal '("orgmode.org" "org-mode") 29 | (git-link--parse-remote "https://orgmode.org/org-mode.git"))) 30 | 31 | (should (equal '("gitlab.com" "weshmashian/emacs.d") 32 | (git-link--parse-remote "https://gitlab.com/weshmashian/emacs.d"))) 33 | 34 | (should (equal '("codeberg.org" "takeonrules/emacs.d") 35 | (git-link--parse-remote "https://codeberg.org/takeonrules/emacs.d"))) 36 | 37 | (should (equal '("foo-bar.github.com" "sshaw/foo/x") 38 | (git-link--parse-remote "https://user:password@foo-bar.github.com/sshaw/foo/x.git"))) 39 | 40 | (should (equal '("msazure.visualstudio.com" "project/_git/repo") 41 | (git-link--parse-remote "msazure@vs-ssh.visualstudio.com:v3/msazure/project/repo"))) 42 | 43 | (should (equal '("msazure.visualstudio.com" "DefaultCollection/project/_git/repo") 44 | (git-link--parse-remote "https://msazure.visualstudio.com/DefaultCollection/project/_git/repo"))) 45 | 46 | (should (equal '("dev.azure.com" "r-darwish/project/_git/repo") 47 | (git-link--parse-remote "git@ssh.dev.azure.com:v3/r-darwish/project/repo"))) 48 | 49 | (should (equal '("dev.azure.com" "r-darwish/project/_git/repo") 50 | (git-link--parse-remote "https://r-darwish@dev.azure.com/r-darwish/project/_git/repo"))) 51 | 52 | (should (equal '("git.sv.gnu.org" "emacs") 53 | (git-link--parse-remote "git://git.sv.gnu.org/emacs.git"))) 54 | 55 | (should (equal '("git.savannah.gnu.org" "emacs") 56 | (git-link--parse-remote "https://git.savannah.gnu.org/git/emacs.git"))) 57 | 58 | (should (equal '("git.savannah.gnu.org" "emacs") 59 | (git-link--parse-remote "ssh://git.savannah.gnu.org/srv/git/emacs.git"))) 60 | 61 | (should (equal '("git.savannah.gnu.org" "emacs") 62 | (git-link--parse-remote "git://git.savannah.gnu.org/emacs.git"))) 63 | 64 | (should (equal '("us-west-2.console.aws.amazon.com" "codesuite/codecommit/repositories/TestRepo") 65 | (git-link--parse-remote "ssh://git-codecommit.us-west-2.amazonaws.com/v1/repos/TestRepo"))) 66 | 67 | (should (equal '("go.googlesource.com" "go") 68 | (git-link--parse-remote "https://go.googlesource.com/go"))) 69 | 70 | (should (equal '("bitbucket.org" "atlassianlabs/atlascode") 71 | (git-link--parse-remote "https://bitbucket.org/atlassianlabs/atlascode.git"))) 72 | 73 | (should (equal '("bitbucket.org" "atlassianlabs/atlascode") 74 | (git-link--parse-remote "ssh://bitbucket.org:atlassianlabs/atlascode.git")))) 75 | 76 | (ert-deftest git-link-bitbucket () 77 | (should (equal "https://bitbucket.org/atlassian/atlascode/annotate/a-commit-hash/README.md#README.md-1" 78 | (git-link-bitbucket "bitbucket.org" "atlassian/atlascode" "README.md" "_branch" "a-commit-hash" 1 nil))) 79 | 80 | (should (equal "https://bitbucket.org/atlassian/atlascode/annotate/a-commit-hash/README.md#README.md-1:33" 81 | (git-link-bitbucket "bitbucket.org" "atlassian/atlascode" "README.md" "_branch" "a-commit-hash" 1 33))) 82 | 83 | (should (equal "https://bitbucket.org/atlassian/atlascode/src/a-commit-hash/.gitignore#.gitignore-1:33" 84 | (git-link-bitbucket "bitbucket.org" "atlassian/atlascode" ".gitignore" "_branch" "a-commit-hash" 1 33)))) 85 | 86 | (ert-deftest git-link--should-render-via-bitbucket-annotate () 87 | (should (equal "annotate" 88 | (git-link--should-render-via-bitbucket-annotate "README.md"))) 89 | 90 | (should (equal "src" 91 | (git-link--should-render-via-bitbucket-annotate "a-cool-new-file.txt")))) 92 | -------------------------------------------------------------------------------- /git-link-transient.el: -------------------------------------------------------------------------------- 1 | ;;; git-link-transient.el --- Transient interface for git-link -*- lexical-binding: t; -*- 2 | 3 | ;; Copyright (C) 2013-2024 Skye Shaw and others 4 | 5 | ;; This program is free software; you can redistribute it and/or modify 6 | ;; it under the terms of the GNU General Public License as published by 7 | ;; the Free Software Foundation, either version 3 of the License, or 8 | ;; (at your option) any later version. 9 | 10 | ;; This program is distributed in the hope that it will be useful, 11 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | ;; GNU General Public License for more details. 14 | 15 | ;; You should have received a copy of the GNU General Public License 16 | ;; along with this program. If not, see . 17 | 18 | ;;; Commentary: 19 | 20 | ;; Transient interface (magit-like menu) for git-link. 21 | ;; Call `git-link-dispatch' to show the menu. 22 | ;; 23 | ;; You need to have `transient' installed as a dependency. 24 | ;; (it's not listed as the dependency of git-link because we want it to be optional.) 25 | 26 | ;;; Code: 27 | 28 | (require 'cl-lib) 29 | (require 'transient) 30 | (require 'git-link) 31 | 32 | (defun git-link-dispatch--action () 33 | "Finally call `git-link' with transient arguments." 34 | (let* ((args (transient-args 'git-link-dispatch)) 35 | (git-link-default-branch (transient-arg-value "branch=" args)) 36 | (git-link-default-remote (transient-arg-value "remote=" args)) 37 | (git-link-use-commit (transient-arg-value "use_commit" args)) 38 | (git-link-use-single-line-number (transient-arg-value "line_number" args))) 39 | (call-interactively #'git-link))) 40 | 41 | (defun git-link-dispatch--copy () 42 | "The copy command in transient suffix." 43 | (interactive) 44 | (let ((git-link-open-in-browser nil) 45 | (git-link-add-to-kill-ring t)) 46 | (git-link-dispatch--action))) 47 | 48 | (defun git-link-dispatch--open () 49 | "The open command in transient suffix." 50 | (interactive) 51 | (let ((git-link-open-in-browser t)) 52 | (git-link-dispatch--action))) 53 | 54 | (defclass git-link--transient-bare-option (transient-option) () 55 | "Similar to `transient-option', but format without argument string.") 56 | 57 | (cl-defmethod transient-format ((obj git-link--transient-bare-option)) 58 | (format " %s %s (%s)" 59 | (transient-format-key obj) 60 | (transient-format-description obj) 61 | (let ((v (oref obj value))) 62 | (if (> (length v) 0) 63 | (propertize v 'face 'transient-value) 64 | (propertize "default" 'face 'transient-inactive-value))))) 65 | 66 | (defclass git-link--transient-bare-switch (transient-switch) () 67 | "Similar to `transient-switch', but format without argument string, only yes/no.") 68 | 69 | (cl-defmethod transient-format ((obj git-link--transient-bare-switch)) 70 | (format " %s %s (%s)" 71 | (transient-format-key obj) 72 | (transient-format-description obj) 73 | (if (oref obj value) 74 | (propertize "on" 'face 'transient-value) 75 | (propertize "off" 'face 'transient-inactive-value)))) 76 | 77 | (transient-define-infix git-link-dispatch--branch () 78 | :class git-link--transient-bare-option 79 | :argument "branch=" 80 | :description "Branch" 81 | :prompt "Branch: " 82 | :key "b" 83 | :init-value (lambda (obj) (oset obj value git-link-default-branch)) 84 | :reader (lambda (prompt &rest _) 85 | (completing-read 86 | prompt 87 | (remove nil (list git-link-default-branch (git-link--branch)))))) 88 | 89 | (transient-define-infix git-link-dispatch--remote () 90 | :class git-link--transient-bare-option 91 | :argument "remote=" 92 | :description "Remote" 93 | :key "r" 94 | :init-value (lambda (obj) (oset obj value git-link-default-remote)) 95 | :reader (lambda (&rest _) (git-link--read-remote))) 96 | 97 | (transient-define-infix git-link-dispatch--use-commit () 98 | :class git-link--transient-bare-switch 99 | :argument "use_commit" 100 | ;; the value should be "use_commit" (the argument) or nil. not t 101 | :init-value (lambda (obj) (oset obj value (and git-link-use-commit "use_commit"))) 102 | :description "Use commit" 103 | :key "c") 104 | 105 | (transient-define-infix git-link-dispatch--line-number () 106 | :class git-link--transient-bare-switch 107 | :argument "line_number" 108 | :description "Line number" 109 | :init-value (lambda (obj) (oset obj value (and git-link-use-single-line-number "line_number"))) 110 | :if-not 'use-region-p 111 | :key "n") 112 | 113 | ;;;###autoload (autoload 'git-link-dispatch "git-link-transient" nil t) 114 | (transient-define-prefix git-link-dispatch () 115 | "Git link dispatch." 116 | [:description 117 | "Options" 118 | (git-link-dispatch--branch) 119 | (git-link-dispatch--remote) 120 | (git-link-dispatch--use-commit) 121 | (git-link-dispatch--line-number)] 122 | [:description 123 | "Git link" 124 | ("l" "Copy link" git-link-dispatch--copy) 125 | ("o" "Open in browser" git-link-dispatch--open)]) 126 | 127 | (provide 'git-link-transient) 128 | ;;; git-link-transient.el ends here 129 | -------------------------------------------------------------------------------- /git-link.el: -------------------------------------------------------------------------------- 1 | ;;; git-link.el --- Get the GitHub/Bitbucket/GitLab URL for a buffer location -*- lexical-binding: t -*- 2 | 3 | ;; Copyright (C) 2013-2022 Skye Shaw and others 4 | ;; Author: Skye Shaw 5 | ;; Version: 0.9.2 6 | ;; Keywords: git, vc, github, bitbucket, gitlab, sourcehut, aws, azure, convenience 7 | ;; URL: http://github.com/sshaw/git-link 8 | ;; Package-Requires: ((emacs "24.3")) 9 | 10 | ;; This file is NOT part of GNU Emacs. 11 | 12 | ;;; License: 13 | 14 | ;; This program is free software: you can redistribute it and/or modify 15 | ;; it under the terms of the GNU General Public License as published by 16 | ;; the Free Software Foundation, either version 3 of the License, or 17 | ;; (at your option) any later version. 18 | 19 | ;; This program is distributed in the hope that it will be useful, 20 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 21 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 22 | ;; GNU General Public License for more details. 23 | 24 | ;; You should have received a copy of the GNU General Public License 25 | ;; along with this program. If not, see . 26 | 27 | ;;; Commentary: 28 | 29 | ;; Create URLs for files and commits in GitHub/Bitbucket/GitLab/... 30 | ;; repositories. `git-link' returns the URL for the current buffer's file 31 | ;; location at the current line number or active region. `git-link-commit' 32 | ;; returns the URL for a commit. URLs are added to the kill ring. 33 | ;; 34 | ;; With a prefix argument prompt for the remote's name. Defaults to "origin". 35 | 36 | ;;; Change Log: 37 | 38 | ;; 2024-06-29 - v0.9.2 39 | ;; * Add git-link-add-to-kill-ring to not add to kill ring (thanks Michael Hauser-Raspe) 40 | ;; * Add prefix arg to open in browser when calling git-link-homepage (thanks Sibi Prabakaran) 41 | ;; 42 | ;; 2024-03-03 - v0.9.1 43 | ;; * Add support for remote host resolution via ssh config (thanks Sibi Prabakaran) 44 | ;; * Regexp escape parts when extracting host from scp-like URLs (thanks Sibi Prabakaran) 45 | ;; 46 | ;; 2023-02-15 - v0.9.0 47 | ;; * Add support for GoogleSource (thanks Peter Becich) 48 | ;; * Add plain=1 to force showing a non rendered GitHub links (thanks Erick Navarro) 49 | ;; * Add prefix arg to override git-link-use-commit when calling git-link (thanks Nacho Barrientos) 50 | ;; * Fix git-link-homepage for Bitbucket (Issue #97 thanks Sibi Prabakaran) 51 | ;; * Fix the Codeberg links to line ranges (Issue #109 thanks Wojciech Siewierski) 52 | ;; 53 | ;; 2022-02-17 - v0.8.6 54 | ;; * Fix URL escaping of pathnames on Emacs < 27 (Issue #93 thanks David Ongaro) 55 | ;; 56 | ;; 2022-02-06 - v0.8.5 57 | ;; * URL escape pathnames (thanks David Ongaro) 58 | ;; * Mark misspelled Savannah functions as obsolete (thanks Hendursaga) 59 | ;; * Add support for AWS CodeCommit (thanks Ram Krishnan) 60 | ;; * Add support for cgit (thanks Hendursaga) 61 | ;; 62 | ;; 2020-01-20 - v0.8.4 63 | ;; * Add support for Codeberg (thanks Jeremy Friesen) 64 | ;; * Add git-link-homepage-remote-alist (thanks Wim Van Deun) 65 | ;; 66 | ;; 2020-01-20 - v0.8.3 67 | ;; * Add support for Savannah 68 | ;; 69 | ;; 2020-12-14 - v0.8.2 70 | ;; * Fix sourcehut URL, don't link to raw version (Issue #77) 71 | ;; * Fix sourcehut multi-line URLs 72 | ;; 73 | ;; 2020-11-23 - v0.8.1 74 | ;; * Fix URL casing (Issue #57) 75 | ;; * Fix byte-compile warnings (Issue #75 thanks Brian Leung) 76 | ;; 77 | ;; 2020-07-21 - v0.8.0 78 | ;; * Add `-' prefix argument to git-link to generate links without line numbers 79 | ;; * Add git-link-use-single-line-number 80 | ;; * Fix sourcehut's git-link handler 81 | ;; 82 | ;; 2020-03-31 - v0.7.6 83 | ;; * Adapt to changes in Azure interface (Issue #65, thanks Roey Darwish Dror) 84 | ;; 85 | ;; 2019-08-28 - v0.7.5 86 | ;; * Add support for Azure DevOps (Issue #62, thanks Roey Darwish Dror) 87 | ;; 88 | ;; 2019-08-16 - v0.7.4 89 | ;; * Add support for Magit-Blob buffers (Issue #61, thanks Miciah Dashiel Butler Masters) 90 | ;; 91 | ;; 2019-03-09 - v0.7.3 92 | ;; * Add support for sourcehut 93 | ;; 94 | ;; 2018-10-30 - v0.7.2 95 | ;; * Fix suffix stripping on remote path only if it ends in .git (Issue #58, thanks Marko Crnic) 96 | ;; 97 | ;; 2018-07-08 - v0.7.1 98 | ;; * Add support for vc-revision-other-window files (Issue #54) 99 | ;; 100 | ;; 2018-06-07 - v0.7.0 101 | ;; * Add support for Tramp (Issue #49, thanks Jürgen Hötzel) 102 | ;; * Fix various compiler warnings 103 | ;; * Fix differences between url-path-and-query across Emacs versions 104 | ;; * Require Emacs 24.3 105 | ;; 106 | ;; 2018-04-23 - v0.6.0 107 | ;; * Fix parsing of remotes with auth info (Issue #51) 108 | ;; * Removed remote regex in favor of url-parse 109 | ;; 110 | ;; 2017-06-03 - v0.5.1 111 | ;; * Add support for more magit modes 112 | ;; 113 | ;; 2017-06-01 - v0.5.0 114 | ;; * Add support for linking in dired and magit modes 115 | ;; * Add support for defcustom 116 | ;; * Change git-link-remote-regex to support more remote URL formats (Thanks Kaushal Modi) 117 | ;; * Change git-link-remote-alist to use regex matching (Thanks Kaushal Modi) 118 | ;; * Fix point on commit hash regex and support uppercase SHAs (Thanks Kaushal Modi!) 119 | ;; * Fix git-link-commit message so that SHA text is displayed without properties 120 | ;; * Enabled lexical-binding (Thanks Kaushal Modi!!) 121 | ;; 122 | ;; -- Note that v0.5.0 was released as "v0.5.0 (unreleased)" 123 | ;; 124 | ;; 2016-10-19 - v0.4.5 125 | ;; * Fix for branches containing reserved URLs characters (Issue #36) 126 | ;; 127 | ;; 2016-09-11 - v0.4.4 128 | ;; * Added support for git-link-homepage 129 | ;; 130 | ;; 2016-08-13 - v0.4.3 131 | ;; * Added support for git-timemachine (Issue #22, thanks Diego Berrocal) 132 | ;; 133 | ;; 2016-08-09 - v0.4.2 134 | ;; * Fix for URLs with ports (Issue #32) 135 | ;; 136 | ;; 2016-04-01 - v0.4.1 137 | ;; * Better handling for branches that have no explicit remote 138 | ;; * Better error messages 139 | ;; 140 | ;; 2016-02-16 - v0.4.0 141 | ;; * Try branch's tracking remote when other branch settings are not specified 142 | ;; * git-link-default-remote now defaults to nil 143 | ;; 144 | ;; 2015-09-21 - v0.3.0 145 | ;; * Support for setting branch and remote names via `git config` 146 | ;; * Added git-link-default-branch 147 | ;; * Removed some functions, use emacs "private" convention for others 148 | ;; 149 | ;; 2015-09-12 - v0.2.2 150 | ;; * Support for BitBucket's multiline format 151 | ;; 152 | ;; 2015-07-25 - v0.2.1 153 | ;; * Fix for BitBucket's new URL format (Thanks Ev Dolzhenko) 154 | ;; * Fix for GitLab's multiline format (Thanks Enrico Carlesso) 155 | ;; 156 | ;; 2015-06-05 - v0.2.0 157 | ;; * Deactivate mark after killing the link (Thanks Kaushal Modi) 158 | ;; * Support for GitLab (Thanks Swaroop C H) 159 | ;; * Use completing-read when prompting for remotes (Thanks Andrew Gwozdziewycz) 160 | ;; * Display URL in minibuffer when adding to kill ring (Thanks Andrew Gwozdziewycz) 161 | ;; * Added git-link-use-commit variable (Thanks Kaushal Modi) 162 | ;; * Fix for displaying link in minibuffer when interprogram-cut-function is set (Thanks Ric Lister) 163 | ;; * Fix to ignore point at beginning of line in regions (Thanks Kaushal Modi) 164 | ;; * Fix for narrow-to-region (Bug #10, thanks Andrew Gwozdziewycz) 165 | ;; * Fix to use remote hostname when constructing link URLs (Thanks David Hull) 166 | ;; 167 | ;; 2015-02-05 - v0.1.0 168 | ;; * Added git-link-commit (Thanks Ryan Barrett) 169 | ;; * Added git-link-open-in-browser variable (Thanks Ryan Barrett) 170 | ;; * Use call-process instead of shell-command-to-string 171 | ;; * Use --short option when calling symbolic-ref (Thanks Steven Huwig) 172 | ;; 173 | ;; 2014-02-27 - v0.0.2 174 | ;; * Fix for buffers visiting files through symlinks (Issue #1, thanks Evgeniy Dolzhenko) 175 | 176 | ;;; Code: 177 | 178 | (require 'cl-lib) 179 | (require 'dired) 180 | (require 'thingatpt) 181 | (require 'url-util) 182 | (require 'url-parse) 183 | 184 | (defgroup git-link nil 185 | "Get the GitHub/Bitbucket/GitLab URL for a buffer location" 186 | :prefix "git-link-" 187 | :link '(url-link :tag "Report a Bug" "https://github.com/sshaw/git-link/issues") 188 | :link '(url-link :tag "Homepage" "https://github.com/sshaw/git-link") 189 | :group 'convenience) 190 | 191 | (eval-when-compile 192 | (defvar git-timemachine-revision)) ;; silence reference to free variable warning 193 | 194 | (defcustom git-link-default-remote nil 195 | "Name of the remote to link to." 196 | :type 'string 197 | :group 'git-link) 198 | 199 | (defcustom git-link-default-branch nil 200 | "Name of the branch to link to." 201 | :type 'string 202 | :group 'git-link) 203 | 204 | (defcustom git-link-open-in-browser nil 205 | "If t also open the link via `browse-url'. To use an alternate 206 | function set to that function's symbol." 207 | :type '(choice boolean function) 208 | :group 'git-link) 209 | 210 | (defcustom git-link-add-to-kill-ring t 211 | "if t also add the link to the kill-ring" 212 | :type 'boolean 213 | :group 'git-link) 214 | 215 | (defcustom git-link-use-commit nil 216 | "If non-nil use the latest commit's hash in the link instead of the branch name." 217 | :type 'boolean 218 | :group 'git-link) 219 | 220 | (defcustom git-link-use-single-line-number t 221 | "If t a link to a single line will always contain the line number. 222 | If nil line numbers will only be added when a selection contains 223 | more than 1 line. 224 | 225 | Note that `git-link' can exclude line numbers on a per invocation basis. 226 | See its docs." 227 | :type 'boolean 228 | :group 'git-link) 229 | 230 | (defcustom git-link-consider-ssh-config nil 231 | "Consider ssh configuration file for resolving the remote's hostname." 232 | :type 'boolean 233 | :group 'git-link) 234 | 235 | (defcustom git-link-remote-alist 236 | '(("git.sr.ht" git-link-sourcehut) 237 | ("codeberg.org" git-link-codeberg) 238 | ("github" git-link-github) 239 | ("bitbucket" git-link-bitbucket) 240 | ("gitorious" git-link-gitorious) 241 | ("gitlab" git-link-gitlab) 242 | ("git\\.\\(sv\\|savannah\\)\\.gnu\\.org" git-link-savannah) 243 | ("googlesource.com" git-link-googlesource) 244 | ("visualstudio\\|azure" git-link-azure) 245 | ("sourcegraph" git-link-sourcegraph) 246 | ("\\(amazonaws\\|amazon\\)\\.com" git-link-codecommit)) 247 | "Alist of host names and functions creating file links for those. 248 | Each element looks like (REGEXP FUNCTION) where REGEXP is used to 249 | match the remote's host name and FUNCTION is used to generate a link 250 | to the file on remote host. 251 | 252 | As an example, \"gitlab\" will match with both \"gitlab.com\" and 253 | \"gitlab.example.com\"." 254 | :type '(alist :key-type string :value-type (group function)) 255 | :group 'git-link) 256 | 257 | (defcustom git-link-commit-remote-alist 258 | '(("git.sr.ht" git-link-commit-github) 259 | ("codeberg.org" git-link-commit-codeberg) 260 | ("github" git-link-commit-github) 261 | ("bitbucket" git-link-commit-bitbucket) 262 | ("gitorious" git-link-commit-gitorious) 263 | ("gitlab" git-link-commit-gitlab) 264 | ("git\\.\\(sv\\|savannah\\)\\.gnu\\.org" git-link-commit-savannah) 265 | ("googlesource.com" git-link-commit-googlesource) 266 | ("visualstudio\\|azure" git-link-commit-azure) 267 | ("sourcegraph" git-link-commit-sourcegraph) 268 | ("\\(amazonaws\\|amazon\\)\\.com" git-link-commit-codecommit)) 269 | "Alist of host names and functions creating commit links for those. 270 | Each element looks like (REGEXP FUNCTION) where REGEXP is used to 271 | match the remote's host name and FUNCTION is used to generate a link 272 | to the commit on remote host. 273 | 274 | As an example, \"gitlab\" will match with both \"gitlab.com\" and 275 | \"gitlab.example.com\"." 276 | :type '(alist :key-type string :value-type (group function)) 277 | :group 'git-link) 278 | 279 | (defcustom git-link-homepage-remote-alist 280 | '(("git.sr.ht" git-link-homepage-github) 281 | ("github" git-link-homepage-github) 282 | ("bitbucket" git-link-homepage-github) 283 | ("gitorious" git-link-homepage-github) 284 | ("gitlab" git-link-homepage-github) 285 | ("git\\.\\(sv\\|savannah\\)\\.gnu\\.org" git-link-homepage-savannah) 286 | ("googlesource.com" git-link-homepage-github) 287 | ("visualstudio\\|azure" git-link-homepage-github) 288 | ("sourcegraph" git-link-homepage-github) 289 | ("\\(amazonaws\\|amazon\\)\\.com" git-link-homepage-codecommit)) 290 | "Alist of host names and functions creating homepage links for those. 291 | Each element looks like (REGEXP FUNCTION) where REGEXP is used to 292 | match the remote's host name and FUNCTION is used to generate a link 293 | to the commit on remote host. 294 | 295 | As an example, \"gitlab\" will match with both \"gitlab.com\" and 296 | \"gitlab.example.com\"." 297 | :type '(alist :key-type string :value-type (group function)) 298 | :group 'git-link) 299 | 300 | (defcustom git-link-extensions-rendered-plain '("org" "md" "rst" "adoc" "markdown" "asciidoc") 301 | "List of extensions that should be rendered in plain mode, systems like 302 | Github, Gitlab, etc show a rendered version by default, for these extensions 303 | we can prevent that behaviour." 304 | :type 'list 305 | :group 'git-link) 306 | 307 | ;; https://support.atlassian.com/bitbucket-cloud/docs/readme-content/#Extensions-and-Languages 308 | (defcustom git-link-extensions-rendered-via-bitbucket-annotate '("org" "md" "mkd" "mkdn" "mdown" 309 | "markdown" "text" "rst" "textile" 310 | "asciidoc") 311 | "List of extensions that should be rendered via annotate else 312 | they will actually be rendered. We can prevent that behaviour." 313 | :type 'list 314 | :group 'git-link) 315 | 316 | (defcustom git-link-web-host-alist nil 317 | "Mapping from Git host names to web host names. 318 | 319 | Elements have the form (GIT-HOST-REGEXP . WEB-HOST), where 320 | GIT-HOST-REGEXP is a regexp matching the host name used by Git 321 | and WEB-HOST is the name of the host serving the corresponding 322 | web interface. 323 | 324 | This can be used when custom deployments serve SSH access and the 325 | web interface under different host names. For example, if Git 326 | uses \"ssh.gitlab.company.com\" but the web interface is at 327 | \"gitlab.company.com\", add 328 | `(\"ssh\\\\.gitlab\\\\.company\\\\.com\" . \"gitlab.company.com\")'." 329 | :type '(alist :key-type string :value-type string) 330 | :group 'git-link) 331 | 332 | (defun git-link--exec(&rest args) 333 | (ignore-errors 334 | (with-temp-buffer 335 | (when (zerop (apply #'process-file "git" nil (current-buffer) nil args)) 336 | (goto-char (point-min)) 337 | (cl-loop until (eobp) 338 | collect (buffer-substring-no-properties 339 | (line-beginning-position) 340 | (line-end-position)) 341 | do (forward-line 1)))))) 342 | 343 | (defun git-link--get-config (name) 344 | (car (git-link--exec "config" "--get" name))) 345 | 346 | (defun git-link--remotes () 347 | (git-link--exec "remote")) 348 | 349 | (defun git-link--last-commit () 350 | (car (git-link--exec "--no-pager" "log" "-n1" "--pretty=format:%H"))) 351 | 352 | (defvar magit-buffer-revision) 353 | 354 | (defun git-link--commit () 355 | (cond 356 | ((git-link--using-git-timemachine) 357 | (car git-timemachine-revision)) 358 | ((git-link--using-magit-blob-mode) 359 | magit-buffer-revision) 360 | (t (git-link--last-commit)))) 361 | 362 | (defun git-link--current-branch () 363 | (car (git-link--exec "symbolic-ref" "--short" "HEAD"))) 364 | 365 | (defun git-link--repo-root () 366 | (let ((dir (car (git-link--exec "rev-parse" "--show-toplevel")))) 367 | (if (file-remote-p default-directory) 368 | (concat (file-remote-p default-directory) dir) 369 | dir))) 370 | 371 | (defun git-link--remote-url (name) 372 | (car (git-link--exec "remote" "get-url" name))) 373 | 374 | (defun git-link--branch-remote (branch) 375 | (git-link--get-config (format "branch.%s.remote" branch))) 376 | 377 | (declare-function magit-rev-branch "ext:magit-git") 378 | 379 | (defun git-link--branch () 380 | (or (git-link--get-config "git-link.branch") 381 | git-link-default-branch 382 | (when (git-link--using-magit-blob-mode) 383 | (magit-rev-branch magit-buffer-revision)) 384 | (git-link--current-branch))) 385 | 386 | (defun git-link--remote () 387 | (let* ((branch (git-link--current-branch)) 388 | (remote (or (git-link--get-config "git-link.remote") 389 | git-link-default-remote 390 | (git-link--branch-remote branch)))) 391 | 392 | ;; Git defaults to "." if the branch has no remote. 393 | ;; If the branch has no remote we try master's, which may be set. 394 | (if (or (null remote) 395 | (and (string= remote ".") 396 | (not (string= branch "master")))) 397 | (setq remote (git-link--branch-remote "master"))) 398 | 399 | (if (or (null remote) (string= remote ".")) 400 | "origin" 401 | remote))) 402 | 403 | (defun git-link--handler (alist str) 404 | "For an ALIST whose `car' (a regexp) matches STR, return cadr. 405 | 406 | The ALIST consists of (REGEXP FN) list elements. 407 | Valid ALISTs are `git-link-remote-alist',`git-link-commit-remote-alist'. 408 | 409 | For the first ALIST element whose REGEXP matches with STR, FN is 410 | returned. 411 | 412 | Return nil, 413 | - if STR does not match with REGEXP in any of the elements of ALIST, or 414 | - if STR is not a string" 415 | (when (stringp str) 416 | (cadr (cl-find-if (lambda (lst) 417 | (string-match-p (car lst) str)) 418 | alist)))) 419 | 420 | (defun git-link--parse-vc-revision (filename) 421 | "If FILENAME appears to be from `vc-revision-other-window' 422 | return (FILENAME . REVISION) otherwise nil." 423 | (when (and (string-match "\\(.+\\)\\.~\\([^~]+\\)~$" filename) 424 | (file-exists-p (match-string 1 filename))) 425 | (cons (match-string 1 filename) 426 | (match-string 2 filename)))) 427 | 428 | (defvar magit-buffer-file-name) 429 | 430 | (defun git-link--relative-filename () 431 | (let* ((filename (buffer-file-name (buffer-base-buffer))) 432 | (dir (git-link--repo-root))) 433 | 434 | (when (null filename) 435 | (cond 436 | ((eq major-mode 'dired-mode) 437 | (setq filename (dired-file-name-at-point))) 438 | ((git-link--using-magit-blob-mode) 439 | (setq filename magit-buffer-file-name)) 440 | ((and (string-match-p "^magit-" (symbol-name major-mode)) 441 | (fboundp 'magit-file-at-point)) 442 | (setq filename (magit-file-at-point))))) 443 | 444 | (if (and dir filename 445 | ;; Make sure filename is not above dir, e.g. "/foo/repo-root/.." 446 | (< (length dir) (length (file-truename filename)))) 447 | (substring (file-truename filename) 448 | (1+ (length dir)))))) 449 | 450 | (defun git-link--parse-remote (url) 451 | "Parse URL and return a list as (HOST DIR). DIR has no leading slash or `git' extension." 452 | (let (host path parsed) 453 | (unless (string-match "^[a-zA-Z0-9]+://" url) 454 | (setq url (concat "ssh://" url))) 455 | 456 | (setq parsed (url-generic-parse-url url) 457 | ;; Normalize path. 458 | ;; If none, will be nil on Emacs < 25. Later versions return "". 459 | path (or (car (url-path-and-query parsed)) "") 460 | host (url-host parsed)) 461 | 462 | (when host 463 | (when (and (not (string= "/" path)) 464 | (not (string= "" path))) 465 | (setq path (substring 466 | (if (string-match "\\.git\\'" path) 467 | (file-name-sans-extension path) 468 | path) 469 | 1))) 470 | 471 | ;; Fix-up scp style URLs. 472 | ;; git@foo:UsEr/repo gives a host of foo:user 473 | ;; We also need to preserve case so we take UsEr from the original url 474 | (when (string-match ":" host) 475 | (let ((parts (split-string host ":" t)) 476 | (case-fold-search t)) 477 | (string-match (concat (regexp-quote (car parts)) ":\\(" (cadr parts) "\\)/") url) 478 | (setq host (car parts) 479 | path (concat (match-string 1 url) "/" path)))) 480 | 481 | 482 | (when git-link-consider-ssh-config 483 | (let* ((ssh-resolved-host (git-link--ssh-resolve-hostname host))) 484 | (when ssh-resolved-host 485 | (setq host ssh-resolved-host)))) 486 | 487 | ;; Fix-up Azure SSH URLs 488 | (when (string= "ssh.dev.azure.com" host) 489 | (setq host "dev.azure.com") 490 | (setq path (replace-regexp-in-string 491 | "v3/\\([^/]+\\)/\\([^/]+\\)/\\([^/]+\\)" 492 | "\\1/\\2/_git/\\3" 493 | path))) 494 | (when (string= "vs-ssh.visualstudio.com" host) 495 | (setq host (concat (url-user parsed) ".visualstudio.com")) 496 | (setq path (replace-regexp-in-string 497 | (concat "^v3/" (url-user parsed) "/\\([^/]+\\)/") 498 | "\\1/_git/" 499 | path))) 500 | 501 | ;; For Savannah 502 | (when (string= "git.savannah.gnu.org" host) 503 | (cond 504 | ((string-match "\\`git/" path) 505 | (setq path (substring path 4))) 506 | ((string-match "\\`srv/git/" path) 507 | (setq path (substring path 8))))) 508 | 509 | ;; For AWS CodeCommit 510 | (when (string-match "git-codecommit\\.\\(.*\\)\\.amazonaws.com" host) 511 | (let* ((matchp (string-match "\\([^\\.]*\\)\\.\\([^\\.]*\\)" host)) 512 | (region (when matchp 513 | (match-string 2 host))) 514 | (domainname ".console.aws.amazon.com")) 515 | (when region 516 | (setq host (concat region domainname)))) 517 | (when (string-match "v1/repos/" path) 518 | (setq path (concat "codesuite/codecommit/repositories/" 519 | (substring path 9))))) 520 | 521 | (list host path)))) 522 | 523 | (defun git-link--ssh-resolve-hostname (hostname) 524 | "Resolve HOSTNAME using ssh client." 525 | (let ((output (shell-command-to-string (format "ssh -G %s" hostname))) 526 | (host nil)) 527 | (dolist (line (split-string output "\n")) 528 | (when (string-match "^hostname \\(.*\\)" line) 529 | (setq host (match-string 1 line)))) 530 | host)) 531 | 532 | (defun git-link--using-git-timemachine () 533 | (and (boundp 'git-timemachine-revision) 534 | git-timemachine-revision)) 535 | 536 | (defun git-link--using-magit-blob-mode () 537 | (bound-and-true-p magit-blob-mode)) 538 | 539 | (defun git-link--read-remote () 540 | (let ((remotes (git-link--remotes)) 541 | (current (git-link--remote))) 542 | (completing-read "Remote: " 543 | remotes 544 | nil 545 | t 546 | "" 547 | nil 548 | (if (member current remotes) 549 | current 550 | (car remotes))))) 551 | 552 | (defun git-link--get-region () 553 | (save-restriction 554 | (widen) 555 | (save-excursion 556 | (let* ((use-region (use-region-p)) 557 | (start (when use-region (region-beginning))) 558 | (end (when use-region (region-end))) 559 | (line-start (line-number-at-pos start)) 560 | line-end) 561 | (when use-region 562 | ;; Avoid adding an extra blank line to the selection. 563 | ;; This happens when point or mark is at the start of the next line. 564 | ;; 565 | ;; When selection is from bottom to top, exchange point and mark 566 | ;; so that the `point' and `(region-end)' are the same. 567 | (when (< (point) (mark)) 568 | (exchange-point-and-mark)) 569 | (when (= end (line-beginning-position)) 570 | ;; Go up and avoid the blank line 571 | (setq end (1- end))) 572 | (setq line-end (line-number-at-pos end)) 573 | (when (<= line-end line-start) 574 | (setq line-end nil))) 575 | (list line-start line-end))))) 576 | 577 | (defun git-link--new (link) 578 | (if git-link-add-to-kill-ring 579 | (kill-new link)) 580 | 581 | ;; prevent URL escapes from being interpreted as format strings 582 | (message (replace-regexp-in-string "%" "%%" link t t)) 583 | (setq deactivate-mark t) 584 | (when git-link-open-in-browser 585 | (if (fboundp git-link-open-in-browser) 586 | (funcall git-link-open-in-browser link) 587 | (browse-url link))) 588 | link 589 | ) 590 | 591 | (defun git-link-codeberg (hostname dirname filename branch commit start end) 592 | (format "https://%s/%s/src/%s/%s" 593 | hostname 594 | dirname 595 | (or branch commit) 596 | (concat filename 597 | (when start 598 | (concat "#" 599 | (if end 600 | (format "L%s-L%s" start end) 601 | (format "L%s" start))))))) 602 | 603 | (defun git-link-gitlab (hostname dirname filename branch commit start end) 604 | (format "https://%s/%s/-/blob/%s/%s" 605 | hostname 606 | dirname 607 | (or branch commit) 608 | (concat filename 609 | (when start 610 | (concat "#" 611 | (if end 612 | (format "L%s-%s" start end) 613 | (format "L%s" start))))))) 614 | 615 | (defun git-link-github (hostname dirname filename branch commit start end) 616 | (format "https://%s/%s/blob/%s/%s" 617 | hostname 618 | dirname 619 | (or branch commit) 620 | (concat filename 621 | (when start 622 | (concat (if (git-link--should-render-plain filename) "?plain=1#" "#") 623 | (if end 624 | (format "L%s-L%s" start end) 625 | (format "L%s" start))))))) 626 | 627 | (defun git-link-googlesource (hostname dirname filename branch commit start _end) 628 | (format "https://%s/%s/+/%s/%s" 629 | hostname 630 | dirname 631 | (or branch commit) 632 | (concat filename 633 | (when start 634 | (format "#%s" start) 635 | )))) 636 | 637 | (defun git-link-azure (hostname dirname filename branch commit start end) 638 | (format "https://%s/%s?path=%%2F%s&version=%s&line=%s&lineEnd=%s&lineStartColumn=1&lineEndColumn=9999&lineStyle=plain" 639 | hostname 640 | dirname 641 | filename 642 | (concat "G" (if branch "B" "C") (or branch commit)) 643 | (or start "") 644 | (or end start ""))) 645 | 646 | (defun git-link-sourcehut (hostname dirname filename branch commit start end) 647 | (format "https://%s/%s/tree/%s/%s" 648 | hostname 649 | dirname 650 | (or branch commit) 651 | (concat filename 652 | (when start 653 | (concat "#" 654 | (if end 655 | (format "L%s-%s" start end) 656 | (format "L%s" start))))))) 657 | 658 | (defun git-link-commit-gitlab (hostname dirname commit) 659 | (format "https://%s/%s/-/commit/%s" 660 | hostname 661 | dirname 662 | commit)) 663 | 664 | (defun git-link-commit-github (hostname dirname commit) 665 | (format "https://%s/%s/commit/%s" 666 | hostname 667 | dirname 668 | commit)) 669 | 670 | (defun git-link-commit-googlesource (hostname dirname commit) 671 | (format "https://%s/%s/+/%s" 672 | hostname 673 | dirname 674 | commit)) 675 | 676 | (defun git-link-commit-azure (hostname dirname commit) 677 | (format "https://%s/%s/commit/%s" 678 | hostname 679 | dirname 680 | 681 | ;; Azure only supports full 32 characters SHA 682 | (car (git-link--exec "rev-parse" commit)))) 683 | 684 | (defun git-link-commit-codeberg (hostname dirname commit) 685 | (format "https://%s/%s/commit/%s" 686 | hostname 687 | dirname 688 | commit)) 689 | 690 | (defun git-link-gitorious (hostname dirname filename _branch commit start _end) 691 | (format "https://%s/%s/source/%s:%s#L%s" 692 | hostname 693 | dirname 694 | commit 695 | filename 696 | start)) 697 | 698 | (defun git-link-commit-gitorious (hostname dirname commit) 699 | (format "https://%s/%s/commit/%s" 700 | hostname 701 | dirname 702 | commit)) 703 | 704 | (defun git-link-bitbucket (hostname dirname filename _branch commit start end) 705 | ;; ?at=branch-name 706 | (format "https://%s/%s/%s/%s/%s" 707 | hostname 708 | dirname 709 | (git-link--should-render-via-bitbucket-annotate filename) 710 | commit 711 | (if (string= "" (file-name-nondirectory filename)) 712 | filename 713 | (concat filename 714 | "#" 715 | (file-name-nondirectory filename) 716 | (when start 717 | (if end 718 | (format "-%s:%s" start end) 719 | (format "-%s" start))))))) 720 | 721 | (defun git-link-commit-bitbucket (hostname dirname commit) 722 | ;; ?at=branch-name 723 | (format "https://%s/%s/commits/%s" 724 | hostname 725 | dirname 726 | commit)) 727 | 728 | (defun git-link-cgit (hostname dirname filename branch commit start _end) 729 | (format "https://%s/%s/tree/%s?h=%s" 730 | hostname 731 | dirname 732 | filename 733 | (concat 734 | (or branch commit) 735 | (when start 736 | (concat "#" (format "n%s" start)))))) 737 | 738 | (defun git-link-commit-cgit (hostname dirname commit) 739 | (format "https://%s/%s/commit/?id=%s" 740 | hostname 741 | dirname 742 | commit)) 743 | 744 | (defun git-link-savannah (hostname dirname filename branch commit start end) 745 | (git-link-cgit hostname 746 | (format "cgit/%s.git" dirname) ; unique to Savannah 747 | filename 748 | branch 749 | commit 750 | start 751 | end)) 752 | 753 | (defun git-link-commit-savannah (hostname dirname commit) 754 | (git-link-commit-cgit hostname 755 | (format "cgit/%s.git" dirname) ; also unique to Savannah 756 | commit)) 757 | 758 | (defun git-link-sourcegraph (hostname dirname filename branch commit start end) 759 | (let ((line-or-range (cond ((and start end) (format "#L%s-%s" start end)) 760 | (start (format "#L%s" start)) 761 | (t ""))) 762 | (branch-or-commit (or branch commit)) 763 | (dir-file-name (directory-file-name dirname))) 764 | (format "https://%s/%s@%s/-/blob/%s%s" 765 | hostname 766 | dir-file-name 767 | branch-or-commit 768 | filename 769 | line-or-range))) 770 | 771 | (defun git-link-commit-sourcegraph (hostname dirname commit) 772 | (let ((dir-file-name (directory-file-name dirname))) 773 | (format "https://%s/%s/-/commit/%s" 774 | hostname 775 | dir-file-name 776 | commit))) 777 | 778 | (defun git-link-homepage-github (hostname dirname) 779 | (format "https://%s/%s" 780 | hostname 781 | dirname)) 782 | 783 | (defun git-link-homepage-savannah (hostname dirname) 784 | (format "https://%s/cgit/%s.git/" 785 | hostname 786 | dirname)) 787 | 788 | (defun git-link-codecommit (hostname 789 | dirname 790 | filename 791 | branch 792 | commit 793 | start 794 | end) 795 | (format "https://%s/%s/browse/refs/heads/%s/--/%s" 796 | hostname 797 | dirname 798 | (or branch commit) 799 | (concat filename 800 | (when start 801 | (format "?lines=%s-%s" 802 | start 803 | (or end start)))))) 804 | 805 | (defun git-link-commit-codecommit (hostname dirname commit) 806 | (format "https://%s/%s/commit/%s" hostname dirname commit)) 807 | 808 | (defun git-link-homepage-codecommit (hostname dirname) 809 | (format "https://%s/%s/browse" hostname dirname)) 810 | 811 | (define-obsolete-function-alias 812 | 'git-link-homepage-svannah 'git-link-homepage-savannah "cf947f9") 813 | 814 | (defalias 'git-link-gitea 'git-link-codeberg) 815 | (defalias 'git-link-commit-gitea 'git-link-commit-codeberg) 816 | 817 | (defun git-link--select-remote () 818 | (if (equal '(4) current-prefix-arg) 819 | (git-link--read-remote) 820 | (git-link--remote))) 821 | 822 | (defun git-link--should-render-plain (filename) 823 | "Check if the extension of the given filename belongs 824 | to the list of extensions which generated link should be 825 | shown as a plain file" 826 | (let ((extension (or (file-name-extension filename) ""))) 827 | (member (downcase extension) git-link-extensions-rendered-plain))) 828 | 829 | (defun git-link--should-render-via-bitbucket-annotate (filename) 830 | "Check if the extension of the given filename belongs 831 | to the list of extensions which generated link should be 832 | shown via annotate in bitbucket." 833 | (let ((extension (or (file-name-extension filename) ""))) 834 | (if (member (downcase extension) git-link-extensions-rendered-via-bitbucket-annotate) 835 | "annotate" 836 | "src"))) 837 | 838 | ;;;###autoload 839 | (defun git-link (remote start end) 840 | "Create a URL representing the current buffer's location in its 841 | GitHub/Bitbucket/GitLab/... repository at the current line number 842 | or active region. The URL will be added to the kill ring. If 843 | `git-link-open-in-browser' is non-nil also call `browse-url'. 844 | 845 | With a prefix argument of - generate a link without line number(s). 846 | Also see `git-link-use-single-line-number'. 847 | 848 | With a single prefix argument prompt for the remote's name. 849 | Defaults to \"origin\". 850 | 851 | With a double prefix argument invert the value of 852 | `git-link-use-commit'." 853 | (interactive 854 | (if (equal '- current-prefix-arg) 855 | (list (git-link--remote) nil nil) 856 | (let* ((remote (git-link--select-remote)) 857 | (region (when (or buffer-file-name (git-link--using-magit-blob-mode)) 858 | (git-link--get-region)))) 859 | 860 | (if (and (null git-link-use-single-line-number) (null (cadr region))) 861 | (list remote nil nil) 862 | (list remote (car region) (cadr region)))))) 863 | 864 | (let ((remote-url (git-link--remote-url remote)) 865 | filename branch commit handler remote-info git-host web-host) 866 | (if (null remote-url) 867 | (message "Remote `%s' not found" remote) 868 | 869 | (setq remote-info (git-link--parse-remote remote-url) 870 | git-host (car remote-info) 871 | filename (git-link--relative-filename) 872 | branch (git-link--branch) 873 | commit (git-link--commit) 874 | handler (git-link--handler git-link-remote-alist git-host) 875 | web-host (or (assoc-default git-host git-link-web-host-alist #'string-match-p) 876 | git-host)) 877 | 878 | (cond ((null filename) 879 | (message "Can't figure out what to link to")) 880 | ((null git-host) 881 | (message "Remote `%s' contains an unsupported URL" remote)) 882 | ((not (functionp handler)) 883 | (message "No handler found for %s" git-host)) 884 | ;; TODO: null ret val 885 | (t 886 | (let ((vc-revison (git-link--parse-vc-revision filename))) 887 | (when vc-revison 888 | (setq filename (car vc-revison) 889 | commit (cdr vc-revison))) 890 | 891 | (git-link--new 892 | (funcall handler 893 | web-host 894 | (cadr remote-info) 895 | (url-hexify-string filename (url--allowed-chars (cons ?/ url-unreserved-chars))) 896 | (if (or (git-link--using-git-timemachine) 897 | (git-link--using-magit-blob-mode) 898 | vc-revison 899 | (if (equal '(16) current-prefix-arg) 900 | (not git-link-use-commit) 901 | git-link-use-commit)) 902 | nil 903 | (if branch 904 | (url-hexify-string branch) 905 | nil)) 906 | commit 907 | start 908 | end)))))))) 909 | 910 | ;;;###autoload 911 | (defun git-link-commit (remote) 912 | "Create a URL representing the commit for the hash under point 913 | in the current buffer's GitHub/Bitbucket/GitLab/... 914 | repository. The URL will be added to the kill ring. 915 | 916 | With a prefix argument prompt for the remote's name. 917 | Defaults to \"origin\"." 918 | 919 | (interactive (list (git-link--select-remote))) 920 | (let* (commit handler remote-info (remote-url (git-link--remote-url remote))) 921 | (if (null remote-url) 922 | (message "Remote `%s' not found" remote) 923 | 924 | (setq remote-info (git-link--parse-remote remote-url) 925 | commit (word-at-point) 926 | handler (git-link--handler git-link-commit-remote-alist (car remote-info))) 927 | 928 | (cond ((null (car remote-info)) 929 | (message "Remote `%s' contains an unsupported URL" remote)) 930 | ((not (string-match-p "[a-fA-F0-9]\\{7,40\\}" (or commit ""))) 931 | (message "Point is not on a commit hash")) 932 | ((not (functionp handler)) 933 | (message "No handler for %s" (car remote-info))) 934 | ;; null ret val 935 | ((git-link--new 936 | (funcall handler 937 | (car remote-info) 938 | (cadr remote-info) 939 | (substring-no-properties commit)))))))) 940 | 941 | ;;;###autoload 942 | (defun git-link-homepage (remote) 943 | "Create a URL representing the homepage of the current 944 | buffer's GitHub/Bitbucket/GitLab/... repository. The URL will be 945 | added to the kill ring. If `git-link-open-in-browser' is non-nil 946 | or if you pass the double prefix (Ctrl-u Ctrl-u), then also call 947 | `browse-url'. 948 | 949 | With a prefix argument prompt for the remote's name. 950 | Defaults to \"origin\"." 951 | 952 | (interactive (list (git-link--select-remote))) 953 | 954 | (let* (handler remote-info 955 | (remote-url (git-link--remote-url remote)) 956 | (git-link-open-in-browser (or git-link-open-in-browser (equal (list 16) current-prefix-arg)))) 957 | 958 | (if (null remote-url) 959 | (message "Remote `%s' not found" remote) 960 | 961 | (setq remote-info (git-link--parse-remote remote-url) 962 | handler (git-link--handler git-link-homepage-remote-alist (car remote-info))) 963 | 964 | (cond ((null (car remote-info)) 965 | (message "Remote `%s' contains an unsupported URL" remote)) 966 | ((not (functionp handler)) 967 | (message "No handler for %s" (car remote-info))) 968 | ;; null ret val 969 | ((git-link--new 970 | (funcall handler 971 | (car remote-info) 972 | (cadr remote-info)))))))) 973 | 974 | (provide 'git-link) 975 | ;;; git-link.el ends here 976 | --------------------------------------------------------------------------------