From 1c1d69bb5d1a84a045f8c2610d2e95a41f34de26 Mon Sep 17 00:00:00 2001 From: Seth Mason Date: Wed, 23 Nov 2016 14:46:06 -0800 Subject: [PATCH 1/2] Add support for github enterprise and bitbucket. Fix #20 --- README.md | 14 ++++- github-browse-file.el | 119 +++++++++++++++++++++++++++++++++--------- 2 files changed, 107 insertions(+), 26 deletions(-) diff --git a/README.md b/README.md index 29d633f..a327779 100644 --- a/README.md +++ b/README.md @@ -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: @@ -18,6 +18,18 @@ 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. + ### Contributors * [Charles Comstock](https://github.com/dgtized) * [Justin Talbott](https://github.com/waymondo) diff --git a/github-browse-file.el b/github-browse-file.el index 5240d77..d82e9a6 100644 --- a/github-browse-file.el +++ b/github-browse-file.el @@ -50,11 +50,40 @@ :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) +(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.") @@ -67,14 +96,55 @@ 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--absolute-url (directory current-rev relative-path anchor) + "Return \"https://DOMAIN/username/repo/current-rev/relative-path#anchor\" for current file. + + (let ((url (vc-git--run-command-string nil "config" "remote.origin.url")) +Error out if this isn't a remote repo." + (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." @@ -116,17 +186,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 () @@ -140,10 +207,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. @@ -194,10 +266,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) From b082f6e839f993ef53b269c55972fa8deffa8b1a Mon Sep 17 00:00:00 2001 From: Seth Mason Date: Wed, 23 Nov 2016 15:35:45 -0800 Subject: [PATCH 2/2] Add support for remotes with different names. --- README.md | 9 +++++++++ github-browse-file.el | 17 ++++++++++++++++- 2 files changed, 25 insertions(+), 1 deletion(-) diff --git a/README.md b/README.md index a327779..46a9761 100644 --- a/README.md +++ b/README.md @@ -30,6 +30,15 @@ For Bitbucket you would do: **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) diff --git a/github-browse-file.el b/github-browse-file.el index d82e9a6..490024c 100644 --- a/github-browse-file.el +++ b/github-browse-file.el @@ -68,6 +68,12 @@ :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" @@ -129,11 +135,20 @@ This should only ever be `let'-bound, not set outright.") 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. - (let ((url (vc-git--run-command-string nil "config" "remote.origin.url")) 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