+++ /dev/null
-;;; 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)))
-
-
-\f
-;;; 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-"))
-
-\f
-;;; Generated autoloads from git-link-transient.el
-
- (autoload 'git-link-dispatch "git-link-transient" nil t)
-(register-definition-prefixes "git-link-transient" '("git-link-"))
-\f
-;;; 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
+++ /dev/null
-;; -*- no-byte-compile: t; lexical-binding: nil -*-
-(define-package "git-link" "20250812.1427"
- "Get the GitHub/Bitbucket/GitLab URL for a buffer location."
- '((emacs "24.3"))
- :url "http://github.com/sshaw/git-link"
- :commit "e4cfed05d110a6af07543d069f12e1894f553c2e"
- :revdesc "e4cfed05d110"
- :keywords '("git" "vc" "github" "bitbucket" "gitlab" "sourcehut" "aws" "azure" "convenience")
- :authors '(("Skye Shaw" . "skye.shawNOSPAMgmail.com"))
- :maintainers '(("Skye Shaw" . "skye.shawNOSPAMgmail.com")))
+++ /dev/null
-;;; 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 <https://www.gnu.org/licenses/>.
-
-;;; 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
+++ /dev/null
-;;; 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 <skye.shawNOSPAMgmail.com>
-;; Package-Version: 20250812.1427
-;; Package-Revision: e4cfed05d110
-;; 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 <http://www.gnu.org/licenses/>.
-
-;;; 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\")'.
-By default this will create a link using the \\='https://\\=' scheme.
-If you want \\='http://\\=' instead prefix the host with it:
-`(\"ssh\\\\.gitlab\\\\.company\\\\.com\" . \"http://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."
- (let ((default-directory (git-link--repo-root)))
- (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--web-host (git-host)
- "Determine the web host to use for GIT-HOST.
-
-The translation is based on `git-link-web-host-alist'. If there
-is no entry for GIT-HOST in the list, it is returned unmodified.
-If a WEB-HOST value does not already have a URL scheme, \\='https://\\='
-is prepended to it."
- (let ((web-host (or (assoc-default git-host git-link-web-host-alist #'string-match-p)
- git-host)))
- (if (string-match-p "^[a-zA-Z][a-zA-Z0-9+.-]+://" web-host)
- web-host
- (concat "https://" web-host))))
-
-(defun git-link-codeberg (hostname dirname filename branch commit start end)
- (format "%s/%s/src/%s/%s"
- hostname
- dirname
- (or branch (concat "commit/" 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 "%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 "%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 "%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 "%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 "%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 "%s/%s/-/commit/%s"
- hostname
- dirname
- commit))
-
-(defun git-link-commit-github (hostname dirname commit)
- (format "%s/%s/commit/%s"
- hostname
- dirname
- commit))
-
-(defun git-link-commit-googlesource (hostname dirname commit)
- (format "%s/%s/+/%s"
- hostname
- dirname
- commit))
-
-(defun git-link-commit-azure (hostname dirname commit)
- (format "%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 "%s/%s/commit/%s"
- hostname
- dirname
- commit))
-
-(defun git-link-gitorious (hostname dirname filename _branch commit start _end)
- (format "%s/%s/source/%s:%s#L%s"
- hostname
- dirname
- commit
- filename
- start))
-
-(defun git-link-commit-gitorious (hostname dirname commit)
- (format "%s/%s/commit/%s"
- hostname
- dirname
- commit))
-
-(defun git-link-bitbucket (hostname dirname filename _branch commit start end)
- ;; ?at=branch-name
- (format "%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 "%s/%s/commits/%s"
- hostname
- dirname
- commit))
-
-(defun git-link-cgit (hostname dirname filename branch commit start _end)
- (format "%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 "%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 "%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 "%s/%s/-/commit/%s"
- hostname
- dir-file-name
- commit)))
-
-(defun git-link-homepage-github (hostname dirname)
- (format "%s/%s"
- hostname
- dirname))
-
-(defun git-link-homepage-savannah (hostname dirname)
- (format "%s/cgit/%s.git/"
- hostname
- dirname))
-
-(defun git-link-codecommit (hostname
- dirname
- filename
- branch
- commit
- start
- end)
- (format "%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 "%s/%s/commit/%s" hostname dirname commit))
-
-(defun git-link-homepage-codecommit (hostname dirname)
- (format "%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 (git-link--web-host 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* ((remote-url (git-link--remote-url remote))
- 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)
- commit (word-at-point)
- handler (git-link--handler git-link-commit-remote-alist git-host)
- web-host (git-link--web-host git-host))
-
- (cond ((null git-host)
- (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" git-host))
- ;; null ret val
- ((git-link--new
- (funcall handler
- web-host
- (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* ((remote-url (git-link--remote-url remote))
- (git-link-open-in-browser (or git-link-open-in-browser (equal (list 16) current-prefix-arg)))
- 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)
- handler (git-link--handler git-link-homepage-remote-alist git-host)
- web-host (git-link--web-host git-host))
-
- (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
- web-host
- (cadr remote-info))))))))
-
-(provide 'git-link)
-;;; git-link.el ends here
--- /dev/null
+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".
--- /dev/null
+;;; 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)))
+
+
+\f
+;;; 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-"))
+
+\f
+;;; Generated autoloads from git-link-transient.el
+
+ (autoload 'git-link-dispatch "git-link-transient" nil t)
+(register-definition-prefixes "git-link-transient" '("git-link-"))
+\f
+;;; 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
--- /dev/null
+;; -*- no-byte-compile: t; lexical-binding: nil -*-
+(define-package "git-link" "20260411.1730"
+ "Get the GitHub/Bitbucket/GitLab URL for a buffer location."
+ '((emacs "24.3"))
+ :url "https://github.com/sshaw/git-link"
+ :commit "b651de43236276cdb18ec7727f645cbf6743a499"
+ :revdesc "b651de432362"
+ :keywords '("git" "vc" "github" "bitbucket" "gitlab" "sourcehut" "aws" "azure" "convenience")
+ :authors '(("Skye Shaw" . "skye.shawNOSPAMgmail.com"))
+ :maintainers '(("Skye Shaw" . "skye.shawNOSPAMgmail.com")))
--- /dev/null
+;;; 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 <https://www.gnu.org/licenses/>.
+
+;;; 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
--- /dev/null
+;;; git-link.el --- Get the GitHub/Bitbucket/GitLab URL for a buffer location -*- lexical-binding: t -*-
+
+;; Copyright (C) 2013-2025 Skye Shaw and others
+;; Author: Skye Shaw <skye.shawNOSPAMgmail.com>
+;; Package-Version: 20260411.1730
+;; Package-Revision: b651de432362
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; 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:
+
+;; 2025-10-23 - v0.10.0
+;; * Add: support for linking to custom web hosts (Issue #136, thanks Sebastian Poeplau)
+;; * Add: Transient menu interface (Issues #128 and #132, thanks Yikai Zhao and David Morgan)
+;; * Fix: linking under vc mode when default-directory is nil
+;; * Fix: hexification of nil branch name (Issue #127, thanks Michael Hauser-Raspe)
+;; * Fix: Codeberg permalinks (Issue #147, thanks Marty Hiatt)
+;;
+;; 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)
+ ("forge.fedoraproject.org" git-link-codeberg))
+ "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)
+ ("forge.fedoraproject.org" git-link-commit-codeberg))
+ "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)
+ ("forge.fedoraproject.org" git-link-homepage-codeberg))
+ "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\")'.
+By default this will create a link using the \\='https://\\=' scheme.
+If you want \\='http://\\=' instead prefix the host with it:
+`(\"ssh\\\\.gitlab\\\\.company\\\\.com\" . \"http://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."
+ (let ((default-directory (git-link--repo-root)))
+ (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--web-host (git-host)
+ "Determine the web host to use for GIT-HOST.
+
+The translation is based on `git-link-web-host-alist'. If there
+is no entry for GIT-HOST in the list, it is returned unmodified.
+If a WEB-HOST value does not already have a URL scheme, \\='https://\\='
+is prepended to it."
+ (let ((web-host (or (assoc-default git-host git-link-web-host-alist #'string-match-p)
+ git-host)))
+ (if (string-match-p "^[a-zA-Z][a-zA-Z0-9+.-]+://" web-host)
+ web-host
+ (concat "https://" web-host))))
+
+(defun git-link-codeberg (hostname dirname filename branch commit start end)
+ (format "%s/%s/src/%s/%s"
+ hostname
+ dirname
+ (or branch (concat "commit/" 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 "%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 "%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 "%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 "%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 "%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 "%s/%s/-/commit/%s"
+ hostname
+ dirname
+ commit))
+
+(defun git-link-commit-github (hostname dirname commit)
+ (format "%s/%s/commit/%s"
+ hostname
+ dirname
+ commit))
+
+(defun git-link-commit-googlesource (hostname dirname commit)
+ (format "%s/%s/+/%s"
+ hostname
+ dirname
+ commit))
+
+(defun git-link-commit-azure (hostname dirname commit)
+ (format "%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 "%s/%s/commit/%s"
+ hostname
+ dirname
+ commit))
+
+(defun git-link-gitorious (hostname dirname filename _branch commit start _end)
+ (format "%s/%s/source/%s:%s#L%s"
+ hostname
+ dirname
+ commit
+ filename
+ start))
+
+(defun git-link-commit-gitorious (hostname dirname commit)
+ (format "%s/%s/commit/%s"
+ hostname
+ dirname
+ commit))
+
+(defun git-link-bitbucket (hostname dirname filename _branch commit start end)
+ ;; ?at=branch-name
+ (format "%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 "%s/%s/commits/%s"
+ hostname
+ dirname
+ commit))
+
+(defun git-link-cgit (hostname dirname filename branch commit start _end)
+ (format "%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 "%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 "%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 "%s/%s/-/commit/%s"
+ hostname
+ dir-file-name
+ commit)))
+
+(defun git-link-homepage-github (hostname dirname)
+ (format "%s/%s"
+ hostname
+ dirname))
+
+(defun git-link-homepage-savannah (hostname dirname)
+ (format "%s/cgit/%s.git/"
+ hostname
+ dirname))
+
+(defun git-link-codecommit (hostname
+ dirname
+ filename
+ branch
+ commit
+ start
+ end)
+ (format "%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 "%s/%s/commit/%s" hostname dirname commit))
+
+(defun git-link-homepage-codecommit (hostname dirname)
+ (format "%s/%s/browse" hostname dirname))
+
+(defun git-link-homepage-codeberg (hostname dirname)
+ (format "%s/%s" 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--commit-hash-p (commit)
+ (string-match-p "[a-fA-F0-9]\\{7,40\\}" (or commit "")))
+
+(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 (git-link--web-host 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* ((remote-url (git-link--remote-url remote))
+ commit handler remote-info git-host web-host)
+ (if (null remote-url)
+ (message "Remote `%s' not found" remote)
+
+ (setq commit (word-at-point))
+ (when (and (not (git-link--commit-hash-p commit))
+ (derived-mode-p 'magit-revision-mode)
+ (boundp 'magit-buffer-revision))
+ (setq commit magit-buffer-revision))
+
+ (setq remote-info (git-link--parse-remote remote-url)
+ git-host (car remote-info)
+ handler (git-link--handler git-link-commit-remote-alist git-host)
+ web-host (git-link--web-host git-host))
+
+ (cond ((null git-host)
+ (message "Remote `%s' contains an unsupported URL" remote))
+ ((not (git-link--commit-hash-p commit))
+ (message "Point is not on a commit hash"))
+ ((not (functionp handler))
+ (message "No handler for %s" git-host))
+ ;; null ret val
+ ((git-link--new
+ (funcall handler
+ web-host
+ (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* ((remote-url (git-link--remote-url remote))
+ (git-link-open-in-browser (or git-link-open-in-browser (equal (list 16) current-prefix-arg)))
+ 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)
+ handler (git-link--handler git-link-homepage-remote-alist git-host)
+ web-host (git-link--web-host git-host))
+
+ (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
+ web-host
+ (cadr remote-info))))))))
+
+(provide 'git-link)
+;;; git-link.el ends here
projects / emacsconfig.git / commitdiff