From: Andreas Gerler Date: Thu, 11 May 2023 15:45:29 +0000 (+0200) Subject: add git-link X-Git-Url: http://git.bundesbrandschatzamt.de/?a=commitdiff_plain;h=9b6a8119338072fdc19e1e56dc08f290e8c50e3d;p=emacsconfig.git add git-link Signed-off-by: Andreas Gerler --- diff --git a/elpa/git-link-20230420.48/git-link-autoloads.el b/elpa/git-link-20230420.48/git-link-autoloads.el new file mode 100644 index 00000000..a617dfc8 --- /dev/null +++ b/elpa/git-link-20230420.48/git-link-autoloads.el @@ -0,0 +1,59 @@ +;;; git-link-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*- +;; +;;; Code: + +(add-to-list 'load-path (directory-file-name + (or (file-name-directory #$) (car load-path)))) + + +;;;### (autoloads nil "git-link" "git-link.el" (0 0 0 0)) +;;; Generated autoloads from git-link.el + +(autoload 'git-link "git-link" "\ +Create a URL representing the current buffer's location in its +GitHub/Bitbucket/GitLab/... repository at the current line number +or active region. The URL will be added to the kill ring. If +`git-link-open-in-browser' is non-nil also call `browse-url'. + +With a prefix argument of - generate a link without line number(s). +Also see `git-link-use-single-line-number'. + +With a single prefix argument prompt for the remote's name. +Defaults to \"origin\". + +With a double prefix argument invert the value of +`git-link-use-commit'. + +\(fn REMOTE START END)" t nil) + +(autoload 'git-link-commit "git-link" "\ +Create a URL representing the commit for the hash under point +in the current buffer's GitHub/Bitbucket/GitLab/... +repository. The URL will be added to the kill ring. + +With a prefix argument prompt for the remote's name. +Defaults to \"origin\". + +\(fn REMOTE)" t nil) + +(autoload 'git-link-homepage "git-link" "\ +Create a URL representing the homepage of the current +buffer's GitHub/Bitbucket/GitLab/... repository. The +URL will be added to the kill ring. + +With a prefix argument prompt for the remote's name. +Defaults to \"origin\". + +\(fn REMOTE)" t nil) + +(register-definition-prefixes "git-link" '("git-link-")) + +;;;*** + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; coding: utf-8 +;; End: +;;; git-link-autoloads.el ends here diff --git a/elpa/git-link-20230420.48/git-link-pkg.el b/elpa/git-link-20230420.48/git-link-pkg.el new file mode 100644 index 00000000..48555697 --- /dev/null +++ b/elpa/git-link-20230420.48/git-link-pkg.el @@ -0,0 +1,2 @@ +;;; Generated package description from git-link.el -*- no-byte-compile: t -*- +(define-package "git-link" "20230420.48" "Get the GitHub/Bitbucket/GitLab URL for a buffer location" '((emacs "24.3")) :commit "1727e9b7ec41a234a2cc14151b9ffd9c1c4f4b14" :authors '(("Skye Shaw" . "skye.shaw@gmail.com")) :maintainers '(("Skye Shaw" . "skye.shaw@gmail.com")) :maintainer '("Skye Shaw" . "skye.shaw@gmail.com") :keywords '("git" "vc" "github" "bitbucket" "gitlab" "sourcehut" "aws" "azure" "convenience") :url "http://github.com/sshaw/git-link") diff --git a/elpa/git-link-20230420.48/git-link.el b/elpa/git-link-20230420.48/git-link.el new file mode 100644 index 00000000..9387059f --- /dev/null +++ b/elpa/git-link-20230420.48/git-link.el @@ -0,0 +1,885 @@ +;;; git-link.el --- Get the GitHub/Bitbucket/GitLab URL for a buffer location -*- lexical-binding: t -*- + +;; Copyright (C) 2013-2022 Skye Shaw and others +;; Author: Skye Shaw +;; Version: 0.9.0 +;; Package-Version: 20230420.48 +;; Package-Commit: 1727e9b7ec41a234a2cc14151b9ffd9c1c4f4b14 +;; Keywords: git, vc, github, bitbucket, gitlab, sourcehut, aws, azure, convenience +;; URL: http://github.com/sshaw/git-link +;; Package-Requires: ((emacs "24.3")) + +;; This file is NOT part of GNU Emacs. + +;;; License: + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; Create URLs for files and commits in GitHub/Bitbucket/GitLab/... +;; repositories. `git-link' returns the URL for the current buffer's file +;; location at the current line number or active region. `git-link-commit' +;; returns the URL for a commit. URLs are added to the kill ring. +;; +;; With a prefix argument prompt for the remote's name. Defaults to "origin". + +;;; Change Log: + +;; 2023-02-15 - v0.9.0 +;; * Add support for GoogleSource (thanks Peter Becich) +;; * Add plain=1 to force showing a non rendered GitHub links (thanks Erick Navarro) +;; * Add prefix arg to override git-link-use-commit when calling git-link (thanks Nacho Barrientos) +;; * Fix git-link-homepage for Bitbucket (Issue #97 thanks Sibi Prabakaran) +;; * Fix the Codeberg links to line ranges (Issue #109 thanks Wojciech Siewierski) +;; +;; 2022-02-17 - v0.8.6 +;; * Fix URL escaping of pathnames on Emacs < 27 (Issue #93 thanks David Ongaro) +;; +;; 2022-02-06 - v0.8.5 +;; * URL escape pathnames (thanks David Ongaro) +;; * Mark misspelled Savannah functions as obsolete (thanks Hendursaga) +;; * Add support for AWS CodeCommit (thanks Ram Krishnan) +;; * Add support for cgit (thanks Hendursaga) +;; +;; 2020-01-20 - v0.8.4 +;; * Add support for Codeberg (thanks Jeremy Friesen) +;; * Add git-link-homepage-remote-alist (thanks Wim Van Deun) +;; +;; 2020-01-20 - v0.8.3 +;; * Add support for Savannah +;; +;; 2020-12-14 - v0.8.2 +;; * Fix sourcehut URL, don't link to raw version (Issue #77) +;; * Fix sourcehut multi-line URLs +;; +;; 2020-11-23 - v0.8.1 +;; * Fix URL casing (Issue #57) +;; * Fix byte-compile warnings (Issue #75 thanks Brian Leung) +;; +;; 2020-07-21 - v0.8.0 +;; * Add `-' prefix argument to git-link to generate links without line numbers +;; * Add git-link-use-single-line-number +;; * Fix sourcehut's git-link handler +;; +;; 2020-03-31 - v0.7.6 +;; * Adapt to changes in Azure interface (Issue #65, thanks Roey Darwish Dror) +;; +;; 2019-08-28 - v0.7.5 +;; * Add support for Azure DevOps (Issue #62, thanks Roey Darwish Dror) +;; +;; 2019-08-16 - v0.7.4 +;; * Add support for Magit-Blob buffers (Issue #61, thanks Miciah Dashiel Butler Masters) +;; +;; 2019-03-09 - v0.7.3 +;; * Add support for sourcehut +;; +;; 2018-10-30 - v0.7.2 +;; * Fix suffix stripping on remote path only if it ends in .git (Issue #58, thanks Marko Crnic) +;; +;; 2018-07-08 - v0.7.1 +;; * Add support for vc-revision-other-window files (Issue #54) +;; +;; 2018-06-07 - v0.7.0 +;; * Add support for Tramp (Issue #49, thanks Jürgen Hötzel) +;; * Fix various compiler warnings +;; * Fix differences between url-path-and-query across Emacs versions +;; * Require Emacs 24.3 +;; +;; 2018-04-23 - v0.6.0 +;; * Fix parsing of remotes with auth info (Issue #51) +;; * Removed remote regex in favor of url-parse +;; +;; 2017-06-03 - v0.5.1 +;; * Add support for more magit modes +;; +;; 2017-06-01 - v0.5.0 +;; * Add support for linking in dired and magit modes +;; * Add support for defcustom +;; * Change git-link-remote-regex to support more remote URL formats (Thanks Kaushal Modi) +;; * Change git-link-remote-alist to use regex matching (Thanks Kaushal Modi) +;; * Fix point on commit hash regex and support uppercase SHAs (Thanks Kaushal Modi!) +;; * Fix git-link-commit message so that SHA text is displayed without properties +;; * Enabled lexical-binding (Thanks Kaushal Modi!!) +;; +;; -- Note that v0.5.0 was released as "v0.5.0 (unreleased)" +;; +;; 2016-10-19 - v0.4.5 +;; * Fix for branches containing reserved URLs characters (Issue #36) +;; +;; 2016-09-11 - v0.4.4 +;; * Added support for git-link-homepage +;; +;; 2016-08-13 - v0.4.3 +;; * Added support for git-timemachine (Issue #22, thanks Diego Berrocal) +;; +;; 2016-08-09 - v0.4.2 +;; * Fix for URLs with ports (Issue #32) +;; +;; 2016-04-01 - v0.4.1 +;; * Better handling for branches that have no explicit remote +;; * Better error messages +;; +;; 2016-02-16 - v0.4.0 +;; * Try branch's tracking remote when other branch settings are not specified +;; * git-link-default-remote now defaults to nil +;; +;; 2015-09-21 - v0.3.0 +;; * Support for setting branch and remote names via `git config` +;; * Added git-link-default-branch +;; * Removed some functions, use emacs "private" convention for others +;; +;; 2015-09-12 - v0.2.2 +;; * Support for BitBucket's multiline format +;; +;; 2015-07-25 - v0.2.1 +;; * Fix for BitBucket's new URL format (Thanks Ev Dolzhenko) +;; * Fix for GitLab's multiline format (Thanks Enrico Carlesso) +;; +;; 2015-06-05 - v0.2.0 +;; * Deactivate mark after killing the link (Thanks Kaushal Modi) +;; * Support for GitLab (Thanks Swaroop C H) +;; * Use completing-read when prompting for remotes (Thanks Andrew Gwozdziewycz) +;; * Display URL in minibuffer when adding to kill ring (Thanks Andrew Gwozdziewycz) +;; * Added git-link-use-commit variable (Thanks Kaushal Modi) +;; * Fix for displaying link in minibuffer when interprogram-cut-function is set (Thanks Ric Lister) +;; * Fix to ignore point at beginning of line in regions (Thanks Kaushal Modi) +;; * Fix for narrow-to-region (Bug #10, thanks Andrew Gwozdziewycz) +;; * Fix to use remote hostname when constructing link URLs (Thanks David Hull) +;; +;; 2015-02-05 - v0.1.0 +;; * Added git-link-commit (Thanks Ryan Barrett) +;; * Added git-link-open-in-browser variable (Thanks Ryan Barrett) +;; * Use call-process instead of shell-command-to-string +;; * Use --short option when calling symbolic-ref (Thanks Steven Huwig) +;; +;; 2014-02-27 - v0.0.2 +;; * Fix for buffers visiting files through symlinks (Issue #1, thanks Evgeniy Dolzhenko) + +;;; Code: + +(require 'cl-lib) +(require 'dired) +(require 'thingatpt) +(require 'url-util) +(require 'url-parse) + +(defgroup git-link nil + "Get the GitHub/Bitbucket/GitLab URL for a buffer location" + :prefix "git-link-" + :link '(url-link :tag "Report a Bug" "https://github.com/sshaw/git-link/issues") + :link '(url-link :tag "Homepage" "https://github.com/sshaw/git-link") + :group 'convenience) + +(eval-when-compile + (defvar git-timemachine-revision)) ;; silence reference to free variable warning + +(defcustom git-link-default-remote nil + "Name of the remote to link to." + :type 'string + :group 'git-link) + +(defcustom git-link-default-branch nil + "Name of the branch to link to." + :type 'string + :group 'git-link) + +(defcustom git-link-open-in-browser nil + "If t also open the link via `browse-url'. To use an alternate +function set to that function's symbol." + :type '(choice boolean function) + :group 'git-link) + +(defcustom git-link-use-commit nil + "If non-nil use the latest commit's hash in the link instead of the branch name." + :type 'boolean + :group 'git-link) + +(defcustom git-link-use-single-line-number t + "If t a link to a single line will always contain the line number. +If nil line numbers will only be added when a selection contains +more than 1 line. + +Note that `git-link' can exclude line numbers on a per invocation basis. +See its docs." + :type 'boolean + :group 'git-link) + +(defcustom git-link-remote-alist + '(("git.sr.ht" git-link-sourcehut) + ("codeberg.org" git-link-codeberg) + ("github" git-link-github) + ("bitbucket" git-link-bitbucket) + ("gitorious" git-link-gitorious) + ("gitlab" git-link-gitlab) + ("git\\.\\(sv\\|savannah\\)\\.gnu\\.org" git-link-savannah) + ("googlesource.com" git-link-googlesource) + ("visualstudio\\|azure" git-link-azure) + ("sourcegraph" git-link-sourcegraph) + ("\\(amazonaws\\|amazon\\)\\.com" git-link-codecommit)) + "Alist of host names and functions creating file links for those. +Each element looks like (REGEXP FUNCTION) where REGEXP is used to +match the remote's host name and FUNCTION is used to generate a link +to the file on remote host. + +As an example, \"gitlab\" will match with both \"gitlab.com\" and +\"gitlab.example.com\"." + :type '(alist :key-type string :value-type (group function)) + :group 'git-link) + +(defcustom git-link-commit-remote-alist + '(("git.sr.ht" git-link-commit-github) + ("codeberg.org" git-link-commit-codeberg) + ("github" git-link-commit-github) + ("bitbucket" git-link-commit-bitbucket) + ("gitorious" git-link-commit-gitorious) + ("gitlab" git-link-commit-github) + ("git\\.\\(sv\\|savannah\\)\\.gnu\\.org" git-link-commit-savannah) + ("googlesource.com" git-link-commit-googlesource) + ("visualstudio\\|azure" git-link-commit-azure) + ("sourcegraph" git-link-commit-sourcegraph) + ("\\(amazonaws\\|amazon\\)\\.com" git-link-commit-codecommit)) + "Alist of host names and functions creating commit links for those. +Each element looks like (REGEXP FUNCTION) where REGEXP is used to +match the remote's host name and FUNCTION is used to generate a link +to the commit on remote host. + +As an example, \"gitlab\" will match with both \"gitlab.com\" and +\"gitlab.example.com\"." + :type '(alist :key-type string :value-type (group function)) + :group 'git-link) + +(defcustom git-link-homepage-remote-alist + '(("git.sr.ht" git-link-homepage-github) + ("github" git-link-homepage-github) + ("bitbucket" git-link-homepage-github) + ("gitorious" git-link-homepage-github) + ("gitlab" git-link-homepage-github) + ("git\\.\\(sv\\|savannah\\)\\.gnu\\.org" git-link-homepage-savannah) + ("googlesource.com" git-link-homepage-github) + ("visualstudio\\|azure" git-link-homepage-github) + ("sourcegraph" git-link-homepage-github) + ("\\(amazonaws\\|amazon\\)\\.com" git-link-homepage-codecommit)) + "Alist of host names and functions creating homepage links for those. +Each element looks like (REGEXP FUNCTION) where REGEXP is used to +match the remote's host name and FUNCTION is used to generate a link +to the commit on remote host. + +As an example, \"gitlab\" will match with both \"gitlab.com\" and +\"gitlab.example.com\"." + :type '(alist :key-type string :value-type (group function)) + :group 'git-link) + +(defcustom git-link-extensions-rendered-plain '("org" "md" "rst" "adoc" "markdown" "asciidoc") + "List of extensions that should be rendered in plain mode, systems like +Github, Gitlab, etc show a rendered version by default, for these extensions +we can prevent that behaviour." + :type 'list + :group 'git-link) + +(defun git-link--exec(&rest args) + (ignore-errors + (with-temp-buffer + (when (zerop (apply #'process-file "git" nil (current-buffer) nil args)) + (goto-char (point-min)) + (cl-loop until (eobp) + collect (buffer-substring-no-properties + (line-beginning-position) + (line-end-position)) + do (forward-line 1)))))) + +(defun git-link--get-config (name) + (car (git-link--exec "config" "--get" name))) + +(defun git-link--remotes () + (git-link--exec "remote")) + +(defun git-link--last-commit () + (car (git-link--exec "--no-pager" "log" "-n1" "--pretty=format:%H"))) + +(defvar magit-buffer-revision) + +(defun git-link--commit () + (cond + ((git-link--using-git-timemachine) + (car git-timemachine-revision)) + ((git-link--using-magit-blob-mode) + magit-buffer-revision) + (t (git-link--last-commit)))) + +(defun git-link--current-branch () + (car (git-link--exec "symbolic-ref" "--short" "HEAD"))) + +(defun git-link--repo-root () + (let ((dir (car (git-link--exec "rev-parse" "--show-toplevel")))) + (if (file-remote-p default-directory) + (concat (file-remote-p default-directory) dir) + dir))) + +(defun git-link--remote-url (name) + (car (git-link--exec "remote" "get-url" name))) + +(defun git-link--branch-remote (branch) + (git-link--get-config (format "branch.%s.remote" branch))) + +(declare-function magit-rev-branch "ext:magit-git") + +(defun git-link--branch () + (or (git-link--get-config "git-link.branch") + git-link-default-branch + (when (git-link--using-magit-blob-mode) + (magit-rev-branch magit-buffer-revision)) + (git-link--current-branch))) + +(defun git-link--remote () + (let* ((branch (git-link--current-branch)) + (remote (or (git-link--get-config "git-link.remote") + git-link-default-remote + (git-link--branch-remote branch)))) + + ;; Git defaults to "." if the branch has no remote. + ;; If the branch has no remote we try master's, which may be set. + (if (or (null remote) + (and (string= remote ".") + (not (string= branch "master")))) + (setq remote (git-link--branch-remote "master"))) + + (if (or (null remote) (string= remote ".")) + "origin" + remote))) + +(defun git-link--handler (alist str) + "For an ALIST whose `car' (a regexp) matches STR, return cadr. + +The ALIST consists of (REGEXP FN) list elements. +Valid ALISTs are `git-link-remote-alist',`git-link-commit-remote-alist'. + +For the first ALIST element whose REGEXP matches with STR, FN is +returned. + +Return nil, +- if STR does not match with REGEXP in any of the elements of ALIST, or +- if STR is not a string" + (when (stringp str) + (cadr (cl-find-if (lambda (lst) + (string-match-p (car lst) str)) + alist)))) + +(defun git-link--parse-vc-revision (filename) +"If FILENAME appears to be from `vc-revision-other-window' +return (FILENAME . REVISION) otherwise nil." + (when (and (string-match "\\(.+\\)\\.~\\([^~]+\\)~$" filename) + (file-exists-p (match-string 1 filename))) + (cons (match-string 1 filename) + (match-string 2 filename)))) + +(defvar magit-buffer-file-name) + +(defun git-link--relative-filename () + (let* ((filename (buffer-file-name (buffer-base-buffer))) + (dir (git-link--repo-root))) + + (when (null filename) + (cond + ((eq major-mode 'dired-mode) + (setq filename (dired-file-name-at-point))) + ((git-link--using-magit-blob-mode) + (setq filename magit-buffer-file-name)) + ((and (string-match-p "^magit-" (symbol-name major-mode)) + (fboundp 'magit-file-at-point)) + (setq filename (magit-file-at-point))))) + + (if (and dir filename + ;; Make sure filename is not above dir, e.g. "/foo/repo-root/.." + (< (length dir) (length (file-truename filename)))) + (substring (file-truename filename) + (1+ (length dir)))))) + +(defun git-link--parse-remote (url) + "Parse URL and return a list as (HOST DIR). DIR has no leading slash or `git' extension." + (let (host path parsed) + (unless (string-match "^[a-zA-Z0-9]+://" url) + (setq url (concat "ssh://" url))) + + (setq parsed (url-generic-parse-url url) + ;; Normalize path. + ;; If none, will be nil on Emacs < 25. Later versions return "". + path (or (car (url-path-and-query parsed)) "") + host (url-host parsed)) + + (when host + (when (and (not (string= "/" path)) + (not (string= "" path))) + (setq path (substring + (if (string-match "\\.git\\'" path) + (file-name-sans-extension path) + path) + 1))) + + ;; Fix-up scp style URLs. + ;; git@foo:UsEr/repo gives a host of foo:user + ;; We also need to preserve case so we take UsEr from the original url + (when (string-match ":" host) + (let ((parts (split-string host ":" t)) + (case-fold-search t)) + (string-match (concat (car parts) ":\\(" (cadr parts) "\\)/") url) + (setq host (car parts) + path (concat (match-string 1 url) "/" path)))) + + ;; Fix-up Azure SSH URLs + (when (string= "ssh.dev.azure.com" host) + (setq host "dev.azure.com") + (setq path (replace-regexp-in-string + "v3/\\([^/]+\\)/\\([^/]+\\)/\\([^/]+\\)" + "\\1/\\2/_git/\\3" + path))) + (when (string= "vs-ssh.visualstudio.com" host) + (setq host (concat (url-user parsed) ".visualstudio.com")) + (setq path (replace-regexp-in-string + (concat "^v3/" (url-user parsed) "/\\([^/]+\\)/") + "\\1/_git/" + path))) + + ;; For Savannah + (when (string= "git.savannah.gnu.org" host) + (cond + ((string-match "\\`git/" path) + (setq path (substring path 4))) + ((string-match "\\`srv/git/" path) + (setq path (substring path 8))))) + + ;; For AWS CodeCommit + (when (string-match "git-codecommit\\.\\(.*\\)\\.amazonaws.com" host) + (let* ((matchp (string-match "\\([^\\.]*\\)\\.\\([^\\.]*\\)" host)) + (region (when matchp + (match-string 2 host))) + (domainname ".console.aws.amazon.com")) + (when region + (setq host (concat region domainname)))) + (when (string-match "v1/repos/" path) + (setq path (concat "codesuite/codecommit/repositories/" + (substring path 9))))) + + (list host path)))) + +(defun git-link--using-git-timemachine () + (and (boundp 'git-timemachine-revision) + git-timemachine-revision)) + +(defun git-link--using-magit-blob-mode () + (bound-and-true-p magit-blob-mode)) + +(defun git-link--read-remote () + (let ((remotes (git-link--remotes)) + (current (git-link--remote))) + (completing-read "Remote: " + remotes + nil + t + "" + nil + (if (member current remotes) + current + (car remotes))))) + +(defun git-link--get-region () + (save-restriction + (widen) + (save-excursion + (let* ((use-region (use-region-p)) + (start (when use-region (region-beginning))) + (end (when use-region (region-end))) + (line-start (line-number-at-pos start)) + line-end) + (when use-region + ;; Avoid adding an extra blank line to the selection. + ;; This happens when point or mark is at the start of the next line. + ;; + ;; When selection is from bottom to top, exchange point and mark + ;; so that the `point' and `(region-end)' are the same. + (when (< (point) (mark)) + (exchange-point-and-mark)) + (when (= end (line-beginning-position)) + ;; Go up and avoid the blank line + (setq end (1- end))) + (setq line-end (line-number-at-pos end)) + (when (<= line-end line-start) + (setq line-end nil))) + (list line-start line-end))))) + +(defun git-link--new (link) + (kill-new link) + ;; prevent URL escapes from being interpreted as format strings + (message (replace-regexp-in-string "%" "%%" link t t)) + (setq deactivate-mark t) + (when git-link-open-in-browser + (if (fboundp git-link-open-in-browser) + (funcall git-link-open-in-browser link) + (browse-url link)))) + +(defun git-link-codeberg (hostname dirname filename branch commit start end) + (format "https://%s/%s/src/%s/%s" + hostname + dirname + (or branch commit) + (concat filename + (when start + (concat "#" + (if end + (format "L%s-L%s" start end) + (format "L%s" start))))))) + +(defun git-link-gitlab (hostname dirname filename branch commit start end) + (format "https://%s/%s/blob/%s/%s" + hostname + dirname + (or branch commit) + (concat filename + (when start + (concat "#" + (if end + (format "L%s-%s" start end) + (format "L%s" start))))))) + +(defun git-link-github (hostname dirname filename branch commit start end) + (format "https://%s/%s/blob/%s/%s" + hostname + dirname + (or branch commit) + (concat filename + (when start + (concat (if (git-link--should-render-plain filename) "?plain=1#" "#") + (if end + (format "L%s-L%s" start end) + (format "L%s" start))))))) + +(defun git-link-googlesource (hostname dirname filename branch commit start end) + (format "https://%s/%s/+/%s/%s" + hostname + dirname + (or branch commit) + (concat filename + (when start + (format "#%s" start) + )))) + +(defun git-link-azure (hostname dirname filename branch commit start end) + (format "https://%s/%s?path=%%2F%s&version=%s&line=%s&lineEnd=%s&lineStartColumn=1&lineEndColumn=9999&lineStyle=plain" + hostname + dirname + filename + (concat "G" (if branch "B" "C") (or branch commit)) + (or start "") + (or end start ""))) + +(defun git-link-sourcehut (hostname dirname filename branch commit start end) + (format "https://%s/%s/tree/%s/%s" + hostname + dirname + (or branch commit) + (concat filename + (when start + (concat "#" + (if end + (format "L%s-%s" start end) + (format "L%s" start))))))) + + +(defun git-link-commit-github (hostname dirname commit) + (format "https://%s/%s/commit/%s" + hostname + dirname + commit)) + +(defun git-link-commit-googlesource (hostname dirname commit) + (format "https://%s/%s/+/%s" + hostname + dirname + commit)) + +(defun git-link-commit-azure (hostname dirname commit) + (format "https://%s/%s/commit/%s" + hostname + dirname + + ;; Azure only supports full 32 characters SHA + (car (git-link--exec "rev-parse" commit)))) + +(defun git-link-commit-codeberg (hostname dirname commit) + (format "https://%s/%s/commit/%s" + hostname + dirname + commit)) + +(defun git-link-gitorious (hostname dirname filename _branch commit start _end) + (format "https://%s/%s/source/%s:%s#L%s" + hostname + dirname + commit + filename + start)) + +(defun git-link-commit-gitorious (hostname dirname commit) + (format "https://%s/%s/commit/%s" + hostname + dirname + commit)) + +(defun git-link-bitbucket (hostname dirname filename _branch commit start end) + ;; ?at=branch-name + (format "https://%s/%s/src/%s/%s" + hostname + dirname + commit + (if (string= "" (file-name-nondirectory filename)) + filename + (concat filename + "#" + (file-name-nondirectory filename) + (when start + (if end + (format "-%s:%s" start end) + (format "-%s" start))))))) + +(defun git-link-commit-bitbucket (hostname dirname commit) + ;; ?at=branch-name + (format "https://%s/%s/commits/%s" + hostname + dirname + commit)) + +(defun git-link-cgit (hostname dirname filename branch commit start _end) + (format "https://%s/%s/tree/%s?h=%s" + hostname + dirname + filename + (concat + (or branch commit) + (when start + (concat "#" (format "n%s" start)))))) + +(defun git-link-commit-cgit (hostname dirname commit) + (format "https://%s/%s/commit/?id=%s" + hostname + dirname + commit)) + +(defun git-link-savannah (hostname dirname filename branch commit start end) + (git-link-cgit hostname + (format "cgit/%s.git" dirname) ; unique to Savannah + filename + branch + commit + start + end)) + +(defun git-link-commit-savannah (hostname dirname commit) + (git-link-commit-cgit hostname + (format "cgit/%s.git" dirname) ; also unique to Savannah + commit)) + +(defun git-link-sourcegraph (hostname dirname filename branch commit start end) + (let ((line-or-range (cond ((and start end) (format "#L%s-%s" start end)) + (start (format "#L%s" start)) + (t ""))) + (branch-or-commit (or branch commit)) + (dir-file-name (directory-file-name dirname))) + (format "https://%s/%s@%s/-/blob/%s%s" + hostname + dir-file-name + branch-or-commit + filename + line-or-range))) + +(defun git-link-commit-sourcegraph (hostname dirname commit) + (let ((dir-file-name (directory-file-name dirname))) + (format "https://%s/%s/-/commit/%s" + hostname + dir-file-name + commit))) + +(defun git-link-homepage-github (hostname dirname) + (format "https://%s/%s" + hostname + dirname)) + +(defun git-link-homepage-savannah (hostname dirname) + (format "https://%s/cgit/%s.git/" + hostname + dirname)) + +(defun git-link-codecommit (hostname + dirname + filename + branch + commit + start + end) + (format "https://%s/%s/browse/refs/heads/%s/--/%s" + hostname + dirname + (or branch commit) + (concat filename + (when start + (format "?lines=%s-%s" + start + (or end start)))))) + +(defun git-link-commit-codecommit (hostname dirname commit) + (format "https://%s/%s/commit/%s" hostname dirname commit)) + +(defun git-link-homepage-codecommit (hostname dirname) + (format "https://%s/%s/browse" hostname dirname)) + +(define-obsolete-function-alias + 'git-link-homepage-svannah 'git-link-homepage-savannah "cf947f9") + +(defun git-link--select-remote () + (if (equal '(4) current-prefix-arg) + (git-link--read-remote) + (git-link--remote))) + +(defun git-link--should-render-plain (filename) + "Check if the extension of the given filename belongs +to the list of extensions which generated link should be +shown as a plain file" + (let ((extension (or (file-name-extension filename) ""))) + (member (downcase extension) git-link-extensions-rendered-plain))) + +;;;###autoload +(defun git-link (remote start end) + "Create a URL representing the current buffer's location in its +GitHub/Bitbucket/GitLab/... repository at the current line number +or active region. The URL will be added to the kill ring. If +`git-link-open-in-browser' is non-nil also call `browse-url'. + +With a prefix argument of - generate a link without line number(s). +Also see `git-link-use-single-line-number'. + +With a single prefix argument prompt for the remote's name. +Defaults to \"origin\". + +With a double prefix argument invert the value of +`git-link-use-commit'." + (interactive + (if (equal '- current-prefix-arg) + (list (git-link--remote) nil nil) + (let* ((remote (git-link--select-remote)) + (region (when (or buffer-file-name (git-link--using-magit-blob-mode)) + (git-link--get-region)))) + + (if (and (null git-link-use-single-line-number) (null (cadr region))) + (list remote nil nil) + (list remote (car region) (cadr region)))))) + + (let (filename branch commit handler remote-info (remote-url (git-link--remote-url remote))) + (if (null remote-url) + (message "Remote `%s' not found" remote) + + (setq remote-info (git-link--parse-remote remote-url) + filename (git-link--relative-filename) + branch (git-link--branch) + commit (git-link--commit) + handler (git-link--handler git-link-remote-alist (car remote-info))) + + (cond ((null filename) + (message "Can't figure out what to link to")) + ((null (car remote-info)) + (message "Remote `%s' contains an unsupported URL" remote)) + ((not (functionp handler)) + (message "No handler found for %s" (car remote-info))) + ;; TODO: null ret val + (t + (let ((vc-revison (git-link--parse-vc-revision filename))) + (when vc-revison + (setq filename (car vc-revison) + commit (cdr vc-revison))) + + (git-link--new + (funcall handler + (car remote-info) + (cadr remote-info) + (url-hexify-string filename (url--allowed-chars (cons ?/ url-unreserved-chars))) + (if (or (git-link--using-git-timemachine) + (git-link--using-magit-blob-mode) + vc-revison + (if (equal '(16) current-prefix-arg) + (not git-link-use-commit) + git-link-use-commit)) + nil + (url-hexify-string branch)) + commit + start + end)))))))) + +;;;###autoload +(defun git-link-commit (remote) + "Create a URL representing the commit for the hash under point +in the current buffer's GitHub/Bitbucket/GitLab/... +repository. The URL will be added to the kill ring. + +With a prefix argument prompt for the remote's name. +Defaults to \"origin\"." + + (interactive (list (git-link--select-remote))) + (let* (commit handler remote-info (remote-url (git-link--remote-url remote))) + (if (null remote-url) + (message "Remote `%s' not found" remote) + + (setq remote-info (git-link--parse-remote remote-url) + commit (word-at-point) + handler (git-link--handler git-link-commit-remote-alist (car remote-info))) + + (cond ((null (car remote-info)) + (message "Remote `%s' contains an unsupported URL" remote)) + ((not (string-match-p "[a-fA-F0-9]\\{7,40\\}" (or commit ""))) + (message "Point is not on a commit hash")) + ((not (functionp handler)) + (message "No handler for %s" (car remote-info))) + ;; null ret val + ((git-link--new + (funcall handler + (car remote-info) + (cadr remote-info) + (substring-no-properties commit)))))))) + +;;;###autoload +(defun git-link-homepage (remote) + "Create a URL representing the homepage of the current +buffer's GitHub/Bitbucket/GitLab/... repository. The +URL will be added to the kill ring. + +With a prefix argument prompt for the remote's name. +Defaults to \"origin\"." + + (interactive (list (git-link--select-remote))) + (let* (handler remote-info (remote-url (git-link--remote-url remote))) + (if (null remote-url) + (message "Remote `%s' not found" remote) + + (setq remote-info (git-link--parse-remote remote-url) + handler (git-link--handler git-link-homepage-remote-alist (car remote-info))) + + (cond ((null (car remote-info)) + (message "Remote `%s' contains an unsupported URL" remote)) + ((not (functionp handler)) + (message "No handler for %s" (car remote-info))) + ;; null ret val + ((git-link--new + (funcall handler + (car remote-info) + (cadr remote-info)))))))) + +(provide 'git-link) +;;; git-link.el ends here