From: Andreas Gerler Date: Wed, 21 May 2025 12:41:15 +0000 (+0200) Subject: update git-link X-Git-Url: http://git.bundesbrandschatzamt.de/?a=commitdiff_plain;h=66d7fe452a2d101e9816dea8301b80a596958b7d;p=emacsconfig.git update git-link --- diff --git a/elpa/git-link-20241208.1850/git-link-autoloads.el b/elpa/git-link-20241208.1850/git-link-autoloads.el deleted file mode 100644 index a616f26d..00000000 --- a/elpa/git-link-20241208.1850/git-link-autoloads.el +++ /dev/null @@ -1,70 +0,0 @@ -;;; git-link-autoloads.el --- automatically extracted autoloads (do not edit) -*- lexical-binding: t -*- -;; Generated by the `loaddefs-generate' function. - -;; This file is part of GNU Emacs. - -;;; Code: - -(add-to-list 'load-path (or (and load-file-name (directory-file-name (file-name-directory load-file-name))) (car load-path))) - - - -;;; 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) -(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) -(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. If `git-link-open-in-browser' is non-nil -or if you pass the double prefix (Ctrl-u Ctrl-u), then also call -`browse-url'. - -With a prefix argument prompt for the remote's name. -Defaults to \"origin\". - -(fn REMOTE)" t) -(register-definition-prefixes "git-link" '("git-link-")) - - -;;; Generated autoloads from git-link-transient.el - - (autoload 'git-link-dispatch "git-link-transient" nil t) -(register-definition-prefixes "git-link-transient" '("git-link-")) - -;;; End of scraped data - -(provide 'git-link-autoloads) - -;; Local Variables: -;; version-control: never -;; no-byte-compile: t -;; no-update-autoloads: t -;; no-native-compile: t -;; coding: utf-8-emacs-unix -;; End: - -;;; git-link-autoloads.el ends here diff --git a/elpa/git-link-20241208.1850/git-link-pkg.el b/elpa/git-link-20241208.1850/git-link-pkg.el deleted file mode 100644 index 6eeed771..00000000 --- a/elpa/git-link-20241208.1850/git-link-pkg.el +++ /dev/null @@ -1,10 +0,0 @@ -;; -*- no-byte-compile: t; lexical-binding: nil -*- -(define-package "git-link" "20241208.1850" - "Get the GitHub/Bitbucket/GitLab URL for a buffer location." - '((emacs "24.3")) - :url "https://github.com/sshaw/git-link" - :commit "40f7b1674d2c703199ff2f82b464f17aa6f61b4b" - :revdesc "40f7b1674d2c" - :keywords '("git" "vc" "github" "bitbucket" "gitlab" "sourcehut" "aws" "azure" "convenience") - :authors '(("Skye Shaw" . "skye.shaw@gmail.com")) - :maintainers '(("Skye Shaw" . "skye.shaw@gmail.com"))) diff --git a/elpa/git-link-20241208.1850/git-link-transient.el b/elpa/git-link-20241208.1850/git-link-transient.el deleted file mode 100644 index 13e5593a..00000000 --- a/elpa/git-link-20241208.1850/git-link-transient.el +++ /dev/null @@ -1,128 +0,0 @@ -;;; git-link-transient.el --- Transient interface for git-link -*- lexical-binding: t; -*- - -;; Copyright (C) 2013-2024 Skye Shaw and others - -;; 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: - -;; Transient interface (magit-like menu) for git-link. -;; Call `git-link-dispatch' to show the menu. -;; -;; You need to have `transient' installed as a dependency. -;; (it's not listed as the dependency of git-link because we want it to be optional.) - -;;; Code: - -(require 'cl-lib) -(require 'transient) -(require 'git-link) - -(defun git-link-dispatch--action () - "Finally call `git-link' with transient arguments." - (let* ((args (transient-args 'git-link-dispatch)) - (git-link-default-branch (transient-arg-value "branch=" args)) - (git-link-default-remote (transient-arg-value "remote=" args)) - (git-link-use-commit (transient-arg-value "use_commit" args)) - (git-link-use-single-line-number (transient-arg-value "line_number" args))) - (call-interactively #'git-link))) - -(defun git-link-dispatch--copy () - "The copy command in transient suffix." - (interactive) - (let ((git-link-open-in-browser nil) - (git-link-add-to-kill-ring t)) - (git-link-dispatch--action))) - -(defun git-link-dispatch--open () - "The open command in transient suffix." - (interactive) - (let ((git-link-open-in-browser t)) - (git-link-dispatch--action))) - -(defclass git-link--transient-bare-option (transient-option) () - "Similar to `transient-option', but format without argument string.") - -(cl-defmethod transient-format ((obj git-link--transient-bare-option)) - (format " %s %s (%s)" - (transient-format-key obj) - (transient-format-description obj) - (let ((v (oref obj value))) - (if (> (length v) 0) - (propertize v 'face 'transient-value) - (propertize "default" 'face 'transient-inactive-value))))) - -(defclass git-link--transient-bare-switch (transient-switch) () - "Similar to `transient-switch', but format without argument string, only yes/no.") - -(cl-defmethod transient-format ((obj git-link--transient-bare-switch)) - (format " %s %s (%s)" - (transient-format-key obj) - (transient-format-description obj) - (if (oref obj value) - (propertize "on" 'face 'transient-value) - (propertize "off" 'face 'transient-inactive-value)))) - -(transient-define-infix git-link-dispatch--branch () - :class git-link--transient-bare-option - :argument "branch=" - :description "Branch" - :prompt "Branch: " - :key "b" - :init-value (lambda (obj) (oset obj value git-link-default-branch)) - :reader (lambda (prompt &rest _) - (completing-read - prompt - (remove nil (list git-link-default-branch (git-link--branch)))))) - -(transient-define-infix git-link-dispatch--remote () - :class git-link--transient-bare-option - :argument "remote=" - :description "Remote" - :key "r" - :init-value (lambda (obj) (oset obj value git-link-default-remote)) - :reader (lambda (&rest _) (git-link--read-remote))) - -(transient-define-infix git-link-dispatch--use-commit () - :class git-link--transient-bare-switch - :argument "use_commit" - ;; the value should be "use_commit" (the argument) or nil. not t - :init-value (lambda (obj) (oset obj value (and git-link-use-commit "use_commit"))) - :description "Use commit" - :key "c") - -(transient-define-infix git-link-dispatch--line-number () - :class git-link--transient-bare-switch - :argument "line_number" - :description "Line number" - :init-value (lambda (obj) (oset obj value (and git-link-use-single-line-number "line_number"))) - :if-not 'use-region-p - :key "n") - -;;;###autoload (autoload 'git-link-dispatch "git-link-transient" nil t) -(transient-define-prefix git-link-dispatch () - "Git link dispatch." - [:description - "Options" - (git-link-dispatch--branch) - (git-link-dispatch--remote) - (git-link-dispatch--use-commit) - (git-link-dispatch--line-number)] - [:description - "Git link" - ("l" "Copy link" git-link-dispatch--copy) - ("o" "Open in browser" git-link-dispatch--open)]) - -(provide 'git-link-transient) -;;; git-link-transient.el ends here diff --git a/elpa/git-link-20241208.1850/git-link.el b/elpa/git-link-20241208.1850/git-link.el deleted file mode 100644 index f8535fa6..00000000 --- a/elpa/git-link-20241208.1850/git-link.el +++ /dev/null @@ -1,956 +0,0 @@ -;;; 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 -;; Package-Version: 20241208.1850 -;; Package-Revision: 40f7b1674d2c -;; 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: - -;; 2024-06-29 - v0.9.2 -;; * Add git-link-add-to-kill-ring to not add to kill ring (thanks Michael Hauser-Raspe) -;; * Add prefix arg to open in browser when calling git-link-homepage (thanks Sibi Prabakaran) -;; -;; 2024-03-03 - v0.9.1 -;; * Add support for remote host resolution via ssh config (thanks Sibi Prabakaran) -;; * Regexp escape parts when extracting host from scp-like URLs (thanks Sibi Prabakaran) -;; -;; 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-add-to-kill-ring t - "if t also add the link to the kill-ring" - :type 'boolean - :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-consider-ssh-config nil - "Consider ssh configuration file for resolving the remote's hostname." - :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-gitlab) - ("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) - -;; https://support.atlassian.com/bitbucket-cloud/docs/readme-content/#Extensions-and-Languages -(defcustom git-link-extensions-rendered-via-bitbucket-annotate '("org" "md" "mkd" "mkdn" "mdown" - "markdown" "text" "rst" "textile" - "asciidoc") - "List of extensions that should be rendered via annotate else -they will actually be rendered. 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 (regexp-quote (car parts)) ":\\(" (cadr parts) "\\)/") url) - (setq host (car parts) - path (concat (match-string 1 url) "/" path)))) - - - (when git-link-consider-ssh-config - (let* ((ssh-resolved-host (git-link--ssh-resolve-hostname host))) - (when ssh-resolved-host - (setq host ssh-resolved-host)))) - - ;; 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--ssh-resolve-hostname (hostname) - "Resolve HOSTNAME using ssh client." - (let ((output (shell-command-to-string (format "ssh -G %s" hostname))) - (host nil)) - (dolist (line (split-string output "\n")) - (when (string-match "^hostname \\(.*\\)" line) - (setq host (match-string 1 line)))) - host)) - -(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) - (if git-link-add-to-kill-ring - (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))) - 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-gitlab (hostname dirname commit) - (format "https://%s/%s/-/commit/%s" - hostname - dirname - commit)) - -(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/%s/%s/%s" - hostname - dirname - (git-link--should-render-via-bitbucket-annotate filename) - 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") - -(defalias 'git-link-gitea 'git-link-codeberg) -(defalias 'git-link-commit-gitea 'git-link-commit-codeberg) - -(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))) - -(defun git-link--should-render-via-bitbucket-annotate (filename) - "Check if the extension of the given filename belongs -to the list of extensions which generated link should be -shown via annotate in bitbucket." - (let ((extension (or (file-name-extension filename) ""))) - (if (member (downcase extension) git-link-extensions-rendered-via-bitbucket-annotate) - "annotate" - "src"))) - -;;;###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 - (if branch - (url-hexify-string branch) - nil)) - 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. If `git-link-open-in-browser' is non-nil -or if you pass the double prefix (Ctrl-u Ctrl-u), then also call -`browse-url'. - -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)) - (git-link-open-in-browser (or git-link-open-in-browser (equal (list 16) current-prefix-arg)))) - - (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 diff --git a/elpa/git-link-20250214.1240/git-link-autoloads.el b/elpa/git-link-20250214.1240/git-link-autoloads.el new file mode 100644 index 00000000..a616f26d --- /dev/null +++ b/elpa/git-link-20250214.1240/git-link-autoloads.el @@ -0,0 +1,70 @@ +;;; git-link-autoloads.el --- automatically extracted autoloads (do not edit) -*- lexical-binding: t -*- +;; Generated by the `loaddefs-generate' function. + +;; This file is part of GNU Emacs. + +;;; Code: + +(add-to-list 'load-path (or (and load-file-name (directory-file-name (file-name-directory load-file-name))) (car load-path))) + + + +;;; 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) +(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) +(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. If `git-link-open-in-browser' is non-nil +or if you pass the double prefix (Ctrl-u Ctrl-u), then also call +`browse-url'. + +With a prefix argument prompt for the remote's name. +Defaults to \"origin\". + +(fn REMOTE)" t) +(register-definition-prefixes "git-link" '("git-link-")) + + +;;; Generated autoloads from git-link-transient.el + + (autoload 'git-link-dispatch "git-link-transient" nil t) +(register-definition-prefixes "git-link-transient" '("git-link-")) + +;;; End of scraped data + +(provide 'git-link-autoloads) + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; no-native-compile: t +;; coding: utf-8-emacs-unix +;; End: + +;;; git-link-autoloads.el ends here diff --git a/elpa/git-link-20250214.1240/git-link-pkg.el b/elpa/git-link-20250214.1240/git-link-pkg.el new file mode 100644 index 00000000..b73e2ef2 --- /dev/null +++ b/elpa/git-link-20250214.1240/git-link-pkg.el @@ -0,0 +1,10 @@ +;; -*- no-byte-compile: t; lexical-binding: nil -*- +(define-package "git-link" "20250214.1240" + "Get the GitHub/Bitbucket/GitLab URL for a buffer location." + '((emacs "24.3")) + :url "http://github.com/sshaw/git-link" + :commit "8d0f98cf36f6b9c31285329b054ae77f9a3d9b33" + :revdesc "8d0f98cf36f6" + :keywords '("git" "vc" "github" "bitbucket" "gitlab" "sourcehut" "aws" "azure" "convenience") + :authors '(("Skye Shaw" . "skye.shaw@gmail.com")) + :maintainers '(("Skye Shaw" . "skye.shaw@gmail.com"))) diff --git a/elpa/git-link-20250214.1240/git-link-transient.el b/elpa/git-link-20250214.1240/git-link-transient.el new file mode 100644 index 00000000..13e5593a --- /dev/null +++ b/elpa/git-link-20250214.1240/git-link-transient.el @@ -0,0 +1,128 @@ +;;; git-link-transient.el --- Transient interface for git-link -*- lexical-binding: t; -*- + +;; Copyright (C) 2013-2024 Skye Shaw and others + +;; 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: + +;; Transient interface (magit-like menu) for git-link. +;; Call `git-link-dispatch' to show the menu. +;; +;; You need to have `transient' installed as a dependency. +;; (it's not listed as the dependency of git-link because we want it to be optional.) + +;;; Code: + +(require 'cl-lib) +(require 'transient) +(require 'git-link) + +(defun git-link-dispatch--action () + "Finally call `git-link' with transient arguments." + (let* ((args (transient-args 'git-link-dispatch)) + (git-link-default-branch (transient-arg-value "branch=" args)) + (git-link-default-remote (transient-arg-value "remote=" args)) + (git-link-use-commit (transient-arg-value "use_commit" args)) + (git-link-use-single-line-number (transient-arg-value "line_number" args))) + (call-interactively #'git-link))) + +(defun git-link-dispatch--copy () + "The copy command in transient suffix." + (interactive) + (let ((git-link-open-in-browser nil) + (git-link-add-to-kill-ring t)) + (git-link-dispatch--action))) + +(defun git-link-dispatch--open () + "The open command in transient suffix." + (interactive) + (let ((git-link-open-in-browser t)) + (git-link-dispatch--action))) + +(defclass git-link--transient-bare-option (transient-option) () + "Similar to `transient-option', but format without argument string.") + +(cl-defmethod transient-format ((obj git-link--transient-bare-option)) + (format " %s %s (%s)" + (transient-format-key obj) + (transient-format-description obj) + (let ((v (oref obj value))) + (if (> (length v) 0) + (propertize v 'face 'transient-value) + (propertize "default" 'face 'transient-inactive-value))))) + +(defclass git-link--transient-bare-switch (transient-switch) () + "Similar to `transient-switch', but format without argument string, only yes/no.") + +(cl-defmethod transient-format ((obj git-link--transient-bare-switch)) + (format " %s %s (%s)" + (transient-format-key obj) + (transient-format-description obj) + (if (oref obj value) + (propertize "on" 'face 'transient-value) + (propertize "off" 'face 'transient-inactive-value)))) + +(transient-define-infix git-link-dispatch--branch () + :class git-link--transient-bare-option + :argument "branch=" + :description "Branch" + :prompt "Branch: " + :key "b" + :init-value (lambda (obj) (oset obj value git-link-default-branch)) + :reader (lambda (prompt &rest _) + (completing-read + prompt + (remove nil (list git-link-default-branch (git-link--branch)))))) + +(transient-define-infix git-link-dispatch--remote () + :class git-link--transient-bare-option + :argument "remote=" + :description "Remote" + :key "r" + :init-value (lambda (obj) (oset obj value git-link-default-remote)) + :reader (lambda (&rest _) (git-link--read-remote))) + +(transient-define-infix git-link-dispatch--use-commit () + :class git-link--transient-bare-switch + :argument "use_commit" + ;; the value should be "use_commit" (the argument) or nil. not t + :init-value (lambda (obj) (oset obj value (and git-link-use-commit "use_commit"))) + :description "Use commit" + :key "c") + +(transient-define-infix git-link-dispatch--line-number () + :class git-link--transient-bare-switch + :argument "line_number" + :description "Line number" + :init-value (lambda (obj) (oset obj value (and git-link-use-single-line-number "line_number"))) + :if-not 'use-region-p + :key "n") + +;;;###autoload (autoload 'git-link-dispatch "git-link-transient" nil t) +(transient-define-prefix git-link-dispatch () + "Git link dispatch." + [:description + "Options" + (git-link-dispatch--branch) + (git-link-dispatch--remote) + (git-link-dispatch--use-commit) + (git-link-dispatch--line-number)] + [:description + "Git link" + ("l" "Copy link" git-link-dispatch--copy) + ("o" "Open in browser" git-link-dispatch--open)]) + +(provide 'git-link-transient) +;;; git-link-transient.el ends here diff --git a/elpa/git-link-20250214.1240/git-link.el b/elpa/git-link-20250214.1240/git-link.el new file mode 100644 index 00000000..5d285a6b --- /dev/null +++ b/elpa/git-link-20250214.1240/git-link.el @@ -0,0 +1,976 @@ +;;; 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 +;; Package-Version: 20250214.1240 +;; Package-Revision: 8d0f98cf36f6 +;; 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: + +;; 2024-06-29 - v0.9.2 +;; * Add git-link-add-to-kill-ring to not add to kill ring (thanks Michael Hauser-Raspe) +;; * Add prefix arg to open in browser when calling git-link-homepage (thanks Sibi Prabakaran) +;; +;; 2024-03-03 - v0.9.1 +;; * Add support for remote host resolution via ssh config (thanks Sibi Prabakaran) +;; * Regexp escape parts when extracting host from scp-like URLs (thanks Sibi Prabakaran) +;; +;; 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-add-to-kill-ring t + "if t also add the link to the kill-ring" + :type 'boolean + :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-consider-ssh-config nil + "Consider ssh configuration file for resolving the remote's hostname." + :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-gitlab) + ("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) + +;; https://support.atlassian.com/bitbucket-cloud/docs/readme-content/#Extensions-and-Languages +(defcustom git-link-extensions-rendered-via-bitbucket-annotate '("org" "md" "mkd" "mkdn" "mdown" + "markdown" "text" "rst" "textile" + "asciidoc") + "List of extensions that should be rendered via annotate else +they will actually be rendered. We can prevent that behaviour." + :type 'list + :group 'git-link) + +(defcustom git-link-web-host-alist nil + "Mapping from Git host names to web host names. + +Elements have the form (GIT-HOST-REGEXP . WEB-HOST), where +GIT-HOST-REGEXP is a regexp matching the host name used by Git +and WEB-HOST is the name of the host serving the corresponding +web interface. + +This can be used when custom deployments serve SSH access and the +web interface under different host names. For example, if Git +uses \"ssh.gitlab.company.com\" but the web interface is at +\"gitlab.company.com\", add +`(\"ssh\\\\.gitlab\\\\.company\\\\.com\" . \"gitlab.company.com\")'." + :type '(alist :key-type string :value-type string) + :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 (regexp-quote (car parts)) ":\\(" (cadr parts) "\\)/") url) + (setq host (car parts) + path (concat (match-string 1 url) "/" path)))) + + + (when git-link-consider-ssh-config + (let* ((ssh-resolved-host (git-link--ssh-resolve-hostname host))) + (when ssh-resolved-host + (setq host ssh-resolved-host)))) + + ;; 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--ssh-resolve-hostname (hostname) + "Resolve HOSTNAME using ssh client." + (let ((output (shell-command-to-string (format "ssh -G %s" hostname))) + (host nil)) + (dolist (line (split-string output "\n")) + (when (string-match "^hostname \\(.*\\)" line) + (setq host (match-string 1 line)))) + host)) + +(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) + (if git-link-add-to-kill-ring + (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))) + 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-gitlab (hostname dirname commit) + (format "https://%s/%s/-/commit/%s" + hostname + dirname + commit)) + +(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/%s/%s/%s" + hostname + dirname + (git-link--should-render-via-bitbucket-annotate filename) + 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") + +(defalias 'git-link-gitea 'git-link-codeberg) +(defalias 'git-link-commit-gitea 'git-link-commit-codeberg) + +(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))) + +(defun git-link--should-render-via-bitbucket-annotate (filename) + "Check if the extension of the given filename belongs +to the list of extensions which generated link should be +shown via annotate in bitbucket." + (let ((extension (or (file-name-extension filename) ""))) + (if (member (downcase extension) git-link-extensions-rendered-via-bitbucket-annotate) + "annotate" + "src"))) + +;;;###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 ((remote-url (git-link--remote-url remote)) + filename branch commit handler remote-info git-host web-host) + (if (null remote-url) + (message "Remote `%s' not found" remote) + + (setq remote-info (git-link--parse-remote remote-url) + git-host (car remote-info) + filename (git-link--relative-filename) + branch (git-link--branch) + commit (git-link--commit) + handler (git-link--handler git-link-remote-alist git-host) + web-host (or (assoc-default git-host git-link-web-host-alist #'string-match-p) + git-host)) + + (cond ((null filename) + (message "Can't figure out what to link to")) + ((null git-host) + (message "Remote `%s' contains an unsupported URL" remote)) + ((not (functionp handler)) + (message "No handler found for %s" git-host)) + ;; 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 + web-host + (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 + (if branch + (url-hexify-string branch) + nil)) + 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. If `git-link-open-in-browser' is non-nil +or if you pass the double prefix (Ctrl-u Ctrl-u), then also call +`browse-url'. + +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)) + (git-link-open-in-browser (or git-link-open-in-browser (equal (list 16) current-prefix-arg)))) + + (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