Showing preview only (342K chars total). Download the full file or copy to clipboard to get everything.
Repository: baohaojun/org-jira
Branch: master
Commit: 5be5c438e596
Files: 15
Total size: 331.3 KB
Directory structure:
gitextract_6otzjjkx/
├── .editorconfig
├── .gitignore
├── .travis.yml
├── Makefile
├── README.md
├── jiralib.el
├── org-jira-sdk.el
├── org-jira.el
├── t/
│ ├── .nosearch
│ ├── batch-runner/
│ │ ├── dash.el
│ │ ├── request.el
│ │ └── s.el
│ ├── jiralib-t.el
│ └── org-jira-t.el
└── todo.org
================================================
FILE CONTENTS
================================================
================================================
FILE: .editorconfig
================================================
root = true
[*]
end_of_line = lf
insert_final_newline = true
charset = utf-8
trim_trailing_whitespace = true
[*.{el}]
indent_style = space
================================================
FILE: .gitignore
================================================
#.*#
*#*#
*.#*
flycheck_*
*.elc
================================================
FILE: .travis.yml
================================================
language: emacs-lisp
sudo: false
env:
- EVM_EMACS=emacs-25.1-travis
- EVM_EMACS=emacs-25.2-travis
- EVM_EMACS=emacs-25.3-travis
- EVM_EMACS=emacs-26.1-travis
- EVM_EMACS=emacs-git-snapshot-travis
script:
- make test
================================================
FILE: Makefile
================================================
# Really just so we can run 'make test' easily
all: test
test:
@emacs -batch \
-l ert \
-l t/batch-runner/s.el \
-l t/batch-runner/request.el \
-l t/batch-runner/dash.el \
-l jiralib.el \
-l org-jira-sdk.el \
-l org-jira.el \
-l t/org-jira-t.el \
-l t/jiralib-t.el \
-f ert-run-tests-batch-and-exit
.PHONY: test
================================================
FILE: README.md
================================================
# org-jira mode
[](https://gitter.im/org-jira/Lobby?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge)
[](http://melpa.org/#/org-jira)
Use Jira in Emacs org-mode.
## TOC
<!-- markdown-toc start - Don't edit this section. Run M-x markdown-toc-refresh-toc -->
**Table of Contents**
- [org-jira mode](#org-jira-mode)
- [TOC](#toc)
- [Setup](#setup)
- [Installation](#installation)
- [Configuration](#configuration)
- [Usage](#usage)
- [Getting Started](#getting-started)
- [Keybinds](#keybinds)
- [Customization](#customization)
- [Authorization workaround (NOT secure)](#authorization-workaround-not-secure)
- [Optimizations](#optimizations)
- [Optimizing available actions for status changes](#optimizing-available-actions-for-status-changes)
- [About](#about)
- [Maintainer](#maintainer)
- [License](#license)
<!-- markdown-toc end -->
## Setup
### Installation
To install, just grab it off of MELPA (ensure your ~/.emacs already
has MELPA set up):
```lisp
(require 'package)
(add-to-list 'package-archives '("melpa" . "http://melpa.milkbox.net/packages/") t)
(package-initialize)
```
Then run `M-x package-install RET org-jira RET` and you're done!
### Configuration
In your ~/.emacs, you should set the variable as such:
```conf
(setq jiralib-url "https://your-site.atlassian.net")
```
If you don't want to enter your credentials (login/password) each time
you go to connect, you can add to your ~/.authinfo.gpg or ~/.authinfo
file, in a format similar to:
```conf
machine your-site.atlassian.net login you@example.com password yourPassword port 80
```
_Please note that in the authinfo file, port 443 should be specified
if your jiralib-url is https._
## Usage
### Getting Started
org-jira mode is easy to use, to get started (after installing this
library) try running `M-x org-jira-get-issues`. You should see that
it pulls in all issues that are assigned to you.
Following that, you can try out some of the org-jira mode commands by
visiting one of the files (they're named after your Jira project code,
for example, 'EX.org' for a project named 'EX').
### Keybinds
Some of the important keybindings:
```lisp
(define-key org-jira-map (kbd "C-c pg") 'org-jira-get-projects)
(define-key org-jira-map (kbd "C-c ib") 'org-jira-browse-issue)
(define-key org-jira-map (kbd "C-c ig") 'org-jira-get-issues)
(define-key org-jira-map (kbd "C-c ih") 'org-jira-get-issues-headonly)
(define-key org-jira-map (kbd "C-c iu") 'org-jira-update-issue)
(define-key org-jira-map (kbd "C-c iw") 'org-jira-progress-issue)
(define-key org-jira-map (kbd "C-c in") 'org-jira-progress-issue-next)
(define-key org-jira-map (kbd "C-c ia") 'org-jira-assign-issue)
(define-key org-jira-map (kbd "C-c ir") 'org-jira-refresh-issue)
(define-key org-jira-map (kbd "C-c iR") 'org-jira-refresh-issues-in-buffer)
(define-key org-jira-map (kbd "C-c ic") 'org-jira-create-issue)
(define-key org-jira-map (kbd "C-c ik") 'org-jira-copy-current-issue-key)
(define-key org-jira-map (kbd "C-c sc") 'org-jira-create-subtask)
(define-key org-jira-map (kbd "C-c sg") 'org-jira-get-subtasks)
(define-key org-jira-map (kbd "C-c cc") 'org-jira-add-comment)
(define-key org-jira-map (kbd "C-c cu") 'org-jira-update-comment)
(define-key org-jira-map (kbd "C-c wu") 'org-jira-update-worklogs-from-org-clocks)
(define-key org-jira-map (kbd "C-c tj") 'org-jira-todo-to-jira)
(define-key org-jira-map (kbd "C-c if") 'org-jira-get-issues-by-fixversion)
```
### Customization
You can define your own streamlined issue progress flow as such:
```lisp
(defconst org-jira-progress-issue-flow
'(("To Do" . "In Progress"
("In Progress" . "Done"))))
```
or using typical Emacs customize options, as its a defcustom.
This will allow you to quickly progress an issue based on its current
status, and what the next status should be.
If your Jira is set up to display a status in the issue differently
than what is shown in the button on Jira, your alist may look like
this (use the labels shown in the org-jira Status when setting it up,
or manually work out the workflows being used through
standard `C-c iw` options/usage):
```lisp
(defconst org-jira-progress-issue-flow
'(("To Do" . "Start Progress")
("In Development" . "Ready For Review")
("Code Review" . "Done")
("Done" . "Reopen")))
```
#### Authorization workaround (NOT secure)
If your Jira instance has disabled basic auth, you can still get in
by copying your web browser's cookie (open up developer console, and
right click and 'Copy request as cURL', then copy/paste the cookie
into the jiralib-token variable):
```lisp
(defconst jiralib-token
(cons "Cookie" . "eyJ<your giant long cookie copied from browser"))
```
### Optimizations
It's possible some things in your Jira instance rarely if ever change - while org-jira
will dynamically query everything as needed, it makes use of some
variables/caching per-run of Emacs. If you ever notice something was
changed on the Jira setup level, you may have to restart your Emacs
(or manually unset these variables). By the same token, that makes it
possible to hardcode some of these values yourself, so org-jira never
needs to look them up.
Some samples may be:
#### Optimizing available actions for status changes
Take time inspecting jiralib-available-actions-cache variable as you
use org-jira, when you see the type of data it stores, you can then
just define it yourself, as such, so repeated usage will not need to
re-query the endpoints to get these lists:
```lisp
(defconst jiralib-available-actions-cache
'(("To Do"
("71" . "Business Question")
("11" . "Start Progress"))
("Code Review"
("71" . "Business Question")
("91" . "Reject")
("171" . "Failed Peer Review")
("221" . "Done"))
("In Development"
("71" . "Business Question")
("21" . "Ready For Review")
("81" . "Reject")
("161" . "Stop Progress"))
("Done"
("71" . "Business Question")
("141" . "Re-open"))))
```
## About
### Maintainer
You can reach me directly: Matthew Carter <m@ahungry.com>, or file an
issue here on https://github.com/ahungry/org-jira.
### License
GPLv3
================================================
FILE: jiralib.el
================================================
;;; jiralib.el -- Provide connectivity to JIRA SOAP/REST services.
;; Copyright (C) 2016,2017 Matthew Carter <m@ahungry.com>
;; Copyright (C) 2011 Bao Haojun
;; original Copyright (C) 2009 Alex Harsanyi
;; Also, used some code from jira.el, which use xml-rpc instead of soap.
;; Thus Copyright (C) for jira.el related code:
;; Brian Zwahr <echosa@gmail.com>
;; Dave Benjamin <dave@ramenlabs.com>
;; Authors:
;; Matthew Carter <m@ahungry.com>
;; Bao Haojun <baohaojun@gmail.com>
;; Alex Harsanyi <AlexHarsanyi@gmail.com>
;; Maintainer: Matthew Carter <m@ahungry.com>
;; Version: 3.0.0
;; Homepage: https://github.com/ahungry/org-jira
;; This file is not part of GNU Emacs.
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see
;; <http://www.gnu.org/licenses/> or write to the Free Software
;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
;; 02110-1301, USA.
;; Author: Alexandru Harsanyi (AlexHarsanyi@gmail.com)
;; Created: December, 2009
;; Keywords: soap, web-services, jira
;; Homepage: http://code.google.com/p/emacs-soap-client
;;; Commentary:
;; This file provides a programatic interface to JIRA. It provides access to
;; JIRA from other programs, but no user level functionality.
;; Jira References:
;; Primary reference (on current Jira, only REST is supported):
;; https://developer.atlassian.com/jiradev/jira-apis/jira-rest-apis
;; Full API list reference:
;; https://docs.atlassian.com/jira/REST/cloud/
;; Legacy reference (unsupported and deprecated/unavailable):
;; http://confluence.atlassian.com/display/JIRA/Creating+a+SOAP+Client
;; JavaDoc for the Jira SOAP service
;; http://docs.atlassian.com/software/jira/docs/api/rpc-jira-plugin/latest/com/atlassian/jira/rpc/soap/JiraSoapService.html
;;; News:
;;;; Changes since 2.6.3:
;; - Add worklog import filter and control variable for external worklogs.
;; - Add the worklog related endpoint/calls.
;;;; Changes since 2.1.0:
;; - Remove os_username / os_password manual http request as part of sign in process
;; This produces sysadmin level warnings on Jira when these are used under the latest Jira.
;; - Remove unused function jiralib-link-issue
;; - Bring version up to match org-jira version so they can share tag
;;;; Changes since 2.0.0:
;; - Allow issue type query by project
;;;; Changes since 0.0.0:
;; - Converted many calls to async
;; - Converted many calls to make use of caching
;;; Code:
(eval-when-compile (require 'cl))
(require 'soap-client)
(require 'request)
(require 'json)
(require 'url-parse)
(require 'url-util)
(defconst jiralib-version "3.0.0"
"Current version of jiralib.el.")
(defgroup jiralib nil
"Jiralib customization group."
:group 'applications)
(defgroup jiralib-faces nil
"Faces for displaying Jiralib information."
:group 'jiralib)
(defcustom jiralib-use-restapi t
"Use restapi instead of soap."
:group 'jiralib
:type 'boolean
:initialize 'custom-initialize-set)
(defcustom jiralib-host ""
"User customizable host name of the Jiralib server.
This will be used with USERNAME to compute password from
.authinfo file. Will be calculated from jiralib-url if not set."
:group 'jiralib
:type 'string
:initialize 'custom-initialize-set)
(defface jiralib-issue-info-face
'((t (:foreground "black" :background "yellow4")))
"Base face for issue information."
:group 'jiralib-faces)
(defface jiralib-issue-info-header-face
'((t (:bold t :inherit 'jiralib-issue-info-face)))
"Base face for issue headers."
:group 'jiralib-faces)
(defface jiralib-issue-summary-face
'((t (:bold t)))
"Base face for issue summary."
:group 'jiralib-faces)
(defface jiralib-comment-face
'((t (:background "gray23")))
"Base face for comments."
:group 'jiralib-faces)
(defface jiralib-comment-header-face
'((t (:bold t)))
"Base face for comment headers."
:group 'jiralib-faces)
(defface jiralib-link-issue-face
'((t (:underline t)))
"Face for linked issues."
:group 'jiralib-faces)
(defface jiralib-link-project-face
'((t (:underline t)))
"Face for linked projects"
:group 'jiralib-faces)
(defface jiralib-link-filter-face
'((t (:underline t)))
"Face for linked filters"
:group 'jiralib-faces)
(defvar jiralib-mode-hook nil)
(defvar jiralib-mode-map nil)
(defvar jiralib-issue-regexp "\\<\\(?:[A-Za-z0-9]+\\)-[0-9]+\\>")
(defcustom jiralib-wsdl-descriptor-url
""
"The location for the WSDL descriptor for the JIRA service.
This is specific to your local JIRA installation. The URL is
typically:
http://YOUR_INSTALLATION/rpc/soap/jirasoapservice-v2?wsdl
The default value works if JIRA is located at a hostname named
'jira'."
:type 'string
:group 'jiralib)
(defcustom jiralib-url
"http://localhost:8081/"
"The address of the jira host."
:type 'string
:group 'jiralib)
(defcustom jiralib-agile-page-size
50
"Page size for agile API retrieve. Limited by server property jira.search.views.default.max"
:type 'integer
:group 'jiralib)
(defvar jiralib-token nil
"JIRA token used for authentication.")
(defvar jiralib-rest-auth-head nil
"JIRA restapi auth head.")
(defvar jiralib-user-login-name nil
"The name of the user logged into JIRA.
This is maintained by `jiralib-login'.")
(defvar jiralib-wsdl nil)
(defcustom jiralib-worklog-import--filters-alist
(list
'(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))))
'(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)))))
"A list of triplets: ('Global-Enable 'Descriptive-Label 'Function-Definition)
that apply worklog predicate filters during import.
Example: (list '('t \"descriptive-predicate-label\" (lambda (x) x)))"
:type '(repeat (list boolean string function))
:group 'org-jira)
(defun jiralib-load-wsdl ()
"Load the JIRA WSDL descriptor."
(setq jiralib-wsdl (soap-load-wsdl-from-url (if (string-equal jiralib-wsdl-descriptor-url "")
(concat jiralib-url "/rpc/soap/jirasoapservice-v2?wsdl")
jiralib-wsdl-descriptor-url))))
(defun jiralib-login (username password)
"Login into JIRA as user USERNAME with PASSWORD.
After a successful login, store the authentication token in
`jiralib-token'."
;; NOTE that we cannot rely on `jiralib-call' because `jiralib-call' relies on
;; us ;-)
(interactive
(if (> 24 emacs-major-version)
(let ((user (read-string "Username for Jira server login? "))
(password (read-passwd "Password for Jira server login? ")))
(list user password))
(let ((found (nth 0 (auth-source-search :max 1
:host (if (string= jiralib-host "")
(url-host (url-generic-parse-url jiralib-url))
jiralib-host)
;; secrets.el wouldn’t accept a number.
:port (number-to-string (url-port (url-generic-parse-url jiralib-url)))
:require '(:user :secret)
:create t)))
user secret)
(when found
(setq user (plist-get found :user)
secret
(let ((sec (plist-get found :secret)))
(if (functionp sec)
(funcall sec)
sec)))
(list user secret)))))
(if jiralib-use-restapi
(setq jiralib-token `("Authorization" . , (format "Basic %s" (base64-encode-string (concat username ":" password)))))
(unless jiralib-wsdl
(jiralib-load-wsdl))
(setq jiralib-token
(car (soap-invoke jiralib-wsdl "jirasoapservice-v2" "login" username password))))
(setq jiralib-user-login-name username))
(defvar jiralib-complete-callback nil)
(defun jiralib-call (method callback &rest params)
"Invoke the Jira METHOD, then CALLBACK with supplied PARAMS.
This function should be used for all JIRA interface calls, as the
method ensures the user is logged in and invokes `soap-invoke'
with the correct service name and authentication token.
All JIRA interface methods take an authentication token as the
first argument. The authentication token is supplied by this
function, so PARAMS should omit this parameter. For example, the
\"getIssue\" method takes two parameters: auth and key, however,
when invoking it through `jiralib-call', the call should be:
(jiralib-call \"getIssue\" KEY)
CALLBACK should be the post processing function to run with the
completed data from the request result, which can be accessed with:
(getf data :data)
as such, the CALLBACK should follow this type of form:
(cl-function
(lambda (&rest data &allow-other-keys)
(print (getf data :data))))
If CALLBACK is set to nil then the request will occur with sync.
This produces a noticeable slowdown and is not recommended by
request.el, so if at all possible, it should be avoided."
;; @todo :auth: Probably pass this all the way down, but I think
;; it may be OK at the moment to just set the variable each time.
(setq jiralib-complete-callback
;; Don't run with async if we don't have a login token yet.
(if jiralib-token callback nil))
;; If we don't have a regex set, ensure it is set BEFORE any async
;; calls are processing, or we're going to have a bad time.
;; This should only end up running once per session.
(unless jiralib-issue-regexp
(let ((projects (mapcar (lambda (e) (downcase (cdr (assoc 'key e))))
(append (jiralib--rest-call-it
"/rest/api/2/project"
:params '((expand . "description,lead,url,projectKeys")))
nil)
)))
(when projects
(setq jiralib-issue-regexp
(concat "\\<" (regexp-opt projects) "-[0-9]+\\>")))))
(if (not jiralib-use-restapi)
(car (apply 'jiralib--call-it method params))
(unless jiralib-token
(call-interactively 'jiralib-login))
(case (intern method)
('getStatuses (jiralib--rest-call-it "/rest/api/2/status"))
('getIssueTypes (jiralib--rest-call-it "/rest/api/2/issuetype"))
('getIssueTypesByProject
(let ((response (jiralib--rest-call-it (format "/rest/api/2/project/%s" (first params)))))
(cl-coerce (cdr (assoc 'issueTypes response)) 'list)))
('getUser (jiralib--rest-call-it "/rest/api/2/user" :params `((username . ,(first params)))))
('getVersions (jiralib--rest-call-it (format "/rest/api/2/project/%s/versions" (first params))))
;; Worklog calls
('getWorklogs
(jiralib--rest-call-it (format "/rest/api/2/issue/%s/worklog" (first params))))
('addWorklog
(jiralib--rest-call-it (format "/rest/api/2/issue/%s/worklog" (first params))
:type "POST"
:data (json-encode (second params))))
('updateWorklog
(jiralib--rest-call-it (format "/rest/api/2/issue/%s/worklog/%s" (first params) (second params))
:type "PUT"
:data (json-encode (third params))))
('addWorklogAndAutoAdjustRemainingEstimate
(jiralib--rest-call-it (format "/rest/api/2/issue/%s/worklog" (first params))
:type "POST"
:data (json-encode (second params))))
('addComment (jiralib--rest-call-it
(format "/rest/api/2/issue/%s/comment" (first params))
:type "POST"
:data (json-encode (second params))))
('createIssue
;; Creating the issue doesn't return it, a second call must be
;; made to pull it in by using the self key in response.
(let ((response (jiralib--rest-call-it
"/rest/api/2/issue"
:type "POST"
:data (json-encode (first params)))))
(jiralib--rest-call-it (cdr (assoc 'self response)) :type "GET")
))
('createIssueWithParent (jiralib--rest-call-it
))
('editComment (jiralib--rest-call-it
(format "/rest/api/2/issue/%s/comment/%s" (first params) (second params))
:data (json-encode `((body . ,(third params))))
:type "PUT"))
('getBoard (jiralib--rest-call-it (format "/rest/agile/1.0/board/%s" (first params))))
('getBoards (apply 'jiralib--agile-call-it "/rest/agile/1.0/board" 'values params))
('getComment (org-jira-find-value
(jiralib--rest-call-it
(format "/rest/api/2/issue/%s/comment/%s" (first params) (second params)))
'comments))
('getComments (org-jira-find-value
(jiralib--rest-call-it
(format "/rest/api/2/issue/%s/comment" (first params)))
'comments))
('getAttachmentsFromIssue (org-jira-find-value
(jiralib--rest-call-it
(format "/rest/api/2/issue/%s?fields=attachment" (first params)))
'comments))
('getComponents (jiralib--rest-call-it
(format "/rest/api/2/project/%s/components" (first params))))
('getIssue (jiralib--rest-call-it
(format "/rest/api/2/issue/%s" (first params))))
('getIssuesFromBoard (apply 'jiralib--agile-call-it
(format "rest/agile/1.0/board/%d/issue" (first params))
'issues
(cdr params)))
('getIssuesFromJqlSearch (append (cdr ( assoc 'issues (jiralib--rest-call-it
"/rest/api/2/search"
:type "POST"
:data (json-encode `((jql . ,(first params))
(maxResults . ,(second params)))))))
nil))
('getPriorities (jiralib--rest-call-it
"/rest/api/2/priority"))
('getProjects (jiralib--rest-call-it "rest/api/2/project"))
('getProjectsNoSchemes (append (jiralib--rest-call-it
"/rest/api/2/project"
:params '((expand . "description,lead,url,projectKeys"))) nil))
('getResolutions (append (jiralib--rest-call-it
"/rest/api/2/resolution") nil))
('getAvailableActions
(mapcar
(lambda (trans)
`(,(assoc 'name trans) ,(assoc 'id trans)))
(cdadr (jiralib--rest-call-it (format "/rest/api/2/issue/%s/transitions" (first params))))))
('getFieldsForAction (org-jira-find-value (car (let ((issue (first params))
(action (second params)))
(seq-filter (lambda (trans)
(or (string-equal action (org-jira-find-value trans 'id))
(string-equal action (org-jira-find-value trans 'name))))
(cdadr (jiralib--rest-call-it
(format "/rest/api/2/issue/%s/transitions" (first params))
:params '((expand . "transitions.fields")))))))
'fields))
('progressWorkflowAction (jiralib--rest-call-it
(format "/rest/api/2/issue/%s/transitions" (first params))
:type "POST"
:data (json-encode `(,(car (second params)) ,(car (third params))))))
('getUsers
(jiralib--rest-call-it (format "/rest/api/2/user/assignable/search?project=%s&maxResults=10000" (first params))
:type "GET"))
('updateIssue (jiralib--rest-call-it
(format "/rest/api/2/issue/%s" (first params))
:type "PUT"
:data (json-encode `((fields . ,(second params)))))))))
(defun jiralib--soap-call-it (&rest args)
"Deprecated SOAP call endpoint. Will be removed soon.
Pass ARGS to jiralib-call."
(let ((jiralib-token nil)
(jiralib-use-restapi nil))
(apply #'jiralib-call args)))
(defun jiralib--rest-call-it (api &rest args)
"Invoke the corresponding jira rest method API.
Invoking COMPLETE-CALLBACK when the
JIRALIB-COMPLETE-CALLBACK is non-nil, request finishes, and
passing ARGS to REQUEST."
(append (request-response-data
(apply #'request (if (string-match "^http[s]*://" api) api ;; If an absolute path, use it
(concat (replace-regexp-in-string "/*$" "/" jiralib-url)
(replace-regexp-in-string "^/*" "" api)))
:sync (not jiralib-complete-callback)
:headers `(,jiralib-token ("Content-Type" . "application/json"))
:parser 'json-read
:complete jiralib-complete-callback
args))
nil))
(defun jiralib--call-it (method &rest params)
"Invoke the JIRA METHOD with supplied PARAMS.
Internal use, returns a list of responses, of which only the
first is normally used."
(when (symbolp method)
(setq method (symbol-name method)))
(unless jiralib-token
(call-interactively 'jiralib-login))
(condition-case data
(apply 'soap-invoke jiralib-wsdl "jirasoapservice-v2"
method jiralib-token params)
(soap-error
;; If we are here, we had a token, but it expired. Re-login and try
;; again.
(setq jiralib-token nil)
(call-interactively 'jiralib-login)
(apply 'soap-invoke jiralib-wsdl "jirasoapservice-v2"
method jiralib-token params))))
;;;; Some utility functions
(defun jiralib-make-list (data field)
"Map all assoc elements in DATA to the value of FIELD in that element."
(loop for element in data
collect (cdr (assoc field element))))
(defun jiralib-make-assoc-list (data key-field value-field)
"Create an association list from a SOAP structure array.
DATA is a list of association lists (a SOAP array-of type)
KEY-FIELD is the field to use as the key in the returned alist
VALUE-FIELD is the field to use as the value in the returned alist"
(loop for element in data
collect (cons (cdr (assoc key-field element))
(cdr (assoc value-field element)))))
(defun jiralib-make-remote-field-values (fields)
"Transform the (KEY . VALUE) list FIELDS into a RemoteFieldValue structure.
Each (KEY . VALUE) pair is transformed into
((id . KEY) (values . (VALUE)))
This method exists because Several JIRA methods require a
RemoteFieldValue list, but it is easier to work with ALISTS in
emacs-lisp"
(let ((remote-field-values))
;; we accept an ALIST of field-name field-values parameter, but we need to
;; construct a structure that encodes as a RemoteFieldValue which is what
;; updateIssue wants
(dolist (field fields)
(let ((name (car field))
(value (cdr field)))
(when (symbolp name)
(setq name (symbol-name name)))
;; Value must be an "array" (for which soap-client accepts lists) even
;; if it is just one value
(unless (vectorp value)
(setq value (vector value)))
(push `((id . ,name) (values . ,value))
remote-field-values)))
(apply 'vector (nreverse remote-field-values))))
;;;; Wrappers around JIRA methods
(defun jiralib--rest-api-for-issue-key (key)
"Return jira rest api for issue KEY."
(concat "rest/api/2/issue/" key))
(defun jiralib-update-issue (key fields &optional callback)
"Update the issue with id KEY with the values in FIELDS, invoking CALLBACK."
(jiralib-call
"updateIssue"
callback
key (if jiralib-use-restapi
fields
(jiralib-make-remote-field-values fields))))
(defvar jiralib-status-codes-cache nil)
(defun jiralib-get-statuses ()
"Return an assoc list mapping a status code to its name.
NOTE: Status codes are stored as strings, not numbers.
This function will only ask JIRA for the list of codes once, then
will cache it."
(unless jiralib-status-codes-cache
(setq jiralib-status-codes-cache
(jiralib-make-assoc-list (jiralib-call "getStatuses" nil) 'id 'name)))
jiralib-status-codes-cache)
(defvar jiralib-issue-types-cache nil)
(defun jiralib-get-issue-types ()
"Return an assoc list mapping an issue type code to its name.
NOTE: Issue type codes are stored as strings, not numbers.
This function will only ask JIRA for the list of codes once, than
will cache it.
The issue types returned via getIssueTypes are all the ones
available to the user, but not necessarily available to the given
project.
This endpoint is essentially a master reference for when issue
types need a name lookup when given an id.
For applying issue types to a given project that is being created, see
the #'jiralib-get-issue-types-by-project call."
(unless jiralib-issue-types-cache
(setq jiralib-issue-types-cache
(jiralib-make-assoc-list (jiralib-call "getIssueTypes" nil) 'id 'name)))
jiralib-issue-types-cache)
(defvar jiralib-issue-types-by-project-cache nil "An alist of available issue types.")
(defun jiralib-get-issue-types-by-project (project)
"Return the available issue types for PROJECT.
PROJECT should be the key, such as `EX' or `DEMO'."
(unless (assoc project jiralib-issue-types-by-project-cache)
(push (cons project
(jiralib-make-assoc-list
(jiralib-call "getIssueTypesByProject" nil project)
'id 'name))
jiralib-issue-types-by-project-cache))
(cdr (assoc project jiralib-issue-types-by-project-cache)))
(defvar jiralib-priority-codes-cache nil)
(defun jiralib-get-priorities ()
"Return an assoc list mapping a priority code to its name.
NOTE: Priority codes are stored as strings, not numbers.
This function will only ask JIRA for the list of codes once, than
will cache it."
(unless jiralib-priority-codes-cache
(setq jiralib-priority-codes-cache
(jiralib-make-assoc-list (jiralib-call "getPriorities" nil) 'id 'name)))
jiralib-priority-codes-cache)
(defvar jiralib-resolution-code-cache nil)
(defun jiralib-get-resolutions ()
"Return an assoc list mapping a resolution code to its name.
NOTE: Resolution codes are stored as strings, not numbers.
This function will only ask JIRA for the list of codes once, than
will cache it."
(unless jiralib-resolution-code-cache
(setq jiralib-resolution-code-cache
(jiralib-make-assoc-list (jiralib-call "getResolutions" nil) 'id 'name)))
jiralib-resolution-code-cache)
;; NOTE: it is not such a good idea to use this, as it needs a JIRA
;; connection to construct the regexp (the user might be prompted for a JIRA
;; username and password).
;;
;; The best use of this function is to generate the regexp once-off and
;; persist it somewhere.
;;
;; FIXME: Probably just deprecate/remove this, we can assert we're on
;; an issue with a general regexp that matches the common format, vs
;; needing to know specific user project list.
(defun jiralib-get-issue-regexp ()
"Return a regexp that will match an issue id.
The regexp is constructed from the project keys in the JIRA
database. An issue is assumed to be in the format KEY-NUMBER,
where KEY is a project key and NUMBER is the issue number."
(unless jiralib-issue-regexp
(let ((projects (mapcar (lambda (e) (downcase (cdr (assoc 'key e))))
(jiralib-call "getProjectsNoSchemes" nil))))
(when projects
(setq jiralib-issue-regexp
(concat "\\<" (regexp-opt projects) "-[0-9]+\\>")))))
jiralib-issue-regexp)
(defun jiralib-do-jql-search (jql &optional limit callback)
"Run a JQL query and return the list of issues that matched.
LIMIT is the maximum number of queries to return. Note that JIRA
has an internal limit of how many queries to return, as such, it
might not be possible to find *ALL* the issues that match a
query."
(unless (or limit (numberp limit))
(setq limit 100))
(jiralib-call "getIssuesFromJqlSearch" callback jql limit))
(defcustom jiralib-available-actions-cache-p t
"Set to t to enable caching for jiralib-get-available-actions.
If nil, will disable caching for this endpoint.
Possible side-effects:
- If the server has the project workflow updated, the cache
saved here will be incorrect.
- If the issue is not up to date with the remote, the wrong
cache key may be queried."
:type 'boolean
:group 'jiralib)
(defvar jiralib-available-actions-cache nil "An alist of available actions.")
(defun jiralib-get-available-actions (issue-key &optional status)
"Return the available workflow actions for ISSUE-KEY.
This uses STATUS as the cache key.
This runs the getAvailableActions SOAP method."
(if (and jiralib-available-actions-cache-p status)
(progn
(unless (assoc status jiralib-available-actions-cache)
(push (cons status
(jiralib-make-assoc-list
(mapcar (lambda (x)
(let ((namestring (cdr (car x)))
(id (cdr x)))
(cons
(cons 'name (org-jira-decode namestring))
id)))
(jiralib-call "getAvailableActions" nil issue-key))
'id 'name))
jiralib-available-actions-cache))
(cdr (assoc status jiralib-available-actions-cache)))
(progn
(jiralib-make-assoc-list
(mapcar (lambda (x)
(let ((namestring (cdr (car x)))
(id (cdr x)))
(cons
(cons 'name (org-jira-decode namestring))
id)))
(jiralib-call "getAvailableActions" nil issue-key))
'id 'name))))
(defcustom jiralib-fields-for-action-cache-p t
"Set to t to enable caching for jiralib-get-fields-for-action.
If nil, will disable caching for this endpoint.
Possible side-effects:
- If many tasks have different workflows, you may want to disable this."
:type 'boolean
:group 'jiralib)
(defvar jiralib-fields-for-action-cache nil "An alist of available fields.")
(defun jiralib-get-fields-for-action-with-cache (issue-key action-id)
"Return the required fields to change ISSUE-KEY to ACTION-ID."
(if (and jiralib-fields-for-action-cache-p action-id)
(progn
(unless (assoc action-id jiralib-fields-for-action-cache)
(push (cons action-id
(jiralib-call "getFieldsForAction" nil issue-key action-id))
jiralib-fields-for-action-cache))
(cdr (assoc action-id jiralib-fields-for-action-cache)))
(jiralib-call "getFieldsForAction" nil issue-key action-id)))
(defun jiralib-get-fields-for-action (issue-key action-id)
"Return the required fields to change ISSUE-KEY to ACTION-ID."
(if jiralib-use-restapi
(let ((fields (jiralib-get-fields-for-action-with-cache issue-key action-id)))
(mapcar (lambda (field)
(cons (symbol-name (car field))
(format "%s (required: %s)"
(org-jira-find-value field 'name)
(if (eq (org-jira-find-value field 'required) :json-false)
"nil"
"t"))))
fields))
(jiralib-make-assoc-list
(jiralib-get-fields-for-action-with-cache issue-key action-id)
'id 'name)))
(defun jiralib-progress-workflow-action (issue-key action-id params &optional callback)
"Progress issue with ISSUE-KEY to action ACTION-ID, and provide the needed PARAMS.
When CALLBACK is present, this will run async."
(if jiralib-use-restapi
(jiralib-call "progressWorkflowAction"
callback issue-key `((transition (id . ,action-id)))
`((fields . ,params)))
(jiralib-call "progressWorkflowAction"
callback issue-key action-id (jiralib-make-remote-field-values params))))
(defun jiralib-format-datetime (&optional datetime)
"Convert a mixed DATETIME format into the Jira required datetime format.
This will produce a datetime string such as:
2010-02-05T14:30:00.000+0000
for being consumed in the Jira API.
If DATETIME is not passed in, it will default to the current time."
(let* ((defaults (format-time-string "%Y-%m-%d %H:%M:%S" (current-time)))
(datetime (concat datetime (subseq defaults (length datetime))))
(parts (parse-time-string datetime)))
(format "%04d-%02d-%02dT%02d:%02d:%02d.000+0000"
(nth 5 parts)
(nth 4 parts)
(nth 3 parts)
(nth 2 parts)
(nth 1 parts)
(nth 0 parts))))
(defvar jiralib-worklog-coming-soon-message
"WORKLOG FEATURES ARE NOT IMPLEMENTED YET, COMING SOON!")
(defun jiralib-add-worklog-and-autoadjust-remaining-estimate (issue-key start-date time-spent comment)
"Log time spent on ISSUE-KEY to its worklog.
The time worked begins at START-DATE and has a TIME-SPENT
duration. JIRA will automatically update the remaining estimate
by subtracting TIME-SPENT from it.
START-DATE should be in the format 2010-02-05T14:30:00Z
TIME-SPENT can be in one of the following formats: 10m, 120m
hours; 10h, 120h days; 10d, 120d weeks.
COMMENT will be added to this worklog."
(let ((formatted-start-date (jiralib-format-datetime start-date)))
(jiralib-call "addWorklogAndAutoAdjustRemainingEstimate"
nil
issue-key
;; Expects data such as: '{"timeSpent":"1h", "started":"2017-02-21T00:00:00.000+0000", "comment":"woot!"}'
;; and only that format will work (no loose formatting on the started date)
`((started . ,formatted-start-date)
(timeSpent . ,time-spent)
(comment . ,comment)))))
;;;; Issue field accessors
(defun jiralib-issue-key (issue)
"Return the key of ISSUE."
(cdr (assoc 'key issue)))
(defun jiralib-issue-owner (issue)
"Return the owner of ISSUE."
(cdr (assq 'assignee issue)))
(defun jiralib-issue-status (issue)
"Return the status of ISSUE as a status string (not as a number!)."
(let ((status-code (cdr (assq 'status issue))))
(cdr (assoc status-code (jiralib-get-statuses)))))
(defun jiralib-custom-field-value (custom-field issue)
"Return the value of CUSTOM-FIELD for ISSUE.
Return nil if the field is not found"
(catch 'found
(dolist (field (cdr (assq 'customFieldValues issue)))
(when (equal (cdr (assq 'customfieldId field)) custom-field)
(throw 'found (cadr (assq 'values field)))))))
(defvar jiralib-current-issue nil
"This holds the currently selected issue.")
(defvar jiralib-projects-list nil
"This holds a list of projects and their details.")
(defvar jiralib-types nil
"This holds a list of issues types.")
(defvar jiralib-priorities nil
"This holds a list of priorities.")
(defvar jiralib-user-fullnames nil
"This holds a list of user fullnames.")
(defun jiralib-get-project-name (key)
"Return the name of the JIRA project with id KEY."
(let ((projects jiralib-projects-list)
(name nil))
(dolist (project projects)
(if (equal (cdr (assoc 'key project)) key)
(setf name (cdr (assoc 'name project)))))
name))
(defun jiralib-get-type-name (id)
"Return the name of the issue type with ID."
(let ((types jiralib-types)
(name nil))
(dolist (type types)
(if (equal (cdr (assoc 'id type)) id)
(setf name (cdr (assoc 'name type)))))
name))
(defun jiralib-get-user-fullname (username)
"Return the full name (display name) of the user with USERNAME."
(if (assoc username jiralib-user-fullnames)
(cdr (assoc username jiralib-user-fullnames))
(progn
(let ((user (jiralib-get-user username)))
(setf jiralib-user-fullnames (append jiralib-user-fullnames (list (cons username (cdr (assoc 'fullname user))))))
(cdr (assoc 'fullname user))))))
(defun jiralib-get-filter (filter-id)
"Return a filter given its FILTER-ID."
(cl-flet ((id-match (filter)
(equal filter-id (cdr (assoc 'id filter)))))
(cl-find-if 'id-match (jiralib-get-saved-filters))))
(defun jiralib-get-filter-alist ()
"Return an association list mapping filter names to IDs."
(mapcar (lambda (filter)
(cons (cdr (assoc 'name filter))
(cdr (assoc 'id filter))))
(jiralib-get-saved-filters)))
(defun jiralib-add-comment (issue-key comment &optional callback)
"Add to issue with ISSUE-KEY the given COMMENT, invoke CALLBACK."
(jiralib-call "addComment" callback issue-key `((body . ,comment))))
(defun jiralib-edit-comment (issue-id comment-id comment &optional callback)
"Edit ISSUE-ID's comment COMMENT-ID to reflect the new COMMENT, invoke CALLBACK."
(if (not jiralib-use-restapi)
(jiralib-call "editComment" callback `((id . ,comment-id)
(body . ,comment)))
(jiralib-call "editComment" callback issue-id comment-id comment)))
(defun jiralib-create-issue (issue)
"Create a new ISSUE in JIRALIB.
ISSUE is a Hashtable object."
(jiralib-call "createIssue" nil issue))
(defun jiralib-create-subtask (subtask parent-issue-id)
"Create SUBTASK for issue with PARENT-ISSUE-ID.
SUBTASK is a Hashtable object."
(jiralib-call "createIssueWithParent" nil subtask parent-issue-id))
(defvar jiralib-subtask-types-cache nil)
(defun jiralib-get-subtask-types ()
"Return an assoc list mapping an issue type code to its name.
NOTE: Issue type codes are stored as strings, not numbers.
This function will only ask JIRA for the list of codes once, than
will cache it."
(unless jiralib-subtask-types-cache
(setq jiralib-subtask-types-cache
(jiralib-make-assoc-list (jiralib-call "getSubTaskIssueTypes" nil) 'id 'name)))
jiralib-subtask-types-cache)
(defun jiralib-get-comment (issue-key comment-id &optional callback)
"Return all comments associated with issue ISSUE-KEY, invoking CALLBACK."
(jiralib-call "getComment" callback issue-key comment-id))
(defun jiralib-get-comments (issue-key &optional callback)
"Return all comments associated with issue ISSUE-KEY, invoking CALLBACK."
(jiralib-call "getComments" callback issue-key))
(defun jiralib-get-attachments (issue-key &optional callback)
"Return all attachments associated with issue ISSUE-KEY, invoking CALLBACK."
(jiralib-call "getAttachmentsFromIssue" callback issue-key))
(defun jiralib-get-worklogs (issue-key &optional callback)
"Return all worklogs associated with issue ISSUE-KEY, invoking CALLBACK."
(jiralib-call "getWorklogs" callback issue-key))
(defun jiralib-add-worklog (issue-id started time-spent-seconds comment &optional callback)
"Add the worklog linked to ISSUE-ID.
Requires STARTED (a jira datetime), TIME-SPENT-SECONDS (integer) and a COMMENT.
CALLBACK will be invoked if passed in upon endpoint completion."
;; Call will fail if 0 seconds are set as the time, so always do at least one min.
(setq time-spent-seconds (max 60 time-spent-seconds))
(let ((worklog `((started . ,started)
;; @todo :worklog: timeSpentSeconds changes into incorrect values
;; in the Jira API (for instance, 89600 = 1 day, but Jira thinks 3 days...
;; We should convert to a Xd Xh Xm format from our seconds ourselves.
(timeSpentSeconds . ,time-spent-seconds)
(comment . ,comment))))
(jiralib-call "addWorklog" callback issue-id worklog)))
(defun jiralib-update-worklog (issue-id worklog-id started time-spent-seconds comment &optional callback)
"Update the worklog linked to ISSUE-ID and WORKLOG-ID.
Requires STARTED (a jira datetime), TIME-SPENT-SECONDS (integer) and a COMMENT.
CALLBACK will be invoked if passed in upon endpoint completion."
;; Call will fail if 0 seconds are set as the time, so always do at least one min.
(setq time-spent-seconds (max 60 time-spent-seconds))
(let ((worklog `((started . ,started)
;; @todo :worklog: timeSpentSeconds changes into incorrect values
;; in the Jira API (for instance, 89600 = 1 day, but Jira thinks 3 days...
;; We should convert to a Xd Xh Xm format from our seconds ourselves.
(timeSpentSeconds . ,time-spent-seconds)
(comment . ,comment))))
(jiralib-call "updateWorklog" callback issue-id worklog-id worklog)))
(defvar jiralib-components-cache nil "An alist of project components.")
(defun jiralib-get-components (project-key)
"Return all components available in the project PROJECT-KEY."
(unless (assoc project-key jiralib-components-cache)
(push (cons project-key
(jiralib-make-assoc-list
(jiralib-call "getComponents" nil project-key) 'id 'name))
jiralib-components-cache))
(cdr (assoc project-key jiralib-components-cache)))
(defun jiralib-get-issue (issue-key &optional callback)
"Get the issue with key ISSUE-KEY, running CALLBACK after."
(jiralib-call "getIssue" callback issue-key))
(defun jiralib-get-issues-from-filter (filter-id)
"Get the issues from applying saved filter FILTER-ID."
(message "jiralib-get-issues-from-filter is NOT IMPLEMENTED!! Do not use!")
(jiralib-call "getIssuesFromFilter" nil filter-id))
(defun jiralib-get-issues-from-text-search (search-terms)
"Find issues using free text search SEARCH-TERMS."
(jiralib-call "getIssuesFromTextSearch" nil search-terms))
(defun jiralib-get-issues-from-text-search-with-project
(project-keys search-terms max-num-results)
"Find issues in projects PROJECT-KEYS, using free text search SEARCH-TERMS.
Return no more than MAX-NUM-RESULTS."
(jiralib-call "getIssuesFromTextSearchWithProject"
nil
(apply 'vector project-keys) search-terms max-num-results))
;; Modified by Brian Zwahr to use getProjectsNoSchemes instead of getProjects
(defun jiralib-get-projects ()
"Return a list of projects available to the user."
(if jiralib-projects-list
jiralib-projects-list
(setq jiralib-projects-list
(if jiralib-use-restapi
(jiralib-call "getProjects" nil)
(jiralib-call "getProjectsNoSchemes" nil)))))
(defun jiralib-get-saved-filters ()
"Get all saved filters available for the currently logged in user."
(jiralib-make-assoc-list (jiralib-call "getSavedFilters" nil) 'id 'name))
(defun jiralib-get-server-info ()
"Return the Server information such as baseUrl, version, edition, buildDate, buildNumber."
(jiralib-call "getServerInfo" nil))
(defun jiralib-get-sub-task-issue-types ()
"Return all visible subtask issue types in the system."
(jiralib-call "getSubTaskIssueTypes" nil))
(defun jiralib-get-user (username)
"Return a user's information given their USERNAME."
(cond ((eq 0 (length username)) nil) ;; Unassigned
(t (jiralib-call "getUser" nil username))))
(defvar jiralib-users-cache nil "Cached list of users.")
(defun jiralib-get-users (project-key)
"Return assignable users information given the PROJECT-KEY."
(unless jiralib-users-cache
(setq jiralib-users-cache
(jiralib-call "getUsers" nil project-key)))
jiralib-users-cache)
(defun jiralib-get-versions (project-key)
"Return all versions available in project PROJECT-KEY."
(jiralib-call "getVersions" nil project-key))
(defun jiralib-strip-cr (string)
"Remove carriage returns from STRING."
(when string (replace-regexp-in-string "\r" "" string)))
(defun jiralib-worklog-import--filter-apply
(worklog-obj &optional predicate-fn-lst unwrap-worklog-records-fn rewrap-worklog-records-fn)
"Remove non-matching org-jira issue worklogs.
Variables:
WORKLOG-OBJ is the passed in object
PREDICATE-FN-LST is the list of lambdas used as match predicates.
UNWRAP-WORKLOG-RECORDS-FN is the function used to produce the list of worklog records from within the worklog-obj
REWRAP-WORKLOG-RECORDS-FN is the function used to reshape the worklog records back into the form they were received in.
Auxiliary Notes:
Only the WORKLOG-OBJ variable is required.
The value of PPREDICATE-FN-LST is filled from the jiralib-worklog-import--filters-alist variable by default.
If PREDICATE-FN-LST is empty the unmodified value of WORKLOG-OBJ is returned.
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.
The variable 'jiralib-user-login-name is used by many lambda filters."
(let
((unwrap-worklog-records-fn)
(rewrap-worklog-records-fn)
(predicate-fn-lst)
(worklogs worklog-obj)
(predicate-fn))
;; let-body
(progn
(setq unwrap-worklog-records-fn
(if (and
(boundp 'unwrap-worklog-records-fn)
(functionp unwrap-worklog-records-fn))
unwrap-worklog-records-fn
(lambda (x) (coerce x 'list))))
(setq rewrap-worklog-records-fn
(if (and
(boundp 'rewrap-worklog-records-fn)
(functionp rewrap-worklog-records-fn))
rewrap-worklog-records-fn
(lambda (x) (remove 'nil (coerce x 'vector)))))
(setq predicate-fn-lst
(if (and (boundp 'predicate-fn-lst)
(not (null predicate-fn-lst))
(listp predicate-fn-lst))
predicate-fn-lst
(mapcar 'caddr
(remove 'nil
(mapcar (lambda (x) (unless (null (car x)) x))
jiralib-worklog-import--filters-alist)))))
;; final condition/sanity checks before processing
(cond
;; pass cases, don't apply filters, return unaltered worklog-obj
((or (not (boundp 'predicate-fn-lst)) (not (listp predicate-fn-lst)) (null predicate-fn-lst))
worklog-obj)
;; default-case, apply worklog filters and return only matching worklogs
(t
(setq worklogs (funcall unwrap-worklog-records-fn worklogs))
(while (setq predicate-fn (pop predicate-fn-lst))
(setq worklogs (mapcar predicate-fn worklogs)))
(funcall rewrap-worklog-records-fn worklogs))))))
(defun jiralib-get-board (id &optional callback)
"Return details on given board"
(jiralib-call "getBoard" nil id))
(defun jiralib-get-boards ()
"Return list of jira boards"
(jiralib-call "getBoards" nil))
(defun jiralib-get-board-issues (board-id &rest params)
"Return list of jira issues in the specified jira board"
(apply 'jiralib-call "getIssuesFromBoard"
(cl-getf params :callback) board-id params))
(defun jiralib--agile-not-last-entry (num-entries total start-at limit)
"Return true if need to retrieve next page from agile api"
(and (> num-entries 0)
(or (not limit) ; not required to be set
(< limit 1) ; ignore invalid limit
(> limit start-at))
(or (not total) ; not always returned
(> total start-at))))
(defun jiralib--agile-limit-page-size (page-size start-at limit)
(if (and limit
(> (+ start-at page-size) limit))
(- limit start-at)
page-size))
(defun jiralib--agile-rest-call-it (api max-results start-at limit query-params)
(let ((callurl
(format "%s?%s" api
(url-build-query-string
(append `((maxResults ,(jiralib--agile-limit-page-size max-results start-at limit))
(startAt ,start-at))
query-params)))))
(jiralib--rest-call-it callurl)))
(defun jiralib--agile-call-it (api values-key &rest params)
"Invoke Jira agile method api and retrieve the results using
paging.
If JIRALIB-COMPLETE-CALLBACK is non-nil, then the call will be
performed asynchronously and JIRALIB-COMPLETE-CALLBACK will be
called when all data are retrieved.
If JIRALIB-COMPLETE-CALLBACK is nil, then the call will be
performed syncronously and this function will return the
retrieved data.
API - path to called API that must start with /rest/agile/1.0.
VALUES-KEY - key of the actual reply data in the reply assoc list.
PARAMS - optional additional parameters.
:limit - limit total number of retrieved entries.
:query-params - extra query parameters in the format of url-build-query-string.
"
(if jiralib-complete-callback
(apply 'jiralib--agile-call-async api values-key params)
(apply 'jiralib--agile-call-sync api values-key params)))
(defun jiralib--agile-call-sync (api values-key &rest params)
"Syncroniously invoke Jira agile method api retrieve all the
results using paging and return results.
VALUES-KEY - key of the actual reply data in the reply assoc list.
PARAMS - extra parameters (as keyword arguments), the supported parameters are:
:limit - limit total number of retrieved entries.
:query-params - extra query parameters in the format of url-build-query-string.
"
(setq jiralib-complete-callback nil)
(let ((not-last t)
(start-at 0)
(limit (getf params :limit))
(query-params (getf params :query-params))
;; maximum page size, 50 is server side maximum
(max-results jiralib-agile-page-size)
(values ()))
(while not-last
(let* ((reply-alist
(jiralib--agile-rest-call-it api max-results start-at limit query-params))
(values-array (cdr (assoc values-key reply-alist)))
(num-entries (length values-array))
(total (cdr (assq 'total reply-alist))))
(setf values (append values (append values-array nil)))
(setf start-at (+ start-at num-entries))
(setf not-last (jiralib--agile-not-last-entry num-entries total start-at limit))))
values))
(defun jiralib--agile-call-async (api values-key &rest params)
"Asyncroniously invoke Jira agile method api,
retrieve all the results using paging and call
JIRALIB-COMPLETE_CALLBACK when all the data are retrieved.
VALUES-KEY - key of the actual reply data in the reply assoc list.
PARAMS - extra parameters (as keyword arguments), the supported parameters are:
limit - limit total number of retrieved entries."
(lexical-let
((start-at 0)
(limit (getf params :limit))
(query-params (getf params :query-params))
;; maximum page size, 50 is server side maximum
(max-results jiralib-agile-page-size)
(values-list ())
(vk values-key)
(url api)
;; save the call back to be called later after the last page
(complete-callback jiralib-complete-callback))
;; setup new callback to be called after each page
(setf jiralib-complete-callback
(cl-function
(lambda (&rest data &allow-other-keys)
(condition-case err
(let* ((reply-alist (cl-getf data :data))
(values-array (cdr (assoc vk reply-alist)))
(num-entries (length values-array))
(total (cdr (assq 'total reply-alist))))
(setf values-list (append values-list (append values-array nil)))
(setf start-at (+ start-at num-entries))
(message "jiralib agile retrieve: got %d values%s%s"
start-at
(if total " of " "")
(if total (int-to-string total) ""))
(if (jiralib--agile-not-last-entry num-entries total start-at limit)
(jiralib--agile-rest-call-it url max-results start-at limit query-params)
;; last page: call originall callback
(message "jiralib agile retrieve: calling callback")
(setf jiralib-complete-callback complete-callback)
(funcall jiralib-complete-callback
:data (list (cons vk values-list)))
(message "jiralib agile retrieve: all done")))
('error (message (format "jiralib agile retrieve: caught error: %s" err)))))))
(jiralib--agile-rest-call-it api max-results start-at limit query-params)))
(provide 'jiralib)
;;; jiralib.el ends here
================================================
FILE: org-jira-sdk.el
================================================
;;; org-jira-sdk.el -- SDK Layer for entities
;; Copyright (C) 2018 Matthew Carter <m@ahungry.com>
;;
;; Authors:
;; Matthew Carter <m@ahungry.com>
;;
;; Maintainer: Matthew Carter <m@ahungry.com>
;; URL: https://github.com/ahungry/org-jira
;; Version: 3.1.1
;; Keywords: ahungry jira org bug tracker
;; Package-Requires: ((emacs "24.5") (cl-lib "0.5") (request "0.2.0") (s "0.0.0"))
;; This file is not part of GNU Emacs.
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see
;; <http://www.gnu.org/licenses/> or write to the Free Software
;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
;; 02110-1301, USA.
;;; Commentary:
;; This provides an SDK wrapper for more strictly defining the entities we interact with.
;;; Code:
(require 'jiralib)
(require 'cl-lib)
(require 's)
(require 'eieio)
(require 'dash)
(require 'cl-generic)
(defclass org-jira-sdk-record ()
((id :initarg :id :type string :required t)
(data :initarg :data :documentation "The area to hold a big alist of data.")
(hydrate-fn :initform (lambda (id) (message "Not implemented."))))
"The ID of the record.")
(defun org-jira-sdk-string-but-first (s) (cl-subseq s 1))
(defun org-jira-sdk-to-string (s) (format "%s" s))
(defun org-jira-sdk-to-prefixed-string (s) (format "org-jira-sdk-%s" s))
(defun org-jira-sdk-record-type-to-symbol (record-type)
(-> record-type symbol-name org-jira-sdk-string-but-first org-jira-sdk-to-prefixed-string intern))
(defun org-jira-sdk-create-from-id (record-type id &optional parent-id callback)
(let ((rec (funcall (org-jira-sdk-record-type-to-symbol record-type)
:id (format "%s" id)
:parent-id parent-id)))
(with-slots (data) rec
(setf data (org-jira-sdk-hydrate rec callback))
(org-jira-sdk-from-data rec))))
(defun org-jira-sdk-create-from-data (record-type data)
(let ((rec (funcall (org-jira-sdk-record-type-to-symbol record-type) :data data)))
(org-jira-sdk-from-data rec)))
(cl-defmethod org-jira-sdk-hydrate ((rec org-jira-sdk-record) &optional callback)
"Populate the record with data from the remote endpoint."
(with-slots (id hydrate-fn) rec
(funcall hydrate-fn id callback)))
(cl-defgeneric org-jira-sdk-from-data ((rec org-jira-sdk-record)))
(cl-defmethod org-jira-sdk-dump ((rec org-jira-sdk-record))
"A decent pretty print/object dump for working with the class items."
(let ((slots (mapcar (lambda (slot) (aref slot 1)) (eieio-class-slots (eieio-object-class rec)))))
(setq slots (cl-remove-if (lambda (s) (not (slot-boundp rec s))) slots))
(apply #'concat
(mapcar (lambda (slot)
(let ((slot (intern (org-jira-sdk-to-string slot))))
(format "\n%+16s: %s" slot (slot-value rec (intern (org-jira-sdk-to-string slot)))))
)
slots))))
(defun org-jira-sdk-path (alist key-chain)
"Query a nested path in some type of ALIST by traversing down the keys of KEY-CHAIN."
(cl-reduce (lambda (a k) (alist-get k a)) key-chain :initial-value alist))
(defclass org-jira-sdk-issue (org-jira-sdk-record)
((assignee :type (or null string) :initarg :assignee)
(components :type string :initarg :components)
(created :type string :initarg :created)
(description :type (or null string) :initarg :description)
(duedate :type (or null string) :initarg :duedate)
(headline :type string :initarg :headline)
(id :type string :initarg :id) ; TODO: Probably remove me
(issue-id :type string :initarg :issue-id :documentation "The common ID/key, such as EX-1.")
(issue-id-int :type string :initarg :issue-id-int :documentation "The internal Jira ID, such as 12345.")
(priority :type string :initarg :priority)
(proj-key :type string :initarg :proj-key)
(reporter :type (or null string) :initarg :reporter)
(resolution :type (or null string) :initarg :resolution)
(start-date :type (or null string) :initarg :start-date)
(status :type string :initarg :status)
(summary :type string :initarg :summary)
(type :type string :initarg :type)
(updated :type string :initarg :updated)
(data :initarg :data :documentation "The remote Jira data object (alist).")
(hydrate-fn :initform #'jiralib-get-issue :initarg :hydrate-fn))
"An issue on the end. ID of the form EX-1, or a numeric such as 10000.")
(defclass org-jira-sdk-comment (org-jira-sdk-record)
((author :type string :initarg :author)
(body :type string :initarg :body)
(comment-id :type string :initarg :comment-id :documentation "The comment ID, such as 12345.")
(created :type string :initarg :created)
(headline :type string :initarg :headline)
(parent-id :type string :initarg :parent-id :documentation "The parent issue-id such as EX-1.")
(updated :type string :initarg :updated)
(data :initarg :data :documentation "The reomte Jira data object (alist).")
(hydrate-fn :initform #'jiralib-get-comment :initarg :hydrate-fn)))
(defclass org-jira-sdk-board (org-jira-sdk-record)
((name :type string :initarg :name :required t)
(url :type string :initarg :url :required t)
(board-type :type string :initarg :board-type)
(jql :type string :initarg :jql)
(limit :type integer :initarg :limit)
;; unused
(parent-id :type string :initarg :parent-id)
(hydrate-fn :initform #'jiralib-get-board :initarg :hydrate-fn)))
(cl-defmethod org-jira-sdk-hydrate ((rec org-jira-sdk-comment) &optional callback)
"Populate the record with data from the remote endpoint."
(with-slots (id proj-key hydrate-fn) rec
(funcall hydrate-fn proj-key id callback)))
(cl-defmethod org-jira-sdk-from-data ((rec org-jira-sdk-issue))
(cl-flet ((path (keys) (org-jira-sdk-path (oref rec data) keys)))
(org-jira-sdk-issue
:assignee (path '(fields assignee name))
:components (mapconcat (lambda (c) (org-jira-sdk-path c '(name))) (path '(fields components)) ", ")
:created (path '(fields created)) ; confirm
:description (or (path '(fields description)) "")
:duedate (path '(fields duedate)) ; confirm
:headline (path '(fields summary)) ; Duplicate of summary, maybe different.
:id (path '(key))
:issue-id (path '(key))
:issue-id-int (path '(id))
:priority (path '(fields priority name))
:proj-key (path '(fields project key))
:reporter (path '(fields reporter name)) ; reporter could be an object of its own slot values
:resolution (path '(fields resolution name)) ; confirm
:start-date (path '(fields start-date)) ; confirm
:status (org-jira-decode (path '(fields status name)))
:summary (path '(fields summary))
:type (path '(fields issuetype name))
:updated (path '(fields updated)) ; confirm
;; TODO: Remove this
;; :data (oref rec data)
)))
(cl-defmethod org-jira-sdk-from-data ((rec org-jira-sdk-comment))
(cl-flet ((path (keys) (org-jira-sdk-path (oref rec data) keys)))
(org-jira-sdk-comment
:author (path '(author displayName))
:body (path '(body))
:comment-id (path '(id))
:created (path '(created))
:headline (format "Comment: %s" (path '(author displayName)))
:parent-id (if (slot-boundp rec 'parent-id) (oref rec parent-id) "")
:updated (path '(updated))
;; TODO: Remove this
;; :data (oref rec data)
)))
(cl-defmethod org-jira-sdk-from-data ((rec org-jira-sdk-board))
(with-slots (data) rec
(org-jira-sdk-board
:id (int-to-string (alist-get 'id data))
:name (alist-get 'name data)
:url (alist-get 'self data)
;; TODO: remove it? used by org-jira-sdk-create-from-id
:parent-id ""
:board-type (alist-get 'type data))))
;; Issue
(defun org-jira-sdk-create-issue-from-data (d) (org-jira-sdk-create-from-data :issue d))
(defun org-jira-sdk-create-issues-from-data-list (ds) (mapcar #'org-jira-sdk-create-issue-from-data ds))
;; Comment
(defun org-jira-sdk-create-comment-from-data (d) (org-jira-sdk-create-from-data :comment d))
(defun org-jira-sdk-create-comments-from-data-list (ds) (mapcar #'org-jira-sdk-create-comment-from-data ds))
(defun org-jira-sdk-isa-record? (i) (typep i 'org-jira-sdk-record))
(defun org-jira-sdk-isa-issue? (i) (typep i 'org-jira-sdk-issue))
(defun org-jira-sdk-isa-comment? (i) (typep i 'org-jira-sdk-comment))
;; Board
(defun org-jira-sdk-create-board-from-data (d) (org-jira-sdk-create-from-data :board d))
(defun org-jira-sdk-create-boards-from-data-list (ds) (mapcar #'org-jira-sdk-create-board-from-data ds))
(provide 'org-jira-sdk)
;;; org-jira-sdk.el ends here
================================================
FILE: org-jira.el
================================================
;;; org-jira.el --- Syncing between Jira and Org-mode. -*- lexical-binding: t -*-
;; Copyright (C) 2016-2018 Matthew Carter <m@ahungry.com>
;; Copyright (C) 2011 Bao Haojun
;;
;; Authors:
;; Matthew Carter <m@ahungry.com>
;; Bao Haojun <baohaojun@gmail.com>
;;
;; Maintainer: Matthew Carter <m@ahungry.com>
;; URL: https://github.com/ahungry/org-jira
;; Version: 4.0.0
;; Keywords: ahungry jira org bug tracker
;; Package-Requires: ((emacs "24.5") (cl-lib "0.5") (request "0.2.0") (s "0.0.0") (dash "2.14.1"))
;; This file is not part of GNU Emacs.
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see
;; <http://www.gnu.org/licenses/> or write to the Free Software
;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
;; 02110-1301, USA.
;;; Commentary:
;; This provides an extension to org-mode for syncing issues with JIRA
;; issue servers.
;;; News:
;;;; Changes in 4.0.0:
;; - Introduce SDK type for handling records vs random alist structures.
;;;; Changes since 3.1.0:
;; - Fix how we were ruining the kill-ring with kill calls.
;;;; Changes since 3.0.0:
;; - Add new org-jira-add-comment call (C-c c c)
;;;; Changes since 2.8.0:
;; - New version 3.0.0 deprecates old filing mechanism and files
;; all of the changes under the top level ticket header.
;; - If you want other top level headers in the same file, this should
;; work now, as long as they come after the main project one.
;;;; Changes since 2.7.0:
;; - Clean up multi-buffer handling, disable attachments call until
;; - refresh is compatible with it.
;;;; Changes since 2.6.3:
;; - Insert worklog import filter in the existing org-jira-update-worklogs-for-current-issue function
;; - Sync up org-clocks and worklogs! Set org-jira-worklog-sync-p to nil to avoid.
;;;; Changes since 2.6.1:
;; - Fix bug with getting all issues when worklog is an error trigger.
;;;; Changes since 2.5.4:
;; - Added new org-jira-refresh-issues-in-buffer call and binding
;;;; Changes since 2.5.3:
;; - Re-introduce the commit that introduced a break into Emacs 25.1.1 list/array push
;; The commit caused updates/comment updates to fail when a blank list of components
;; was present - it will now handle both cases (full list, empty list).
;;;; Changes since 2.5.2:
;; - Revert a commit that introduced a break into Emacs 25.1.1 list/array push
;; The commit caused updates/comment updates to fail
;;;; Changes since 2.5.1:
;; - Only set duedate if a DEADLINE is present in the tags and predicate is t
;;;; Changes since 2.5.0:
;; - Allow overriding the org property names with new defcustom
;;;; Changes since 2.4.0:
;; - Fix many deprecation/warning issues
;; - Fix error with allow-other-keys not being wrapped in cl-function
;;;; Changes since 2.3.0:
;; - Integration with org deadline and Jira due date fields
;;;; Changes since 2.2.0:
;; - Selecting issue type based on project key for creating issues
;;;; Changes since 2.1.0:
;; - Allow changing to unassigned user
;; - Add new shortcut for quick assignment
;;;; Changes since 2.0.0:
;; - Change statusCategory to status value
;; - Clean out some redundant code
;; - Add ELPA tags in keywords
;;;; Changes since 1.0.1:
;; - Converted many calls to async
;; - Removed minor annoyances (position resets etc.)
;;; Code:
(require 'org)
(require 'org-clock)
(require 'cl-lib)
(require 'url)
(require 'ls-lisp)
(require 'dash)
(require 's)
(require 'jiralib)
(require 'org-jira-sdk)
(defconst org-jira-version "3.0.0"
"Current version of org-jira.el.")
(defgroup org-jira nil
"Customization group for org-jira."
:tag "Org JIRA"
:group 'org)
(defvar org-jira-working-dir "~/.org-jira"
"Folder under which to store org-jira working files.")
(defcustom org-jira-default-jql
"assignee = currentUser() and resolution = unresolved ORDER BY
priority DESC, created ASC"
"Default jql for querying your Jira tickets."
:group 'org-jira
:type 'string)
(defcustom org-jira-ignore-comment-user-list
'("admin")
"Jira usernames that should have comments ignored."
:group 'org-jira
:type '(repeat (string :tag "Jira username:")))
(defcustom org-jira-reverse-comment-order nil
"If non-nil, order comments from most recent to least recent."
:group 'org-jira
:type 'boolean)
(defcustom org-jira-done-states
'("Closed" "Resolved" "Done")
"Jira states that should be considered as DONE for `org-mode'."
:group 'org-jira
:type '(repeat (string :tag "Jira state name:")))
(defcustom org-jira-users
'(("Full Name" . "username"))
"A list of displayName and key pairs."
:group 'org-jira
:type 'list)
(defcustom org-jira-progress-issue-flow
'(("To Do" . "In Progress")
("In Progress" . "Done"))
"Quickly define a common issue flow."
:group 'org-jira
:type 'list)
(defcustom org-jira-property-overrides (list)
"An assoc list of property tag overrides.
The KEY . VAL pairs should both be strings.
For instance, to change the :assignee: property in the org :PROPERTIES:
block to :WorkedBy:, you can set this as such:
(setq org-jira-property-overrides (list (cons \"assignee\" \"WorkedBy\")))
or simply:
(add-to-list (quote org-jira-property-overrides)
(cons (\"assignee\" \"WorkedBy\")))
This will work for most any of the properties, with the
exception of ones with unique functionality, such as:
- deadline
- summary
- description"
:group 'org-jira
:type 'list)
(defcustom org-jira-serv-alist nil
"Association list to set information for each jira server.
Each element of the alist is a jira server name. The CAR of each
element is a string, uniquely identifying the server. The CDR of
each element is a well-formed property list with an even number
of elements, alternating keys and values, specifying parameters
for the server.
(:property value :property value ... )
When a property is given a value in org-jira-serv-alist, its
setting overrides the value of the corresponding user
variable (if any) during syncing.
Most properties are optional, but some should always be set:
:url soap url of the jira server.
:username username to be used.
:host hostname of the jira server (TODO: compute it from ~url~).
All the other properties are optional. They override the global
variables.
:password password to be used, will be prompted if missing."
:group 'org-jira
:type '(alist :value-type plist))
(defcustom org-jira-use-status-as-todo nil
"Use the JIRA status as the TODO tag value."
:group 'org-jira)
(defcustom org-jira-coding-system nil
"Use custom coding system on org-jira buffers."
:group 'org-jira)
(defcustom org-jira-deadline-duedate-sync-p t
"Keep org deadline and jira duedate fields synced.
You may wish to set this to nil if you track org deadlines in
your buffer that you do not want to send back to your Jira
instance."
:group 'org-jira
:type 'boolean)
(defcustom org-jira-worklog-sync-p t
"Keep org clocks and jira worklog fields synced.
You may wish to set this to nil if you track org clocks in
your buffer that you do not want to send back to your Jira
instance."
:group 'org-jira
:type 'boolean)
(defcustom org-jira-download-dir "~/Downloads"
"Name of the default jira download library."
:group 'org-jira
:type 'string)
(defcustom org-jira-download-ask-override t
"Ask before overriding tile."
:group 'org-jira
:type 'boolean)
(defcustom org-jira-jira-status-to-org-keyword-alist nil
"Custom alist of jira status stored in car and `org-mode' keyword stored in cdr."
:group 'org-jira
:type '(alist :key-type string :value-type string))
(defcustom org-jira-priority-to-org-priority-omit-default-priority nil
"Whether to omit insertion of priority when it matches the default.
When set to t, will omit the insertion of the matched value from
`org-jira-priority-to-org-priority-alist' when it matches the `org-default-priority'."
:group 'org-jira
:type 'boolean)
(defcustom org-jira-priority-to-org-priority-alist nil
"Alist mapping jira priority keywords to `org-mode' priority cookies.
A sample value might be
(list (cons \"High\" ?A)
(cons \"Medium\" ?B)
(cons \"Low\" ?C)).
See `org-default-priority' for more info."
:group 'org-jira
:type '(alist :key-type string :value-type character))
(defcustom org-jira-boards-default-limit 50
"Default limit for number of issues retrieved from agile boards."
:group 'org-jira
:type 'integer)
(defvar org-jira-serv nil
"Parameters of the currently selected blog.")
(defvar org-jira-serv-name nil
"Name of the blog, to pick from `org-jira-serv-alist'.")
(defvar org-jira-projects-list nil
"List of jira projects.")
(defvar org-jira-current-project nil
"Currently selected (i.e., active project).")
(defvar org-jira-issues-list nil
"List of jira issues under the current project.")
(defvar org-jira-server-rpc-url nil
"Jira server soap URL.")
(defvar org-jira-server-userid nil
"Jira server user id.")
(defvar org-jira-proj-id nil
"Jira project ID.")
(defvar org-jira-logged-in nil
"Flag whether user is logged-in or not.")
(defvar org-jira-buffer-name "*org-jira-%s*"
"Name of the jira buffer.")
(defvar org-jira-buffer-kill-prompt t
"Ask before killing buffer.")
(make-variable-buffer-local 'org-jira-buffer-kill-prompt)
(defvar org-jira-mode-hook nil
"Hook to run upon entry into mode.")
(defvar org-jira-issue-id-history '()
"Prompt history for issue id.")
(defvar org-jira-fixversion-id-history '()
"Prompt history for fixversion id.")
(defvar org-jira-verbosity 'debug)
(defun org-jira-log (s) (when (eq 'debug org-jira-verbosity) (message (format "%s" s))))
(defmacro ensure-on-issue (&rest body)
"Make sure we are on an issue heading, before executing BODY."
(declare (debug t)
(indent 0))
`(save-excursion
(save-restriction
(widen)
(unless (looking-at "^\\*\\* ")
(search-backward-regexp "^\\*\\* " nil t)) ; go to top heading
(let ((org-jira-id (org-jira-id)))
(unless (and org-jira-id (string-match (jiralib-get-issue-regexp) (downcase org-jira-id)))
(error "Not on an issue region!")))
,@body)))
(defmacro org-jira-with-callback (&rest body)
"Simpler way to write the data callbacks."
(declare (debug t)
(indent 0))
`(lambda (&rest request-response)
(declare (ignore cb-data))
(let ((cb-data (cl-getf request-response :data)))
,@body)))
(defmacro org-jira-freeze-ui (&rest body)
"Freeze the UI layout for the user as much as possible."
(declare (debug t)
(indent 0))
`(save-excursion
(save-restriction
(widen)
(org-save-outline-visibility t
(outline-show-all)
,@body))))
(defmacro ensure-on-issue-id (issue-id &rest body)
"Just do some work on ISSUE-ID, execute BODY."
(declare (debug t)
(indent 1))
`(let* ((proj-key (replace-regexp-in-string "-.*" "" issue-id))
(project-file (expand-file-name (concat proj-key ".org") org-jira-working-dir))
(project-buffer (or (find-buffer-visiting project-file)
(find-file project-file))))
(with-current-buffer project-buffer
(org-jira-freeze-ui
(let ((p (org-find-entry-with-id ,issue-id)))
(unless p (error "Issue %s not found!" ,issue-id))
(goto-char p)
(org-narrow-to-subtree)
,@body)))))
(defmacro ensure-on-todo (&rest body)
"Make sure we are on an todo heading, before executing BODY."
(declare (debug t)
(indent 0))
`(save-excursion
(save-restriction
(let ((continue t)
(on-todo nil))
(while continue
(when (org-get-todo-state)
(setq continue nil on-todo t))
(unless (and continue (org-up-heading-safe))
(setq continue nil)))
(if (not on-todo)
(error "TODO not found")
(org-narrow-to-subtree)
,@body)))))
(defmacro ensure-on-comment (&rest body)
"Make sure we are on a comment heading, before executing BODY."
(declare (debug t)
(indent 0))
`(save-excursion
(org-back-to-heading)
(forward-thing 'whitespace)
(unless (looking-at "Comment:")
(error "Not on a comment region!"))
(save-restriction
(org-narrow-to-subtree)
,@body)))
(defmacro ensure-on-worklog (&rest body)
"Make sure we are on a worklog heading, before executing BODY."
(declare (debug t)
(indent 0))
`(save-excursion
(org-back-to-heading)
(forward-thing 'whitespace)
(unless (looking-at "Worklog:")
(error "Not on a worklog region!"))
(save-restriction
(org-narrow-to-subtree)
,@body)))
(defvar org-jira-entry-mode-map
(let ((org-jira-map (make-sparse-keymap)))
(define-key org-jira-map (kbd "C-c pg") 'org-jira-get-projects)
(define-key org-jira-map (kbd "C-c bg") 'org-jira-get-boards)
(define-key org-jira-map (kbd "C-c iv") 'org-jira-get-issues-by-board)
(define-key org-jira-map (kbd "C-c ib") 'org-jira-browse-issue)
(define-key org-jira-map (kbd "C-c ig") 'org-jira-get-issues)
(define-key org-jira-map (kbd "C-c ih") 'org-jira-get-issues-headonly)
;;(define-key org-jira-map (kbd "C-c if") 'org-jira-get-issues-from-filter-headonly)
;;(define-key org-jira-map (kbd "C-c iF") 'org-jira-get-issues-from-filter)
(define-key org-jira-map (kbd "C-c iu") 'org-jira-update-issue)
(define-key org-jira-map (kbd "C-c iw") 'org-jira-progress-issue)
(define-key org-jira-map (kbd "C-c in") 'org-jira-progress-issue-next)
(define-key org-jira-map (kbd "C-c ia") 'org-jira-assign-issue)
(define-key org-jira-map (kbd "C-c ir") 'org-jira-refresh-issue)
(define-key org-jira-map (kbd "C-c iR") 'org-jira-refresh-issues-in-buffer)
(define-key org-jira-map (kbd "C-c ic") 'org-jira-create-issue)
(define-key org-jira-map (kbd "C-c ik") 'org-jira-copy-current-issue-key)
(define-key org-jira-map (kbd "C-c sc") 'org-jira-create-subtask)
(define-key org-jira-map (kbd "C-c sg") 'org-jira-get-subtasks)
(define-key org-jira-map (kbd "C-c cc") 'org-jira-add-comment)
(define-key org-jira-map (kbd "C-c cu") 'org-jira-update-comment)
(define-key org-jira-map (kbd "C-c wu") 'org-jira-update-worklogs-from-org-clocks)
(define-key org-jira-map (kbd "C-c tj") 'org-jira-todo-to-jira)
(define-key org-jira-map (kbd "C-c if") 'org-jira-get-issues-by-fixversion)
org-jira-map))
;;;###autoload
(define-minor-mode org-jira-mode
"Toggle org-jira mode.
With no argument, the mode is toggled on/off.
Non-nil argument turns mode on.
Nil argument turns mode off.
Commands:
\\{org-jira-entry-mode-map}
Entry to this mode calls the value of `org-jira-mode-hook'."
:init-value nil
:lighter " jira"
:group 'org-jira
:keymap org-jira-entry-mode-map
(if org-jira-mode
(run-mode-hooks 'org-jira-mode-hook)))
(defun org-jira-get-project-name (proj)
(org-jira-find-value proj 'key))
(defun org-jira-find-value (l &rest keys)
(let* (key exists)
(while (and keys (listp l))
(setq key (car keys))
(setq exists nil)
(mapc (lambda (item)
(when (equal key (car item))
(setq exists t)))
(if (and (listp l)
(listp (car l)))
l
nil))
(setq keys (cdr keys))
(if exists
(setq l (cdr (assoc key l)))
(setq l (or (cdr (assoc key l)) l))))
l))
(defun org-jira-get-project-lead (proj)
(org-jira-find-value proj 'lead 'name))
(defun org-jira-get-assignable-users (project-key)
"Get the list of assignable users for PROJECT-KEY, adding user set jira-users first."
(append
'(("Unassigned" . ""))
org-jira-users
(mapcar (lambda (user)
(cons (org-jira-decode (cdr (assoc 'displayName user)))
(org-jira-decode (cdr (assoc 'name user)))))
(jiralib-get-users project-key))))
(defun org-jira-entry-put (pom property value)
"Similar to org-jira-entry-put, but with an optional alist of overrides.
At point-or-marker POM, set PROPERTY to VALUE.
Look at customizing org-jira-property-overrides if you want
to change the property names this sets."
(unless (stringp property)
(setq property (symbol-name property)))
(let ((property (or (assoc-default property org-jira-property-overrides)
property)))
(org-entry-put pom property (org-jira-decode value))))
(defun org-jira-kill-line ()
"Kill the line, without 'kill-line' side-effects of altering kill ring."
(interactive)
(delete-region (point) (line-end-position)))
;; Appropriated from org.el
(defun org-jira-org-kill-line (&optional _arg)
"Kill line, to tags or end of line."
(cond
((or (not org-special-ctrl-k)
(bolp)
(not (org-at-heading-p)))
(when (and (get-char-property (min (point-max) (point-at-eol)) 'invisible)
org-ctrl-k-protect-subtree
(or (eq org-ctrl-k-protect-subtree 'error)
(not (y-or-n-p "Kill hidden subtree along with headline? "))))
(user-error "C-k aborted as it would kill a hidden subtree"))
(call-interactively
(if (bound-and-true-p visual-line-mode) 'kill-visual-line 'org-jira-kill-line)))
((looking-at ".*?\\S-\\([ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)[ \t]*$")
(delete-region (point) (match-beginning 1))
(org-set-tags nil t))
(t (delete-region (point) (point-at-eol)))))
;;;###autoload
(defun org-jira-get-projects ()
"Get list of projects."
(interactive)
(let ((projects-file (expand-file-name "projects-list.org" org-jira-working-dir)))
(or (find-buffer-visiting projects-file)
(find-file projects-file))
(org-jira-mode t)
(save-excursion
(let* ((oj-projs (jiralib-get-projects)))
(mapc (lambda (proj)
(let* ((proj-key (org-jira-find-value proj 'key))
(proj-headline (format "Project: [[file:%s.org][%s]]" proj-key proj-key)))
(save-restriction
(widen)
(goto-char (point-min))
(outline-show-all)
(setq p (org-find-exact-headline-in-buffer proj-headline))
(if (and p (>= p (point-min))
(<= p (point-max)))
(progn
(goto-char p)
(org-narrow-to-subtree)
(end-of-line))
(goto-char (point-max))
(unless (looking-at "^")
(insert "\n"))
(insert "* ")
(org-jira-insert proj-headline)
(org-narrow-to-subtree))
(org-jira-entry-put (point) "name" (org-jira-get-project-name proj))
(org-jira-entry-put (point) "key" (org-jira-find-value proj 'key))
(org-jira-entry-put (point) "lead" (org-jira-get-project-lead proj))
(org-jira-entry-put (point) "ID" (org-jira-find-value proj 'id))
(org-jira-entry-put (point) "url" (format "%s/browse/%s" (replace-regexp-in-string "/*$" "" jiralib-url) (org-jira-find-value proj 'key))))))
oj-projs)))))
(defun org-jira-get-issue-components (issue)
"Return the components the ISSUE belongs to."
(mapconcat
(lambda (comp)
(org-jira-find-value comp 'name))
(org-jira-find-value issue 'fields 'components) ", "))
(defun org-jira-decode (data)
"Decode text DATA.
It must receive a coercion to string, as not every time will it
be populated."
(let ((coding-system (or org-jira-coding-system
(when (boundp 'buffer-file-coding-system)
buffer-file-coding-system 'utf-8))))
(decode-coding-string
(string-make-unibyte (cl-coerce data 'string)) coding-system)))
(defun org-jira-insert (&rest args)
"Set coding to text provide by `ARGS' when insert in buffer."
(insert (org-jira-decode (apply #'concat args))))
(defun org-jira-transform-time-format (jira-time-str)
"Convert JIRA-TIME-STR to format \"%Y-%m-%d %T\".
Example: \"2012-01-09T08:59:15.000Z\" becomes \"2012-01-09
16:59:15\", with the current timezone being +0800."
(condition-case ()
(format-time-string
"%Y-%m-%d %T"
(apply
'encode-time
(parse-time-string (replace-regexp-in-string "T\\|\\.000" " " jira-time-str))))
(error jira-time-str)))
(defun org-jira--fix-encode-time-args (arg)
"Fix ARG for 3 nil values at the head."
(cl-loop
for n from 0 to 2 by 1 do
(when (not (nth n arg))
(setcar (nthcdr n arg) 0)))
arg)
(defun org-jira-time-format-to-jira (org-time-str)
"Convert ORG-TIME-STR back to jira time format."
(condition-case ()
(format-time-string
"%Y-%m-%dT%T.000Z"
(apply 'encode-time
(org-jira--fix-encode-time-args (parse-time-string org-time-str)))
t)
(error org-time-str)))
(defun org-jira-get-comment-val (key comment)
"Return the value associated with KEY of COMMENT."
(org-jira-get-issue-val key comment))
(defun org-jira-time-stamp-to-org-clock (time-stamp)
"Convert TIME-STAMP into org-clock format."
(format-time-string "%Y-%m-%d %a %H:%M" time-stamp))
(defun org-jira-date-strip-letter-t (date)
"Convert DATE into a time stamp and then into org-clock format.
Expects a date in format such as: 2017-02-26T00:08:00.000-0500 and
returns in format 2017-02-26 00:08:00-0500."
(replace-regexp-in-string
"\\.000\\([-+]\\)" "\\1"
(replace-regexp-in-string "^\\(.*?\\)T" "\\1 " date)))
(defun org-jira-date-to-org-clock (date)
"Convert DATE into a time stamp and then into org-clock format.
Expects a date in format such as: 2017-02-26T00:08:00.000-0500."
(org-jira-time-stamp-to-org-clock
(date-to-time
(org-jira-date-strip-letter-t date))))
(defun org-jira-worklogs-to-org-clocks (worklogs)
"Get a list of WORKLOGS and convert to org-clocks."
(mapcar
(lambda (worklog)
(let ((wl-start (cdr (assoc 'started worklog)))
(wl-time (cdr (assoc 'timeSpentSeconds worklog)))
(wl-end))
(setq wl-start (org-jira-date-to-org-clock wl-start))
(setq wl-end (org-jira-time-stamp-to-org-clock (time-add (date-to-time wl-start) wl-time)))
(list
wl-start
wl-end
(cdr (assoc 'comment worklog))
(cdr (assoc 'id worklog))
)
))
worklogs)
)
(defun org-jira-format-clock (clock-entry)
"Format a CLOCK-ENTRY given the (list start end).
This format is typically generated from org-jira-worklogs-to-org-clocks call."
(format "CLOCK: [%s]--[%s]" (car clock-entry) (cadr clock-entry)))
(defun org-jira-insert-clock (clock-entry)
"Insert a CLOCK-ENTRY given the (list start end).
This format is typically generated from org-jira-worklogs-to-org-clocks call."
(insert (org-jira-format-clock clock-entry))
(org-beginning-of-line)
(org-ctrl-c-ctrl-c) ;; @todo Maybe not call directly? does it matter? - used to resync the clock estimate
(org-end-of-line)
(insert "\n")
(insert (format " :id: %s\n" (cadddr clock-entry)))
(when (caddr clock-entry) (insert (format " %s\n" (org-jira-decode (caddr clock-entry))))) ;; No comment is nil, so don't print it
)
(defun org-jira-logbook-reset (issue-id &optional clocks)
"Find logbook for ISSUE-ID, delete it.
Re-create it with CLOCKS. This is used for worklogs."
(interactive)
(let ((existing-logbook-p nil))
;; See if the LOGBOOK already exists or not.
(ensure-on-issue-id issue-id
(let ((drawer-name (or (org-clock-drawer-name) "LOGBOOK")))
(when (search-forward (format ":%s:" drawer-name) nil 1 1)
(setq existing-logbook-p t))))
(ensure-on-issue-id issue-id
(let ((drawer-name (or (org-clock-drawer-name) "LOGBOOK")))
(if existing-logbook-p
(progn ;; If we had a logbook, drop it and re-create in a bit.
(search-forward (format ":%s:" drawer-name) nil 1 1)
(org-beginning-of-line)
(delete-region (point) (search-forward ":END:" nil 1 1))
)
(progn ;; Otherwise, create a new one at the end of properties list
(search-forward ":END:" nil 1 1)
(forward-line)))
(org-insert-drawer nil (format "%s" drawer-name)) ;; Doc says non-nil, but this requires nil
(mapc #'org-jira-insert-clock clocks)
;; Clean up leftover newlines (we left 2 behind)
(dotimes (n 2)
(search-forward-regexp "^$" nil 1 1)
(delete-region (point) (min (point-max) (1+ (point)))))))))
(defun org-jira-get-worklog-val (key WORKLOG)
"Return the value associated with KEY of WORKLOG."
(org-jira-get-comment-val key WORKLOG))
(defun org-jira-get-issue-val (key issue)
"Return the value associated with key KEY of issue ISSUE."
(let ((tmp (or (org-jira-find-value issue 'fields key 'key) ""))) ;; For project, we need a key, not the name...
(unless (stringp tmp)
(setq tmp (org-jira-find-value issue key)))
(unless (stringp tmp)
(setq tmp (org-jira-find-value issue 'fields key 'displayName)))
(unless (stringp tmp)
(setq tmp ""))
(cond ((eq key 'components)
(org-jira-get-issue-components issue))
((member key '(created updated startDate))
(org-jira-transform-time-format tmp))
((eq key 'status)
(if jiralib-use-restapi
(org-jira-find-value issue 'fields 'status 'name)
(org-jira-find-value (jiralib-get-statuses) tmp)))
((eq key 'resolution)
(if jiralib-use-restapi
tmp
(if (string= tmp "")
""
(org-jira-find-value (jiralib-get-resolutions) tmp))))
((eq key 'type)
(if jiralib-use-restapi
(org-jira-find-value issue 'fields 'issuetype 'name)
(org-jira-find-value (jiralib-get-issue-types) tmp)))
((eq key 'priority)
(if jiralib-use-restapi
(org-jira-find-value issue 'fields 'priority 'name)
(org-jira-find-value (jiralib-get-priorities) tmp)))
((eq key 'description)
(org-jira-strip-string tmp))
(t
tmp))))
(defvar org-jira-jql-history nil)
;;;###autoload
(defun org-jira-get-issue-list (&optional callback)
"Get list of issues, using jql (jira query language), invoke CALLBACK after.
Default is unresolved issues assigned to current login user; with
a prefix argument you are given the chance to enter your own
jql."
(org-jira-log (format "I was called, was it with a callback? %s" (if callback "yes" "no")))
(let ((jql org-jira-default-jql))
(when current-prefix-arg
(setq jql (read-string "Jql: "
(if org-jira-jql-history
(car org-jira-jql-history)
"assignee = currentUser() and resolution = unresolved")
'org-jira-jql-history
"assignee = currentUser() and resolution = unresolved")))
(list (jiralib-do-jql-search jql nil callback))))
(defun org-jira-get-issue-by-id (id)
"Get an issue by its ID."
(push id org-jira-issue-id-history)
(let ((jql (format "id = %s" id)))
(jiralib-do-jql-search jql)))
(defun org-jira-get-issue-by-fixversion (fixversion-id)
"Get an issue by its FIXVERSION-ID."
(push fixversion-id org-jira-fixversion-id-history)
(let ((jql (format "fixVersion = \"%s\"" fixversion-id)))
(jiralib-do-jql-search jql)))
;;;###autoload
(defun org-jira-get-summary ()
"Get issue summary from point and place next to issue id from jira"
(interactive)
(let ((jira-id (thing-at-point 'symbol)))
(forward-symbol 1)
(insert (format " - %s"
(cdr (assoc 'summary (car (org-jira-get-issue-by-id jira-id))))))))
;;;###autoload
(defun org-jira-get-summary-url ()
"Get issue summary from point and place next to issue id from jira, and make issue id a link"
(interactive)
(let ((jira-id (thing-at-point 'symbol)))
(insert (format "[[%s][%s]] - %s"
(concatenate 'string jiralib-url "browse/" jira-id) jira-id
(cdr (assoc 'summary (car (org-jira-get-issue-by-id jira-id))))))))
;;;###autoload
(defun org-jira-get-issues-headonly (issues)
"Get list of ISSUES, head only.
The default behavior is to return issues assigned to you and unresolved.
With a prefix argument, allow you to customize the jql. See
`org-jira-get-issue-list'."
(interactive
(org-jira-get-issue-list))
(let* ((issues-file (expand-file-name "issues-headonly.org" org-jira-working-dir))
(issues-headonly-buffer (or (find-buffer-visiting issues-file)
(find-file issues-file))))
(with-current-buffer issues-headonly-buffer
(widen)
(delete-region (point-min) (point-max))
(mapc (lambda (issue)
(let ((issue-id (org-jira-get-issue-key issue))
(issue-summary (org-jira-get-issue-summary issue)))
(org-jira-insert (format "- [jira:%s] %s\n" issue-id issue-summary))))
issues))
(switch-to-buffer issues-headonly-buffer)))
;;;###autoload
(defun org-jira-get-issue (id)
"Get a JIRA issue, allowing you to enter the issue-id first."
(interactive (list (read-string "Issue ID: " "" 'org-jira-issue-id-history)))
(org-jira-get-issues (org-jira-get-issue-by-id id))
(let ((issue-pos (org-find-entry-with-id id)))
(when issue-pos
(goto-char issue-pos)
(recenter 0))))
;;;###autoload
(defun org-jira-get-issues-by-fixversion (fixversion)
"Get list of issues by FIXVERSION."
(interactive (list (read-string "Fixversion ID: " ""
'org-jira-fixversion-id-history)))
(org-jira-get-issues (org-jira-get-issue-by-fixversion fixversion)))
;;;###autoload
(defun org-jira-get-issue-project (issue)
(org-jira-find-value issue 'fields 'project 'key))
(defun org-jira-get-issue-key (issue)
(org-jira-find-value issue 'key))
(defun org-jira-get-issue-summary (issue)
(org-jira-find-value issue 'fields 'summary))
(defvar org-jira-get-issue-list-callback
(cl-function
(lambda (&key data &allow-other-keys)
"Callback for async, DATA is the response from the request call.
Will send a list of org-jira-sdk-issue objects to the list printer."
(org-jira-log "Received data for org-jira-get-issue-list-callback.")
(--> data
(org-jira-sdk-path it '(issues))
(append it nil) ; convert the conses into a proper list.
org-jira-sdk-create-issues-from-data-list
org-jira-get-issues))))
;;;###autoload
(defun org-jira-get-issues (issues)
"Get list of ISSUES into an org buffer.
Default is get unfinished issues assigned to you, but you can
customize jql with a prefix argument.
See`org-jira-get-issue-list'"
;; If the user doesn't provide a default, async call to build an issue list
;; from the JQL style query
(interactive
(org-jira-get-issue-list org-jira-get-issue-list-callback))
(org-jira-log "Fetching issues...")
(when (> (length issues) 0)
(org-jira--render-issues-from-issue-list issues)))
(defun org-jira--get-project-buffer (Issue)
(with-slots (proj-key) Issue
(let* ((project-file (expand-file-name (concat proj-key ".org") org-jira-working-dir))
(project-buffer (find-file-noselect project-file)))
project-buffer)))
(defun org-jira--render-issue (Issue)
"Render single ISSUE."
(org-jira-log "Rendering issue from issue list")
(org-jira-sdk-dump Issue)
(with-slots (proj-key issue-id summary status priority headline id) Issue
(let (p)
(with-current-buffer (org-jira--get-project-buffer Issue)
(org-jira-freeze-ui
(org-jira-mode t)
(goto-char (point-min))
(unless (looking-at (format "^* %s-Tickets" proj-key))
(insert (format "* %s-Tickets\n" proj-key)))
(setq p (org-find-entry-with-id issue-id))
(save-restriction
(if (and p (>= p (point-min))
(<= p (point-max)))
(progn
(goto-char p)
(forward-thing 'whitespace)
(org-jira-kill-line))
(goto-char (point-max))
(unless (looking-at "^")
(insert "\n"))
(insert "** "))
(let ((status (org-jira-decode status)))
(org-jira-insert
(concat (org-jira-get-org-keyword-from-status status)
" "
(org-jira-get-org-priority-cookie-from-issue priority)
headline)))
(save-excursion
(unless (search-forward "\n" (point-max) 1)
(insert "\n")))
(org-narrow-to-subtree)
(save-excursion
(org-back-to-heading t)
(org-set-tags-to (replace-regexp-in-string "-" "_" issue-id)))
(mapc (lambda (entry)
(let ((val (slot-value Issue entry)))
(when (or (and val (not (string= val "")))
(eq entry 'assignee)) ;; Always show assignee
(org-jira-entry-put (point) (symbol-name entry) val))))
'(assignee reporter type priority resolution status components created updated))
(org-jira-entry-put (point) "ID" issue-id)
(org-jira-entry-put (point) "CUSTOM_ID" issue-id)
;; Insert the duedate as a deadline if it exists
(when org-jira-deadline-duedate-sync-p
(let ((duedate (oref Issue duedate)))
(when (> (length duedate) 0)
(org-deadline nil duedate))))
(mapc
(lambda (heading-entry)
(ensure-on-issue-id issue-id
(let* ((entry-heading
(concat (symbol-name heading-entry)
(format ": [[%s][%s]]"
(concat jiralib-url "/browse/" issue-id) issue-id))))
(setq p (org-find-exact-headline-in-buffer entry-heading))
(if (and p (>= p (point-min))
(<= p (point-max)))
(progn
(goto-char p)
(org-narrow-to-subtree)
(goto-char (point-min))
(forward-line 1)
(delete-region (point) (point-max)))
(if (org-goto-first-child)
(org-insert-heading)
(goto-char (point-max))
(org-insert-subheading t))
(org-jira-insert entry-heading "\n"))
;; Insert 2 spaces of indentation so Jira markup won't cause org-markup
(org-jira-insert
(replace-regexp-in-string
"^" " "
(format "%s" (slot-value Issue heading-entry)))))))
'(description))
(org-jira-update-comments-for-issue issue-id)
;; FIXME: Re-enable when attachments are not erroring.
;;(org-jira-update-attachments-for-current-issue)
;; only sync worklog clocks when the user sets it to be so.
(when org-jira-worklog-sync-p
(org-jira-update-worklogs-for-issue issue-id))))))))
(defun org-jira--render-issues-from-issue-list (Issues)
"Add the issues from ISSUES list into the org file(s).
ISSUES is a list of `org-jira-sdk-issue' records."
;; FIXME: Some type of loading error - the first async callback does not know about
;; the issues existing as a class, so we may need to instantiate here if we have none.
(when (eq 0 (->> Issues (cl-remove-if-not #'org-jira-sdk-isa-issue?) length))
(setq Issues (org-jira-sdk-create-issues-from-data-list Issues)))
;; First off, we never ever want to run on non-issues, so check our types early.
(setq Issues (cl-remove-if-not #'org-jira-sdk-isa-issue? Issues))
(org-jira-log (format "About to render %d issues." (length Issues)))
;; If we have any left, we map over them.
(mapc 'org-jira--render-issue Issues)
(switch-to-buffer (org-jira--get-project-buffer (-last-item Issues))))
;;;###autoload
(defun org-jira-update-comment ()
"Update a comment for the current issue."
(interactive)
(let* ((issue-id (org-jira-get-from-org 'issue 'key))
(comment-id (org-jira-get-from-org 'comment 'id))
(comment (replace-regexp-in-string "^ " "" (org-jira-get-comment-body comment-id)))
(callback-edit
(cl-function
(lambda (&key data &allow-other-keys)
(org-jira-update-comments-for-current-issue))))
(callback-add
(cl-function
(lambda (&key data &allow-other-keys)
;; @todo :optim: Has to be a better way to do this than delete region (like update the unmarked one)
(org-jira-delete-current-comment)
(org-jira-update-comments-for-current-issue)))))
(if comment-id
(jiralib-edit-comment issue-id comment-id comment callback-edit)
(jiralib-add-comment issue-id comment callback-add))))
(defun org-jira-add-comment (issue-id comment)
"For ISSUE-ID, add a new COMMENT string to the issue region."
(interactive
(let* ((issue-id (org-jira-id))
(comment (read-string (format "Comment (%s): " issue-id))))
(list issue-id comment)))
(lexical-let ((issue-id issue-id))
(ensure-on-issue-id issue-id
(goto-char (point-max))
(jiralib-add-comment
issue-id comment
(cl-function
(lambda (&key data &allow-other-keys)
(ensure-on-issue-id issue-id (org-jira-update-comments-for-current-issue))))))))
(defun org-jira-org-clock-to-date (org-time)
"Convert ORG-TIME formatted date into a plain date string."
(format-time-string
"%Y-%m-%dT%H:%M:%S.000%z"
(date-to-time org-time)))
(defun org-jira-worklog-time-from-org-time (org-time)
"Take in an ORG-TIME and convert it into the portions of a worklog time.
Expects input in format such as: [2017-04-05 Wed 01:00]--[2017-04-05 Wed 01:46] => 0:46"
(let ((start (replace-regexp-in-string "^\\[\\(.*?\\)\\].*" "\\1" org-time))
(end (replace-regexp-in-string ".*--\\[\\(.*?\\)\\].*" "\\1" org-time)))
`((started . ,(org-jira-org-clock-to-date start))
(time-spent-seconds . ,(time-to-seconds
(time-subtract
(date-to-time end)
(date-to-time start)))))))
(defun org-jira-org-clock-to-jira-worklog (org-time clock-content)
"Given ORG-TIME and CLOCK-CONTENT, format a jira worklog entry."
(let ((lines (split-string clock-content "\n"))
worklog-id)
;; See if we look like we have an id
(when (string-match ":id:" (first lines))
(setq worklog-id
(replace-regexp-in-string "^.*:id: \\([0-9]*\\)$" "\\1" (first lines)))
(when (> (string-to-number worklog-id) 0) ;; pop off the first id line if we found it valid
(setq lines (cdr lines))))
(setq lines (reverse (cdr (reverse lines)))) ;; drop last line
(let ((comment (org-trim (mapconcat 'identity lines "\n")))
(worklog-time (org-jira-worklog-time-from-org-time org-time)))
`((worklog-id . ,worklog-id)
(comment . ,comment)
(started . ,(cdr (assoc 'started worklog-time)))
(time-spent-seconds . ,(cdr (assoc 'time-spent-seconds worklog-time)))
))))
;;;###autoload
(defun org-jira-update-worklogs-from-org-clocks ()
"Update or add a worklog based on the org clocks."
(interactive)
(let ((issue-id (org-jira-get-from-org 'issue 'key)))
(ensure-on-issue-id issue-id
(search-forward (format ":%s:" (or (org-clock-drawer-name) "LOGBOOK")) nil 1 1)
(org-beginning-of-line)
;; (org-cycle 1)
(while (search-forward "CLOCK: " nil 1 1)
(let ((org-time (buffer-substring-no-properties (point) (point-at-eol))))
(forward-line)
;; See where the stuff ends (what point)
(let (next-clock-point)
(save-excursion
(search-forward-regexp "\\(CLOCK\\|:END\\):" nil 1 1)
(setq next-clock-point (point)))
(let ((clock-content
(buffer-substring-no-properties (point) next-clock-point)))
;; @todo :optim: This is inefficient, calling the resync on each update/insert event,
;; ideally we would track and only insert/update changed entries, as well
;; only call a resync once (when the entire list is processed, which will
;; basically require a dry run to see how many items we should be updating.
;; Update via jiralib call
(let* ((worklog (org-jira-org-clock-to-jira-worklog org-time clock-content))
(comment-text (cdr (assoc 'comment worklog)))
(comment-text (if (string= (org-trim comment-text) "") nil comment-text)))
(if (cdr (assoc 'worklog-id worklog))
(jiralib-update-worklog
issue-id
(cdr (assoc 'worklog-id worklog))
(cdr (assoc 'started worklog))
(cdr (assoc 'time-spent-seconds worklog))
comment-text
(cl-function
(lambda (&key data &allow-other-keys)
(org-jira-update-worklogs-for-issue issue-id))))
;; else
(jiralib-add-worklog
issue-id
(cdr (assoc 'started worklog))
(cdr (assoc 'time-spent-seconds worklog))
comment-text
(cl-function
(lambda (&key data &allow-other-keys)
(org-jira-update-worklogs-for-issue issue-id))))
)
)))))
)))
(defun org-jira-update-worklog ()
"Update a worklog for the current issue."
(interactive)
(error "Deprecated, use org-jira-update-worklogs-from-org-clocks instead!")
(let* ((issue-id (org-jira-get-from-org 'issue 'key))
(worklog-id (org-jira-get-from-org 'worklog 'id))
(timeSpent (org-jira-get-from-org 'worklog 'timeSpent))
(timeSpent (if timeSpent
timeSpent
(read-string "Input the time you spent (such as 3w 1d 2h): ")))
(timeSpent (replace-regexp-in-string " \\(\\sw\\)\\sw*\\(,\\|$\\)" "\\1" timeSpent))
(startDate (org-jira-get-from-org 'worklog 'startDate))
(startDate (if startDate
startDate
(org-read-date nil nil nil "Input when did you start")))
(startDate (org-jira-time-format-to-jira startDate))
(comment (replace-regexp-in-string "^ " "" (org-jira-get-worklog-comment worklog-id)))
(worklog `((comment . ,comment)
(timeSpent . ,timeSpent)
(timeSpentInSeconds . 10)
(startDate . ,startDate)))
(worklog (if worklog-id
(cons `(id . ,(replace-regexp-in-string "^worklog-" "" worklog-id)) worklog)
worklog)))
(if worklog-id
(jiralib-update-worklog worklog)
(jiralib-add-worklog-and-autoadjust-remaining-estimate issue-id startDate timeSpent comment))
(org-jira-delete-current-worklog)
(org-jira-update-worklogs-for-current-issue)))
(defun org-jira-delete-current-comment ()
"Delete the current comment."
(ensure-on-comment
(delete-region (point-min) (point-max))))
(defun org-jira-delete-current-worklog ()
"Delete the current worklog."
(ensure-on-worklog
(delete-region (point-min) (point-max))))
;;;###autoload
(defun org-jira-copy-current-issue-key ()
"Copy the current issue's key into clipboard."
(interactive)
(let ((issue-id (org-jira-get-from-org 'issue 'key)))
(with-temp-buffer
(insert issue-id)
(kill-region (point-min) (point-max)))))
(defun org-jira-get-comment-id (comment)
(org-jira-find-value comment 'id))
(defun org-jira-get-comment-author (comment)
(org-jira-find-value comment 'author 'displayName))
(defun org-jira-isa-ignored-comment? (comment)
(member-ignore-case (oref comment author) org-jira-ignore-comment-user-list))
(defun org-jira-maybe-reverse-comments (comments)
(if org-jira-reverse-comment-order (reverse comments) comments))
(defun org-jira-extract-comments-from-data (data)
(->> (append data nil)
org-jira-sdk-create-comments-from-data-list
org-jira-maybe-reverse-comments
(cl-remove-if #'org-jira-isa-ignored-comment?)))
(defun org-jira--render-comment (issue-id Comment)
(with-slots (comment-id author headline created updated body) Comment
(ensure-on-issue-id issue-id
(setq p (org-find-entry-with-id comment-id))
(when (and p (>= p (point-min))
(<= p (point-max)))
(goto-char p)
(org-narrow-to-subtree)
(delete-region (point-min) (point-max)))
(goto-char (point-max))
(unless (looking-at "^")
(insert "\n"))
(insert "*** ")
(org-jira-insert headline "\n")
(org-narrow-to-subtree)
(org-jira-entry-put (point) "ID" comment-id)
(org-jira-entry-put (point) "created" created)
(unless (string= created updated)
(org-jira-entry-put (point) "updated" updated))
(goto-char (point-max))
;; Insert 2 spaces of indentation so Jira markup won't cause org-markup
(org-jira-insert (replace-regexp-in-string "^" " " (or body ""))))))
(defun org-jira-update-comments-for-issue (issue-id)
"Update the comments for the specified ISSUE-ID issue."
(jiralib-get-comments
issue-id
(org-jira-with-callback
(org-jira-log "In the callback for org-jira-update-comments-for-issue.")
(-->
(org-jira-find-value cb-data 'comments)
(org-jira-extract-comments-from-data it)
(mapc (lambda (Comment) (org-jira--render-comment issue-id Comment)) it)))))
(defun org-jira-update-comments-for-current-issue ()
"Update comments for the current issue."
(org-jira-log "About to update comments for current issue.")
(-> (org-jira-get-from-org 'issue 'key) org-jira-update-comments-for-issue))
(defun org-jira-delete-subtree ()
"Derived from org-cut-subtree.
Like that function, without mangling the user's clipboard for the
purpose of wiping an old subtree."
(let (beg end folded (beg0 (point)))
(org-back-to-heading t) ; take what is really there
(setq beg (point))
(skip-chars-forward " \t\r\n")
(save-match-data
(save-excursion (outline-end-of-heading)
(setq folded (org-invisible-p))
(org-end-of-subtree t t)))
;; Include the end of an inlinetask
(when (and (featurep 'org-inlinetask)
(looking-at-p (concat (org-inlinetask-outline-regexp)
"END[ \t]*$")))
(end-of-line))
(setq end (point))
(goto-char beg0)
(when (> end beg)
(setq org-subtree-clip-folded folded)
(org-save-markers-in-region beg end)
(delete-region beg end))))
(defun org-jira-update-attachments-for-current-issue ()
"Update the attachments for the current issue."
(when jiralib-use-restapi
(lexical-let ((issue-id (org-jira-get-from-org 'issue 'key)))
;; Run the call
(jiralib-get-attachments
issue-id
(save-excursion
(cl-function
(lambda (&key data &allow-other-keys)
;; First, make sure we're in the proper buffer (logic copied from org-jira-get-issues.
(let* ((proj-key (replace-regexp-in-string "-.*" "" issue-id))
(project-file (expand-file-name (concat proj-key ".org") org-jira-working-dir))
(project-buffer (or (find-buffer-visiting project-file)
(find-file project-file))))
(with-current-buffer project-buffer
;; delete old attachment node
(ensure-on-issue
(if (org-goto-first-child)
(while (org-goto-sibling)
(forward-thing 'whitespace)
(when (looking-at "Attachments:")
(org-jira-delete-subtree)))))
(let ((attachments (org-jira-find-value data 'fields 'attachment)))
(when (not (zerop (length attachments)))
(ensure-on-issue
(if (org-goto-first-child)
(progn
(while (org-goto-sibling))
(org-insert-heading-after-current))
(org-insert-subheading nil))
(insert "Attachments:")
(mapc
(lambda (attachment)
(let ((attachment-id (org-jira-get-comment-id attachment))
(author (org-jira-get-comment-author attachment))
(created (org-jira-transform-time-format
(org-jira-find-value attachment 'created)))
(size (org-jira-find-value attachment 'size))
(mimeType (org-jira-find-value attachment 'mimeType))
(content (org-jira-find-value attachment 'content))
(filename (org-jira-find-value attachment 'filename)))
(if (looking-back "Attachments:")
(org-insert-subheading nil)
(org-insert-heading-respect-content))
(insert "[[" content "][" filename "]]")
(org-narrow-to-subtree)
(org-jira-entry-put (point) "ID" attachment-id)
(org-jira-entry-put (point) "Author" author)
(org-jira-entry-put (point) "Name" filename)
(org-jira-entry-put (point) "Created" created)
(org-jira-entry-put (point) "Size" (ls-lisp-format-file-size size t))
(org-jira-entry-put (point) "Content" content)
(widen)))
attachments)))))))))))))
(defun org-jira-sort-org-clocks (clocks)
"Given a CLOCKS list, sort it by start date descending."
;; Expects data such as this:
;; ((\"2017-02-26 Sun 00:08\" \"2017-02-26 Sun 01:08\" \"Hi\" \"10101\")
;; (\"2017-03-16 Thu 22:25\" \"2017-03-16 Thu 22:57\" \"Test\" \"10200\"))
(sort clocks
(lambda (a b)
(> (time-to-seconds (date-to-time (car a)))
(time-to-seconds (date-to-time (car b)))))))
(defun org-jira-update-worklogs-for-current-issue ()
"Update the worklogs for the current issue."
(-> (org-jira-get-from-org 'issue 'key)
org-jira-update-worklogs-for-issue))
(defun org-jira-update-worklogs-for-issue (issue-id)
"Update the worklogs for the current issue."
;; Run the call
(jiralib-get-worklogs
issue-id
(org-jira-with-callback
(ensure-on-issue-id issue-id
(let ((worklogs (org-jira-find-value cb-data 'worklogs)))
(org-jira-logbook-reset
issue-id
(org-jira-sort-org-clocks (org-jira-worklogs-to-org-clocks
(jiralib-worklog-import--filter-apply worklogs)))))))))
;;;###autoload
(defun org-jira-unassign-issue ()
"Update an issue to be unassigned."
(interactive)
(let ((issue-id (org-jira-parse-issue-id)))
(org-jira-update-issue-details issue-id :assignee nil)))
;;;###autoload
(defun org-jira-assign-issue ()
"Update an issue with interactive re-assignment."
(interactive)
(let ((issue-id (org-jira-parse-issue-id)))
(if issue-id
(let* ((project (replace-regexp-in-string "-[0-9]+" "" issue-id))
(jira-users (org-jira-get-assignable-users project))
(user (completing-read
"Assignee: "
(append (mapcar 'car jira-users)
(mapcar 'cdr jira-users))))
(assignee (or
(cdr (assoc user jira-users))
(cdr (rassoc user jira-users)))))
(when (null assignee)
(error "No assignee found, use org-jira-unassign-issue to make the issue unassigned"))
(org-jira-update-issue-details issue-id :assignee assignee))
(error "Not on an issue"))))
;;;###autoload
(defun org-jira-update-issue ()
"Update an issue."
(interactive)
(let ((issue-id (org-jira-parse-issue-id)))
(if issue-id
(org-jira-update-issue-details issue-id)
(error "Not on an issue"))))
;;;###autoload
(defun org-jira-todo-to-jira ()
"Convert an ordinary todo item to a jira ticket."
(interactive)
(ensure-on-todo
(when (org-jira-parse-issue-id)
(error "Already on jira ticket"))
(save-excursion (org-jira-create-issue
(org-jira-read-project)
(org-jira-read-issue-type)
(org-get-heading t t)
(org-get-entry)))
(delete-region (point-min) (point-max))))
;;;###autoload
(defun org-jira-get-subtasks ()
"Get subtasks for the current issue."
(interactive)
(ensure-on-issue
(org-jira-get-issues-headonly (jiralib-do-jql-search (format "parent = %s" (org-jira-parse-issue-id))))))
(defvar org-jira-project-read-history nil)
(defvar org-jira-boards-read-history nil)
(defvar org-jira-components-read-history nil)
(defvar org-jira-priority-read-history nil)
(defvar org-jira-type-read-history nil)
(defun org-jira-read-project ()
"Read project name."
(completing-read
"Project: "
(jiralib-make-list (jiralib-get-projects) 'key)
nil
t
nil
'org-jira-project-read-history
(car org-jira-project-read-history)))
(defun org-jira-read-board ()
"Read board name. Returns cons pair (name . integer-id)"
(let* ((boards-alist
(jiralib-make-assoc-list (jiralib-get-boards) 'name 'id))
(board-name
(completing-read "Boards: " boards-alist
nil t nil
'org-jira-boards-read-history
(car org-jira-boards-read-history))))
(assoc board-name boards-alist)))
(defun org-jira-read-component (project)
"Read the components options for PROJECT such as EX."
(completing-read
"Components (choose Done to stop): "
(append '("Done") (mapcar 'cdr (jiralib-get-components project)))
nil
t
nil
'org-jira-components-read-history
"Done"))
;; TODO: Finish this feature - integrate into org-jira-create-issue
(defun org-jira-read-components (project)
"Types: string PROJECT : string (csv of components).
Get all the components for the PROJECT such as EX,
that should be bound to an issue."
(let (components component)
(while (not (equal "Done" component))
(setq component (org-jira-read-component project))
(unless (equal "Done" component)
(push component components)))
components))
(defun org-jira-read-priority ()
"Read priority name."
(completing-read
"Priority: "
(mapcar 'cdr (jiralib-get-priorities))
nil
t
nil
'org-jira-priority-read-history
(car org-jira-priority-read-history)))
(defun org-jira-read-issue-type (&optional project)
"Read issue type name. PROJECT is the optional project key."
(let* ((issue-types
(mapcar 'cdr (if project
(jiralib-get-issue-types-by-project project)
(jiralib-get-issue-types))))
(initial-input (when (member (car org-jira-type-read-history) issue-types)
org-jira-type-read-history)))
(completing-read
"Type: "
issue-types
nil
t
nil
initial-input
(car initial-input))))
(defun org-jira-read-subtask-type ()
"Read issue type name."
(completing-read
"Type: "
(mapcar 'cdr (jiralib-get-subtask-types))
nil
t
nil
'org-jira-type-read-history
(car org-jira-type-read-history)))
(defun org-jira-get-issue-struct (project type summary description)
"Create an issue struct for PROJECT, of TYPE, with SUMMARY and DESCRIPTION."
(if (or (equal project "")
(equal type "")
(equal summary ""))
(error "Must provide all information!"))
(let* ((project-components (jiralib-get-components project))
(jira-users (org-jira-get-assignable-users project))
(user (completing-read "Assignee: " (mapcar 'car jira-users)))
(priority (car (rassoc (org-jira-read-priority) (jiralib-get-priorities))))
(ticket-struct
`((fields
(project (key . ,project))
(issuetype (id . ,(car (rassoc type (if (and (boundp 'parent-id) parent-id)
(jiralib-get-subtask-types)
(jiralib-get-issue-types))))))
(summary . ,(format "%s%s" summary
(if (and (boundp 'parent-id) parent-id)
(format " (subtask of [jira:%s])" parent-id)
"")))
(description . ,description)
(priority (id . ,priority))
(assignee (name . ,(or (cdr (assoc user jira-users)) user)))))))
ticket-struct))
;;;###autoload
(defun org-jira-create-issue (project type summary description)
"Create an issue in PROJECT, of type TYPE, with given SUMMARY and DESCRIPTION."
(interactive
(let* ((project (org-jira-read-project))
(type (org-jira-read-issue-type project))
(summary (read-string "Summary: "))
(description (read-string "Description: ")))
(list project type summary description)))
(if (or (equal project "")
(equal type "")
(equal summary ""))
(error "Must provide all information!"))
(let* ((parent-id nil)
(ticket-struct (org-jira-get-issue-struct project type summary description)))
(org-jira-get-issues (list (jiralib-create-issue ticket-struct)))))
;;;###autoload
(defun org-jira-create-subtask (project type summary description)
"Create a subtask issue for PROJECT, of TYPE, with SUMMARY and DESCRIPTION."
(interactive (ensure-on-issue (list (org-jira-read-project)
(org-jira-read-subtask-type)
(read-string "Summary: ")
(read-string "Description: "))))
(if (or (equal project "")
(equal type "")
(equal summary ""))
(error "Must provide all information!"))
(let* ((parent-id (org-jira-parse-issue-id))
(ticket-struct (org-jira-get-issue-struct project type summary description)))
(org-jira-get-issues (list (jiralib-create-subtask ticket-struct parent-id)))))
(defun org-jira-strip-string (str)
"Remove the beginning and ending white space for a string STR."
(s-trim str))
(defun org-jira-get-issue-val-from-org (key)
"Return the requested value by KEY from the current issue."
(ensure-on-issue
(cond ((eq key 'description)
(org-goto-first-child)
(forward-thing 'whitespace)
(if (looking-at "description: ")
(org-jira-strip-string (org-get-entry))
(error "Can not find description field for this issue")))
((eq key 'summary)
(ensure-on-issue
(org-get-heading t t)))
;; org returns a time tuple, we need to convert it
((eq key 'deadline)
(let ((encoded-time (org-get-deadline-time (point))))
(when encoded-time
(cl-reduce (lambda (carry segment)
(format "%s-%s" carry segment))
(reverse (cl-subseq (decode-time encoded-time) 3 6))))))
;; default case, just grab the value in the properties block
(t
(when (symbolp key)
(setq key (symbol-name key)))
(setq key (or (assoc-default key org-jira-property-overrides)
key))
(when (string= key "key")
(setq key "ID"))
;; The variable `org-special-properties' will mess this up
;; if our search, such as 'priority' is within there, so
;; don't bother with it for this (since we only ever care
;; about the local properties, not any hierarchal or special
;; ones).
(let ((org-special-properties nil))
(or (org-entry-get (point) key)
""))))))
(defvar org-jira-actions-history nil)
(defun org-jira-read-action (actions)
"Read issue workflow progress ACTIONS."
(let ((action (completing-read
"Action: "
(mapcar 'cdr actions)
nil
t
nil
'org-jira-actions-history
(car org-jira-actions-history))))
(car (rassoc action actions))))
(defvar org-jira-fields-history nil)
(defun org-jira-read-field (fields)
"Read (custom) FIELDS for workflow progress."
(let ((field-desc (completing-read
"More fields to set: "
(cons "Thanks, no more fields are *required*." (mapcar 'org-jira-decode (mapcar 'cdr fields)))
nil
t
nil
'org-jira-fields-history))
field-name)
(setq field-name (car (rassoc field-desc fields)))
(if field-name
(intern field-name)
field-name)))
(defvar org-jira-rest-fields nil
"Extra fields are held here for usage between two endpoints.
Used in org-jira-read-resolution and org-jira-progress-issue calls.")
(defvar org-jira-resolution-history nil)
(defun org-jira-read-resolution ()
"Read issue workflow progress resolution."
(if (not jiralib-use-restapi)
(let ((resolution (completing-read
"Resolution: "
(mapcar 'cdr (jiralib-get-resolutions))
nil
t
nil
'org-jira-resolution-history
(car org-jira-resolution-history))))
(car (rassoc resolution (jiralib-get-resolutions))))
(let* ((resolutions (org-jira-find-value org-jira-rest-fields 'resolution 'allowedValues))
(resolution-name (completing-read
"Resolution: "
(mapcar (lambda (resolution)
(org-jira-find-value resolution 'name))
resolutions))))
(cons 'name resolution-name))))
;; TODO: Refactor to just scoop all ids from buffer, run ensure-on-issue-id on
;; each using a map, and refresh them that way. That way we don't have to iterate
;; on the user headings etc.
(defun org-jira-refresh-issues-in-buffer ()
"Iterate across all entries in current buffer, refreshing on issue :ID:.
Where issue-id will be something such as \"EX-22\"."
(interactive)
(save-excursion
(save-restriction
(widen)
(outline-show-all)
(outline-hide-sublevels 2)
(goto-char (point-min))
(outline-next-visible-heading 1)
(while (not (org-next-line-empty-p))
(when (outline-on-heading-p t)
;; It's possible we could be on a non-org-jira headline, but
;; that should be an exceptional case and not necessitating a
;; fix atm.
(org-jira-refresh-issue))
(outline-next-visible-heading 1)))))
;;;###autoload
(defun org-jira-refresh-issue ()
"Refresh current issue from jira to org."
(interactive)
(ensure-on-issue
(org-jira--refresh-issue (org-jira-id))))
(defun org-jira--refresh-issue (issue-id)
"Refresh issue from jira to org using ISSUE-ID."
(jiralib-get-issue
issue-id
(org-jira-with-callback
(org-jira-log (format "Received refresh issue data for id: %s" issue-id))
(-> cb-data list org-jira-sdk-create-issues-from-data-list org-jira--render-issues-from-issue-list))))
(defun org-jira--refresh-issue-by-id (issue-id)
"Refresh issue from jira to org using ISSUE-ID."
(ensure-on-issue-id issue-id
(org-jira--refresh-issue issue-id)))
(defvar org-jira-fields-values-history nil)
;;;###autoload
(defun org-jira-progress-issue ()
"Progress issue workflow."
(interactive)
(ensure-on-issue
(let* ((issue-id (org-jira-id))
(actions (jiralib-get-available-actions
issue-id
(org-jira-get-issue-val-from-org 'status)))
(action (org-jira-read-action actions))
(fields (jiralib-get-fields-for-action issue-id action))
(org-jira-rest-fields fields)
(field-key)
(custom-fields-collector nil)
(custom-fields
(progn
;; delete those elements in fields, which have
;; already been set in custom-fields-collector
(while fields
(setq fields
(cl-remove-if
(lambda (strstr)
(cl-member-if (lambda (symstr)
(string= (car strstr) (symbol-name (car symstr))))
custom-fields-collector))
fields))
(setq field-key (org-jira-read-field fields))
(if (not field-key)
(setq fields nil)
(setq custom-fields-collector
(cons
(funcall (if jiralib-use-restapi
#'list
#'cons)
field-key
(if (eq field-key 'resolution)
(org-jira-read-resolution)
(let ((field-value (completing-read
(format "Please enter %s's value: "
(cdr (assoc (symbol-name field-key) fields)))
org-jira-fields-values-history
nil
nil
nil
'org-jira-fields-values-history)))
(if jiralib-use-restapi
(cons 'name field-value)
field-value))))
custom-fields-collector))))
custom-fields-collector)))
(jiralib-progress-workflow-action
issue-id
action
custom-fields
(cl-function
(lambda (&key data &allow-other-keys)
(org-jira-refresh-issue)))))))
(defun org-jira-progress-next-action (actions current-status)
"Grab the user defined 'next' action from ACTIONS, given CURRENT-STATUS."
(let* ((next-action-name (cdr (assoc current-status org-jira-progress-issue-flow)))
(next-action-id (caar (cl-remove-if-not
(lambda (action)
(equal action next-action-name)) actions :key #'cdr))))
next-action-id))
;;;###autoload
(defun org-jira-progress-issue-next ()
"Progress issue workflow."
(interactive)
(ensure-on-issue
(let* ((issue-id (org-jira-id))
(actions (jiralib-get-available-actions
issue-id
(org-jira-get-issue-val-from-org 'status)))
(action (org-jira-progress-next-action actions (org-jira-get-issue-val-from-org 'status)))
(fields (jiralib-get-fields-for-action issue-id action))
(org-jira-rest-fields fields)
(field-key)
(custom-fields-collector nil)
(custom-fields
(progn
;; delete those elements in fields, which have
;; already been set in custom-fields-collector
(while fields
(setq fields
(cl-remove-if
(lambda (strstr)
(cl-member-if (lambda (symstr)
(string= (car strstr) (symbol-name (car symstr))))
custom-fields-collector))
fields))
(setq field-key (org-jira-read-field fields))
(if (not field-key)
(setq fields nil)
(setq custom-fields-collector
(cons
(funcall (if jiralib-use-restapi
#'list
#'cons)
field-key
(if (eq field-key 'resolution)
(org-jira-read-resolution)
(let ((field-value (completing-read
(format "Please enter %s's value: "
(cdr (assoc (symbol-name field-key) fields)))
org-jira-fields-values-history
nil
nil
nil
'org-jira-fields-values-history)))
(if jiralib-use-restapi
(cons 'name field-value)
field-value))))
custom-fields-collector))))
custom-fields-collector)))
(if action
(jiralib-progress-workflow-action
issue-id
action
custom-fields
(org-jira-with-callback
(ensure-on-issue-id issue-id (org-jira-refresh-issue))))
(error "No action defined for that step!")))))
(defun org-jira-get-id-name-alist (name ids-to-names)
"Find the id corresponding to NAME in IDS-TO-NAMES and return an alist with id and name as keys."
(let ((id (car (rassoc name ids-to-names))))
`((id . ,id)
(name . ,name))))
(defun org-jira-build-components-list (project-components org-issue-components)
"Given PROJECT-COMPONENTS, attempt to build a list.
If the PROJECT-COMPONENTS are nil, this should return:
(list components []), which will translate into the JSON:
{\"components\": []}
otherwise it should return:
(list components (list (cons id comp-id) (cons name item-name))),
which will translate into the JSON:
{\"components\": [{\"id\": \"comp-id\", \"name\": \"item\"}]}"
(if (not project-components) (vector) ;; Return a blank array for JSON
(apply 'list
(cl-mapcan
(lambda (item)
(let ((comp-id (car (rassoc item project-components))))
(if comp-id
`(((id . ,comp-id)
(name . ,item)))
nil)))
(split-string org-issue-components ",\\s *")))))
(defun org-jira-strip-priority-tags (s)
(->> s (replace-regexp-in-string "\\[#.*?\\]" "") s-trim))
(defun org-jira-update-issue-details (issue-id &rest rest)
"Update the details of issue ISSUE-ID. REST will contain optional input."
(ensure-on-issue-id issue-id
;; Set up a bunch of values from the org content
(let* ((org-issue-components (org-jira-get-issue-val-from-org 'components))
(org-issue-description (s-trim (org-jira-get-issue-val-from-org 'description)))
(org-issue-priority (org-jira-get-issue-val-from-org 'priority))
(org-issue-type (org-jira-get-issue-val-from-org 'type))
(org-issue-assignee (cl-getf rest :assignee (org-jira-get-issue-val-from-org 'assignee)))
(project (replace-regexp-in-string "-[0-9]+" "" issue-id))
(project-components (jiralib-get-components project)))
;; Lets fire off a worklog update async with the main issue
;; update, why not? This is better to fire first, because it
;; doesn't auto-refresh any areas, while the end of the main
;; update does a callback that reloads the worklog entries (so,
;; we hope that wont occur until after this successfully syncs
;; up). Only do this sync if the user defcustom defines it as such.
(when org-jira-worklog-sync-p
(org-jira-update-worklogs-from-org-clocks))
;; Send the update to jira
(let ((update-fields
(list (cons
'components
(or (org-jira-build-components-list
project-components
org-issue-components) []))
(cons 'priority (org-jira-get-id-name-alist org-issue-priority
(jiralib-get-priorities)))
(cons 'description org-issue-description)
(cons 'assignee (jiralib-get-user org-issue-assignee))
(cons 'summary (org-jira-strip-priority-tags (org-jira-get-issue-val-from-org 'summary)))
(cons 'issuetype (org-jira-get-id-name-alist org-issue-type
(jiralib-get-issue-types))))))
;; If we enable duedate sync and we have a deadline present
(when (and org-jira-deadline-duedate-sync-p
(org-jira-get-issue-val-from-org 'deadline))
(setq update-fields
(append update-fields
(list (cons 'duedate (org-jira-get-issue-val-from-org 'deadline))))))
(jiralib-update-issue
issue-id
update-fields
;; This callback occurs on success
(org-jira-with-callback
(message (format "Issue '%s' updated!" issue-id))
(jiralib-get-issue
issue-id
(org-jira-with-callback
(org-jira-log "Update get issue for refresh callback hit.")
(-> cb-data list org-jira-get-issues))))
))
)))
(defun org-jira-parse-issue-id ()
"Get issue id from org text."
(save-excursion
(let ((continue t)
issue-id)
(while continue
(when (string-match (jiralib-get-issue-regexp)
(or (setq issue-id (org-entry-get (point) "ID"))
""))
(setq continue nil))
(unless (and continue (org-up-heading-safe))
(setq continue nil)))
issue-id)))
(defun org-jira-get-from-org (type entry)
"Get an org property from the current item.
TYPE is the type to of the current item, and can be 'issue, or 'comment.
ENTRY will vary, and is the name of the property to return. If
it is a symbol, it will be converted to string."
(when (symbolp entry)
(setq entry (symbol-name entry)))
(cond
((eq type 'issue)
(org-jira-get-issue-val-from-org entry))
((eq type 'comment)
(org-jira-get-comment-val-from-org entry))
((eq type 'worklog)
(org-jira-get-worklog-val-from-org entry))
(t (error "Unknown type %s" type))))
(defun org-jira-get-comment-val-from-org (entry)
"Get the JIRA issue field value ENTRY of the current comment item."
(ensure-on-comment
(when (symbolp entry)
(setq entry (symbol-name entry)))
(when (string= entry "id")
(setq entry "ID"))
(org-entry-get (point) entry)))
(defun org-jira-get-worklog-val-from-org (entry)
"Get the JIRA issue field value ENTRY of the current worklog item."
(ensure-on-worklog
(when (symbolp entry)
(setq entry (symbol-name entry)))
(when (string= entry "id")
(setq entry "ID"))
(org-entry-get (point) entry)))
(defun org-jira-get-comment-body (&optional comment-id)
"Get the comment body of the comment with id COMMENT-ID."
(ensure-on-comment
(goto-char (point-min))
;; so that search for :END: won't fail
(org-jira-entry-put (point) "ID" comment-id)
(search-forward ":END:" nil 1 1)
(forward-line)
(org-jira-strip-string (buffer-substring-no-properties (point) (point-max)))))
(defun org-jira-get-worklog-comment (&optional worklog-id)
"Get the worklog comment of the worklog with id WORKLOG-ID."
(ensure-on-worklog
(goto-char (point-min))
;; so that search for :END: won't fail
(org-jira-entry-put (point) "ID" worklog-id)
(search-forward ":END:" nil 1 1)
(forward-line)
(org-jira-strip-string (buffer-substring-no-properties (point) (point-max)))))
(defun org-jira-id ()
"Get the ID entry for the current heading."
(org-entry-get (point) "ID"))
;;;###autoload
(defun org-jira-browse-issue ()
"Open the current issue in external browser."
(interactive)
(ensure-on-issue
(browse-url (concat (replace-regexp-in-string "/*$" "" jiralib-url) "/browse/" (org-jira-id)))))
(defun org-jira-url-copy-file (url newname)
"Similar to url-copy-file but async."
(lexical-let ((newname newname))
(url-retrieve
url
(lambda (status)
(let ((buffer (current-buffer))
(handle nil)
(filename (if (and (file-exists-p newname)
org-jira-download-ask-override)
(read-string "File already exists, select new name or press ENTER to override: " newname)
newname)))
(if (not buffer)
(error "Opening input file: No such file or directory, %s" url))
(with-current-buffer buffer
(setq handle (mm-dissect-buffer t)))
(mm-save-part-to-file handle filename)
(kill-buffer buffer)
(mm-destroy-parts handle))))))
;;;###autoload
(defun org-jira-download-attachment ()
"Download the attachment under cursor."
(interactive)
(when jiralib-use-restapi
(save-excursion
(org-up-heading-safe)
(org-back-to-heading)
(forward-thing 'whitespace)
(unless (looking-at "Attachments:")
(error "Not on a attachment region!")))
(let ((filename (org-entry-get (point) "Name"))
(url (org-entry-get (point) "Content"))
(url-request-extra-headers `(,jiralib-token)))
(org-jira-url-copy-file
url
(concat (file-name-as-directory org-jira-download-dir) filename)))))
;;;###autoload
(defun org-jira-get-issues-from-filter (filter)
"Get issues from the server-side stored filter named FILTER.
Provide this command in case some users are not able to use
client side jql (maybe because of JIRA server version?)."
(interactive
(list (completing-read "Filter: " (mapcar 'cdr (jiralib-get-saved-filters)))))
(org-jira-get-issues (jiralib-get-issues-from-filter (car (rassoc filter (jiralib-get-saved-filters))))))
;;;###autoload
(defun org-jira-get-issues-from-filter-headonly (filter)
"Get issues *head only* from saved filter named FILTER.
See `org-jira-get-issues-from-filter'."
(interactive
(list (completing-read "Filter: " (mapcar 'cdr (jiralib-get-saved-filters)))))
(org-jira-get-issues-headonly (jiralib-get-issues-from-filter (car (rassoc filter (jiralib-get-saved-filters))))))
(org-add-link-type "jira" 'org-jira-open)
;; This was only added in org 9.0, not sure all org users will have
;; that version, so keep the deprecated one from above for now.
;;(org-link-set-parameters "jira" ((:follow . 'org-jira-open)))
(defun org-jira-open (path)
"Open a Jira Link from PATH."
(org-jira-get-issue path))
;;;###autoload
(defun org-jira-get-issues-by-board ()
"Get list of ISSUES from agile board."
(interactive)
(let* ((board (org-jira-read-board))
(board-id (cdr board)))
(jiralib-get-board-issues board-id
:callback org-jira-get-issue-list-callback
:limit (org-jira-get-board-limit board-id)
:query-params (org-jira--make-jql-queryparams board-id))))
(defun org-jira-get-board-limit (id)
"Get limit for number of retrieved issues for a board
id - integer board id"
(let ((board (org-jira--get-board-from-buffer id)))
(if (and board (slot-boundp board 'limit))
(oref board limit)
org-jira-boards-default-limit)))
(defun org-jira--make-jql-queryparams (board-id)
"make GET query parameters for jql, returns nil if JQL query is not set"
(let* ((board (org-jira--get-board-from-buffer board-id))
(jql (if (and board (slot-boundp board 'jql))
(oref board jql))))
(if (and jql (not (string-blank-p jql))) `((jql ,jql)))))
;;;###autoload
(defun org-jira-get-issues-by-board-headonly ()
"Get list of ISSUES from agile board, head only."
(interactive)
(let* ((board (org-jira-read-board))
(board-id (cdr board)))
(org-jira-get-issues-headonly
(jiralib-get-board-issues board-id
:limit (org-jira-get-board-limit board-id)
:query-params (org-jira--make-jql-queryparams board-id)))))
(defun org-jira--render-boards-from-list (boards)
"Add the boards from list into the org file.
boards - list of `org-jira-sdk-board' records."
(mapc 'org-jira--render-board boards))
(defun org-jira--render-board (board)
"Render single board"
;;(org-jira-sdk-dump board)
(with-slots (id name url board-type jql limit) board
(with-current-buffer (org-jira--get-boards-buffer)
(org-jira-mode t)
(org-jira-freeze-ui
(org-save-outline-visibility t
(save-restriction
(outline-show-all)
(widen)
(goto-char (point-min))
(let* ((board-headline
(format "Board: [[%s][%s]]" url name))
(headline-pos
(org-find-exact-headline-in-buffer board-headline (current-buffer) t))
(entry-exists (and headline-pos (>= headline-pos (point-min)) (<= headline-pos (point-max))))
(limit-value (if (slot-boundp board 'limit) (int-to-string limit) nil))
(jql-value (if (slot-boundp board 'jql) jql nil)))
(if entry-exists
(progn
(goto-char headline-pos)
(org-narrow-to-subtree)
(end-of-line))
(goto-char (point-max))
(unless (looking-at "^")
(insert "\n"))
(insert "* ")
(org-jira-insert board-headline)
(org-narrow-to-subtree))
(org-jira-entry-put (point) "name" name)
(org-jira-entry-put (point) "type" board-type)
(org-jira-entry-put (point) "url" url)
;; do not overwrite existing user properties with empty values
(if (or (not entry-exists) limit-value)
(org-jira-entry-put (point) "limit" limit-value))
(if (or (not entry-exists) jql-value)
(org-jira-entry-put (point) "JQL" jql-value ))
(org-jira-entry-put (point) "ID" id))))))))
(defun org-jira--get-boards-file ()
(expand-file-name "boards-list.org" org-jira-working-dir))
(defun org-jira--get-boards-buffer ()
"Return buffer for list of agile boards. Create one if it does not exist."
(let* ((boards-file (org-jira--get-boards-file))
(existing-buffer (find-buffer-visiting boards-file)))
(if existing-buffer
existing-buffer
(find-file-noselect boards-file))))
;;;###autoload
(defun org-jira-get-boards ()
"Get list of boards and their properies."
(interactive)
(let* ((datalist (jiralib-get-boards))
(boards (org-jira-sdk-create-boards-from-data-list datalist)))
(org-jira--render-boards-from-list boards))
(switch-to-buffer (org-jira--get-boards-buffer)))
(defun org-jira--get-board-from-buffer (id)
"Parse board record from org file."
(with-current-buffer (org-jira--get-boards-buffer)
(org-jira-freeze-ui
(let ((pos (org-find-property "ID" (int-to-string id))))
(if pos
(progn
(goto-char pos)
(apply 'org-jira-sdk-board
(reduce
#'(lambda (acc entry)
(let* ((pname (car entry))
(pval (cdr entry))
(pair (and pval
(not (string-empty-p pval))
(cond
((equal pname "ID")
(list :id pval))
((equal pname "URL")
(list :url pval))
((equal pname "TYPE")
(list :board-type pval))
((equal pname "NAME")
(list :name pval))
((equal pname "LIMIT")
(list :limit (string-to-number pval)))
((equal pname "JQL")
(list :jql pval))
(t nil)))))
(if pair (append pair acc) acc)))
(org-entry-properties) :initial-value ()))))))))
(defun org-jira-get-org-keyword-from-status (status)
"Gets an 'org-mode' keyword corresponding to a given jira STATUS."
(if org-jira-use-status-as-todo
(upcase (replace-regexp-in-string " " "-" status))
(let ((known-keyword (assoc status org-jira-jira-status-to-org-keyword-alist)))
(cond (known-keyword (cdr known-keyword))
((member (org-jira-decode status) org-jira-done-states) "DONE")
("TODO")))))
(defun org-jira-get-org-priority-string (character)
"Return an org-priority-string based on CHARACTER and user settings."
(cond ((not character) "")
((and org-jira-priority-to-org-priority-omit-default-priority
(eq character org-default-priority)) "")
(t (format "[#%c] " character))))
(defun org-jira-get-org-priority-cookie-from-issue (priority)
"Get the `org-mode' [#X] PRIORITY cookie."
(let ((character (cdr (assoc priority org-jira-priority-to-org-priority-alist))))
(org-jira-get-org-priority-string character)))
(provide 'org-jira)
;;; org-jira.el ends here
================================================
FILE: t/.nosearch
================================================
================================================
FILE: t/batch-runner/dash.el
================================================
;;; dash.el --- A modern list library for Emacs -*- lexical-binding: t -*-
;; Copyright (C) 2012-2016 Free Software Foundation, Inc.
;; Author: Magnar Sveen <magnars@gmail.com>
;; Version: 2.14.1
;; Package-Version: 20180726.1213
;; Keywords: lists
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; A modern list api for Emacs.
;;
;; See documentation on https://github.com/magnars/dash.el#functions
;;
;; **Please note** The lexical binding in this file is not utilised at the
;; moment. We will take full advantage of lexical binding in an upcoming 3.0
;; release of Dash. In the meantime, we've added the pragma to avoid a bug that
;; you can read more about in https://github.com/magnars/dash.el/issues/130.
;;
;;; Code:
(defgroup dash ()
"Customize group for dash.el"
:group 'lisp
:prefix "dash-")
(defun dash--enable-fontlock (symbol value)
(when value
(dash-enable-font-lock))
(set-default symbol value))
(defcustom dash-enable-fontlock nil
"If non-nil, enable fontification of dash functions, macros and
special values."
:type 'boolean
:set 'dash--enable-fontlock
:group 'dash)
(defmacro !cons (car cdr)
"Destructive: Set CDR to the cons of CAR and CDR."
`(setq ,cdr (cons ,car ,cdr)))
(defmacro !cdr (list)
"Destructive: Set LIST to the cdr of LIST."
`(setq ,list (cdr ,list)))
(defmacro --each (list &rest body)
"Anaphoric form of `-each'."
(declare (debug (form body))
(indent 1))
(let ((l (make-symbol "list")))
`(let ((,l ,list)
(it-index 0))
(while ,l
(let ((it (car ,l)))
,@body)
(setq it-index (1+ it-index))
(!cdr ,l)))))
(defmacro -doto (eval-initial-value &rest forms)
"Eval a form, then insert that form as the 2nd argument to other forms.
The EVAL-INITIAL-VALUE form is evaluated once. Its result is
passed to FORMS, which are then evaluated sequentially. Returns
the target form."
(declare (indent 1))
(let ((retval (make-symbol "value")))
`(let ((,retval ,eval-initial-value))
,@(mapcar (lambda (form)
(if (sequencep form)
`(,(-first-item form) ,retval ,@(cdr form))
`(funcall form ,retval)))
forms)
,retval)))
(defun -each (list fn)
"Call FN with every item in LIST. Return nil, used for side-effects only."
(--each list (funcall fn it)))
(put '-each 'lisp-indent-function 1)
(defalias '--each-indexed '--each)
(defun -each-indexed (list fn)
"Call (FN index item) for each item in LIST.
In the anaphoric form `--each-indexed', the index is exposed as symbol `it-index'.
See also: `-map-indexed'."
(--each list (funcall fn it-index it)))
(put '-each-indexed 'lisp-indent-function 1)
(defmacro --each-while (list pred &rest body)
"Anaphoric form of `-each-while'."
(declare (debug (form form body))
(indent 2))
(let ((l (make-symbol "list"))
(c (make-symbol "continue")))
`(let ((,l ,list)
(,c t)
(it-index 0))
(while (and ,l ,c)
(let ((it (car ,l)))
(if (not ,pred) (setq ,c nil) ,@body))
(setq it-index (1+ it-index))
(!cdr ,l)))))
(defun -each-while (list pred fn)
"Call FN with every item in LIST while (PRED item) is non-nil.
Return nil, used for side-effects only."
(--each-while list (funcall pred it) (funcall fn it)))
(put '-each-while 'lisp-indent-function 2)
(defmacro --dotimes (num &rest body)
"Repeatedly executes BODY (presumably for side-effects) with symbol `it' bound to integers from 0 through NUM-1."
(declare (debug (form body))
(indent 1))
(let ((n (make-symbol "num")))
`(let ((,n ,num)
(it 0))
(while (< it ,n)
,@body
(setq it (1+ it))))))
(defun -dotimes (num fn)
"Repeatedly calls FN (presumably for side-effects) passing in integers from 0 through NUM-1."
(--dotimes num (funcall fn it)))
(put '-dotimes 'lisp-indent-function 1)
(defun -map (fn list)
"Return a new list consisting of the result of applying FN to the items in LIST."
(mapcar fn list))
(defmacro --map (form list)
"Anaphoric form of `-map'."
(declare (debug (form form)))
`(mapcar (lambda (it) ,form) ,list))
(defmacro --reduce-from (form initial-value list)
"Anaphoric form of `-reduce-from'."
(declare (debug (form form form)))
`(let ((acc ,initial-value))
(--each ,list (setq acc ,form))
acc))
(defun -reduce-from (fn initial-value list)
"Return the result of applying FN to INITIAL-VALUE and the
first item in LIST, then applying FN to that result and the 2nd
item, etc. If LIST contains no items, return INITIAL-VALUE and
FN is not called.
In the anaphoric form `--reduce-from', the accumulated value is
exposed as symbol `acc'.
See also: `-reduce', `-reduce-r'"
(--reduce-from (funcall fn acc it) initial-value list))
(defmacro --reduce (form list)
"Anaphoric form of `-reduce'."
(declare (debug (form form)))
(let ((lv (make-symbol "list-value")))
`(let ((,lv ,list))
(if ,lv
(--reduce-from ,form (car ,lv) (cdr ,lv))
(let (acc it) ,form)))))
(defun -reduce (fn list)
"Return the result of applying FN to the first 2 items in LIST,
then applying FN to that result and the 3rd item, etc. If LIST
contains no items, FN must accept no arguments as well, and
reduce return the result of calling FN with no arguments. If
LIST has only 1 item, it is returned and FN is not called.
In the anaphoric form `--reduce', the accumulated value is
exposed as symbol `acc'.
See also: `-reduce-from', `-reduce-r'"
(if list
(-reduce-from fn (car list) (cdr list))
(funcall fn)))
(defun -reduce-r-from (fn initial-value list)
"Replace conses with FN, nil with INITIAL-VALUE and evaluate
the resulting expression. If LIST is empty, INITIAL-VALUE is
returned and FN is not called.
Note: this function works the same as `-reduce-from' but the
operation associates from right instead of from left.
See also: `-reduce-r', `-reduce'"
(if (not list) initial-value
(funcall fn (car list) (-reduce-r-from fn initial-value (cdr list)))))
(defmacro --reduce-r-from (form initial-value list)
"Anaphoric version of `-reduce-r-from'."
(declare (debug (form form form)))
`(-reduce-r-from (lambda (&optional it acc) ,form) ,initial-value ,list))
(defun -reduce-r (fn list)
"Replace conses with FN and evaluate the resulting expression.
The final nil is ignored. If LIST contains no items, FN must
accept no arguments as well, and reduce return the result of
calling FN with no arguments. If LIST has only 1 item, it is
returned and FN is not called.
The first argument of FN is the new item, the second is the
accumulated value.
Note: this function works the same as `-reduce' but the operation
associates from right instead of from left.
See also: `-reduce-r-from', `-reduce'"
(cond
((not list) (funcall fn))
((not (cdr list)) (car list))
(t (funcall fn (car list) (-reduce-r fn (cdr list))))))
(defmacro --reduce-r (form list)
"Anaphoric version of `-reduce-r'."
(declare (debug (form form)))
`(-reduce-r (lambda (&optional it acc) ,form) ,list))
(defun -reductions-from (fn init list)
"Return a list of the intermediate values of the reduction.
See `-reduce-from' for explanation of the arguments.
See also: `-reductions', `-reductions-r', `-reduce-r'"
(nreverse (--reduce-from (cons (funcall fn (car acc) it) acc) (list init) list)))
(defun -reductions (fn list)
"Return a list of the intermediate values of the reduction.
See `-reduce' for explanation of the arguments.
See also: `-reductions-from', `-reductions-r', `-reduce-r'"
(-reductions-from fn (car list) (cdr list)))
(defun -reductions-r-from (fn init list)
"Return a list of the intermediate values of the reduction.
See `-reduce-r-from' for explanation of the arguments.
See also: `-reductions-r', `-reductions', `-reduce'"
(--reduce-r-from (cons (funcall fn it (car acc)) acc) (list init) list))
(defun -reductions-r (fn list)
"Return a list of the intermediate values of the reduction.
See `-reduce-r' for explanation of the arguments.
See also: `-reductions-r-from', `-reductions', `-reduce'"
(-reductions-r-from fn (-last-item list) (-butlast list)))
(defmacro --filter (form list)
"Anaphoric form of `-filter'.
See also: `--remove'."
(declare (debug (form form)))
(let ((r (make-symbol "result")))
`(let (,r)
(--each ,list (when ,form (!cons it ,r)))
(nreverse ,r))))
(defun -filter (pred list)
"Return a new list of the items in LIST for which PRED returns a non-nil value.
Alias: `-select'
See also: `-keep', `-remove'."
(--filter (funcall pred it) list))
(defalias '-select '-filter)
(defalias '--select '--filter)
(defmacro --remove (form list)
"Anaphoric form of `-remove'.
See also `--filter'."
(declare (debug (form form)))
`(--filter (not ,form) ,list))
(defun -remove (pred list)
"Return a new list of the items in LIST for which PRED returns nil.
Alias: `-reject'
See also: `-filter'."
(--remove (funcall pred it) list))
(defalias '-reject '-remove)
(defalias '--reject '--remove)
(defun -remove-first (pred list)
"Return a new list with the first item matching PRED removed.
Alias: `-reject-first'
See also: `-remove', `-map-first'"
(let (front)
(while (and list (not (funcall pred (car list))))
(push (car list) front)
(!cdr list))
(if list
(-concat (nreverse front) (cdr list))
(nreverse front))))
(defmacro --remove-first (form list)
"Anaphoric form of `-remove-first'."
(declare (debug (form form)))
`(-remove-first (lambda (it) ,form) ,list))
(defalias '-reject-first '-remove-first)
(defalias '--reject-first '--remove-first)
(defun -remove-last (pred list)
"Return a new list with the last item matching PRED removed.
Alias: `-reject-last'
See also: `-remove', `-map-last'"
(nreverse (-remove-first pred (reverse list))))
(defmacro --remove-last (form list)
"Anaphoric form of `-remove-last'."
(declare (debug (form form)))
`(-remove-last (lambda (it) ,form) ,list))
(defalias '-reject-last '-remove-last)
(defalias '--reject-last '--remove-last)
(defun -remove-item (item list)
"Remove all occurences of ITEM from LIST.
Comparison is done with `equal'."
(declare (pure t) (side-effect-free t))
(--remove (equal it item) list))
(defmacro --keep (form list)
"Anaphoric form of `-keep'."
(declare (debug (form form)))
(let ((r (make-symbol "result"))
(m (make-symbol "mapped")))
`(let (,r)
(--each ,list (let ((,m ,form)) (when ,m (!cons ,m ,r))))
(nreverse ,r))))
(defun -keep (fn list)
"Return a new list of the non-nil results of applying FN to the items in LIST.
If you want to select the original items satisfying a predicate use `-filter'."
(--keep (funcall fn it) list))
(defun -non-nil (list)
"Return all non-nil elements of LIST."
(declare (pure t) (side-effect-free t))
(-remove 'null list))
(defmacro --map-indexed (form list)
"Anaphoric form of `-map-indexed'."
(declare (debug (form form)))
(let ((r (make-symbol "result")))
`(let (,r)
(--each ,list
(!cons ,form ,r))
(nreverse ,r))))
(defun -map-indexed (fn list)
"Return a new list consisting of the result of (FN index item) for each item in LIST.
In the anaphoric form `--map-indexed', the index is exposed as symbol `it-index'.
See also: `-each-indexed'."
(--map-indexed (funcall fn it-index it) list))
(defmacro --map-when (pred rep list)
"Anaphoric form of `-map-when'."
(declare (debug (form form form)))
(let ((r (make-symbol "result")))
`(let (,r)
(--each ,list (!cons (if ,pred ,rep it) ,r))
(nreverse ,r))))
(defun -map-when (pred rep list)
"Return a new list where the elements in LIST that do not match the PRED function
are unchanged, and where the elements in LIST that do match the PRED function are mapped
through the REP function.
Alias: `-replace-where'
See also: `-update-at'"
(--map-when (funcall pred it) (funcall rep it) list))
(defalias '-replace-where '-map-when)
(defalias '--replace-where '--map-when)
(defun -map-first (pred rep list)
"Replace first item in LIST satisfying PRED with result of REP called on this item.
See also: `-map-when', `-replace-first'"
(let (front)
(while (and list (not (funcall pred (car list))))
(push (car list) front)
(!cdr list))
(if list
(-concat (nreverse front) (cons (funcall rep (car list)) (cdr list)))
(nreverse front))))
(defmacro --map-first (pred rep list)
"Anaphoric form of `-map-first'."
`(-map-first (lambda (it) ,pred) (lambda (it) (ignore it) ,rep) ,list))
(defun -map-last (pred rep list)
"Replace last item in LIST satisfying PRED with result of REP called on this item.
See also: `-map-when', `-replace-last'"
(nreverse (-map-first pred rep (reverse list))))
(defmacro --map-last (pred rep list)
"Anaphoric form of `-map-last'."
`(-map-last (lambda (it) ,pred) (lambda (it) (ignore it) ,rep) ,list))
(defun -replace (old new list)
"Replace all OLD items in LIST with NEW.
Elements are compared using `equal'.
See also: `-replace-at'"
(declare (pure t) (side-effect-free t))
(--map-when (equal it old) new list))
(defun -replace-first (old new list)
"Replace the first occurence of OLD with NEW in LIST.
Elements are compared using `equal'.
See also: `-map-first'"
(declare (pure t) (side-effect-free t))
(--map-first (equal old it) new list))
(defun -replace-last (old new list)
"Replace the last occurence of OLD with NEW in LIST.
Elements are compared using `equal'.
See also: `-map-last'"
(declare (pure t) (side-effect-free t))
(--map-last (equal old it) new list))
(defmacro --mapcat (form list)
"Anaphoric form of `-mapcat'."
(declare (debug (form form)))
`(apply 'append (--map ,form ,list)))
(defun -mapcat (fn list)
"Return the concatenation of the result of mapping FN over LIST.
Thus function FN should return a list."
(--mapcat (funcall fn it) list))
(defun -flatten (l)
"Take a nested list L and return its contents as a single, flat list.
Note that because `nil' represents a list of zero elements (an
empty list), any mention of nil in L will disappear after
flattening. If you need to preserve nils, consider `-flatten-n'
or map them to some unique symbol and then map them back.
Conses of two atoms are considered \"terminals\", that is, they
aren't flattened further.
See also: `-flatten-n'"
(declare (pure t) (side-effect-free t))
(if (and (listp l) (listp (cdr l)))
(-mapcat '-flatten l)
(list l)))
(defmacro --iterate (form init n)
"Anaphoric version of `-iterate'."
(declare (debug (form form form)))
`(-iterate (lambda (it) ,form) ,init ,n))
(defun -flatten-n (num list)
"Flatten NUM levels of a nested LIST.
See also: `-flatten'"
(declare (pure t) (side-effect-free t))
(-last-item (--iterate (--mapcat (-list it) it) list (1+ num))))
(defun -concat (&rest lists)
"Return a new list with the concatenation of the elements in the supplied LISTS."
(declare (pure t) (side-effect-free t))
(apply 'append lists))
(defalias '-copy 'copy-sequence
"Create a shallow copy of LIST.
\(fn LIST)")
(defun -splice (pred fun list)
"Splice lists generated by FUN in place of elements matching PRED in LIST.
FUN takes the element matching PRED as input.
This function can be used as replacement for `,@' in case you
need to splice several lists at marked positions (for example
with keywords).
See also: `-splice-list', `-insert-at'"
(let (r)
(--each list
(if (funcall pred it)
(let ((new (funcall fun it)))
(--each new (!cons it r)))
(!cons it r)))
(nreverse r)))
(defmacro --splice (pred form list)
"Anaphoric form of `-splice'."
`(-splice (lambda (it) ,pred) (lambda (it) ,form) ,list))
(defun -splice-list (pred new-list list)
"Splice NEW-LIST in place of elements matching PRED in LIST.
See also: `-splice', `-insert-at'"
(-splice pred (lambda (_) new-list) list))
(defmacro --splice-list (pred new-list list)
"Anaphoric form of `-splice-list'."
`(-splice-list (lambda (it) ,pred) ,new-list ,list))
(defun -cons* (&rest args)
"Make a new list from the elements of ARGS.
The last 2 members of ARGS are used as the final cons of the
result so if the final member of ARGS is not a list the result is
a dotted list."
(declare (pure t) (side-effect-free t))
(-reduce-r 'cons args))
(defun -snoc (list elem &rest elements)
"Append ELEM to the end of the list.
This is like `cons', but operates on the end of list.
If ELEMENTS is non nil, append these to the list as well."
(-concat list (list elem) elements))
(defmacro --first (form list)
"Anaphoric form of `-first'."
(declare (debug (form form)))
(let ((n (make-symbol "needle")))
`(let (,n)
(--each-while ,list (not ,n)
(when ,form (setq ,n it)))
,n)))
(defun -first (pred list)
"Return the first x in LIST where (PRED x) is non-nil, else nil.
To get the first item in the list no questions asked, use `car'.
Alias: `-find'"
(--first (funcall pred it) list))
(defalias '-find '-first)
(defalias '--find '--first)
(defmacro --some (form list)
"Anaphoric form of `-some'."
(declare (debug (form form)))
(let ((n (make-symbol "needle")))
`(let (,n)
(--each-while ,list (not ,n)
(setq ,n ,form))
,n)))
(defun -some (pred list)
"Return (PRED x) for the first LIST item where (PRED x) is non-nil, else nil.
Alias: `-any'"
(--some (funcall pred it) list))
(defalias '-any '-some)
(defalias '--any '--some)
(defmacro --last (form list)
"Anaphoric form of `-last'."
(declare (debug (form form)))
(let ((n (make-symbol "needle")))
`(let (,n)
(--each ,list
(when ,form (setq ,n it)))
,n)))
(defun -last (pred list)
"Return the last x in LIST where (PRED x) is non-nil, else nil."
(--last (funcall pred it) list))
(defalias '-first-item 'car
"Return the first item of LIST, or nil on an empty list.
See also: `-second-item', `-last-item'.
\(fn LIST)")
;; Ensure that calls to `-first-item' are compiled to a single opcode,
;; just like `car'.
(put '-first-item 'byte-opcode 'byte-car)
(put '-first-item 'byte-compile 'byte-compile-one-arg)
(defalias '-second-item 'cadr
"Return the second item of LIST, or nil if LIST is too short.
See also: `-third-item'.
\(fn LIST)")
(defalias '-third-item 'caddr
"Return the third item of LIST, or nil if LIST is too short.
See also: `-fourth-item'.
\(fn LIST)")
(defun -fourth-item (list)
"Return the fourth item of LIST, or nil if LIST is too short.
See also: `-fifth-item'."
(declare (pure t) (side-effect-free t))
(car (cdr (cdr (cdr list)))))
(defun -fifth-item (list)
"Return the fifth item of LIST, or nil if LIST is too short.
See also: `-last-item'."
(declare (pure t) (side-effect-free t))
(car (cdr (cdr (cdr (cdr list))))))
;; TODO: gv was introduced in 24.3, so we can remove the if statement
;; when support for earlier versions is dropped
(eval-when-compile
(require 'cl)
(if (fboundp 'gv-define-simple-setter)
(gv-define-simple-setter -first-item setcar)
(require 'cl)
(with-no-warnings
(defsetf -first-item (x) (val) `(setcar ,x ,val)))))
(defun -last-item (list)
"Return the last item of LIST, or nil on an empty list."
(declare (pure t) (side-effect-free t))
(car (last list)))
;; TODO: gv was introduced in 24.3, so we can remove the if statement
;; when support for earlier versions is dropped
(eval-when-compile
(if (fboundp 'gv-define-setter)
(gv-define-setter -last-item (val x) `(setcar (last ,x) ,val))
(with-no-warnings
(defsetf -last-item (x) (val) `(setcar (last ,x) ,val)))))
(defun -butlast (list)
"Return a list of all items in list except for the last."
;; no alias as we don't want magic optional argument
(declare (pure t) (side-effect-free t))
(butlast list))
(defmacro --count (pred list)
"Anaphoric form of `-count'."
(declare (debug (form form)))
(let ((r (make-symbol "result")))
`(let ((,r 0))
(--each ,list (when ,pred (setq ,r (1+ ,r))))
,r)))
(defun -count (pred list)
"Counts the number of items in LIST where (PRED item) is non-nil."
(--count (funcall pred it) list))
(defun ---truthy? (val)
(declare (pure t) (side-effect-free t))
(not (null val)))
(defmacro --any? (form list)
"Anaphoric form of `-any?'."
(declare (debug (form form)))
`(---truthy? (--some ,form ,list)))
(defun -any? (pred list)
"Return t if (PRED x) is non-nil for any x in LIST, else nil.
Alias: `-any-p', `-some?', `-some-p'"
(--any? (funcall pred it) list))
(defalias '-some? '-any?)
(defalias '--some? '--any?)
(defalias '-any-p '-any?)
(defalias '--any-p '--any?)
(defalias '-some-p '-any?)
(defalias '--some-p '--any?)
(defmacro --all? (form list)
"Anaphoric form of `-all?'."
(declare (debug (form form)))
(let ((a (make-symbol "all")))
`(let ((,a t))
(--each-while ,list ,a (setq ,a ,form))
(---truthy? ,a))))
(defun -all? (pred list)
"Return t if (PRED x) is non-nil for all x in LIST, else nil.
Alias: `-all-p', `-every?', `-every-p'"
(--all? (funcall pred it) list))
(defalias '-every? '-all?)
(defalias '--every? '--all?)
(defalias '-all-p '-all?)
(defalias '--all-p '--all?)
(defalias '-every-p '-all?)
(defalias '--every-p '--all?)
(defmacro --none? (form list)
"Anaphoric form of `-none?'."
(declare (debug (form form)))
`(--all? (not ,form) ,list))
(defun -none? (pred list)
"Return t if (PRED x) is nil for all x in LIST, else nil.
Alias: `-none-p'"
(--none? (funcall pred it) list))
(defalias '-none-p '-none?)
(defalias '--none-p '--none?)
(defmacro --only-some? (form list)
"Anaphoric form of `-only-some?'."
(declare (debug (form form)))
(let ((y (make-symbol "yes"))
(n (make-symbol "no")))
`(let (,y ,n)
(--each-while ,list (not (and ,y ,n))
(if ,form (setq ,y t) (setq ,n t)))
(---truthy? (and ,y ,n)))))
(defun -only-some? (pred list)
"Return `t` if at least one item of LIST matches PRED and at least one item of LIST does not match PRED.
Return `nil` both if all items match the predicate or if none of the items match the predicate.
Alias: `-only-some-p'"
(--only-some? (funcall pred it) list))
(defalias '-only-some-p '-only-some?)
(defalias '--only-some-p '--only-some?)
(defun -slice (list from &optional to step)
"Return copy of LIST, starting from index FROM to index TO.
FROM or TO may be negative. These values are then interpreted
modulo the length of the list.
If STEP is a number, only each STEPth item in the resulting
section is returned. Defaults to 1."
(declare (pure t) (side-effect-free t))
(let ((length (length list))
(new-list nil))
;; to defaults to the end of the list
(setq to (or to length))
(setq step (or step 1))
;; handle negative indices
(when (< from 0)
(setq from (mod from length)))
(when (< to 0)
(setq to (mod to length)))
;; iterate through the list, keeping the elements we want
(--each-while list (< it-index to)
(when (and (>= it-index from)
(= (mod (- from it-index) step) 0))
(push it new-list)))
(nreverse new-list)))
(defun -take (n list)
"Return a new list of the first N items in LIST, or all items if there are fewer than N.
See also: `-take-last'"
(declare (pure t) (side-effect-free t))
(let (result)
(--dotimes n
(when list
(!cons (car list) result)
(!cdr list)))
(nreverse result)))
(defun -take-last (n list)
"Return the last N items of LIST in order.
See also: `-take'"
(declare (pure t) (side-effect-free t))
(copy-sequence (last list n)))
(defalias '-drop 'nthcdr
"Return the tail of LIST without the first N items.
See also: `-drop-last'
\(fn N LIST)")
(defun -drop-last (n list)
"Remove the last N items of LIST and return a copy.
See also: `-drop'"
;; No alias because we don't want magic optional argument
(declare (pure t) (side-effect-free t))
(butlast list n))
(defmacro --take-while (form list)
"Anaphoric form of `-take-while'."
(declare (debug (form form)))
(let ((r (make-symbol "result")))
`(let (,r)
(--each-while ,list ,form (!cons it ,r))
(nreverse ,r))))
(defun -take-while (pred list)
"Return a new list of successive items from LIST while (PRED item) returns a non-nil value."
(--take-while (funcall pred it) list))
(defmacro --drop-while (form list)
"Anaphoric form of `-drop-while'."
(declare (debug (form form)))
(let ((l (make-symbol "list")))
`(let ((,l ,list))
(while (and ,l (let ((it (car ,l))) ,form))
(!cdr ,l))
,l)))
(defun -drop-while (pred list)
"Return the tail of LIST starting from the first item for which (PRED item) returns nil."
(--drop-while (funcall pred it) list))
(defun -split-at (n list)
"Return a list of ((-take N LIST) (-drop N LIST)), in no more than one pass through the list."
(declare (pure t) (side-effect-free t))
(let (result)
(--dotimes n
(when list
(!cons (car list) result)
(!cdr list)))
(list (nreverse result) list)))
(defun -rotate (n list)
"Rotate LIST N places to the right. With N negative, rotate to the left.
The time complexity is O(n)."
(declare (pure t) (side-effect-free t))
(if (> n 0)
(append (last list n) (butlast list n))
(append (-drop (- n) list) (-take (- n) list))))
(defun -insert-at (n x list)
"Return a list with X inserted into LIST at position N.
See also: `-splice', `-splice-list'"
(declare (pure t) (side-effect-free t))
(let ((split-list (-split-at n list)))
(nconc (car split-list) (cons x (cadr split-list)))))
(defun -replace-at (n x list)
"Return a list with element at Nth position in LIST replaced with X.
See also: `-replace'"
(declare (pure t) (side-effect-free t))
(let ((split-list (-split-at n list)))
(nconc (car split-list) (cons x (cdr (cadr split-list))))))
(defun -update-at (n func list)
"Return a list with element at Nth position in LIST replaced with `(func (nth n list))`.
See also: `-map-when'"
(let ((split-list (-split-at n list)))
(nconc (car split-list) (cons (funcall func (car (cadr split-list))) (cdr (cadr split-list))))))
(defmacro --update-at (n form list)
"Anaphoric version of `-update-at'."
(declare (debug (form form form)))
`(-update-at ,n (lambda (it) ,form) ,list))
(defun -remove-at (n list)
"Return a list with element at Nth position in LIST removed.
See also: `-remove-at-indices', `-remove'"
(declare (pure t) (side-effect-free t))
(-remove-at-indices (list n) list))
(defun -remove-at-indices (indices list)
"Return a list whose elements are elements from LIST without
elements selected as `(nth i list)` for all i
from INDICES.
See also: `-remove-at', `-remove'"
(declare (pure t) (side-effect-free t))
(let* ((indices (-sort '< indices))
(diffs (cons (car indices) (-map '1- (-zip-with '- (cdr indices) indices))))
r)
(--each diffs
(let ((split (-split-at it list)))
(!cons (car split) r)
(setq list (cdr (cadr split)))))
(!cons list r)
(apply '-concat (nreverse r))))
(defmacro --split-with (pred list)
"Anaphoric form of `-split-with'."
(declare (debug (form form)))
(let ((l (make-symbol "list"))
(r (make-symbol "result"))
(c (make-symbol "continue")))
`(let ((,l ,list)
(,r nil)
(,c t))
(while (and ,l ,c)
(let ((it (car ,l)))
(if (not ,pred)
(setq ,c nil)
(!cons it ,r)
(!cdr ,l))))
(list (nreverse ,r) ,l))))
(defun -split-with (pred list)
"Return a list of ((-take-while PRED LIST) (-drop-while PRED LIST)), in no more than one pass through the list."
(--split-with (funcall pred it) list))
(defmacro -split-on (item list)
"Split the LIST each time ITEM is found.
Unlike `-partition-by', the ITEM is discarded from the results.
Empty lists are also removed from the result.
Comparison is done by `equal'.
See also `-split-when'"
(declare (debug (form form)))
`(-split-when (lambda (it) (equal it ,item)) ,list))
(defmacro --split-when (form list)
"Anaphoric version of `-split-when'."
(declare (debug (form form)))
`(-split-when (lambda (it) ,form) ,list))
(defun -split-when (fn list)
"Split the LIST on each element where FN returns non-nil.
Unlike `-partition-by', the \"matched\" element is discarded from
the results. Empty lists are also removed from the result.
This function can be thought of as a generalization of
`split-string'."
(let (r s)
(while list
(if (not (funcall fn (car list)))
(push (car list) s)
(when s (push (nreverse s) r))
(setq s nil))
(!cdr list))
(when s (push (nreverse s) r))
(nreverse r)))
(defmacro --separate (form list)
"Anaphoric form of `-separate'."
(declare (debug (form form)))
(let ((y (make-symbol "yes"))
(n (make-symbol "no")))
`(let (,y ,n)
(--each ,list (if ,form (!cons it ,y) (!cons it ,n)))
(list (nreverse ,y) (nreverse ,n)))))
(defun -separate (pred list)
"Return a list of ((-filter PRED LIST) (-remove PRED LIST)), in one pass through the list."
(--separate (funcall pred it) list))
(defun ---partition-all-in-steps-reversed (n step list)
"Private: Used by -partition-all-in-steps and -partition-in-steps."
(when (< step 1)
(error "Step must be a positive number, or you're looking at some juicy infinite loops."))
(let ((result nil))
(while list
(!cons (-take n list) result)
(setq list (-drop step list)))
result))
(defun -partition-all-in-steps (n step list)
"Return a new list with the items in LIST grouped into N-sized sublists at offsets STEP apart.
The last groups may contain less than N items."
(declare (pure t) (side-effect-free t))
(nreverse (---partition-all-in-steps-reversed n step list)))
(defun -partition-in-steps (n step list)
"Return a new list with the items in LIST grouped into N-sized sublists at offsets STEP apart.
If there are not enough items to make the last group N-sized,
those items are discarded."
(declare (pure t) (side-effect-free t))
(let ((result (---partition-all-in-steps-reversed n step list)))
(while (and result (< (length (car result)) n))
(!cdr result))
(nreverse result)))
(defun -partition-all (n list)
"Return a new list with the items in LIST grouped into N-sized sublists.
The last group may contain less than N items."
(declare (pure t) (side-effect-free t))
(-partition-all-in-steps n n list))
(defun -partition (n list)
"Return a new list with the items in LIST grouped into N-sized sublists.
If there are not enough items to make the last group N-sized,
those items are discarded."
(declare (pure t) (side-effect-free t))
(-partition-in-steps n n list))
(defmacro --partition-by (form list)
"Anaphoric form of `-partition-by'."
(declare (debug (form form)))
(let ((r (make-symbol "result"))
(s (make-symbol "sublist"))
(v (make-symbol "value"))
(n (make-symbol "new-value"))
(l (make-symbol "list")))
`(let ((,l ,list))
(when ,l
(let* ((,r nil)
(it (car ,l))
(,s (list it))
(,v ,form)
(,l (cdr ,l)))
(while ,l
(let* ((it (car ,l))
(,n ,form))
(unless (equal ,v ,n)
(!cons (nreverse ,s) ,r)
(setq ,s nil)
(setq ,v ,n))
(!cons it ,s)
(!cdr ,l)))
(!cons (nreverse ,s) ,r)
(nreverse ,r))))))
(defun -partition-by (fn list)
"Apply FN to each item in LIST, splitting it each time FN returns a new value."
(--partition-by (funcall fn it) list))
(defmacro --partition-by-header (form list)
"Anaphoric form of `-partition-by-header'."
(declare (debug (form form)))
(let ((r (make-symbol "result"))
(s (make-symbol "sublist"))
(h (make-symbol "header-value"))
(b (make-symbol "seen-body?"))
(n (make-symbol "new-value"))
(l (make-symbol "list")))
`(let ((,l ,list))
(when ,l
(let* ((,r nil)
(it (car ,l))
(,s (list it))
(,h ,form)
(,b nil)
(,l (cdr ,l)))
(while ,l
(let* ((it (car ,l))
(,n ,form))
(if (equal ,h ,n)
(when ,b
(!cons (nreverse ,s) ,r)
(setq ,s nil)
(setq ,b nil))
(setq ,b t))
(!cons it ,s)
(!cdr ,l)))
(!cons (nreverse ,s) ,r)
(nreverse ,r))))))
(defun -partition-by-header (fn list)
"Apply FN to the first item in LIST. That is the header
value. Apply FN to each item in LIST, splitting it each time FN
returns the header value, but only after seeing at least one
other value (the body)."
(--partition-by-header (funcall fn it) list))
(defun -partition-after-pred (pred list)
"Partition directly after each time PRED is true on an element of LIST."
(when list
(let ((rest (-partition-after-pred pred
(cdr list))))
(if (funcall pred (car list))
;;split after (car list)
(cons (list (car list))
rest)
;;don't split after (car list)
(cons (cons (car list)
(car rest))
(cdr rest))))))
(defun -partition-before-pred (pred list)
"Partition directly before each time PRED is true on an element of LIST."
(nreverse (-map #'reverse
(-partition-after-pred pred (reverse list)))))
(defun -partition-after-item (item list)
"Partition directly after each time ITEM appears in LIST."
(-partition-after-pred (lambda (ele) (equal ele item))
list))
(defun -partition-before-item (item list)
"Partition directly before each time ITEM appears in LIST."
(-partition-before-pred (lambda (ele) (equal ele item))
list))
(defmacro --group-by (form list)
"Anaphoric form of `-group-by'."
(declare (debug t))
(let ((n (make-symbol "n"))
(k (make-symbol "k"))
(grp (make-symbol "grp")))
`(nreverse
(-map
(lambda (,n)
(cons (car ,n)
(nreverse (cdr ,n))))
(--reduce-from
(let* ((,k (,@form))
(,grp (assoc ,k acc)))
(if ,grp
(setcdr ,grp (cons it (cdr ,grp)))
(push
(list ,k it)
acc))
acc)
nil ,list)))))
(defun -group-by (fn list)
"Separate LIST into an alist whose keys are FN applied to the
elements of LIST. Keys are compared by `equal'."
(--group-by (funcall fn it) list))
(defun -interpose (sep list)
"Return a new list of all elements in LIST separated by SEP."
(declare (pure t) (side-effect-free t))
(let (result)
(when list
(!cons (car list) result)
(!cdr list))
(while list
(setq result (cons (car list) (cons sep result)))
(!cdr list))
(nreverse result)))
(defun -interleave (&rest lists)
"Return a new list of the first item in each list, then the second etc."
(declare (pure t) (side-effect-free t))
(when lists
(let (result)
(while (-none? 'null lists)
(--each lists (!cons (car it) result))
(setq lists (-map 'cdr lists)))
(nreverse result))))
(defmacro --zip-with (form list1 list2)
"Anaphoric form of `-zip-with'.
The elements in list1 are bound as symbol `it', the elements in list2 as symbol `other'."
(declare (debug (form form form)))
(let ((r (make-symbol "result"))
(l1 (make-symbol "list1"))
(l2 (make-symbol "list2")))
`(let ((,r nil)
(,l1 ,list1)
(,l2 ,list2))
(while (and ,l1 ,l2)
(let ((it (car ,l1))
(other (car ,l2)))
(!cons ,form ,r)
(!cdr ,l1)
(!cdr ,l2)))
(nreverse ,r))))
(defun -zip-with (fn list1 list2)
"Zip the two lists LIST1 and LIST2 using a function FN. This
function is applied pairwise taking as first argument element of
LIST1 and as second argument element of LIST2 at corresponding
position.
The anaphoric form `--zip-with' binds the elements from LIST1 as symbol `it',
and the elements from LIST2 as symbol `other'."
(--zip-with (funcall fn it other) list1 list2))
(defun -zip (&rest lists)
"Zip LISTS together. Group the head of each list, followed by the
second elements of each list, and so on. The lengths of the returned
groupings are equal to the length of the shortest input list.
If two lists are provided as arguments, return the groupings as a list
of cons cells. Otherwise, return the groupings as a list of lists.
Please note! This distinction is being removed in an upcoming 3.0
release of Dash. If you rely on this behavior, use -zip-pair instead."
(declare (pure t) (side-effect-free t))
(when lists
(let (results)
(while (-none? 'null lists)
(setq results (cons (mapcar 'car lists) results))
(setq lists (mapcar 'cdr lists)))
(setq results (nreverse results))
(if (= (length lists) 2)
;; to support backward compatability, return
;; a cons cell if two lists were provided
(--map (cons (car it) (cadr it)) results)
results))))
(defalias '-zip-pair '-zip)
(defun -zip-fill (fill-value &rest lists)
"Zip LISTS, with FILL-VALUE padded onto the shorter lists. The
lengths of the returned groupings are equal to the length of the
longest input list."
(declare (pure t) (side-effect-free t))
(apply '-zip (apply '-pad (cons fill-value lists))))
(defun -unzip (lists)
"Unzip LISTS.
This works just like `-zip' but takes a list of lists instead of
a variable number of arguments, such that
(-unzip (-zip L1 L2 L3 ...))
is identity (given that the lists are the same length).
See also: `-zip'"
(apply '-zip lists))
(defun -cycle (list)
"Return an infinite copy of LIST that will cycle through the
elements and repeat from the beginning."
(declare (pure t) (side-effect-free t))
(let ((newlist (-map 'identity list)))
(nconc newlist newlist)))
(defun -pad (fill-value &rest lists)
"Appends FILL-VALUE to the end of each list in LISTS such that they
will all have the same length."
(let* ((annotations (-annotate 'length lists))
(n (-max (-map 'car annotations))))
(--map (append (cdr it) (-repeat (- n (car it)) fill-value)) annotations)))
(defun -annotate (fn list)
"Return a list of cons cells where each cell is FN applied to each
element of LIST paired with the unmodified element of LIST."
(-zip (-map fn list) list))
(defmacro --annotate (form list)
"Anaphoric version of `-annotate'."
(declare (debug (form form)))
`(-annotate (lambda (it) ,form) ,list))
(defun dash--table-carry (lists restore-lists &optional re)
"Helper for `-table' and `-table-flat'.
If a list overflows, carry to the right and reset the list."
(while (not (or (car lists)
(equal lists '(nil))))
(setcar lists (car restore-lists))
(pop (cadr lists))
(!cdr lists)
(!cdr restore-lists)
(when re
(push (nreverse (car re)) (cadr re))
(setcar re nil)
(!cdr re))))
(defun -table (fn &rest lists)
"Compute outer product of LISTS using function FN.
The function FN should have the same arity as the number of
supplied lists.
The outer product is computed by applying fn to all possible
combinations created by taking one element from each list in
order. The dimension of the result is (length lists).
See also: `-table-flat'"
(let ((restore-lists (copy-sequence lists))
(last-list (last lists))
(re (make-list (length lists) nil)))
(while (car last-list)
(let ((item (apply fn (-map 'car lists))))
(push item (car re))
(setcar lists (cdar lists)) ;; silence byte compiler
(dash--table-carry lists restore-lists re)))
(nreverse (car (last re)))))
(defun -table-flat (fn &rest lists)
"Compute flat outer product of LISTS using function FN.
The function FN should have the same arity as the number of
supplied lists.
The outer product is computed by applying fn to all possible
combinations created by taking one element from each list in
order. The results are flattened, ignoring the tensor structure
of the result. This is equivalent to calling:
(-flatten-n (1- (length lists)) (apply \\='-table fn lists))
but the implementation here is much more efficient.
See also: `-flatten-n', `-table'"
(let ((restore-lists (copy-sequence lists))
(last-list (last lists))
re)
(while (car last-list)
(let ((item (apply fn (-map 'car lists))))
(push item re)
(setcar lists (cdar lists)) ;; silence byte compiler
(dash--table-carry lists restore-lists)))
(nreverse re)))
(defun -partial (fn &rest args)
"Take a function FN and fewer than the normal arguments to FN,
and return a fn that takes a variable number of additional ARGS.
When called, the returned function calls FN with ARGS first and
then additional args."
(apply 'apply-partially fn args))
(defun -elem-index (elem list)
"Return the index of the first element in the given LIST which
is equal to the query element ELEM, or nil if there is no
such element."
(declare (pure t) (side-effect-free t))
(car (-elem-indices elem list)))
(defun -elem-indices (elem list)
"Return the indices of all elements in LIST equal to the query
element ELEM, in ascending order."
(declare (pure t) (side-effect-free t))
(-find-indices (-partial 'equal elem) list))
(defun -find-indices (pred list)
"Return the indices of all elements in LIST satisfying the
predicate PRED, in ascending order."
(apply 'append (--map-indexed (when (funcall pred it) (list it-index)) list)))
(defmacro --find-indices (form list)
"Anaphoric version of `-find-indices'."
(declare (debug (form form)))
`(-find-indices (lambda (it) ,form) ,list))
(defun -find-index (pred list)
"Take a predicate PRED and a LIST and return the index of the
first element in the list satisfying the predicate, or nil if
there is no such element.
See also `-first'."
(car (-find-indices pred list)))
(defmacro --find-index (form list)
"Anaphoric version of `-find-index'."
(declare (debug (form form)))
`(-find-index (lambda (it) ,form) ,list))
(defun -find-last-index (pred list)
"Take a predicate PRED and a LIST and return the index of the
last element in the list satisfying the predicate, or nil if
there is no such element.
See also `-last'."
(-last-item (-find-indices pred list)))
(defmacro --find-last-index (form list)
"Anaphoric version of `-find-last-index'."
`(-find-last-index (lambda (it) ,form) ,list))
(defun -select-by-indices (indices list)
"Return a list whose elements are elements from LIST selected
as `(nth i list)` for all i from INDICES."
(declare (pure t) (side-effect-free t))
(let (r)
(--each indices
(!cons (nth it list) r))
(nreverse r)))
(defun -select-columns (columns table)
"Select COLUMNS from TABLE.
TABLE is a list of lists where each element represents one row.
It is assumed each row has the same length.
Each row is transformed such that only the specified COLUMNS are
selected.
See also: `-select-column', `-select-by-indices'"
(declare (pure t
gitextract_6otzjjkx/ ├── .editorconfig ├── .gitignore ├── .travis.yml ├── Makefile ├── README.md ├── jiralib.el ├── org-jira-sdk.el ├── org-jira.el ├── t/ │ ├── .nosearch │ ├── batch-runner/ │ │ ├── dash.el │ │ ├── request.el │ │ └── s.el │ ├── jiralib-t.el │ └── org-jira-t.el └── todo.org
Condensed preview — 15 files, each showing path, character count, and a content snippet. Download the .json file or copy for the full structured content (353K chars).
[
{
"path": ".editorconfig",
"chars": 141,
"preview": "root = true\n\n[*]\nend_of_line = lf\ninsert_final_newline = true\ncharset = utf-8\ntrim_trailing_whitespace = true\n\n[*.{el}]\n"
},
{
"path": ".gitignore",
"chars": 31,
"preview": "#.*#\n*#*#\n*.#*\nflycheck_*\n*.elc"
},
{
"path": ".travis.yml",
"chars": 228,
"preview": "language: emacs-lisp\nsudo: false\nenv:\n - EVM_EMACS=emacs-25.1-travis\n - EVM_EMACS=emacs-25.2-travis\n - EVM_EMACS=emac"
},
{
"path": "Makefile",
"chars": 326,
"preview": "# 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-"
},
{
"path": "README.md",
"chars": 6397,
"preview": "# org-jira mode\n\n[](htt"
},
{
"path": "jiralib.el",
"chars": 49901,
"preview": ";;; jiralib.el -- Provide connectivity to JIRA SOAP/REST services.\n\n;; Copyright (C) 2016,2017 Matthew Carter <m@ahungry"
},
{
"path": "org-jira-sdk.el",
"chars": 9132,
"preview": ";;; org-jira-sdk.el -- SDK Layer for entities\n\n;; Copyright (C) 2018 Matthew Carter <m@ahungry.com>\n;;\n;; Authors:\n;; Ma"
},
{
"path": "org-jira.el",
"chars": 88233,
"preview": ";;; org-jira.el --- Syncing between Jira and Org-mode. -*- lexical-binding: t -*-\n\n;; Copyright (C) 2016-2018 Matthew Ca"
},
{
"path": "t/.nosearch",
"chars": 0,
"preview": ""
},
{
"path": "t/batch-runner/dash.el",
"chars": 100328,
"preview": ";;; dash.el --- A modern list library for Emacs -*- lexical-binding: t -*-\n\n;; Copyright (C) 2012-2016 Free Software Fo"
},
{
"path": "t/batch-runner/request.el",
"chars": 48828,
"preview": ";;; request.el --- Compatible layer for URL request in Emacs -*- lexical-binding: t; -*-\n\n;; Copyright (C) 2012 Takafumi"
},
{
"path": "t/batch-runner/s.el",
"chars": 23075,
"preview": ";;; s.el --- The long lost Emacs string manipulation library.\n\n;; Copyright (C) 2012-2015 Magnar Sveen\n\n;; Author: Magna"
},
{
"path": "t/jiralib-t.el",
"chars": 1569,
"preview": ";;; jiralib-t.el --- ERT tests\n\n;; Copyright (C) 2017 Matthew Carter <m@ahungry.com>\n;;\n;; Authors:\n;; Matthew Carter <m"
},
{
"path": "t/org-jira-t.el",
"chars": 10870,
"preview": ";;; org-jira-t.el --- ERT tests\n\n;; Copyright (C) 2017 Matthew Carter <m@ahungry.com>\n;;\n;; Authors:\n;; Matthew Carter <"
},
{
"path": "todo.org",
"chars": 176,
"preview": "* Worklog\n** TODO Sync up Estimate/Remaining Estimate in Worklog or Property\nWith the dynamic org clocking, integrate wi"
}
]
About this extraction
This page contains the full source code of the baohaojun/org-jira GitHub repository, extracted and formatted as plain text for AI agents and large language models (LLMs). The extraction includes 15 files (331.3 KB), approximately 86.2k tokens. Use this with OpenClaw, Claude, ChatGPT, Cursor, Windsurf, or any other AI tool that accepts text input. You can copy the full output to your clipboard or download it as a .txt file.
Extracted by GitExtract — free GitHub repo to text converter for AI. Built by Nikandr Surkov.