Skip to content

Add support for github enterprise and bitbucket #22

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
wants to merge 2 commits into
base: master
Choose a base branch
from
Open

Add support for github enterprise and bitbucket #22

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
1c1d69b
Add support for github enterprise and bitbucket. Fix #20
slackorama Nov 23, 2016
b082f6e
Add support for remotes with different names.
slackorama Nov 23, 2016
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
23 changes: 22 additions & 1 deletion README.md
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@
github-browse-file
==================

View the file you're editing in Emacs on GitHub.
View the file you're editing in Emacs on GitHub or Bitbucket depending on the value of `remote.origin.url`.

### Installation:

Expand All @@ -18,6 +18,27 @@ Call `github-browse-file` (for the git blob) or `github-browse-file-blame`

`github-browse-commit` can be used to link to the current commit.

#### Enterprise support

If you use Github Enterprise or Bitbucket Server, add your domain to `github-browse-file-domains` via `customize` or use something like in your init file:

(add-to-list 'github-browse-file-domains '("git.dayjob.com" :type github))

For Bitbucket you would do:

(add-to-list 'github-browse-file-domains '("git.dayjob.com" :type bitbucket))

**Note:** This assumes that your hosted instance is listening on https.

#### Remotes by a different name

If your remote isn't named `origin`, you may modify the `github-browse-file-remote-names` to add your differently named remote. For example:

