[ { "path": ".editorconfig", "content": "root = true\n\n[*]\nend_of_line = lf\ninsert_final_newline = true\ncharset = utf-8\ntrim_trailing_whitespace = true\n\n[*.{el}]\nindent_style = space\n" }, { "path": ".gitignore", "content": "#.*#\n*#*#\n*.#*\nflycheck_*\n*.elc" }, { "path": ".travis.yml", "content": "language: emacs-lisp\nsudo: false\nenv:\n - EVM_EMACS=emacs-25.1-travis\n - EVM_EMACS=emacs-25.2-travis\n - EVM_EMACS=emacs-25.3-travis\n - EVM_EMACS=emacs-26.1-travis\n - EVM_EMACS=emacs-git-snapshot-travis\nscript:\n - make test\n" }, { "path": "Makefile", "content": "# Really just so we can run 'make test' easily\n\nall: test\n\ntest:\n\t@emacs -batch \\\n\t-l ert \\\n\t-l t/batch-runner/s.el \\\n\t-l t/batch-runner/request.el \\\n\t-l t/batch-runner/dash.el \\\n\t-l jiralib.el \\\n\t-l org-jira-sdk.el \\\n\t-l org-jira.el \\\n\t-l t/org-jira-t.el \\\n\t-l t/jiralib-t.el \\\n\t-f ert-run-tests-batch-and-exit\n\n.PHONY: test\n" }, { "path": "README.md", "content": "# org-jira mode\n\n[![Join the chat at https://gitter.im/org-jira/Lobby](https://badges.gitter.im/org-jira/Lobby.svg)](https://gitter.im/org-jira/Lobby?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge)\n[![MELPA](http://melpa.org/packages/org-jira-badge.svg)](http://melpa.org/#/org-jira)\n\nUse Jira in Emacs org-mode.\n\n## TOC\n\n\n**Table of Contents**\n\n- [org-jira mode](#org-jira-mode)\n - [TOC](#toc)\n - [Setup](#setup)\n - [Installation](#installation)\n - [Configuration](#configuration)\n - [Usage](#usage)\n - [Getting Started](#getting-started)\n - [Keybinds](#keybinds)\n - [Customization](#customization)\n - [Authorization workaround (NOT secure)](#authorization-workaround-not-secure)\n - [Optimizations](#optimizations)\n - [Optimizing available actions for status changes](#optimizing-available-actions-for-status-changes)\n - [About](#about)\n - [Maintainer](#maintainer)\n - [License](#license)\n\n\n\n\n## Setup\n### Installation\nTo install, just grab it off of MELPA (ensure your ~/.emacs already\nhas MELPA set up):\n\n```lisp\n(require 'package)\n(add-to-list 'package-archives '(\"melpa\" . \"http://melpa.milkbox.net/packages/\") t)\n(package-initialize)\n```\n\nThen run `M-x package-install RET org-jira RET` and you're done!\n### Configuration\nIn your ~/.emacs, you should set the variable as such:\n\n```conf\n(setq jiralib-url \"https://your-site.atlassian.net\")\n```\n\nIf you don't want to enter your credentials (login/password) each time\nyou go to connect, you can add to your ~/.authinfo.gpg or ~/.authinfo\nfile, in a format similar to:\n\n```conf\nmachine your-site.atlassian.net login you@example.com password yourPassword port 80\n```\n_Please note that in the authinfo file, port 443 should be specified\nif your jiralib-url is https._\n\n## Usage\n### Getting Started\norg-jira mode is easy to use, to get started (after installing this\nlibrary) try running `M-x org-jira-get-issues`. You should see that\nit pulls in all issues that are assigned to you.\n\nFollowing that, you can try out some of the org-jira mode commands by\nvisiting one of the files (they're named after your Jira project code,\nfor example, 'EX.org' for a project named 'EX').\n### Keybinds\nSome of the important keybindings:\n\n```lisp\n(define-key org-jira-map (kbd \"C-c pg\") 'org-jira-get-projects)\n(define-key org-jira-map (kbd \"C-c ib\") 'org-jira-browse-issue)\n(define-key org-jira-map (kbd \"C-c ig\") 'org-jira-get-issues)\n(define-key org-jira-map (kbd \"C-c ih\") 'org-jira-get-issues-headonly)\n(define-key org-jira-map (kbd \"C-c iu\") 'org-jira-update-issue)\n(define-key org-jira-map (kbd \"C-c iw\") 'org-jira-progress-issue)\n(define-key org-jira-map (kbd \"C-c in\") 'org-jira-progress-issue-next)\n(define-key org-jira-map (kbd \"C-c ia\") 'org-jira-assign-issue)\n(define-key org-jira-map (kbd \"C-c ir\") 'org-jira-refresh-issue)\n(define-key org-jira-map (kbd \"C-c iR\") 'org-jira-refresh-issues-in-buffer)\n(define-key org-jira-map (kbd \"C-c ic\") 'org-jira-create-issue)\n(define-key org-jira-map (kbd \"C-c ik\") 'org-jira-copy-current-issue-key)\n(define-key org-jira-map (kbd \"C-c sc\") 'org-jira-create-subtask)\n(define-key org-jira-map (kbd \"C-c sg\") 'org-jira-get-subtasks)\n(define-key org-jira-map (kbd \"C-c cc\") 'org-jira-add-comment)\n(define-key org-jira-map (kbd \"C-c cu\") 'org-jira-update-comment)\n(define-key org-jira-map (kbd \"C-c wu\") 'org-jira-update-worklogs-from-org-clocks)\n(define-key org-jira-map (kbd \"C-c tj\") 'org-jira-todo-to-jira)\n(define-key org-jira-map (kbd \"C-c if\") 'org-jira-get-issues-by-fixversion)\n```\n\n### Customization\nYou can define your own streamlined issue progress flow as such:\n\n```lisp\n(defconst org-jira-progress-issue-flow\n '((\"To Do\" . \"In Progress\"\n (\"In Progress\" . \"Done\"))))\n```\nor using typical Emacs customize options, as its a defcustom.\n\nThis will allow you to quickly progress an issue based on its current\nstatus, and what the next status should be.\n\nIf your Jira is set up to display a status in the issue differently\nthan what is shown in the button on Jira, your alist may look like\nthis (use the labels shown in the org-jira Status when setting it up,\nor manually work out the workflows being used through\nstandard `C-c iw` options/usage):\n\n```lisp\n(defconst org-jira-progress-issue-flow\n '((\"To Do\" . \"Start Progress\")\n (\"In Development\" . \"Ready For Review\")\n (\"Code Review\" . \"Done\")\n (\"Done\" . \"Reopen\")))\n```\n\n#### Authorization workaround (NOT secure)\nIf your Jira instance has disabled basic auth, you can still get in\nby copying your web browser's cookie (open up developer console, and\nright click and 'Copy request as cURL', then copy/paste the cookie\ninto the jiralib-token variable):\n\n```lisp\n(defconst jiralib-token\n (cons \"Cookie\" . \"eyJ, or file an\nissue here on https://github.com/ahungry/org-jira.\n\n### License\n\nGPLv3\n" }, { "path": "jiralib.el", "content": ";;; jiralib.el -- Provide connectivity to JIRA SOAP/REST services.\n\n;; Copyright (C) 2016,2017 Matthew Carter \n;; Copyright (C) 2011 Bao Haojun\n;; original Copyright (C) 2009 Alex Harsanyi\n\n;; Also, used some code from jira.el, which use xml-rpc instead of soap.\n;; Thus Copyright (C) for jira.el related code:\n;; Brian Zwahr \n;; Dave Benjamin \n\n;; Authors:\n;; Matthew Carter \n;; Bao Haojun \n;; Alex Harsanyi \n\n;; Maintainer: Matthew Carter \n;; Version: 3.0.0\n;; Homepage: https://github.com/ahungry/org-jira\n\n;; This file is not part of GNU Emacs.\n\n;; This program is free software: you can redistribute it and/or modify\n;; it under the terms of the GNU General Public License as published by\n;; the Free Software Foundation, either version 3 of the License, or\n;; (at your option) any later version.\n\n;; This program is distributed in the hope that it will be useful,\n;; but WITHOUT ANY WARRANTY; without even the implied warranty of\n;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n;; GNU General Public License for more details.\n\n;; You should have received a copy of the GNU General Public License\n;; along with this program. If not, see\n;; or write to the Free Software\n;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA\n;; 02110-1301, USA.\n\n;; Author: Alexandru Harsanyi (AlexHarsanyi@gmail.com)\n;; Created: December, 2009\n;; Keywords: soap, web-services, jira\n;; Homepage: http://code.google.com/p/emacs-soap-client\n\n;;; Commentary:\n\n;; This file provides a programatic interface to JIRA. It provides access to\n;; JIRA from other programs, but no user level functionality.\n\n;; Jira References:\n\n;; Primary reference (on current Jira, only REST is supported):\n;; https://developer.atlassian.com/jiradev/jira-apis/jira-rest-apis\n\n;; Full API list reference:\n;; https://docs.atlassian.com/jira/REST/cloud/\n\n;; Legacy reference (unsupported and deprecated/unavailable):\n;; http://confluence.atlassian.com/display/JIRA/Creating+a+SOAP+Client\n\n;; JavaDoc for the Jira SOAP service\n;; http://docs.atlassian.com/software/jira/docs/api/rpc-jira-plugin/latest/com/atlassian/jira/rpc/soap/JiraSoapService.html\n\n;;; News:\n\n;;;; Changes since 2.6.3:\n;; - Add worklog import filter and control variable for external worklogs.\n;; - Add the worklog related endpoint/calls.\n\n;;;; Changes since 2.1.0:\n;; - Remove os_username / os_password manual http request as part of sign in process\n;; This produces sysadmin level warnings on Jira when these are used under the latest Jira.\n;; - Remove unused function jiralib-link-issue\n;; - Bring version up to match org-jira version so they can share tag\n\n;;;; Changes since 2.0.0:\n;; - Allow issue type query by project\n\n;;;; Changes since 0.0.0:\n;; - Converted many calls to async\n;; - Converted many calls to make use of caching\n\n;;; Code:\n\n(eval-when-compile (require 'cl))\n(require 'soap-client)\n(require 'request)\n(require 'json)\n(require 'url-parse)\n(require 'url-util)\n\n(defconst jiralib-version \"3.0.0\"\n \"Current version of jiralib.el.\")\n\n(defgroup jiralib nil\n \"Jiralib customization group.\"\n :group 'applications)\n\n(defgroup jiralib-faces nil\n \"Faces for displaying Jiralib information.\"\n :group 'jiralib)\n\n(defcustom jiralib-use-restapi t\n \"Use restapi instead of soap.\"\n :group 'jiralib\n :type 'boolean\n :initialize 'custom-initialize-set)\n\n(defcustom jiralib-host \"\"\n \"User customizable host name of the Jiralib server.\n\nThis will be used with USERNAME to compute password from\n.authinfo file. Will be calculated from jiralib-url if not set.\"\n :group 'jiralib\n :type 'string\n :initialize 'custom-initialize-set)\n\n(defface jiralib-issue-info-face\n '((t (:foreground \"black\" :background \"yellow4\")))\n \"Base face for issue information.\"\n :group 'jiralib-faces)\n\n(defface jiralib-issue-info-header-face\n '((t (:bold t :inherit 'jiralib-issue-info-face)))\n \"Base face for issue headers.\"\n :group 'jiralib-faces)\n\n(defface jiralib-issue-summary-face\n '((t (:bold t)))\n \"Base face for issue summary.\"\n :group 'jiralib-faces)\n\n(defface jiralib-comment-face\n '((t (:background \"gray23\")))\n \"Base face for comments.\"\n :group 'jiralib-faces)\n\n(defface jiralib-comment-header-face\n '((t (:bold t)))\n \"Base face for comment headers.\"\n :group 'jiralib-faces)\n\n(defface jiralib-link-issue-face\n '((t (:underline t)))\n \"Face for linked issues.\"\n :group 'jiralib-faces)\n\n(defface jiralib-link-project-face\n '((t (:underline t)))\n \"Face for linked projects\"\n :group 'jiralib-faces)\n\n(defface jiralib-link-filter-face\n '((t (:underline t)))\n \"Face for linked filters\"\n :group 'jiralib-faces)\n\n(defvar jiralib-mode-hook nil)\n(defvar jiralib-mode-map nil)\n(defvar jiralib-issue-regexp \"\\\\<\\\\(?:[A-Za-z0-9]+\\\\)-[0-9]+\\\\>\")\n\n(defcustom jiralib-wsdl-descriptor-url\n \"\"\n \"The location for the WSDL descriptor for the JIRA service.\nThis is specific to your local JIRA installation. The URL is\ntypically:\n\n http://YOUR_INSTALLATION/rpc/soap/jirasoapservice-v2?wsdl\n\nThe default value works if JIRA is located at a hostname named\n'jira'.\"\n :type 'string\n :group 'jiralib)\n\n(defcustom jiralib-url\n \"http://localhost:8081/\"\n \"The address of the jira host.\"\n :type 'string\n :group 'jiralib)\n\n(defcustom jiralib-agile-page-size\n 50\n \"Page size for agile API retrieve. Limited by server property jira.search.views.default.max\"\n :type 'integer\n :group 'jiralib)\n\n(defvar jiralib-token nil\n \"JIRA token used for authentication.\")\n\n(defvar jiralib-rest-auth-head nil\n \"JIRA restapi auth head.\")\n\n(defvar jiralib-user-login-name nil\n \"The name of the user logged into JIRA.\nThis is maintained by `jiralib-login'.\")\n\n(defvar jiralib-wsdl nil)\n\n(defcustom jiralib-worklog-import--filters-alist\n (list\n '(nil \"WorklogUpdatedByCurrentUser\" (lambda (wl) (let-alist wl (when (and wl (string-equal (downcase (or jiralib-user-login-name user-login-name)) (downcase .updateAuthor.name))) wl))))\n '(nil \"WorklogAuthoredByCurrentUser\" (lambda (wl) (let-alist wl (when (and wl (string-equal (downcase (or jiralib-user-login-name user-login-name)) (downcase .author.name))) wl)))))\n \"A list of triplets: ('Global-Enable 'Descriptive-Label 'Function-Definition)\nthat apply worklog predicate filters during import.\n\nExample: (list '('t \\\"descriptive-predicate-label\\\" (lambda (x) x)))\"\n :type '(repeat (list boolean string function))\n :group 'org-jira)\n\n\n\n(defun jiralib-load-wsdl ()\n \"Load the JIRA WSDL descriptor.\"\n (setq jiralib-wsdl (soap-load-wsdl-from-url (if (string-equal jiralib-wsdl-descriptor-url \"\")\n (concat jiralib-url \"/rpc/soap/jirasoapservice-v2?wsdl\")\n jiralib-wsdl-descriptor-url))))\n\n(defun jiralib-login (username password)\n \"Login into JIRA as user USERNAME with PASSWORD.\n\nAfter a successful login, store the authentication token in\n`jiralib-token'.\"\n ;; NOTE that we cannot rely on `jiralib-call' because `jiralib-call' relies on\n ;; us ;-)\n (interactive\n (if (> 24 emacs-major-version)\n (let ((user (read-string \"Username for Jira server login? \"))\n (password (read-passwd \"Password for Jira server login? \")))\n (list user password))\n (let ((found (nth 0 (auth-source-search :max 1\n :host (if (string= jiralib-host \"\")\n (url-host (url-generic-parse-url jiralib-url))\n jiralib-host)\n ;; secrets.el wouldn’t accept a number.\n :port (number-to-string (url-port (url-generic-parse-url jiralib-url)))\n :require '(:user :secret)\n :create t)))\n user secret)\n (when found\n (setq user (plist-get found :user)\n secret\n (let ((sec (plist-get found :secret)))\n (if (functionp sec)\n (funcall sec)\n sec)))\n (list user secret)))))\n (if jiralib-use-restapi\n (setq jiralib-token `(\"Authorization\" . , (format \"Basic %s\" (base64-encode-string (concat username \":\" password)))))\n (unless jiralib-wsdl\n (jiralib-load-wsdl))\n (setq jiralib-token\n (car (soap-invoke jiralib-wsdl \"jirasoapservice-v2\" \"login\" username password))))\n (setq jiralib-user-login-name username))\n\n(defvar jiralib-complete-callback nil)\n\n(defun jiralib-call (method callback &rest params)\n \"Invoke the Jira METHOD, then CALLBACK with supplied PARAMS.\n\nThis function should be used for all JIRA interface calls, as the\nmethod ensures the user is logged in and invokes `soap-invoke'\nwith the correct service name and authentication token.\n\nAll JIRA interface methods take an authentication token as the\nfirst argument. The authentication token is supplied by this\nfunction, so PARAMS should omit this parameter. For example, the\n\\\"getIssue\\\" method takes two parameters: auth and key, however,\nwhen invoking it through `jiralib-call', the call should be:\n\n (jiralib-call \\\"getIssue\\\" KEY)\n\nCALLBACK should be the post processing function to run with the\ncompleted data from the request result, which can be accessed with:\n\n (getf data :data)\n\nas such, the CALLBACK should follow this type of form:\n\n (cl-function\n (lambda (&rest data &allow-other-keys)\n (print (getf data :data))))\n\nIf CALLBACK is set to nil then the request will occur with sync.\nThis produces a noticeable slowdown and is not recommended by\nrequest.el, so if at all possible, it should be avoided.\"\n ;; @todo :auth: Probably pass this all the way down, but I think\n ;; it may be OK at the moment to just set the variable each time.\n (setq jiralib-complete-callback\n ;; Don't run with async if we don't have a login token yet.\n (if jiralib-token callback nil))\n\n ;; If we don't have a regex set, ensure it is set BEFORE any async\n ;; calls are processing, or we're going to have a bad time.\n ;; This should only end up running once per session.\n (unless jiralib-issue-regexp\n (let ((projects (mapcar (lambda (e) (downcase (cdr (assoc 'key e))))\n (append (jiralib--rest-call-it\n \"/rest/api/2/project\"\n :params '((expand . \"description,lead,url,projectKeys\")))\n nil)\n )))\n (when projects\n (setq jiralib-issue-regexp\n (concat \"\\\\<\" (regexp-opt projects) \"-[0-9]+\\\\>\")))))\n\n (if (not jiralib-use-restapi)\n (car (apply 'jiralib--call-it method params))\n (unless jiralib-token\n (call-interactively 'jiralib-login))\n (case (intern method)\n ('getStatuses (jiralib--rest-call-it \"/rest/api/2/status\"))\n ('getIssueTypes (jiralib--rest-call-it \"/rest/api/2/issuetype\"))\n ('getIssueTypesByProject\n (let ((response (jiralib--rest-call-it (format \"/rest/api/2/project/%s\" (first params)))))\n (cl-coerce (cdr (assoc 'issueTypes response)) 'list)))\n ('getUser (jiralib--rest-call-it \"/rest/api/2/user\" :params `((username . ,(first params)))))\n ('getVersions (jiralib--rest-call-it (format \"/rest/api/2/project/%s/versions\" (first params))))\n\n ;; Worklog calls\n ('getWorklogs\n (jiralib--rest-call-it (format \"/rest/api/2/issue/%s/worklog\" (first params))))\n\n ('addWorklog\n (jiralib--rest-call-it (format \"/rest/api/2/issue/%s/worklog\" (first params))\n :type \"POST\"\n :data (json-encode (second params))))\n\n ('updateWorklog\n (jiralib--rest-call-it (format \"/rest/api/2/issue/%s/worklog/%s\" (first params) (second params))\n :type \"PUT\"\n :data (json-encode (third params))))\n\n ('addWorklogAndAutoAdjustRemainingEstimate\n (jiralib--rest-call-it (format \"/rest/api/2/issue/%s/worklog\" (first params))\n :type \"POST\"\n :data (json-encode (second params))))\n\n ('addComment (jiralib--rest-call-it\n (format \"/rest/api/2/issue/%s/comment\" (first params))\n :type \"POST\"\n :data (json-encode (second params))))\n ('createIssue\n ;; Creating the issue doesn't return it, a second call must be\n ;; made to pull it in by using the self key in response.\n (let ((response (jiralib--rest-call-it\n \"/rest/api/2/issue\"\n :type \"POST\"\n :data (json-encode (first params)))))\n (jiralib--rest-call-it (cdr (assoc 'self response)) :type \"GET\")\n ))\n ('createIssueWithParent (jiralib--rest-call-it\n ))\n ('editComment (jiralib--rest-call-it\n (format \"/rest/api/2/issue/%s/comment/%s\" (first params) (second params))\n :data (json-encode `((body . ,(third params))))\n :type \"PUT\"))\n ('getBoard (jiralib--rest-call-it (format \"/rest/agile/1.0/board/%s\" (first params))))\n ('getBoards (apply 'jiralib--agile-call-it \"/rest/agile/1.0/board\" 'values params))\n ('getComment (org-jira-find-value\n (jiralib--rest-call-it\n (format \"/rest/api/2/issue/%s/comment/%s\" (first params) (second params)))\n 'comments))\n ('getComments (org-jira-find-value\n (jiralib--rest-call-it\n (format \"/rest/api/2/issue/%s/comment\" (first params)))\n 'comments))\n ('getAttachmentsFromIssue (org-jira-find-value\n (jiralib--rest-call-it\n (format \"/rest/api/2/issue/%s?fields=attachment\" (first params)))\n 'comments))\n ('getComponents (jiralib--rest-call-it\n (format \"/rest/api/2/project/%s/components\" (first params))))\n ('getIssue (jiralib--rest-call-it\n (format \"/rest/api/2/issue/%s\" (first params))))\n ('getIssuesFromBoard (apply 'jiralib--agile-call-it\n\t\t\t\t (format \"rest/agile/1.0/board/%d/issue\" (first params))\n\t\t\t\t 'issues\n\t\t\t\t (cdr params)))\n ('getIssuesFromJqlSearch (append (cdr ( assoc 'issues (jiralib--rest-call-it\n \"/rest/api/2/search\"\n :type \"POST\"\n :data (json-encode `((jql . ,(first params))\n (maxResults . ,(second params)))))))\n nil))\n ('getPriorities (jiralib--rest-call-it\n \"/rest/api/2/priority\"))\n ('getProjects (jiralib--rest-call-it \"rest/api/2/project\"))\n ('getProjectsNoSchemes (append (jiralib--rest-call-it\n \"/rest/api/2/project\"\n :params '((expand . \"description,lead,url,projectKeys\"))) nil))\n ('getResolutions (append (jiralib--rest-call-it\n \"/rest/api/2/resolution\") nil))\n ('getAvailableActions\n (mapcar\n (lambda (trans)\n `(,(assoc 'name trans) ,(assoc 'id trans)))\n (cdadr (jiralib--rest-call-it (format \"/rest/api/2/issue/%s/transitions\" (first params))))))\n ('getFieldsForAction (org-jira-find-value (car (let ((issue (first params))\n (action (second params)))\n (seq-filter (lambda (trans)\n (or (string-equal action (org-jira-find-value trans 'id))\n (string-equal action (org-jira-find-value trans 'name))))\n (cdadr (jiralib--rest-call-it\n (format \"/rest/api/2/issue/%s/transitions\" (first params))\n :params '((expand . \"transitions.fields\")))))))\n 'fields))\n ('progressWorkflowAction (jiralib--rest-call-it\n (format \"/rest/api/2/issue/%s/transitions\" (first params))\n :type \"POST\"\n :data (json-encode `(,(car (second params)) ,(car (third params))))))\n ('getUsers\n (jiralib--rest-call-it (format \"/rest/api/2/user/assignable/search?project=%s&maxResults=10000\" (first params))\n :type \"GET\"))\n ('updateIssue (jiralib--rest-call-it\n (format \"/rest/api/2/issue/%s\" (first params))\n :type \"PUT\"\n :data (json-encode `((fields . ,(second params)))))))))\n\n(defun jiralib--soap-call-it (&rest args)\n \"Deprecated SOAP call endpoint. Will be removed soon.\nPass ARGS to jiralib-call.\"\n (let ((jiralib-token nil)\n (jiralib-use-restapi nil))\n (apply #'jiralib-call args)))\n\n(defun jiralib--rest-call-it (api &rest args)\n \"Invoke the corresponding jira rest method API.\nInvoking COMPLETE-CALLBACK when the\nJIRALIB-COMPLETE-CALLBACK is non-nil, request finishes, and\npassing ARGS to REQUEST.\"\n (append (request-response-data\n (apply #'request (if (string-match \"^http[s]*://\" api) api ;; If an absolute path, use it\n (concat (replace-regexp-in-string \"/*$\" \"/\" jiralib-url)\n (replace-regexp-in-string \"^/*\" \"\" api)))\n :sync (not jiralib-complete-callback)\n :headers `(,jiralib-token (\"Content-Type\" . \"application/json\"))\n :parser 'json-read\n :complete jiralib-complete-callback\n args))\n nil))\n\n(defun jiralib--call-it (method &rest params)\n \"Invoke the JIRA METHOD with supplied PARAMS.\n\nInternal use, returns a list of responses, of which only the\nfirst is normally used.\"\n (when (symbolp method)\n (setq method (symbol-name method)))\n (unless jiralib-token\n (call-interactively 'jiralib-login))\n (condition-case data\n (apply 'soap-invoke jiralib-wsdl \"jirasoapservice-v2\"\n method jiralib-token params)\n (soap-error\n ;; If we are here, we had a token, but it expired. Re-login and try\n ;; again.\n (setq jiralib-token nil)\n (call-interactively 'jiralib-login)\n (apply 'soap-invoke jiralib-wsdl \"jirasoapservice-v2\"\n method jiralib-token params))))\n\n\f\n;;;; Some utility functions\n\n(defun jiralib-make-list (data field)\n \"Map all assoc elements in DATA to the value of FIELD in that element.\"\n (loop for element in data\n collect (cdr (assoc field element))))\n\n(defun jiralib-make-assoc-list (data key-field value-field)\n \"Create an association list from a SOAP structure array.\n\nDATA is a list of association lists (a SOAP array-of type)\nKEY-FIELD is the field to use as the key in the returned alist\nVALUE-FIELD is the field to use as the value in the returned alist\"\n (loop for element in data\n collect (cons (cdr (assoc key-field element))\n (cdr (assoc value-field element)))))\n\n(defun jiralib-make-remote-field-values (fields)\n \"Transform the (KEY . VALUE) list FIELDS into a RemoteFieldValue structure.\n\nEach (KEY . VALUE) pair is transformed into\n ((id . KEY) (values . (VALUE)))\n\nThis method exists because Several JIRA methods require a\nRemoteFieldValue list, but it is easier to work with ALISTS in\nemacs-lisp\"\n (let ((remote-field-values))\n\n ;; we accept an ALIST of field-name field-values parameter, but we need to\n ;; construct a structure that encodes as a RemoteFieldValue which is what\n ;; updateIssue wants\n (dolist (field fields)\n (let ((name (car field))\n (value (cdr field)))\n (when (symbolp name)\n (setq name (symbol-name name)))\n ;; Value must be an \"array\" (for which soap-client accepts lists) even\n ;; if it is just one value\n (unless (vectorp value)\n (setq value (vector value)))\n (push `((id . ,name) (values . ,value))\n remote-field-values)))\n\n (apply 'vector (nreverse remote-field-values))))\n\f\n;;;; Wrappers around JIRA methods\n\n(defun jiralib--rest-api-for-issue-key (key)\n \"Return jira rest api for issue KEY.\"\n (concat \"rest/api/2/issue/\" key))\n\n(defun jiralib-update-issue (key fields &optional callback)\n \"Update the issue with id KEY with the values in FIELDS, invoking CALLBACK.\"\n (jiralib-call\n \"updateIssue\"\n callback\n key (if jiralib-use-restapi\n fields\n (jiralib-make-remote-field-values fields))))\n\n(defvar jiralib-status-codes-cache nil)\n\n(defun jiralib-get-statuses ()\n \"Return an assoc list mapping a status code to its name.\nNOTE: Status codes are stored as strings, not numbers.\n\nThis function will only ask JIRA for the list of codes once, then\nwill cache it.\"\n (unless jiralib-status-codes-cache\n (setq jiralib-status-codes-cache\n (jiralib-make-assoc-list (jiralib-call \"getStatuses\" nil) 'id 'name)))\n jiralib-status-codes-cache)\n\n(defvar jiralib-issue-types-cache nil)\n\n(defun jiralib-get-issue-types ()\n \"Return an assoc list mapping an issue type code to its name.\nNOTE: Issue type codes are stored as strings, not numbers.\n\nThis function will only ask JIRA for the list of codes once, than\nwill cache it.\n\nThe issue types returned via getIssueTypes are all the ones\navailable to the user, but not necessarily available to the given\nproject.\n\nThis endpoint is essentially a master reference for when issue\ntypes need a name lookup when given an id.\n\nFor applying issue types to a given project that is being created, see\nthe #'jiralib-get-issue-types-by-project call.\"\n (unless jiralib-issue-types-cache\n (setq jiralib-issue-types-cache\n (jiralib-make-assoc-list (jiralib-call \"getIssueTypes\" nil) 'id 'name)))\n jiralib-issue-types-cache)\n\n(defvar jiralib-issue-types-by-project-cache nil \"An alist of available issue types.\")\n\n(defun jiralib-get-issue-types-by-project (project)\n \"Return the available issue types for PROJECT.\n\nPROJECT should be the key, such as `EX' or `DEMO'.\"\n (unless (assoc project jiralib-issue-types-by-project-cache)\n (push (cons project\n (jiralib-make-assoc-list\n (jiralib-call \"getIssueTypesByProject\" nil project)\n 'id 'name))\n jiralib-issue-types-by-project-cache))\n (cdr (assoc project jiralib-issue-types-by-project-cache)))\n\n(defvar jiralib-priority-codes-cache nil)\n\n(defun jiralib-get-priorities ()\n \"Return an assoc list mapping a priority code to its name.\nNOTE: Priority codes are stored as strings, not numbers.\n\nThis function will only ask JIRA for the list of codes once, than\nwill cache it.\"\n (unless jiralib-priority-codes-cache\n (setq jiralib-priority-codes-cache\n (jiralib-make-assoc-list (jiralib-call \"getPriorities\" nil) 'id 'name)))\n jiralib-priority-codes-cache)\n\n(defvar jiralib-resolution-code-cache nil)\n\n(defun jiralib-get-resolutions ()\n \"Return an assoc list mapping a resolution code to its name.\nNOTE: Resolution codes are stored as strings, not numbers.\n\nThis function will only ask JIRA for the list of codes once, than\nwill cache it.\"\n (unless jiralib-resolution-code-cache\n (setq jiralib-resolution-code-cache\n (jiralib-make-assoc-list (jiralib-call \"getResolutions\" nil) 'id 'name)))\n jiralib-resolution-code-cache)\n\n;; NOTE: it is not such a good idea to use this, as it needs a JIRA\n;; connection to construct the regexp (the user might be prompted for a JIRA\n;; username and password).\n;;\n;; The best use of this function is to generate the regexp once-off and\n;; persist it somewhere.\n;;\n;; FIXME: Probably just deprecate/remove this, we can assert we're on\n;; an issue with a general regexp that matches the common format, vs\n;; needing to know specific user project list.\n(defun jiralib-get-issue-regexp ()\n \"Return a regexp that will match an issue id.\n\nThe regexp is constructed from the project keys in the JIRA\ndatabase. An issue is assumed to be in the format KEY-NUMBER,\nwhere KEY is a project key and NUMBER is the issue number.\"\n (unless jiralib-issue-regexp\n (let ((projects (mapcar (lambda (e) (downcase (cdr (assoc 'key e))))\n (jiralib-call \"getProjectsNoSchemes\" nil))))\n (when projects\n (setq jiralib-issue-regexp\n (concat \"\\\\<\" (regexp-opt projects) \"-[0-9]+\\\\>\")))))\n jiralib-issue-regexp)\n\n(defun jiralib-do-jql-search (jql &optional limit callback)\n \"Run a JQL query and return the list of issues that matched.\nLIMIT is the maximum number of queries to return. Note that JIRA\nhas an internal limit of how many queries to return, as such, it\nmight not be possible to find *ALL* the issues that match a\nquery.\"\n (unless (or limit (numberp limit))\n (setq limit 100))\n (jiralib-call \"getIssuesFromJqlSearch\" callback jql limit))\n\n(defcustom jiralib-available-actions-cache-p t\n \"Set to t to enable caching for jiralib-get-available-actions.\n\nIf nil, will disable caching for this endpoint.\n\nPossible side-effects:\n\n - If the server has the project workflow updated, the cache\nsaved here will be incorrect.\n\n - If the issue is not up to date with the remote, the wrong\ncache key may be queried.\"\n :type 'boolean\n :group 'jiralib)\n\n(defvar jiralib-available-actions-cache nil \"An alist of available actions.\")\n\n(defun jiralib-get-available-actions (issue-key &optional status)\n \"Return the available workflow actions for ISSUE-KEY.\nThis uses STATUS as the cache key.\nThis runs the getAvailableActions SOAP method.\"\n (if (and jiralib-available-actions-cache-p status)\n (progn\n (unless (assoc status jiralib-available-actions-cache)\n (push (cons status\n (jiralib-make-assoc-list\n (mapcar (lambda (x)\n (let ((namestring (cdr (car x)))\n (id (cdr x)))\n (cons\n (cons 'name (org-jira-decode namestring))\n id)))\n (jiralib-call \"getAvailableActions\" nil issue-key))\n 'id 'name))\n jiralib-available-actions-cache))\n (cdr (assoc status jiralib-available-actions-cache)))\n (progn\n (jiralib-make-assoc-list\n (mapcar (lambda (x)\n (let ((namestring (cdr (car x)))\n (id (cdr x)))\n (cons\n (cons 'name (org-jira-decode namestring))\n id)))\n (jiralib-call \"getAvailableActions\" nil issue-key))\n 'id 'name))))\n\n(defcustom jiralib-fields-for-action-cache-p t\n \"Set to t to enable caching for jiralib-get-fields-for-action.\n\nIf nil, will disable caching for this endpoint.\n\nPossible side-effects:\n\n - If many tasks have different workflows, you may want to disable this.\"\n :type 'boolean\n :group 'jiralib)\n\n(defvar jiralib-fields-for-action-cache nil \"An alist of available fields.\")\n\n(defun jiralib-get-fields-for-action-with-cache (issue-key action-id)\n \"Return the required fields to change ISSUE-KEY to ACTION-ID.\"\n (if (and jiralib-fields-for-action-cache-p action-id)\n (progn\n (unless (assoc action-id jiralib-fields-for-action-cache)\n (push (cons action-id\n (jiralib-call \"getFieldsForAction\" nil issue-key action-id))\n jiralib-fields-for-action-cache))\n (cdr (assoc action-id jiralib-fields-for-action-cache)))\n (jiralib-call \"getFieldsForAction\" nil issue-key action-id)))\n\n(defun jiralib-get-fields-for-action (issue-key action-id)\n \"Return the required fields to change ISSUE-KEY to ACTION-ID.\"\n (if jiralib-use-restapi\n (let ((fields (jiralib-get-fields-for-action-with-cache issue-key action-id)))\n (mapcar (lambda (field)\n (cons (symbol-name (car field))\n (format \"%s (required: %s)\"\n (org-jira-find-value field 'name)\n (if (eq (org-jira-find-value field 'required) :json-false)\n \"nil\"\n \"t\"))))\n fields))\n (jiralib-make-assoc-list\n (jiralib-get-fields-for-action-with-cache issue-key action-id)\n 'id 'name)))\n\n(defun jiralib-progress-workflow-action (issue-key action-id params &optional callback)\n \"Progress issue with ISSUE-KEY to action ACTION-ID, and provide the needed PARAMS.\n\nWhen CALLBACK is present, this will run async.\"\n (if jiralib-use-restapi\n (jiralib-call \"progressWorkflowAction\"\n callback issue-key `((transition (id . ,action-id)))\n `((fields . ,params)))\n (jiralib-call \"progressWorkflowAction\"\n callback issue-key action-id (jiralib-make-remote-field-values params))))\n\n\n(defun jiralib-format-datetime (&optional datetime)\n \"Convert a mixed DATETIME format into the Jira required datetime format.\n\nThis will produce a datetime string such as:\n\n 2010-02-05T14:30:00.000+0000\n\nfor being consumed in the Jira API.\n\nIf DATETIME is not passed in, it will default to the current time.\"\n (let* ((defaults (format-time-string \"%Y-%m-%d %H:%M:%S\" (current-time)))\n (datetime (concat datetime (subseq defaults (length datetime))))\n (parts (parse-time-string datetime)))\n (format \"%04d-%02d-%02dT%02d:%02d:%02d.000+0000\"\n (nth 5 parts)\n (nth 4 parts)\n (nth 3 parts)\n (nth 2 parts)\n (nth 1 parts)\n (nth 0 parts))))\n\n(defvar jiralib-worklog-coming-soon-message\n \"WORKLOG FEATURES ARE NOT IMPLEMENTED YET, COMING SOON!\")\n\n(defun jiralib-add-worklog-and-autoadjust-remaining-estimate (issue-key start-date time-spent comment)\n \"Log time spent on ISSUE-KEY to its worklog.\nThe time worked begins at START-DATE and has a TIME-SPENT\nduration. JIRA will automatically update the remaining estimate\nby subtracting TIME-SPENT from it.\n\nSTART-DATE should be in the format 2010-02-05T14:30:00Z\n\nTIME-SPENT can be in one of the following formats: 10m, 120m\nhours; 10h, 120h days; 10d, 120d weeks.\n\nCOMMENT will be added to this worklog.\"\n (let ((formatted-start-date (jiralib-format-datetime start-date)))\n (jiralib-call \"addWorklogAndAutoAdjustRemainingEstimate\"\n nil\n issue-key\n ;; Expects data such as: '{\"timeSpent\":\"1h\", \"started\":\"2017-02-21T00:00:00.000+0000\", \"comment\":\"woot!\"}'\n ;; and only that format will work (no loose formatting on the started date)\n `((started . ,formatted-start-date)\n (timeSpent . ,time-spent)\n (comment . ,comment)))))\n\n\f\n;;;; Issue field accessors\n\n(defun jiralib-issue-key (issue)\n \"Return the key of ISSUE.\"\n (cdr (assoc 'key issue)))\n\n(defun jiralib-issue-owner (issue)\n \"Return the owner of ISSUE.\"\n (cdr (assq 'assignee issue)))\n\n(defun jiralib-issue-status (issue)\n \"Return the status of ISSUE as a status string (not as a number!).\"\n (let ((status-code (cdr (assq 'status issue))))\n (cdr (assoc status-code (jiralib-get-statuses)))))\n\n(defun jiralib-custom-field-value (custom-field issue)\n \"Return the value of CUSTOM-FIELD for ISSUE.\nReturn nil if the field is not found\"\n (catch 'found\n (dolist (field (cdr (assq 'customFieldValues issue)))\n (when (equal (cdr (assq 'customfieldId field)) custom-field)\n (throw 'found (cadr (assq 'values field)))))))\n\n(defvar jiralib-current-issue nil\n \"This holds the currently selected issue.\")\n\n(defvar jiralib-projects-list nil\n \"This holds a list of projects and their details.\")\n\n(defvar jiralib-types nil\n \"This holds a list of issues types.\")\n\n(defvar jiralib-priorities nil\n \"This holds a list of priorities.\")\n\n(defvar jiralib-user-fullnames nil\n \"This holds a list of user fullnames.\")\n\n(defun jiralib-get-project-name (key)\n \"Return the name of the JIRA project with id KEY.\"\n (let ((projects jiralib-projects-list)\n (name nil))\n (dolist (project projects)\n (if (equal (cdr (assoc 'key project)) key)\n (setf name (cdr (assoc 'name project)))))\n name))\n\n(defun jiralib-get-type-name (id)\n \"Return the name of the issue type with ID.\"\n (let ((types jiralib-types)\n (name nil))\n (dolist (type types)\n (if (equal (cdr (assoc 'id type)) id)\n (setf name (cdr (assoc 'name type)))))\n name))\n\n(defun jiralib-get-user-fullname (username)\n \"Return the full name (display name) of the user with USERNAME.\"\n (if (assoc username jiralib-user-fullnames)\n (cdr (assoc username jiralib-user-fullnames))\n (progn\n (let ((user (jiralib-get-user username)))\n (setf jiralib-user-fullnames (append jiralib-user-fullnames (list (cons username (cdr (assoc 'fullname user))))))\n (cdr (assoc 'fullname user))))))\n\n\n(defun jiralib-get-filter (filter-id)\n \"Return a filter given its FILTER-ID.\"\n (cl-flet ((id-match (filter)\n (equal filter-id (cdr (assoc 'id filter)))))\n (cl-find-if 'id-match (jiralib-get-saved-filters))))\n\n(defun jiralib-get-filter-alist ()\n \"Return an association list mapping filter names to IDs.\"\n (mapcar (lambda (filter)\n (cons (cdr (assoc 'name filter))\n (cdr (assoc 'id filter))))\n (jiralib-get-saved-filters)))\n\n(defun jiralib-add-comment (issue-key comment &optional callback)\n \"Add to issue with ISSUE-KEY the given COMMENT, invoke CALLBACK.\"\n (jiralib-call \"addComment\" callback issue-key `((body . ,comment))))\n\n(defun jiralib-edit-comment (issue-id comment-id comment &optional callback)\n \"Edit ISSUE-ID's comment COMMENT-ID to reflect the new COMMENT, invoke CALLBACK.\"\n (if (not jiralib-use-restapi)\n (jiralib-call \"editComment\" callback `((id . ,comment-id)\n (body . ,comment)))\n (jiralib-call \"editComment\" callback issue-id comment-id comment)))\n\n(defun jiralib-create-issue (issue)\n \"Create a new ISSUE in JIRALIB.\n\nISSUE is a Hashtable object.\"\n (jiralib-call \"createIssue\" nil issue))\n\n(defun jiralib-create-subtask (subtask parent-issue-id)\n \"Create SUBTASK for issue with PARENT-ISSUE-ID.\n\nSUBTASK is a Hashtable object.\"\n (jiralib-call \"createIssueWithParent\" nil subtask parent-issue-id))\n\n\n(defvar jiralib-subtask-types-cache nil)\n\n(defun jiralib-get-subtask-types ()\n \"Return an assoc list mapping an issue type code to its name.\nNOTE: Issue type codes are stored as strings, not numbers.\n\nThis function will only ask JIRA for the list of codes once, than\nwill cache it.\"\n (unless jiralib-subtask-types-cache\n (setq jiralib-subtask-types-cache\n (jiralib-make-assoc-list (jiralib-call \"getSubTaskIssueTypes\" nil) 'id 'name)))\n jiralib-subtask-types-cache)\n\n(defun jiralib-get-comment (issue-key comment-id &optional callback)\n \"Return all comments associated with issue ISSUE-KEY, invoking CALLBACK.\"\n (jiralib-call \"getComment\" callback issue-key comment-id))\n\n(defun jiralib-get-comments (issue-key &optional callback)\n \"Return all comments associated with issue ISSUE-KEY, invoking CALLBACK.\"\n (jiralib-call \"getComments\" callback issue-key))\n\n(defun jiralib-get-attachments (issue-key &optional callback)\n \"Return all attachments associated with issue ISSUE-KEY, invoking CALLBACK.\"\n (jiralib-call \"getAttachmentsFromIssue\" callback issue-key))\n\n(defun jiralib-get-worklogs (issue-key &optional callback)\n \"Return all worklogs associated with issue ISSUE-KEY, invoking CALLBACK.\"\n (jiralib-call \"getWorklogs\" callback issue-key))\n\n(defun jiralib-add-worklog (issue-id started time-spent-seconds comment &optional callback)\n \"Add the worklog linked to ISSUE-ID.\n\nRequires STARTED (a jira datetime), TIME-SPENT-SECONDS (integer) and a COMMENT.\nCALLBACK will be invoked if passed in upon endpoint completion.\"\n ;; Call will fail if 0 seconds are set as the time, so always do at least one min.\n (setq time-spent-seconds (max 60 time-spent-seconds))\n (let ((worklog `((started . ,started)\n ;; @todo :worklog: timeSpentSeconds changes into incorrect values\n ;; in the Jira API (for instance, 89600 = 1 day, but Jira thinks 3 days...\n ;; We should convert to a Xd Xh Xm format from our seconds ourselves.\n (timeSpentSeconds . ,time-spent-seconds)\n (comment . ,comment))))\n (jiralib-call \"addWorklog\" callback issue-id worklog)))\n\n(defun jiralib-update-worklog (issue-id worklog-id started time-spent-seconds comment &optional callback)\n \"Update the worklog linked to ISSUE-ID and WORKLOG-ID.\n\nRequires STARTED (a jira datetime), TIME-SPENT-SECONDS (integer) and a COMMENT.\nCALLBACK will be invoked if passed in upon endpoint completion.\"\n ;; Call will fail if 0 seconds are set as the time, so always do at least one min.\n (setq time-spent-seconds (max 60 time-spent-seconds))\n (let ((worklog `((started . ,started)\n ;; @todo :worklog: timeSpentSeconds changes into incorrect values\n ;; in the Jira API (for instance, 89600 = 1 day, but Jira thinks 3 days...\n ;; We should convert to a Xd Xh Xm format from our seconds ourselves.\n (timeSpentSeconds . ,time-spent-seconds)\n (comment . ,comment))))\n (jiralib-call \"updateWorklog\" callback issue-id worklog-id worklog)))\n\n(defvar jiralib-components-cache nil \"An alist of project components.\")\n\n(defun jiralib-get-components (project-key)\n \"Return all components available in the project PROJECT-KEY.\"\n (unless (assoc project-key jiralib-components-cache)\n (push (cons project-key\n (jiralib-make-assoc-list\n (jiralib-call \"getComponents\" nil project-key) 'id 'name))\n jiralib-components-cache))\n (cdr (assoc project-key jiralib-components-cache)))\n\n(defun jiralib-get-issue (issue-key &optional callback)\n \"Get the issue with key ISSUE-KEY, running CALLBACK after.\"\n (jiralib-call \"getIssue\" callback issue-key))\n\n(defun jiralib-get-issues-from-filter (filter-id)\n \"Get the issues from applying saved filter FILTER-ID.\"\n (message \"jiralib-get-issues-from-filter is NOT IMPLEMENTED!! Do not use!\")\n (jiralib-call \"getIssuesFromFilter\" nil filter-id))\n\n(defun jiralib-get-issues-from-text-search (search-terms)\n \"Find issues using free text search SEARCH-TERMS.\"\n (jiralib-call \"getIssuesFromTextSearch\" nil search-terms))\n\n(defun jiralib-get-issues-from-text-search-with-project\n (project-keys search-terms max-num-results)\n \"Find issues in projects PROJECT-KEYS, using free text search SEARCH-TERMS.\n\nReturn no more than MAX-NUM-RESULTS.\"\n (jiralib-call \"getIssuesFromTextSearchWithProject\"\n nil\n (apply 'vector project-keys) search-terms max-num-results))\n\n;; Modified by Brian Zwahr to use getProjectsNoSchemes instead of getProjects\n(defun jiralib-get-projects ()\n \"Return a list of projects available to the user.\"\n (if jiralib-projects-list\n jiralib-projects-list\n (setq jiralib-projects-list\n (if jiralib-use-restapi\n (jiralib-call \"getProjects\" nil)\n (jiralib-call \"getProjectsNoSchemes\" nil)))))\n\n(defun jiralib-get-saved-filters ()\n \"Get all saved filters available for the currently logged in user.\"\n (jiralib-make-assoc-list (jiralib-call \"getSavedFilters\" nil) 'id 'name))\n\n(defun jiralib-get-server-info ()\n \"Return the Server information such as baseUrl, version, edition, buildDate, buildNumber.\"\n (jiralib-call \"getServerInfo\" nil))\n\n(defun jiralib-get-sub-task-issue-types ()\n \"Return all visible subtask issue types in the system.\"\n (jiralib-call \"getSubTaskIssueTypes\" nil))\n\n(defun jiralib-get-user (username)\n \"Return a user's information given their USERNAME.\"\n (cond ((eq 0 (length username)) nil) ;; Unassigned\n (t (jiralib-call \"getUser\" nil username))))\n\n(defvar jiralib-users-cache nil \"Cached list of users.\")\n\n(defun jiralib-get-users (project-key)\n \"Return assignable users information given the PROJECT-KEY.\"\n (unless jiralib-users-cache\n (setq jiralib-users-cache\n (jiralib-call \"getUsers\" nil project-key)))\n jiralib-users-cache)\n\n(defun jiralib-get-versions (project-key)\n \"Return all versions available in project PROJECT-KEY.\"\n (jiralib-call \"getVersions\" nil project-key))\n\n(defun jiralib-strip-cr (string)\n \"Remove carriage returns from STRING.\"\n (when string (replace-regexp-in-string \"\\r\" \"\" string)))\n\n(defun jiralib-worklog-import--filter-apply\n (worklog-obj &optional predicate-fn-lst unwrap-worklog-records-fn rewrap-worklog-records-fn)\n \"Remove non-matching org-jira issue worklogs.\n\nVariables:\n WORKLOG-OBJ is the passed in object\n PREDICATE-FN-LST is the list of lambdas used as match predicates.\n UNWRAP-WORKLOG-RECORDS-FN is the function used to produce the list of worklog records from within the worklog-obj\n REWRAP-WORKLOG-RECORDS-FN is the function used to reshape the worklog records back into the form they were received in.\n\nAuxiliary Notes:\n Only the WORKLOG-OBJ variable is required.\n The value of PPREDICATE-FN-LST is filled from the jiralib-worklog-import--filters-alist variable by default.\n If PREDICATE-FN-LST is empty the unmodified value of WORKLOG-OBJ is returned.\n If PREDICATE-FN-LST contains multiple predicate functions, each predicate filters operates as a clause in an AND match. In effect, a worklog must match all predicates to be returned.\n The variable 'jiralib-user-login-name is used by many lambda filters.\"\n\n (let\n ((unwrap-worklog-records-fn)\n (rewrap-worklog-records-fn)\n (predicate-fn-lst)\n (worklogs worklog-obj)\n (predicate-fn))\n ;; let-body\n (progn\n (setq unwrap-worklog-records-fn\n (if (and\n (boundp 'unwrap-worklog-records-fn)\n (functionp unwrap-worklog-records-fn))\n unwrap-worklog-records-fn\n (lambda (x) (coerce x 'list))))\n (setq rewrap-worklog-records-fn\n (if (and\n (boundp 'rewrap-worklog-records-fn)\n (functionp rewrap-worklog-records-fn))\n rewrap-worklog-records-fn\n (lambda (x) (remove 'nil (coerce x 'vector)))))\n (setq predicate-fn-lst\n (if (and (boundp 'predicate-fn-lst)\n (not (null predicate-fn-lst))\n (listp predicate-fn-lst))\n predicate-fn-lst\n (mapcar 'caddr\n (remove 'nil\n (mapcar (lambda (x) (unless (null (car x)) x))\n jiralib-worklog-import--filters-alist)))))\n ;; final condition/sanity checks before processing\n (cond\n ;; pass cases, don't apply filters, return unaltered worklog-obj\n ((or (not (boundp 'predicate-fn-lst)) (not (listp predicate-fn-lst)) (null predicate-fn-lst))\n worklog-obj)\n ;; default-case, apply worklog filters and return only matching worklogs\n (t\n (setq worklogs (funcall unwrap-worklog-records-fn worklogs))\n (while (setq predicate-fn (pop predicate-fn-lst))\n (setq worklogs (mapcar predicate-fn worklogs)))\n (funcall rewrap-worklog-records-fn worklogs))))))\n\n\n(defun jiralib-get-board (id &optional callback)\n \"Return details on given board\"\n (jiralib-call \"getBoard\" nil id))\n\n(defun jiralib-get-boards ()\n \"Return list of jira boards\"\n (jiralib-call \"getBoards\" nil))\n\n(defun jiralib-get-board-issues (board-id &rest params)\n \"Return list of jira issues in the specified jira board\"\n (apply 'jiralib-call \"getIssuesFromBoard\"\n\t (cl-getf params :callback) board-id params))\n\n(defun jiralib--agile-not-last-entry (num-entries total start-at limit)\n \"Return true if need to retrieve next page from agile api\"\n (and (> num-entries 0)\n (or (not limit) ; not required to be set\n\t (< limit 1) ; ignore invalid limit\n\t (> limit start-at))\n (or (not total) ; not always returned\n (> total start-at))))\n\n(defun jiralib--agile-limit-page-size (page-size start-at limit)\n (if (and limit\n\t (> (+ start-at page-size) limit))\n (- limit start-at)\n page-size))\n \n\n(defun jiralib--agile-rest-call-it (api max-results start-at limit query-params)\n (let ((callurl\n\t (format \"%s?%s\" api\n\t\t (url-build-query-string\n\t\t (append `((maxResults ,(jiralib--agile-limit-page-size max-results start-at limit))\n\t\t\t (startAt ,start-at))\n\t\t\t query-params)))))\n (jiralib--rest-call-it callurl)))\n\n(defun jiralib--agile-call-it (api values-key &rest params)\n \"Invoke Jira agile method api and retrieve the results using\npaging.\n\nIf JIRALIB-COMPLETE-CALLBACK is non-nil, then the call will be\nperformed asynchronously and JIRALIB-COMPLETE-CALLBACK will be\ncalled when all data are retrieved.\n\nIf JIRALIB-COMPLETE-CALLBACK is nil, then the call will be\nperformed syncronously and this function will return the\nretrieved data.\n\nAPI - path to called API that must start with /rest/agile/1.0.\n\nVALUES-KEY - key of the actual reply data in the reply assoc list.\n\nPARAMS - optional additional parameters.\n:limit - limit total number of retrieved entries.\n:query-params - extra query parameters in the format of url-build-query-string.\n\"\n (if jiralib-complete-callback\n (apply 'jiralib--agile-call-async api values-key params)\n (apply 'jiralib--agile-call-sync api values-key params)))\n\n(defun jiralib--agile-call-sync (api values-key &rest params)\n \"Syncroniously invoke Jira agile method api retrieve all the\nresults using paging and return results.\n\nVALUES-KEY - key of the actual reply data in the reply assoc list.\n\nPARAMS - extra parameters (as keyword arguments), the supported parameters are:\n\n:limit - limit total number of retrieved entries.\n:query-params - extra query parameters in the format of url-build-query-string.\n\"\n (setq jiralib-complete-callback nil)\n (let ((not-last t)\n (start-at 0)\n\t(limit (getf params :limit))\n\t(query-params (getf params :query-params))\n\t;; maximum page size, 50 is server side maximum\n (max-results jiralib-agile-page-size)\n (values ()))\n (while not-last\n (let* ((reply-alist\n\t (jiralib--agile-rest-call-it api max-results start-at limit query-params))\n (values-array (cdr (assoc values-key reply-alist)))\n (num-entries (length values-array))\n (total (cdr (assq 'total reply-alist))))\n (setf values (append values (append values-array nil)))\n (setf start-at (+ start-at num-entries))\n (setf not-last (jiralib--agile-not-last-entry num-entries total start-at limit))))\n values))\n\n(defun jiralib--agile-call-async (api values-key &rest params)\n \"Asyncroniously invoke Jira agile method api,\nretrieve all the results using paging and call\nJIRALIB-COMPLETE_CALLBACK when all the data are retrieved.\n\nVALUES-KEY - key of the actual reply data in the reply assoc list.\n\nPARAMS - extra parameters (as keyword arguments), the supported parameters are:\n\nlimit - limit total number of retrieved entries.\"\n (lexical-let\n ((start-at 0)\n (limit (getf params :limit))\n (query-params (getf params :query-params))\n ;; maximum page size, 50 is server side maximum\n (max-results jiralib-agile-page-size)\n (values-list ())\n (vk values-key)\n (url api)\n ;; save the call back to be called later after the last page\n (complete-callback jiralib-complete-callback))\n ;; setup new callback to be called after each page\n (setf jiralib-complete-callback\n (cl-function\n (lambda (&rest data &allow-other-keys)\n (condition-case err\n (let* ((reply-alist (cl-getf data :data))\n (values-array (cdr (assoc vk reply-alist)))\n (num-entries (length values-array))\n (total (cdr (assq 'total reply-alist))))\n (setf values-list (append values-list (append values-array nil)))\n (setf start-at (+ start-at num-entries))\n (message \"jiralib agile retrieve: got %d values%s%s\"\n start-at\n (if total \" of \" \"\")\n (if total (int-to-string total) \"\"))\n (if (jiralib--agile-not-last-entry num-entries total start-at limit)\n\t\t (jiralib--agile-rest-call-it url max-results start-at limit query-params)\n ;; last page: call originall callback\n (message \"jiralib agile retrieve: calling callback\")\n (setf jiralib-complete-callback complete-callback)\n (funcall jiralib-complete-callback\n :data (list (cons vk values-list)))\n (message \"jiralib agile retrieve: all done\")))\n ('error (message (format \"jiralib agile retrieve: caught error: %s\" err)))))))\n (jiralib--agile-rest-call-it api max-results start-at limit query-params)))\n\n(provide 'jiralib)\n;;; jiralib.el ends here\n" }, { "path": "org-jira-sdk.el", "content": ";;; org-jira-sdk.el -- SDK Layer for entities\n\n;; Copyright (C) 2018 Matthew Carter \n;;\n;; Authors:\n;; Matthew Carter \n;;\n;; Maintainer: Matthew Carter \n;; URL: https://github.com/ahungry/org-jira\n;; Version: 3.1.1\n;; Keywords: ahungry jira org bug tracker\n;; Package-Requires: ((emacs \"24.5\") (cl-lib \"0.5\") (request \"0.2.0\") (s \"0.0.0\"))\n\n;; This file is not part of GNU Emacs.\n\n;; This program is free software: you can redistribute it and/or modify\n;; it under the terms of the GNU General Public License as published by\n;; the Free Software Foundation, either version 3 of the License, or\n;; (at your option) any later version.\n\n;; This program is distributed in the hope that it will be useful,\n;; but WITHOUT ANY WARRANTY; without even the implied warranty of\n;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n;; GNU General Public License for more details.\n\n;; You should have received a copy of the GNU General Public License\n;; along with this program. If not, see\n;; or write to the Free Software\n;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA\n;; 02110-1301, USA.\n\n;;; Commentary:\n\n;; This provides an SDK wrapper for more strictly defining the entities we interact with.\n\n;;; Code:\n\n(require 'jiralib)\n(require 'cl-lib)\n(require 's)\n(require 'eieio)\n(require 'dash)\n(require 'cl-generic)\n\n(defclass org-jira-sdk-record ()\n ((id :initarg :id :type string :required t)\n (data :initarg :data :documentation \"The area to hold a big alist of data.\")\n (hydrate-fn :initform (lambda (id) (message \"Not implemented.\"))))\n \"The ID of the record.\")\n\n(defun org-jira-sdk-string-but-first (s) (cl-subseq s 1))\n\n(defun org-jira-sdk-to-string (s) (format \"%s\" s))\n\n(defun org-jira-sdk-to-prefixed-string (s) (format \"org-jira-sdk-%s\" s))\n\n(defun org-jira-sdk-record-type-to-symbol (record-type)\n (-> record-type symbol-name org-jira-sdk-string-but-first org-jira-sdk-to-prefixed-string intern))\n\n(defun org-jira-sdk-create-from-id (record-type id &optional parent-id callback)\n (let ((rec (funcall (org-jira-sdk-record-type-to-symbol record-type)\n :id (format \"%s\" id)\n :parent-id parent-id)))\n (with-slots (data) rec\n (setf data (org-jira-sdk-hydrate rec callback))\n (org-jira-sdk-from-data rec))))\n\n(defun org-jira-sdk-create-from-data (record-type data)\n (let ((rec (funcall (org-jira-sdk-record-type-to-symbol record-type) :data data)))\n (org-jira-sdk-from-data rec)))\n\n(cl-defmethod org-jira-sdk-hydrate ((rec org-jira-sdk-record) &optional callback)\n \"Populate the record with data from the remote endpoint.\"\n (with-slots (id hydrate-fn) rec\n (funcall hydrate-fn id callback)))\n\n(cl-defgeneric org-jira-sdk-from-data ((rec org-jira-sdk-record)))\n\n(cl-defmethod org-jira-sdk-dump ((rec org-jira-sdk-record))\n \"A decent pretty print/object dump for working with the class items.\"\n (let ((slots (mapcar (lambda (slot) (aref slot 1)) (eieio-class-slots (eieio-object-class rec)))))\n (setq slots (cl-remove-if (lambda (s) (not (slot-boundp rec s))) slots))\n (apply #'concat\n (mapcar (lambda (slot)\n (let ((slot (intern (org-jira-sdk-to-string slot))))\n (format \"\\n%+16s: %s\" slot (slot-value rec (intern (org-jira-sdk-to-string slot)))))\n )\n slots))))\n\n(defun org-jira-sdk-path (alist key-chain)\n \"Query a nested path in some type of ALIST by traversing down the keys of KEY-CHAIN.\"\n (cl-reduce (lambda (a k) (alist-get k a)) key-chain :initial-value alist))\n\n(defclass org-jira-sdk-issue (org-jira-sdk-record)\n ((assignee :type (or null string) :initarg :assignee)\n (components :type string :initarg :components)\n (created :type string :initarg :created)\n (description :type (or null string) :initarg :description)\n (duedate :type (or null string) :initarg :duedate)\n (headline :type string :initarg :headline)\n (id :type string :initarg :id) ; TODO: Probably remove me\n (issue-id :type string :initarg :issue-id :documentation \"The common ID/key, such as EX-1.\")\n (issue-id-int :type string :initarg :issue-id-int :documentation \"The internal Jira ID, such as 12345.\")\n (priority :type string :initarg :priority)\n (proj-key :type string :initarg :proj-key)\n (reporter :type (or null string) :initarg :reporter)\n (resolution :type (or null string) :initarg :resolution)\n (start-date :type (or null string) :initarg :start-date)\n (status :type string :initarg :status)\n (summary :type string :initarg :summary)\n (type :type string :initarg :type)\n (updated :type string :initarg :updated)\n (data :initarg :data :documentation \"The remote Jira data object (alist).\")\n (hydrate-fn :initform #'jiralib-get-issue :initarg :hydrate-fn))\n \"An issue on the end. ID of the form EX-1, or a numeric such as 10000.\")\n\n(defclass org-jira-sdk-comment (org-jira-sdk-record)\n ((author :type string :initarg :author)\n (body :type string :initarg :body)\n (comment-id :type string :initarg :comment-id :documentation \"The comment ID, such as 12345.\")\n (created :type string :initarg :created)\n (headline :type string :initarg :headline)\n (parent-id :type string :initarg :parent-id :documentation \"The parent issue-id such as EX-1.\")\n (updated :type string :initarg :updated)\n (data :initarg :data :documentation \"The reomte Jira data object (alist).\")\n (hydrate-fn :initform #'jiralib-get-comment :initarg :hydrate-fn)))\n\n(defclass org-jira-sdk-board (org-jira-sdk-record)\n ((name :type string :initarg :name :required t)\n (url :type string :initarg :url :required t)\n (board-type :type string :initarg :board-type)\n (jql :type string :initarg :jql)\n (limit :type integer :initarg :limit)\n ;; unused\n (parent-id :type string :initarg :parent-id)\n (hydrate-fn :initform #'jiralib-get-board :initarg :hydrate-fn)))\n\n(cl-defmethod org-jira-sdk-hydrate ((rec org-jira-sdk-comment) &optional callback)\n \"Populate the record with data from the remote endpoint.\"\n (with-slots (id proj-key hydrate-fn) rec\n (funcall hydrate-fn proj-key id callback)))\n\n(cl-defmethod org-jira-sdk-from-data ((rec org-jira-sdk-issue))\n (cl-flet ((path (keys) (org-jira-sdk-path (oref rec data) keys)))\n (org-jira-sdk-issue\n :assignee (path '(fields assignee name))\n :components (mapconcat (lambda (c) (org-jira-sdk-path c '(name))) (path '(fields components)) \", \")\n :created (path '(fields created)) ; confirm\n :description (or (path '(fields description)) \"\")\n :duedate (path '(fields duedate)) ; confirm\n :headline (path '(fields summary)) ; Duplicate of summary, maybe different.\n :id (path '(key))\n :issue-id (path '(key))\n :issue-id-int (path '(id))\n :priority (path '(fields priority name))\n :proj-key (path '(fields project key))\n :reporter (path '(fields reporter name)) ; reporter could be an object of its own slot values\n :resolution (path '(fields resolution name)) ; confirm\n :start-date (path '(fields start-date)) ; confirm\n :status (org-jira-decode (path '(fields status name)))\n :summary (path '(fields summary))\n :type (path '(fields issuetype name))\n :updated (path '(fields updated)) ; confirm\n ;; TODO: Remove this\n ;; :data (oref rec data)\n )))\n\n(cl-defmethod org-jira-sdk-from-data ((rec org-jira-sdk-comment))\n (cl-flet ((path (keys) (org-jira-sdk-path (oref rec data) keys)))\n (org-jira-sdk-comment\n :author (path '(author displayName))\n :body (path '(body))\n :comment-id (path '(id))\n :created (path '(created))\n :headline (format \"Comment: %s\" (path '(author displayName)))\n :parent-id (if (slot-boundp rec 'parent-id) (oref rec parent-id) \"\")\n :updated (path '(updated))\n ;; TODO: Remove this\n ;; :data (oref rec data)\n )))\n\n(cl-defmethod org-jira-sdk-from-data ((rec org-jira-sdk-board))\n (with-slots (data) rec\n (org-jira-sdk-board\n :id (int-to-string (alist-get 'id data))\n :name (alist-get 'name data)\n :url (alist-get 'self data)\n ;; TODO: remove it? used by org-jira-sdk-create-from-id\n :parent-id \"\"\n :board-type (alist-get 'type data))))\n\n;; Issue\n(defun org-jira-sdk-create-issue-from-data (d) (org-jira-sdk-create-from-data :issue d))\n(defun org-jira-sdk-create-issues-from-data-list (ds) (mapcar #'org-jira-sdk-create-issue-from-data ds))\n\n;; Comment\n(defun org-jira-sdk-create-comment-from-data (d) (org-jira-sdk-create-from-data :comment d))\n(defun org-jira-sdk-create-comments-from-data-list (ds) (mapcar #'org-jira-sdk-create-comment-from-data ds))\n\n(defun org-jira-sdk-isa-record? (i) (typep i 'org-jira-sdk-record))\n(defun org-jira-sdk-isa-issue? (i) (typep i 'org-jira-sdk-issue))\n(defun org-jira-sdk-isa-comment? (i) (typep i 'org-jira-sdk-comment))\n\n;; Board\n(defun org-jira-sdk-create-board-from-data (d) (org-jira-sdk-create-from-data :board d))\n(defun org-jira-sdk-create-boards-from-data-list (ds) (mapcar #'org-jira-sdk-create-board-from-data ds))\n\n(provide 'org-jira-sdk)\n\n;;; org-jira-sdk.el ends here\n" }, { "path": "org-jira.el", "content": ";;; org-jira.el --- Syncing between Jira and Org-mode. -*- lexical-binding: t -*-\n\n;; Copyright (C) 2016-2018 Matthew Carter \n;; Copyright (C) 2011 Bao Haojun\n;;\n;; Authors:\n;; Matthew Carter \n;; Bao Haojun \n;;\n;; Maintainer: Matthew Carter \n;; URL: https://github.com/ahungry/org-jira\n;; Version: 4.0.0\n;; Keywords: ahungry jira org bug tracker\n;; Package-Requires: ((emacs \"24.5\") (cl-lib \"0.5\") (request \"0.2.0\") (s \"0.0.0\") (dash \"2.14.1\"))\n\n;; This file is not part of GNU Emacs.\n\n;; This program is free software: you can redistribute it and/or modify\n;; it under the terms of the GNU General Public License as published by\n;; the Free Software Foundation, either version 3 of the License, or\n;; (at your option) any later version.\n\n;; This program is distributed in the hope that it will be useful,\n;; but WITHOUT ANY WARRANTY; without even the implied warranty of\n;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n;; GNU General Public License for more details.\n\n;; You should have received a copy of the GNU General Public License\n;; along with this program. If not, see\n;; or write to the Free Software\n;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA\n;; 02110-1301, USA.\n\n;;; Commentary:\n\n;; This provides an extension to org-mode for syncing issues with JIRA\n;; issue servers.\n\n;;; News:\n\n;;;; Changes in 4.0.0:\n;; - Introduce SDK type for handling records vs random alist structures.\n\n;;;; Changes since 3.1.0:\n;; - Fix how we were ruining the kill-ring with kill calls.\n\n;;;; Changes since 3.0.0:\n;; - Add new org-jira-add-comment call (C-c c c)\n\n;;;; Changes since 2.8.0:\n;; - New version 3.0.0 deprecates old filing mechanism and files\n;; all of the changes under the top level ticket header.\n;; - If you want other top level headers in the same file, this should\n;; work now, as long as they come after the main project one.\n\n;;;; Changes since 2.7.0:\n;; - Clean up multi-buffer handling, disable attachments call until\n;; - refresh is compatible with it.\n\n;;;; Changes since 2.6.3:\n;; - Insert worklog import filter in the existing org-jira-update-worklogs-for-current-issue function\n;; - Sync up org-clocks and worklogs! Set org-jira-worklog-sync-p to nil to avoid.\n\n;;;; Changes since 2.6.1:\n;; - Fix bug with getting all issues when worklog is an error trigger.\n\n;;;; Changes since 2.5.4:\n;; - Added new org-jira-refresh-issues-in-buffer call and binding\n\n;;;; Changes since 2.5.3:\n;; - Re-introduce the commit that introduced a break into Emacs 25.1.1 list/array push\n;; The commit caused updates/comment updates to fail when a blank list of components\n;; was present - it will now handle both cases (full list, empty list).\n\n;;;; Changes since 2.5.2:\n;; - Revert a commit that introduced a break into Emacs 25.1.1 list/array push\n;; The commit caused updates/comment updates to fail\n\n;;;; Changes since 2.5.1:\n;; - Only set duedate if a DEADLINE is present in the tags and predicate is t\n\n;;;; Changes since 2.5.0:\n;; - Allow overriding the org property names with new defcustom\n\n;;;; Changes since 2.4.0:\n;; - Fix many deprecation/warning issues\n;; - Fix error with allow-other-keys not being wrapped in cl-function\n\n;;;; Changes since 2.3.0:\n;; - Integration with org deadline and Jira due date fields\n\n;;;; Changes since 2.2.0:\n;; - Selecting issue type based on project key for creating issues\n\n;;;; Changes since 2.1.0:\n;; - Allow changing to unassigned user\n;; - Add new shortcut for quick assignment\n\n;;;; Changes since 2.0.0:\n;; - Change statusCategory to status value\n;; - Clean out some redundant code\n;; - Add ELPA tags in keywords\n\n;;;; Changes since 1.0.1:\n;; - Converted many calls to async\n;; - Removed minor annoyances (position resets etc.)\n\n;;; Code:\n\n(require 'org)\n(require 'org-clock)\n(require 'cl-lib)\n(require 'url)\n(require 'ls-lisp)\n(require 'dash)\n(require 's)\n(require 'jiralib)\n(require 'org-jira-sdk)\n\n(defconst org-jira-version \"3.0.0\"\n \"Current version of org-jira.el.\")\n\n(defgroup org-jira nil\n \"Customization group for org-jira.\"\n :tag \"Org JIRA\"\n :group 'org)\n\n(defvar org-jira-working-dir \"~/.org-jira\"\n \"Folder under which to store org-jira working files.\")\n\n(defcustom org-jira-default-jql\n \"assignee = currentUser() and resolution = unresolved ORDER BY\n priority DESC, created ASC\"\n \"Default jql for querying your Jira tickets.\"\n :group 'org-jira\n :type 'string)\n\n(defcustom org-jira-ignore-comment-user-list\n '(\"admin\")\n \"Jira usernames that should have comments ignored.\"\n :group 'org-jira\n :type '(repeat (string :tag \"Jira username:\")))\n\n(defcustom org-jira-reverse-comment-order nil\n \"If non-nil, order comments from most recent to least recent.\"\n :group 'org-jira\n :type 'boolean)\n\n(defcustom org-jira-done-states\n '(\"Closed\" \"Resolved\" \"Done\")\n \"Jira states that should be considered as DONE for `org-mode'.\"\n :group 'org-jira\n :type '(repeat (string :tag \"Jira state name:\")))\n\n(defcustom org-jira-users\n '((\"Full Name\" . \"username\"))\n \"A list of displayName and key pairs.\"\n :group 'org-jira\n :type 'list)\n\n(defcustom org-jira-progress-issue-flow\n '((\"To Do\" . \"In Progress\")\n (\"In Progress\" . \"Done\"))\n \"Quickly define a common issue flow.\"\n :group 'org-jira\n :type 'list)\n\n(defcustom org-jira-property-overrides (list)\n \"An assoc list of property tag overrides.\n\nThe KEY . VAL pairs should both be strings.\n\nFor instance, to change the :assignee: property in the org :PROPERTIES:\nblock to :WorkedBy:, you can set this as such:\n\n (setq org-jira-property-overrides (list (cons \\\"assignee\\\" \\\"WorkedBy\\\")))\n\nor simply:\n\n (add-to-list (quote org-jira-property-overrides)\n (cons (\\\"assignee\\\" \\\"WorkedBy\\\")))\n\nThis will work for most any of the properties, with the\nexception of ones with unique functionality, such as:\n\n - deadline\n - summary\n - description\"\n :group 'org-jira\n :type 'list)\n\n(defcustom org-jira-serv-alist nil\n \"Association list to set information for each jira server.\nEach element of the alist is a jira server name. The CAR of each\nelement is a string, uniquely identifying the server. The CDR of\neach element is a well-formed property list with an even number\nof elements, alternating keys and values, specifying parameters\nfor the server.\n\n (:property value :property value ... )\n\nWhen a property is given a value in org-jira-serv-alist, its\nsetting overrides the value of the corresponding user\nvariable (if any) during syncing.\n\nMost properties are optional, but some should always be set:\n\n :url soap url of the jira server.\n :username username to be used.\n :host hostname of the jira server (TODO: compute it from ~url~).\n\nAll the other properties are optional. They override the global\nvariables.\n\n :password password to be used, will be prompted if missing.\"\n :group 'org-jira\n :type '(alist :value-type plist))\n\n(defcustom org-jira-use-status-as-todo nil\n \"Use the JIRA status as the TODO tag value.\"\n :group 'org-jira)\n\n(defcustom org-jira-coding-system nil\n \"Use custom coding system on org-jira buffers.\"\n :group 'org-jira)\n\n(defcustom org-jira-deadline-duedate-sync-p t\n \"Keep org deadline and jira duedate fields synced.\nYou may wish to set this to nil if you track org deadlines in\nyour buffer that you do not want to send back to your Jira\ninstance.\"\n :group 'org-jira\n :type 'boolean)\n\n(defcustom org-jira-worklog-sync-p t\n \"Keep org clocks and jira worklog fields synced.\nYou may wish to set this to nil if you track org clocks in\nyour buffer that you do not want to send back to your Jira\ninstance.\"\n :group 'org-jira\n :type 'boolean)\n\n(defcustom org-jira-download-dir \"~/Downloads\"\n \"Name of the default jira download library.\"\n :group 'org-jira\n :type 'string)\n\n(defcustom org-jira-download-ask-override t\n \"Ask before overriding tile.\"\n :group 'org-jira\n :type 'boolean)\n\n(defcustom org-jira-jira-status-to-org-keyword-alist nil\n \"Custom alist of jira status stored in car and `org-mode' keyword stored in cdr.\"\n :group 'org-jira\n :type '(alist :key-type string :value-type string))\n\n(defcustom org-jira-priority-to-org-priority-omit-default-priority nil\n \"Whether to omit insertion of priority when it matches the default.\n\nWhen set to t, will omit the insertion of the matched value from\n`org-jira-priority-to-org-priority-alist' when it matches the `org-default-priority'.\"\n :group 'org-jira\n :type 'boolean)\n\n(defcustom org-jira-priority-to-org-priority-alist nil\n \"Alist mapping jira priority keywords to `org-mode' priority cookies.\n\nA sample value might be\n (list (cons \\\"High\\\" ?A)\n (cons \\\"Medium\\\" ?B)\n (cons \\\"Low\\\" ?C)).\n\nSee `org-default-priority' for more info.\"\n :group 'org-jira\n :type '(alist :key-type string :value-type character))\n\n(defcustom org-jira-boards-default-limit 50\n \"Default limit for number of issues retrieved from agile boards.\"\n :group 'org-jira\n :type 'integer)\n\n(defvar org-jira-serv nil\n \"Parameters of the currently selected blog.\")\n\n(defvar org-jira-serv-name nil\n \"Name of the blog, to pick from `org-jira-serv-alist'.\")\n\n(defvar org-jira-projects-list nil\n \"List of jira projects.\")\n\n(defvar org-jira-current-project nil\n \"Currently selected (i.e., active project).\")\n\n(defvar org-jira-issues-list nil\n \"List of jira issues under the current project.\")\n\n(defvar org-jira-server-rpc-url nil\n \"Jira server soap URL.\")\n\n(defvar org-jira-server-userid nil\n \"Jira server user id.\")\n\n(defvar org-jira-proj-id nil\n \"Jira project ID.\")\n\n(defvar org-jira-logged-in nil\n \"Flag whether user is logged-in or not.\")\n\n(defvar org-jira-buffer-name \"*org-jira-%s*\"\n \"Name of the jira buffer.\")\n\n(defvar org-jira-buffer-kill-prompt t\n \"Ask before killing buffer.\")\n\n(make-variable-buffer-local 'org-jira-buffer-kill-prompt)\n\n(defvar org-jira-mode-hook nil\n \"Hook to run upon entry into mode.\")\n\n(defvar org-jira-issue-id-history '()\n \"Prompt history for issue id.\")\n\n(defvar org-jira-fixversion-id-history '()\n \"Prompt history for fixversion id.\")\n\n(defvar org-jira-verbosity 'debug)\n\n(defun org-jira-log (s) (when (eq 'debug org-jira-verbosity) (message (format \"%s\" s))))\n\n(defmacro ensure-on-issue (&rest body)\n \"Make sure we are on an issue heading, before executing BODY.\"\n (declare (debug t)\n (indent 0))\n `(save-excursion\n (save-restriction\n (widen)\n (unless (looking-at \"^\\\\*\\\\* \")\n (search-backward-regexp \"^\\\\*\\\\* \" nil t)) ; go to top heading\n (let ((org-jira-id (org-jira-id)))\n (unless (and org-jira-id (string-match (jiralib-get-issue-regexp) (downcase org-jira-id)))\n (error \"Not on an issue region!\")))\n ,@body)))\n\n(defmacro org-jira-with-callback (&rest body)\n \"Simpler way to write the data callbacks.\"\n (declare (debug t)\n (indent 0))\n `(lambda (&rest request-response)\n (declare (ignore cb-data))\n (let ((cb-data (cl-getf request-response :data)))\n ,@body)))\n\n(defmacro org-jira-freeze-ui (&rest body)\n \"Freeze the UI layout for the user as much as possible.\"\n (declare (debug t)\n (indent 0))\n `(save-excursion\n (save-restriction\n (widen)\n (org-save-outline-visibility t\n (outline-show-all)\n ,@body))))\n\n(defmacro ensure-on-issue-id (issue-id &rest body)\n \"Just do some work on ISSUE-ID, execute BODY.\"\n (declare (debug t)\n (indent 1))\n `(let* ((proj-key (replace-regexp-in-string \"-.*\" \"\" issue-id))\n (project-file (expand-file-name (concat proj-key \".org\") org-jira-working-dir))\n (project-buffer (or (find-buffer-visiting project-file)\n (find-file project-file))))\n (with-current-buffer project-buffer\n (org-jira-freeze-ui\n (let ((p (org-find-entry-with-id ,issue-id)))\n (unless p (error \"Issue %s not found!\" ,issue-id))\n (goto-char p)\n (org-narrow-to-subtree)\n ,@body)))))\n\n(defmacro ensure-on-todo (&rest body)\n \"Make sure we are on an todo heading, before executing BODY.\"\n (declare (debug t)\n (indent 0))\n `(save-excursion\n (save-restriction\n (let ((continue t)\n (on-todo nil))\n (while continue\n (when (org-get-todo-state)\n (setq continue nil on-todo t))\n (unless (and continue (org-up-heading-safe))\n (setq continue nil)))\n (if (not on-todo)\n (error \"TODO not found\")\n (org-narrow-to-subtree)\n ,@body)))))\n\n(defmacro ensure-on-comment (&rest body)\n \"Make sure we are on a comment heading, before executing BODY.\"\n (declare (debug t)\n (indent 0))\n `(save-excursion\n (org-back-to-heading)\n (forward-thing 'whitespace)\n (unless (looking-at \"Comment:\")\n (error \"Not on a comment region!\"))\n (save-restriction\n (org-narrow-to-subtree)\n ,@body)))\n\n(defmacro ensure-on-worklog (&rest body)\n \"Make sure we are on a worklog heading, before executing BODY.\"\n (declare (debug t)\n (indent 0))\n `(save-excursion\n (org-back-to-heading)\n (forward-thing 'whitespace)\n (unless (looking-at \"Worklog:\")\n (error \"Not on a worklog region!\"))\n (save-restriction\n (org-narrow-to-subtree)\n ,@body)))\n\n(defvar org-jira-entry-mode-map\n (let ((org-jira-map (make-sparse-keymap)))\n (define-key org-jira-map (kbd \"C-c pg\") 'org-jira-get-projects)\n (define-key org-jira-map (kbd \"C-c bg\") 'org-jira-get-boards)\n (define-key org-jira-map (kbd \"C-c iv\") 'org-jira-get-issues-by-board)\n (define-key org-jira-map (kbd \"C-c ib\") 'org-jira-browse-issue)\n (define-key org-jira-map (kbd \"C-c ig\") 'org-jira-get-issues)\n (define-key org-jira-map (kbd \"C-c ih\") 'org-jira-get-issues-headonly)\n ;;(define-key org-jira-map (kbd \"C-c if\") 'org-jira-get-issues-from-filter-headonly)\n ;;(define-key org-jira-map (kbd \"C-c iF\") 'org-jira-get-issues-from-filter)\n (define-key org-jira-map (kbd \"C-c iu\") 'org-jira-update-issue)\n (define-key org-jira-map (kbd \"C-c iw\") 'org-jira-progress-issue)\n (define-key org-jira-map (kbd \"C-c in\") 'org-jira-progress-issue-next)\n (define-key org-jira-map (kbd \"C-c ia\") 'org-jira-assign-issue)\n (define-key org-jira-map (kbd \"C-c ir\") 'org-jira-refresh-issue)\n (define-key org-jira-map (kbd \"C-c iR\") 'org-jira-refresh-issues-in-buffer)\n (define-key org-jira-map (kbd \"C-c ic\") 'org-jira-create-issue)\n (define-key org-jira-map (kbd \"C-c ik\") 'org-jira-copy-current-issue-key)\n (define-key org-jira-map (kbd \"C-c sc\") 'org-jira-create-subtask)\n (define-key org-jira-map (kbd \"C-c sg\") 'org-jira-get-subtasks)\n (define-key org-jira-map (kbd \"C-c cc\") 'org-jira-add-comment)\n (define-key org-jira-map (kbd \"C-c cu\") 'org-jira-update-comment)\n (define-key org-jira-map (kbd \"C-c wu\") 'org-jira-update-worklogs-from-org-clocks)\n (define-key org-jira-map (kbd \"C-c tj\") 'org-jira-todo-to-jira)\n (define-key org-jira-map (kbd \"C-c if\") 'org-jira-get-issues-by-fixversion)\n org-jira-map))\n\n;;;###autoload\n(define-minor-mode org-jira-mode\n \"Toggle org-jira mode.\nWith no argument, the mode is toggled on/off.\nNon-nil argument turns mode on.\nNil argument turns mode off.\n\nCommands:\n\\\\{org-jira-entry-mode-map}\n\nEntry to this mode calls the value of `org-jira-mode-hook'.\"\n\n :init-value nil\n :lighter \" jira\"\n :group 'org-jira\n :keymap org-jira-entry-mode-map\n\n (if org-jira-mode\n (run-mode-hooks 'org-jira-mode-hook)))\n\n(defun org-jira-get-project-name (proj)\n (org-jira-find-value proj 'key))\n\n(defun org-jira-find-value (l &rest keys)\n (let* (key exists)\n (while (and keys (listp l))\n (setq key (car keys))\n (setq exists nil)\n (mapc (lambda (item)\n (when (equal key (car item))\n (setq exists t)))\n (if (and (listp l)\n (listp (car l)))\n l\n nil))\n (setq keys (cdr keys))\n (if exists\n (setq l (cdr (assoc key l)))\n (setq l (or (cdr (assoc key l)) l))))\n l))\n\n(defun org-jira-get-project-lead (proj)\n (org-jira-find-value proj 'lead 'name))\n\n(defun org-jira-get-assignable-users (project-key)\n \"Get the list of assignable users for PROJECT-KEY, adding user set jira-users first.\"\n (append\n '((\"Unassigned\" . \"\"))\n org-jira-users\n (mapcar (lambda (user)\n (cons (org-jira-decode (cdr (assoc 'displayName user)))\n (org-jira-decode (cdr (assoc 'name user)))))\n (jiralib-get-users project-key))))\n\n(defun org-jira-entry-put (pom property value)\n \"Similar to org-jira-entry-put, but with an optional alist of overrides.\n\nAt point-or-marker POM, set PROPERTY to VALUE.\n\nLook at customizing org-jira-property-overrides if you want\nto change the property names this sets.\"\n (unless (stringp property)\n (setq property (symbol-name property)))\n (let ((property (or (assoc-default property org-jira-property-overrides)\n property)))\n (org-entry-put pom property (org-jira-decode value))))\n\n(defun org-jira-kill-line ()\n \"Kill the line, without 'kill-line' side-effects of altering kill ring.\"\n (interactive)\n (delete-region (point) (line-end-position)))\n\n;; Appropriated from org.el\n(defun org-jira-org-kill-line (&optional _arg)\n \"Kill line, to tags or end of line.\"\n (cond\n ((or (not org-special-ctrl-k)\n (bolp)\n (not (org-at-heading-p)))\n (when (and (get-char-property (min (point-max) (point-at-eol)) 'invisible)\n org-ctrl-k-protect-subtree\n (or (eq org-ctrl-k-protect-subtree 'error)\n (not (y-or-n-p \"Kill hidden subtree along with headline? \"))))\n (user-error \"C-k aborted as it would kill a hidden subtree\"))\n (call-interactively\n (if (bound-and-true-p visual-line-mode) 'kill-visual-line 'org-jira-kill-line)))\n ((looking-at \".*?\\\\S-\\\\([ \\t]+\\\\(:[[:alnum:]_@#%:]+:\\\\)\\\\)[ \\t]*$\")\n (delete-region (point) (match-beginning 1))\n (org-set-tags nil t))\n (t (delete-region (point) (point-at-eol)))))\n\n;;;###autoload\n(defun org-jira-get-projects ()\n \"Get list of projects.\"\n (interactive)\n (let ((projects-file (expand-file-name \"projects-list.org\" org-jira-working-dir)))\n (or (find-buffer-visiting projects-file)\n (find-file projects-file))\n (org-jira-mode t)\n (save-excursion\n (let* ((oj-projs (jiralib-get-projects)))\n (mapc (lambda (proj)\n (let* ((proj-key (org-jira-find-value proj 'key))\n (proj-headline (format \"Project: [[file:%s.org][%s]]\" proj-key proj-key)))\n (save-restriction\n (widen)\n (goto-char (point-min))\n (outline-show-all)\n (setq p (org-find-exact-headline-in-buffer proj-headline))\n (if (and p (>= p (point-min))\n (<= p (point-max)))\n (progn\n (goto-char p)\n (org-narrow-to-subtree)\n (end-of-line))\n (goto-char (point-max))\n (unless (looking-at \"^\")\n (insert \"\\n\"))\n (insert \"* \")\n (org-jira-insert proj-headline)\n (org-narrow-to-subtree))\n (org-jira-entry-put (point) \"name\" (org-jira-get-project-name proj))\n (org-jira-entry-put (point) \"key\" (org-jira-find-value proj 'key))\n (org-jira-entry-put (point) \"lead\" (org-jira-get-project-lead proj))\n (org-jira-entry-put (point) \"ID\" (org-jira-find-value proj 'id))\n (org-jira-entry-put (point) \"url\" (format \"%s/browse/%s\" (replace-regexp-in-string \"/*$\" \"\" jiralib-url) (org-jira-find-value proj 'key))))))\n oj-projs)))))\n\n(defun org-jira-get-issue-components (issue)\n \"Return the components the ISSUE belongs to.\"\n (mapconcat\n (lambda (comp)\n (org-jira-find-value comp 'name))\n (org-jira-find-value issue 'fields 'components) \", \"))\n\n(defun org-jira-decode (data)\n \"Decode text DATA.\n\nIt must receive a coercion to string, as not every time will it\nbe populated.\"\n (let ((coding-system (or org-jira-coding-system\n (when (boundp 'buffer-file-coding-system)\n buffer-file-coding-system 'utf-8))))\n (decode-coding-string\n (string-make-unibyte (cl-coerce data 'string)) coding-system)))\n\n(defun org-jira-insert (&rest args)\n \"Set coding to text provide by `ARGS' when insert in buffer.\"\n (insert (org-jira-decode (apply #'concat args))))\n\n(defun org-jira-transform-time-format (jira-time-str)\n \"Convert JIRA-TIME-STR to format \\\"%Y-%m-%d %T\\\".\n\nExample: \\\"2012-01-09T08:59:15.000Z\\\" becomes \\\"2012-01-09\n16:59:15\\\", with the current timezone being +0800.\"\n (condition-case ()\n (format-time-string\n \"%Y-%m-%d %T\"\n (apply\n 'encode-time\n (parse-time-string (replace-regexp-in-string \"T\\\\|\\\\.000\" \" \" jira-time-str))))\n (error jira-time-str)))\n\n(defun org-jira--fix-encode-time-args (arg)\n \"Fix ARG for 3 nil values at the head.\"\n (cl-loop\n for n from 0 to 2 by 1 do\n (when (not (nth n arg))\n (setcar (nthcdr n arg) 0)))\n arg)\n\n(defun org-jira-time-format-to-jira (org-time-str)\n \"Convert ORG-TIME-STR back to jira time format.\"\n (condition-case ()\n (format-time-string\n \"%Y-%m-%dT%T.000Z\"\n (apply 'encode-time\n (org-jira--fix-encode-time-args (parse-time-string org-time-str)))\n t)\n (error org-time-str)))\n\n(defun org-jira-get-comment-val (key comment)\n \"Return the value associated with KEY of COMMENT.\"\n (org-jira-get-issue-val key comment))\n\n(defun org-jira-time-stamp-to-org-clock (time-stamp)\n \"Convert TIME-STAMP into org-clock format.\"\n (format-time-string \"%Y-%m-%d %a %H:%M\" time-stamp))\n\n(defun org-jira-date-strip-letter-t (date)\n \"Convert DATE into a time stamp and then into org-clock format.\nExpects a date in format such as: 2017-02-26T00:08:00.000-0500 and\nreturns in format 2017-02-26 00:08:00-0500.\"\n (replace-regexp-in-string\n \"\\\\.000\\\\([-+]\\\\)\" \"\\\\1\"\n (replace-regexp-in-string \"^\\\\(.*?\\\\)T\" \"\\\\1 \" date)))\n\n(defun org-jira-date-to-org-clock (date)\n \"Convert DATE into a time stamp and then into org-clock format.\nExpects a date in format such as: 2017-02-26T00:08:00.000-0500.\"\n (org-jira-time-stamp-to-org-clock\n (date-to-time\n (org-jira-date-strip-letter-t date))))\n\n(defun org-jira-worklogs-to-org-clocks (worklogs)\n \"Get a list of WORKLOGS and convert to org-clocks.\"\n (mapcar\n (lambda (worklog)\n (let ((wl-start (cdr (assoc 'started worklog)))\n (wl-time (cdr (assoc 'timeSpentSeconds worklog)))\n (wl-end))\n (setq wl-start (org-jira-date-to-org-clock wl-start))\n (setq wl-end (org-jira-time-stamp-to-org-clock (time-add (date-to-time wl-start) wl-time)))\n (list\n wl-start\n wl-end\n (cdr (assoc 'comment worklog))\n (cdr (assoc 'id worklog))\n )\n ))\n worklogs)\n )\n\n(defun org-jira-format-clock (clock-entry)\n \"Format a CLOCK-ENTRY given the (list start end).\nThis format is typically generated from org-jira-worklogs-to-org-clocks call.\"\n (format \"CLOCK: [%s]--[%s]\" (car clock-entry) (cadr clock-entry)))\n\n(defun org-jira-insert-clock (clock-entry)\n \"Insert a CLOCK-ENTRY given the (list start end).\nThis format is typically generated from org-jira-worklogs-to-org-clocks call.\"\n (insert (org-jira-format-clock clock-entry))\n (org-beginning-of-line)\n (org-ctrl-c-ctrl-c) ;; @todo Maybe not call directly? does it matter? - used to resync the clock estimate\n (org-end-of-line)\n (insert \"\\n\")\n (insert (format \" :id: %s\\n\" (cadddr clock-entry)))\n (when (caddr clock-entry) (insert (format \" %s\\n\" (org-jira-decode (caddr clock-entry))))) ;; No comment is nil, so don't print it\n )\n\n(defun org-jira-logbook-reset (issue-id &optional clocks)\n \"Find logbook for ISSUE-ID, delete it.\nRe-create it with CLOCKS. This is used for worklogs.\"\n (interactive)\n (let ((existing-logbook-p nil))\n ;; See if the LOGBOOK already exists or not.\n (ensure-on-issue-id issue-id\n (let ((drawer-name (or (org-clock-drawer-name) \"LOGBOOK\")))\n (when (search-forward (format \":%s:\" drawer-name) nil 1 1)\n (setq existing-logbook-p t))))\n (ensure-on-issue-id issue-id\n (let ((drawer-name (or (org-clock-drawer-name) \"LOGBOOK\")))\n (if existing-logbook-p\n (progn ;; If we had a logbook, drop it and re-create in a bit.\n (search-forward (format \":%s:\" drawer-name) nil 1 1)\n (org-beginning-of-line)\n (delete-region (point) (search-forward \":END:\" nil 1 1))\n )\n (progn ;; Otherwise, create a new one at the end of properties list\n (search-forward \":END:\" nil 1 1)\n (forward-line)))\n (org-insert-drawer nil (format \"%s\" drawer-name)) ;; Doc says non-nil, but this requires nil\n (mapc #'org-jira-insert-clock clocks)\n ;; Clean up leftover newlines (we left 2 behind)\n (dotimes (n 2)\n (search-forward-regexp \"^$\" nil 1 1)\n (delete-region (point) (min (point-max) (1+ (point)))))))))\n\n(defun org-jira-get-worklog-val (key WORKLOG)\n \"Return the value associated with KEY of WORKLOG.\"\n (org-jira-get-comment-val key WORKLOG))\n\n(defun org-jira-get-issue-val (key issue)\n \"Return the value associated with key KEY of issue ISSUE.\"\n (let ((tmp (or (org-jira-find-value issue 'fields key 'key) \"\"))) ;; For project, we need a key, not the name...\n (unless (stringp tmp)\n (setq tmp (org-jira-find-value issue key)))\n (unless (stringp tmp)\n (setq tmp (org-jira-find-value issue 'fields key 'displayName)))\n (unless (stringp tmp)\n (setq tmp \"\"))\n (cond ((eq key 'components)\n (org-jira-get-issue-components issue))\n ((member key '(created updated startDate))\n (org-jira-transform-time-format tmp))\n ((eq key 'status)\n (if jiralib-use-restapi\n (org-jira-find-value issue 'fields 'status 'name)\n (org-jira-find-value (jiralib-get-statuses) tmp)))\n ((eq key 'resolution)\n (if jiralib-use-restapi\n tmp\n (if (string= tmp \"\")\n \"\"\n (org-jira-find-value (jiralib-get-resolutions) tmp))))\n ((eq key 'type)\n (if jiralib-use-restapi\n (org-jira-find-value issue 'fields 'issuetype 'name)\n (org-jira-find-value (jiralib-get-issue-types) tmp)))\n ((eq key 'priority)\n (if jiralib-use-restapi\n (org-jira-find-value issue 'fields 'priority 'name)\n (org-jira-find-value (jiralib-get-priorities) tmp)))\n ((eq key 'description)\n (org-jira-strip-string tmp))\n (t\n tmp))))\n\n(defvar org-jira-jql-history nil)\n\n;;;###autoload\n(defun org-jira-get-issue-list (&optional callback)\n \"Get list of issues, using jql (jira query language), invoke CALLBACK after.\n\nDefault is unresolved issues assigned to current login user; with\na prefix argument you are given the chance to enter your own\njql.\"\n (org-jira-log (format \"I was called, was it with a callback? %s\" (if callback \"yes\" \"no\")))\n (let ((jql org-jira-default-jql))\n (when current-prefix-arg\n (setq jql (read-string \"Jql: \"\n (if org-jira-jql-history\n (car org-jira-jql-history)\n \"assignee = currentUser() and resolution = unresolved\")\n 'org-jira-jql-history\n \"assignee = currentUser() and resolution = unresolved\")))\n (list (jiralib-do-jql-search jql nil callback))))\n\n(defun org-jira-get-issue-by-id (id)\n \"Get an issue by its ID.\"\n (push id org-jira-issue-id-history)\n (let ((jql (format \"id = %s\" id)))\n (jiralib-do-jql-search jql)))\n\n(defun org-jira-get-issue-by-fixversion (fixversion-id)\n \"Get an issue by its FIXVERSION-ID.\"\n (push fixversion-id org-jira-fixversion-id-history)\n (let ((jql (format \"fixVersion = \\\"%s\\\"\" fixversion-id)))\n (jiralib-do-jql-search jql)))\n\n;;;###autoload\n(defun org-jira-get-summary ()\n \"Get issue summary from point and place next to issue id from jira\"\n (interactive)\n (let ((jira-id (thing-at-point 'symbol)))\n (forward-symbol 1)\n (insert (format \" - %s\"\n (cdr (assoc 'summary (car (org-jira-get-issue-by-id jira-id))))))))\n\n;;;###autoload\n(defun org-jira-get-summary-url ()\n \"Get issue summary from point and place next to issue id from jira, and make issue id a link\"\n (interactive)\n (let ((jira-id (thing-at-point 'symbol)))\n (insert (format \"[[%s][%s]] - %s\"\n (concatenate 'string jiralib-url \"browse/\" jira-id) jira-id\n (cdr (assoc 'summary (car (org-jira-get-issue-by-id jira-id))))))))\n\n;;;###autoload\n(defun org-jira-get-issues-headonly (issues)\n \"Get list of ISSUES, head only.\n\nThe default behavior is to return issues assigned to you and unresolved.\n\nWith a prefix argument, allow you to customize the jql. See\n`org-jira-get-issue-list'.\"\n\n (interactive\n (org-jira-get-issue-list))\n\n (let* ((issues-file (expand-file-name \"issues-headonly.org\" org-jira-working-dir))\n (issues-headonly-buffer (or (find-buffer-visiting issues-file)\n (find-file issues-file))))\n (with-current-buffer issues-headonly-buffer\n (widen)\n (delete-region (point-min) (point-max))\n\n (mapc (lambda (issue)\n (let ((issue-id (org-jira-get-issue-key issue))\n (issue-summary (org-jira-get-issue-summary issue)))\n (org-jira-insert (format \"- [jira:%s] %s\\n\" issue-id issue-summary))))\n issues))\n (switch-to-buffer issues-headonly-buffer)))\n\n;;;###autoload\n(defun org-jira-get-issue (id)\n \"Get a JIRA issue, allowing you to enter the issue-id first.\"\n (interactive (list (read-string \"Issue ID: \" \"\" 'org-jira-issue-id-history)))\n (org-jira-get-issues (org-jira-get-issue-by-id id))\n (let ((issue-pos (org-find-entry-with-id id)))\n (when issue-pos\n (goto-char issue-pos)\n (recenter 0))))\n\n;;;###autoload\n(defun org-jira-get-issues-by-fixversion (fixversion)\n \"Get list of issues by FIXVERSION.\"\n (interactive (list (read-string \"Fixversion ID: \" \"\"\n 'org-jira-fixversion-id-history)))\n (org-jira-get-issues (org-jira-get-issue-by-fixversion fixversion)))\n\n;;;###autoload\n(defun org-jira-get-issue-project (issue)\n (org-jira-find-value issue 'fields 'project 'key))\n\n(defun org-jira-get-issue-key (issue)\n (org-jira-find-value issue 'key))\n\n(defun org-jira-get-issue-summary (issue)\n (org-jira-find-value issue 'fields 'summary))\n\n(defvar org-jira-get-issue-list-callback\n (cl-function\n (lambda (&key data &allow-other-keys)\n \"Callback for async, DATA is the response from the request call.\n\nWill send a list of org-jira-sdk-issue objects to the list printer.\"\n (org-jira-log \"Received data for org-jira-get-issue-list-callback.\")\n (--> data\n (org-jira-sdk-path it '(issues))\n (append it nil) ; convert the conses into a proper list.\n org-jira-sdk-create-issues-from-data-list\n org-jira-get-issues))))\n\n;;;###autoload\n(defun org-jira-get-issues (issues)\n \"Get list of ISSUES into an org buffer.\n\nDefault is get unfinished issues assigned to you, but you can\ncustomize jql with a prefix argument.\nSee`org-jira-get-issue-list'\"\n ;; If the user doesn't provide a default, async call to build an issue list\n ;; from the JQL style query\n (interactive\n (org-jira-get-issue-list org-jira-get-issue-list-callback))\n (org-jira-log \"Fetching issues...\")\n (when (> (length issues) 0)\n (org-jira--render-issues-from-issue-list issues)))\n\n(defun org-jira--get-project-buffer (Issue)\n (with-slots (proj-key) Issue\n (let* ((project-file (expand-file-name (concat proj-key \".org\") org-jira-working-dir))\n (project-buffer (find-file-noselect project-file)))\n project-buffer)))\n\n(defun org-jira--render-issue (Issue)\n \"Render single ISSUE.\"\n (org-jira-log \"Rendering issue from issue list\")\n (org-jira-sdk-dump Issue)\n (with-slots (proj-key issue-id summary status priority headline id) Issue\n (let (p)\n (with-current-buffer (org-jira--get-project-buffer Issue)\n (org-jira-freeze-ui\n (org-jira-mode t)\n (goto-char (point-min))\n (unless (looking-at (format \"^* %s-Tickets\" proj-key))\n (insert (format \"* %s-Tickets\\n\" proj-key)))\n (setq p (org-find-entry-with-id issue-id))\n (save-restriction\n (if (and p (>= p (point-min))\n (<= p (point-max)))\n (progn\n (goto-char p)\n (forward-thing 'whitespace)\n (org-jira-kill-line))\n (goto-char (point-max))\n (unless (looking-at \"^\")\n (insert \"\\n\"))\n (insert \"** \"))\n (let ((status (org-jira-decode status)))\n (org-jira-insert\n (concat (org-jira-get-org-keyword-from-status status)\n \" \"\n (org-jira-get-org-priority-cookie-from-issue priority)\n headline)))\n (save-excursion\n (unless (search-forward \"\\n\" (point-max) 1)\n (insert \"\\n\")))\n (org-narrow-to-subtree)\n (save-excursion\n (org-back-to-heading t)\n (org-set-tags-to (replace-regexp-in-string \"-\" \"_\" issue-id)))\n (mapc (lambda (entry)\n (let ((val (slot-value Issue entry)))\n (when (or (and val (not (string= val \"\")))\n (eq entry 'assignee)) ;; Always show assignee\n (org-jira-entry-put (point) (symbol-name entry) val))))\n '(assignee reporter type priority resolution status components created updated))\n\n (org-jira-entry-put (point) \"ID\" issue-id)\n (org-jira-entry-put (point) \"CUSTOM_ID\" issue-id)\n\n ;; Insert the duedate as a deadline if it exists\n (when org-jira-deadline-duedate-sync-p\n (let ((duedate (oref Issue duedate)))\n (when (> (length duedate) 0)\n (org-deadline nil duedate))))\n\n (mapc\n (lambda (heading-entry)\n (ensure-on-issue-id issue-id\n (let* ((entry-heading\n (concat (symbol-name heading-entry)\n (format \": [[%s][%s]]\"\n (concat jiralib-url \"/browse/\" issue-id) issue-id))))\n (setq p (org-find-exact-headline-in-buffer entry-heading))\n (if (and p (>= p (point-min))\n (<= p (point-max)))\n (progn\n (goto-char p)\n (org-narrow-to-subtree)\n (goto-char (point-min))\n (forward-line 1)\n (delete-region (point) (point-max)))\n (if (org-goto-first-child)\n (org-insert-heading)\n (goto-char (point-max))\n (org-insert-subheading t))\n (org-jira-insert entry-heading \"\\n\"))\n\n ;; Insert 2 spaces of indentation so Jira markup won't cause org-markup\n (org-jira-insert\n (replace-regexp-in-string\n \"^\" \" \"\n (format \"%s\" (slot-value Issue heading-entry)))))))\n '(description))\n\n (org-jira-update-comments-for-issue issue-id)\n\n ;; FIXME: Re-enable when attachments are not erroring.\n ;;(org-jira-update-attachments-for-current-issue)\n\n ;; only sync worklog clocks when the user sets it to be so.\n (when org-jira-worklog-sync-p\n (org-jira-update-worklogs-for-issue issue-id))))))))\n\n(defun org-jira--render-issues-from-issue-list (Issues)\n \"Add the issues from ISSUES list into the org file(s).\n\nISSUES is a list of `org-jira-sdk-issue' records.\"\n ;; FIXME: Some type of loading error - the first async callback does not know about\n ;; the issues existing as a class, so we may need to instantiate here if we have none.\n (when (eq 0 (->> Issues (cl-remove-if-not #'org-jira-sdk-isa-issue?) length))\n (setq Issues (org-jira-sdk-create-issues-from-data-list Issues)))\n\n ;; First off, we never ever want to run on non-issues, so check our types early.\n (setq Issues (cl-remove-if-not #'org-jira-sdk-isa-issue? Issues))\n (org-jira-log (format \"About to render %d issues.\" (length Issues)))\n\n ;; If we have any left, we map over them.\n (mapc 'org-jira--render-issue Issues)\n (switch-to-buffer (org-jira--get-project-buffer (-last-item Issues))))\n\n;;;###autoload\n(defun org-jira-update-comment ()\n \"Update a comment for the current issue.\"\n (interactive)\n (let* ((issue-id (org-jira-get-from-org 'issue 'key))\n (comment-id (org-jira-get-from-org 'comment 'id))\n (comment (replace-regexp-in-string \"^ \" \"\" (org-jira-get-comment-body comment-id)))\n (callback-edit\n (cl-function\n (lambda (&key data &allow-other-keys)\n (org-jira-update-comments-for-current-issue))))\n (callback-add\n (cl-function\n (lambda (&key data &allow-other-keys)\n ;; @todo :optim: Has to be a better way to do this than delete region (like update the unmarked one)\n (org-jira-delete-current-comment)\n (org-jira-update-comments-for-current-issue)))))\n (if comment-id\n (jiralib-edit-comment issue-id comment-id comment callback-edit)\n (jiralib-add-comment issue-id comment callback-add))))\n\n(defun org-jira-add-comment (issue-id comment)\n \"For ISSUE-ID, add a new COMMENT string to the issue region.\"\n (interactive\n (let* ((issue-id (org-jira-id))\n (comment (read-string (format \"Comment (%s): \" issue-id))))\n (list issue-id comment)))\n (lexical-let ((issue-id issue-id))\n (ensure-on-issue-id issue-id\n (goto-char (point-max))\n (jiralib-add-comment\n issue-id comment\n (cl-function\n (lambda (&key data &allow-other-keys)\n (ensure-on-issue-id issue-id (org-jira-update-comments-for-current-issue))))))))\n\n(defun org-jira-org-clock-to-date (org-time)\n \"Convert ORG-TIME formatted date into a plain date string.\"\n (format-time-string\n \"%Y-%m-%dT%H:%M:%S.000%z\"\n (date-to-time org-time)))\n\n(defun org-jira-worklog-time-from-org-time (org-time)\n \"Take in an ORG-TIME and convert it into the portions of a worklog time.\nExpects input in format such as: [2017-04-05 Wed 01:00]--[2017-04-05 Wed 01:46] => 0:46\"\n (let ((start (replace-regexp-in-string \"^\\\\[\\\\(.*?\\\\)\\\\].*\" \"\\\\1\" org-time))\n (end (replace-regexp-in-string \".*--\\\\[\\\\(.*?\\\\)\\\\].*\" \"\\\\1\" org-time)))\n `((started . ,(org-jira-org-clock-to-date start))\n (time-spent-seconds . ,(time-to-seconds\n (time-subtract\n (date-to-time end)\n (date-to-time start)))))))\n\n(defun org-jira-org-clock-to-jira-worklog (org-time clock-content)\n \"Given ORG-TIME and CLOCK-CONTENT, format a jira worklog entry.\"\n (let ((lines (split-string clock-content \"\\n\"))\n worklog-id)\n ;; See if we look like we have an id\n (when (string-match \":id:\" (first lines))\n (setq worklog-id\n (replace-regexp-in-string \"^.*:id: \\\\([0-9]*\\\\)$\" \"\\\\1\" (first lines)))\n (when (> (string-to-number worklog-id) 0) ;; pop off the first id line if we found it valid\n (setq lines (cdr lines))))\n (setq lines (reverse (cdr (reverse lines)))) ;; drop last line\n (let ((comment (org-trim (mapconcat 'identity lines \"\\n\")))\n (worklog-time (org-jira-worklog-time-from-org-time org-time)))\n `((worklog-id . ,worklog-id)\n (comment . ,comment)\n (started . ,(cdr (assoc 'started worklog-time)))\n (time-spent-seconds . ,(cdr (assoc 'time-spent-seconds worklog-time)))\n ))))\n\n;;;###autoload\n(defun org-jira-update-worklogs-from-org-clocks ()\n \"Update or add a worklog based on the org clocks.\"\n (interactive)\n (let ((issue-id (org-jira-get-from-org 'issue 'key)))\n (ensure-on-issue-id issue-id\n (search-forward (format \":%s:\" (or (org-clock-drawer-name) \"LOGBOOK\")) nil 1 1)\n (org-beginning-of-line)\n ;; (org-cycle 1)\n (while (search-forward \"CLOCK: \" nil 1 1)\n (let ((org-time (buffer-substring-no-properties (point) (point-at-eol))))\n (forward-line)\n ;; See where the stuff ends (what point)\n (let (next-clock-point)\n (save-excursion\n (search-forward-regexp \"\\\\(CLOCK\\\\|:END\\\\):\" nil 1 1)\n (setq next-clock-point (point)))\n (let ((clock-content\n (buffer-substring-no-properties (point) next-clock-point)))\n\n ;; @todo :optim: This is inefficient, calling the resync on each update/insert event,\n ;; ideally we would track and only insert/update changed entries, as well\n ;; only call a resync once (when the entire list is processed, which will\n ;; basically require a dry run to see how many items we should be updating.\n\n ;; Update via jiralib call\n (let* ((worklog (org-jira-org-clock-to-jira-worklog org-time clock-content))\n (comment-text (cdr (assoc 'comment worklog)))\n (comment-text (if (string= (org-trim comment-text) \"\") nil comment-text)))\n (if (cdr (assoc 'worklog-id worklog))\n (jiralib-update-worklog\n issue-id\n (cdr (assoc 'worklog-id worklog))\n (cdr (assoc 'started worklog))\n (cdr (assoc 'time-spent-seconds worklog))\n comment-text\n (cl-function\n (lambda (&key data &allow-other-keys)\n (org-jira-update-worklogs-for-issue issue-id))))\n ;; else\n (jiralib-add-worklog\n issue-id\n (cdr (assoc 'started worklog))\n (cdr (assoc 'time-spent-seconds worklog))\n comment-text\n (cl-function\n (lambda (&key data &allow-other-keys)\n (org-jira-update-worklogs-for-issue issue-id))))\n )\n )))))\n )))\n\n(defun org-jira-update-worklog ()\n \"Update a worklog for the current issue.\"\n (interactive)\n (error \"Deprecated, use org-jira-update-worklogs-from-org-clocks instead!\")\n (let* ((issue-id (org-jira-get-from-org 'issue 'key))\n (worklog-id (org-jira-get-from-org 'worklog 'id))\n (timeSpent (org-jira-get-from-org 'worklog 'timeSpent))\n (timeSpent (if timeSpent\n timeSpent\n (read-string \"Input the time you spent (such as 3w 1d 2h): \")))\n (timeSpent (replace-regexp-in-string \" \\\\(\\\\sw\\\\)\\\\sw*\\\\(,\\\\|$\\\\)\" \"\\\\1\" timeSpent))\n (startDate (org-jira-get-from-org 'worklog 'startDate))\n (startDate (if startDate\n startDate\n (org-read-date nil nil nil \"Input when did you start\")))\n (startDate (org-jira-time-format-to-jira startDate))\n (comment (replace-regexp-in-string \"^ \" \"\" (org-jira-get-worklog-comment worklog-id)))\n (worklog `((comment . ,comment)\n (timeSpent . ,timeSpent)\n (timeSpentInSeconds . 10)\n (startDate . ,startDate)))\n (worklog (if worklog-id\n (cons `(id . ,(replace-regexp-in-string \"^worklog-\" \"\" worklog-id)) worklog)\n worklog)))\n (if worklog-id\n (jiralib-update-worklog worklog)\n (jiralib-add-worklog-and-autoadjust-remaining-estimate issue-id startDate timeSpent comment))\n (org-jira-delete-current-worklog)\n (org-jira-update-worklogs-for-current-issue)))\n\n(defun org-jira-delete-current-comment ()\n \"Delete the current comment.\"\n (ensure-on-comment\n (delete-region (point-min) (point-max))))\n\n(defun org-jira-delete-current-worklog ()\n \"Delete the current worklog.\"\n (ensure-on-worklog\n (delete-region (point-min) (point-max))))\n\n;;;###autoload\n(defun org-jira-copy-current-issue-key ()\n \"Copy the current issue's key into clipboard.\"\n (interactive)\n (let ((issue-id (org-jira-get-from-org 'issue 'key)))\n (with-temp-buffer\n (insert issue-id)\n (kill-region (point-min) (point-max)))))\n\n(defun org-jira-get-comment-id (comment)\n (org-jira-find-value comment 'id))\n\n(defun org-jira-get-comment-author (comment)\n (org-jira-find-value comment 'author 'displayName))\n\n(defun org-jira-isa-ignored-comment? (comment)\n (member-ignore-case (oref comment author) org-jira-ignore-comment-user-list))\n\n(defun org-jira-maybe-reverse-comments (comments)\n (if org-jira-reverse-comment-order (reverse comments) comments))\n\n(defun org-jira-extract-comments-from-data (data)\n (->> (append data nil)\n org-jira-sdk-create-comments-from-data-list\n org-jira-maybe-reverse-comments\n (cl-remove-if #'org-jira-isa-ignored-comment?)))\n\n(defun org-jira--render-comment (issue-id Comment)\n (with-slots (comment-id author headline created updated body) Comment\n (ensure-on-issue-id issue-id\n (setq p (org-find-entry-with-id comment-id))\n (when (and p (>= p (point-min))\n (<= p (point-max)))\n (goto-char p)\n (org-narrow-to-subtree)\n (delete-region (point-min) (point-max)))\n (goto-char (point-max))\n (unless (looking-at \"^\")\n (insert \"\\n\"))\n (insert \"*** \")\n (org-jira-insert headline \"\\n\")\n (org-narrow-to-subtree)\n (org-jira-entry-put (point) \"ID\" comment-id)\n (org-jira-entry-put (point) \"created\" created)\n (unless (string= created updated)\n (org-jira-entry-put (point) \"updated\" updated))\n (goto-char (point-max))\n ;; Insert 2 spaces of indentation so Jira markup won't cause org-markup\n (org-jira-insert (replace-regexp-in-string \"^\" \" \" (or body \"\"))))))\n\n(defun org-jira-update-comments-for-issue (issue-id)\n \"Update the comments for the specified ISSUE-ID issue.\"\n (jiralib-get-comments\n issue-id\n (org-jira-with-callback\n (org-jira-log \"In the callback for org-jira-update-comments-for-issue.\")\n (-->\n (org-jira-find-value cb-data 'comments)\n (org-jira-extract-comments-from-data it)\n (mapc (lambda (Comment) (org-jira--render-comment issue-id Comment)) it)))))\n\n(defun org-jira-update-comments-for-current-issue ()\n \"Update comments for the current issue.\"\n (org-jira-log \"About to update comments for current issue.\")\n (-> (org-jira-get-from-org 'issue 'key) org-jira-update-comments-for-issue))\n\n(defun org-jira-delete-subtree ()\n \"Derived from org-cut-subtree.\n\nLike that function, without mangling the user's clipboard for the\npurpose of wiping an old subtree.\"\n (let (beg end folded (beg0 (point)))\n (org-back-to-heading t) ; take what is really there\n (setq beg (point))\n (skip-chars-forward \" \\t\\r\\n\")\n (save-match-data\n (save-excursion (outline-end-of-heading)\n (setq folded (org-invisible-p))\n (org-end-of-subtree t t)))\n ;; Include the end of an inlinetask\n (when (and (featurep 'org-inlinetask)\n (looking-at-p (concat (org-inlinetask-outline-regexp)\n \"END[ \\t]*$\")))\n (end-of-line))\n (setq end (point))\n (goto-char beg0)\n (when (> end beg)\n (setq org-subtree-clip-folded folded)\n (org-save-markers-in-region beg end)\n (delete-region beg end))))\n\n(defun org-jira-update-attachments-for-current-issue ()\n \"Update the attachments for the current issue.\"\n (when jiralib-use-restapi\n (lexical-let ((issue-id (org-jira-get-from-org 'issue 'key)))\n ;; Run the call\n (jiralib-get-attachments\n issue-id\n (save-excursion\n (cl-function\n (lambda (&key data &allow-other-keys)\n ;; First, make sure we're in the proper buffer (logic copied from org-jira-get-issues.\n (let* ((proj-key (replace-regexp-in-string \"-.*\" \"\" issue-id))\n (project-file (expand-file-name (concat proj-key \".org\") org-jira-working-dir))\n (project-buffer (or (find-buffer-visiting project-file)\n (find-file project-file))))\n (with-current-buffer project-buffer\n ;; delete old attachment node\n (ensure-on-issue\n (if (org-goto-first-child)\n (while (org-goto-sibling)\n (forward-thing 'whitespace)\n (when (looking-at \"Attachments:\")\n (org-jira-delete-subtree)))))\n (let ((attachments (org-jira-find-value data 'fields 'attachment)))\n (when (not (zerop (length attachments)))\n (ensure-on-issue\n (if (org-goto-first-child)\n (progn\n (while (org-goto-sibling))\n (org-insert-heading-after-current))\n (org-insert-subheading nil))\n\n (insert \"Attachments:\")\n (mapc\n (lambda (attachment)\n (let ((attachment-id (org-jira-get-comment-id attachment))\n (author (org-jira-get-comment-author attachment))\n (created (org-jira-transform-time-format\n (org-jira-find-value attachment 'created)))\n (size (org-jira-find-value attachment 'size))\n (mimeType (org-jira-find-value attachment 'mimeType))\n (content (org-jira-find-value attachment 'content))\n (filename (org-jira-find-value attachment 'filename)))\n (if (looking-back \"Attachments:\")\n (org-insert-subheading nil)\n (org-insert-heading-respect-content))\n (insert \"[[\" content \"][\" filename \"]]\")\n (org-narrow-to-subtree)\n (org-jira-entry-put (point) \"ID\" attachment-id)\n (org-jira-entry-put (point) \"Author\" author)\n (org-jira-entry-put (point) \"Name\" filename)\n (org-jira-entry-put (point) \"Created\" created)\n (org-jira-entry-put (point) \"Size\" (ls-lisp-format-file-size size t))\n (org-jira-entry-put (point) \"Content\" content)\n (widen)))\n attachments)))))))))))))\n\n(defun org-jira-sort-org-clocks (clocks)\n \"Given a CLOCKS list, sort it by start date descending.\"\n ;; Expects data such as this:\n\n ;; ((\\\"2017-02-26 Sun 00:08\\\" \\\"2017-02-26 Sun 01:08\\\" \\\"Hi\\\" \\\"10101\\\")\n ;; (\\\"2017-03-16 Thu 22:25\\\" \\\"2017-03-16 Thu 22:57\\\" \\\"Test\\\" \\\"10200\\\"))\n (sort clocks\n (lambda (a b)\n (> (time-to-seconds (date-to-time (car a)))\n (time-to-seconds (date-to-time (car b)))))))\n\n(defun org-jira-update-worklogs-for-current-issue ()\n \"Update the worklogs for the current issue.\"\n (-> (org-jira-get-from-org 'issue 'key)\n org-jira-update-worklogs-for-issue))\n\n(defun org-jira-update-worklogs-for-issue (issue-id)\n \"Update the worklogs for the current issue.\"\n ;; Run the call\n (jiralib-get-worklogs\n issue-id\n (org-jira-with-callback\n (ensure-on-issue-id issue-id\n (let ((worklogs (org-jira-find-value cb-data 'worklogs)))\n (org-jira-logbook-reset\n issue-id\n (org-jira-sort-org-clocks (org-jira-worklogs-to-org-clocks\n (jiralib-worklog-import--filter-apply worklogs)))))))))\n\n;;;###autoload\n(defun org-jira-unassign-issue ()\n \"Update an issue to be unassigned.\"\n (interactive)\n (let ((issue-id (org-jira-parse-issue-id)))\n (org-jira-update-issue-details issue-id :assignee nil)))\n\n;;;###autoload\n(defun org-jira-assign-issue ()\n \"Update an issue with interactive re-assignment.\"\n (interactive)\n (let ((issue-id (org-jira-parse-issue-id)))\n (if issue-id\n (let* ((project (replace-regexp-in-string \"-[0-9]+\" \"\" issue-id))\n (jira-users (org-jira-get-assignable-users project))\n (user (completing-read\n \"Assignee: \"\n (append (mapcar 'car jira-users)\n (mapcar 'cdr jira-users))))\n (assignee (or\n (cdr (assoc user jira-users))\n (cdr (rassoc user jira-users)))))\n (when (null assignee)\n (error \"No assignee found, use org-jira-unassign-issue to make the issue unassigned\"))\n (org-jira-update-issue-details issue-id :assignee assignee))\n (error \"Not on an issue\"))))\n\n;;;###autoload\n(defun org-jira-update-issue ()\n \"Update an issue.\"\n (interactive)\n (let ((issue-id (org-jira-parse-issue-id)))\n (if issue-id\n (org-jira-update-issue-details issue-id)\n (error \"Not on an issue\"))))\n\n;;;###autoload\n(defun org-jira-todo-to-jira ()\n \"Convert an ordinary todo item to a jira ticket.\"\n (interactive)\n (ensure-on-todo\n (when (org-jira-parse-issue-id)\n (error \"Already on jira ticket\"))\n (save-excursion (org-jira-create-issue\n (org-jira-read-project)\n (org-jira-read-issue-type)\n (org-get-heading t t)\n (org-get-entry)))\n (delete-region (point-min) (point-max))))\n\n;;;###autoload\n(defun org-jira-get-subtasks ()\n \"Get subtasks for the current issue.\"\n (interactive)\n (ensure-on-issue\n (org-jira-get-issues-headonly (jiralib-do-jql-search (format \"parent = %s\" (org-jira-parse-issue-id))))))\n\n(defvar org-jira-project-read-history nil)\n(defvar org-jira-boards-read-history nil)\n(defvar org-jira-components-read-history nil)\n(defvar org-jira-priority-read-history nil)\n(defvar org-jira-type-read-history nil)\n\n(defun org-jira-read-project ()\n \"Read project name.\"\n (completing-read\n \"Project: \"\n (jiralib-make-list (jiralib-get-projects) 'key)\n nil\n t\n nil\n 'org-jira-project-read-history\n (car org-jira-project-read-history)))\n\n(defun org-jira-read-board ()\n \"Read board name. Returns cons pair (name . integer-id)\"\n (let* ((boards-alist\n (jiralib-make-assoc-list (jiralib-get-boards) 'name 'id))\n (board-name\n (completing-read \"Boards: \" boards-alist\n nil t nil\n 'org-jira-boards-read-history\n (car org-jira-boards-read-history))))\n (assoc board-name boards-alist)))\n\n(defun org-jira-read-component (project)\n \"Read the components options for PROJECT such as EX.\"\n (completing-read\n \"Components (choose Done to stop): \"\n (append '(\"Done\") (mapcar 'cdr (jiralib-get-components project)))\n nil\n t\n nil\n 'org-jira-components-read-history\n \"Done\"))\n\n;; TODO: Finish this feature - integrate into org-jira-create-issue\n(defun org-jira-read-components (project)\n \"Types: string PROJECT : string (csv of components).\n\nGet all the components for the PROJECT such as EX,\nthat should be bound to an issue.\"\n (let (components component)\n (while (not (equal \"Done\" component))\n (setq component (org-jira-read-component project))\n (unless (equal \"Done\" component)\n (push component components)))\n components))\n\n(defun org-jira-read-priority ()\n \"Read priority name.\"\n (completing-read\n \"Priority: \"\n (mapcar 'cdr (jiralib-get-priorities))\n nil\n t\n nil\n 'org-jira-priority-read-history\n (car org-jira-priority-read-history)))\n\n(defun org-jira-read-issue-type (&optional project)\n \"Read issue type name. PROJECT is the optional project key.\"\n (let* ((issue-types\n (mapcar 'cdr (if project\n (jiralib-get-issue-types-by-project project)\n (jiralib-get-issue-types))))\n (initial-input (when (member (car org-jira-type-read-history) issue-types)\n org-jira-type-read-history)))\n (completing-read\n \"Type: \"\n issue-types\n nil\n t\n nil\n initial-input\n (car initial-input))))\n\n(defun org-jira-read-subtask-type ()\n \"Read issue type name.\"\n (completing-read\n \"Type: \"\n (mapcar 'cdr (jiralib-get-subtask-types))\n nil\n t\n nil\n 'org-jira-type-read-history\n (car org-jira-type-read-history)))\n\n(defun org-jira-get-issue-struct (project type summary description)\n \"Create an issue struct for PROJECT, of TYPE, with SUMMARY and DESCRIPTION.\"\n (if (or (equal project \"\")\n (equal type \"\")\n (equal summary \"\"))\n (error \"Must provide all information!\"))\n (let* ((project-components (jiralib-get-components project))\n (jira-users (org-jira-get-assignable-users project))\n (user (completing-read \"Assignee: \" (mapcar 'car jira-users)))\n (priority (car (rassoc (org-jira-read-priority) (jiralib-get-priorities))))\n (ticket-struct\n `((fields\n (project (key . ,project))\n (issuetype (id . ,(car (rassoc type (if (and (boundp 'parent-id) parent-id)\n (jiralib-get-subtask-types)\n (jiralib-get-issue-types))))))\n (summary . ,(format \"%s%s\" summary\n (if (and (boundp 'parent-id) parent-id)\n (format \" (subtask of [jira:%s])\" parent-id)\n \"\")))\n (description . ,description)\n (priority (id . ,priority))\n (assignee (name . ,(or (cdr (assoc user jira-users)) user)))))))\n ticket-struct))\n\n;;;###autoload\n(defun org-jira-create-issue (project type summary description)\n \"Create an issue in PROJECT, of type TYPE, with given SUMMARY and DESCRIPTION.\"\n (interactive\n (let* ((project (org-jira-read-project))\n (type (org-jira-read-issue-type project))\n (summary (read-string \"Summary: \"))\n (description (read-string \"Description: \")))\n (list project type summary description)))\n (if (or (equal project \"\")\n (equal type \"\")\n (equal summary \"\"))\n (error \"Must provide all information!\"))\n (let* ((parent-id nil)\n (ticket-struct (org-jira-get-issue-struct project type summary description)))\n (org-jira-get-issues (list (jiralib-create-issue ticket-struct)))))\n\n;;;###autoload\n(defun org-jira-create-subtask (project type summary description)\n \"Create a subtask issue for PROJECT, of TYPE, with SUMMARY and DESCRIPTION.\"\n (interactive (ensure-on-issue (list (org-jira-read-project)\n (org-jira-read-subtask-type)\n (read-string \"Summary: \")\n (read-string \"Description: \"))))\n (if (or (equal project \"\")\n (equal type \"\")\n (equal summary \"\"))\n (error \"Must provide all information!\"))\n (let* ((parent-id (org-jira-parse-issue-id))\n (ticket-struct (org-jira-get-issue-struct project type summary description)))\n (org-jira-get-issues (list (jiralib-create-subtask ticket-struct parent-id)))))\n\n(defun org-jira-strip-string (str)\n \"Remove the beginning and ending white space for a string STR.\"\n (s-trim str))\n\n(defun org-jira-get-issue-val-from-org (key)\n \"Return the requested value by KEY from the current issue.\"\n (ensure-on-issue\n (cond ((eq key 'description)\n (org-goto-first-child)\n (forward-thing 'whitespace)\n (if (looking-at \"description: \")\n (org-jira-strip-string (org-get-entry))\n (error \"Can not find description field for this issue\")))\n\n ((eq key 'summary)\n (ensure-on-issue\n (org-get-heading t t)))\n\n ;; org returns a time tuple, we need to convert it\n ((eq key 'deadline)\n (let ((encoded-time (org-get-deadline-time (point))))\n (when encoded-time\n (cl-reduce (lambda (carry segment)\n (format \"%s-%s\" carry segment))\n (reverse (cl-subseq (decode-time encoded-time) 3 6))))))\n\n ;; default case, just grab the value in the properties block\n (t\n (when (symbolp key)\n (setq key (symbol-name key)))\n (setq key (or (assoc-default key org-jira-property-overrides)\n key))\n (when (string= key \"key\")\n (setq key \"ID\"))\n ;; The variable `org-special-properties' will mess this up\n ;; if our search, such as 'priority' is within there, so\n ;; don't bother with it for this (since we only ever care\n ;; about the local properties, not any hierarchal or special\n ;; ones).\n (let ((org-special-properties nil))\n (or (org-entry-get (point) key)\n \"\"))))))\n\n(defvar org-jira-actions-history nil)\n(defun org-jira-read-action (actions)\n \"Read issue workflow progress ACTIONS.\"\n (let ((action (completing-read\n \"Action: \"\n (mapcar 'cdr actions)\n nil\n t\n nil\n 'org-jira-actions-history\n (car org-jira-actions-history))))\n (car (rassoc action actions))))\n\n(defvar org-jira-fields-history nil)\n(defun org-jira-read-field (fields)\n \"Read (custom) FIELDS for workflow progress.\"\n (let ((field-desc (completing-read\n \"More fields to set: \"\n (cons \"Thanks, no more fields are *required*.\" (mapcar 'org-jira-decode (mapcar 'cdr fields)))\n nil\n t\n nil\n 'org-jira-fields-history))\n field-name)\n (setq field-name (car (rassoc field-desc fields)))\n (if field-name\n (intern field-name)\n field-name)))\n\n\n(defvar org-jira-rest-fields nil\n \"Extra fields are held here for usage between two endpoints.\nUsed in org-jira-read-resolution and org-jira-progress-issue calls.\")\n\n(defvar org-jira-resolution-history nil)\n(defun org-jira-read-resolution ()\n \"Read issue workflow progress resolution.\"\n (if (not jiralib-use-restapi)\n (let ((resolution (completing-read\n \"Resolution: \"\n (mapcar 'cdr (jiralib-get-resolutions))\n nil\n t\n nil\n 'org-jira-resolution-history\n (car org-jira-resolution-history))))\n (car (rassoc resolution (jiralib-get-resolutions))))\n (let* ((resolutions (org-jira-find-value org-jira-rest-fields 'resolution 'allowedValues))\n (resolution-name (completing-read\n \"Resolution: \"\n (mapcar (lambda (resolution)\n (org-jira-find-value resolution 'name))\n resolutions))))\n (cons 'name resolution-name))))\n\n;; TODO: Refactor to just scoop all ids from buffer, run ensure-on-issue-id on\n;; each using a map, and refresh them that way. That way we don't have to iterate\n;; on the user headings etc.\n(defun org-jira-refresh-issues-in-buffer ()\n \"Iterate across all entries in current buffer, refreshing on issue :ID:.\nWhere issue-id will be something such as \\\"EX-22\\\".\"\n (interactive)\n (save-excursion\n (save-restriction\n (widen)\n (outline-show-all)\n (outline-hide-sublevels 2)\n (goto-char (point-min))\n (outline-next-visible-heading 1)\n (while (not (org-next-line-empty-p))\n (when (outline-on-heading-p t)\n ;; It's possible we could be on a non-org-jira headline, but\n ;; that should be an exceptional case and not necessitating a\n ;; fix atm.\n (org-jira-refresh-issue))\n (outline-next-visible-heading 1)))))\n\n;;;###autoload\n(defun org-jira-refresh-issue ()\n \"Refresh current issue from jira to org.\"\n (interactive)\n (ensure-on-issue\n (org-jira--refresh-issue (org-jira-id))))\n\n(defun org-jira--refresh-issue (issue-id)\n \"Refresh issue from jira to org using ISSUE-ID.\"\n (jiralib-get-issue\n issue-id\n (org-jira-with-callback\n (org-jira-log (format \"Received refresh issue data for id: %s\" issue-id))\n (-> cb-data list org-jira-sdk-create-issues-from-data-list org-jira--render-issues-from-issue-list))))\n\n(defun org-jira--refresh-issue-by-id (issue-id)\n \"Refresh issue from jira to org using ISSUE-ID.\"\n (ensure-on-issue-id issue-id\n (org-jira--refresh-issue issue-id)))\n\n(defvar org-jira-fields-values-history nil)\n;;;###autoload\n(defun org-jira-progress-issue ()\n \"Progress issue workflow.\"\n (interactive)\n (ensure-on-issue\n (let* ((issue-id (org-jira-id))\n (actions (jiralib-get-available-actions\n issue-id\n (org-jira-get-issue-val-from-org 'status)))\n (action (org-jira-read-action actions))\n (fields (jiralib-get-fields-for-action issue-id action))\n (org-jira-rest-fields fields)\n (field-key)\n (custom-fields-collector nil)\n (custom-fields\n (progn\n ;; delete those elements in fields, which have\n ;; already been set in custom-fields-collector\n (while fields\n (setq fields\n (cl-remove-if\n (lambda (strstr)\n (cl-member-if (lambda (symstr)\n (string= (car strstr) (symbol-name (car symstr))))\n custom-fields-collector))\n fields))\n (setq field-key (org-jira-read-field fields))\n (if (not field-key)\n (setq fields nil)\n (setq custom-fields-collector\n (cons\n (funcall (if jiralib-use-restapi\n #'list\n #'cons)\n field-key\n (if (eq field-key 'resolution)\n (org-jira-read-resolution)\n (let ((field-value (completing-read\n (format \"Please enter %s's value: \"\n (cdr (assoc (symbol-name field-key) fields)))\n org-jira-fields-values-history\n nil\n nil\n nil\n 'org-jira-fields-values-history)))\n (if jiralib-use-restapi\n (cons 'name field-value)\n field-value))))\n custom-fields-collector))))\n custom-fields-collector)))\n (jiralib-progress-workflow-action\n issue-id\n action\n custom-fields\n (cl-function\n (lambda (&key data &allow-other-keys)\n (org-jira-refresh-issue)))))))\n\n(defun org-jira-progress-next-action (actions current-status)\n \"Grab the user defined 'next' action from ACTIONS, given CURRENT-STATUS.\"\n (let* ((next-action-name (cdr (assoc current-status org-jira-progress-issue-flow)))\n (next-action-id (caar (cl-remove-if-not\n (lambda (action)\n (equal action next-action-name)) actions :key #'cdr))))\n next-action-id))\n\n;;;###autoload\n(defun org-jira-progress-issue-next ()\n \"Progress issue workflow.\"\n (interactive)\n (ensure-on-issue\n (let* ((issue-id (org-jira-id))\n (actions (jiralib-get-available-actions\n issue-id\n (org-jira-get-issue-val-from-org 'status)))\n (action (org-jira-progress-next-action actions (org-jira-get-issue-val-from-org 'status)))\n (fields (jiralib-get-fields-for-action issue-id action))\n (org-jira-rest-fields fields)\n (field-key)\n (custom-fields-collector nil)\n (custom-fields\n (progn\n ;; delete those elements in fields, which have\n ;; already been set in custom-fields-collector\n (while fields\n (setq fields\n (cl-remove-if\n (lambda (strstr)\n (cl-member-if (lambda (symstr)\n (string= (car strstr) (symbol-name (car symstr))))\n custom-fields-collector))\n fields))\n (setq field-key (org-jira-read-field fields))\n (if (not field-key)\n (setq fields nil)\n (setq custom-fields-collector\n (cons\n (funcall (if jiralib-use-restapi\n #'list\n #'cons)\n field-key\n (if (eq field-key 'resolution)\n (org-jira-read-resolution)\n (let ((field-value (completing-read\n (format \"Please enter %s's value: \"\n (cdr (assoc (symbol-name field-key) fields)))\n org-jira-fields-values-history\n nil\n nil\n nil\n 'org-jira-fields-values-history)))\n (if jiralib-use-restapi\n (cons 'name field-value)\n field-value))))\n custom-fields-collector))))\n custom-fields-collector)))\n (if action\n (jiralib-progress-workflow-action\n issue-id\n action\n custom-fields\n (org-jira-with-callback\n (ensure-on-issue-id issue-id (org-jira-refresh-issue))))\n (error \"No action defined for that step!\")))))\n\n(defun org-jira-get-id-name-alist (name ids-to-names)\n \"Find the id corresponding to NAME in IDS-TO-NAMES and return an alist with id and name as keys.\"\n (let ((id (car (rassoc name ids-to-names))))\n `((id . ,id)\n (name . ,name))))\n\n(defun org-jira-build-components-list (project-components org-issue-components)\n \"Given PROJECT-COMPONENTS, attempt to build a list.\n\nIf the PROJECT-COMPONENTS are nil, this should return:\n\n (list components []), which will translate into the JSON:\n\n {\\\"components\\\": []}\n\notherwise it should return:\n\n (list components (list (cons id comp-id) (cons name item-name))),\n\n which will translate into the JSON:\n\n{\\\"components\\\": [{\\\"id\\\": \\\"comp-id\\\", \\\"name\\\": \\\"item\\\"}]}\"\n (if (not project-components) (vector) ;; Return a blank array for JSON\n (apply 'list\n (cl-mapcan\n (lambda (item)\n (let ((comp-id (car (rassoc item project-components))))\n (if comp-id\n `(((id . ,comp-id)\n (name . ,item)))\n nil)))\n (split-string org-issue-components \",\\\\s *\")))))\n\n(defun org-jira-strip-priority-tags (s)\n (->> s (replace-regexp-in-string \"\\\\[#.*?\\\\]\" \"\") s-trim))\n\n(defun org-jira-update-issue-details (issue-id &rest rest)\n \"Update the details of issue ISSUE-ID. REST will contain optional input.\"\n (ensure-on-issue-id issue-id\n ;; Set up a bunch of values from the org content\n (let* ((org-issue-components (org-jira-get-issue-val-from-org 'components))\n (org-issue-description (s-trim (org-jira-get-issue-val-from-org 'description)))\n (org-issue-priority (org-jira-get-issue-val-from-org 'priority))\n (org-issue-type (org-jira-get-issue-val-from-org 'type))\n (org-issue-assignee (cl-getf rest :assignee (org-jira-get-issue-val-from-org 'assignee)))\n (project (replace-regexp-in-string \"-[0-9]+\" \"\" issue-id))\n (project-components (jiralib-get-components project)))\n\n ;; Lets fire off a worklog update async with the main issue\n ;; update, why not? This is better to fire first, because it\n ;; doesn't auto-refresh any areas, while the end of the main\n ;; update does a callback that reloads the worklog entries (so,\n ;; we hope that wont occur until after this successfully syncs\n ;; up). Only do this sync if the user defcustom defines it as such.\n (when org-jira-worklog-sync-p\n (org-jira-update-worklogs-from-org-clocks))\n\n ;; Send the update to jira\n (let ((update-fields\n (list (cons\n 'components\n (or (org-jira-build-components-list\n project-components\n org-issue-components) []))\n (cons 'priority (org-jira-get-id-name-alist org-issue-priority\n (jiralib-get-priorities)))\n (cons 'description org-issue-description)\n (cons 'assignee (jiralib-get-user org-issue-assignee))\n (cons 'summary (org-jira-strip-priority-tags (org-jira-get-issue-val-from-org 'summary)))\n (cons 'issuetype (org-jira-get-id-name-alist org-issue-type\n (jiralib-get-issue-types))))))\n\n ;; If we enable duedate sync and we have a deadline present\n (when (and org-jira-deadline-duedate-sync-p\n (org-jira-get-issue-val-from-org 'deadline))\n (setq update-fields\n (append update-fields\n (list (cons 'duedate (org-jira-get-issue-val-from-org 'deadline))))))\n\n (jiralib-update-issue\n issue-id\n update-fields\n ;; This callback occurs on success\n (org-jira-with-callback\n (message (format \"Issue '%s' updated!\" issue-id))\n (jiralib-get-issue\n issue-id\n (org-jira-with-callback\n (org-jira-log \"Update get issue for refresh callback hit.\")\n (-> cb-data list org-jira-get-issues))))\n ))\n )))\n\n(defun org-jira-parse-issue-id ()\n \"Get issue id from org text.\"\n (save-excursion\n (let ((continue t)\n issue-id)\n (while continue\n (when (string-match (jiralib-get-issue-regexp)\n (or (setq issue-id (org-entry-get (point) \"ID\"))\n \"\"))\n (setq continue nil))\n (unless (and continue (org-up-heading-safe))\n (setq continue nil)))\n issue-id)))\n\n(defun org-jira-get-from-org (type entry)\n \"Get an org property from the current item.\n\nTYPE is the type to of the current item, and can be 'issue, or 'comment.\n\nENTRY will vary, and is the name of the property to return. If\nit is a symbol, it will be converted to string.\"\n (when (symbolp entry)\n (setq entry (symbol-name entry)))\n (cond\n ((eq type 'issue)\n (org-jira-get-issue-val-from-org entry))\n ((eq type 'comment)\n (org-jira-get-comment-val-from-org entry))\n ((eq type 'worklog)\n (org-jira-get-worklog-val-from-org entry))\n (t (error \"Unknown type %s\" type))))\n\n(defun org-jira-get-comment-val-from-org (entry)\n \"Get the JIRA issue field value ENTRY of the current comment item.\"\n (ensure-on-comment\n (when (symbolp entry)\n (setq entry (symbol-name entry)))\n (when (string= entry \"id\")\n (setq entry \"ID\"))\n (org-entry-get (point) entry)))\n\n(defun org-jira-get-worklog-val-from-org (entry)\n \"Get the JIRA issue field value ENTRY of the current worklog item.\"\n (ensure-on-worklog\n (when (symbolp entry)\n (setq entry (symbol-name entry)))\n (when (string= entry \"id\")\n (setq entry \"ID\"))\n (org-entry-get (point) entry)))\n\n(defun org-jira-get-comment-body (&optional comment-id)\n \"Get the comment body of the comment with id COMMENT-ID.\"\n (ensure-on-comment\n (goto-char (point-min))\n ;; so that search for :END: won't fail\n (org-jira-entry-put (point) \"ID\" comment-id)\n (search-forward \":END:\" nil 1 1)\n (forward-line)\n (org-jira-strip-string (buffer-substring-no-properties (point) (point-max)))))\n\n(defun org-jira-get-worklog-comment (&optional worklog-id)\n \"Get the worklog comment of the worklog with id WORKLOG-ID.\"\n (ensure-on-worklog\n (goto-char (point-min))\n ;; so that search for :END: won't fail\n (org-jira-entry-put (point) \"ID\" worklog-id)\n (search-forward \":END:\" nil 1 1)\n (forward-line)\n (org-jira-strip-string (buffer-substring-no-properties (point) (point-max)))))\n\n(defun org-jira-id ()\n \"Get the ID entry for the current heading.\"\n (org-entry-get (point) \"ID\"))\n\n;;;###autoload\n(defun org-jira-browse-issue ()\n \"Open the current issue in external browser.\"\n (interactive)\n (ensure-on-issue\n (browse-url (concat (replace-regexp-in-string \"/*$\" \"\" jiralib-url) \"/browse/\" (org-jira-id)))))\n\n(defun org-jira-url-copy-file (url newname)\n \"Similar to url-copy-file but async.\"\n (lexical-let ((newname newname))\n (url-retrieve\n url\n (lambda (status)\n (let ((buffer (current-buffer))\n (handle nil)\n (filename (if (and (file-exists-p newname)\n org-jira-download-ask-override)\n (read-string \"File already exists, select new name or press ENTER to override: \" newname)\n newname)))\n (if (not buffer)\n (error \"Opening input file: No such file or directory, %s\" url))\n (with-current-buffer buffer\n (setq handle (mm-dissect-buffer t)))\n (mm-save-part-to-file handle filename)\n (kill-buffer buffer)\n (mm-destroy-parts handle))))))\n\n;;;###autoload\n(defun org-jira-download-attachment ()\n \"Download the attachment under cursor.\"\n (interactive)\n (when jiralib-use-restapi\n (save-excursion\n (org-up-heading-safe)\n (org-back-to-heading)\n (forward-thing 'whitespace)\n (unless (looking-at \"Attachments:\")\n (error \"Not on a attachment region!\")))\n (let ((filename (org-entry-get (point) \"Name\"))\n (url (org-entry-get (point) \"Content\"))\n (url-request-extra-headers `(,jiralib-token)))\n (org-jira-url-copy-file\n url\n (concat (file-name-as-directory org-jira-download-dir) filename)))))\n\n;;;###autoload\n(defun org-jira-get-issues-from-filter (filter)\n \"Get issues from the server-side stored filter named FILTER.\n\nProvide this command in case some users are not able to use\nclient side jql (maybe because of JIRA server version?).\"\n (interactive\n (list (completing-read \"Filter: \" (mapcar 'cdr (jiralib-get-saved-filters)))))\n (org-jira-get-issues (jiralib-get-issues-from-filter (car (rassoc filter (jiralib-get-saved-filters))))))\n\n;;;###autoload\n(defun org-jira-get-issues-from-filter-headonly (filter)\n \"Get issues *head only* from saved filter named FILTER.\nSee `org-jira-get-issues-from-filter'.\"\n (interactive\n (list (completing-read \"Filter: \" (mapcar 'cdr (jiralib-get-saved-filters)))))\n (org-jira-get-issues-headonly (jiralib-get-issues-from-filter (car (rassoc filter (jiralib-get-saved-filters))))))\n\n(org-add-link-type \"jira\" 'org-jira-open)\n\n;; This was only added in org 9.0, not sure all org users will have\n;; that version, so keep the deprecated one from above for now.\n\n;;(org-link-set-parameters \"jira\" ((:follow . 'org-jira-open)))\n\n(defun org-jira-open (path)\n \"Open a Jira Link from PATH.\"\n (org-jira-get-issue path))\n\n;;;###autoload\n(defun org-jira-get-issues-by-board ()\n \"Get list of ISSUES from agile board.\"\n (interactive)\n (let* ((board (org-jira-read-board))\n (board-id (cdr board)))\n (jiralib-get-board-issues board-id\n :callback org-jira-get-issue-list-callback\n :limit (org-jira-get-board-limit board-id)\n :query-params (org-jira--make-jql-queryparams board-id))))\n\n(defun org-jira-get-board-limit (id)\n \"Get limit for number of retrieved issues for a board\nid - integer board id\"\n (let ((board (org-jira--get-board-from-buffer id)))\n (if (and board (slot-boundp board 'limit))\n (oref board limit)\n org-jira-boards-default-limit)))\n\n(defun org-jira--make-jql-queryparams (board-id)\n \"make GET query parameters for jql, returns nil if JQL query is not set\"\n (let* ((board (org-jira--get-board-from-buffer board-id))\n (jql (if (and board (slot-boundp board 'jql))\n (oref board jql))))\n (if (and jql (not (string-blank-p jql))) `((jql ,jql)))))\n\n;;;###autoload\n(defun org-jira-get-issues-by-board-headonly ()\n \"Get list of ISSUES from agile board, head only.\"\n (interactive)\n (let* ((board (org-jira-read-board))\n (board-id (cdr board)))\n (org-jira-get-issues-headonly\n (jiralib-get-board-issues board-id\n :limit (org-jira-get-board-limit board-id)\n :query-params (org-jira--make-jql-queryparams board-id)))))\n\n\n(defun org-jira--render-boards-from-list (boards)\n \"Add the boards from list into the org file.\n\nboards - list of `org-jira-sdk-board' records.\"\n (mapc 'org-jira--render-board boards))\n\n\n(defun org-jira--render-board (board)\n \"Render single board\"\n ;;(org-jira-sdk-dump board)\n (with-slots (id name url board-type jql limit) board\n (with-current-buffer (org-jira--get-boards-buffer)\n (org-jira-mode t)\n (org-jira-freeze-ui\n (org-save-outline-visibility t\n (save-restriction\n (outline-show-all)\n (widen)\n (goto-char (point-min))\n (let* ((board-headline\n (format \"Board: [[%s][%s]]\" url name))\n (headline-pos\n (org-find-exact-headline-in-buffer board-headline (current-buffer) t))\n (entry-exists (and headline-pos (>= headline-pos (point-min)) (<= headline-pos (point-max))))\n (limit-value (if (slot-boundp board 'limit) (int-to-string limit) nil))\n (jql-value (if (slot-boundp board 'jql) jql nil)))\n (if entry-exists\n (progn\n (goto-char headline-pos)\n (org-narrow-to-subtree)\n (end-of-line))\n (goto-char (point-max))\n (unless (looking-at \"^\")\n (insert \"\\n\"))\n (insert \"* \")\n (org-jira-insert board-headline)\n (org-narrow-to-subtree))\n (org-jira-entry-put (point) \"name\" name)\n (org-jira-entry-put (point) \"type\" board-type)\n (org-jira-entry-put (point) \"url\" url)\n ;; do not overwrite existing user properties with empty values\n (if (or (not entry-exists) limit-value)\n (org-jira-entry-put (point) \"limit\" limit-value))\n (if (or (not entry-exists) jql-value)\n (org-jira-entry-put (point) \"JQL\" jql-value ))\n (org-jira-entry-put (point) \"ID\" id))))))))\n\n(defun org-jira--get-boards-file ()\n (expand-file-name \"boards-list.org\" org-jira-working-dir))\n\n(defun org-jira--get-boards-buffer ()\n \"Return buffer for list of agile boards. Create one if it does not exist.\"\n (let* ((boards-file (org-jira--get-boards-file))\n (existing-buffer (find-buffer-visiting boards-file)))\n (if existing-buffer\n existing-buffer\n (find-file-noselect boards-file))))\n\n;;;###autoload\n(defun org-jira-get-boards ()\n \"Get list of boards and their properies.\"\n (interactive)\n (let* ((datalist (jiralib-get-boards))\n (boards (org-jira-sdk-create-boards-from-data-list datalist)))\n (org-jira--render-boards-from-list boards))\n (switch-to-buffer (org-jira--get-boards-buffer)))\n\n(defun org-jira--get-board-from-buffer (id)\n \"Parse board record from org file.\"\n (with-current-buffer (org-jira--get-boards-buffer)\n (org-jira-freeze-ui\n (let ((pos (org-find-property \"ID\" (int-to-string id))))\n (if pos\n (progn\n (goto-char pos)\n (apply 'org-jira-sdk-board\n (reduce\n #'(lambda (acc entry)\n (let* ((pname (car entry))\n (pval (cdr entry))\n (pair (and pval\n (not (string-empty-p pval))\n (cond\n ((equal pname \"ID\")\n (list :id pval))\n ((equal pname \"URL\")\n (list :url pval))\n ((equal pname \"TYPE\")\n (list :board-type pval))\n ((equal pname \"NAME\")\n (list :name pval))\n ((equal pname \"LIMIT\")\n (list :limit (string-to-number pval)))\n ((equal pname \"JQL\")\n (list :jql pval))\n (t nil)))))\n (if pair (append pair acc) acc)))\n (org-entry-properties) :initial-value ()))))))))\n\n(defun org-jira-get-org-keyword-from-status (status)\n \"Gets an 'org-mode' keyword corresponding to a given jira STATUS.\"\n (if org-jira-use-status-as-todo\n (upcase (replace-regexp-in-string \" \" \"-\" status))\n (let ((known-keyword (assoc status org-jira-jira-status-to-org-keyword-alist)))\n (cond (known-keyword (cdr known-keyword))\n ((member (org-jira-decode status) org-jira-done-states) \"DONE\")\n (\"TODO\")))))\n\n(defun org-jira-get-org-priority-string (character)\n \"Return an org-priority-string based on CHARACTER and user settings.\"\n (cond ((not character) \"\")\n ((and org-jira-priority-to-org-priority-omit-default-priority\n (eq character org-default-priority)) \"\")\n (t (format \"[#%c] \" character))))\n\n(defun org-jira-get-org-priority-cookie-from-issue (priority)\n \"Get the `org-mode' [#X] PRIORITY cookie.\"\n (let ((character (cdr (assoc priority org-jira-priority-to-org-priority-alist))))\n (org-jira-get-org-priority-string character)))\n\n(provide 'org-jira)\n;;; org-jira.el ends here\n" }, { "path": "t/.nosearch", "content": "" }, { "path": "t/batch-runner/dash.el", "content": ";;; dash.el --- A modern list library for Emacs -*- lexical-binding: t -*-\n\n;; Copyright (C) 2012-2016 Free Software Foundation, Inc.\n\n;; Author: Magnar Sveen \n;; Version: 2.14.1\n;; Package-Version: 20180726.1213\n;; Keywords: lists\n\n;; This program is free software; you can redistribute it and/or modify\n;; it under the terms of the GNU General Public License as published by\n;; the Free Software Foundation, either version 3 of the License, or\n;; (at your option) any later version.\n\n;; This program is distributed in the hope that it will be useful,\n;; but WITHOUT ANY WARRANTY; without even the implied warranty of\n;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n;; GNU General Public License for more details.\n\n;; You should have received a copy of the GNU General Public License\n;; along with this program. If not, see .\n\n;;; Commentary:\n\n;; A modern list api for Emacs.\n;;\n;; See documentation on https://github.com/magnars/dash.el#functions\n;;\n;; **Please note** The lexical binding in this file is not utilised at the\n;; moment. We will take full advantage of lexical binding in an upcoming 3.0\n;; release of Dash. In the meantime, we've added the pragma to avoid a bug that\n;; you can read more about in https://github.com/magnars/dash.el/issues/130.\n;;\n\n;;; Code:\n\n(defgroup dash ()\n \"Customize group for dash.el\"\n :group 'lisp\n :prefix \"dash-\")\n\n(defun dash--enable-fontlock (symbol value)\n (when value\n (dash-enable-font-lock))\n (set-default symbol value))\n\n(defcustom dash-enable-fontlock nil\n \"If non-nil, enable fontification of dash functions, macros and\nspecial values.\"\n :type 'boolean\n :set 'dash--enable-fontlock\n :group 'dash)\n\n(defmacro !cons (car cdr)\n \"Destructive: Set CDR to the cons of CAR and CDR.\"\n `(setq ,cdr (cons ,car ,cdr)))\n\n(defmacro !cdr (list)\n \"Destructive: Set LIST to the cdr of LIST.\"\n `(setq ,list (cdr ,list)))\n\n(defmacro --each (list &rest body)\n \"Anaphoric form of `-each'.\"\n (declare (debug (form body))\n (indent 1))\n (let ((l (make-symbol \"list\")))\n `(let ((,l ,list)\n (it-index 0))\n (while ,l\n (let ((it (car ,l)))\n ,@body)\n (setq it-index (1+ it-index))\n (!cdr ,l)))))\n\n(defmacro -doto (eval-initial-value &rest forms)\n \"Eval a form, then insert that form as the 2nd argument to other forms.\nThe EVAL-INITIAL-VALUE form is evaluated once. Its result is\npassed to FORMS, which are then evaluated sequentially. Returns\nthe target form.\"\n (declare (indent 1))\n (let ((retval (make-symbol \"value\")))\n `(let ((,retval ,eval-initial-value))\n ,@(mapcar (lambda (form)\n (if (sequencep form)\n `(,(-first-item form) ,retval ,@(cdr form))\n `(funcall form ,retval)))\n forms)\n ,retval)))\n\n(defun -each (list fn)\n \"Call FN with every item in LIST. Return nil, used for side-effects only.\"\n (--each list (funcall fn it)))\n\n(put '-each 'lisp-indent-function 1)\n\n(defalias '--each-indexed '--each)\n\n(defun -each-indexed (list fn)\n \"Call (FN index item) for each item in LIST.\n\nIn the anaphoric form `--each-indexed', the index is exposed as symbol `it-index'.\n\nSee also: `-map-indexed'.\"\n (--each list (funcall fn it-index it)))\n(put '-each-indexed 'lisp-indent-function 1)\n\n(defmacro --each-while (list pred &rest body)\n \"Anaphoric form of `-each-while'.\"\n (declare (debug (form form body))\n (indent 2))\n (let ((l (make-symbol \"list\"))\n (c (make-symbol \"continue\")))\n `(let ((,l ,list)\n (,c t)\n (it-index 0))\n (while (and ,l ,c)\n (let ((it (car ,l)))\n (if (not ,pred) (setq ,c nil) ,@body))\n (setq it-index (1+ it-index))\n (!cdr ,l)))))\n\n(defun -each-while (list pred fn)\n \"Call FN with every item in LIST while (PRED item) is non-nil.\nReturn nil, used for side-effects only.\"\n (--each-while list (funcall pred it) (funcall fn it)))\n\n(put '-each-while 'lisp-indent-function 2)\n\n(defmacro --dotimes (num &rest body)\n \"Repeatedly executes BODY (presumably for side-effects) with symbol `it' bound to integers from 0 through NUM-1.\"\n (declare (debug (form body))\n (indent 1))\n (let ((n (make-symbol \"num\")))\n `(let ((,n ,num)\n (it 0))\n (while (< it ,n)\n ,@body\n (setq it (1+ it))))))\n\n(defun -dotimes (num fn)\n \"Repeatedly calls FN (presumably for side-effects) passing in integers from 0 through NUM-1.\"\n (--dotimes num (funcall fn it)))\n\n(put '-dotimes 'lisp-indent-function 1)\n\n(defun -map (fn list)\n \"Return a new list consisting of the result of applying FN to the items in LIST.\"\n (mapcar fn list))\n\n(defmacro --map (form list)\n \"Anaphoric form of `-map'.\"\n (declare (debug (form form)))\n `(mapcar (lambda (it) ,form) ,list))\n\n(defmacro --reduce-from (form initial-value list)\n \"Anaphoric form of `-reduce-from'.\"\n (declare (debug (form form form)))\n `(let ((acc ,initial-value))\n (--each ,list (setq acc ,form))\n acc))\n\n(defun -reduce-from (fn initial-value list)\n \"Return the result of applying FN to INITIAL-VALUE and the\nfirst item in LIST, then applying FN to that result and the 2nd\nitem, etc. If LIST contains no items, return INITIAL-VALUE and\nFN is not called.\n\nIn the anaphoric form `--reduce-from', the accumulated value is\nexposed as symbol `acc'.\n\nSee also: `-reduce', `-reduce-r'\"\n (--reduce-from (funcall fn acc it) initial-value list))\n\n(defmacro --reduce (form list)\n \"Anaphoric form of `-reduce'.\"\n (declare (debug (form form)))\n (let ((lv (make-symbol \"list-value\")))\n `(let ((,lv ,list))\n (if ,lv\n (--reduce-from ,form (car ,lv) (cdr ,lv))\n (let (acc it) ,form)))))\n\n(defun -reduce (fn list)\n \"Return the result of applying FN to the first 2 items in LIST,\nthen applying FN to that result and the 3rd item, etc. If LIST\ncontains no items, FN must accept no arguments as well, and\nreduce return the result of calling FN with no arguments. If\nLIST has only 1 item, it is returned and FN is not called.\n\nIn the anaphoric form `--reduce', the accumulated value is\nexposed as symbol `acc'.\n\nSee also: `-reduce-from', `-reduce-r'\"\n (if list\n (-reduce-from fn (car list) (cdr list))\n (funcall fn)))\n\n(defun -reduce-r-from (fn initial-value list)\n \"Replace conses with FN, nil with INITIAL-VALUE and evaluate\nthe resulting expression. If LIST is empty, INITIAL-VALUE is\nreturned and FN is not called.\n\nNote: this function works the same as `-reduce-from' but the\noperation associates from right instead of from left.\n\nSee also: `-reduce-r', `-reduce'\"\n (if (not list) initial-value\n (funcall fn (car list) (-reduce-r-from fn initial-value (cdr list)))))\n\n(defmacro --reduce-r-from (form initial-value list)\n \"Anaphoric version of `-reduce-r-from'.\"\n (declare (debug (form form form)))\n `(-reduce-r-from (lambda (&optional it acc) ,form) ,initial-value ,list))\n\n(defun -reduce-r (fn list)\n \"Replace conses with FN and evaluate the resulting expression.\nThe final nil is ignored. If LIST contains no items, FN must\naccept no arguments as well, and reduce return the result of\ncalling FN with no arguments. If LIST has only 1 item, it is\nreturned and FN is not called.\n\nThe first argument of FN is the new item, the second is the\naccumulated value.\n\nNote: this function works the same as `-reduce' but the operation\nassociates from right instead of from left.\n\nSee also: `-reduce-r-from', `-reduce'\"\n (cond\n ((not list) (funcall fn))\n ((not (cdr list)) (car list))\n (t (funcall fn (car list) (-reduce-r fn (cdr list))))))\n\n(defmacro --reduce-r (form list)\n \"Anaphoric version of `-reduce-r'.\"\n (declare (debug (form form)))\n `(-reduce-r (lambda (&optional it acc) ,form) ,list))\n\n(defun -reductions-from (fn init list)\n \"Return a list of the intermediate values of the reduction.\n\nSee `-reduce-from' for explanation of the arguments.\n\nSee also: `-reductions', `-reductions-r', `-reduce-r'\"\n (nreverse (--reduce-from (cons (funcall fn (car acc) it) acc) (list init) list)))\n\n(defun -reductions (fn list)\n \"Return a list of the intermediate values of the reduction.\n\nSee `-reduce' for explanation of the arguments.\n\nSee also: `-reductions-from', `-reductions-r', `-reduce-r'\"\n (-reductions-from fn (car list) (cdr list)))\n\n(defun -reductions-r-from (fn init list)\n \"Return a list of the intermediate values of the reduction.\n\nSee `-reduce-r-from' for explanation of the arguments.\n\nSee also: `-reductions-r', `-reductions', `-reduce'\"\n (--reduce-r-from (cons (funcall fn it (car acc)) acc) (list init) list))\n\n(defun -reductions-r (fn list)\n \"Return a list of the intermediate values of the reduction.\n\nSee `-reduce-r' for explanation of the arguments.\n\nSee also: `-reductions-r-from', `-reductions', `-reduce'\"\n (-reductions-r-from fn (-last-item list) (-butlast list)))\n\n(defmacro --filter (form list)\n \"Anaphoric form of `-filter'.\n\nSee also: `--remove'.\"\n (declare (debug (form form)))\n (let ((r (make-symbol \"result\")))\n `(let (,r)\n (--each ,list (when ,form (!cons it ,r)))\n (nreverse ,r))))\n\n(defun -filter (pred list)\n \"Return a new list of the items in LIST for which PRED returns a non-nil value.\n\nAlias: `-select'\n\nSee also: `-keep', `-remove'.\"\n (--filter (funcall pred it) list))\n\n(defalias '-select '-filter)\n(defalias '--select '--filter)\n\n(defmacro --remove (form list)\n \"Anaphoric form of `-remove'.\n\nSee also `--filter'.\"\n (declare (debug (form form)))\n `(--filter (not ,form) ,list))\n\n(defun -remove (pred list)\n \"Return a new list of the items in LIST for which PRED returns nil.\n\nAlias: `-reject'\n\nSee also: `-filter'.\"\n (--remove (funcall pred it) list))\n\n(defalias '-reject '-remove)\n(defalias '--reject '--remove)\n\n(defun -remove-first (pred list)\n \"Return a new list with the first item matching PRED removed.\n\nAlias: `-reject-first'\n\nSee also: `-remove', `-map-first'\"\n (let (front)\n (while (and list (not (funcall pred (car list))))\n (push (car list) front)\n (!cdr list))\n (if list\n (-concat (nreverse front) (cdr list))\n (nreverse front))))\n\n(defmacro --remove-first (form list)\n \"Anaphoric form of `-remove-first'.\"\n (declare (debug (form form)))\n `(-remove-first (lambda (it) ,form) ,list))\n\n(defalias '-reject-first '-remove-first)\n(defalias '--reject-first '--remove-first)\n\n(defun -remove-last (pred list)\n \"Return a new list with the last item matching PRED removed.\n\nAlias: `-reject-last'\n\nSee also: `-remove', `-map-last'\"\n (nreverse (-remove-first pred (reverse list))))\n\n(defmacro --remove-last (form list)\n \"Anaphoric form of `-remove-last'.\"\n (declare (debug (form form)))\n `(-remove-last (lambda (it) ,form) ,list))\n\n(defalias '-reject-last '-remove-last)\n(defalias '--reject-last '--remove-last)\n\n(defun -remove-item (item list)\n \"Remove all occurences of ITEM from LIST.\n\nComparison is done with `equal'.\"\n (declare (pure t) (side-effect-free t))\n (--remove (equal it item) list))\n\n(defmacro --keep (form list)\n \"Anaphoric form of `-keep'.\"\n (declare (debug (form form)))\n (let ((r (make-symbol \"result\"))\n (m (make-symbol \"mapped\")))\n `(let (,r)\n (--each ,list (let ((,m ,form)) (when ,m (!cons ,m ,r))))\n (nreverse ,r))))\n\n(defun -keep (fn list)\n \"Return a new list of the non-nil results of applying FN to the items in LIST.\n\nIf you want to select the original items satisfying a predicate use `-filter'.\"\n (--keep (funcall fn it) list))\n\n(defun -non-nil (list)\n \"Return all non-nil elements of LIST.\"\n (declare (pure t) (side-effect-free t))\n (-remove 'null list))\n\n(defmacro --map-indexed (form list)\n \"Anaphoric form of `-map-indexed'.\"\n (declare (debug (form form)))\n (let ((r (make-symbol \"result\")))\n `(let (,r)\n (--each ,list\n (!cons ,form ,r))\n (nreverse ,r))))\n\n(defun -map-indexed (fn list)\n \"Return a new list consisting of the result of (FN index item) for each item in LIST.\n\nIn the anaphoric form `--map-indexed', the index is exposed as symbol `it-index'.\n\nSee also: `-each-indexed'.\"\n (--map-indexed (funcall fn it-index it) list))\n\n(defmacro --map-when (pred rep list)\n \"Anaphoric form of `-map-when'.\"\n (declare (debug (form form form)))\n (let ((r (make-symbol \"result\")))\n `(let (,r)\n (--each ,list (!cons (if ,pred ,rep it) ,r))\n (nreverse ,r))))\n\n(defun -map-when (pred rep list)\n \"Return a new list where the elements in LIST that do not match the PRED function\nare unchanged, and where the elements in LIST that do match the PRED function are mapped\nthrough the REP function.\n\nAlias: `-replace-where'\n\nSee also: `-update-at'\"\n (--map-when (funcall pred it) (funcall rep it) list))\n\n(defalias '-replace-where '-map-when)\n(defalias '--replace-where '--map-when)\n\n(defun -map-first (pred rep list)\n \"Replace first item in LIST satisfying PRED with result of REP called on this item.\n\nSee also: `-map-when', `-replace-first'\"\n (let (front)\n (while (and list (not (funcall pred (car list))))\n (push (car list) front)\n (!cdr list))\n (if list\n (-concat (nreverse front) (cons (funcall rep (car list)) (cdr list)))\n (nreverse front))))\n\n(defmacro --map-first (pred rep list)\n \"Anaphoric form of `-map-first'.\"\n `(-map-first (lambda (it) ,pred) (lambda (it) (ignore it) ,rep) ,list))\n\n(defun -map-last (pred rep list)\n \"Replace last item in LIST satisfying PRED with result of REP called on this item.\n\nSee also: `-map-when', `-replace-last'\"\n (nreverse (-map-first pred rep (reverse list))))\n\n(defmacro --map-last (pred rep list)\n \"Anaphoric form of `-map-last'.\"\n `(-map-last (lambda (it) ,pred) (lambda (it) (ignore it) ,rep) ,list))\n\n(defun -replace (old new list)\n \"Replace all OLD items in LIST with NEW.\n\nElements are compared using `equal'.\n\nSee also: `-replace-at'\"\n (declare (pure t) (side-effect-free t))\n (--map-when (equal it old) new list))\n\n(defun -replace-first (old new list)\n \"Replace the first occurence of OLD with NEW in LIST.\n\nElements are compared using `equal'.\n\nSee also: `-map-first'\"\n (declare (pure t) (side-effect-free t))\n (--map-first (equal old it) new list))\n\n(defun -replace-last (old new list)\n \"Replace the last occurence of OLD with NEW in LIST.\n\nElements are compared using `equal'.\n\nSee also: `-map-last'\"\n (declare (pure t) (side-effect-free t))\n (--map-last (equal old it) new list))\n\n(defmacro --mapcat (form list)\n \"Anaphoric form of `-mapcat'.\"\n (declare (debug (form form)))\n `(apply 'append (--map ,form ,list)))\n\n(defun -mapcat (fn list)\n \"Return the concatenation of the result of mapping FN over LIST.\nThus function FN should return a list.\"\n (--mapcat (funcall fn it) list))\n\n(defun -flatten (l)\n \"Take a nested list L and return its contents as a single, flat list.\n\nNote that because `nil' represents a list of zero elements (an\nempty list), any mention of nil in L will disappear after\nflattening. If you need to preserve nils, consider `-flatten-n'\nor map them to some unique symbol and then map them back.\n\nConses of two atoms are considered \\\"terminals\\\", that is, they\naren't flattened further.\n\nSee also: `-flatten-n'\"\n (declare (pure t) (side-effect-free t))\n (if (and (listp l) (listp (cdr l)))\n (-mapcat '-flatten l)\n (list l)))\n\n(defmacro --iterate (form init n)\n \"Anaphoric version of `-iterate'.\"\n (declare (debug (form form form)))\n `(-iterate (lambda (it) ,form) ,init ,n))\n\n(defun -flatten-n (num list)\n \"Flatten NUM levels of a nested LIST.\n\nSee also: `-flatten'\"\n (declare (pure t) (side-effect-free t))\n (-last-item (--iterate (--mapcat (-list it) it) list (1+ num))))\n\n(defun -concat (&rest lists)\n \"Return a new list with the concatenation of the elements in the supplied LISTS.\"\n (declare (pure t) (side-effect-free t))\n (apply 'append lists))\n\n(defalias '-copy 'copy-sequence\n \"Create a shallow copy of LIST.\n\n\\(fn LIST)\")\n\n(defun -splice (pred fun list)\n \"Splice lists generated by FUN in place of elements matching PRED in LIST.\n\nFUN takes the element matching PRED as input.\n\nThis function can be used as replacement for `,@' in case you\nneed to splice several lists at marked positions (for example\nwith keywords).\n\nSee also: `-splice-list', `-insert-at'\"\n (let (r)\n (--each list\n (if (funcall pred it)\n (let ((new (funcall fun it)))\n (--each new (!cons it r)))\n (!cons it r)))\n (nreverse r)))\n\n(defmacro --splice (pred form list)\n \"Anaphoric form of `-splice'.\"\n `(-splice (lambda (it) ,pred) (lambda (it) ,form) ,list))\n\n(defun -splice-list (pred new-list list)\n \"Splice NEW-LIST in place of elements matching PRED in LIST.\n\nSee also: `-splice', `-insert-at'\"\n (-splice pred (lambda (_) new-list) list))\n\n(defmacro --splice-list (pred new-list list)\n \"Anaphoric form of `-splice-list'.\"\n `(-splice-list (lambda (it) ,pred) ,new-list ,list))\n\n(defun -cons* (&rest args)\n \"Make a new list from the elements of ARGS.\n\nThe last 2 members of ARGS are used as the final cons of the\nresult so if the final member of ARGS is not a list the result is\na dotted list.\"\n (declare (pure t) (side-effect-free t))\n (-reduce-r 'cons args))\n\n(defun -snoc (list elem &rest elements)\n \"Append ELEM to the end of the list.\n\nThis is like `cons', but operates on the end of list.\n\nIf ELEMENTS is non nil, append these to the list as well.\"\n (-concat list (list elem) elements))\n\n(defmacro --first (form list)\n \"Anaphoric form of `-first'.\"\n (declare (debug (form form)))\n (let ((n (make-symbol \"needle\")))\n `(let (,n)\n (--each-while ,list (not ,n)\n (when ,form (setq ,n it)))\n ,n)))\n\n(defun -first (pred list)\n \"Return the first x in LIST where (PRED x) is non-nil, else nil.\n\nTo get the first item in the list no questions asked, use `car'.\n\nAlias: `-find'\"\n (--first (funcall pred it) list))\n\n(defalias '-find '-first)\n(defalias '--find '--first)\n\n(defmacro --some (form list)\n \"Anaphoric form of `-some'.\"\n (declare (debug (form form)))\n (let ((n (make-symbol \"needle\")))\n `(let (,n)\n (--each-while ,list (not ,n)\n (setq ,n ,form))\n ,n)))\n\n(defun -some (pred list)\n \"Return (PRED x) for the first LIST item where (PRED x) is non-nil, else nil.\n\nAlias: `-any'\"\n (--some (funcall pred it) list))\n\n(defalias '-any '-some)\n(defalias '--any '--some)\n\n(defmacro --last (form list)\n \"Anaphoric form of `-last'.\"\n (declare (debug (form form)))\n (let ((n (make-symbol \"needle\")))\n `(let (,n)\n (--each ,list\n (when ,form (setq ,n it)))\n ,n)))\n\n(defun -last (pred list)\n \"Return the last x in LIST where (PRED x) is non-nil, else nil.\"\n (--last (funcall pred it) list))\n\n(defalias '-first-item 'car\n \"Return the first item of LIST, or nil on an empty list.\n\nSee also: `-second-item', `-last-item'.\n\n\\(fn LIST)\")\n\n;; Ensure that calls to `-first-item' are compiled to a single opcode,\n;; just like `car'.\n(put '-first-item 'byte-opcode 'byte-car)\n(put '-first-item 'byte-compile 'byte-compile-one-arg)\n\n(defalias '-second-item 'cadr\n \"Return the second item of LIST, or nil if LIST is too short.\n\nSee also: `-third-item'.\n\n\\(fn LIST)\")\n\n(defalias '-third-item 'caddr\n \"Return the third item of LIST, or nil if LIST is too short.\n\nSee also: `-fourth-item'.\n\n\\(fn LIST)\")\n\n(defun -fourth-item (list)\n \"Return the fourth item of LIST, or nil if LIST is too short.\n\nSee also: `-fifth-item'.\"\n (declare (pure t) (side-effect-free t))\n (car (cdr (cdr (cdr list)))))\n\n(defun -fifth-item (list)\n \"Return the fifth item of LIST, or nil if LIST is too short.\n\nSee also: `-last-item'.\"\n (declare (pure t) (side-effect-free t))\n (car (cdr (cdr (cdr (cdr list))))))\n\n;; TODO: gv was introduced in 24.3, so we can remove the if statement\n;; when support for earlier versions is dropped\n(eval-when-compile\n (require 'cl)\n (if (fboundp 'gv-define-simple-setter)\n (gv-define-simple-setter -first-item setcar)\n (require 'cl)\n (with-no-warnings\n (defsetf -first-item (x) (val) `(setcar ,x ,val)))))\n\n(defun -last-item (list)\n \"Return the last item of LIST, or nil on an empty list.\"\n (declare (pure t) (side-effect-free t))\n (car (last list)))\n\n;; TODO: gv was introduced in 24.3, so we can remove the if statement\n;; when support for earlier versions is dropped\n(eval-when-compile\n (if (fboundp 'gv-define-setter)\n (gv-define-setter -last-item (val x) `(setcar (last ,x) ,val))\n (with-no-warnings\n (defsetf -last-item (x) (val) `(setcar (last ,x) ,val)))))\n\n(defun -butlast (list)\n \"Return a list of all items in list except for the last.\"\n ;; no alias as we don't want magic optional argument\n (declare (pure t) (side-effect-free t))\n (butlast list))\n\n(defmacro --count (pred list)\n \"Anaphoric form of `-count'.\"\n (declare (debug (form form)))\n (let ((r (make-symbol \"result\")))\n `(let ((,r 0))\n (--each ,list (when ,pred (setq ,r (1+ ,r))))\n ,r)))\n\n(defun -count (pred list)\n \"Counts the number of items in LIST where (PRED item) is non-nil.\"\n (--count (funcall pred it) list))\n\n(defun ---truthy? (val)\n (declare (pure t) (side-effect-free t))\n (not (null val)))\n\n(defmacro --any? (form list)\n \"Anaphoric form of `-any?'.\"\n (declare (debug (form form)))\n `(---truthy? (--some ,form ,list)))\n\n(defun -any? (pred list)\n \"Return t if (PRED x) is non-nil for any x in LIST, else nil.\n\nAlias: `-any-p', `-some?', `-some-p'\"\n (--any? (funcall pred it) list))\n\n(defalias '-some? '-any?)\n(defalias '--some? '--any?)\n(defalias '-any-p '-any?)\n(defalias '--any-p '--any?)\n(defalias '-some-p '-any?)\n(defalias '--some-p '--any?)\n\n(defmacro --all? (form list)\n \"Anaphoric form of `-all?'.\"\n (declare (debug (form form)))\n (let ((a (make-symbol \"all\")))\n `(let ((,a t))\n (--each-while ,list ,a (setq ,a ,form))\n (---truthy? ,a))))\n\n(defun -all? (pred list)\n \"Return t if (PRED x) is non-nil for all x in LIST, else nil.\n\nAlias: `-all-p', `-every?', `-every-p'\"\n (--all? (funcall pred it) list))\n\n(defalias '-every? '-all?)\n(defalias '--every? '--all?)\n(defalias '-all-p '-all?)\n(defalias '--all-p '--all?)\n(defalias '-every-p '-all?)\n(defalias '--every-p '--all?)\n\n(defmacro --none? (form list)\n \"Anaphoric form of `-none?'.\"\n (declare (debug (form form)))\n `(--all? (not ,form) ,list))\n\n(defun -none? (pred list)\n \"Return t if (PRED x) is nil for all x in LIST, else nil.\n\nAlias: `-none-p'\"\n (--none? (funcall pred it) list))\n\n(defalias '-none-p '-none?)\n(defalias '--none-p '--none?)\n\n(defmacro --only-some? (form list)\n \"Anaphoric form of `-only-some?'.\"\n (declare (debug (form form)))\n (let ((y (make-symbol \"yes\"))\n (n (make-symbol \"no\")))\n `(let (,y ,n)\n (--each-while ,list (not (and ,y ,n))\n (if ,form (setq ,y t) (setq ,n t)))\n (---truthy? (and ,y ,n)))))\n\n(defun -only-some? (pred list)\n \"Return `t` if at least one item of LIST matches PRED and at least one item of LIST does not match PRED.\nReturn `nil` both if all items match the predicate or if none of the items match the predicate.\n\nAlias: `-only-some-p'\"\n (--only-some? (funcall pred it) list))\n\n(defalias '-only-some-p '-only-some?)\n(defalias '--only-some-p '--only-some?)\n\n(defun -slice (list from &optional to step)\n \"Return copy of LIST, starting from index FROM to index TO.\n\nFROM or TO may be negative. These values are then interpreted\nmodulo the length of the list.\n\nIf STEP is a number, only each STEPth item in the resulting\nsection is returned. Defaults to 1.\"\n (declare (pure t) (side-effect-free t))\n (let ((length (length list))\n (new-list nil))\n ;; to defaults to the end of the list\n (setq to (or to length))\n (setq step (or step 1))\n ;; handle negative indices\n (when (< from 0)\n (setq from (mod from length)))\n (when (< to 0)\n (setq to (mod to length)))\n\n ;; iterate through the list, keeping the elements we want\n (--each-while list (< it-index to)\n (when (and (>= it-index from)\n (= (mod (- from it-index) step) 0))\n (push it new-list)))\n (nreverse new-list)))\n\n(defun -take (n list)\n \"Return a new list of the first N items in LIST, or all items if there are fewer than N.\n\nSee also: `-take-last'\"\n (declare (pure t) (side-effect-free t))\n (let (result)\n (--dotimes n\n (when list\n (!cons (car list) result)\n (!cdr list)))\n (nreverse result)))\n\n(defun -take-last (n list)\n \"Return the last N items of LIST in order.\n\nSee also: `-take'\"\n (declare (pure t) (side-effect-free t))\n (copy-sequence (last list n)))\n\n(defalias '-drop 'nthcdr\n \"Return the tail of LIST without the first N items.\n\nSee also: `-drop-last'\n\n\\(fn N LIST)\")\n\n(defun -drop-last (n list)\n \"Remove the last N items of LIST and return a copy.\n\nSee also: `-drop'\"\n ;; No alias because we don't want magic optional argument\n (declare (pure t) (side-effect-free t))\n (butlast list n))\n\n(defmacro --take-while (form list)\n \"Anaphoric form of `-take-while'.\"\n (declare (debug (form form)))\n (let ((r (make-symbol \"result\")))\n `(let (,r)\n (--each-while ,list ,form (!cons it ,r))\n (nreverse ,r))))\n\n(defun -take-while (pred list)\n \"Return a new list of successive items from LIST while (PRED item) returns a non-nil value.\"\n (--take-while (funcall pred it) list))\n\n(defmacro --drop-while (form list)\n \"Anaphoric form of `-drop-while'.\"\n (declare (debug (form form)))\n (let ((l (make-symbol \"list\")))\n `(let ((,l ,list))\n (while (and ,l (let ((it (car ,l))) ,form))\n (!cdr ,l))\n ,l)))\n\n(defun -drop-while (pred list)\n \"Return the tail of LIST starting from the first item for which (PRED item) returns nil.\"\n (--drop-while (funcall pred it) list))\n\n(defun -split-at (n list)\n \"Return a list of ((-take N LIST) (-drop N LIST)), in no more than one pass through the list.\"\n (declare (pure t) (side-effect-free t))\n (let (result)\n (--dotimes n\n (when list\n (!cons (car list) result)\n (!cdr list)))\n (list (nreverse result) list)))\n\n(defun -rotate (n list)\n \"Rotate LIST N places to the right. With N negative, rotate to the left.\nThe time complexity is O(n).\"\n (declare (pure t) (side-effect-free t))\n (if (> n 0)\n (append (last list n) (butlast list n))\n (append (-drop (- n) list) (-take (- n) list))))\n\n(defun -insert-at (n x list)\n \"Return a list with X inserted into LIST at position N.\n\nSee also: `-splice', `-splice-list'\"\n (declare (pure t) (side-effect-free t))\n (let ((split-list (-split-at n list)))\n (nconc (car split-list) (cons x (cadr split-list)))))\n\n(defun -replace-at (n x list)\n \"Return a list with element at Nth position in LIST replaced with X.\n\nSee also: `-replace'\"\n (declare (pure t) (side-effect-free t))\n (let ((split-list (-split-at n list)))\n (nconc (car split-list) (cons x (cdr (cadr split-list))))))\n\n(defun -update-at (n func list)\n \"Return a list with element at Nth position in LIST replaced with `(func (nth n list))`.\n\nSee also: `-map-when'\"\n (let ((split-list (-split-at n list)))\n (nconc (car split-list) (cons (funcall func (car (cadr split-list))) (cdr (cadr split-list))))))\n\n(defmacro --update-at (n form list)\n \"Anaphoric version of `-update-at'.\"\n (declare (debug (form form form)))\n `(-update-at ,n (lambda (it) ,form) ,list))\n\n(defun -remove-at (n list)\n \"Return a list with element at Nth position in LIST removed.\n\nSee also: `-remove-at-indices', `-remove'\"\n (declare (pure t) (side-effect-free t))\n (-remove-at-indices (list n) list))\n\n(defun -remove-at-indices (indices list)\n \"Return a list whose elements are elements from LIST without\nelements selected as `(nth i list)` for all i\nfrom INDICES.\n\nSee also: `-remove-at', `-remove'\"\n (declare (pure t) (side-effect-free t))\n (let* ((indices (-sort '< indices))\n (diffs (cons (car indices) (-map '1- (-zip-with '- (cdr indices) indices))))\n r)\n (--each diffs\n (let ((split (-split-at it list)))\n (!cons (car split) r)\n (setq list (cdr (cadr split)))))\n (!cons list r)\n (apply '-concat (nreverse r))))\n\n(defmacro --split-with (pred list)\n \"Anaphoric form of `-split-with'.\"\n (declare (debug (form form)))\n (let ((l (make-symbol \"list\"))\n (r (make-symbol \"result\"))\n (c (make-symbol \"continue\")))\n `(let ((,l ,list)\n (,r nil)\n (,c t))\n (while (and ,l ,c)\n (let ((it (car ,l)))\n (if (not ,pred)\n (setq ,c nil)\n (!cons it ,r)\n (!cdr ,l))))\n (list (nreverse ,r) ,l))))\n\n(defun -split-with (pred list)\n \"Return a list of ((-take-while PRED LIST) (-drop-while PRED LIST)), in no more than one pass through the list.\"\n (--split-with (funcall pred it) list))\n\n(defmacro -split-on (item list)\n \"Split the LIST each time ITEM is found.\n\nUnlike `-partition-by', the ITEM is discarded from the results.\nEmpty lists are also removed from the result.\n\nComparison is done by `equal'.\n\nSee also `-split-when'\"\n (declare (debug (form form)))\n `(-split-when (lambda (it) (equal it ,item)) ,list))\n\n(defmacro --split-when (form list)\n \"Anaphoric version of `-split-when'.\"\n (declare (debug (form form)))\n `(-split-when (lambda (it) ,form) ,list))\n\n(defun -split-when (fn list)\n \"Split the LIST on each element where FN returns non-nil.\n\nUnlike `-partition-by', the \\\"matched\\\" element is discarded from\nthe results. Empty lists are also removed from the result.\n\nThis function can be thought of as a generalization of\n`split-string'.\"\n (let (r s)\n (while list\n (if (not (funcall fn (car list)))\n (push (car list) s)\n (when s (push (nreverse s) r))\n (setq s nil))\n (!cdr list))\n (when s (push (nreverse s) r))\n (nreverse r)))\n\n(defmacro --separate (form list)\n \"Anaphoric form of `-separate'.\"\n (declare (debug (form form)))\n (let ((y (make-symbol \"yes\"))\n (n (make-symbol \"no\")))\n `(let (,y ,n)\n (--each ,list (if ,form (!cons it ,y) (!cons it ,n)))\n (list (nreverse ,y) (nreverse ,n)))))\n\n(defun -separate (pred list)\n \"Return a list of ((-filter PRED LIST) (-remove PRED LIST)), in one pass through the list.\"\n (--separate (funcall pred it) list))\n\n(defun ---partition-all-in-steps-reversed (n step list)\n \"Private: Used by -partition-all-in-steps and -partition-in-steps.\"\n (when (< step 1)\n (error \"Step must be a positive number, or you're looking at some juicy infinite loops.\"))\n (let ((result nil))\n (while list\n (!cons (-take n list) result)\n (setq list (-drop step list)))\n result))\n\n(defun -partition-all-in-steps (n step list)\n \"Return a new list with the items in LIST grouped into N-sized sublists at offsets STEP apart.\nThe last groups may contain less than N items.\"\n (declare (pure t) (side-effect-free t))\n (nreverse (---partition-all-in-steps-reversed n step list)))\n\n(defun -partition-in-steps (n step list)\n \"Return a new list with the items in LIST grouped into N-sized sublists at offsets STEP apart.\nIf there are not enough items to make the last group N-sized,\nthose items are discarded.\"\n (declare (pure t) (side-effect-free t))\n (let ((result (---partition-all-in-steps-reversed n step list)))\n (while (and result (< (length (car result)) n))\n (!cdr result))\n (nreverse result)))\n\n(defun -partition-all (n list)\n \"Return a new list with the items in LIST grouped into N-sized sublists.\nThe last group may contain less than N items.\"\n (declare (pure t) (side-effect-free t))\n (-partition-all-in-steps n n list))\n\n(defun -partition (n list)\n \"Return a new list with the items in LIST grouped into N-sized sublists.\nIf there are not enough items to make the last group N-sized,\nthose items are discarded.\"\n (declare (pure t) (side-effect-free t))\n (-partition-in-steps n n list))\n\n(defmacro --partition-by (form list)\n \"Anaphoric form of `-partition-by'.\"\n (declare (debug (form form)))\n (let ((r (make-symbol \"result\"))\n (s (make-symbol \"sublist\"))\n (v (make-symbol \"value\"))\n (n (make-symbol \"new-value\"))\n (l (make-symbol \"list\")))\n `(let ((,l ,list))\n (when ,l\n (let* ((,r nil)\n (it (car ,l))\n (,s (list it))\n (,v ,form)\n (,l (cdr ,l)))\n (while ,l\n (let* ((it (car ,l))\n (,n ,form))\n (unless (equal ,v ,n)\n (!cons (nreverse ,s) ,r)\n (setq ,s nil)\n (setq ,v ,n))\n (!cons it ,s)\n (!cdr ,l)))\n (!cons (nreverse ,s) ,r)\n (nreverse ,r))))))\n\n(defun -partition-by (fn list)\n \"Apply FN to each item in LIST, splitting it each time FN returns a new value.\"\n (--partition-by (funcall fn it) list))\n\n(defmacro --partition-by-header (form list)\n \"Anaphoric form of `-partition-by-header'.\"\n (declare (debug (form form)))\n (let ((r (make-symbol \"result\"))\n (s (make-symbol \"sublist\"))\n (h (make-symbol \"header-value\"))\n (b (make-symbol \"seen-body?\"))\n (n (make-symbol \"new-value\"))\n (l (make-symbol \"list\")))\n `(let ((,l ,list))\n (when ,l\n (let* ((,r nil)\n (it (car ,l))\n (,s (list it))\n (,h ,form)\n (,b nil)\n (,l (cdr ,l)))\n (while ,l\n (let* ((it (car ,l))\n (,n ,form))\n (if (equal ,h ,n)\n (when ,b\n (!cons (nreverse ,s) ,r)\n (setq ,s nil)\n (setq ,b nil))\n (setq ,b t))\n (!cons it ,s)\n (!cdr ,l)))\n (!cons (nreverse ,s) ,r)\n (nreverse ,r))))))\n\n(defun -partition-by-header (fn list)\n \"Apply FN to the first item in LIST. That is the header\nvalue. Apply FN to each item in LIST, splitting it each time FN\nreturns the header value, but only after seeing at least one\nother value (the body).\"\n (--partition-by-header (funcall fn it) list))\n\n(defun -partition-after-pred (pred list)\n \"Partition directly after each time PRED is true on an element of LIST.\"\n (when list\n (let ((rest (-partition-after-pred pred\n (cdr list))))\n (if (funcall pred (car list))\n ;;split after (car list)\n (cons (list (car list))\n rest)\n\n ;;don't split after (car list)\n (cons (cons (car list)\n (car rest))\n (cdr rest))))))\n\n(defun -partition-before-pred (pred list)\n \"Partition directly before each time PRED is true on an element of LIST.\"\n (nreverse (-map #'reverse\n (-partition-after-pred pred (reverse list)))))\n\n(defun -partition-after-item (item list)\n \"Partition directly after each time ITEM appears in LIST.\"\n (-partition-after-pred (lambda (ele) (equal ele item))\n list))\n\n(defun -partition-before-item (item list)\n \"Partition directly before each time ITEM appears in LIST.\"\n (-partition-before-pred (lambda (ele) (equal ele item))\n list))\n\n(defmacro --group-by (form list)\n \"Anaphoric form of `-group-by'.\"\n (declare (debug t))\n (let ((n (make-symbol \"n\"))\n (k (make-symbol \"k\"))\n (grp (make-symbol \"grp\")))\n `(nreverse\n (-map\n (lambda (,n)\n (cons (car ,n)\n (nreverse (cdr ,n))))\n (--reduce-from\n (let* ((,k (,@form))\n (,grp (assoc ,k acc)))\n (if ,grp\n (setcdr ,grp (cons it (cdr ,grp)))\n (push\n (list ,k it)\n acc))\n acc)\n nil ,list)))))\n\n(defun -group-by (fn list)\n \"Separate LIST into an alist whose keys are FN applied to the\nelements of LIST. Keys are compared by `equal'.\"\n (--group-by (funcall fn it) list))\n\n(defun -interpose (sep list)\n \"Return a new list of all elements in LIST separated by SEP.\"\n (declare (pure t) (side-effect-free t))\n (let (result)\n (when list\n (!cons (car list) result)\n (!cdr list))\n (while list\n (setq result (cons (car list) (cons sep result)))\n (!cdr list))\n (nreverse result)))\n\n(defun -interleave (&rest lists)\n \"Return a new list of the first item in each list, then the second etc.\"\n (declare (pure t) (side-effect-free t))\n (when lists\n (let (result)\n (while (-none? 'null lists)\n (--each lists (!cons (car it) result))\n (setq lists (-map 'cdr lists)))\n (nreverse result))))\n\n(defmacro --zip-with (form list1 list2)\n \"Anaphoric form of `-zip-with'.\n\nThe elements in list1 are bound as symbol `it', the elements in list2 as symbol `other'.\"\n (declare (debug (form form form)))\n (let ((r (make-symbol \"result\"))\n (l1 (make-symbol \"list1\"))\n (l2 (make-symbol \"list2\")))\n `(let ((,r nil)\n (,l1 ,list1)\n (,l2 ,list2))\n (while (and ,l1 ,l2)\n (let ((it (car ,l1))\n (other (car ,l2)))\n (!cons ,form ,r)\n (!cdr ,l1)\n (!cdr ,l2)))\n (nreverse ,r))))\n\n(defun -zip-with (fn list1 list2)\n \"Zip the two lists LIST1 and LIST2 using a function FN. This\nfunction is applied pairwise taking as first argument element of\nLIST1 and as second argument element of LIST2 at corresponding\nposition.\n\nThe anaphoric form `--zip-with' binds the elements from LIST1 as symbol `it',\nand the elements from LIST2 as symbol `other'.\"\n (--zip-with (funcall fn it other) list1 list2))\n\n(defun -zip (&rest lists)\n \"Zip LISTS together. Group the head of each list, followed by the\nsecond elements of each list, and so on. The lengths of the returned\ngroupings are equal to the length of the shortest input list.\n\nIf two lists are provided as arguments, return the groupings as a list\nof cons cells. Otherwise, return the groupings as a list of lists.\n\nPlease note! This distinction is being removed in an upcoming 3.0\nrelease of Dash. If you rely on this behavior, use -zip-pair instead.\"\n (declare (pure t) (side-effect-free t))\n (when lists\n (let (results)\n (while (-none? 'null lists)\n (setq results (cons (mapcar 'car lists) results))\n (setq lists (mapcar 'cdr lists)))\n (setq results (nreverse results))\n (if (= (length lists) 2)\n ;; to support backward compatability, return\n ;; a cons cell if two lists were provided\n (--map (cons (car it) (cadr it)) results)\n results))))\n\n(defalias '-zip-pair '-zip)\n\n(defun -zip-fill (fill-value &rest lists)\n \"Zip LISTS, with FILL-VALUE padded onto the shorter lists. The\nlengths of the returned groupings are equal to the length of the\nlongest input list.\"\n (declare (pure t) (side-effect-free t))\n (apply '-zip (apply '-pad (cons fill-value lists))))\n\n(defun -unzip (lists)\n \"Unzip LISTS.\n\nThis works just like `-zip' but takes a list of lists instead of\na variable number of arguments, such that\n\n (-unzip (-zip L1 L2 L3 ...))\n\nis identity (given that the lists are the same length).\n\nSee also: `-zip'\"\n (apply '-zip lists))\n\n(defun -cycle (list)\n \"Return an infinite copy of LIST that will cycle through the\nelements and repeat from the beginning.\"\n (declare (pure t) (side-effect-free t))\n (let ((newlist (-map 'identity list)))\n (nconc newlist newlist)))\n\n(defun -pad (fill-value &rest lists)\n \"Appends FILL-VALUE to the end of each list in LISTS such that they\nwill all have the same length.\"\n (let* ((annotations (-annotate 'length lists))\n (n (-max (-map 'car annotations))))\n (--map (append (cdr it) (-repeat (- n (car it)) fill-value)) annotations)))\n\n(defun -annotate (fn list)\n \"Return a list of cons cells where each cell is FN applied to each\nelement of LIST paired with the unmodified element of LIST.\"\n (-zip (-map fn list) list))\n\n(defmacro --annotate (form list)\n \"Anaphoric version of `-annotate'.\"\n (declare (debug (form form)))\n `(-annotate (lambda (it) ,form) ,list))\n\n(defun dash--table-carry (lists restore-lists &optional re)\n \"Helper for `-table' and `-table-flat'.\n\nIf a list overflows, carry to the right and reset the list.\"\n (while (not (or (car lists)\n (equal lists '(nil))))\n (setcar lists (car restore-lists))\n (pop (cadr lists))\n (!cdr lists)\n (!cdr restore-lists)\n (when re\n (push (nreverse (car re)) (cadr re))\n (setcar re nil)\n (!cdr re))))\n\n(defun -table (fn &rest lists)\n \"Compute outer product of LISTS using function FN.\n\nThe function FN should have the same arity as the number of\nsupplied lists.\n\nThe outer product is computed by applying fn to all possible\ncombinations created by taking one element from each list in\norder. The dimension of the result is (length lists).\n\nSee also: `-table-flat'\"\n (let ((restore-lists (copy-sequence lists))\n (last-list (last lists))\n (re (make-list (length lists) nil)))\n (while (car last-list)\n (let ((item (apply fn (-map 'car lists))))\n (push item (car re))\n (setcar lists (cdar lists)) ;; silence byte compiler\n (dash--table-carry lists restore-lists re)))\n (nreverse (car (last re)))))\n\n(defun -table-flat (fn &rest lists)\n \"Compute flat outer product of LISTS using function FN.\n\nThe function FN should have the same arity as the number of\nsupplied lists.\n\nThe outer product is computed by applying fn to all possible\ncombinations created by taking one element from each list in\norder. The results are flattened, ignoring the tensor structure\nof the result. This is equivalent to calling:\n\n (-flatten-n (1- (length lists)) (apply \\\\='-table fn lists))\n\nbut the implementation here is much more efficient.\n\nSee also: `-flatten-n', `-table'\"\n (let ((restore-lists (copy-sequence lists))\n (last-list (last lists))\n re)\n (while (car last-list)\n (let ((item (apply fn (-map 'car lists))))\n (push item re)\n (setcar lists (cdar lists)) ;; silence byte compiler\n (dash--table-carry lists restore-lists)))\n (nreverse re)))\n\n(defun -partial (fn &rest args)\n \"Take a function FN and fewer than the normal arguments to FN,\nand return a fn that takes a variable number of additional ARGS.\nWhen called, the returned function calls FN with ARGS first and\nthen additional args.\"\n (apply 'apply-partially fn args))\n\n(defun -elem-index (elem list)\n \"Return the index of the first element in the given LIST which\nis equal to the query element ELEM, or nil if there is no\nsuch element.\"\n (declare (pure t) (side-effect-free t))\n (car (-elem-indices elem list)))\n\n(defun -elem-indices (elem list)\n \"Return the indices of all elements in LIST equal to the query\nelement ELEM, in ascending order.\"\n (declare (pure t) (side-effect-free t))\n (-find-indices (-partial 'equal elem) list))\n\n(defun -find-indices (pred list)\n \"Return the indices of all elements in LIST satisfying the\npredicate PRED, in ascending order.\"\n (apply 'append (--map-indexed (when (funcall pred it) (list it-index)) list)))\n\n(defmacro --find-indices (form list)\n \"Anaphoric version of `-find-indices'.\"\n (declare (debug (form form)))\n `(-find-indices (lambda (it) ,form) ,list))\n\n(defun -find-index (pred list)\n \"Take a predicate PRED and a LIST and return the index of the\nfirst element in the list satisfying the predicate, or nil if\nthere is no such element.\n\nSee also `-first'.\"\n (car (-find-indices pred list)))\n\n(defmacro --find-index (form list)\n \"Anaphoric version of `-find-index'.\"\n (declare (debug (form form)))\n `(-find-index (lambda (it) ,form) ,list))\n\n(defun -find-last-index (pred list)\n \"Take a predicate PRED and a LIST and return the index of the\nlast element in the list satisfying the predicate, or nil if\nthere is no such element.\n\nSee also `-last'.\"\n (-last-item (-find-indices pred list)))\n\n(defmacro --find-last-index (form list)\n \"Anaphoric version of `-find-last-index'.\"\n `(-find-last-index (lambda (it) ,form) ,list))\n\n(defun -select-by-indices (indices list)\n \"Return a list whose elements are elements from LIST selected\nas `(nth i list)` for all i from INDICES.\"\n (declare (pure t) (side-effect-free t))\n (let (r)\n (--each indices\n (!cons (nth it list) r))\n (nreverse r)))\n\n(defun -select-columns (columns table)\n \"Select COLUMNS from TABLE.\n\nTABLE is a list of lists where each element represents one row.\nIt is assumed each row has the same length.\n\nEach row is transformed such that only the specified COLUMNS are\nselected.\n\nSee also: `-select-column', `-select-by-indices'\"\n (declare (pure t) (side-effect-free t))\n (--map (-select-by-indices columns it) table))\n\n(defun -select-column (column table)\n \"Select COLUMN from TABLE.\n\nTABLE is a list of lists where each element represents one row.\nIt is assumed each row has the same length.\n\nThe single selected column is returned as a list.\n\nSee also: `-select-columns', `-select-by-indices'\"\n (declare (pure t) (side-effect-free t))\n (--mapcat (-select-by-indices (list column) it) table))\n\n(defmacro -> (x &optional form &rest more)\n \"Thread the expr through the forms. Insert X as the second item\nin the first form, making a list of it if it is not a list\nalready. If there are more forms, insert the first form as the\nsecond item in second form, etc.\"\n (declare (debug (form &rest [&or symbolp (sexp &rest form)])))\n (cond\n ((null form) x)\n ((null more) (if (listp form)\n `(,(car form) ,x ,@(cdr form))\n (list form x)))\n (:else `(-> (-> ,x ,form) ,@more))))\n\n(defmacro ->> (x &optional form &rest more)\n \"Thread the expr through the forms. Insert X as the last item\nin the first form, making a list of it if it is not a list\nalready. If there are more forms, insert the first form as the\nlast item in second form, etc.\"\n (declare (debug ->))\n (cond\n ((null form) x)\n ((null more) (if (listp form)\n `(,@form ,x)\n (list form x)))\n (:else `(->> (->> ,x ,form) ,@more))))\n\n(defmacro --> (x &rest forms)\n \"Starting with the value of X, thread each expression through FORMS.\n\nInsert X at the position signified by the symbol `it' in the first\nform. If there are more forms, insert the first form at the position\nsignified by `it' in in second form, etc.\"\n (declare (debug (form body)))\n `(-as-> ,x it ,@forms))\n\n(defmacro -as-> (value variable &rest forms)\n \"Starting with VALUE, thread VARIABLE through FORMS.\n\nIn the first form, bind VARIABLE to VALUE. In the second form, bind\nVARIABLE to the result of the first form, and so forth.\"\n (declare (debug (form symbolp body)))\n (if (null forms)\n `,value\n `(let ((,variable ,value))\n (-as-> ,(if (symbolp (car forms))\n (list (car forms) variable)\n (car forms))\n ,variable\n ,@(cdr forms)))))\n\n(defmacro -some-> (x &optional form &rest more)\n \"When expr is non-nil, thread it through the first form (via `->'),\nand when that result is non-nil, through the next form, etc.\"\n (declare (debug ->))\n (if (null form) x\n (let ((result (make-symbol \"result\")))\n `(-some-> (-when-let (,result ,x)\n (-> ,result ,form))\n ,@more))))\n\n(defmacro -some->> (x &optional form &rest more)\n \"When expr is non-nil, thread it through the first form (via `->>'),\nand when that result is non-nil, through the next form, etc.\"\n (declare (debug ->))\n (if (null form) x\n (let ((result (make-symbol \"result\")))\n `(-some->> (-when-let (,result ,x)\n (->> ,result ,form))\n ,@more))))\n\n(defmacro -some--> (x &optional form &rest more)\n \"When expr in non-nil, thread it through the first form (via `-->'),\nand when that result is non-nil, through the next form, etc.\"\n (declare (debug ->))\n (if (null form) x\n (let ((result (make-symbol \"result\")))\n `(-some--> (-when-let (,result ,x)\n (--> ,result ,form))\n ,@more))))\n\n(defun -grade-up (comparator list)\n \"Grade elements of LIST using COMPARATOR relation, yielding a\npermutation vector such that applying this permutation to LIST\nsorts it in ascending order.\"\n ;; ugly hack to \"fix\" lack of lexical scope\n (let ((comp `(lambda (it other) (funcall ',comparator (car it) (car other)))))\n (->> (--map-indexed (cons it it-index) list)\n (-sort comp)\n (-map 'cdr))))\n\n(defun -grade-down (comparator list)\n \"Grade elements of LIST using COMPARATOR relation, yielding a\npermutation vector such that applying this permutation to LIST\nsorts it in descending order.\"\n ;; ugly hack to \"fix\" lack of lexical scope\n (let ((comp `(lambda (it other) (funcall ',comparator (car other) (car it)))))\n (->> (--map-indexed (cons it it-index) list)\n (-sort comp)\n (-map 'cdr))))\n\n(defvar dash--source-counter 0\n \"Monotonic counter for generated symbols.\")\n\n(defun dash--match-make-source-symbol ()\n \"Generate a new dash-source symbol.\n\nAll returned symbols are guaranteed to be unique.\"\n (prog1 (make-symbol (format \"--dash-source-%d--\" dash--source-counter))\n (setq dash--source-counter (1+ dash--source-counter))))\n\n(defun dash--match-ignore-place-p (symbol)\n \"Return non-nil if SYMBOL is a symbol and starts with _.\"\n (and (symbolp symbol)\n (eq (aref (symbol-name symbol) 0) ?_)))\n\n(defun dash--match-cons-skip-cdr (skip-cdr source)\n \"Helper function generating idiomatic shifting code.\"\n (cond\n ((= skip-cdr 0)\n `(pop ,source))\n (t\n `(prog1 ,(dash--match-cons-get-car skip-cdr source)\n (setq ,source ,(dash--match-cons-get-cdr (1+ skip-cdr) source))))))\n\n(defun dash--match-cons-get-car (skip-cdr source)\n \"Helper function generating idiomatic code to get nth car.\"\n (cond\n ((= skip-cdr 0)\n `(car ,source))\n ((= skip-cdr 1)\n `(cadr ,source))\n (t\n `(nth ,skip-cdr ,source))))\n\n(defun dash--match-cons-get-cdr (skip-cdr source)\n \"Helper function generating idiomatic code to get nth cdr.\"\n (cond\n ((= skip-cdr 0)\n source)\n ((= skip-cdr 1)\n `(cdr ,source))\n (t\n `(nthcdr ,skip-cdr ,source))))\n\n(defun dash--match-cons (match-form source)\n \"Setup a cons matching environment and call the real matcher.\"\n (let ((s (dash--match-make-source-symbol))\n (n 0)\n (m match-form))\n (while (and (consp m)\n (dash--match-ignore-place-p (car m)))\n (setq n (1+ n)) (!cdr m))\n (cond\n ;; when we only have one pattern in the list, we don't have to\n ;; create a temporary binding (--dash-source--) for the source\n ;; and just use the input directly\n ((and (consp m)\n (not (cdr m)))\n (dash--match (car m) (dash--match-cons-get-car n source)))\n ;; handle other special types\n ((> n 0)\n (dash--match m (dash--match-cons-get-cdr n source)))\n ;; this is the only entry-point for dash--match-cons-1, that's\n ;; why we can't simply use the above branch, it would produce\n ;; infinite recursion\n (t\n (cons (list s source) (dash--match-cons-1 match-form s))))))\n\n(defun dash--match-cons-1 (match-form source &optional props)\n \"Match MATCH-FORM against SOURCE.\n\nMATCH-FORM is a proper or improper list. Each element of\nMATCH-FORM is either a symbol, which gets bound to the respective\nvalue in source or another match form which gets destructured\nrecursively.\n\nIf the cdr of last cons cell in the list is `nil', matching stops\nthere.\n\nSOURCE is a proper or improper list.\"\n (let ((skip-cdr (or (plist-get props :skip-cdr) 0)))\n (cond\n ((consp match-form)\n (cond\n ((cdr match-form)\n (cond\n ((and (symbolp (car match-form))\n (memq (car match-form) '(&keys &plist &alist &hash)))\n (dash--match-kv (dash--match-kv-normalize-match-form match-form) (dash--match-cons-get-cdr skip-cdr source)))\n ((dash--match-ignore-place-p (car match-form))\n (dash--match-cons-1 (cdr match-form) source\n (plist-put props :skip-cdr (1+ skip-cdr))))\n (t\n (-concat (dash--match (car match-form) (dash--match-cons-skip-cdr skip-cdr source))\n (dash--match-cons-1 (cdr match-form) source)))))\n (t ;; Last matching place, no need for shift\n (dash--match (car match-form) (dash--match-cons-get-car skip-cdr source)))))\n ((eq match-form nil)\n nil)\n (t ;; Handle improper lists. Last matching place, no need for shift\n (dash--match match-form (dash--match-cons-get-cdr skip-cdr source))))))\n\n(defun dash--vector-tail (seq start)\n \"Return the tail of SEQ starting at START.\"\n (cond\n ((vectorp seq)\n (let* ((re-length (- (length seq) start))\n (re (make-vector re-length 0)))\n (--dotimes re-length (aset re it (aref seq (+ it start))))\n re))\n ((stringp seq)\n (substring seq start))))\n\n(defun dash--match-vector (match-form source)\n \"Setup a vector matching environment and call the real matcher.\"\n (let ((s (dash--match-make-source-symbol)))\n (cond\n ;; don't bind `s' if we only have one sub-pattern\n ((= (length match-form) 1)\n (dash--match (aref match-form 0) `(aref ,source 0)))\n ;; if the source is a symbol, we don't need to re-bind it\n ((symbolp source)\n (dash--match-vector-1 match-form source))\n ;; don't bind `s' if we only have one sub-pattern which is not ignored\n ((let* ((ignored-places (mapcar 'dash--match-ignore-place-p match-form))\n (ignored-places-n (length (-remove 'null ignored-places))))\n (when (= ignored-places-n (1- (length match-form)))\n (let ((n (-find-index 'null ignored-places)))\n (dash--match (aref match-form n) `(aref ,source ,n))))))\n (t\n (cons (list s source) (dash--match-vector-1 match-form s))))))\n\n(defun dash--match-vector-1 (match-form source)\n \"Match MATCH-FORM against SOURCE.\n\nMATCH-FORM is a vector. Each element of MATCH-FORM is either a\nsymbol, which gets bound to the respective value in source or\nanother match form which gets destructured recursively.\n\nIf second-from-last place in MATCH-FORM is the symbol &rest, the\nnext element of the MATCH-FORM is matched against the tail of\nSOURCE, starting at index of the &rest symbol. This is\nconceptually the same as the (head . tail) match for improper\nlists, where dot plays the role of &rest.\n\nSOURCE is a vector.\n\nIf the MATCH-FORM vector is shorter than SOURCE vector, only\nthe (length MATCH-FORM) places are bound, the rest of the SOURCE\nis discarded.\"\n (let ((i 0)\n (l (length match-form))\n (re))\n (while (< i l)\n (let ((m (aref match-form i)))\n (push (cond\n ((and (symbolp m)\n (eq m '&rest))\n (prog1 (dash--match\n (aref match-form (1+ i))\n `(dash--vector-tail ,source ,i))\n (setq i l)))\n ((and (symbolp m)\n ;; do not match symbols starting with _\n (not (eq (aref (symbol-name m) 0) ?_)))\n (list (list m `(aref ,source ,i))))\n ((not (symbolp m))\n (dash--match m `(aref ,source ,i))))\n re)\n (setq i (1+ i))))\n (-flatten-n 1 (nreverse re))))\n\n(defun dash--match-kv-normalize-match-form (pattern)\n \"Normalize kv PATTERN.\n\nThis method normalizes PATTERN to the format expected by\n`dash--match-kv'. See `-let' for the specification.\"\n (let ((normalized (list (car pattern)))\n (skip nil)\n (fill-placeholder (make-symbol \"--dash-fill-placeholder--\")))\n (-each (apply '-zip (-pad fill-placeholder (cdr pattern) (cddr pattern)))\n (lambda (pair)\n (let ((current (car pair))\n (next (cdr pair)))\n (if skip\n (setq skip nil)\n (if (or (eq fill-placeholder next)\n (not (or (and (symbolp next)\n (not (keywordp next))\n (not (eq next t))\n (not (eq next nil)))\n (and (consp next)\n (not (eq (car next) 'quote)))\n (vectorp next))))\n (progn\n (cond\n ((keywordp current)\n (push current normalized)\n (push (intern (substring (symbol-name current) 1)) normalized))\n ((stringp current)\n (push current normalized)\n (push (intern current) normalized))\n ((and (consp current)\n (eq (car current) 'quote))\n (push current normalized)\n (push (cadr current) normalized))\n (t (error \"-let: found key `%s' in kv destructuring but its pattern `%s' is invalid and can not be derived from the key\" current next)))\n (setq skip nil))\n (push current normalized)\n (push next normalized)\n (setq skip t))))))\n (nreverse normalized)))\n\n(defun dash--match-kv (match-form source)\n \"Setup a kv matching environment and call the real matcher.\n\nkv can be any key-value store, such as plist, alist or hash-table.\"\n (let ((s (dash--match-make-source-symbol)))\n (cond\n ;; don't bind `s' if we only have one sub-pattern (&type key val)\n ((= (length match-form) 3)\n (dash--match-kv-1 (cdr match-form) source (car match-form)))\n ;; if the source is a symbol, we don't need to re-bind it\n ((symbolp source)\n (dash--match-kv-1 (cdr match-form) source (car match-form)))\n (t\n (cons (list s source) (dash--match-kv-1 (cdr match-form) s (car match-form)))))))\n\n(defun dash--match-kv-1 (match-form source type)\n \"Match MATCH-FORM against SOURCE of type TYPE.\n\nMATCH-FORM is a proper list of the form (key1 place1 ... keyN\nplaceN). Each placeK is either a symbol, which gets bound to the\nvalue of keyK retrieved from the key-value store, or another\nmatch form which gets destructured recursively.\n\nSOURCE is a key-value store of type TYPE, which can be a plist,\nan alist or a hash table.\n\nTYPE is a token specifying the type of the key-value store.\nValid values are &plist, &alist and &hash.\"\n (-flatten-n 1 (-map\n (lambda (kv)\n (let* ((k (car kv))\n (v (cadr kv))\n (getter (cond\n ((or (eq type '&plist) (eq type '&keys))\n `(plist-get ,source ,k))\n ((eq type '&alist)\n `(cdr (assoc ,k ,source)))\n ((eq type '&hash)\n `(gethash ,k ,source)))))\n (cond\n ((symbolp v)\n (list (list v getter)))\n (t (dash--match v getter)))))\n (-partition 2 match-form))))\n\n(defun dash--match-symbol (match-form source)\n \"Bind a symbol.\n\nThis works just like `let', there is no destructuring.\"\n (list (list match-form source)))\n\n(defun dash--match (match-form source)\n \"Match MATCH-FORM against SOURCE.\n\nThis function tests the MATCH-FORM and dispatches to specific\nmatchers based on the type of the expression.\n\nKey-value stores are disambiguated by placing a token &plist,\n&alist or &hash as a first item in the MATCH-FORM.\"\n (cond\n ((symbolp match-form)\n (dash--match-symbol match-form source))\n ((consp match-form)\n (cond\n ;; Handle the \"x &as\" bindings first.\n ((and (consp (cdr match-form))\n (symbolp (car match-form))\n (eq '&as (cadr match-form)))\n (let ((s (car match-form)))\n (cons (list s source)\n (dash--match (cddr match-form) s))))\n ((memq (car match-form) '(&keys &plist &alist &hash))\n (dash--match-kv (dash--match-kv-normalize-match-form match-form) source))\n (t (dash--match-cons match-form source))))\n ((vectorp match-form)\n ;; We support the &as binding in vectors too\n (cond\n ((and (> (length match-form) 2)\n (symbolp (aref match-form 0))\n (eq '&as (aref match-form 1)))\n (let ((s (aref match-form 0)))\n (cons (list s source)\n (dash--match (dash--vector-tail match-form 2) s))))\n (t (dash--match-vector match-form source))))))\n\n(defun dash--normalize-let-varlist (varlist)\n \"Normalize VARLIST so that every binding is a list.\n\n`let' allows specifying a binding which is not a list but simply\nthe place which is then automatically bound to nil, such that all\nthree of the following are identical and evaluate to nil.\n\n (let (a) a)\n (let ((a)) a)\n (let ((a nil)) a)\n\nThis function normalizes all of these to the last form.\"\n (--map (if (consp it) it (list it nil)) varlist))\n\n(defmacro -let* (varlist &rest body)\n \"Bind variables according to VARLIST then eval BODY.\n\nVARLIST is a list of lists of the form (PATTERN SOURCE). Each\nPATTERN is matched against the SOURCE structurally. SOURCE is\nonly evaluated once for each PATTERN.\n\nEach SOURCE can refer to the symbols already bound by this\nVARLIST. This is useful if you want to destructure SOURCE\nrecursively but also want to name the intermediate structures.\n\nSee `-let' for the list of all possible patterns.\"\n (declare (debug ((&rest [&or (sexp form) sexp]) body))\n (indent 1))\n (let* ((varlist (dash--normalize-let-varlist varlist))\n (bindings (--mapcat (dash--match (car it) (cadr it)) varlist)))\n `(let* ,bindings\n ,@body)))\n\n(defmacro -let (varlist &rest body)\n \"Bind variables according to VARLIST then eval BODY.\n\nVARLIST is a list of lists of the form (PATTERN SOURCE). Each\nPATTERN is matched against the SOURCE \\\"structurally\\\". SOURCE\nis only evaluated once for each PATTERN. Each PATTERN is matched\nrecursively, and can therefore contain sub-patterns which are\nmatched against corresponding sub-expressions of SOURCE.\n\nAll the SOURCEs are evalled before any symbols are\nbound (i.e. \\\"in parallel\\\").\n\nIf VARLIST only contains one (PATTERN SOURCE) element, you can\noptionally specify it using a vector and discarding the\nouter-most parens. Thus\n\n (-let ((PATTERN SOURCE)) ..)\n\nbecomes\n\n (-let [PATTERN SOURCE] ..).\n\n`-let' uses a convention of not binding places (symbols) starting\nwith _ whenever it's possible. You can use this to skip over\nentries you don't care about. However, this is not *always*\npossible (as a result of implementation) and these symbols might\nget bound to undefined values.\n\nFollowing is the overview of supported patterns. Remember that\npatterns can be matched recursively, so every a, b, aK in the\nfollowing can be a matching construct and not necessarily a\nsymbol/variable.\n\nSymbol:\n\n a - bind the SOURCE to A. This is just like regular `let'.\n\nConses and lists:\n\n (a) - bind `car' of cons/list to A\n\n (a . b) - bind car of cons to A and `cdr' to B\n\n (a b) - bind car of list to A and `cadr' to B\n\n (a1 a2 a3 ...) - bind 0th car of list to A1, 1st to A2, 2nd to A3 ...\n\n (a1 a2 a3 ... aN . rest) - as above, but bind the Nth cdr to REST.\n\nVectors:\n\n [a] - bind 0th element of a non-list sequence to A (works with\n vectors, strings, bit arrays...)\n\n [a1 a2 a3 ...] - bind 0th element of non-list sequence to A0, 1st to\n A1, 2nd to A2, ...\n If the PATTERN is shorter than SOURCE, the values at\n places not in PATTERN are ignored.\n If the PATTERN is longer than SOURCE, an `error' is\n thrown.\n\n [a1 a2 a3 ... &rest rest] - as above, but bind the rest of\n the sequence to REST. This is\n conceptually the same as improper list\n matching (a1 a2 ... aN . rest)\n\nKey/value stores:\n\n (&plist key0 a0 ... keyN aN) - bind value mapped by keyK in the\n SOURCE plist to aK. If the\n value is not found, aK is nil.\n Uses `plist-get' to fetch values.\n\n (&alist key0 a0 ... keyN aN) - bind value mapped by keyK in the\n SOURCE alist to aK. If the\n value is not found, aK is nil.\n Uses `assoc' to fetch values.\n\n (&hash key0 a0 ... keyN aN) - bind value mapped by keyK in the\n SOURCE hash table to aK. If the\n value is not found, aK is nil.\n Uses `gethash' to fetch values.\n\nFurther, special keyword &keys supports \\\"inline\\\" matching of\nplist-like key-value pairs, similarly to &keys keyword of\n`cl-defun'.\n\n (a1 a2 ... aN &keys key1 b1 ... keyN bK)\n\nThis binds N values from the list to a1 ... aN, then interprets\nthe cdr as a plist (see key/value matching above).\n\nA shorthand notation for kv-destructuring exists which allows the\npatterns be optionally left out and derived from the key name in\nthe following fashion:\n\n- a key :foo is converted into `foo' pattern,\n- a key 'bar is converted into `bar' pattern,\n- a key \\\"baz\\\" is converted into `baz' pattern.\n\nThat is, the entire value under the key is bound to the derived\nvariable without any further destructuring.\n\nThis is possible only when the form following the key is not a\nvalid pattern (i.e. not a symbol, a cons cell or a vector).\nOtherwise the matching proceeds as usual and in case of an\ninvalid spec fails with an error.\n\nThus the patterns are normalized as follows:\n\n ;; derive all the missing patterns\n (&plist :foo 'bar \\\"baz\\\") => (&plist :foo foo 'bar bar \\\"baz\\\" baz)\n\n ;; we can specify some but not others\n (&plist :foo 'bar explicit-bar) => (&plist :foo foo 'bar explicit-bar)\n\n ;; nothing happens, we store :foo in x\n (&plist :foo x) => (&plist :foo x)\n\n ;; nothing happens, we match recursively\n (&plist :foo (a b c)) => (&plist :foo (a b c))\n\nYou can name the source using the syntax SYMBOL &as PATTERN.\nThis syntax works with lists (proper or improper), vectors and\nall types of maps.\n\n (list &as a b c) (list 1 2 3)\n\nbinds A to 1, B to 2, C to 3 and LIST to (1 2 3).\n\nSimilarly:\n\n (bounds &as beg . end) (cons 1 2)\n\nbinds BEG to 1, END to 2 and BOUNDS to (1 . 2).\n\n (items &as first . rest) (list 1 2 3)\n\nbinds FIRST to 1, REST to (2 3) and ITEMS to (1 2 3)\n\n [vect &as _ b c] [1 2 3]\n\nbinds B to 2, C to 3 and VECT to [1 2 3] (_ avoids binding as usual).\n\n (plist &as &plist :b b) (list :a 1 :b 2 :c 3)\n\nbinds B to 2 and PLIST to (:a 1 :b 2 :c 3). Same for &alist and &hash.\n\nThis is especially useful when we want to capture the result of a\ncomputation and destructure at the same time. Consider the\nform (function-returning-complex-structure) returning a list of\ntwo vectors with two items each. We want to capture this entire\nresult and pass it to another computation, but at the same time\nwe want to get the second item from each vector. We can achieve\nit with pattern\n\n (result &as [_ a] [_ b]) (function-returning-complex-structure)\n\nNote: Clojure programmers may know this feature as the \\\":as\nbinding\\\". The difference is that we put the &as at the front\nbecause we need to support improper list binding.\"\n (declare (debug ([&or (&rest [&or (sexp form) sexp])\n (vector [&rest [sexp form]])]\n body))\n (indent 1))\n (if (vectorp varlist)\n `(let* ,(dash--match (aref varlist 0) (aref varlist 1))\n ,@body)\n (let* ((varlist (dash--normalize-let-varlist varlist))\n (inputs (--map-indexed (list (make-symbol (format \"input%d\" it-index)) (cadr it)) varlist))\n (new-varlist (--map (list (caar it) (cadr it)) (-zip varlist inputs))))\n `(let ,inputs\n (-let* ,new-varlist ,@body)))))\n\n(defmacro -lambda (match-form &rest body)\n \"Return a lambda which destructures its input as MATCH-FORM and executes BODY.\n\nNote that you have to enclose the MATCH-FORM in a pair of parens,\nsuch that:\n\n (-lambda (x) body)\n (-lambda (x y ...) body)\n\nhas the usual semantics of `lambda'. Furthermore, these get\ntranslated into normal lambda, so there is no performance\npenalty.\n\nSee `-let' for the description of destructuring mechanism.\"\n (declare (doc-string 2) (indent defun)\n (debug (&define sexp\n [&optional stringp]\n [&optional (\"interactive\" interactive)]\n def-body)))\n (cond\n ((not (consp match-form))\n (signal 'wrong-type-argument \"match-form must be a list\"))\n ;; no destructuring, so just return regular lambda to make things faster\n ((-all? 'symbolp match-form)\n `(lambda ,match-form ,@body))\n (t\n (let* ((inputs (--map-indexed (list it (make-symbol (format \"input%d\" it-index))) match-form)))\n ;; TODO: because inputs to the lambda are evaluated only once,\n ;; -let* need not to create the extra bindings to ensure that.\n ;; We should find a way to optimize that. Not critical however.\n `(lambda ,(--map (cadr it) inputs)\n (-let* ,inputs ,@body))))))\n\n(defmacro -setq (&rest forms)\n \"Bind each MATCH-FORM to the value of its VAL.\n\nMATCH-FORM destructuring is done according to the rules of `-let'.\n\nThis macro allows you to bind multiple variables by destructuring\nthe value, so for example:\n\n (-setq (a b) x\n (&plist :c c) plist)\n\nexpands roughly speaking to the following code\n\n (setq a (car x)\n b (cadr x)\n c (plist-get plist :c))\n\nCare is taken to only evaluate each VAL once so that in case of\nmultiple assignments it does not cause unexpected side effects.\n\n\\(fn [MATCH-FORM VAL]...)\"\n (declare (debug (&rest sexp form))\n (indent 1))\n (when (= (mod (length forms) 2) 1)\n (error \"Odd number of arguments\"))\n (let* ((forms-and-sources\n ;; First get all the necessary mappings with all the\n ;; intermediate bindings.\n (-map (lambda (x) (dash--match (car x) (cadr x)))\n (-partition 2 forms)))\n ;; To preserve the logic of dynamic scoping we must ensure\n ;; that we `setq' the variables outside of the `let*' form\n ;; which holds the destructured intermediate values. For\n ;; this we generate for each variable a placeholder which is\n ;; bound to (lexically) the result of the destructuring.\n ;; Then outside of the helper `let*' form we bind all the\n ;; original variables to their respective placeholders.\n ;; TODO: There is a lot of room for possible optimization,\n ;; for start playing with `special-variable-p' to eliminate\n ;; unnecessary re-binding.\n (variables-to-placeholders\n (-mapcat\n (lambda (bindings)\n (-map\n (lambda (binding)\n (let ((var (car binding)))\n (list var (make-symbol (concat \"--dash-binding-\" (symbol-name var) \"--\")))))\n (--filter (not (string-prefix-p \"--\" (symbol-name (car it)))) bindings)))\n forms-and-sources)))\n `(let ,(-map 'cadr variables-to-placeholders)\n (let* ,(-flatten-n 1 forms-and-sources)\n (setq ,@(-flatten (-map 'reverse variables-to-placeholders))))\n (setq ,@(-flatten variables-to-placeholders)))))\n\n(defmacro -if-let* (vars-vals then &rest else)\n \"If all VALS evaluate to true, bind them to their corresponding\nVARS and do THEN, otherwise do ELSE. VARS-VALS should be a list\nof (VAR VAL) pairs.\n\nNote: binding is done according to `-let*'. VALS are evaluated\nsequentially, and evaluation stops after the first nil VAL is\nencountered.\"\n (declare (debug ((&rest (sexp form)) form body))\n (indent 2))\n (->> vars-vals\n (--mapcat (dash--match (car it) (cadr it)))\n (--reduce-r-from\n (let ((var (car it))\n (val (cadr it)))\n `(let ((,var ,val))\n (if ,var ,acc ,@else)))\n then)))\n\n(defmacro -if-let (var-val then &rest else)\n \"If VAL evaluates to non-nil, bind it to VAR and do THEN,\notherwise do ELSE.\n\nNote: binding is done according to `-let'.\n\n\\(fn (VAR VAL) THEN &rest ELSE)\"\n (declare (debug ((sexp form) form body))\n (indent 2))\n `(-if-let* (,var-val) ,then ,@else))\n\n(defmacro --if-let (val then &rest else)\n \"If VAL evaluates to non-nil, bind it to symbol `it' and do THEN,\notherwise do ELSE.\"\n (declare (debug (form form body))\n (indent 2))\n `(-if-let (it ,val) ,then ,@else))\n\n(defmacro -when-let* (vars-vals &rest body)\n \"If all VALS evaluate to true, bind them to their corresponding\nVARS and execute body. VARS-VALS should be a list of (VAR VAL)\npairs.\n\nNote: binding is done according to `-let*'. VALS are evaluated\nsequentially, and evaluation stops after the first nil VAL is\nencountered.\"\n (declare (debug ((&rest (sexp form)) body))\n (indent 1))\n `(-if-let* ,vars-vals (progn ,@body)))\n\n(defmacro -when-let (var-val &rest body)\n \"If VAL evaluates to non-nil, bind it to VAR and execute body.\n\nNote: binding is done according to `-let'.\n\n\\(fn (VAR VAL) &rest BODY)\"\n (declare (debug ((sexp form) body))\n (indent 1))\n `(-if-let ,var-val (progn ,@body)))\n\n(defmacro --when-let (val &rest body)\n \"If VAL evaluates to non-nil, bind it to symbol `it' and\nexecute body.\"\n (declare (debug (form body))\n (indent 1))\n `(--if-let ,val (progn ,@body)))\n\n(defvar -compare-fn nil\n \"Tests for equality use this function or `equal' if this is nil.\nIt should only be set using dynamic scope with a let, like:\n\n (let ((-compare-fn #\\\\='=)) (-union numbers1 numbers2 numbers3)\")\n\n(defun -distinct (list)\n \"Return a new list with all duplicates removed.\nThe test for equality is done with `equal',\nor with `-compare-fn' if that's non-nil.\n\nAlias: `-uniq'\"\n (let (result)\n (--each list (unless (-contains? result it) (!cons it result)))\n (nreverse result)))\n\n(defalias '-uniq '-distinct)\n\n(defun -union (list list2)\n \"Return a new list containing the elements of LIST and elements of LIST2 that are not in LIST.\nThe test for equality is done with `equal',\nor with `-compare-fn' if that's non-nil.\"\n ;; We fall back to iteration implementation if the comparison\n ;; function isn't one of `eq', `eql' or `equal'.\n (let* ((result (reverse list))\n ;; TODO: get rid of this dynamic variable, pass it as an\n ;; argument instead.\n (-compare-fn (if (bound-and-true-p -compare-fn)\n -compare-fn\n 'equal)))\n (if (memq -compare-fn '(eq eql equal))\n (let ((ht (make-hash-table :test -compare-fn)))\n (--each list (puthash it t ht))\n (--each list2 (unless (gethash it ht) (!cons it result))))\n (--each list2 (unless (-contains? result it) (!cons it result))))\n (nreverse result)))\n\n(defun -intersection (list list2)\n \"Return a new list containing only the elements that are members of both LIST and LIST2.\nThe test for equality is done with `equal',\nor with `-compare-fn' if that's non-nil.\"\n (--filter (-contains? list2 it) list))\n\n(defun -difference (list list2)\n \"Return a new list with only the members of LIST that are not in LIST2.\nThe test for equality is done with `equal',\nor with `-compare-fn' if that's non-nil.\"\n (--filter (not (-contains? list2 it)) list))\n\n(defun -powerset (list)\n \"Return the power set of LIST.\"\n (if (null list) '(())\n (let ((last (-powerset (cdr list))))\n (append (mapcar (lambda (x) (cons (car list) x)) last)\n last))))\n\n(defun -permutations (list)\n \"Return the permutations of LIST.\"\n (if (null list) '(())\n (apply #'append\n (mapcar (lambda (x)\n (mapcar (lambda (perm) (cons x perm))\n (-permutations (remove x list))))\n list))))\n\n(defun -inits (list)\n \"Return all prefixes of LIST.\"\n (nreverse (-map 'reverse (-tails (nreverse list)))))\n\n(defun -tails (list)\n \"Return all suffixes of LIST\"\n (-reductions-r-from 'cons nil list))\n\n(defun -common-prefix (&rest lists)\n \"Return the longest common prefix of LISTS.\"\n (declare (pure t) (side-effect-free t))\n (--reduce (--take-while (and acc (equal (pop acc) it)) it)\n lists))\n\n(defun -contains? (list element)\n \"Return non-nil if LIST contains ELEMENT.\n\nThe test for equality is done with `equal', or with `-compare-fn'\nif that's non-nil.\n\nAlias: `-contains-p'\"\n (not\n (null\n (cond\n ((null -compare-fn) (member element list))\n ((eq -compare-fn 'eq) (memq element list))\n ((eq -compare-fn 'eql) (memql element list))\n (t\n (let ((lst list))\n (while (and lst\n (not (funcall -compare-fn element (car lst))))\n (setq lst (cdr lst)))\n lst))))))\n\n(defalias '-contains-p '-contains?)\n\n(defun -same-items? (list list2)\n \"Return true if LIST and LIST2 has the same items.\n\nThe order of the elements in the lists does not matter.\n\nAlias: `-same-items-p'\"\n (let ((length-a (length list))\n (length-b (length list2)))\n (and\n (= length-a length-b)\n (= length-a (length (-intersection list list2))))))\n\n(defalias '-same-items-p '-same-items?)\n\n(defun -is-prefix? (prefix list)\n \"Return non-nil if PREFIX is prefix of LIST.\n\nAlias: `-is-prefix-p'\"\n (declare (pure t) (side-effect-free t))\n (--each-while list (equal (car prefix) it)\n (!cdr prefix))\n (not prefix))\n\n(defun -is-suffix? (suffix list)\n \"Return non-nil if SUFFIX is suffix of LIST.\n\nAlias: `-is-suffix-p'\"\n (declare (pure t) (side-effect-free t))\n (-is-prefix? (reverse suffix) (reverse list)))\n\n(defun -is-infix? (infix list)\n \"Return non-nil if INFIX is infix of LIST.\n\nThis operation runs in O(n^2) time\n\nAlias: `-is-infix-p'\"\n (declare (pure t) (side-effect-free t))\n (let (done)\n (while (and (not done) list)\n (setq done (-is-prefix? infix list))\n (!cdr list))\n done))\n\n(defalias '-is-prefix-p '-is-prefix?)\n(defalias '-is-suffix-p '-is-suffix?)\n(defalias '-is-infix-p '-is-infix?)\n\n(defun -sort (comparator list)\n \"Sort LIST, stably, comparing elements using COMPARATOR.\nReturn the sorted list. LIST is NOT modified by side effects.\nCOMPARATOR is called with two elements of LIST, and should return non-nil\nif the first element should sort before the second.\"\n (sort (copy-sequence list) comparator))\n\n(defmacro --sort (form list)\n \"Anaphoric form of `-sort'.\"\n (declare (debug (form form)))\n `(-sort (lambda (it other) ,form) ,list))\n\n(defun -list (&rest args)\n \"Return a list with ARGS.\n\nIf first item of ARGS is already a list, simply return ARGS. If\nnot, return a list with ARGS as elements.\"\n (declare (pure t) (side-effect-free t))\n (let ((arg (car args)))\n (if (listp arg) arg args)))\n\n(defun -repeat (n x)\n \"Return a list with X repeated N times.\nReturn nil if N is less than 1.\"\n (declare (pure t) (side-effect-free t))\n (let (ret)\n (--dotimes n (!cons x ret))\n ret))\n\n(defun -sum (list)\n \"Return the sum of LIST.\"\n (declare (pure t) (side-effect-free t))\n (apply '+ list))\n\n(defun -running-sum (list)\n \"Return a list with running sums of items in LIST.\n\nLIST must be non-empty.\"\n (declare (pure t) (side-effect-free t))\n (unless (consp list)\n (error \"LIST must be non-empty\"))\n (-reductions '+ list))\n\n(defun -product (list)\n \"Return the product of LIST.\"\n (declare (pure t) (side-effect-free t))\n (apply '* list))\n\n(defun -running-product (list)\n \"Return a list with running products of items in LIST.\n\nLIST must be non-empty.\"\n (declare (pure t) (side-effect-free t))\n (unless (consp list)\n (error \"LIST must be non-empty\"))\n (-reductions '* list))\n\n(defun -max (list)\n \"Return the largest value from LIST of numbers or markers.\"\n (declare (pure t) (side-effect-free t))\n (apply 'max list))\n\n(defun -min (list)\n \"Return the smallest value from LIST of numbers or markers.\"\n (declare (pure t) (side-effect-free t))\n (apply 'min list))\n\n(defun -max-by (comparator list)\n \"Take a comparison function COMPARATOR and a LIST and return\nthe greatest element of the list by the comparison function.\n\nSee also combinator `-on' which can transform the values before\ncomparing them.\"\n (--reduce (if (funcall comparator it acc) it acc) list))\n\n(defun -min-by (comparator list)\n \"Take a comparison function COMPARATOR and a LIST and return\nthe least element of the list by the comparison function.\n\nSee also combinator `-on' which can transform the values before\ncomparing them.\"\n (--reduce (if (funcall comparator it acc) acc it) list))\n\n(defmacro --max-by (form list)\n \"Anaphoric version of `-max-by'.\n\nThe items for the comparator form are exposed as \\\"it\\\" and \\\"other\\\".\"\n (declare (debug (form form)))\n `(-max-by (lambda (it other) ,form) ,list))\n\n(defmacro --min-by (form list)\n \"Anaphoric version of `-min-by'.\n\nThe items for the comparator form are exposed as \\\"it\\\" and \\\"other\\\".\"\n (declare (debug (form form)))\n `(-min-by (lambda (it other) ,form) ,list))\n\n(defun -iterate (fun init n)\n \"Return a list of iterated applications of FUN to INIT.\n\nThis means a list of form:\n\n (init (fun init) (fun (fun init)) ...)\n\nN is the length of the returned list.\"\n (if (= n 0) nil\n (let ((r (list init)))\n (--dotimes (1- n)\n (push (funcall fun (car r)) r))\n (nreverse r))))\n\n(defun -fix (fn list)\n \"Compute the (least) fixpoint of FN with initial input LIST.\n\nFN is called at least once, results are compared with `equal'.\"\n (let ((re (funcall fn list)))\n (while (not (equal list re))\n (setq list re)\n (setq re (funcall fn re)))\n re))\n\n(defmacro --fix (form list)\n \"Anaphoric form of `-fix'.\"\n `(-fix (lambda (it) ,form) ,list))\n\n(defun -unfold (fun seed)\n \"Build a list from SEED using FUN.\n\nThis is \\\"dual\\\" operation to `-reduce-r': while -reduce-r\nconsumes a list to produce a single value, `-unfold' takes a\nseed value and builds a (potentially infinite!) list.\n\nFUN should return `nil' to stop the generating process, or a\ncons (A . B), where A will be prepended to the result and B is\nthe new seed.\"\n (let ((last (funcall fun seed)) r)\n (while last\n (push (car last) r)\n (setq last (funcall fun (cdr last))))\n (nreverse r)))\n\n(defmacro --unfold (form seed)\n \"Anaphoric version of `-unfold'.\"\n (declare (debug (form form)))\n `(-unfold (lambda (it) ,form) ,seed))\n\n(defun -cons-pair? (con)\n \"Return non-nil if CON is true cons pair.\nThat is (A . B) where B is not a list.\"\n (declare (pure t) (side-effect-free t))\n (and (listp con)\n (not (listp (cdr con)))))\n\n(defun -cons-to-list (con)\n \"Convert a cons pair to a list with `car' and `cdr' of the pair respectively.\"\n (declare (pure t) (side-effect-free t))\n (list (car con) (cdr con)))\n\n(defun -value-to-list (val)\n \"Convert a value to a list.\n\nIf the value is a cons pair, make a list with two elements, `car'\nand `cdr' of the pair respectively.\n\nIf the value is anything else, wrap it in a list.\"\n (declare (pure t) (side-effect-free t))\n (cond\n ((-cons-pair? val) (-cons-to-list val))\n (t (list val))))\n\n(defun -tree-mapreduce-from (fn folder init-value tree)\n \"Apply FN to each element of TREE, and make a list of the results.\nIf elements of TREE are lists themselves, apply FN recursively to\nelements of these nested lists.\n\nThen reduce the resulting lists using FOLDER and initial value\nINIT-VALUE. See `-reduce-r-from'.\n\nThis is the same as calling `-tree-reduce-from' after `-tree-map'\nbut is twice as fast as it only traverse the structure once.\"\n (cond\n ((not tree) nil)\n ((-cons-pair? tree) (funcall fn tree))\n ((listp tree)\n (-reduce-r-from folder init-value (mapcar (lambda (x) (-tree-mapreduce-from fn folder init-value x)) tree)))\n (t (funcall fn tree))))\n\n(defmacro --tree-mapreduce-from (form folder init-value tree)\n \"Anaphoric form of `-tree-mapreduce-from'.\"\n (declare (debug (form form form form)))\n `(-tree-mapreduce-from (lambda (it) ,form) (lambda (it acc) ,folder) ,init-value ,tree))\n\n(defun -tree-mapreduce (fn folder tree)\n \"Apply FN to each element of TREE, and make a list of the results.\nIf elements of TREE are lists themselves, apply FN recursively to\nelements of these nested lists.\n\nThen reduce the resulting lists using FOLDER and initial value\nINIT-VALUE. See `-reduce-r-from'.\n\nThis is the same as calling `-tree-reduce' after `-tree-map'\nbut is twice as fast as it only traverse the structure once.\"\n (cond\n ((not tree) nil)\n ((-cons-pair? tree) (funcall fn tree))\n ((listp tree)\n (-reduce-r folder (mapcar (lambda (x) (-tree-mapreduce fn folder x)) tree)))\n (t (funcall fn tree))))\n\n(defmacro --tree-mapreduce (form folder tree)\n \"Anaphoric form of `-tree-mapreduce'.\"\n (declare (debug (form form form)))\n `(-tree-mapreduce (lambda (it) ,form) (lambda (it acc) ,folder) ,tree))\n\n(defun -tree-map (fn tree)\n \"Apply FN to each element of TREE while preserving the tree structure.\"\n (cond\n ((not tree) nil)\n ((-cons-pair? tree) (funcall fn tree))\n ((listp tree)\n (mapcar (lambda (x) (-tree-map fn x)) tree))\n (t (funcall fn tree))))\n\n(defmacro --tree-map (form tree)\n \"Anaphoric form of `-tree-map'.\"\n (declare (debug (form form)))\n `(-tree-map (lambda (it) ,form) ,tree))\n\n(defun -tree-reduce-from (fn init-value tree)\n \"Use FN to reduce elements of list TREE.\nIf elements of TREE are lists themselves, apply the reduction recursively.\n\nFN is first applied to INIT-VALUE and first element of the list,\nthen on this result and second element from the list etc.\n\nThe initial value is ignored on cons pairs as they always contain\ntwo elements.\"\n (cond\n ((not tree) nil)\n ((-cons-pair? tree) tree)\n ((listp tree)\n (-reduce-r-from fn init-value (mapcar (lambda (x) (-tree-reduce-from fn init-value x)) tree)))\n (t tree)))\n\n(defmacro --tree-reduce-from (form init-value tree)\n \"Anaphoric form of `-tree-reduce-from'.\"\n (declare (debug (form form form)))\n `(-tree-reduce-from (lambda (it acc) ,form) ,init-value ,tree))\n\n(defun -tree-reduce (fn tree)\n \"Use FN to reduce elements of list TREE.\nIf elements of TREE are lists themselves, apply the reduction recursively.\n\nFN is first applied to first element of the list and second\nelement, then on this result and third element from the list etc.\n\nSee `-reduce-r' for how exactly are lists of zero or one element handled.\"\n (cond\n ((not tree) nil)\n ((-cons-pair? tree) tree)\n ((listp tree)\n (-reduce-r fn (mapcar (lambda (x) (-tree-reduce fn x)) tree)))\n (t tree)))\n\n(defmacro --tree-reduce (form tree)\n \"Anaphoric form of `-tree-reduce'.\"\n (declare (debug (form form)))\n `(-tree-reduce (lambda (it acc) ,form) ,tree))\n\n(defun -tree-map-nodes (pred fun tree)\n \"Call FUN on each node of TREE that satisfies PRED.\n\nIf PRED returns nil, continue descending down this node. If PRED\nreturns non-nil, apply FUN to this node and do not descend\nfurther.\"\n (if (funcall pred tree)\n (funcall fun tree)\n (if (and (listp tree)\n (not (-cons-pair? tree)))\n (-map (lambda (x) (-tree-map-nodes pred fun x)) tree)\n tree)))\n\n(defmacro --tree-map-nodes (pred form tree)\n \"Anaphoric form of `-tree-map-nodes'.\"\n `(-tree-map-nodes (lambda (it) ,pred) (lambda (it) ,form) ,tree))\n\n(defun -tree-seq (branch children tree)\n \"Return a sequence of the nodes in TREE, in depth-first search order.\n\nBRANCH is a predicate of one argument that returns non-nil if the\npassed argument is a branch, that is, a node that can have children.\n\nCHILDREN is a function of one argument that returns the children\nof the passed branch node.\n\nNon-branch nodes are simply copied.\"\n (cons tree\n (when (funcall branch tree)\n (-mapcat (lambda (x) (-tree-seq branch children x))\n (funcall children tree)))))\n\n(defmacro --tree-seq (branch children tree)\n \"Anaphoric form of `-tree-seq'.\"\n `(-tree-seq (lambda (it) ,branch) (lambda (it) ,children) ,tree))\n\n(defun -clone (list)\n \"Create a deep copy of LIST.\nThe new list has the same elements and structure but all cons are\nreplaced with new ones. This is useful when you need to clone a\nstructure such as plist or alist.\"\n (declare (pure t) (side-effect-free t))\n (-tree-map 'identity list))\n\n(defun dash-enable-font-lock ()\n \"Add syntax highlighting to dash functions, macros and magic values.\"\n (eval-after-load 'lisp-mode\n '(progn\n (let ((new-keywords '(\n \"!cons\"\n \"!cdr\"\n \"-each\"\n \"--each\"\n \"-each-indexed\"\n \"--each-indexed\"\n \"-each-while\"\n \"--each-while\"\n \"-doto\"\n \"-dotimes\"\n \"--dotimes\"\n \"-map\"\n \"--map\"\n \"-reduce-from\"\n \"--reduce-from\"\n \"-reduce\"\n \"--reduce\"\n \"-reduce-r-from\"\n \"--reduce-r-from\"\n \"-reduce-r\"\n \"--reduce-r\"\n \"-reductions-from\"\n \"-reductions-r-from\"\n \"-reductions\"\n \"-reductions-r\"\n \"-filter\"\n \"--filter\"\n \"-select\"\n \"--select\"\n \"-remove\"\n \"--remove\"\n \"-reject\"\n \"--reject\"\n \"-remove-first\"\n \"--remove-first\"\n \"-reject-first\"\n \"--reject-first\"\n \"-remove-last\"\n \"--remove-last\"\n \"-reject-last\"\n \"--reject-last\"\n \"-remove-item\"\n \"-non-nil\"\n \"-keep\"\n \"--keep\"\n \"-map-indexed\"\n \"--map-indexed\"\n \"-splice\"\n \"--splice\"\n \"-splice-list\"\n \"--splice-list\"\n \"-map-when\"\n \"--map-when\"\n \"-replace-where\"\n \"--replace-where\"\n \"-map-first\"\n \"--map-first\"\n \"-map-last\"\n \"--map-last\"\n \"-replace\"\n \"-replace-first\"\n \"-replace-last\"\n \"-flatten\"\n \"-flatten-n\"\n \"-concat\"\n \"-mapcat\"\n \"--mapcat\"\n \"-copy\"\n \"-cons*\"\n \"-snoc\"\n \"-first\"\n \"--first\"\n \"-find\"\n \"--find\"\n \"-some\"\n \"--some\"\n \"-any\"\n \"--any\"\n \"-last\"\n \"--last\"\n \"-first-item\"\n \"-second-item\"\n \"-third-item\"\n \"-fourth-item\"\n \"-fifth-item\"\n \"-last-item\"\n \"-butlast\"\n \"-count\"\n \"--count\"\n \"-any?\"\n \"--any?\"\n \"-some?\"\n \"--some?\"\n \"-any-p\"\n \"--any-p\"\n \"-some-p\"\n \"--some-p\"\n \"-some->\"\n \"-some->>\"\n \"-some-->\"\n \"-all?\"\n \"-all-p\"\n \"--all?\"\n \"--all-p\"\n \"-every?\"\n \"--every?\"\n \"-all-p\"\n \"--all-p\"\n \"-every-p\"\n \"--every-p\"\n \"-none?\"\n \"--none?\"\n \"-none-p\"\n \"--none-p\"\n \"-only-some?\"\n \"--only-some?\"\n \"-only-some-p\"\n \"--only-some-p\"\n \"-slice\"\n \"-take\"\n \"-drop\"\n \"-drop-last\"\n \"-take-last\"\n \"-take-while\"\n \"--take-while\"\n \"-drop-while\"\n \"--drop-while\"\n \"-split-at\"\n \"-rotate\"\n \"-insert-at\"\n \"-replace-at\"\n \"-update-at\"\n \"--update-at\"\n \"-remove-at\"\n \"-remove-at-indices\"\n \"-split-with\"\n \"--split-with\"\n \"-split-on\"\n \"-split-when\"\n \"--split-when\"\n \"-separate\"\n \"--separate\"\n \"-partition-all-in-steps\"\n \"-partition-in-steps\"\n \"-partition-all\"\n \"-partition\"\n \"-partition-after-item\"\n \"-partition-after-pred\"\n \"-partition-before-item\"\n \"-partition-before-pred\"\n \"-partition-by\"\n \"--partition-by\"\n \"-partition-by-header\"\n \"--partition-by-header\"\n \"-group-by\"\n \"--group-by\"\n \"-interpose\"\n \"-interleave\"\n \"-unzip\"\n \"-zip-with\"\n \"--zip-with\"\n \"-zip\"\n \"-zip-fill\"\n \"-zip-pair\"\n \"-cycle\"\n \"-pad\"\n \"-annotate\"\n \"--annotate\"\n \"-table\"\n \"-table-flat\"\n \"-partial\"\n \"-elem-index\"\n \"-elem-indices\"\n \"-find-indices\"\n \"--find-indices\"\n \"-find-index\"\n \"--find-index\"\n \"-find-last-index\"\n \"--find-last-index\"\n \"-select-by-indices\"\n \"-select-columns\"\n \"-select-column\"\n \"-grade-up\"\n \"-grade-down\"\n \"->\"\n \"->>\"\n \"-->\"\n \"-as->\"\n \"-when-let\"\n \"-when-let*\"\n \"--when-let\"\n \"-if-let\"\n \"-if-let*\"\n \"--if-let\"\n \"-let*\"\n \"-let\"\n \"-lambda\"\n \"-distinct\"\n \"-uniq\"\n \"-union\"\n \"-intersection\"\n \"-difference\"\n \"-powerset\"\n \"-permutations\"\n \"-inits\"\n \"-tails\"\n \"-common-prefix\"\n \"-contains?\"\n \"-contains-p\"\n \"-same-items?\"\n \"-same-items-p\"\n \"-is-prefix-p\"\n \"-is-prefix?\"\n \"-is-suffix-p\"\n \"-is-suffix?\"\n \"-is-infix-p\"\n \"-is-infix?\"\n \"-sort\"\n \"--sort\"\n \"-list\"\n \"-repeat\"\n \"-sum\"\n \"-running-sum\"\n \"-product\"\n \"-running-product\"\n \"-max\"\n \"-min\"\n \"-max-by\"\n \"--max-by\"\n \"-min-by\"\n \"--min-by\"\n \"-iterate\"\n \"--iterate\"\n \"-fix\"\n \"--fix\"\n \"-unfold\"\n \"--unfold\"\n \"-cons-pair?\"\n \"-cons-to-list\"\n \"-value-to-list\"\n \"-tree-mapreduce-from\"\n \"--tree-mapreduce-from\"\n \"-tree-mapreduce\"\n \"--tree-mapreduce\"\n \"-tree-map\"\n \"--tree-map\"\n \"-tree-reduce-from\"\n \"--tree-reduce-from\"\n \"-tree-reduce\"\n \"--tree-reduce\"\n \"-tree-seq\"\n \"--tree-seq\"\n \"-tree-map-nodes\"\n \"--tree-map-nodes\"\n \"-clone\"\n \"-rpartial\"\n \"-juxt\"\n \"-applify\"\n \"-on\"\n \"-flip\"\n \"-const\"\n \"-cut\"\n \"-orfn\"\n \"-andfn\"\n \"-iteratefn\"\n \"-fixfn\"\n \"-prodfn\"\n ))\n (special-variables '(\n \"it\"\n \"it-index\"\n \"acc\"\n \"other\"\n )))\n (font-lock-add-keywords 'emacs-lisp-mode `((,(concat \"\\\\_<\" (regexp-opt special-variables 'paren) \"\\\\_>\")\n 1 font-lock-variable-name-face)) 'append)\n (font-lock-add-keywords 'emacs-lisp-mode `((,(concat \"(\\\\s-*\" (regexp-opt new-keywords 'paren) \"\\\\_>\")\n 1 font-lock-keyword-face)) 'append))\n (--each (buffer-list)\n (with-current-buffer it\n (when (and (eq major-mode 'emacs-lisp-mode)\n (boundp 'font-lock-mode)\n font-lock-mode)\n (font-lock-refresh-defaults)))))))\n\n(provide 'dash)\n;;; dash.el ends here\n" }, { "path": "t/batch-runner/request.el", "content": ";;; request.el --- Compatible layer for URL request in Emacs -*- lexical-binding: t; -*-\n\n;; Copyright (C) 2012 Takafumi Arakaki\n;; Copyright (C) 1985-1986, 1992, 1994-1995, 1999-2012\n;; Free Software Foundation, Inc.\n\n;; Author: Takafumi Arakaki \n;; Package-Requires: ((emacs \"24.4\"))\n;; Package-Version: 20170131.1747\n;; Version: 0.3.0\n\n;; This file is NOT part of GNU Emacs.\n\n;; request.el is free software: you can redistribute it and/or modify\n;; it under the terms of the GNU General Public License as published by\n;; the Free Software Foundation, either version 3 of the License, or\n;; (at your option) any later version.\n\n;; request.el is distributed in the hope that it will be useful,\n;; but WITHOUT ANY WARRANTY; without even the implied warranty of\n;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n;; GNU General Public License for more details.\n\n;; You should have received a copy of the GNU General Public License\n;; along with request.el.\n;; If not, see .\n\n;;; Commentary:\n\n;; Request.el is a HTTP request library with multiple backends. It\n;; supports url.el which is shipped with Emacs and curl command line\n;; program. User can use curl when s/he has it, as curl is more reliable\n;; than url.el. Library author can use request.el to avoid imposing\n;; external dependencies such as curl to users while giving richer\n;; experience for users who have curl.\n\n;; Following functions are adapted from GNU Emacs source code.\n;; Free Software Foundation holds the copyright of them.\n;; * `request--process-live-p'\n;; * `request--url-default-expander'\n\n;;; Code:\n\n(eval-when-compile\n (defvar url-http-method)\n (defvar url-http-response-status))\n\n(require 'cl-lib)\n(require 'url)\n(require 'mail-utils)\n\n(defgroup request nil\n \"Compatible layer for URL request in Emacs.\"\n :group 'comm\n :prefix \"request-\")\n\n(defconst request-version \"0.3.0\")\n\n\f\n;;; Customize variables\n\n(defcustom request-storage-directory\n (concat (file-name-as-directory user-emacs-directory) \"request\")\n \"Directory to store data related to request.el.\"\n :type 'directory)\n\n(defcustom request-curl \"curl\"\n \"Executable for curl command.\"\n :type 'string)\n\n(defcustom request-curl-options nil\n \"curl command options.\n\nList of strings that will be passed to every curl invocation. You can pass\nextra options here, like setting the proxy.\"\n :type '(repeat string))\n\n(defcustom request-backend (if (executable-find request-curl)\n 'curl\n 'url-retrieve)\n \"Backend to be used for HTTP request.\nAutomatically set to `curl' if curl command is found.\"\n :type '(choice (const :tag \"cURL backend\" curl)\n (const :tag \"url-retrieve backend\" url-retrieve)))\n\n(defcustom request-timeout nil\n \"Default request timeout in second.\n`nil' means no timeout.\"\n :type '(choice (integer :tag \"Request timeout seconds\")\n (boolean :tag \"No timeout\" nil)))\n\n(defcustom request-temp-prefix \"emacs-request\"\n \"Prefix for temporary files created by Request.\"\n :type 'string\n :risky t)\n\n(defcustom request-log-level -1\n \"Logging level for request.\nOne of `error'/`warn'/`info'/`verbose'/`debug'.\n-1 means no logging.\"\n :type '(choice (integer :tag \"No logging\" -1)\n (const :tag \"Level error\" error)\n (const :tag \"Level warn\" warn)\n (const :tag \"Level info\" info)\n (const :tag \"Level Verbose\" verbose)\n (const :tag \"Level DEBUG\" debug)))\n\n(defcustom request-message-level 'warn\n \"Logging level for request.\nSee `request-log-level'.\"\n :type '(choice (integer :tag \"No logging\" -1)\n (const :tag \"Level error\" error)\n (const :tag \"Level warn\" warn)\n (const :tag \"Level info\" info)\n (const :tag \"Level Verbose\" verbose)\n (const :tag \"Level DEBUG\" debug)))\n\n\f\n;;; Utilities\n\n(defun request--safe-apply (function &rest arguments)\n (condition-case err\n (apply #'apply function arguments)\n ((debug error))))\n\n(defun request--safe-call (function &rest arguments)\n (request--safe-apply function arguments))\n\n;; (defun request--url-no-cache (url)\n;; \"Imitate `cache=false' of `jQuery.ajax'.\n;; See: http://api.jquery.com/jQuery.ajax/\"\n;; ;; FIXME: parse URL before adding ?_=TIME.\n;; (concat url (format-time-string \"?_=%s\")))\n\n(defmacro request--document-function (function docstring)\n \"Document FUNCTION with DOCSTRING. Use this for defstruct accessor etc.\"\n (declare (indent defun)\n (doc-string 2))\n `(put ',function 'function-documentation ,docstring))\n\n(defun request--process-live-p (process)\n \"Copied from `process-live-p' for backward compatibility (Emacs < 24).\nAdapted from lisp/subr.el.\nFSF holds the copyright of this function:\n Copyright (C) 1985-1986, 1992, 1994-1995, 1999-2012\n Free Software Foundation, Inc.\"\n (memq (process-status process) '(run open listen connect stop)))\n\n\f\n;;; Logging\n\n(defconst request--log-level-def\n '(;; debugging\n (blather . 60) (trace . 50) (debug . 40)\n ;; information\n (verbose . 30) (info . 20)\n ;; errors\n (warn . 10) (error . 0))\n \"Named logging levels.\")\n\n(defun request--log-level-as-int (level)\n (if (integerp level)\n level\n (or (cdr (assq level request--log-level-def))\n 0)))\n\n(defvar request-log-buffer-name \" *request-log*\")\n\n(defun request--log-buffer ()\n (get-buffer-create request-log-buffer-name))\n\n(defmacro request-log (level fmt &rest args)\n (declare (indent 1))\n `(let ((level (request--log-level-as-int ,level))\n (log-level (request--log-level-as-int request-log-level))\n (msg-level (request--log-level-as-int request-message-level)))\n (when (<= level (max log-level msg-level))\n (let ((msg (format \"[%s] %s\" ,level\n (condition-case err\n (format ,fmt ,@args)\n (error (format \"\n!!! Logging error while executing:\n%S\n!!! Error:\n%S\"\n ',args err))))))\n (when (<= level log-level)\n (with-current-buffer (request--log-buffer)\n (setq buffer-read-only t)\n (let ((inhibit-read-only t))\n (goto-char (point-max))\n (insert msg \"\\n\"))))\n (when (<= level msg-level)\n (message \"REQUEST %s\" msg))))))\n\n\f\n;;; HTTP specific utilities\n\n(defconst request--url-unreserved-chars\n '(?a ?b ?c ?d ?e ?f ?g ?h ?i ?j ?k ?l ?m ?n ?o ?p ?q ?r ?s ?t ?u ?v ?w ?x ?y ?z\n ?A ?B ?C ?D ?E ?F ?G ?H ?I ?J ?K ?L ?M ?N ?O ?P ?Q ?R ?S ?T ?U ?V ?W ?X ?Y ?Z\n ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9\n ?- ?_ ?. ?~)\n \"`url-unreserved-chars' copied from Emacs 24.3 release candidate.\nThis is used for making `request--urlencode-alist' RFC 3986 compliant\nfor older Emacs versions.\")\n\n(defun request--urlencode-alist (alist)\n ;; FIXME: make monkey patching `url-unreserved-chars' optional\n (let ((url-unreserved-chars request--url-unreserved-chars))\n (cl-loop for sep = \"\" then \"&\"\n for (k . v) in alist\n concat sep\n concat (url-hexify-string (format \"%s\" k))\n concat \"=\"\n concat (url-hexify-string (format \"%s\" v)))))\n\n\f\n;;; Header parser\n\n(defun request--parse-response-at-point ()\n \"Parse the first header line such as \\\"HTTP/1.1 200 OK\\\".\"\n (when (re-search-forward \"\\\\=[ \\t\\n]*HTTP/\\\\([0-9\\\\.]+\\\\) +\\\\([0-9]+\\\\)\" nil t)\n (list :version (match-string 1)\n :code (string-to-number (match-string 2)))))\n\n(defun request--goto-next-body ()\n (re-search-forward \"^\\r\\n\"))\n\n\f\n;;; Response object\n\n(cl-defstruct request-response\n \"A structure holding all relevant information of a request.\"\n status-code history data error-thrown symbol-status url\n done-p settings\n ;; internal variables\n -buffer -raw-header -timer -backend -tempfiles)\n\n(defmacro request--document-response (function docstring)\n (declare (indent defun)\n (doc-string 2))\n `(request--document-function ,function ,(concat docstring \"\n\n.. This is an accessor for `request-response' object.\n\n\\(fn RESPONSE)\")))\n\n(request--document-response request-response-status-code\n \"Integer HTTP response code (e.g., 200).\")\n\n(request--document-response request-response-history\n \"Redirection history (a list of response object).\nThe first element is the oldest redirection.\n\nYou can use restricted portion of functions for the response\nobjects in the history slot. It also depends on backend. Here\nis the table showing what functions you can use for the response\nobjects in the history slot.\n\n==================================== ============== ==============\nSlots Backends\n------------------------------------ -----------------------------\n\\\\ curl url-retrieve\n==================================== ============== ==============\nrequest-response-url yes yes\nrequest-response-header yes no\nother functions no no\n==================================== ============== ==============\n\")\n\n(request--document-response request-response-data\n \"Response parsed by the given parser.\")\n\n(request--document-response request-response-error-thrown\n \"Error thrown during request.\nIt takes the form of ``(ERROR-SYMBOL . DATA)``, which can be\nre-raised (`signal'ed) by ``(signal ERROR-SYMBOL DATA)``.\")\n\n(request--document-response request-response-symbol-status\n \"A symbol representing the status of request (not HTTP response code).\nOne of success/error/timeout/abort/parse-error.\")\n\n(request--document-response request-response-url\n \"Final URL location of response.\")\n\n(request--document-response request-response-done-p\n \"Return t when the request is finished or aborted.\")\n\n(request--document-response request-response-settings\n \"Keyword arguments passed to `request' function.\nSome arguments such as HEADERS is changed to the one actually\npassed to the backend. Also, it has additional keywords such\nas URL which is the requested URL.\")\n\n(defun request-response-header (response field-name)\n \"Fetch the values of RESPONSE header field named FIELD-NAME.\n\nIt returns comma separated values when the header has multiple\nfield with the same name, as :RFC:`2616` specifies.\n\nExamples::\n\n (request-response-header response\n \\\"content-type\\\") ; => \\\"text/html; charset=utf-8\\\"\n (request-response-header response\n \\\"unknown-field\\\") ; => nil\n\"\n (let ((raw-header (request-response--raw-header response)))\n (when raw-header\n (with-temp-buffer\n (erase-buffer)\n (insert raw-header)\n ;; ALL=t to fetch all fields with the same name to get comma\n ;; separated value [#rfc2616-sec4]_.\n (mail-fetch-field field-name nil t)))))\n;; .. [#rfc2616-sec4] RFC2616 says this is the right thing to do\n;; (see http://tools.ietf.org/html/rfc2616.html#section-4.2).\n;; Python's requests module does this too.\n\n\f\n;;; Backend dispatcher\n\n(defconst request--backend-alist\n '((url-retrieve\n . ((request . request--url-retrieve)\n (request-sync . request--url-retrieve-sync)\n (terminate-process . delete-process)\n (get-cookies . request--url-retrieve-get-cookies)))\n (curl\n . ((request . request--curl)\n (request-sync . request--curl-sync)\n (terminate-process . interrupt-process)\n (get-cookies . request--curl-get-cookies))))\n \"Map backend and method name to actual method (symbol).\n\nIt's alist of alist, of the following form::\n\n ((BACKEND . ((METHOD . FUNCTION) ...)) ...)\n\nIt would be nicer if I can use EIEIO. But as CEDET is included\nin Emacs by 23.2, using EIEIO means abandon older Emacs versions.\nIt is probably necessary if I need to support more backends. But\nlet's stick to manual dispatch for now.\")\n;; See: (view-emacs-news \"23.2\")\n\n(defun request--choose-backend (method)\n \"Return `fucall'able object for METHOD of current `request-backend'.\"\n (assoc-default\n method\n (or (assoc-default request-backend request--backend-alist)\n (error \"%S is not valid `request-backend'.\" request-backend))))\n\n\f\n;;; Cookie\n\n(defun request-cookie-string (host &optional localpart secure)\n \"Return cookie string (like `document.cookie').\n\nExample::\n\n (request-cookie-string \\\"127.0.0.1\\\" \\\"/\\\") ; => \\\"key=value; key2=value2\\\"\n\"\n (mapconcat (lambda (nv) (concat (car nv) \"=\" (cdr nv)))\n (request-cookie-alist host localpart secure)\n \"; \"))\n\n(defun request-cookie-alist (host &optional localpart secure)\n \"Return cookies as an alist.\n\nExample::\n\n (request-cookie-alist \\\"127.0.0.1\\\" \\\"/\\\") ; => ((\\\"key\\\" . \\\"value\\\") ...)\n\"\n (funcall (request--choose-backend 'get-cookies) host localpart secure))\n\n\f\n;;; Main\n\n(cl-defun request-default-error-callback (url &key symbol-status\n &allow-other-keys)\n (request-log 'error\n \"Error (%s) while connecting to %s.\" symbol-status url))\n\n(cl-defun request (url &rest settings\n &key\n (type \"GET\")\n (params nil)\n (data nil)\n (files nil)\n (parser nil)\n (headers nil)\n (success nil)\n (error nil)\n (complete nil)\n (timeout request-timeout)\n (status-code nil)\n (sync nil)\n (response (make-request-response))\n (unix-socket nil))\n \"Send request to URL.\n\nRequest.el has a single entry point. It is `request'.\n\n==================== ========================================================\nKeyword argument Explanation\n==================== ========================================================\nTYPE (string) type of request to make: POST/GET/PUT/DELETE\nPARAMS (alist) set \\\"?key=val\\\" part in URL\nDATA (string/alist) data to be sent to the server\nFILES (alist) files to be sent to the server (see below)\nPARSER (symbol) a function that reads current buffer and return data\nHEADERS (alist) additional headers to send with the request\nSUCCESS (function) called on success\nERROR (function) called on error\nCOMPLETE (function) called on both success and error\nTIMEOUT (number) timeout in second\nSTATUS-CODE (alist) map status code (int) to callback\nSYNC (bool) If `t', wait until request is done. Default is `nil'.\n==================== ========================================================\n\n\n* Callback functions\n\nCallback functions STATUS, ERROR, COMPLETE and `cdr's in element of\nthe alist STATUS-CODE take same keyword arguments listed below. For\nforward compatibility, these functions must ignore unused keyword\narguments (i.e., it's better to use `&allow-other-keys' [#]_).::\n\n (CALLBACK ; SUCCESS/ERROR/COMPLETE/STATUS-CODE\n :data data ; whatever PARSER function returns, or nil\n :error-thrown error-thrown ; (ERROR-SYMBOL . DATA), or nil\n :symbol-status symbol-status ; success/error/timeout/abort/parse-error\n :response response ; request-response object\n ...)\n\n.. [#] `&allow-other-keys' is a special \\\"markers\\\" available in macros\n in the CL library for function definition such as `cl-defun' and\n `cl-function'. Without this marker, you need to specify all arguments\n to be passed. This becomes problem when request.el adds new arguments\n when calling callback functions. If you use `&allow-other-keys'\n (or manually ignore other arguments), your code is free from this\n problem. See info node `(cl) Argument Lists' for more information.\n\nArguments data, error-thrown, symbol-status can be accessed by\n`request-response-data', `request-response-error-thrown',\n`request-response-symbol-status' accessors, i.e.::\n\n (request-response-data RESPONSE) ; same as data\n\nResponse object holds other information which can be accessed by\nthe following accessors:\n`request-response-status-code',\n`request-response-url' and\n`request-response-settings'\n\n* STATUS-CODE callback\n\nSTATUS-CODE is an alist of the following format::\n\n ((N-1 . CALLBACK-1)\n (N-2 . CALLBACK-2)\n ...)\n\nHere, N-1, N-2,... are integer status codes such as 200.\n\n\n* FILES\n\nFILES is an alist of the following format::\n\n ((NAME-1 . FILE-1)\n (NAME-2 . FILE-2)\n ...)\n\nwhere FILE-N is a list of the form::\n\n (FILENAME &key PATH BUFFER STRING MIME-TYPE)\n\nFILE-N can also be a string (path to the file) or a buffer object.\nIn that case, FILENAME is set to the file name or buffer name.\n\nExample FILES argument::\n\n `((\\\"passwd\\\" . \\\"/etc/passwd\\\") ; filename = passwd\n (\\\"scratch\\\" . ,(get-buffer \\\"*scratch*\\\")) ; filename = *scratch*\n (\\\"passwd2\\\" . (\\\"password.txt\\\" :file \\\"/etc/passwd\\\"))\n (\\\"scratch2\\\" . (\\\"scratch.txt\\\" :buffer ,(get-buffer \\\"*scratch*\\\")))\n (\\\"data\\\" . (\\\"data.csv\\\" :data \\\"1,2,3\\\\n4,5,6\\\\n\\\")))\n\n.. note:: FILES is implemented only for curl backend for now.\n As furl.el_ supports multipart POST, it should be possible to\n support FILES in pure elisp by making furl.el_ another backend.\n Contributions are welcome.\n\n .. _furl.el: http://code.google.com/p/furl-el/\n\n\n* PARSER function\n\nPARSER function takes no argument and it is executed in the\nbuffer with HTTP response body. The current position in the HTTP\nresponse buffer is at the beginning of the buffer. As the HTTP\nheader is stripped off, the cursor is actually at the beginning\nof the response body. So, for example, you can pass `json-read'\nto parse JSON object in the buffer. To fetch whole response as a\nstring, pass `buffer-string'.\n\nWhen using `json-read', it is useful to know that the returned\ntype can be modified by `json-object-type', `json-array-type',\n`json-key-type', `json-false' and `json-null'. See docstring of\neach function for what it does. For example, to convert JSON\nobjects to plist instead of alist, wrap `json-read' by `lambda'\nlike this.::\n\n (request\n \\\"http://...\\\"\n :parser (lambda ()\n (let ((json-object-type 'plist))\n (json-read)))\n ...)\n\nThis is analogous to the `dataType' argument of jQuery.ajax_.\nOnly this function can access to the process buffer, which\nis killed immediately after the execution of this function.\n\n* SYNC\n\nSynchronous request is functional, but *please* don't use it\nother than testing or debugging. Emacs users have better things\nto do rather than waiting for HTTP request. If you want a better\nway to write callback chains, use `request-deferred'.\n\nIf you can't avoid using it (e.g., you are inside of some hook\nwhich must return some value), make sure to set TIMEOUT to\nrelatively small value.\n\nDue to limitation of `url-retrieve-synchronously', response slots\n`request-response-error-thrown', `request-response-history' and\n`request-response-url' are unknown (always `nil') when using\nsynchronous request with `url-retrieve' backend.\n\n* Note\n\nAPI of `request' is somewhat mixture of jQuery.ajax_ (Javascript)\nand requests.request_ (Python).\n\n.. _jQuery.ajax: http://api.jquery.com/jQuery.ajax/\n.. _requests.request: http://docs.python-requests.org\n\"\n (request-log 'debug \"REQUEST\")\n ;; FIXME: support CACHE argument (if possible)\n ;; (unless cache\n ;; (setq url (request--url-no-cache url)))\n (unless error\n (setq error (apply-partially #'request-default-error-callback url))\n (setq settings (plist-put settings :error error)))\n (unless (or (stringp data)\n (null data)\n (assoc-string \"Content-Type\" headers t))\n (setq data (request--urlencode-alist data))\n (setq settings (plist-put settings :data data)))\n (when params\n (cl-assert (listp params) nil \"PARAMS must be an alist. Given: %S\" params)\n (setq url (concat url (if (string-match-p \"\\\\?\" url) \"&\" \"?\")\n (request--urlencode-alist params))))\n (setq settings (plist-put settings :url url))\n (setq settings (plist-put settings :response response))\n (setf (request-response-settings response) settings)\n (setf (request-response-url response) url)\n (setf (request-response--backend response) request-backend)\n ;; Call `request--url-retrieve'(`-sync') or `request--curl'(`-sync').\n (apply (if sync\n (request--choose-backend 'request-sync)\n (request--choose-backend 'request))\n url settings)\n (when timeout\n (request-log 'debug \"Start timer: timeout=%s sec\" timeout)\n (setf (request-response--timer response)\n (run-at-time timeout nil\n #'request-response--timeout-callback response)))\n response)\n\n(defun request--clean-header (response)\n \"Strip off carriage returns in the header of REQUEST.\"\n (request-log 'debug \"-CLEAN-HEADER\")\n (let ((buffer (request-response--buffer response))\n (backend (request-response--backend response))\n sep-regexp)\n (if (eq backend 'url-retrieve)\n ;; FIXME: make this workaround optional.\n ;; But it looks like sometimes `url-http-clean-headers'\n ;; fails to cleanup. So, let's be bit permissive here...\n (setq sep-regexp \"^\\r?$\")\n (setq sep-regexp \"^\\r$\"))\n (when (buffer-live-p buffer)\n (with-current-buffer buffer\n (request-log 'trace\n \"(buffer-string) at %S =\\n%s\" buffer (buffer-string))\n (goto-char (point-min))\n (when (and (re-search-forward sep-regexp nil t)\n ;; Are \\r characters stripped off already?:\n (not (equal (match-string 0) \"\")))\n (while (re-search-backward \"\\r$\" (point-min) t)\n (replace-match \"\")))))))\n\n(defun request--cut-header (response)\n \"Cut the first header part in the buffer of RESPONSE and move it to\nraw-header slot.\"\n (request-log 'debug \"-CUT-HEADER\")\n (let ((buffer (request-response--buffer response)))\n (when (buffer-live-p buffer)\n (with-current-buffer buffer\n (goto-char (point-min))\n (when (re-search-forward \"^$\" nil t)\n (setf (request-response--raw-header response)\n (buffer-substring (point-min) (point)))\n (delete-region (point-min) (min (1+ (point)) (point-max))))))))\n\n(defun request-untrampify-filename (file)\n \"Return FILE as the local file name.\"\n (or (file-remote-p file 'localname) file))\n\n(defun request--parse-data (response parser)\n \"Run PARSER in current buffer if ERROR-THROWN is nil,\nthen kill the current buffer.\"\n (request-log 'debug \"-PARSE-DATA\")\n (let ((buffer (request-response--buffer response)))\n (request-log 'debug \"parser = %s\" parser)\n (when (and (buffer-live-p buffer) parser)\n (with-current-buffer buffer\n (request-log 'trace\n \"(buffer-string) at %S =\\n%s\" buffer (buffer-string))\n (when (/= (request-response-status-code response) 204)\n (goto-char (point-min))\n (setf (request-response-data response) (funcall parser)))))))\n\n(cl-defun request--callback (buffer &key parser success error complete\n timeout status-code response\n &allow-other-keys)\n (request-log 'debug \"REQUEST--CALLBACK\")\n (request-log 'debug \"(buffer-string) =\\n%s\"\n (when (buffer-live-p buffer)\n (with-current-buffer buffer (buffer-string))))\n\n ;; Sometimes BUFFER given as the argument is different from the\n ;; buffer already set in RESPONSE. That's why it is reset here.\n ;; FIXME: Refactor how BUFFER is passed around.\n (setf (request-response--buffer response) buffer)\n (request-response--cancel-timer response)\n (cl-symbol-macrolet\n ((error-thrown (request-response-error-thrown response))\n (symbol-status (request-response-symbol-status response))\n (data (request-response-data response))\n (done-p (request-response-done-p response)))\n\n ;; Parse response header\n (request--clean-header response)\n (request--cut-header response)\n ;; Note: Try to do this even `error-thrown' is set. For example,\n ;; timeout error can occur while downloading response body and\n ;; header is there in that case.\n\n ;; Parse response body\n (request-log 'debug \"error-thrown = %S\" error-thrown)\n (condition-case err\n (request--parse-data response parser)\n (error\n ;; If there was already an error (e.g. server timeout) do not set the\n ;; status to `parse-error'.\n (unless error-thrown\n (setq symbol-status 'parse-error)\n (setq error-thrown err)\n (request-log 'error \"Error from parser %S: %S\" parser err))))\n (kill-buffer buffer)\n (request-log 'debug \"data = %s\" data)\n\n ;; Determine `symbol-status'\n (unless symbol-status\n (setq symbol-status (if error-thrown 'error 'success)))\n (request-log 'debug \"symbol-status = %s\" symbol-status)\n\n ;; Call callbacks\n (let ((args (list :data data\n :symbol-status symbol-status\n :error-thrown error-thrown\n :response response)))\n (let* ((success-p (eq symbol-status 'success))\n (cb (if success-p success error))\n (name (if success-p \"success\" \"error\")))\n (when cb\n (request-log 'debug \"Executing %s callback.\" name)\n (request--safe-apply cb args)))\n\n (let ((cb (cdr (assq (request-response-status-code response)\n status-code))))\n (when cb\n (request-log 'debug \"Executing status-code callback.\")\n (request--safe-apply cb args)))\n\n (when complete\n (request-log 'debug \"Executing complete callback.\")\n (request--safe-apply complete args)))\n\n (setq done-p t)\n\n ;; Remove temporary files\n ;; FIXME: Make tempfile cleanup more reliable. It is possible\n ;; callback is never called.\n (request--safe-delete-files (request-response--tempfiles response))))\n\n(cl-defun request-response--timeout-callback (response)\n (request-log 'debug \"-TIMEOUT-CALLBACK\")\n (setf (request-response-symbol-status response) 'timeout)\n (setf (request-response-error-thrown response) '(error . (\"Timeout\")))\n (let* ((buffer (request-response--buffer response))\n (proc (and (buffer-live-p buffer) (get-buffer-process buffer))))\n (when proc\n ;; This will call `request--callback':\n (funcall (request--choose-backend 'terminate-process) proc))\n\n (cl-symbol-macrolet ((done-p (request-response-done-p response)))\n (unless done-p\n ;; This code should never be executed. However, it occurs\n ;; sometimes with `url-retrieve' backend.\n ;; FIXME: In Emacs 24.3.50 or later, this is always executed in\n ;; request-get-timeout test. Find out if it is fine.\n (request-log 'error \"Callback is not called when stopping process! \\\nExplicitly calling from timer.\")\n (when (buffer-live-p buffer)\n (cl-destructuring-bind (&key code &allow-other-keys)\n (with-current-buffer buffer\n (goto-char (point-min))\n (request--parse-response-at-point))\n (setf (request-response-status-code response) code)))\n (apply #'request--callback\n buffer\n (request-response-settings response))\n (setq done-p t)))))\n\n(defun request-response--cancel-timer (response)\n (request-log 'debug \"REQUEST-RESPONSE--CANCEL-TIMER\")\n (cl-symbol-macrolet ((timer (request-response--timer response)))\n (when timer\n (cancel-timer timer)\n (setq timer nil))))\n\n\n(defun request-abort (response)\n \"Abort request for RESPONSE (the object returned by `request').\nNote that this function invoke ERROR and COMPLETE callbacks.\nCallbacks may not be called immediately but called later when\nassociated process is exited.\"\n (cl-symbol-macrolet ((buffer (request-response--buffer response))\n (symbol-status (request-response-symbol-status response))\n (done-p (request-response-done-p response)))\n (let ((process (get-buffer-process buffer)))\n (unless symbol-status ; should I use done-p here?\n (setq symbol-status 'abort)\n (setq done-p t)\n (when (and\n (processp process) ; process can be nil when buffer is killed\n (request--process-live-p process))\n (funcall (request--choose-backend 'terminate-process) process))))))\n\n\f\n;;; Backend: `url-retrieve'\n\n(cl-defun request--url-retrieve-preprocess-settings\n (&rest settings &key type data files headers &allow-other-keys)\n (when files\n (error \"`url-retrieve' backend does not support FILES.\"))\n (when (and (equal type \"POST\")\n data\n (not (assoc-string \"Content-Type\" headers t)))\n (push '(\"Content-Type\" . \"application/x-www-form-urlencoded\") headers)\n (setq settings (plist-put settings :headers headers)))\n settings)\n\n(cl-defun request--url-retrieve (url &rest settings\n &key type data timeout response\n &allow-other-keys\n &aux headers)\n (setq settings (apply #'request--url-retrieve-preprocess-settings settings))\n (setq headers (plist-get settings :headers))\n (let* ((url-request-extra-headers headers)\n (url-request-method type)\n (url-request-data data)\n (buffer (url-retrieve url #'request--url-retrieve-callback\n (nconc (list :response response) settings)))\n (proc (get-buffer-process buffer)))\n (setf (request-response--buffer response) buffer)\n (process-put proc :request-response response)\n (request-log 'debug \"Start querying: %s\" url)\n (set-process-query-on-exit-flag proc nil)))\n\n(cl-defun request--url-retrieve-callback (status &rest settings\n &key response url\n &allow-other-keys)\n ;;(declare (special url-http-method\n ;; url-http-response-status))\n (request-log 'debug \"-URL-RETRIEVE-CALLBACK\")\n (request-log 'debug \"status = %S\" status)\n (request-log 'debug \"url-http-method = %s\" url-http-method)\n (request-log 'debug \"url-http-response-status = %s\" url-http-response-status)\n\n (setf (request-response-status-code response) url-http-response-status)\n (let ((redirect (plist-get status :redirect)))\n (when redirect\n (setf (request-response-url response) redirect)))\n ;; Construct history slot\n (cl-loop for v in\n (cl-loop with first = t\n with l = nil\n for (k v) on status by 'cddr\n when (eq k :redirect)\n if first\n do (setq first nil)\n else\n do (push v l)\n finally do (cons url l))\n do (let ((r (make-request-response :-backend 'url-retrieve)))\n (setf (request-response-url r) v)\n (push r (request-response-history response))))\n\n (cl-symbol-macrolet ((error-thrown (request-response-error-thrown response))\n (status-error (plist-get status :error)))\n (when (and error-thrown status-error)\n (request-log 'warn\n \"Error %S thrown already but got another error %S from \\\n`url-retrieve'. Ignoring it...\" error-thrown status-error))\n (unless error-thrown\n (setq error-thrown status-error)))\n\n (apply #'request--callback (current-buffer) settings))\n\n(cl-defun request--url-retrieve-sync (url &rest settings\n &key type data timeout response\n &allow-other-keys\n &aux headers)\n (setq settings (apply #'request--url-retrieve-preprocess-settings settings))\n (setq headers (plist-get settings :headers))\n (let* ((url-request-extra-headers headers)\n (url-request-method type)\n (url-request-data data)\n (buffer (if timeout\n (with-timeout\n (timeout\n (setf (request-response-symbol-status response)\n 'timeout)\n (setf (request-response-done-p response) t)\n nil)\n (url-retrieve-synchronously url))\n (url-retrieve-synchronously url))))\n (setf (request-response--buffer response) buffer)\n ;; It seems there is no way to get redirects and URL here...\n (when buffer\n ;; Fetch HTTP response code\n (with-current-buffer buffer\n (goto-char (point-min))\n (cl-destructuring-bind (&key version code)\n (request--parse-response-at-point)\n (setf (request-response-status-code response) code)))\n ;; Parse response body, etc.\n (apply #'request--callback buffer settings)))\n response)\n\n(defun request--url-retrieve-get-cookies (host localpart secure)\n (mapcar\n (lambda (c) (cons (url-cookie-name c) (url-cookie-value c)))\n (url-cookie-retrieve host localpart secure)))\n\n\f\n;;; Backend: curl\n\n(defvar request--curl-cookie-jar nil\n \"Override what the function `request--curl-cookie-jar' returns.\nCurrently it is used only for testing.\")\n\n(defun request--curl-cookie-jar ()\n \"Cookie storage for curl backend.\"\n (or request--curl-cookie-jar\n (expand-file-name \"curl-cookie-jar\" request-storage-directory)))\n\n(defconst request--curl-write-out-template\n (if (eq system-type 'windows-nt)\n \"\\\\n(:num-redirects %{num_redirects} :url-effective %{url_effective})\"\n \"\\\\n(:num-redirects %{num_redirects} :url-effective \\\"%{url_effective}\\\")\"))\n\n(defun request--curl-mkdir-for-cookie-jar ()\n (ignore-errors\n (make-directory (file-name-directory (request--curl-cookie-jar)) t)))\n\n(cl-defun request--curl-command\n (url &key type data headers timeout response files* unix-socket\n &allow-other-keys\n &aux\n (cookie-jar (convert-standard-filename\n (expand-file-name (request--curl-cookie-jar)))))\n (append\n (list request-curl \"--silent\" \"--include\"\n \"--location\"\n ;; FIXME: test automatic decompression\n \"--compressed\"\n ;; FIMXE: this way of using cookie might be problem when\n ;; running multiple requests.\n \"--cookie\" cookie-jar \"--cookie-jar\" cookie-jar\n \"--write-out\" request--curl-write-out-template)\n request-curl-options\n (when unix-socket (list \"--unix-socket\" unix-socket))\n (cl-loop for (name filename path mime-type) in files*\n collect \"--form\"\n collect (format \"%s=@%s;filename=%s%s\" name\n (request-untrampify-filename path) filename\n (if mime-type\n (format \";type=%s\" mime-type)\n \"\")))\n (when data\n (let ((tempfile (request--make-temp-file)))\n (push tempfile (request-response--tempfiles response))\n (let ((file-coding-system-alist nil)\n (coding-system-for-write 'binary))\n (with-temp-file tempfile\n (setq buffer-file-coding-system 'binary)\n (set-buffer-multibyte nil)\n (insert data)))\n (list \"--data-binary\" (concat \"@\" (request-untrampify-filename tempfile)))))\n (when type (list \"--request\" type))\n (cl-loop for (k . v) in headers\n collect \"--header\"\n collect (format \"%s: %s\" k v))\n (list url)))\n\n(defun request--curl-normalize-files-1 (files get-temp-file)\n (cl-loop for (name . item) in files\n collect\n (cl-destructuring-bind\n (filename &key file buffer data mime-type)\n (cond\n ((stringp item) (list (file-name-nondirectory item) :file item))\n ((bufferp item) (list (buffer-name item) :buffer item))\n (t item))\n (unless (= (cl-loop for v in (list file buffer data) if v sum 1) 1)\n (error \"Only one of :file/:buffer/:data must be given. Got: %S\"\n (cons name item)))\n (cond\n (file\n (list name filename file mime-type))\n (buffer\n (let ((tf (funcall get-temp-file)))\n (with-current-buffer buffer\n (write-region (point-min) (point-max) tf nil 'silent))\n (list name filename tf mime-type)))\n (data\n (let ((tf (funcall get-temp-file)))\n (with-temp-buffer\n (erase-buffer)\n (insert data)\n (write-region (point-min) (point-max) tf nil 'silent))\n (list name filename tf mime-type)))))))\n\n(defun request--make-temp-file ()\n \"Create a temporary file.\"\n (if (file-remote-p default-directory)\n (let ((tramp-temp-name-prefix request-temp-prefix)\n (vec (tramp-dissect-file-name default-directory)))\n (tramp-make-tramp-file-name\n (tramp-file-name-method vec)\n (tramp-file-name-user vec)\n (tramp-file-name-host vec)\n (tramp-make-tramp-temp-file vec)\n (tramp-file-name-hop vec)))\n (make-temp-file request-temp-prefix)))\n\n(defun request--curl-normalize-files (files)\n \"Change FILES into a list of (NAME FILENAME PATH MIME-TYPE).\nThis is to make `request--curl-command' cleaner by converting\nFILES to a homogeneous list. It returns a list (FILES* TEMPFILES)\nwhere FILES* is a converted FILES and TEMPFILES is a list of\ntemporary file paths.\"\n (let (tempfiles noerror)\n (unwind-protect\n (let* ((get-temp-file (lambda ()\n (let ((tf (request--make-temp-file)))\n (push tf tempfiles)\n tf)))\n (files* (request--curl-normalize-files-1 files get-temp-file)))\n (setq noerror t)\n (list files* tempfiles))\n (unless noerror\n ;; Remove temporary files only when an error occurs\n (request--safe-delete-files tempfiles)))))\n\n(defun request--safe-delete-files (files)\n \"Remove FILES but do not raise error when failed to do so.\"\n (mapc (lambda (f) (condition-case err\n (delete-file f)\n (error (request-log 'error\n \"Failed delete file %s. Got: %S\" f err))))\n files))\n\n(cl-defun request--curl (url &rest settings\n &key type data files headers timeout response\n &allow-other-keys)\n \"cURL-based request backend.\n\nRedirection handling strategy\n-----------------------------\n\ncurl follows redirection when --location is given. However,\nall headers are printed when it is used with --include option.\nNumber of redirects is printed out sexp-based message using\n--write-out option (see `request--curl-write-out-template').\nThis number is used for removing extra headers and parse\nlocation header from the last redirection header.\n\nSexp at the end of buffer and extra headers for redirects are\nremoved from the buffer before it is shown to the parser function.\n\"\n (request--curl-mkdir-for-cookie-jar)\n (let* (;; Use pipe instead of pty. Otherwise, curl process hangs.\n (process-connection-type nil)\n ;; Avoid starting program in non-existing directory.\n (home-directory (if (file-remote-p default-directory)\n (let ((vec (tramp-dissect-file-name default-directory)))\n (tramp-make-tramp-file-name\n (tramp-file-name-method vec)\n (tramp-file-name-user vec)\n (tramp-file-name-host vec)\n \"~/\"\n (tramp-file-name-hop vec)))\n \"~/\"))\n (default-directory (expand-file-name home-directory))\n (buffer (generate-new-buffer \" *request curl*\"))\n (command (cl-destructuring-bind\n (files* tempfiles)\n (request--curl-normalize-files files)\n (setf (request-response--tempfiles response) tempfiles)\n (apply #'request--curl-command url :files* files*\n :response response settings)))\n (proc (apply #'start-file-process \"request curl\" buffer command)))\n (request-log 'debug \"Run: %s\" (mapconcat 'identity command \" \"))\n (setf (request-response--buffer response) buffer)\n (process-put proc :request-response response)\n (set-process-coding-system proc 'binary 'binary)\n (set-process-query-on-exit-flag proc nil)\n (set-process-sentinel proc #'request--curl-callback)))\n\n(defun request--curl-read-and-delete-tail-info ()\n \"Read a sexp at the end of buffer and remove it and preceding character.\nThis function moves the point at the end of buffer by side effect.\nSee also `request--curl-write-out-template'.\"\n (let (forward-sexp-function)\n (goto-char (point-max))\n (forward-sexp -1)\n (let ((beg (1- (point))))\n (prog1\n (read (current-buffer))\n (delete-region beg (point-max))))))\n\n(defconst request--cookie-reserved-re\n (mapconcat\n (lambda (x) (concat \"\\\\(^\" x \"\\\\'\\\\)\"))\n '(\"comment\" \"commenturl\" \"discard\" \"domain\" \"max-age\" \"path\" \"port\"\n \"secure\" \"version\" \"expires\")\n \"\\\\|\")\n \"Uninterested keys in cookie.\nSee \\\"set-cookie-av\\\" in http://www.ietf.org/rfc/rfc2965.txt\")\n\n(defun request--consume-100-continue ()\n \"Remove \\\"HTTP/* 100 Continue\\\" header at the point.\"\n (cl-destructuring-bind (&key code &allow-other-keys)\n (save-excursion (request--parse-response-at-point))\n (when (equal code 100)\n (delete-region (point) (progn (request--goto-next-body) (point)))\n ;; FIXME: Does this make sense? Is it possible to have multiple 100?\n (request--consume-100-continue))))\n\n(defun request--consume-200-connection-established ()\n \"Remove \\\"HTTP/* 200 Connection established\\\" header at the point.\"\n (when (looking-at-p \"HTTP/1\\\\.[0-1] 200 Connection established\")\n (delete-region (point) (progn (request--goto-next-body) (point)))))\n\n(defun request--curl-preprocess ()\n \"Pre-process current buffer before showing it to user.\"\n (let (history)\n (cl-destructuring-bind (&key num-redirects url-effective)\n (request--curl-read-and-delete-tail-info)\n (goto-char (point-min))\n (request--consume-100-continue)\n (request--consume-200-connection-established)\n (when (> num-redirects 0)\n (cl-loop with case-fold-search = t\n repeat num-redirects\n ;; Do not store code=100 headers:\n do (request--consume-100-continue)\n do (let ((response (make-request-response\n :-buffer (current-buffer)\n :-backend 'curl)))\n (request--clean-header response)\n (request--cut-header response)\n (push response history))))\n\n (goto-char (point-min))\n (nconc (list :num-redirects num-redirects :url-effective url-effective\n :history (nreverse history))\n (request--parse-response-at-point)))))\n\n(defun request--curl-absolutify-redirects (start-url redirects)\n \"Convert relative paths in REDIRECTS to absolute URLs.\nSTART-URL is the URL requested.\"\n (cl-loop for prev-url = start-url then url\n for url in redirects\n unless (string-match url-nonrelative-link url)\n do (setq url (url-expand-file-name url prev-url))\n collect url))\n\n(defun request--curl-absolutify-location-history (start-url history)\n \"Convert relative paths in HISTORY to absolute URLs.\nSTART-URL is the URL requested.\"\n (when history\n (setf (request-response-url (car history)) start-url))\n (cl-loop for url in (request--curl-absolutify-redirects\n start-url\n (mapcar (lambda (response)\n (request-response-header response \"location\"))\n history))\n for response in (cdr history)\n do (setf (request-response-url response) url)))\n\n(defun request--curl-callback (proc event)\n (let* ((buffer (process-buffer proc))\n (response (process-get proc :request-response))\n (symbol-status (request-response-symbol-status response))\n (settings (request-response-settings response)))\n (request-log 'debug \"REQUEST--CURL-CALLBACK event = %s\" event)\n (request-log 'debug \"REQUEST--CURL-CALLBACK proc = %S\" proc)\n (request-log 'debug \"REQUEST--CURL-CALLBACK buffer = %S\" buffer)\n (request-log 'debug \"REQUEST--CURL-CALLBACK symbol-status = %S\"\n symbol-status)\n (cond\n ((and (memq (process-status proc) '(exit signal))\n (/= (process-exit-status proc) 0))\n (setf (request-response-error-thrown response) (cons 'error event))\n (apply #'request--callback buffer settings))\n ((equal event \"finished\\n\")\n (cl-destructuring-bind (&key version code num-redirects history error\n url-effective)\n (condition-case err\n (with-current-buffer buffer\n (request--curl-preprocess))\n ((debug error)\n (list :error err)))\n (request--curl-absolutify-location-history (plist-get settings :url)\n history)\n (setf (request-response-status-code response) code)\n (setf (request-response-url response) url-effective)\n (setf (request-response-history response) history)\n (setf (request-response-error-thrown response)\n (or error (when (>= code 400) `(error . (http ,code)))))\n (apply #'request--callback buffer settings))))))\n\n(cl-defun request--curl-sync (url &rest settings &key response &allow-other-keys)\n ;; To make timeout work, use polling approach rather than using\n ;; `call-process'.\n (let (finished)\n (prog1 (apply #'request--curl url\n :complete (lambda (&rest _) (setq finished t))\n settings)\n (let ((proc (get-buffer-process (request-response--buffer response))))\n (while (and (not finished) (request--process-live-p proc))\n (accept-process-output proc))))))\n\n(defun request--curl-get-cookies (host localpart secure)\n (request--netscape-get-cookies (request--curl-cookie-jar)\n host localpart secure))\n\n\f\n;;; Netscape cookie.txt parser\n\n(defun request--netscape-cookie-parse ()\n \"Parse Netscape/Mozilla cookie format.\"\n (goto-char (point-min))\n (let ((tsv-re (concat \"^\\\\(#HttpOnly_\\\\)?\"\n (cl-loop repeat 6 concat \"\\\\([^\\t\\n]+\\\\)\\t\")\n \"\\\\(.*\\\\)\"))\n cookies)\n (while (not (eobp))\n ;; HttpOnly cookie starts with '#' but its line is not comment line(#60)\n (cond ((and (looking-at-p \"^#\") (not (looking-at-p \"^#HttpOnly_\"))) t)\n ((looking-at-p \"^$\") t)\n ((looking-at tsv-re)\n (let ((cookie (cl-loop for i from 1 to 8 collect (match-string i))))\n (push cookie cookies))))\n (forward-line 1))\n (setq cookies (nreverse cookies))\n (cl-loop for (http-only domain flag path secure expiration name value) in cookies\n collect (list domain\n (equal flag \"TRUE\")\n path\n (equal secure \"TRUE\")\n (null (not http-only))\n (string-to-number expiration)\n name\n value))))\n\n(defun request--netscape-filter-cookies (cookies host localpart secure)\n (cl-loop for (domain flag path secure-1 http-only expiration name value) in cookies\n when (and (equal domain host)\n (equal path localpart)\n (or secure (not secure-1)))\n collect (cons name value)))\n\n(defun request--netscape-get-cookies (filename host localpart secure)\n (when (file-readable-p filename)\n (with-temp-buffer\n (erase-buffer)\n (insert-file-contents filename)\n (request--netscape-filter-cookies (request--netscape-cookie-parse)\n host localpart secure))))\n\n(provide 'request)\n\n;;; request.el ends here\n" }, { "path": "t/batch-runner/s.el", "content": ";;; s.el --- The long lost Emacs string manipulation library.\n\n;; Copyright (C) 2012-2015 Magnar Sveen\n\n;; Author: Magnar Sveen \n;; Version: 1.12.0\n;; Package-Version: 20171102.227\n;; Keywords: strings\n\n;; This program is free software; you can redistribute it and/or modify\n;; it under the terms of the GNU General Public License as published by\n;; the Free Software Foundation, either version 3 of the License, or\n;; (at your option) any later version.\n\n;; This program is distributed in the hope that it will be useful,\n;; but WITHOUT ANY WARRANTY; without even the implied warranty of\n;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n;; GNU General Public License for more details.\n\n;; You should have received a copy of the GNU General Public License\n;; along with this program. If not, see .\n\n;;; Commentary:\n\n;; The long lost Emacs string manipulation library.\n;;\n;; See documentation on https://github.com/magnars/s.el#functions\n\n;;; Code:\n\n;; Silence byte-compiler\n(defvar ucs-normalize-combining-chars) ; Defined in `ucs-normalize'\n(autoload 'slot-value \"eieio\")\n\n(defun s-trim-left (s)\n \"Remove whitespace at the beginning of S.\"\n (declare (pure t) (side-effect-free t))\n (save-match-data\n (if (string-match \"\\\\`[ \\t\\n\\r]+\" s)\n (replace-match \"\" t t s)\n s)))\n\n(defun s-trim-right (s)\n \"Remove whitespace at the end of S.\"\n (save-match-data\n (declare (pure t) (side-effect-free t))\n (if (string-match \"[ \\t\\n\\r]+\\\\'\" s)\n (replace-match \"\" t t s)\n s)))\n\n(defun s-trim (s)\n \"Remove whitespace at the beginning and end of S.\"\n (declare (pure t) (side-effect-free t))\n (s-trim-left (s-trim-right s)))\n\n(defun s-collapse-whitespace (s)\n \"Convert all adjacent whitespace characters to a single space.\"\n (declare (pure t) (side-effect-free t))\n (replace-regexp-in-string \"[ \\t\\n\\r]+\" \" \" s))\n\n(defun s-split (separator s &optional omit-nulls)\n \"Split S into substrings bounded by matches for regexp SEPARATOR.\nIf OMIT-NULLS is non-nil, zero-length substrings are omitted.\n\nThis is a simple wrapper around the built-in `split-string'.\"\n (declare (side-effect-free t))\n (save-match-data\n (split-string s separator omit-nulls)))\n\n(defun s-split-up-to (separator s n &optional omit-nulls)\n \"Split S up to N times into substrings bounded by matches for regexp SEPARATOR.\n\nIf OMIT-NULLS is non-nil, zero-length substrings are omitted.\n\nSee also `s-split'.\"\n (declare (side-effect-free t))\n (save-match-data\n (let ((op 0)\n (r nil))\n (with-temp-buffer\n (insert s)\n (setq op (goto-char (point-min)))\n (while (and (re-search-forward separator nil t)\n (< 0 n))\n (let ((sub (buffer-substring op (match-beginning 0))))\n (unless (and omit-nulls\n (equal sub \"\"))\n (push sub r)))\n (setq op (goto-char (match-end 0)))\n (setq n (1- n)))\n (let ((sub (buffer-substring op (point-max))))\n (unless (and omit-nulls\n (equal sub \"\"))\n (push sub r))))\n (nreverse r))))\n\n(defun s-lines (s)\n \"Splits S into a list of strings on newline characters.\"\n (declare (pure t) (side-effect-free t))\n (s-split \"\\\\(\\r\\n\\\\|[\\n\\r]\\\\)\" s))\n\n(defun s-join (separator strings)\n \"Join all the strings in STRINGS with SEPARATOR in between.\"\n (declare (pure t) (side-effect-free t))\n (mapconcat 'identity strings separator))\n\n(defun s-concat (&rest strings)\n \"Join all the string arguments into one string.\"\n (declare (pure t) (side-effect-free t))\n (apply 'concat strings))\n\n(defun s-prepend (prefix s)\n \"Concatenate PREFIX and S.\"\n (declare (pure t) (side-effect-free t))\n (concat prefix s))\n\n(defun s-append (suffix s)\n \"Concatenate S and SUFFIX.\"\n (declare (pure t) (side-effect-free t))\n (concat s suffix))\n\n(defun s-repeat (num s)\n \"Make a string of S repeated NUM times.\"\n (declare (pure t) (side-effect-free t))\n (let (ss)\n (while (> num 0)\n (setq ss (cons s ss))\n (setq num (1- num)))\n (apply 'concat ss)))\n\n(defun s-chop-suffix (suffix s)\n \"Remove SUFFIX if it is at end of S.\"\n (declare (pure t) (side-effect-free t))\n (let ((pos (- (length suffix))))\n (if (and (>= (length s) (length suffix))\n (string= suffix (substring s pos)))\n (substring s 0 pos)\n s)))\n\n(defun s-chop-suffixes (suffixes s)\n \"Remove SUFFIXES one by one in order, if they are at the end of S.\"\n (declare (pure t) (side-effect-free t))\n (while suffixes\n (setq s (s-chop-suffix (car suffixes) s))\n (setq suffixes (cdr suffixes)))\n s)\n\n(defun s-chop-prefix (prefix s)\n \"Remove PREFIX if it is at the start of S.\"\n (declare (pure t) (side-effect-free t))\n (let ((pos (length prefix)))\n (if (and (>= (length s) (length prefix))\n (string= prefix (substring s 0 pos)))\n (substring s pos)\n s)))\n\n(defun s-chop-prefixes (prefixes s)\n \"Remove PREFIXES one by one in order, if they are at the start of S.\"\n (declare (pure t) (side-effect-free t))\n (while prefixes\n (setq s (s-chop-prefix (car prefixes) s))\n (setq prefixes (cdr prefixes)))\n s)\n\n(defun s-shared-start (s1 s2)\n \"Returns the longest prefix S1 and S2 have in common.\"\n (declare (pure t) (side-effect-free t))\n (let ((search-length (min (length s1) (length s2)))\n (i 0))\n (while (and (< i search-length)\n (= (aref s1 i) (aref s2 i)))\n (setq i (1+ i)))\n (substring s1 0 i)))\n\n(defun s-shared-end (s1 s2)\n \"Returns the longest suffix S1 and S2 have in common.\"\n (declare (pure t) (side-effect-free t))\n (let* ((l1 (length s1))\n (l2 (length s2))\n (search-length (min l1 l2))\n (i 0))\n (while (and (< i search-length)\n (= (aref s1 (- l1 i 1)) (aref s2 (- l2 i 1))))\n (setq i (1+ i)))\n ;; If I is 0, then it means that there's no common suffix between\n ;; S1 and S2.\n ;;\n ;; However, since (substring s (- 0)) will return the whole\n ;; string, `s-shared-end' should simply return the empty string\n ;; when I is 0.\n (if (zerop i)\n \"\"\n (substring s1 (- i)))))\n\n(defun s-chomp (s)\n \"Remove one trailing `\\\\n`, `\\\\r` or `\\\\r\\\\n` from S.\"\n (declare (pure t) (side-effect-free t))\n (s-chop-suffixes '(\"\\n\" \"\\r\") s))\n\n(defun s-truncate (len s)\n \"If S is longer than LEN, cut it down to LEN - 3 and add ... at the end.\"\n (declare (pure t) (side-effect-free t))\n (if (> (length s) len)\n (format \"%s...\" (substring s 0 (- len 3)))\n s))\n\n(defun s-word-wrap (len s)\n \"If S is longer than LEN, wrap the words with newlines.\"\n (declare (side-effect-free t))\n (save-match-data\n (with-temp-buffer\n (insert s)\n (let ((fill-column len))\n (fill-region (point-min) (point-max)))\n (buffer-substring (point-min) (point-max)))))\n\n(defun s-center (len s)\n \"If S is shorter than LEN, pad it with spaces so it is centered.\"\n (declare (pure t) (side-effect-free t))\n (let ((extra (max 0 (- len (length s)))))\n (concat\n (make-string (ceiling extra 2) ? )\n s\n (make-string (floor extra 2) ? ))))\n\n(defun s-pad-left (len padding s)\n \"If S is shorter than LEN, pad it with PADDING on the left.\"\n (declare (pure t) (side-effect-free t))\n (let ((extra (max 0 (- len (length s)))))\n (concat (make-string extra (string-to-char padding))\n s)))\n\n(defun s-pad-right (len padding s)\n \"If S is shorter than LEN, pad it with PADDING on the right.\"\n (declare (pure t) (side-effect-free t))\n (let ((extra (max 0 (- len (length s)))))\n (concat s\n (make-string extra (string-to-char padding)))))\n\n(defun s-left (len s)\n \"Returns up to the LEN first chars of S.\"\n (declare (pure t) (side-effect-free t))\n (if (> (length s) len)\n (substring s 0 len)\n s))\n\n(defun s-right (len s)\n \"Returns up to the LEN last chars of S.\"\n (declare (pure t) (side-effect-free t))\n (let ((l (length s)))\n (if (> l len)\n (substring s (- l len) l)\n s)))\n\n(defun s-ends-with? (suffix s &optional ignore-case)\n \"Does S end with SUFFIX?\n\nIf IGNORE-CASE is non-nil, the comparison is done without paying\nattention to case differences.\n\nAlias: `s-suffix?'\"\n (declare (pure t) (side-effect-free t))\n (let ((start-pos (- (length s) (length suffix))))\n (and (>= start-pos 0)\n (eq t (compare-strings suffix nil nil\n s start-pos nil ignore-case)))))\n\n(defun s-starts-with? (prefix s &optional ignore-case)\n \"Does S start with PREFIX?\n\nIf IGNORE-CASE is non-nil, the comparison is done without paying\nattention to case differences.\n\nAlias: `s-prefix?'. This is a simple wrapper around the built-in\n`string-prefix-p'.\"\n (declare (pure t) (side-effect-free t))\n (string-prefix-p prefix s ignore-case))\n\n(defun s--truthy? (val)\n (declare (pure t) (side-effect-free t))\n (not (null val)))\n\n(defun s-contains? (needle s &optional ignore-case)\n \"Does S contain NEEDLE?\n\nIf IGNORE-CASE is non-nil, the comparison is done without paying\nattention to case differences.\"\n (declare (pure t) (side-effect-free t))\n (let ((case-fold-search ignore-case))\n (s--truthy? (string-match-p (regexp-quote needle) s))))\n\n(defun s-equals? (s1 s2)\n \"Is S1 equal to S2?\n\nThis is a simple wrapper around the built-in `string-equal'.\"\n (declare (pure t) (side-effect-free t))\n (string-equal s1 s2))\n\n(defun s-less? (s1 s2)\n \"Is S1 less than S2?\n\nThis is a simple wrapper around the built-in `string-lessp'.\"\n (declare (pure t) (side-effect-free t))\n (string-lessp s1 s2))\n\n(defun s-matches? (regexp s &optional start)\n \"Does REGEXP match S?\nIf START is non-nil the search starts at that index.\n\nThis is a simple wrapper around the built-in `string-match-p'.\"\n (declare (side-effect-free t))\n (s--truthy? (string-match-p regexp s start)))\n\n(defun s-blank? (s)\n \"Is S nil or the empty string?\"\n (declare (pure t) (side-effect-free t))\n (or (null s) (string= \"\" s)))\n\n(defun s-blank-str? (s)\n \"Is S nil or the empty string or string only contains whitespace?\"\n (declare (pure t) (side-effect-free t))\n (or (s-blank? s) (s-blank? (s-trim s))))\n\n(defun s-present? (s)\n \"Is S anything but nil or the empty string?\"\n (declare (pure t) (side-effect-free t))\n (not (s-blank? s)))\n\n(defun s-presence (s)\n \"Return S if it's `s-present?', otherwise return nil.\"\n (declare (pure t) (side-effect-free t))\n (and (s-present? s) s))\n\n(defun s-lowercase? (s)\n \"Are all the letters in S in lower case?\"\n (declare (side-effect-free t))\n (let ((case-fold-search nil))\n (not (string-match-p \"[[:upper:]]\" s))))\n\n(defun s-uppercase? (s)\n \"Are all the letters in S in upper case?\"\n (declare (side-effect-free t))\n (let ((case-fold-search nil))\n (not (string-match-p \"[[:lower:]]\" s))))\n\n(defun s-mixedcase? (s)\n \"Are there both lower case and upper case letters in S?\"\n (let ((case-fold-search nil))\n (s--truthy?\n (and (string-match-p \"[[:lower:]]\" s)\n (string-match-p \"[[:upper:]]\" s)))))\n\n(defun s-capitalized? (s)\n \"In S, is the first letter upper case, and all other letters lower case?\"\n (declare (side-effect-free t))\n (let ((case-fold-search nil))\n (s--truthy?\n (string-match-p \"^[[:upper:]][^[:upper:]]*$\" s))))\n\n(defun s-numeric? (s)\n \"Is S a number?\"\n (declare (pure t) (side-effect-free t))\n (s--truthy?\n (string-match-p \"^[0-9]+$\" s)))\n\n(defun s-replace (old new s)\n \"Replaces OLD with NEW in S.\"\n (declare (pure t) (side-effect-free t))\n (replace-regexp-in-string (regexp-quote old) new s t t))\n\n(defalias 's-replace-regexp 'replace-regexp-in-string)\n\n(defun s--aget (alist key)\n (declare (pure t) (side-effect-free t))\n (cdr (assoc-string key alist)))\n\n(defun s-replace-all (replacements s)\n \"REPLACEMENTS is a list of cons-cells. Each `car` is replaced with `cdr` in S.\"\n (declare (pure t) (side-effect-free t))\n (replace-regexp-in-string (regexp-opt (mapcar 'car replacements))\n (lambda (it) (s--aget replacements it))\n s t t))\n\n(defun s-downcase (s)\n \"Convert S to lower case.\n\nThis is a simple wrapper around the built-in `downcase'.\"\n (declare (side-effect-free t))\n (downcase s))\n\n(defun s-upcase (s)\n \"Convert S to upper case.\n\nThis is a simple wrapper around the built-in `upcase'.\"\n (declare (side-effect-free t))\n (upcase s))\n\n(defun s-capitalize (s)\n \"Convert the first word's first character to upper case and the rest to lower case in S.\"\n (declare (side-effect-free t))\n (concat (upcase (substring s 0 1)) (downcase (substring s 1))))\n\n(defun s-titleize (s)\n \"Convert each word's first character to upper case and the rest to lower case in S.\n\nThis is a simple wrapper around the built-in `capitalize'.\"\n (declare (side-effect-free t))\n (capitalize s))\n\n(defmacro s-with (s form &rest more)\n \"Threads S through the forms. Inserts S as the last item\nin the first form, making a list of it if it is not a list\nalready. If there are more forms, inserts the first form as the\nlast item in second form, etc.\"\n (declare (debug (form &rest [&or (function &rest form) fboundp])))\n (if (null more)\n (if (listp form)\n `(,(car form) ,@(cdr form) ,s)\n (list form s))\n `(s-with (s-with ,s ,form) ,@more)))\n\n(put 's-with 'lisp-indent-function 1)\n\n(defun s-index-of (needle s &optional ignore-case)\n \"Returns first index of NEEDLE in S, or nil.\n\nIf IGNORE-CASE is non-nil, the comparison is done without paying\nattention to case differences.\"\n (declare (pure t) (side-effect-free t))\n (let ((case-fold-search ignore-case))\n (string-match-p (regexp-quote needle) s)))\n\n(defun s-reverse (s)\n \"Return the reverse of S.\"\n (declare (pure t) (side-effect-free t))\n (save-match-data\n (if (multibyte-string-p s)\n (let ((input (string-to-list s))\n output)\n (require 'ucs-normalize)\n (while input\n ;; Handle entire grapheme cluster as a single unit\n (let ((grapheme (list (pop input))))\n (while (memql (car input) ucs-normalize-combining-chars)\n (push (pop input) grapheme))\n (setq output (nconc (nreverse grapheme) output))))\n (concat output))\n (concat (nreverse (string-to-list s))))))\n\n(defun s-match-strings-all (regex string)\n \"Return a list of matches for REGEX in STRING.\n\nEach element itself is a list of matches, as per\n`match-string'. Multiple matches at the same position will be\nignored after the first.\"\n (declare (side-effect-free t))\n (save-match-data\n (let ((all-strings ())\n (i 0))\n (while (and (< i (length string))\n (string-match regex string i))\n (setq i (1+ (match-beginning 0)))\n (let (strings\n (num-matches (/ (length (match-data)) 2))\n (match 0))\n (while (/= match num-matches)\n (push (match-string match string) strings)\n (setq match (1+ match)))\n (push (nreverse strings) all-strings)))\n (nreverse all-strings))))\n\n(defun s-matched-positions-all (regexp string &optional subexp-depth)\n \"Return a list of matched positions for REGEXP in STRING.\nSUBEXP-DEPTH is 0 by default.\"\n (declare (side-effect-free t))\n (if (null subexp-depth)\n (setq subexp-depth 0))\n (save-match-data\n (let ((pos 0) result)\n (while (and (string-match regexp string pos)\n (< pos (length string)))\n (let ((m (match-end subexp-depth)))\n (push (cons (match-beginning subexp-depth) (match-end subexp-depth)) result)\n (setq pos (match-end 0))))\n (nreverse result))))\n\n(defun s-match (regexp s &optional start)\n \"When the given expression matches the string, this function returns a list\nof the whole matching string and a string for each matched subexpressions.\nIf it did not match the returned value is an empty list (nil).\n\nWhen START is non-nil the search will start at that index.\"\n (declare (side-effect-free t))\n (save-match-data\n (if (string-match regexp s start)\n (let ((match-data-list (match-data))\n result)\n (while match-data-list\n (let* ((beg (car match-data-list))\n (end (cadr match-data-list))\n (subs (if (and beg end) (substring s beg end) nil)))\n (setq result (cons subs result))\n (setq match-data-list\n (cddr match-data-list))))\n (nreverse result)))))\n\n(defun s-slice-at (regexp s)\n \"Slices S up at every index matching REGEXP.\"\n (declare (side-effect-free t))\n (if (= 0 (length s)) (list \"\")\n (save-match-data\n (let (i)\n (setq i (string-match regexp s 1))\n (if i\n (cons (substring s 0 i)\n (s-slice-at regexp (substring s i)))\n (list s))))))\n\n(defun s-split-words (s)\n \"Split S into list of words.\"\n (declare (side-effect-free t))\n (s-split\n \"[^[:word:]0-9]+\"\n (let ((case-fold-search nil))\n (replace-regexp-in-string\n \"\\\\([[:lower:]]\\\\)\\\\([[:upper:]]\\\\)\" \"\\\\1 \\\\2\"\n (replace-regexp-in-string \"\\\\([[:upper:]]\\\\)\\\\([[:upper:]][0-9[:lower:]]\\\\)\" \"\\\\1 \\\\2\" s)))\n t))\n\n(defun s--mapcar-head (fn-head fn-rest list)\n \"Like MAPCAR, but applies a different function to the first element.\"\n (if list\n (cons (funcall fn-head (car list)) (mapcar fn-rest (cdr list)))))\n\n(defun s-lower-camel-case (s)\n \"Convert S to lowerCamelCase.\"\n (declare (side-effect-free t))\n (s-join \"\" (s--mapcar-head 'downcase 'capitalize (s-split-words s))))\n\n(defun s-upper-camel-case (s)\n \"Convert S to UpperCamelCase.\"\n (declare (side-effect-free t))\n (s-join \"\" (mapcar 'capitalize (s-split-words s))))\n\n(defun s-snake-case (s)\n \"Convert S to snake_case.\"\n (declare (side-effect-free t))\n (s-join \"_\" (mapcar 'downcase (s-split-words s))))\n\n(defun s-dashed-words (s)\n \"Convert S to dashed-words.\"\n (declare (side-effect-free t))\n (s-join \"-\" (mapcar 'downcase (s-split-words s))))\n\n(defun s-capitalized-words (s)\n \"Convert S to Capitalized words.\"\n (declare (side-effect-free t))\n (let ((words (s-split-words s)))\n (s-join \" \" (cons (capitalize (car words)) (mapcar 'downcase (cdr words))))))\n\n(defun s-titleized-words (s)\n \"Convert S to Titleized Words.\"\n (declare (side-effect-free t))\n (s-join \" \" (mapcar 's-titleize (s-split-words s))))\n\n(defun s-word-initials (s)\n \"Convert S to its initials.\"\n (declare (side-effect-free t))\n (s-join \"\" (mapcar (lambda (ss) (substring ss 0 1))\n (s-split-words s))))\n\n;; Errors for s-format\n(progn\n (put 's-format-resolve\n 'error-conditions\n '(error s-format s-format-resolve))\n (put 's-format-resolve\n 'error-message\n \"Cannot resolve a template to values\"))\n\n(defun s-format (template replacer &optional extra)\n \"Format TEMPLATE with the function REPLACER.\n\nREPLACER takes an argument of the format variable and optionally\nan extra argument which is the EXTRA value from the call to\n`s-format'.\n\nSeveral standard `s-format' helper functions are recognized and\nadapted for this:\n\n (s-format \\\"${name}\\\" 'gethash hash-table)\n (s-format \\\"${name}\\\" 'aget alist)\n (s-format \\\"$0\\\" 'elt sequence)\n\nThe REPLACER function may be used to do any other kind of\ntransformation.\"\n (let ((saved-match-data (match-data)))\n (unwind-protect\n (replace-regexp-in-string\n \"\\\\$\\\\({\\\\([^}]+\\\\)}\\\\|[0-9]+\\\\)\"\n (lambda (md)\n (let ((var\n (let ((m (match-string 2 md)))\n (if m m\n (string-to-number (match-string 1 md)))))\n (replacer-match-data (match-data)))\n (unwind-protect\n (let ((v\n (cond\n ((eq replacer 'gethash)\n (funcall replacer var extra))\n ((eq replacer 'aget)\n (funcall 's--aget extra var))\n ((eq replacer 'elt)\n (funcall replacer extra var))\n ((eq replacer 'oref)\n (funcall #'slot-value extra (intern var)))\n (t\n (set-match-data saved-match-data)\n (if extra\n (funcall replacer var extra)\n (funcall replacer var))))))\n (if v (format \"%s\" v) (signal 's-format-resolve md)))\n (set-match-data replacer-match-data)))) template\n ;; Need literal to make sure it works\n t t)\n (set-match-data saved-match-data))))\n\n(defvar s-lex-value-as-lisp nil\n \"If `t' interpolate lisp values as lisp.\n\n`s-lex-format' inserts values with (format \\\"%S\\\").\")\n\n(defun s-lex-fmt|expand (fmt)\n \"Expand FMT into lisp.\"\n (declare (side-effect-free t))\n (list 's-format fmt (quote 'aget)\n (append '(list)\n (mapcar\n (lambda (matches)\n (list\n 'cons\n (cadr matches)\n `(format\n (if s-lex-value-as-lisp \"%S\" \"%s\")\n ,(intern (cadr matches)))))\n (s-match-strings-all \"${\\\\([^}]+\\\\)}\" fmt)))))\n\n(defmacro s-lex-format (format-str)\n \"`s-format` with the current environment.\n\nFORMAT-STR may use the `s-format' variable reference to refer to\nany variable:\n\n (let ((x 1))\n (s-lex-format \\\"x is: ${x}\\\"))\n\nThe values of the variables are interpolated with \\\"%s\\\" unless\nthe variable `s-lex-value-as-lisp' is `t' and then they are\ninterpolated with \\\"%S\\\".\"\n (declare (debug (form)))\n (s-lex-fmt|expand format-str))\n\n(defun s-count-matches (regexp s &optional start end)\n \"Count occurrences of `regexp' in `s'.\n\n`start', inclusive, and `end', exclusive, delimit the part of `s'\nto match. \"\n (declare (side-effect-free t))\n (save-match-data\n (with-temp-buffer\n (insert s)\n (goto-char (point-min))\n (count-matches regexp (or start 1) (or end (point-max))))))\n\n(defun s-wrap (s prefix &optional suffix)\n \"Wrap string S with PREFIX and optionally SUFFIX.\n\nReturn string S with PREFIX prepended. If SUFFIX is present, it\nis appended, otherwise PREFIX is used as both prefix and\nsuffix.\"\n (declare (pure t) (side-effect-free t))\n (concat prefix s (or suffix prefix)))\n\n\f\n;;; Aliases\n\n(defalias 's-blank-p 's-blank?)\n(defalias 's-blank-str-p 's-blank-str?)\n(defalias 's-capitalized-p 's-capitalized?)\n(defalias 's-contains-p 's-contains?)\n(defalias 's-ends-with-p 's-ends-with?)\n(defalias 's-equals-p 's-equals?)\n(defalias 's-less-p 's-less?)\n(defalias 's-lowercase-p 's-lowercase?)\n(defalias 's-matches-p 's-matches?)\n(defalias 's-mixedcase-p 's-mixedcase?)\n(defalias 's-numeric-p 's-numeric?)\n(defalias 's-prefix-p 's-starts-with?)\n(defalias 's-prefix? 's-starts-with?)\n(defalias 's-present-p 's-present?)\n(defalias 's-starts-with-p 's-starts-with?)\n(defalias 's-suffix-p 's-ends-with?)\n(defalias 's-suffix? 's-ends-with?)\n(defalias 's-uppercase-p 's-uppercase?)\n\n\f\n(provide 's)\n;;; s.el ends here\n" }, { "path": "t/jiralib-t.el", "content": ";;; jiralib-t.el --- ERT tests\n\n;; Copyright (C) 2017 Matthew Carter \n;;\n;; Authors:\n;; Matthew Carter \n;;\n;; Maintainer: Matthew Carter \n;; URL: https://github.com/ahungry/org-jira\n;; Version: 2.6.2\n;; Keywords: ahungry jira org bug tracker\n;; Package-Requires: ((emacs \"24.5\") (cl-lib \"0.5\") (request \"0.2.0\"))\n\n;; This file is not part of GNU Emacs.\n\n;; This program is free software: you can redistribute it and/or modify\n;; it under the terms of the GNU General Public License as published by\n;; the Free Software Foundation, either version 3 of the License, or\n;; (at your option) any later version.\n\n;; This program is distributed in the hope that it will be useful,\n;; but WITHOUT ANY WARRANTY; without even the implied warranty of\n;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n;; GNU General Public License for more details.\n\n;; You should have received a copy of the GNU General Public License\n;; along with this program. If not, see\n;; or write to the Free Software\n;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA\n;; 02110-1301, USA.\n\n;;; Commentary:\n\n;; This tests the extension to org-mode for syncing issues with JIRA\n;; issue servers.\n\n;;; News:\n\n;;;; Changes since 0.0.0:\n;; - Add some basic tests\n\n;;; Code:\n\n(require 'jiralib)\n\n(ert-deftest jiralib-format-datetime-test ()\n (should\n (string= \"2017-01-01T00:00:00.000+0000\"\n (jiralib-format-datetime \"2017-01-01 00:00:00\"))))\n\n(provide 'jiralib-t)\n;;; jiralib-t.el ends here\n" }, { "path": "t/org-jira-t.el", "content": ";;; org-jira-t.el --- ERT tests\n\n;; Copyright (C) 2017 Matthew Carter \n;;\n;; Authors:\n;; Matthew Carter \n;;\n;; Maintainer: Matthew Carter \n;; URL: https://github.com/ahungry/org-jira\n;; Version: 2.6.2\n;; Keywords: ahungry jira org bug tracker\n;; Package-Requires: ((emacs \"24.5\") (cl-lib \"0.5\") (request \"0.2.0\"))\n\n;; This file is not part of GNU Emacs.\n\n;; This program is free software: you can redistribute it and/or modify\n;; it under the terms of the GNU General Public License as published by\n;; the Free Software Foundation, either version 3 of the License, or\n;; (at your option) any later version.\n\n;; This program is distributed in the hope that it will be useful,\n;; but WITHOUT ANY WARRANTY; without even the implied warranty of\n;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n;; GNU General Public License for more details.\n\n;; You should have received a copy of the GNU General Public License\n;; along with this program. If not, see\n;; or write to the Free Software\n;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA\n;; 02110-1301, USA.\n\n;;; Commentary:\n\n;; This tests the extension to org-mode for syncing issues with JIRA\n;; issue servers.\n\n;;; News:\n\n;;;; Changes since 0.0.0:\n;; - Add some basic tests\n\n;;; Code:\n\n(require 'org-jira)\n\n(set-time-zone-rule t)\n\n(ert-deftest org-jira-date-strip-letter-t-test ()\n (should\n (string= \"2017-01-01 00:00:00+0000\"\n (org-jira-date-strip-letter-t \"2017-01-01T00:00:00.000+0000\")))\n )\n\n(ert-deftest org-jira-date-to-org-clock-test ()\n (should\n (string= \"2017-01-01 Sun 00:00\"\n (org-jira-date-to-org-clock \"2017-01-01T00:00:00.000+0000\")))\n (should\n (string= \"2017-02-05 Sun 00:00\"\n (org-jira-date-to-org-clock \"2017-02-05T00:00:00.000+0000\")))\n )\n\n(ert-deftest org-jira-org-clock-to-date-test ()\n (should\n (string= \"2017-01-01T00:00:00.000+0000\"\n (org-jira-org-clock-to-date \"2017-01-01 Sun 00:00\")))\n )\n\n(ert-deftest org-jira-time-stamp-to-org-clock-test ()\n (should\n (string= \"2017-01-01 Sun 00:05\"\n (org-jira-time-stamp-to-org-clock '(22632 18348))))\n )\n\n(defvar org-jira-worklog-fixture-response\n '((startAt . 0)\n (maxResults . 2)\n (total . 2)\n (worklogs .\n [((self . \"https://example.com/rest/api/2/issue/10402/worklog/10101\")\n (author\n (self . \"https://example.com/rest/api/2/user?username=admin\")\n (name . \"admin\")\n (key . \"admin\")\n (accountId . \"omitted\")\n (emailAddress . \"m@example.com\")\n (avatarUrls\n (48x48 . \"https://avatar-cdn.atlassian.com/12345?s=48&d=https%3A%2F%2Fsecure.gravatar.com%2Favatar%2F12345%3Fd%3Dmm%26s%3D48%26noRedirect%3Dtrue\")\n (24x24 . \"https://avatar-cdn.atlassian.com/12345?s=24&d=https%3A%2F%2Fsecure.gravatar.com%2Favatar%2F12345%3Fd%3Dmm%26s%3D24%26noRedirect%3Dtrue\")\n (16x16 . \"https://avatar-cdn.atlassian.com/12345?s=16&d=https%3A%2F%2Fsecure.gravatar.com%2Favatar%2F12345%3Fd%3Dmm%26s%3D16%26noRedirect%3Dtrue\")\n (32x32 . \"https://avatar-cdn.atlassian.com/12345?s=32&d=https%3A%2F%2Fsecure.gravatar.com%2Favatar%2F12345%3Fd%3Dmm%26s%3D32%26noRedirect%3Dtrue\"))\n (displayName . \"Matthew Carter\")\n (active . t)\n (timeZone . \"America/New_York\"))\n (updateAuthor\n (self . \"https://example.com/rest/api/2/user?username=admin\")\n (name . \"admin\")\n (key . \"admin\")\n (accountId . \"omitted\")\n (emailAddress . \"m@example.com\")\n (avatarUrls\n (48x48 . \"https://avatar-cdn.atlassian.com/12345?s=48&d=https%3A%2F%2Fsecure.gravatar.com%2Favatar%2F12345%3Fd%3Dmm%26s%3D48%26noRedirect%3Dtrue\")\n (24x24 . \"https://avatar-cdn.atlassian.com/12345?s=24&d=https%3A%2F%2Fsecure.gravatar.com%2Favatar%2F12345%3Fd%3Dmm%26s%3D24%26noRedirect%3Dtrue\")\n (16x16 . \"https://avatar-cdn.atlassian.com/12345?s=16&d=https%3A%2F%2Fsecure.gravatar.com%2Favatar%2F12345%3Fd%3Dmm%26s%3D16%26noRedirect%3Dtrue\")\n (32x32 . \"https://avatar-cdn.atlassian.com/12345?s=32&d=https%3A%2F%2Fsecure.gravatar.com%2Favatar%2F12345%3Fd%3Dmm%26s%3D32%26noRedirect%3Dtrue\"))\n (displayName . \"Matthew Carter\")\n (active . t)\n (timeZone . \"America/New_York\"))\n (comment . \"Some comment here\")\n (created . \"2017-02-27T23:47:04.261+0000\")\n (updated . \"2017-02-27T23:47:04.261+0000\")\n (started . \"2017-02-26T00:08:00.000+0000\")\n (timeSpent . \"1h\")\n (timeSpentSeconds . 3600)\n (id . \"10101\")\n (issueId . \"10402\"))\n ((self . \"https://example.com/rest/api/2/issue/10402/worklog/10200\")\n (author\n (self . \"https://example.com/rest/api/2/user?username=admin\")\n (name . \"admin\")\n (key . \"admin\")\n (accountId . \"omitted\")\n (emailAddress . \"m@example.com\")\n (avatarUrls\n (48x48 . \"https://avatar-cdn.atlassian.com/12345?s=48&d=https%3A%2F%2Fsecure.gravatar.com%2Favatar%2F12345%3Fd%3Dmm%26s%3D48%26noRedirect%3Dtrue\")\n (24x24 . \"https://avatar-cdn.atlassian.com/12345?s=24&d=https%3A%2F%2Fsecure.gravatar.com%2Favatar%2F12345%3Fd%3Dmm%26s%3D24%26noRedirect%3Dtrue\")\n (16x16 . \"https://avatar-cdn.atlassian.com/12345?s=16&d=https%3A%2F%2Fsecure.gravatar.com%2Favatar%2F12345%3Fd%3Dmm%26s%3D16%26noRedirect%3Dtrue\")\n (32x32 . \"https://avatar-cdn.atlassian.com/12345?s=32&d=https%3A%2F%2Fsecure.gravatar.com%2Favatar%2F12345%3Fd%3Dmm%26s%3D32%26noRedirect%3Dtrue\"))\n (displayName . \"Matthew Carter\")\n (active . t)\n (timeZone . \"America/New_York\"))\n (updateAuthor\n (self . \"https://example.com/rest/api/2/user?username=admin\")\n (name . \"admin\")\n (key . \"admin\")\n (accountId . \"omitted\")\n (emailAddress . \"m@example.com\")\n (avatarUrls\n (48x48 . \"https://avatar-cdn.atlassian.com/12345?s=48&d=https%3A%2F%2Fsecure.gravatar.com%2Favatar%2F12345%3Fd%3Dmm%26s%3D48%26noRedirect%3Dtrue\")\n (24x24 . \"https://avatar-cdn.atlassian.com/12345?s=24&d=https%3A%2F%2Fsecure.gravatar.com%2Favatar%2F12345%3Fd%3Dmm%26s%3D24%26noRedirect%3Dtrue\")\n (16x16 . \"https://avatar-cdn.atlassian.com/12345?s=16&d=https%3A%2F%2Fsecure.gravatar.com%2Favatar%2F12345%3Fd%3Dmm%26s%3D16%26noRedirect%3Dtrue\")\n (32x32 . \"https://avatar-cdn.atlassian.com/12345?s=32&d=https%3A%2F%2Fsecure.gravatar.com%2Favatar%2F12345%3Fd%3Dmm%26s%3D32%26noRedirect%3Dtrue\"))\n (displayName . \"Matthew Carter\")\n (active . t)\n (timeZone . \"America/New_York\"))\n (comment . \"Add 32 minutes\")\n (created . \"2017-03-16T23:25:45.396+0000\")\n (updated . \"2017-03-16T23:25:45.396+0000\")\n (started . \"2017-03-16T22:25:00.000+0000\")\n (timeSpent . \"32m\")\n (timeSpentSeconds . 1920)\n (id . \"10200\")\n (issueId . \"10402\"))]))\n \"A sample response, as served from the #'jiralib-get-worklogs call.\")\n\n;; (ert-deftest org-jira-worklogs-to-org-clocks-test ()\n;; (let ((result (org-jira-worklogs-to-org-clocks\n;; (cdr (assoc 'worklogs org-jira-worklog-fixture-response)))))\n;; (should\n;; (string= \"2017-02-26 Sun 00:08\"\n;; (caar result)))\n;; (should\n;; (string= \"2017-02-26 Sun 01:08\"\n;; (cadar result)))\n;; (should\n;; (string= \"2017-03-16 Thu 22:25\"\n;; (caadr result)))\n;; (should\n;; (string= \"2017-03-16 Thu 22:57\"\n;; (cadadr result)))\n;; ))\n\n(ert-deftest org-jira-format-clock-test ()\n (should\n (string= \"CLOCK: [2017-02-26 Sun 00:08]--[2017-02-26 Sun 01:08]\"\n (org-jira-format-clock '(\"2017-02-26 Sun 00:08\" \"2017-02-26 Sun 01:08\")))))\n\n(ert-deftest org-jira-org-clock-to-jira-worklog-test ()\n (let ((result\n (org-jira-org-clock-to-jira-worklog\n \"[2017-04-05 Wed 01:00]--[2017-04-05 Wed 01:46] => 0:46\"\n \" :id: 10101\n Success!\nCLOCK:\")))\n (should (string= \"10101\" (cdr (assoc 'worklog-id result))))\n (should (string= \"Success!\" (cdr (assoc 'comment result))))\n (should (string= \"2017-04-05T01:00:00.000+0000\" (cdr (assoc 'started result))))\n (should (= 2760.0 (cdr (assoc 'time-spent-seconds result))))\n ))\n\n(ert-deftest org-jira-org-clock-to-jira-worklog-no-id-test ()\n (let ((result\n (org-jira-org-clock-to-jira-worklog\n \"[2017-04-05 Wed 01:00]--[2017-04-05 Wed 01:46] => 0:46\"\n \"My sweet comment!\nCLOCK:\")))\n (should (equal nil (cdr (assoc 'worklog-id result))))\n (should (string= \"My sweet comment!\" (cdr (assoc 'comment result))))\n (should (string= \"2017-04-05T01:00:00.000+0000\" (cdr (assoc 'started result))))\n (should (= 2760.0 (cdr (assoc 'time-spent-seconds result))))\n ))\n\n(ert-deftest org-jira-sort-org-clocks-test ()\n (let* ((clocks '((\"2017-02-26 Sun 00:08\" \"2017-02-26 Sun 01:08\" \"Some comment here\" \"10101\")\n (\"2017-03-16 Thu 22:25\" \"2017-03-16 Thu 22:57\" \"Add 32 minutes\" \"10200\"))\n )\n (result (org-jira-sort-org-clocks clocks)))\n\n (should (string= \"2017-03-16 Thu 22:25\" (car (car result))))\n ))\n\n(ert-deftest org-jira-strip-string-test ()\n (should (string= \"dog\" (org-jira-strip-string \" dog \"))))\n\n;; This test sort of sucks, as its just confirming we get back some strings.\n(ert-deftest org-jira-decode-test ()\n (should (string= \"\" (org-jira-decode nil)))\n (should (string= \"dog\" (org-jira-decode \"dog\"))))\n\n(ert-deftest org-jira-t-get-org-priority-string ()\n (let ((org-jira-priority-to-org-priority-omit-default-priority nil)\n (org-default-priority ?B))\n (should (string= \"[#B] \" (org-jira-get-org-priority-string ?B)))\n (setq org-jira-priority-to-org-priority-omit-default-priority t)\n (should (string= \"\" (org-jira-get-org-priority-string ?B)))\n (should (string= \"\" (org-jira-get-org-priority-string nil)))\n )\n )\n\n(ert-deftest org-jira-t-strip-priority-tags ()\n (should (string= \"good and clean\" (org-jira-strip-priority-tags \"[#C] good and clean\")))\n (should (string= \"food and clean\" (org-jira-strip-priority-tags \" [#C] [#D] food and clean \")))\n )\n\n\n(provide 'org-jira-t)\n;;; org-jira-t.el ends here\n" }, { "path": "todo.org", "content": "* Worklog\n** TODO Sync up Estimate/Remaining Estimate in Worklog or Property\nWith the dynamic org clocking, integrate with how org clock tracks\nestimates would be a good idea.\n" } ]