diff --git a/.github/ISSUE_TEMPLATE.md b/.github/ISSUE_TEMPLATE.md index ebdb7bc..34e18c0 100644 --- a/.github/ISSUE_TEMPLATE.md +++ b/.github/ISSUE_TEMPLATE.md @@ -2,14 +2,6 @@ Reporting an error? Oh no! I'm happy to take a look at it, but *please* provide the backtrace in your issue: before triggering the error make sure `debug-on-error` is set to `t` (interactively, you can use `M-x toggle-debug-on-error`). Then, just copy the backtrace that's provided :smile: -As you're probably aware, Magithub is a synthesis of two very fantastic tools: [the magit porcelain for Emacs][magit] and [the `hub` command-line utility][hub]. Please be mindful of which project you're opening this issue against. - -Since this project has a familiarity with *both* tools, an issue opened here can easily be redirected somewhere else. - # Feature Requests -Since Magithub relies on [`hub`][hub], there are some features that are yet beyond reach. I'm using [the 2.2-stable branch][hub-2.2] to create Magithub's commands -- anything that's not implemented there will be difficult to implement here. When a new version of Hub is released, Magithub will be similarly updated to account for any new commands/switches/options. Feel free to open an feature-request issue for tracking, though! - -[magit]: //www.github.com/magit/magit -[hub]: //hub.github.com -[hub-2.2]: //github.com/github/hub/tree/2.2-stable +Always welcome! Please be specific about what you want, though. A little bit of code can go a long way :wink: (and a pull request goes even further!) diff --git a/.github/PULL_REQUEST_TEMPLATE.md b/.github/PULL_REQUEST_TEMPLATE.md new file mode 100644 index 0000000..8f350f6 --- /dev/null +++ b/.github/PULL_REQUEST_TEMPLATE.md @@ -0,0 +1,9 @@ +Thanks for contributing! It's really appreciated :smile: + +Here are some things to remember: + +- In the past, commit messages have mentioned issues directly. I've found this to be more trouble than it's worth -- especially when code goes under review and is edited and subsequently rebased. Try to leave issue/PR references out of commit messages -- opting instead to use the PR body to link the necessary records in the bug tracker. + +- If you're fixing a bug or implementing a new feature, add something to the appropriate `RelNotes/*.org` file. + +- If it's a breaking change (i.e., it could reasonably break someone's configuration), document that in the release notes as well. diff --git a/.gitignore b/.gitignore index e8d3566..1362728 100644 --- a/.gitignore +++ b/.gitignore @@ -1,3 +1,9 @@ *.elc *~ -/.cask +/magithub.html +/magithub.pdf +/magithub/ +/build.log +/magithub-autoloads.el +/.emake/ +/emake.mk diff --git a/.travis.yml b/.travis.yml index 3a62818..a134597 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,37 +1,38 @@ -language: emacs-lisp - -sudo: false - +language: generic +sudo: required +dist: trusty +cache: +- directories: + - "$HOME/emacs" matrix: fast_finish: true allow_failures: - - env: EMACS_VERSION=snapshot - + - env: EMACS_VERSION=snapshot + - env: EMACS_VERSION=26.1 MELPA_STABLE=true env: - - EMACS_VERSION=24.4 - - EMACS_VERSION=24.5 + global: + - EMAKE_SHA1=1b23379eb5a9f82d3e2d227d0f217864e40f23e0 + matrix: - EMACS_VERSION=25.1 + - EMACS_VERSION=25.2 + - EMACS_VERSION=25.3 + - EMACS_VERSION=26.1 + - EMACS_VERSION=26.1 MELPA_STABLE=true - EMACS_VERSION=snapshot - before_install: - - export PATH="$HOME/bin:$PATH" - - wget 'https://raw.githubusercontent.com/flycheck/emacs-travis/master/emacs-travis.mk' - - make -f emacs-travis.mk install_emacs - - make -f emacs-travis.mk install_cask - +- wget "https://raw.githubusercontent.com/vermiculus/emake.el/${EMAKE_SHA1}/emake.mk" +- make setup install: - - cask install - +- make install script: - - cask exec ert-runner - +- make --keep-going test notifications: email: on_success: never on_failure: change webhooks: urls: - - https://webhooks.gitter.im/e/b1163bae60c65660fbd2 + - https://webhooks.gitter.im/e/b1163bae60c65660fbd2 on_success: change on_failure: always on_start: never diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md new file mode 100644 index 0000000..be51f79 --- /dev/null +++ b/CONTRIBUTING.md @@ -0,0 +1,57 @@ +# Contributing + +First off, thanks for contributing to this project. It's people like +you -- your time and effort in reporting bugs, suggesting features, or +submitting pull requests -- that make this project and so many others +like it in the Emacs world a joy to work with. Stay awesome! + +## Roadmap + +Magithub's vision is to become the bridge between the `git` VCS and +GitHub social network. Not only do I want to replicate the standard +functionality you would expect from a GitHub client, but I want to +closely *integrate* Magit's workflows with GitHub's featureset to +develop and optimize the broader experience of using `git` with other +people. + +Magit itself may include such support in the future, though probably +to a less-specialized extent. At present, Magithub is focusing on +GitHub (although the lessons learned here could be applied to a +Magitlab, for instance). + +## Reporting Bugs + +Ugh, nasty bugs! Every software project has them (except +[TeX, vπ][tex-bug]), and many of them are found only by users like +you. As you write your issue, please follow the instructions the +issue template provides. A stack trace helps tremendously! + +Sometimes there are intermittent bugs that cannot be reproduced +easily. Anyone who develops software can tell you that it is very +difficult to debug an issue that you cannot see. For this reason, the +'unconfirmed' label indicates an issue that hasn't been reproduced by +a maintainer and the 'waiting' label indicates an issue is waiting for +some response from the folks who are actually experiencing it. Any +issue that has had the 'waiting' label for more than two weeks can be +closed as 'not reproducible'. If you are still having the issue after +that time, please do re-open the issue! I don't mean to say that bugs +are features, but I don't want to give a false first impression of +bugginess. + +## Suggesting Features + +Feature requests are always welcome! Pull requests even more so. +:wink: Know however that this is a project I do in my free time; +sometimes life gets in the way of doing this development -- or even +reviewing development from a pull request. Don't let that deter you +:smile: It *will* be reviewed. + +## Unit Tests + +Additions of more unit tests are always appreciated -- as well as +improvements to the overall unit test approach. The *only* thing I +would like to continue to avoid is making real API requests (since +this makes pull requests difficult), so please mock the response for +any such test you write. Reach out on Gitter if you need a hand. + +[tex-bug]: http://www.ntg.nl/maps/05/34.pdf diff --git a/Cask b/Cask index 5e8214d..453402c 100644 --- a/Cask +++ b/Cask @@ -3,8 +3,9 @@ (package-file "magithub.el") -(files "*.el") +(files "magithub*.el") (development + (depends-on "cask") (depends-on "ert") (depends-on "ert-runner")) diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..ca63e5d --- /dev/null +++ b/Makefile @@ -0,0 +1,90 @@ +-include config.mk + +PACKAGE_BASENAME := magithub +EMAKE_SHA1 := 1b23379eb5a9f82d3e2d227d0f217864e40f23e0 + +# override defaults +ifeq ($(MELPA_STABLE),true) +PACKAGE_ARCHIVES := gnu melpa-stable +else +PACKAGE_ARCHIVES := gnu melpa +endif + +PACKAGE_TEST_ARCHIVES := gnu melpa + +include emake.mk + +.DEFAULT_GOAL: help + +### Magithub targets + +.PHONY: clean install compile test + +clean: + rm -rf $(EMAKE_WORKDIR) + rm -rf *.elc + +emake.mk: ## download the emake Makefile + wget 'https://raw.githubusercontent.com/vermiculus/emake.el/$(EMAKE_SHA1)/emake.mk' + +test: compile test-ert ## run tests +lint: lint-package-lint lint-checkdoc ## run lints + + +### Manual-building + +ifndef ORG_LOAD_PATH +ORG_LOAD_PATH = -L ../dash +ORG_LOAD_PATH += -L ../org/lisp +ORG_LOAD_PATH += -L ../org/contrib/lisp +ORG_LOAD_PATH += -L ../ox-texinfo+ +endif + +INSTALL_INFO ?= $(shell command -v ginstall-info || printf install-info) +EMACS ?= emacs +MAKEINFO ?= makeinfo +MANUAL_HTML_ARGS ?= --css-ref /assets/the.css + +doc: info html html-dir pdf ## generate most manual formats +info: $(PACKAGE_BASENAME).info dir ## generate info manual +html: $(PACKAGE_BASENAME).html ## generate html manual file +pdf: $(PACKAGE_BASENAME).pdf ## generate pdf manual + +ORG_ARGS = --batch -Q $(ORG_LOAD_PATH) -l ox-extra -l ox-texinfo+.el +ORG_EVAL = --eval "(ox-extras-activate '(ignore-headlines))" +ORG_EVAL += --eval "(setq indent-tabs-mode nil)" +ORG_EVAL += --eval "(setq org-src-preserve-indentation nil)" +ORG_EVAL += --funcall org-texinfo-export-to-texinfo + +# This target first bumps version strings in the Org source. The +# necessary tools might be missing so other targets do not depend +# on this target and it has to be run explicitly when appropriate. +# +# AMEND=t make texi Update manual to be amended to HEAD. +# VERSION=N make texi Update manual for release. +# +.PHONY: texi +texi: ## generate texi manual (see comments) + @$(EMACS) $(ORG_ARGS) $(PACKAGE_BASENAME).org $(ORG_EVAL) + @printf "\n" >> $(PACKAGE_BASENAME).texi + @rm -f $(PACKAGE_BASENAME).texi~ + +%.info: %.texi + @printf "Generating $@\n" + @$(MAKEINFO) --no-split $< -o $@ + +dir: $(PACKAGE_BASENAME).info + @printf "Generating $@\n" + @printf "%s" $^ | xargs -n 1 $(INSTALL_INFO) --dir=$@ + +%.html: %.texi + @printf "Generating $@\n" + @$(MAKEINFO) --html --no-split $(MANUAL_HTML_ARGS) $< + +html-dir: $(PACKAGE_BASENAME).texi ## generate html manual directory + @printf "Generating $(PACKAGE_BASENAME)/*.html\n" + @$(MAKEINFO) --html $(MANUAL_HTML_ARGS) $< + +%.pdf: %.texi + @printf "Generating $@\n" + @texi2pdf --clean $< > /dev/null diff --git a/README.md b/README.md index 0ced835..11df12d 100644 --- a/README.md +++ b/README.md @@ -1,53 +1,73 @@ +# Maintainer's Note + +I have not had as much time for extra-curriculars as I once had. +At this point, I will never catch up to the obvious successor of +this package, Forge, nor would I really want to :smile: + +Please check out that project instead! I believe there are things +a GitHub-specific package could do that don't make sense to generalize, +but Forge has served me well for the 95%. + +If you have a vision and would like to take over maintainership, +reach out! + +--- + Overview -- the status buffer # Magithub [![MELPA Status](http://melpa.milkbox.net/packages/magithub-badge.svg)](http://melpa.milkbox.net/#/magithub) -[![MELPA Stable Status](http://melpa-stable.milkbox.net/packages/magithub-badge.svg)](http://melpa-stable.milkbox.net/#/magithub) [![Build Status](https://travis-ci.org/vermiculus/magithub.svg?branch=master)](https://travis-ci.org/vermiculus/magithub) -[![Gitter](https://badges.gitter.im/vermiculus/magithub.svg)](https://gitter.im/vermiculus/magithub?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge) +[![Gitter](https://badges.gitter.im/vermiculus/magithub.svg)](https://gitter.im/vermiculus/magithub) +[![MELPA Stable Status](http://melpa-stable.milkbox.net/packages/magithub-badge.svg)](http://melpa-stable.milkbox.net/#/magithub) +[![GitHub Commits](https://img.shields.io/github/commits-since/vermiculus/magithub/latest.svg)](//github.com/vermiculus/magithub/releases) -Magithub is a collection of interfaces to GitHub. +Magithub is a collection of interfaces to GitHub integrated into +[Magit][magit] workflows: -Integrated into [Magit][magit] workflows, Magithub allows very easy, -very basic GitHub repository management. Supported actions from the -status buffer include: +- Push new repositories +- Fork existing ones +- List and create issues and pull requests +- Keep offline notes for your eyes only +- Write comments +- Manage labels and assignees +- Stay up-to-date with status checks (e.g., CI) and notifications +- ... - - `H H` opens the current repo in the browser - - `H c` pushes brand-new local repositories up to GitHub - - `H f` creates forks of existing repositories - - `H p` submits pull requests upstream - - `H i` creates issues - - `RET` on an issue open that issue in GitHub - - `RET` on the CI header takes you to your CI dashboard +as well as support for working offline. Happy hacking! -## Installation - -The package can be installed from MELPA. Otherwise, simply place -`magithub.el` in your `load-path` and `(require 'magithub)`. Use the -function `magithub-feature-autoinject` to add full Magit workflow -integration. +## Quick Start -If you use [use-package][gh-use-package], you should instead use: +GitHub rate-limits unauthenticated requests heavily, so Magithub does +not support making such requests. Consequently, `ghub` must be +authenticated before using Magithub -- [see its README][ghub] for +those instructions. ```elisp (use-package magithub :after magit - :config (magithub-feature-autoinject t)) + :config + (magithub-feature-autoinject t) + (setq magithub-clone-default-directory "~/github")) ``` -For now, Magithub requires the `hub` utility to work -- before trying -to use Magithub, follow the installation instructions -at [hub.github.com][hub]. To force `hub` to authenticate, you can use -`hub browse` in a terminal (inside a GitHub repo). +See [the full documentation][magithub-org] for more details. + +## Getting Help + +See [the FAQ][magithub-org-faq] in the full documentation. If your +question isn't answered there, [drop by the Gitter +room]((https://gitter.im/vermiculus/magithub)). ## Support I'm gainfully and happily employed with a company that frowns on -moonlighting, so unfortunately I can't accept any donations myself. -Instead, [please direct any and all support to Magit itself][magit-donate]! +moonlighting, so unfortunately I can't accept any monetary support. +Instead, [please direct any and all support to Magit +itself][magit-donate]! ## Note @@ -63,9 +83,13 @@ package's name will not be changing. [magit]: //www.github.com/magit/magit [magit-donate]: https://magit.vc/donate +[ghub]: //github.com/tarsius/ghub [hub]: //hub.github.com +[token]: https://github.com/settings/tokens [gh-use-package]: //github.com/jwiegley/use-package [old-magithub]: //github.com/nex3/magithub [old-magithub-11]: //github.com/nex3/magithub/issues/11 [old-magithub-13]: //github.com/nex3/magithub/issues/13 [melpa-1126]: //github.com/melpa/melpa/issues/1126 +[magithub-org]: https://github.com/vermiculus/magithub/blob/master/magithub.org +[magithub-org-faq]: https://github.com/vermiculus/magithub/blob/master/magithub.org#faq diff --git a/RelNotes/0.1.6.org b/RelNotes/0.1.6.org new file mode 100644 index 0000000..9956932 --- /dev/null +++ b/RelNotes/0.1.6.org @@ -0,0 +1,147 @@ +#+Title: Magithub Release 0.1.6 +#+Date: [2018-06-02 Sat] + +#+LINK: PR https://www.github.com/vermiculus/magithub/pull/%s +#+LINK: BUG https://www.github.com/vermiculus/magithub/issues/%s + +* Breaking Changes +- If you were using ~magit-header-line~ to customize the appearance of + the =Issues= and =Pull Requests= section headers, those now use the + ~magit-section-heading~ face. [[PR:196]] +- Many functions related to issue/post creation have been reworked. + Instead of the widget framework, we now use =magithub-edit-mode=. See + more details in 'New Features'. [[PR:204]] +- =magithub-dashboard-show-unread-notifications= is now called + =magithub-dashboard-show-read-notifications= and all functionality + pertaining to that variable has been updated. [[PR:251]] +- Most settings, like the inclusion of sections in ~magit-status~, are + now controlled by various =git config= properties. These settings are + reachable under =H C=. The following functions/variables no longer + exist: + - ~magithub-ci-enabled-p~ (now ~magithub-settings-include-status-p~) + - ~magithub-ci--set-enabled~ + - ~magithub-ci-disable~ + - ~magithub-ci-enable~ + - ~magithub-toggle-ci-status-header~ + - =magithub-cache= (now =magithub-settings-cache-behavior-override=; + ~magithub-settings-cache-behavior~) + - ~magithub-toggle-online~ + - ~magithub-go-online~ + - ~magithub-go-offline~ + - ~magithub-source--remote~ + - ~magithub--deftoggle~ + - ~magithub-toggle-pull-requests~ + - ~magithub-toggle-issues~ + - ~magithub-proxy-set~ + - ~magithub-proxy-set-default~ + - ~magithub-enable~ + - ~magithub-disable~ + - ~magithub-enabled-toggle~ + - =magithub-enabled-by-default= + + The various integration sections are now added to the appropriate + hooks by ~magithub-feature-autoinject~ via =magithub-feature-list=. + + For more details on how to set configure Magithub now, consult the + documentation inside ~magithub-settings-popup~ (=? KEY=) or read + =magithub-settings.el=. [[PR:265]] +- =hub.host= is no longer respected and has been replaced by user option + ~magithub-github-hosts~. This most directly impacts GitHub Enterprise + support. +** Caching [[PR:328]] +Caching has been reworked mostly from the ground-up. 'Offline mode' +is now manifest in a single, Boolean-valued git variable +"magithub.online", which see ~magithub-settings--set-magithub.online~ +for that behavior. + +- ~magithub-cache-invalidate~ was not used, so it is no longer + available. +- ~magithub-issue-refresh~ no longer takes parameters. + +* New Features +- Browse commits by using =w= on a commit section. If the current + section's value cannot be understood as a valid commit, use the + =git-revision= at point. +- ~magithub-feature-autoinject~ can now take a list of features to load. +- Many symbols are now supported by ~thing-at-point~: + - =github-user= + - =github-issue= + - =github-label= + - =github-comment= + - =github-repository= + - =github-pull-request= + - =github-notification= + These symbols should allow other GitHub-sensitive packages to use + the work Magithub has already done without depending on Magithub + directly. [[PR:201]] +- The widget interface for writing issues and pull requests is gone! + Now, everything uses the framework debuted for writing comments. + For issues and pull requests, the first line (i.e., everything up to + the first newline character) is parsed as the title; everything else + as the body. Now issues, pull requests, and comments use a common + interface that supports submitting, canceling, and saving drafts to + finish later. [[PR:204]] +- You can now edit comments using =e= on a comment section. [[PR:206]] +- When submitting pull requests of a single commit, the commit message + is defaulted into the pull request body. Multiple commits? + ~magit-log~ shows you the changes you want to merge. [[PR:239]] +- Headers in issue-view mode are now easier to navigate. [[PR:250]] +- Notifications are marked as read when visited in Emacs. [[PR:252]] +- ~magithub-repo~ can now take a string of the form =user/repo=. This is + helpful when writing other code that uses Magithub functionality. [[PR:253]] +- New command ~magithub-pull-request-new-from-issue~ can create pull + requests from issues. This creates a new pull request by copying + the title/body from the source issue. (To be honest, this API + endpoint is not what I thought it would be.) [[PR:256]] +- Confirmation messages can now be skipped (or the default question + behavior otherwise altered) using =git config= properties. See + ~magithub-confirm-set-default-behavior~ or configure your settings + locally (or globally) interactively when they're asked. [[PR:268]] + [[PR:270]] +- Use default branch of the repository as =BASE= if there's no upstream + for the current branch. [[PR:269]] +- Completion of issue numbers ("#123"), and user names ("@purcell") is + supported in edit and commit message buffers via the standard + ~completion-at-point~ mechanism, and therefore also via ~company~'s ~capf~ + backend. This is enabled by default in certain buffers via the + ~magithub-features~ mechanism. [[PR:263]], [[PR:278]] + +* Bug Fixes +- ~magithub-clone~ is now asynchonous, and defers to the user whether + or not to display the magit-process-buffer according to the value of + ~magit-process-popup-time~. [[https://github.com/vermiculus/magithub/pull/340][PR:340]] +- In ~magithub-repo~, an API request is no longer made when the + repository context cannot be determined. +- The list of labels is now correctly cached per-repository. [[PR:203]] +- The full list of labels is now available for use when modifying + issues and pull requests. [[PR:203]] +- The cache (and other files in =magithub-dir=) are no longer added to + the =recentf= list. [[PR:210]] +- Consistently use ~magithub-request~. [[PR:229]] +- ~magit-magithub-pull-request-section-map~ is now defined in terms of + ~magit-magithub-issue-section-map~. [[PR:238]] +- Fix autoloads to load and install the dispatch with Magit. [[PR:238]] +- Remove awkward blank lines from the end of the dashboard. [[PR:238]] +- Issue/PR drafts are deleted appropriately after successful + submission. [[PR:247]] +- Various performance improvements. [[PR:255]] +- Ghub+ is now required in core. This should help users who utilize + deferred loading. [[PR:260]] +- Submitting pull requests to other repositories in some scenarios + should now be fixed. [[PR:272]] +- ~magithub-clone~ now correctly provides a default destination. [[PR:273]] +- ~magithub-pull-request-new~ now uses a better check to test for pull + requests of a single commit: [[PR:274]] + #+BEGIN_SRC sh + git rev-list --count BASE.. + #+END_SRC +- Authenticate correctly when marking notifications as read. [[PR:277]] +- Don't call ~magit-get~ in a non-existent directory in ~magithub-clone~. + [[PR:282]] +- Pull requests now work in repositories with remotes that point to + non-GitHub locations. [[PR:285]] +- We now only prompt to refresh GitHub data when the command being run + by the user is solely intended to refresh the buffer. [[PR:318]] +- We no longer ever call =/rate_limit= directly, instead relying on an + improved version of ~ghubp-ratelimit~ that handles GitHub Enterprise + sanely. [[BUG:327]] diff --git a/RelNotes/0.2.org b/RelNotes/0.2.org new file mode 100644 index 0000000..af6e3ca --- /dev/null +++ b/RelNotes/0.2.org @@ -0,0 +1,20 @@ +#+Title: Magithub Release 0.2 +#+Date: + +#+LINK: PR https://www.github.com/vermiculus/magithub/pull/%s +#+LINK: BUG https://www.github.com/vermiculus/magithub/issues/%s + +* Bug Fixes +- ~magithub-cache-write-to-disk~ now will write to the disk without + prompting when ~require-final-newline~ is set to t. [[PR:343]] +- ~magithub-github-hosts~ can now support more than one host when + customized through the customization interface [[https://github.com/vermiculus/magithub/pull/357][PR:357]] +- ~magithub--api-available-p~ now authenticates as =magithub= to retrieve + ratelimit information. [[BUG:363]] +- ~magithub-instrument~ is introduced, which see. +* Enhancements +- Open and close issues with =O= and =C=, respectively. [[PR:369]] +- Browse files with ~magithub-browse-file~. Supports file-visiting + buffers with active regions as well as dired- and magit-status-like + buffers. Blame the file with ~magithub-browse-file-blame~. [[PR:377]] +- Speed github datetime parsing. [[PR:393]] diff --git a/images/status.png b/images/status.png index b3ad6ea..b876622 100644 Binary files a/images/status.png and b/images/status.png differ diff --git a/magithub-cache.el b/magithub-cache.el deleted file mode 100644 index aa0694d..0000000 --- a/magithub-cache.el +++ /dev/null @@ -1,88 +0,0 @@ -;;; magithub-cache.el --- caching network data -*- lexical-binding: t; -*- - -;; Copyright (C) 2016 Sean Allred - -;; Author: Sean Allred -;; Keywords: data, tools - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Commentary: - -;; - -;;; Code: - -(require 'magithub-core) - -(defvar magithub-cache--cache () - "An alist of hash tables to use as thr cache. -Entries are of the form (time-entered . value).") - -(defvar magithub-cache-refresh-seconds-plist - (list :issues 600 :ci-status 60 t 60) - "The number of seconds that have to pass for GitHub data to be -considered outdated.") - -(defun magithub-cache--get-table (repo) - (declare (indent defun)) - (let ((table (cdr (assoc repo magithub-cache--cache)))) - (unless table - (add-to-list 'magithub-cache--cache (cons repo (make-hash-table))) - (setq table (cdr (assoc repo magithub-cache--cache)))) - table)) - -(defun magithub-cache--table (table cache default) - "The cached value for CACHE (set to DEFAULT if necessary)." - (declare (indent defun)) - (let ((cached-value (gethash cache table :no-value))) - (if (or (eq cached-value :no-value) - (< (or (plist-get magithub-cache-refresh-seconds-plist cache) - (plist-get magithub-cache-refresh-seconds-plist t)) - (time-to-seconds (time-since (car cached-value))))) - (cdr (puthash cache (cons (current-time) (eval default)) table)) - (when magithub-debug-mode - (message "Using cached value for %S (retrieved %s)" - cache (format-time-string "%F %T" (car cached-value)))) - (cdr cached-value)))) - -(defun magithub-cache (repo cache default) - (declare (indent defun)) - (magithub-cache--table (magithub-cache--get-table repo) cache default)) - -(defun magithub-cache-value--table (table cache) - "The cached value for CACHE." - (let ((c (gethash cache table :no-value))) - (unless (eq c :no-value) - (cdr c)))) - -(defun magithub-cache-value (repo cache) - "The cached value for CACHE." - (magithub-cache-value--table (magithub-cache--get-table repo) cache)) - -(defun magithub-cache-clear (repo &optional cache) - "Clear the cache for CACHE. -If CACHE is nil, the entire cache is cleared." - (if cache (remhash cache (magithub-cache--get-table repo)) - (cl-delete repo magithub-cache--cache - :key #'car :test #'equal))) - -(defun magithub-refresh () - "Refresh all GitHub data." - (interactive) - (magithub-cache-clear (magithub-repo-id)) - (magit-refresh)) - -(provide 'magithub-cache) -;;; magithub-cache.el ends here diff --git a/magithub-ci.el b/magithub-ci.el index 5903f6e..47e812f 100644 --- a/magithub-ci.el +++ b/magithub-ci.el @@ -1,6 +1,6 @@ ;;; magithub-ci.el --- Show CI status as a magit-status header -*- lexical-binding: t; -*- -;; Copyright (C) 2016 Sean Allred +;; Copyright (C) 2016-2018 Sean Allred ;; Author: Sean Allred ;; Keywords: tools @@ -26,228 +26,170 @@ (require 'magit) (require 'magit-section) -(require 'magit-popup) (require 'dash) (require 's) (require 'magithub-core) -(require 'magithub-cache) - -(defconst magithub-ci-status-symbol-alist - '(("✔" . success) - ("✖" . failure) ; also means `error'... gross - ("●" . pending)) - "Because hub 2.3 is silly and does silly things. -Reference: https://github.com/github/hub/blob/master/commands/ci_status.go#L107") - -(defconst magithub-ci-status-regex - (rx bos - (group any) (* any) "\t" - (group (* any)) "\t" - (? (group (* any))) eos)) - -(defvar magithub-ci-urls nil - "An alist mapping of repositories to CI urls.") - -(defun magithub-ci-enabled-p () - "Non-nil if CI is enabled for this repository. -If magithub.ci.enabled is not set, CI is considered to be enabled." - (when (member (magit-get "magithub" "ci" "enabled") '(nil "yes")) t)) -(defun magithub-ci-disable () - "Disable CI for this repository." - (magit-set "no" "magithub" "ci" "enabled")) -(defun magithub-ci-enable () - "Enable CI for this repository." - (magit-set "yes" "magithub" "ci" "enabled")) +(require 'magithub-issue) +;;;###autoload (defun magithub-maybe-insert-ci-status-header () "If this is a GitHub repository, insert the CI status header." - (when (and (magithub-ci-enabled-p) - (magithub-usable-p)) + (when (and (magithub-settings-include-status-p) + (magithub-usable-p) + (let ((b (magit-get-current-branch))) + (or (magit-get-upstream-remote b) + (magit-get-push-remote b)))) (magithub-insert-ci-status-header))) -(defun magithub-ci-toggle () - "Toggle CI integration." - (interactive) - (if (magithub-ci-enabled-p) - (magithub-ci-disable) - (magithub-ci-enable)) - (when (derived-mode-p 'magit-status-mode) - (magit-refresh))) - -(magit-define-popup-action 'magithub-dispatch-popup - ?~ "Toggle CI for this repository" #'magithub-ci-toggle ?`) - -(defun magithub-ci-status () - "One of 'success, 'error, 'failure, 'pending, or 'no-status." - (unless (string-equal (magit-rev-parse "HEAD") - (magithub-ci-status-current-commit)) - (magithub-cache-clear (magithub-repo-id) :ci-status)) - (let ((cached-val (magithub-cache-value (magithub-repo-id) :ci-status))) - (if (and (consp cached-val) (eq (plist-get (car cached-val) :status) 'success)) - cached-val - (magithub-cache (magithub-repo-id) :ci-status - '(magithub-ci-status--internal))))) - -(defun magithub-ci-status-current-commit (&optional new-value) - "The commit our cached value corresponds to." - (let ((keys (list "magithub" "ci" "lastCommit"))) - (if new-value (apply #'magit-set new-value keys) - (apply #'magit-get keys)))) - -(defun magithub-ci-status--parse-2.2.8 (output) - "Backwards compatibility for old versions of hub. -See `magithub-ci-status--parse'." - (-when-let (matches (cdr (s-match (rx bos (group (+ (any alpha space))) - (? ": " (group (+ (not (any " "))))) eos) - output))) - (list (list :status (intern (replace-regexp-in-string - "\s" "-" (car matches))) - :url (cadr matches))))) - -(defun magithub-ci-status--internal (&optional for-commit) - "One of 'success, 'error, 'failure, 'pending, or 'no-status." - (let* ((current-commit (magit-rev-parse "HEAD")) - (last-commit (or for-commit current-commit)) - (output (magithub--command-output "ci-status" `("-v" ,last-commit)))) - (-if-let (checks (if (magithub-hub-version-at-least "2.3") - (magithub-ci-status--parse output) - (magithub-ci-status--parse-2.2.8 (car output)))) - (let ((overall-status (car checks))) - (prog1 (or (and (plist-get overall-status :status) checks) 'no-status) - (if (not (or for-commit (plist-get overall-status :status))) - (let ((last-commit (magithub-ci-status--last-commit))) - (unless (string-equal current-commit last-commit) - (magithub-ci-status--internal last-commit)) - (magithub-ci-status-current-commit current-commit)) - (magithub-ci-status-current-commit current-commit)))) - (beep) - (setq magithub-hub-error - (message - (concat "Hub didn't have any recognizable output for \"ci-status\"!\n" - "Are you connected to the internet?\n" - "Consider submitting an issue to github/hub."))) - 'internal-error))) - -(defun magithub-ci-status--parse (output) - "Parse a string OUTPUT into a list of statuses. -The first status will be an `overall' status." - (let ((statuses (mapcar #'magithub-ci-status--parse-line output)) - (get-status (lambda (status) (lambda (s) (eq (plist-get s :status) status))))) - (cons - (list :check 'overall - :status - (cond - ((-all? (funcall get-status 'success) statuses) 'success) - ((-some? (funcall get-status 'pending) statuses) 'pending) - ((-some? (funcall get-status 'error) statuses) 'error) - ((-some? (funcall get-status 'failure) statuses) 'failure))) - statuses))) - -(defun magithub-ci-status--parse-line (line) - "Parse a single LINE of status into a status plist." - (-if-let (matches (cdr (s-match magithub-ci-status-regex line))) - (list :status (cdr (assoc (car matches) magithub-ci-status-symbol-alist)) - :url (car (cddr matches)) - :check (cadr matches)) - (if (string= line "no-status") - 'no-status - (if (string= line "") 'no-output)))) - -(defun magithub-ci-status--last-commit () - "Find the commit considered to have the current CI status. -Right now, this finds the most recent commit without - - [ci skip] - -or - - [skip ci] - -in the commit message. - -See the following resources: - - - https://docs.travis-ci.com/user/customizing-the-build#Skipping-a-build - - https://circleci.com/docs/skip-a-build/" - (let* ((args '("--invert-grep" - "--grep=\\[ci skip\\]" - "--grep=\\[skip ci\\]" - "--format=oneline" - "--max-count=1")) - (output (magit-git-lines "log" args))) - (car (split-string (car output))))) +(defvar magithub-ci--status-last-refreshed nil + "An alist of alists: repos to refs to times. +For efficiency, repos are represented only by their full names.") + +(defun magithub-ci--status-last-refreshed-time (repo ref) + "The last time the statuses for REPO@REF were retrieved. +This is a generalized variable and can be set with `setf'." + (declare (gv-setter + (lambda (time) + `(let ((repo (magithub-repo-name ,repo))) + (if-let ((statuses (assoc repo magithub-ci--status-last-refreshed))) + (if-let ((status (assoc ,ref (cdr statuses)))) + (setcdr status ,time) + (push (cons ,ref ,time) (cdr statuses))) + (push (cons repo (list (cons ,ref ,time))) + magithub-ci--status-last-refreshed)))))) + '(thread-last magithub-ci--status-last-refreshed + (assoc (magithub-repo-name repo)) (cdr) + (assoc ref) (cdr)) + (cdr (assoc ref (cdr (assoc (magithub-repo-name repo) + magithub-ci--status-last-refreshed))))) + +(defun magithub-pull-request-pr->branch (pull-request) + "Does not handle cases where the local branch has been renamed." + (let-alist pull-request .head.ref)) + +(define-error 'magithub-error-ambiguous-branch "Ambiguous Branch" 'magithub-error) +(defun magithub-pull-request-branch->pr--ghub (branch) + "This is a hueristic; it's not 100% accurate. +It may fail if the fork has multiple branches named BRANCH." + (let ((repo (magithub-repo-from-remote (magit-get-push-remote branch)))) + (when (alist-get 'fork repo) + (let* ((guess-head (format "%s:%s" (magit-get-push-remote branch) branch)) + (prs (magithub-cache :ci-status + `(magithub-request + (ghubp-get-repos-owner-repo-pulls ',(magithub-repo) :head ,guess-head))))) + (pcase (length prs) + (0) ; this branch does not seem to correspond to any PR + (1 (magit-set (number-to-string (alist-get 'number (car prs))) + "branch" branch "magithub" "sourcePR") + (car prs)) + (_ ;; todo: currently unhandled + (signal 'magithub-error-ambiguous-branch + (list :prs prs + :guess-head guess-head + :repo-from-remote (alist-get 'full_name repo) + :source-repo (alist-get 'full_name (magithub-repo)))))))))) + +(defun magithub-pull-request-branch->pr--gitconfig (branch) + "Gets a pull request object from branch.BRANCH.magithub.sourcePR" + (when-let ((source (magit-get "branch" branch "magithub" "sourcePR"))) + (magithub-pull-request (magithub-repo) (string-to-number source)))) + +(defun magithub-ci-status--get-default-ref (&optional branch) + "The ref to use for CI status based on BRANCH. + +Handles cases where the local branch's name is different than its +remote counterpart." + (setq branch (or branch (magit-get-current-branch))) + (if (or (magithub-pull-request-branch->pr--gitconfig branch) + (and (magithub-online-p) + (with-demoted-errors "Error: %S" + (magithub-pull-request-branch->pr--ghub branch)))) + (magit-rev-parse branch) + (when-let ((push-branch (magit-get-push-branch branch))) + (when (magit-branch-p push-branch) + (cdr (magit-split-branch-name push-branch)))))) + +(defun magithub-ci-status (ref) + (when (stringp ref) + (if (magit-rebase-in-progress-p) + ;; avoid rate-limiting ourselves + (magithub-debug-message "skipping CI status checks while in rebase") + (or (magithub-cache :ci-status + `(magithub-request + (ghubp-get-repos-owner-repo-commits-ref-status + ',(magithub-repo) ,ref)) + :message + (format "Getting CI status for %s..." + (if (magit-branch-p ref) (format "branch `%s'" ref) + (substring ref 0 6))) + :after-update + (lambda (status &rest _) + (setf (magithub-ci--status-last-refreshed-time (magithub-repo) ref) + (current-time)) + (message "(magithub): new statuses retrieved -- overall: %s" + (alist-get 'state status)))) + '((state . "error") + (total_count . 0) + (magithub-message . "ref not found on remote")))))) (defvar magithub-ci-status-alist - '((no-status . "None") - (error . "Error") - (internal-error . magithub-ci--hub-error-string) - (failure . "Failure") - (pending . "Pending") - (success . "Success"))) - -(defun magithub-ci--hub-error-string () - "Internal error string." - (format "Internal error!\n%s" magithub-hub-error)) - -(defface magithub-ci-no-status - '((((class color)) :inherit magit-dimmed)) - "Face used when CI status is `no-status'." - :group 'magithub-faces) - -(defface magithub-ci-error - '((((class color)) :inherit magit-signature-untrusted)) - "Face used when CI status is `error'." - :group 'magithub-faces) - -(defface magithub-ci-pending - '((((class color)) :inherit magit-signature-untrusted)) - "Face used when CI status is `pending'." - :group 'magithub-faces) - -(defface magithub-ci-success - '((((class color)) :inherit magit-signature-good)) - "Face used when CI status is `success'." - :group 'magithub-faces) - -(defface magithub-ci-failure - '((((class color)) :inherit magit-signature-bad)) - "Face used when CI status is `'" - :group 'magithub-faces) - -(defface magithub-ci-unknown - '((((class color)) :inherit magit-signature-untrusted)) - "Face used when CI status is `unknown'." - :group 'magithub-faces) - -(defun magithub-ci-visit () - "Browse the CI. -Sets up magithub.ci.url if necessary." - (interactive) - (let* ((checks (magithub-ci-status)) - (checks-alist - (magithub--zip - checks - (if (magithub-hub-version-at-least "2.3") - (lambda (c) - (format "%S: %s" - (plist-get c :status) - (plist-get c :check))) - :status) - :url)) - (target-url - (if (= 1 (length checks-alist)) - (cdar checks-alist) - (when checks-alist - (cdr (assoc (completing-read "CI Service: " checks-alist) - checks-alist)))))) - (when (or (null target-url) (string= "" target-url)) - (user-error "No CI URL detected")) - (browse-url target-url))) + '((nil . ((display . "None") (face . magithub-ci-no-status))) + ("error" . ((display . "Error") (face . magithub-ci-error))) + ("failure" . ((display . "Failure") (face . magithub-ci-failure))) + ("pending" . ((display . "Pending") (face . magithub-ci-pending))) + ("success" . ((display . "Success") (face . magithub-ci-success))))) +(defconst magithub-ci-status--unknown + '((face . magithub-ci-unknown))) + +(defun magithub-ci-pr-status (pr) + (interactive (list (thing-at-point 'github-pull-request))) + (unless pr + (user-error "no pr at point")) + (message "state of #%d: %s" + (let-alist pr .number) + (let-alist (ghubp-get-repos-owner-repo-commits-ref-status + (magithub-repo) + (let-alist pr .head.sha)) + .state))) + +(defun magithub-ci-visit (ref) + "Jump to CI with `browse-url'." + (interactive (list (magit-rev-parse (magit-commit-at-point)))) + (let (done) + (when (null ref) + (pcase (oref (magit-current-section) value) + (`(magithub-ci-url . ,url) + (browse-url url) + (setq done t)) + (`(magithub-ci-ref . ,secref) + (setq ref secref)))) + (unless done + (let* ((urls (alist-get 'statuses (magithub-ci-status ref))) + (status + (cond + ((= 1 (length urls)) (car urls)) + (urls (magithub--completing-read + "Status service: " urls + #'magithub-ci--format-status))))) + (let-alist status + (when (or (null .target_url) (string= "" .target_url)) + (user-error "No Status URL detected")) + (browse-url .target_url)))))) + +(defun magithub-ci--format-status (status) + (let-alist status + (format "(%s) %s: %s" + (let ((spec (magithub-ci--status-spec .state))) + (alist-get 'display spec .state)) + .context + .description))) (defvar magit-magithub-ci-status-section-map (let ((map (make-sparse-keymap))) + (set-keymap-parent map magithub-map) (define-key map [remap magit-visit-thing] #'magithub-ci-visit) + (define-key map [remap magithub-browse-thing] #'magithub-ci-visit) (define-key map [remap magit-refresh] #'magithub-ci-refresh) map) "Keymap for `magithub-ci-status' header section.") @@ -255,41 +197,74 @@ Sets up magithub.ci.url if necessary." (defun magithub-ci-refresh () "Invalidate the CI cache and refresh the buffer." (interactive) - (magithub-cache-clear (magithub-repo-id) :ci-status) - (when (derived-mode-p 'magit-status-mode) - (magit-refresh))) + (unless (magithub-online-p) + (magithub-confirm 'ci-refresh-when-offline)) + (magithub-cache-without-cache :ci-status + (magithub-ci-status (magithub-ci-status--get-default-ref))) + (magit-refresh)) (defun magithub-insert-ci-status-header () - (let* ((checks (magithub-ci-status)) - (status (if (consp checks) (plist-get (car checks) :status) checks)) - (face (intern (format "magithub-ci-%s" - (symbol-name status)))) - (status-val (cdr (assq status magithub-ci-status-alist)))) - (magit-insert-section (magithub-ci-status) - (insert (format "%-10s" "CI: ")) - (insert (propertize - (cond - ((stringp status-val) status-val) - ((functionp status-val) (funcall status-val)) - (t (format "%S" status-val))) - 'face (if (facep face) face 'magithub-ci-unknown))) - (when (and (consp checks) (not (eq status 'success)) (< 1 (length checks))) - (let* ((successes (-filter (lambda (c) (eq (plist-get c :status) 'success)) - checks)) - (numsuccesses (length successes)) - (numchecks (length checks))) - (insert - (format " %d succeeded; %d did not; %s for details" - numsuccesses - (- numchecks numsuccesses) - (substitute-command-keys "\\[magit-visit-thing]"))))) - (insert ?\n)))) - -(magithub--deftoggle magithub-toggle-ci-status-header - magit-status-headers-hook #'magithub-maybe-insert-ci-status-header "the CI header") - -(when (executable-find magithub-hub-executable) - (magithub-toggle-ci-status-header)) + (let* ((ref (magithub-ci-status--get-default-ref)) + (checks (magithub-ci-status ref)) + (indent (make-string 10 ?\ ))) + (when checks + (magit-insert-section (magithub-ci-status + `(magithub-ci-ref . ,ref) + 'collapsed) + (magit-insert-heading + (format "%-10s%s %s %s%s" "Status:" + (magithub-ci--status-header checks) + (propertize "on ref" 'face 'magit-dimmed) + (propertize ref 'face 'magit-refname) + (propertize "..." 'face 'magit-dimmed))) + (magit-insert-section-body + (insert (propertize + (format "%-10sas of %s\n" "" + (if-let ((time (magithub-ci--status-last-refreshed-time (magithub-repo) ref))) + (magithub--format-time time) + "???")) + 'face 'magit-dimmed)) + (dolist (status (alist-get 'statuses checks)) + (magit-insert-section (magithub-ci-status + `(magithub-ci-url . ,(alist-get 'target_url status))) + (insert indent (magithub-ci--status-propertized status "*")) + (magit-insert-heading)))))))) + +(defun magithub-ci--status-header (checks) + (pcase (alist-get 'total_count checks) + (0 (format "%s %s" + (magithub-ci--status-propertized checks) + (or (alist-get 'magithub-message checks) + (propertize "it seems checks have not yet begun" + 'face 'magit-dimmed)))) + (1 (magithub-ci--status-propertized checks)) + (_ (let* ((overall-status (alist-get 'state checks)) + (status-spec (magithub-ci--status-spec overall-status)) + (display (or (alist-get 'display status-spec) overall-status)) + (statuses (alist-get 'statuses checks)) + (passed (-filter (lambda (s) (string= "success" (alist-get 'state s))) + statuses))) + (propertize (format "%s (%d/%d)" display (length passed) (length statuses)) + 'face (alist-get 'face status-spec)))))) + +(defun magithub-ci--status-spec (status-string) + (or (cdr (assoc-string status-string magithub-ci-status-alist)) + magithub-ci-status--unknown)) + +(defun magithub-ci--status-propertized (status &optional override-status-text) + (let ((status-string (alist-get 'state status)) + (description (alist-get 'description status)) + (context (alist-get 'context status))) + (let-alist (magithub-ci--status-spec status-string) + (concat (propertize (or override-status-text + .display + status-string) + 'face .face) + (when description + (format " %s" description)) + (when context + (propertize (format " %s" context) + 'face 'magit-dimmed)))))) (provide 'magithub-ci) ;;; magithub-ci.el ends here diff --git a/magithub-comment.el b/magithub-comment.el new file mode 100644 index 0000000..0de3a80 --- /dev/null +++ b/magithub-comment.el @@ -0,0 +1,261 @@ +;;; magithub-comment.el --- tools for comments -*- lexical-binding: t; -*- + +;; Copyright (C) 2017-2018 Sean Allred + +;; Author: Sean Allred +;; Keywords: lisp + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; Tools for working with issue comments. + +;;; Code: + +(require 'magit) +(require 'markdown-mode) +(require 'thingatpt) + +(require 'magithub-core) +(require 'magithub-repo) +(require 'magithub-issue) +(require 'magithub-edit-mode) + +(declare-function magithub-issue-view "magithub-issue-view.el" (issue)) + +(defvar magit-magithub-comment-section-map + (let ((m (make-sparse-keymap))) + (set-keymap-parent m magithub-map) + (define-key m [remap magithub-browse-thing] #'magithub-comment-browse) + (define-key m [remap magit-delete-thing] #'magithub-comment-delete) + (define-key m (kbd "SPC") #'magithub-comment-view) + (define-key m [remap magithub-reply-thing] #'magithub-comment-reply) + (define-key m [remap magithub-edit-thing] #'magithub-comment-edit) + m)) + +(defun magithub-comment-browse (comment) + (interactive (list (thing-at-point 'github-comment))) + (unless comment + (user-error "No comment found")) + (let-alist comment + (browse-url .html_url))) + +(declare-function face-remap-remove-relative "face-remap.el" (cookie)) +(defun magithub-comment-delete (comment) + (interactive (list (thing-at-point 'github-comment))) + (unless comment + (user-error "No comment found")) + (let ((repo (magithub-comment-source-repo comment)) + (author (let-alist comment .user.login)) + (me (let-alist (magithub-user-me) .login))) + (unless (or (string= author me) + (magithub-repo-admin-p repo)) + (user-error "You don't have permission to delete this comment")) + (let ((cookie (face-remap-add-relative 'magit-section-highlight + ;;'magit-diff-removed-highlight + ;;:strike-through t + ;;:background "red4" + ;; + 'magithub-deleted-thing + ))) + (unwind-protect (magithub-confirm 'comment-delete) + (face-remap-remove-relative cookie))) + (magithub-request + (ghubp-delete-repos-owner-repo-issues-comments-id repo comment)) + (magithub-cache-without-cache :issues + (magit-refresh-buffer)) + (message "Comment deleted"))) + +(defun magithub-comment-source-issue (comment) + (magithub-cache :comment + `(magithub-request + (ghubp-follow-get ,(alist-get 'issue_url comment))))) + +(defun magithub-comment-source-repo (comment) + (magithub-issue-repo (magithub-comment-source-issue comment))) + +(defun magithub-comment-insert (comment) + "Insert a single issue COMMENT." + (let-alist comment + (magit-insert-section (magithub-comment comment) + (magit-insert-heading (propertize .user.login 'face 'magithub-user)) + (save-excursion + (let ((created-at (magithub--format-time .created_at))) + (backward-char 1) + (insert (make-string (- (current-fill-column) + (current-column) + (length created-at)) + ? )) + (insert (propertize created-at 'face 'magit-dimmed)))) + (insert (magithub-fill-gfm (magithub-wash-gfm (s-trim .body))) + "\n\n")))) + +(defvar magithub-gfm-view-mode-map + (let ((m (make-sparse-keymap))) + (define-key m [remap kill-this-buffer] #'magithub-comment-view-close) + m) + "Keymap for `magithub-gfm-view-mode'.") + +(declare-function gfm-view-mode "ext:markdown-mode.el") +(define-derived-mode magithub-gfm-view-mode gfm-view-mode "M:GFM-View" + "Major mode for viewing GitHub markdown content.") + +(defvar-local magithub-comment-view--parent-buffer nil + "The 'parent' buffer of the current comment-view. +This variable is used to jump back to the issue that contained +the comment; see `magithub-comment-view' and +`magithub-comment-view-close'.") + +(defun magithub-comment-view (comment) + "View COMMENT in a new buffer." + (interactive (list (thing-at-point 'github-comment))) + (let ((prev (current-buffer))) + (with-current-buffer (get-buffer-create "*comment*") + (magithub-gfm-view-mode) + (setq-local magithub-comment-view--parent-buffer prev) + (let ((inhibit-read-only t)) + (erase-buffer) + (insert (magithub-wash-gfm (alist-get 'body comment)))) + (goto-char 0) + (magit-display-buffer (current-buffer))))) + +(defun magithub-comment-view-close () + "Close the current buffer." + (interactive) + (let ((oldbuf magithub-comment-view--parent-buffer)) + (kill-this-buffer) + (magit-display-buffer oldbuf))) + +;;;###autoload +(defun magithub-comment-new (issue &optional discard-draft initial-content) + "Comment on ISSUE in a new buffer. +If prefix argument DISCARD-DRAFT is specified, the draft will not +be considered. + +If INITIAL-CONTENT is specified, it will be inserted as the +initial contents of the reply if there is no draft." + (interactive (let ((issue (magithub-interactive-issue))) + (prog1 (list issue current-prefix-arg) + (unless (derived-mode-p 'magithub-issue-view-mode) + (magithub-issue-view issue))))) + (let* ((issueref (magithub-issue-reference issue)) + (repo (magithub-issue-repo issue))) + (with-current-buffer + (magithub-edit-new (concat "reply to " issueref) + :header (concat "replying to " issueref) + :submit #'magithub-issue-comment-submit + :content initial-content + :prompt-discard-draft discard-draft + :file (magithub-comment--draft-file issue repo)) + (setq-local magithub-issue issue) + (setq-local magithub-repo repo) + (magit-display-buffer (current-buffer))))) + +(defun magithub-comment--draft-file (issue repo) + "Get an appropriate draft file for ISSUE in REPO." + (let-alist issue + (expand-file-name (format "%s-comment" .number) + (magithub-repo-data-dir repo)))) + +(defun magithub-comment--submit-edit (comment repo new-body) + (interactive (list (thing-at-point 'github-comment) + (thing-at-point 'github-repository) + (buffer-string))) + (when (string= new-body "") + (user-error "Can't post an empty comment; try deleting it instead")) + (magithub-confirm 'comment-edit) + (magithub-request + (ghubp-patch-repos-owner-repo-issues-comments-id + repo comment + `((body . ,new-body))))) + +(defun magithub-comment-edit (comment issue repo) + "Edit COMMENT." + (interactive (list (thing-at-point 'github-comment) + (or (thing-at-point 'github-issue) + (thing-at-point 'github-pull-request)) + (thing-at-point 'github-repository))) + (let ((updated (magithub-request (ghubp-follow-get (alist-get 'url comment))))) + (with-current-buffer + (magithub-edit-new (format "*%s: editing comment by %s (%s)*" + (magithub-issue-reference issue) + (let-alist comment .user.login) + (alist-get 'id comment)) + :submit #'magithub-comment--submit-edit + :content (alist-get 'body updated) + :file (magithub-comment--draft-file issue repo)) + (setq-local magithub-issue issue) + (setq-local magithub-repo repo) + (setq-local magithub-comment updated) + (magit-display-buffer (current-buffer))) + + (unless (string= (alist-get 'body comment) + (alist-get 'body updated)) + (message "Comment has changed since information was cached; \ +updated content pulled in for edit")))) + +(defun magithub-comment-reply (comment &optional discard-draft issue) + "Reply to COMMENT on ISSUE. +If prefix argument DISCARD-DRAFT is provided, the current draft +will deleted. + +If ISSUE is not provided, it will be determined from context or +from COMMENT." + (interactive (list (thing-at-point 'github-comment) + current-prefix-arg + (thing-at-point 'github-issue))) + (let-alist comment + (magithub-comment-new + (or issue (magithub-request (ghubp-follow-get .issue_url))) + discard-draft + (let ((reply-body (if (use-region-p) + (buffer-substring (region-beginning) (region-end)) + .body))) + (with-temp-buffer + (insert (string-trim (magithub-wash-gfm reply-body))) + (markdown-blockquote-region (point-min) (point-max)) + (goto-char (point-max)) + (insert "\n\n") + (buffer-string)))))) + +(defun magithub-issue-comment-submit (issue comment &optional repo) + "On ISSUE, submit a new COMMENT. + +COMMENT is the text of the new comment. + +REPO is an optional repo object; it will be deduced from ISSUE if +not provided." + (interactive (list (thing-at-point 'github-issue) + (save-restriction + (widen) + (buffer-substring-no-properties (point-min) (point-max))) + (thing-at-point 'github-repository))) + (unless issue + (user-error "No issue provided")) + (setq repo (or repo + (magithub-issue-repo issue) + (thing-at-point 'github-repository))) + (unless repo + (user-error "No repo detected")) + ;; all required args provided + (magithub-confirm 'comment (magithub-issue-reference issue)) + (magithub-request + (ghubp-post-repos-owner-repo-issues-number-comments + repo issue `((body . ,comment)))) + (magithub-edit-delete-draft) + (message "Success")) + +(provide 'magithub-comment) +;;; magithub-comment.el ends here diff --git a/magithub-completion.el b/magithub-completion.el new file mode 100644 index 0000000..5ef8f7b --- /dev/null +++ b/magithub-completion.el @@ -0,0 +1,102 @@ +;;; magithub-completion.el --- Completion using info provided by magithub -*- lexical-binding: t; -*- + +;; Copyright (C) 2018 Steve Purcell + +;; Author: Steve Purcell +;; Keywords: convenience + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; Provides `completion-at-point' functions which complete issue +;; numbers etc when they are entered in commit messages. + +;; Extended information is attached to completions so that `company' +;; can access it via the standard `company-capf' backend. + +;;; Code: + + +(require 'magithub-settings) +(require 'magithub-issue) + + +;;;###autoload +(defun magithub-completion-complete-issues () + "A `completion-at-point' function which completes \"#123\" issue references. +Add this to `completion-at-point-functions' in buffers where you +want this to be available." + (when (magithub-enabled-p) + (when (looking-back "#\\([0-9]*\\)" (- (point) 10)) + (let ((start (match-beginning 1)) + (end (match-end 0)) + (prefix (match-string 1)) + completions) + (dolist (i (magithub--issue-list)) + (let-alist i + (let ((n (number-to-string .number))) + (when (string-prefix-p prefix n) + (push (propertize n :issue i) completions))))) + (list start end (sort completions #'string<) + :exclusive 'no + :company-docsig (lambda (c) + (let-alist (get-text-property 0 :issue c) + .title)) + :annotation-function (lambda (c) + (let-alist (get-text-property 0 :issue c) + .title)) + :company-doc-buffer (lambda (c) + (save-window-excursion + (magithub-issue-visit + (get-text-property 0 :issue c))))))))) + +;;;###autoload +(defun magithub-completion-complete-users () + "A `completion-at-point' function which completes \"@user\" user references. +Add this to `completion-at-point-functions' in buffers where you +want this to be available. The user list is currently simply the +list of all users who created issues or pull requests." + (when (magithub-enabled-p) + (when (looking-back "@\\([_-A-Za-z0-9]*\\)" (- (point) 30)) + (let ((start (match-beginning 1)) + (end (match-end 0)) + (prefix (match-string 1)) + completions) + (dolist (i (magithub--issue-list)) + (let-alist i + (when (string-prefix-p prefix .user.login) + (let ((candidate (copy-sequence .user.login)) + (association (and .author_association + (not (string= "NONE" .author_association)) + .author_association))) + (push (propertize candidate :user .user :association association) + completions))))) + (list start end (sort (cl-remove-duplicates completions :test #'string=) + #'string<) + :exclusive 'no + :company-docsig (lambda (c) (get-text-property 0 :association c)) + :annotation-function (lambda (c) (get-text-property 0 :association c))))))) + +;;;###autoload +(defun magithub-completion-enable () + "Enable completion of info from magithub in the current buffer." + (make-local-variable 'completion-at-point-functions) + (dolist (f '(magithub-completion-complete-issues + magithub-completion-complete-users)) + (add-to-list 'completion-at-point-functions f))) + + +(provide 'magithub-completion) +;;; magithub-completion.el ends here diff --git a/magithub-core.el b/magithub-core.el index 2198c6e..b07c2d9 100644 --- a/magithub-core.el +++ b/magithub-core.el @@ -1,6 +1,6 @@ ;;; magithub-core.el --- core functions for magithub -*- lexical-binding: t; -*- -;; Copyright (C) 2016 Sean Allred +;; Copyright (C) 2016-2018 Sean Allred ;; Author: Sean Allred ;; Keywords: tools @@ -20,115 +20,709 @@ ;;; Commentary: -;; +;; Core functions for Magithub. ;;; Code: (require 'magit) (require 'dash) (require 's) +(require 'subr-x) +(require 'ghub) +(require 'ghub+) +(require 'bug-reference) +(require 'cl-lib) +(require 'markdown-mode) +(require 'parse-time) +(require 'thingatpt) +(require 'recentf) -(defun magithub-github-repository-p () - "Non-nil if \"origin\" points to GitHub or a whitelisted domain." - (-when-let (origin (magit-get "remote" "origin" "url")) - (-some? (lambda (domain) (s-contains? domain origin)) - (cons "github.com" (magit-get-all "hub" "host"))))) +(require 'magithub-settings) +(require 'magithub-faces) -(defun magithub-repo-id () - "Returns an identifying value for this repository." - (magit-get "remote" "origin" "url")) +(defconst magithub-github-token-scopes '(repo user notifications) + "The authentication scopes Magithub requests.") -(defun magithub--api-available-p () - "Non-nil if the API is available." - (let ((magit-git-executable "ping") - (magit-pre-call-git-hook nil) - (magit-git-global-arguments nil)) - (= 0 (magit-git-exit-code "-c 1" "-n" "api.github.com")))) +;;; Debugging utilities -(defun magithub--completing-read-multiple (prompt collection) - "Using PROMPT, get a list of elements in COLLECTION. -This function continues until all candidates have been entered or -until the user enters a value of \"\". Duplicate entries are not -allowed." - (let (label-list this-label done) - (while (not done) - (setq collection (remove this-label collection) - this-label "") - (when collection - ;; @todo it would be nice to detect whether or not we are - ;; allowed to create labels -- if not, we can require-match - (setq this-label (completing-read prompt collection))) - (unless (setq done (s-blank? this-label)) - (push this-label label-list))) - label-list)) +(defvar magithub-debug-mode nil + "Controls what kinds of debugging information shows. +List of symbols. -(defconst magithub-hash-regexp - (rx bow (= 40 (| digit (any (?A . ?F) (?a . ?f)))) eow) - "Regexp for matching commit hashes.") +`dry-api' - don't actually make API requests +`forms' - show forms being evaluated in the cache") + +(defun magithub-debug-mode (&optional submode) + "True if debug mode is on. +If SUBMODE is supplied, specifically check for that mode in +`magithub-debug-mode'." + (and (listp magithub-debug-mode) + (memq submode magithub-debug-mode))) + +(defun magithub-message (fmt &rest args) + "Print a message." + (message "magithub: %s" (apply #'format fmt args))) + +(defun magithub-debug-message (fmt &rest args) + "Print a debug message. +Respects `magithub-debug-mode' and `debug-on-error'." + (when (or magithub-debug-mode debug-on-error) + (let ((print-quoted t)) + (message "magithub: (%s) %s" + (format-time-string "%M:%S.%3N" (current-time)) + (apply #'format fmt args))))) + +(defun magithub-debug--ghub-request-wrapper (oldfun &rest args) + "Report ghub requests as they're being made. +Intended as around-advice for `ghub-requst'." + (magithub-debug-message "ghub-request%S" args) + (unless (magithub-debug-mode 'dry-api) + (apply oldfun args))) -(defcustom magithub-hub-executable "hub" - "The hub executable used by Magithub." +(defun magithub-instrument () + "Instrument Magithub for debugging." + (interactive) + (advice-add #'ghub-request :around #'magithub-debug--ghub-request-wrapper)) + +(defcustom magithub-dir + (expand-file-name "magithub" user-emacs-directory) + "Data directory. +Various Magithub data (such as the cache) will be dumped into the +root of this directory. + +If it does not exist, it will be created." :group 'magithub - :package-version '(magithub . "0.1") - :type 'string) + :type 'directory) +(add-to-list 'recentf-exclude + (lambda (filename) + (file-in-directory-p filename magithub-dir))) -(defvar magithub-debug-mode nil - "When non-nil, echo hub commands before they're executed.") +;;; Turning Magithub on/off + +(defmacro magithub-in-data-dir (&rest forms) + "Execute forms in `magithub-dir'. +If `magithub-dir' does not yet exist, it and its parents will be +created automatically." + (declare (debug t)) + `(progn + (unless (file-directory-p magithub-dir) + (mkdir magithub-dir t)) + (let ((default-directory magithub-dir)) + ,@forms))) + +;;; Caching; Online/Offline mode + +(defcustom magithub-cache-file "cache" + "Use this file for Magithub's persistent cache." + :group 'magithub + :type 'file) + +(defun magithub-cache-read-from-disk () + "Returns the cache as read from `magithub-cache-file'." + (magithub-in-data-dir + (when (file-readable-p magithub-cache-file) + (with-temp-buffer + (insert-file-contents magithub-cache-file) + (read (current-buffer)))))) + +(defvar magithub-cache--cache + (or (ignore-errors + (magithub-cache-read-from-disk)) + (make-hash-table :test 'equal)) + "The actual cache. +Holds all information ever cached by Magithub. + +Occasionally written to `magithub-cache-file' by +`magithub-cache-write-to-disk'.") + +(defvar magithub-cache--needs-write nil + "Signals that the cache has been updated. +When non-nil, the cache will be written to disk next time the +idle timer runs.") + +(defvar magithub-cache--refreshed-forms nil + "Forms that have been refreshed this session. +See also `magithub--refresh'.") -(defvar magithub-hub-error nil - "When non-nil, this is a message for when hub fails.") +(cl-defun magithub-cache (class form &key message after-update) + "The cached value for FORM if available. -(defmacro magithub-with-hub (&rest body) - `(let ((magit-git-executable magithub-hub-executable) - (magit-pre-call-git-hook nil) - (magit-git-global-arguments nil)) +If FORM has not been cached or its CLASS dictates the cache has +expired, FORM will be re-evaluated. + +CLASS: The kind of data this is; see `magithub-cache--refresh'. + +MESSAGE may be specified for intensive functions. We'll display +this with `with-temp-message' while the form is evaluating. + +AFTER-UPDATE is a function to run after the cache is updated." + (declare (indent defun)) + (let* ((no-value-sym (cl-gensym)) + (entry (list (ghubp-get-context) class form)) + (online (magithub-online-p)) + (cached-value (gethash entry magithub-cache--cache no-value-sym)) + (value-does-not-exist (eq cached-value no-value-sym)) + (cached-value (if value-does-not-exist nil cached-value)) + make-request new-value) + + (when online + (if (or (eq magithub-cache--refresh t) + (eq magithub-cache--refresh class)) + ;; if we're refreshing (and we haven't seen this form + ;; before), go ahead and make the request if it's the class + ;; we're refreshing (or t, which encompasses all classes) + (setq make-request (not (member entry magithub-cache--refreshed-forms))) + (setq make-request value-does-not-exist))) + + (or (and make-request + (prog1 (setq new-value (with-temp-message message (eval form))) + (puthash entry new-value magithub-cache--cache) + (unless magithub-cache--needs-write + (setq magithub-cache--needs-write t) + (run-with-idle-timer 600 nil #'magithub-cache-write-to-disk)) + (when magithub-cache--refresh + (push entry magithub-cache--refreshed-forms)) + (if (functionp after-update) + (funcall after-update new-value) + new-value))) + cached-value))) + +(defun magithub-maybe-report-offline-mode () + "Conditionally inserts the OFFLINE header. +If this is a Magithub-enabled repository and we're offline, we +insert a header notifying the user that all data shown is cached. +To aid in determining if the cache should be refreshed, we report +the age of the oldest cached information." + (when (and (magithub-usable-p) + (not (magithub-online-p))) + (magit-insert-section (magithub nil t) + (insert + (format + "Magithub: %s; use %s to refresh GitHub content or %s to go back online%s\n" + (propertize "OFFLINE" 'face 'magit-head) + (propertize + (substitute-command-keys "\\[universal-argument] \\[magit-refresh]") + 'face 'magit-header-line-key) + (propertize + (substitute-command-keys "\\[magithub-dispatch-popup] C o") + 'face 'magit-header-line-key) + (propertize "..." 'face 'magit-dimmed))) + (magit-insert-heading) + (let* ((msg "When Magithub is offline, no API requests are ever made \ +automatically. Even when online, cached API responses never expire, so \ +they must be updated manually with %s.") + (msg (s-word-wrap (- fill-column 10) msg)) + (msg (format msg (propertize + (substitute-command-keys + "\\[universal-argument] \\[magit-refresh]") + 'face 'magit-header-line-key)))) + (insert (format "%s\n" (replace-regexp-in-string + (rx bol) (make-string 10 ?\ ) msg))))))) + +(eval-after-load 'magit + '(add-hook 'magit-status-headers-hook + #'magithub-maybe-report-offline-mode + 'append)) + +(defun magithub-cache--time-out (time) + "Convert TIME into a human-readable string. +Returns \"Xd Xh Xm Xs\" (counting from zero)" + (let ((seconds (time-to-seconds time))) + (format-time-string + (cond + ((< seconds 60) "%-Ss") + ((< seconds 3600) "%-Mm %-Ss") + ((< seconds 86400) "%-Hh %-Mm %-Ss") + (t "%-jd %-Hh %-Mm %-Ss")) + time))) + +(defun magithub-cache-write-to-disk () + "Write the cache to disk. +The cache is written to `magithub-cache-file' in +`magithub-dir'" + (if (active-minibuffer-window) + (run-with-idle-timer 600 nil #'magithub-cache-write-to-disk) ;defer + (when magithub-cache--needs-write + (magithub-in-data-dir + (with-temp-buffer + (let ((require-final-newline nil)) + (insert (prin1-to-string magithub-cache--cache)) + (write-file magithub-cache-file)))) + (setq magithub-cache--needs-write nil) + (magithub-debug-message "wrote cache to disk: %S" + (expand-file-name magithub-cache-file + magithub-dir))))) + +(defmacro magithub-cache-without-cache (class &rest body) + "For CLASS, execute BODY without using CLASS's caches. +Use t to ignore previously cached values completely. +See also `magithub-cache--refresh'." + (declare (indent 1) (debug t)) + `(let ((magithub-cache--refresh ,class)) ,@body)) -(defun magithub--hub-command (magit-function command args) - (unless (executable-find magithub-hub-executable) - (user-error "Hub (hub.github.com) not installed; aborting")) - (unless (file-exists-p "~/.config/hub") - (user-error "Hub hasn't been initialized yet; aborting")) - (when magithub-debug-mode - (message "Calling hub with args: %S %S" command args)) - (with-timeout (5 (error "Took too long! %s%S" command args)) - (magithub-with-hub (funcall magit-function command args)))) - -(defun magithub--git-raw-output (&rest args) - "Execute Git with ARGS, returning its output as string. -Adapted from `magit-git-lines'." - (with-temp-buffer - (apply #'magit-git-insert args) - (buffer-string))) - -(defun magithub--command (command &optional args) - "Run COMMAND synchronously using `magithub-hub-executable'." - (magithub--hub-command #'magit-run-git command args)) - -(defun magithub--command-with-editor (command &optional args) - "Run COMMAND asynchronously using `magithub-hub-executable'. -Ensure GIT_EDITOR is set up appropriately." - (magithub--hub-command #'magit-run-git-with-editor command args)) - -(defun magithub--command-output (command &optional args raw) - "Run COMMAND synchronously using `magithub-hub-executable'. -If not RAW, return output as a list of lines." - (magithub--hub-command (if raw #'magithub--git-raw-output #'magit-git-lines) command args)) - -(defun magithub--command-quick (command &optional args) - "Quickly execute COMMAND with ARGS." - (ignore (magithub--command-output command args))) - -(defun magithub-hub-version () - "Return the `hub' version as a string." - (-> "--version" - magithub--command-output cadr - split-string cddr car - (split-string "-") car)) - -(defun magithub-hub-version-at-least (version-string) - "Return t if `hub's version is at least VERSION-STRING." - (version<= version-string (magithub-hub-version))) +(add-hook 'kill-emacs-hook + #'magithub-cache-write-to-disk) + +;;; API availability checking + +(define-error 'magithub-error "Magithub Error") +(define-error 'magithub-api-timeout "Magithub API Timeout" 'magithub-error) + +(defvar magithub--api-last-checked + ;; see https://travis-ci.org/vermiculus/magithub/jobs/259006323 + ;; (eval-when-compile (date-to-time "1/1/1970")) + '(14445 17280) + "The last time the API was available. +Used to avoid pinging GitHub multiple times a second.") + +(defcustom magithub-api-timeout 3 + "Number of seconds we'll wait for the API to respond." + :group 'magithub + :type 'integer) + +(defcustom magithub-api-low-threshold 15 + "Low threshold for API requests. +This variable is not currently respected; see tarsius/ghub#16. + +If the number of available API requests drops to or below this +threshold, you'll be asked if you'd like to go offline." + :group 'magithub + :type 'integer) + +(defcustom magithub-api-available-check-frequency 10 + "Minimum number of seconds between each API availability check. +While online (see `magithub-go-online'), we check to ensure the +API is available before making a real request. This involves a +`/rate_limit' call (or for some Enterprise instances, a `/meta' +call). Use this setting to configure how often this is done. It +will be done no more frequently than other API actions. + +These calls are guaranteed to not count against your rate limit." + :group 'magithub + :type 'integer) + +(defvar magithub--quick-abort-api-check nil + "When non-nil, we'll assume the API is unavailable. +Do not modify this variable in code outside Magithub.") + +(defvar magithub--api-offline-reason nil + "The reason we're going offline. +Could be one of several strings: + + * authentication issue + + * response timeout + + * generic error + +and possibly others as error handlers are added to +`magithub--api-available-p'.") + +(defun magithub--api-available-p () + "Non-nil if the API is available. +Pings the API a maximum of once every ten seconds." + (setq magithub--api-offline-reason nil) + (when (magithub-enabled-p) + (magithub-debug-message "checking if the API is available") + (prog1 (when + (progn + (magithub-debug-message "making sure authinfo is unlocked") + (ghubp-token 'magithub)) + (if (and magithub--api-last-checked + (< (time-to-seconds (time-since magithub--api-last-checked)) + magithub-api-available-check-frequency)) + (prog1 magithub--api-last-checked + (magithub-debug-message "used cached value for api-last-checked")) + + (magithub-debug-message "cache expired; retrieving new value for api-last-checked") + (setq magithub--api-last-checked (current-time)) + + (let (api-status error-data response) + (condition-case err + (progn + (with-timeout (magithub-api-timeout + (signal 'magithub-api-timeout nil)) + (setq response + ;; /rate_limit is free for GitHub.com. + ;; If rate limiting is disabled + ;; (i.e. GHE), try using /meta which + ;; should (hopefully) always work. See + ;; also issue #107. + (magithub-request + (or (ghubp-ratelimit) + (ghubp-request 'get "/meta" nil nil))) + + api-status (and response t))) + + (magithub-debug-message + "new value retrieved for api-last-available: %S" response)) + + ;; Sometimes, the API can take a long time to respond + ;; (whether that's GitHub not responding or requests being + ;; blocked by some client-side firewall). Handle this + ;; possibility gracefully. + (magithub-api-timeout + (setq error-data err + magithub--api-offline-reason + (concat "API is not responding quickly; " + "consider customizing `magithub-api-timeout' " + "if this happens often"))) + + ;; Never hurts to be cautious :-) + (error + (setq error-data err) + (setq magithub--api-offline-reason + (format "unknown issue: %S" err)))) + + (when error-data + (magithub-debug-message + "consider reporting unknown error while checking api-available: %S" + error-data)) + + api-status))) + (when magithub--api-offline-reason + (magit-set "false" "magithub.online") + (run-with-idle-timer 2 nil #'magithub--api-offline-reason))))) + +(defun magithub--api-offline-reason () + "Report the reason we're going offline and go offline. +Refresh the status buffer if necessary. + +See `magithub--api-offline-reason'." + (when magithub--api-offline-reason + (message "Magithub is now offline: %s" + magithub--api-offline-reason) + (setq magithub--api-offline-reason nil))) + +;;; Repository parsing + +(defcustom magithub-github-hosts + (list "github.com") + "A list of top-level domains that should be recognized as GitHub hosts. +See also `magithub-github-repository-p'." + :group 'magithub + :type '(repeat string)) + +(defun magithub-github-repository-p () + "Non-nil if \"origin\" points to GitHub or a whitelisted domain. +See also `magithub-github-hosts'." + (when-let ((origin (magit-get "remote" (magithub-settings-context-remote) "url"))) + (-some? (lambda (domain) (s-contains? domain origin)) + magithub-github-hosts))) + +(defalias 'magithub--parse-url 'magithub--repo-parse-url) +(make-obsolete 'magithub--parse-url 'magithub--repo-parse-url "0.1.4") +(defun magithub--repo-parse-url (url) + "Parse URL into its components. +URL may be of several different formats: + +- git@github.com:vermiculus/magithub.git +- https://github.com/vermiculus/magithub" + (and url + (or (and (string-match + ;; git@github.com:vermiculus/magithub.git + (rx bol + (group (+? any)) ;sshuser -- git + "@" + (group (+? any)) ;domain -- github.com + ":" + (group (+? (| alnum "-" "." "_"))) ;owner.login -- vermiculus + "/" + (group (+? (| alnum "-" "." "_"))) ;name -- magithub + (? ".git") + eol) + url) + `((kind . 'ssh) + (ssh-user . ,(match-string 1 url)) + (domain . ,(match-string 2 url)) + (sparse-repo (owner (login . ,(match-string 3 url))) + (name . ,(match-string 4 url))))) + (and (string-match + ;; https://github.com/vermiculus/magithub.git + ;; git://github.com/vermiculus/magithub.git + ;; ssh://git@github.com/vermiculus/magithub + ;; git+ssh://github.com/vermiculus/magithub.git + (rx bol + (or (seq "http" (? "s")) + (seq "ssh") + (seq "git" (? "+ssh"))) + "://" + (group (+? any)) ;domain -- github.com + "/" + (group (+? (| alnum "-" "." "_"))) ;owner.login -- vermiculus + "/" + (group (+? (| alnum "-" "." "_"))) ;name -- magithub + (? ".git") + eol) + url) + `((kind . 'http) + (domain . ,(match-string 1 url)) + (sparse-repo (owner (login . ,(match-string 2 url))) + (name . ,(match-string 3 url)))))))) + +(defun magithub--url->repo (url) + "Tries to parse a remote url into a GitHub repository object" + (cdr (assq 'sparse-repo (magithub--repo-parse-url url)))) + +(defun magithub-source--sparse-repo () + "Returns the sparse repository object for the current context. + +Only information that can be determined without API calls will be +included in the returned object." + (magithub-repo-from-remote--sparse + (magithub-settings-context-remote))) + +(defun magithub-repo-from-remote (remote) + (when-let ((repo (magithub-repo-from-remote--sparse remote))) + (magithub-repo repo))) + +(defun magithub-repo-from-remote--sparse (remote) + (magithub--url->repo (magit-get "remote" remote "url"))) + +(defalias 'magithub-source-repo 'magithub-repo) +(make-obsolete 'magithub-source-repo 'magithub-repo "0.1.4") +(defun magithub-repo (&optional sparse-repo) + "Turn SPARSE-REPO into a full repository object. +If SPARSE-REPO is null, the current context is used. + +SPARSE-REPO may either be a partial repository object (with at +least the `.owner.login' and `.name' keys) or a string identifier +of the form `owner/name' (as in `vermiculus/magithub')." + (if (and (stringp sparse-repo) + (string-match (rx bos + (group (+? (| alnum "-" "." "_"))) ;owner.login -- vermiculus + "/" + (group (+? (| alnum "-" "." "_"))) ;name -- magithub + eos) + sparse-repo)) + (magithub-repo `((owner (login . ,(match-string 1 sparse-repo))) + (name . ,(match-string 2 sparse-repo)))) + (when-let ((sparse-repo (or sparse-repo (magithub-source--sparse-repo)))) + (or (magithub-cache :repo-demographics + `(or (magithub-request + (ghubp-get-repos-owner-repo ',sparse-repo)) + (and (not (magithub--api-available-p)) + sparse-repo))) + (when (magithub-online-p) + (let ((magithub-cache--refresh t)) + (magithub-repo sparse-repo))) + sparse-repo)))) + +;;; Repository utilities + +(defvar magit-magithub-repo-section-map + (let ((m (make-sparse-keymap))) + (define-key m [remap magit-visit-thing] #'magithub-repo-visit) + m)) + +(defun magithub-repo-visit (repo) + "Visit REPO on GitHub." + (interactive (list (thing-at-point 'github-repository))) + (if-let ((url (alist-get 'html_url repo))) + (browse-url url) + (user-error "No URL for repo"))) + +(defun magithub-repo-visit-issues (repo) + "Visit REPO's issues on GitHub." + (interactive (list (thing-at-point 'github-repository))) + (if-let ((url (alist-get 'html_url repo))) + (browse-url (format "%s/issues" url)) + (user-error "No URL for repo"))) + +(defun magithub-repo-name (repo) + "Return the full name of REPO. +If the `full_name' object is present, use that. Otherwise, +concatenate `.owner.login' and `.name' with `/'." + (let-alist repo (or .full_name (concat .owner.login "/" .name)))) + +(defun magithub-repo-admin-p (&optional repo) + "Non-nil if the currently-authenticated user can manage REPO. +REPO defaults to the current repository." + (let-alist (magithub-repo (or repo (thing-at-point 'github-repository))) + .permissions.admin)) + +(defun magithub-repo-push-p (&optional repo) + "Non-nil if the currently-authenticated user can manage REPO. +REPO defaults to the current repository." + (let-alist (magithub-repo (or repo (thing-at-point 'github-repository))) + .permissions.push)) + +(defun magithub--repo-simplify (repo) + "Convert full repository object REPO to a sparse repository object." + (let (login name) + ;; There are syntax problems with things like `,.owner.login' + (let-alist repo + (setq login .owner.login + name .name)) + `((owner (login . ,login)) + (name . ,name)))) + +(defun magithub-repo-remotes () + "Return GitHub repositories in this repository. +`magit-list-remotes' is filtered to those remotes that point to +GitHub repositories." + (delq nil (mapcar (lambda (r) + (when-let ((repo (magithub-repo-from-remote r))) + (cons r repo))) + (magit-list-remotes)))) + +(defun magithub-read-repo (prompt &optional default-input skip-prompt-for-sole-remote) + "Using PROMPT, read a GitHub repository. +See also `magithub-repo-remotes'. +If there's only one remote available, optionally return it without prompting." + (let* ((remotes (magithub-repo-remotes)) + (maxlen (->> remotes + (mapcar #'car) + (mapcar #'length) + (apply #'max))) + (fmt (format "%%-%ds (%%s/%%s)" maxlen))) + (if (and skip-prompt-for-sole-remote (= (length remotes) 1)) + (car remotes) + (magithub-repo + (cdr (magithub--completing-read + prompt (magithub-repo-remotes) + (lambda (remote-repo-pair) + (let-alist (cdr remote-repo-pair) + (format fmt (car remote-repo-pair) .owner.login .name))) + nil nil nil default-input)))))) + +(defun magithub-repo-remotes-for-repo (repo) + (-filter (lambda (remote) + (let-alist (list (cons 'repo repo) + (cons 'remote (magithub-repo-from-remote remote))) + (and (string= .repo.owner.login + .remote.owner.login) + (string= .repo.name .remote.name)))) + (magit-list-remotes))) + +;;; Feature checking + +(declare-function magithub-pull-request-merge "magithub-issue-tricks" + (pull-request &optional args)) +(declare-function magithub-maybe-insert-ci-status-header "magithub-ci" ()) +(declare-function magithub-issue--insert-pr-section "magithub-issue" ()) +(declare-function magithub-issue--insert-issue-section "magithub-issue" ()) +(declare-function magithub-completion-enable "magithub-completion" ()) +(defconst magithub-feature-list + ;; features must only return nil if they fail to install + `((pull-request-merge . ,(lambda () + (require 'transient nil t) + (when (functionp 'magit-am) + (transient-append-suffix 'magit-am "a" + '("P" "Apply patches from pull request" magithub-pull-request-merge)) + t))) + + (commit-browse . ,(lambda () + (define-key magit-commit-section-map "w" + #'magithub-commit-browse) + t)) + + (status-checks-header . ,(lambda () + (add-hook 'magit-status-headers-hook + #'magithub-maybe-insert-ci-status-header + t) + t)) + + (completion . ,(lambda () + (dolist (hook '(git-commit-setup-hook magithub-edit-mode-hook)) + (add-hook hook #'magithub-completion-enable)) + t)) + + ;; order is important in this list; pull request section should + ;; come before issues section by default + (pull-requests-section . ,(lambda () + (add-hook 'magit-status-sections-hook + #'magithub-issue--insert-pr-section + t) + t)) + + (issues-section . ,(lambda () + (add-hook 'magit-status-sections-hook + #'magithub-issue--insert-issue-section + t) + t))) + "All Magit-integration features of Magithub. +See `magithub-feature-autoinject'. + +- `pull-request-merge' + Apply patches from pull requests. + (`magithub-pull-request-merge' inserted into `magit-am-popup') + +- `commit-browse' + Browse commits using \\\\[magithub-browse-thing]. + +- `completion' + Enable `completion-at-point' support for #issue and @user references + where possible. + +- `issues-section' + View issues in the `magit-status' buffer. + +- `pull-requests-section' + View pull requests in the `magit-status' buffer. + +- `status-checks-header' + View project status in the `magit-status' buffer (e.g., CI).") + +(defvar magithub-features nil + "An alist of feature-symbols to Booleans. +When a feature symbol maps to non-nil, that feature is considered +'loaded'. Thus, to disable all messages, prepend '(t . t) to +this list. + +Example: + + ((pull-request-merge . t) (other-feature . nil)) + +signals that `pull-request-merge' is a loaded feature and +`other-feature' has not been loaded and will not be loaded. + +See `magithub-feature-list'.") + +;;;###autoload +(defun magithub-feature-autoinject (feature) + "Configure FEATURE to recommended settings. +If FEATURE is `all' or t, all known features will be loaded. If +FEATURE is a list, then it is a list of FEATURE symbols to load. + +See `magithub-feature-list' for a list of available features and +`magithub-features' for a list of currently-installed features." + (cond + ((memq feature '(t all)) + (mapc #'magithub-feature-autoinject + (mapcar #'car magithub-feature-list))) + ((listp feature) + (mapc #'magithub-feature-autoinject feature)) + (t + (if-let ((install (cdr (assq feature magithub-feature-list)))) + (if (functionp install) + (if-let ((result (funcall install))) + (add-to-list 'magithub-features (cons feature t)) + (error "feature %S failed to install: %S" feature result)) + (error "install form for %S not a function: %S" feature install)) + (user-error "unknown feature %S" feature))))) + +(defun magithub-feature-check (feature) + "Check if a Magithub FEATURE has been configured. +See `magithub-features'." + (if (listp magithub-features) + (let* ((p (assq feature magithub-features))) + (if (consp p) (cdr p) + (cdr (assq t magithub-features)))) + magithub-features)) + +(defun magithub-feature-maybe-idle-notify (&rest feature-list) + "Notify user if any of FEATURES are not yet configured." + (unless (-all? #'magithub-feature-check feature-list) + (let ((m "Magithub features not configured: %S") + (s "see variable `magithub-features' to turn off this message")) + (run-with-idle-timer + 1 nil (lambda () + (message (concat m "; " s) feature-list) + (add-to-list 'feature-list '(t . t) t)))))) + +;;; Getting help (defun magithub--meta-new-issue () "Open a new Magithub issue. @@ -141,42 +735,23 @@ See /.github/ISSUE_TEMPLATE.md in this repository." (interactive) (browse-url "https://gitter.im/vermiculus/magithub")) -(defun magithub-enable () - "Enable Magithub for this repository." - (interactive) - (magit-set "yes" "magithub" "enabled") - (when (derived-mode-p 'magit-status-mode) - (magit-refresh))) +(defun magithub-error (err-message &optional tag trace) + "Report a Magithub error. -(defun magithub-disable () - "Disable Magithub for this repository." - (interactive) - (magit-set "no" "magithub" "enabled") - (when (derived-mode-p 'magit-status-mode) - (magit-refresh))) - -(defun magithub-enabled-p () - "Returns non-nil when Magithub is enabled for this repository." - (when (member (magit-get "magithub" "enabled") '("yes" nil)) t)) - -(defun magithub-enabled-toggle () - "Toggle Magithub" - (interactive) - (if (magithub-enabled-p) - (magithub-disable) - (magithub-enable))) +ERR-MESSAGE is a string to be shown to the user. -(defun magithub-usable-p () - "Non-nil if Magithub should do its thing." - (and (executable-find magithub-hub-executable) - (magithub-enabled-p) - (magithub-github-repository-p) - (magithub--api-available-p))) +TAG, if provided, is a user-friendly description of the error. +It defaults to ERR-MESSAGE. -(defun magithub-error (err-message tag &optional trace) - "Report a Magithub error." - (setq trace (or trace (with-output-to-string (backtrace)))) - (when (y-or-n-p (concat tag " Report? (A bug report will be placed in your clipboard.)")) +If TRACE is provided, it should be an appropriate backtrace to +describe the error. If not provided, it is retrieved." + (unless (stringp err-message) + ;; just in case. it'd be embarassing if the bug-reporter was + ;; perceived as buggy + (setq err-message (prin1-to-string err-message))) + (setq trace (or trace (with-output-to-string (backtrace))) + tag (or tag err-message)) + (when (magithub-confirm-no-error 'report-error tag) (with-current-buffer-window (get-buffer-create "*magithub issue*") #'display-buffer-pop-up-window nil @@ -186,6 +761,8 @@ See /.github/ISSUE_TEMPLATE.md in this repository." (format "## Automated error report +%s + ### Description %s @@ -195,32 +772,97 @@ See /.github/ISSUE_TEMPLATE.md in this repository." ``` %s``` " + err-message (read-string "Briefly describe what you were doing: ") trace)))) (magithub--meta-new-issue)) (error err-message)) -(defmacro magithub--deftoggle (name hook func s) - "Define a section-toggle command." - (declare (indent defun)) - `(defun ,name () - ,(concat "Toggle the " s " section.") - (interactive) - (if (memq ,func ,hook) - (remove-hook ',hook ,func) - (if (executable-find magithub-hub-executable) - (add-hook ',hook ,func t) - (message ,(concat "`hub' isn't installed, so I can't insert " s)))) - (when (derived-mode-p 'magit-status-mode) - (magit-refresh)) - (memq ,func ,hook))) +;;; Miscellaneous utilities + +(defcustom magithub-datetime-format "%c" + "The display format string for date-time values. +See also `format-time-string'." + :group 'magithub + :type 'string) + +(defun magithub--parse-time-string (iso8601) + "Parse ISO8601 into a time value. +ISO8601 is expected to not have a TZ component. + +We first use a crude parsing and if it fails we fall back to a more +general purpose function. This is done to speed up parsing time." + (if (string-match "^\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)T\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)Z$" iso8601) + (encode-time + (string-to-number (match-string 6 iso8601)) + (string-to-number (match-string 5 iso8601)) + (string-to-number (match-string 4 iso8601)) + (string-to-number (match-string 3 iso8601)) + (string-to-number (match-string 2 iso8601)) + (string-to-number (match-string 1 iso8601)) + t) + (parse-iso8601-time-string (concat iso8601 "+00:00")))) + +(defun magithub--format-time (time) + "Format TIME according to `magithub-datetime-format'. +TIME may be a time value or a string. + +Eventually, TIME will always be a time value." + ;; todo: ghub+ needs to convert time values for defined response fields + (format-time-string + magithub-datetime-format + (or (and (stringp time) + (magithub--parse-time-string time)) + time))) + +(defun magithub--completing-read + (prompt collection &optional format-function predicate require-match default initial-input) + "Using PROMPT, get a list of elements in COLLECTION. +This function continues until all candidates have been entered or +until the user enters a value of \"\". Duplicate entries are not +allowed." + (let* ((format-function (or format-function (lambda (o) (format "%S" o)))) + (collection (if (functionp predicate) (-filter predicate collection) collection)) + (collection (magithub--zip collection format-function nil))) + (cdr (assoc-string + (completing-read prompt collection nil require-match + (or initial-input + (and default + (funcall format-function default)))) + collection)))) + +(defun magithub--completing-read-multiple + (prompt collection &optional format-function predicate require-match default) + "Using PROMPT, get a list of elements in COLLECTION. +This function continues until all candidates have been entered or +until the user enters a value of \"\". Duplicate entries are not +allowed." + (let ((this t) (coll (copy-tree collection)) ret) + (while (and collection this) + (setq this (magithub--completing-read + prompt coll format-function + predicate require-match default)) + (when this + (push this ret) + (setq coll (delete this coll)))) + ret)) + +(defconst magithub-hash-regexp + (rx bow (= 40 (| digit (any (?A . ?F) (?a . ?f)))) eow) + "Regexp for matching commit hashes.") + +(defun magithub-usable-p () + "Non-nil if Magithub should do its thing." + (and (magithub-enabled-p) + (magithub-github-repository-p) + (magithub-source--sparse-repo))) (defun magithub--zip-case (p e) "Get an appropriate value for element E given property/function P." (cond - ((symbolp p) (plist-get e p)) - ((functionp p) (funcall p e)) ((null p) e) + ((functionp p) (funcall p e)) + ((symbolp p) (plist-get e p)) (t nil))) (defun magithub--zip (object-list prop1 prop2) @@ -243,5 +885,396 @@ If a prop is nil, the entire element is used." (if prop2 p2 e2))))) object-list object-list))) +(defun magithub--satisfies-p (preds obj) + "Non-nil when all functions in PREDS are non-nil for OBJ." + (while (and (listp preds) + (functionp (car preds)) + (funcall (car preds) obj)) + (setq preds (cdr preds))) + (null preds)) + +(defun magithub-section-type (section) + "If SECTION is a magithub-type section, return the type. +For example, if + + (eq (magit-section-type SECTION) \\='magithub-issue) + +return the interned symbol `issue'." + (let* ((type (oref section type)) + (name (symbol-name type))) + (and (string-prefix-p "magithub-" name) + (intern (substring name 9))))) + +(defvar magithub--section-value-at-point-specializations + '((user assignee)) + "Alist of general types to specific types. +Specific types offer more relevant functionality to a given +section, but are inconvenient for +`magithub--section-value-at-point'. This alist defines +equivalencies such that a search for the general type will also +return sections of a specialized type.") + +(define-obsolete-function-alias + 'magithub-thing-at-point + #'magithub--section-value-at-point + "0.1.5") + +;;;###autoload +(defun magithub--section-value-at-point (type) + "Determine the thing of TYPE at point. +This is intended for use as a resolving function for +`thing-at-point'. + +The following symbols are defined, but other values may work with +this function: `github-user', `github-issue', `github-label', +`github-comment', `github-repository', `github-pull-request', +`github-notification'," + (let ((search-sym (intern (concat "magithub-" (symbol-name type)))) + this-section) + (if (and (boundp search-sym) (symbol-value search-sym)) + (symbol-value search-sym) + (setq this-section (magit-current-section)) + (while (and this-section + (not (let ((this-type (magithub-section-type this-section))) + (or + ;; exact match + (eq type this-type) + ;; equivalency + (thread-last magithub--section-value-at-point-specializations + (alist-get type) + (memq this-type)))))) + (setq this-section (oref this-section parent))) + (and this-section (oref this-section value))))) + +(defvar-local magithub-issue nil + "Issue object.") + +(defvar-local magithub-comment nil + "Comment object.") + +(defvar-local magithub-repo nil + "Repository object.") + +;;;###autoload +(put 'github-user 'thing-at-point + (lambda () + (magithub--section-value-at-point 'user))) + +;;;###autoload +(put 'github-issue 'thing-at-point + (lambda () + (or magithub-issue + (magithub--section-value-at-point 'issue)))) + +;;;###autoload +(put 'github-label 'thing-at-point + (lambda () + (magithub--section-value-at-point 'label))) + +;;;###autoload +(put 'github-comment 'thing-at-point + (lambda () + (or magithub-comment + (magithub--section-value-at-point 'comment)))) + +;;;###autoload +(put 'github-notification 'thing-at-point + (lambda () + (magithub--section-value-at-point 'notification))) + +;;;###autoload +(put 'github-repository 'thing-at-point + (lambda () + (or (magithub--section-value-at-point 'repository) + magithub-repo + (magithub-repo)))) + +;;;###autoload +(put 'github-pull-request 'thing-at-point + (lambda () + (or (magithub--section-value-at-point 'pull-request) + (when-let ((issue (thing-at-point 'github-issue))) + (and + (magithub-issue--issue-is-pull-p issue) + (magithub-cache :issues + `(magithub-request + (ghubp-get-repos-owner-repo-pulls-number + ',(magithub-issue-repo issue) + ',issue)))))))) + +(defun magithub-verify-manage-labels (&optional interactive) + "Verify the user has permission to manage labels. +If the authenticated user does not have permission, an error will +be signaled. + +If INTERACTIVE is non-nil, a `user-error' will be raised instead +of a signal (e.g., for interactive forms)." + (let-alist (thing-at-point 'github-repository) + (if .permissions.push t + (if interactive + (user-error "You're not allowed to manage labels in %s" .full_name) + (signal 'error `(unauthorized manage-labels ,(progn .full_name))))))) + +(defun magithub-bug-reference-mode-on () + "In GitHub repositories, configure `bug-reference-mode'." + (interactive) + (when (magithub-usable-p) + (when-let ((repo (magithub-repo))) + (bug-reference-mode 1) + (setq-local bug-reference-bug-regexp "#\\(?2:[0-9]+\\)") + (setq-local bug-reference-url-format + (format "%s/issues/%%s" (alist-get 'html_url repo)))))) + +(defun magithub-filter-all (funcs list) + "Return LIST without elements that fail any element of FUNCS." + (dolist (f funcs) + (setq list (cl-remove-if-not f list))) + list) + +(defcustom magithub-preferred-remote-method 'ssh_url + "Preferred method when cloning or adding remotes. +One of the following: + + `clone_url' (https://github.com/octocat/Hello-World.git) + `git_url' (git://github.com/octocat/Hello-World.git) + `ssh_url' (git@github.com:octocat/Hello-World.git)" + :group 'magithub + :type '(choice + (const :tag "https" clone_url) + (const :tag "git" git_url) + (const :tag "ssh" ssh_url))) + +(defun magithub-repo--clone-url (repo) + "Get the preferred cloning URL from REPO." + (alist-get magithub-preferred-remote-method repo)) + +(defun magithub--wait-for-git (proc &optional seconds) + "Wait for git process PROC, polling every SECONDS seconds." + (let ((seconds (or seconds 0.5))) + (while (process-live-p proc) + (sit-for seconds)))) + +(defmacro magithub--run-git-synchronously (&rest body) + (declare (debug t)) + (let ((valsym (cl-gensym)) final-form) + (while body + (let ((form (pop body))) + (push `(let ((,valsym ,form)) + (if (processp ,valsym) + (magithub--wait-for-git ,valsym) + ,valsym)) + final-form))) + `(progn + ,@(nreverse final-form)))) + +(defun magithub-core-bucket (collection key-func &optional value-func) + "Bucket COLLECTION by ENTRY-FUNC and VALUE-FUNC. + +Each element of COLLECTION is passed through KEY-FUNC to +determine its key in an alist. If specified, the value is +determined by VALUE-FUNC. + +Returns an alist of these keys to lists of values. + +See also `magithub-fnnor-each-bucket'." + (unless value-func + (setq value-func #'identity)) + (let (bucketed) + (dolist (item collection) + (let ((entry (funcall key-func item)) + (val (funcall value-func item))) + (if-let (bucket (assoc entry bucketed)) + (push val (cdr bucket)) + (push (cons entry (list val)) + bucketed)))) + bucketed)) + +(defmacro magithub-core-bucket-multi (collection &rest buckets) + "Chain calls to `magithub-core-bucket'." + (declare (indent 1)) + (let* ((fnelsym (cl-gensym)) + (apply-to fnelsym) + form) + (while buckets + (setq form `(magithub-core-bucket + ,(or form collection) + (lambda (,fnelsym) (funcall ,(pop buckets) ,apply-to))) + apply-to `(car ,apply-to))) + form)) + +(defmacro magithub-for-each-bucket (buckets key values &rest body) + "Do things for each bucket in BUCKETS. + +For each bucket in BUCKETs, bind the key to KEY and its +contents (a list) to VALUES and execute BODY. + +See also `magithub-core-bucket'." + (declare (indent 3) (debug t)) + (let ((buckets-sym (cl-gensym))) + `(let ((,buckets-sym ,buckets)) + (while ,buckets-sym + (-let (((,key . ,values) (pop ,buckets-sym))) + ,@body))))) + +(defmacro magithub-defsort (symbol compare doc accessor) + "Define SYMBOL to be a sort over two objects. +COMPARE is used on the application of ACCESSOR to each argument." + (declare (doc-string 3) (indent 2)) + `(defun ,symbol (a b) ,doc (,(eval compare) + (funcall ,accessor a) + (funcall ,accessor b)))) + +(defun magithub-core-color-completing-read (prompt) + "Generic completing-read for a color." + (let* ((colors (list-colors-duplicates)) + (len (apply #'max (mapcar (lambda (c) (length (car c))) colors))) + (sample (make-string 20 ?\ ))) + (car + (magithub--completing-read + prompt colors + (lambda (colors) + (format (format "%%-%ds %%s" len) (car colors) + (propertize sample 'face `(:background ,(car colors))))))))) + +(defun magit-section-show-level-5 () + "Show surrounding sections up to fifth level." + (interactive) + (magit-section-show-level 5)) + +(defun magit-section-show-level-5-all () + "Show all sections up to fifth level." + (interactive) + (magit-section-show-level -5)) + +(defun magithub--refresh-reset () + "Reset everything to the defaults after refreshing. +To be added to `magit-unwind-refresh-hook'." + (setq magithub-cache--refresh nil) + ;; reclaim some memory + (setq magithub-cache--refreshed-forms nil)) + +(defvar magithub-cache--refresh nil + ;; Can also consider making this a list in the future to refresh + ;; multiple forms. No current use-case for this, though. + "Non-nil when refreshing. +If t, all form classes will be refreshed. Otherwise, if non-nil, +this variable is expected to be `eq' to the class of forms that +should be selectively refreshed.") + +(make-obsolete 'magithub-refresh 'magithub--refresh "0.2") +(defun magithub-refresh () + (interactive (user-error (substitute-command-keys + "This is no longer an interactive function; \ +use \\[universal-argument] \\[magit-refresh] instead :-)")))) + +(defun magithub--refresh () + "Refresh GitHub data. +Use directly at your own peril; this is intended for use with +`magit-pre-refresh-hook'." + (when (and current-prefix-arg + (memq this-command '(magit-refresh + magit-refresh-all + magithub-ci-refresh + magithub-issue-refresh)) + (magithub-usable-p) + (magithub-confirm-no-error 'refresh) + (or (magithub--api-available-p) + (magithub-confirm-no-error 'refresh-when-API-unresponsive))) + ;; `magithub--refresh' is part of `magit-pre-refresh-hook' and our requests + ;; are made as part of `magit-refresh'. There's no way we can let-bind + ;; `magithub-settings--refresh' around that entire form, so we do the next + ;; best thing: use `magit-unwind-refresh-hook' to reset the override back + ;; to its old value. + (setq magithub-cache--refresh t) + (setq magithub-cache--refreshed-forms nil))) + +(defun magithub-wash-gfm (text) + "Wash TEXT as it comes from the API." + (with-temp-buffer + (insert text) + (goto-char (point-min)) + (while (search-forward " " nil t) + (delete-char -1)) + (s-trim (buffer-string)))) + +(defun magithub-fill-gfm (text) + "Fill TEXT according to GFM rules." + (with-temp-buffer + (delay-mode-hooks + (gfm-mode) ;autoloaded + (insert text) + ;; re font-lock-ensure: see jrblevin/markdown-mode#251 + (font-lock-ensure) + (fill-region (point-min) (point-max)) + (buffer-string)))) + +(defun magithub-indent-text (indent text) + "Indent TEXT by INDENT spaces." + (replace-regexp-in-string (rx bol) (make-string indent ?\ ) text)) + +(defun magithub-commit-browse (rev) + "Browse REV on GitHub. +Interactively, this is the commit at point." + (interactive (list (or (when-let ((rev (magit-rev-verify + (oref (magit-current-section) value)))) + rev) + (thing-at-point 'git-revision)))) + (if-let ((parsed (magit-rev-parse rev))) + (if-let ((commits (magithub-request + (ghubp-get-repos-owner-repo-commits + (magithub-repo) nil + :sha parsed)))) + (let-alist (car commits) + (browse-url .html_url)) + (user-error "No commit %s on remote" parsed)) + (error "Could not parse %S" rev))) + +(defun magithub-add-thing () + "Conceptual command to add a thing (e.g., label, assignee, ...)" + (interactive) + (user-error "There is no thing at point that could be added to")) + +(defun magithub-browse-thing () + "Conceptual command to browse a thing on GitHub" + (interactive) + (user-error "There is no thing at point that could be browsed")) + +(defun magithub-edit-thing () + "Conceptual command to edit a thing (e.g., comment)" + (interactive) + (user-error "There is no thing at point that could be edited")) + +(defun magithub-reply-thing () + "Conceptual command to reply to a thing (e.g., comment)" + (interactive) + (user-error "There is no thing at point that could be replied to")) + +(defvar magithub-map + (let ((m (make-sparse-keymap))) + (define-key m "a" #'magithub-add-thing) + (define-key m "w" #'magithub-browse-thing) + (define-key m "e" #'magithub-edit-thing) + (define-key m "r" #'magithub-reply-thing) + m) + "Parent keymap for Magithub sections.") + +(defmacro magithub-request (&rest body) + "Execute BODY authenticating as Magithub." + (declare (debug t)) + `(ghubp-override-context auth 'magithub + ,@body)) + +(defun magithub-debug-section (section) + (interactive (list (magit-current-section))) + (pp-eval-expression `(oref ,section value))) + +(eval-after-load 'magit + '(progn + (dolist (hook '(magit-revision-mode-hook git-commit-setup-hook)) + (add-hook hook #'magithub-bug-reference-mode-on)) + (add-hook 'magit-pre-refresh-hook #'magithub--refresh) + (add-hook 'magit-unwind-refresh-hook + #'magithub--refresh-reset))) + (provide 'magithub-core) ;;; magithub-core.el ends here diff --git a/magithub-dash.el b/magithub-dash.el new file mode 100644 index 0000000..b95524c --- /dev/null +++ b/magithub-dash.el @@ -0,0 +1,217 @@ +;;; magithub-dash.el --- magithub dashboard -*- lexical-binding: t; -*- + +;; Copyright (C) 2017-2018 Sean Allred + +;; Author: Sean Allred +;; Keywords: hypermedia + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; Magithub-Dash is a dashboard for your GitHub activity. + +;;; Code: + +(require 'magit) +(require 'magithub-core) +(require 'magithub-notification) +(require 'magithub-issue) + +(declare-function magithub-dispatch-popup "magithub.el") + +(defcustom magithub-dashboard-show-read-notifications t + "Show read notifications in the dashboard." + :type 'boolean + :group 'magithub) + +(transient-define-prefix magithub-dashboard-popup () + "Popup console for the dashboard." + ["Actions" + ("r" "Toggle showing read notifications" magithub-dashboard-show-read-notifications-toggle)]) + +(defun magithub-dashboard-show-read-notifications-toggle () + (interactive) + (setq magithub-dashboard-show-read-notifications + (not magithub-dashboard-show-read-notifications)) + (magit-refresh-buffer)) + +;;;###autoload +(defun magithub-dashboard () + "View your GitHub dashboard." + (interactive) + (let ((magit-generate-buffer-name-function + (lambda (&rest _) "*magithub-dash*"))) + (magit-mode-setup #'magithub-dash-mode))) + +(defvaralias 'magithub-dash-map 'magithub-dash-mode-map + "Old name of `magithub-dash-mode-map'. +This will be removed in a future version.") +(defvar magithub-dash-mode-map + (let ((m (make-sparse-keymap))) + (set-keymap-parent m magit-mode-map) + (define-key m (kbd "5") #'magit-section-show-level-5) + (define-key m (kbd "M-5") #'magit-section-show-level-5-all) + (define-key m (kbd ";") #'magithub-dashboard-popup) + (define-key m (kbd "H") #'magithub-dispatch-popup) + m) + "Keymap for `magithub-dash-mode'.") +;; todo: remove on version bump + +(define-derived-mode magithub-dash-mode + magit-mode "Magithub-Dash" + "Major mode for your GitHub dashboard.") + +(defun magithub-dash-refresh-buffer (&rest _args) + "Refresh the dashboard. +Runs `magithub-dash-sections-hook'." + (interactive) + (magit-insert-section (magithub-dash-buf) + (run-hooks 'magithub-dash-sections-hook)) + (let ((inhibit-read-only t)) + (save-excursion + (goto-char (point-max)) + (delete-blank-lines)))) + +(defvar magithub-dash-sections-hook + '(magithub-dash-insert-headers + magithub-dash-insert-notifications + magithub-dash-insert-issues) + "Sections inserted by `magithub-dashboard'.") + +(defvar magithub-dash-headers-hook + '(magithub-dash-insert-user-name-header + magithub-dash-insert-ratelimit-header + magithub-maybe-report-offline-mode) + "Headers inserted by `magithub-dash-insert-headers'.") + +(defun magithub-dash-insert-headers () + "Insert dashboard headers. +See also `magithub-dash-headers-hook'." + (magit-insert-headers 'magithub-dash-headers-hook)) + +(defun magithub-dash-insert-user-name-header (&optional user) + "Inserts a header for USER's name and login." + (setq user (or user (magithub-user-me))) + (let-alist user + (when .login + (let ((login (propertize .login 'face 'magithub-user))) + (magit-insert-section (magithub-user user) + (insert (format "%-10s" "User:") + (if .name + (format "%s (%s)" .name login) + login) + "\n")))))) + +(defun magithub-dash-insert-ratelimit-header () + "If API requests are being rate-limited, insert relevant information." + (magithub-request + (when-let ((ratelimit (ghubp-ratelimit))) + (when (time-less-p (alist-get 'reset ratelimit) (current-time)) + (ghubp-ratelimit 'no-headers))) + (let-alist (ghubp-ratelimit) + (when .limit + (magit-insert-section (magithub-ratelimit) + (let* ((seconds-until-reset (time-to-seconds + (time-subtract .reset + (current-time)))) + (ratio (/ (float .remaining) .limit))) + (insert + (format "%-10s%s - %d/%d requests; %s until reset\n" "Requests:" + (cond + ((< 0.50 ratio) (propertize "OK" 'face 'success)) + ((< 0.25 ratio) (propertize "Running low..." 'face 'warning)) + (t (propertize "Danger!" 'face 'error))) + .remaining + .limit + (magithub-cache--time-out seconds-until-reset))))))))) + +(defun magithub-dash-insert-notifications (&optional notifications) + "Insert NOTIFICATIONS into the buffer bucketed by repository." + (setq notifications (or notifications + (magithub-notifications + magithub-dashboard-show-read-notifications))) + (if notifications + (let* ((bucketed (magithub-core-bucket + notifications + (apply-partially #'alist-get 'repository))) + (unread (if magithub-dashboard-show-read-notifications + (-filter #'magithub-notification-unread-p notifications) + notifications)) + (hide (not unread)) + (heading (if magithub-dashboard-show-read-notifications + (format "%s (%d unread of %d)" + (propertize "Notifications" + 'face 'magit-section-heading) + (length unread) + (length notifications)) + (format "%s (%d)" + (propertize "Notifications" + 'face 'magit-section-heading) + (length notifications))))) + (magit-insert-section (magithub-notifications notifications hide) + (magit-insert-heading heading) + (magithub-for-each-bucket bucketed repo repo-notifications + (setq hide (null (-filter #'magithub-notification-unread-p + repo-notifications))) + (magit-insert-section (magithub-repo repo hide) + (magit-insert-heading + (concat (propertize (magithub-repo-name repo) 'face 'magithub-repo) + (propertize "..." 'face 'magit-dimmed))) + (mapc #'magithub-notification-insert-section repo-notifications) + (insert "\n"))) + (insert "\n"))) + (magit-insert-section (magithub-notifications) + (magit-insert-heading "Notifications") + (insert (propertize (if magithub-dashboard-show-read-notifications + "No notifications" + "No unread notifications") + 'face 'magit-dimmed) + "\n\n")))) + +(defun magithub-dash-insert-issues (&optional issues title) + "Insert ISSUES bucketed by their source repository. + +If ISSUES is not defined, all issues assigned to the current user +will be used." + (magithub-request + (setq issues (or issues (magithub-cache :issues `(magithub-request + (ghubp-get-issues)))) + title (or title "Issues Assigned to Me")) + (when-let ((user-repo-issue-buckets + ;; bucket by user then by repo + (magithub-core-bucket-multi issues + #'magithub-issue-repo + (lambda (repo) (alist-get 'owner repo))))) + (magit-insert-section (magithub-users-repo-issue-buckets) + (magit-insert-heading + (format "%s (%d)" + (propertize title 'face 'magit-section-heading) + (length issues))) + (magithub-for-each-bucket user-repo-issue-buckets user repo-issue-buckets + (magit-insert-section (magithub-user-repo-issues) + (magit-insert-heading + (propertize (alist-get 'login user) 'face 'magithub-user) + (propertize "/..." 'face 'magit-dimmed)) + (magithub-for-each-bucket repo-issue-buckets repo repo-issues + (magit-insert-section (magithub-repo-issues repo) + (magit-insert-heading + (format "%s:" (propertize (alist-get 'name repo) + 'face 'magithub-repo))) + (magithub-issue-insert-sections repo-issues) + (insert "\n"))))) + (insert "\n"))))) + +(provide 'magithub-dash) +;;; magithub-dash.el ends here diff --git a/magithub-edit-mode.el b/magithub-edit-mode.el new file mode 100644 index 0000000..6ede36c --- /dev/null +++ b/magithub-edit-mode.el @@ -0,0 +1,207 @@ +;;; magithub-edit-mode.el --- message-editing mode -*- lexical-binding: t; -*- + +;; Copyright (C) 2016-2018 Sean Allred + +;; Author: Sean Allred +;; Keywords: multimedia + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; Edit generic GitHub (markdown) content. To be used for comments, +;; issues, pull requests, etc. + +;;; Code: + +(require 'markdown-mode) +(require 'git-commit) + +(defvar magithub-edit-mode-map + (let ((m (make-sparse-keymap))) + (define-key m (kbd "C-c C-c") #'magithub-edit-submit) + (define-key m (kbd "C-c C-k") #'magithub-edit-cancel) + m) + "Keymap for `magithub-edit-mode'.") + +;;;###autoload +(define-derived-mode magithub-edit-mode gfm-mode "Magithub-Edit" + "Major mode for editing GitHub issues and pull requests.") + +(defvar-local magithub-edit-submit-function nil + "Populated by SUBMIT in `magithub-edit-new'.") +(defvar-local magithub-edit-cancel-function nil + "Populated by CANCEL in `magithub-edit-new'.") +(defvar-local magithub-edit-previous-buffer nil + "The buffer we were in when the edit was initiated.") + +(defface magithub-edit-title + '((t :inherit markdown-header-face-1)) + "Face used for the title in issues and pull requests." + :group 'magithub-faces) + +(defun magithub-edit-submit () + "Submit this post. +Uses `magithub-edit-submit-function' to do so." + (interactive) + (unless (commandp magithub-edit-submit-function t) + (error "No submit function defined")) + (magithub-edit--done magithub-edit-submit-function) + (magithub-cache-without-cache t + (magit-refresh-buffer))) + +(defun magithub-edit-cancel () + "Cancel this post. +Offer to save a draft if the buffer is considered modified, then +call `magithub-edit-cancel-function'." + (interactive) + ;; Offer to save the draft + (if (and (buffer-modified-p) + ;; don't necessarily want to use `magithub-confirm', here + ;; this is potentially a very dangerous action + (y-or-n-p "Save draft? ")) + (save-buffer) + (set-buffer-modified-p nil)) + + ;; If the saved draft is empty, might as well delete it + (when (and (stringp buffer-file-name) + (file-readable-p buffer-file-name) + (string= "" (let ((f buffer-file-name)) + (with-temp-buffer + (insert-file-contents f) + (buffer-string))))) + (magithub-edit-delete-draft)) + + (magithub-edit--done magithub-edit-cancel-function)) + +(defun magithub-edit--done (callback) + "Cleanup this buffer. +If CALLBACK is a command, call it interactively. (This will +usually be the SUBMIT or CANCEL commands from +`magithub-edit-new'.) If that function returns a buffer, switch +to that buffer." + (let ((nextbuf magithub-edit-previous-buffer)) + (when (commandp callback t) + (let ((newbuf (save-excursion + (call-interactively callback)))) + (when (bufferp newbuf) + (setq nextbuf newbuf)))) + (set-buffer-modified-p nil) + (kill-buffer) + (when nextbuf + (let ((switch-to-buffer-preserve-window-point t)) + (switch-to-buffer nextbuf))))) + +(defun magithub-edit-delete-draft () + "Delete the draft for the current edit buffer." + (when (and (stringp buffer-file-name) + (file-exists-p buffer-file-name) + (file-writable-p buffer-file-name)) + (delete-file buffer-file-name magit-delete-by-moving-to-trash) + (message "Deleted %s" buffer-file-name)) + (set-visited-file-name nil)) + +(cl-defun magithub-edit-new (buffer-name &key cancel content file header prompt-discard-draft submit template) + "Generate a new edit buffer called BUFFER-NAME and return it. +'Edit' buffers provide a common interface and handling for +submitting, cancelling, and saving drafts of posts. + +CANCEL is a function to use upon \\[magithub-edit-cancel]. + +CONTENT is initial content for the buffer. It is considered +novel and the buffer will not be closed without prompting to save +a draft. + +FILE is the file to use for drafts of this post. + +HEADER is a title to use in the header line of the new buffer. + +If PROMPT-DISCARD-DRAFT is non-nil, this function will display +the draft before offering to delete it. This option is +recommended when using \\[universal-argument] with the command +that calls this function. + +SUBMIT is a function to use upon \\[magithub-edit-submit]. + +TEMPLATE is like CONTENT, but is not considered novel. We won't +ask to save a draft here if post is cancelled." + (declare (indent 1)) + (let ((prevbuf (current-buffer)) + (file (and (stringp file) + (file-writable-p file) + file)) + draft) + + ;; Load the draft + (setq draft (and (stringp file) + (file-readable-p file) + (with-temp-buffer + (insert-file-contents file) + (buffer-string)))) + (when (string= draft "") + (setq draft nil)) + + ;; Discard the draft if desired + (when (and draft prompt-discard-draft) + (with-current-buffer (get-buffer-create " *draft*") + (erase-buffer) + (insert draft) + (view-buffer-other-window (current-buffer)) + ;; don't necessarily want to use `magithub-confirm', here + ;; this is potentially a very dangerous action + (when (yes-or-no-p "Discard this draft? ") + (setq draft nil) + (when (file-writable-p file) + (delete-file file magit-delete-by-moving-to-trash))) + (kill-buffer (current-buffer)))) + + (with-current-buffer (get-buffer-create buffer-name) + (when file + (let ((orig-name (buffer-name)) + (dir default-directory)) + (set-visited-file-name file) + (rename-buffer orig-name) + (cd dir))) + (magithub-edit-mode) + + (setq magithub-edit-previous-buffer prevbuf + magithub-edit-submit-function submit + magithub-edit-cancel-function cancel) + (magit-set-header-line-format + (substitute-command-keys + (let ((line "submit: \\[magithub-edit-submit] | cancel: \\[magithub-edit-cancel]")) + (when header + (setq line (concat line " | " header))) + line))) + + (cond + (draft + (insert draft) + (set-buffer-modified-p nil) + (goto-char (point-max)) + (message "Loaded existing draft from %s" file)) + (content + (insert content) + (goto-char (point-max)) + (message "Loaded initial content")) + (template + (insert template) + (set-buffer-modified-p nil) + (goto-char (point-min)) + (message "Loaded template"))) + + (current-buffer)))) + +(provide 'magithub-edit-mode) +;;; magithub-edit-mode.el ends here diff --git a/magithub-faces.el b/magithub-faces.el new file mode 100644 index 0000000..bf773a6 --- /dev/null +++ b/magithub-faces.el @@ -0,0 +1,119 @@ +;;; magithub-faces.el --- faces of Magithub -*- lexical-binding: t; -*- + +;; Copyright (C) 2017-2018 Sean Allred + +;; Author: Sean Allred +;; Keywords: faces + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; Holds all faces for Magithub. + +;;; Code: + +(require 'faces) +(require 'magit) +(require 'git-commit) + +(defface magithub-repo + '((t :inherit magit-branch-remote)) + "Face used for repository names." + :group 'magithub-faces) + +(defface magithub-issue-title + '((t)) + "Face used for issue titles." + :group 'magithub-faces) + +(defface magithub-issue-number + '((t :inherit magit-dimmed)) + "Face used for issue numbers." + :group 'magithub-faces) + +(defface magithub-issue-title-edit + '((t :inherit magithub-issue-title :inherit (git-commit-summary))) + "Face used for post titles during editing." + :group 'magithub-faces) + +(defface magithub-issue-title-with-note + '((t :inherit magithub-issue-title :inherit (git-commit-summary))) + "Face used for issue titles when the issue has an attached note. +See also `magithub-issue-personal-note'." + :group 'magithub-faces) + +(defface magithub-user + '((t :inherit magit-log-author)) + "Face used for usernames." + :group 'magithub-faces) + +(defface magithub-ci-no-status + '((t :inherit magit-dimmed)) + "Face used when CI status is `no-status'." + :group 'magithub-faces) + +(defface magithub-ci-error + '((t :inherit magit-signature-untrusted)) + "Face used when CI status is `error'." + :group 'magithub-faces) + +(defface magithub-ci-pending + '((t :inherit magit-signature-untrusted)) + "Face used when CI status is `pending'." + :group 'magithub-faces) + +(defface magithub-ci-success + '((t :inherit success)) + "Face used when CI status is `success'." + :group 'magithub-faces) + +(defface magithub-ci-failure + '((t :inherit error)) + "Face used when CI status is `failure'" + :group 'magithub-faces) + +(defface magithub-ci-unknown + '((t :inherit magit-signature-untrusted)) + "Face used when CI status is `unknown'." + :group 'magithub-faces) + +(defface magithub-issue-open + '((t :inherit success)) + "Face used to indicate an issue is open." + :group 'magithub-faces) + +(defface magithub-issue-closed + '((t :inherit error)) + "Face used to indicate an issue is closed." + :group 'magithub-faces) + +(defface magithub-label '((t :box t)) + "The inherited face used for labels. +Feel free to customize any part of this face, but be aware that +`:foreground' will be overridden by `magithub-label-propertize'." + :group 'magithub) + +(defface magithub-notification-reason + '((t :inherit magit-dimmed)) + "Face used for notification reasons." + :group 'magithub-faces) + +(defface magithub-deleted-thing + '((t :background "red4" :inherit magit-section-highlight)) + "Face used for things about to be deleted." + :group 'magithub-faces) + +(provide 'magithub-faces) +;;; magithub-faces.el ends here diff --git a/magithub-issue-post.el b/magithub-issue-post.el new file mode 100644 index 0000000..72e1ac3 --- /dev/null +++ b/magithub-issue-post.el @@ -0,0 +1,224 @@ +;;; magithub-issue-post.el --- -*- lexical-binding: t; -*- + +;; Copyright (C) 2017-2018 Sean Allred + +;; Author: Sean Allred + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;;; Code: + +(require 'magithub-core) +(require 'magithub-repo) +(require 'magithub-issue) +(require 'magithub-label) +(require 'magithub-edit-mode) + +(declare-function magithub-issue-view "magithub-issue-view.el" (issue)) + +(defvar-local magithub-issue--extra-data nil) + +(defun magithub-issue-post-submit () + (interactive) + (let ((issue (magithub-issue-post--parse-buffer)) + (repo (magithub-repo))) + (when (s-blank-p (alist-get 'title issue)) + (user-error "Title is required")) + (when (magithub-repo-push-p repo) + (when-let ((issue-labels (magithub-label-read-labels "Labels: "))) + (push (cons 'labels issue-labels) issue))) + (magithub-confirm 'submit-issue) + (let ((issue (magithub-request + (ghubp-post-repos-owner-repo-issues repo issue)))) + (magithub-edit-delete-draft) + (magithub-issue-view issue)))) + +(defun magithub-issue-post--parse-buffer () + (let ((lines (split-string (buffer-string) "\n"))) + `((title . ,(s-trim (car lines))) + (body . ,(s-trim (mapconcat #'identity (cdr lines) "\n")))))) + +(defun magithub-issue-new (repo) + (interactive (list (magithub-repo))) + (let* ((repo (magithub-repo repo)) + (name (magithub-repo-name repo))) + (with-current-buffer + (magithub-edit-new (format "*magithub-issue: %s*" name) + :header (format "Creating an issue for %s" name) + :submit #'magithub-issue-post-submit + :file (expand-file-name "new-issue-draft" + (magithub-repo-data-dir repo)) + :template (magithub-issue--template-text "ISSUE_TEMPLATE")) + (font-lock-add-keywords nil `((,(rx bos (group (*? any)) eol) 1 + 'magithub-issue-title-edit t))) + (magithub-bug-reference-mode-on) + (magit-display-buffer (current-buffer))))) + +(defun magithub-pull-request-new-from-issue + (repo issue base head &optional maintainer-can-modify) + "Create a pull request from an existing issue. +REPO is the parent repository of ISSUE. BASE and HEAD are as +they are in `magithub-pull-request-new'." + (interactive (if-let ((issue-at-point (thing-at-point 'github-issue))) + (let-alist (magithub-pull-request-new-arguments) + (let ((allow-maint-mod (magithub-confirm-no-error + 'pr-allow-maintainers-to-submit))) + (magithub-confirm 'submit-pr-from-issue + (magithub-issue-reference issue-at-point) + .user+head .base) + (list .repo issue-at-point .base .head allow-maint-mod))) + (user-error "No issue detected at point"))) + (let ((pull-request `((head . ,head) + (base . ,base) + (issue . ,(alist-get 'number issue))))) + (when maintainer-can-modify + (push (cons 'maintainer_can_modify t) pull-request)) + (magithub-request + (ghubp-post-repos-owner-repo-pulls repo pull-request)))) + +(defun magithub-issue--template-text (template) + (with-temp-buffer + (when-let ((template (magithub-issue--template-find template))) + (insert-file-contents template) + (buffer-string)))) + +(defun magithub-issue--template-find (filename) + "Find an appropriate template called FILENAME and returns its absolute path. + +See also URL +`https://github.com/blog/2111-issue-and-pull-request-templates'" + (let ((default-directory (magit-toplevel)) + combinations) + (dolist (tryname (list filename (concat filename ".md"))) + (dolist (trydir (list default-directory (expand-file-name ".github/"))) + (push (expand-file-name tryname trydir) combinations))) + (-find #'file-readable-p combinations))) + +(defun magithub-remote-branches (remote) + "Return a list of branches on REMOTE." + (let ((regexp (concat (regexp-quote remote) (rx "/" (group (* any)))))) + (--map (and (string-match regexp it) + (match-string 1 it)) + (magit-list-remote-branch-names remote)))) + +(defun magithub-remote-branches-choose (prompt remote &optional default) + "Using PROMPT, choose a branch on REMOTE." + (let ((branches (magithub-remote-branches remote))) + (magit-completing-read + (format "[%s] %s" + (magithub-repo-name (magithub-repo-from-remote remote)) + prompt) + branches + nil t nil nil (and (member default branches) default)))) + +(defun magithub-pull-request-new-arguments () + (unless (magit-get-push-remote) + (user-error "Nothing on remote yet; have you pushed your branch? Aborting")) + (let* ((this-repo (magithub-read-repo "Fork's remote (this is you!) " (ghubp-username) t)) + (this-repo-owner (let-alist this-repo .owner.login)) + (parent-repo (or (alist-get 'parent this-repo) this-repo)) + (this-remote (car (magithub-repo-remotes-for-repo this-repo))) + (on-this-remote (string= (magit-get-push-remote) this-remote)) + (base-remote (car (magithub-repo-remotes-for-repo parent-repo))) + (head-branch (let ((branch (magithub-remote-branches-choose + "Head branch" this-remote + (when on-this-remote + (magit-get-current-branch))))) + (unless (magit-rev-verify (magit-get-push-branch branch)) + (user-error "`%s' has not yet been pushed to your fork (%s)" + branch (magithub-repo-name this-repo))) + branch)) + (base (magithub-remote-branches-choose + "Base branch" base-remote + (or (and on-this-remote + (magit-get-upstream-branch head-branch)) + (let-alist parent-repo .default_branch)))) + (user+head (format "%s:%s" this-repo-owner head-branch))) + (when (magithub-request (ghubp-get-repos-owner-repo-pulls parent-repo nil + :head user+head)) + (user-error "A pull request on %s already exists for head \"%s\"" + (magithub-repo-name parent-repo) + user+head)) + `((repo . ,parent-repo) + (base . ,base) + (head . ,(if (string= this-remote base-remote) + head-branch + user+head)) + (head-no-user . ,head-branch) + (fork . ,this-repo) + (user+head . ,user+head)))) + +(defun magithub-pull-request-new (repo base head head-no-user) + "Create a new pull request." + (interactive (let-alist (magithub-pull-request-new-arguments) + (magithub-confirm 'pre-submit-pr .user+head + (magithub-repo-name .repo) .base) + (list .repo .base .head .head-no-user))) + (let ((is-single-commit + (string= "1" (magit-git-string "rev-list" "--count" (format "%s.." base))))) + (unless is-single-commit + (apply #'magit-log-other (list (format "%s..%s" base head)) (magit-log-arguments))) + (with-current-buffer + (let ((template (magithub-issue--template-text "PULL_REQUEST_TEMPLATE"))) + (magithub-edit-new (format "*magithub-pull-request: %s into %s:%s*" + head + (magithub-repo-name repo) + base) + :header (let-alist repo (format "PR %s/%s (%s->%s)" + .owner.login .name head base)) + :submit #'magithub-pull-request-submit + :file (expand-file-name "new-pull-request-draft" + (magithub-repo-data-dir repo)) + :template template + :content (when is-single-commit + ;; when we only want to merge one commit + ;; insert that commit message as the initial content + (concat + (with-temp-buffer + (magit-git-insert "show" "-q" head-no-user "--format=%B") + (let ((fill-column (point-max))) + (fill-region (point-min) (point-max)) + (buffer-string))) + template)))) + (font-lock-add-keywords nil `((,(rx bos (group (*? any)) eol) 1 + 'magithub-issue-title-edit t))) + (magithub-bug-reference-mode-on) + (setq magithub-issue--extra-data + `((base . ,base) (head . ,head) (repo . ,repo))) + (magit-display-buffer (current-buffer))))) + +(defun magithub-pull-request-submit () + (interactive) + (let ((pull-request `(,@(magithub-issue-post--parse-buffer) + (base . ,(alist-get 'base magithub-issue--extra-data)) + (head . ,(alist-get 'head magithub-issue--extra-data))))) + (when (s-blank-p (alist-get 'title pull-request)) + (user-error "Title is required")) + (magithub-confirm 'submit-pr) + (when (magithub-confirm-no-error 'pr-allow-maintainers-to-submit) + (push (cons 'maintainer_can_modify t) pull-request)) + (let ((pr (condition-case _ + (magithub-request + (ghubp-post-repos-owner-repo-pulls + (alist-get 'repo magithub-issue--extra-data) + pull-request)) + (ghub-422 + (user-error "This pull request already exists!"))))) + (magithub-edit-delete-draft) + (magithub-issue-view pr)))) + +(provide 'magithub-issue-post) +;;; magithub-issue-post.el ends here diff --git a/magithub-issue-tricks.el b/magithub-issue-tricks.el new file mode 100644 index 0000000..09d0364 --- /dev/null +++ b/magithub-issue-tricks.el @@ -0,0 +1,56 @@ +;;; magithub-issue-tricks.el --- -*- lexical-binding: t; -*- + +;; Copyright (C) 2017-2018 Sean Allred + +;; Author: Sean Allred + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;;; Code: + +(require 'magit) +(require 'magithub-issue) + +(defcustom magithub-hub-executable "hub" + "The hub executable used by Magithub." + :group 'magithub + :package-version '(magithub . "0.1") + :type 'string) + +(defmacro magithub-with-hub (&rest body) + `(let ((magit-git-executable magithub-hub-executable) + (magit-pre-call-git-hook nil) + (magit-git-global-arguments nil)) + ,@body)) + +;;;###autoload +(defun magithub-pull-request-merge (pull-request &optional args) + "Merge PULL-REQUEST with ARGS. +See `magithub-pull-request--completing-read'. If point is on a +pull-request object, that object is selected by default." + (interactive (list (magithub-issue-completing-read-pull-requests) + (magit-am-arguments))) + (unless (executable-find magithub-hub-executable) + (user-error "This hasn't been supported in elisp yet; please install/configure `hub'")) + (unless (member pull-request (magithub-pull-requests)) + (user-error "Unknown pull request %S" pull-request)) + (let-alist pull-request + (magithub-with-hub + (magit-run-git-sequencer "am" args .html_url)) + (message "#%d has been applied" .number))) + +(provide 'magithub-issue-tricks) +;;; magithub-issue-tricks.el ends here diff --git a/magithub-issue-view.el b/magithub-issue-view.el new file mode 100644 index 0000000..77769b3 --- /dev/null +++ b/magithub-issue-view.el @@ -0,0 +1,180 @@ +;;; magithub-issue-view.el --- view issues -*- lexical-binding: t; -*- + +;; Copyright (C) 2017-2018 Sean Allred + +;; Author: Sean Allred +;; Keywords: lisp + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; View issues in magit-like buffers. + +;;; Code: + +(require 'magit-mode) + +(require 'magithub-core) +(require 'magithub-issue) +(require 'magithub-comment) + +(defvar magithub-issue-view-mode-map + (let ((m (make-composed-keymap (list magithub-map) magit-mode-map))) + (define-key m [remap magithub-reply-thing] #'magithub-comment-new) + (define-key m [remap magithub-browse-thing] #'magithub-issue-browse) + (define-key m [remap magit-refresh] #'magithub-issue-view-refresh) + m)) + +(define-derived-mode magithub-issue-view-mode magit-mode + "Issue View" "View GitHub issues with Magithub.") + +(defvar magithub-issue-view-headers-hook + '(magithub-issue-view-insert-title + magithub-issue-view-insert-author + magithub-issue-view-insert-state + magithub-issue-view-insert-asked + magithub-issue-view-insert-labels) + "Header information for each issue.") + +(defvar magithub-issue-view-sections-hook + '(magithub-issue-view-insert-headers + magithub-issue-view-insert-body + magithub-issue-view-insert-comments) + "Sections to be inserted for each issue.") + +(defun magithub-issue-view-refresh () + "Refresh the current issue." + (interactive) + (if (derived-mode-p 'magithub-issue-view-mode) + (progn + ;; todo: find a better means to separate the keymaps of issues + ;; in the status buffer vs issues in their own buffer + (when magithub-issue + (magithub-cache-without-cache :issues + (setq-local magithub-issue + (magithub-issue magithub-repo magithub-issue)) + (magithub-issue-comments magithub-issue))) + (let ((magit-refresh-args (list magithub-issue))) + (magit-refresh)) + (message "refreshed")) + (call-interactively #'magit-refresh))) + +(defun magithub-issue-view-refresh-buffer (issue &rest _) + (setq-local magithub-issue issue) + (setq-local magithub-repo (magithub-issue-repo issue)) + (magit-insert-section (magithub-issue issue) + (run-hooks 'magithub-issue-view-sections-hook))) + +(defun magithub-issue-view-insert-headers () + "Run `magithub-issue-view-headers-hook'." + (magit-insert-headers 'magithub-issue-view-headers-hook)) + +(defun magithub-issue-view--lock-value (args) + "Provide an identifying value for ISSUE. +See also `magit-buffer-lock-functions'." + (let ((issue (car args))) + (let-alist `((repo . ,(magithub-issue-repo issue)) + (issue . ,issue)) + (list .repo.owner.login .repo.name .issue.number)))) +(push (cons 'magithub-issue-view-mode #'magithub-issue-view--lock-value) + magit-buffer-lock-functions) + +(defun magithub-issue-view--buffer-name (_mode issue-lock-value) + "Generate a buffer name for ISSUE-LOCK-VALUE. +See also `magithub-issue-view--lock-value'." + (let ((owner (nth 0 issue-lock-value)) + (repo (nth 1 issue-lock-value)) + (number (nth 2 issue-lock-value))) + (format "*magithub: %s/%s#%d: %s*" + owner + repo + number + (alist-get 'title (magithub-issue `((owner (login . ,owner)) + (name . ,repo)) + number))))) + +;;;###autoload +(defun magithub-issue-view (issue) + "View ISSUE in a new buffer. +Return the new buffer." + (interactive (list (magithub-interactive-issue))) + (let ((magit-generate-buffer-name-function #'magithub-issue-view--buffer-name)) + (magit-mode-setup-internal #'magithub-issue-view-mode (list issue) t) + (current-buffer))) + +(cl-defun magithub-issue-view-insert--generic (title text &optional type section-value &key face) + "Insert a generic header line with TITLE: VALUE" + (declare (indent 2)) + (setq type (or type 'magithub)) + (magit-insert-section ((eval type) section-value) + (insert (format "%-10s" title) + (or (and face (propertize text 'face face)) + text) + ?\n) + (magit-insert-heading))) + +(defun magithub-issue-view-insert-title () + "Insert issue title." + (let-alist magithub-issue + (magithub-issue-view-insert--generic "Title:" .title))) + +(defun magithub-issue-view-insert-author () + "Insert issue author." + (insert (format "%-10s" "Author:")) + (let-alist magithub-issue + (magit-insert-section (magithub-user .user) + (insert (propertize .user.login 'face 'magithub-user) ?\n) + (magit-insert-heading)))) + +(defun magithub-issue-view-insert-state () + "Insert issue state." + (magithub-issue-view-insert--generic "State:" + (if (magithub-issue-open-p magithub-issue) + (propertize "Open" 'face 'magithub-issue-open) + (propertize "Closed" 'face 'magithub-issue-closed)) + :face 'magit-dimmed)) + +(defun magithub-issue-view-insert-asked () + "Insert posted time." + (let-alist magithub-issue + (magithub-issue-view-insert--generic "Posted:" (magithub--format-time .created_at) + :face 'magit-dimmed))) + +(defun magithub-issue-view-insert-labels () + "Insert labels." + (insert (format "%-10s" "Labels:")) + (magithub-label-insert-list (alist-get 'labels magithub-issue)) + (insert ?\n)) + +(defun magithub-issue-view-insert-body () + "Insert issue body." + (let-alist magithub-issue + (magit-insert-section (magithub-issue-body magithub-issue) + (magit-insert-heading "Body") + (if (or (null .body) (string= .body "")) + (insert (propertize "There's nothing here!\n\n" 'face 'magit-dimmed)) + (insert (magithub-fill-gfm (magithub-wash-gfm (s-trim .body))) "\n\n"))))) + +(defun magithub-issue-view-insert-comments () + "Insert issue comments." + (let ((comments (magithub-issue-comments magithub-issue))) + (magit-insert-section (magithub-issue-comments comments) + (magit-insert-heading "Comments:") + (if (null comments) + (insert (propertize "There's nothing here!\n\n" 'face 'magit-dimmed)) + (mapc #'magithub-comment-insert comments))))) + +(provide 'magithub-issue-view) +;;; magithub-issue-view.el ends here diff --git a/magithub-issue.el b/magithub-issue.el index b620bb4..f3fc07b 100644 --- a/magithub-issue.el +++ b/magithub-issue.el @@ -1,6 +1,6 @@ ;;; magithub-issue.el --- Browse issues with Magithub -*- lexical-binding: t; -*- -;; Copyright (C) 2016 Sean Allred +;; Copyright (C) 2016-2018 Sean Allred ;; Author: Sean Allred ;; Keywords: tools @@ -24,350 +24,638 @@ ;;; Code: -(require 'magit) -(require 'magit-section) -(require 'dash) (require 's) +(require 'dash) +(require 'ghub+) +(require 'cl-lib) +(require 'magit) +(require 'thingatpt) (require 'magithub-core) -(require 'magithub-cache) +(require 'magithub-user) +(require 'magithub-label) + +(declare-function magithub-issue-view "magithub-issue-view.el" (issue)) + +(defvar magit-magithub-repo-issues-section-map + (let ((m (make-sparse-keymap))) + (define-key m [remap magit-visit-thing] #'magithub-repo-visit-issues) + m)) + +(defvar magit-magithub-note-section-map + (let ((m (make-sparse-keymap))) + (set-keymap-parent m magithub-map) + (define-key m [remap magit-visit-thing] #'magithub-issue-personal-note) + m)) + +;;; Core + +(defun magithub-issue--admin-p (issue) + "Returns non-nil if ISSUE can be managed by the current user." + (magithub-request + (or (string= (let-alist issue .user.login) + (let-alist (magithub-user-me) .login)) + (magithub-repo-admin-p)))) + +(defun magithub-issue--ensure-admin (issue user-error-message) + "Ensure the user can administrate ISSUE. +If not, error out with USER-ERROR-MESSAGE." + (declare (indent 1)) + (unless (magithub-issue--admin-p issue) + (user-error "%s: not the issue owner or an administrator of this repo" user-error-message))) + +(defun magithub-issue-open-p (issue) + "Returns non-nil if ISSUE is open." + (string= (let-alist issue .state) "open")) + +(declare-function magithub-issue-view-refresh "magithub-issue-view") +(defun magithub-issue--open-close (issue do-close) + "Open or close ISSUE. If DO-CLOSE is non-nil, ISSUE will be closed." + (magithub-issue--ensure-admin issue + (if do-close + "Cannot close this issue" + "Cannot reopen this issue")) + ;; valid states: issue is open and we want to close + ;; issue is closed and we want to open + ;; (not ...) is to coerce to t or nil + (unless (eq (not (magithub-issue-open-p issue)) (not do-close)) + (user-error (if do-close + "Issue already closed" + "Issue already open"))) + (magithub-confirm (if do-close 'issue-close 'issue-reopen) + (magithub-issue-reference issue)) + (prog1 + (magithub-request + (ghubp-patch-repos-owner-repo-issues-number + (magithub-repo) issue + `((state . ,(if do-close "closed" "open"))))) + (when (derived-mode-p 'magithub-issue-view-mode) + (require 'magithub-issue-view) + (magithub-issue-view-refresh)) + (magithub-message "%s %s" + (if do-close "closed" "reopened") + (magithub-issue-reference issue)))) + +(defun magithub-issue-close (issue) + "Close ISSUE." + (interactive (list (magithub-interactive-issue))) + (magithub-issue--open-close issue t)) + +(defun magithub-issue-open (issue) + "Open ISSUE." + (interactive (list (magithub-interactive-issue))) + (magithub-issue--open-close issue nil)) + +(defmacro magithub-interactive-issue-or-pr (sym args doc &rest body) + "Declare an interactive form that works on both issues and PRs. +SYM is a postfix for the function symbol. An appropriate prefix +will be added for both the issue-version and PR-version. + +ARGS should be a list of one element, the symbol ISSUE-OR-PR. + +DOC is a doc-string. + +BODY is the function implementation." + (declare (indent defun) + (doc-string 3)) + (unless (eq (car args) 'issue-or-pr) + (error "For clarity, the first argument must be ISSUE-OR-PR")) + (let* ((snam (symbol-name sym)) + (isym (intern (concat "magithub-issue-" snam))) + (psym (intern (concat "magithub-pull-request-" snam)))) + `(list + (defun ,isym ,(cons 'issue (cdr args)) + ,(format (concat doc "\n\nSee also `%S'.") "ISSUE" psym) + (interactive (list (magithub-interactive-issue))) + (let ((issue-or-pr issue)) + ,@body)) + (defun ,psym ,(cons 'pull-request (cdr args)) + ,(format (concat doc "\n\nSee also `%S'.") "PULL-REQUEST" isym) + (interactive (list (magithub-interactive-pull-request))) + (let ((issue-or-pr pull-request)) + ,@body))))) + +(defun magithub--issue-list (&rest params) + "Return a list of issues for the current repository. +The response is unpaginated, so avoid doing this with PARAMS that +will return a ton of issues. + +See also `ghubp-get-repos-owner-repo-issues'." + (cl-assert (cl-evenp (length params))) + (magithub-cache :issues + `(magithub-request + (ghubp-unpaginate + (ghubp-get-repos-owner-repo-issues + ',(magithub-repo) + ,@params))) + :message + "Retrieving issue list...")) + +(defun magithub-issue--issue-is-pull-p (issue) + (not (null (alist-get 'pull_request issue)))) + +(defun magithub-issue--issue-is-issue-p (issue) + (and (alist-get 'number issue) + (not (magithub-issue--issue-is-pull-p issue)))) + +(defun magithub-issue-comments (issue) + "Get comments on ISSUE." + (let ((repo (magithub-issue-repo issue))) + (magithub-cache :issues + `(magithub-request + (ghubp-unpaginate + (ghubp-get-repos-owner-repo-issues-number-comments ',repo ',issue)))))) + +;;; Finding issues and pull requests -(magit-define-popup magithub-issues-popup - "Popup console for creating GitHub issues." - 'magithub-commands - :man-page "hub" - :options '((?l "Add labels" "--label=" magithub-issue-read-labels)) - :actions '((?c "Create new issue" magithub-issue-new))) +(defun magithub-issues () + "Return a list of issue objects that are actually issues." + (-filter #'magithub-issue--issue-is-issue-p + (magithub--issue-list))) -(defun magithub-issue-new () - "Create a new issue on GitHub." - (interactive) - (unless (magithub-github-repository-p) - (user-error "Not a GitHub repository")) - (magithub--command-with-editor - "issue" (cons "create" (magithub-issues-arguments)))) - -(defun magithub-issue-label-list () - "Return a list of issue labels. -This is a hard-coded list right now." - (list "bug" "duplicate" "enhancement" - "help wanted" "invalid" "question" "wontfix")) - -(defun magithub-issue-read-labels (prompt &optional default) - "Read some issue labels and return a comma-separated string. -Available issues are provided by `magithub-issue-label-list'. - -DEFAULT is a comma-separated list of issues -- those issues that -are in DEFAULT are not prompted for again." - ;; todo: probably need to add DEFAULT to the top here - (s-join - "," - (magithub--completing-read-multiple - (format "%s... %s" prompt "Issue labels (or \"\" to quit): ") - (let* ((default-labels (when default (s-split "," default t)))) - (cl-set-difference (magithub-issue-label-list) default-labels))))) +(defun magithub-pull-requests () + "Return a list of issue objects that are actually pull requests." + (-filter #'magithub-issue--issue-is-pull-p + (magithub--issue-list))) + +;;; Sorting + +(defcustom magithub-issue-sort-function + #'magithub-issue-sort-ascending + "Function used for sorting issues and pull requests in the +status buffer. Should take two issue-objects as arguments." + :type 'function + :group 'magithub) + +(magithub-defsort magithub-issue-sort-ascending #'< + "Lower issue numbers come first." + (apply-partially #'alist-get :number)) + +(magithub-defsort magithub-issue-sort-descending #'> + "Higher issue numbers come first." + (apply-partially #'alist-get :number)) (defun magithub-issue--sort (issues) - "Sort ISSUES by issue number." - (sort issues - (lambda (a b) (< (plist-get a :number) - (plist-get b :number))))) - -(defun magithub-issue--url-type (url) - "If URL corresponds to an issue, the symbol `issue'. -If URL correponds to a pull request, the symbol `pull-request'." - (if (string-match-p (rx "/pull/" (+ digit) eos) url) - 'pull-request 'issue)) - -(defun magithub-issue--process-line-2.2.8 (s) - "Process a line S into an issue. - -Returns a plist with the following properties: - - :number issue or pull request number - :type either 'pull-request or 'issue - :title the title of the issue or pull request - :url link to issue or pull request" - (let (number title url) - (if (ignore-errors - (with-temp-buffer - (insert s) - (goto-char 0) - (search-forward "]") - (setq number (string-to-number (substring s 0 (point)))) - (setq title (substring s (point) - (save-excursion - (goto-char (point-max)) - (- (search-backward "(") 2)))) - (goto-char (point-max)) - (delete-char -2) - (search-backward "(") - (forward-char 2) - (setq url (buffer-substring-no-properties (point) (point-max))) - t)) - (list :number number - :type (magithub-issue--url-type url) - :title title - :url url) - (magithub-error - "failed to parse issue" - "There was an error parsing issues.")))) - -(defun magithub--issue-list--internal-2.2.8 () - "Backwards compatibility for old versions of hub. -See `magithub-issue-list--internal'." - (magithub-issue--sort - (mapcar #'magithub-issue--process-line-2.2.8 - (magithub--command-output "issue")))) - -(defun magithub--issue-list--internal () - "Return a new list of issues for the current repository." - (magithub-issue--sort - (magithub--issue-list--get-properties - (mapcar #'cadr magithub-issue--format-args)))) - -(defconst magithub-issue--format-args - (let ((csv (lambda (s) (unless (string= s "") (s-split "," s)))) - (num (lambda (s) (unless (string= s "") (string-to-number s)))) - (time (lambda (s) (seconds-to-time (string-to-number s))))) - `(("I" :number ,num) - ("U" :url) - ("t" :title) - ("L" :labels ,csv) - ("au" :author) - ("Mn" :milestone ,num) - ("Mt" :milestone-title) - ("NC" :comment-count ,num) - ("b" :body) - ("as" :assignees ,csv) - ("ct" :created ,time) - ("ut" :updated ,time))) - "List of format specifiers. - -1. Format code for Hub -2. Property keyword to be used in the plist -3. Optional response parser function") - -(defun magithub--issue-list--get-properties (props) - "Make a new request for PROPS (and only PROPS). -Response will be processed into a list of plists." - (let* ((field-delim (char-to-string 1)) ;non-printing char -- safely delimit freetext - (issue-delim (char-to-string 2)) - ;; filter the master list to just the properties we're interested in - (format-specs (-remove (lambda (fmt) (not (memq (cadr fmt) props))) - magithub-issue--format-args)) - ;; reset props to the correct order - (props (mapcar #'cadr format-specs)) - - ;; grab transform functions in the correct order - (string-or-nil (lambda (s) (if (string= "" s) nil s))) - (funcs (mapcar (lambda (fmt) (or (caddr fmt) string-or-nil)) format-specs)) - - ;; build our --format= string - (format-string (mapconcat (lambda (f) (concat "%" f)) - (mapcar #'car format-specs) - field-delim)) - (format-string (format "--format=%s%s" format-string issue-delim)) - - ;; make request - (lines (magithub--command-output "issue" (list format-string) t)) - ;; and split on the issue delimiter (butlast is for the terminal issue-delim) - (issues (butlast (s-split issue-delim lines))) - - ;; split into fields - (pieces (mapcar (lambda (s) (split-string s field-delim)) issues)) - ;; zip with our transform functions - (pieces (mapcar (lambda (p) (-zip p funcs)) pieces)) - ;; and apply our transform functions - (pieces (mapcar (lambda (i) (mapcar (lambda (p) (funcall (cdr p) (car p))) i)) pieces)) - - ;; zip with our properties - (zipped (mapcar (lambda (p) (-zip props p props)) pieces)) - ;; simplifying conses to lists -- only necessary until Dash 3.0 (minor performance hit) - (zipped (mapcar (lambda (p) (mapcar #'butlast p)) zipped)) - ;; removing null values - (zapnil (lambda (pair) (when (cadr pair) pair))) - (zipped (delq nil (mapcar (lambda (p) (mapcar zapnil p)) zipped))) - - ;; join all our lists into a plist - (flat (mapcar (lambda (p) (apply #'append p)) zipped))) - ;; determine the type of each issue (PR vs. issue) - (mapcar (lambda (p) (if-let ((url (plist-get p :url))) - (append `(:type ,(magithub-issue--url-type url)) p) - p)) - flat))) - -(defun magithub--issue-list () - "Return a list of issues for the current repository." - (magithub-cache (magithub-repo-id) :issues - '(with-temp-message "Retrieving issue list..." - (if (magithub-hub-version-at-least "2.3") - (magithub--issue-list--internal) - (magithub--issue-list--internal-2.2.8))))) - -(defun magithub-issue--wrap-title (title indent) - "Word-wrap string TITLE to `fill-column' with an INDENT." - (s-replace - "\n" (concat "\n" (make-string indent ?\ )) - (s-word-wrap (- fill-column indent) title))) - -(defun magithub-issue--insert (issue) - "Insert an `issue' as a Magit section into the buffer." - (when issue - (magit-insert-section (magithub-issue issue) - (insert (format " %3d %s\n" - (plist-get issue :number) - (magithub-issue--wrap-title - (plist-get issue :title) 6)))))) + "Sort ISSUES by `magithub-issue-sort-function'." + (sort issues magithub-issue-sort-function)) -(defun magithub-issue-browse (issue) - "Visits `issue' in the browser. -Interactively, this finds the issue at point. +;;; Getting issues from the user -If `issue' is nil, open the repository's issues page." - (interactive (list (magit-section-value - (magit-current-section)))) - (browse-url - (if (plist-member issue :url) - (plist-get issue :url) - (car (magithub--command-output "browse" '("--url-only" "--" "issues")))))) +(defun magithub-issue--format-for-read (issue) + "Format ISSUE as a string suitable for completion." + (let-alist issue (format "%3d %s" .number .title))) + +(defun magithub-issue--completing-read (prompt default preds) + "Complete over all open pull requests returning its issue object. +If point is on a pull-request object, that object is selected by +default." + (magithub--completing-read prompt (magithub--issue-list) + #'magithub-issue--format-for-read + (apply-partially #'magithub--satisfies-p preds) + t default)) +(defun magithub-issue-completing-read-issues (&optional default) + "Read an issue in the minibuffer with completion." + (interactive (list (thing-at-point 'github-issue))) + (magithub-issue--completing-read + "Issue: " default (list #'magithub-issue--issue-is-issue-p))) +(defun magithub-issue-completing-read-pull-requests (&optional default) + "Read a pull request in the minibuffer with completion." + (interactive (list (thing-at-point 'github-pull-request))) + (magithub-issue--completing-read + "Pull Request: " default (list #'magithub-issue--issue-is-pull-p))) +(defun magithub-interactive-issue () + (or (thing-at-point 'github-issue) + (magithub-issue-completing-read-issues))) +(defun magithub-interactive-pull-request () + (or (thing-at-point 'github-pull-request) + (magithub-issue-completing-read-pull-requests))) + +(defun magithub-issue-find (number) + "Return the issue or pull request with the given NUMBER." + (-find (lambda (i) (= (alist-get 'number i) number)) + (magithub--issue-list :filter "all" :state "all"))) + +(defun magithub-issue (repo number-or-issue) + "Retrieve in REPO issue NUMBER-OR-ISSUE. +NUMBER-OR-ISSUE is either a number or an issue object. If it's a +number, the issue by that number is retrieved. If it's an issue +object, the same issue is retrieved." + (let ((num (or (and (numberp number-or-issue) + number-or-issue) + (alist-get 'number number-or-issue)))) + (magithub-cache :issues + `(magithub-request + (ghubp-get-repos-owner-repo-issues-number + ',repo '((number . ,num)))) + :message + (format "Getting issue %s#%d..." (magithub-repo-name repo) num)))) + +(defun magithub-issue-personal-note-file (issue-or-pr) + "Return an absolute filename appropriate for ISSUE-OR-PR." + (let-alist `((repo . ,(magithub-repo (magithub-issue-repo issue-or-pr))) + (issue . ,issue-or-pr)) + (expand-file-name + (format "%s/%s/notes/%d.org" .repo.owner.login .repo.name .issue.number) + magithub-dir))) + +(magithub-interactive-issue-or-pr personal-note (issue-or-pr) + "Write a personal note about %s. +This is stored in `magit-git-dir' and is unrelated to +`git-notes'." + (if (null issue-or-pr) + (error "No issue or pull request here") + (let-alist issue-or-pr + (let ((note-file (magithub-issue-personal-note-file issue-or-pr))) + (make-directory (file-name-directory note-file) t) + (with-current-buffer (find-file-other-window note-file) + (rename-buffer (format "*magithub note for #%d*" .number))))))) + +(defun magithub-issue-has-personal-note-p (issue-or-pr) + "Non-nil if a personal note exists for ISSUE-OR-PR." + (let ((filename (magithub-issue-personal-note-file issue-or-pr))) + (and (file-exists-p filename) + (not (string-equal + "" + (string-trim + (with-temp-buffer + (insert-file-contents-literally filename) + (buffer-string)))))))) + +(defun magithub-issue-repo (issue) + "Get a repository object from ISSUE." + (let-alist issue + (or .repository + .base.repo + (save-match-data + (when (string-match (concat (rx bos) + "https://" + (regexp-quote (ghubp-host)) + (rx "/repos/" + (group (+ (not (any "/")))) "/" + (group (+ (not (any "/")))) "/issues/") + (regexp-quote (number-to-string .number)) + (rx eos)) + .url) + (magithub-repo + `((owner (login . ,(match-string 1 .url))) + (name . ,(match-string 2 .url))))))))) + +(defun magithub-issue-reference (issue) + "Return a string like \"owner/repo#number\" for ISSUE." + (let-alist `((repo . ,(magithub-issue-repo issue)) + (issue . ,issue)) + (format "%s/%s#%d" .repo.owner.login .repo.name .issue.number))) + +(defun magithub-issue-from-reference (string) + "Parse an issue from an \"owner/repo#number\" STRING." + (when (string-match (rx bos (group (+ any)) + "/" (group (+ any)) + "#" (group (+ digit)) + eos) + string) + (magithub-issue `((owner (login . ,(match-string 1 string))) + (name . ,(match-string 2 string))) + (string-to-number (match-string 3 string))))) + +(defun magithub-issue-insert-sections (issues) + "Insert ISSUES into the buffer with alignment. +See also `magithub-issue-insert-section'." + (let ((max-num-len (thread-last issues + (ghubp-get-in-all '(number)) + (apply #'max) + (number-to-string) + (length)))) + (--map (magithub-issue-insert-section it max-num-len) + issues))) + +(defun magithub-issue-insert-section (issue &optional pad-num-to-len) + "Insert ISSUE into the buffer. +If PAD-NUM-TO-LEN is non-nil, it is an integer width. For +example, if this section's issue number is \"3\" and the next +section's number is \"401\", pass a padding of 3 to both to align +them. + +See also `magithub-issue-insert-sections'." + (when issue + (setq pad-num-to-len (or pad-num-to-len 0)) + (magit-insert-section (magithub-issue issue t) + (let-alist issue + (magit-insert-heading + (format (format "%%%ds %%s" (1+ pad-num-to-len)) ;1+ accounts for # + (propertize (format "#%d" .number) + 'face 'magithub-issue-number) + (propertize .title + 'face (if (magithub-issue-has-personal-note-p issue) + 'magithub-issue-title-with-note + 'magithub-issue-title)))) + (run-hook-with-args 'magithub-issue-details-hook issue + (format " %s %%-12s" + (make-string pad-num-to-len ?\ ))))))) + +(defvar magithub-issue-details-hook + '(magithub-issue-detail-insert-personal-notes + magithub-issue-detail-insert-created + magithub-issue-detail-insert-updated + magithub-issue-detail-insert-author + magithub-issue-detail-insert-assignees + magithub-issue-detail-insert-labels + magithub-issue-detail-insert-body-preview) + "Detail functions for issue-type sections. +These details appear under issues as expandable content. + +Each function takes two arguments: + + 1. an issue object + 2. a format string for a string label (for alignment)") + +(defun magithub-issue-detail-insert-author (issue fmt) + "Insert the author of ISSUE using FMT." + (let-alist issue + (insert (format fmt "Author:")) + (magit-insert-section (magithub-user (magithub-user .user)) + (insert + (propertize .user.login 'face 'magithub-user))) + (insert "\n"))) + +(defun magithub-issue-detail-insert-created (issue fmt) + "Insert when ISSUE was created using FMT." + (let-alist issue + (insert (format fmt "Created:") + (propertize (magithub--format-time .created_at) + 'face 'magit-dimmed) + "\n"))) + +(defun magithub-issue-detail-insert-updated (issue fmt) + "Insert when ISSUE was created using FMT." + (let-alist issue + (insert (format fmt "Updated:") + (propertize (magithub--format-time .updated_at) + 'face 'magit-dimmed) + "\n"))) + +(defun magithub-issue-detail-insert-assignees (issue fmt) + "Insert the assignees of ISSUE using FMT." + (let-alist issue + (insert (format fmt "Assignees:")) + (if .assignees + (let ((assignees .assignees) assignee) + (while (setq assignee (pop assignees)) + (magit-insert-section (magithub-assignee (magithub-user assignee)) + (insert (propertize (alist-get 'login assignee) + 'face 'magithub-user))) + (when assignees + (insert " ")))) + (magit-insert-section (magithub-assignee) + (insert (propertize "none" 'face 'magit-dimmed)))) + (insert "\n"))) + +(defun magithub-issue-detail-insert-personal-notes (issue fmt) + "Insert a link to ISSUE's notes." + (insert (format fmt "My notes:")) + (magit-insert-section (magithub-note) + (insert (if (magithub-issue-has-personal-note-p issue) + (propertize "visit your note" 'face 'link) + (propertize "create a new note" 'face 'magit-dimmed)))) + (insert "\n")) + +(defun magithub-issue-detail-insert-body-preview (issue fmt) + "Insert a preview of ISSUE's body using FMT." + (let-alist issue + (let (label-string label-len width did-cut maxchar text) + (setq label-string (format fmt "Preview:")) + (insert label-string) + + (if (or (null .body) (string= .body "")) + (insert (concat (propertize "none" 'face 'magit-dimmed) + "\n")) + + (setq label-len (length label-string)) + (setq width (- fill-column label-len)) + (setq maxchar (* 3 width)) + (setq did-cut (< maxchar (length .body))) + (setq maxchar (if did-cut (- maxchar 3) maxchar)) + (setq text (if did-cut + (substring .body 0 (min (length .body) (* 4 width))) + .body)) + (setq text (replace-regexp-in-string " " "" text)) + (setq text (let ((fill-column width)) + (thread-last text + (magithub-fill-gfm) + (magithub-indent-text label-len) + (s-trim)))) + (insert text) + (when did-cut + (insert (propertize "..." 'face 'magit-dimmed))) + (insert "\n"))))) + +(defun magithub-issue-detail-insert-labels (issue fmt) + "Insert ISSUE's labels using FMT." + (let-alist issue + (insert (format fmt "Labels:")) + (magithub-label-insert-list .labels) + (insert "\n"))) + +;;; Magithub-Status stuff (defun magithub-issue-refresh () "Refresh issues for this repository." (interactive) - (magithub-cache-clear (magithub-repo-id) :issues) + (magithub-cache-without-cache :issues + (magithub--issue-list)) (when (derived-mode-p 'magit-status-mode) (magit-refresh))) +(declare-function magithub-comment-new "magithub-comment") (defvar magit-magithub-issue-section-map (let ((map (make-sparse-keymap))) - (define-key map [remap magit-visit-thing] #'magithub-issue-browse) - (define-key map [remap magit-refresh] #'magithub-issue-refresh) + (set-keymap-parent map magithub-map) + (define-key map [remap magit-visit-thing] #'magithub-issue-visit) + (define-key map [remap magithub-browse-thing] #'magithub-issue-browse) + (define-key map [remap magithub-reply-thing] #'magithub-comment-new) + (define-key map "L" #'magithub-issue-add-labels) + (define-key map "N" #'magithub-issue-personal-note) + (define-key map "C" #'magithub-issue-close) + (define-key map "O" #'magithub-issue-open) map) "Keymap for `magithub-issue' sections.") -(defvar magit-magithub-issue-list-section-map +(defvar magit-magithub-issues-list-section-map (let ((map (make-sparse-keymap))) - (define-key map [remap magit-visit-thing] #'magithub-issue-browse) + (set-keymap-parent map magithub-map) + (define-key map [remap magit-visit-thing] #'magithub-issue-visit) + (define-key map [remap magithub-browse-thing] #'magithub-issue-browse) (define-key map [remap magit-refresh] #'magithub-issue-refresh) map) - "Keymap for `magithub-issue-list' sections.") + "Keymap for `magithub-issues-list' sections.") + +(defvar magit-magithub-pull-request-section-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map magit-magithub-issues-list-section-map) + (define-key map [remap magithub-issue-visit] #'magithub-pull-visit) + (define-key map [remap magithub-issue-browse] #'magithub-pull-browse) + map) + "Keymap for `magithub-pull-request' sections.") -(defvar magit-magithub-pull-request-list-section-map +(defvar magit-magithub-pull-requests-list-section-map (let ((map (make-sparse-keymap))) - (define-key map [remap magit-visit-thing] #'magithub-issue-browse) + (set-keymap-parent map magithub-map) + (define-key map [remap magit-visit-thing] #'magithub-pull-visit) + (define-key map [remap magithub-browse-thing] #'magithub-pull-browse) (define-key map [remap magit-refresh] #'magithub-issue-refresh) map) "Keymap for `magithub-pull-request-list' sections.") -(defun magithub--issues-of-type (type) - "Filter `magithub--issue-list' for issues of type TYPE." - (-filter (lambda (i) (eq (plist-get i :type) type)) - (magithub--issue-list))) - -(defun magithub-issues () - "Return a list of issue objects that are actually issues." - (magithub--issues-of-type 'issue)) - -(defun magithub-pull-requests () - "Return a list of issue objects that are actually pull requests." - (magithub--issues-of-type 'pull-request)) +;; By maintaining these as lists of functions, we're setting +;; ourselves up to be able to dynamically apply new filters from the +;; status buffer (e.g., 'bugs' or 'questions' assigned to me) +(defcustom magithub-issue-issue-filter-functions nil + "List of functions that filter issues. +Each function will be supplied a single issue object. If any +function returns nil, the issue will not be listed in the status +buffer." + :type '(repeat function) + :group 'magithub) + +(defcustom magithub-issue-pull-request-filter-functions nil + "List of functions that filter pull-requests. +Each function will be supplied a single issue object. If any +function returns nil, the issue will not be listed in the status +buffer." + :type '(repeat function) + :group 'magithub) + +(defun magithub-issue-add-labels (issue labels) + "Update ISSUE's labels to LABELS." + (interactive + (when (magithub-verify-manage-labels t) + (let* ((fmt (lambda (l) (alist-get 'name l))) + (issue (or (thing-at-point 'github-issue) + (thing-at-point 'github-pull-request))) + (current-labels (alist-get 'labels issue)) + (to-remove (magithub--completing-read-multiple + "Remove labels: " current-labels fmt))) + (setq current-labels (cl-set-difference current-labels to-remove)) + (list issue (magithub--completing-read-multiple + "Add labels: " (magithub-label-list) fmt + nil nil current-labels))))) + (when (magithub-request + (ghubp-patch-repos-owner-repo-issues-number + (magithub-repo) issue `((labels . ,labels)))) + (setcdr (assq 'labels issue) labels)) + (when (derived-mode-p 'magit-status-mode) + (magit-refresh))) +;;;###autoload (defun magithub-issue--insert-issue-section () "Insert GitHub issues if appropriate." - (magithub-with-proxy (magithub-proxy-default-proxy) - (when (magithub-usable-p) - (-when-let (issues (magithub-issues)) - (magit-insert-section (magithub-issue-list) - (magit-insert-heading "Issues:") - (mapc #'magithub-issue--insert issues) - (insert ?\n)))))) - + (when (and (magithub-settings-include-issues-p) + (magithub-usable-p) + (alist-get 'has_issues (magithub-repo))) + (magithub-issue--insert-generic-section + (magithub-issues-list) + "Issues" + (magithub-issues) + magithub-issue-issue-filter-functions))) + +;;;###autoload (defun magithub-issue--insert-pr-section () "Insert GitHub pull requests if appropriate." - (magithub-feature-maybe-idle-notify - 'pull-request-merge - 'pull-request-checkout) - (magithub-with-proxy (magithub-proxy-default-proxy) - (when (magithub-usable-p) - (-when-let (pull-requests (magithub-pull-requests)) - (magit-insert-section (magithub-pull-request-list) - (magit-insert-heading "Pull Requests:") - (mapc #'magithub-issue--insert pull-requests) - (insert ?\n)))))) + (when (and (magithub-settings-include-pull-requests-p) + (magithub-usable-p)) + (magithub-feature-maybe-idle-notify + 'pull-request-merge) + (magithub-issue--insert-generic-section + (magithub-pull-requests-list) + "Pull Requests" + (magithub-pull-requests) + magithub-issue-pull-request-filter-functions))) + +(defmacro magithub-issue--insert-generic-section + (spec title list filters) + (let ((sym-filtered (cl-gensym))) + `(when-let ((,sym-filtered (magithub-filter-all ,filters ,list))) + (magit-insert-section ,spec + (insert (format "%s%s:" + (propertize ,title 'face 'magit-section-heading) + (if ,filters + (propertize " (filtered)" 'face 'magit-dimmed) + ""))) + (magit-insert-heading) + (magithub-issue-insert-sections ,sym-filtered) + (insert ?\n))))) + +(defun magithub-issue-browse (issue) + "Visits ISSUE in the browser. +Interactively, this finds the issue at point." + (interactive (list (magithub-interactive-issue))) + (magithub-issue--browse issue)) + +(defun magithub-issue-visit (issue) + "Visits ISSUE in Emacs. +Interactively, this finds the issue at point." + (interactive (list (magithub-interactive-issue))) + (magithub-issue-view issue)) + +(defun magithub-pull-browse (pr) + "Visits PR in the browser. +Interactively, this finds the pull request at point." + (interactive (list (magithub-interactive-pull-request))) + (magithub-issue--browse pr)) + +(defun magithub-pull-visit (pr) + "Visits PR in Emacs. +Interactively, this finds the pull request at point." + (interactive (list (magithub-interactive-pull-request))) + (magithub-issue-view pr)) + +(defun magithub-issue--browse (issue-or-pr) + "Visits ISSUE-OR-PR in the browser. +Interactively, this finds the issue at point." + (when-let ((url (alist-get 'html_url issue-or-pr))) + (browse-url url))) (defun magithub-repolist-column-issue (_id) "Insert the number of open issues in this repository." - (number-to-string (length (magithub-issues)))) + (when (magithub-usable-p) + (number-to-string (length (magithub-issues))))) (defun magithub-repolist-column-pull-request (_id) "Insert the number of open pull requests in this repository." - (number-to-string (length (magithub-pull-requests)))) - -(defun magithub-pull-request--format-pr-for-read (pr) - "Format pull request PR as string suitable for completion." - (format "%3d %s" (plist-get pr :number) (plist-get pr :title))) - -(defun magithub-pull-request--completing-read-list () - "Return an alist of PR-strings to full pull-request issue objects. -See `magithub-pull-request--format-pr-for-am'." - (-when-let (pr-list (magithub-pull-requests)) - (-zip-pair - (mapcar #'magithub-pull-request--format-pr-for-read pr-list) - pr-list))) - -(defun magithub-pull-request-at-point () - "The pull request object at point (or nil)." - (when (derived-mode-p 'magit-status-mode) - (-when-let* ((s (magit-current-section)) - (v (magit-section-value s))) - (and (listp v) - (eq (plist-get v :type) 'pull-request) - v)))) - -(defun magithub-pull-request--completing-read () - "Complete over all open pull requests returning its issue object. -If point is on a pull-request object, that object is selected by -default." - (let ((prs (magithub-pull-request--completing-read-list)) current-pr) - (-when-let (tap (magithub-pull-request-at-point)) - (when (and (listp tap) (eq (plist-get tap :type) 'pull-request)) - (setq current-pr (magithub-pull-request--format-pr-for-read tap)))) - (cdr (assoc (completing-read "Pull request: " prs nil t current-pr) prs)))) - -(defun magithub-pull-request-checkout (pull-request) - "Checkout PULL-REQUEST as a local branch." - (interactive (list (magithub-pull-request--completing-read))) - (-when-let (url (plist-get pull-request :url)) - (magithub-with-hub - (magit-checkout url)) - (dolist (var-val `(("URL" . ,url) - ("ID" . ,(plist-get pull-request :number)))) - (magit-set (cdr var-val) - "branch" (magit-get-current-branch) - (concat "magithubPullRequest" (car var-val)))))) - -(defun magithub-pull-request-merge (pull-request &optional args) - "Merge PULL-REQUEST with ARGS. -See `magithub-pull-request--completing-read'. If point is on a -pull-request object, that object is selected by default." - (interactive (list (magithub-pull-request--completing-read) - (magit-am-arguments))) - (unless (member pull-request (magithub-pull-requests)) - (user-error "Unknown pull request %S" pull-request)) - (magithub-with-hub - (magit-run-git-sequencer "am" args (plist-get pull-request :url))) - (message "#%d has been applied" (plist-get pull-request :number))) - -;;; Hook into the status buffer -(magithub--deftoggle magithub-toggle-issues - magit-status-sections-hook #'magithub-issue--insert-issue-section "issues") -(magithub--deftoggle magithub-toggle-pull-requests - magit-status-sections-hook #'magithub-issue--insert-pr-section "pull requests") - -(when (executable-find magithub-hub-executable) - (magithub-toggle-pull-requests) - (magithub-toggle-issues)) + (when (magithub-usable-p) + (number-to-string (length (magithub-pull-requests))))) + +;;; Pull Request handling + + +(defun magithub-pull-request (repo number) + "Retrieve a pull request in REPO by NUMBER." + (magithub-cache :issues + `(magithub-request + (ghubp-get-repos-owner-repo-pulls-number + ',repo '((number . ,number)))) + :message + (format "Getting pull request %s#%d..." + (magithub-repo-name repo) + number))) + +(defun magithub-remote-fork-p (remote) + "True if REMOTE is a fork." + (thread-last remote + (magithub-repo-from-remote) + (alist-get 'fork))) + +(defun magithub-pull-request-checked-out (pull-request) + "True if PULL-REQUEST is currently checked out." + (let-alist pull-request + (let ((remote .user.login) + (branch .head.ref)) + (and (magit-remote-p remote) + (magithub-remote-fork-p remote) + (magit-branch-p branch) + (string= remote (magit-get-push-remote branch)))))) + +;; (make-obsolete 'magithub-pull-request-checkout 'magit-checkout-pull-request "0.1.6") +;; (defalias 'magithub-pull-request-checkout #'magit-checkout-pull-request) (provide 'magithub-issue) ;;; magithub-issue.el ends here diff --git a/magithub-label.el b/magithub-label.el new file mode 100644 index 0000000..c4d5e66 --- /dev/null +++ b/magithub-label.el @@ -0,0 +1,176 @@ +;;; magithub-labels.el --- -*- lexical-binding: t; -*- + +;; Copyright (C) 2017-2018 Sean Allred + +;; Author: Sean Allred + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;;; Code: + +(require 'thingatpt) +(require 'ghub+) + +(require 'magithub-core) + +(defvar magit-magithub-label-section-map + (let ((m (make-sparse-keymap))) + (set-keymap-parent m magithub-map) + (define-key m [remap magit-visit-thing] #'magithub-label-visit) + (define-key m [remap magit-delete-thing] #'magithub-label-remove) + (define-key m [remap magit-section-toggle] (lambda () (interactive))) + (define-key m [remap magithub-browse-thing] #'magithub-label-browse) + (define-key m [remap magithub-add-thing] #'magithub-label-add) + m) + "Keymap for label sections.") + +(defun magithub-label-list () + "Return a list of issue and pull-request labels." + (magithub-cache :label + `(magithub-request + (ghubp-unpaginate + (ghubp-get-repos-owner-repo-labels + ',(magithub-repo)))) + :message + "Loading labels...")) + +(defun magithub-label-read-labels (prompt &optional default) + "Read some issue labels and return a list of strings. +Available issues are provided by `magithub-label-list'. + +DEFAULT is a list of pre-selected labels. These labels are not +prompted for again." + (let ((remaining-labels + (cl-set-difference (magithub-label-list) default + :test (lambda (a b) + (= (alist-get 'name a) + (alist-get 'name b)))))) + (magithub--completing-read-multiple + prompt remaining-labels + (lambda (l) (alist-get 'name l))))) + +(defalias 'magithub-label-visit #'magithub-label-browse) +(defun magithub-label-browse (label) + "Visit LABEL with `browse-url'. +In the future, this will likely be replaced with a search on +issues and pull requests with the label LABEL." + (interactive (list (thing-at-point 'github-label))) + (unless label + (user-error "No label found at point to browse")) + (unless (string= (ghubp-host) ghub-default-host) + (user-error "Label browsing not yet supported on GitHub Enterprise; pull requests welcome!")) + (let-alist (magithub-repo) + (browse-url (format "%s/%s/%s/labels/%s" + (ghubp-base-html-url) + .owner.login .name (alist-get 'name label))))) + +(defcustom magithub-label-color-replacement-alist nil + "Make certain label colors easier to see. +In your theme, you may find that certain colors are very +difficult to see. Customize this list to map GitHub's label +colors to their Emacs replacements." + :group 'magithub + :type '(alist :key-type color :value-type color)) + +(defun magithub-label--get-display-color (label) + "Gets the display color for LABEL. +Respects `magithub-label-color-replacement-alist'." + (let ((original (concat "#" (alist-get 'color label)))) + (if-let ((color (assoc-string original magithub-label-color-replacement-alist t))) + (cdr color) + original))) + +(defun magithub-label-propertize (label) + "Propertize LABEL according to its color. +The face used is dynamically calculated, but it always inherits +from `magithub-label'. Customize that to affect all labels." + (propertize (alist-get 'name label) + 'face (list :foreground (magithub-label--get-display-color label) + :inherit 'magithub-label))) + +(defun magithub-label-color-replace (label new-color) + "For LABEL, define a NEW-COLOR to use in the buffer." + (interactive + (list (thing-at-point 'github-label) + (magithub-core-color-completing-read "Replace label color: "))) + (let ((label-color (concat "#" (alist-get 'color label)))) + (if-let ((cell (assoc-string label-color magithub-label-color-replacement-alist))) + (setcdr cell new-color) + (push (cons label-color new-color) + magithub-label-color-replacement-alist))) + (when (magithub-confirm-no-error 'label-save-customized-colors) + (customize-save-variable 'magithub-label-color-replacement-alist + magithub-label-color-replacement-alist + "Auto-saved by `magithub-label-color-replace'")) + (when (derived-mode-p 'magit-status-mode) + (magit-refresh))) + +(defun magithub-label--verify-manage () + (or (magithub-repo-push-p) + (user-error "You don't have permission to manage labels in this repository"))) + +(defun magithub-label-remove (issue label) + "From ISSUE, remove LABEL." + (interactive (and (magithub-label--verify-manage) + (list (thing-at-point 'github-issue) + (thing-at-point 'github-label)))) + (unless issue + (user-error "No issue here")) + (unless label + (user-error "No label here")) + (let-alist label + (magithub-confirm 'remove-label .name) + (prog1 (magithub-request + (ghubp-delete-repos-owner-repo-issues-number-labels-name + (magithub-issue-repo issue) issue label)) + (magithub-cache-without-cache :issues + (magit-refresh-buffer))))) + +(defun magithub-label-add (issue labels) + "To ISSUE, add LABELS." + (interactive (list (thing-at-point 'github-issue) + (magithub-label-read-labels "Add labels: "))) + (if (not (and issue labels)) + (user-error "No issue/labels") + (magithub-confirm 'add-label + (s-join "," (ghubp-get-in-all '(name) labels)) + (magithub-repo-name (magithub-issue-repo issue)) + (alist-get 'number issue)) + (prog1 (magithub-request + (ghubp-post-repos-owner-repo-issues-number-labels + (magithub-issue-repo issue) issue labels)) + (magithub-cache-without-cache :issues + (magit-refresh))))) + +(defun magithub-label-insert (label) + "Insert LABEL into the buffer. +If you need to insert many labels, use +`magithub-label-insert-list'." + (magit-insert-section (magithub-label label) + (insert (magithub-label-propertize label)))) + +(defun magithub-label-insert-list (label-list) + "Insert LABEL-LIST intro the buffer." + (if (null label-list) + (magit-insert-section (magithub-label) + (insert (propertize "none" 'face 'magit-dimmed))) + (while label-list + (magithub-label-insert (pop label-list)) + (when label-list + (insert " "))))) + +(provide 'magithub-label) +;;; magithub-labels.el ends here diff --git a/magithub-notification.el b/magithub-notification.el new file mode 100644 index 0000000..9223039 --- /dev/null +++ b/magithub-notification.el @@ -0,0 +1,173 @@ +;;; magithub-notification.el --- notification handling -*- lexical-binding: t; -*- + +;; Copyright (C) 2017-2018 Sean Allred + +;; Author: Sean Allred +;; Keywords: lisp + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; View and interact with notifications. + +;;; Code: + +(require 'thingatpt) +(require 'magit-section) + +(require 'magithub-core) + +(defvar magit-magithub-notification-section-map + (let ((m (make-sparse-keymap))) + (set-keymap-parent m magithub-map) + (define-key m [remap magit-visit-thing] #'magithub-notification-visit) + (define-key m [remap magithub-browse-thing] #'magithub-notification-browse) + (define-key m [remap magit-refresh] #'magithub-notification-refresh) + m)) + +(defvar magit-magithub-notifications-section-map + (let ((m (make-sparse-keymap))) + (set-keymap-parent m magithub-map) + (define-key m [remap magit-refresh] #'magithub-notification-refresh) + m)) + +(defun magithub-notifications (&optional include-read only-participating since before) + "Get notifications for the currently-authenticated user. +If INCLUDE-READ is non-nil, read notifications are returned as +well. + +If ONLY-PARTICIPATING is non-nil, only return notifications that +the user is directly participating in. + +If SINCE/BEFORE are non-nil, they are time values. Only +notifications received since/before this value will be returned. +See also Info node `(elisp)Time of Day'." + (let (args) + (when include-read + (push '(:all "true") args)) + (when only-participating + (push '(:participating "true") args)) + (when since + (push `(:since ,(format-time-string "%FT%T%z" since)) args)) + (when before + (push `(:before ,(format-time-string "%FT%T%z" before)) args)) + (magithub-cache :notification + `(magithub-request + (ghubp-unpaginate + (ghubp-get-notifications ,@(apply #'append args))))))) + +(defun magithub-notification-refresh () + (interactive) + (magithub-cache-without-cache :notification + (magit-refresh)) + (message "(magithub) notifications refreshed")) + +(defun magithub-notification-read-p (notification) + "Non-nil if NOTIFICATION has been read." + (not (magithub-notification-unread-p notification))) + +(defun magithub-notification-unread-p (notification) + "Non-nil if NOTIFICATION has been not been read." + (alist-get 'unread notification)) + +(defconst magithub-notification-reasons + '(("assign" . "You were assigned to the Issue.") + ("author" . "You created the thread.") + ("comment" . "You commented on the thread.") + ("invitation" . "You accepted an invitation to contribute to the repository.") + ("manual" . "You subscribed to the thread (via an Issue or Pull Request).") + ("mention" . "You were specifically @mentioned in the content.") + ("state_change" . "You changed the thread state (for example, closing an Issue or merging a Pull Request).") + ("subscribed" . "You're watching the repository.") + ("team_mention" . "You were on a team that was mentioned.")) + "Human-readable description of possible notification reasons. +Stripped from the GitHub API Docs: + + URL `https://developer.github.com/v3/activity/notifications/#notification-reasons'.") + +(defun magithub-notification-reason (notification &optional expanded) + "Get the reason NOTIFICATION exists. +If EXPANDED is non-nil, use `magithub-notification-reasons' to +get a more verbose explanation." + (let-alist notification + (if expanded + (cdr (assoc-string .reason magithub-notification-reasons + "(Unknown)")) + .reason))) + +(declare-function magithub-issue-view "magithub-issue-view" (issue)) +(defalias 'magithub-notification-visit #'magithub-notification-browse) +(defun magithub-notification-browse (notification) + "Visits the URL pointed to by NOTIFICATION." + (interactive (list (thing-at-point 'github-notification))) + (magithub-request + (if notification + (let-alist notification + (cond + ((member .subject.type '("Issue" "PullRequest")) + (ghubp-patch-notifications-threads-id notification) + (require 'magithub-issue-view) + (magithub-issue-view (ghubp-follow-get .subject.url))) + (t (if-let ((url (or .subject.latest_comment_url .subject.url)) + (html-url (alist-get 'html_url (ghubp-follow-get url)))) + (browse-url html-url) + (user-error "No target URL found"))))) + (user-error "No notification here")))) + +(defvar magithub-notification-details-hook + '(magithub-notification-detail-insert-type + magithub-notification-detail-insert-updated + magithub-notification-detail-insert-expanded-reason) + "Detail functions for notification-type sections. +These details appear under notifications as expandable content. + +Each function takes the notification object as its only +argument.") + +(defun magithub-notification-insert-section (notification) + "Insert NOTIFICATION as a section into the buffer." + (let-alist notification + (magit-insert-section (magithub-notification notification (not .unread)) + (magit-insert-heading + (format "%-12s %s" + (propertize (magithub-notification-reason notification) + 'face 'magithub-notification-reason + 'help-echo (magithub-notification-reason notification t)) + (propertize (concat .subject.title "\n") + 'face (if .unread 'highlight)))) + (run-hook-with-args 'magithub-notification-details-hook notification)))) + +(defun magithub-notification-detail-insert-type (notification) + "Insert NOTIFICATION's type." + (let-alist notification + (insert (format "%-12s %s\n" "Type:" + (propertize .subject.type 'face 'magit-dimmed))))) + +(defun magithub-notification-detail-insert-updated (notification) + "Insert a timestamp of when NOTIFICATION was last updated." + (let-alist notification + (insert (format "%-12s %s\n" "Updated:" + (propertize .updated_at 'face 'magit-dimmed))))) + +(defun magithub-notification-detail-insert-expanded-reason (notification) + "Insert NOTIFICATION's expanded reason. +See also `magithub-notification-reasons'." + (insert (format "%-12s %s\n" "Reason:" + (propertize (or (magithub-notification-reason notification t) + "(no description available)") + 'face 'magit-dimmed)))) + +(provide 'magithub-notification) +;;; magithub-notification.el ends here diff --git a/magithub-orgs.el b/magithub-orgs.el new file mode 100644 index 0000000..395ab5c --- /dev/null +++ b/magithub-orgs.el @@ -0,0 +1,36 @@ +;;; magithub-orgs.el --- Organization handling -*- lexical-binding: t; -*- + +;; Copyright (C) 2016-2018 Sean Allred + +;; Author: Sean Allred +;; Keywords: tools + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; Utilities for dealing with organizations. + +;;; Code: + +(require 'magithub-core) + +(defun magithub-orgs-list () + "List organizations for the currently authenticated user." + (magithub-cache :user-demographics + `(magithub-request + (ghubp-get-user-orgs)))) + +(provide 'magithub-orgs) +;;; magithub-orgs.el ends here diff --git a/magithub-proxy.el b/magithub-proxy.el deleted file mode 100644 index 59a157b..0000000 --- a/magithub-proxy.el +++ /dev/null @@ -1,79 +0,0 @@ -;;; magithub-proxy.el --- Fake repository context -*- lexical-binding: t; -*- - -;; Copyright (C) 2017 Sean Allred - -;; Author: Sean Allred -;; Keywords: tools - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Commentary: - -;; Jump to issues from `magit-status'! - -;;; Code: - -(require 'magit) - -(defmacro magithub-with-proxy (remote &rest body) - "Using REMOTE as `origin', run BODY." - (declare (indent 1)) - `(magithub--proxy-with-remote ,remote (lambda () ,@body))) - -(defconst magithub--proxy-remote-url-config - '("remote" "origin" "url") - "The config path to origin's URL.") - -(defun magithub--proxy-current-remote () - "The current remote of `origin'." - (apply #'magit-get magithub--proxy-remote-url-config)) - -(defun magithub--proxy-set-remote (remote) - "Set the remote of `origin'." - (apply #'magit-set remote magithub--proxy-remote-url-config)) - -(defun magithub--proxy-with-remote (remote f) - "Using REMOTE as `origin', execute function F. -F should take no arguments." - (if remote - (let ((real-origin-remote (magithub--proxy-current-remote))) - (prog2 (magithub--proxy-set-remote remote) - (condition-case err - (funcall f) - ;; if F throws errors, make sure to restore the real remote - (error (magithub--proxy-set-remote real-origin-remote) - (error err))) - (magithub--proxy-set-remote real-origin-remote))) - (funcall f))) - -(defun magithub-proxy-default-proxy () - "Get the default proxy for this repository." - (magit-get "magithub" "proxy")) - -(defun magithub-proxy-set-default (remote) - "Set REMOTE as the proxy for this repository." - (interactive (list (ignore-errors - (magit-read-url - "Please enter the remote url to use for Magithub functionality" - (or (magithub-proxy-default-proxy) - (magit-get "remote" (magit-get "branch" "master" "remote") "url") - (magithub--proxy-current-remote)))))) - (if (or (string= remote "") - (string= remote (magithub--proxy-current-remote))) - (magit-set nil "magithub" "proxy") - (magit-set remote "magithub" "proxy")) - (magithub-issue-refresh)) - -(provide 'magithub-proxy) -;;; magithub-proxy.el ends here diff --git a/magithub-repo.el b/magithub-repo.el new file mode 100644 index 0000000..9432835 --- /dev/null +++ b/magithub-repo.el @@ -0,0 +1,51 @@ +;;; magithub-repo.el --- repo tools -*- lexical-binding: t; -*- + +;; Copyright (C) 2017-2018 Sean Allred + +;; Author: Sean Allred +;; Keywords: lisp + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; Basic tools for working with repositories. + +;;; Code: + +(require 'magit) +(require 'thingatpt) + +(require 'magithub-core) + +(defvar magit-magithub-repo-section-map + (let ((m (make-sparse-keymap))) + (set-keymap-parent m magithub-map) + (define-key m [remap magithub-browse-thing] #'magithub-repo-browse) + m)) + +(defun magithub-repo-browse (repo) + (interactive (list (thing-at-point 'github-repo))) + (unless repo + (user-error "No repository found at point")) + (let-alist repo + (browse-url .html_url))) + +(defun magithub-repo-data-dir (repo) + (let-alist repo + (expand-file-name (format "%s/%s/" .owner.login .name) + magithub-dir))) + +(provide 'magithub-repo) +;;; magithub-repo.el ends here diff --git a/magithub-settings.el b/magithub-settings.el new file mode 100644 index 0000000..eabd5d4 --- /dev/null +++ b/magithub-settings.el @@ -0,0 +1,390 @@ +;;; magithub-settings.el --- repo-specific user settings -*- lexical-binding: t; -*- + +;; Copyright (C) 2018 Sean Allred + +;; Author: Sean Allred +;; Keywords: tools + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;;; Code: + +(require 'magit) + +(defconst magithub-settings-section "magithub" + "This string prefixes all Magithub-related git settings.") +(defconst magithub-settings-prefix "magithub" + "This string prefixes all Magithub-related git settings.") + +(defmacro magithub-settings--simple (popup key variable docstring choices default) + (declare (indent 3) (doc-string 4)) + (unless (stringp variable) + (error "VARIABLE must be a string: %S" variable)) + (let* ((variable (concat magithub-settings-section "." variable)) + (Nset (concat "magithub-settings--set-" variable)) + (Nfmt (concat "magithub-settings--format-" variable))) + (let ((Sset (intern Nset)) + (docstring (format "%s\n\nThis is the Git variable %S." docstring variable))) + `(progn + (transient-define-infix ,Sset () ,docstring + :class 'magit--git-variable:choices + :variable ,variable + :choices ,choices + :default ,default) + (transient-define-infix ,(intern Nfmt) () ,(format "See `%s'." Nset) + :class 'magit--git-variable:choices + :variable ,variable + :choices ,choices + :default ,default) + (transient-append-suffix ',popup "h" + '(,key ,variable ,Sset)) + ,variable)))) + +(defun magithub-settings--value-or (variable default &optional accessor) + (declare (indent 2)) + (if (magit-get variable) + (funcall (or accessor #'magit-get) variable) + default)) + +;;;###autoload (autoload 'magithub-settings-popup "magithub-settings" nil t) +(transient-define-prefix magithub-settings-popup () + "Popup console for managing Magithub settings." + ["test" + ("h" "Ask for help on Gitter" magithub--meta-help)] + ) + +(magithub-settings--simple magithub-settings-popup "e" "enabled" + "Enable/disable all Magithub functionality." + '("true" "false") "true") + +(defun magithub-enabled-p () + "Returns non-nil if Magithub content is available." + (magithub-settings--value-or "magithub.enabled" t + #'magit-get-boolean)) + +(magithub-settings--simple magithub-settings-popup "o" "online" + "Controls whether Magithub is online or offline. + +- `true': requests are made to GitHub for missing data +- `false': no requests are made to GitHub + +In both cases, when there is data in the cache, that data is +used. Refresh the buffer with a prefix argument to disregard the +cache while refreshing: \\\\[universal-argument] \\[magit-refresh]" + '("true" "false") "true") + +(defun magithub-online-p () + "See `magithub-settings--set-magithub.online'. +Returns the value as t or nil." + (magithub-settings--value-or "magithub.online" t + #'magit-get-boolean)) + + +(magithub-settings--simple magithub-settings-popup "s" "status.includeStatusHeader" + "When true, the project status header is included in +`magit-status-headers-hook'." + '("true" "false") "true") + +(defun magithub-settings-include-status-p () + "Non-nil if the project status header should be included." + (magithub-settings--value-or "magithub.status.includeStatusHeader" t + #'magit-get-boolean)) + + +(magithub-settings--simple magithub-settings-popup "i" "status.includeIssuesSection" + "When true, project issues are included in +`magit-status-sections-hook'." + '("true" "false") "true") + +(defun magithub-settings-include-issues-p () + "Non-nil if the issues section should be included." + (magithub-settings--value-or "magithub.status.includeIssuesSection" t + #'magit-get-boolean)) + + +(magithub-settings--simple magithub-settings-popup "p" "status.includePullRequestsSection" + "When true, project pull requests are included in +`magit-status-sections-hook'." + '("true" "false") "true") + +(defun magithub-settings-include-pull-requests-p () + "Non-nil if the pull requests section should be included." + (magithub-settings--value-or "magithub.status.includePullRequestsSection" t + #'magit-get-boolean)) + + +(magithub-settings--simple magithub-settings-popup "x" "contextRemote" + "Use REMOTE as the proxy. +When set, the proxy is used whenever a GitHub repository is needed." + (magit-list-remotes) "origin") + +(defun magithub-settings-context-remote () + "Determine the correct remote to use for issue-tracking." + (magithub-settings--value-or "magithub.contextRemote" "origin")) + +(defvar magithub-confirmation + ;; todo: future enhancement - could allow prompt message to be a function. + '((pre-submit-pr short "You are about to create a pull request to merge branch `%s' into %s:%s; is this what you wanted to do?") + (submit-pr long "Are you sure you want to submit this pull request?") + (submit-pr-from-issue long "Are you sure you wish to create a PR based on %s by merging `%s' into `%s'?") + (pr-allow-maintainers-to-submit short "Allow maintainers to modify this pull request?") + (submit-issue long "Are you sure you want to submit this issue?") + (remove-label short "Remove label {%s} from this issue?") + (add-label short "Add label(s) {%s} to %s#%s?") + (create-repo-as-private long "Will this be a private repository?") + (init-repo-after-create short "Not inside a Git repository; initialize one here?") + (fork long "Fork this repository?") + (fork-create-spinoff short "Create a spinoff branch?") + (fork-add-me-as-remote short "Add %s as a remote in this repository?") + (fork-set-upstream-to-me short "Set upstream to %s?") + (clone long "Clone %s to %s?") + (clone-fork-set-upstream-to-parent short "This repository appears to be a fork of %s; set upstream to that remote?") + (clone-fork-set-proxy-to-upstream short "Use upstream as a proxy for issues, etc.?") + (clone-open-magit-status short "%s/%s has finished cloning to %s. Open?") + (clone-create-directory short "%s does not exist. Create it?") + (ci-refresh-when-offline short "Magithub offline; refresh statuses anyway?") + (refresh short "Refresh GitHub data?") + (refresh-when-API-unresponsive short "GitHub doesn't seem to be responding, are you sure?") + (label-save-customized-colors short "Save customization?") + (user-email short "Email @%s at \"%s\"?") + (user-email-self short "Email yourself?") + (assignee-add long "Assign '%s' to %s#%d?") + (assignee-remove long "Remove '%s' from %s#%d?") + (comment short "Submit this comment to %s?") + (comment-edit short "Commit this edit?") + (comment-delete long "Are you sure you wish to delete this comment?") + (report-error short "%s Report? (A bug report will be placed in your clipboard.)") + (issue-reopen short "Reopen %s?") + (issue-close short "Close %s?")) + "Alist of actions/decisions to their default behaviors and associated prompts. + +These behaviors can be overridden with (man)git-config. + +A behavior is one of the following symbols: + + `long' + use `yes-or-no-p' to confirm each time + + `short' + use `y-or-n-p' to confirm each time + + `allow' + always allow action + + `deny' + always deny action") + +(defun magithub-confirm (action &rest prompt-format-args) + "Confirm ACTION using Git config settings. +See `magithub--confirm'." + (magithub--confirm action prompt-format-args nil)) + +(defun magithub-confirm-no-error (action &rest prompt-format-args) + "Confirm ACTION using Git config settings. +See `magithub--confirm'." + (magithub--confirm action prompt-format-args t)) + +(defun magithub-settings--from-confirmation-action (action) + "Create a magithub.confirm.* setting from ACTION." + (concat + magithub-settings-section + ".confirm." + (let ((pascal-case (replace-regexp-in-string "-" "" (upcase-initials (symbol-name action))))) + ;; we have PascalCase, we want camelCase + (concat (downcase (substring pascal-case 0 1)) + (substring pascal-case 1))))) + +(defvar magithub-confirm-y-or-n-p-map + (let ((m (make-keymap))) + (define-key m (kbd "C-g") 'quit) ;don't know how to remap keyboard-quit here + (define-key m "q" 'quit) + (define-key m (kbd "C-u") 'cycle) + (define-key m "y" 'allow) + (define-key m "n" 'deny) + m)) + +(defvar magithub-confirm-yes-or-no-p-map + (let ((m (make-sparse-keymap))) + (set-keymap-parent m minibuffer-local-map) + (define-key m [remap universal-argument] #'magithub--confirm-cycle-set-default-interactive) + m)) + +(defvar magithub-confirm--current-cycle nil + "Control how a response should be saved. +This variable should never be set globally; always let-bind it! + + nil + Do not save the response + + `local' + Save response locally + + `global' + Save response globally") + +(defun magithub-confirm-yes-or-no-p (prompt var) + "Like `yes-or-no-p', but optionally save response to VAR." + (let ((p (concat prompt (substitute-command-keys " (yes, no, or \\[universal-argument]*) "))) + magithub-confirm--current-cycle old-cycle done answer changed) + (while (not done) + (setq changed (not (eq old-cycle magithub-confirm--current-cycle)) + old-cycle magithub-confirm--current-cycle + answer (read-from-minibuffer + (magithub--confirm-get-prompt-with-cycle + p var magithub-confirm--current-cycle) + ;; default in what was already entered if the save-behavior changed + (when changed answer) + magithub-confirm-yes-or-no-p-map nil + 'yes-or-no-p-history)) + ;; If the user activated `magithub--confirm-cycle-set-default-interactive', + ;; `magithub-confirm--current-cycle' will have been updated. + (when (and (eq old-cycle magithub-confirm--current-cycle) + (stringp answer)) + (setq answer (downcase (s-trim answer))) + (if (member answer '("yes" "no")) + (setq done t) + (message "Please answer yes or no. ") + (sleep-for 2)))) + (when magithub-confirm--current-cycle + (magithub--confirm-cycle-save-var-value + var (pcase answer + ("yes" "allow") + ("no" "deny")))) + (string= answer "yes"))) + +(defun magithub-confirm-y-or-n-p (prompt var) + "Like `y-or-n-p', but optionally save response to VAR." + (let ((cursor-in-echo-area t) + (newprompt (format "%s (y, n, C-u*) " prompt)) + magithub-confirm--current-cycle done answer varval explain) + (while (not done) + (setq newprompt + (if explain + (format "%s (please answer y or n or use C-u to cycle through and set default answers) " prompt) + (format "%s (y, n, C-u*) " prompt)) + explain nil + answer + (lookup-key magithub-confirm-y-or-n-p-map + (vector + (read-key (magithub--confirm-get-prompt-with-cycle + newprompt var magithub-confirm--current-cycle))))) + (pcase answer + (`quit (keyboard-quit)) + (`cycle (magithub--confirm-cycle-set-default)) + (`allow (setq done t varval "allow")) + (`deny (setq done t varval "deny")) + (_ (setq explain t)))) + (when (stringp varval) + (magithub--confirm-cycle-save-var-value var varval)) + (eq answer 'allow))) + +(defun magithub--confirm-cycle-save-var-value (var val) + "Save VAR with VAL locally or globally. +See `magithub-confirm--current-cycle'." + (pcase magithub-confirm--current-cycle + (`local (magit-set val var)) + (`global (magit-set val "--global" var)))) + +(defun magithub--confirm-cycle-set-default-interactive () + "In `magithub--confirm-yes-or-no-p', update behavior." + (interactive) + (magithub--confirm-cycle-set-default) + (exit-minibuffer)) + +(defun magithub--confirm-cycle-set-default () + (setq magithub-confirm--current-cycle + (cadr (member magithub-confirm--current-cycle + '(nil local global))))) + +(defun magithub--confirm-get-prompt-with-cycle (prompt var cycle) + "Get an appropriate PROMPT associated with VAR for CYCLE. +See `magithub-confirm--current-cycle'." + (propertize + (pcase cycle + (`local (format "%s[and don't ask again: git config %s] " prompt var)) + (`global (format "%s[and don't ask again: git config --global %s] " prompt var)) + (_ prompt)) + 'face 'minibuffer-prompt)) + +(defun magithub--confirm (action prompt-format-args noerror) + "Confirm ACTION using Git config settings. + +When PROMPT-FORMAT-ARGS is non-nil, the prompt piece of ACTION's +confirmation spec is passed through `format' with these +arguments. + +Unless NOERROR is non-nil, denying ACTION will result in a user +error to abort the action. + +This is like `magit-confirm', but a little more powerful. It +might belong in Magit, but we'll see how it goes." + (let ((spec (alist-get action magithub-confirmation)) + var default prompt setting choice) + (unless spec + (magithub-error "No confirmation settings for %S" spec)) + (unless (= 2 (length spec)) + (magithub-error "Spec for %S must have 2 members: %S" action spec)) + (setq default (symbol-name (nth 0 spec)) + prompt (nth 1 spec) + var (magithub-settings--from-confirmation-action action)) + (when prompt-format-args + (setq prompt (apply #'format prompt prompt-format-args))) + (when (and (null noerror) (string= "deny" default)) + (magithub-error (format "The default for %S is deny, but this will cause an error" action))) + + (setq setting (magithub-settings--value-or var default)) + (when (and (string= setting "deny") + (null noerror)) + (let ((raw (magit-git-string "config" "--show-origin" var)) + washed) + (when (string-match (rx bos (group (+ any)) (+ space) (group (+ any)) eos) raw) + (setq washed (format "%s => %s" + (match-string 1 raw) + (match-string 2 raw)))) + (user-error "Abort per %s [%s]" var (or washed raw)))) + + (setq choice + (pcase setting + ("long" (magithub-confirm-yes-or-no-p prompt var)) + ("short" (magithub-confirm-y-or-n-p prompt var)) + ("allow" t) + ("deny" nil))) + + (or choice + (unless noerror + (user-error "Abort"))))) + +(defun magithub-confirm-set-default-behavior (action default &optional globally) + "Set the default behavior of ACTION to DEFAULT. + +If GLOBALLY is non-nil, make this configuration apply globally. + +See `magithub-confirmation' for valid values of DEFAULT." + (unless (alist-get action magithub-confirmation) + (error "Action not defined: %S" action)) + (let* ((var (magithub-settings--from-confirmation-action action)) + (args (list var))) + (when globally + (push "--global" args)) + (apply #'magit-set + (if (memq default '(long short allow deny)) + (symbol-name default) + (error "Invalid default behavior: %S" default)) + args) + default)) + +(provide 'magithub-settings) +;;; magithub-settings.el ends here diff --git a/magithub-user.el b/magithub-user.el new file mode 100644 index 0000000..8aa2371 --- /dev/null +++ b/magithub-user.el @@ -0,0 +1,149 @@ +;;; magithub-user.el --- Inspect users -*- lexical-binding: t; -*- + +;; Copyright (C) 2016-2018 Sean Allred + +;; Author: Sean Allred +;; Keywords: lisp + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; Code for dealing with the current user and other users. + +;;; Code: + +(require 'ghub+) +(require 'cl-lib) +(require 'thingatpt) + +(require 'magithub-core) + +(defvar magit-magithub-user-section-map + (let ((m (make-sparse-keymap))) + (set-keymap-parent m magithub-map) + (define-key m [remap magit-visit-thing] #'magithub-user-visit) + (define-key m [remap magithub-browse-thing] #'magithub-user-browse) + (define-key m "m" #'magithub-user-email) + m)) + +(defvar magit-magithub-assignee-section-map + (let ((m (make-sparse-keymap))) + (set-keymap-parent m magit-magithub-user-section-map) + (define-key m "a" #'magithub-assignee-add) + (define-key m [remap magit-delete-thing] #'magithub-assignee-remove) + m)) + +(defun magithub-user-me () + "Return the currently-authenticated user." + (magithub-cache :user-demographics + `(magithub-request + (ghubp-get-user)) + :message + "user object for the currently-authenticated user")) + +(defun magithub-user (user) + "Return the full object for USER." + (magithub-cache :user-demographics + `(magithub-request + (ghubp-get-users-username ',user)))) + +(defun magithub-assignee--verify-manage () + (or (magithub-repo-push-p) + (user-error "You don't have permission to manage assignees in this repository"))) + +(defun magithub-assignee-add (issue user) + (interactive (when (magithub-assignee--verify-manage) + (let ((issue (magit-section-parent-value (magit-current-section)))) + (list issue + (magithub-user-choose-assignee + "Choose an assignee: " + (magithub-issue-repo issue)))))) + (let-alist `((repo . ,(magithub-issue-repo issue)) + (issue . ,issue) + (user . ,user)) + (magithub-confirm 'assignee-add + .user.login + (magithub-repo-name .repo) + .issue.number) + (prog1 (magithub-request + (ghubp-post-repos-owner-repo-issues-number-assignees + .repo .issue (list .user))) + (let ((sec (magit-current-section))) + (magithub-cache-without-cache :issues + (magit-refresh-buffer)) + (magit-section-show sec))))) + +(defun magithub-assignee-remove (issue user) + (interactive (when (magithub-assignee--verify-manage) + (list (thing-at-point 'github-issue) + (thing-at-point 'github-user)))) + (let-alist `((repo . ,(magithub-issue-repo issue)) + (issue . ,issue) + (user . ,user)) + (magithub-confirm .user.login + (magithub-repo-name .repo) + .issue.number) + (prog1 (magithub-request + (ghubp-delete-repos-owner-repo-issues-number-assignees .repo .issue (list .user))) + (magithub-cache-without-cache :issues + (magit-refresh-buffer))))) + +(defun magithub-user-choose (prompt &optional default-user) + (let (ret-user new-username) + (while (not ret-user) + (setq new-username + (magit-read-string-ns + (concat prompt + (if new-username (format " ['%s' not found]" new-username))) + (alist-get 'login default-user))) + (when-let ((try (condition-case _ + (magithub-request + (ghubp-get-users-username `((login . ,new-username)))) + (ghub-404 nil)))) + (setq ret-user try))) + ret-user)) + +(defun magithub-user-choose-assignee (prompt &optional repo default-user) + (magithub--completing-read + prompt + (magithub-request + (ghubp-get-repos-owner-repo-assignees repo)) + (lambda (user) (let-alist user .login)) + nil t default-user)) + +(defalias 'magithub-user-visit #'magithub-user-browse) +(defun magithub-user-browse (user) + "Open USER on GitHub." + (interactive (list (thing-at-point 'github-user))) + (if user + (browse-url (alist-get 'html_url user)) + (user-error "No user here"))) + +(defun magithub-user-email (user) + "Email USER." + (interactive (list (thing-at-point 'github-user))) + (when (string= (alist-get 'login (magithub-user-me)) + (alist-get 'login user)) + (magithub-confirm 'user-email-self)) + (unless user + (user-error "No user here")) + (let-alist user + (unless .email + (user-error "No email found; target user may be private")) + (magithub-confirm 'user-email .login .email) + (browse-url (format "mailto:%s" .email)))) + +(provide 'magithub-user) +;;; magithub-user.el ends here diff --git a/magithub.el b/magithub.el index 0c8de0b..c6fa5d3 100644 --- a/magithub.el +++ b/magithub.el @@ -1,12 +1,12 @@ ;;; magithub.el --- Magit interfaces for GitHub -*- lexical-binding: t; -*- -;; Copyright (C) 2016-2017 Sean Allred +;; Copyright (C) 2016-2018 Sean Allred ;; Author: Sean Allred ;; Keywords: git, tools, vc ;; Homepage: https://github.com/vermiculus/magithub -;; Package-Requires: ((emacs "24.4") (magit "2.8.0") (git-commit "20160821.1338") (with-editor "20160828.1025") (s "20160711.525")) -;; Package-Version: 0.1 +;; Package-Requires: ((emacs "25") (magit "2.12") (s "1.12.0") (ghub+ "0.3") (git-commit "2.12") (markdown-mode "2.3")) +;; Package-Version: 0.1.7 ;; 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 @@ -23,94 +23,196 @@ ;;; Commentary: -;; Magithub is an interface to GitHub using the `hub' utility [1]. +;; Magithub is a Magit-based interface to GitHub. ;; -;; Integrated into Magit workflows, Magithub allows very easy, very -;; basic GitHub repository management. Supported actions include: +;; Integrated into Magit workflows, Magithub lets you interact with +;; your GitHub repositories and manage your work/play from emacs: ;; -;; - pushing brand-new local repositories up to GitHub -;; - creating forks of existing repositories -;; - submitting pull requests upstream -;; - viewing and creating issues +;; - push brand-new local repositories up to GitHub +;; - create forks of existing repositories +;; - submit pull requests upstream +;; - view and create issues +;; - view, create, and edit comments +;; - view status checks (e.g., Travis CI) +;; - manage labels and assignees +;; - view/visit notifications +;; - write personal notes on issues for reference later +;; - and probably more... ;; ;; Press `H' in the status buffer to get started -- happy hacking! -;; -;; [1]: https://hub.github.com - -;; Requires hub 2.2.8 ;;; Code: (require 'magit) (require 'magit-process) -(require 'magit-popup) -(require 'git-commit) -(require 'with-editor) (require 'cl-lib) (require 's) (require 'dash) +(require 'ghub+) (require 'magithub-core) (require 'magithub-issue) -(require 'magithub-cache) (require 'magithub-ci) -(require 'magithub-proxy) +(require 'magithub-issue-post) +(require 'magithub-issue-tricks) +(require 'magithub-orgs) +(require 'magithub-dash) -(magit-define-popup magithub-dispatch-popup +;;;###autoload (autoload 'magithub-dispatch-popup "magithub" nil t) +(transient-define-prefix magithub-dispatch-popup () "Popup console for dispatching other Magithub popups." - 'magithub-commands - :man-page "hub" - :actions '("Actions" - (?H "Browse on GitHub" magithub-browse) - (?c "Create" magithub-create-popup) - (?f "Fork" magithub-fork-popup) - (?i "Issues" magithub-issues-popup) - (?p "Submit a pull request" magithub-pull-request-popup) - (?x "Use a proxy repository for issues/PRs" magithub-proxy-set-default) - "Meta" - (?` "Toggle Magithub-Status integration" magithub-enabled-toggle) - (?g "Refresh all GitHub data" magithub-refresh) - (?& "Request a feature or report a bug" magithub--meta-new-issue) - (?h "Ask for help on Gitter" magithub--meta-help))) - -(magit-define-popup-action 'magit-dispatch-popup - ?H "Magithub" #'magithub-dispatch-popup ?!) -(define-key magit-status-mode-map - "H" #'magithub-dispatch-popup) - -(magit-define-popup magithub-create-popup - "Popup console for creating GitHub repositories." - 'magithub-commands - :man-page "hub" - :switches '((?p "Mark as private" "-p")) - :actions '((?c "Create this repository" magithub-create)) - :options '((?d "Description" "--description=") - (?h "Homepage" "--homepage="))) - -(magit-define-popup magithub-fork-popup - "Popup console for forking GitHub repositories." - 'magithub-commands - :man-page "hub" - :switches '((?r "Don't add my fork as a remote in this repository" "--no-remote")) - :actions '((?f "Fork the project at origin" magithub-fork))) - -(magit-define-popup magithub-pull-request-popup - "Popup console for creating pull requests on GitHub repositories." - 'magithub-commands - :man-page "hub" - :switches '((?f "Ignore unpushed commits" "-f") - (?o "Open in my browser" "-o")) - :options '((?b "Base branch" "--base=" magit-read-branch) - (?h "Head branch" "--head=" magit-read-branch)) - :actions '((?P "Submit a pull request" magithub-pull-request)) - :default-arguments '("-o")) + [["Variables" + ("C" "Settings..." magithub-settings-popup)] + ["Actions" + ("d" "Dashboard" magithub-dashboard) + ("H" "Browse on GitHub" magithub-browse) + ("c" "Create on GitHub" magithub-create) + ("f" "Fork this repo" magithub-fork) + ("i" "Submit an issue" magithub-issue-new) + ("p" "Submit a pull request" magithub-pull-request-new)] + ["Meta" + ("&" "Request a feature or report a bug" magithub--meta-new-issue) + ("h" "Ask for help on Gitter" magithub--meta-help)]] + ) + +;;;###autoload +(eval-after-load 'magit + '(progn + (require 'transient) + (when (functionp 'magit-am) + (transient-append-suffix 'magit-dispatch "C-h m" + '("H" "Magithub" magithub-dispatch-popup))) + (define-key magit-status-mode-map + "H" #'magithub-dispatch-popup))) (defun magithub-browse () "Open the repository in your browser." (interactive) (unless (magithub-github-repository-p) (user-error "Not a GitHub repository")) - (browse-url (car (magithub--command-output "browse" "-u")))) + (magithub-repo-visit (magithub-repo))) + +(defun magithub-browse-file (file &optional begin end use-default-branch) + "Open FILE in your browser highlighting lines BEGIN to END. + +FILE is a path to relative to the root of the Git repository. + +If FILE and BEGIN/END are not provided, they are detected from +the current context: + + 1. In a file-visiting buffer, the buffer's file context and + active region are used. + + 2. In a dired- or magit-like buffer, the file at point is used. + +If USE-DEFAULT-BRANCH is set (interactively, via prefix +argument), then browse the file at the default branch of the +repository instead of the current HEAD." + (interactive (list nil nil nil current-prefix-arg)) + (magithub-browse-file--url-fn-interactive #'browse-url + file begin end use-default-branch)) + +(defun magithub-browse-file-copy-location-as-kill (file &optional begin end use-default-branch) + "Like `magithub-browse-file', but copy the URL as a kill instead." + (interactive (list nil nil nil current-prefix-arg)) + (magithub-browse-file--url-fn-interactive #'kill-new + file begin end use-default-branch)) + +(defun magithub-browse-file--url-fn-interactive (func file begin end use-default-branch) + "Provides boilerplate for using `magithub-browse-file--url'." + (declare (indent 1)) + (let* ((args (magithub-browse-file--get-file-and-region file begin end)) + (file (plist-get args :file)) + (begin (plist-get args :begin)) + (end (plist-get args :end))) + (unless file + (user-error "Could not detect a file at point")) + (let ((default-directory (if (file-directory-p file) + file + (file-name-directory file)))) + (unless (magithub-github-repository-p) + (user-error "Not a GitHub repository")) + (funcall func (magithub-browse-file--url + file begin end use-default-branch))))) + +(defun magithub-browse-file--url (file begin end use-default-branch) + "Wrapper for `magithub-browse-file--url2' providing sensible defaults." + (magithub-browse-file--url2 + (magithub-repo) (magit-toplevel) file + (or (and use-default-branch 'default-branch) + (magit-rev-parse "HEAD")) + begin end)) + +(defun magithub-browse-file--url2 (repo toplevel file rev begin end) + "For REPO cloned at TOPLEVEL, calculate the URL for FILE at REV. +If provided, the region from lines BEGIN and END will be highlighted." + (let-alist repo + (setq file (string-remove-prefix toplevel file)) + (if (eq rev 'default-branch) + (setq rev .default_branch)) + (if (string-empty-p file) + (format "%s/tree/%s" .html_url rev) + (format "%s/blob/%s/%s%s" .html_url rev file + (or (magithub-browse-file--get-anchor begin end) ""))))) + +(defun magithub-browse-file--get-file-and-region (file begin end) + "Get an appropriate file at point. +FILE, BEGIN, and END are override values." + (let ((region-active-p (region-active-p))) + (list :file + (expand-file-name + (or file + buffer-file-name + (and (derived-mode-p 'dired-mode) + (or (dired-file-name-at-point) + default-directory)) + (and (derived-mode-p 'magit-status-mode) + (magit-file-at-point)))) + :begin + (or begin + (and buffer-file-name + (line-number-at-pos + (if region-active-p + (region-beginning) + (point))))) + :end + (or end + (and buffer-file-name + region-active-p + (line-number-at-pos + (region-end))))))) + +(defun magithub-browse-file--get-anchor (&optional begin end) + (cond + ((and begin end) + (format "#L%d-L%d" begin end)) + (begin + (format "#L%d" begin)))) + +(defun magithub-browse-file-blame (file &optional begin end use-default-branch) + "Blame FILE in the browser. + +If USE-DEFAULT-BRANCH is set (interactively, via prefix +argument), then blame the file at the default branch of the +repository instead of the current HEAD." + (interactive (list nil current-prefix-arg)) + (let* ((args (magithub-browse-file--get-file-and-region file begin end)) + (file (plist-get args :file)) + (begin (plist-get args :begin)) + (end (plist-get args :end))) + (unless file + (user-error "Nothing to blame here")) + (let-alist (magithub-repo) + (let* ((default-directory (file-name-directory file)) + (file (string-remove-prefix (magit-toplevel) file)) + (git-rev (if use-default-branch + .default_branch + (magit-git-string "rev-parse" "HEAD"))) + (anchor (magithub-browse-file--get-anchor begin end))) + (unless (magithub-github-repository-p) + (user-error "Not a GitHub repository")) + (browse-url + (format "%s/blame/%s/%s%s" .html_url git-rev file (or anchor ""))))))) (defvar magithub-after-create-messages '("Don't be shy!" @@ -118,97 +220,110 @@ "One of these messages will be displayed after you create a GitHub repository.") -(defun magithub-create () - "Create the current repository on GitHub." - (interactive) - (message "Creating repository on GitHub...") - (magithub--command "create" (magithub-create-arguments)) - (message "Creating repository on GitHub...done! %s" - (nth (random (length magithub-after-create-messages)) - magithub-after-create-messages)) - (magit-push-popup)) +(defun magithub-create (repo &optional org) + "Create REPO on GitHub. + +If ORG is non-nil, it is an organization object under which to +create the new repository. You must be a member of this +organization." + (interactive (if (or (not (magit-toplevel)) (magithub-github-repository-p)) + (list nil nil) + (let* ((ghub-username (ghubp-username)) ;performance + (account (magithub--read-user-or-org)) + (priv (magithub-confirm-no-error 'create-repo-as-private)) + (reponame (magithub--read-repo-name account)) + (desc (read-string "Description (optional): "))) + (list + `((name . ,reponame) + (private . ,priv) + (description . ,desc)) + (unless (string= ghub-username account) + `((login . ,account))))))) + (when (magithub-github-repository-p) + (error "Already in a GitHub repository")) + (if (not (magit-toplevel)) + (when (magithub-confirm-no-error 'init-repo-after-create) + (magit-init default-directory) + (call-interactively #'magithub-create)) + (with-temp-message "Creating repository on GitHub..." + (setq repo + (magithub-request + (if org + (ghubp-post-orgs-org-repos org repo) + (ghubp-post-user-repos repo))))) + (magithub--random-message "Creating repository on GitHub...done!") + (magit-status-internal default-directory) + (magit-remote-add "origin" (magithub-repo--clone-url repo)) + (magit-refresh) + (when (magit-rev-verify "HEAD") + (magit-push)))) + +(defun magithub--read-user-or-org () + "Prompt for an account with completion. + +Candidates will include the current user and all organizations, +public and private, of which they're a part. If there is only +one candidate (i.e., no organizations), the single candidate will +be returned without prompting the user." + (let ((user (ghubp-username)) + (orgs (ghubp-get-in-all '(login) + (magithub-orgs-list))) + candidates) + (setq candidates orgs) + (when user (push user candidates)) + (cl-case (length candidates) + (0 (user-error "No accounts found")) + (1 (car candidates)) + (t (completing-read "Account: " candidates nil t))))) + +(defun magithub--read-repo-name (for-user) + (let* ((prompt (format "Repository name: %s/" for-user)) + (dirnam (file-name-nondirectory (substring default-directory 0 -1))) + (valid-regexp (rx bos (+ (any alnum "." "-" "_")) eos)) + ret) + ;; This is not very clever, but it gets the job done. I'd like to + ;; either have instant feedback on what's valid or not allow users + ;; to enter invalid names at all. Could code from Ivy be used? + (while (not (s-matches-p valid-regexp + (setq ret (read-string prompt nil nil dirnam)))) + (message "invalid name") + (sit-for 1)) + ret)) + +(defun magithub--random-message (&optional prefix) + (let ((msg (nth (random (length magithub-after-create-messages)) + magithub-after-create-messages))) + (if prefix (format "%s %s" prefix msg) msg))) (defun magithub-fork () "Fork 'origin' on GitHub." (interactive) (unless (magithub-github-repository-p) (user-error "Not a GitHub repository")) - (when (and (s-equals? "master" (magit-get-current-branch)) - (y-or-n-p "Looks like master is checked out. Create a new branch? ")) - (call-interactively #'magit-branch-spinoff)) - (message "Forking repository on GitHub...") - (magithub--command "fork" (magithub-fork-arguments)) - (message "Forking repository on GitHub...done")) - -(defun magithub-pull-request () - "Open a pull request to 'origin' on GitHub." - (interactive) - (unless (magithub-github-repository-p) - (user-error "Not a GitHub repository")) - (let (just-pushed) - (unless (magit-get-push-remote) - (when (y-or-n-p "No push remote defined; push now? ") - (call-interactively #'magit-push-current-to-pushremote) - (setq just-pushed t))) - (unless (magit-get-push-remote) - (user-error "No push remote defined; aborting pull request")) - (unless just-pushed - (when (y-or-n-p "Do you want to push any more commits? ") - (magit-push-popup))) - (magithub--command-with-editor "pull-request" (magithub-pull-request-arguments)))) - -(defface magithub-issue-warning-face - '((((class color)) :inherit warning)) - "Face used to call out warnings in the issue-create buffer." - :group 'magithub) - -(defun magithub-setup-edit-buffer () - "Perform setup on a hub edit buffer." - (with-editor-mode 1) - (git-commit-setup-font-lock) - (font-lock-add-keywords - nil `((,magithub-hash-regexp (0 'magit-hash t))) t) - (add-hook - (make-local-variable 'with-editor-pre-finish-hook) - (lambda () - (let ((fill-column (point-max))) - (fill-region (point-min) (point-max)))))) - -(defun magithub-setup-new-issue-buffer () - "Setup the buffer created for issue-posting." - (font-lock-add-keywords - nil '(("^# \\(Creating issue for .*\\)" (1 'magithub-issue-warning-face t))) t)) - -(defvar magithub--file-types - '(("ISSUE_EDITMSG" . issue) - ("PULLREQ_EDITMSG" . pull-request)) - "File types -- car is the basename of a file in /.git/, cdr is - one of `issue' or `pull-request'.") - -(defun magithub--edit-file-type (path) - "Determine the type of buffer this is (if it was created by hub). -Returns `issue', `pull-request', or another non-nil value if -created by hub. - -This function will return nil for matches to -`git-commit-filename-regexp'." - (when (and path (magit-inside-gitdir-p)) - (let ((basename (file-name-base path))) - (and (not (s-matches? git-commit-filename-regexp basename)) - (cdr (assoc basename magithub--file-types)))))) - -(defun magithub-check-buffer () - "If this is a buffer created by hub, perform setup." - (-when-let (filetype (magithub--edit-file-type buffer-file-name)) - (magithub-setup-edit-buffer) - (when (eq filetype 'issue) - (magithub-setup-new-issue-buffer)))) -(add-hook 'find-file-hook #'magithub-check-buffer) + (magithub-confirm 'fork) + (let* ((repo (magithub-repo)) + (fork (with-temp-message "Forking repository on GitHub..." + (magithub-request + (ghubp-post-repos-owner-repo-forks repo))))) + (when (magithub-confirm-no-error 'fork-create-spinoff) + (call-interactively #'magit-branch-spinoff)) + (magithub--random-message + (let-alist repo (format "%s/%s forked!" .owner.login .name))) + (let-alist fork + (when (magithub-confirm-no-error 'fork-add-me-as-remote .owner.login) + (magit-remote-add .owner.login (magithub-repo--clone-url fork)) + (magit-set .owner.login "branch" (magit-get-current-branch) "pushRemote"))) + (let-alist repo + (when (magithub-confirm-no-error 'fork-set-upstream-to-me .owner.login) + (call-interactively #'magit-branch..merge/remote))))) + +(defvar magithub-clone-history nil + "History for `magithub-clone' prompt.") (defun magithub-clone--get-repo () "Prompt for a user and a repository. -Returns a list (USER REPOSITORY)." - (let ((user (getenv "GITHUB_USER")) +Returns a sparse repository object." + (let ((user (ghubp-username)) (repo-regexp (rx bos (group (+ (not (any " ")))) "/" (group (+ (not (any " ")))) eos)) repo) @@ -218,114 +333,88 @@ Returns a list (USER REPOSITORY)." "Clone GitHub repository " (if repo "(format is \"user/repo\"; C-g to quit)" "(user/repo)") ": ") - (when user (concat user "/"))))) - (list (match-string 1 repo) - (match-string 2 repo)))) + (when user (concat user "/")) + nil nil 'magithub-clone-history))) + `((owner (login . ,(match-string 1 repo))) + (name . ,(match-string 2 repo))))) (defcustom magithub-clone-default-directory nil "Default directory to clone to when using `magithub-clone'. -When nil, the current directory at invocation is used.") +When nil, the current directory at invocation is used." + :type 'directory + :group 'magithub) -(defun magithub-clone (user repo dir) - "Clone USER/REPO. +(defun magithub-clone (repo dir) + "Clone REPO. Banned inside existing GitHub repositories if -`magithub-clone-default-directory' is nil." - (interactive (if (and (not magithub-clone-default-directory) - (magithub-github-repository-p)) - (user-error "Already in a GitHub repo") - (let ((args (magithub-clone--get-repo))) - (append args (list (read-directory-name - "Destination: " - (if (s-ends-with? "/" magithub-clone-default-directory) - magithub-clone-default-directory - (concat magithub-clone-default-directory "/")) - nil nil - (cadr args))))))) +`magithub-clone-default-directory' is nil. + +See also `magithub-preferred-remote-method'." + (interactive (let* ((repo (magithub-clone--get-repo)) + (repo (or (magithub-request + (ghubp-get-repos-owner-repo repo)) + (let-alist repo + (user-error "Repository %s/%s does not exist" + .owner.login .name)))) + (name (alist-get 'name repo)) + (dirname (read-directory-name + "Destination: " + magithub-clone-default-directory + name nil name))) + (list repo dirname))) + ;; Argument validation + (unless (called-interactively-p 'any) + (unless (setq repo (magithub-request + (ghubp-get-repos-owner-repo repo))) + (let-alist repo + (user-error "Repository %s/%s does not exist" + .owner.login .name)))) + (let ((parent (file-name-directory dir))) + (unless (file-exists-p parent) + (when (magithub-confirm 'clone-create-directory parent) + (mkdir parent t)))) (unless (file-writable-p dir) - (user-error "%s does not exist or is not writable" dir)) - (when (y-or-n-p (format "Clone %s/%s to %s? " user repo dir)) - (let* ((proc (start-process "*magithub-clone*" "*magithub-clone*" - magithub-hub-executable - "clone" - (format "%s/%s" user repo) - dir))) - (set-process-sentinel - proc - (lambda (p event) - (setq event (s-trim event)) - (cond ((string= event "finished") - (run-with-idle-timer 1 nil #'magithub-clone--finished user repo dir)) - (t (pop-to-buffer (process-buffer p)) - (message "unhandled event: %s => %s" (process-command p) event)))))))) + (user-error "%s is not writable" dir)) + + (let-alist repo + (when (magithub-confirm-no-error 'clone .full_name dir) + (let (set-upstream set-proxy) + (setq set-upstream + (and .fork (magithub-confirm-no-error + 'clone-fork-set-upstream-to-parent + .parent.full_name)) + set-proxy + (and set-upstream (magithub-confirm-no-error + 'clone-fork-set-proxy-to-upstream))) + (condition-case _ + (let ((default-directory dir) + (magit-clone-set-remote.pushDefault t)) + (mkdir dir t) + (magit-clone (magithub-repo--clone-url repo) dir) + (add-function + :after + (process-sentinel magit-this-process) + (lambda (process _event) + (unless (process-live-p process) + (when set-upstream + (let ((upstream "upstream")) + (when set-proxy (magit-set upstream "magithub.proxy")) + (magit-remote-add upstream (magithub-repo--clone-url .parent)) + (magit-branch..merge/remote (magit-get-current-branch) + upstream)))))))))))) (defun magithub-clone--finished (user repo dir) "After finishing the clone, allow the user to jump to their new repo." - (when (y-or-n-p (format "%s/%s has finished cloning to %s. Open? " user repo dir)) - (magit-status (s-chop-suffix "/" dir)))) - -(defvar magithub-features nil - "An alist of feature-symbols to Booleans. -When a feature symbol maps to non-nil, that feature is considered -'loaded'. Thus, to disable all messages, prepend '(t . t) to -this list. - -Example: - - ((pull-request-merge . t) (other-feature . nil)) - -signals that `pull-request-merge' is a loaded feature and -`other-feature' has not been loaded and will not be loaded. - -To enable all features, see `magithub-feature-autoinject'. - -See `magithub-feature-list' for a list and description of features.") - -(defconst magithub-feature-list - '(pull-request-merge pull-request-checkout) - "All magit-integration features of Magithub. - -`pull-request-merge' -Apply patches from pull request - -`pull-request-checkout' -Checkout pull requests as new branches") - -(defun magithub-feature-autoinject (feature) - "Configure FEATURE to recommended settings. -If FEATURE is `all' ot t, all known features will be loaded." - (if (memq feature '(t all)) - (mapc #'magithub-feature-autoinject magithub-feature-list) - (cl-case feature - - (pull-request-merge - (magit-define-popup-action 'magit-am-popup - ?P "Apply patches from pull request" #'magithub-pull-request-merge)) - - (pull-request-checkout - (magit-define-popup-action 'magit-branch-popup - ?P "Checkout pull request" #'magithub-pull-request-checkout)) - - (t (user-error "unknown feature %S" feature))) - (add-to-list 'magithub-features (cons feature t)))) - -(defun magithub-feature-check (feature) - "Check if a Magithub FEATURE has been configured. -See `magithub-features'." - (if (listp magithub-features) - (let* ((p (assq feature magithub-features))) - (if (consp p) (cdr p) - (cdr (assq t magithub-features)))) - magithub-features)) - -(defun magithub-feature-maybe-idle-notify (&rest features) - "Notify user if any of FEATURES are not yet configured." - (unless (-all? #'magithub-feature-check features) - (let ((m "Magithub features not configured: %S") - (s "see variable `magithub-features' to turn off this message")) - (run-with-idle-timer - 1 nil (lambda () - (message (concat m "; " s) features) - (add-to-list 'magithub-features '(t . t) t)))))) + (when (magithub-confirm-no-error 'clone-open-magit-status user repo dir) + (magit-status-internal (s-chop-suffix "/" dir)))) + +(defun magithub-visit-thing () + (interactive) + (user-error + (with-temp-buffer + (use-local-map magithub-map) + (substitute-command-keys + "Deprecated; use `\\[magithub-browse-thing]' instead")))) (provide 'magithub) ;;; magithub.el ends here diff --git a/magithub.org b/magithub.org new file mode 100644 index 0000000..4540ba9 --- /dev/null +++ b/magithub.org @@ -0,0 +1,744 @@ +#+TITLE: Magithub -- Magit interfaces for GitHub +#+AUTHOR: Sean Allred +#+EMAIL: code@seanallred.com +#+DATE: 2017-2018 +#+LANGUAGE: en + +#+TEXINFO_DIR_CATEGORY: Emacs +#+TEXINFO_DIR_TITLE: Magithub: (magithub). +#+TEXINFO_DIR_DESC: Magit interfaces for GitHub +#+SUBTITLE: for version 0.1.5 (0.1.5-106-ge4a004c+1) +#+BIND: ox-texinfo+-before-export-hook ox-texinfo+-update-version-strings + +#+TEXINFO_DEFFN: t +#+OPTIONS: H:4 num:4 toc:2 + +You may also be interested in [[https://github.com/vermiculus/magithub/tree/master/RelNotes][the most current release notes]]. + +Magithub provides an integrated GitHub experience through Magit's familiar +interface. Just as Magit hopes to 'outsmart git', Magithub hopes to add +smarts to GitHub for performing common tasks. + +Happy hacking! + +#+TEXINFO: @noindent +This manual is for Magithub version 0.1.5 (0.1.5-106-ge4a004c+1). + +#+BEGIN_QUOTE +Copyright (C) 2017-2018 Sean Allred + +You can redistribute this document 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 document 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. +#+END_QUOTE + +* Installation +** _ :ignore: + +Magithub can be installed from [[http://melpa.milkbox.net/#/magithub][MELPA]] using =M-x list-packages= or by +evaluating the following: + +#+BEGIN_SRC elisp + (package-install 'magithub) +#+END_SRC + +Here is the basic recommended [[https://github.com/jwiegley/use-package][=use-package=]] configuration: + +#+BEGIN_SRC elisp + (use-package magithub + :after magit + :ensure t + :config (magithub-feature-autoinject t)) +#+END_SRC + +If you prefer to install the package manually, this can of course be done +via the usual means. + +For more information, see [[info:emacs#Packages]]. + +** Authentication + +Given GitHub's rate-limiting policy, Magithub is unlikely to ever support +running without authenticating. As such, you /must/ authenticate before you +use Magithub. (As of #107, Magithub will not even attempt go online until +you're properly authenticated.) + +To authenticate, you can simply start using Magithub; Ghub should walk you +through the authentication process unless you use two-factor authentication. +(Your token is stored in one of your ~auth-sources~; see [[https://magit.vc/manual/ghub/How-Ghub-uses-Auth_002dSource.html#How-Ghub-uses-Auth_002dSource][Ghub's manual]] for +details.) + +If you do use two-factor authentication, you must + +1. Manually create a GitHub token (from https://github.com/settings/tokens) + for scopes `repo`, `notifications` and `user` (see variable + ~magithub-github-token-scopes~) +2. Store it for Magithub per user in one of your ~auth-sources~ + (e.g. =~/.authinfo=). Write a line like this: + + #+BEGIN_EXAMPLE + machine api.github.com login YOUR_GITHUB_USERNAME^magithub password YOUR_GITHUB_TOKEN + #+END_EXAMPLE + +Beware that writing the token in plaintext in =~/.authinfo= (or elsewhere) is +not secure against attackers with access to that file. For details and +better alternatives (like using GPG), see Ghub's manual on [[https://magit.vc/manual/ghub/Manually-Creating-and-Storing-a-Token.html#Manually-Creating-and-Storing-a-Token][Manually Creating +and Storing a Token]] and [[https://magit.vc/manual/ghub/How-Ghub-uses-Auth_002dSource.html#How-Ghub-uses-Auth_002dSource][How Ghub uses Auth-Source]]. + +If you want to authenticate Ghub without using Magithub, you can simply +evaluate the following: + +#+BEGIN_SRC emacs-lisp + (require 'magithub) + (ghub-get "/user" nil :auth 'magithub) +#+END_SRC + +After Ghub walks you through the authentication process during evaluation, +the ~ghub-get~ form should return familiar information (your login, email, +etc.). + +If you're having trouble /authenticating/, [[https://github.com/magit/ghub/issues/new][open a Ghub issue]] or drop by +[[https://gitter.im/vermiculus/magithub][Magithub's]] or [[https://gitter.im/magit/magit][Magit's]] Gitter channel. + +** Enterprise Support + +For GitHub Enterprise support, you'll need to add your enterprise domain to +~magithub-github-hosts~ so that Magithub can detect when it's in a GitHub +repository. + +#+BEGIN_SRC elisp + (use-package magithub + :ensure t + :config + (magithub-feature-autoinject t) + (setq magithub-github-hosts '("github.enterprise.domain/api/v3"))) +#+END_SRC + +Next, you will need to create a personal access token and add it to +your =~/.authinfo= file to authenticate to your domain; see Ghub's +manual for details. + +#+BEGIN_EXAMPLE +machine github.enterprise.domain/api/v3 login YOUR_USERNAME^magithub password YOUR_GITHUB_TOKEN +#+END_EXAMPLE + +Finally, for each github repository you with to use with GHE, you will +need to add a ~github.host~ config and a ~DOMAIN.user~ config. + +#+BEGIN_SRC shell + # where GHE_URL is the url to your v3 api endpoint, and USERNAME is your GHE username + GHE_URL=github.enterprise.domain/api/v3; git config github.host ${GHE_URL}; git config ${GHE_URL}.user $USERNAME +#+END_SRC + +* Introduction +** _ :ignore: + +Magithub tries to follow closely Magit's lead in general interface. Most of +its functionality is developed to tightly integrate with its section/ +framework. See [[https://magit.vc/manual/magit/Sections.html#Sections][Magit's documentation]] for information on how to navigate +using this framework. + +Magithub's functionality uses section-specific keymaps to expose +functionality. Where it makes sense, the following keys will map to +functions that 'do the right thing': + +- Key: w, magithub-browse-thing + + Open a browser to the thing at point. For instance, when point is on + issue 42 in your-favorite/github-repo, we'll open + =http://github.com/your-favorite/github-repo/issue/42=. + +- Key: a, magithub-add-thing + + Add something to the thing at point. For instance, on a list of labels, + you can add more labels. + +- Key: e, magithub-edit-thing + + Edit the thing at point, such as an issue. + +- Key: r, magithub-reply-thing + + Reply to the thing at point, such as a comment. + +Magithub also considers the similar placeholder commands introduced by Magit +which you may already be familiar with: + +- Key: k, magit-delete-thing +- Key: RET, magit-visit-thing + +These concepts are intended to provide a more consistent experience +throughout Magithub within Magit by categorizing your broader interactions +with all GitHub content. As with Magit, more commands are added as the +situation calls for it. + +** Note + +By default, Magithub enables itself in all repositories where =origin= points +to GitHub. + +- User Option: magithub-enabled-by-default + + When non-nil, Magithub is enabled by default. This is the fallback value + of git variable =magithub.enabled= is not set in this repository. + +- User Option: magithub-github-hosts + + A list of top-level domains that should be recognized as GitHub hosts. + +** Brief Tutorial + +Here's a script that will guide you through the major features of Magithub. +This is not a replacement for the documentation, but rather an example +workflow to whet your appetite. + +*** Clone a repository +#+BEGIN_EXAMPLE +M-x magithub-clone RET vermiculus/my-new-repository +#+END_EXAMPLE +Cloning a repository this way gets the clone URL from GitHub and forwards +that on to ~magit-clone~. If the repository is a fork, you're prompted to add +the parent is added under the =upstream= remote. + +Fork behavior may change in the future. It may be more appropriate to +actually/ clone the source repository and add your remote as a fork. This +will cover the 90% case (the 10% case being active forks of unmaintained +projects). + +*** Viewing project status +You are dropped into a status buffer for =vermiculus/my-new-repository=. You +see some open issues and pull requests. You move your cursor to an issue of +interest and =TAB= to expand it, seeing the author, when it was +created/updated, any labels, and a preview of the issue contents. + +If =vermiculus/my-new-repository= used any status checks, you would see those +statuses as a header in this buffer. + +*** Viewing and replying to an issue +You =RET= on the issue and are taken to a dedicated buffer for that issue. +You can now see its full contents as well as all comments. You'd like to +leave a comment -- a suggestion for a fix or an additional use-case to +consider -- you press =r= to open a new buffer to /reply/ to this issue. You +write your comment and =C-c C-c= to submit. But, oh no! You didn't turn on +=flyspell-mode= in markdown buffers, so you submitted a spelling error. A +simple =e= on the comment will /edit/ it. After submitting again with =C-c C-c=, +everything is well. + +Right now, other activity on the issue is not inserted into this buffer. +Press =w= to open the issue in your browser. + +*** Creating an issue +You notice a small issue in how some feature is implemented, so back in the +status buffer, you use =H i= to create a new issue. (While inside the GitHub +repository, you could've used any key bound to ~magithub-issue-new~.) The +first line is the title of the new issue; everything else is the body. You +submit the issue with =C-c C-c=. + +From here you will be prompted to add labels by selecting them from the list +and adding them with =RET=. To skip adding labels and submit the issue without +any you can enter "" in the field and then =RET=. + +/Note: your completion framework may have special functionality to enter null +here (ie. in Ivy you must use =C-M-j= to accept without input)./ + +You come back a little while later to leave additional details -- you reply +to your own issue in a comment, but realize you should just edit your +original issue to avoid confusion. You =k= to /kill/ / delete the comment. + +*** Creating a pull request +Since you care about this project and want to help it succeed, you decide to +fix this issue yourself. You checkout a new branch (=b c my-feature RET=) and +get to work. + +Because you're so /awesome/, you're ready to push your commit to fix your +issue. After realizing you don't have push permissions to this repository, +you create a fork using =H f=. You push your branch to your new remote (named +after your username) and create a pull request with =H p=. You select the +head branch as =my-feature= and the base branch as =master= (or whatever the +production/staging branch is for the project). You fill out the pull +request template provided by the project (and inserted into your PR) and off +you go! + +* Status Buffer Integration + +The part of Magithub you're likely to interact with the most is +embedded right into Magit's status buffer. + +- Key: H, magithub-dispatch-popup + + Access many Magithub entry-points. See [[*Dispatch Popup]] for more details. + +- Key: H C e, FIXME + + Toggle status buffer integration in this repository. + +There are two integrations turned on by default: + +** Project Status + +Many services (such as Travis CI and CircleCI) will post statuses to +commits. A summary of these statuses are visible in the status buffer +headers. Note that the branch must have a [[https://magit.vc/manual/magit/The-Two-Remotes.html#The-Two-Remotes][push-remote]] set in order to +find the correct status to use. + +- Key: RET, magithub-ci-visit +- Key: w, magithub-ci-visit + + Visit the service's summary of this status. For example, a status posted + by Travis CI will open that build on Travis. + +- Key: g, magithub-ci-refresh + + Refresh statuses from GitHub and then refresh the current buffer. + +- Key: H C s, FIXME + + Enable/disable status checks in this repository. + +** Open Issues and Pull Requests + +These will also display in the status buffer. There's a lot of +functionality available right from an issue section. + +- Key: g, magithub-issue-refresh + + Refresh issues and pull requests from GitHub and then refresh the current + buffer. + +- Key: RET, magithub-issue-visit + + Open a new buffer to view an issue and its comments. + +- Key: w, magithub-issue-browse +- Key: w, magithub-pull-browse + + Browse this issue / pull request on GitHub. + +- Key: O, magithub-issue-open +- Key: C, magithub-issue-close + + Open/close an issue. + +- Key: N, magithub-issue-personal-note + + Opens a buffer for offline note-taking. + +- Key: L, magithub-issue-add-labels + + Add labels to the issue. + +- Key: a, magithub-label-add +- Key: k, magithub-label-remove + + When point is on a label section, you can add/remove labels (provided you + have permission to do so). + +- Command: magithub-label-color-replace + + Labels are colored as they would be on GitHub. In some themes, this + produces an illegible or otherwise undesirable color. This command can + help you find a substitute for labels of this color. + +- Variable: magithub-issue-details-hook + + Control which issue details display in the status buffer. Functions + intended for this variable use the =magithub-issue-detail-insert-*= prefix. + + Performance note: judicious use of this variable can improve your overall + Magit experience in large buffers. + +- User Option: magithub-issue-issue-filter-functions +- User Option: magithub-issue-pull-request-filter-functions + + These are lists of functions which must all return non-nil for an issue/PR + to be displayed in the status buffer. They all receive the issue/PR + object as their sole argument. For example, you might want to filter out + issues labels =enhancement= from your list: + + #+BEGIN_SRC emacs-lisp + (setq magithub-issue-issue-filter-functions + (list (lambda (issue) ; don't show enhancement requests + (not + (member "enhancement" + (let-alist issue + (ghubp-get-in-all '(name) .labels))))))) + #+END_SRC + +*** Manipulating the Cache + When point is on a Magithub-controlled section (like the status header): + | Default Key | Description | + |-------------+--------------------------------------------| + | =g= | Refresh only this section's GitHub content | + | =C-u g= | Like =g=, but works on the whole buffer | + +*** Offline Mode + | Default Key | Description | + |-------------+---------------------| + | =H C c= | Toggle offline mode | + + Offline mode was introduced for those times when you're on the go, but you'd + still like to have an overview of GitHub data in your status buffer. It's + also useful for folks who want to explicitly control when Emacs communicates + with GitHub -- for this purpose, you can use =C-u g= (discussed above) to pull + data from GitHub while in offline mode. + + To start into offline mode everywhere, use + #+BEGIN_SRC sh + git config --global magithub.cache always + #+END_SRC + + See the documentation for function ~magithub-settings--set-magithub.cache~ + for details on appropriate values. + +*** Controlling Sections + + Sections like the issue list and the status header can be toggled with the + interactive functions of the form =magithub-toggle-*=. These functions have + no default keybinding. + + Since status checks can be API-hungry and not all projects use them, you can + disable the status header at the repository-level with =H ~=; see the Status + Checks section for more information. + +* Dispatch Popup + +Much of Magithub's functionality, including configuration options, is behind +this popup. In Magit status buffers, it's bound to =H=. + +- Key: d, magithub-dashboard + + See [[*Dashboard]]. + +- Key: c, magithub-create + + Push a local repository up to GitHub. + +- Key: H, magithub-browse + + Open the current repository in your browser. + +- Key: f, magithub-fork + + Fork this repository on GitHub. This will add your fork as a remote under + your username. For example, if user =octocat= forked Magit, we would see a + new remote called =octocat= pointing to =octocat/magit=. + +- Key: i, magithub-issue-new +- Key: p, magithub-pull-request-new + + Open a new buffer to create an issue or open a pull request. See + [[*Creating Content]]. + +** Configuration + +Per-repository configuration is controlled via git variables reachable from +the dispatch popup via =H C=. Use =? = to get online help for each +variable in that popup. + +- Key: C e, FIXME + + Turn Magithub on/off (completely). + +- Key: C s, FIXME + + Turn the project status header on/off. + +- Key: C c, FIXME + + Control whether Magithub is considered 'online'. This controls the + behavior of the the cache. This may go away in the future. See + [[*Manipulating the Cache]] for more details. + +- Key: C i, FIXME + + Toggle the issues section. + +- Key: C p, FIXME + + Toggle the pull requests section. + +- Key: C x, FIXME + + Set the 'proxy' used for this repository. See [[*Proxies]]. + +** Meta + +Since Magithub is so integrated with Magit, there's often confusion about +whom to ask for support (especially for users of preconfigured Emacsen like +Spacemacs and Prelude). Hopefully, these functions can direct you to the +appropriate spot. + +- Key: &, magithub--meta-new-issue + + Open the browser to create a new issue for Magithub functionality + described in this document. + +- Key: h, magithub--meta-help + + Open the browser to ask for help on Gitter, a GitHub-focused chatroom. + +* 'Features' + +Given that some features of Magithub are not desired by or appropriate for +every type of user, there are features that are not turned on by default. +These are features that are injected into standard Magit popups. + +The list of available features is available in constant +~magithub-feature-list~. Despite its name, this is an alist of symbols (i.e., +'features') to functions that install the feature. While the documentation +for each feature lives in that symbol, you would normally not otherwise +interact with it. + +- Function: magithub-feature-autoinject + + This function is the expected interface to install features. You will + normally use + #+BEGIN_SRC emacs-lisp + (magithub-feature-autoinject t) + #+END_SRC + in your configuration to install all features, but you have the option of + installing them one at a time using the symbols from constant + ~magithub-feature-list~ or as a list of those symbols: + #+BEGIN_SRC emacs-lisp + (magithub-feature-autoinject 'commit-browse) + (magithub-feature-autoinject '(commit-browse pull-request-merge)) + #+END_SRC + +* Cloning + +- Command: magithub-clone + + Clone a repository from GitHub. + +- User Option: magithub-clone-default-directory + + The default destination directory to use for cloning. + +- User Option: magithub-preferred-remote-method + + This option is a symbol indicating the preferred cloning method (between + HTTPS, SSH, and the =git://= protocol). + +* Dashboard + +The dashboard shows you information pertaining to /you/: +- notifications +- issues and pull requests you're assigned per repository +as well as contextual information like the logged-in user and [[https://developer.github.com/v3/#rate-limiting][rate-limiting]] +information. + +- Command: magithub-dashboard + + View your dashboard. + +- Key: ;, magithub-dashboard-popup + + Configure your global dashboard settings. + +- User Option: magithub-dashboard-show-read-notifications + + When non-nil, we'll show read notifications in the dashboard. + +* Creating Content + +It's great to read about what's been happening, but it's even better to +contribute your own thoughts and activity! + +- Key: H i, magithub-issue-new +- Key: H p, magithub-pull-request-new + + Create issues and pull requests. If you have push access to the + repository, you'll have the opportunity to add labels before you submit + the issue. + + Creating a pull request requires a HEAD branch, a BASE branch, and to know + which remote points to your fork. + +- Key: r, magithub-comment-new +- Key: r, magithub-comment-reply + + On an issue or pull request section, ~magithub-comment-new~ will allow you + to post a comment to that issue/PR. If point is already on a comment, + ~magithub-comment-reply~ will quote the comment at point for you. + +* Caching + +Caching is a complicated topic with a long Magithub history of, well, +failure. As of today, all data retrieved from the API is cached by +default. Using =g= on Magithub sections will usually refresh the information +in the buffer pertaining to that section. Otherwise, =C-u g= in any Magit +buffer will refresh all GitHub data in that buffer. + +This behavior may change in the future, but for now, it's the most stable +option. See + +* Proxies + +It's not uncommon to have repositories where the bug-tracker is in a +separate repository. For these cases, you can use the idea of 'proxies'. A +proxy is a remote (with a GitHub-associated URL) that you choose to use for +all GitHub API requests concerning the /actual/ current repository. This is +manifest in the git variable =magithub.proxy=. + +- Key: H C x, magithub-settings--set-magithub.contextRemote + + If you consistently use a specific remote name for the bug tracker, you + can set it globally. + +All GitHub requests specific to the current repository context are routed +through ~magithub-repo~ which respects this proxy. + +* Configuring + +Magithub uses a standardized configuration scheme implemented using Git +variables. This allows your Magithub configuration to use all the powerful +features of =git-config(1)= and allows tight integration into Magit's existing +repository configuration workflows. + +To get the most up-to-date list of configuration options, use +#+BEGIN_SRC example +M-x apropos-command RET magithub-settings--set +#+END_SRC +to summarize them all. If an important option is missing from this manual, +reports and pull requests are welcome! + +The decision to implement these as Git variables stems from the varying size +of project repositories: it is extremely common to contribute to +exceptionally large repositories where including, say, the 'issues' section +would bring Emacs to its knees -- but it is equally common to work on +smaller repositories where such concern is negligible and the issues section +is a nice feature. + +* Unfiled +** Content +*** Working with Repositories +**** DONE General +| Default Key | Description | +|--------------------+------------------------------------------------| +| =H H= | Opens the current repository in the browser | +| =H c= | Creates the current local repository on GitHub | +| =M-x magithub-clone= | Clone a repository | + +=magithub-clone= may appear to be a thin wrapper over =magit-clone=, but it's +quite a bit smarter than that. We'll of course respect +=magithub-preferred-remote-method= when cloning the repository, but we can +also detect when the repository is a fork and can create and set an upstream +remote accordingly (similar to =M-x magithub-fork=). + +**** DONE Issues +| Default Key | Description | +|-------------+--------------------------| +| =H i= | Create a new issue | +| =RET= | Open the issue in GitHub | + +You can filter issues with =magithub-issue-issue-filter-functions=: +#+BEGIN_SRC emacs-lisp + (setq magithub-issue-issue-filter-functions + (list (lambda (issue) ; don't show enhancement requests + (not + (member "enhancement" + (let-alist issue + (ghubp-get-in-all '(name) .labels))))))) +#+END_SRC +Each function in the =*-functions= list must return non-nil for the issue to +appear in the issue list. See also the documentation for that variable. + +**** DONE Forking and Pull Requests +| Default Key | Description | +|-------------+-------------------------------| +| =H f= | Fork the current repository | +| =H p= | Submit pull requests upstream | + +You can also filter pull requests with +=magithub-issue-pull-request-filter-functions=. See the section on +issue-filtering for an example. + +**** TODO Labels +| Default Key | Description | +|----------------------------------+-------------------------------------------| +| =M-x magithub-label-color-replace= | Choose a new color for the label at point | + +By default, Magithub will adopt the color used by GitHub when showing +labels. In some themes, this doesn't provide enough contrast. Use =M-x +magithub-label-color-replace= to replace the current label's color with +another one. (This will apply to all labels in all repositories, but will +of course not apply to all /shades/ of the original color.) + +**** TODO Status Checks +| Default Key | Description | +|-------------+--------------------------------------------------| +| =RET= | Visit the status's dashboard in your browser | +| =TAB= | On the status header, show individual CI details | +| =H ~= | Toggle status integration for this repository | + +When the status buffer first opens, the status header is inserted at the top +and probably looks something like this: +#+BEGIN_EXAMPLE +Status: Success +#+END_EXAMPLE + +You can get a breakdown of which checks succeeded and which failed by using +=TAB=: +#+BEGIN_EXAMPLE +Status: Success + Checks for ref: develop + Success The Travis CI build passed continuous-integration/travis-ci/push +#+END_EXAMPLE + +Pressing =RET= on the header will take you to the dashboard associated with +that status check. If there's more than one status check here, you'll be +prompted to choose a check (e.g., Travis, Circle, CLA, ...). Of course, if +you expand the header to show the individual checks, =RET= on those will take +you straight to that check. + +*** TODO Your Dashboard +Check out =M-x magithub-dashboard= to view your notifications and issues +assigned to you + +** TODO 'Tricks' + +Most of Magithub is implemented in pure Elisp now, but there are a few +lingering goodies that haven't been ported (since their real logic is +non-trivial). These definitions are relegated to =magithub-issue-tricks.el=. + +Make sure to install [[https://hub.github.com][=hub=]] and add it to your ~exec-path~ if you intend to use +these functions. After installation, use =hub browse= from a directory with a +GitHub repository to force the program to authenticate -- this avoids some +weirdness on the Emacs side of things. + +* _ Copying +:PROPERTIES: +:COPYING: t +:END: + +#+BEGIN_QUOTE +Copyright (C) 2017-2018 Sean Allred + +You can redistribute this document 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 document 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. +#+END_QUOTE + +* _ :ignore: + +# IMPORTANT: Also update ORG_ARGS and ORG_EVAL in the Makefile. +# Local Variables: +# fill-column: 76 +# eval: (require 'ox-extra nil t) +# eval: (require 'ox-texinfo+ nil t) +# eval: (and (featurep 'ox-extra) (ox-extras-activate '(ignore-headlines))) +# indent-tabs-mode: nil +# org-src-preserve-indentation: nil +# End: diff --git a/magithub.texi b/magithub.texi new file mode 100644 index 0000000..86d0a42 --- /dev/null +++ b/magithub.texi @@ -0,0 +1,1011 @@ +\input texinfo @c -*- texinfo -*- +@c %**start of header +@setfilename magithub.info +@settitle Magithub -- Magit interfaces for GitHub +@documentencoding UTF-8 +@documentlanguage en +@c %**end of header + +@copying +@quotation +Copyright (C) 2017-2018 Sean Allred + +You can redistribute this document 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 document 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. +@end quotation +@end copying + +@dircategory Emacs +@direntry +* Magithub: (magithub). Magit interfaces for GitHub. +@end direntry + +@finalout +@titlepage +@title Magithub -- Magit interfaces for GitHub +@subtitle for version 0.1.5 (0.1.5-106-ge4a004c+1) +@author Sean Allred +@page +@vskip 0pt plus 1filll +@insertcopying +@end titlepage + +@contents + +@ifnottex +@node Top +@top Magithub -- Magit interfaces for GitHub + +You may also be interested in @uref{https://github.com/vermiculus/magithub/tree/master/RelNotes, the most current release notes}. + +Magithub provides an integrated GitHub experience through Magit's familiar +interface. Just as Magit hopes to 'outsmart git', Magithub hopes to add +smarts to GitHub for performing common tasks. + +Happy hacking! + +@noindent +This manual is for Magithub version 0.1.5 (0.1.5-106-ge4a004c+1). + +@quotation +Copyright (C) 2017-2018 Sean Allred + +You can redistribute this document 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 document 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. +@end quotation +@end ifnottex + +@menu +* Installation:: +* Introduction:: +* Status Buffer Integration:: +* Dispatch Popup:: +* 'Features':: +* Cloning:: +* Dashboard:: +* Creating Content:: +* Caching:: +* Proxies:: +* Unfiled:: + +@detailmenu +--- The Detailed Node Listing --- + +Installation + +* Authentication:: +* Enterprise Support:: + +Introduction + +* Note:: +* Brief Tutorial:: + +Brief Tutorial + +* Clone a repository:: +* Viewing project status:: +* Viewing and replying to an issue:: +* Creating an issue:: +* Creating a pull request:: + + +Status Buffer Integration + +* Project Status:: +* Open Issues and Pull Requests:: + +Open Issues and Pull Requests + +* Manipulating the Cache:: +* Offline Mode:: +* Controlling Sections:: + + +Dispatch Popup + +* Configuration:: +* Meta:: + +Unfiled + +* Content:: +* 'Tricks':: + +Content + +* Working with Repositories:: +* Your Dashboard:: + + +@end detailmenu +@end menu + +@node Installation +@chapter Installation + +Magithub can be installed from @uref{http://melpa.milkbox.net/#/magithub, MELPA} using @samp{M-x list-packages} or by +evaluating the following: + +@lisp +(package-install 'magithub) +@end lisp + +Here is the basic recommended @uref{https://github.com/jwiegley/use-package, @samp{use-package}} configuration: + +@lisp +(use-package magithub + :after magit + :ensure t + :config (magithub-feature-autoinject t)) +@end lisp + +If you prefer to install the package manually, this can of course be done +via the usual means. + +For more information, see @ref{Packages,,,emacs,}. + +@menu +* Authentication:: +* Enterprise Support:: +@end menu + +@node Authentication +@section Authentication + +Given GitHub's rate-limiting policy, Magithub is unlikely to ever support +running without authenticating. As such, you @emph{must} authenticate before you +use Magithub. (As of #107, Magithub will not even attempt go online until +you're properly authenticated.) + +To authenticate, you can simply start using Magithub; Ghub should walk you +through the authentication process unless you use two-factor authentication. +(Your token is stored in one of your @code{auth-sources}; see @uref{https://magit.vc/manual/ghub/How-Ghub-uses-Auth_002dSource.html#How-Ghub-uses-Auth_002dSource, Ghub's manual} for +details.) + +If you do use two-factor authentication, you must + +@itemize +@item +Manually create a GitHub token (from @uref{https://github.com/settings/tokens}) +for scopes `repo`, `notifications` and `user` (see variable +@code{magithub-github-token-scopes}) + +@item +Store it for Magithub per user in one of your @code{auth-sources} +(e.g. @samp{~/.authinfo}). Write a line like this: + +@example +machine api.github.com login YOUR_GITHUB_USERNAME^magithub password YOUR_GITHUB_TOKEN +@end example +@end itemize + +Beware that writing the token in plaintext in @samp{~/.authinfo} (or elsewhere) is +not secure against attackers with access to that file. For details and +better alternatives (like using GPG), see Ghub's manual on @uref{https://magit.vc/manual/ghub/Manually-Creating-and-Storing-a-Token.html#Manually-Creating-and-Storing-a-Token, Manually Creating +and Storing a Token} and @uref{https://magit.vc/manual/ghub/How-Ghub-uses-Auth_002dSource.html#How-Ghub-uses-Auth_002dSource, How Ghub uses Auth-Source}. + +If you want to authenticate Ghub without using Magithub, you can simply +evaluate the following: + +@lisp +(require 'magithub) +(ghub-get "/user" nil :auth 'magithub) +@end lisp + +After Ghub walks you through the authentication process during evaluation, +the @code{ghub-get} form should return familiar information (your login, email, +etc.). + +If you're having trouble @emph{authenticating}, @uref{https://github.com/magit/ghub/issues/new, open a Ghub issue} or drop by +@uref{https://gitter.im/vermiculus/magithub, Magithub's} or @uref{https://gitter.im/magit/magit, Magit's} Gitter channel. + +@node Enterprise Support +@section Enterprise Support + +For GitHub Enterprise support, you'll need to add your enterprise domain to +@code{magithub-github-hosts} so that Magithub can detect when it's in a GitHub +repository. You will also need to configure your @samp{~/.authinfo} file +appropriately to authenticate to your domain; see Ghub's manual for details. + +@node Introduction +@chapter Introduction + +Magithub tries to follow closely Magit's lead in general interface. Most of +its functionality is developed to tightly integrate with its section/ +framework. See @uref{https://magit.vc/manual/magit/Sections.html#Sections, Magit's documentation} for information on how to navigate +using this framework. + +Magithub's functionality uses section-specific keymaps to expose +functionality. Where it makes sense, the following keys will map to +functions that 'do the right thing': + +@table @asis +@kindex w +@cindex magithub-browse-thing +@item @kbd{w} @tie{}@tie{}@tie{}@tie{}(@code{magithub-browse-thing}) + +Open a browser to the thing at point. For instance, when point is on +issue 42 in your-favorite/github-repo, we'll open +@samp{http://github.com/your-favorite/github-repo/issue/42}. + +@kindex a +@cindex magithub-add-thing +@item @kbd{a} @tie{}@tie{}@tie{}@tie{}(@code{magithub-add-thing}) + +Add something to the thing at point. For instance, on a list of labels, +you can add more labels. + +@kindex e +@cindex magithub-edit-thing +@item @kbd{e} @tie{}@tie{}@tie{}@tie{}(@code{magithub-edit-thing}) + +Edit the thing at point, such as an issue. + +@kindex r +@cindex magithub-reply-thing +@item @kbd{r} @tie{}@tie{}@tie{}@tie{}(@code{magithub-reply-thing}) + +Reply to the thing at point, such as a comment. +@end table + +Magithub also considers the similar placeholder commands introduced by Magit +which you may already be familiar with: + +@table @asis +@kindex k +@cindex magit-delete-thing +@item @kbd{k} @tie{}@tie{}@tie{}@tie{}(@code{magit-delete-thing}) +@kindex RET +@cindex magit-visit-thing +@item @kbd{RET} @tie{}@tie{}@tie{}@tie{}(@code{magit-visit-thing}) +@end table + +These concepts are intended to provide a more consistent experience +throughout Magithub within Magit by categorizing your broader interactions +with all GitHub content. As with Magit, more commands are added as the +situation calls for it. + +@menu +* Note:: +* Brief Tutorial:: +@end menu + +@node Note +@section Note + +By default, Magithub enables itself in all repositories where @samp{origin} points +to GitHub. + +@defopt magithub-enabled-by-default + +When non-nil, Magithub is enabled by default. This is the fallback value +of git variable @samp{magithub.enabled} is not set in this repository. +@end defopt + +@defopt magithub-github-hosts + +A list of top-level domains that should be recognized as GitHub hosts. +@end defopt + +@node Brief Tutorial +@section Brief Tutorial + +Here's a script that will guide you through the major features of Magithub. +This is not a replacement for the documentation, but rather an example +workflow to whet your appetite. + +@menu +* Clone a repository:: +* Viewing project status:: +* Viewing and replying to an issue:: +* Creating an issue:: +* Creating a pull request:: +@end menu + +@node Clone a repository +@subsection Clone a repository + +@example +M-x magithub-clone RET vermiculus/my-new-repository +@end example +Cloning a repository this way gets the clone URL from GitHub and forwards +that on to @code{magit-clone}. If the repository is a fork, you're prompted to add +the parent is added under the @samp{upstream} remote. + +Fork behavior may change in the future. It may be more appropriate to +actually/ clone the source repository and add your remote as a fork. This +will cover the 90% case (the 10% case being active forks of unmaintained +projects). + +@node Viewing project status +@subsection Viewing project status + +You are dropped into a status buffer for @samp{vermiculus/my-new-repository}. You +see some open issues and pull requests. You move your cursor to an issue of +interest and @samp{TAB} to expand it, seeing the author, when it was +created/updated, any labels, and a preview of the issue contents. + +If @samp{vermiculus/my-new-repository} used any status checks, you would see those +statuses as a header in this buffer. + +@node Viewing and replying to an issue +@subsection Viewing and replying to an issue + +You @samp{RET} on the issue and are taken to a dedicated buffer for that issue. +You can now see its full contents as well as all comments. You'd like to +leave a comment -- a suggestion for a fix or an additional use-case to +consider -- you press @samp{r} to open a new buffer to @emph{reply} to this issue. You +write your comment and @samp{C-c C-c} to submit. But, oh no! You didn't turn on +@samp{flyspell-mode} in markdown buffers, so you submitted a spelling error. A +simple @samp{e} on the comment will @emph{edit} it. After submitting again with @samp{C-c C-c}, +everything is well. + +Right now, other activity on the issue is not inserted into this buffer. +Press @samp{w} to open the issue in your browser. + +@node Creating an issue +@subsection Creating an issue + +You notice a small issue in how some feature is implemented, so back in the +status buffer, you use @samp{H i} to create a new issue. (While inside the GitHub +repository, you could've used any key bound to @code{magithub-issue-new}.) The +first line is the title of the new issue; everything else is the body. You +submit the issue with @samp{C-c C-c}. + +You come back a little while later to leave additional details -- you reply +to your own issue in a comment, but realize you should just edit your +original issue to avoid confusion. You @samp{k} to @emph{kill} / delete the comment. + +@node Creating a pull request +@subsection Creating a pull request + +Since you care about this project and want to help it succeed, you decide to +fix this issue yourself. You checkout a new branch (@samp{b c my-feature RET}) and +get to work. + +Because you're so @emph{awesome}, you're ready to push your commit to fix your +issue. After realizing you don't have push permissions to this repository, +you create a fork using @samp{H f}. You push your branch to your new remote (named +after your username) and create a pull request with @samp{H p}. You select the +head branch as @samp{my-feature} and the base branch as @samp{master} (or whatever the +production/staging branch is for the project). You fill out the pull +request template provided by the project (and inserted into your PR) and off +you go! + +@node Status Buffer Integration +@chapter Status Buffer Integration + +The part of Magithub you're likely to interact with the most is +embedded right into Magit's status buffer. + +@table @asis +@kindex H +@cindex magithub-dispatch-popup +@item @kbd{H} @tie{}@tie{}@tie{}@tie{}(@code{magithub-dispatch-popup}) + +Access many Magithub entry-points. See @ref{Dispatch Popup} for more details. + +@kindex H e +@cindex FIXME +@item @kbd{H e} @tie{}@tie{}@tie{}@tie{}(@code{FIXME}) + +Toggle status buffer integration in this repository. +@end table + +There are two integrations turned on by default: + +@menu +* Project Status:: +* Open Issues and Pull Requests:: +@end menu + +@node Project Status +@section Project Status + +Many services (such as Travis CI and CircleCI) will post statuses to +commits. A summary of these statuses are visible in the status buffer +headers. + +@table @asis +@kindex RET +@cindex magithub-ci-visit +@item @kbd{RET} @tie{}@tie{}@tie{}@tie{}(@code{magithub-ci-visit}) +@kindex w +@cindex magithub-ci-visit +@item @kbd{w} @tie{}@tie{}@tie{}@tie{}(@code{magithub-ci-visit}) + +Visit the service's summary of this status. For example, a status posted +by Travis CI will open that build on Travis. + +@kindex g +@cindex magithub-ci-refresh +@item @kbd{g} @tie{}@tie{}@tie{}@tie{}(@code{magithub-ci-refresh}) + +Refresh statuses from GitHub and then refresh the current buffer. + +@kindex H s +@cindex FIXME +@item @kbd{H s} @tie{}@tie{}@tie{}@tie{}(@code{FIXME}) + +Enable/disable status checks in this repository. +@end table + +@node Open Issues and Pull Requests +@section Open Issues and Pull Requests + +These will also display in the status buffer. There's a lot of +functionality available right from an issue section. + +@table @asis +@kindex g +@cindex magithub-issue-refresh +@item @kbd{g} @tie{}@tie{}@tie{}@tie{}(@code{magithub-issue-refresh}) + +Refresh issues and pull requests from GitHub and then refresh the current +buffer. + +@kindex RET +@cindex magithub-issue-visit +@item @kbd{RET} @tie{}@tie{}@tie{}@tie{}(@code{magithub-issue-visit}) + +Open a new buffer to view an issue and its comments. + +@kindex w +@cindex magithub-issue-browse +@item @kbd{w} @tie{}@tie{}@tie{}@tie{}(@code{magithub-issue-browse}) +@kindex w +@cindex magithub-pull-browse +@item @kbd{w} @tie{}@tie{}@tie{}@tie{}(@code{magithub-pull-browse}) + +Browse this issue / pull request on GitHub. + +@kindex N +@cindex magithub-issue-personal-note +@item @kbd{N} @tie{}@tie{}@tie{}@tie{}(@code{magithub-issue-personal-note}) + +Opens a buffer for offline note-taking. + +@kindex L +@cindex magithub-issue-add-labels +@item @kbd{L} @tie{}@tie{}@tie{}@tie{}(@code{magithub-issue-add-labels}) + +Add labels to the issue. + +@kindex a +@cindex magithub-label-add +@item @kbd{a} @tie{}@tie{}@tie{}@tie{}(@code{magithub-label-add}) +@kindex k +@cindex magithub-label-remove +@item @kbd{k} @tie{}@tie{}@tie{}@tie{}(@code{magithub-label-remove}) + +When point is on a label section, you can add/remove labels (provided you +have permission to do so). + +@end table + +@cindex magithub-label-color-replace +@deffn Command magithub-label-color-replace + +Labels are colored as they would be on GitHub. In some themes, this +produces an illegible or otherwise undesirable color. This command can +help you find a substitute for labels of this color. +@end deffn + +@defvar magithub-issue-details-hook + +Control which issue details display in the status buffer. Functions +intended for this variable use the @samp{magithub-issue-detail-insert-*} prefix. + +Performance note: judicious use of this variable can improve your overall +Magit experience in large buffers. +@end defvar + +@defopt magithub-issue-issue-filter-functions +@end defopt +@defopt magithub-issue-pull-request-filter-functions + +These are lists of functions which must all return non-nil for an issue/PR +to be displayed in the status buffer. They all receive the issue/PR +object as their sole argument. For example, you might want to filter out +issues labels @samp{enhancement} from your list: + +@lisp +(setq magithub-issue-issue-filter-functions + (list (lambda (issue) ; don't show enhancement requests + (not + (member "enhancement" + (let-alist issue + (ghubp-get-in-all '(name) .labels))))))) +@end lisp +@end defopt + +@menu +* Manipulating the Cache:: +* Offline Mode:: +* Controlling Sections:: +@end menu + +@node Manipulating the Cache +@subsection Manipulating the Cache + +When point is on a Magithub-controlled section (like the status header): +@multitable {aaaaaaaaaaa} {aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa} +@headitem Default Key +@tab Description +@item @samp{g} +@tab Refresh only this section's GitHub content +@item @samp{C-u g} +@tab Like @samp{g}, but works on the whole buffer +@end multitable + +@node Offline Mode +@subsection Offline Mode + +@multitable {aaaaaaaaaaa} {aaaaaaaaaaaaaaaaaaa} +@headitem Default Key +@tab Description +@item @samp{H C c} +@tab Toggle offline mode +@end multitable + +Offline mode was introduced for those times when you're on the go, but you'd +still like to have an overview of GitHub data in your status buffer. It's +also useful for folks who want to explicitly control when Emacs communicates +with GitHub -- for this purpose, you can use @samp{C-u g} (discussed above) to pull +data from GitHub while in offline mode. + +To start into offline mode everywhere, use +@example +git config --global magithub.cache always +@end example + +See the documentation for function @code{magithub-settings--set-magithub.cache} +for details on appropriate values. + +@node Controlling Sections +@subsection Controlling Sections + +Sections like the issue list and the status header can be toggled with the +interactive functions of the form @samp{magithub-toggle-*}. These functions have +no default keybinding. + +Since status checks can be API-hungry and not all projects use them, you can +disable the status header at the repository-level with @samp{H ~}; see the Status +Checks section for more information. + +@node Dispatch Popup +@chapter Dispatch Popup + +Much of Magithub's functionality, including configuration options, is behind +this popup. In Magit status buffers, it's bound to @samp{H}. + +@table @asis +@kindex d +@cindex magithub-dashboard +@item @kbd{d} @tie{}@tie{}@tie{}@tie{}(@code{magithub-dashboard}) + +See @ref{Dashboard}. + +@kindex c +@cindex magithub-create +@item @kbd{c} @tie{}@tie{}@tie{}@tie{}(@code{magithub-create}) + +Push a local repository up to GitHub. + +@kindex H +@cindex magithub-browse +@item @kbd{H} @tie{}@tie{}@tie{}@tie{}(@code{magithub-browse}) + +Open the current repository in your browser. + +@kindex f +@cindex magithub-fork +@item @kbd{f} @tie{}@tie{}@tie{}@tie{}(@code{magithub-fork}) + +Fork this repository on GitHub. This will add your fork as a remote under +your username. For example, if user @samp{octocat} forked Magit, we would see a +new remote called @samp{octocat} pointing to @samp{octocat/magit}. + +@kindex i +@cindex magithub-issue-new +@item @kbd{i} @tie{}@tie{}@tie{}@tie{}(@code{magithub-issue-new}) +@kindex p +@cindex magithub-pull-request-new +@item @kbd{p} @tie{}@tie{}@tie{}@tie{}(@code{magithub-pull-request-new}) + +Open a new buffer to create an issue or open a pull request. See +@ref{Creating Content}. +@end table + +@menu +* Configuration:: +* Meta:: +@end menu + +@node Configuration +@section Configuration + +Per-repository configuration is controlled via git variables reachable from +the dispatch popup via @samp{H C}. Use @samp{? } to get online help for each +variable in that popup. + +@table @asis +@kindex C e +@cindex FIXME +@item @kbd{C e} @tie{}@tie{}@tie{}@tie{}(@code{FIXME}) + +Turn Magithub on/off (completely). + +@kindex C s +@cindex FIXME +@item @kbd{C s} @tie{}@tie{}@tie{}@tie{}(@code{FIXME}) + +Turn the project status header on/off. + +@kindex C c +@cindex FIXME +@item @kbd{C c} @tie{}@tie{}@tie{}@tie{}(@code{FIXME}) + +Control whether Magithub is considered 'online'. This controls the +behavior of the the cache. This may go away in the future. See +Controlling the Cache for more details. FIXME there is no such node. + +@kindex C i +@cindex FIXME +@item @kbd{C i} @tie{}@tie{}@tie{}@tie{}(@code{FIXME}) + +Toggle the issues section. + +@kindex C p +@cindex FIXME +@item @kbd{C p} @tie{}@tie{}@tie{}@tie{}(@code{FIXME}) + +Toggle the pull requests section. + +@kindex C x +@cindex FIXME +@item @kbd{C x} @tie{}@tie{}@tie{}@tie{}(@code{FIXME}) + +Set the 'proxy' used for this repository. See @ref{Proxies}. +@end table + +@node Meta +@section Meta + +Since Magithub is so integrated with Magit, there's often confusion about +whom to ask for support (especially for users of preconfigured Emacsen like +Spacemacs and Prelude). Hopefully, these functions can direct you to the +appropriate spot. + +@table @asis +@kindex & +@cindex magithub--meta-new-issue +@item @kbd{&} @tie{}@tie{}@tie{}@tie{}(@code{magithub--meta-new-issue}) + +Open the browser to create a new issue for Magithub functionality +described in this document. + +@kindex h +@cindex magithub--meta-help +@item @kbd{h} @tie{}@tie{}@tie{}@tie{}(@code{magithub--meta-help}) + +Open the browser to ask for help on Gitter, a GitHub-focused chatroom. +@end table + +@node 'Features' +@chapter 'Features' + +Given that some features of Magithub are not desired by or appropriate for +every type of user, there are features that are not turned on by default. +These are features that are injected into standard Magit popups. + +The list of available features is available in constant +@code{magithub-feature-list}. Despite its name, this is an alist of symbols (i.e., +'features') to functions that install the feature. While the documentation +for each feature lives in that symbol, you would normally not otherwise +interact with it. + +@defun magithub-feature-autoinject + +This function is the expected interface to install features. You will +normally use +@lisp +(magithub-feature-autoinject t) +@end lisp +in your configuration to install all features, but you have the option of +installing them one at a time using the symbols from constant +@code{magithub-feature-list} or as a list of those symbols: +@lisp +(magithub-feature-autoinject 'commit-browse) +(magithub-feature-autoinject '(commit-browse pull-request-merge)) +@end lisp +@end defun + +@node Cloning +@chapter Cloning + +@cindex magithub-clone +@deffn Command magithub-clone + +Clone a repository from GitHub. +@end deffn + +@defopt magithub-clone-default-directory + +The default destination directory to use for cloning. +@end defopt + +@defopt magithub-preferred-remote-method + +This option is a symbol indicating the preferred cloning method (between +HTTPS, SSH, and the @samp{git://} protocol). +@end defopt + +@node Dashboard +@chapter Dashboard + +The dashboard shows you information pertaining to @emph{you}: +@itemize +@item +notifications + +@item +issues and pull requests you're assigned per repository +@end itemize +as well as contextual information like the logged-in user and @uref{https://developer.github.com/v3/#rate-limiting, rate-limiting} +information. + +@cindex magithub-dashboard +@deffn Command magithub-dashboard + +View your dashboard. +@end deffn + +@table @asis +@kindex ; +@cindex magithub-dashboard-popup +@item @kbd{;} @tie{}@tie{}@tie{}@tie{}(@code{magithub-dashboard-popup}) + +Configure your global dashboard settings. + +@end table + +@defopt magithub-dashboard-show-read-notifications + +When non-nil, we'll show read notifications in the dashboard. +@end defopt + +@node Creating Content +@chapter Creating Content + +It's great to read about what's been happening, but it's even better to +contribute your own thoughts and activity! + +@table @asis +@kindex H i +@cindex magithub-issue-new +@item @kbd{H i} @tie{}@tie{}@tie{}@tie{}(@code{magithub-issue-new}) +@kindex H p +@cindex magithub-pull-request-new +@item @kbd{H p} @tie{}@tie{}@tie{}@tie{}(@code{magithub-pull-request-new}) + +Create issues and pull requests. If you have push access to the +repository, you'll have the opportunity to add labels before you submit +the issue. + +Creating a pull request requires a HEAD branch, a BASE branch, and to know +which remote points to your fork. + +@kindex r +@cindex magithub-comment-new +@item @kbd{r} @tie{}@tie{}@tie{}@tie{}(@code{magithub-comment-new}) +@kindex r +@cindex magithub-comment-reply +@item @kbd{r} @tie{}@tie{}@tie{}@tie{}(@code{magithub-comment-reply}) + +On an issue or pull request section, @code{magithub-comment-new} will allow you +to post a comment to that issue/PR. If point is already on a comment, +@code{magithub-comment-reply} will quote the comment at point for you. +@end table + +@node Caching +@chapter Caching + +Caching is a complicated topic with a long Magithub history of, well, +failure. As of today, all data retrieved from the API is cached by +default. Using @samp{g} on Magithub sections will usually refresh the information +in the buffer pertaining to that section. Otherwise, @samp{C-u g} in any Magit +buffer will refresh all GitHub data in that buffer. + +This behavior may change in the future, but for now, it's the most stable +option. See + +@node Proxies +@chapter Proxies + +It's not uncommon to have repositories where the bug-tracker is in a +separate repository. For these cases, you can use the idea of 'proxies'. A +proxy is a remote (with a GitHub-associated URL) that you choose to use for +all GitHub API requests concerning the @emph{actual} current repository. This is +manifest in the git variable @samp{magithub.proxy}. + +@defun magithub-proxy-set-default + +If you consistently use a specific remote name for the bug tracker, you +can set it globally. +@end defun + +All GitHub requests specific to the current repository context are routed +through @code{magithub-repo} which respects this proxy. + +@node Unfiled +@chapter Unfiled + +@menu +* Content:: +* 'Tricks':: +@end menu + +@node Content +@section Content + +@menu +* Working with Repositories:: +* Your Dashboard:: +@end menu + +@node Working with Repositories +@subsection Working with Repositories + +@menu +* General:: +* Issues:: +* Forking and Pull Requests:: +* Labels:: +* Status Checks:: +@end menu + +@node General +@subsubsection @strong{DONE} General + +@multitable {aaaaaaaaaaaaaaaaaaaa} {aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa} +@headitem Default Key +@tab Description +@item @samp{H H} +@tab Opens the current repository in the browser +@item @samp{H c} +@tab Creates the current local repository on GitHub +@item @samp{M-x magithub-clone} +@tab Clone a repository +@end multitable + +@samp{magithub-clone} may appear to be a thin wrapper over @samp{magit-clone}, but it's +quite a bit smarter than that. We'll of course respect +@samp{magithub-preferred-remote-method} when cloning the repository, but we can +also detect when the repository is a fork and can create and set an upstream +remote accordingly (similar to @samp{M-x magithub-fork}). + +@node Issues +@subsubsection @strong{DONE} Issues + +@multitable {aaaaaaaaaaa} {aaaaaaaaaaaaaaaaaaaaaaaa} +@headitem Default Key +@tab Description +@item @samp{H i} +@tab Create a new issue +@item @samp{RET} +@tab Open the issue in GitHub +@end multitable + +You can filter issues with @samp{magithub-issue-issue-filter-functions}: +@lisp +(setq magithub-issue-issue-filter-functions + (list (lambda (issue) ; don't show enhancement requests + (not + (member "enhancement" + (let-alist issue + (ghubp-get-in-all '(name) .labels))))))) +@end lisp +Each function in the @samp{*-functions} list must return non-nil for the issue to +appear in the issue list. See also the documentation for that variable. + +@node Forking and Pull Requests +@subsubsection @strong{DONE} Forking and Pull Requests + +@multitable {aaaaaaaaaaa} {aaaaaaaaaaaaaaaaaaaaaaaaaaaaa} +@headitem Default Key +@tab Description +@item @samp{H f} +@tab Fork the current repository +@item @samp{H p} +@tab Submit pull requests upstream +@end multitable + +You can also filter pull requests with +@samp{magithub-issue-pull-request-filter-functions}. See the section on +issue-filtering for an example. + +@node Labels +@subsubsection @strong{TODO} Labels + +@multitable {aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa} {aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa} +@headitem Default Key +@tab Description +@item @samp{M-x magithub-label-color-replace} +@tab Choose a new color for the label at point +@end multitable + +By default, Magithub will adopt the color used by GitHub when showing +labels. In some themes, this doesn't provide enough contrast. Use @samp{M-x +magithub-label-color-replace} to replace the current label's color with +another one. (This will apply to all labels in all repositories, but will +of course not apply to all @emph{shades} of the original color.) + +@node Status Checks +@subsubsection @strong{TODO} Status Checks + +@multitable {aaaaaaaaaaa} {aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa} +@headitem Default Key +@tab Description +@item @samp{RET} +@tab Visit the status's dashboard in your browser +@item @samp{TAB} +@tab On the status header, show individual CI details +@item @samp{H ~} +@tab Toggle status integration for this repository +@end multitable + +When the status buffer first opens, the status header is inserted at the top +and probably looks something like this: +@example +Status: Success +@end example + +You can get a breakdown of which checks succeeded and which failed by using +@samp{TAB}: +@example +Status: Success + Checks for ref: develop + Success The Travis CI build passed continuous-integration/travis-ci/push +@end example + +Pressing @samp{RET} on the header will take you to the dashboard associated with +that status check. If there's more than one status check here, you'll be +prompted to choose a check (e.g., Travis, Circle, CLA, @dots{}). Of course, if +you expand the header to show the individual checks, @samp{RET} on those will take +you straight to that check. + +@node Your Dashboard +@subsection @strong{TODO} Your Dashboard + +Check out @samp{M-x magithub-dashboard} to view your notifications and issues +assigned to you + +@node 'Tricks' +@section @strong{TODO} 'Tricks' + +Most of Magithub is implemented in pure Elisp now, but there are a few +lingering goodies that haven't been ported (since their real logic is +non-trivial). These definitions are relegated to @samp{magithub-issue-tricks.el}. + +Make sure to install @uref{https://hub.github.com, @samp{hub}} and add it to your @code{exec-path} if you intend to use +these functions. After installation, use @samp{hub browse} from a directory with a +GitHub repository to force the program to authenticate -- this avoids some +weirdness on the Emacs side of things. + +@bye diff --git a/test/magithub-test.el b/test/magithub-test.el index efe6d5c..103fb48 100644 --- a/test/magithub-test.el +++ b/test/magithub-test.el @@ -1,43 +1,54 @@ ;;; magithub-tests.el --- tests for Magithub -;; Copyright (C) 2016 Sean Allred +;; Copyright (C) 2016-2018 Sean Allred ;; ;; License: GPLv3 ;;; Code: (require 'ert) +(require 'magithub-core) +(require 'ghub+) -(add-to-list 'load-path ".") +(setq ghubp-request-override-function + #'magithub-mock-ghub-request) -(ert-deftest magithub-test-compile-core () - (should (byte-compile-file "magithub-core.el"))) -(ert-deftest magithub-test-compile-issue () - (should (byte-compile-file "magithub-issue.el"))) -(ert-deftest magithub-test-compile-ci () - (should (byte-compile-file "magithub-ci.el"))) -(ert-deftest magithub-test-compile-main () - (should (byte-compile-file "magithub.el"))) +(defmacro magithub-test-cache-with-new-cache (plist &rest body) + (declare (indent 1)) + `(let ((magithub-cache-class-refresh-seconds-alist ',plist) + (magithub-cache--cache (make-hash-table))) + ,@body)) -(require 'magithub-cache) (ert-deftest magithub-test-cache () - (should (equal (magithub-cache-value 1 :test) - nil)) - (should (equal (magithub-cache 1 :test '(list 1 2 3)) - '(1 2 3))) - (should (equal (magithub-cache-value 1 :test) - '(1 2 3))) - (should (equal (magithub-cache-value 2 :test) - nil)) - (should (equal (magithub-cache 2 :test '(list 2 4 6)) - '(2 4 6))) - (should (equal (magithub-cache-value 2 :test) - '(2 4 6))) - (should (equal (magithub-cache-value 2 :test-another) - nil)) - (should (equal (magithub-cache 2 :test-another 100) - 100)) - (should (equal (magithub-cache-value 2 :test-another) - 100))) + (magithub-test-cache-with-new-cache ((:test . 30)) + (should (equal t (magithub-cache :test t))))) + +(ert-deftest magithub-test-origin-parse () + "Tests issue #105." + (let ((repo '((owner (login . "vermiculus")) + (name . "magithub")))) + (should (equal repo (magithub--url->repo "git@github.com:vermiculus/magithub.git"))) + (should (equal repo (magithub--url->repo "git@github.com:vermiculus/magithub"))) + (should (equal repo (magithub--url->repo "git+ssh://github.com/vermiculus/magithub"))) + (should (equal repo (magithub--url->repo "ssh://git@github.com/vermiculus/magithub"))))) + +(ert-deftest magithub-test-source-repo () + "Test basic API functionality. +This tests everything from checking API availability to +determining that we're in a GitHub repository to actually making +cached API calls." + (let ((magithub--api-last-checked (current-time))) + (should (magithub-source--sparse-repo)) + (should (magithub-repo)) + (should (let ((magithub-cache--refresh t)) ; force API call + (magithub-repo))) + (should (magithub-repo)))) ; force cache read + +(ert-deftest magithub-test-parse-time-string () + "Test parsing of datetime." + (should (equal '(23253 12274) (magithub--parse-time-string "2018-04-16T23:21:22Z"))) + (should (equal '(23253 12274) (magithub--parse-time-string "2018-04-16T23:21:22"))) + (should (equal '(23253 12274) (magithub--parse-time-string "2018-04-16T2321:22"))) + (should-error (magithub--parse-time-string "2018-04-16T23:21:2XZ"))) ;;; magithub-test.el ends here diff --git a/test/mock-data/get/repos.d/vermiculus.d/magithub.81a9dfc7 b/test/mock-data/get/repos.d/vermiculus.d/magithub.81a9dfc7 new file mode 100644 index 0000000..e438e73 --- /dev/null +++ b/test/mock-data/get/repos.d/vermiculus.d/magithub.81a9dfc7 @@ -0,0 +1,95 @@ +((id . 68352724) + (name . "magithub") + (full_name . "vermiculus/magithub") + (owner + (login . "vermiculus") + (id . 2082195) + (avatar_url . "https://avatars3.githubusercontent.com/u/2082195?v=4") + (gravatar_id . "") + (url . "https://api.github.com/users/vermiculus") + (html_url . "https://github.com/vermiculus") + (followers_url . "https://api.github.com/users/vermiculus/followers") + (following_url . "https://api.github.com/users/vermiculus/following{/other_user}") + (gists_url . "https://api.github.com/users/vermiculus/gists{/gist_id}") + (starred_url . "https://api.github.com/users/vermiculus/starred{/owner}{/repo}") + (subscriptions_url . "https://api.github.com/users/vermiculus/subscriptions") + (organizations_url . "https://api.github.com/users/vermiculus/orgs") + (repos_url . "https://api.github.com/users/vermiculus/repos") + (events_url . "https://api.github.com/users/vermiculus/events{/privacy}") + (received_events_url . "https://api.github.com/users/vermiculus/received_events") + (type . "User") + (site_admin)) + (private) + (html_url . "https://github.com/vermiculus/magithub") + (description . "Magit interfaces for GitHub") + (fork) + (url . "https://api.github.com/repos/vermiculus/magithub") + (forks_url . "https://api.github.com/repos/vermiculus/magithub/forks") + (keys_url . "https://api.github.com/repos/vermiculus/magithub/keys{/key_id}") + (collaborators_url . "https://api.github.com/repos/vermiculus/magithub/collaborators{/collaborator}") + (teams_url . "https://api.github.com/repos/vermiculus/magithub/teams") + (hooks_url . "https://api.github.com/repos/vermiculus/magithub/hooks") + (issue_events_url . "https://api.github.com/repos/vermiculus/magithub/issues/events{/number}") + (events_url . "https://api.github.com/repos/vermiculus/magithub/events") + (assignees_url . "https://api.github.com/repos/vermiculus/magithub/assignees{/user}") + (branches_url . "https://api.github.com/repos/vermiculus/magithub/branches{/branch}") + (tags_url . "https://api.github.com/repos/vermiculus/magithub/tags") + (blobs_url . "https://api.github.com/repos/vermiculus/magithub/git/blobs{/sha}") + (git_tags_url . "https://api.github.com/repos/vermiculus/magithub/git/tags{/sha}") + (git_refs_url . "https://api.github.com/repos/vermiculus/magithub/git/refs{/sha}") + (trees_url . "https://api.github.com/repos/vermiculus/magithub/git/trees{/sha}") + (statuses_url . "https://api.github.com/repos/vermiculus/magithub/statuses/{sha}") + (languages_url . "https://api.github.com/repos/vermiculus/magithub/languages") + (stargazers_url . "https://api.github.com/repos/vermiculus/magithub/stargazers") + (contributors_url . "https://api.github.com/repos/vermiculus/magithub/contributors") + (subscribers_url . "https://api.github.com/repos/vermiculus/magithub/subscribers") + (subscription_url . "https://api.github.com/repos/vermiculus/magithub/subscription") + (commits_url . "https://api.github.com/repos/vermiculus/magithub/commits{/sha}") + (git_commits_url . "https://api.github.com/repos/vermiculus/magithub/git/commits{/sha}") + (comments_url . "https://api.github.com/repos/vermiculus/magithub/comments{/number}") + (issue_comment_url . "https://api.github.com/repos/vermiculus/magithub/issues/comments{/number}") + (contents_url . "https://api.github.com/repos/vermiculus/magithub/contents/{+path}") + (compare_url . "https://api.github.com/repos/vermiculus/magithub/compare/{base}...{head}") + (merges_url . "https://api.github.com/repos/vermiculus/magithub/merges") + (archive_url . "https://api.github.com/repos/vermiculus/magithub/{archive_format}{/ref}") + (downloads_url . "https://api.github.com/repos/vermiculus/magithub/downloads") + (issues_url . "https://api.github.com/repos/vermiculus/magithub/issues{/number}") + (pulls_url . "https://api.github.com/repos/vermiculus/magithub/pulls{/number}") + (milestones_url . "https://api.github.com/repos/vermiculus/magithub/milestones{/number}") + (notifications_url . "https://api.github.com/repos/vermiculus/magithub/notifications{?since,all,participating}") + (labels_url . "https://api.github.com/repos/vermiculus/magithub/labels{/name}") + (releases_url . "https://api.github.com/repos/vermiculus/magithub/releases{/id}") + (deployments_url . "https://api.github.com/repos/vermiculus/magithub/deployments") + (created_at . "2016-09-16T04:32:34Z") + (updated_at . "2017-09-29T11:26:51Z") + (pushed_at . "2017-09-18T20:06:43Z") + (git_url . "git://github.com/vermiculus/magithub.git") + (ssh_url . "git@github.com:vermiculus/magithub.git") + (clone_url . "https://github.com/vermiculus/magithub.git") + (svn_url . "https://github.com/vermiculus/magithub") + (homepage . "") + (size . 1841) + (stargazers_count . 290) + (watchers_count . 290) + (language . "Emacs Lisp") + (has_issues . t) + (has_projects . t) + (has_downloads . t) + (has_wiki . t) + (has_pages) + (forks_count . 27) + (mirror_url) + (open_issues_count . 35) + (forks . 27) + (open_issues . 35) + (watchers . 290) + (default_branch . "master") + (permissions + (admin . t) + (push . t) + (pull . t)) + (allow_squash_merge . t) + (allow_merge_commit . t) + (allow_rebase_merge . t) + (network_count . 27) + (subscribers_count . 15)) diff --git a/test/test-helper.el b/test/test-helper.el new file mode 100644 index 0000000..52a5cbd --- /dev/null +++ b/test/test-helper.el @@ -0,0 +1,69 @@ +;;; Allow loading package files +(require 'cl-lib) + +(defun magithub-in-test-dir (file) + "Expand FILE in the test directory." + (let ((dir default-directory)) + (while (and (not (string= dir "/")) + (not (file-exists-p (expand-file-name ".git" dir)))) + (setq dir (file-name-directory (directory-file-name dir)))) + (when (string= dir "/") + (error "Project root not found")) + (setq dir (expand-file-name "test" dir)) + (expand-file-name file dir))) + +(defun magithub-mock-data-crunch (data) + "Crunch DATA into a string appropriate for a filename." + (substring (sha1 (prin1-to-string data)) 0 8)) + +(cl-defun magithub-mock-ghub-request (method resource &optional params + &key query payload headers unpaginate + noerror reader username auth host) + "Mock a call to the GitHub API. + +If the call has not been mocked and the AUTOTEST environment +variable is not set, offer to save a snapshot of the real API's +response." + (message "(mock-ghub-request %S %S %S :query %S :payload %S :headers %S :unpaginate %S :noerror %S :reader %S :username %S :auth %S :host %S)" + method resource params query payload headers unpaginate noerror reader username auth host) + (when (not (magithub-online-p)) + (error "Did not respect online/offline")) + (let* ((parts (cdr (s-split "/" resource))) + (directory (mapconcat (lambda (s) (concat s ".d")) + (butlast parts) "/")) + (filename (magithub-in-test-dir + (format "mock-data/%s/%s/%s.%s" + (downcase method) + directory + (car (last parts)) + (magithub-mock-data-crunch + (list method resource params query payload headers + unpaginate noerror reader username auth host)))))) + (if (file-readable-p filename) + (prog1 (with-temp-buffer + (insert-file-contents-literally filename) + (read (current-buffer))) + (message "Found %S" filename)) + (message "Did not find %S" filename) + (if (and (not (getenv "AUTOTEST")) + (y-or-n-p (format "Request not mocked; mock now?"))) + (progn + (make-directory directory t) + (let ((real-data (ghub-request method resource params + :query query + :payload payload + :headers headers + :unpaginate unpaginate + :noerror noerror + :reader reader + :username username + :auth auth + :host host))) + (pp-display-expression real-data "*GitHub API Response*") + (if (y-or-n-p "API response displayed; is this ok?") + (with-temp-buffer + (insert (pp-to-string real-data)) + (write-file filename) + (message "Wrote %s" filename)) + (error "API response rejected")))) + (error "Unmocked test!")))))