(setq github-browse-file-remote-names '("upstream" "origin"))

The order of this list matters as the first remote name that returns a url, is the one that is used for the link that is generated.


### Contributors
* [Charles Comstock](https://github.com/dgtized)
* [Justin Talbott](https://github.com/waymondo)
Expand Down
134 changes: 109 additions & 25 deletions github-browse-file.el
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -50,11 +50,46 @@
:group 'github-browse-file
:type 'boolean)

(defcustom github-browse-file-domains `(("github.com"
:type github)
("bitbucket.org"
:type bitbucket))
"Domains to match against and their repo types from `github-browse-file--repo-types'."
:group 'github-browse-file
:type '(alist :key-type string
:value-type (plist :key-type (const :type)
:value-type (choice (const bitbucket)
(const github)))
))


(defcustom github-browse-file-show-line-at-point nil
"If non-nil, link to the current line or active region"
:group 'github-browse-file
:type 'boolean)


(defcustom github-browse-file-remote-names'("origin")
"Names of remote repositories to look for."
:group 'github-browse-file
:type '(repeat string))

(defvar github-browse-file--repo-types '((github
:commit-dir "commit"
:src-dir "blob"
:blame-dir "blame"
:tree-dir "tree"
:anchor github-browse-file--format-anchors-github
)
(bitbucket
:commit-dir "commits"
:src-dir "src"
:blame-dir "annotate"
:tree-dir "src"
:anchor github-browse-file--format-anchors-bitbucket))
"The different supported enterprise type repositories supported.
Based on the type, it informs `github-browse-file--absolute-url' how to construct the URL.")

(defvar github-browse-file--view-blame nil
"If non-nil, view \"blame\" instead of \"blob\".
This should only ever be `let'-bound, not set outright.")
Expand All @@ -67,14 +102,64 @@ This should only ever be `let'-bound, not set outright.")
'(magit-commit-mode magit-revision-mode magit-log-mode)
"Non-file magit modes that should link to commits.")

(defun github-browse-file--relative-url ()
"Return \"username/repo\" for current repository.

Error out if this isn't a GitHub repo."
(let ((url (vc-git--run-command-string nil "config" "remote.origin.url")))
(unless url (error "Not in a GitHub repo"))
(when (and url (string-match "github.com:?/?\\(.*\\)" url))
(replace-regexp-in-string "\\.git$" "" (match-string 1 url)))))
(defun github-browse-file--format-anchors-github (&optional anchor)
(cond
((= 1 (length anchor))
(format "L%d" (car anchor)))
((= 2 (length anchor))
(format "L%d-L%d" (car anchor) (car (cdr anchor))))
(t "")))

(defun github-browse-file--format-anchors-bitbucket (&optional anchor)
""
(let ((file-name (file-name-nondirectory (buffer-file-name))))
(cond
((= 1 (length anchor))
(format "%s-%d" file-name (car anchor)))
((= 2 (length anchor))
(format "%s-%d:%d" file-name (car anchor) (car (cdr anchor))))
(t ""))
)
)

(defun github-browse-file--remote-regexp (domain)
(eval
`(rx bol (or ,(concat "git@" domain ":")
(and (or "git" "ssh" "http" "https") "://"
(* nonl) (? "@") ,domain "/"))
(and (group (* nonl) "/" (* nonl))) (? ".git"))))

(defun github-browse-file--get-regexps ()
"Return the plist keyed by regexp of repo information."
(loop for (key . domain-plist) in github-browse-file-domains
collect (cons (github-browse-file--remote-regexp key)
(plist-put domain-plist :url (concat "https://" key)))))

(defun github-browse-file--get-remote-url ()
"Get the URL of the remote repository.
Looks for the first URL that is returned for the remotes in `github-browse-file-remote-names'."
(let ((possible-urls (cl-loop for repo-name in github-browse-file-remote-names
collect (vc-git--run-command-string nil "config" (format "remote.%s.url" repo-name)))))
(cl-loop for remote-url in possible-urls
if remote-url
return remote-url)))

(defun github-browse-file--absolute-url (directory current-rev relative-path anchor)
"Return \"https://DOMAIN/username/repo/current-rev/relative-path#anchor\" for current file.

Error out if this isn't a remote repo."
(let ((url (github-browse-file--get-remote-url))
(regexps (github-browse-file--get-regexps)))
(unless url (error "Not in a remote repo"))
(cl-loop for (regexp . domain-plist) in regexps
if (and url (string-match regexp url))
return (let ((repo-plist (cdr (assoc (plist-get domain-plist :type) github-browse-file--repo-types))))
(concat (plist-get domain-plist :url) "/"
(replace-regexp-in-string "\\.git$" "" (match-string 1 url)) "/"
(plist-get repo-plist directory) "/"
(when current-rev (concat current-rev "/"))
relative-path
(when anchor (concat "#" (funcall (plist-get repo-plist :anchor) anchor))))))))

(defun github-browse-file--repo-relative-path ()
"Return the path to the current file relative to the repository root."
Expand Down Expand Up @@ -116,17 +201,14 @@ Otherwise, return the name of the current branch."
(and rev (replace-regexp-in-string "\n" "" rev))))))

(defun github-browse-file--browse-url (&optional anchor)
"Load http://github.com/user/repo/file#ANCHOR in a web browser and add it to
"Load http://DOMAIN/user/repo/file#ANCHOR in a web browser and add it to
the kill ring."
(let ((url (concat "https://github.com/"
(github-browse-file--relative-url) "/"
(cond ((eq major-mode 'magit-status-mode) "tree")
((member major-mode github-browse-file--magit-commit-link-modes) "commit")
(github-browse-file--view-blame "blame")
(t "blob")) "/"
(github-browse-file--current-rev) "/"
(github-browse-file--repo-relative-path)
(when anchor (concat "#" anchor)))))
(let* ((directory (cond ((eq major-mode 'magit-status-mode) :tree-dir)
((member major-mode github-browse-file--magit-commit-link-modes) :commit-dir)
(github-browse-file--view-blame :blame-dir)
(t :src-dir)))
(current-rev (github-browse-file--current-rev))
(url (concat (github-browse-file--absolute-url directory current-rev (github-browse-file--repo-relative-path) anchor))))
(github-browse--save-and-view url)))

(defun github-browse-file--anchor-lines ()
Expand All @@ -140,10 +222,15 @@ default to current line."
(end (line-number-at-pos (region-end))))
(when (eq (char-before (region-end)) ?\n) (cl-decf end))
(if (>= start end)
(format "L%d" start)
(format "L%d-L%d" start end))))
`(,start nil)
;; (format "L%d" start)
;; (format "L%d-L%d" start end)
`(,start ,end)
)))
(github-browse-file-show-line-at-point
(format "L%d" (line-number-at-pos (point))))))
`(,(line-number-at-pos (point)))
;; (format "L%d" (line-number-at-pos (point)))
)))

(defun github-browse-file--guess-commit ()
"Guess the current git commit.
Expand Down Expand Up @@ -194,10 +281,7 @@ region."
"Show the GitHub page for the current commit."
(interactive)
(let* ((commit (github-browse-file--guess-commit))
(url (concat "https://github.com/"
(github-browse-file--relative-url)
"/commit/"
commit)))
(url (github-browse-file--absolute-url :commit-dir commit nil nil)))
(github-browse--save-and-view url)))

(provide 'github-browse-file)
Expand Down