--- /dev/null
+;;; gh-api.el --- api definition for gh.el -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2011 Yann Hodique
+
+;; Author: Yann Hodique <yann.hodiqueNOSPAMgmail.com>
+;; Keywords:
+
+;; This file 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 2, or (at your option)
+;; any later version.
+
+;; This file 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 GNU Emacs; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(require 'eieio)
+
+(require 'json)
+
+(require 'gh-profile)
+(require 'gh-url)
+(require 'gh-auth)
+(require 'gh-cache)
+
+(require 'logito)
+
+(defgroup gh-api nil
+ "Github API."
+ :group 'gh)
+
+(defcustom gh-api-username-filter 'gh-api-enterprise-username-filter
+ "Filter to apply to usernames to build URL components"
+ :type 'function
+ :group 'gh-api)
+
+(defclass gh-api ()
+ ((sync :initarg :sync :initform t)
+ (cache :initarg :cache :initform nil)
+ (base :initarg :base :type string)
+ (profile :initarg :profile :type string)
+ (auth :initarg :auth :initform nil)
+ (data-format :initarg :data-format)
+ (num-retries :initarg :num-retries :initform 0)
+ (log :initarg :log :initform nil)
+ (cache-cls :initform gh-cache :allocation :class))
+ "Github API")
+
+(cl-defmethod logito-log ((api gh-api) level tag string &rest objects)
+ (apply 'logito-log (oref api :log) level tag string objects))
+
+(cl-defmethod initialize-instance ((api gh-api) &rest args)
+ (cl-call-next-method))
+
+(cl-defmethod gh-api-set-default-auth ((api gh-api) auth)
+ (let ((auth (or (oref api :auth) auth))
+ (cache (oref api :cache))
+ (classname (symbol-name (funcall (if (fboundp 'eieio-object-class)
+ 'eieio-object-class
+ 'object-class)
+ api))))
+ (oset api :auth auth)
+ (unless (or (null cache)
+ (and (eieio-object-p cache)
+ (object-of-class-p cache 'gh-cache)))
+ (oset api :cache (make-instance
+ (oref api cache-cls)
+ :object-name
+ (format "gh/%s/%s"
+ classname
+ (gh-api-get-username api)))))))
+
+(cl-defmethod gh-api-expand-resource ((api gh-api)
+ resource)
+ resource)
+
+(defun gh-api-enterprise-username-filter (username)
+ (replace-regexp-in-string (regexp-quote ".") "-" username))
+
+(cl-defmethod gh-api-get-username ((api gh-api))
+ (let ((username (oref (oref api :auth) :username)))
+ (funcall gh-api-username-filter username)))
+
+(defclass gh-api-v3 (gh-api)
+ ((data-format :initarg :data-format :initform :json))
+ "Github API v3")
+
+(defcustom gh-api-v3-authenticator 'gh-oauth-authenticator
+ "Authenticator for Github API v3"
+ :type '(choice (const :tag "Password" gh-password-authenticator)
+ (const :tag "OAuth" gh-oauth-authenticator))
+ :group 'gh-api)
+
+(cl-defmethod initialize-instance ((api gh-api-v3) &rest args)
+ (cl-call-next-method)
+ (let ((gh-profile-current-profile (gh-profile-current-profile)))
+ (oset api :profile (gh-profile-current-profile))
+ (oset api :base (gh-profile-url))
+ (gh-api-set-default-auth api
+ (or (oref api :auth)
+ (funcall gh-api-v3-authenticator "auth")))))
+
+(defclass gh-api-request (gh-url-request)
+ ((default-response-cls :allocation :class :initform gh-api-response)))
+
+(defclass gh-api-response (gh-url-response)
+ ())
+
+(defun gh-api-json-decode (repr)
+ (if (or (null repr) (string= repr ""))
+ 'empty
+ (let ((json-array-type 'list))
+ (json-read-from-string repr))))
+
+(defun gh-api-json-encode (json)
+ (encode-coding-string (json-encode-list json) 'utf-8))
+
+(cl-defmethod gh-url-response-set-data ((resp gh-api-response) data)
+ (cl-call-next-method resp (gh-api-json-decode data)))
+
+(defclass gh-api-paged-request (gh-api-request)
+ ((default-response-cls :allocation :class :initform gh-api-paged-response)
+ (page-limit :initarg :page-limit :initform -1)))
+
+(defclass gh-api-paged-response (gh-api-response)
+ ())
+
+(cl-defmethod gh-api-paging-links ((resp gh-api-paged-response))
+ (let ((links-header (cdr (assoc "Link" (oref resp :headers)))))
+ (when links-header
+ (cl-loop for item in (split-string links-header ", ")
+ when (string-match "^<\\(.*\\)>; rel=\"\\(.*\\)\"" item)
+ collect (cons (match-string 2 item)
+ (match-string 1 item))))))
+
+(cl-defmethod gh-url-response-set-data ((resp gh-api-paged-response) data)
+ (let ((previous-data (oref resp :data))
+ (next (cdr (assoc "next" (gh-api-paging-links resp)))))
+ (cl-call-next-method)
+ (oset resp :data (append previous-data (oref resp :data)))
+ (when (and next (not (equal 304 (oref resp :http-status))))
+ (let* ((req (oref resp :-req))
+ (last-page-limit (oref req :page-limit))
+ (this-page-limit (if (numberp last-page-limit) (- last-page-limit 1) -1)))
+ (oset req :page-limit this-page-limit)
+ (unless (eq (oref req :page-limit) 0)
+ ;; We use an explicit check for 0 since -1 indicates that
+ ;; paging should continue forever.
+ (oset resp :data-received nil)
+ (oset req :url next)
+ ;; Params need to be set to nil because the next uri will
+ ;; already have query params. If params are non-nil this will
+ ;; cause another set of params to be added to the end of the
+ ;; string which will override the params that are set in the
+ ;; next link.
+ (oset req :query nil)
+ (gh-url-run-request req resp))))))
+
+(cl-defmethod gh-api-authenticated-request
+ ((api gh-api) transformer method resource &optional data params page-limit)
+ (let* ((fmt (oref api :data-format))
+ (headers (cond ((eq fmt :form)
+ '(("Content-Type" .
+ "application/x-www-form-urlencoded")))
+ ((eq fmt :json)
+ '(("Content-Type" .
+ "application/json")))))
+ (cache (oref api :cache))
+ (key (list resource
+ method
+ (sha1 (format "%s" transformer))))
+ (cache-key (and cache
+ (member method (oref cache safe-methods))
+ key))
+ (has-value (and cache-key (pcache-has cache cache-key)))
+ (value (and has-value (pcache-get cache cache-key)))
+ (is-outdated (and has-value (gh-cache-outdated-p cache cache-key)))
+ (etag (and is-outdated (gh-cache-etag cache cache-key)))
+ (req
+ (and (or (not has-value)
+ is-outdated)
+ (gh-auth-modify-request
+ (oref api :auth)
+ ;; TODO: use gh-api-paged-request only when needed
+ (make-instance 'gh-api-paged-request
+ :method method
+ :url (concat (oref api :base)
+ (gh-api-expand-resource
+ api resource))
+ :query params
+ :headers (if etag
+ (cons (cons "If-None-Match" etag)
+ headers)
+ headers)
+ :data (or (and (eq fmt :json)
+ (gh-api-json-encode data))
+ (and (eq fmt :form)
+ (gh-url-form-encode data))
+ "")
+ :page-limit page-limit)))))
+ (cond ((and has-value ;; got value from cache
+ (not is-outdated))
+ (make-instance 'gh-api-response :data-received t :data value))
+ (cache-key ;; no value, but cache exists and method is safe
+ (let ((resp (make-instance (oref req default-response-cls)
+ :transform transformer)))
+ (gh-url-run-request req resp)
+ (gh-url-add-response-callback
+ resp (make-instance 'gh-api-callback :cache cache :key cache-key
+ :revive etag))
+ resp))
+ (cache ;; unsafe method, cache exists
+ (pcache-invalidate cache key)
+ (gh-url-run-request req (make-instance
+ (oref req default-response-cls)
+ :transform transformer)))
+ (t ;; no cache involved
+ (gh-url-run-request req (make-instance
+ (oref req default-response-cls)
+ :transform transformer))))))
+
+(defclass gh-api-callback (gh-url-callback)
+ ((cache :initarg :cache)
+ (key :initarg :key)
+ (revive :initarg :revive)))
+
+(cl-defmethod gh-url-callback-run ((cb gh-api-callback) resp)
+ (let ((cache (oref cb :cache))
+ (key (oref cb :key)))
+ (if (and (oref cb :revive) (equal (oref resp :http-status) 304))
+ (progn
+ (gh-cache-revive cache key)
+ (oset resp :data (pcache-get cache key)))
+ (pcache-put cache key (oref resp :data))
+ (gh-cache-set-etag cache key
+ (cdr (assoc "ETag" (oref resp :headers)))))))
+
+(define-obsolete-function-alias 'gh-api-add-response-callback
+ 'gh-url-add-response-callback "0.6.0")
+
+(provide 'gh-api)
+;;; gh-api.el ends here
+
+;; Local Variables:
+;; indent-tabs-mode: nil
+;; End:
--- /dev/null
+;;; gh-auth.el --- authentication for gh.el -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2011 Yann Hodique
+
+;; Author: Yann Hodique <yann.hodiqueNOSPAMgmail.com>
+;; Keywords:
+
+;; This file 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 2, or (at your option)
+;; any later version.
+
+;; This file 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 GNU Emacs; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(require 'eieio)
+
+(require 'gh-profile)
+(require 'gh-common)
+(require 'gh-url)
+
+(defgroup gh-auth nil
+ "Github authentication."
+ :group 'gh)
+
+(defvar gh-auth-alist nil)
+
+(defun gh-auth-remember (profile key value)
+ (let ((cell (assoc profile gh-auth-alist)))
+ (when (not cell)
+ (setq cell (cons profile nil))
+ (setq gh-auth-alist (append gh-auth-alist (list cell))))
+ (setcdr cell (plist-put (cdr cell) key value))))
+
+(defun gh-auth-get-username ()
+ (let* ((profile (gh-profile-current-profile))
+ (user (or (plist-get (cdr (assoc profile gh-auth-alist)) :username)
+ (plist-get (cdr (assoc profile gh-profile-alist)) :username)
+ (gh-config "user"))))
+ (when (not user)
+ (setq user (read-string "GitHub username: "))
+ (gh-set-config "user" user))
+ (gh-auth-remember profile :username user)
+ user))
+
+(defun gh-auth-get-password (&optional remember)
+ (let* ((profile (gh-profile-current-profile))
+ (pass (or (plist-get (cdr (assoc profile gh-auth-alist)) :password)
+ (plist-get (cdr (assoc profile gh-profile-alist)) :password)
+ (gh-config "password"))))
+ (when (not pass)
+ (setq pass (read-passwd "GitHub password: "))
+ (when remember
+ (gh-set-config "password" pass)))
+ (when remember
+ (gh-auth-remember profile :password pass))
+ pass))
+
+(declare-function 'gh-oauth-auth-new "gh-oauth")
+
+(defun gh-auth-get-oauth-token ()
+ (let* ((profile (gh-profile-current-profile))
+ (token (or (plist-get (cdr (assoc profile gh-auth-alist)) :token)
+ (plist-get (cdr (assoc profile gh-profile-alist)) :token)
+ (gh-config "oauth-token"))))
+ (when (not token)
+ (let* ((api (make-instance 'gh-oauth-api))
+ (tok (and (fboundp 'gh-oauth-auth-new)
+ (oref (oref (funcall 'gh-oauth-auth-new api
+ '(user repo gist)) :data)
+ :token))))
+ (setq token (or tok (read-string "GitHub OAuth token: ")))
+ (gh-set-config "oauth-token" token)))
+ (gh-auth-remember profile :token token)
+ token))
+
+(defclass gh-authenticator ()
+ ((username :initarg :username :initform nil))
+ "Abstract authenticator")
+
+(cl-defmethod initialize-instance ((auth gh-authenticator) &rest args)
+ (cl-call-next-method)
+ (or (oref auth :username)
+ (oset auth :username (gh-auth-get-username))))
+
+(cl-defmethod gh-auth-modify-request ((auth gh-authenticator) req)
+ req)
+
+(defclass gh-auth-2fa-callback (gh-url-callback)
+ ((req :initarg :req :initform nil))
+ "2-factor callback")
+
+(cl-defmethod gh-url-callback-run ((cb gh-auth-2fa-callback) resp)
+ (when (equal (oref resp :http-status) 401)
+ (let* ((otp-header "X-GitHub-OTP")
+ (h (assoc otp-header (oref resp :headers))))
+ (when (and h (string-prefix-p "required;" (cdr h)))
+ (let ((otp (read-from-minibuffer "Enter dual-factor auth code: "))
+ (req (oref cb :req)))
+ ;; reset resp
+ (oset resp :data nil)
+ (oset resp :data-received nil)
+
+ (object-add-to-list req :headers
+ (cons otp-header otp))
+ (gh-url-run-request req resp))))))
+
+(defclass gh-password-authenticator (gh-authenticator)
+ ((password :initarg :password :protection :private :initform nil)
+ (remember :allocation :class :initform t)
+
+ (2fa-cls :initform gh-auth-2fa-callback :allocation :class))
+ "Password-based authenticator")
+
+(cl-defmethod initialize-instance ((auth gh-password-authenticator) &rest args)
+ (cl-call-next-method)
+ (or (oref auth :password)
+ (oset auth :password (gh-auth-get-password (oref auth remember)))))
+
+(cl-defmethod gh-auth-modify-request ((auth gh-password-authenticator) req)
+ (object-add-to-list req :headers
+ (cons "Authorization"
+ (concat "Basic "
+ (base64-encode-string
+ (format "%s:%s" (oref auth :username)
+ (encode-coding-string
+ (oref auth :password) 'utf-8))))))
+ (object-add-to-list req :install-callbacks
+ (make-instance (oref auth 2fa-cls) :req req))
+ req)
+
+(defclass gh-oauth-authenticator (gh-authenticator)
+ ((token :initarg :token :protection :private :initform nil))
+ "Oauth-based authenticator")
+
+(cl-defmethod initialize-instance ((auth gh-oauth-authenticator) &rest args)
+ (cl-call-next-method)
+ (or (oref auth :token)
+ (oset auth :token (gh-auth-get-oauth-token))))
+
+(cl-defmethod gh-auth-modify-request ((auth gh-oauth-authenticator) req)
+ (object-add-to-list req :headers
+ (cons "Authorization"
+ (encode-coding-string
+ (format "token %s" (oref auth :token)) 'utf-8)))
+ req)
+
+(provide 'gh-auth)
+;; to avoid circular dependencies...
+(require 'gh-oauth)
+;;; gh-auth.el ends here
+
+;; Local Variables:
+;; indent-tabs-mode: nil
+;; End:
--- /dev/null
+;;; gh-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*-
+;;
+;;; Code:
+
+(add-to-list 'load-path (directory-file-name
+ (or (file-name-directory #$) (car load-path))))
+
+\f
+;;;### (autoloads nil "gh-api" "gh-api.el" (0 0 0 0))
+;;; Generated autoloads from gh-api.el
+
+(register-definition-prefixes "gh-api" '("gh-api"))
+
+;;;***
+\f
+;;;### (autoloads nil "gh-auth" "gh-auth.el" (0 0 0 0))
+;;; Generated autoloads from gh-auth.el
+
+(register-definition-prefixes "gh-auth" '("gh-"))
+
+;;;***
+\f
+;;;### (autoloads nil "gh-cache" "gh-cache.el" (0 0 0 0))
+;;; Generated autoloads from gh-cache.el
+
+(register-definition-prefixes "gh-cache" '("gh-cache"))
+
+;;;***
+\f
+;;;### (autoloads nil "gh-comments" "gh-comments.el" (0 0 0 0))
+;;; Generated autoloads from gh-comments.el
+
+(register-definition-prefixes "gh-comments" '("gh-comments-api-mixin"))
+
+;;;***
+\f
+;;;### (autoloads nil "gh-common" "gh-common.el" (0 0 0 0))
+;;; Generated autoloads from gh-common.el
+
+(register-definition-prefixes "gh-common" '("gh-"))
+
+;;;***
+\f
+;;;### (autoloads nil "gh-gist" "gh-gist.el" (0 0 0 0))
+;;; Generated autoloads from gh-gist.el
+
+(register-definition-prefixes "gh-gist" '("gh-gist-api"))
+
+;;;***
+\f
+;;;### (autoloads nil "gh-issues" "gh-issues.el" (0 0 0 0))
+;;; Generated autoloads from gh-issues.el
+
+(register-definition-prefixes "gh-issues" '("gh-issues-"))
+
+;;;***
+\f
+;;;### (autoloads nil "gh-oauth" "gh-oauth.el" (0 0 0 0))
+;;; Generated autoloads from gh-oauth.el
+
+(register-definition-prefixes "gh-oauth" '("gh-oauth-"))
+
+;;;***
+\f
+;;;### (autoloads nil "gh-orgs" "gh-orgs.el" (0 0 0 0))
+;;; Generated autoloads from gh-orgs.el
+
+(register-definition-prefixes "gh-orgs" '("gh-orgs-api"))
+
+;;;***
+\f
+;;;### (autoloads nil "gh-profile" "gh-profile.el" (0 0 0 0))
+;;; Generated autoloads from gh-profile.el
+
+(register-definition-prefixes "gh-profile" '("gh-profile-"))
+
+;;;***
+\f
+;;;### (autoloads nil "gh-pulls" "gh-pulls.el" (0 0 0 0))
+;;; Generated autoloads from gh-pulls.el
+
+(register-definition-prefixes "gh-pulls" '("gh-pulls-"))
+
+;;;***
+\f
+;;;### (autoloads nil "gh-repos" "gh-repos.el" (0 0 0 0))
+;;; Generated autoloads from gh-repos.el
+
+(register-definition-prefixes "gh-repos" '("gh-repos-api"))
+
+;;;***
+\f
+;;;### (autoloads nil "gh-search" "gh-search.el" (0 0 0 0))
+;;; Generated autoloads from gh-search.el
+
+(register-definition-prefixes "gh-search" '("gh-search-"))
+
+;;;***
+\f
+;;;### (autoloads nil "gh-url" "gh-url.el" (0 0 0 0))
+;;; Generated autoloads from gh-url.el
+
+(register-definition-prefixes "gh-url" '("gh-url-"))
+
+;;;***
+\f
+;;;### (autoloads nil "gh-users" "gh-users.el" (0 0 0 0))
+;;; Generated autoloads from gh-users.el
+
+(register-definition-prefixes "gh-users" '("gh-users-api"))
+
+;;;***
+\f
+;;;### (autoloads nil nil ("gh-issue-comments.el" "gh-pkg.el" "gh-pull-comments.el"
+;;;;;; "gh.el") (0 0 0 0))
+
+;;;***
+\f
+;; Local Variables:
+;; version-control: never
+;; no-byte-compile: t
+;; no-update-autoloads: t
+;; coding: utf-8
+;; End:
+;;; gh-autoloads.el ends here
--- /dev/null
+;;; gh-cache.el --- caching for gh.el -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2011 Yann Hodique
+
+;; Author: Yann Hodique <yann.hodiqueNOSPAMgmail.com>
+;; Keywords:
+
+;; This file 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 2, or (at your option)
+;; any later version.
+
+;; This file 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 GNU Emacs; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(require 'eieio)
+
+(require 'pcache)
+
+(defconst gh-cache-outdated-expiration-delay (* 60 60 24))
+
+(defconst gh-cache-internal-version-constant 4)
+
+(defconst gh-cache-version-constant
+ (format "%s/gh-%s" pcache-version-constant gh-cache-internal-version-constant))
+
+(defclass gh-cache (pcache-repository)
+ ((version-constant :allocation :class)
+ (entries :initarg :entries :initform (make-hash-table :test 'equal))
+ (safe-methods :allocation :class :initform ("HEAD" "GET" "OPTIONS" "TRACE"))
+ (invalidation-chain :allocation :class :initform nil)
+
+ (entry-cls :initarg :entry-cls :initform gh-cache-entry)))
+
+(oset-default 'gh-cache version-constant gh-cache-version-constant)
+
+(defclass gh-cache-entry (pcache-entry)
+ ((etag :initarg :etag :initform nil)
+ (outdated :initarg :outdated :initform nil)
+ ;; (ttl :initarg :ttl :initform 0)
+ ))
+
+(cl-defmethod pcache-invalidate :after ((cache gh-cache) key)
+ (let ((resource (car key)))
+ (pcache-map cache #'(lambda (k v)
+ (when (equal (car k) resource)
+ (pcache-invalidate cache k))))
+ (dolist (next (oref cache invalidation-chain))
+ (let ((nextresource
+ (replace-regexp-in-string (car next) (cdr next) resource)))
+ (when (not (equal nextresource resource))
+ (pcache-map cache #'(lambda (k v)
+ (when (equal (car k) nextresource)
+ (pcache-invalidate cache k)))))))))
+
+(cl-defmethod pcache-get ((cache gh-cache) key &optional default)
+ (let* ((table (oref cache :entries))
+ (entry (gethash key table)))
+ (if (not entry)
+ default
+ (unless (pcache-entry-valid-p entry)
+ (oset entry :outdated t))
+ (oref entry :value))))
+
+(cl-defmethod pcache-has ((cache pcache-repository) key)
+ (let* ((default (make-symbol ":nil"))
+ (table (oref cache :entries))
+ (entry (gethash key table default)))
+ (not (eq entry default))))
+
+(cl-defmethod pcache-purge-invalid ((cache gh-cache))
+ (let ((table (oref cache :entries)))
+ (maphash #'(lambda (k e)
+ (unless (gh-cache-expired-p e)
+ (remhash k table)))
+ table)
+ (pcache-save cache)))
+
+(cl-defmethod gh-cache-outdated-p ((cache gh-cache) key)
+ (let* ((table (oref cache :entries))
+ (entry (gethash key table)))
+ (and entry
+ (oref entry :outdated))))
+
+(cl-defmethod gh-cache-expired-p ((cache gh-cache) key)
+ (let* ((table (oref cache :entries))
+ (entry (gethash key table)))
+ (and (gh-cache-outdated-p cache key)
+ (not
+ (let ((time (float-time (current-time))))
+ (< time (+ gh-cache-outdated-expiration-delay
+ (oref entry :timestamp))))))))
+
+(cl-defmethod gh-cache-revive ((cache gh-cache) key)
+ (let* ((table (oref cache :entries))
+ (entry (gethash key table)))
+ (and entry
+ (oset entry :outdated nil)
+ (oset entry :timestamp (float-time (current-time)))
+ t)))
+
+(cl-defmethod gh-cache-etag ((cache gh-cache) key)
+ (let* ((table (oref cache :entries))
+ (entry (gethash key table)))
+ (and entry
+ (oref entry :etag))))
+
+(cl-defmethod gh-cache-set-etag ((cache gh-cache) key etag)
+ (let* ((table (oref cache :entries))
+ (entry (gethash key table)))
+ (and entry
+ (oset entry :etag etag))))
+
+(provide 'gh-cache)
+;;; gh-cache.el ends here
+
+;; Local Variables:
+;; indent-tabs-mode: nil
+;; End:
--- /dev/null
+;;; gh-comments.el --- support for comment-enabled APIs -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2014-2015 Yann Hodique
+
+;; Author: Yann Hodique <hodiqueyNOSPAMvmware.com>
+;; Keywords:
+
+;; This file 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 2, or (at your option)
+;; any later version.
+
+;; This file 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 GNU Emacs; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(require 'eieio)
+
+(require 'gh-common)
+(require 'gh-api)
+
+(defclass gh-comments-api-mixin ()
+ ((comment-cls :allocation :class :initform gh-comment))
+ :abstract t)
+
+(cl-defmethod gh-comments-list ((api gh-comments-api-mixin) base)
+ (gh-api-authenticated-request
+ api (gh-object-list-reader (oref api comment-cls)) "GET"
+ (format "%s/comments" (gh-ref-object-base base))))
+
+(cl-defmethod gh-comments-get ((api gh-comments-api-mixin) base comment-id)
+ (gh-api-authenticated-request
+ api (gh-object-reader (oref api comment-cls)) "GET"
+ (format "%s/comments/%s" (gh-ref-object-base base) comment-id)))
+
+(cl-defmethod gh-comments-update ((api gh-comments-api-mixin) base comment-id comment)
+ (gh-api-authenticated-request
+ api (gh-object-reader (oref api comment-cls)) "PATCH"
+ (format "%s/comments/%s" (gh-ref-object-base base) comment-id)
+ (gh-comment-req-to-update comment)))
+
+(cl-defmethod gh-comments-new ((api gh-comments-api-mixin) base comment)
+ (gh-api-authenticated-request
+ api (gh-object-reader (oref api comment-cls)) "POST"
+ (format "%s/comments" (gh-ref-object-base base))
+ (gh-comment-req-to-update comment)))
+
+(cl-defmethod gh-comments-delete ((api gh-comments-api-mixin) base comment-id)
+ (gh-api-authenticated-request
+ api nil "DELETE"
+ (format "%s/comments/%s" (gh-ref-object-base base) comment-id)))
+
+(provide 'gh-comments)
+;;; gh-comments.el ends here
--- /dev/null
+;;; gh-common.el --- common objects for gh.el -*- lexical-binding: t; no-byte-compile: t-*-
+
+;; Copyright (C) 2011 Yann Hodique
+
+;; Author: Yann Hodique <yann.hodiqueNOSPAMgmail.com>
+;; Keywords:
+
+;; This file 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 2, or (at your option)
+;; any later version.
+
+;; This file 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 GNU Emacs; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(require 'eieio)
+(require 'marshal)
+
+(autoload 'gh-profile-current-profile "gh-profile")
+(autoload 'gh-profile-default-profile "gh-profile")
+
+(defgroup gh nil
+ "Github API client libraries."
+ :group 'applications)
+
+(defcustom gh-use-local-git-config nil
+ "If `t' use git configuration from the machine running
+Emacs. This makes a difference when running with TRAMP."
+ :type 'boolean
+ :group 'gh)
+
+;;; Helper functions
+
+(defun gh-read (obj field)
+ (cdr (assoc field obj)))
+
+(defun gh-namespaced-key (key)
+ (let ((profile (gh-profile-current-profile)))
+ (concat "github."
+ (if (string= profile (gh-profile-default-profile))
+ ""
+ (concat profile "."))
+ key)))
+
+(defun gh-config (key)
+ "Returns a GitHub specific value from the global Git config."
+ (let ((strip (lambda (string)
+ (if (> (length string) 0)
+ (substring string 0 (- (length string) 1))))))
+ (funcall strip (gh-command-to-string "config" (gh-namespaced-key key)))))
+
+(defun gh-set-config (key value)
+ "Sets a GitHub specific value to the global Git config."
+ (gh-command-to-string "config" "--global" (gh-namespaced-key key) value))
+
+(defun gh-command-to-string (&rest args)
+ (let ((git (executable-find "git"))
+ (runner (if gh-use-local-git-config
+ 'call-process
+ 'process-file)))
+ (with-output-to-string
+ (apply runner git nil standard-output nil args))))
+
+(defun gh-sanitize-content (content)
+ "Remove all non-unicode characters. This can be used to
+sanitize API calls that need to handle potentially dirty data."
+ (let (res skipped)
+ (mapc (lambda (c)
+ (if (eq 'Cn (get-char-code-property c 'general-category))
+ (setq skipped t)
+ (push c res)))
+ content)
+ (when skipped
+ (warn "Content contained non-unicode characters"))
+ (apply #'string (nreverse res))))
+
+;;; Base classes for common objects
+
+(defun gh-marshal-default-spec (slot)
+ (let ((slot-name (symbol-name slot)))
+ (list (cons 'alist
+ (intern (replace-regexp-in-string "-" "_" slot-name))))))
+
+(defmacro gh-defclass (name superclass slots &rest options-and-doc)
+ `(marshal-defclass ,name ,superclass ,slots ,@options-and-doc
+ :marshal-default-spec gh-marshal-default-spec))
+
+(gh-defclass gh-object ()
+ ())
+
+(cl-defmethod gh-object-read ((cls (subclass gh-object)) data)
+ (let ((target (make-instance cls)))
+ (when data
+ (gh-object-read-into target data))
+ target))
+
+(cl-defmethod gh-object-read ((obj gh-object) data)
+ (when data
+ (gh-object-read-into obj data)))
+
+(cl-defmethod gh-object-reader ((obj gh-object))
+ (apply-partially 'gh-object-read obj))
+
+(cl-defmethod gh-object-reader ((cls (subclass gh-object)))
+ (apply-partially 'gh-object-read cls))
+
+(cl-defmethod gh-object-list-read ((obj gh-object) data)
+ (mapcar (gh-object-reader obj) data))
+
+(cl-defmethod gh-object-list-read ((cls (subclass gh-object)) data)
+ (mapcar (gh-object-reader cls) data))
+
+(cl-defmethod gh-object-list-reader ((obj gh-object))
+ (apply-partially 'gh-object-list-read obj))
+
+(cl-defmethod gh-object-list-reader ((cls (subclass gh-object)))
+ (apply-partially 'gh-object-list-read cls))
+
+(cl-defmethod gh-object-read-into ((obj gh-object) data)
+ (unmarshal obj data 'alist))
+
+(cl-defmethod slot-unbound ((obj gh-object) cls slot-name fn)
+ (if (eq fn 'oref) nil
+ (cl-call-next-method)))
+
+(gh-defclass gh-ref-object (gh-object)
+ ((id :initarg :id)
+ (url :initarg :url)
+ (html-url :initarg :html-url)))
+
+(cl-defmethod gh-ref-object-base ((obj gh-ref-object))
+ (let ((url (oref obj :url)))
+ (concat "/"
+ (mapconcat #'identity
+ (cddr (split-string url "/" t))
+ "/"))))
+
+(cl-defmethod gh-ref-object-base (obj)
+ (if (stringp obj) obj
+ (error "illegal input for `gh-ref-object-base'")))
+
+(gh-defclass gh-user (gh-ref-object)
+ ((login :initarg :login)
+ (gravatar-url :initarg :gravatar-url))
+ "Github user object")
+
+(gh-defclass gh-comment (gh-ref-object)
+ ((body :initarg :body)
+ (user :initarg :user :initform nil :marshal-type gh-user)
+ (created-at :initarg :created_at)
+ (updated-at :initarg :updated_at))
+ "Github comment object")
+
+(cl-defmethod gh-comment-req-to-update ((req gh-comment))
+ `(("body" . ,(oref req :body))))
+
+(provide 'gh-common)
+;;; gh-common.el ends here
+
+;; Local Variables:
+;; indent-tabs-mode: nil
+;; End:
--- /dev/null
+;;; gh-gist.el --- gist module for gh.el -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2011 Yann Hodique
+
+;; Author: Yann Hodique <yann.hodiqueNOSPAMgmail.com>
+;; Keywords:
+
+;; This file 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 2, or (at your option)
+;; any later version.
+
+;; This file 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 GNU Emacs; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(require 'eieio)
+
+(require 'gh-api)
+(require 'gh-auth)
+(require 'gh-common)
+
+(defclass gh-gist-api (gh-api-v3)
+ ((gist-cls :allocation :class :initform gh-gist-gist))
+ "Gist API")
+
+(gh-defclass gh-gist-gist-stub (gh-object)
+ ((files :initarg :files :type list :initform nil :marshal-type (list gh-gist-gist-file))
+ (public :initarg :public :marshal-type bool)
+ (description :initarg :description))
+ "Class for user-created gist objects")
+
+(gh-defclass gh-gist-history-change (gh-object)
+ ((total :initarg :total)
+ (additions :initarg :additions)
+ (deletions :initarg :deletions)))
+
+(gh-defclass gh-gist-history-entry (gh-object)
+ ((user :initarg :user :initform nil :marshal-type gh-user)
+ (version :initarg :version)
+ (committed :initarg :committed :marshal ((alist . committed_at)))
+ (change :initarg :change :marshal ((alist . change_status))
+ :marshal-type gh-gist-history-change)
+ (url :initarg :url)))
+
+(gh-defclass gh-gist-fork-entry (gh-ref-object)
+ ((user :initarg :user :initform nil :marshal-type gh-user)
+ (created :initarg :created :marshal ((alist . created_at)))
+ (updated :initarg :updated :marshal ((alist . updated_at)))))
+
+(gh-defclass gh-gist-gist (gh-ref-object gh-gist-gist-stub)
+ ((date :initarg :date :marshal ((alist . created_at)))
+ (update :initarg :update :marshal ((alist . updated_at)))
+ (push-url :initarg :push-url :marshal ((alist . git_push_url)))
+ (pull-url :initarg :pull-url :marshal ((alist . git_pull_url)))
+ (comments :initarg :comments)
+ (user :initarg :user :initform nil :marshal-type gh-user :marshal ((alist . owner)))
+ (history :initarg :history :initform nil :type list :marshal-type (list gh-gist-history-entry))
+ (forks :initarg :forks :initform nil :type list :marshal-type (list gh-gist-fork-entry)))
+ "Gist object")
+
+(gh-defclass gh-gist-gist-file (gh-object)
+ ((filename :initarg :filename)
+ (size :initarg :size)
+ (url :initarg :url :marshal ((alist . raw_url)))
+ (content :initarg :content)))
+
+(cl-defmethod make-instance ((cls (subclass gh-gist-gist-file)) &rest args)
+ (let ((obj (cl-call-next-method)))
+ (when (oref obj :content)
+ (oset obj :content (gh-sanitize-content (oref obj :content))))
+ obj))
+
+(cl-defmethod gh-gist-gist-to-obj ((gist gh-gist-gist-stub))
+ (let ((files (mapcar #'gh-gist-gist-file-to-obj (oref gist :files))))
+ `(("description" . ,(oref gist :description))
+ ("public" . ,(oref gist :public))
+ ,@(and files (list (cons "files" files))))))
+
+(cl-defmethod gh-gist-gist-has-files ((gist gh-gist-gist-stub))
+ (not (memq nil (mapcar (lambda (f)
+ (oref f :content)) (oref gist :files)))))
+
+(cl-defmethod gh-gist-gist-file-to-obj ((file gh-gist-gist-file))
+ (let* ((filename (oref file :filename))
+ (content (oref file :content))
+ (file (if content
+ `(("filename" . ,filename)
+ ("content" . ,content))
+ nil)))
+ (cons filename file)))
+
+(cl-defmethod gh-gist-list ((api gh-gist-api) &optional username)
+ (gh-api-authenticated-request
+ api (gh-object-list-reader (oref api gist-cls)) "GET"
+ (format "/users/%s/gists" (or username (gh-api-get-username api)))))
+
+(cl-defmethod gh-gist-list-public ((api gh-gist-api))
+ (gh-api-authenticated-request
+ api (gh-object-list-reader (oref api gist-cls)) "GET" "/gists/public"))
+
+(cl-defmethod gh-gist-list-starred ((api gh-gist-api))
+ (gh-api-authenticated-request
+ api (gh-object-list-reader (oref api gist-cls)) "GET" "/gists/starred"))
+
+(cl-defmethod gh-gist-get ((api gh-gist-api) gist-or-id)
+ (let (id transformer)
+ (if (stringp gist-or-id)
+ (setq id gist-or-id
+ transformer (gh-object-reader (oref api gist-cls)))
+ (setq id (oref gist-or-id :id)
+ transformer (gh-object-reader gist-or-id)))
+ (gh-api-authenticated-request
+ api transformer "GET" (format "/gists/%s" id))))
+
+(cl-defmethod gh-gist-new ((api gh-gist-api) gist-stub)
+ (gh-api-authenticated-request
+ api (gh-object-reader (oref api gist-cls)) "POST" "/gists"
+ (gh-gist-gist-to-obj gist-stub)))
+
+(cl-defmethod gh-gist-edit ((api gh-gist-api) gist)
+ (gh-api-authenticated-request
+ api (gh-object-reader (oref api gist-cls)) "PATCH"
+ (format "/gists/%s"
+ (oref gist :id))
+ (gh-gist-gist-to-obj gist)))
+
+(cl-defmethod gh-gist-set-star ((api gh-gist-api) gist-or-id star)
+ (let ((id (if (stringp gist-or-id) gist-or-id
+ (oref gist-or-id :id))))
+ (gh-api-authenticated-request
+ api 'ignore (if star "PUT" "DELETE")
+ (format "/gists/%s/star" id))))
+
+(cl-defmethod gh-gist-get-star ((api gh-gist-api) gist-or-id)
+ (let ((id (if (stringp gist-or-id) gist-or-id
+ (oref gist-or-id :id))))
+ (gh-api-authenticated-request
+ api 'ignore "GET" (format "/gists/%s/star" id))))
+
+(cl-defmethod gh-gist-fork ((api gh-gist-api) gist-or-id)
+ (let ((id (if (stringp gist-or-id) gist-or-id
+ (oref gist-or-id :id))))
+ (gh-api-authenticated-request
+ api (gh-object-reader (oref api gist-cls)) "POST"
+ (format "/gists/%s/forks" id))))
+
+(cl-defmethod gh-gist-delete ((api gh-gist-api) gist-or-id)
+ (let ((id (if (stringp gist-or-id) gist-or-id
+ (oref gist-or-id :id))))
+ (gh-api-authenticated-request
+ api 'ignore "DELETE" (format "/gists/%s" id))))
+
+(provide 'gh-gist)
+;;; gh-gist.el ends here
+
+;; Local Variables:
+;; indent-tabs-mode: nil
+;; End:
--- /dev/null
+;;; gh-issue-comments.el --- issue comments api for github -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2014 Travis Thieman
+
+;; Author: Travis Thieman <travis.thiemanNOSPAMgmail.com>
+;; Keywords:
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; TODOS:
+;; * Support listing all comments in a repository
+
+;; Basic usage:
+
+;; (setf api (gh-issue-comments-api "api" :sync nil :cache nil :num-retries 1))
+;; (setf comments (gh-issue-comments-list api "user" "repo" "issue id"))
+;; (setq my-comment (make-instance 'gh-issue-comments-comment :body "This is great!"))
+;; (gh-issue-comments-new api "user" "repo" "issue id" my-comment)
+
+;;; Code:
+
+(require 'eieio)
+
+(require 'gh-api)
+(require 'gh-auth)
+(require 'gh-common)
+
+(require 'gh-issues)
+
+(let ((ver "1.0.0"))
+ (define-obsolete-function-alias
+ 'gh-issue-comments-api 'gh-issues-api ver)
+ (define-obsolete-function-alias
+ 'gh-issue-comments-comment 'gh-issues-comment ver)
+
+ (define-obsolete-function-alias
+ 'gh-issue-comments-req-to-update 'gh-comment-req-to-update ver)
+
+ (define-obsolete-function-alias
+ 'gh-issue-comments-list 'gh-issues-comments-list ver)
+ (define-obsolete-function-alias
+ 'gh-issue-comments-get 'gh-issues-comments-get ver)
+ (define-obsolete-function-alias
+ 'gh-issue-comments-update 'gh-issues-comments-update ver)
+ (define-obsolete-function-alias
+ 'gh-issue-comments-new 'gh-issues-comments-new ver)
+ (define-obsolete-function-alias
+ 'gh-issue-comments-delete 'gh-issues-comments-delete ver))
+
+(provide 'gh-issue-comments)
+;;; gh-issue-comments.el ends here
+
+;; Local Variables:
+;; indent-tabs-mode: nil
+;; End:
--- /dev/null
+;;; gh-issues.el --- issues api for github -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2014-2015 Yann Hodique
+;; Copyright (C) 2014 Travis Thieman
+;; Copyright (C) 2012 Raimon Grau
+
+;; Author: Raimon Grau <raimonsterNOSPAMgmail.com>
+;; Keywords:
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Basic usage:
+
+;; (setf api (gh-issues-api "api" :sync nil :cache nil :num-retries 1))
+;; (setf issues (gh-issues-issue-list api "user" "repo"))
+;; (last (oref issues data)) ; get one issue
+;; (setq mi (make-instance 'gh-issues-issue :body "issue body" :title "issue title"))
+;; (gh-issues-issue-new api "user" "repo" mi)
+;; (setf comments (gh-issues-comments-list api "user" "repo" "issue id"))
+;; (setq my-comment (make-instance 'gh-issues-comment :body "This is great!"))
+;; (gh-issues-comments-new api "user" "repo" "issue id" my-comment)
+
+;;; Code:
+
+(require 'eieio)
+
+(require 'gh-api)
+(require 'gh-auth)
+(require 'gh-comments)
+(require 'gh-common)
+
+(require 'gh-repos)
+
+(defclass gh-issues-api (gh-api-v3 gh-comments-api-mixin)
+ ((issue-cls :allocation :class :initform gh-issues-issue)
+ (milestone-cls :allocation :class :initform gh-issues-milestone)
+ (label-cls :allocation :class :initform gh-issues-label)
+ (comment-cls :allocation :class :initform gh-issues-comment))
+ "Github Issues api")
+
+(gh-defclass gh-issues-issue (gh-ref-object)
+ ((number :initarg :number)
+ (state :initarg :state)
+ (title :initarg :title)
+ (body :initarg :body)
+ (user :initarg :user :initform nil :marshal-type gh-user)
+ (labels :initarg :labels :initform nil :marshal-type (list gh-issues-label))
+ (assignees :initarg :assignees :initform nil :marshal-type (list gh-user))
+ (assignee :initarg :assignee :initform nil :marshal-type gh-user)
+ (milestone :initarg :milestone :initform nil :marshal-type gh-issues-milestone)
+ (comments :initarg :comments :initform 0)
+ (pull-request :initarg :pull-request :marshal-type gh-issues-pull-request)
+ (closed-at :initarg :closed-at)
+ (created-at :initarg :created-at)
+ (updated-at :initarg :updated-at))
+ "issues request")
+
+(gh-defclass gh-issues-pull-request (gh-object)
+ ((html-url :initarg :html-url)
+ (diff-url :initarg :diff-url)
+ (patch-url :initarg :patch-url)))
+
+(gh-defclass gh-issues-label (gh-ref-object)
+ ((name :initarg :name)
+ (color :initarg :color)))
+
+(cl-defmethod gh-issues-label-req-to-update ((label gh-issues-label))
+ `(("name" . ,(oref label :name))
+ ("color" . ,(oref label :color))))
+
+(gh-defclass gh-issues-milestone (gh-ref-object)
+ ((number :initarg :number)
+ (state :initarg :state)
+ (title :initarg :title)
+ (description :initarg :description)
+ (creator :initarg :creator :initform nil :marshal-type gh-user)
+ (open-issues :initarg :open-issues )
+ (closed-issues :initarg :closed-issues)
+ (created-at :initarg :created-at)
+ (due-on :initarg :due-on))
+ "github milestone")
+
+(gh-defclass gh-issues-comment (gh-comment)
+ ())
+
+(cl-defmethod gh-issues-issue-list ((api gh-issues-api) user repo)
+ (gh-api-authenticated-request
+ api (gh-object-list-reader (oref api issue-cls)) "GET"
+ (format "/repos/%s/%s/issues" user repo)))
+
+(cl-defmethod gh-issues-milestone-list ((api gh-issues-api) user repo)
+ (gh-api-authenticated-request
+ api (gh-object-list-reader (oref api milestone-cls)) "GET"
+ (format "/repos/%s/%s/milestones" user repo)))
+
+(cl-defmethod gh-issues-milestone-get ((api gh-issues-api) user repo id)
+ (gh-api-authenticated-request
+ api (gh-object-reader (oref api milestone-cls)) "GET"
+ (format "/repos/%s/%s/milestones/%s" user repo id)))
+
+(cl-defmethod gh-issues-milestone-new ((api gh-issues-api) user repo milestone)
+ (gh-api-authenticated-request
+ api (gh-object-reader (oref api milestone-cls)) "POST"
+ (format "/repos/%s/%s/milestones" user repo)
+ (gh-issues-milestone-req-to-update milestone)))
+
+(cl-defmethod gh-issues-milestone-update ((api gh-issues-api) user repo
+ id milestone)
+ (gh-api-authenticated-request
+ api (gh-object-reader (oref api milestone-cls)) "PATCH"
+ (format "/repos/%s/%s/milestones/%s" user repo id)
+ (gh-issues-milestone-req-to-update milestone)))
+
+(cl-defmethod gh-issues-milestone-req-to-update ((milestone gh-issues-milestone))
+ (let ((state (oref milestone :state))
+ (description (oref milestone :description))
+ (due-on (oref milestone :due-on))
+ (to-update `(("title" . ,(oref milestone :title)))))
+ (when state (nconc to-update `(("state" . ,state))))
+ (when description (nconc to-update `(("description" . ,description))))
+ (when due-on (nconc to-update `(("due_on" . ,due-on))))
+ to-update))
+
+(cl-defmethod gh-issues-issue-get ((api gh-issues-api) user repo id)
+ (gh-api-authenticated-request
+ api (gh-object-reader (oref api issue-cls)) "GET"
+ (format "/repos/%s/%s/issues/%s" user repo id)))
+
+(cl-defmethod gh-issues-issue-req-to-update ((req gh-issues-issue))
+ (let ((assignee (oref req :assignee))
+ ;; (labels (oref req labels))
+ (milestone (oref req :milestone))
+ (to-update `(("title" . ,(oref req :title))
+ ("state" . ,(oref req :state))
+ ("body" . ,(oref req :body)))))
+
+ ;; (when labels (nconc to-update `(("labels" . ,(oref req labels) ))))
+ (when milestone
+ (nconc to-update `(("milestone" . ,(oref milestone :number)))))
+ (when assignee
+ (nconc to-update `(("assignee" . ,(oref assignee :login)))))
+ to-update))
+
+(cl-defmethod gh-issues-issue-update ((api gh-issues-api) user repo id req)
+ (gh-api-authenticated-request
+ api (gh-object-reader (oref api issue-cls)) "PATCH"
+ (format "/repos/%s/%s/issues/%s" user repo id)
+ (gh-issues-issue-req-to-update req)))
+
+(cl-defmethod gh-issues-issue-new ((api gh-issues-api) user repo issue)
+ (gh-api-authenticated-request
+ api (gh-object-reader (oref api issue-cls)) "POST"
+ (format "/repos/%s/%s/issues" user repo)
+ (gh-issues-issue-req-to-update issue)))
+
+;;; Labels
+
+(cl-defmethod gh-issues-label-get ((api gh-issues-api) user repo name)
+ (gh-api-authenticated-request
+ api (gh-object-reader (oref api label-cls)) "GET"
+ (format "/repos/%s/%s/labels/%s" user repo name)))
+
+(cl-defmethod gh-issues-label-list ((api gh-issues-api) user repo)
+ (gh-api-authenticated-request
+ api (gh-object-list-reader (oref api label-cls)) "GET"
+ (format "/repos/%s/%s/labels" user repo )))
+
+(cl-defmethod gh-issues-label-new ((api gh-issues-api) user repo req)
+ (gh-api-authenticated-request
+ api (gh-object-reader (oref api label-cls)) "POST"
+ (format "/repos/%s/%s/labels" user repo)
+ (gh-issues-label-req-to-update req)))
+
+(cl-defmethod gh-issues-label-update ((api gh-issues-api) user repo req)
+ (gh-api-authenticated-request
+ api (gh-object-reader (oref api label-cls)) "POST"
+ (format "/repos/%s/%s/labels/%s" user repo (oref req :name))
+ (gh-issues-label-req-to-update req)))
+
+(cl-defmethod gh-issues-label-delete ((api gh-issues-api) user repo name)
+ (gh-api-authenticated-request
+ api (gh-object-reader (oref api label-cls)) "DELETE"
+ (format "/repos/%s/%s/labels/%s" user repo name)))
+
+
+(cl-defmethod gh-issues-labels-in-issue ((api gh-issues-api) user repo
+ issue-or-issue-id)
+ (let ((issue-id (gh-issues--issue-id issue-or-issue-id)))
+ (gh-api-authenticated-request
+ api (gh-object-list-reader (oref api label-cls)) "GET"
+ (format "/repos/%s/%s/issues/%s/labels" user repo issue-id))))
+
+(cl-defmethod gh-issues-labels-add-to-issue ((api gh-issues-api) user repo
+ issue-or-issue-id labels)
+ (let ((issue-id (gh-issues--issue-id issue-or-issue-id)))
+ (gh-api-authenticated-request
+ api (gh-object-list-reader (oref api label-cls)) "PUT"
+ (format "/repos/%s/%s/issues/%s/labels" user repo issue-id)
+ (mapcar #'gh-issues--label-name labels))))
+
+(cl-defmethod gh-issues-labels-remove-all-from-issue ((api gh-issues-api) user repo
+ issue-or-issue-id )
+ (let ((issue-id (gh-issues--issue-id issue-or-issue-id)))
+ (gh-api-authenticated-request
+ api (lambda (x) x) "DELETE"
+ (format "/repos/%s/%s/issues/%s/labels" user repo issue-id))))
+
+(cl-defmethod gh-issues-labels-in-milestone ((api gh-issues-api) user repo
+ milestone-or-milestone-id)
+ (let ((milestone-id (gh-issues--milestone-id milestone-or-milestone-id)))
+ (gh-api-authenticated-request
+ api (gh-object-list-reader (oref api label-cls)) "GET"
+ (format "/repos/%s/%s/milestones/%s/labels" user repo milestone-id))))
+
+;;; Comments
+
+(cl-defmethod gh-issues-comments-list ((api gh-issues-api) user repo issue-id)
+ (gh-comments-list api (format "/repos/%s/%s/issues/%s" user repo issue-id)))
+
+(cl-defmethod gh-issues-comments-get ((api gh-issues-api) user repo comment-id)
+ (gh-comments-get api (format "/repos/%s/%s/issues" user repo) comment-id))
+
+(cl-defmethod gh-issues-comments-update ((api gh-issues-api)
+ user repo comment-id comment)
+ (gh-comments-update api (format "/repos/%s/%s/issues" user repo)
+ comment-id comment))
+
+(cl-defmethod gh-issues-comments-new ((api gh-issues-api)
+ user repo issue-id comment)
+ (gh-comments-new api (format "/repos/%s/%s/issues/%s" user repo issue-id)
+ comment))
+
+(cl-defmethod gh-issues-comments-delete ((api gh-issues-api) user repo comment-id)
+ (gh-comments-delete api (format "/repos/%s/%s/issues" user repo) comment-id))
+
+;;; helpers
+
+(defun gh-issues--issue-id (issue-or-issue-id)
+ (if (eieio-object-p issue-or-issue-id)
+ (oref issue-or-issue-id :id)
+ issue-or-issue-id))
+
+(defun gh-issues--milestone-id (milestone-or-milestone-id)
+ (if (eieio-object-p milestone-or-milestone-id)
+ (oref milestone-or-milestone-id :id)
+ milestone-or-milestone-id))
+
+(defun gh-issues--label-name (label-or-label-name)
+ (if (eieio-object-p label-or-label-name)
+ (oref label-or-label-name :name)
+ label-or-label-name))
+
+
+(provide 'gh-issues)
+;;; gh-issues.el ends here
+
+;; Local Variables:
+;; indent-tabs-mode: nil
+;; End:
--- /dev/null
+;;; gh-oauth.el --- oauth module for gh.el -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2012 Yann Hodique
+
+;; Author: Yann Hodique <yann.hodiqueNOSPAMgmail.com>
+;; Keywords:
+
+;; This file 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 2, or (at your option)
+;; any later version.
+
+;; This file 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 GNU Emacs; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(require 'eieio)
+
+(require 'gh-api)
+(require 'gh-auth)
+(require 'gh-common)
+
+(defclass gh-oauth-api (gh-api-v3)
+ ((auth-cls :allocation :class :initform gh-oauth-authorization))
+ "OAuth API")
+
+(defclass gh-oauth-password-authenticator (gh-password-authenticator)
+ ((remember :allocation :class :initform nil)))
+
+(cl-defmethod initialize-instance ((api gh-oauth-api) &rest args)
+ ;; force password authentication for this API
+ (let ((gh-api-v3-authenticator 'gh-oauth-password-authenticator))
+ (cl-call-next-method)))
+
+(gh-defclass gh-oauth-authorization (gh-ref-object)
+ ((scopes :initarg :scopes)
+ (token :initarg :token)
+ (app :initarg :app :initform nil :marshal-type gh-oauth-app)
+ (updated-at :initarg :updated-at)
+ (created-at :initarg :created-at)))
+
+(gh-defclass gh-oauth-app (gh-object)
+ ((url :initarg :url)
+ (name :initarg :name)))
+
+(cl-defmethod gh-oauth-auth-list ((api gh-oauth-api))
+ (gh-api-authenticated-request
+ api (gh-object-list-reader (oref api auth-cls)) "GET"
+ (format "/authorizations")))
+
+(cl-defmethod gh-oauth-auth-get ((api gh-oauth-api) id)
+ (gh-api-authenticated-request
+ api (gh-object-reader (oref api auth-cls)) "GET"
+ (format "/authorizations/%s" id)))
+
+(cl-defmethod gh-oauth-auth-new ((api gh-oauth-api) &optional scopes)
+ (gh-api-authenticated-request
+ api (gh-object-reader (oref api auth-cls)) "POST"
+ (format "/authorizations") (list (cons 'scopes scopes)
+ (cons 'note (format "gh.el - %s"
+ (system-name))))))
+
+(cl-defmethod gh-oauth-auth-update ((api gh-oauth-api) id &optional scopes)
+ (gh-api-authenticated-request
+ api (gh-object-reader (oref api auth-cls)) "PATCH"
+ (format "/authorizations/%s" id) (list (cons 'scopes scopes))))
+
+(cl-defmethod gh-oauth-auth-delete ((api gh-oauth-api) id)
+ (gh-api-authenticated-request
+ api nil "DELETE" (format "/authorizations/%s" id)))
+
+(provide 'gh-oauth)
+;;; gh-oauth.el ends here
+
+;; Local Variables:
+;; indent-tabs-mode: nil
+;; End:
--- /dev/null
+;;; gh-org.el --- orgs module for gh.el -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2012 Yann Hodique
+
+;; Author: Yann Hodique <yann.hodiqueNOSPAMgmail.com>
+;; Keywords:
+
+;; This file 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 2, or (at your option)
+;; any later version.
+
+;; This file 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 GNU Emacs; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(require 'eieio)
+
+(require 'gh-api)
+(require 'gh-auth)
+(require 'gh-common)
+
+(defclass gh-orgs-api (gh-api-v3)
+ ((org-cls :allocation :class :initform gh-orgs-org))
+ "Orgs API")
+
+(gh-defclass gh-orgs-org-stub (gh-ref-object)
+ ((login :initarg :login)
+ (avatar-url :initarg :avatar-url)
+ (description :initarg :description)))
+
+(gh-defclass gh-orgs-plan (gh-object)
+ ((name :initarg :name)
+ (space :initarg :space)
+ (private-repos :initarg :private-repos)))
+
+(gh-defclass gh-orgs-org (gh-orgs-org-stub)
+ ((name :initarg :name)
+ (company :initarg :company)
+ (blog :initarg :blog)
+ (location :initarg :location)
+ (email :initarg :email)
+ (public-repos :initarg :public-repos)
+ (public-gists :initarg :public-gists)
+ (followers :initarg :followers)
+ (following :initarg :following)
+ (created-at :initarg :created-at)
+ (type :initarg :type)
+ (total-private-repos :initarg :total-private-repos)
+ (owned-private-repos :initarg :owned-private-repos)
+ (private-gists :initarg :private-gists)
+ (disk-usage :initarg :disk-usage)
+ (collaborators :initarg :collaborators)
+ (billing-email :initarg :billing-email)
+ (plan :initarg :plan :initform nil :marshal-type gh-orgs-plan))
+ "Class for GitHub organizations")
+
+(cl-defmethod gh-orgs-org-to-obj ((org gh-orgs-org))
+ `(,@(when (slot-boundp org :billing-email)
+ (list (cons "billing_email" (oref org :billing-email))))
+ ,@(when (slot-boundp org :blog)
+ (list (cons "blog" (oref org :blog))))
+ ,@(when (slot-boundp org :company)
+ (list (cons "company" (oref org :company))))
+ ,@(when (slot-boundp org :email)
+ (list (cons "email" (oref org :email))))
+ ,@(when (slot-boundp org :location)
+ (list (cons "location" (oref org :location))))
+ ,@(when (slot-boundp org :name)
+ (list (cons "name" (oref org :name))))))
+
+(cl-defmethod gh-orgs-list ((api gh-orgs-api) &optional username)
+ (gh-api-authenticated-request
+ api (gh-object-list-reader (oref api org-cls)) "GET"
+ (format "/users/%s/orgs" (or username (gh-api-get-username api)))))
+
+(cl-defmethod gh-orgs-get ((api gh-orgs-api) org)
+ (gh-api-authenticated-request
+ api (gh-object-reader (oref api org-cls)) "GET"
+ (format "/orgs/%s" org)))
+
+(cl-defmethod gh-orgs-update ((api gh-orgs-api) org-obj)
+ (gh-api-authenticated-request
+ api (gh-object-reader (oref api org-cls)) "PATCH"
+ (format "/orgs/%s" (oref org-obj :login))
+ (apply 'gh-orgs-org-to-obj org-obj nil)))
+
+(provide 'gh-orgs)
+;;; gh-org.el ends here
+
+;; Local Variables:
+;; indent-tabs-mode: nil
+;; End:
--- /dev/null
+(define-package "gh" "20221204.1817" "A GitHub library for Emacs"
+ '((emacs "25.1")
+ (pcache "0.4.2")
+ (logito "0.1")
+ (marshal "0.9.0")
+ (cl-lib "0.3"))
+ :commit "e1423a54fc97924e75d1fde27911c3c678a7d6c3" :authors
+ '(("Yann Hodique" . "yhodiqueNOSPAMgmail.com"))
+ :maintainer
+ '("Yann Hodique" . "yhodiqueNOSPAMgmail.com")
+ :url "https://github.com/sigma/gh.el")
+;; Local Variables:
+;; no-byte-compile: t
+;; End:
--- /dev/null
+;;; gh-profile.el --- profile support for gh.el -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2013 Yann Hodique
+
+;; Author: Yann Hodique <yann.hodiqueNOSPAMgmail.com>
+;; Keywords:
+
+;; This file 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 2, or (at your option)
+;; any later version.
+
+;; This file 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 GNU Emacs; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(require 'rx)
+(require 'url-parse)
+
+(defgroup gh-profile nil
+ "Github profile."
+ :group 'gh)
+
+(defun gh-profile-remote-regexp (domain)
+ (eval
+ `(rx bol (or ,(concat "git@" domain ":")
+ (and (or "git" "ssh" "http" "https") "://"
+ (* nonl) (? "@") ,domain "/"))
+ (and (group (* nonl)) "/" (group (* nonl))) (? ".git"))))
+
+(defcustom gh-profile-alist `(("github"
+ :url "https://api.github.com"
+ :remote-regexp
+ ,(gh-profile-remote-regexp "github.com")))
+ "List of profiles for Github access. List every Github
+Enterprise server and/or Github accounts you have access
+to here."
+ :type '(alist :key-type string
+ :value-type (plist :key-type (choice (const :url)
+ (const :username)
+ (const :password)
+ (const :token)
+ (const :remote-regexp))
+ :value-type string))
+ :group 'gh-profile)
+
+(defun gh-profile-get-remote-regexp (profile)
+ (let* ((profile-plist (cdr (assoc profile gh-profile-alist)))
+ (regexp (plist-get profile-plist :remote-regexp)))
+ (if regexp
+ regexp
+ ;; try to guess remote format (just use the hostname)
+ (let* ((url (url-generic-parse-url (plist-get profile-plist :url)))
+ (host (url-host url)))
+ (gh-profile-remote-regexp host)))))
+
+(defcustom gh-profile-default-profile "github"
+ "Default profile. This needs to be a key present in
+ `gh-profile-alist'"
+ :type 'string
+ :group 'gh-profile)
+
+(defun gh-profile-default-profile ()
+ gh-profile-default-profile)
+
+(defvar gh-profile-current-profile nil)
+(make-variable-buffer-local 'gh-profile-current-profile)
+
+(defun gh-profile-current-profile ()
+ (or gh-profile-current-profile
+ (gh-profile-default-profile)))
+
+(defun gh-profile-url ()
+ (plist-get (cdr (assoc (gh-profile-current-profile)
+ gh-profile-alist)) :url))
+
+(defun gh-profile-completing-read ()
+ (let ((profiles (mapcar #'car gh-profile-alist)))
+ (if (> (length profiles) 1)
+ (completing-read "Github profile: " profiles nil t nil nil (first profiles))
+ (car profiles))))
+
+(defun gh-profile-get-remote-profile (remote-url)
+ (cl-loop for (id . props) in gh-profile-alist
+ if (string-match (gh-profile-get-remote-regexp id)
+ remote-url)
+ return id))
+
+(provide 'gh-profile)
+;;; gh-profile.el ends here
--- /dev/null
+;;; gh-pull-comments.el --- pull request comments api for github -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2014 Toni Reina
+
+;; Author: Toni Reina <areina0NOSPAMgmail.com>
+;; Keywords:
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; TODOS:
+;; * Support listing all comments in a repository
+
+;; Basic usage:
+
+;; (setf api (gh-pull-comments-api "api" :sync nil :cache nil :num-retries 1))
+;; (setf comments (gh-pull-comments-list api "user" "repo" "pull request id"))
+;; (setq my-comment (make-instance 'gh-pull-comments-comment
+;; :body "This is great!"
+;; :path "README.md"
+;; :position 2
+;; :commit-id "commit sha"))
+;; (gh-pull-comments-new api "user" "repo" "pull request id" my-comment)
+
+;;; Code:
+
+(require 'eieio)
+
+(require 'gh-api)
+(require 'gh-auth)
+(require 'gh-common)
+
+(require 'gh-pulls)
+
+(let ((ver "1.0.0"))
+ (define-obsolete-function-alias
+ 'gh-pull-comments-api 'gh-pulls-api ver)
+ (define-obsolete-function-alias
+ 'gh-pull-comments-comment 'gh-pulls-comment ver)
+
+ (define-obsolete-function-alias
+ 'gh-pull-comments-req-to-update 'gh-comment-req-to-update ver)
+ (define-obsolete-function-alias
+ 'gh-pull-comments-req-to-create 'gh-pulls-comment-req-to-create ver)
+
+ (define-obsolete-function-alias
+ 'gh-pull-comments-list 'gh-pulls-comments-list ver)
+ (define-obsolete-function-alias
+ 'gh-pull-comments-get 'gh-pulls-comments-get ver)
+ (define-obsolete-function-alias
+ 'gh-pull-comments-update 'gh-pulls-comments-update ver)
+ (define-obsolete-function-alias
+ 'gh-pull-comments-new 'gh-pulls-comments-new ver)
+ (define-obsolete-function-alias
+ 'gh-pull-comments-delete 'gh-pulls-comments-delete ver))
+
+(provide 'gh-pull-comments)
+;;; gh-pull-comments.el ends here
+
+;; Local Variables:
+;; indent-tabs-mode: nil
+;; End:
--- /dev/null
+;;; gh-pulls.el --- pull requests module for gh.el -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2011 Yann Hodique
+
+;; Author: Yann Hodique <yann.hodiqueNOSPAMgmail.com>
+;; Keywords:
+
+;; This file 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 2, or (at your option)
+;; any later version.
+
+;; This file 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 GNU Emacs; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(require 'eieio)
+
+(require 'gh-api)
+(require 'gh-auth)
+(require 'gh-comments)
+(require 'gh-common)
+
+(require 'gh-repos)
+
+(defclass gh-pulls-cache (gh-cache)
+ ((invalidation-chain :allocation :class
+ :initform '(("^/repos/.*/.*/pulls$" . "\0")
+ ("^/repos/.*/.*/pulls/.*$" . "\0")))))
+
+(defclass gh-pulls-api (gh-api-v3 gh-comments-api-mixin)
+ ((cache-cls :allocation :class :initform gh-pulls-cache)
+
+ (req-cls :allocation :class :initform gh-pulls-request)
+ (comment-cls :allocation :class :initform gh-pulls-comment))
+ "Git pull requests API")
+
+(gh-defclass gh-pulls-comment (gh-comment)
+ ((path :initarg :path)
+ (diff-hunk :initarg :diff-hunk)
+ (position :initarg :position)
+ (original-position :initarg :original-position)
+ (commit-id :initarg :commit-id)
+ (original-commit-id :initarg :original-commit-id)
+ (in-reply-to :initarg :in-reply-to :initform nil)))
+
+(cl-defmethod gh-pulls-comment-req-to-create ((req gh-pulls-comment))
+ (let ((in-reply-to (oref req in-reply-to))
+ (to-update `(("body" . ,(oref req body)))))
+ (if in-reply-to
+ (nconc to-update `(("in_reply_to" . ,in-reply-to)))
+ (nconc to-update `(("commit_id" . ,(oref req commit-id))
+ ("path" . ,(oref req path))
+ ("position" . ,(oref req position)))))
+ to-update))
+
+(gh-defclass gh-pulls-request-stub (gh-ref-object)
+ ((diff-url :initarg :diff-url)
+ (patch-url :initarg :patch-url)
+ (issue-url :initarg :issue-url)
+ (number :initarg :number)
+ (state :initarg :state)
+ (title :initarg :title)
+ (body :initarg :body)
+ (created-at :initarg :created-at)
+ (updated-at :initarg :updated-at)
+ (closed-at :initarg :closed-at)
+ (merged-at :initarg :merged-at)
+ (head :initarg :head :initform nil :marshal-type gh-repos-ref)
+ (base :initarg :base :initform nil :marshal-type gh-repos-ref)))
+
+(gh-defclass gh-pulls-request (gh-pulls-request-stub)
+ ((merged :initarg :merged)
+ (mergeable :initarg :mergeable)
+ (merged-by :initarg :merged-by)
+ (comments :initarg :comments)
+ (user :initarg :user :initform nil :marshal-type gh-user)
+ (commits :initarg :commits)
+ (additions :initarg :additions)
+ (deletions :initarg :deletions)
+ (changed-files :initarg :changed-files))
+ "Git pull requests API")
+
+(cl-defmethod gh-pulls-req-to-new ((req gh-pulls-request))
+ (let ((head (oref req :head))
+ (base (oref req :base)))
+ `(("title" . ,(oref req :title))
+ ("body" . ,(oref req :body))
+ ("head" . ,(or (oref head :ref) (oref head :sha)))
+ ("base" . ,(or (oref base :ref) (oref base :sha))))))
+
+(cl-defmethod gh-pulls-req-to-update ((req gh-pulls-request-stub))
+ `(("title" . ,(oref req :title))
+ ("body" . ,(oref req :body))
+ ("state" . ,(oref req :state))))
+
+(cl-defmethod gh-pulls-list ((api gh-pulls-api) user repo)
+ (gh-api-authenticated-request
+ api (gh-object-list-reader (oref api req-cls)) "GET"
+ (format "/repos/%s/%s/pulls" user repo)))
+
+(cl-defmethod gh-pulls-get ((api gh-pulls-api) user repo id)
+ (gh-api-authenticated-request
+ api (gh-object-reader (oref api req-cls)) "GET"
+ (format "/repos/%s/%s/pulls/%s" user repo id)))
+
+(cl-defmethod gh-pulls-new ((api gh-pulls-api) user repo req)
+ (gh-api-authenticated-request
+ api (gh-object-reader (oref api req-cls)) "POST"
+ (format "/repos/%s/%s/pulls" user repo)
+ (gh-pulls-req-to-new req)))
+
+(cl-defmethod gh-pulls-update ((api gh-pulls-api) user repo id req)
+ (gh-api-authenticated-request
+ api (gh-object-reader (oref api req-cls)) "PATCH"
+ (format "/repos/%s/%s/pulls/%s" user repo id)
+ (gh-pulls-req-to-update req)))
+
+;;; Comments
+
+(cl-defmethod gh-pulls-comments-list ((api gh-pulls-api) user repo pull-id)
+ (gh-comments-list api (format "/repos/%s/%s/pulls/%s" user repo pull-id)))
+
+(cl-defmethod gh-pulls-comments-get ((api gh-pulls-api) user repo comment-id)
+ (gh-comments-get api (format "/repos/%s/%s/pulls" user repo) comment-id))
+
+(cl-defmethod gh-pulls-comments-update ((api gh-pulls-api)
+ user repo comment-id comment)
+ (gh-comments-update api (format "/repos/%s/%s/pulls" user repo)
+ comment-id (gh-comment-req-to-update comment)))
+
+(cl-defmethod gh-pulls-comments-new ((api gh-pulls-api)
+ user repo pull-id comment)
+ (gh-comments-new api (format "/repos/%s/%s/pulls/%s" user repo pull-id)
+ (gh-pulls-comment-req-to-create comment)))
+
+(cl-defmethod gh-pulls-comments-delete ((api gh-pulls-api) user repo comment-id)
+ (gh-comments-delete api (format "/repos/%s/%s/pulls" user repo) comment-id))
+
+(provide 'gh-pulls)
+;;; gh-pulls.el ends here
+
+;; Local Variables:
+;; indent-tabs-mode: nil
+;; End:
--- /dev/null
+;;; gh-repos.el --- repos module for gh.el -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2011 Yann Hodique
+
+;; Author: Yann Hodique <yann.hodiqueNOSPAMgmail.com>
+;; Keywords:
+
+;; This file 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 2, or (at your option)
+;; any later version.
+
+;; This file 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 GNU Emacs; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(require 'eieio)
+
+(require 'gh-api)
+(require 'gh-auth)
+(require 'gh-common)
+
+(defclass gh-repos-api (gh-api-v3)
+ ((repo-cls :allocation :class :initform gh-repos-repo)
+ (user-cls :allocation :class :initform gh-user))
+ "Repos API")
+
+(gh-defclass gh-repos-repo-stub (gh-object)
+ ((name :initarg :name)
+ (description :initarg :description)
+ (homepage :initarg :homepage)
+ (private :initarg :private))
+ "Class for user-created repository objects")
+
+(gh-defclass gh-repos-repo (gh-ref-object gh-repos-repo-stub)
+ ((clone-url :initarg :clone-url)
+ (git-url :initarg :git-url)
+ (ssh-url :initarg :ssh-url)
+ (svn-url :initarg :svn-url)
+ (mirror-url :initarg :mirror-url)
+ (owner :initarg :owner :initform nil :marshal-type gh-user)
+ (full-name :initarg :full-name)
+ (language :initarg :language)
+ (fork :initarg :fork)
+ (forks :initarg :forks)
+ (forks-count :initarg :forks-count)
+ (watchers :initarg :watchers)
+ (watchers-count :initarg :watchers-count)
+ (stargazers-count :initarg :stargazers-count)
+ (size :initarg :size)
+ (master-branch :initarg :master-branch)
+ (open-issues :initarg :open-issues)
+ (pushed-at :initarg :pushed-at)
+ (created-at :initarg :created-at)
+ (updated-at :initarg :updated-at)
+ (organisation :initarg :organisation :initform nil :marshal-type gh-user)
+ (parent :initarg :parent :marshal-type gh-repos-repo)
+ (source :initarg :source :marshal-type gh-repos-repo)
+ (has-issues :initarg :has-issues)
+ (has-wiki :initarg :has-wiki)
+ (has-downloads :initarg :has-downloads))
+ "Class for GitHub repositories")
+
+(gh-defclass gh-repos-ref (gh-object)
+ ((label :initarg :label)
+ (ref :initarg :ref :initform nil)
+ (sha :initarg :sha :initform nil)
+ (user :initarg :user :initform nil :marshal-type gh-user)
+ (repo :initarg :repo :initform nil :marshal-type gh-repos-repo)))
+
+(cl-defmethod gh-repos-user-list ((api gh-repos-api) &optional username)
+ (gh-api-authenticated-request
+ api (gh-object-list-reader (oref api repo-cls)) "GET"
+ (format "/users/%s/repos" (or username (gh-api-get-username api)))))
+
+(cl-defmethod gh-repos-org-list ((api gh-repos-api) org)
+ (gh-api-authenticated-request
+ api (gh-object-list-reader (oref api repo-cls)) "GET"
+ (format "/orgs/%s/repos" org)))
+
+(cl-defmethod gh-repos-repo-to-obj ((repo gh-repos-repo-stub)
+ &rest caps)
+ (let ((has_issues (plist-member caps :issues))
+ (has_wiki (plist-member caps :wiki))
+ (has_downloads (plist-member caps :downloads)))
+ `(("name" . ,(oref repo :name))
+ ,@(when (slot-boundp repo :homepage)
+ (list (cons "homepage" (oref repo :homepage))))
+ ,@(when (slot-boundp repo :description)
+ (list (cons "description" (oref repo :description))))
+ ,@(when (slot-boundp repo :private)
+ (list (cons "public" (not (oref repo :private)))))
+ ,@(when has_issues
+ (list (cons "has_issues" (plist-get caps :issues))))
+ ,@(when has_wiki
+ (list (cons "has_wiki" (plist-get caps :wiki))))
+ ,@(when has_downloads
+ (list (cons "has_downloads" (plist-get caps :downloads)))))))
+
+(cl-defmethod gh-repos-repo-new ((api gh-repos-api) repo-stub
+ &optional org &rest caps)
+ (gh-api-authenticated-request
+ api (gh-object-reader (oref api repo-cls)) "POST"
+ (if org (format "/orgs/%s/repos" org)
+ "/user/repos")
+ (apply 'gh-repos-repo-to-obj repo-stub caps)))
+
+(cl-defmethod gh-repos-repo-get ((api gh-repos-api) repo-id &optional user)
+ (gh-api-authenticated-request
+ api (gh-object-reader (oref api repo-cls)) "GET"
+ (format "/repos/%s/%s"
+ (or user (gh-api-get-username api))
+ repo-id)))
+
+(cl-defmethod gh-repos-repo-update ((api gh-repos-api) repo-stub
+ &optional user &rest caps)
+ (gh-api-authenticated-request
+ api (gh-object-reader (oref api repo-cls)) "PATCH"
+ (format "/repos/%s/%s"
+ (or user (gh-api-get-username api))
+ (oref repo-stub :name))
+ (apply 'gh-repos-repo-to-obj repo-stub caps)))
+
+(cl-defmethod gh-repos-repo-rename ((api gh-repos-api) repo-stub new-name
+ &optional user)
+ (let ((new-stub (make-instance 'gh-repos-repo-stub :name new-name)))
+ (gh-api-authenticated-request
+ api (gh-object-reader (oref api repo-cls)) "PATCH"
+ (format "/repos/%s/%s"
+ (or user (gh-api-get-username api))
+ (oref repo-stub :name))
+ (gh-repos-repo-to-obj new-stub))))
+
+(cl-defmethod gh-repos-repo-delete ((api gh-repos-api) repo-id
+ &optional user)
+ (gh-api-authenticated-request
+ api (gh-object-reader (oref api repo-cls)) "DELETE"
+ (format "/repos/%s/%s"
+ (or user (gh-api-get-username api))
+ repo-id)))
+
+;; TODO gh-repos-repo-move
+
+(cl-defmethod gh-repos-repo-contributors ((api gh-repos-api) repo)
+ (gh-api-authenticated-request
+ api (gh-object-reader (oref api repo-cls)) "GET"
+ (format "/repos/%s/%s/contributors"
+ (oref (oref repo :owner) :login)
+ (oref repo :name))))
+
+;;; TODO: generate some useful objects with the return values
+
+(cl-defmethod gh-repos-repo-languages ((api gh-repos-api) repo)
+ (gh-api-authenticated-request
+ api nil "GET" (format "/repos/%s/%s/languages"
+ (oref (oref repo :owner) :login)
+ (oref repo :name))))
+
+(cl-defmethod gh-repos-repo-teams ((api gh-repos-api) repo)
+ (gh-api-authenticated-request
+ api nil "GET" (format "/repos/%s/%s/teams"
+ (oref (oref repo :owner) :login)
+ (oref repo :name))))
+
+(cl-defmethod gh-repos-repo-tags ((api gh-repos-api) repo)
+ (gh-api-authenticated-request
+ api nil "GET" (format "/repos/%s/%s/tags"
+ (oref (oref repo :owner) :login)
+ (oref repo :name))))
+
+(cl-defmethod gh-repos-repo-branches ((api gh-repos-api) repo)
+ (gh-api-authenticated-request
+ api nil "GET" (format "/repos/%s/%s/branches"
+ (oref (oref repo :owner) :login)
+ (oref repo :name))))
+
+;;; TODO gh-repos-repo-branch-commits
+
+;;; Collaborators sub-API
+
+(cl-defmethod gh-repos-collaborators-list ((api gh-repos-api) repo)
+ (gh-api-authenticated-request
+ api (gh-object-list-reader (oref api user-cls)) "GET" (format "/repos/%s/%s/collaborators"
+ (oref (oref repo :owner) :login)
+ (oref repo :name))))
+
+(cl-defmethod gh-repos-collaborators-p ((api gh-repos-api) repo user)
+ (eq (oref (gh-api-authenticated-request
+ api nil "GET"
+ (format "/repos/%s/%s/collaborators/%s"
+ (oref (oref repo :owner) :login)
+ (oref repo :name)
+ user))
+ :http-status)
+ 204))
+
+(cl-defmethod gh-repos-collaborators-add ((api gh-repos-api) repo user)
+ (gh-api-authenticated-request
+ api nil "PUT"
+ (format "/repos/%s/%s/collaborators/%s"
+ (oref (oref repo :owner) :login)
+ (oref repo :name)
+ user)))
+
+(cl-defmethod gh-repos-collaborators-delete ((api gh-repos-api) repo user)
+ (gh-api-authenticated-request
+ api nil "DELETE"
+ (format "/repos/%s/%s/collaborators/%s"
+ (oref (oref repo :owner) :login)
+ (oref repo :name)
+ user)))
+
+;;; TODO Comments sub-API
+;;; TODO Commits sub-API
+;;; TODO Contents sub-API
+;;; TODO Downloads sub-API
+
+;;; Forks sub-API
+
+(cl-defmethod gh-repos-forks-list ((api gh-repos-api) repo &optional recursive)
+ (let ((resp (gh-api-authenticated-request
+ api (gh-object-list-reader (oref api repo-cls)) "GET"
+ (format "/repos/%s/%s/forks"
+ (oref (oref repo :owner) :login)
+ (oref repo :name)))))
+ (when recursive
+ (let ((forks (oref resp :data)))
+ (oset resp :data
+ (apply 'nconc forks
+ (mapcar
+ (lambda (f)
+ (oref (gh-repos-forks-list api f t) data))
+ forks)))))
+ resp))
+
+(cl-defmethod gh-repos-fork ((api gh-repos-api) repo &optional org)
+ (gh-api-authenticated-request
+ api (gh-object-reader (oref api repo-cls)) "POST"
+ (format "/repos/%s/%s/forks"
+ (oref (oref repo :owner) :login)
+ (oref repo :name))
+ nil (when org `(("org" . ,org)))))
+
+;;; TODO Keys sub-API
+;;; TODO Hooks sub-API
+;;; TODO Merging sub-API
+
+;;; Starring sub-API
+
+(cl-defmethod gh-repos-stargazers ((api gh-repos-api) repo)
+ (gh-api-authenticated-request
+ api (gh-object-list-reader (oref api user-cls)) "GET"
+ (format "/repos/%s/%s/stargazers"
+ (oref (oref repo :owner) :login)
+ (oref repo :name))))
+
+(cl-defmethod gh-repos-starred-list ((api gh-repos-api) &optional username)
+ (gh-api-authenticated-request
+ api (gh-object-list-reader (oref api repo-cls)) "GET"
+ (format "/users/%s/starred" (or username (gh-api-get-username api)))))
+
+(cl-defmethod gh-repos-starred-p ((api gh-repos-api) repo)
+ (eq (oref (gh-api-authenticated-request
+ api nil "GET"
+ (format "/user/starred/%s/%s"
+ (oref (oref repo :owner) :login)
+ (oref repo :name)))
+ :http-status)
+ 204))
+
+(cl-defmethod gh-repos-star ((api gh-repos-api) repo)
+ (gh-api-authenticated-request
+ api nil "PUT"
+ (format "/user/starred/%s/%s"
+ (oref (oref repo :owner) :login)
+ (oref repo :name))))
+
+(cl-defmethod gh-repos-unstar ((api gh-repos-api) repo)
+ (gh-api-authenticated-request
+ api nil "DELETE"
+ (format "/user/starred/%s/%s"
+ (oref (oref repo :owner) :login)
+ (oref repo :name))))
+
+;;; TODO Statuses sub-API
+
+;;; Watching sub-API
+
+(cl-defmethod gh-repos-watchers ((api gh-repos-api) repo)
+ (gh-api-authenticated-request
+ api (gh-object-list-reader (oref api user-cls)) "GET"
+ (format "/repos/%s/%s/subscribers"
+ (oref (oref repo :owner) :login)
+ (oref repo :name))))
+
+(cl-defmethod gh-repos-watched-list ((api gh-repos-api) &optional username)
+ (gh-api-authenticated-request
+ api (gh-object-list-reader (oref api repo-cls)) "GET"
+ (format "/users/%s/subscriptions"
+ (or username (gh-api-get-username api)))))
+
+(cl-defmethod gh-repos-watched-p ((api gh-repos-api) repo)
+ (eq (oref (gh-api-authenticated-request
+ api nil "GET"
+ (format "/user/subscriptions/%s/%s"
+ (oref (oref repo :owner) :login)
+ (oref repo :name)))
+ :http-status)
+ 204))
+
+(cl-defmethod gh-repos-watch ((api gh-repos-api) repo)
+ (gh-api-authenticated-request
+ api nil "PUT"
+ (format "/user/subscriptions/%s/%s"
+ (oref (oref repo :owner) :login)
+ (oref repo :name))))
+
+(cl-defmethod gh-repos-unwatch ((api gh-repos-api) repo)
+ (gh-api-authenticated-request
+ api nil "DELETE"
+ (format "/user/subscriptions/%s/%s"
+ (oref (oref repo :owner) :login)
+ (oref repo :name))))
+
+(provide 'gh-repos)
+;;; gh-repos.el ends here
+
+;; Local Variables:
+;; indent-tabs-mode: nil
+;; End:
--- /dev/null
+;;; gh-search.el --- repository search for gh.el -*- lexical-binding: t; -*-
+;; Copyright (C) 2016 Ivan Malison
+
+;; Author: Ivan Malison <IvanMalisonNOSPAMgmail.com>
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(require 'gh-users)
+(require 'gh-repos)
+
+(defclass gh-search-api (gh-api-v3)
+ ((repo-cls :allocation :class :initform gh-repos-repo)
+ (user-cls :allocation :class :initform gh-users-user)))
+
+(defmacro gh-search-method-builder (method-name uri process-result-function)
+ `(cl-defmethod ,method-name ((search-api gh-search-api)
+ query-string &optional page-limit
+ &rest additional-arguments)
+ (unless (and (stringp query-string) (> (length query-string) 1))
+ (error "a non-empty query string must be provided to github search"))
+ (gh-api-authenticated-request
+ search-api
+ (apply-partially (quote ,process-result-function) search-api)
+ "GET" ,uri nil
+ `((q . ,query-string) ,@additional-arguments) page-limit)))
+
+(defmacro gh-search-process-method-builder (method-name class-symbol)
+ `(cl-defmethod ,method-name ((search-api gh-search-api) data)
+ (unless (listp data)
+ (error "Did not recieve a list from the search query"))
+ (let ((items (assoc 'items data)))
+ (unless items
+ (error "Search query did not return items"))
+ (gh-object-list-read (oref search-api ,class-symbol) (cdr items)))))
+
+(gh-search-process-method-builder gh-process-repo-search-result repo-cls)
+(gh-search-process-method-builder gh-process-user-search-result user-cls)
+(gh-search-method-builder gh-search-repos "/search/repositories"
+ gh-process-repo-search-result)
+(gh-search-method-builder gh-search-users "/search/users"
+ gh-process-user-search-result)
+
+(provide 'gh-search)
+;;; gh-search.el ends here
--- /dev/null
+;;; gh-url.el --- url wrapper for gh.el -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2012 Yann Hodique
+
+;; Author: Yann Hodique <yann.hodiqueNOSPAMgmail.com>
+;; Keywords:
+
+;; This file 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 2, or (at your option)
+;; any later version.
+
+;; This file 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 GNU Emacs; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(require 'eieio)
+
+(require 'url-http)
+
+(defclass gh-url-request ()
+ ((method :initarg :method :type string)
+ (url :initarg :url :type string)
+ (query :initarg :query :initform nil)
+ (headers :initarg :headers :initform nil)
+ (data :initarg :data :initform "" :type string)
+ (async :initarg :async :initform nil)
+ (num-retries :initarg :num-retries :initform 0)
+ (install-callbacks :initarg :install-callbacks :initform nil)
+
+ (default-response-cls :allocation :class :initform gh-url-response)))
+
+(defclass gh-url-response ()
+ ((data-received :initarg :data-received :initform nil)
+ (data :initarg :data :initform nil)
+ (headers :initarg :headers :initform nil)
+ (http-status :initarg :http-status :initform nil)
+ (callbacks :initarg :callbacks :initform nil)
+ (transform :initarg :transform :initform nil)
+ (-req :initarg :-req :initform nil)))
+
+(cl-defmethod gh-url-response-set-data ((resp gh-url-response) data)
+ (let ((transform (oref resp :transform)))
+ (oset resp :data
+ (if transform
+ (funcall transform data)
+ data))
+ (oset resp :data-received t)))
+
+(defclass gh-url-callback ()
+ nil)
+
+(cl-defmethod gh-url-callback-run ((cb gh-url-callback) resp)
+ nil)
+
+(cl-defmethod gh-url-response-run-callbacks ((resp gh-url-response))
+ (let ((copy-list (lambda (list)
+ (if (consp list)
+ (let ((res nil))
+ (while (consp list) (push (pop list) res))
+ (prog1 (nreverse res) (setcdr res list)))
+ (car list)))))
+ (let ((data (oref resp :data)))
+ (dolist (cb (funcall copy-list (oref resp :callbacks)))
+ (cond ((and (object-p cb)
+ (object-of-class-p cb 'gh-url-callback))
+ (gh-url-callback-run cb resp))
+ ((or (functionp cb) (symbolp cb))
+ (funcall cb data))
+ (t (apply (car cb) data (cdr cb))))
+ (object-remove-from-list resp :callbacks cb))))
+ resp)
+
+(cl-defmethod gh-url-add-response-callback ((resp gh-url-response) callback)
+ (object-add-to-list resp :callbacks callback t)
+ (if (oref resp :data-received)
+ (gh-url-response-run-callbacks resp)
+ resp))
+
+;;; code borrowed from nicferrier's web.el
+(defun gh-url-parse-headers (data)
+ (let* ((headers nil)
+ (header-lines (split-string data "\n"))
+ (status-line (car header-lines)))
+ (when (string-match
+ "HTTP/\\([0-9.]+\\) \\([0-9]\\{3\\}\\)\\( \\(.*\\)\\)*"
+ status-line)
+ (push (cons 'status-version (match-string 1 status-line)) headers)
+ (push (cons 'status-code (match-string 2 status-line)) headers)
+ (push (cons 'status-string
+ (or (match-string 4 status-line) ""))
+ headers))
+ (cl-loop for line in (cdr header-lines)
+ if (string-match
+ "^\\([A-Za-z0-9.-]+\\):[ ]*\\(.*\\)"
+ line)
+ do
+ (let ((name (match-string 1 line))
+ (value (match-string 2 line)))
+ (push (cons name value) headers)))
+ headers))
+
+(cl-defmethod gh-url-response-finalize ((resp gh-url-response))
+ (when (oref resp :data-received)
+ (gh-url-response-run-callbacks resp)))
+
+(cl-defmethod gh-url-response-init ((resp gh-url-response)
+ buffer)
+ (declare (special url-http-end-of-headers))
+ (unwind-protect
+ (with-current-buffer buffer
+ (let ((headers (gh-url-parse-headers
+ (buffer-substring
+ (point-min) (1+ url-http-end-of-headers)))))
+ (oset resp :headers headers)
+ (oset resp :http-status (read (cdr (assoc 'status-code headers)))))
+ (goto-char (1+ url-http-end-of-headers))
+ (let ((raw (buffer-substring (point) (point-max))))
+ (gh-url-response-set-data resp raw)))
+ (kill-buffer buffer))
+ (gh-url-response-finalize resp)
+ resp)
+
+(defun gh-url-set-response (status req-resp)
+ (set-buffer-multibyte t)
+ (cl-destructuring-bind (req resp) req-resp
+ (let ((responses-req (clone req))
+ (num (oref req :num-retries)))
+ (oset resp :-req responses-req)
+ (if (or (null num) (zerop num))
+ (gh-url-response-init resp (current-buffer))
+ (condition-case err
+ (gh-url-response-init resp (current-buffer))
+ (error
+ (oset req :num-retries (1- num))
+ (gh-url-run-request req resp)))))))
+
+(defun gh-url-form-encode (form)
+ (mapconcat (lambda (x) (format "%s=%s" (car x) (cdr x)))
+ form "&"))
+
+(defun gh-url-params-encode (form)
+ (concat "?" (gh-url-form-encode form)))
+
+(cl-defmethod gh-url-run-request ((req gh-url-request) &optional resp)
+ (let ((url-registered-auth-schemes
+ '(("basic" ignore . 4))) ;; don't let default handlers kick in
+ (url-privacy-level 'high)
+ (url-user-agent (format "User-Agent: URL/%s\r\n"
+ url-version))
+ (url-request-method (oref req :method))
+ (url-request-data (oref req :data))
+ (url-request-extra-headers (oref req :headers))
+ (url (concat (oref req :url)
+ (let ((params (oref req :query)))
+ (if params
+ (gh-url-params-encode params)
+ "")))))
+ (if (oref req :async)
+ (let* ((resp (or resp (make-instance (oref req default-response-cls))))
+ (req-resp (list req resp)))
+ (with-current-buffer
+ (url-retrieve url 'gh-url-set-response (list req-resp))
+ (set (make-local-variable 'url-registered-auth-schemes)
+ url-registered-auth-schemes)))
+ (let* ((resp (or resp (make-instance (oref req default-response-cls))))
+ (req-resp (list req resp)))
+ (with-current-buffer (url-retrieve-synchronously url)
+ (gh-url-set-response nil req-resp)))))
+ (mapc (lambda (cb)
+ (gh-url-add-response-callback resp cb))
+ (oref req :install-callbacks))
+ resp)
+
+(provide 'gh-url)
+;;; gh-url.el ends here
--- /dev/null
+;;; gh-users.el --- users module for gh.el -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2013 Yann Hodique
+
+;; Author: Yann Hodique <yann.hodiqueNOSPAMgmail.com>
+;; Keywords:
+
+;; This file 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 2, or (at your option)
+;; any later version.
+
+;; This file 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 GNU Emacs; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(require 'eieio)
+
+(require 'gh-api)
+(require 'gh-auth)
+(require 'gh-common)
+
+(defclass gh-users-api (gh-api-v3)
+ ((users-cls :allocation :class :initform gh-users-user))
+ "Users API")
+
+(gh-defclass gh-users-user (gh-user)
+ ((gravatar-id :initarg :gravatar-id)
+ (html-url :initarg :html-url)
+ (followers-url :initarg :followers-url)
+ (following-url :initarg :following-url)
+ (gists-url :initarg :gists-url)
+ (starred-url :initarg :starred-url)
+ (subscriptions-url :initarg :subscriptions-url)
+ (organizations-url :initarg :organizations-url)
+ (repos-url :initarg :repos-url)
+ (events-url :initarg :events-url)
+ (received-events-url :initarg :received-events-url)
+ (type :initarg :type)
+ (site-admin :initarg :site-admin)
+ (name :initarg :name)
+ (company :initarg :company)
+ (blog :initarg :blog)
+ (location :initarg :location)
+ (email :initarg :email)
+ (hireable :initarg :hireable)
+ (bio :initarg :bio)
+ (public-repos :initarg :public-repos)
+ (public-gists :initarg :public-gists)
+ (followers :initarg :followers)
+ (following :initarg :following)
+ (created-at :initarg :created-at)
+ (update-at :initarg :update-at)))
+
+(cl-defmethod gh-users-get ((api gh-users-api) &optional username)
+ (gh-api-authenticated-request
+ api (gh-object-reader (oref api users-cls)) "GET"
+ (if username
+ (format "/users/%s" username)
+ "/user")))
+
+(cl-defmethod gh-users-list ((api gh-users-api))
+ (gh-api-authenticated-request
+ api (gh-object-list-reader (oref api users-cls)) "GET"
+ "/users"))
+
+(provide 'gh-users)
+;;; gh-users.el ends here
--- /dev/null
+;;; gh.el --- Github API client libraries -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2011 Yann Hodique
+
+;; Author: Yann Hodique <yhodiqueNOSPAMgmail.com>
+;; Keywords:
+;; Homepage: https://github.com/sigma/gh.el
+
+;; This file 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 2, or (at your option)
+;; any later version.
+
+;; This file 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 GNU Emacs; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(require 'gh-gist)
+(require 'gh-pulls)
+(require 'gh-issues)
+(require 'gh-users)
+
+(provide 'gh)
+;;; gh.el ends here
+
+;; Local Variables:
+;; indent-tabs-mode: nil
+;; End:
--- /dev/null
+;;; buck.el --- Client library for the Bitbucket API -*- lexical-binding:t -*-
+
+;; Copyright (C) 2016-2023 Jonas Bernoulli
+
+;; Author: Jonas Bernoulli <jonasNOSPAMbernoul.li>
+;; Homepage: https://github.com/magit/ghub
+;; Keywords: tools
+
+;; SPDX-License-Identifier: GPL-3.0-or-later
+
+;; This file 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 file 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 file. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Buck is a library that provides basic support for using the Bitbucket API
+;; from Emacs packages. It abstracts access to API resources using only
+;; a handful of functions that are not resource-specific.
+
+;; This library is implemented on top of Ghub. Unlike Ghub, Buck does
+;; not support the guided creation of tokens because Bitbucket lacks the
+;; features that would be necessary to implement that. Users have to
+;; create tokens through the web interface.
+
+;;; Code:
+
+(require 'ghub)
+
+(defconst buck-default-host "api.bitbucket.org/2.0"
+ "The default host that is used if `buck.host' is not set.")
+
+;; HEAD and PATCH are not supported according to
+;; https://developer.atlassian.com/bitbucket/api/2/reference/meta/uri-uuid
+
+(cl-defun buck-get (resource &optional params
+ &key query payload headers
+ silent unpaginate noerror reader
+ username auth host
+ callback errorback extra)
+ "Make a `GET' request for RESOURCE, with optional query PARAMS.
+Like calling `ghub-request' (which see) with \"GET\" as METHOD
+and `bitbucket' as FORGE."
+ (ghub-request "GET" resource params :forge 'bitbucket
+ :query query :payload payload :headers headers
+ :silent silent :unpaginate unpaginate
+ :noerror noerror :reader reader
+ :username username :auth auth :host host
+ :callback callback :errorback errorback :extra extra))
+
+(cl-defun buck-put (resource &optional params
+ &key query payload headers
+ silent unpaginate noerror reader
+ username auth host
+ callback errorback extra)
+ "Make a `PUT' request for RESOURCE, with optional payload PARAMS.
+Like calling `ghub-request' (which see) with \"PUT\" as METHOD
+and `bitbucket' as FORGE."
+ (ghub-request "PUT" resource params :forge 'bitbucket
+ :query query :payload payload :headers headers
+ :silent silent :unpaginate unpaginate
+ :noerror noerror :reader reader
+ :username username :auth auth :host host
+ :callback callback :errorback errorback :extra extra))
+
+(cl-defun buck-post (resource &optional params
+ &key query payload headers
+ silent unpaginate noerror reader
+ username auth host
+ callback errorback extra)
+ "Make a `POST' request for RESOURCE, with optional payload PARAMS.
+Like calling `ghub-request' (which see) with \"POST\" as METHOD
+and `bitbucket' as FORGE."
+ (ghub-request "POST" resource params :forge 'bitbucket
+ :query query :payload payload :headers headers
+ :silent silent :unpaginate unpaginate
+ :noerror noerror :reader reader
+ :username username :auth auth :host host
+ :callback callback :errorback errorback :extra extra))
+
+(cl-defun buck-delete (resource &optional params
+ &key query payload headers
+ silent unpaginate noerror reader
+ username auth host
+ callback errorback extra)
+ "Make a `DELETE' request for RESOURCE, with optional payload PARAMS.
+Like calling `ghub-request' (which see) with \"DELETE\" as METHOD
+and `bitbucket' as FORGE."
+ (ghub-request "DELETE" resource params :forge 'bitbucket
+ :query query :payload payload :headers headers
+ :silent silent :unpaginate unpaginate
+ :noerror noerror :reader reader
+ :username username :auth auth :host host
+ :callback callback :errorback errorback :extra extra))
+
+(cl-defun buck-request (method resource &optional params
+ &key query payload headers
+ silent unpaginate noerror reader
+ username auth host
+ callback errorback extra)
+ "Make a request for RESOURCE and return the response body.
+Like calling `ghub-request' (which see) with `bitbucket' as FORGE."
+ (ghub-request method resource params :forge 'bitbucket
+ :query query :payload payload :headers headers
+ :silent silent :unpaginate unpaginate
+ :noerror noerror :reader reader
+ :username username :auth auth :host host
+ :callback callback :errorback errorback :extra extra))
+
+(cl-defun buck-repository-id (owner name &key username auth host)
+ "Return the id of the repository specified by OWNER, NAME and HOST."
+ (substring (cdr (assq 'uuid
+ (buck-get (format "/repositories/%s/%s" owner name)
+ nil
+ :username username :auth auth :host host)))
+ 1 -1))
+
+;;; _
+(provide 'buck)
+;;; buck.el ends here
--- /dev/null
+This is the file .../info/dir, which contains the
+topmost node of the Info hierarchy, called (dir)Top.
+The first time you invoke Info you start off looking at this node.
+\1f
+File: dir, Node: Top This is the top of the INFO tree
+
+ This (the Directory node) gives a menu of major topics.
+ Typing "q" exits, "H" lists all Info commands, "d" returns here,
+ "h" gives a primer for first-timers,
+ "mEmacs<Return>" visits the Emacs manual, etc.
+
+ In Emacs, you can click mouse button 2 on a menu item or cross reference
+ to select it.
+
+* Menu:
+
+Emacs
+* Ghub: (ghub). Client library for the Github API.
--- /dev/null
+;;; ghub-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*-
+;;
+;;; Code:
+
+(add-to-list 'load-path (directory-file-name
+ (or (file-name-directory #$) (car load-path))))
+
+\f
+;;;### (autoloads nil "buck" "buck.el" (0 0 0 0))
+;;; Generated autoloads from buck.el
+
+(register-definition-prefixes "buck" '("buck-default-host"))
+
+;;;***
+\f
+;;;### (autoloads nil "ghub" "ghub.el" (0 0 0 0))
+;;; Generated autoloads from ghub.el
+
+(autoload 'ghub-clear-caches "ghub" "\
+Clear all caches that might negatively affect Ghub.
+
+If a library that is used by Ghub caches incorrect information
+such as a mistyped password, then that can prevent Ghub from
+asking the user for the correct information again.
+
+Set `url-http-real-basic-auth-storage' to nil
+and call `auth-source-forget+'." t nil)
+
+(register-definition-prefixes "ghub" '("ghub-"))
+
+;;;***
+\f
+;;;### (autoloads nil "ghub-graphql" "ghub-graphql.el" (0 0 0 0))
+;;; Generated autoloads from ghub-graphql.el
+
+(register-definition-prefixes "ghub-graphql" '("ghub-"))
+
+;;;***
+\f
+;;;### (autoloads nil "glab" "glab.el" (0 0 0 0))
+;;; Generated autoloads from glab.el
+
+(register-definition-prefixes "glab" '("glab-default-host"))
+
+;;;***
+\f
+;;;### (autoloads nil "gogs" "gogs.el" (0 0 0 0))
+;;; Generated autoloads from gogs.el
+
+(register-definition-prefixes "gogs" '("gogs-default-host"))
+
+;;;***
+\f
+;;;### (autoloads nil "gsexp" "gsexp.el" (0 0 0 0))
+;;; Generated autoloads from gsexp.el
+
+(register-definition-prefixes "gsexp" '("gsexp-"))
+
+;;;***
+\f
+;;;### (autoloads nil "gtea" "gtea.el" (0 0 0 0))
+;;; Generated autoloads from gtea.el
+
+(register-definition-prefixes "gtea" '("gtea-default-host"))
+
+;;;***
+\f
+;;;### (autoloads nil nil ("ghub-pkg.el") (0 0 0 0))
+
+;;;***
+\f
+;; Local Variables:
+;; version-control: never
+;; no-byte-compile: t
+;; no-update-autoloads: t
+;; coding: utf-8
+;; End:
+;;; ghub-autoloads.el ends here
--- /dev/null
+;;; ghub-graphql.el --- Access Github API using GrapthQL -*- lexical-binding:t -*-
+
+;; Copyright (C) 2016-2023 Jonas Bernoulli
+
+;; Author: Jonas Bernoulli <jonasNOSPAMbernoul.li>
+;; Homepage: https://github.com/magit/ghub
+;; Keywords: tools
+
+;; SPDX-License-Identifier: GPL-3.0-or-later
+
+;; This file 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 file 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 file. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'ghub)
+(require 'gsexp)
+(require 'treepy)
+
+;; Needed for Emacs < 27.
+(eval-when-compile (require 'json))
+(declare-function json-read-from-string "json" (string))
+(declare-function json-encode "json" (object))
+
+(eval-when-compile (require 'pp)) ; Needed for Emacs < 29.
+(eval-when-compile (require 'subr-x))
+
+;;; Api
+
+(defvar ghub-graphql-items-per-request 100
+ "Number of GraphQL items to query for entities that return a collection.
+
+Adjust this value if you're hitting query timeouts against larger
+repositories.")
+
+(cl-defun ghub-graphql (graphql &optional variables
+ &key username auth host forge
+ headers silent
+ callback errorback value extra)
+ "Make a GraphQL request using GRAPHQL and VARIABLES.
+Return the response as a JSON-like alist. Even if the response
+contains `errors', do not raise an error. GRAPHQL is a GraphQL
+string. VARIABLES is a JSON-like alist. The other arguments
+behave as for `ghub-request' (which see)."
+ (cl-assert (not (stringp variables)))
+ (cl-assert (or (stringp graphql)
+ (memq (car-safe graphql) '(query mutation))))
+ (unless (stringp graphql)
+ (setq graphql (gsexp-encode (ghub--graphql-prepare-query graphql))))
+ (ghub-request "POST"
+ (if (eq forge 'gitlab) "/api/graphql" "/graphql")
+ nil
+ :payload `((query . ,graphql)
+ ,@(and variables `((variables ,@variables))))
+ :headers headers :silent silent
+ :username username :auth auth :host host :forge forge
+ :callback callback :errorback errorback
+ :extra extra :value value))
+
+(cl-defun ghub-graphql-rate-limit (&key username auth host)
+ "Return rate limit information."
+ (let-alist (ghub-graphql
+ '(query (rateLimit limit cost remaining resetAt))
+ nil :username username :auth auth :host host)
+ .data.rateLimit))
+
+(cl-defun ghub--repository-id (owner name &key username auth host)
+ "Return the id of the repository specified by OWNER, NAME and HOST."
+ (let-alist (ghub-graphql
+ '(query (repository [(owner $owner String!)
+ (name $name String!)]
+ id))
+ `((owner . ,owner)
+ (name . ,name))
+ :username username :auth auth :host host)
+ .data.repository.id))
+
+;;; Api (drafts)
+
+(defconst ghub-fetch-repository-sparse
+ '(query
+ (repository
+ [(owner $owner String!)
+ (name $name String!)]
+ name
+ id
+ createdAt
+ updatedAt
+ nameWithOwner
+ (parent nameWithOwner)
+ description
+ homepageUrl
+ (defaultBranchRef name)
+ isArchived
+ isFork
+ isLocked
+ isMirror
+ isPrivate
+ hasIssuesEnabled
+ hasWikiEnabled
+ (licenseInfo name)
+ (stargazers totalCount)
+ (watchers totalCount))))
+
+(defconst ghub-fetch-repository
+ `(query
+ (repository
+ ,@(cdr (cadr ghub-fetch-repository-sparse))
+ (assignableUsers [(:edges t)]
+ id
+ login
+ name)
+ (issues [(:edges t)
+ (:singular issue number)
+ (orderBy ((field UPDATED_AT) (direction DESC)))]
+ number
+ id
+ state
+ (author login)
+ title
+ createdAt
+ updatedAt
+ closedAt
+ locked
+ (milestone id)
+ body
+ (assignees [(:edges t)]
+ id)
+ (comments [(:edges t)]
+ databaseId
+ (author login)
+ createdAt
+ updatedAt
+ body)
+ (labels [(:edges t)]
+ id))
+ (labels [(:edges t)
+ (:singular label id)]
+ id
+ name
+ color
+ description)
+ (milestones [(:edges t)
+ (:singular milestone id)]
+ id
+ number
+ title
+ createdAt
+ updatedAt
+ dueOn
+ closedAt
+ description)
+ (pullRequests [(:edges t)
+ (:singular pullRequest number)
+ (orderBy ((field UPDATED_AT) (direction DESC)))]
+ number
+ id
+ state
+ (author login)
+ title
+ createdAt
+ updatedAt
+ closedAt
+ mergedAt
+ isDraft
+ locked
+ maintainerCanModify
+ isCrossRepository
+ (milestone id)
+ body
+ (baseRef name
+ (repository nameWithOwner))
+ baseRefOid
+ (headRef name
+ (repository (owner login)
+ nameWithOwner))
+ headRefOid
+ (assignees [(:edges t)]
+ id)
+ (reviewRequests [(:edges t)]
+ (requestedReviewer "... on User { id }\n"))
+ (comments [(:edges t)]
+ databaseId
+ (author login)
+ createdAt
+ updatedAt
+ body)
+ (labels [(:edges t)]
+ id)))))
+
+(defconst ghub-fetch-repository-review-threads
+ '(query
+ (repository
+ [(owner $owner String!)
+ (name $name String!)]
+ (pullRequests [(:edges t)
+ (:singular pullRequest number)
+ (orderBy ((field UPDATED_AT) (direction DESC)))]
+ number
+ baseRefOid
+ headRefOid
+ (reviewThreads [(:edges t)]
+ id
+ line
+ originalLine
+ diffSide
+ (resolvedBy login)
+ (comments [(:edges t)]
+ id
+ databaseId
+ (author login)
+ createdAt
+ updatedAt
+ body
+ (replyTo databaseId)
+ (originalCommit oid)
+ path))))))
+
+(cl-defun ghub-fetch-repository (owner name callback
+ &optional until
+ &key username auth host forge
+ headers errorback sparse)
+ "Asynchronously fetch forge data about the specified repository.
+Once all data has been collected, CALLBACK is called with the
+data as the only argument."
+ (ghub--graphql-vacuum (if sparse
+ ghub-fetch-repository-sparse
+ ghub-fetch-repository)
+ `((owner . ,owner)
+ (name . ,name))
+ callback until
+ :narrow '(repository)
+ :username username
+ :auth auth
+ :host host
+ :forge forge
+ :headers headers
+ :errorback errorback))
+
+(cl-defun ghub-fetch-issue (owner name number callback
+ &optional until
+ &key username auth host forge
+ headers errorback)
+ "Asynchronously fetch forge data about the specified issue.
+Once all data has been collected, CALLBACK is called with the
+data as the only argument."
+ (ghub--graphql-vacuum (ghub--graphql-prepare-query
+ ghub-fetch-repository
+ `(repository issues (issue . ,number)))
+ `((owner . ,owner)
+ (name . ,name))
+ callback until
+ :narrow '(repository issue)
+ :username username
+ :auth auth
+ :host host
+ :forge forge
+ :headers headers
+ :errorback errorback))
+
+(cl-defun ghub-fetch-pullreq (owner name number callback
+ &optional until
+ &key username auth host forge
+ headers errorback)
+ "Asynchronously fetch forge data about the specified pull-request.
+Once all data has been collected, CALLBACK is called with the
+data as the only argument."
+ (ghub--graphql-vacuum (ghub--graphql-prepare-query
+ ghub-fetch-repository
+ `(repository pullRequests (pullRequest . ,number)))
+ `((owner . ,owner)
+ (name . ,name))
+ callback until
+ :narrow '(repository pullRequest)
+ :username username
+ :auth auth
+ :host host
+ :forge forge
+ :headers headers
+ :errorback errorback))
+
+(cl-defun ghub-fetch-review-threads (owner name number callback
+ &optional until
+ &key username auth host forge
+ headers errorback)
+ "Asynchronously fetch forge data about the review threads from a pull-request.
+Once all data has been collected, CALLBACK is called with the
+data as the only argument."
+ (ghub--graphql-vacuum (ghub--graphql-prepare-query
+ ghub-fetch-repository-review-threads
+ `(repository pullRequests (pullRequest . ,number)))
+ `((owner . ,owner)
+ (name . ,name))
+ callback until
+ :narrow '(repository pullRequest)
+ :username username
+ :auth auth
+ :host host
+ :forge forge
+ :headers headers
+ :errorback errorback))
+
+;;; Internal
+
+(cl-defstruct (ghub--graphql-req
+ (:include ghub--req)
+ (:constructor ghub--make-graphql-req)
+ (:copier nil))
+ (query nil :read-only t)
+ (query-str nil :read-only nil)
+ (variables nil :read-only t)
+ (until nil :read-only t)
+ (buffer nil :read-only t)
+ (pages 0 :read-only nil))
+
+(cl-defun ghub--graphql-vacuum (query variables callback
+ &optional until
+ &key narrow username auth host forge
+ headers errorback)
+ "Make a GraphQL request using QUERY and VARIABLES.
+See Info node `(ghub)GraphQL Support'."
+ (unless host
+ (setq host (ghub--host forge)))
+ (unless (or username (stringp auth) (eq auth 'none))
+ (setq username (ghub--username host forge)))
+ (ghub--graphql-retrieve
+ (ghub--make-graphql-req
+ :url (url-generic-parse-url
+ (format "https://%s/graphql"
+ (if (string-suffix-p "/v3" host)
+ (substring host 0 -3)
+ host)))
+ :method "POST"
+ :headers (ghub--headers headers host auth username forge)
+ :handler #'ghub--graphql-handle-response
+ :query query
+ :variables variables
+ :until until
+ :buffer (current-buffer)
+ :callback (and (not (eq callback 'synchronous))
+ (let ((buf (current-buffer)))
+ (if narrow
+ (lambda (data)
+ (let ((path narrow) key)
+ (while (setq key (pop path))
+ (setq data (cdr (assq key data)))))
+ (ghub--graphql-set-mode-line buf nil)
+ (funcall (or callback #'ghub--graphql-pp-response)
+ data))
+ (lambda (data)
+ (ghub--graphql-set-mode-line buf nil)
+ (funcall (or callback #'ghub--graphql-pp-response)
+ data)))))
+ :errorback (and (not (eq callback 'synchronous))
+ errorback))))
+
+(cl-defun ghub--graphql-retrieve (req &optional lineage cursor)
+ (let ((p (cl-incf (ghub--graphql-req-pages req))))
+ (when (> p 1)
+ (ghub--graphql-set-mode-line req "Fetching page %s" p)))
+ (setf (ghub--graphql-req-query-str req)
+ (gsexp-encode
+ (ghub--graphql-prepare-query
+ (ghub--graphql-req-query req)
+ lineage cursor)))
+ (ghub--retrieve
+ (let ((json-false nil))
+ (ghub--encode-payload
+ `((query . ,(ghub--graphql-req-query-str req))
+ (variables . ,(ghub--graphql-req-variables req)))))
+ req))
+
+(defun ghub--graphql-prepare-query (query &optional lineage cursor)
+ (when lineage
+ (setq query (ghub--graphql-narrow-query query lineage cursor)))
+ (let ((loc (ghub--alist-zip query))
+ variables)
+ (cl-block nil
+ (while t
+ (let ((node (treepy-node loc)))
+ (when (and (vectorp node)
+ (listp (aref node 0)))
+ (let ((alist (cl-coerce node 'list))
+ vars)
+ (when (cadr (assq :edges alist))
+ (push (list 'first ghub-graphql-items-per-request) vars)
+ (setq loc (treepy-up loc))
+ (setq node (treepy-node loc))
+ (setq loc (treepy-replace
+ loc `(,(car node)
+ ,(cadr node)
+ (pageInfo endCursor hasNextPage)
+ (edges (node ,@(cddr node))))))
+ (setq loc (treepy-down loc))
+ (setq loc (treepy-next loc)))
+ (dolist (elt alist)
+ (cond ((keywordp (car elt)))
+ ((length= elt 3)
+ (push (list (nth 0 elt) (nth 1 elt)) vars)
+ (push (list (nth 1 elt) (nth 2 elt)) variables))
+ ((length= elt 2)
+ (push elt vars))))
+ (setq loc (treepy-replace loc (vconcat (nreverse vars)))))))
+ (if (treepy-end-p loc)
+ (let ((node (copy-sequence (treepy-node loc))))
+ (when variables
+ (push (cl-coerce variables 'vector)
+ (cdr node)))
+ (cl-return node))
+ (setq loc (treepy-next loc)))))))
+
+(defun ghub--graphql-handle-response (status req)
+ (let ((buffer (current-buffer)))
+ (unwind-protect
+ (progn
+ (set-buffer-multibyte t)
+ (let* ((headers (ghub--handle-response-headers status req))
+ (payload (ghub--handle-response-payload req))
+ (payload (ghub--handle-response-error status payload req))
+ (err (plist-get status :error))
+ (errors (cdr (assq 'errors payload)))
+ (errors (and errors (cons 'ghub-graphql-error errors))))
+ (if (or err errors)
+ (if-let ((errorback (ghub--req-errorback req)))
+ (funcall errorback (or err errors) headers status req)
+ (ghub--signal-error (or err errors)))
+ (ghub--graphql-walk-response req (assq 'data payload)))))
+ (when (buffer-live-p buffer)
+ (kill-buffer buffer)))))
+
+(defun ghub--graphql-walk-response (req data)
+ (let* ((loc (ghub--req-value req))
+ (loc (if (not loc)
+ (ghub--alist-zip data)
+ (setq data (ghub--graphql-narrow-data
+ data (ghub--graphql-lineage loc)))
+ (setf (alist-get 'edges data)
+ (append (alist-get 'edges (treepy-node loc))
+ (or (alist-get 'edges data)
+ (error "BUG: Expected new nodes"))))
+ (treepy-replace loc data))))
+ (cl-block nil
+ (while t
+ (when (eq (car-safe (treepy-node loc)) 'edges)
+ (setq loc (treepy-up loc))
+ (pcase-let ((`(,key . ,val) (treepy-node loc)))
+ (let-alist val
+ (let* ((cursor (and .pageInfo.hasNextPage
+ .pageInfo.endCursor))
+ (until (cdr (assq (intern (format "%s-until" key))
+ (ghub--graphql-req-until req))))
+ (nodes (mapcar #'cdar .edges))
+ (nodes (if until
+ (seq-take-while
+ (lambda (node)
+ (or (string> (cdr (assq 'updatedAt node))
+ until)
+ (setq cursor nil)))
+ nodes)
+ nodes)))
+ (if cursor
+ (progn
+ (setf (ghub--req-value req) loc)
+ (ghub--graphql-retrieve req
+ (ghub--graphql-lineage loc)
+ cursor)
+ (cl-return))
+ (setq loc (treepy-replace loc (cons key nodes))))))))
+ (cond ((not (treepy-end-p loc))
+ (setq loc (treepy-next loc)))
+ ((ghub--req-callback req)
+ (funcall (ghub--req-callback req)
+ (treepy-root loc))
+ (cl-return))
+ ((cl-return (treepy-root loc))))))))
+
+(defun ghub--graphql-lineage (loc)
+ (let (lineage)
+ (while (treepy-up loc)
+ (push (car (treepy-node loc)) lineage)
+ (setq loc (treepy-up loc)))
+ lineage))
+
+(defun ghub--graphql-narrow-data (data lineage)
+ (let (key)
+ (while (setq key (pop lineage))
+ (if (consp (car lineage))
+ (progn (pop lineage)
+ (setf data (cadr data)))
+ (setq data (assq key (cdr data))))))
+ data)
+
+(defun ghub--graphql-narrow-query (query lineage cursor)
+ (if (consp (car lineage))
+ (let* ((child (cddr query))
+ (alist (cl-coerce (cadr query) 'list))
+ (single (cdr (assq :singular alist))))
+ `(,(car single)
+ ,(vector (list (cadr single) (cdr (car lineage))))
+ ,@(if (cdr lineage)
+ (ghub--graphql-narrow-query child (cdr lineage) cursor)
+ child)))
+ (let* ((child (or (assq (car lineage) (cdr query))
+ ;; Alias
+ (cl-find-if (lambda (c)
+ (eq (car-safe (car-safe c))
+ (car lineage)))
+ query)
+ ;; Edges
+ (cl-find-if (lambda (c)
+ (and (listp c)
+ (vectorp (cadr c))
+ (eq (cadr (assq :singular
+ (cl-coerce (cadr c)
+ 'list)))
+ (car lineage))))
+ (cdr query))
+ (error "BUG: Failed to narrow query")))
+ (object (car query))
+ (args (and (vectorp (cadr query))
+ (cadr query))))
+ `(,object
+ ,@(and args (list args))
+ ,(cond ((cdr lineage)
+ (ghub--graphql-narrow-query child (cdr lineage) cursor))
+ (cursor
+ `(,(car child)
+ ,(vconcat `((after ,cursor))
+ (cadr child))
+ ,@(cddr child)))
+ (t
+ child))))))
+
+(defun ghub--alist-zip (root)
+ (let ((branchp (lambda (elt) (and (listp elt) (listp (cdr elt)))))
+ (make-node (lambda (_ children) children)))
+ (treepy-zipper branchp #'identity make-node root)))
+
+(defun ghub--graphql-set-mode-line (buf string &rest args)
+ (when (ghub--graphql-req-p buf)
+ (setq buf (ghub--graphql-req-buffer buf)))
+ (when (buffer-live-p buf)
+ (with-current-buffer buf
+ (setq mode-line-process
+ (and string (concat " " (apply #'format string args))))
+ (force-mode-line-update t))))
+
+(defun ghub--graphql-pp-response (data)
+ (require 'pp) ; needed for Emacs < 29.
+ (pp-display-expression data "*Pp Eval Output*"))
+
+;;; _
+(provide 'ghub-graphql)
+;;; ghub-graphql.el ends here
--- /dev/null
+(define-package "ghub" "20230301.1402" "Client libraries for Git forge APIs."
+ '((emacs "25.1")
+ (compat "29.1.3.4")
+ (let-alist "1.0.6")
+ (treepy "0.1.1"))
+ :commit "6a5de97649ff3eca9aa20b79f3526b4b3ab86b13" :authors
+ '(("Jonas Bernoulli" . "jonasNOSPAMbernoul.li"))
+ :maintainer
+ '("Jonas Bernoulli" . "jonasNOSPAMbernoul.li")
+ :keywords
+ '("tools")
+ :url "https://github.com/magit/ghub")
+;; Local Variables:
+;; no-byte-compile: t
+;; End:
--- /dev/null
+;;; ghub.el --- Client libraries for Git forge APIs -*- lexical-binding:t -*-
+
+;; Copyright (C) 2016-2023 Jonas Bernoulli
+
+;; Author: Jonas Bernoulli <jonasNOSPAMbernoul.li>
+;; Homepage: https://github.com/magit/ghub
+;; Keywords: tools
+
+;; SPDX-License-Identifier: GPL-3.0-or-later
+
+;; This file 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 file 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 file. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Ghub provides basic support for using the APIs of various Git forges
+;; from Emacs packages. Originally it only supported the Github REST
+;; API, but now it also supports the Github GraphQL API as well as the
+;; REST APIs of Gitlab, Gitea, Gogs and Bitbucket.
+
+;; Ghub abstracts access to API resources using only a handful of basic
+;; functions such as `ghub-get'. These are convenience wrappers around
+;; `ghub-request'. Additional forge-specific wrappers like `glab-put',
+;; `gtea-put', `gogs-post' and `buck-delete' are also available. Ghub
+;; does not provide any resource-specific functions, with the exception
+;; of `FORGE-repository-id'.
+
+;; When accessing Github, then Ghub handles the creation and storage of
+;; access tokens using a setup wizard to make it easier for users to get
+;; started. The tokens for other forges have to be created manually.
+
+;; Ghub is intentionally limited to only provide these two essential
+;; features — basic request functions and guided setup — to avoid being
+;; too opinionated, which would hinder wide adoption. It is assumed that
+;; wide adoption would make life easier for users and maintainers alike,
+;; because then all packages that talk to forge APIs could be configured
+;; the same way.
+
+;; Please consult the manual (info "ghub") for more information.
+
+;;; Code:
+
+(require 'auth-source)
+(require 'cl-lib)
+(require 'compat)
+(require 'gnutls)
+(require 'let-alist)
+(require 'url)
+(require 'url-auth)
+(require 'url-http)
+
+(eval-when-compile (require 'subr-x))
+
+;; Needed for Emacs < 27.
+(eval-when-compile (require 'json))
+(declare-function json-read-from-string "json" (string))
+(declare-function json-encode "json" (object))
+
+(declare-function glab-repository-id "glab" (owner name &key username auth host))
+(declare-function gtea-repository-id "gtea" (owner name &key username auth host))
+(declare-function gogs-repository-id "gogs" (owner name &key username auth host))
+(declare-function buck-repository-id "buck" (owner name &key username auth host))
+
+(defvar url-callback-arguments)
+(defvar url-http-end-of-headers)
+(defvar url-http-extra-headers)
+(defvar url-http-response-status)
+
+;;; Settings
+
+(defconst ghub-default-host "api.github.com"
+ "The default host that is used if `ghub.host' is not set.")
+
+(defvar ghub-github-token-scopes '(repo)
+ "The Github API scopes that your private tools need.
+
+You have to manually create or update the token at
+https://github.com/settings/tokens. This variable
+only serves as documentation.")
+
+(defvar ghub-insecure-hosts nil
+ "List of hosts that use http instead of https.")
+
+(defvar ghub-json-use-jansson nil
+ "Whether to use the Jansson library, if available.
+This is experimental. Only let-bind this but do not enable it
+globally because doing that is likely to break other packages
+that use `ghub'. As a user also do not enable this yet.
+See https://github.com/magit/ghub/pull/149.")
+
+(defvar ghub-json-object-type 'alist
+ "The object type that is used for json payload decoding.")
+
+(defvar ghub-json-array-type 'list
+ "The array type that is used for json payload decoding.")
+
+;;; Request
+;;;; Object
+
+(cl-defstruct (ghub--req
+ (:constructor ghub--make-req)
+ (:copier nil))
+ (url nil :read-only nil)
+ (forge nil :read-only t)
+ (silent nil :read-only t)
+ (method nil :read-only t)
+ (headers nil :read-only t)
+ (handler nil :read-only t)
+ (unpaginate nil :read-only nil)
+ (noerror nil :read-only t)
+ (reader nil :read-only t)
+ (callback nil :read-only t)
+ (errorback nil :read-only t)
+ (value nil :read-only nil)
+ (extra nil :read-only nil))
+
+(defalias 'ghub-req-extra #'ghub--req-extra)
+
+;;;; API
+
+(define-error 'ghub-error "Ghub/Url Error" 'error)
+(define-error 'ghub-http-error "HTTP Error" 'ghub-error)
+
+(defvar ghub-response-headers nil
+ "The headers returned in response to the last request.
+`ghub-request' returns the response body and stores the
+response headers in this variable.")
+
+(cl-defun ghub-head (resource &optional params
+ &key query payload headers
+ silent unpaginate noerror reader
+ username auth host
+ callback errorback extra)
+ "Make a `HEAD' request for RESOURCE, with optional query PARAMS.
+Like calling `ghub-request' (which see) with \"HEAD\" as METHOD."
+ (ghub-request "HEAD" resource params
+ :query query :payload payload :headers headers
+ :silent silent :unpaginate unpaginate
+ :noerror noerror :reader reader
+ :username username :auth auth :host host
+ :callback callback :errorback errorback :extra extra))
+
+(cl-defun ghub-get (resource &optional params
+ &key query payload headers
+ silent unpaginate noerror reader
+ username auth host
+ callback errorback extra)
+ "Make a `GET' request for RESOURCE, with optional query PARAMS.
+Like calling `ghub-request' (which see) with \"GET\" as METHOD."
+ (ghub-request "GET" resource params
+ :query query :payload payload :headers headers
+ :silent silent :unpaginate unpaginate
+ :noerror noerror :reader reader
+ :username username :auth auth :host host
+ :callback callback :errorback errorback :extra extra))
+
+(cl-defun ghub-put (resource &optional params
+ &key query payload headers
+ silent unpaginate noerror reader
+ username auth host
+ callback errorback extra)
+ "Make a `PUT' request for RESOURCE, with optional payload PARAMS.
+Like calling `ghub-request' (which see) with \"PUT\" as METHOD."
+ (ghub-request "PUT" resource params
+ :query query :payload payload :headers headers
+ :silent silent :unpaginate unpaginate
+ :noerror noerror :reader reader
+ :username username :auth auth :host host
+ :callback callback :errorback errorback :extra extra))
+
+(cl-defun ghub-post (resource &optional params
+ &key query payload headers
+ silent unpaginate noerror reader
+ username auth host
+ callback errorback extra)
+ "Make a `POST' request for RESOURCE, with optional payload PARAMS.
+Like calling `ghub-request' (which see) with \"POST\" as METHOD."
+ (ghub-request "POST" resource params
+ :query query :payload payload :headers headers
+ :silent silent :unpaginate unpaginate
+ :noerror noerror :reader reader
+ :username username :auth auth :host host
+ :callback callback :errorback errorback :extra extra))
+
+(cl-defun ghub-patch (resource &optional params
+ &key query payload headers
+ silent unpaginate noerror reader
+ username auth host
+ callback errorback extra)
+ "Make a `PATCH' request for RESOURCE, with optional payload PARAMS.
+Like calling `ghub-request' (which see) with \"PATCH\" as METHOD."
+ (ghub-request "PATCH" resource params
+ :query query :payload payload :headers headers
+ :silent silent :unpaginate unpaginate
+ :noerror noerror :reader reader
+ :username username :auth auth :host host
+ :callback callback :errorback errorback :extra extra))
+
+(cl-defun ghub-delete (resource &optional params
+ &key query payload headers
+ silent unpaginate noerror reader
+ username auth host
+ callback errorback extra)
+ "Make a `DELETE' request for RESOURCE, with optional payload PARAMS.
+Like calling `ghub-request' (which see) with \"DELETE\" as METHOD."
+ (ghub-request "DELETE" resource params
+ :query query :payload payload :headers headers
+ :silent silent :unpaginate unpaginate
+ :noerror noerror :reader reader
+ :username username :auth auth :host host
+ :callback callback :errorback errorback :extra extra))
+
+(cl-defun ghub-request (method resource &optional params
+ &key query payload headers
+ silent unpaginate noerror reader
+ username auth host forge
+ callback errorback value extra)
+ "Make a request for RESOURCE and return the response body.
+
+Also place the response headers in `ghub-response-headers'.
+
+METHOD is the HTTP method, given as a string.
+RESOURCE is the resource to access, given as a string beginning
+ with a slash.
+
+PARAMS, QUERY, PAYLOAD and HEADERS are alists used to specify
+ data. The Github API documentation is vague on how data has
+ to be transmitted and for a particular resource usually just
+ talks about \"parameters\". Generally speaking when the METHOD
+ is \"HEAD\" or \"GET\", then they have to be transmitted as a
+ query, otherwise as a payload.
+Use PARAMS to automatically transmit like QUERY or PAYLOAD would
+ depending on METHOD.
+Use QUERY to explicitly transmit data as a query.
+Use PAYLOAD to explicitly transmit data as a payload.
+ Instead of an alist, PAYLOAD may also be a string, in which
+ case it gets encoded as UTF-8 but is otherwise transmitted as-is.
+Use HEADERS for those rare resources that require that the data
+ is transmitted as headers instead of as a query or payload.
+ When that is the case, then the API documentation usually
+ mentions it explicitly.
+
+If SILENT is non-nil, then don't message progress reports and
+ the like.
+
+If UNPAGINATE is t, then make as many requests as necessary to
+ get all values. If UNPAGINATE is a natural number, then get
+ at most that many pages. For any other non-nil value raise
+ an error.
+If NOERROR is non-nil, then do not raise an error if the request
+ fails and return nil instead. If NOERROR is `return', then
+ return the error payload instead of nil.
+If READER is non-nil, then it is used to read and return from the
+ response buffer. The default is `ghub--read-json-payload'.
+ For the very few resources that do not return JSON, you might
+ want to use `ghub--decode-payload'.
+
+If USERNAME is non-nil, then make a request on behalf of that
+ user. It is better to specify the user using the Git variable
+ `github.user' for \"api.github.com\", or `github.HOST.user' if
+ connecting to a Github Enterprise instance.
+
+Each package that uses `ghub' should use its own token. If AUTH
+ is nil, then the generic `ghub' token is used instead. This
+ is only acceptable for personal utilities. A packages that
+ is distributed to other users should always use this argument
+ to identify itself, using a symbol matching its name.
+
+ Package authors who find this inconvenient should write a
+ wrapper around this function and possibly for the
+ method-specific functions as well.
+
+ Some symbols have a special meaning. `none' means to make an
+ unauthorized request. `basic' means to make a password based
+ request. If the value is a string, then it is assumed to be
+ a valid token. `basic' and an explicit token string are only
+ intended for internal and debugging uses.
+
+If HOST is non-nil, then connect to that Github instance. This
+ defaults to \"api.github.com\". When a repository is connected
+ to a Github Enterprise instance, then it is better to specify
+ that using the Git variable `github.host' instead of using this
+ argument.
+
+If FORGE is `gitlab', then connect to Gitlab.com or, depending
+ on HOST, to another Gitlab instance. This is only intended for
+ internal use. Instead of using this argument you should use
+ function `glab-request' and other `glab-*' functions.
+
+If CALLBACK and/or ERRORBACK is non-nil, then make one or more
+ asynchronous requests and call CALLBACK or ERRORBACK when
+ finished. If no error occurred, then call CALLBACK, unless
+ that is nil.
+
+ If an error occurred, then call ERRORBACK, or if that is nil,
+ then CALLBACK. ERRORBACK can also be t, in which case an error
+ is signaled instead. NOERROR is ignored for all asynchronous
+ requests.
+
+Both callbacks are called with four arguments.
+ 1. For CALLBACK, the combined value of the retrieved pages.
+ For ERRORBACK, the error that occurred when retrieving the
+ last page.
+ 2. The headers of the last page as an alist.
+ 3. Status information provided by `url-retrieve'. Its `:error'
+ property holds the same information as ERRORBACK's first
+ argument.
+ 4. A `ghub--req' struct, which can be passed to `ghub-continue'
+ (which see) to retrieve the next page, if any."
+ (cl-assert (or (booleanp unpaginate) (natnump unpaginate)))
+ (unless (string-prefix-p "/" resource)
+ (setq resource (concat "/" resource)))
+ (unless host
+ (setq host (ghub--host forge)))
+ (unless (or username (stringp auth) (eq auth 'none))
+ (setq username (ghub--username host forge)))
+ (cond ((not params))
+ ((member method '("GET" "HEAD"))
+ (when query
+ (error "PARAMS and QUERY are mutually exclusive for METHOD %S"
+ method))
+ (setq query params))
+ (t
+ (when payload
+ (error "PARAMS and PAYLOAD are mutually exclusive for METHOD %S"
+ method))
+ (setq payload params)))
+ (when (or callback errorback)
+ (setq noerror t))
+ (ghub--retrieve
+ (ghub--encode-payload payload)
+ (ghub--make-req
+ :url (url-generic-parse-url
+ (concat (if (member host ghub-insecure-hosts) "http://" "https://")
+ (cond ((and (equal resource "/graphql")
+ (string-suffix-p "/v3" host))
+ ;; Needed for some Github Enterprise instances.
+ (substring host 0 -3))
+ ((and (equal resource "/api/graphql")
+ (string-suffix-p "/api/v4" host))
+ ;; Needed for all Gitlab instances.
+ (substring host 0 -7))
+ (host))
+ resource
+ (and query (concat "?" (ghub--url-encode-params query)))))
+ :forge forge
+ :silent silent
+ ;; Encode in case caller used (symbol-name 'GET). #35
+ :method (encode-coding-string method 'utf-8)
+ :headers (ghub--headers headers host auth username forge)
+ :handler #'ghub--handle-response
+ :unpaginate unpaginate
+ :noerror noerror
+ :reader reader
+ :callback callback
+ :errorback errorback
+ :value value
+ :extra extra)))
+
+(defun ghub-continue (req)
+ "If there is a next page, then retrieve that.
+
+This function is only intended to be called from callbacks. If
+there is a next page, then retrieve that and return the buffer
+that the result will be loaded into, or t if the process has
+already completed. If there is no next page, then return nil.
+
+Callbacks are called with four arguments (see `ghub-request').
+The forth argument is a `ghub--req' struct, intended to be passed
+to this function. A callback may use the struct's `extra' slot
+to pass additional information to the callback that will be
+called after the next request has finished. Use the function
+`ghub-req-extra' to get and set the value of this slot."
+ (and (assq 'next (ghub-response-link-relations req))
+ (or (ghub--retrieve nil req) t)))
+
+(cl-defun ghub-wait (resource &optional duration
+ &key username auth host forge)
+ "Busy-wait up to DURATION seconds for RESOURCE to become available.
+
+DURATION specifies how many seconds to wait at most. It defaults
+to 64 seconds. The first attempt is made immediately, the second
+after two seconds, and each subsequent attempt is made after
+waiting as long again as we already waited between all preceding
+attempts combined.
+
+See `ghub-request' for information about the other arguments."
+ (unless duration
+ (setq duration 64))
+ (with-local-quit
+ (let ((total 0))
+ (while (not (ghub-request "GET" resource nil
+ :noerror t
+ :username username
+ :auth auth
+ :host host
+ :forge forge))
+ (message "Waited (%3ss of %ss) for %s..." total duration resource)
+ (if (= total duration)
+ (error "%s is taking too long to create %s"
+ (if forge (capitalize (symbol-name forge)) "Github")
+ resource)
+ (if (> total 0)
+ (let ((wait (min total (- duration total))))
+ (sit-for wait)
+ (cl-incf total wait))
+ (sit-for (setq total 2))))))))
+
+(defun ghub-response-link-relations (req &optional headers payload)
+ "Return an alist of link relations in HEADERS.
+If optional HEADERS is nil, then return those that were
+previously stored in the variable `ghub-response-headers'.
+
+When accessing a Bitbucket instance then the link relations
+are in PAYLOAD instead of HEADERS, making their API merely
+RESTish and forcing this function to append those relations
+to the value of `ghub-response-headers', for later use when
+this function is called with nil for PAYLOAD."
+ (if (eq (ghub--req-forge req) 'bitbucket)
+ (if payload
+ (let* ((page (cl-mapcan (lambda (key)
+ (and-let* ((elt (assq key payload)))
+ (list elt)))
+ '(size page pagelen next previous)))
+ (headers (cons (cons 'link-alist page) headers)))
+ (if (and req (or (ghub--req-callback req)
+ (ghub--req-errorback req)))
+ (setq-local ghub-response-headers headers)
+ (setq-default ghub-response-headers headers))
+ page)
+ (cdr (assq 'link-alist ghub-response-headers)))
+ (and-let* ((rels (cdr (assoc "Link" (or headers ghub-response-headers)))))
+ (mapcar (lambda (elt)
+ (pcase-let ((`(,url ,rel) (split-string elt "; ")))
+ (cons (intern (substring rel 5 -1))
+ (substring url 1 -1))))
+ (split-string rels ", ")))))
+
+(cl-defun ghub-repository-id (owner name &key username auth host forge noerror)
+ "Return the id of the specified repository.
+Signal an error if the id cannot be determined."
+ (let ((fn (cl-case forge
+ ((nil ghub github) #'ghub--repository-id)
+ (gitlab #'glab-repository-id)
+ (gitea #'gtea-repository-id)
+ (gogs #'gogs-repository-id)
+ (bitbucket #'buck-repository-id)
+ (t (intern (format "%s-repository-id" forge))))))
+ (unless (fboundp fn)
+ (error "ghub-repository-id: Forge type/abbreviation `%s' is unknown"
+ forge))
+ (or (funcall fn owner name :username username :auth auth :host host)
+ (and (not noerror)
+ (error "Repository %S does not exist on %S.\n%s%S?"
+ (concat owner "/" name)
+ (or host (ghub--host forge))
+ "Maybe it was renamed and you have to update "
+ "remote.<remote>.url")))))
+
+;;;; Internal
+
+(defvar ghub-use-workaround-for-emacs-bug t
+ "Whether to work around Emacs bug debbugs#34341.
+
+First see https://github.com/magit/ghub/wiki/Known-Issues,
+for information about this bug and another related bug.
+
+Because our under of these bugs evolved over time, the possible
+values of this variable are a bit odd: If t, enable workaround if
+necessary (i.e., if Emacs < 26.3 and GnuTLS >= 3.6.3 are used).
+If `force', enable workaround even if that is believed to be
+unnecessary. If nil, do not enable the workaround. The default
+is t.")
+
+(defvar ghub-use-workaround-for-emacs-bug-54989 t
+ "Whether to work around Emacs bug debbugs#54989.
+
+First see https://github.com/magit/ghub/wiki/Known-Issues,
+for information about this bug and another related bug.
+
+If t, work around the bug if necessary (i.e., if not using Emacs'
+\"master\" branch). If nil, then don't work around the bug. The
+default is t. Setting this variable only has an effect if it is
+done before `ghub' is loaded.")
+
+(cl-defun ghub--retrieve (payload req)
+ (let ((url-request-extra-headers
+ (let ((headers (ghub--req-headers req)))
+ (if (functionp headers) (funcall headers) headers)))
+ (url-request-method (ghub--req-method req))
+ (url-request-data payload)
+ (url-show-status nil)
+ (url (ghub--req-url req))
+ (handler (ghub--req-handler req))
+ (silent (ghub--req-silent req))
+ (gnutls-algorithm-priority
+ (if (and ghub-use-workaround-for-emacs-bug
+ (or (eq ghub-use-workaround-for-emacs-bug 'force)
+ (and (not gnutls-algorithm-priority)
+ (>= libgnutls-version 30603)
+ (version< emacs-version "26.3")
+ ;; (memq (ghub--req-forge req) '(github nil))
+ )))
+ "NORMAL:-VERS-TLS1.3"
+ gnutls-algorithm-priority)))
+ (if (or (ghub--req-callback req)
+ (ghub--req-errorback req))
+ (url-retrieve url handler (list req) silent)
+ (with-current-buffer
+ (url-retrieve-synchronously url silent)
+ (funcall handler (car url-callback-arguments) req)))))
+
+(defun ghub--handle-response (status req)
+ (let ((buffer (current-buffer)))
+ (unwind-protect
+ (progn
+ (set-buffer-multibyte t)
+ (let* ((unpaginate (ghub--req-unpaginate req))
+ (headers (ghub--handle-response-headers status req))
+ (payload (ghub--handle-response-payload req))
+ (payload (ghub--handle-response-error status payload req))
+ (value (ghub--handle-response-value payload req))
+ (prev (ghub--req-url req))
+ (next (cdr (assq 'next (ghub-response-link-relations
+ req headers payload)))))
+ (when (numberp unpaginate)
+ (cl-decf unpaginate))
+ (setf (ghub--req-url req)
+ (url-generic-parse-url next))
+ (setf (ghub--req-unpaginate req) unpaginate)
+ (or (and next
+ unpaginate
+ (or (eq unpaginate t)
+ (> unpaginate 0))
+ (ghub-continue req))
+ (let ((callback (ghub--req-callback req))
+ (errorback (ghub--req-errorback req))
+ (err (plist-get status :error)))
+ (cond ((and err errorback)
+ (setf (ghub--req-url req) prev)
+ (funcall (if (eq errorback t)
+ 'ghub--errorback
+ errorback)
+ err headers status req))
+ (callback
+ (funcall callback value headers status req))
+ (t value))))))
+ (when (buffer-live-p buffer)
+ (kill-buffer buffer)))))
+
+(defun ghub--handle-response-headers (_status req)
+ (goto-char (point-min))
+ (forward-line 1)
+ (let (headers)
+ (when (memq url-http-end-of-headers '(nil 0))
+ (setq url-debug t)
+ (error "BUG: missing headers; but there's a patch for that \
+see https://github.com/magit/ghub/wiki/Known-Issues"))
+ (while (re-search-forward "^\\([^:]*\\): \\(.+\\)"
+ url-http-end-of-headers t)
+ (push (cons (match-string 1)
+ (match-string 2))
+ headers))
+ (setq headers (nreverse headers))
+ (goto-char (1+ url-http-end-of-headers))
+ (if (and req (or (ghub--req-callback req)
+ (ghub--req-errorback req)))
+ (setq-local ghub-response-headers headers)
+ (setq-default ghub-response-headers headers))
+ headers))
+
+(defun ghub--handle-response-error (status payload req)
+ (let ((noerror (ghub--req-noerror req))
+ (err (plist-get status :error)))
+ (if err
+ (if noerror
+ (if (eq noerror 'return)
+ payload
+ (setcdr (last err) (list payload))
+ nil)
+ (ghub--signal-error err payload req))
+ payload)))
+
+(defun ghub--signal-error (err &optional payload req)
+ (pcase-let ((`(,symb . ,data) err))
+ (if (eq symb 'error)
+ (if (eq (car-safe data) 'http)
+ (signal 'ghub-http-error
+ (let ((code (car (cdr-safe data))))
+ (list code
+ (nth 2 (assq code url-http-codes))
+ (and req (url-filename (ghub--req-url req)))
+ payload)))
+ (signal 'ghub-error data))
+ (signal symb data))))
+
+(defun ghub--errorback (err _headers _status req)
+ (ghub--signal-error err (nth 3 err) req))
+
+(defun ghub--handle-response-value (payload req)
+ (setf (ghub--req-value req)
+ (nconc (ghub--req-value req)
+ (if-let ((nested (and (eq (ghub--req-forge req) 'bitbucket)
+ (assq 'values payload))))
+ (cdr nested)
+ payload))))
+
+(defun ghub--handle-response-payload (req)
+ (funcall (or (ghub--req-reader req)
+ 'ghub--read-json-payload)
+ url-http-response-status))
+
+(defun ghub--read-json-payload (_status)
+ (let ((raw (ghub--decode-payload)))
+ (and raw
+ (condition-case nil
+ (if (and ghub-json-use-jansson
+ (fboundp 'json-parse-string))
+ (json-parse-string
+ raw
+ :object-type ghub-json-object-type
+ :array-type ghub-json-array-type
+ :false-object nil
+ :null-object nil)
+ (require 'json)
+ (let ((json-object-type ghub-json-object-type)
+ (json-array-type ghub-json-array-type)
+ (json-false nil)
+ (json-null nil))
+ (json-read-from-string raw)))
+ ((json-parse-error json-readtable-error)
+ `((message
+ . ,(if (looking-at "<!DOCTYPE html>")
+ (if (re-search-forward
+ "<p>\\(?:<strong>\\)?\\([^<]+\\)" nil t)
+ (match-string 1)
+ "error description missing")
+ (string-trim (buffer-substring (point) (point-max)))))
+ (documentation_url
+ . "https://github.com/magit/ghub/wiki/Github-Errors")))))))
+
+(defun ghub--decode-payload (&optional _status)
+ (and (not (eobp))
+ (decode-coding-string
+ (buffer-substring-no-properties (point) (point-max))
+ 'utf-8)))
+
+(defun ghub--encode-payload (payload)
+ (and payload
+ (progn
+ (unless (stringp payload)
+ (setq payload
+ (if (and ghub-json-use-jansson
+ (fboundp 'json-serialize))
+ (json-serialize payload
+ ;; :object-type and :array-type
+ ;; are not supported here.
+ :false-object nil
+ :null-object :null)
+ (require 'json)
+ (let ((json-object-type ghub-json-object-type)
+ (json-array-type ghub-json-array-type)
+ (json-false nil)
+ (json-null :null))
+ ;; Unfortunately `json-encode' may modify the input.
+ ;; See https://debbugs.gnu.org/cgi/bugreport.cgi?bug=40693.
+ ;; and https://github.com/magit/forge/issues/267
+ (json-encode (copy-tree payload))))))
+ (encode-coding-string payload 'utf-8))))
+
+(defun ghub--url-encode-params (params)
+ (mapconcat (lambda (param)
+ (pcase-let ((`(,key . ,val) param))
+ (concat (url-hexify-string (symbol-name key)) "="
+ (cl-typecase val
+ (integer (number-to-string val))
+ (boolean (if val "true" "false"))
+ (t (url-hexify-string val))))))
+ params "&"))
+
+;;; Authentication
+;;;; API
+
+;;;###autoload
+(defun ghub-clear-caches ()
+ "Clear all caches that might negatively affect Ghub.
+
+If a library that is used by Ghub caches incorrect information
+such as a mistyped password, then that can prevent Ghub from
+asking the user for the correct information again.
+
+Set `url-http-real-basic-auth-storage' to nil
+and call `auth-source-forget+'."
+ (interactive)
+ (setq url-http-real-basic-auth-storage nil)
+ (auth-source-forget+))
+
+;;;; Internal
+
+(defun ghub--headers (headers host auth username forge)
+ (push (cons "Content-Type" "application/json") headers)
+ (if (eq auth 'none)
+ headers
+ (unless (or username (stringp auth))
+ (setq username (ghub--username host forge)))
+ (lambda ()
+ (if (eq auth 'basic)
+ (cons (cons "Authorization" (ghub--basic-auth host username))
+ headers)
+ (cons (ghub--auth host auth username forge) headers)))))
+
+(cl-defgeneric ghub--auth (host auth &optional username forge)
+ (unless username
+ (setq username (ghub--username host forge)))
+ (if (eq auth 'basic)
+ (cl-ecase forge
+ ((nil gitea gogs bitbucket)
+ (cons "Authorization" (ghub--basic-auth host username)))
+ ((github gitlab)
+ (error "%s does not support basic authentication"
+ (capitalize (symbol-name forge)))))
+ (cons (cl-ecase forge
+ ((nil github gitea gogs bitbucket)
+ "Authorization")
+ (gitlab
+ "Private-Token"))
+ (if (eq forge 'bitbucket)
+ ;; For some undocumented reason Bitbucket supports
+ ;; values of the form "token <token>" only for GET
+ ;; requests. For PUT requests we have to use basic
+ ;; authentication. Note that the secret is a token
+ ;; (aka "app password"), not the actual password.
+ ;; The documentation fails to mention this little
+ ;; detail. See #97.
+ (concat "Basic "
+ (base64-encode-string
+ (concat username ":"
+ (ghub--token host username auth nil forge))
+ t))
+ (concat
+ (and (not (eq forge 'gitlab)) "token ")
+ (encode-coding-string
+ (cl-typecase auth
+ (string auth)
+ (null (ghub--token host username 'ghub nil forge))
+ (symbol (ghub--token host username auth nil forge))
+ (t (signal 'wrong-type-argument
+ `((or stringp symbolp) ,auth))))
+ 'utf-8))))))
+
+(defun ghub--basic-auth (host username)
+ (let ((url (url-generic-parse-url
+ (if (member host ghub-insecure-hosts) "http://" "https://"))))
+ (setf (url-user url) username)
+ (url-basic-auth url t)))
+
+(defun ghub--token (host username package &optional nocreate forge)
+ (let* ((user (ghub--ident username package))
+ (token
+ (or (car (ghub--auth-source-get (list :secret)
+ :host host :user user))
+ (progn
+ ;; Auth-Source caches the information that there is no
+ ;; value, but in our case that is a situation that needs
+ ;; fixing so we want to keep trying by invalidating that
+ ;; information.
+ ;; The (:max 1) is needed and has to be placed at the
+ ;; end for Emacs releases before 26.1. #24 #64 #72
+ (auth-source-forget (list :host host :user user :max 1))
+ (and (not nocreate)
+ (error "\
+Required %s token (\"%s\" for \"%s\") does not exist.
+See https://magit.vc/manual/ghub/Getting-Started.html
+or (info \"(ghub)Getting Started\") for instructions.
+\(The setup wizard no longer exists.)"
+ (capitalize (symbol-name (or forge 'github)))
+ user host))))))
+ (if (functionp token) (funcall token) token)))
+
+(cl-defgeneric ghub--host (&optional forge)
+ (cl-ecase forge
+ ((nil github)
+ (or (ignore-errors (car (process-lines "git" "config" "github.host")))
+ ghub-default-host))
+ (gitlab
+ (or (ignore-errors (car (process-lines "git" "config" "gitlab.host")))
+ (bound-and-true-p glab-default-host)))
+ (gitea
+ (or (ignore-errors (car (process-lines "git" "config" "gitea.host")))
+ (bound-and-true-p gtea-default-host)))
+ (gogs
+ (or (ignore-errors (car (process-lines "git" "config" "gogs.host")))
+ (bound-and-true-p gogs-default-host)))
+ (bitbucket
+ (or (ignore-errors (car (process-lines "git" "config" "bitbucket.host")))
+ (bound-and-true-p buck-default-host)))))
+
+(cl-defgeneric ghub--username (host &optional forge)
+ (let ((var
+ (cl-ecase forge
+ ((nil github)
+ (if (equal host ghub-default-host)
+ "github.user"
+ (format "github.%s.user" host)))
+ (gitlab
+ (if (equal host "gitlab.com/api/v4")
+ "gitlab.user"
+ (format "gitlab.%s.user" host)))
+ (bitbucket
+ (if (equal host "api.bitbucket.org/2.0")
+ "bitbucket.user"
+ (format "bitbucket.%s.user" host)))
+ (gitea
+ (when (zerop (call-process "git" nil nil nil "config" "gitea.host"))
+ (error "gitea.host is set but always ignored"))
+ (format "gitea.%s.user" host))
+ (gogs
+ (when (zerop (call-process "git" nil nil nil "config" "gogs.host"))
+ (error "gogs.host is set but always ignored"))
+ (format "gogs.%s.user" host)))))
+ (condition-case nil
+ (car (process-lines "git" "config" var))
+ (error
+ (let ((user (read-string
+ (format "Git variable `%s' is unset. Set to: " var))))
+ (if (equal user "")
+ (user-error "The empty string is not a valid username")
+ (call-process
+ "git" nil nil nil "config"
+ (if (eq (read-char-choice
+ (format "Set %s=%s [g]lobally (recommended) or [l]ocally? "
+ var user)
+ (list ?g ?l))
+ ?g)
+ "--global"
+ "--local")
+ var user)
+ user))))))
+
+(defun ghub--ident (username package)
+ (format "%s^%s" username package))
+
+(defun ghub--auth-source-get (keys &rest spec)
+ (declare (indent 1))
+ (let ((plist (car (apply #'auth-source-search
+ (append spec (list :max 1))))))
+ (mapcar (lambda (k)
+ (plist-get plist k))
+ keys)))
+
+(when (version< emacs-version "26.2")
+ ;; Fixed by Emacs commit 60ff8101449eea3a5ca4961299501efd83d011bd.
+ (advice-add 'auth-source-netrc-parse-next-interesting :around
+ 'auth-source-netrc-parse-next-interesting@save-match-data)
+ (defun auth-source-netrc-parse-next-interesting@save-match-data (fn)
+ "Save match-data for the benefit of caller `auth-source-netrc-parse-one'.
+Without wrapping this function in `save-match-data' the caller
+won't see the secret from a line that is followed by a commented
+line."
+ (save-match-data (funcall fn))))
+
+(when (< emacs-major-version 28)
+ ;; Fixed by Emacs commit 0b98ea5fbe276c67206896dca111c000f984ee0f.
+ (advice-add 'url-http-handle-authentication :around
+ 'url-http-handle-authentication@unauthorized-bugfix)
+ (defun url-http-handle-authentication@unauthorized-bugfix (fn proxy)
+ "If authorization failed then don't try again but fail properly.
+For Emacs 27.1 prevent a useful `http' error from being replaced
+by a generic one that omits all useful information. For earlier
+releases prevent a new request from being made, which would
+either result in an infinite loop or (e.g. in the case of `ghub')
+the user being asked for their name."
+ (if (assoc "Authorization" url-http-extra-headers)
+ t ; Return "success", here also known as "successfully failed".
+ (funcall fn proxy))))
+
+(when (and (< emacs-major-version 29)
+ ghub-use-workaround-for-emacs-bug-54989)
+ ;; Fixed in Emacs commit 0829c6836eff14dda0cf8b3047376967f7b000f4.
+ ;; Cleanup from 26faa2b943675107e1664b2fea7174137c473475 is not
+ ;; included in this copy because doing that would require changes
+ ;; to more functions. This function has seen a few other changes
+ ;; since Emacs 25.1, the oldest version we still support. Of these
+ ;; only 4f1df40db36b221e7842bd75d6281922dcb268ee makes a functional
+ ;; change, fixing debbug#35658. The first release to contain that
+ ;; commit is 27.1. That commit either fixes a related bug or it
+ ;; deals with the same bug but only partially fixes it.
+ (advice-add 'url-http-chunked-encoding-after-change-function :override
+ 'url-http-chunked-encoding-after-change-function@54989-backport)
+ (defvar url-http-chunked-last-crlf-missing nil)
+ (defvar url-http-content-type)
+ (defvar url-http-chunked-start)
+ (defvar url-http-chunked-length)
+ (defvar url-http-chunked-counter)
+ (defun url-http-chunked-encoding-after-change-function@54989-backport
+ (st nd length)
+ "Backport bugfix from https://debbugs.gnu.org/cgi/bugreport.cgi?bug=54989."
+ (if url-http-chunked-last-crlf-missing
+ (progn
+ (goto-char url-http-chunked-last-crlf-missing)
+ (if (not (looking-at "\r\n"))
+ (url-http-debug
+ "Still spinning for the terminator of last chunk...")
+ (url-http-debug "Saw the last CRLF.")
+ (delete-region (match-beginning 0) (match-end 0))
+ (when (url-http-parse-headers)
+ (url-http-activate-callback))))
+ (save-excursion
+ (goto-char st)
+ (let ((read-next-chunk t)
+ (case-fold-search t)
+ (regexp nil)
+ (no-initial-crlf nil))
+ ;; We need to loop thru looking for more chunks even within
+ ;; one after-change-function call.
+ (while read-next-chunk
+ (setq no-initial-crlf (= 0 url-http-chunked-counter))
+ (with-no-warnings
+ (if url-http-content-type
+ (url-display-percentage nil
+ "Reading [%s]... chunk #%d"
+ url-http-content-type url-http-chunked-counter)
+ (url-display-percentage nil
+ "Reading... chunk #%d"
+ url-http-chunked-counter)))
+ (url-http-debug "Reading chunk %d (%d %d %d)"
+ url-http-chunked-counter st nd length)
+ (setq regexp (if no-initial-crlf
+ "\\([0-9a-z]+\\).*\r?\n"
+ "\r?\n\\([0-9a-z]+\\).*\r?\n"))
+
+ (if url-http-chunked-start
+ ;; We know how long the chunk is supposed to be, skip over
+ ;; leading crap if possible.
+ (if (> nd (+ url-http-chunked-start url-http-chunked-length))
+ (progn
+ (url-http-debug "Got to the end of chunk #%d!"
+ url-http-chunked-counter)
+ (goto-char (+ url-http-chunked-start
+ url-http-chunked-length)))
+ (url-http-debug "Still need %d bytes to hit end of chunk"
+ (- (+ url-http-chunked-start
+ url-http-chunked-length)
+ nd))
+ (setq read-next-chunk nil)))
+ (if (not read-next-chunk)
+ (url-http-debug "Still spinning for next chunk...")
+ (if no-initial-crlf (skip-chars-forward "\r\n"))
+ (if (not (looking-at regexp))
+ (progn
+ ;; Must not have received the entirety of the chunk header,
+ ;; need to spin some more.
+ (url-http-debug "Did not see start of chunk @ %d!" (point))
+ (setq read-next-chunk nil))
+ ;; The data we got may have started in the middle of the
+ ;; initial chunk header, so move back to the start of the
+ ;; line and re-compute.
+ (when (= url-http-chunked-counter 0)
+ (beginning-of-line)
+ (looking-at regexp))
+ (add-text-properties (match-beginning 0) (match-end 0)
+ (list 'chunked-encoding t
+ 'face 'cursor
+ 'invisible t))
+ (setq url-http-chunked-length
+ (string-to-number (buffer-substring (match-beginning 1)
+ (match-end 1))
+ 16)
+ url-http-chunked-counter (1+ url-http-chunked-counter)
+ url-http-chunked-start (set-marker
+ (or url-http-chunked-start
+ (make-marker))
+ (match-end 0)))
+ (delete-region (match-beginning 0) (match-end 0))
+ (url-http-debug "Saw start of chunk %d (length=%d, start=%d"
+ url-http-chunked-counter url-http-chunked-length
+ (marker-position url-http-chunked-start))
+ (if (= 0 url-http-chunked-length)
+ (progn
+ ;; Found the end of the document! Wheee!
+ (url-http-debug "Saw end of stream chunk!")
+ (setq read-next-chunk nil)
+ (with-no-warnings
+ (url-display-percentage nil nil))
+ ;; Every chunk, even the last 0-length one, is
+ ;; terminated by CRLF. Skip it.
+ (if (not (looking-at "\r?\n"))
+ (progn
+ (url-http-debug
+ "Spinning for the terminator of last chunk...")
+ (setq-local url-http-chunked-last-crlf-missing
+ (point)))
+ (url-http-debug "Removing terminator of last chunk")
+ (delete-region (match-beginning 0) (match-end 0))
+ (when (re-search-forward "^\r?\n" nil t)
+ (url-http-debug "Saw end of trailers..."))
+ (when (url-http-parse-headers)
+ (url-http-activate-callback)))))))))))))
+
+;;; _
+(provide 'ghub)
+(require 'ghub-graphql)
+;;; ghub.el ends here
--- /dev/null
+This is ghub.info, produced by makeinfo version 6.7 from ghub.texi.
+
+ Copyright (C) 2017-2023 Jonas Bernoulli <jonasNOSPAMbernoul.li>
+
+ 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.
+
+INFO-DIR-SECTION Emacs
+START-INFO-DIR-ENTRY
+* Ghub: (ghub). Client library for the Github API.
+END-INFO-DIR-ENTRY
+
+\1f
+File: ghub.info, Node: Top, Next: Introduction, Up: (dir)
+
+Ghub User and Developer Manual
+******************************
+
+Ghub is an Emacs library that is used by various packages to access the
+APIs of various instances of various Git forge implementations.
+
+This manual is for Ghub version 3.5.6.50-git.
+
+ Copyright (C) 2017-2023 Jonas Bernoulli <jonasNOSPAMbernoul.li>
+
+ 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.
+
+* Menu:
+
+* Introduction::
+* Getting Started::
+* API::
+* Notes::
+* Function Index::
+* Variable Index::
+
+— The Detailed Node Listing —
+
+Getting Started
+
+* Basic Concepts, Arguments and Variables: Basic Concepts Arguments and Variables.
+* Setting the Username::
+* Creating and Storing a Token::
+* Github Configuration Variables::
+
+Creating and Storing a Token
+
+* Creating a Token::
+* Storing a Token::
+
+
+API
+
+* Their APIs::
+* Making REST Requests::
+* Making GraphQL Requests::
+* Github Convenience Wrappers::
+* Non-Github Convenience Wrappers::
+
+Notes
+
+* Using Ghub in Personal Scripts::
+* Using Ghub in Your Own Package::
+* Forge Limitations and Notes::
+
+
+\1f
+File: ghub.info, Node: Introduction, Next: Getting Started, Prev: Top, Up: Top
+
+1 Introduction
+**************
+
+Ghub is an Emacs library that is used by various packages to access the
+APIs of various instances of various Git forge implementations.
+
+ A forge is a web-based collaborative software platform for developing
+and distributing computer applications. Examples include Github and
+Gitlab.
+
+\1f
+File: ghub.info, Node: Getting Started, Next: API, Prev: Introduction, Up: Top
+
+2 Getting Started
+*****************
+
+This manual guides you through the steps that are necessary to use the
+Forge package and/or to make a request using just Ghub itself, such as
+this:
+
+ (ghub-request "GET" "/user")
+
+ To be able to do that, Ghub needs to know who you want to talk to,
+who you are, and how you are going to prove the latter to the former.
+
+ Additionally Ghub wants to know on behalf of which Emacs package it
+is making a request. So the question of "who is making the request" has
+to be rephrased as "which human (or bot) is using what (Emacs) package
+to make the request". If for example, the human known as "tarsius" is
+using the ‘forge’ package, then that is represented in some places using
+the string "tarsius^forge".
+
+ This package used to attempt to get the answers to these questions
+using a setup wizard. Unfortunately that had to be removed because (a)
+it only ever supported Github, (b) by now Github has removed support for
+that on their end, (c) it did not always work, and (d) when it couldn’t
+be used, or failed, then it made things _more_ complicated.
+
+ So now it is necessary for users to read some documentation and
+because many things can go wrong, those instructions have to be fairly
+detailed. You can of course skip over most of this, but if things go
+wrong, then I would like to kindly request that you take another look
+before asking me for help.
+
+* Menu:
+
+* Basic Concepts, Arguments and Variables: Basic Concepts Arguments and Variables.
+* Setting the Username::
+* Creating and Storing a Token::
+* Github Configuration Variables::
+
+\1f
+File: ghub.info, Node: Basic Concepts Arguments and Variables, Next: Setting the Username, Up: Getting Started
+
+2.1 Basic Concepts, Arguments and Variables
+===========================================
+
+Originally Ghub supported only Github but now it also supports Gitlab,
+Gitea, Gogs and Bitbucket. For the historic reason just given, the
+function ‘ghub-request’ defaults to acting on a ‘github’ forge, but can
+be told to act on another forge using the FORGE argument.
+
+ The FORGE argument only specifies what kind of forge to act on, not
+which instance. The HOST argument can be used to select the instance.
+For some forges a default instance is defined:
+
+ • Forge ‘github’ defaults to host ‘api.github.com’.
+ • Forge ‘gitlab’ defaults to host ‘gitlab.com/api/v4’.
+ • Forge ‘bitbucket’ defaults to host ‘api.bitbucket.org/2.0’.
+ • No canonical host exists for the ‘gitea’ and ‘gogs’ forges and
+ ‘localhost:3000/api/v1’ is used as the default host in both cases.
+
+ Together the FORGE and HOST arguments specify the forge type and
+instance. In addition to that, it is also necessary to specify on whose
+behalf the request is being made, which can be done using the USERNAME
+and AUTH arguments. For example:
+
+ (ghub-request "GET" "/user" nil
+ :forge 'github
+ :host "api.github.com"
+ :username "tarsius"
+ :auth 'forge)
+
+ Having to specify these arguments for every request is inconvenient.
+Additional variables and convenience functions can be used to make that
+unnecessary in most cases.
+
+ (But for debugging purposes the above explicit form is very useful.
+You will obviously have to change the value of USERNAME and you should
+use ‘ghub’ as AUTH when first trying this at home.)
+
+ These variables can be set globally and/or for a specific repository.
+
+ • For "api.github.com" (aka the API of <https://github.com>) the Git
+ variable ‘github.user’ specifies the user.
+ • For another ‘github’ instance the Git variable ‘github.HOST.user’
+ specifies the user. The HOST in that variable name is the same as
+ the value of the HOST argument of the called function.
+ • Instead of specifying the HOST in every function call, the Git
+ variable ‘github.host’ can be used. This should only be set
+ locally.
+
+ These ‘github’ specific variables are discussed in more detail in
+*note Github Configuration Variables::.
+
+For ‘gitlab’ and ‘bitbucket’ forges similar variables are available:
+
+ • ‘gitlab.user’ specifies the <https://gitlab.com> user.
+ • ‘gitlab.HOST.user’ specifies the user for the HOST ‘gitlab’
+ instance.
+ • ‘gitlab.host’ specifies the ‘gitlab’ host, unless the HOST argument
+ is non-nil
+ • ‘bitbucket.user’ specifies the <https://bitbucket.org> user.
+ • ‘bitbucket.HOST.user’ specifies the user for the HOST ‘bitbucket’
+ instance.
+ • ‘bitbucket.host’ specifies the ‘bitbucket’ host, unless the HOST
+ argument is non-nil.
+
+ For the ‘gitea’ and ‘gogs’ forges some similar variables are
+available, however for some of the ‘ghub.*’ variables no equivalent
+variable exist for these two forges:
+
+ • ‘gitea.user’ is *not* used because no canonical ‘gitea’ instance
+ exists.
+ • ‘gitea.HOST.user’ specifies the user for the HOST ‘gitea’ instance.
+ • ‘gitea.host’ specifies the ‘gitea’ host, unless the HOST argument
+ is non-nil
+ • ‘gogs.user’ is *not* used because no canonical ‘gogs’ instance
+ exists.
+ • ‘gogs.HOST.user’ specifies the user for the HOST ‘gogs’ instance.
+ • ‘gogs.host’ specifies the ‘gogs’ host, unless the HOST argument is
+ non-nil
+
+\1f
+File: ghub.info, Node: Setting the Username, Next: Creating and Storing a Token, Prev: Basic Concepts Arguments and Variables, Up: Getting Started
+
+2.2 Setting the Username
+========================
+
+Ghub needs to know your username that you use on the host that you want
+it to connect to. For each host a different Git variable has to be set
+to specify the username on that host. More than one variable is needed
+because you might use different usernames on different hosts.
+
+Setting your Github.com Username
+--------------------------------
+
+To inform Ghub about your "github.com" username do this:
+
+ git config --global github.user USERNAME
+
+ If you need to identify as another user in a particular repository,
+then you have to set that variable locally:
+
+ cd /path/to/repo
+ git config --local github.user USERNAME
+
+Setting your Gitlab.com Username
+--------------------------------
+
+To inform Ghub about your "gitlab.com" username do this:
+
+ git config --global gitlab.user USERNAME
+
+ If you need to identify as another user in a particular repository,
+then you have to set that variable locally:
+
+ cd /path/to/repo
+ git config --local gitlab.user USERNAME
+
+ Make sure you use the correct USERNAME for this forge/host. It might
+not be the same as on "github.com"!
+
+Setting your Github Enterprise Username
+---------------------------------------
+
+For Github Enterprise instances you have to specify where the API can be
+accessed and a different variable has to be used to set the username.
+
+ For example if the API is available at ‘https://example.com/api/v3’,
+then you should do this:
+
+ git config --global github.example.com/api/v3.user USERNAME
+
+ Make sure you use the correct USERNAME for this instance. It might
+not be the same as on "github.com"!
+
+ Doing this only tells Ghub who you are on this host, additionally you
+have to tell Ghub which repositories are connected to that forge/host,
+like so:
+
+ cd /path/to/repo
+ git config --local github.host example.com/api/v3
+
+Setting your Username for Other Hosts and/or Forges
+---------------------------------------------------
+
+To inform Ghub about your username on HOST (a FORGE instance) do this:
+
+ git config --global FORGE.HOST.user USERNAME
+
+ FORGE can be one of ‘bitbucket’, ‘gitea’ or ‘gogs’. It can also be
+‘github’ or ‘gitlab’; but if that is the case, then you should look at
+the preceding sections instead, which discuss these cases specifically.
+
+ HOST identifies the instance. This actually points at the top-level
+endpoint of the API and may contain path components, e.g.:
+‘example.com/api’.
+
+ If you need to identify as another user in a particular repository,
+then you have to set that variable locally:
+
+ cd /path/to/repo
+ git config --local FORGE.HOST.user USERNAME
+
+\1f
+File: ghub.info, Node: Creating and Storing a Token, Next: Github Configuration Variables, Prev: Setting the Username, Up: Getting Started
+
+2.3 Creating and Storing a Token
+================================
+
+* Menu:
+
+* Creating a Token::
+* Storing a Token::
+
+\1f
+File: ghub.info, Node: Creating a Token, Next: Storing a Token, Up: Creating and Storing a Token
+
+2.3.1 Creating a Token
+----------------------
+
+To create a token, use the web interface of the forge/host you want to
+connect to. Here is a list of pages to do this for certain popular
+hosts:
+
+ • <https://github.com/settings/tokens>
+ • <https://gitlab.com/-/profile/personal_access_tokens>
+
+ For other forges we cannot provide a functioning URL because they
+contain unknown values such as your name. Just go to the general
+settings page of the respective host and then go from there.
+
+ Except on ‘gitea’ and ‘gogs’ each token can be limited to certain
+"scopes", i.e., it is possible to limit for which purposes any given
+token can be used.
+
+ Before you create a token to be used for a certain package, you
+should consult the documentation of that package, which in turn should
+tell you which scopes are needed and why. The Forge package for example
+does so in *note (forge)Token Creation::.
+
+\1f
+File: ghub.info, Node: Storing a Token, Prev: Creating a Token, Up: Creating and Storing a Token
+
+2.3.2 Storing a Token
+---------------------
+
+Please also see *note (auth)Top:: for all the gory details about
+Auth-Source.
+
+ The variable ‘auth-sources’ controls how and where Auth-Source keeps
+its secrets. The default value is a list of three files:
+‘("~/.authinfo" "~/.authinfo.gpg" "~/.netrc")’, but to avoid confusion
+you should make sure that only one of these files exists and then you
+should also adjust the value of the variable to only ever use that file,
+for example:
+
+ (setq auth-sources '("~/.authinfo"))
+
+ In ‘~/.authinfo’ secrets are stored in plain text. If you don’t want
+that, then you should use the encrypted ‘~/.authinfo.gpg’ instead:
+
+ (setq auth-sources '("~/.authinfo.gpg"))
+
+ Auth-Source also supports storing secrets in various external
+key-chains. See *note (auth)Top:: for more information.
+
+ The default Auth-Source backends only support storing three values
+per entry; the "machine", the "login" and the "password". Because Ghub
+uses separate tokens for each package, it has to squeeze four values
+into those three slots, and it does that by using "USERNAME^PACKAGE" as
+the "login".
+
+ Assuming your *Github* username is "ziggy", the package is named
+"forge", and you want to access *Github.com* with the *token*
+"012345abcdef...", an entry in one of the three mentioned files would
+then look like this:
+
+ machine api.github.com login ziggy^forge password 012345abcdef...
+
+ Assuming your *Gitlab* username is "ziggy", the package is named
+"forge", and you want to access *Gitlab.com* with the *token*
+"012345abcdef...", an entry in one of the three mentioned files would
+then look like this:
+
+ machine gitlab.com/api/v4 login ziggy^forge password 012345abcdef...
+
+\1f
+File: ghub.info, Node: Github Configuration Variables, Prev: Creating and Storing a Token, Up: Getting Started
+
+2.4 Github Configuration Variables
+==================================
+
+The username and, unless you only use Github.com itself, the Github
+Enterprise instance have to be configured using Git variables. In rare
+cases it might also be necessary to specify the identity of the local
+machine, which is done using a lisp variable.
+
+ -- Variable: github.user
+ The Github.com username. This should be set globally and if you
+ have multiple Github.com user accounts, then you should set this
+ locally only for those repositories that you want to access using
+ the secondary identity.
+
+ -- Variable: github.HOST.user
+ This variable serves the same purpose as ‘github.user’ but for the
+ Github Enterprise instance identified by ‘HOST’.
+
+ The reason why separate variables are used is that this makes it
+ possible to set both values globally instead of having to set one
+ of the values locally in each and every repository that is
+ connected to the Github Enterprise instance, not Github.com.
+
+ -- Variable: github.host
+ This variable should only be set locally for a repository and
+ specifies the Github Enterprise edition that that repository is
+ connected to. You should not set this globally because then each
+ and every repository becomes connected to the specified Github
+ Enterprise instance, including those that should actually be
+ connected to Github.com.
+
+ When this is undefined, then "api.github.com" is used (defined in
+ the constant ‘ghub-default-host’, which you should never attempt to
+ change.)
+
+\1f
+File: ghub.info, Node: API, Next: Notes, Prev: Getting Started, Up: Top
+
+3 API
+*****
+
+* Menu:
+
+* Their APIs::
+* Making REST Requests::
+* Making GraphQL Requests::
+* Github Convenience Wrappers::
+* Non-Github Convenience Wrappers::
+
+\1f
+File: ghub.info, Node: Their APIs, Next: Making REST Requests, Up: API
+
+3.1 Their APIs
+==============
+
+Of course this manual does not cover the APIs of all forges that it
+supports, but for your convenience, here are the links to their API
+manuals:
+
+ • Github:
+ • <https://developer.github.com/v4> (GraphQl)
+ • <https://developer.github.com/v3> (REST)
+ • Gitlab:
+ • <https://docs.gitlab.com/ee/api/README.html>
+ • Gitea:
+ • <https://docs.gitea.io/en-us/api-usage>
+ • <https://try.gitea.io/api/swagger>
+ • Gogs:
+ • <https://github.com/gogs/go-gogs-client/wiki>
+ • Bitbucket:
+ • <https://developer.atlassian.com/bitbucket/api/2/reference>
+
+\1f
+File: ghub.info, Node: Making REST Requests, Next: Making GraphQL Requests, Prev: Their APIs, Up: API
+
+3.2 Making REST Requests
+========================
+
+ -- Function: ghub-request method resource &optional params &key query
+ payload headers unpaginate noerror reader username auth host
+ callback errorback url value error extra method*
+ This function makes a request for ‘RESOURCE’ using ‘METHOD’.
+ ‘PARAMS’, ‘QUERY’, ‘PAYLOAD’ and/or ‘HEADERS’ are alists holding
+ additional request data. The response body is returned and the
+ response headers are stored in the variable
+ ‘ghub-response-headers’.
+
+ • ‘METHOD’ is the HTTP method, given as a string.
+ • ‘RESOURCE’ is the resource to access, given as a string
+ beginning with a slash.
+
+ • ‘PARAMS’, ‘QUERY’, ‘PAYLOAD’ and ‘HEADERS’ are alists and are
+ used to specify request data. All these arguments are alists
+ that resemble the JSON expected and returned by the Github
+ API. The keys are symbols and the values stored in the ‘cdr’
+ (not the ‘cadr’) can be strings, integers, or lists of strings
+ and integers.
+
+ The Github API documentation is vague on how data has to be
+ transmitted and for a particular resource usually just talks
+ about "parameters". Generally speaking when the ‘METHOD’ is
+ "HEAD" or "GET", then they have to be transmitted as a query,
+ otherwise as a payload.
+
+ • Use ‘PARAMS’ to automatically transmit like ‘QUERY’ or
+ ‘PAYLOAD’ would depending on ‘METHOD’.
+ • Use ‘QUERY’ to explicitly transmit data as a query.
+ • Use ‘PAYLOAD’ to explicitly transmit data as a payload.
+ Instead of an alist, ‘PAYLOAD’ may also be a string, in
+ which case it gets encoded as UTF-8 but is otherwise
+ transmitted as-is.
+ • Use ‘HEADERS’ for those rare resources that require that
+ the data is transmitted as headers instead of as a query
+ or payload. When that is the case, then the Github API
+ documentation usually mentions it explicitly.
+
+ • If ‘SILENT’ is non-nil, then progress reports and the like are
+ not messaged.
+
+ • If ‘UNPAGINATE’ is t, then this function makes as many
+ requests as necessary to get all values. If ‘UNPAGINATE’ is a
+ natural number, then it gets at most that many pages. For any
+ other non-nil value it raises an error.
+
+ • If ‘NOERROR’ is non-nil, then no error is raised if the
+ request fails and ‘nil’ is returned instead. If ‘NOERROR’ is
+ ‘return’, then the error payload is returned instead of ‘nil’.
+
+ • If ‘READER’ is non-nil, then it is used to read and return
+ from the response buffer. The default is
+ ‘ghub--read-json-payload’. For the very few resources that do
+ not return JSON, you might want to use ‘ghub--decode-payload’.
+
+ • If ‘USERNAME’ is non-nil, then the request is made on behalf
+ of that user. It is better to specify the user using the Git
+ variable ‘github.user’ for "api.github.com", or
+ ‘github.HOST.user’ if connecting to a Github Enterprise
+ instance.
+
+ • Each package that uses Ghub should use its own token. If
+ ‘AUTH’ is ‘nil’ or unspecified, then the generic ‘ghub’ token
+ is used instead. This is only acceptable for personal
+ utilities. A package that is distributed to other users
+ should always use this argument to identify itself, using a
+ symbol matching its name.
+
+ Package authors who find this inconvenient should write a
+ wrapper around this function and possibly for the
+ method-specific functions as well.
+
+ Beside ‘nil’, some other symbols have a special meaning too.
+ ‘none’ means to make an unauthorized request. ‘basic’ means
+ to make a password based request. If the value is a string,
+ then it is assumed to be a valid token. ‘basic’ and an
+ explicit token string are only intended for internal and
+ debugging uses.
+
+ If ‘AUTH’ is a package symbol, then the scopes are specified
+ using the variable ‘AUTH-github-token-scopes’. It is an error
+ if that is not specified. See ‘ghub-github-token-scopes’ for
+ an example.
+
+ • If ‘HOST’ is non-nil, then connect to that Github instance.
+ This defaults to "api.github.com". When a repository is
+ connected to a Github Enterprise instance, then it is better
+ to specify that using the Git variable ‘github.host’ instead
+ of using this argument.
+
+ • If ‘FORGE’ is ‘gitlab’, then connect to Gitlab.com or,
+ depending on ‘HOST’, to another Gitlab instance. This is only
+ intended for internal use. Instead of using this argument you
+ should use function ‘glab-request’ and other ‘glab-*’
+ functions.
+
+ • If ‘CALLBACK’ and/or ‘ERRORBACK’ is non-nil, then this
+ function makes one or more asynchronous requests and calls
+ ‘CALLBACK’ or ‘ERRORBACK’ when finished. If no error
+ occurred, then it calls ‘CALLBACK’, unless that is ‘nil’.
+
+ If an error occurred, then it calls ‘ERRORBACK’, or if that is
+ nil, then ‘CALLBACK’. ‘ERRORBACK’ can also be ‘t’, in which
+ case it signals instead. ‘NOERROR’ is ignored for all
+ asynchronous requests.
+
+ Both callbacks are called with four arguments.
+
+ 1. For ‘CALLBACK’, the combined value of the retrieved
+ pages. For ‘ERRORBACK’, the error that occurred when
+ retrieving the last page.
+ 2. The headers of the last page as an alist.
+ 3. Status information provided by ‘url-retrieve’. Its
+ ‘:error’ property holds the same information as the first
+ argument to ‘ERRORBACK’.
+ 4. A ‘ghub--req’ struct, which can be passed to
+ ‘ghub-continue’ (which see) to retrieve the next page, if
+ any.
+
+ -- Function: ghub-continue args
+ If there is a next page, then this function retrieves that.
+
+ This function is only intended to be called from callbacks. If
+ there is a next page, then that is retrieved and the buffer that
+ the result will be loaded into is returned, or t if the process has
+ already completed. If there is no next page, then return nil.
+
+ Callbacks are called with four arguments (see ‘ghub-request’). The
+ forth argument is a ‘ghub--req’ struct, intended to be passed to
+ this function. A callback may use the struct’s ‘extra’ slot to
+ pass additional information to the callback that will be called
+ after the next request. Use the function ‘ghub-req-extra’ to get
+ and set the value of that slot.
+
+ As an example, using ‘ghub-continue’ in a callback like so:
+
+ (ghub-get "/users/tarsius/repos" nil
+ :callback (lambda (value _headers _status req)
+ (unless (ghub-continue req)
+ (setq my-value value))))
+
+ is equivalent to:
+
+ (ghub-get "/users/tarsius/repos" nil
+ :unpaginate t
+ :callback (lambda (value _headers _status _req)
+ (setq my-value value)))
+
+ To demonstrate how to pass information from one callback to the
+ next, here we record when we start fetching each page:
+
+ (ghub-get "/users/tarsius/repos" nil
+ :extra (list (current-time))
+ :callback (lambda (value _headers _status req)
+ (push (current-time) (ghub-req-extra req))
+ (unless (ghub-continue req)
+ (setq my-times (ghub-req-extra req))
+ (setq my-value value))))
+
+ -- Variable: ghub-response-headers
+ A select few Github API resources respond by transmitting data in
+ the response header instead of in the response body. Because there
+ are so few of these inconsistencies, ‘ghub-request’ always returns
+ the response body.
+
+ To access the response headers use this variable after
+ ‘ghub-request’ has returned.
+
+ -- Function: ghub-response-link-relations req headers payload
+ This function returns an alist of the link relations in ‘HEADERS’,
+ or if optional ‘HEADERS’ is nil, then those in
+ ‘ghub-response-headers’.
+
+ When accessing a Bitbucket instance then the link relations are in
+ ‘PAYLOAD’ instead of ‘HEADERS’, making their API merely RESTish and
+ forcing this function to append those relations to the value of
+ ‘ghub-response-headers’, for later use when this function is called
+ with ‘nil’ for ‘PAYLOAD’.
+
+\1f
+File: ghub.info, Node: Making GraphQL Requests, Next: Github Convenience Wrappers, Prev: Making REST Requests, Up: API
+
+3.3 Making GraphQL Requests
+===========================
+
+ -- Function: ghub-graphql graphql &optional variables &key username
+ auth host callback silent callback errorback value extra
+ This function makes a GraphQL request using ‘GRAPHQL’ and
+ ‘VARIABLES’ as inputs. ‘GRAPHQL’ is a GraphQL string. ‘VARIABLES’
+ is a JSON-like alist. The other arguments behave as for
+ ‘ghub-request’ (which see).
+
+ The response is returned as a JSON-like alist. Even if the
+ response contains ‘errors’, this function does not raise an error.
+ Cursor-handling is likewise left to the caller.
+
+ ‘ghub-graphql’ is a thin convenience wrapper around ‘ghub-request’,
+similar to ‘ghub-post’ and friends. While the latter only hard-code the
+value of the ‘METHOD’ argument, the former also hard-codes ‘RESOURCE’
+and constructs ‘PAYLOAD’ from ‘GRAPHQL’ and ‘VARIABLES’. It also drops
+‘UNPAGINATE’, ‘NOERROR’, ‘READER’ (internal functions expect alist-ified
+JSON) and ‘FORGE’ (only Github currently supports GraphQL).
+
+ ‘ghub-graphql’ does not account for the fact that pagination works
+differently in GraphQL than it does in REST, so users of this function
+have to deal with that themselves. Likewise error handling works
+differently and has to be done by the caller too.
+
+ An early attempt at implementing automatic unpaginating for GraphQL
+can be found in the ‘faithful-graphql’ branch, provided I haven’t
+deleted that by now. On that branch I try to do things as intended by
+the designers of GraphQL, using variables and fragments, and drowning in
+a sea of boilerplate.
+
+ The problem with that approach is that it only works for applications
+that fetch specific information on demand and actually want things to be
+paginated. I am convinced that GraphQL is very nice for web apps.
+
+ However the Forge package for which I have implemented all of this
+has very different needs. It wants to fetch "all the data" and "cache"
+it locally, so that it is available even when there is no internet
+connection. GraphQL was designed around the idea that you should be
+able to "ask for what you need and get exactly that". But when that
+boils down to "look, if I persist, then you are going to hand me over
+all the data anyway, so just caught it up already", then things start to
+fall apart. If Github’s GraphQL allowed pagination to be turned off
+completely, then teaching ‘ghub-graphql’ about error handling would be
+enough.
+
+ But it doesn’t and when doing things as intended, then that leads to
+huge amounts of repetitive boilerplate, which is so boring to write that
+doing it without introducing bugs left and right is near impossible; so
+I decided to give up on GraphQL variables, fragments and conditions, and
+instead implement something more powerful, though also more opinionated.
+
+ -- Function: ghub--graphql-vacuum query variables callback &optional
+ until &key narrow username auth host forge
+ This function is an opinionated alternative to ‘ghub-graphql’. It
+ relies on dark magic to get the job done.
+
+ It makes an initial request using ‘QUERY’. It then looks for
+ paginated edges in the returned data and makes more requests to
+ resolve them. In order to do so it automatically transforms the
+ initial ‘QUERY’ into another query suitable for that particular
+ edge. The data retrieved by subsequent requests is then injected
+ into the data of the original request before that is returned or
+ passed to the callback. If subsequently retrieved data features
+ new paginated edges, then those are followed recursively.
+
+ The end result is essentially the same as using ‘ghub-graphql’, if
+ only it were possible to say "do not paginate anything". The
+ implementation is much more complicated because it is not possible
+ to do that.
+
+ ‘QUERY’ is a GraphQL query expressed as an s-expression. The
+ bundled ‘gsexp’ library is used to turn that into a GraphQL query
+ string. Only a subset of the GraphQL features are supported;
+ fragments for example are not, and magical stuff happens to
+ variables. This is not documented yet, I am afraid. Look at
+ existing callers.
+
+ ‘VARIABLES’ is a JSON-like alist as for ‘ghub-graphql’.
+
+ ‘UNTIL’ is an alist ‘((EDGE-until . VALUE)...)’. When unpaginating
+ ‘EDGE’ try not to fetch beyond the element whose first field has
+ the value ‘VALUE’ and remove that element as well as all "lesser"
+ elements from the retrieved data if necessary. Look at
+ ‘forge--pull-repository’ for an example. This is only useful if
+ you "cache" the response locally and want to avoid fetching data
+ again that you already have.
+
+ Other arguments behave as for ‘ghub-graphql’ and ‘ghub-request’,
+ more or less. If ‘CALLBACK’ is nil, pretty-print the response.
+
+ Using ‘ghub--graphql-vacuum’, the following resource specific
+functions are implemented. These functions are not part of the public
+API yet and are very much subject to change.
+
+ -- Function: ghub-fetch-repository owner name callback &optional until
+ &key username auth host forge
+ This function asynchronously fetches forge data about the specified
+ repository. Once all data has been collected, ‘CALLBACK’ is called
+ with the data as the only argument.
+
+ -- Function: ghub-fetch-issue owner name callback &optional until &key
+ username auth host forge
+ This function asynchronously fetches forge data about the specified
+ issue. Once all data has been collected, ‘CALLBACK’ is called with
+ the data as the only argument.
+
+ -- Function: ghub-fetch-pullreq owner name callback &optional until
+ &key username auth host forge
+ This function asynchronously fetches forge data about the specified
+ pull-request. Once all data has been collected, ‘CALLBACK’ is
+ called with the data as the only argument.
+
+ Note that in order to avoid duplication all of these functions base
+their initial query on the query stored in ‘ghub-fetch-repository’. The
+latter two pass that query through ‘ghub--graphql-prepare-query’, which
+then uses ‘ghub--graphql-narrow-query’ to remove parts the caller is not
+interested in. These two functions are also used internally, when
+unpaginating, but as demonstrated here they can be useful even before
+making an initial request.
+
+\1f
+File: ghub.info, Node: Github Convenience Wrappers, Next: Non-Github Convenience Wrappers, Prev: Making GraphQL Requests, Up: API
+
+3.4 Github Convenience Wrappers
+===============================
+
+ -- Function: ghub-head resource &optional params &key query payload
+ headers unpaginate noerror reader username auth host callback
+ errorback
+ -- Function: ghub-get resource &optional params &key query payload
+ headers unpaginate noerror reader username auth host callback
+ errorback
+ These functions are simple wrappers around ‘ghub-request’. Their
+ signature is identical to that of the latter, except that they do
+ not have an argument named ‘METHOD’. The HTTP method is instead
+ given by the second word in the function name.
+
+ As described in the documentation for ‘ghub-request’, it depends on
+ the used method whether the value of the ‘PARAMS’ argument is used
+ as the query or the payload. For the "HEAD" and "GET" methods it
+ is used as the query.
+
+ -- Function: ghub-put resource &optional params &key query payload
+ headers unpaginate noerror reader username auth host callback
+ errorback
+ -- Function: ghub-post resource &optional params &key query payload
+ headers unpaginate noerror reader username auth host callback
+ errorback
+ -- Function: ghub-patch resource &optional params &key query payload
+ headers unpaginate noerror reader username auth host callback
+ errorback
+ -- Function: ghub-delete resource &optional params &key query payload
+ headers unpaginate noerror reader username auth host callback
+ errorback
+ These functions are simple wrappers around ‘ghub-request’. Their
+ signature is identical to that of the latter, except that they do
+ not have an argument named ‘METHOD’. The HTTP method is instead
+ given by the second word in the function name.
+
+ As described in the documentation for ‘ghub-request’, it depends on
+ the used method whether the value of the ‘PARAMS’ argument is used
+ as the query or the payload. For the "PUT", "POST", "PATCH" and
+ "DELETE" methods it is used as the payload.
+
+ -- Function: ghub-wait resource &optional duration &key username auth
+ host
+ Some API requests result in an immediate successful response even
+ when the requested action has not actually been carried out yet.
+ An example is the request for the creation of a new repository,
+ which doesn’t cause the repository to immediately become available.
+ The Github API documentation usually mentions this when describing
+ an affected resource.
+
+ If you want to do something with some resource right after making a
+ request for its creation, then you might have to wait for it to
+ actually be created. This function can be used to do so. It
+ repeatedly tries to access the resource until it becomes available
+ or until a timeout is reached. In the latter case it signals
+ ‘ghub-error’.
+
+ ‘RESOURCE’ specifies the resource that this function waits for.
+
+ ‘DURATION’ specifies the maximum number of seconds to wait for,
+ defaulting to 64 seconds. Emacs will block during that time, but
+ the user can abort using ‘C-g’.
+
+ The first attempt is made immediately and will often succeed. If
+ not, then another attempt is made after two seconds, and each
+ subsequent attempt is made after waiting as long as we already
+ waited between all preceding attempts combined.
+
+ See ‘ghub-request’’s documentation above for information about the
+ other arguments.
+
+\1f
+File: ghub.info, Node: Non-Github Convenience Wrappers, Prev: Github Convenience Wrappers, Up: API
+
+3.5 Non-Github Convenience Wrappers
+===================================
+
+‘ghub-request’ and ‘ghub-METHOD’ can be used to make a request for any
+of the supported forge types, but except when making a request for a
+‘github’ instance, then that requires the use of the FORGE argument.
+
+ To avoid that, functions named ‘FORGE-request’ and ‘FORGE-METHOD’ are
+also available. The following forms are equivalent, for example:
+
+ (ghub-get ... :auth 'PACKAGE :forge 'gitlab)
+ (glab-get ... :auth 'PACKAGE)
+
+ These forms would remain equivalent even if you did not specify a
+value for the AUTH arguments — but you should not do that if you plan to
+share your code with others (see *note Using Ghub in Your Own
+Package::). If you do omit AUTH, then the request is made on behalf of
+the ‘ghub’ package, *regardless* of the symbol prefix of the function
+you use to do so.
+
+ All ‘FORGE-request’ and ‘FORGE-METHOD’ functions, including but not
+limited to ‘ghub-METHOD’, are very simple wrappers around
+‘ghub-request’. They take fewer arguments than ‘ghub-request’ and
+instead pass constant values for the arguments METHOD and/or FORGE.
+
+ -- Function: buck-request resource &optional params &key query payload
+ headers unpaginate noerror reader username auth host callback
+ errorback
+ -- Function: glab-request resource &optional params &key query payload
+ headers unpaginate noerror reader username auth host callback
+ errorback
+ -- Function: gogs-request resource &optional params &key query payload
+ headers unpaginate noerror reader username auth host callback
+ errorback
+ Wrappers around ‘ghub-request’ which hardcode the FORGE to either
+ ‘bitbucket’, ‘gitlab’, ‘gogs’ or ‘gitea’.
+
+ -- Function: buck-get resource &optional params &key query payload
+ headers unpaginate noerror reader username auth host callback
+ errorback
+ -- Function: buck-put resource &optional params &key query payload
+ headers unpaginate noerror reader username auth host callback
+ errorback
+ -- Function: buck-post resource &optional params &key query payload
+ headers unpaginate noerror reader username auth host callback
+ errorback
+ -- Function: buck-delete resource &optional params &key query payload
+ headers unpaginate noerror reader username auth host callback
+ errorback
+ -- Function: glab-head resource &optional params &key query payload
+ headers unpaginate noerror reader username auth host callback
+ errorback
+ -- Function: glab-get resource &optional params &key query payload
+ headers unpaginate noerror reader username auth host callback
+ errorback
+ -- Function: glab-put resource &optional params &key query payload
+ headers unpaginate noerror reader username auth host callback
+ errorback
+ -- Function: glab-post resource &optional params &key query payload
+ headers unpaginate noerror reader username auth host callback
+ errorback
+ -- Function: glab-patch resource &optional params &key query payload
+ headers unpaginate noerror reader username auth host callback
+ errorback
+ -- Function: glab-delete resource &optional params &key query payload
+ headers unpaginate noerror reader username auth host callback
+ errorback
+ -- Function: gogs-get resource &optional params &key query payload
+ headers unpaginate noerror reader username auth host callback
+ errorback
+ -- Function: gogs-put resource &optional params &key query payload
+ headers unpaginate noerror reader username auth host callback
+ errorback
+ -- Function: gogs-post resource &optional params &key query payload
+ headers unpaginate noerror reader username auth host callback
+ errorback
+ -- Function: gogs-patch resource &optional params &key query payload
+ headers unpaginate noerror reader username auth host callback
+ errorback
+ -- Function: gogs-delete resource &optional params &key query payload
+ headers unpaginate noerror reader username auth host callback
+ errorback
+ -- Function: gtea-get resource &optional params &key query payload
+ headers unpaginate noerror reader username auth host callback
+ errorback
+ -- Function: gtea-put resource &optional params &key query payload
+ headers unpaginate noerror reader username auth host callback
+ errorback
+ -- Function: gtea-post resource &optional params &key query payload
+ headers unpaginate noerror reader username auth host callback
+ errorback
+ -- Function: gtea-patch resource &optional params &key query payload
+ headers unpaginate noerror reader username auth host callback
+ errorback
+ -- Function: gtea-delete resource &optional params &key query payload
+ headers unpaginate noerror reader username auth host callback
+ errorback
+ Wrappers around ‘FORGE-METHOD’ which hardcode the FORGE to either
+ ‘bitbucket’, ‘gitlab’, ‘gogs’ or ‘gitea’, and the METHOD to the
+ implied method.
+
+ Note that ‘buck-head’, ‘buck-patch’, ‘gogs-head’ and ‘gtea-head’ do
+ not exist because the respective APIs do not appear to support
+ these methods.
+
+\1f
+File: ghub.info, Node: Notes, Next: Function Index, Prev: API, Up: Top
+
+4 Notes
+*******
+
+* Menu:
+
+* Using Ghub in Personal Scripts::
+* Using Ghub in Your Own Package::
+* Forge Limitations and Notes::
+
+\1f
+File: ghub.info, Node: Using Ghub in Personal Scripts, Next: Using Ghub in Your Own Package, Up: Notes
+
+4.1 Using Ghub in Personal Scripts
+==================================
+
+You can of course use ‘ghub-request’ and its wrapper functions in your
+personal scripts. Unlike when you use Ghub in a package that you
+distribute for others to use, you don’t have to explicitly specify a
+package in personal scripts.
+
+ ;; This is perfectly acceptable in personal scripts ...
+ (ghub-get "/user")
+
+ ;; ... and actually equals to
+ (ghub-get "/user" nil :auth 'ghub)
+
+ ;; In packages you have to specify the package using AUTH.
+ (ghub-get "/user" nil :auth 'some-package)
+
+ When the ‘AUTH’ argument is not specified, then a request is made on
+behalf of the ‘ghub’ package itself. Like for any other package you
+have to create a dedicated token of coures.
+
+\1f
+File: ghub.info, Node: Using Ghub in Your Own Package, Next: Forge Limitations and Notes, Prev: Using Ghub in Personal Scripts, Up: Notes
+
+4.2 Using Ghub in Your Own Package
+==================================
+
+Every package should use its own token. This allows you as the author
+of some package to only request access to API scopes that are actually
+needed, which in turn might make it easier for users to trust your
+package not to do unwanted things.
+
+ You have to tell ‘ghub-request’ on behalf of which package a request
+is being made by passing the symbol ‘PACKAGE’ as the value of its ‘AUTH’
+argument.
+
+ (ghub-request "GET" "/user" nil :auth 'PACKAGE)
+
+ Keep in mind that the users of your package will have to manually
+create a suitable token. To make that easier, you should not only link
+to this manual but also prominently mention the scopes the token needs;
+and explain what they are needed for.
+
+\1f
+File: ghub.info, Node: Forge Limitations and Notes, Prev: Using Ghub in Your Own Package, Up: Notes
+
+4.3 Forge Limitations and Notes
+===============================
+
+ • There are no default Gitea and Gogs instances so the variables
+ ‘gitea.host’ and ‘gogs.host’ are not taken into account.
+
+ • Gitea and Gogs do not support limiting a token to certain scopes.
+
+ • The Bitbucket API is fairly broken and my willingness to deal with
+ that is extremely limited unless someone pays me vast amounts of
+ money.
+
+ • The Gitlab API documentation is not always accurate, though I don’t
+ have an example at hand. It also isn’t structured well, making it
+ occasionally difficult to find the information one is looking for.
+
+ • Where one would use ‘user/repo’ when accessing another forge, one
+ has to use ‘user%2Frepo’ when accessing Gitlab, e.g.:
+
+ (glab-get "/projects/python-mode-devs%2Fpython-mode")
+
+\1f
+File: ghub.info, Node: Function Index, Next: Variable Index, Prev: Notes, Up: Top
+
+Appendix A Function Index
+*************************
+
+\0\b[index\0\b]
+* Menu:
+
+* buck-delete: Non-Github Convenience Wrappers.
+ (line 49)
+* buck-get: Non-Github Convenience Wrappers.
+ (line 40)
+* buck-post: Non-Github Convenience Wrappers.
+ (line 46)
+* buck-put: Non-Github Convenience Wrappers.
+ (line 43)
+* buck-request: Non-Github Convenience Wrappers.
+ (line 28)
+* ghub--graphql-vacuum: Making GraphQL Requests.
+ (line 56)
+* ghub-continue: Making REST Requests.
+ (line 125)
+* ghub-delete: Github Convenience Wrappers.
+ (line 31)
+* ghub-fetch-issue: Making GraphQL Requests.
+ (line 105)
+* ghub-fetch-pullreq: Making GraphQL Requests.
+ (line 111)
+* ghub-fetch-repository: Making GraphQL Requests.
+ (line 99)
+* ghub-get: Github Convenience Wrappers.
+ (line 9)
+* ghub-graphql: Making GraphQL Requests.
+ (line 6)
+* ghub-head: Github Convenience Wrappers.
+ (line 6)
+* ghub-patch: Github Convenience Wrappers.
+ (line 28)
+* ghub-post: Github Convenience Wrappers.
+ (line 25)
+* ghub-put: Github Convenience Wrappers.
+ (line 22)
+* ghub-request: Making REST Requests.
+ (line 6)
+* ghub-response-link-relations: Making REST Requests.
+ (line 174)
+* ghub-wait: Github Convenience Wrappers.
+ (line 44)
+* glab-delete: Non-Github Convenience Wrappers.
+ (line 67)
+* glab-get: Non-Github Convenience Wrappers.
+ (line 55)
+* glab-head: Non-Github Convenience Wrappers.
+ (line 52)
+* glab-patch: Non-Github Convenience Wrappers.
+ (line 64)
+* glab-post: Non-Github Convenience Wrappers.
+ (line 61)
+* glab-put: Non-Github Convenience Wrappers.
+ (line 58)
+* glab-request: Non-Github Convenience Wrappers.
+ (line 31)
+* gogs-delete: Non-Github Convenience Wrappers.
+ (line 82)
+* gogs-get: Non-Github Convenience Wrappers.
+ (line 70)
+* gogs-patch: Non-Github Convenience Wrappers.
+ (line 79)
+* gogs-post: Non-Github Convenience Wrappers.
+ (line 76)
+* gogs-put: Non-Github Convenience Wrappers.
+ (line 73)
+* gogs-request: Non-Github Convenience Wrappers.
+ (line 34)
+* gtea-delete: Non-Github Convenience Wrappers.
+ (line 97)
+* gtea-get: Non-Github Convenience Wrappers.
+ (line 85)
+* gtea-patch: Non-Github Convenience Wrappers.
+ (line 94)
+* gtea-post: Non-Github Convenience Wrappers.
+ (line 91)
+* gtea-put: Non-Github Convenience Wrappers.
+ (line 88)
+
+\1f
+File: ghub.info, Node: Variable Index, Prev: Function Index, Up: Top
+
+Appendix B Variable Index
+*************************
+
+\0\b[index\0\b]
+* Menu:
+
+* ghub-response-headers: Making REST Requests.
+ (line 165)
+* github.host: Github Configuration Variables.
+ (line 26)
+* github.HOST.user: Github Configuration Variables.
+ (line 17)
+* github.user: Github Configuration Variables.
+ (line 11)
+
+
+\1f
+Tag Table:
+Node: Top\7f754
+Node: Introduction\7f2285
+Node: Getting Started\7f2690
+Node: Basic Concepts Arguments and Variables\7f4372
+Node: Setting the Username\7f8226
+Ref: Setting your Githubcom Username\7f8710
+Ref: Setting your Gitlabcom Username\7f9066
+Ref: Setting your Github Enterprise Username\7f9532
+Ref: Setting your Username for Other Hosts and/or Forges\7f10265
+Node: Creating and Storing a Token\7f11071
+Node: Creating a Token\7f11335
+Node: Storing a Token\7f12355
+Node: Github Configuration Variables\7f14200
+Node: API\7f15911
+Node: Their APIs\7f16149
+Node: Making REST Requests\7f16874
+Node: Making GraphQL Requests\7f26287
+Node: Github Convenience Wrappers\7f32970
+Node: Non-Github Convenience Wrappers\7f36674
+Node: Notes\7f42178
+Node: Using Ghub in Personal Scripts\7f42385
+Node: Using Ghub in Your Own Package\7f43276
+Node: Forge Limitations and Notes\7f44211
+Node: Function Index\7f45184
+Node: Variable Index\7f50833
+\1f
+End Tag Table
+
+\1f
+Local Variables:
+coding: utf-8
+End:
--- /dev/null
+;;; glab.el --- Client library for the Gitlab API -*- lexical-binding:t -*-
+
+;; Copyright (C) 2016-2023 Jonas Bernoulli
+
+;; Author: Jonas Bernoulli <jonasNOSPAMbernoul.li>
+;; Homepage: https://github.com/magit/ghub
+;; Keywords: tools
+
+;; SPDX-License-Identifier: GPL-3.0-or-later
+
+;; This file 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 file 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 file. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Glab is a library that provides basic support for using the Gitlab API
+;; from Emacs packages. It abstracts access to API resources using only
+;; a handful of functions that are not resource-specific.
+
+;; This library is implemented on top of Ghub. Unlike Ghub, Glab does
+;; not support the guided creation of tokens because Gitlab lacks the
+;; features that would be necessary to implement that. Users have to
+;; create tokens through the web interface.
+
+;;; Code:
+
+(require 'ghub)
+
+(defconst glab-default-host "gitlab.com/api/v4"
+ "The default host that is used if `glab.host' is not set.")
+
+(cl-defun glab-head (resource &optional params
+ &key query payload headers
+ silent unpaginate noerror reader
+ username auth host
+ callback errorback extra)
+ "Make a `HEAD' request for RESOURCE, with optional query PARAMS.
+Like calling `ghub-request' (which see) with \"HEAD\" as METHOD
+and `gitlab' as FORGE."
+ (ghub-request "HEAD" resource params :forge 'gitlab
+ :query query :payload payload :headers headers
+ :silent silent :unpaginate unpaginate
+ :noerror noerror :reader reader
+ :username username :auth auth :host host
+ :callback callback :errorback errorback :extra extra))
+
+(cl-defun glab-get (resource &optional params
+ &key query payload headers
+ silent unpaginate noerror reader
+ username auth host
+ callback errorback extra)
+ "Make a `GET' request for RESOURCE, with optional query PARAMS.
+Like calling `ghub-request' (which see) with \"GET\" as METHOD
+and `gitlab' as FORGE."
+ (ghub-request "GET" resource params :forge 'gitlab
+ :query query :payload payload :headers headers
+ :silent silent :unpaginate unpaginate
+ :noerror noerror :reader reader
+ :username username :auth auth :host host
+ :callback callback :errorback errorback :extra extra))
+
+(cl-defun glab-put (resource &optional params
+ &key query payload headers
+ silent unpaginate noerror reader
+ username auth host
+ callback errorback extra)
+ "Make a `PUT' request for RESOURCE, with optional payload PARAMS.
+Like calling `ghub-request' (which see) with \"PUT\" as METHOD
+and `gitlab' as FORGE."
+ (ghub-request "PUT" resource params :forge 'gitlab
+ :query query :payload payload :headers headers
+ :silent silent :unpaginate unpaginate
+ :noerror noerror :reader reader
+ :username username :auth auth :host host
+ :callback callback :errorback errorback :extra extra))
+
+(cl-defun glab-post (resource &optional params
+ &key query payload headers
+ silent unpaginate noerror reader
+ username auth host
+ callback errorback extra)
+ "Make a `POST' request for RESOURCE, with optional payload PARAMS.
+Like calling `ghub-request' (which see) with \"POST\" as METHOD
+and `gitlab' as FORGE."
+ (ghub-request "POST" resource params :forge 'gitlab
+ :query query :payload payload :headers headers
+ :silent silent :unpaginate unpaginate
+ :noerror noerror :reader reader
+ :username username :auth auth :host host
+ :callback callback :errorback errorback :extra extra))
+
+(cl-defun glab-patch (resource &optional params
+ &key query payload headers
+ silent unpaginate noerror reader
+ username auth host
+ callback errorback extra)
+ "Make a `PATCH' request for RESOURCE, with optional payload PARAMS.
+Like calling `ghub-request' (which see) with \"PATCH\" as METHOD
+and `gitlab' as FORGE."
+ (ghub-request "PATCH" resource params :forge 'gitlab
+ :query query :payload payload :headers headers
+ :silent silent :unpaginate unpaginate
+ :noerror noerror :reader reader
+ :username username :auth auth :host host
+ :callback callback :errorback errorback :extra extra))
+
+(cl-defun glab-delete (resource &optional params
+ &key query payload headers
+ silent unpaginate noerror reader
+ username auth host
+ callback errorback extra)
+ "Make a `DELETE' request for RESOURCE, with optional payload PARAMS.
+Like calling `ghub-request' (which see) with \"DELETE\" as METHOD
+and `gitlab' as FORGE."
+ (ghub-request "DELETE" resource params :forge 'gitlab
+ :query query :payload payload :headers headers
+ :silent silent :unpaginate unpaginate
+ :noerror noerror :reader reader
+ :username username :auth auth :host host
+ :callback callback :errorback errorback :extra extra))
+
+(cl-defun glab-request (method resource &optional params
+ &key query payload headers
+ silent unpaginate noerror reader
+ username auth host
+ callback errorback extra)
+ "Make a request for RESOURCE and return the response body.
+Like calling `ghub-request' (which see) with `gitlab' as FORGE."
+ (ghub-request method resource params :forge 'gitlab
+ :query query :payload payload :headers headers
+ :silent silent :unpaginate unpaginate
+ :noerror noerror :reader reader
+ :username username :auth auth :host host
+ :callback callback :errorback errorback :extra extra))
+
+(cl-defun glab-graphql (graphql &optional variables
+ &key username auth host
+ headers silent
+ callback errorback value extra)
+ "Make a GraphQL request using GRAPHQL and VARIABLES.
+Like calling `ghub-graphql' (which see) with `gitlab' as FORGE."
+ (ghub-graphql graphql variables :forge 'gitlab
+ :username username :auth auth :host host
+ :headers headers :silent silent
+ :callback callback :errorback errorback
+ :value value :extra extra))
+
+(cl-defun glab-repository-id (owner name &key username auth host)
+ "Return the id of the repository specified by OWNER, NAME and HOST."
+ (number-to-string
+ (cdr (assq 'id (glab-get (format "/projects/%s%%2F%s"
+ (string-replace "/" "%2F" owner)
+ name)
+ nil :username username :auth auth :host host)))))
+
+;;; _
+(provide 'glab)
+;;; glab.el ends here
--- /dev/null
+;;; gogs.el --- Client library for the Gogs API -*- lexical-binding:t -*-
+
+;; Copyright (C) 2016-2023 Jonas Bernoulli
+
+;; Author: Jonas Bernoulli <jonasNOSPAMbernoul.li>
+;; Homepage: https://github.com/magit/ghub
+;; Keywords: tools
+
+;; SPDX-License-Identifier: GPL-3.0-or-later
+
+;; This file 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 file 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 file. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Gogs is a library that provides basic support for using the Gogs API
+;; from Emacs packages. It abstracts access to API resources using only
+;; a handful of functions that are not resource-specific.
+
+;; This library is implemented on top of Ghub. Unlike Ghub, Gogs does
+;; not support the guided creation of tokens because Gogs lacks the
+;; features that would be necessary to implement that. Users have to
+;; create tokens through the web interface.
+
+;;; Code:
+
+(require 'ghub)
+
+(defconst gogs-default-host "localhost:3000/api/v1"
+ "The default Gogs host.")
+
+;; HEAD does not appear to be supported.
+
+(cl-defun gogs-get (resource &optional params
+ &key query payload headers
+ silent unpaginate noerror reader
+ username auth host
+ callback errorback extra)
+ "Make a `GET' request for RESOURCE, with optional query PARAMS.
+Like calling `ghub-request' (which see) with \"GET\" as METHOD
+and `gogs' as FORGE."
+ (ghub-request "GET" resource params :forge 'gogs
+ :query query :payload payload :headers headers
+ :silent silent :unpaginate unpaginate
+ :noerror noerror :reader reader
+ :username username :auth auth :host host
+ :callback callback :errorback errorback :extra extra))
+
+(cl-defun gogs-put (resource &optional params
+ &key query payload headers
+ silent unpaginate noerror reader
+ username auth host
+ callback errorback extra)
+ "Make a `PUT' request for RESOURCE, with optional payload PARAMS.
+Like calling `ghub-request' (which see) with \"PUT\" as METHOD
+and `gogs' as FORGE."
+ (ghub-request "PUT" resource params :forge 'gogs
+ :query query :payload payload :headers headers
+ :silent silent :unpaginate unpaginate
+ :noerror noerror :reader reader
+ :username username :auth auth :host host
+ :callback callback :errorback errorback :extra extra))
+
+(cl-defun gogs-post (resource &optional params
+ &key query payload headers
+ silent unpaginate noerror reader
+ username auth host
+ callback errorback extra)
+ "Make a `POST' request for RESOURCE, with optional payload PARAMS.
+Like calling `ghub-request' (which see) with \"POST\" as METHOD
+and `gogs' as FORGE."
+ (ghub-request "POST" resource params :forge 'gogs
+ :query query :payload payload :headers headers
+ :silent silent :unpaginate unpaginate
+ :noerror noerror :reader reader
+ :username username :auth auth :host host
+ :callback callback :errorback errorback :extra extra))
+
+(cl-defun gogs-patch (resource &optional params
+ &key query payload headers
+ silent unpaginate noerror reader
+ username auth host
+ callback errorback extra)
+ "Make a `PATCH' request for RESOURCE, with optional payload PARAMS.
+Like calling `ghub-request' (which see) with \"PATCH\" as METHOD
+and `gogs' as FORGE."
+ (ghub-request "PATCH" resource params :forge 'gogs
+ :query query :payload payload :headers headers
+ :silent silent :unpaginate unpaginate
+ :noerror noerror :reader reader
+ :username username :auth auth :host host
+ :callback callback :errorback errorback :extra extra))
+
+(cl-defun gogs-delete (resource &optional params
+ &key query payload headers
+ silent unpaginate noerror reader
+ username auth host
+ callback errorback extra)
+ "Make a `DELETE' request for RESOURCE, with optional payload PARAMS.
+Like calling `ghub-request' (which see) with \"DELETE\" as METHOD
+and `gogs' as FORGE."
+ (ghub-request "DELETE" resource params :forge 'gogs
+ :query query :payload payload :headers headers
+ :silent silent :unpaginate unpaginate
+ :noerror noerror :reader reader
+ :username username :auth auth :host host
+ :callback callback :errorback errorback :extra extra))
+
+(cl-defun gogs-request (method resource &optional params
+ &key query payload headers
+ silent unpaginate noerror reader
+ username auth host
+ callback errorback extra)
+ "Make a request for RESOURCE and return the response body.
+Like calling `ghub-request' (which see) with `gogs' as FORGE."
+ (ghub-request method resource params :forge 'gogs
+ :query query :payload payload :headers headers
+ :silent silent :unpaginate unpaginate
+ :noerror noerror :reader reader
+ :username username :auth auth :host host
+ :callback callback :errorback errorback :extra extra))
+
+(cl-defun gogs-repository-id (owner name &key username auth host)
+ "Return the id of the repository specified by OWNER, NAME and HOST."
+ (number-to-string
+ (cdr (assq 'id (gogs-get (format "/repos/%s/%s" owner name)
+ nil :username username :auth auth :host host)))))
+
+;;; _
+(provide 'gogs)
+;;; gogs.el ends here
--- /dev/null
+;;; gsexp.el --- GraphQl as S-expressions -*- lexical-binding:t -*-
+
+;; Copyright (C) 2016-2023 Jonas Bernoulli
+
+;; Author: Jonas Bernoulli <jonasNOSPAMbernoul.li>
+;; Homepage: https://github.com/magit/ghub
+;; Keywords: tools
+
+;; SPDX-License-Identifier: GPL-3.0-or-later
+
+;; This file 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 file 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 file. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This library encodes S-expressions as GraphQl documents. Currently
+;; it is rather incomplete and only intended for use by `ghub-graphql'
+;; but I might fill the gaps and add documentation eventually. I am
+;; not in a hurry though.
+
+;;; Code:
+
+(require 'cl-lib)
+
+(defvar gsexp-one-variable-per-line nil)
+
+(defun gsexp-encode (document)
+ (gsexp--pp (gsexp--encode-field document)))
+
+(defun gsexp--encode-field (field)
+ (cond
+ ((stringp field)
+ field)
+ ((symbolp field)
+ (symbol-name field))
+ ((listp (car field))
+ (concat (format "%s: " (caar field))
+ (gsexp--encode-field (cons (car (cdar field))
+ (cdr field)))))
+ ((concat
+ (pcase (pop field)
+ (`[] "")
+ ((and (pred symbolp) op) (symbol-name op))
+ (`[,op] (symbol-name op))
+ (`[,op ,name] (format "%s %s" op name)))
+ (and (vectorp (car field))
+ (format " (%s%s)"
+ (if gsexp-one-variable-per-line "\n" "")
+ (mapconcat #'gsexp--encode-argument
+ (append (pop field) nil)
+ (if gsexp-one-variable-per-line ",\n" ","))))
+ (and field
+ (format " {\n%s\n}"
+ (mapconcat #'gsexp--encode-field field "\n")))))))
+
+(cl-defun gsexp--encode-argument ((argument value))
+ (format "%s: %s" argument (gsexp--encode-value value)))
+
+(defun gsexp--encode-value (value)
+ (cond
+ ((numberp value)
+ (number-to-string value))
+ ((symbolp value) ; including variables, enums, booleans and null
+ (symbol-name value))
+ ((stringp value)
+ (prin1-to-string value))
+ ((vectorp value)
+ (format "(%s)" (mapconcat #'gsexp--encode-value value "")))
+ ((listp value)
+ (format "{%s}" (mapconcat
+ (pcase-lambda (`(,name ,value))
+ (format "%s: %s" name (gsexp--encode-value value)))
+ value ", ")))
+ ((error "Invalid field value: %S" value))))
+
+(defun gsexp--pp (string)
+ (with-temp-buffer
+ (save-excursion
+ (insert string))
+ (while (< (point) (point-max))
+ (unless (and (bolp) (eolp))
+ (save-excursion
+ (let ((level (car (syntax-ppss (line-beginning-position)))))
+ (when (looking-at "\\s-*\\s)")
+ (cl-decf level))
+ (indent-line-to (* 2 level)))))
+ (forward-line 1))
+ (buffer-string)))
+
+;;; _
+(provide 'gsexp)
+;;; gsexp.el ends here
--- /dev/null
+;;; gtea.el --- Client library for the Gitea API -*- lexical-binding:t -*-
+
+;; Copyright (C) 2016-2023 Jonas Bernoulli
+
+;; Author: Jonas Bernoulli <jonasNOSPAMbernoul.li>
+;; Homepage: https://github.com/magit/ghub
+;; Keywords: tools
+
+;; SPDX-License-Identifier: GPL-3.0-or-later
+
+;; This file 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 file 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 file. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Gtea is a library that provides basic support for using the Gitea API
+;; from Emacs packages. It abstracts access to API resources using only
+;; a handful of functions that are not resource-specific.
+
+;; This library is implemented on top of Ghub. Unlike Ghub, Gtea does
+;; not support the guided creation of tokens because Gitea lacks the
+;; features that would be necessary to implement that. Users have to
+;; create tokens through the web interface.
+
+;;; Code:
+
+(require 'ghub)
+
+(defconst gtea-default-host "localhost:3000/api/v1"
+ "The default Gitea host.")
+
+;; HEAD does not appear to be supported.
+
+(cl-defun gtea-get (resource &optional params
+ &key query payload headers
+ silent unpaginate noerror reader
+ username auth host
+ callback errorback extra)
+ "Make a `GET' request for RESOURCE, with optional query PARAMS.
+Like calling `ghub-request' (which see) with \"GET\" as METHOD
+and `gitea' as FORGE."
+ (ghub-request "GET" resource params :forge 'gitea
+ :query query :payload payload :headers headers
+ :silent silent :unpaginate unpaginate
+ :noerror noerror :reader reader
+ :username username :auth auth :host host
+ :callback callback :errorback errorback :extra extra))
+
+(cl-defun gtea-put (resource &optional params
+ &key query payload headers
+ silent unpaginate noerror reader
+ username auth host
+ callback errorback extra)
+ "Make a `PUT' request for RESOURCE, with optional payload PARAMS.
+Like calling `ghub-request' (which see) with \"PUT\" as METHOD
+and `gitea' as FORGE."
+ (ghub-request "PUT" resource params :forge 'gitea
+ :query query :payload payload :headers headers
+ :silent silent :unpaginate unpaginate
+ :noerror noerror :reader reader
+ :username username :auth auth :host host
+ :callback callback :errorback errorback :extra extra))
+
+(cl-defun gtea-post (resource &optional params
+ &key query payload headers
+ silent unpaginate noerror reader
+ username auth host
+ callback errorback extra)
+ "Make a `POST' request for RESOURCE, with optional payload PARAMS.
+Like calling `ghub-request' (which see) with \"POST\" as METHOD
+and `gitea' as FORGE."
+ (ghub-request "POST" resource params :forge 'gitea
+ :query query :payload payload :headers headers
+ :silent silent :unpaginate unpaginate
+ :noerror noerror :reader reader
+ :username username :auth auth :host host
+ :callback callback :errorback errorback :extra extra))
+
+(cl-defun gtea-patch (resource &optional params
+ &key query payload headers
+ silent unpaginate noerror reader
+ username auth host
+ callback errorback extra)
+ "Make a `PATCH' request for RESOURCE, with optional payload PARAMS.
+Like calling `ghub-request' (which see) with \"PATCH\" as METHOD
+and `gitea' as FORGE."
+ (ghub-request "PATCH" resource params :forge 'gitea
+ :query query :payload payload :headers headers
+ :silent silent :unpaginate unpaginate
+ :noerror noerror :reader reader
+ :username username :auth auth :host host
+ :callback callback :errorback errorback :extra extra))
+
+(cl-defun gtea-delete (resource &optional params
+ &key query payload headers
+ silent unpaginate noerror reader
+ username auth host
+ callback errorback extra)
+ "Make a `DELETE' request for RESOURCE, with optional payload PARAMS.
+Like calling `ghub-request' (which see) with \"DELETE\" as METHOD
+and `gitea' as FORGE."
+ (ghub-request "DELETE" resource params :forge 'gitea
+ :query query :payload payload :headers headers
+ :silent silent :unpaginate unpaginate
+ :noerror noerror :reader reader
+ :username username :auth auth :host host
+ :callback callback :errorback errorback :extra extra))
+
+(cl-defun gtea-request (method resource &optional params
+ &key query payload headers
+ silent unpaginate noerror reader
+ username auth host
+ callback errorback extra)
+ "Make a request for RESOURCE and return the response body.
+Like calling `ghub-request' (which see) with `gitea' as FORGE."
+ (ghub-request method resource params :forge 'gitea
+ :query query :payload payload :headers headers
+ :silent silent :unpaginate unpaginate
+ :noerror noerror :reader reader
+ :username username :auth auth :host host
+ :callback callback :errorback errorback :extra extra))
+
+(cl-defun gtea-repository-id (owner name &key username auth host)
+ "Return the id of the repository specified by OWNER, NAME and HOST."
+ (number-to-string
+ (cdr (assq 'id (gtea-get (format "/repos/%s/%s" owner name)
+ nil :username username :auth auth :host host)))))
+
+;;; _
+(provide 'gtea)
+;;; gtea.el ends here
--- /dev/null
+;;; logito-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*-
+;;
+;;; Code:
+
+(add-to-list 'load-path (directory-file-name
+ (or (file-name-directory #$) (car load-path))))
+
+\f
+;;;### (autoloads nil "logito" "logito.el" (0 0 0 0))
+;;; Generated autoloads from logito.el
+
+(register-definition-prefixes "logito" '("logito-"))
+
+;;;***
+\f
+;; Local Variables:
+;; version-control: never
+;; no-byte-compile: t
+;; no-update-autoloads: t
+;; coding: utf-8
+;; End:
+;;; logito-autoloads.el ends here
--- /dev/null
+;;; Generated package description from logito.el -*- no-byte-compile: t -*-
+(define-package "logito" "20201226.534" "logging library for Emacs" '((emacs "25.1")) :commit "d5934ce10ba3a70d3fcfb94d742ce3b9136ce124" :authors '(("Yann Hodique" . "yann.hodiqueNOSPAMgmail.com")) :maintainer '("Yann Hodique" . "yann.hodiqueNOSPAMgmail.com") :keywords '("lisp" "extensions"))
--- /dev/null
+;;; logito.el --- logging library for Emacs
+
+;; Copyright (C) 2012 Yann Hodique
+
+;; Author: Yann Hodique <yann.hodiqueNOSPAMgmail.com>
+;; Keywords: lisp, extensions
+;; Package-Version: 20201226.534
+;; Package-Commit: d5934ce10ba3a70d3fcfb94d742ce3b9136ce124
+;; Version: 0.1
+;; Package-Requires: ((emacs "25.1"))
+
+;; This file 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 2, or (at your option)
+;; any later version.
+
+;; This file 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 GNU Emacs; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This module provides logging facility for Emacs
+
+;;; Code:
+
+(require 'eieio)
+
+(defclass logito-object ()
+ ((level :initarg :level :initform nil)))
+
+(cl-defmethod logito-insert-log ((log logito-object) format &rest objects)
+ "Base implementation, do nothing")
+
+(cl-defmethod logito-should-log ((log logito-object) level)
+ (let ((l (oref log level)))
+ (and (integerp l)
+ (<= level l))))
+
+(cl-defmethod logito-log ((log logito-object) level tag string &rest objects)
+ (when (logito-should-log log level)
+ (apply 'logito-insert-log log (format "[%s] %s" tag string) objects)))
+
+(cl-defmethod logito-log (log level tag string &rest objects)
+ "Fallback implementation, do nothing. This allows in particular
+ to pass nil as the log object."
+ nil)
+
+(defclass logito-message-object (logito-object)
+ ())
+
+(cl-defmethod logito-insert-log ((log logito-message-object) format &rest objects)
+ (apply 'message format objects))
+
+(defclass logito-buffer-object (logito-object)
+ ((buffer :initarg :buffer :initform nil)))
+
+(cl-defmethod logito-should-log ((log logito-buffer-object) level)
+ (and (oref log buffer)
+ (cl-call-next-method)))
+
+(cl-defmethod logito-insert-log ((log logito-buffer-object) format &rest objects)
+ (let ((buffer (get-buffer-create (oref log buffer))))
+ (with-current-buffer buffer
+ (goto-char (point-max))
+ (insert (apply 'format format objects) "\n\n"))))
+
+(defmacro logito-def-level (sym val &optional pkg)
+ "Define a constant <PKG>-<SYM>-level and a macro <PKG>:<SYM>
+associated with this level. PKG defaults to `logito'"
+ (let* ((pkg (or pkg 'logito))
+ (const (intern (format "%s:%s-level"
+ (symbol-name pkg) (symbol-name sym))))
+ (mac (intern (format "%s:%s"
+ (symbol-name pkg) (symbol-name sym)))))
+ `(progn
+ (defconst ,const ,val)
+ (defmacro ,mac (log string &rest objects)
+ (append
+ (list 'logito-log log ,const '',sym string)
+ objects)))))
+
+;; built-in log levels
+(logito-def-level error 0)
+(logito-def-level info 5)
+(logito-def-level verbose 10)
+(logito-def-level debug 15)
+
+(provide 'logito)
+;;; logito.el ends here
--- /dev/null
+;;; marshal-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*-
+;;
+;;; Code:
+
+(add-to-list 'load-path (directory-file-name
+ (or (file-name-directory #$) (car load-path))))
+
+\f
+;;;### (autoloads nil "marshal" "marshal.el" (0 0 0 0))
+;;; Generated autoloads from marshal.el
+
+(autoload 'marshal "marshal" "\
+
+
+\(fn OBJ TYPE)" nil nil)
+
+(autoload 'unmarshal "marshal" "\
+
+
+\(fn OBJ BLOB TYPE)" nil nil)
+
+(autoload 'marshal-defclass "marshal" "\
+
+
+\(fn NAME SUPERCLASS SLOTS &rest OPTIONS-AND-DOC)" nil t)
+
+(function-put 'marshal-defclass 'lisp-indent-function '2)
+
+(register-definition-prefixes "marshal" '("marshal-" "unmarshal-internal"))
+
+;;;***
+\f
+;; Local Variables:
+;; version-control: never
+;; no-byte-compile: t
+;; no-update-autoloads: t
+;; coding: utf-8
+;; End:
+;;; marshal-autoloads.el ends here
--- /dev/null
+;;; Generated package description from marshal.el -*- no-byte-compile: t -*-
+(define-package "marshal" "20201223.1853" "eieio extension for automatic (un)marshalling" '((emacs "25.1") (ht "2.0")) :commit "490496d974d03906f784707ecc2e0ac36ed84b96" :authors '(("Yann Hodique" . "yann.hodiqueNOSPAMgmail.com")) :maintainer '("Yann Hodique" . "yann.hodiqueNOSPAMgmail.com") :keywords '("extensions") :url "https://github.com/sigma/marshal.el")
--- /dev/null
+;;; marshal.el --- eieio extension for automatic (un)marshalling
+
+;; Copyright (C) 2015-2020 Yann Hodique
+
+;; Author: Yann Hodique <yann.hodiqueNOSPAMgmail.com>
+;; Keywords: extensions
+;; Package-Version: 20201223.1853
+;; Package-Commit: 490496d974d03906f784707ecc2e0ac36ed84b96
+;; Version: 0.9.1
+;; URL: https://github.com/sigma/marshal.el
+;; Package-Requires: ((emacs "25.1") (ht "2.0"))
+
+;; This file 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 2, or (at your option)
+;; any later version.
+
+;; This file 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 GNU Emacs; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Inspired by Go tagged structs. 'alist, 'plist and 'json drivers are
+;; provided, but implementing others just requires to inherit from
+;; `marshal-driver'.
+
+;; Sometimes the types are not enough (for example with lists, whose elements
+;; are not explicitly typed. In those cases, a small extension on top of types
+;; can be used. Like for example :marshal-type (list string)
+
+;; Examples:
+
+;; 1. Regular use:
+
+;; (marshal-defclass plop ()
+;; ((foo :initarg :foo :type string :marshal ((alist . field_foo)))
+;; (bar :initarg :bar :type integer :marshal ((alist . field_bar)))
+;; (baz :initarg :baz :type integer :marshal ((alist . field_baz)))))
+
+;; (marshal-defclass plopi ()
+;; ((alpha :marshal ((alist . field_alpha)))
+;; (beta :type plop :marshal ((alist . field_beta)))))
+
+;; (marshal (make-instance 'plop :foo "ok" :bar 42) 'alist)
+;; => '((field_bar . 42) (field_foo . "ok"))
+
+;; (unmarshal 'plop '((field_foo . "plop") (field_bar . 0) (field_baz . 1)) 'alist)
+;; => '[object plop "plop" "plop" 0 1]
+
+;; (marshal
+;; (unmarshal 'plopi '((field_alpha . 42)
+;; (field_beta . ((field_foo . "plop")
+;; (field_bar . 0)
+;; (field_baz . 1)))) 'alist)
+;; 'alist)
+;; => '((field_beta (field_baz . 1) (field_bar . 0) (field_foo . "plop")) (field_alpha . 42))
+
+;; 2. Objects involving lists:
+
+;; (marshal-defclass foo/tree ()
+;; ((root :initarg :id :marshal ((plist . :root) json))
+;; (leaves :initarg :leaves :marshal ((plist . :leaves) json) :marshal-type (list foo/tree))))
+
+;; (marshal (make-instance 'foo/tree :id 0
+;; :leaves (list (make-instance 'foo/tree :id 1)
+;; (make-instance 'foo/tree :id 2
+;; :leaves (list (make-instance 'foo/tree :id 3)))))
+;; 'plist)
+;; => (:root 0 :leaves ((:root 1) (:root 2 :leaves ((:root 3)))))
+
+;; (unmarshal 'foo/tree '(:root 0 :leaves ((:root 1) (:root 2 :leaves ((:root 3))))) 'plist)
+
+;; => [object foo/tree "foo/tree" 0
+;; ([object foo/tree "foo/tree" 1 nil]
+;; [object foo/tree "foo/tree" 2
+;; ([object foo/tree "foo/tree" 3 nil])])]
+
+;; 3. Json
+
+;; (marshal (make-instance 'foo/tree :id 0
+;; :leaves (list (make-instance 'foo/tree :id 1)
+;; (make-instance 'foo/tree :id 2
+;; :leaves (list (make-instance 'foo/tree :id 3)))))
+;; 'json)
+;; => "{\"leaves\":[{\"root\":1},{\"leaves\":[{\"root\":3}],\"root\":2}],\"root\":0}"
+
+;; (unmarshal 'foo/tree "{\"leaves\":[{\"root\":1},{\"leaves\":[{\"root\":3}],\"root\":2}],\"root\":0}" 'json)
+;; => [object foo/tree "foo/tree" 0
+;; ([object foo/tree "foo/tree" 1 nil]
+;; [object foo/tree "foo/tree" 2
+;; ([object foo/tree "foo/tree" 3 nil])])]
+
+;;; Code:
+
+(require 'eieio)
+
+(eval-and-compile
+ ;;; load json library lazily
+ (dolist (sym '(json-encode json-read-from-string))
+ (autoload sym "json"))
+
+ ;;; load ht library lazily
+ (dolist (sym '(ht-empty? ht-items ht<-alist))
+ (autoload sym "ht")))
+
+;;; Defined drivers
+
+(defvar marshal-drivers nil "Alist of drivers")
+
+(defun marshal-register-driver (type driver)
+ (add-to-list 'marshal-drivers (cons type driver)))
+
+;;; Marshalling driver interface
+
+(defclass marshal-driver ()
+ ((input :initarg :input)
+ (output :initarg :output)))
+
+(cl-defmethod marshal-open ((obj marshal-driver) &optional input)
+ (if input
+ (oset obj :input input)
+ (oset obj :output nil)))
+
+(cl-defmethod marshal-write ((obj marshal-driver) path value)
+ (unless (slot-boundp obj :output)
+ (error "Driver has not been opened in write mode")))
+
+(cl-defmethod marshal-read ((obj marshal-driver) path)
+ (unless (slot-boundp obj :input)
+ (error "Driver has not been opened in read mode")))
+
+(cl-defmethod marshal-close ((obj marshal-driver))
+ (when (slot-boundp obj :output)
+ (oref obj output)))
+
+(cl-defmethod marshal-guess-type ((cls (subclass marshal-driver)) blob)
+ (cond ((null blob) nil)
+ ((booleanp blob) 'bool)
+ ((stringp blob) 'string)
+ ((numberp blob) 'number)
+ ((listp blob) 'list)
+ ((hash-table-p blob) 'hash)))
+
+(cl-defmethod marshal-preprocess ((obj marshal-driver) blob)
+ blob)
+
+(cl-defmethod marshal-postprocess ((obj marshal-driver) blob)
+ blob)
+
+(cl-defmethod marshal-unmarshal-null ((cls (subclass marshal-driver)))
+ nil)
+
+(cl-defmethod marshal-marshal-null ((cls (subclass marshal-driver)))
+ nil)
+
+(cl-defmethod marshal-unmarshal-string ((cls (subclass marshal-driver)) s)
+ (format "%s" s))
+
+(cl-defmethod marshal-marshal-string ((cls (subclass marshal-driver)) s)
+ s)
+
+(cl-defmethod marshal-unmarshal-number ((cls (subclass marshal-driver)) i)
+ i)
+
+(cl-defmethod marshal-marshal-number ((cls (subclass marshal-driver)) i)
+ i)
+
+(cl-defmethod marshal-unmarshal-bool ((cls (subclass marshal-driver)) b)
+ (equal b t))
+
+(cl-defmethod marshal-marshal-bool ((cls (subclass marshal-driver)) b)
+ (equal b t))
+
+(cl-defmethod marshal-unmarshal-list ((cls (subclass marshal-driver)) l l-type)
+ (cons (unmarshal-internal (when (consp l-type)
+ (cadr l-type))
+ (car l) cls)
+ (unmarshal-internal l-type (cdr l) cls)))
+
+(cl-defmethod marshal-marshal-list ((cls (subclass marshal-driver)) l)
+ (unless (null l)
+ (cons (marshal-internal (car l) cls)
+ (marshal-internal (cdr l) cls))))
+
+(cl-defmethod marshal-unmarshal-hash ((cls (subclass marshal-driver)) h h-type)
+ (let ((k-type (when (consp h-type) (nth 1 h-type)))
+ (v-type (when (consp h-type) (nth 2 h-type))))
+ (ht<-alist
+ (mapcar (lambda (item)
+ (cons (unmarshal-internal k-type (car item) cls)
+ (unmarshal-internal v-type (cdr item) cls))) h))))
+
+(cl-defmethod marshal-marshal-hash ((cls (subclass marshal-driver)) h)
+ (unless (ht-empty? h)
+ (mapcar (lambda (item)
+ (cons (marshal-internal (car item) cls)
+ (marshal-internal (cadr item) cls)))
+ (ht-items h))))
+
+;;; alist-based driver
+
+(defclass marshal-driver-alist (marshal-driver)
+ ())
+
+(cl-defmethod marshal-write ((obj marshal-driver-alist) path value)
+ (cl-call-next-method)
+ (object-add-to-list obj :output (cons path value)))
+
+(cl-defmethod marshal-read ((obj marshal-driver-alist) path)
+ (cl-call-next-method)
+ (cdr (assoc path (oref obj input))))
+
+;;; json driver
+
+(defclass marshal-driver-json (marshal-driver-alist)
+ ())
+
+(cl-defmethod marshal-preprocess ((obj marshal-driver-json) blob)
+ (let ((json-array-type 'list)
+ (json-object-type 'alist)
+ (json-false :json-false))
+ (json-read-from-string (cl-call-next-method))))
+
+(cl-defmethod marshal-postprocess ((obj marshal-driver-json) blob)
+ (json-encode (cl-call-next-method)))
+
+(cl-defmethod marshal-unmarshal-bool ((cls (subclass marshal-driver-json)) b)
+ (not (eq b :json-false)))
+
+(cl-defmethod marshal-marshal-bool ((cls (subclass marshal-driver-json)) b)
+ (or b :json-false))
+
+;;; plist-based driver
+
+(defclass marshal-driver-plist (marshal-driver)
+ ())
+
+(cl-defmethod marshal-write ((obj marshal-driver-plist) path value)
+ (cl-call-next-method)
+ (oset obj :output (plist-put (oref obj output) path value)))
+
+(cl-defmethod marshal-read ((obj marshal-driver-plist) path)
+ (cl-call-next-method)
+ (plist-get (oref obj input) path))
+
+;;; helper functions
+
+(defun marshal--alist-add (alist key value &optional append)
+ (let ((existing (assoc key alist)))
+ (if (not existing)
+ (cons (cons key value) alist)
+ (setcdr existing (if append
+ (append (cdr existing) value)
+ value))
+ alist)))
+
+(defun marshal--alist-merge (alist1 alist2 &optional append)
+ (let ((res alist1))
+ (if alist2
+ (let* ((pair (car alist2))
+ (x (car pair))
+ (y (cdr pair)))
+ (marshal--alist-merge
+ (marshal--alist-add alist1 x y append)
+ (cdr alist2)))
+ alist1)))
+
+(defun marshal--transpose-alist2 (l)
+ (let (res
+ (rows l))
+ (while rows
+ (let* ((row (car rows))
+ (x (car row))
+ (cols (cdr row)))
+ (while cols
+ (let* ((col (car cols))
+ (y (car col))
+ (z (cdr col))
+ (target (or (assoc y res)
+ (let ((p (cons y nil)))
+ (setq res (push p res))
+ p))))
+ (setcdr target (cons (cons x z) (cdr target))))
+ (setq cols (cdr cols))))
+ (setq rows (cdr rows)))
+ res))
+
+;;; base-class for serializable objects
+
+(defclass marshal-base ()
+ ((-marshal-info :allocation :class :initform nil :protection :protected)
+ (-type-info :allocation :class :initform nil :protection :protected)))
+
+(cl-defmethod marshal-get-marshal-info ((cls (subclass marshal-base)))
+ (get cls :marshal-info))
+
+(cl-defmethod marshal-get-type-info ((cls (subclass marshal-base)))
+ (get cls :type-info))
+
+(cl-defmethod marshal-get-class-slot ((cls (subclass marshal-base)))
+ (get cls :marshal-class-slot))
+
+(defun marshal-get-driver (type)
+ (let ((cls (or (and (class-p type) type)
+ (cdr (assoc type marshal-drivers))
+ 'marshal-driver)))
+ (make-instance cls)))
+
+(cl-defmethod marshal-internal ((obj marshal-base) type &optional hint)
+ (let* ((type (or (and (class-p type)
+ (car (rassoc type marshal-drivers)))
+ type))
+ (driver (marshal-get-driver type))
+ (marshal-info (cdr (assoc type (marshal-get-marshal-info (eieio-object-class obj))))))
+ (marshal-open driver)
+ (when marshal-info
+ (when (and hint (not (eq hint (eieio-object-class obj))))
+ (marshal-write driver (marshal-get-class-slot hint)
+ (eieio-object-class obj)))
+ (dolist (s (mapcar (lambda (x) (eieio-slot-descriptor-name x)) (eieio-class-slots (eieio-object-class obj))))
+ (let ((path (cdr (assoc s marshal-info))))
+ (when (and path
+ (slot-boundp obj s))
+ (marshal-write driver path
+ (marshal-internal
+ (eieio-oref obj s)
+ type
+ (cdr (assoc s (marshal-get-type-info (eieio-object-class obj))))))))))
+ (marshal-close driver)))
+
+(cl-defmethod marshal-internal ((obj t) type &optional hint)
+ (let ((driver (eieio-object-class (marshal-get-driver type))))
+ (cond ((and (null hint) (null obj))
+ (marshal-marshal-null driver))
+ ((or (eq obj t)
+ (and (null obj) (eq hint 'bool)))
+ (marshal-marshal-bool driver obj))
+ ((stringp obj)
+ (marshal-marshal-string driver obj))
+ ((numberp obj)
+ (marshal-marshal-number driver obj))
+ ((listp obj)
+ (marshal-marshal-list driver obj))
+ ((hash-table-p obj)
+ (marshal-marshal-hash driver obj)))))
+
+;;;###autoload
+(defun marshal (obj type)
+ (let ((driver (marshal-get-driver type)))
+ (marshal-postprocess driver
+ (marshal-internal obj type))))
+
+(cl-defmethod unmarshal--obj ((obj marshal-base) blob type)
+ (let ((driver (marshal-get-driver type))
+ (marshal-info (cdr (assoc type (marshal-get-marshal-info (eieio-object-class obj))))))
+ (marshal-open driver blob)
+ (when (and marshal-info blob)
+ (dolist (s (mapcar (lambda (x) (eieio-slot-descriptor-name x)) (eieio-class-slots (eieio-object-class obj))))
+ (let ((path (cdr (assoc s marshal-info))))
+ (when path
+ (eieio-oset obj s
+ (unmarshal-internal
+ (cdr (assoc s (marshal-get-type-info (eieio-object-class obj))))
+ (marshal-read driver path)
+ type))))))
+ (marshal-close driver)
+ obj))
+
+(defun unmarshal-internal (obj blob type)
+ (let ((obj (if (class-p obj)
+ (let ((driver (marshal-get-driver type)))
+ (let ((cls (or (and
+ (not (null blob))
+ (let ((driver (marshal-get-driver type)))
+ (prog2
+ (marshal-open driver blob)
+ (marshal-read
+ driver
+ (marshal-get-class-slot obj))
+ (marshal-close driver))))
+ obj)))
+ (make-instance cls)))
+ obj)))
+ (unmarshal--internal obj blob type)))
+
+(cl-defmethod unmarshal--internal ((obj t) blob type)
+ (let* ((driver (eieio-object-class (marshal-get-driver type)))
+ (obj (or obj (marshal-guess-type driver blob))))
+ (cond ((or (null obj) (null blob))
+ (marshal-unmarshal-null driver))
+ ((eq obj 'bool)
+ (marshal-unmarshal-bool driver blob))
+ ((eq obj 'string)
+ (marshal-unmarshal-string driver blob))
+ ((memq obj '(number integer))
+ (marshal-unmarshal-number driver blob))
+ ((or (eq obj 'list)
+ (and (consp obj) (eq (car obj) 'list)))
+ (marshal-unmarshal-list driver blob obj))
+ ((or (eq obj 'hash)
+ (and (consp obj) (eq (car obj) 'hash)))
+ (marshal-unmarshal-hash driver blob obj)))))
+
+(cl-defmethod unmarshal--internal ((obj marshal-base) blob type)
+ (let ((type (or (and (class-p type)
+ (car (rassoc type marshal-drivers)))
+ type)))
+ (unmarshal--obj obj blob type)))
+
+;;;###autoload
+(defun unmarshal (obj blob type)
+ (let ((driver (marshal-get-driver type)))
+ (unmarshal-internal obj (marshal-preprocess driver blob) type)))
+
+;;;###autoload
+(defmacro marshal-defclass (name superclass slots &rest options-and-doc)
+ (declare (debug t) (indent 2))
+ (let* ((options (if (stringp (car options-and-doc))
+ (cdr options-and-doc)
+ options-and-doc))
+ (default-spec-func (or (plist-get options :marshal-default-spec)
+ 'ignore))
+ (base-cls (or (plist-get options :marshal-base-cls)
+ 'marshal-base))
+ (cls-slot (or (plist-get options :marshal-class-slot)
+ :-cls))
+ (marshal-info (marshal--transpose-alist2
+ (remove nil
+ (mapcar
+ (lambda (s)
+ (let ((name (car s)))
+ (let ((marshal
+ (or (plist-get (cdr s) :marshal)
+ (funcall default-spec-func name))))
+ (when marshal
+ (cons name
+ (mapcar
+ (lambda (p)
+ (if (consp p)
+ p
+ (cons p name)))
+ marshal))))))
+ slots))))
+ (type-info (remove nil
+ (mapcar (lambda (s)
+ (let ((name (car s)))
+ (let ((type (or (plist-get (cdr s) :marshal-type)
+ (plist-get (cdr s) :type))))
+ (when type
+ (cons name type)))))
+ slots))))
+ `(progn
+ (defclass ,name (,@superclass ,base-cls)
+ (,@slots)
+ ,@options-and-doc)
+
+ (put ',name :marshal-class-slot ',cls-slot)
+
+ (put ',name :marshal-info ',marshal-info)
+ (dolist (cls ',superclass)
+ (put ',name :marshal-info
+ (marshal--alist-merge (get ',name :marshal-info)
+ (marshal-get-marshal-info cls) t)))
+
+ (put ',name :type-info ',type-info)
+ (dolist (cls ',superclass)
+ (put ',name :type-info
+ (marshal--alist-merge (get ',name :type-info)
+ (marshal-get-type-info cls) t)))
+
+ ,name)))
+
+;;; Default drivers
+(marshal-register-driver 'alist 'marshal-driver-alist)
+(marshal-register-driver 'plist 'marshal-driver-plist)
+(marshal-register-driver 'json 'marshal-driver-json)
+
+(provide 'marshal)
+;;; marshal.el ends here
projects / emacsconfig.git / commitdiff